diff --git a/.github/actions/check-copyright-headers/action.yml b/.github/actions/check-copyright-headers/action.yml
new file mode 100644
index 0000000000..bb353b0ae3
--- /dev/null
+++ b/.github/actions/check-copyright-headers/action.yml
@@ -0,0 +1,20 @@
+# Copyright Strata Contributors
+# SPDX-License-Identifier: Apache-2.0 OR MIT
+name: Check copyright headers
+description: >
+  Verify that all .lean files have the expected copyright header.
+  Downstream repos can add their own checks for other file types.
+
+inputs:
+  directory:
+    description: Root directory to scan (relative to the workspace).
+    required: false
+    default: "."
+
+runs:
+  using: composite
+  steps:
+    - name: Check copyright headers
+      shell: bash
+      run: |
+        python3 "${{ github.action_path }}/../../scripts/check_copyright_headers.py" "${{ inputs.directory }}"
diff --git a/.github/actions/check-lean-import/action.yml b/.github/actions/check-lean-import/action.yml
new file mode 100644
index 0000000000..b57772235a
--- /dev/null
+++ b/.github/actions/check-lean-import/action.yml
@@ -0,0 +1,20 @@
+# Copyright Strata Contributors
+# SPDX-License-Identifier: Apache-2.0 OR MIT
+name: Check Lean import
+description: >
+  Ensure no .lean file uses a bare "import Lean" statement. Encourages
+  importing only the specific parts of Lean that are needed.
+
+inputs:
+  directory:
+    description: Directory to scan for .lean files (relative to the workspace).
+    required: false
+    default: "."
+
+runs:
+  using: composite
+  steps:
+    - name: Check for bare import Lean
+      shell: bash
+      run: |
+        "${{ github.action_path }}/../../scripts/checkLeanImport.sh" "${{ inputs.directory }}"
diff --git a/.github/actions/check-no-panic/action.yml b/.github/actions/check-no-panic/action.yml
new file mode 100644
index 0000000000..1b79e629c7
--- /dev/null
+++ b/.github/actions/check-no-panic/action.yml
@@ -0,0 +1,24 @@
+# Copyright Strata Contributors
+# SPDX-License-Identifier: Apache-2.0 OR MIT
+name: Check no panic
+description: >
+  Detect net-new panic! calls introduced in a PR. Only fails when more
+  panics are added than removed. Suppression: add "-- nopanic:ok" on a line.
+  Requires actions/checkout with fetch-depth: 0 (needs full git history to
+  compute the merge base).
+
+inputs:
+  base-ref:
+    description: >
+      Git ref to diff against (e.g. "origin/main"). The script computes
+      the merge base automatically.
+    required: false
+    default: "origin/main"
+
+runs:
+  using: composite
+  steps:
+    - name: Check for new panic! usage
+      shell: bash
+      run: |
+        "${{ github.action_path }}/../../scripts/checkNoPanic.sh" "${{ inputs.base-ref }}"
diff --git a/.github/actions/lint-whitespace/action.yml b/.github/actions/lint-whitespace/action.yml
new file mode 100644
index 0000000000..7a2f586b6f
--- /dev/null
+++ b/.github/actions/lint-whitespace/action.yml
@@ -0,0 +1,19 @@
+# Copyright Strata Contributors
+# SPDX-License-Identifier: Apache-2.0 OR MIT
+name: Lint whitespace
+description: >
+  Check .lean files for trailing whitespace and missing final newlines.
+
+inputs:
+  directory:
+    description: Directory to scan for .lean files (relative to the workspace).
+    required: false
+    default: "Strata"
+
+runs:
+  using: composite
+  steps:
+    - name: Check for trailing whitespace
+      shell: bash
+      run: |
+        "${{ github.action_path }}/../../scripts/lintWhitespace.sh" "${{ inputs.directory }}"
diff --git a/.github/actions/restore-lake-cache/action.yml b/.github/actions/restore-lake-cache/action.yml
index 9151866cfd..3f156fa761 100644
--- a/.github/actions/restore-lake-cache/action.yml
+++ b/.github/actions/restore-lake-cache/action.yml
@@ -66,9 +66,9 @@ runs:
       uses: actions/cache/restore@v5
       with:
         path: ${{ inputs.path }}
-        key: ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }}
+        key: ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('[^.]*/**/*.st', '*.st') }}-${{ github.sha }}
         restore-keys: |
-          ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}
+          ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('[^.]*/**/*.st', '*.st') }}
           ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}
           ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}
         fail-on-cache-miss: ${{ inputs.fail-on-cache-miss }}
@@ -78,5 +78,5 @@ runs:
       uses: actions/cache/restore@v5
       with:
         path: ${{ inputs.path }}
-        key: ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }}
+        key: ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('[^.]*/**/*.st', '*.st') }}-${{ github.sha }}
         fail-on-cache-miss: ${{ inputs.fail-on-cache-miss }}
diff --git a/.github/actions/save-lake-cache/action.yml b/.github/actions/save-lake-cache/action.yml
index 5754371b87..e4834362e9 100644
--- a/.github/actions/save-lake-cache/action.yml
+++ b/.github/actions/save-lake-cache/action.yml
@@ -32,4 +32,4 @@ runs:
       uses: actions/cache/save@v5
       with:
         path: ${{ inputs.path }}
-        key: ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('**/*.st') }}-${{ github.sha }}
+        key: ${{ inputs.key-prefix }}-${{ runner.os }}-${{ runner.arch }}-${{ hashFiles('lean-toolchain') }}-${{ hashFiles('lake-manifest.json') }}-${{ hashFiles('[^.]*/**/*.st', '*.st') }}-${{ github.sha }}
diff --git a/.github/labeler.yml b/.github/labeler.yml
index c0fd35fdbf..02a7c8ce07 100644
--- a/.github/labeler.yml
+++ b/.github/labeler.yml
@@ -2,7 +2,8 @@ Python:
   - changed-files:
       - any-glob-to-any-file:
           - 'StrataPython/**'
-          - 'Tools/Python/**'
+          - 'Tools/Python-base/**'
+          - 'StrataPython/Tools/strata-python/**'
 
 Laurel:
   - changed-files:
@@ -41,7 +42,8 @@ dependencies:
           - 'lake-manifest.json'
           - 'lakefile.toml'
           - 'lean-toolchain'
-          - 'Tools/Python/pyproject.toml'
+          - 'Tools/Python-base/pyproject.toml'
+          - 'StrataPython/Tools/strata-python/pyproject.toml'
           - 'Tools/BoogieToStrata/**/*.csproj'
           - 'Tools/BoogieToStrata/**/*.sln'
 
diff --git a/.github/scripts/checkLeanImport.sh b/.github/scripts/checkLeanImport.sh
index 9b4d64d76b..b3f9063759 100755
--- a/.github/scripts/checkLeanImport.sh
+++ b/.github/scripts/checkLeanImport.sh
@@ -2,4 +2,6 @@
 # Check to identify modules that inadvertently import all of Lean.
 # We want to encourage only importing parts of Lean when needed.
 
-! (find . -name "*.lean" -type f -print0 | xargs -0 grep -E -n '^import Lean$')
\ No newline at end of file
+LINT_DIR="${1:-.}"
+
+! (find "$LINT_DIR" -name "*.lean" -type f -print0 | xargs -0 grep -E -n '^import Lean$')
\ No newline at end of file
diff --git a/.github/scripts/check_copyright_headers.py b/.github/scripts/check_copyright_headers.py
index 3672ee3bac..e983f34212 100644
--- a/.github/scripts/check_copyright_headers.py
+++ b/.github/scripts/check_copyright_headers.py
@@ -59,12 +59,6 @@ def check_all_source_files(directory: Path, ext: str, header: str) -> bool:
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/"""
 
-python_copyright_header = """\
-# Copyright Strata Contributors
-#
-#  SPDX-License-Identifier: Apache-2.0 OR MIT
-"""
-
 def main():
     """Main function to handle command line arguments"""
     if len(sys.argv) != 2:
@@ -73,15 +67,7 @@ def main():
         sys.exit(1)
 
     directory_path = Path(sys.argv[1])
-    success = True
-
-    if not check_all_source_files(directory_path, ext=".lean", header=lean_copyright_header):
-        success = False
-
-    if not check_all_source_files(directory_path / 'Tools', ext=".py", header=python_copyright_header):
-        success = False
-
-    # Exit with appropriate code
+    success = check_all_source_files(directory_path, ext=".lean", header=lean_copyright_header)
     sys.exit(0 if success else 1)
 
 if __name__ == "__main__":
diff --git a/.github/scripts/lintWhitespace.sh b/.github/scripts/lintWhitespace.sh
index 9d0c27a5f1..bd2d69255b 100755
--- a/.github/scripts/lintWhitespace.sh
+++ b/.github/scripts/lintWhitespace.sh
@@ -1,9 +1,12 @@
 #!/bin/bash
+set -e
+
+LINT_DIR="${1:-Strata}"
 
 tmpfile=$(mktemp)
 issues_found=0
 
-find Strata -type f -name "*.lean" | while IFS= read -r file; do
+find "$LINT_DIR" -type f -name "*.lean" | while IFS= read -r file; do
     # Check for trailing whitespace and print line number if found
     while IFS=: read -r line_num line; do
         echo "Trailing whitespace found in $file at line $line_num: $line"
diff --git a/.github/workflows/cbmc.yml b/.github/workflows/cbmc.yml
index b6a9f739bb..4a6f5134ae 100644
--- a/.github/workflows/cbmc.yml
+++ b/.github/workflows/cbmc.yml
@@ -82,7 +82,8 @@ jobs:
       - name: Run Python CBMC pipeline tests
         shell: bash
         run: |
-          pip install ./Tools/Python
+          pip install ./Tools/Python-base
+          pip install ./StrataPython/Tools/strata-python
           ./StrataPython/StrataPythonTest/run_py_cbmc_tests.sh
       - name: Run property summary tests
         shell: bash
diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml
index 5bc38adc7d..35202f6b57 100644
--- a/.github/workflows/ci.yml
+++ b/.github/workflows/ci.yml
@@ -115,8 +115,9 @@ jobs:
         with:
           python-version: '3.14'
       - name: Build using pip
-        run: pip install .
-        working-directory: Tools/Python
+        run: |
+          pip install ./Tools/Python-base
+          pip install ./StrataPython/Tools/strata-python
       - name: Run pyInterpret golden-file tests
         working-directory: StrataPython/StrataPythonTest
         shell: bash
@@ -145,8 +146,9 @@ jobs:
       with:
         python-version: '3.14'
     - name: Build using pip
-      run: pip install .
-      working-directory: Tools/Python
+      run: |
+        pip install ./Tools/Python-base
+        pip install ./StrataPython/Tools/strata-python
     - name: Restore Lean build cache
       # The cache is safe to use here because we just saved it for this exact SHA
       # in the build_and_test_lean job
@@ -261,8 +263,9 @@ jobs:
       with:
         python-version: ${{ matrix.python_version }}
     - name: Build using pip
-      run: pip install .
-      working-directory: Tools/Python
+      run: |
+        pip install ./Tools/Python-base
+        pip install ./StrataPython/Tools/strata-python
     - name: Restore Lean build cache
       # The cache is safe to use here because we just saved it for this exact SHA
       # in the build_and_test_lean job from ci.yml
@@ -304,7 +307,7 @@ jobs:
       working-directory: StrataPython
     - name: Run test script
       run: FAIL_FAST=1 ./scripts/run_cpython_tests.sh ${{ matrix.python_version }}
-      working-directory: Tools/Python
+      working-directory: StrataPython/Tools/strata-python
 
   cbmc:
     needs: build_and_test_lean
diff --git a/.kiro/steering/structure.md b/.kiro/steering/structure.md
index 4445fa325b..e29800ee73 100644
--- a/.kiro/steering/structure.md
+++ b/.kiro/steering/structure.md
@@ -15,8 +15,6 @@ Strata is a Lean4 verification framework using **dialects** as composable langua
 - `Strata/` - Core implementation (DDM, dialects, languages, transforms, backends)
 - `StrataTest/` - Unit tests (mirrors Strata/ structure)
 - `Examples/` - Sample programs (`.st` files, naming: `<name>.<dialect>.st`)
-- `Tools/` - External tools (BoogieToStrata, Python utilities)
-- `vcs/` - Generated SMT2 verification conditions
 
 ### Core Components
 
@@ -34,9 +32,7 @@ Strata is a Lean4 verification framework using **dialects** as composable langua
 - `Core/` - Primary verification language (procedures, contracts, VCG, SMT encoding)
 - `C_Simp/` - Simplified C-like language
 - `Dyn/` - Dynamic language example
-- `Laurel/` - A common representation for front-end languages like Java, Python and JavaScript.
-Translated to Core.
-- `Python/` - The well-known Python language
+- `Laurel/` - A common representation for front-end languages like Java, Python and JavaScript. Translated to Core.
 
 **`Strata/Transform/`** - Program Transformations
 - Each transformation has implementation + optional correctness proof (`*Correct.lean`)
diff --git a/Examples/CFGNondet.core.st b/Examples/CFGNondet.core.st
new file mode 100644
index 0000000000..ab23e62eb8
--- /dev/null
+++ b/Examples/CFGNondet.core.st
@@ -0,0 +1,23 @@
+program Core;
+
+// Nondeterministic CFG: y is set to either 1 or 2.
+procedure NondetChoice(out y : int)
+spec {
+  ensures (y == 1 || y == 2);
+}
+cfg entry {
+  entry: {
+    goto left, right;
+  }
+  left: {
+    y := 1;
+    goto done;
+  }
+  right: {
+    y := 2;
+    goto done;
+  }
+  done: {
+    return;
+  }
+};
diff --git a/Examples/CFGSimple.core.st b/Examples/CFGSimple.core.st
new file mode 100644
index 0000000000..2e7bc54d93
--- /dev/null
+++ b/Examples/CFGSimple.core.st
@@ -0,0 +1,48 @@
+program Core;
+
+// A simple deterministic CFG: compute max of two integers.
+procedure Max(x : int, y : int, out m : int)
+spec {
+  ensures (m >= x);
+  ensures (m >= y);
+  ensures (m == x || m == y);
+}
+cfg entry {
+  entry: {
+    branch (x >= y) goto then_branch else goto else_branch;
+  }
+  then_branch: {
+    m := x;
+    goto done;
+  }
+  else_branch: {
+    m := y;
+    goto done;
+  }
+  done: {
+    return;
+  }
+};
+
+// A CFG with a simple loop: increment y until it reaches n.
+procedure CountUp(n : int, out y : int)
+spec {
+  requires (n >= 0);
+  ensures (y == n);
+}
+cfg entry {
+  entry: {
+    y := 0;
+    goto loop;
+  }
+  loop: {
+    branch (y < n) goto body else goto done;
+  }
+  body: {
+    y := y + 1;
+    goto loop;
+  }
+  done: {
+    return;
+  }
+};
diff --git a/README.md b/README.md
index 7f0c69e097..3102b9c54d 100644
--- a/README.md
+++ b/README.md
@@ -28,13 +28,10 @@ changes!**
    (`cvc5` and `z3`). See [Installing dependencies → SMT Solvers](#smt-solvers)
    below.
 
-3. **Python 3.11+**: required for Python-related tests and the `strata`
-   Python tooling. See [Installing dependencies → Python](#python) below.
-
-4. **Java JDK (11 or later)**: required for Java code generation tests.
+3. **Java JDK (11 or later)**: required for Java code generation tests.
    See [Installing dependencies → Java](#java-for-code-generation-tests) below.
 
-5. **ion-java jar (1.11.11)**: required for the Java/Ion integration test.
+4. **ion-java jar (1.11.11)**: required for the Java/Ion integration test.
    See [Installing dependencies → Java](#java-for-code-generation-tests) below.
 
 ### Installing dependencies
@@ -54,25 +51,13 @@ cp /path/to/cvc5 /path/to/z3 ~/.local/bin/
 # or: sudo cp /path/to/cvc5 /path/to/z3 /usr/local/bin/
 ```
 
-#### Python
-
-Python 3.11 or later is required. Install the `strata` Python package inside a
-virtual environment (recommended; avoids PEP 668's `externally-managed-environment`
-error on Debian/Ubuntu 23.04+):
-
-```bash
-python3 -m venv .venv
-source .venv/bin/activate
-pip install ./Tools/Python
-```
-
 #### Java (for code generation tests)
 
 A JDK (11+) providing `javac` must be on your `PATH`. For running the
 Java/Ion integration test, download the ion-java jar:
 
 ```bash
-wget -q -O StrataTestExtra/DDM/Integration/Java/testdata/ion-java-1.11.11.jar \
+wget -q -O StrataTestExtra/Languages/Java/testdata/ion-java-1.11.11.jar \
   https://github.com/amazon-ion/ion-java/releases/download/v1.11.11/ion-java-1.11.11.jar
 ```
 
@@ -81,7 +66,6 @@ wget -q -O StrataTestExtra/DDM/Integration/Java/testdata/ion-java-1.11.11.jar \
 ```bash
 cvc5 --version    # should print version info
 z3 --version      # should print version info
-python3 --version # should be 3.11+
 ```
 
 ## Build
@@ -93,6 +77,7 @@ lake build && lake test
 ```
 
 Unit tests are run with `#guard_msgs` commands. No output means the tests passed.
+For how to write a new test, see [docs/Testing.md](docs/Testing.md).
 
 To build executable files only and omit proof checks that might take a long time, use
 
@@ -110,13 +95,10 @@ Two kinds of tests coexist in this repo:
   These accept prefix filters:
 
 ```bash
-# Run all extra tests except Python (which requires the Python package)
-lake test -- --exclude Languages.Python
-
-# Run only Python extra tests (requires `pip install ./Tools/Python`)
-lake test -- Languages.Python
+# Run all extra tests except those in the Imperative namespace
+lake test -- --exclude DL.Imperative
 
-# Run all extra tests (Python tests will fail without the Python package above)
+# Run all extra tests
 lake test
 ```
 
diff --git a/Scripts/JavaGenTestData.lean b/Scripts/JavaGenTestData.lean
new file mode 100644
index 0000000000..00a2e890dc
--- /dev/null
+++ b/Scripts/JavaGenTestData.lean
@@ -0,0 +1,79 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+import StrataDDM
+
+/-!
+# Java test data generation helper
+
+Usage:
+  lake env lean --run Scripts/JavaGenTestData.lean javaGen <dialect-file> <package> <output-dir>
+  lake env lean --run Scripts/JavaGenTestData.lean print --include <dir> <file>
+
+Note: Unlike the former CLI `javaGen` command, this script only loads dialects
+from files — it does not support referencing preloaded dialect names directly.
+This is sufficient for the testdata regeneration workflow.
+-/
+
+open StrataDDM
+
+def javaGen (dialectPath packageName outputDir : String) : IO Unit := do
+  let fm ← mkDialectFileMap
+  let d ← readStrataDialectFile fm dialectPath
+  match StrataDDM.Java.generateDialect d packageName with
+  | .ok files =>
+    StrataDDM.Java.writeJavaFiles outputDir packageName files
+    IO.println s!"Generated Java files for {d.name} in {outputDir}/{StrataDDM.Java.packageToPath packageName}"
+  | .error msg =>
+    IO.eprintln s!"Error generating Java: {msg}"
+    IO.Process.exit 1
+
+def printFile (includeDirs : List String) (file : String) : IO Unit := do
+  let fm ← mkDialectFileMap
+  let mut fm := fm
+  for dir in includeDirs do
+    match ← fm.addSearchPath dir |>.toBaseIO with
+    | .error msg =>
+      IO.eprintln msg
+      IO.Process.exit 1
+    | .ok fm' => fm := fm'
+  let ld ← fm.getLoaded
+  if mem : file ∈ ld.dialects then
+    IO.print <| ld.dialects.format file mem
+    return
+  match ← readStrataFile fm file with
+  | .dialect d =>
+    let ld ← fm.getLoaded
+    if mem : d.name ∈ ld.dialects then
+      IO.print <| ld.dialects.format d.name mem
+    else
+      IO.eprintln "Internal error reading file."
+      IO.Process.exit 1
+  | .program pgm =>
+    IO.print <| toString pgm
+
+private def parseIncludeArgs (args : List String) : List String × List String :=
+  go args []
+where
+  go : List String → List String → List String × List String
+    | "--include" :: dir :: rest, includes => go rest (dir :: includes)
+    | other, includes => (includes.reverse, other)
+
+def main (args : List String) : IO Unit := do
+  match args with
+  | "javaGen" :: dialectPath :: packageName :: outputDir :: _ =>
+    javaGen dialectPath packageName outputDir
+  | "print" :: rest =>
+    let (includeDirs, fileArgs) := parseIncludeArgs rest
+    match fileArgs with
+    | [file] => printFile includeDirs file
+    | _ =>
+      IO.eprintln "Usage: ... print [--include <dir>]... <file>"
+      IO.Process.exit 1
+  | _ =>
+    IO.eprintln "Usage:"
+    IO.eprintln "  lake env lean --run Scripts/JavaGenTestData.lean javaGen <dialect> <package> <output-dir>"
+    IO.eprintln "  lake env lean --run Scripts/JavaGenTestData.lean print [--include <dir>]... <file>"
+    IO.Process.exit 1
diff --git a/Scripts/LaurelToCBMC.lean b/Scripts/LaurelToCBMC.lean
new file mode 100644
index 0000000000..61388af488
--- /dev/null
+++ b/Scripts/LaurelToCBMC.lean
@@ -0,0 +1,134 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+import Strata.Backends.CBMC.GOTO.CoreToGOTOPipeline
+import Strata.Languages.Laurel
+
+/-! # LaurelToCBMC
+
+Script that replaces `laurel_to_cbmc.sh`. Translates a Laurel `.lr.st` source
+file through the full Strata pipeline to CBMC verification:
+
+1. Parse Laurel source → Laurel AST
+2. Translate Laurel → Core
+3. Inline procedures, type-check, generate CProver GOTO JSON
+4. Invoke `symtab2gb` to produce a GOTO binary
+5. Invoke `goto-cc` to add C scaffolding
+6. Invoke `goto-instrument --dfcc` for contract instrumentation
+7. Invoke `cbmc` for bounded model checking
+
+Usage:
+  lake env lean --run Scripts/LaurelToCBMC.lean <file.lr.st>
+
+Environment variables:
+  CBMC              - path to cbmc binary (default: cbmc)
+  GOTO_CC           - path to goto-cc binary (default: goto-cc)
+  GOTO_INSTRUMENT   - path to goto-instrument binary (default: goto-instrument)
+-/
+
+open Strata
+
+/-- Strip well-known Strata file suffixes from a file path's basename. -/
+private def deriveBaseName (file : String) : String :=
+  let name := System.FilePath.fileName file |>.getD file
+  let suffixes := [".lr.st", ".laurel.st", ".st"]
+  match suffixes.find? (name.endsWith ·) with
+  | some sfx => (name.dropEnd sfx.length).toString
+  | none     => name
+
+/-- Read an environment variable, returning a default if unset or empty. -/
+private def getEnvOrDefault (var : String) (default : String) : IO String := do
+  match ← IO.getEnv var with
+  | some v => if v.isEmpty then pure default else pure v
+  | none   => pure default
+
+/-- Run an external process. Prints stdout/stderr to the caller's streams and
+    returns the exit code. -/
+private def runProcess (step : String) (cmd : String) (args : Array String) : IO UInt32 := do
+  let proc ← IO.Process.spawn {
+    cmd := cmd
+    args := args
+    stdout := .inherit
+    stderr := .inherit
+    stdin := .inherit
+  }
+  let exitCode ← proc.wait
+  if exitCode != 0 then
+    IO.eprintln s!"Error: {step} failed (exit code {exitCode})"
+  return exitCode
+
+/-- The Laurel-to-GOTO translation pipeline. Parses a Laurel source file,
+    translates to Core, inlines procedures, type-checks, and emits CProver GOTO
+    JSON files (`<baseName>.symtab.json` and `<baseName>.goto.json`) in the
+    given output directory. -/
+private def laurelAnalyzeToGoto (path : System.FilePath) (outputDir : System.FilePath)
+    (baseName : String) : IO Unit := do
+  let content ← IO.FS.readFile path
+  let laurelProgram ← Strata.parseLaurelText path content
+  match ← Strata.Laurel.translate {} laurelProgram with
+  | (none, diags) =>
+    throw (IO.userError s!"Core translation errors: {diags.map (·.message)}")
+  | (some coreProgram, _) =>
+    -- Use the output directory as a prefix so files land in tmpDir
+    let outputBaseName := (outputDir / baseName).toString
+    match ← Strata.inlineCoreToGotoFiles coreProgram outputBaseName
+              (sourceText := some content) |>.toBaseIO with
+    | .ok () => pure ()
+    | .error msg => throw (IO.userError msg)
+
+def main (args : List String) : IO UInt32 := do
+  match args with
+  | [file] =>
+    unless file.endsWith ".lr.st" || file.endsWith ".laurel.st" do
+      IO.eprintln s!"Error: expected a .lr.st file, got: {file}"
+      return 1
+    let path : System.FilePath := file
+    unless ← path.pathExists do
+      IO.eprintln s!"Error: file not found: {file}"
+      return 1
+    let baseName := deriveBaseName file
+
+    -- Use a temporary directory for intermediate files (cleaned up automatically)
+    IO.FS.withTempDir fun tmpDir => do
+
+    -- Step 1: Laurel → GOTO JSON (in tmp dir)
+    let result ← (laurelAnalyzeToGoto path tmpDir baseName).toBaseIO
+    match result with
+    | .error e =>
+      IO.eprintln s!"Error: {e}"
+      return 1
+    | .ok () => pure ()
+
+    let symTabFile := (tmpDir / s!"{baseName}.symtab.json").toString
+    let gotoFile := (tmpDir / s!"{baseName}.goto.json").toString
+    let gbFile := (tmpDir / s!"{baseName}.gb").toString
+    let ccGbFile := (tmpDir / s!"{baseName}_cc.gb").toString
+    let dfccGbFile := (tmpDir / s!"{baseName}_dfcc.gb").toString
+
+    -- Step 2: symtab2gb
+    let rc ← runProcess "symtab2gb" "symtab2gb"
+      #[symTabFile, "--goto-functions", gotoFile, "--out", gbFile]
+    if rc != 0 then return rc
+
+    -- Step 3: goto-cc (add C scaffolding)
+    let gotoCC ← getEnvOrDefault "GOTO_CC" "goto-cc"
+    let rc ← runProcess "goto-cc" gotoCC
+      #["--function", "main", "-o", ccGbFile, gbFile]
+    if rc != 0 then return rc
+
+    -- Step 4: goto-instrument --dfcc
+    let gotoInstrument ← getEnvOrDefault "GOTO_INSTRUMENT" "goto-instrument"
+    let rc ← runProcess "goto-instrument --dfcc" gotoInstrument
+      #["--dfcc", "main", ccGbFile, dfccGbFile]
+    if rc != 0 then return rc
+
+    -- Step 5: cbmc verification
+    let cbmc ← getEnvOrDefault "CBMC" "cbmc"
+    runProcess "cbmc" cbmc
+      #[dfccGbFile, "--function", "main", "--z3", "--verbosity", "9"]
+
+  | _ =>
+    IO.eprintln "Usage: LaurelToCBMC <file.lr.st>"
+    return 1
diff --git a/Strata.lean b/Strata.lean
index d3b20a8f23..5457e4d54a 100644
--- a/Strata.lean
+++ b/Strata.lean
@@ -13,7 +13,7 @@ import StrataDDM.Ion
 
 /- Dialect Library -/
 import Strata.DL.SMT
-import Strata.DL.Lambda.Lambda
+import Strata.DL.Lambda
 import Strata.DL.Imperative
 
 /- Utilities -/
@@ -34,7 +34,6 @@ import Strata.Transform.CallElimCorrect
 import Strata.Transform.CoreSpecification
 import Strata.Transform.DetToKleeneCorrect
 import Strata.Transform.ProcBodyVerifyCorrect
-import Strata.Transform.Specification
 
 /- Strata Languages — additional -/
 import Strata.Languages.B3
@@ -79,7 +78,6 @@ import Strata.Cli.VerifyOptions
 
 -- noimport:
 import Strata.DL.Imperative.CFGSemantics
-import Strata.DL.Imperative.SemanticsProps
 import Strata.DL.Lambda.Denote.Assumptions
 import Strata.DL.Lambda.Denote.CallOfLFuncDenote
 import Strata.DL.Lambda.Denote.LExprDenote
diff --git a/Strata/Backends/CBMC/CoreToCBMC.lean b/Strata/Backends/CBMC/CoreToCBMC.lean
index 6e80119990..bfc3a27365 100644
--- a/Strata/Backends/CBMC/CoreToCBMC.lean
+++ b/Strata/Backends/CBMC/CoreToCBMC.lean
@@ -340,7 +340,8 @@ def createImplementationSymbolFromAST (func : Core.Procedure) : Except String CB
 
   -- For now, keep the hardcoded implementation but use function name from AST
   let loc : SourceLoc := { functionName := (func.header.name.toPretty), lineNum := "1" }
-  let stmtJsons ← (func.body.mapM (stmtToJson (I:=CoreLParams) · loc))
+  let bodyStmts ← func.body.getStructured
+  let stmtJsons ← (bodyStmts.mapM (stmtToJson (I:=CoreLParams) · loc))
 
   let implValue := Json.mkObj [
     ("id", "code"),
diff --git a/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean b/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean
index 6dd8ce166c..152fba1d01 100644
--- a/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean
+++ b/Strata/Backends/CBMC/GOTO/CoreToCProverGOTO.lean
@@ -204,7 +204,11 @@ def transformToGoto (cprog : Core.Program) : Except Format CProverGOTO.Context :
       if !p.header.typeArgs.isEmpty then
         throw f!"[transformToGoto] Translation for polymorphic Strata Core procedures is unimplemented."
 
-      let cmds ← p.body.mapM
+      -- TODO: This pass could be split into a two-stage transformation:
+      -- 1. structured → cfg (via StructuredToUnstructured)
+      -- 2. cfg → CProverGOTO (always operates on CFG, no pattern matching needed)
+      let bodyStmts ← p.body.getStructured.mapError fun s => f!"{s}"
+      let cmds ← bodyStmts.mapM
         (fun b => match b with
           | .cmd (.cmd c) => return c
           | _ => throw f!"[transformToGoto] We can process Strata Core commands only, not statements! \
@@ -221,7 +225,7 @@ def transformToGoto (cprog : Core.Program) : Except Format CProverGOTO.Context :
       let formals_renamed := formals.zip new_formals
       let formals_tys : Map String CProverGOTO.Ty := formals.zip formals_tys
 
-      let locals := (Imperative.Block.definedVars p.body).map Core.CoreIdent.toPretty
+      let locals := (Imperative.Block.definedVars bodyStmts false).map Core.CoreIdent.toPretty
       let new_locals := locals.map (fun l => CProverGOTO.mkLocalSymbol pname l)
       let locals_renamed := locals.zip new_locals
 
diff --git a/Strata/Backends/CBMC/GOTO/CoreToGOTOPipeline.lean b/Strata/Backends/CBMC/GOTO/CoreToGOTOPipeline.lean
index 535f7cfe39..51806cf529 100644
--- a/Strata/Backends/CBMC/GOTO/CoreToGOTOPipeline.lean
+++ b/Strata/Backends/CBMC/GOTO/CoreToGOTOPipeline.lean
@@ -44,12 +44,17 @@ namespace Strata
 
 public section
 
-private def renameIdent (rn : Std.HashMap String String) (id : Core.CoreIdent) : Core.CoreIdent :=
+/-- Rewrite a `Core.CoreIdent` according to a name-substitution map. Names absent
+from `rn` pass through unchanged; metadata is preserved. -/
+def renameIdent (rn : Std.HashMap String String) (id : Core.CoreIdent) : Core.CoreIdent :=
   match rn[id.name]? with
   | some new => ⟨new, id.metadata⟩
   | none => id
 
-private partial def renameExpr
+/-- Rewrite all free variable names in a `Core.Expression.Expr` according to `rn`.
+Recurses through binders and other expression forms; bound-variable indices are
+unchanged. -/
+partial def renameExpr
     (rn : Std.HashMap String String)
     : Core.Expression.Expr → Core.Expression.Expr
   | .fvar m name ty => .fvar m (renameIdent rn name) ty
@@ -60,7 +65,9 @@ private partial def renameExpr
   | .eq m e1 e2 => .eq m (renameExpr rn e1) (renameExpr rn e2)
   | e => e
 
-private def renameCmd
+/-- Apply a name-substitution map to identifiers and expressions inside an
+`Imperative.Cmd` over Core expressions. -/
+def renameCmd
     (rn : Std.HashMap String String)
     : Imperative.Cmd Core.Expression → Imperative.Cmd Core.Expression
   | .init name ty e md => .init (renameIdent rn name) ty (e.map (renameExpr rn)) md
@@ -106,7 +113,7 @@ private def hasCallStmt : List Core.Statement → Bool
 Collect all funcDecl statements from a procedure body (recursively)
 and return them as Core.Functions, stripping them from the body.
 -/
-private def collectFuncDecls : List Core.Statement →
+def collectFuncDecls : List Core.Statement →
     Except Std.Format (List Core.Function × List Core.Statement)
   | [] => return ([], [])
   | .funcDecl decl _ :: rest => do
@@ -263,7 +270,11 @@ def procedureToGotoCtx
     : Except Std.Format
         (CoreToGOTO.CProverGOTO.Context × List Core.Function) := do
   -- Lift local function declarations out of the body
-  let (liftedFuncs, body) ← collectFuncDecls p.body
+  -- TODO: This pass could be split into a two-stage transformation:
+  -- 1. structured → cfg (via StructuredToUnstructured)
+  -- 2. cfg → CProverGOTO (always operates on CFG, no pattern matching needed)
+  let bodyStmts ← p.body.getStructured.mapError fun s => f!"{s}"
+  let (liftedFuncs, body) ← collectFuncDecls bodyStmts
   let pname := Core.CoreIdent.toPretty p.header.name
   if !p.header.typeArgs.isEmpty then
     .error f!"[procedureToGotoCtx] Polymorphic procedures unsupported."
@@ -274,7 +285,7 @@ def procedureToGotoCtx
   let formals_tys : Map String CProverGOTO.Ty := formals.zip formals_tys
   let outputs := p.header.outputs.keys.map Core.CoreIdent.toPretty
   let new_outputs := outputs.map (CProverGOTO.mkLocalSymbol pname ·)
-  let locals := (Imperative.Block.definedVars body).map Core.CoreIdent.toPretty
+  let locals := (Imperative.Block.definedVars body false).map Core.CoreIdent.toPretty
   let new_locals := locals.map (CProverGOTO.mkLocalSymbol pname ·)
   let rn : Std.HashMap String String :=
     (formals.zip new_formals ++ outputs.zip new_outputs ++ locals.zip new_locals).foldl
diff --git a/Strata/Backends/CBMC/StrataToCBMC.lean b/Strata/Backends/CBMC/StrataToCBMC.lean
index f57b641e8b..8c385368d5 100644
--- a/Strata/Backends/CBMC/StrataToCBMC.lean
+++ b/Strata/Backends/CBMC/StrataToCBMC.lean
@@ -7,7 +7,7 @@ module
 
 public import Strata.Backends.CBMC.Common
 public import StrataDDM.AST
-import StrataDDM.Integration.Lean.HashCommands -- shake: keep
+public import StrataDDM.Integration.Lean.HashCommands -- shake: keep
 public import Strata.Languages.C_Simp.C_Simp
 import Strata.Languages.C_Simp.DDMTransform.Parse
 import Strata.Languages.C_Simp.DDMTransform.Translate
diff --git a/Strata/DL/Imperative.lean b/Strata/DL/Imperative.lean
index a9abadbe4e..dea67476fe 100644
--- a/Strata/DL/Imperative.lean
+++ b/Strata/DL/Imperative.lean
@@ -12,11 +12,12 @@ public import Strata.DL.Imperative.MetaData
 public import Strata.DL.Imperative.CmdEval
 public import Strata.DL.Imperative.CmdType
 public import Strata.DL.Imperative.CmdSemantics
+public import Strata.DL.Imperative.CmdSemanticsProps
+public import Strata.DL.Imperative.StmtProps
 public import Strata.DL.Imperative.StmtSemantics
+public import Strata.DL.Imperative.StmtSemanticsProps
 
 public import Strata.DL.Imperative.KleeneStmt
 public import Strata.DL.Imperative.KleeneStmtSemantics
 
-public import Strata.DL.Imperative.SemanticsProps
-
 public import Strata.DL.Imperative.SMTUtils
diff --git a/Strata/DL/Imperative/CFGSemantics.lean b/Strata/DL/Imperative/CFGSemantics.lean
index 9ddd57722e..b7a0476986 100644
--- a/Strata/DL/Imperative/CFGSemantics.lean
+++ b/Strata/DL/Imperative/CFGSemantics.lean
@@ -56,7 +56,7 @@ inductive EvalDetBlock
   (P : PureExpr)
   (EvalCmd : EvalCmdParam P CmdT)
   (extendEval : ExtendEval P)
-  [HasNot P] :
+  [HasBoolOps P] :
   SemanticStore P → DetBlock l CmdT P → CFGConfig l P → Prop where
 
   | step_goto_true :
@@ -90,7 +90,7 @@ inductive EvalNondetBlock
   (P : PureExpr)
   (EvalCmd : EvalCmdParam P CmdT)
   (extendEval : ExtendEval P)
-  [HasNot P] :
+  [HasBoolOps P] :
   SemanticStore P → NondetBlock l CmdT P → CFGConfig l P → Prop where
 
   | step_goto_none :
diff --git a/Strata/DL/Imperative/Cmd.lean b/Strata/DL/Imperative/Cmd.lean
index ac443016d2..0ebf6f117f 100644
--- a/Strata/DL/Imperative/Cmd.lean
+++ b/Strata/DL/Imperative/Cmd.lean
@@ -108,9 +108,15 @@ instance : HasInit P (Cmd P) where
 ---------------------------------------------------------------------
 
 /-- Get all variables accessed by an `ExprOrNondet`. -/
-def ExprOrNondet.getVars [HasVarsPure P P.Expr] (e : ExprOrNondet P) : List P.Ident :=
+def ExprOrNondet.getVars [HasFvars P] (e : ExprOrNondet P) : List P.Ident :=
   match e with
-  | .det e => HasVarsPure.getVars e
+  | .det e => HasFvars.getFvars e
+  | .nondet => []
+
+/-- Get all operator/function names referenced by an `ExprOrNondet`. -/
+def ExprOrNondet.getOps [HasOps P] (e : ExprOrNondet P) : List P.Ident :=
+  match e with
+  | .det e => HasOps.getOps e
   | .nondet => []
 
 /-- Map a function over the expression in an `ExprOrNondet`. -/
@@ -120,26 +126,26 @@ def ExprOrNondet.map {P Q : PureExpr} (f : P.Expr → Q.Expr) : ExprOrNondet P 
 
 mutual
 /-- Get all variables accessed by `c`. -/
-def Cmd.getVars [HasVarsPure P P.Expr] (c : Cmd P) : List P.Ident :=
+def Cmd.getVars [HasFvars P] (c : Cmd P) : List P.Ident :=
   match c with
   | .init _ _ e _ => e.getVars
   | .set _ e _ => e.getVars
-  | .assert _ e _ => HasVarsPure.getVars e
-  | .assume _ e _ => HasVarsPure.getVars e
-  | .cover _ e _ => HasVarsPure.getVars e
+  | .assert _ e _ => HasFvars.getFvars e
+  | .assume _ e _ => HasFvars.getFvars e
+  | .cover _ e _ => HasFvars.getFvars e
 
-def Cmds.getVars [HasVarsPure P P.Expr] (cs : Cmds P) : List P.Ident :=
+def Cmds.getVars [HasFvars P] (cs : Cmds P) : List P.Ident :=
   match cs with
   | [] => []
   | c :: crest => Cmd.getVars c ++ Cmds.getVars crest
   termination_by (sizeOf cs)
 end
 
-instance (P : PureExpr) [HasVarsPure P P.Expr]
+instance (P : PureExpr) [HasFvars P]
   : HasVarsPure P (Cmd P) where
   getVars := Cmd.getVars
 
-instance (P : PureExpr) [HasVarsPure P P.Expr]
+instance (P : PureExpr) [HasFvars P]
   : HasVarsPure P (Cmds P) where
   getVars := Cmds.getVars
 
@@ -174,14 +180,38 @@ def Cmds.modifiedVars (cs : Cmds P) : List P.Ident :=
   termination_by (sizeOf cs)
 
 instance (P : PureExpr) : HasVarsImp P (Cmd P) where
-  definedVars := Cmd.definedVars
+  definedVars c _ := Cmd.definedVars c
   modifiedVars := Cmd.modifiedVars
 
 instance (P : PureExpr) : HasVarsImp P (Cmds P) where
-  definedVars := Cmds.definedVars
+  definedVars c _ := Cmds.definedVars c
   modifiedVars := Cmds.modifiedVars
   -- order matters for Havoc, so needs to override the default
-  modifiedOrDefinedVars := List.flatMap HasVarsImp.modifiedOrDefinedVars
+
+mutual
+/-- Get all operator/function names referenced by `c`. -/
+def Cmd.getOps [HasOps P] (c : Cmd P) : List P.Ident :=
+  match c with
+  | .init _ _ (.det e) _ => HasOps.getOps e
+  | .init _ _ .nondet _ => []
+  | .set _ (.det e) _ => HasOps.getOps e
+  | .set _ .nondet _ => []
+  | .assert _ e _ => HasOps.getOps e
+  | .assume _ e _ => HasOps.getOps e
+  | .cover _ e _ => HasOps.getOps e
+
+def Cmds.getOps [HasOps P] (cs : Cmds P) : List P.Ident :=
+  match cs with
+  | [] => []
+  | c :: crest => Cmd.getOps c ++ Cmds.getOps crest
+  termination_by (sizeOf cs)
+end
+
+instance (P : PureExpr) [HasOps P] : HasOpsImp P (Cmd P) where
+  getOps := Cmd.getOps
+
+instance (P : PureExpr) [HasOps P] : HasOpsImp P (Cmds P) where
+  getOps := Cmds.getOps
 
 ---------------------------------------------------------------------
 
diff --git a/Strata/DL/Imperative/CmdSemantics.lean b/Strata/DL/Imperative/CmdSemantics.lean
index 712f09657f..353d23e77b 100644
--- a/Strata/DL/Imperative/CmdSemantics.lean
+++ b/Strata/DL/Imperative/CmdSemantics.lean
@@ -56,82 +56,6 @@ def isDefinedOver {P : PureExpr}
   (getVars : α → List P.Ident) (σ : SemanticStore P) (s : α) : Prop :=
   isDefined σ (getVars s)
 
-theorem isDefinedCons :
-  isDefined σ [v] →
-  isDefined σ vs2 →
-  isDefined σ (v :: vs2) := by
-  intros Hd1 Hd2
-  simp [isDefined] at *
-  simp [Option.isSome] at *
-  split <;> simp_all
-
-theorem isDefinedApp :
-  isDefined σ vs1 →
-  isDefined σ vs2 →
-  isDefined σ (vs1 ++ vs2) := by
-  intros Hd1 Hd2
-  simp [isDefined] at *
-  intros id Hin
-  simp [Option.isSome] at *
-  cases Hin with
-  | inl Hin =>
-    split <;> simp
-    specialize Hd1 id Hin; simp_all
-  | inr Hin =>
-    split <;> simp
-    specialize Hd2 id Hin; simp_all
-
-theorem isDefinedCons' :
-  isDefined σ (h :: t) →
-  isDefined σ [h] ∧ isDefined σ t := by simp [isDefined] at *
-
-theorem isDefinedApp' :
-  isDefined σ (t1 ++ t2) →
-  isDefined σ t1 ∧ isDefined σ t2 := by
-  intros Hd
-  simp [isDefined] at *
-  apply And.intro
-  . intros x Hin
-    apply Hd; left; assumption
-  . intros x Hin
-    apply Hd; right; assumption
-
-theorem isNotDefinedCons :
-  isNotDefined σ [v] →
-  isNotDefined σ vs2 →
-  isNotDefined σ (v :: vs2) := by
-  intros Hd1 Hd2
-  simp [isNotDefined] at *
-  simp_all
-
-theorem isNotDefinedApp :
-  isNotDefined σ vs1 →
-  isNotDefined σ vs2 →
-  isNotDefined σ (vs1 ++ vs2) := by
-  intros Hd1 Hd2
-  simp [isNotDefined] at *
-  intros id Hin
-  cases Hin with
-  | inl Hin =>
-    specialize Hd1 id Hin; simp_all
-  | inr Hin =>
-    specialize Hd2 id Hin; simp_all
-
-theorem isNotDefinedCons' :
-  isNotDefined σ (h :: t) →
-  isNotDefined σ [h] ∧ isNotDefined σ t := by simp [isNotDefined] at *
-
-theorem isNotDefinedApp' :
-  isNotDefined σ (t1 ++ t2) →
-  isNotDefined σ t1 ∧ isNotDefined σ t2 := by
-  intros Hd
-  simp [isNotDefined] at *
-  apply And.intro
-  . intros x Hin
-    apply Hd; left; assumption
-  . intros x Hin
-    apply Hd; right; assumption
-
 /-! ### Store Substitution -/
 
 /-- Substitution relation between stores.  -/
@@ -157,74 +81,13 @@ def invStoresExcept {P : PureExpr} (σ₁ σ₂ : SemanticStore P) (vs : List P.
 def substSwap {P : PureExpr} (substs : List (P.Ident × P.Ident))
   : List (P.Ident × P.Ident) := substs.map Prod.swap
 
-theorem substSwapId (substs : List (P.Ident × P.Ident)) :
-  (substSwap (substSwap substs)) = substs := by
-  simp [substSwap]
-
-theorem substStoresFlip :
-  substStores σ₁ σ₂ substs →
-  substStores σ₂ σ₁ (substSwap substs) := by
-  intros Hsub
-  simp [substStores, substSwap] at *
-  intros k1 k2 x2 x1 Hin Heq1 Heq2
-  simp_all
-  apply Eq.symm
-  apply Hsub
-  exact Hin
-
-theorem substStoresFlip' :
-  substStores σ₂ σ₁ (substSwap substs) →
-  substStores σ₁ σ₂ substs := by
-  intros Hsub
-  have Hsub' := substStoresFlip Hsub
-  simp [substSwapId] at Hsub'
-  exact Hsub'
-
-theorem substDefinedFlip :
-  substDefined σ₁ σ₂ substs →
-  substDefined σ₂ σ₁ (substSwap substs) := by
-  intros Hsub
-  simp [substDefined, substSwap] at *
-  intros k1 k2 x2 x1 Hin Heq1 Heq2
-  simp_all
-  exact And.comm.mp (Hsub k2 k1 Hin)
-
-theorem substDefinedFlip' :
-  substDefined σ₂ σ₁ (substSwap substs) →
-  substDefined σ₁ σ₂ substs := by
-  intros Hsub
-  have Hsub' := substDefinedFlip Hsub
-  simp [substSwapId] at Hsub'
-  exact Hsub'
-
-theorem invStoresComm :
-  invStores σ₁ σ₂ ks →
-  invStores σ₂ σ₁ ks := by
-  intros Hinv
-  simp [invStores] at *
-  apply substStoresFlip'
-  simp [substSwap]
-  assumption
-
-theorem invStoresExceptComm :
-  invStoresExcept σ₁ σ₂ ks →
-  invStoresExcept σ₂ σ₁ ks := by
-  intros Hinv ks' Hdisj
-  simp [invStoresExcept] at *
-  exact invStoresComm (Hinv ks' Hdisj)
-
 /-! ### Well-Formedness of `SemanticEval`s -/
 
-/-- The boolean evaluator and the general evaluator are in agreement
--- only defined conservatively,
--- since there could be coercions like [1 >>= True] and [0 >>= False]
--- or that when δ evaluates to none, δP evaluates to False
-  -/
-def WellFormedSemanticEvalBool {P : PureExpr} [HasBool P] [HasNot P]
+@[expose] def WellFormedSemanticEvalBool {P : PureExpr} [HasBool P] [HasBoolOps P]
     (δ : SemanticEval P) : Prop :=
     ∀ σ e,
-      (δ σ e = some Imperative.HasBool.tt ↔ δ σ (Imperative.HasNot.not e) = (some HasBool.ff)) ∧
-      (δ σ e = some Imperative.HasBool.ff ↔ δ σ (Imperative.HasNot.not e) = (some HasBool.tt))
+      (δ σ e = some Imperative.HasBool.tt ↔ δ σ (Imperative.HasBoolOps.not e) = (some HasBool.ff)) ∧
+      (δ σ e = some Imperative.HasBool.ff ↔ δ σ (Imperative.HasBoolOps.not e) = (some HasBool.tt))
 
 def WellFormedSemanticEvalVal {P : PureExpr} [HasVal P]
     (δ : SemanticEval P) : Prop :=
@@ -236,8 +99,8 @@ def WellFormedSemanticEvalVal {P : PureExpr} [HasVal P]
 @[expose] def WellFormedSemanticEvalVar {P : PureExpr} [HasFvar P] (δ : SemanticEval P)
     : Prop := (∀ e v σ, HasFvar.getFvar e = some v → δ σ e = σ v)
 
-@[expose] def WellFormedSemanticEvalExprCongr {P : PureExpr} [HasVarsPure P P.Expr] (δ : SemanticEval P)
-    : Prop := ∀ e σ σ', (∀ x ∈ HasVarsPure.getVars e, σ x = σ' x) → δ σ e = δ σ' e
+@[expose] def WellFormedSemanticEvalExprCongr {P : PureExpr} [HasFvars P] (δ : SemanticEval P)
+    : Prop := ∀ e σ σ', (∀ x ∈ HasFvars.getFvars e, σ x = σ' x) → δ σ e = δ σ' e
 
 /--
 Abstract variable update.
@@ -281,7 +144,7 @@ sets it to `true`; all other constructors report `false`.
 The failure flag is accumulated in `Env.hasFailure` by the statement
 semantics (`EvalStmt`).
 -/
-inductive EvalCmd [HasFvar P] [HasBool P] [HasNot P] :
+inductive EvalCmd [HasFvar P] [HasBool P] [HasBoolOps P] :
   SemanticEval P → SemanticStore P → Cmd P → SemanticStore P → Bool → Prop where
   /-- If `e` evaluates to a value `v`, initialize `x` according to `InitState`. -/
   | eval_init :
@@ -344,98 +207,4 @@ inductive EvalCmd [HasFvar P] [HasBool P] [HasNot P] :
 
 end section
 
-theorem InitStateDefCons
-  {P : PureExpr} {σ σ' : SemanticStore P}
-  {vs : List P.Ident} {e : P.Expr} {v : P.Ident} :
-  isDefined σ vs →
-  InitState P σ v e σ' →
-  isDefined σ' (v::vs) := by
-  intros Hdef Heval
-  cases Heval with
-  | init Hold HH Hsome =>
-  simp [isDefined, HH] at *
-  intros v' Hv'
-  have Heq: ¬ v = v' :=by
-    false_or_by_contra; rename_i Heq
-    specialize Hdef v' Hv'
-    simp_all
-  specialize Hsome v' Heq
-  specialize Hdef v'
-  simp_all
-
-theorem InitStateDefMonotone
-  {P : PureExpr} {σ σ' : SemanticStore P}
-  {vs : List P.Ident} {e : P.Expr} {v : P.Ident} :
-  isDefined σ vs →
-  InitState P σ v e σ' →
-  isDefined σ' vs := by
-  intros Hdef Heval
-  exact (isDefinedCons' (InitStateDefCons Hdef Heval)).right
-
-theorem UpdateStateDef
-  {P : PureExpr} {σ σ' : SemanticStore P}
-  {e : P.Expr} {v : P.Ident} :
-  UpdateState P σ v e σ' →
-  isDefined σ [v] ∧ isDefined σ' [v] := by
-  intro Heval
-  cases Heval with
-  | update Hold HH Hsome =>
-  simp_all [isDefined]
-
-theorem UpdateStateDefMonotone
-  {P : PureExpr} {σ σ' : SemanticStore P}
-  {vs : List P.Ident} {e : P.Expr} {v : P.Ident} :
-  isDefined σ vs →
-  UpdateState P σ v e σ' →
-  isDefined σ' vs := by
-  intros Hdef Heval
-  cases Heval with
-  | update Hold HH Hsome =>
-  simp [isDefined] at *
-  intros v' Hv'
-  by_cases Heq: (v = v')
-  case pos =>
-    simp [Option.isSome]
-    simp [Heq] at *
-    split <;> simp_all
-  case neg =>
-    specialize Hsome v' Heq
-    specialize Hdef v'
-    simp [Hsome]
-    exact Hdef Hv'
-
-theorem UpdateStateUniqueResult
-  {P : PureExpr} {σ σ' σ'': SemanticStore P}
-  {e : P.Expr} {v : P.Ident} :
-  UpdateState P σ v e σ' →
-  UpdateState P σ v e σ'' →
-  σ' = σ'' := by
-  intro Hu1 Hu2
-  cases Hu1; cases Hu2
-  rename_i Hfa1 _ _ _ Hfa2 _
-  ext v' e'
-  by_cases h: v' = v
-  simp_all
-  rw[eq_comm] at h
-  specialize Hfa1 v' h
-  specialize Hfa2 v' h
-  simp_all
-
-theorem InitStateUniqueResult
-  {P : PureExpr} {σ σ' σ'': SemanticStore P}
-  {e : P.Expr} {v : P.Ident} :
-  InitState P σ v e σ' →
-  InitState P σ v e σ'' →
-  σ' = σ'' := by
-  intro Hu1 Hu2
-  cases Hu1; cases Hu2
-  rename_i Hfa1 _ _ Hfa2 _
-  ext v' e'
-  by_cases h: v' = v
-  simp_all
-  rw[eq_comm] at h
-  specialize Hfa1 v' h
-  specialize Hfa2 v' h
-  simp_all
-
 end -- public section
diff --git a/Strata/DL/Imperative/CmdSemanticsProps.lean b/Strata/DL/Imperative/CmdSemanticsProps.lean
new file mode 100644
index 0000000000..778b35c70a
--- /dev/null
+++ b/Strata/DL/Imperative/CmdSemanticsProps.lean
@@ -0,0 +1,373 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.DL.Imperative.CmdSemantics
+import all Strata.DL.Imperative.CmdSemantics
+import all Strata.DL.Imperative.Cmd
+public import Strata.DL.Imperative.Stmt
+import all Strata.DL.Util.ListUtils
+
+---------------------------------------------------------------------
+
+namespace Imperative
+
+public section
+
+section
+
+variable (P : PureExpr)
+
+theorem isDefinedCons :
+  isDefined σ [v] →
+  isDefined σ vs2 →
+  isDefined σ (v :: vs2) := by
+  intros Hd1 Hd2
+  simp [isDefined] at *
+  simp [Option.isSome] at *
+  split <;> simp_all
+
+theorem isDefinedApp :
+  isDefined σ vs1 →
+  isDefined σ vs2 →
+  isDefined σ (vs1 ++ vs2) := by
+  intros Hd1 Hd2
+  simp [isDefined] at *
+  intros id Hin
+  simp [Option.isSome] at *
+  cases Hin with
+  | inl Hin =>
+    split <;> simp
+    specialize Hd1 id Hin; simp_all
+  | inr Hin =>
+    split <;> simp
+    specialize Hd2 id Hin; simp_all
+
+theorem isDefinedCons' :
+  isDefined σ (h :: t) →
+  isDefined σ [h] ∧ isDefined σ t := by simp [isDefined] at *
+
+theorem isDefinedApp' :
+  isDefined σ (t1 ++ t2) →
+  isDefined σ t1 ∧ isDefined σ t2 := by
+  intros Hd
+  simp [isDefined] at *
+  apply And.intro
+  . intros x Hin
+    apply Hd; left; assumption
+  . intros x Hin
+    apply Hd; right; assumption
+
+theorem isNotDefinedCons :
+  isNotDefined σ [v] →
+  isNotDefined σ vs2 →
+  isNotDefined σ (v :: vs2) := by
+  intros Hd1 Hd2
+  simp [isNotDefined] at *
+  simp_all
+
+theorem isNotDefinedApp :
+  isNotDefined σ vs1 →
+  isNotDefined σ vs2 →
+  isNotDefined σ (vs1 ++ vs2) := by
+  intros Hd1 Hd2
+  simp [isNotDefined] at *
+  intros id Hin
+  cases Hin with
+  | inl Hin =>
+    specialize Hd1 id Hin; simp_all
+  | inr Hin =>
+    specialize Hd2 id Hin; simp_all
+
+theorem isNotDefinedCons' :
+  isNotDefined σ (h :: t) →
+  isNotDefined σ [h] ∧ isNotDefined σ t := by simp [isNotDefined] at *
+
+theorem isNotDefinedApp' :
+  isNotDefined σ (t1 ++ t2) →
+  isNotDefined σ t1 ∧ isNotDefined σ t2 := by
+  intros Hd
+  simp [isNotDefined] at *
+  apply And.intro
+  . intros x Hin
+    apply Hd; left; assumption
+  . intros x Hin
+    apply Hd; right; assumption
+
+/-! ### Store Substitution Properties -/
+
+theorem substSwapId (substs : List (P.Ident × P.Ident)) :
+  (substSwap (substSwap substs)) = substs := by
+  simp [substSwap]
+
+theorem substStoresFlip :
+  substStores σ₁ σ₂ substs →
+  substStores σ₂ σ₁ (substSwap substs) := by
+  intros Hsub
+  simp [substStores, substSwap] at *
+  intros k1 k2 x2 x1 Hin Heq1 Heq2
+  simp_all
+  apply Eq.symm
+  apply Hsub
+  exact Hin
+
+theorem substStoresFlip' :
+  substStores σ₂ σ₁ (substSwap substs) →
+  substStores σ₁ σ₂ substs := by
+  intros Hsub
+  have Hsub' := substStoresFlip Hsub
+  simp [substSwapId] at Hsub'
+  exact Hsub'
+
+theorem substDefinedFlip :
+  substDefined σ₁ σ₂ substs →
+  substDefined σ₂ σ₁ (substSwap substs) := by
+  intros Hsub
+  simp [substDefined, substSwap] at *
+  intros k1 k2 x2 x1 Hin Heq1 Heq2
+  simp_all
+  exact And.comm.mp (Hsub k2 k1 Hin)
+
+theorem substDefinedFlip' :
+  substDefined σ₂ σ₁ (substSwap substs) →
+  substDefined σ₁ σ₂ substs := by
+  intros Hsub
+  have Hsub' := substDefinedFlip Hsub
+  simp [substSwapId] at Hsub'
+  exact Hsub'
+
+theorem invStoresComm :
+  invStores σ₁ σ₂ ks →
+  invStores σ₂ σ₁ ks := by
+  intros Hinv
+  simp [invStores] at *
+  apply substStoresFlip'
+  simp [substSwap]
+  assumption
+
+theorem invStoresExceptComm :
+  invStoresExcept σ₁ σ₂ ks →
+  invStoresExcept σ₂ σ₁ ks := by
+  intros Hinv ks' Hdisj
+  simp [invStoresExcept] at *
+  exact invStoresComm (Hinv ks' Hdisj)
+
+end section
+
+theorem InitStateDefCons
+  {P : PureExpr} {σ σ' : SemanticStore P}
+  {vs : List P.Ident} {e : P.Expr} {v : P.Ident} :
+  isDefined σ vs →
+  InitState P σ v e σ' →
+  isDefined σ' (v::vs) := by
+  intros Hdef Heval
+  cases Heval with
+  | init Hold HH Hsome =>
+  simp [isDefined, HH] at *
+  intros v' Hv'
+  have Heq: ¬ v = v' :=by
+    false_or_by_contra; rename_i Heq
+    specialize Hdef v' Hv'
+    simp_all
+  specialize Hsome v' Heq
+  specialize Hdef v'
+  simp_all
+
+theorem InitStateDefMonotone
+  {P : PureExpr} {σ σ' : SemanticStore P}
+  {vs : List P.Ident} {e : P.Expr} {v : P.Ident} :
+  isDefined σ vs →
+  InitState P σ v e σ' →
+  isDefined σ' vs := by
+  intros Hdef Heval
+  exact (isDefinedCons' (InitStateDefCons Hdef Heval)).right
+
+theorem UpdateStateDef
+  {P : PureExpr} {σ σ' : SemanticStore P}
+  {e : P.Expr} {v : P.Ident} :
+  UpdateState P σ v e σ' →
+  isDefined σ [v] ∧ isDefined σ' [v] := by
+  intro Heval
+  cases Heval with
+  | update Hold HH Hsome =>
+  simp_all [isDefined]
+
+theorem UpdateStateDefMonotone
+  {P : PureExpr} {σ σ' : SemanticStore P}
+  {vs : List P.Ident} {e : P.Expr} {v : P.Ident} :
+  isDefined σ vs →
+  UpdateState P σ v e σ' →
+  isDefined σ' vs := by
+  intros Hdef Heval
+  cases Heval with
+  | update Hold HH Hsome =>
+  simp [isDefined] at *
+  intros v' Hv'
+  by_cases Heq: (v = v')
+  case pos =>
+    simp [Option.isSome]
+    simp [Heq] at *
+    split <;> simp_all
+  case neg =>
+    specialize Hsome v' Heq
+    specialize Hdef v'
+    simp [Hsome]
+    exact Hdef Hv'
+
+theorem UpdateStateUniqueResult
+  {P : PureExpr} {σ σ' σ'': SemanticStore P}
+  {e : P.Expr} {v : P.Ident} :
+  UpdateState P σ v e σ' →
+  UpdateState P σ v e σ'' →
+  σ' = σ'' := by
+  intro Hu1 Hu2
+  cases Hu1; cases Hu2
+  rename_i Hfa1 _ _ _ Hfa2 _
+  ext v' e'
+  by_cases h: v' = v
+  simp_all
+  rw[eq_comm] at h
+  specialize Hfa1 v' h
+  specialize Hfa2 v' h
+  simp_all
+
+theorem InitStateUniqueResult
+  {P : PureExpr} {σ σ' σ'': SemanticStore P}
+  {e : P.Expr} {v : P.Ident} :
+  InitState P σ v e σ' →
+  InitState P σ v e σ'' →
+  σ' = σ'' := by
+  intro Hu1 Hu2
+  cases Hu1; cases Hu2
+  rename_i Hfa1 _ _ Hfa2 _
+  ext v' e'
+  by_cases h: v' = v
+  simp_all
+  rw[eq_comm] at h
+  specialize Hfa1 v' h
+  specialize Hfa2 v' h
+  simp_all
+
+/-! ### Assert / set commutation -/
+
+theorem eval_assert_store_cst
+  [HasFvar P] [HasBool P] [HasBoolOps P] [HasOps P]:
+  EvalCmd P δ σ (.assert l e md) σ' f → σ = σ' := by
+  intros Heval; cases Heval with
+  | eval_assert_pass _ => rfl
+  | eval_assert_fail _ => rfl
+
+theorem UpdateStateComm {P: PureExpr} {x1 x2: P.Ident} {σ σ' σ'' σ1 σ2: SemanticStore P} {v1 v2: P.Expr}
+  [DecidableEq P.Ident]:
+  ¬ x1 = x2 →
+  UpdateState P σ x1 v1 σ1 →
+  UpdateState P σ1 x2 v2 σ' →
+  UpdateState P σ x2 v2 σ2 →
+  UpdateState P σ2 x1 v1 σ'' →
+  σ' = σ'' := by
+  intro Hneq Hu1 Hu2 Hu3 Hu4
+  cases Hu1; cases Hu2; cases Hu3; cases Hu4
+  ext i e
+  rename_i Hfa1 _ _ _ Hfa2 _ _ _ Hfa3 _ _ _ Hfa4 _
+  simp at Hfa1 Hfa2 Hfa3 Hfa4
+  rw[Eq.comm] at Hneq
+  by_cases Heq1: x1 = i
+  simp_all
+  by_cases Heq2: x2 = i
+  rw[Eq.comm] at Hneq
+  specialize Hfa4 x2 Hneq
+  simp_all
+  specialize Hfa1 i Heq1
+  specialize Hfa2 i Heq2
+  specialize Hfa3 i Heq2
+  specialize Hfa4 i Heq1
+  simp_all
+
+theorem UpdateState_InitStateComm {P: PureExpr} {x1 x2: P.Ident} {σ σ' σ'' σ1 σ2: SemanticStore P} {v1 v2: P.Expr}
+  [DecidableEq P.Ident]:
+  ¬ x1 = x2 →
+  UpdateState P σ x1 v1 σ1 →
+  InitState P σ1 x2 v2 σ' →
+  InitState P σ x2 v2 σ2 →
+  UpdateState P σ2 x1 v1 σ'' →
+  σ' = σ'' := by
+  intro Hneq Hu1 Hu2 Hu3 Hu4
+  cases Hu1; cases Hu2; cases Hu3; cases Hu4
+  ext i e
+  rename_i Hfa1 _ _ Hfa2 _ _ Hfa3 _ _ _ Hfa4 _
+  simp at Hfa1 Hfa2 Hfa3 Hfa4
+  rw[Eq.comm] at Hneq
+  by_cases Heq1: x1 = i
+  simp_all
+  by_cases Heq2: x2 = i
+  rw[Eq.comm] at Hneq
+  specialize Hfa4 x2 Hneq
+  simp_all
+  specialize Hfa1 i Heq1
+  specialize Hfa2 i Heq2
+  specialize Hfa3 i Heq2
+  specialize Hfa4 i Heq1
+  simp_all
+
+theorem semantic_eval_eq_of_eval_cmd_set_unrelated_var
+  [HasVarsImp P (Cmd P)] [HasFvar P] [HasBool P] [HasBoolOps P] [HasFvars P] [HasOps P]:
+  WellFormedSemanticEvalExprCongr δ →
+  ¬ v ∈ HasFvars.getFvars e →
+  EvalCmd P δ σ (Cmd.set v (.det e') md) σ' f →
+  δ σ e = δ σ' e := by
+  intro Hwf Hnin Heval
+  unfold WellFormedSemanticEvalExprCongr at Hwf
+  specialize Hwf e σ σ'
+  have: ∀ (v : P.Ident), v ∈ HasFvars.getFvars e → σ v = σ' v := by
+    cases Heval
+    rename_i Hu
+    cases Hu
+    rename_i Hfa _
+    intro v' Hv'
+    ext e'
+    by_cases Hc: ¬ v = v'
+    specialize Hfa v' Hc
+    simp_all
+    simp_all
+  exact Hwf this
+
+theorem eval_cmd_set_comm'
+  [HasVarsImp P (List (Stmt P (Cmd P)))] [HasVarsImp P (Cmd P)]
+  [HasFvar P] [HasBool P] [HasBoolOps P] [HasOps P] [DecidableEq P.Ident] :
+  ¬ x1 = x2 →
+  δ σ v1 = δ σ2 v1 →
+  δ σ v2 = δ σ1 v2 →
+  EvalCmd P δ σ (Cmd.set x1 (.det v1) md1) σ1 f1 →
+  EvalCmd P δ σ1 (Cmd.set x2 (.det v2) md2) σ' f2 →
+  EvalCmd P δ σ (Cmd.set x2 (.det v2) md2') σ2 f3 →
+  EvalCmd P δ σ2 (Cmd.set x1 (.det v1) md1') σ'' f4 →
+  σ' = σ'' := by
+  intro Hneq Heq1 Heq2 Hs1 Hs2 Hs3 Hs4
+  cases Hs1 with | eval_set _ Hu1 _ =>
+  cases Hs2 with | eval_set _ Hu2 _ =>
+  cases Hs3 with | eval_set _ Hu3 _ =>
+  cases Hs4 with | eval_set _ Hu4 _ =>
+  simp_all
+  exact UpdateStateComm Hneq Hu1 Hu2 Hu3 Hu4
+
+theorem eval_cmd_set_comm
+  [HasVarsImp P (List (Stmt P (Cmd P)))] [HasVarsImp P (Cmd P)]
+  [HasFvar P] [HasBool P] [HasBoolOps P] [HasFvars P] [HasOps P] [DecidableEq P.Ident]:
+  WellFormedSemanticEvalExprCongr δ →
+  ¬ x1 = x2 →
+  ¬ x1 ∈ HasFvars.getFvars v2 →
+  ¬ x2 ∈ HasFvars.getFvars v1 →
+  EvalCmd P δ σ (Cmd.set x1 (.det v1) md1) σ1 f1 →
+  EvalCmd P δ σ1 (Cmd.set x2 (.det v2) md2) σ' f2 →
+  EvalCmd P δ σ (Cmd.set x2 (.det v2) md2') σ2 f3 →
+  EvalCmd P δ σ2 (Cmd.set x1 (.det v1) md1') σ'' f4 →
+  σ' = σ'' := by
+  intro Hwf Hneq Hnin1 Hnin2 Hs1 Hs2 Hs3 Hs4
+  have Heval2:= semantic_eval_eq_of_eval_cmd_set_unrelated_var Hwf Hnin1 Hs1
+  have Heval1:= semantic_eval_eq_of_eval_cmd_set_unrelated_var Hwf Hnin2 Hs3
+  exact eval_cmd_set_comm' Hneq Heval1 Heval2 Hs1 Hs2 Hs3 Hs4
+
+end -- public section
diff --git a/Strata/DL/Imperative/HasVars.lean b/Strata/DL/Imperative/HasVars.lean
index 5cc92a66c8..983396a809 100644
--- a/Strata/DL/Imperative/HasVars.lean
+++ b/Strata/DL/Imperative/HasVars.lean
@@ -19,10 +19,28 @@ class HasVarsPure (P : PureExpr) (α : Type) where
 /-! # Imperative Variable Lookup : HasVarsImp -/
 
 class HasVarsImp (P : PureExpr) (α : Type) where
-  definedVars : α → List P.Ident
+  definedVars :
+    α →
+    Bool/-If true, the returned List P.Ident excludes vars not visible from outside.
+      For example, if the first argument (whose type is α) is:
+      ```
+      var x := 1;
+      {
+        var y := 2;
+      }
+      ```
+      and this flag is true, definedVars will only return 'x'.
+      (example: Stmt.definedVars) -/ →
+    List P.Ident
   modifiedVars : α → List P.Ident
-  modifiedOrDefinedVars : α → List P.Ident
-          := λ e ↦ definedVars e ++ modifiedVars e
+
+/-! # Operator/Function Name Lookup over Commands : HasOpsImp
+
+`HasOpsImp` collects the operator (function) names referenced by a command,
+parallel to `HasOps` for expressions. -/
+
+class HasOpsImp (P : PureExpr) (α : Type) where
+  getOps : α → List P.Ident
 
 ---------------------------------------------------------------------
 
diff --git a/Strata/DL/Imperative/KleeneSemanticsProps.lean b/Strata/DL/Imperative/KleeneSemanticsProps.lean
index 11b8b1a667..e5b5e0e5cc 100644
--- a/Strata/DL/Imperative/KleeneSemanticsProps.lean
+++ b/Strata/DL/Imperative/KleeneSemanticsProps.lean
@@ -18,25 +18,24 @@ namespace Imperative
 
 public section
 
-variable {P : PureExpr} [HasFvar P] [HasBool P] [HasNot P] [HasVal P] [HasBoolVal P]
+variable {P : PureExpr} [HasFvar P] [HasBool P] [HasBoolOps P]
 
 /-! ## Env helpers -/
 
-omit [HasFvar P] [HasVal P] [HasBool P] [HasNot P] in
+omit [HasFvar P] [HasBool P] [HasBoolOps P] in
 theorem assume_env_eq (ρ : Env P) :
     ({ ρ with store := ρ.store, hasFailure := ρ.hasFailure || false } : Env P) = ρ := by
   cases ρ; simp [Bool.or_false]
 
-omit [HasFvar P] [HasNot P] in
+omit [HasFvar P] [HasBoolOps P] in
 theorem eval_tt_is_tt
     (δ : SemanticEval P) (σ : SemanticStore P)
     (hwfv : WellFormedSemanticEvalVal δ) :
     δ σ HasBool.tt = some HasBool.tt :=
-  hwfv.2 HasBool.tt σ HasBoolVal.bool_is_val.1
+  hwfv.2 HasBool.tt σ HasBool.boolIsVal.1
 
 /-! ## Kleene small-step helpers -/
 
-omit [HasVal P] [HasBoolVal P] in
 theorem kleene_block_inner_star
     (σ_parent : SemanticStore P)
     (inner inner' : KleeneConfig P (Cmd P))
@@ -46,7 +45,6 @@ theorem kleene_block_inner_star
   | refl => exact .refl _
   | step _ mid _ hstep _ ih => exact .step _ _ _ (.step_block_body hstep) ih
 
-omit [HasVal P] [HasBoolVal P] in
 /-- Lift an inner execution through a block wrapper to terminal (with projection). -/
 theorem kleene_block_terminal
     (σ_parent : SemanticStore P)
@@ -58,7 +56,6 @@ theorem kleene_block_terminal
     (kleene_block_inner_star σ_parent inner (.terminal ρ') h)
     (.step _ _ _ .step_block_done (.refl _))
 
-omit [HasVal P] [HasBoolVal P] in
 theorem kleene_seq_inner_star
     (inner inner' : KleeneConfig P (Cmd P)) (s2 : KleeneStmt P (Cmd P))
     (h : StepKleeneStar P (EvalCmd P) inner inner') :
@@ -67,7 +64,6 @@ theorem kleene_seq_inner_star
   | refl => exact .refl _
   | step _ mid _ hstep _ ih => exact .step _ _ _ (.step_seq_inner hstep) ih
 
-omit [HasVal P] [HasBoolVal P] in
 theorem kleene_seq_terminal
     (s1 s2 : KleeneStmt P (Cmd P)) (ρ ρ₁ ρ' : Env P)
     (h1 : StepKleeneStar P (EvalCmd P) (.stmt s1 ρ) (.terminal ρ₁))
@@ -77,7 +73,6 @@ theorem kleene_seq_terminal
     (ReflTrans_Transitive _ _ _ _ (kleene_seq_inner_star _ _ s2 h1)
       (.step _ _ _ .step_seq_done (.refl _))) h2)
 
-omit [HasVal P] [HasBoolVal P] in
 theorem kleene_assume_terminal
     {label : String} {expr : P.Expr} {md : MetaData P} {ρ₀ : Env P}
     (hcond : ρ₀.eval ρ₀.store expr = some HasBool.tt)
@@ -90,5 +85,17 @@ theorem kleene_assume_terminal
     .step _ _ _ (.step_cmd (EvalCmd.eval_assume hcond hwfb)) (.refl _)
   rwa [assume_env_eq] at raw
 
+theorem kleene_assume_then
+    {label : String} {expr : P.Expr} {md : MetaData P}
+    {b : KleeneStmt P (Cmd P)} {ρ₀ : Env P}
+    (h_assume : StepKleeneStar P (EvalCmd P)
+      (.stmt (.cmd (.assume label expr md)) ρ₀) (.terminal ρ₀)) :
+    StepKleeneStar P (EvalCmd P)
+      (.stmt (.seq (.cmd (.assume label expr md)) b) ρ₀) (.stmt b ρ₀) :=
+  .step _ _ _ .step_seq
+    (ReflTrans_Transitive _ _ _ _
+      (kleene_seq_inner_star _ _ b h_assume)
+      (.step _ _ _ .step_seq_done (.refl _)))
+
 end -- public section
 end Imperative
diff --git a/Strata/DL/Imperative/KleeneStmt.lean b/Strata/DL/Imperative/KleeneStmt.lean
index a23d7312f7..fb13f3b293 100644
--- a/Strata/DL/Imperative/KleeneStmt.lean
+++ b/Strata/DL/Imperative/KleeneStmt.lean
@@ -59,18 +59,20 @@ abbrev KleeneStmt.assume {P : PureExpr} (label : String) (b : P.Expr) (md : Meta
 
 mutual
 /-- Get all variables defined by the statement `s`. -/
-def KleeneStmt.definedVars [HasVarsImp P C] (s : KleeneStmt P C) : List P.Ident :=
+def KleeneStmt.definedVars [HasVarsImp P C] (s : KleeneStmt P C)
+    (excludeScoped : Bool): List P.Ident :=
   match s with
-  | .cmd c => HasVarsImp.definedVars c
-  | .seq s1 s2 => KleeneStmt.definedVars s1 ++ KleeneStmt.definedVars s2
-  | .choice s1 s2 => KleeneStmt.definedVars s1 ++ KleeneStmt.definedVars s2
-  | .loop s => KleeneStmt.definedVars s
-  | .block s => KleeneStmt.definedVars s
-
-def KleeneStmts.definedVars [HasVarsImp P C] (ss : List (KleeneStmt P C)) : List P.Ident :=
+  | .cmd c => HasVarsImp.definedVars c excludeScoped
+  | .seq s1 s2 => KleeneStmt.definedVars s1 excludeScoped ++ KleeneStmt.definedVars s2 excludeScoped
+  | .choice s1 s2 => KleeneStmt.definedVars s1 excludeScoped ++ KleeneStmt.definedVars s2 excludeScoped
+  | .loop s => KleeneStmt.definedVars s excludeScoped
+  | .block s => KleeneStmt.definedVars s excludeScoped
+
+def KleeneStmts.definedVars [HasVarsImp P C] (ss : List (KleeneStmt P C))
+    (excludeScoped : Bool) : List P.Ident :=
   match ss with
   | [] => []
-  | s :: srest => KleeneStmt.definedVars s ++ KleeneStmts.definedVars srest
+  | s :: srest => KleeneStmt.definedVars s excludeScoped ++ KleeneStmts.definedVars srest excludeScoped
 end
 
 mutual
diff --git a/Strata/DL/Imperative/KleeneStmtSemantics.lean b/Strata/DL/Imperative/KleeneStmtSemantics.lean
index 4152be0a2f..93289773d1 100644
--- a/Strata/DL/Imperative/KleeneStmtSemantics.lean
+++ b/Strata/DL/Imperative/KleeneStmtSemantics.lean
@@ -56,7 +56,7 @@ inductive KleeneConfig (P : PureExpr) (CmdT : Type) : Type where
 
 section
 
-variable {CmdT : Type} (P : PureExpr) [HasBool P] [HasNot P]
+variable {CmdT : Type} (P : PureExpr) [HasBool P] [HasBoolOps P]
 
 /-- A single execution step for non-deterministic (Kleene) statements. -/
 inductive StepKleene
@@ -146,7 +146,7 @@ end
 
 /-- Multi-step execution for non-deterministic statements: the reflexive,
 transitive closure of `StepKleene`. -/
-abbrev StepKleeneStar (P : PureExpr) [HasBool P] [HasNot P]
+abbrev StepKleeneStar (P : PureExpr) [HasBool P] [HasBoolOps P]
     (EvalCmd : EvalCmdParam P CmdT) :
     KleeneConfig P CmdT → KleeneConfig P CmdT → Prop :=
   ReflTrans (StepKleene P EvalCmd)
diff --git a/Strata/DL/Imperative/MetaData.lean b/Strata/DL/Imperative/MetaData.lean
index 21a1db7857..61d4d7eb6d 100644
--- a/Strata/DL/Imperative/MetaData.lean
+++ b/Strata/DL/Imperative/MetaData.lean
@@ -293,6 +293,27 @@ def MetaData.eraseAllElems {P : PureExpr} [BEq P.Ident]
     (md : MetaData P) (fld : MetaDataElem.Field P) : MetaData P :=
   md.filter (fun e => !(e.fld == fld))
 
+/-- Label for a per-loop-invariant source provenance. Loop lowering stores one
+    such element per invariant, in invariant order, so that loop elimination can
+    attribute each invariant's verification condition to the specific invariant's
+    source location rather than to the whole loop. -/
+def MetaData.invariantProvenanceLabel : String := "invariantProvenance"
+
+/-- Append a loop invariant's provenance to metadata. These are appended in
+    invariant order. Note this matches on the `.label` constructor directly, so
+    it needs no `BEq P.Ident` instance. -/
+def MetaData.pushInvariantProvenance {P : PureExpr} (md : MetaData P) (p : Provenance) : MetaData P :=
+  md.push { fld := .label MetaData.invariantProvenanceLabel, value := .provenance p }
+
+/-- Get all per-invariant provenances from metadata, in the order they were
+    pushed (matching the loop's invariant order). -/
+def MetaData.getInvariantProvenances {P : PureExpr} (md : MetaData P) : Array Provenance :=
+  md.filterMap fun elem =>
+    match elem.fld, elem.value with
+    | .label l, .provenance p =>
+      if l == MetaData.invariantProvenanceLabel then some p else none
+    | _, _ => none
+
 /-- Replace the primary provenance with a new one, shifting existing related
     provenances and prepending the old primary provenance. -/
 def MetaData.setCallSiteFileRange {P : PureExpr} [BEq P.Ident]
diff --git a/Strata/DL/Imperative/PureExpr.lean b/Strata/DL/Imperative/PureExpr.lean
index aeb3cff286..7e70784541 100644
--- a/Strata/DL/Imperative/PureExpr.lean
+++ b/Strata/DL/Imperative/PureExpr.lean
@@ -43,31 +43,6 @@ structure PureExpr : Type 1 where
 @[expose] abbrev PureExpr.TypedExpr (P : PureExpr)  := P.Expr × P.Ty
 
 /-! ## Type Classes for Expressions -/
-/-- Boolean expressions -/
-class HasBool (P : PureExpr) where
-  tt : P.Expr
-  ff : P.Expr
-  tt_is_not_ff: tt ≠ ff
-  boolTy : P.Ty
-
-class HasNot (P : PureExpr) extends HasBool P where
-  not : P.Expr → P.Expr
-
-class HasAnd (P : PureExpr) extends HasBool P where
-  and : P.Expr → P.Expr → P.Expr
-
-class HasImp (P : PureExpr) extends HasBool P where
-  imp : P.Expr → P.Expr → P.Expr
-
-/-- Integer ordering primitives.
-    `zero` is the lower-bound constant for well-foundedness (measure ≥ 0).
-    `intTy` is the type of integer expressions, for variable declarations.
-    `ge` is derivable as `HasNot.not (lt b a)` and is therefore omitted. -/
-class HasIntOrder (P : PureExpr) where
-  eq    : P.Expr → P.Expr → P.Expr
-  lt    : P.Expr → P.Expr → P.Expr
-  zero  : P.Expr
-  intTy : P.Ty
 
 class HasIdent (P : PureExpr) where
   ident : String → P.Ident
@@ -76,11 +51,50 @@ class HasFvar (P : PureExpr) where
   mkFvar : P.Ident → P.Expr
   getFvar : P.Expr → Option P.Ident
 
+/-- Multi-variable version of `HasFvar.getFvar`: returns ALL free variables in
+    a (possibly compound) expression.  `HasFvar.getFvar` only returns Some when
+    the expression is a single fvar atom; `HasFvars.getFvars` recurses into
+    compounds. -/
+class HasFvars (P : PureExpr) where
+  getFvars : P.Expr → List P.Ident
+
+/-- Returns ALL operator/function names referenced in an expression
+    (e.g., `.op` constructs in Lambda). -/
+class HasOps (P : PureExpr) where
+  getOps : P.Expr → List P.Ident
+
 class HasVal (P : PureExpr) where
   value : P.Expr → Prop
 
-class HasBoolVal (P : PureExpr) [HasBool P] [HasVal P] where
-  bool_is_val : (@HasVal.value P) HasBool.tt ∧ (@HasVal.value P) HasBool.ff
+/-- Boolean expressions.  Extends `HasVal P` (folding in the former
+    `HasBoolVal`).  `boolIsVal` ensures `tt`/`ff` are values. -/
+class HasBool (P : PureExpr) extends HasVal P where
+  tt : P.Expr
+  ff : P.Expr
+  tt_is_not_ff: tt ≠ ff
+  boolTy : P.Ty
+  boolIsVal : (@HasVal.value P) tt ∧ (@HasVal.value P) ff
+
+/-- Boolean operations: not, and, imp. -/
+class HasBoolOps (P : PureExpr) extends HasBool P where
+  not : P.Expr → P.Expr
+  and : P.Expr → P.Expr → P.Expr
+  imp : P.Expr → P.Expr → P.Expr
+
+/-- Integer constants and the integer type. -/
+class HasInt (P : PureExpr) [HasVal P] [HasFvars P] where
+  zero  : P.Expr
+  intTy : P.Ty
+  isNumeral : P.Expr → Bool
+  numeralIsValue : ∀ n, isNumeral n = Bool.true → (@HasVal.value P) n
+  zeroIsNumeral : isNumeral zero = Bool.true
+  numeralHasNoFvars : ∀ (n : P.Expr), isNumeral n = Bool.true →
+    HasFvars.getFvars (P := P) n = []
+
+/-- Integer arithmetic / comparison primitives. -/
+class HasIntOps (P : PureExpr) [HasBool P] [HasFvars P] [HasInt P] where
+  eq    : P.Expr → P.Expr → P.Expr
+  lt    : P.Expr → P.Expr → P.Expr
 
 /-- Substitution of free variables in expressions.
     Used for closure capture in function declarations. -/
diff --git a/Strata/DL/Imperative/SemanticsProps.lean b/Strata/DL/Imperative/SemanticsProps.lean
deleted file mode 100644
index feff847016..0000000000
--- a/Strata/DL/Imperative/SemanticsProps.lean
+++ /dev/null
@@ -1,489 +0,0 @@
-/-
-  Copyright Strata Contributors
-
-  SPDX-License-Identifier: Apache-2.0 OR MIT
--/
-module
-
-import all Strata.DL.Imperative.CmdSemantics
-public import Strata.DL.Imperative.StmtSemantics
-import all Strata.DL.Imperative.StmtSemantics
-import all Strata.DL.Imperative.Cmd
-
-namespace Imperative
-
-public section
-
-theorem eval_assert_store_cst
-  [HasFvar P] [HasBool P] [HasNot P]:
-  EvalCmd P δ σ (.assert l e md) σ' f → σ = σ' := by
-  intros Heval; cases Heval with
-  | eval_assert_pass _ => rfl
-  | eval_assert_fail _ => rfl
-
-theorem eval_stmt_assert_store_cst
-  [HasFvar P] [HasBool P] [HasNot P] :
-  EvalStmtSmall P (EvalCmd P) extendEval ρ (.cmd (Cmd.assert l e md)) ρ' → ρ.store = ρ'.store := by
-  intro Heval
-  unfold EvalStmtSmall at Heval
-  -- step_cmd produces .terminal, so the trace is one step then done
-  match Heval with
-  | .step _ _ _ (.step_cmd hcmd) hrest =>
-    -- hrest : StepStmtStar ... (.terminal ...) (.terminal ρ')
-    -- .terminal is terminal (no further steps), so hrest must be refl
-    cases hrest with
-    | refl => simp; exact eval_assert_store_cst hcmd
-    | step _ _ _ hstep _ => exact absurd hstep (by intro h; cases h)
-
-theorem eval_stmt_assert_eval_cst
-  [HasFvar P] [HasBool P] [HasNot P] :
-  EvalStmtSmall P (EvalCmd P) extendEval ρ (.cmd (Cmd.assert l e md)) ρ' → ρ.eval = ρ'.eval := by
-  intro Heval
-  unfold EvalStmtSmall at Heval
-  match Heval with
-  | .step _ _ _ (.step_cmd _) hrest =>
-    cases hrest with
-    | refl => simp
-    | step _ _ _ hstep _ => exact absurd hstep (by intro h; cases h)
-
-theorem eval_stmts_assert_store_cst
-  [HasFvar P] [HasBool P] [HasNot P] :
-  EvalStmtsSmall P (EvalCmd P) extendEval ρ [(.cmd (Cmd.assert l e md))] ρ' → ρ.store = ρ'.store := by
-  intro Heval
-  -- Use stmts_cons_step inversion: the singleton list steps through
-  -- .stmts [assert] ρ →* .stmts [] ρ'' →* .terminal ρ'
-  -- where the head statement preserves the store.
-  have hstmt : EvalStmtSmall P (EvalCmd P) extendEval ρ (.cmd (Cmd.assert l e md)) ρ' := by
-    unfold EvalStmtsSmall at Heval
-    unfold EvalStmtSmall
-    -- .stmts [s] ρ → .seq (.stmt s ρ) [] → ... → .seq (.terminal ρ'') [] → .stmts [] ρ'' → .terminal ρ''
-    have hcons := stmts_cons_step P (EvalCmd P) extendEval
-      (.cmd (Cmd.assert l e md)) [] ρ
-    -- We need to extract the stmt execution from the stmts execution
-    -- Use seq_reaches_terminal to invert
-    match Heval with
-    | .step _ _ _ .step_stmts_cons hrest =>
-      have ⟨ρ₁, hterm, htail⟩ := seq_reaches_terminal P (EvalCmd P) extendEval hrest
-      -- htail : StepStmtStar (.stmts [] ρ₁) (.terminal ρ')
-      -- From htail, .stmts [] → .terminal in one step, so ρ₁ = ρ'
-      match htail with
-      | .step _ _ _ .step_stmts_nil hrest' =>
-        cases hrest' with
-        | refl => exact hterm
-        | step _ _ _ h _ => exact absurd h (by intro h; cases h)
-  exact eval_stmt_assert_store_cst hstmt
-
-theorem eval_stmt_assert_eq_of_pure_expr_eq
-  [HasFvar P] [HasBool P] [HasNot P] :
-  WellFormedSemanticEvalBool ρ.eval →
-  (EvalStmtSmall P (EvalCmd P) extendEval ρ (.cmd (Cmd.assert l1 e md1)) ρ' ↔
-  EvalStmtSmall P (EvalCmd P) extendEval ρ (.cmd (Cmd.assert l2 e md2)) ρ') := by
-  intro Hwf
-  constructor <;>
-  (
-    intro Heval
-    unfold EvalStmtSmall at Heval ⊢
-    match Heval with
-    | .step _ _ _ (.step_cmd hcmd) hrest =>
-      cases hrest with
-      | refl =>
-        cases hcmd with
-        | eval_assert_pass htt _ =>
-          exact .step _ _ _ (.step_cmd (EvalCmd.eval_assert_pass htt Hwf)) (.refl _)
-        | eval_assert_fail hne _ =>
-          exact .step _ _ _ (.step_cmd (EvalCmd.eval_assert_fail hne Hwf)) (.refl _)
-      | step _ _ _ hstep _ => exact absurd hstep (by intro h; cases h)
-  )
-
-/-! ### hasFailure monotonicity and irrelevance
-
-`hasFailure` is never consulted by any `StepStmt` premise,
-so it is both *monotone* (once `true`, stays `true`) and *irrelevant*
-(changing only `hasFailure` in the input env yields an execution with the
-same `store` and `eval` in the output).
--/
-
-private theorem step_hasFailure_monotone
-  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
-  {extendEval : ExtendEval P}
-  [HasBool P] [HasNot P]
-  {c c' : Config P CmdT}
-  (hstep : StepStmt P EvalCmd extendEval c c')
-  (hf : c.getEnv.hasFailure = true) :
-  c'.getEnv.hasFailure = true := by
-  induction hstep with
-  | step_cmd _ => simp [Config.getEnv]; left; exact hf
-  | step_block => simp [Config.getEnv]; exact hf
-  | step_ite_true _ _ => exact hf
-  | step_ite_false _ _ => exact hf
-  | step_ite_nondet_true => exact hf
-  | step_ite_nondet_false => exact hf
-  | step_loop_enter _ _ _ _ =>
-    simp [Config.getEnv]; left; exact hf
-  | step_loop_exit _ _ _ _ =>
-    simp [Config.getEnv]; left; exact hf
-  | step_loop_nondet_enter _ _ =>
-    simp [Config.getEnv]; left; exact hf
-  | step_loop_nondet_exit _ _ =>
-    simp [Config.getEnv]; left; exact hf
-  | step_exit => exact hf
-  | step_funcDecl => simp [Config.getEnv]; exact hf
-  | step_typeDecl => exact hf
-  | step_stmts_nil => exact hf
-  | step_stmts_cons => exact hf
-  | step_seq_inner _ ih => exact ih hf
-  | step_seq_done => exact hf
-  | step_seq_exit => exact hf
-  | step_block_body _ ih => exact ih hf
-  | step_block_done => exact hf
-  | step_block_exit_match _ => exact hf
-  | step_block_exit_mismatch _ => exact hf
-
-theorem EvalStmtSmall_hasFailure_monotone
-  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
-  {extendEval : ExtendEval P}
-  {ρ ρ' : Env P} {s : Stmt P CmdT}
-  [HasBool P] [HasNot P] :
-  EvalStmtSmall P EvalCmd extendEval ρ s ρ' →
-  ρ.hasFailure = true → ρ'.hasFailure = true := by
-  intro Heval Hf
-  suffices ∀ c c', StepStmtStar P EvalCmd extendEval c c' →
-      c.getEnv.hasFailure = true → c'.getEnv.hasFailure = true by
-    exact this _ _ Heval Hf
-  intro c c' hstar hf
-  induction hstar with
-  | refl => exact hf
-  | step _ _ _ hstep _ ih => exact ih (step_hasFailure_monotone hstep hf)
-
-theorem EvalStmtsSmall_hasFailure_monotone
-  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
-  {extendEval : ExtendEval P}
-  {ρ ρ' : Env P} {ss : List (Stmt P CmdT)}
-  [HasBool P] [HasNot P] :
-  EvalStmtsSmall P EvalCmd extendEval ρ ss ρ' →
-  ρ.hasFailure = true → ρ'.hasFailure = true := by
-  intro Heval Hf
-  suffices ∀ c c', StepStmtStar P EvalCmd extendEval c c' →
-      c.getEnv.hasFailure = true → c'.getEnv.hasFailure = true by
-    exact this _ _ Heval Hf
-  intro c c' hstar hf
-  induction hstar with
-  | refl => exact hf
-  | step _ _ _ hstep _ ih => exact ih (step_hasFailure_monotone hstep hf)
-
-theorem StepStmtStar_hasFailure_monotone
-  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
-  {extendEval : ExtendEval P}
-  [HasBool P] [HasNot P]
-  {c c' : Config P CmdT}
-  (hstar : StepStmtStar P EvalCmd extendEval c c')
-  (hf : c.getEnv.hasFailure = true) :
-  c'.getEnv.hasFailure = true := by
-  induction hstar with
-  | refl => exact hf
-  | step _ _ _ hstep _ ih => exact ih (step_hasFailure_monotone hstep hf)
-
-theorem EvalStmtSmall_hasFailure_irrel
-  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
-  {extendEval : ExtendEval P}
-  {ρ ρ' : Env P} {s : Stmt P CmdT}
-  [HasBool P] [HasNot P] :
-  EvalStmtSmall P EvalCmd extendEval ρ s ρ' →
-  ∀ (ρ₂ : Env P), ρ₂.store = ρ.store → ρ₂.eval = ρ.eval →
-  ∃ ρ₂', EvalStmtSmall P EvalCmd extendEval ρ₂ s ρ₂' ∧
-    ρ₂'.store = ρ'.store ∧ ρ₂'.eval = ρ'.eval :=
-  smallStep_hasFailure_irrel P EvalCmd extendEval s ρ ρ'
-
-theorem EvalStmtsSmall_hasFailure_irrel
-  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
-  {extendEval : ExtendEval P}
-  {ρ ρ' : Env P} {ss : List (Stmt P CmdT)}
-  [HasBool P] [HasNot P] :
-  EvalStmtsSmall P EvalCmd extendEval ρ ss ρ' →
-  ∀ (ρ₂ : Env P), ρ₂.store = ρ.store → ρ₂.eval = ρ.eval →
-  ∃ ρ₂', EvalStmtsSmall P EvalCmd extendEval ρ₂ ss ρ₂' ∧
-    ρ₂'.store = ρ'.store ∧ ρ₂'.eval = ρ'.eval := by
-  intro Heval ρ₂ Hstore Heval_eq
-  -- Reuse the simulation-based proof from StmtSemantics
-  -- smallStep_hasFailure_irrel works on .stmt configs; we need .stmts
-  -- Use the same simulation technique directly
-  suffices ∀ (c₁ c₂ : Config P CmdT),
-      ConfigSE P c₁ c₂ →
-      ∀ c₁', StepStmtStar P EvalCmd extendEval c₁ c₁' →
-      ∃ c₂', StepStmtStar P EvalCmd extendEval c₂ c₂' ∧ ConfigSE P c₁' c₂' by
-    have heq_init : ConfigSE P (.stmts ss ρ) (.stmts ss ρ₂) := ⟨rfl, Hstore.symm, Heval_eq.symm⟩
-    have ⟨c₂', hstar₂, heq₂⟩ := this _ _ heq_init _ Heval
-    match c₂', heq₂ with
-    | .terminal ρ₂', heq_t => exact ⟨ρ₂', hstar₂, heq_t.1.symm, heq_t.2.symm⟩
-  intro c₁ c₂ heq c₁' hstar
-  induction hstar generalizing c₂ with
-  | refl => exact ⟨c₂, .refl _, heq⟩
-  | step _ mid _ hstep _ ih =>
-    have ⟨mid₂, hstep₂, heq_mid⟩ := step_simulation P EvalCmd extendEval _ _ _ hstep heq
-    have ⟨c₂', hstar₂, heq_final⟩ := ih _ heq_mid
-    exact ⟨c₂', .step _ _ _ hstep₂ hstar₂, heq_final⟩
-
-/-! ### Assert elimination -/
-
-theorem eval_stmts_assert_elim
-  [HasFvar P] [HasBool P] [HasNot P] :
-  WellFormedSemanticEvalBool ρ.eval →
-  EvalStmtsSmall P (EvalCmd P) extendEval ρ (.cmd (.assert l1 e md1) :: cmds) ρ' →
-  ∃ ρ'', EvalStmtsSmall P (EvalCmd P) extendEval ρ cmds ρ'' ∧
-    ρ''.store = ρ'.store ∧ ρ''.eval = ρ'.eval ∧
-    (ρ'.hasFailure = false → ρ''.hasFailure = false) := by
-  intro Hwf Heval
-  unfold EvalStmtsSmall at Heval
-  match Heval with
-  | .step _ _ _ .step_stmts_cons hrest =>
-    have ⟨ρ₁, hterm_assert, htail⟩ := seq_reaches_terminal P (EvalCmd P) extendEval hrest
-    -- The assert takes exactly one step_cmd to terminal
-    have ⟨hcmd, hσ, hδ⟩ : (∃ σ' f, EvalCmd P ρ.eval ρ.store (.assert l1 e md1) σ' f) ∧
-        ρ.store = ρ₁.store ∧ ρ.eval = ρ₁.eval := by
-      match hterm_assert with
-      | .step _ _ _ (.step_cmd hcmd) (.refl _) =>
-        exact ⟨⟨_, _, hcmd⟩, eval_assert_store_cst hcmd, rfl⟩
-    -- Use hasFailure_irrel to re-run cmds from ρ
-    have ⟨ρ'', Hblock, Hstore, Heval_eq⟩ := EvalStmtsSmall_hasFailure_irrel htail ρ hσ hδ
-    -- Determine whether the assert passed or failed
-    match hterm_assert with
-    | .step _ _ _ (.step_cmd hcmd) (.refl _) =>
-      cases hcmd with
-      | eval_assert_pass =>
-        -- ρ₁ = { ρ with hasFailure := ρ.hasFailure || false } = ρ
-        exists ρ'
-        refine ⟨?_, rfl, rfl, id⟩
-        show StepStmtStar P (EvalCmd P) extendEval (.stmts cmds ρ) (.terminal ρ')
-        have : ρ = { store := ρ.store, eval := ρ.eval, hasFailure := ρ.hasFailure || false } := by
-          cases ρ; simp
-        rw [this]; exact htail
-      | eval_assert_fail =>
-        exists ρ''
-        refine ⟨Hblock, Hstore, Heval_eq, ?_⟩
-        intro Hf
-        -- ρ₁.hasFailure = ρ.hasFailure || true = true
-        -- By monotonicity, ρ'.hasFailure = true, contradicting Hf
-        have hf1 : (Env.mk ρ.store ρ.eval (ρ.hasFailure || true)).hasFailure = true := by simp
-        exact absurd (EvalStmtsSmall_hasFailure_monotone htail hf1) (by simp [Hf])
-
-theorem assert_elim
-  [HasFvar P] [HasBool P] [HasNot P] :
-  WellFormedSemanticEvalBool ρ.eval →
-  EvalStmtsSmall P (EvalCmd P) extendEval ρ (.cmd (.assert l1 e md1) :: [.cmd (.assert l2 e md2)]) ρ' →
-  EvalStmtsSmall P (EvalCmd P) extendEval ρ [.cmd (.assert l3 e md3)] ρ' := by
-  intro Hwf Heval
-  unfold EvalStmtsSmall at Heval ⊢
-  -- Invert: first assert
-  match Heval with
-  | .step _ _ _ .step_stmts_cons hrest =>
-    have ⟨ρ₁, hterm1, htail1⟩ := seq_reaches_terminal P (EvalCmd P) extendEval hrest
-    match hterm1 with
-    | .step _ _ _ (.step_cmd hcmd1) (.refl _) =>
-      -- Invert: second assert (from htail1 which is .stmts [assert2] ρ₁ →* .terminal ρ')
-      match htail1 with
-      | .step _ _ _ .step_stmts_cons hrest2 =>
-        have ⟨ρ₂, hterm2, htail2⟩ := seq_reaches_terminal P (EvalCmd P) extendEval hrest2
-        match hterm2 with
-        | .step _ _ _ (.step_cmd hcmd2) (.refl _) =>
-          match htail2 with
-          | .step _ _ _ .step_stmts_nil (.refl _) =>
-            -- Both asserts preserve store, so ρ₂ has same store/eval as ρ
-            -- hcmd1 and hcmd2 both evaluate e in the same store/eval
-            -- They must agree on pass/fail
-            cases hcmd1 with
-            | eval_assert_pass h1 _ =>
-              -- e evaluates to tt; hcmd2 also sees tt (same store/eval)
-              -- Build single assert3 that passes, producing same ρ'
-              -- ρ' = { store := ρ.store, eval := ρ.eval, hasFailure := (ρ.hasFailure || false) || f₂ }
-              -- We need to produce the same env with a single assert
-              -- Since h1 : ρ.eval ρ.store e = some tt, hcmd2 must also pass
-              cases hcmd2 with
-              | eval_assert_pass _ _ =>
-                apply ReflTrans.step _ _ _ .step_stmts_cons
-                apply ReflTrans.step _ _ _ (.step_seq_inner (.step_cmd (EvalCmd.eval_assert_pass h1 Hwf)))
-                apply ReflTrans.step _ _ _ .step_seq_done
-                apply ReflTrans.step _ _ _ .step_stmts_nil
-                simp_all [Bool.or_false]; exact .refl _
-              | eval_assert_fail h2 _ =>
-                simp at h2
-                exact absurd (h1.symm.trans h2)
-                  (by exact fun h => HasBool.tt_is_not_ff (Option.some.inj h))
-            | eval_assert_fail h1 _ =>
-              cases hcmd2 with
-              | eval_assert_pass h2 _ =>
-                simp at h2
-                exact absurd (h2.symm.trans h1)
-                  (by exact fun h => HasBool.tt_is_not_ff (Option.some.inj h))
-              | eval_assert_fail _ _ =>
-                apply ReflTrans.step _ _ _ .step_stmts_cons
-                apply ReflTrans.step _ _ _ (.step_seq_inner (.step_cmd (EvalCmd.eval_assert_fail h1 Hwf)))
-                apply ReflTrans.step _ _ _ .step_seq_done
-                apply ReflTrans.step _ _ _ .step_stmts_nil
-                simp_all [Bool.or_true]; exact .refl _
-
-theorem UpdateStateComm {P: PureExpr} {x1 x2: P.Ident} {σ σ' σ'' σ1 σ2: SemanticStore P} {v1 v2: P.Expr}
-  [DecidableEq P.Ident]:
-  ¬ x1 = x2 →
-  UpdateState P σ x1 v1 σ1 →
-  UpdateState P σ1 x2 v2 σ' →
-  UpdateState P σ x2 v2 σ2 →
-  UpdateState P σ2 x1 v1 σ'' →
-  σ' = σ'' := by
-  intro Hneq Hu1 Hu2 Hu3 Hu4
-  cases Hu1; cases Hu2; cases Hu3; cases Hu4
-  ext i e
-  rename_i Hfa1 _ _ _ Hfa2 _ _ _ Hfa3 _ _ _ Hfa4 _
-  simp at Hfa1 Hfa2 Hfa3 Hfa4
-  rw[Eq.comm] at Hneq
-  by_cases Heq1: x1 = i
-  simp_all
-  by_cases Heq2: x2 = i
-  rw[Eq.comm] at Hneq
-  specialize Hfa4 x2 Hneq
-  simp_all
-  specialize Hfa1 i Heq1
-  specialize Hfa2 i Heq2
-  specialize Hfa3 i Heq2
-  specialize Hfa4 i Heq1
-  simp_all
-
-theorem UpdateState_InitStateComm {P: PureExpr} {x1 x2: P.Ident} {σ σ' σ'' σ1 σ2: SemanticStore P} {v1 v2: P.Expr}
-  [DecidableEq P.Ident]:
-  ¬ x1 = x2 →
-  UpdateState P σ x1 v1 σ1 →
-  InitState P σ1 x2 v2 σ' →
-  InitState P σ x2 v2 σ2 →
-  UpdateState P σ2 x1 v1 σ'' →
-  σ' = σ'' := by
-  intro Hneq Hu1 Hu2 Hu3 Hu4
-  cases Hu1; cases Hu2; cases Hu3; cases Hu4
-  ext i e
-  rename_i Hfa1 _ _ Hfa2 _ _ Hfa3 _ _ _ Hfa4 _
-  simp at Hfa1 Hfa2 Hfa3 Hfa4
-  rw[Eq.comm] at Hneq
-  by_cases Heq1: x1 = i
-  simp_all
-  by_cases Heq2: x2 = i
-  rw[Eq.comm] at Hneq
-  specialize Hfa4 x2 Hneq
-  simp_all
-  specialize Hfa1 i Heq1
-  specialize Hfa2 i Heq2
-  specialize Hfa3 i Heq2
-  specialize Hfa4 i Heq1
-  simp_all
-
-theorem semantic_eval_eq_of_eval_cmd_set_unrelated_var
-  [HasVarsImp P (Cmd P)] [HasVarsPure P P.Expr]
-  [HasFvar P] [HasVal P] [HasBool P] [HasNot P]:
-  WellFormedSemanticEvalExprCongr δ →
-  ¬ v ∈ HasVarsPure.getVars e →
-  EvalCmd P δ σ (Cmd.set v (.det e') md) σ' f →
-  δ σ e = δ σ' e := by
-  intro Hwf Hnin Heval
-  unfold WellFormedSemanticEvalExprCongr at Hwf
-  specialize Hwf e σ σ'
-  have: ∀ (v : P.Ident), v ∈ HasVarsPure.getVars e → σ v = σ' v := by
-    cases Heval
-    rename_i Hu
-    cases Hu
-    rename_i Hfa _
-    intro v' Hv'
-    ext e'
-    by_cases Hc: ¬ v = v'
-    specialize Hfa v' Hc
-    simp_all
-    simp_all
-  exact Hwf this
-
-theorem eval_cmd_set_comm'
-  [HasVarsImp P (List (Stmt P (Cmd P)))] [HasVarsImp P (Cmd P)]
-  [HasFvar P] [HasVal P] [HasBool P] [HasNot P] [DecidableEq P.Ident] :
-  ¬ x1 = x2 →
-  δ σ v1 = δ σ2 v1 →
-  δ σ v2 = δ σ1 v2 →
-  EvalCmd P δ σ (Cmd.set x1 (.det v1) md1) σ1 f1 →
-  EvalCmd P δ σ1 (Cmd.set x2 (.det v2) md2) σ' f2 →
-  EvalCmd P δ σ (Cmd.set x2 (.det v2) md2') σ2 f3 →
-  EvalCmd P δ σ2 (Cmd.set x1 (.det v1) md1') σ'' f4 →
-  σ' = σ'' := by
-  intro Hneq Heq1 Heq2 Hs1 Hs2 Hs3 Hs4
-  cases Hs1 with | eval_set _ Hu1 _ =>
-  cases Hs2 with | eval_set _ Hu2 _ =>
-  cases Hs3 with | eval_set _ Hu3 _ =>
-  cases Hs4 with | eval_set _ Hu4 _ =>
-  simp_all
-  exact UpdateStateComm Hneq Hu1 Hu2 Hu3 Hu4
-
-theorem eval_cmd_set_comm
-  [HasVarsImp P (List (Stmt P (Cmd P)))] [HasVarsImp P (Cmd P)] [HasVarsPure P P.Expr]
-  [HasFvar P] [HasVal P] [HasBool P] [HasNot P] [DecidableEq P.Ident]:
-  WellFormedSemanticEvalExprCongr δ →
-  ¬ x1 = x2 →
-  ¬ x1 ∈ HasVarsPure.getVars v2 →
-  ¬ x2 ∈ HasVarsPure.getVars v1 →
-  EvalCmd P δ σ (Cmd.set x1 (.det v1) md1) σ1 f1 →
-  EvalCmd P δ σ1 (Cmd.set x2 (.det v2) md2) σ' f2 →
-  EvalCmd P δ σ (Cmd.set x2 (.det v2) md2') σ2 f3 →
-  EvalCmd P δ σ2 (Cmd.set x1 (.det v1) md1') σ'' f4 →
-  σ' = σ'' := by
-  intro Hwf Hneq Hnin1 Hnin2 Hs1 Hs2 Hs3 Hs4
-  have Heval2:= semantic_eval_eq_of_eval_cmd_set_unrelated_var Hwf Hnin1 Hs1
-  have Heval1:= semantic_eval_eq_of_eval_cmd_set_unrelated_var Hwf Hnin2 Hs3
-  exact eval_cmd_set_comm' Hneq Heval1 Heval2 Hs1 Hs2 Hs3 Hs4
-
-theorem eval_stmt_set_comm
-  [HasVarsImp P (List (Stmt P (Cmd P)))] [HasVarsImp P (Cmd P)] [HasVarsPure P P.Expr]
-  [HasFvar P] [HasVal P] [HasBool P] [HasNot P] [DecidableEq P.Ident]:
-  WellFormedSemanticEvalExprCongr ρ.eval →
-  ¬ x1 = x2 →
-  ¬ x1 ∈ HasVarsPure.getVars v2 →
-  ¬ x2 ∈ HasVarsPure.getVars v1 →
-  EvalStmtSmall P (EvalCmd P) evalFun ρ (.cmd (Cmd.set x1 (.det v1) md1)) ρ1 →
-  EvalStmtSmall P (EvalCmd P) evalFun ρ1 (.cmd (Cmd.set x2 (.det v2) md2)) ρ' →
-  EvalStmtSmall P (EvalCmd P) evalFun ρ (.cmd (Cmd.set x2 (.det v2) md2')) ρ2 →
-  EvalStmtSmall P (EvalCmd P) evalFun ρ2 (.cmd (Cmd.set x1 (.det v1) md1')) ρ'' →
-  ρ'.store = ρ''.store := by
-  intro Hwf Hneq Hnin1 Hnin2 Hs1 Hs2 Hs3 Hs4
-  unfold EvalStmtSmall at Hs1 Hs2 Hs3 Hs4
-  match Hs1, Hs2, Hs3, Hs4 with
-  | .step _ _ _ (.step_cmd Hc1) (.refl _),
-    .step _ _ _ (.step_cmd Hc2) (.refl _),
-    .step _ _ _ (.step_cmd Hc3) (.refl _),
-    .step _ _ _ (.step_cmd Hc4) (.refl _) =>
-    simp
-    exact eval_cmd_set_comm Hwf Hneq Hnin1 Hnin2 Hc1 Hc2 Hc3 Hc4
-
-theorem eval_stmts_set_comm
-  [HasVarsImp P (List (Stmt P (Cmd P)))] [HasVarsImp P (Cmd P)] [HasVarsPure P P.Expr]
-  [HasFvar P] [HasVal P] [HasBool P] [HasNot P] [DecidableEq P.Ident] :
-  WellFormedSemanticEvalExprCongr ρ.eval →
-  ¬ x1 = x2 →
-  ¬ x1 ∈ HasVarsPure.getVars v2 →
-  ¬ x2 ∈ HasVarsPure.getVars v1 →
-  EvalStmtsSmall P (EvalCmd P) evalFun ρ [(.cmd (Cmd.set x1 (.det v1) md1)), (.cmd (Cmd.set x2 (.det v2) md2))] ρ' →
-  EvalStmtsSmall P (EvalCmd P) evalFun ρ [(.cmd (Cmd.set x2 (.det v2) md2')), (.cmd (Cmd.set x1 (.det v1) md1'))] ρ'' →
-  ρ'.store = ρ''.store := by
-  intro Hwf Hneq Hnin1 Hnin2 Heval1 Heval2
-  -- Extract the four EvalCmd's from the two list executions
-  -- Each list [cmd1, cmd2] decomposes via:
-  -- stmts_cons → seq → cmd1 terminal → stmts [cmd2] → seq → cmd2 terminal → stmts [] → terminal
-  have extract := fun (s1 s2 : Stmt P (Cmd P)) (ρ₀ ρ_final : Env P)
-      (h : EvalStmtsSmall P (EvalCmd P) evalFun ρ₀ [s1, s2] ρ_final) =>
-    show ∃ ρ_mid, EvalStmtSmall P (EvalCmd P) evalFun ρ₀ s1 ρ_mid ∧
-        EvalStmtSmall P (EvalCmd P) evalFun ρ_mid s2 ρ_final from by
-      unfold EvalStmtsSmall EvalStmtSmall at *
-      match h with
-      | .step _ _ _ .step_stmts_cons hrest =>
-        have ⟨ρ₁, hterm1, htail1⟩ := seq_reaches_terminal P (EvalCmd P) evalFun hrest
-        match htail1 with
-        | .step _ _ _ .step_stmts_cons hrest2 =>
-          have ⟨ρ₂, hterm2, htail2⟩ := seq_reaches_terminal P (EvalCmd P) evalFun hrest2
-          match htail2 with
-          | .step _ _ _ .step_stmts_nil (.refl _) =>
-            exact ⟨ρ₁, hterm1, hterm2⟩
-  have ⟨ρ_mid1, Hs1, Hs2⟩ := extract _ _ _ _ Heval1
-  have ⟨ρ_mid2, Hs3, Hs4⟩ := extract _ _ _ _ Heval2
-  exact eval_stmt_set_comm Hwf Hneq Hnin1 Hnin2 Hs1 Hs2 Hs3 Hs4
-
-end -- public section
diff --git a/Strata/DL/Imperative/Stmt.lean b/Strata/DL/Imperative/Stmt.lean
index 821ecf0d9d..bc306bfb29 100644
--- a/Strata/DL/Imperative/Stmt.lean
+++ b/Strata/DL/Imperative/Stmt.lean
@@ -39,7 +39,10 @@ inductive Stmt (P : PureExpr) (Cmd : Type) : Type where
   /-- An iterated execution statement. Includes an optional measure (for
   termination) and labeled invariants. When `guard` is `.nondet`, the loop iterates
   a non-deterministic number of times. Each invariant carries a label string
-  (expected to be distinct, like assert labels do). -/
+  (expected to be distinct, like assert labels do).
+  TODO: measure will be moved to metadata md, since it doesn't contribute to
+  the small-step semantics (StepStmt).
+  -/
   | loop     (guard : ExprOrNondet P) (measure : Option P.Expr)
              (invariants : List (String × P.Expr))
              (body : List (Stmt P Cmd)) (md : MetaData P)
@@ -232,57 +235,112 @@ end
 
 mutual
 /-- Get all variables accessed by `s`. -/
-def Stmt.getVars [HasVarsPure P P.Expr] [HasVarsPure P C] (s : Stmt P C) : List P.Ident :=
+@[expose]
+def Stmt.getVars [HasFvars P] [HasVarsPure P C] (s : Stmt P C) : List P.Ident :=
   match s with
   | .cmd cmd => HasVarsPure.getVars cmd
   | .block _ bss _ => Block.getVars bss
   | .ite cond tbss ebss _ => cond.getVars ++ Block.getVars tbss ++ Block.getVars ebss
-  | .loop guard _ _ bss _ => guard.getVars ++ Block.getVars bss
+  | .loop guard measure invariants bss _ =>
+    guard.getVars ++
+    (measure.map HasFvars.getFvars).getD [] ++
+    (invariants.flatMap fun lp => HasFvars.getFvars lp.2) ++
+    Block.getVars bss
   | .exit _ _  => []
   | .funcDecl decl _ =>
-    -- Get free variables from function body, excluding formal parameters
-    match decl.body with
-    | none => []
-    | some body =>
-      let bodyVars := HasVarsPure.getVars body
-      let formals := decl.inputs.map (·.1)
-      bodyVars.filter (fun v => formals.all (fun f => ¬(P.EqIdent v f).decide))
+    -- Get free variables from function body and axioms, excluding formal
+    -- parameters. Axiom free variables are included.
+    (match decl.body with
+      | some body => (HasFvars.getFvars body).filter
+          (fun v => (decl.inputs.map (·.1)).all (fun f => !(P.EqIdent v f).decide))
+      | none => []) ++
+    decl.axioms.flatMap (fun ax => (HasFvars.getFvars ax).filter
+      (fun v => (decl.inputs.map (·.1)).all (fun f => !(P.EqIdent v f).decide)))
   | .typeDecl _ _ => []  -- Type declarations don't reference variables
 
-def Block.getVars [HasVarsPure P P.Expr] [HasVarsPure P C] (ss : Block P C) : List P.Ident :=
+@[expose]
+def Block.getVars [HasFvars P] [HasVarsPure P C] (ss : Block P C) : List P.Ident :=
   match ss with
   | [] => []
   | s :: srest => Stmt.getVars s ++ Block.getVars srest
 end
 
-instance (P : PureExpr) [HasVarsPure P P.Expr] [HasVarsPure P C]
+instance (P : PureExpr) [HasFvars P] [HasVarsPure P C]
   : HasVarsPure P (Stmt P C) where
   getVars := Stmt.getVars
 
-instance (P : PureExpr) [HasVarsPure P P.Expr] [HasVarsPure P C]
+instance (P : PureExpr) [HasFvars P] [HasVarsPure P C]
   : HasVarsPure P (Block P C) where
   getVars := Block.getVars
 
+mutual
+/-- Get all operator/function names referenced by `s`.  Mirrors
+    `Stmt.getVars` but collects `.op`-style names (resolved via the evaluator)
+    rather than free variables (resolved via the store). -/
+@[expose]
+def Stmt.getOps [HasOps P] [HasOpsImp P C] (s : Stmt P C) : List P.Ident :=
+  match s with
+  | .cmd cmd => HasOpsImp.getOps cmd
+  | .block _ bss _ => Block.getOps bss
+  | .ite cond tbss ebss _ =>
+    cond.getOps ++ Block.getOps tbss ++ Block.getOps ebss
+  | .loop guard measure invariants bss _ =>
+    guard.getOps ++
+    (measure.map (HasOps.getOps (P := P))).getD [] ++
+    (invariants.flatMap fun lp => HasOps.getOps (P := P) lp.2) ++
+    Block.getOps bss
+  | .exit _ _  => []
+  | .funcDecl decl _ =>
+    -- Operator names referenced by the function body and axioms.
+    -- (Operator names are global, so no formal-parameter filtering applies.)
+    ((decl.body.map (HasOps.getOps (P := P))).getD []) ++
+    decl.axioms.flatMap (HasOps.getOps (P := P))
+  | .typeDecl _ _ => []
+
+@[expose]
+def Block.getOps [HasOps P] [HasOpsImp P C] (ss : Block P C) : List P.Ident :=
+  match ss with
+  | [] => []
+  | s :: srest => Stmt.getOps s ++ Block.getOps srest
+end
+
+instance (P : PureExpr) [HasOps P] [HasOpsImp P C]
+  : HasOpsImp P (Stmt P C) where
+  getOps := Stmt.getOps
+
+instance (P : PureExpr) [HasOps P] [HasOpsImp P C]
+  : HasOpsImp P (Block P C) where
+  getOps := Block.getOps
+
 mutual
 /-- Get all variables defined by the statement `s`. -/
-def Stmt.definedVars [HasVarsImp P C] (s : Stmt P C) : List P.Ident :=
+@[simp, expose]
+def Stmt.definedVars [HasVarsImp P C] (s : Stmt P C)
+    (excludeScoped : Bool) : List P.Ident :=
   match s with
-  | .cmd cmd => HasVarsImp.definedVars cmd
-  | .block _ bss _ => Block.definedVars bss
-  | .ite _ tbss ebss _ => Block.definedVars tbss ++ Block.definedVars ebss
-  | .loop _ _ _ body _ => Block.definedVars body
-  | .funcDecl decl _ => [decl.name]  -- Function declaration defines the function name
-  | .typeDecl _ _ => []  -- Type declarations don't define variables
+  | .cmd cmd => HasVarsImp.definedVars cmd excludeScoped -- excludeScoped doesn't matter
+  | .block _ bss _ => if excludeScoped then [] else Block.definedVars bss excludeScoped
+  | .ite _ tbss ebss _ =>
+    if excludeScoped then [] else Block.definedVars tbss excludeScoped ++ Block.definedVars ebss excludeScoped
+  | .loop _ _ _ body _ => if excludeScoped then [] else Block.definedVars body excludeScoped
+  -- `step_funcDecl` extends `eval`, leaving `store` unchanged.  `definedVars`
+  -- tracks store-level definitions, so funcDecl introduces nothing here; the
+  -- name is tracked separately via `Stmt.funcDeclNames`.
+  | .funcDecl _ _ => []
+  | .typeDecl _ _ => []
   | _ => []
 
-def Block.definedVars [HasVarsImp P C] (ss : Block P C) : List P.Ident :=
+@[simp, expose]
+def Block.definedVars [HasVarsImp P C] (ss : Block P C)
+    (excludeScoped : Bool) : List P.Ident :=
   match ss with
   | [] => []
-  | s :: srest => Stmt.definedVars s ++ Block.definedVars srest
+  | s :: srest => Stmt.definedVars s excludeScoped ++ Block.definedVars srest excludeScoped
 end
 
 mutual
 /-- Get all variables modified by the statement `s`. -/
+@[simp, expose]
 def Stmt.modifiedVars [HasVarsImp P C] (s : Stmt P C) : List P.Ident :=
   match s with
   | .cmd cmd => HasVarsImp.modifiedVars cmd
@@ -293,50 +351,92 @@ def Stmt.modifiedVars [HasVarsImp P C] (s : Stmt P C) : List P.Ident :=
   | .funcDecl _ _ => []  -- Function declarations don't modify variables
   | .typeDecl _ _ => []  -- Type declarations don't modify variables
 
+@[simp, expose]
 def Block.modifiedVars [HasVarsImp P C] (ss : Block P C) : List P.Ident :=
   match ss with
   | [] => []
   | s :: srest => Stmt.modifiedVars s ++ Block.modifiedVars srest
 end
 
-mutual
-/-- Get all variables modified/defined by the statement `s`.
-    Note that we need a separate function because order matters here for sub-blocks
- -/
-def Stmt.modifiedOrDefinedVars [HasVarsImp P C] (s : Stmt P C) : List P.Ident :=
-  match s with
-  | .block _ bss _ => Block.modifiedOrDefinedVars bss
-  | .ite _ tbss ebss _ => Block.modifiedOrDefinedVars tbss ++ Block.modifiedOrDefinedVars ebss
-  | _ => Stmt.definedVars s ++ Stmt.modifiedVars s
+/-- Get all variables modified/defined by the statement `s` (the write-set). -/
+@[simp, expose]
+def Stmt.modifiedOrDefinedVars [HasVarsImp P C] (s : Stmt P C)
+    (excludeScoped : Bool): List P.Ident :=
+  s.modifiedVars ++ s.definedVars excludeScoped
 
-def Block.modifiedOrDefinedVars [HasVarsImp P C] (ss : Block P C) : List P.Ident :=
-  match ss with
-  | [] => []
-  | s :: srest => Stmt.modifiedOrDefinedVars s ++ Block.modifiedOrDefinedVars srest
-end
+@[simp, expose]
+def Block.modifiedOrDefinedVars [HasVarsImp P C] (ss : Block P C)
+    (excludeScoped : Bool): List P.Ident :=
+  ss.modifiedVars ++ ss.definedVars excludeScoped
 
 mutual
 /-- Get all variables touched (modified, defined, or read) by the statement `s`. -/
-def Stmt.touchedVars [HasVarsImp P C] [HasVarsPure P P.Expr] [HasVarsPure P C]
+@[simp, expose]
+def Stmt.touchedVars [HasVarsImp P C] [HasFvars P] [HasVarsPure P C]
     (s : Stmt P C) : List P.Ident :=
-  Stmt.modifiedOrDefinedVars s ++ Stmt.getVars s
+  Stmt.modifiedOrDefinedVars s true ++ Stmt.getVars s
 
-def Block.touchedVars [HasVarsImp P C] [HasVarsPure P P.Expr] [HasVarsPure P C]
+@[simp, expose]
+def Block.touchedVars [HasVarsImp P C] [HasFvars P] [HasVarsPure P C]
     (ss : Block P C) : List P.Ident :=
-  Block.modifiedOrDefinedVars ss ++ Block.getVars ss
+  Block.modifiedOrDefinedVars ss true ++ Block.getVars ss
+end
+
+mutual
+/-- Collect all labeled `exit` targets occurring in a statement (recursive). -/
+@[expose] def Stmt.labels (s : Stmt P C) : List String :=
+  match s with
+  | .exit l _        => [l]
+  | .cmd _           => []
+  | .block _ bss _   => Block.labels bss
+  | .ite _ tss ess _ => Block.labels tss ++ Block.labels ess
+  | .loop _ _ _ bss _ => Block.labels bss
+  | .funcDecl _ _    => []
+  | .typeDecl _ _    => []
+
+/-- Collect all labeled `exit` targets in a list of statements. -/
+@[expose] def Block.labels (ss : Block P C) : List String :=
+  match ss with
+  | []        => []
+  | s :: rest => Stmt.labels s ++ Block.labels rest
+end
+
+mutual
+/-- Collect `decl.name` from `funcDecl` AST nodes in a statement.
+
+    `excludeScoped = false` (the recursive form): collect all `funcDecl`
+    names syntactically inside `s`.
+    `excludeScoped = true` (the scope-aware form): collect only `funcDecl`
+    names introduced at the top level of `s`. Parallel to `Stmt.definedVars _ true`. -/
+@[expose] def Stmt.funcDeclNames (s : Stmt P C) (excludeScoped : Bool) : List P.Ident :=
+  match s with
+  | .funcDecl decl _ => [decl.name]
+  | .cmd _           => []
+  | .exit _ _        => []
+  | .typeDecl _ _    => []
+  | .block _ bss _ => if excludeScoped then [] else Block.funcDeclNames bss excludeScoped
+  | .ite _ tss ess _ =>
+    if excludeScoped then [] else Block.funcDeclNames tss excludeScoped ++
+                                  Block.funcDeclNames ess excludeScoped
+  | .loop _ _ _ bss _ => if excludeScoped then [] else Block.funcDeclNames bss excludeScoped
+
+/-- Collect `decl.name` from `funcDecl` AST nodes in a block.  See
+    `Stmt.funcDeclNames` for the meaning of `excludeScoped`. -/
+@[expose] def Block.funcDeclNames (ss : Block P C) (excludeScoped : Bool) : List P.Ident :=
+  match ss with
+  | []        => []
+  | s :: rest => Stmt.funcDeclNames s excludeScoped ++
+                 Block.funcDeclNames rest excludeScoped
 end
 
+
 instance (P : PureExpr) [HasVarsImp P C] : HasVarsImp P (Stmt P C) where
   definedVars := Stmt.definedVars
   modifiedVars := Stmt.modifiedVars
-  -- order matters for Havoc, so needs to override the default
-  modifiedOrDefinedVars := Stmt.modifiedOrDefinedVars
 
 instance (P : PureExpr) [HasVarsImp P C] : HasVarsImp P (Block P C) where
   definedVars := Block.definedVars
   modifiedVars := Block.modifiedVars
-  -- order matters for Havoc, so needs to override the default
-  modifiedOrDefinedVars := Block.modifiedOrDefinedVars
 
 ---------------------------------------------------------------------
 
@@ -361,7 +461,10 @@ def formatStmt (P : PureExpr) (s : Stmt P C)
       let invParts : List Format := invariant.map fun (l, e) =>
         if l.isEmpty then f!"{e}" else f!"[{l}]: {e}"
       let invFmt : Format := f!"[{Format.joinSep invParts f!", "}]"
-      let beforeBody := nestD f!"{line}{guard}{line}({measure}){line}{invFmt}"
+      let measureFmt : Format := match measure with
+        | none => f!"none"
+        | some e => f!"some {e}"
+      let beforeBody := nestD f!"{line}{guard}{line}({measureFmt}){line}{invFmt}"
       let children := group f!"{beforeBody}{line}{body}"
       f!"{md}while{children}"
   | .exit label md => f!"{md}exit {label}"
@@ -411,82 +514,6 @@ where
     | _, [] => True
     | labels, s :: ss => Stmt.exitsCoveredByBlocks labels s ∧ Block.exitsCoveredByBlocks labels ss
 
-theorem block_exitsCoveredByBlocks_append
-    {P : PureExpr} {CmdT : Type}
-    (labels : List String) (ss₁ ss₂ : List (Stmt P CmdT))
-    (h₁ : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels ss₁)
-    (h₂ : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels ss₂) :
-    Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels (ss₁ ++ ss₂) := by
-  induction ss₁ with
-  | nil => exact h₂
-  | cons s ss ih => exact ⟨h₁.1, ih h₁.2⟩
-
-/-- `exitsCoveredByBlocks` is monotone in the label list: more covering labels
-    can only help. -/
-theorem exitsCoveredByBlocks_weaken
-    {P : PureExpr} {CmdT : Type}
-    (labels₁ labels₂ : List String)
-    (hsub : ∀ l, l ∈ labels₁ → l ∈ labels₂) :
-    (∀ (s : Stmt P CmdT),
-      s.exitsCoveredByBlocks labels₁ → s.exitsCoveredByBlocks labels₂) ∧
-    (∀ (ss : List (Stmt P CmdT)),
-      Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels₁ ss →
-      Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels₂ ss) := by
-  suffices hstmt : ∀ (s : Stmt P CmdT),
-      ∀ labels₁ labels₂, (∀ l, l ∈ labels₁ → l ∈ labels₂) →
-        s.exitsCoveredByBlocks labels₁ → s.exitsCoveredByBlocks labels₂ by
-    constructor
-    · exact fun s => hstmt s labels₁ labels₂ hsub
-    · intro ss
-      induction ss with
-      | nil => intros; trivial
-      | cons s ss ih =>
-        exact fun h => ⟨hstmt s _ _ hsub h.1, ih h.2⟩
-  intro s
-  induction s using Stmt.rec (motive_2 := fun ss =>
-    ∀ labels₁ labels₂, (∀ l, l ∈ labels₁ → l ∈ labels₂) →
-      Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels₁ ss →
-      Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels₂ ss) with
-  | cmd _ => intros; trivial
-  | block l ss _ ih =>
-    intro labels₁ labels₂ hsub h
-    show Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks (l :: labels₂) ss
-    exact ih (l :: labels₁) (l :: labels₂)
-      (fun x hx => by cases hx with
-        | head => exact .head _
-        | tail _ hm => exact .tail _ (hsub x hm))
-      h
-  | ite _ tss ess _ ih_t ih_e =>
-    intro labels₁ labels₂ hsub h
-    exact ⟨ih_t labels₁ labels₂ hsub h.1, ih_e labels₁ labels₂ hsub h.2⟩
-  | loop _ _ _ body _ ih =>
-    intro labels₁ labels₂ hsub h
-    exact ih labels₁ labels₂ hsub h
-  | exit l _ =>
-    intro labels₁ labels₂ hsub h
-    exact hsub l h
-  | funcDecl _ _ => intros; trivial
-  | typeDecl _ _ => intros; trivial
-  | nil => intros; trivial
-  | cons s ss ih_s ih_ss =>
-    rename_i labels₁ labels₂ hsub h
-    exact ⟨ih_s labels₁ labels₂ hsub h.1, ih_ss labels₁ labels₂ hsub h.2⟩
-
-/-- If every statement in a list is a `.cmd`, then `exitsCoveredByBlocks` holds
-    for any labels (since `.cmd` has no exit statements). -/
-theorem all_cmd_exitsCoveredByBlocks
-    {P : PureExpr} {CmdT : Type}
-    (labels : List String) (ss : List (Stmt P CmdT))
-    (h : ∀ s ∈ ss, ∃ c, s = Stmt.cmd c) :
-    Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels ss := by
-  induction ss with
-  | nil => trivial
-  | cons hd tl ih =>
-    constructor
-    · obtain ⟨c, hc⟩ := h hd (.head _)
-      subst hc; exact True.intro
-    · exact ih (fun s hs => h s (.tail _ hs))
-
 ---------------------------------------------------------------------
 
 end -- public section
diff --git a/Strata/DL/Imperative/StmtProps.lean b/Strata/DL/Imperative/StmtProps.lean
new file mode 100644
index 0000000000..f900526b78
--- /dev/null
+++ b/Strata/DL/Imperative/StmtProps.lean
@@ -0,0 +1,60 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.DL.Imperative.Stmt
+
+namespace Imperative
+
+public section
+
+variable {P : PureExpr} {C : Type}
+
+mutual
+
+/-- If a statement contains no function declarations, then `funcDeclNames` is
+    empty (for either choice of `excludeScoped`). -/
+theorem Stmt.funcDeclNames_eq_nil_of_noFuncDecl
+    (s : Stmt P C) (excludeScoped : Bool) (h : Stmt.noFuncDecl s = true) :
+    Stmt.funcDeclNames s excludeScoped = [] := by
+  match s with
+  | .cmd _ => simp [Stmt.funcDeclNames]
+  | .exit _ _ => simp [Stmt.funcDeclNames]
+  | .typeDecl _ _ => simp [Stmt.funcDeclNames]
+  | .funcDecl _ _ => simp [Stmt.noFuncDecl] at h
+  | .block _ bss _ =>
+    simp [Stmt.noFuncDecl] at h
+    cases excludeScoped <;> simp [Stmt.funcDeclNames]
+    exact Block.funcDeclNames_eq_nil_of_noFuncDecl bss false h
+  | .ite _ tss ess _ =>
+    simp [Stmt.noFuncDecl, Bool.and_eq_true] at h
+    cases excludeScoped <;> simp [Stmt.funcDeclNames]
+    refine ⟨?_, ?_⟩
+    · exact Block.funcDeclNames_eq_nil_of_noFuncDecl tss false h.1
+    · exact Block.funcDeclNames_eq_nil_of_noFuncDecl ess false h.2
+  | .loop _ _ _ body _ =>
+    simp [Stmt.noFuncDecl] at h
+    cases excludeScoped <;> simp [Stmt.funcDeclNames]
+    exact Block.funcDeclNames_eq_nil_of_noFuncDecl body false h
+
+/-- If a block contains no function declarations, then `funcDeclNames` is empty. -/
+theorem Block.funcDeclNames_eq_nil_of_noFuncDecl
+    (ss : Block P C) (excludeScoped : Bool) (h : Block.noFuncDecl ss = true) :
+    Block.funcDeclNames ss excludeScoped = [] := by
+  match ss with
+  | [] => simp [Block.funcDeclNames]
+  | s :: rest =>
+    simp [Block.noFuncDecl, Bool.and_eq_true] at h
+    simp [Block.funcDeclNames]
+    refine ⟨?_, ?_⟩
+    · exact Stmt.funcDeclNames_eq_nil_of_noFuncDecl s excludeScoped h.1
+    · exact Block.funcDeclNames_eq_nil_of_noFuncDecl rest excludeScoped h.2
+
+end
+
+end -- public section
+
+end Imperative
diff --git a/Strata/DL/Imperative/StmtSemantics.lean b/Strata/DL/Imperative/StmtSemantics.lean
index 68a7dd2993..e2c547b1d6 100644
--- a/Strata/DL/Imperative/StmtSemantics.lean
+++ b/Strata/DL/Imperative/StmtSemantics.lean
@@ -35,6 +35,25 @@ structure Env (P : PureExpr) where
 /-- Type of a function that extends the semantic evaluator with a new function definition. -/
 @[expose] abbrev ExtendEval (P : PureExpr) := SemanticEval P → SemanticStore P → PureFunc P → SemanticEval P
 
+/-- An evaluator `e` is reachable from `e_parent` by a chain of `extendEval`
+    extensions.  Since `step_funcDecl` is the only rule that mutates
+    `Env.eval` (it tacks on `extendEval ρ.eval ρ.store decl`), the eval at
+    any reachable config is related to the eval at the source config by this
+    predicate.
+
+    This is the honest relation between a block's parent eval and the
+    block's inner `ρ.eval`: the inner eval extends the parent's, but is not
+    arbitrary. -/
+inductive EvalExtensionOf {P : PureExpr} (extendEval : ExtendEval P) :
+    SemanticEval P → SemanticEval P → Prop where
+  /-- Reflexivity: `e_parent` extends itself. -/
+  | refl {e : SemanticEval P} : EvalExtensionOf extendEval e e
+  /-- Step: if `e` extends `e_parent`, then `extendEval e σ decl` does too. -/
+  | step {e_parent e : SemanticEval P}
+         (σ : SemanticStore P) (decl : PureFunc P) :
+      EvalExtensionOf extendEval e_parent e →
+      EvalExtensionOf extendEval e_parent (extendEval e σ decl)
+
 /-! ## Small-Step Operational Semantics for Statements
 
 This module defines small-step operational semantics for the Imperative
@@ -69,11 +88,15 @@ inductive Config (P : PureExpr) (CmdT : Type) : Type where
       The label identifies which block to exit to. -/
   | exiting : String → Env P → Config P CmdT
   /-- A block context: execute the inner config, then consume matching exits.
-      The label is `Option String` — `none` denotes an unnamed block that only
-      catches unlabeled exits.  The `SemanticStore P` is the parent store at
-      block entry; on exit, the result is projected through it so that
-      variables initialized inside the block are not visible outside. -/
-  | block : Option String → SemanticStore P → Config P CmdT → Config P CmdT
+      - The block label is `Option String` — `none` denotes an unnamed block, and is only
+        used for scoping of variables; no explicit exit statement can reach this block.
+      - The `SemanticStore P` is the parent store at
+        block entry; on exit, the result is projected through it so that
+        variables initialized inside the block are not visible outside.
+      - The `SemanticEval P` is the parent evaluator at block entry; on exit,
+        the result evaluator is restored to it so that any internal function
+        declarations introduced inside the block are not visible outside. -/
+  | block : Option String → SemanticStore P → SemanticEval P → Config P CmdT → Config P CmdT
   /-- A sequence context: execute the first statement (as a sub-config), then
       continue with the remaining statements. -/
   | seq : Config P CmdT → List (Stmt P CmdT) → Config P CmdT
@@ -88,7 +111,7 @@ variable {P : PureExpr} {CmdT : Type}
   | .stmts _ ρ => ρ
   | .terminal ρ => ρ
   | .exiting _ ρ => ρ
-  | .block _ _ inner => inner.getEnv
+  | .block _ _ _ inner => inner.getEnv
   | .seq inner _ => inner.getEnv
 
 /-- Extract the store from a configuration. -/
@@ -132,32 +155,48 @@ where
   | .stmts ss _, label => Stmt.noMatchingAssert.Stmts.noMatchingAssert ss label
   | .terminal _, _ => True
   | .exiting _ _, _ => True
-  | .block _ _ inner, label => inner.noMatchingAssert label
+  | .block _ _ _ inner, label => inner.noMatchingAssert label
   | .seq inner ss, label =>
     inner.noMatchingAssert label ∧ Stmt.noMatchingAssert.Stmts.noMatchingAssert ss label
 
-/-- Config-level noFuncDecl predicate. -/
+/-- Config-level noFuncDecl predicate.
+
+    For `.block` we additionally require that the snapshotted parent eval
+    `e_parent` matches the inner config's current eval.  Together with
+    no-funcDecl-inside, this ensures that on `step_block_done` the eval
+    restoration is a no-op (it puts back the same eval that was already
+    there), so eval is preserved throughout. -/
 def Config.noFuncDecl : Config P CmdT → Prop
   | .stmt s _ => Stmt.noFuncDecl s = true
   | .stmts ss _ => Block.noFuncDecl ss = true
   | .terminal _ => True
   | .exiting _ _ => True
-  | .block _ _ inner => Config.noFuncDecl inner
+  | .block _ _ e_parent inner => Config.noFuncDecl inner ∧ e_parent = inner.getEnv.eval
   | .seq inner ss => Config.noFuncDecl inner ∧ Block.noFuncDecl ss = true
 
+/-- Config-level `funcDeclNames`: collects all `decl.name`s from `funcDecl`
+    AST nodes syntactically present anywhere in the config. -/
+@[expose] def Config.funcDeclNames : Config P CmdT → List P.Ident
+  | .stmt s _ => Stmt.funcDeclNames s false
+  | .stmts ss _ => Block.funcDeclNames ss false
+  | .terminal _ => []
+  | .exiting _ _ => []
+  | .block _ _ _ inner => Config.funcDeclNames inner
+  | .seq inner ss => Config.funcDeclNames inner ++ Block.funcDeclNames ss false
+
 /-- Extend `exitsCoveredByBlocks` to configurations.
 
     The label list has type `List String` (matching `Stmt.exit`'s mandatory-label
     AST).  An anonymous (`.none`) `Config.block` (introduced by the loop/if's body
-    wrapper) does NOT contribute a label — labeled exits cannot match `.none`,
+    wrapper) does not contribute a label — labeled exits cannot match `.none`,
     and unlabeled exits do not exist as user statements. -/
 @[expose] def Config.exitsCoveredByBlocks : List String → Config P CmdT → Prop
   | labels, .stmt s _ => s.exitsCoveredByBlocks labels
   | labels, .stmts ss _ => Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels ss
   | _, .terminal _ => True
   | labels, .exiting l _ => l ∈ labels
-  | labels, .block none _ inner => Config.exitsCoveredByBlocks labels inner
-  | labels, .block (some l) _ inner => Config.exitsCoveredByBlocks (l :: labels) inner
+  | labels, .block none _ _ inner => Config.exitsCoveredByBlocks labels inner
+  | labels, .block (some l) _ _ inner => Config.exitsCoveredByBlocks (l :: labels) inner
   | labels, .seq inner ss =>
     Config.exitsCoveredByBlocks labels inner ∧ Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks labels ss
 
@@ -171,7 +210,7 @@ def Config.noFuncDecl : Config P CmdT → Prop
 
 section
 
-variable {CmdT : Type} (P : PureExpr) [HasBool P] [HasNot P]
+variable {CmdT : Type} (P : PureExpr) [HasBool P] [HasBoolOps P] [HasFvars P] [HasInt P] [HasIntOps P]
 
 /--
 `StepStmt` defines a single execution step from one configuration to another.
@@ -198,44 +237,46 @@ inductive StepStmt
   /-- A labeled block steps to a block context that wraps its body as `.stmts`.
       The AST label `label : String` is lifted into `.some label` for the
       `Config.block` wrapper (whose label is `Option String`).
-      The parent store `ρ.store` is saved so that block-local variables
-      can be popped on exit. -/
+      The parent store `ρ.store` and parent eval `ρ.eval` are saved so that
+      block-local variables and function declarations can be popped on exit. -/
   | step_block :
     StepStmt EvalCmd extendEval
       (.stmt (.block label ss _) ρ)
-      (.block (.some label) ρ.store (.stmts ss ρ))
+      (.block (.some label) ρ.store ρ.eval (.stmts ss ρ))
 
   /-- If the condition of an `ite` statement evaluates to true, step to the
-      then branch. -/
+      then branch.  The branch is wrapped in a block so that variables
+      `init`'d inside are projected away on exit (matching `definedVars`
+      with `excludeScoped = true`). -/
   | step_ite_true :
     ρ.eval ρ.store c = .some HasBool.tt →
     WellFormedSemanticEvalBool ρ.eval →
     ----
     StepStmt EvalCmd extendEval
       (.stmt (.ite (.det c) tss ess _) ρ)
-      (.stmts tss ρ)
+      (.block .none ρ.store ρ.eval (.stmts tss ρ))
 
   /-- If the condition of an `ite` statement evaluates to false, step to the
-      else branch. -/
+      else branch (scoped via block wrapper). -/
   | step_ite_false :
     ρ.eval ρ.store c = .some HasBool.ff →
     WellFormedSemanticEvalBool ρ.eval →
     ----
     StepStmt EvalCmd extendEval
       (.stmt (.ite (.det c) tss ess _) ρ)
-      (.stmts ess ρ)
+      (.block .none ρ.store ρ.eval (.stmts ess ρ))
 
-  /-- Non-deterministic ite: step to the then branch. -/
+  /-- Non-deterministic ite: step to the then branch (scoped). -/
   | step_ite_nondet_true :
     StepStmt EvalCmd extendEval
       (.stmt (.ite .nondet tss ess _) ρ)
-      (.stmts tss ρ)
+      (.block .none ρ.store ρ.eval (.stmts tss ρ))
 
-  /-- Non-deterministic ite: step to the else branch. -/
+  /-- Non-deterministic ite: step to the else branch (scoped). -/
   | step_ite_nondet_false :
     StepStmt EvalCmd extendEval
       (.stmt (.ite .nondet tss ess _) ρ)
-      (.stmts ess ρ)
+      (.block .none ρ.store ρ.eval (.stmts ess ρ))
 
   /-- If a loop guard is true, execute the body (followed by the loop again).
       Each invariant expression must evaluate to a boolean (`tt` or `ff`);
@@ -261,7 +302,7 @@ inductive StepStmt
     StepStmt EvalCmd extendEval
       (.stmt (.loop (.det g) m inv body md) ρ)
       (.seq
-        (.block .none ρ.store (.stmts body
+        (.block .none ρ.store ρ.eval (.stmts body
           { ρ with hasFailure := ρ.hasFailure || hasInvFailure }))
         [.loop (.det g) m inv body md])
 
@@ -289,7 +330,7 @@ inductive StepStmt
     StepStmt EvalCmd extendEval
       (.stmt (.loop .nondet m inv body md) ρ)
       (.seq
-        (.block .none ρ.store (.stmts body
+        (.block .none ρ.store ρ.eval (.stmts body
           { ρ with hasFailure := ρ.hasFailure || hasInvFailure }))
         [.loop .nondet m inv body md])
 
@@ -309,7 +350,7 @@ inductive StepStmt
       (.exiting label ρ)
 
   /-- A function declaration extends the evaluator with the new function. -/
-  | step_funcDecl [HasSubstFvar P] [HasVarsPure P P.Expr] :
+  | step_funcDecl [HasSubstFvar P] :
     StepStmt EvalCmd extendEval
       (.stmt (.funcDecl decl md) ρ)
       (.terminal { ρ with eval := extendEval ρ.eval ρ.store decl })
@@ -361,37 +402,40 @@ inductive StepStmt
     StepStmt EvalCmd extendEval inner inner' →
     ----
     StepStmt EvalCmd extendEval
-      (.block label σ_parent inner)
-      (.block label σ_parent inner')
+      (.block label σ_parent e_parent inner)
+      (.block label σ_parent e_parent inner')
 
   /-- When a block's inner body reaches terminal, the block terminates.
       The resulting store is projected through the parent store: only variables
       that existed before the block keep their (possibly updated) values;
-      variables initialized inside the block are discarded. -/
+      variables initialized inside the block are discarded.  The evaluator is
+      restored to the parent's: function declarations introduced inside the
+      block are not visible outside. -/
   | step_block_done :
     StepStmt EvalCmd extendEval
-      (.block label σ_parent (.terminal ρ'))
-      (.terminal { ρ' with store := projectStore σ_parent ρ'.store })
+      (.block label σ_parent e_parent (.terminal ρ'))
+      (.terminal { ρ' with store := projectStore σ_parent ρ'.store, eval := e_parent })
 
   /-- When a block's inner body exits with a matching label, the block consumes it.
-      Store is projected. -/
+      Store and eval are projected/restored. -/
   | step_block_exit_match :
     label = .some l →
     ----
     StepStmt EvalCmd extendEval
-      (.block label σ_parent (.exiting l ρ'))
-      (.terminal { ρ' with store := projectStore σ_parent ρ'.store })
+      (.block label σ_parent e_parent (.exiting l ρ'))
+      (.terminal { ρ' with store := projectStore σ_parent ρ'.store, eval := e_parent })
 
   /-- When a block's inner body exits with a non-matching label, the exit propagates.
       Includes the case where the block's own label is `.none` (anonymous loop/ite
       wrapper, which never matches a labeled exit) as well as any other mismatched
-      `.some` label.  Store is projected since we're leaving this block. -/
+      `.some` label.  Store and eval are projected/restored since we're leaving
+      this block. -/
   | step_block_exit_mismatch :
     label ≠ .some l →
     ----
     StepStmt EvalCmd extendEval
-      (.block label σ_parent (.exiting l ρ'))
-      (.exiting l { ρ' with store := projectStore σ_parent ρ'.store })
+      (.block label σ_parent e_parent (.exiting l ρ'))
+      (.exiting l { ρ' with store := projectStore σ_parent ρ'.store, eval := e_parent })
 
 end
 
@@ -402,7 +446,7 @@ section
 variable
   {CmdT : Type}
   (P : PureExpr)
-  [HasBool P] [HasNot P]
+  [HasBool P] [HasBoolOps P] [HasFvars P] [HasOps P] [HasInt P] [HasIntOps P]
   (EvalCmd : EvalCmdParam P CmdT)
   (extendEval : ExtendEval P)
 
@@ -426,702 +470,16 @@ abbrev EvalStmtsSmall
 
 ---------------------------------------------------------------------
 
-/-! ## Basic Properties and Theorems -/
-
-/-- Empty statement list evaluation. -/
-theorem evalStmtsSmallNil
-    (ρ : Env P) :
-    EvalStmtsSmall P EvalCmd extendEval ρ [] ρ := by
-  unfold EvalStmtsSmall
-  exact .step _ _ _ StepStmt.step_stmts_nil (.refl _)
-
 /-- Configuration is terminal if no further steps are possible. -/
 def IsTerminal
     (c : Config P CmdT) : Prop :=
   ∀ c', ¬ StepStmt P EvalCmd extendEval c c'
 
-/-- Terminal configurations are indeed terminal. -/
-theorem terminalIsTerminal
-    (ρ : Env P) :
-    IsTerminal P EvalCmd extendEval (.terminal ρ) := by
-  unfold IsTerminal
-  intro c' h
-  cases h
-
-/-!
-### Stepping through a statement list
-
-When executing `.stmts (s :: ss) ρ`, the semantics first enters a
-`.seq` context (via `step_stmts_cons`), executes `s` to terminal, then
-resumes with `.stmts ss ρ'`.
-
-The proof proceeds in two parts:
-1. A helper lemma (`seq_inner_star`) showing that multi-step execution of
-   the inner config lifts to multi-step execution of the enclosing `.seq`.
-2. The main theorem (`stmts_cons_step`) composing the pieces.
--/
-
-/-- Helper: if the inner config of a `.seq` takes multiple steps, the
-    enclosing `.seq` takes the same number of steps.
-    Proved by induction on the multi-step derivation. -/
-theorem seq_inner_star
-    (inner inner' : Config P CmdT)
-    (ss : List (Stmt P CmdT))
-    (h : StepStmtStar P EvalCmd extendEval inner inner') :
-    StepStmtStar P EvalCmd extendEval
-      (.seq inner ss)
-      (.seq inner' ss) := by
-  induction h with
-  | refl => exact .refl _
-  | step _ mid _ hstep _ ih =>
-    exact .step _ _ _ (.step_seq_inner hstep) ih
-
-/-- Helper: if the inner config of a `.block` takes multiple steps, the
-    enclosing `.block` takes the same number of steps. -/
-theorem block_inner_star
-    (inner inner' : Config P CmdT)
-    (label : Option String)
-    (σ_parent : SemanticStore P)
-    (h : StepStmtStar P EvalCmd extendEval inner inner') :
-    StepStmtStar P EvalCmd extendEval (.block label σ_parent inner) (.block label σ_parent inner') := by
-  induction h with
-  | refl => exact .refl _
-  | step _ mid _ hstep _ ih => exact .step _ _ _ (.step_block_body hstep) ih
-
-/-- When executing `.stmts (s :: ss) ρ`, if the head statement `s`
-    multi-steps to `.terminal ρ'`, then the whole list multi-steps to
-    `.stmts ss ρ'`.
-
-    This captures the fundamental sequencing behaviour of statement lists
-    in the small-step semantics. -/
-theorem stmts_cons_step
-    (s : Stmt P CmdT) (ss : List (Stmt P CmdT))
-    (ρ ρ' : Env P)
-    (hstmt : StepStmtStar P EvalCmd extendEval
-      (.stmt s ρ) (.terminal ρ')) :
-    StepStmtStar P EvalCmd extendEval
-      (.stmts (s :: ss) ρ)
-      (.stmts ss ρ') := by
-  -- Step 1: .stmts (s :: ss) ρ  →  .seq (.stmt s ρ) ss
-  --         via step_stmts_cons
-  apply ReflTrans.step _ (.seq (.stmt s ρ) ss)
-  · exact .step_stmts_cons
-  -- Step 2: .seq (.stmt s ρ) ss  →*  .seq (.terminal ρ') ss
-  --         by lifting hstmt through the seq context
-  have h2 := seq_inner_star P EvalCmd extendEval _ _ ss hstmt
-  -- Step 3: .seq (.terminal ρ') ss  →  .stmts ss ρ'
-  --         via step_seq_done, then chain with h2 by induction
-  suffices h3 : StepStmtStar P EvalCmd extendEval
-      (.seq (.terminal ρ') ss) (.stmts ss ρ') from
-    ReflTrans_Transitive _ _ _ _ h2 h3
-  exact .step _ _ _ .step_seq_done (.refl _)
-
-/-! ## Inversion lemmas for seq and block execution -/
-
-/-- Invert a seq execution reaching terminal: the inner terminates,
-    then the tail stmts run to terminal. -/
-theorem seq_reaches_terminal
-    {inner : Config P CmdT} {ss : List (Stmt P CmdT)} {ρ' : Env P}
-    (hstar : StepStmtStar P EvalCmd extendEval (.seq inner ss) (.terminal ρ')) :
-    ∃ ρ₁, StepStmtStar P EvalCmd extendEval inner (.terminal ρ₁) ∧
-      StepStmtStar P EvalCmd extendEval (.stmts ss ρ₁) (.terminal ρ') := by
-  suffices ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt →
-      ∀ inner ss ρ', src = .seq inner ss → tgt = .terminal ρ' →
-      ∃ ρ₁, StepStmtStar P EvalCmd extendEval inner (.terminal ρ₁) ∧
-        StepStmtStar P EvalCmd extendEval (.stmts ss ρ₁) (.terminal ρ') from
-    this _ _ hstar _ _ _ rfl rfl
-  intro src tgt hstar_g
-  induction hstar_g with
-  | refl => intro _ _ _ hsrc htgt; subst hsrc; cases htgt
-  | step _ mid _ hstep hrest ih =>
-    intro inner ss ρ' hsrc htgt; subst hsrc
-    cases hstep with
-    | step_seq_inner h =>
-      have ⟨ρ₁, hterm, htail⟩ := ih _ _ _ rfl htgt
-      exact ⟨ρ₁, .step _ _ _ h hterm, htail⟩
-    | step_seq_done => subst htgt; exact ⟨_, .refl _, hrest⟩
-    | step_seq_exit => subst htgt; cases hrest with | step _ _ _ h _ => cases h
-
-/-- Invert a seq execution reaching exiting: either the inner exited
-    (propagated), or the inner terminated and the tail exited. -/
-theorem seq_reaches_exiting
-    {inner : Config P CmdT} {ss : List (Stmt P CmdT)} {lbl : String} {ρ' : Env P}
-    (hstar : StepStmtStar P EvalCmd extendEval (.seq inner ss) (.exiting lbl ρ')) :
-    (StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ')) ∨
-    (∃ ρ₁, StepStmtStar P EvalCmd extendEval inner (.terminal ρ₁) ∧
-      StepStmtStar P EvalCmd extendEval (.stmts ss ρ₁) (.exiting lbl ρ')) := by
-  suffices ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt →
-      ∀ inner ss lbl ρ', src = .seq inner ss → tgt = .exiting lbl ρ' →
-      (StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ')) ∨
-      (∃ ρ₁, StepStmtStar P EvalCmd extendEval inner (.terminal ρ₁) ∧
-        StepStmtStar P EvalCmd extendEval (.stmts ss ρ₁) (.exiting lbl ρ')) from
-    this _ _ hstar _ _ _ _ rfl rfl
-  intro src tgt hstar_g
-  induction hstar_g with
-  | refl => intro _ _ _ _ hsrc htgt; subst hsrc; cases htgt
-  | step _ mid _ hstep hrest ih =>
-    intro inner ss lbl ρ' hsrc htgt; subst hsrc
-    cases hstep with
-    | step_seq_inner h =>
-      match ih _ _ _ _ rfl htgt with
-      | .inl hexit => exact .inl (.step _ _ _ h hexit)
-      | .inr ⟨ρ₁, hterm, htail⟩ => exact .inr ⟨ρ₁, .step _ _ _ h hterm, htail⟩
-    | step_seq_done => subst htgt; exact .inr ⟨_, .refl _, hrest⟩
-    | step_seq_exit => exact .inl (htgt ▸ hrest)
-
-/-- Invert a block execution reaching terminal: the inner either
-    terminated or exited (caught by the block).  In both cases the inner
-    reaches a config whose env projects to `ρ'` via the parent store. -/
-theorem block_reaches_terminal
-    {inner : Config P CmdT} {l : Option String} {σ_parent : SemanticStore P} {ρ' : Env P}
-    (hstar : StepStmtStar P EvalCmd extendEval (.block l σ_parent inner) (.terminal ρ')) :
-    (∃ ρ_inner, StepStmtStar P EvalCmd extendEval inner (.terminal ρ_inner) ∧
-      ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store }) ∨
-    (∃ lbl ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ_inner) ∧
-      ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store }) := by
-  suffices ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt →
-      ∀ inner ρ', src = .block l σ_parent inner → tgt = .terminal ρ' →
-      (∃ ρ_inner, StepStmtStar P EvalCmd extendEval inner (.terminal ρ_inner) ∧
-        ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store }) ∨
-      (∃ lbl ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ_inner) ∧
-        ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store }) from
-    this _ _ hstar _ _ rfl rfl
-  intro src tgt hstar_g
-  induction hstar_g with
-  | refl => intro _ _ hsrc htgt; subst hsrc; cases htgt
-  | step _ mid _ hstep hrest ih =>
-    intro inner ρ' hsrc htgt; subst hsrc
-    cases hstep with
-    | step_block_body h =>
-      match ih _ _ rfl htgt with
-      | .inl ⟨ρ_inner, hterm, heq⟩ => exact .inl ⟨ρ_inner, .step _ _ _ h hterm, heq⟩
-      | .inr ⟨lbl, ρ_inner, hexit, heq⟩ => exact .inr ⟨lbl, ρ_inner, .step _ _ _ h hexit, heq⟩
-    | step_block_done =>
-      subst htgt; cases hrest with
-      | refl => exact .inl ⟨_, .refl _, rfl⟩
-      | step _ _ _ h _ => cases h
-    | step_block_exit_match =>
-      subst htgt; cases hrest with
-      | refl => exact .inr ⟨_, _, .refl _, rfl⟩
-      | step _ _ _ h _ => cases h
-    | step_block_exit_mismatch =>
-      subst htgt; cases hrest with | step _ _ _ h _ => cases h
-
-/-- Invert a block execution reaching exiting: the inner must have
-    exited with a label that didn't match the block.  The env is projected. -/
-theorem block_reaches_exiting
-    {inner : Config P CmdT} {l : Option String} {σ_parent : SemanticStore P} {lbl : String} {ρ' : Env P}
-    (hstar : StepStmtStar P EvalCmd extendEval (.block l σ_parent inner) (.exiting lbl ρ')) :
-    ∃ lbl_inner ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl_inner ρ_inner) ∧
-      ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store } := by
-  suffices ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt →
-      ∀ inner lbl ρ', src = .block l σ_parent inner → tgt = .exiting lbl ρ' →
-      ∃ lbl_inner ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl_inner ρ_inner) ∧
-        ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store } from
-    this _ _ hstar _ _ _ rfl rfl
-  intro src tgt hstar_g
-  induction hstar_g with
-  | refl => intro _ _ _ hsrc htgt; subst hsrc; cases htgt
-  | step _ mid _ hstep hrest ih =>
-    intro inner lbl ρ' hsrc htgt; subst hsrc
-    cases hstep with
-    | step_block_body h =>
-      have ⟨lbl_inner, ρ_inner, hexit, heq⟩ := ih _ _ _ rfl htgt
-      exact ⟨lbl_inner, ρ_inner, .step _ _ _ h hexit, heq⟩
-    | step_block_exit_mismatch =>
-      subst htgt; cases hrest with
-      | refl => exact ⟨_, _, .refl _, rfl⟩
-      | step _ _ _ h _ => cases h
-    | step_block_done | step_block_exit_match =>
-      subst htgt; cases hrest with | step _ _ _ h _ => cases h
-
-/-! ## Trace construction helpers -/
-
-/-- Entering a block: a single step from `.stmt (.block l body md) ρ`
-    to `.block (.some l) (.stmts body ρ)`. -/
-theorem step_block_enter (l : String) (body : List (Stmt P CmdT))
-    (md : MetaData P) (ρ : Env P) :
-    StepStmtStar P EvalCmd extendEval
-      (.stmt (.block l body md) ρ) (.block (.some l) ρ.store (.stmts body ρ)) :=
-  .step _ _ _ .step_block (.refl _)
-
-/-- If a prefix of a statement list terminates, the full list steps
-    to the suffix starting from the terminal environment. -/
-theorem stmts_prefix_terminal_append
-    (pfx sfx : List (Stmt P CmdT)) (ρ ρ' : Env P)
-    (h : StepStmtStar P EvalCmd extendEval (.stmts pfx ρ) (.terminal ρ')) :
-    StepStmtStar P EvalCmd extendEval (.stmts (pfx ++ sfx) ρ) (.stmts sfx ρ') := by
-  induction pfx generalizing ρ with
-  | nil =>
-    cases h with
-    | step _ _ _ h_step h_rest => cases h_step with
-      | step_stmts_nil => cases h_rest with
-        | refl => exact .refl _
-        | step _ _ _ h _ => exact nomatch h
-  | cons s rest ih =>
-    cases h with
-    | step _ _ _ h_step h_rest => cases h_step with
-      | step_stmts_cons =>
-        have ⟨ρ₁, h_s, h_r⟩ := seq_reaches_terminal P EvalCmd extendEval h_rest
-        exact ReflTrans_Transitive _ _ _ _
-          (stmts_cons_step P EvalCmd extendEval s (rest ++ sfx) ρ ρ₁ h_s) (ih ρ₁ h_r)
-
-/-- Decompose a terminating execution of `ss₁ ++ ss₂` into a terminating
-    execution of `ss₁` followed by a terminating execution of `ss₂`. -/
-theorem stmts_append_terminates
-    (ss₁ ss₂ : List (Stmt P CmdT)) (ρ ρ' : Env P)
-    (h : StepStmtStar P EvalCmd extendEval (.stmts (ss₁ ++ ss₂) ρ) (.terminal ρ')) :
-    ∃ ρ₁, StepStmtStar P EvalCmd extendEval (.stmts ss₁ ρ) (.terminal ρ₁) ∧
-           StepStmtStar P EvalCmd extendEval (.stmts ss₂ ρ₁) (.terminal ρ') := by
-  induction ss₁ generalizing ρ with
-  | nil =>
-    exact ⟨ρ, .step _ _ _ .step_stmts_nil (.refl _), h⟩
-  | cons s rest ih =>
-    cases h with
-    | step _ _ _ hstep hrest => cases hstep with
-      | step_stmts_cons =>
-        have ⟨ρ_mid, h_s, h_rest_ss₂⟩ :=
-          seq_reaches_terminal P EvalCmd extendEval hrest
-        have ⟨ρ₁, h_rest, h_ss₂⟩ := ih ρ_mid h_rest_ss₂
-        exact ⟨ρ₁, ReflTrans_Transitive _ _ _ _
-          (stmts_cons_step P EvalCmd extendEval
-            s rest ρ ρ_mid h_s) h_rest, h_ss₂⟩
-
-/-- Try every non-recursive `StepStmt` constructor, using `‹_›` (term-level
-    assumption) to fill arguments so that no hypothesis names are needed. -/
-local macro "apply_step" : tactic => `(tactic| first
-  | exact .step_cmd ‹_›        | exact .step_ite_true ‹_› ‹_›
-  | exact .step_ite_false ‹_› ‹_›
-  | exact .step_loop_enter ‹_› ‹_› ‹_› ‹_›
-  | exact .step_loop_exit ‹_› ‹_› ‹_› ‹_›
-  | exact .step_block
-  | exact .step_exit            | exact .step_funcDecl
-  | exact .step_typeDecl        | exact .step_stmts_nil
-  | exact .step_stmts_cons)
-
-/-! ## Store/eval simulation and hasFailure irrelevance -/
-
-/-- Two configs agree on store/eval (may differ on hasFailure). -/
-private def ConfigSE : Config P CmdT → Config P CmdT → Prop
-  | .stmt s₁ ρ₁, .stmt s₂ ρ₂ => s₁ = s₂ ∧ ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval
-  | .stmts ss₁ ρ₁, .stmts ss₂ ρ₂ => ss₁ = ss₂ ∧ ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval
-  | .terminal ρ₁, .terminal ρ₂ => ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval
-  | .exiting l₁ ρ₁, .exiting l₂ ρ₂ => l₁ = l₂ ∧ ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval
-  | .block l₁ σ₁ i₁, .block l₂ σ₂ i₂ => l₁ = l₂ ∧ σ₁ = σ₂ ∧ ConfigSE i₁ i₂
-  | .seq i₁ ss₁, .seq i₂ ss₂ => ss₁ = ss₂ ∧ ConfigSE i₁ i₂
-  | _, _ => False
-
-/-- Single-step simulation: if two configs agree on store/eval and one steps,
-    the other can take the same step with store/eval preserved. -/
-private def step_simulation
-    (c₁ c₁' c₂ : Config P CmdT)
-    (hstep : StepStmt P EvalCmd extendEval c₁ c₁')
-    (heq : ConfigSE P c₁ c₂) :
-    ∃ c₂', StepStmt P EvalCmd extendEval c₂ c₂' ∧ ConfigSE P c₁' c₂' := by
-  cases hstep with
-  -- Non-recursive cases where c₁ is `.stmt` or `.stmts`: exactly one c₂
-  -- constructor is valid, and the output ConfigSE follows by `simp_all`.
-  | step_cmd _ | step_block | step_ite_true _ _ | step_ite_false _ _
-  | step_loop_enter _ _ _ _ | step_loop_exit _ _ _ _
-  | step_exit | step_funcDecl | step_typeDecl | step_stmts_nil | step_stmts_cons =>
-    cases c₂ <;> try contradiction
-    obtain ⟨rfl, hs, he⟩ := heq; rename_i ρ₂; cases ρ₂; subst hs; subst he
-    exact ⟨_, by apply_step, by simp_all [ConfigSE]⟩
-  | step_ite_nondet_true =>
-    cases c₂ <;> try contradiction
-    obtain ⟨rfl, hs, he⟩ := heq; rename_i ρ₂; cases ρ₂; simp at hs he; subst hs; subst he
-    exact ⟨_, .step_ite_nondet_true, by simp [ConfigSE]⟩
-  | step_ite_nondet_false =>
-    cases c₂ <;> try contradiction
-    obtain ⟨rfl, hs, he⟩ := heq; rename_i ρ₂; cases ρ₂; simp at hs he; subst hs; subst he
-    exact ⟨_, .step_ite_nondet_false, by simp [ConfigSE]⟩
-  | step_loop_nondet_enter _ _ =>
-    cases c₂ <;> try contradiction
-    obtain ⟨rfl, hs, he⟩ := heq; rename_i ρ₂; cases ρ₂; simp at hs he; subst hs; subst he
-    exact ⟨_, .step_loop_nondet_enter ‹_› ‹_›, by simp_all [ConfigSE]⟩
-  | step_loop_nondet_exit _ _ =>
-    cases c₂ <;> try contradiction
-    obtain ⟨rfl, hs, he⟩ := heq; rename_i ρ₂; cases ρ₂; simp at hs he; subst hs; subst he
-    exact ⟨_, .step_loop_nondet_exit ‹_› ‹_›, by simp_all [ConfigSE]⟩
-  | step_seq_inner h =>
-    cases c₂ with
-    | seq i₂ _ =>
-      have hrs := heq.1; subst hrs
-      have ⟨c₂', h₂, heq₂⟩ := step_simulation _ _ _ h heq.2
-      exact ⟨_, .step_seq_inner h₂, ⟨rfl, heq₂⟩⟩
-    | _ => exact nomatch heq
-  | step_seq_done =>
-    cases c₂ with
-    | seq i₂ _ =>
-      have hrs := heq.1; subst hrs
-      cases i₂ with
-      | terminal ρ₂ => exact ⟨_, .step_seq_done, ⟨rfl, heq.2.1, heq.2.2⟩⟩
-      | _ => exact nomatch heq.2
-    | _ => exact nomatch heq
-  | step_seq_exit =>
-    cases c₂ with
-    | seq i₂ _ =>
-      cases i₂ with
-      | exiting _ _ => exact ⟨_, .step_seq_exit, ⟨heq.2.1, heq.2.2.1, heq.2.2.2⟩⟩
-      | _ => exact nomatch heq.2
-    | _ => exact nomatch heq
-  | step_block_body h =>
-    cases c₂ with
-    | block _ _ i₂ =>
-      have hrs := heq.1; subst hrs
-      have hσ := heq.2.1; subst hσ
-      have ⟨c₂', h₂, heq₂⟩ := step_simulation _ _ _ h heq.2.2
-      exact ⟨_, .step_block_body h₂, ⟨rfl, rfl, heq₂⟩⟩
-    | _ => exact nomatch heq
-  | step_block_done =>
-    cases c₂ with
-    | block _ _ i₂ =>
-      have hrs := heq.1; subst hrs
-      have hσ := heq.2.1; subst hσ
-      cases i₂ with
-      | terminal ρ₂ =>
-        have hse := heq.2.2
-        exact ⟨_, .step_block_done, ⟨congrArg (projectStore _) hse.1, hse.2⟩⟩
-      | _ => exact nomatch heq.2.2
-    | _ => exact nomatch heq
-  | step_block_exit_match hl =>
-    cases c₂ with
-    | block _ _ i₂ =>
-      have hlb := heq.1; subst hlb
-      have hσ := heq.2.1; subst hσ
-      cases i₂ with
-      | exiting l₂ ρ₂ =>
-        have hl₂ := heq.2.2.1; subst hl₂
-        have hse := heq.2.2.2
-        exact ⟨_, .step_block_exit_match hl, ⟨congrArg (projectStore _) hse.1, hse.2⟩⟩
-      | _ => exact nomatch heq.2.2
-    | _ => exact nomatch heq
-  | step_block_exit_mismatch hl =>
-    cases c₂ with
-    | block _ _ i₂ =>
-      have hlb := heq.1; subst hlb
-      have hσ := heq.2.1; subst hσ
-      cases i₂ with
-      | exiting l₂ ρ₂ =>
-        have hl₂ := heq.2.2.1; subst hl₂
-        have hse := heq.2.2.2
-        exact ⟨_, .step_block_exit_mismatch hl, ⟨rfl, congrArg (projectStore _) hse.1, hse.2⟩⟩
-      | _ => exact nomatch heq.2.2
-    | _ => exact nomatch heq
-
-/-- The terminal state's store and eval are independent of the starting
-    `hasFailure` flag.  Proved by simulation: each step preserves
-    store/eval equivalence, so the terminal states agree. -/
-theorem smallStep_hasFailure_irrel
-    (s : Stmt P CmdT) (ρ ρ' : Env P)
-    (h : StepStmtStar P EvalCmd extendEval (.stmt s ρ) (.terminal ρ')) :
-    ∀ (ρ₂ : Env P), ρ₂.store = ρ.store → ρ₂.eval = ρ.eval →
-    ∃ ρ₂', StepStmtStar P EvalCmd extendEval (.stmt s ρ₂) (.terminal ρ₂') ∧
-      ρ₂'.store = ρ'.store ∧ ρ₂'.eval = ρ'.eval := by
-  intro ρ₂ hs he
-  suffices ∀ (c₁ c₂ : Config P CmdT),
-      ConfigSE P c₁ c₂ →
-      ∀ c₁', StepStmtStar P EvalCmd extendEval c₁ c₁' →
-      ∃ c₂', StepStmtStar P EvalCmd extendEval c₂ c₂' ∧ ConfigSE P c₁' c₂' by
-    have heq_init : ConfigSE P (.stmt s ρ) (.stmt s ρ₂) := ⟨rfl, hs.symm, he.symm⟩
-    have ⟨c₂', hstar₂, heq₂⟩ := this _ _ heq_init _ h
-    match c₂', heq₂ with
-    | .terminal ρ₂', heq_t => exact ⟨ρ₂', hstar₂, heq_t.1.symm, heq_t.2.symm⟩
-  intro c₁ c₂ heq c₁' hstar
-  induction hstar generalizing c₂ with
-  | refl => exact ⟨c₂, .refl _, heq⟩
-  | step _ mid _ hstep _ ih =>
-    have ⟨mid₂, hstep₂, heq_mid⟩ := step_simulation P EvalCmd extendEval _ _ _ hstep heq
-    have ⟨c₂', hstar₂, heq_final⟩ := ih _ heq_mid
-    exact ⟨c₂', .step _ _ _ hstep₂ hstar₂, heq_final⟩
-
-/-! ## Well-paired exits: preservation and no-escape -/
-
-omit [HasBool P] [HasNot P] in
-/-- Helper: when the inner of a block reaches `.exiting l` and the
-    block's label (if some) doesn't match `l`, then `l` must be in the outer
-    labels list.  The conclusion is `l ∈ labels`, which is exactly the
-    `Config.exitsCoveredByBlocks` of `.exiting l ρ''` for any ρ''. -/
-private theorem block_exit_mismatch_unfold {labels : List String}
-    {label : Option String} {σ_parent : SemanticStore P} {l : String} {ρ' ρ'' : Env P}
-    (h : Config.exitsCoveredByBlocks labels
-          (.block label σ_parent (.exiting l ρ' : Config P CmdT)))
-    (hne : label ≠ .some l) :
-    Config.exitsCoveredByBlocks labels (.exiting l ρ'' : Config P CmdT) := by
-  show l ∈ labels
-  cases label with
-  | none => exact h
-  | some lb =>
-    have h' : l ∈ lb :: labels := h
-    rw [List.mem_cons] at h'
-    rcases h' with hh | hh
-    · exact absurd (by rw [hh]) hne
-    · exact hh
-
-/-- A single step preserves `Config.exitsCoveredByBlocks`. -/
-private theorem step_preserves_exitsCoveredByBlocks
-    (labels : List String)
-    (c₁ c₂ : Config P CmdT)
-    (hstep : StepStmt P EvalCmd extendEval c₁ c₂)
-    (hwp : c₁.exitsCoveredByBlocks labels) :
-    c₂.exitsCoveredByBlocks labels := by
-  -- Prove a generalized version where labels is universally quantified,
-  -- so the IH works at any nesting depth (needed for step_block_body).
-  suffices ∀ c₁ c₂, StepStmt P EvalCmd extendEval c₁ c₂ →
-      ∀ labels, c₁.exitsCoveredByBlocks labels → c₂.exitsCoveredByBlocks labels by
-    exact this c₁ c₂ hstep labels hwp
-  intro c₁ c₂ hstep
-  induction hstep with
-  | step_cmd => intro _ _; trivial
-  | step_block => intro _ hwp; exact hwp
-  | step_ite_true => intro _ hwp; exact hwp.1
-  | step_ite_false => intro _ hwp; exact hwp.2
-  | step_ite_nondet_true => intro _ hwp; exact hwp.1
-  | step_ite_nondet_false => intro _ hwp; exact hwp.2
-  | step_loop_enter _ _ =>
-    intro labels hwp
-    -- Goal: .seq (.block .none ρ.store (.stmts body ρ')) [.loop ...] covers labels.
-    -- The .block .none label doesn't extend the labels list (Config.exitsCoveredByBlocks's
-    -- .block none case just descends).
-    simp only [Config.exitsCoveredByBlocks, Stmt.exitsCoveredByBlocks] at hwp ⊢
-    exact ⟨hwp, hwp, True.intro⟩
-  | step_loop_exit => intro _ _; trivial
-  | step_loop_nondet_enter =>
-    intro labels hwp
-    simp only [Config.exitsCoveredByBlocks, Stmt.exitsCoveredByBlocks] at hwp ⊢
-    exact ⟨hwp, hwp, True.intro⟩
-  | step_loop_nondet_exit => intro _ _; trivial
-  | step_exit =>
-    intro labels hwp
-    -- hwp : l ∈ labels (from .stmt (.exit l)), goal: .exiting (.some l) covers labels = l ∈ labels
-    exact hwp
-  | step_funcDecl => intro _ _; trivial
-  | step_typeDecl => intro _ _; trivial
-  | step_stmts_nil => intro _ _; trivial
-  | step_stmts_cons => intro _ hwp; exact ⟨hwp.1, hwp.2⟩
-  | step_seq_inner _ ih => intro labels hwp; exact ⟨ih labels hwp.1, hwp.2⟩
-  | step_seq_done => intro _ hwp; exact hwp.2
-  | step_seq_exit => intro _ hwp; exact hwp.1
-  | step_block_body _ ih =>
-    intro labels hwp
-    rename_i inner inner' label σ_parent _
-    cases label with
-    | none => exact ih labels hwp
-    | some l => exact ih (l :: labels) hwp
-  | step_block_done => intro _ _; trivial
-  | step_block_exit_match => intro _ _; trivial
-  | step_block_exit_mismatch hne =>
-    intro labels hwp
-    exact block_exit_mismatch_unfold (P := P) (CmdT := CmdT) hwp hne
-
-/-- Well-paired statements cannot escape via `.exiting`:
-    if all exits in `s` are caught by enclosing blocks
-    (`s.exitsCoveredByBlocks []`), then `s` never reaches `.exiting`. -/
-theorem exitsCoveredByBlocks_noEscape
-    (s : Stmt P CmdT)
-    (hwp : s.exitsCoveredByBlocks []) :
-    ∀ (ρ : Env P) (lbl : String) (ρ' : Env P),
-      ¬ StepStmtStar P EvalCmd extendEval (.stmt s ρ) (.exiting lbl ρ') := by
-  intro ρ lbl ρ' hstar
-  -- Prove Config.exitsCoveredByBlocks [] is preserved, then show .exiting contradicts it.
-  suffices ∀ c₁ c₂,
-      c₁.exitsCoveredByBlocks ([] : List String) →
-      StepStmtStar P EvalCmd extendEval c₁ c₂ →
-      c₂.exitsCoveredByBlocks ([] : List String) by
-    have hwp' := this _ _ (show Config.exitsCoveredByBlocks [] (.stmt s ρ) from hwp) hstar
-    -- Config.exitsCoveredByBlocks [] (.exiting lbl ρ') requires lbl ∈ [] (False).
-    exact absurd hwp' (by simp [Config.exitsCoveredByBlocks])
-  intro c₁ c₂ hwp_c hstar_c
-  induction hstar_c with
-  | refl => exact hwp_c
-  | step _ _ _ hstep _ ih =>
-    exact ih (step_preserves_exitsCoveredByBlocks P EvalCmd extendEval [] _ _ hstep hwp_c)
-
-/-- Well-paired statement lists cannot escape via `.exiting`:
-    if all exits in `bss` are caught by enclosing blocks
-    (`Block.exitsCoveredByBlocks [] bss`), then `.stmts bss ρ` never reaches `.exiting`. -/
-theorem block_exitsCoveredByBlocks_noEscape
-    (bss : List (Stmt P CmdT))
-    (hwp : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks [] bss) :
-    ∀ (ρ : Env P) (lbl : String) (ρ' : Env P),
-      ¬ StepStmtStar P EvalCmd extendEval (.stmts bss ρ) (.exiting lbl ρ') := by
-  intro ρ lbl ρ' hstar
-  suffices ∀ c₁ c₂,
-      c₁.exitsCoveredByBlocks ([] : List String) →
-      StepStmtStar P EvalCmd extendEval c₁ c₂ →
-      c₂.exitsCoveredByBlocks ([] : List String) by
-    have hwp' := this _ _ (show Config.exitsCoveredByBlocks [] (.stmts bss ρ) from hwp) hstar
-    exact absurd hwp' (by simp [Config.exitsCoveredByBlocks])
-  intro c₁ c₂ hwp_c hstar_c
-  induction hstar_c with
-  | refl => exact hwp_c
-  | step _ _ _ hstep _ ih =>
-    exact ih (step_preserves_exitsCoveredByBlocks P EvalCmd extendEval [] _ _ hstep hwp_c)
-
-/-- If `.block l inner →* cfg`, the inner config never reaches `.exiting`,
-    and `cfg` is neither terminal nor exiting, then `cfg = .block l inner'`
-    for some `inner'` with `inner →* inner'`. -/
-theorem block_star_extract_inner
-    {l : Option String} {σ_parent : SemanticStore P} {inner cfg : Config P CmdT}
-    (h_star : StepStmtStar P EvalCmd extendEval (.block l σ_parent inner) cfg)
-    (h_no_exit : ∀ lbl ρ', ¬ StepStmtStar P EvalCmd extendEval
-        inner (.exiting lbl ρ'))
-    (h_not_terminal : ∀ ρ', cfg ≠ .terminal ρ')
-    (h_not_exiting : ∀ lbl ρ', cfg ≠ .exiting lbl ρ') :
-    ∃ inner', cfg = .block l σ_parent inner' ∧
-      StepStmtStar P EvalCmd extendEval inner inner' := by
-  suffices ∀ c₁ c₂,
-      StepStmtStar P EvalCmd extendEval c₁ c₂ →
-      ∀ inner₀, c₁ = .block l σ_parent inner₀ →
-      (∀ lbl ρ', ¬ StepStmtStar P EvalCmd extendEval inner₀ (.exiting lbl ρ')) →
-      (∀ ρ', c₂ ≠ .terminal ρ') → (∀ lbl ρ', c₂ ≠ .exiting lbl ρ') →
-      ∃ inner', c₂ = .block l σ_parent inner' ∧
-        StepStmtStar P EvalCmd extendEval inner₀ inner' from
-    this _ _ h_star _ rfl h_no_exit h_not_terminal h_not_exiting
-  intro c₁ c₂ h_star
-  induction h_star with
-  | refl => intro inner₀ heq _ _ _; subst heq; exact ⟨inner₀, rfl, .refl _⟩
-  | step _ mid _ hstep hrest ih =>
-    intro inner₀ heq h_ne h_nt h_nx; subst heq
-    cases hstep with
-    | step_block_body h_inner_step =>
-      have h_ne' : ∀ lbl ρ', ¬ StepStmtStar P EvalCmd extendEval _ (.exiting lbl ρ') :=
-        fun lbl ρ' h => h_ne lbl ρ' (.step _ _ _ h_inner_step h)
-      obtain ⟨inner', rfl, h_inner_star⟩ := ih _ rfl h_ne' h_nt h_nx
-      exact ⟨inner', rfl, .step _ _ _ h_inner_step h_inner_star⟩
-    | step_block_done =>
-      cases hrest with
-      | refl => exact absurd rfl (h_nt _)
-      | step _ _ _ h _ => exact nomatch h
-    | step_block_exit_match => exact absurd (.refl _) (h_ne _ _)
-    | step_block_exit_mismatch => exact absurd (.refl _) (h_ne _ _)
-
-/-! ## noFuncDecl preserves eval (small-step) -/
-
-/-- A single step preserves eval when noFuncDecl holds.
-    The only step that changes eval is step_funcDecl, which is excluded. -/
-private theorem step_preserves_eval_noFuncDecl
-    (c₁ c₂ : Config P CmdT)
-    (hstep : StepStmt P EvalCmd extendEval c₁ c₂)
-    (hnofd : Config.noFuncDecl c₁) :
-    c₂.getEnv.eval = c₁.getEnv.eval ∧ Config.noFuncDecl c₂ := by
-  suffices ∀ c₁ c₂, StepStmt P EvalCmd extendEval c₁ c₂ →
-      ∀ (_ : Config.noFuncDecl c₁),
-      c₂.getEnv.eval = c₁.getEnv.eval ∧ Config.noFuncDecl c₂ by
-    exact this c₁ c₂ hstep hnofd
-  intro c₁ c₂ hstep
-  induction hstep with
-  | step_cmd => intro _; exact ⟨rfl, trivial⟩
-  | step_block =>
-    intro hnofd
-    simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢
-    exact ⟨rfl, hnofd⟩
-  | step_ite_true =>
-    intro hnofd
-    simp only [Config.noFuncDecl, Stmt.noFuncDecl, Bool.and_eq_true] at hnofd
-    exact ⟨rfl, hnofd.1⟩
-  | step_ite_false =>
-    intro hnofd
-    simp only [Config.noFuncDecl, Stmt.noFuncDecl, Bool.and_eq_true] at hnofd
-    exact ⟨rfl, hnofd.2⟩
-  | step_ite_nondet_true =>
-    intro hnofd
-    simp only [Config.noFuncDecl, Stmt.noFuncDecl, Bool.and_eq_true] at hnofd
-    exact ⟨rfl, hnofd.1⟩
-  | step_ite_nondet_false =>
-    intro hnofd
-    simp only [Config.noFuncDecl, Stmt.noFuncDecl, Bool.and_eq_true] at hnofd
-    exact ⟨rfl, hnofd.2⟩
-  | step_loop_enter =>
-    intro hnofd
-    refine ⟨rfl, ?_, ?_⟩
-    · -- Goal: inner Config has noFuncDecl
-      simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢
-      exact hnofd
-    · -- Goal: rest = [loop ...] has Block.noFuncDecl
-      simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢
-      simp [Block.noFuncDecl, Stmt.noFuncDecl, hnofd]
-  | step_loop_exit => intro _; exact ⟨rfl, trivial⟩
-  | step_loop_nondet_enter =>
-    intro hnofd
-    refine ⟨rfl, ?_, ?_⟩
-    · simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢; exact hnofd
-    · simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢
-      simp [Block.noFuncDecl, Stmt.noFuncDecl, hnofd]
-  | step_loop_nondet_exit => intro _; exact ⟨rfl, trivial⟩
-  | step_exit => intro _; exact ⟨rfl, trivial⟩
-  | step_funcDecl =>
-    intro hnofd; simp [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd
-  | step_typeDecl => intro _; exact ⟨rfl, trivial⟩
-  | step_stmts_nil => intro _; exact ⟨rfl, trivial⟩
-  | step_stmts_cons =>
-    intro hnofd
-    refine ⟨rfl, ?_⟩
-    simp only [Config.noFuncDecl, Block.noFuncDecl, Bool.and_eq_true] at hnofd ⊢
-    exact hnofd
-  | step_seq_inner _ ih =>
-    intro hnofd
-    have ⟨heq, hnofd'⟩ := ih hnofd.1
-    exact ⟨heq, hnofd', hnofd.2⟩
-  | step_seq_done => intro hnofd; exact ⟨rfl, hnofd.2⟩
-  | step_seq_exit => intro _; exact ⟨rfl, trivial⟩
-  | step_block_body _ ih => intro hnofd; exact ih hnofd
-  | step_block_done => intro _; exact ⟨rfl, trivial⟩
-  | step_block_exit_match => intro _; exact ⟨rfl, trivial⟩
-  | step_block_exit_mismatch => intro _; exact ⟨rfl, trivial⟩
-
-/-- When a statement has no function declarations, small-step execution
-    preserves the evaluator. -/
-theorem smallStep_noFuncDecl_preserves_eval
-    (s : Stmt P CmdT) (ρ ρ' : Env P)
-    (hnofd : Stmt.noFuncDecl s = true)
-    (hstar : StepStmtStar P EvalCmd extendEval (.stmt s ρ) (.terminal ρ')) :
-    ρ'.eval = ρ.eval := by
-  suffices ∀ c₁ c₂,
-      Config.noFuncDecl c₁ →
-      StepStmtStar P EvalCmd extendEval c₁ c₂ →
-      c₂.getEnv.eval = c₁.getEnv.eval by
-    exact this _ _ (show Config.noFuncDecl (.stmt s ρ) from hnofd) hstar
-  intro c₁ c₂ hnofd_c hstar_c
-  induction hstar_c with
-  | refl => rfl
-  | step _ mid _ hstep _ ih =>
-    have ⟨heq, hnofd_mid⟩ := step_preserves_eval_noFuncDecl P EvalCmd extendEval _ _ hstep hnofd_c
-    rw [ih hnofd_mid, heq]
-
-/-- When a block has no function declarations, small-step execution
-    preserves the evaluator. -/
-theorem smallStep_noFuncDecl_preserves_eval_block
-    (bss : List (Stmt P CmdT)) (ρ ρ' : Env P)
-    (hnofd : Block.noFuncDecl bss = true)
-    (hstar : StepStmtStar P EvalCmd extendEval (.stmts bss ρ) (.terminal ρ')) :
-    ρ'.eval = ρ.eval := by
-  suffices ∀ c₁ c₂,
-      Config.noFuncDecl c₁ →
-      StepStmtStar P EvalCmd extendEval c₁ c₂ →
-      c₂.getEnv.eval = c₁.getEnv.eval by
-    exact this _ _ (show Config.noFuncDecl (.stmts bss ρ) from hnofd) hstar
-  intro c₁ c₂ hnofd_c hstar_c
-  induction hstar_c with
-  | refl => rfl
-  | step _ mid _ hstep _ ih =>
-    have ⟨heq, hnofd_mid⟩ := step_preserves_eval_noFuncDecl P EvalCmd extendEval _ _ hstep hnofd_c
-    rw [ih hnofd_mid, heq]
-
-/-- Alias for `smallStep_noFuncDecl_preserves_eval_block`, matching the
-    `Block.noFuncDecl` naming convention. -/
-theorem block_noFuncDecl_preserves_eval
-    (ss : List (Stmt P CmdT)) (ρ ρ' : Env P)
-    (hnofd : Block.noFuncDecl ss = true)
-    (hterm : StepStmtStar P EvalCmd extendEval (.stmts ss ρ) (.terminal ρ')) :
-    ρ'.eval = ρ.eval :=
-  smallStep_noFuncDecl_preserves_eval_block P EvalCmd extendEval ss ρ ρ' hnofd hterm
-
 end -- section
 
 section
 
-variable (P : PureExpr) [HasFvar P] [HasBool P] [HasNot P]
+variable (P : PureExpr) [HasFvar P] [HasBool P] [HasBoolOps P] [HasFvars P] [HasOps P] [HasInt P] [HasIntOps P]
 variable (extendEval : ExtendEval P)
 
 /-! ## Assertion Identity -/
@@ -1137,7 +495,7 @@ structure AssertId where
 /-- `isAtAssert cfg aid` holds when the head of `cfg` is either an `assert`
     command whose label and expression match `aid`, or a loop statement
     whose invariant list contains an entry with matching label and
-    expression.  Recurses into `block` and `seq` wrappers so that
+    expression. Recurses into `block` and `seq` wrappers so that
     assertions inside compound statements are visible. -/
 @[expose] def isAtAssert : Config P (Cmd P) → AssertId P → Prop
   | .stmt (.cmd (.assert label expr _)) _, aid =>
@@ -1146,349 +504,10 @@ structure AssertId where
     aid.label = label ∧ aid.expr = expr
   | .stmt (.loop _ _ inv _ _) _, aid => (aid.label, aid.expr) ∈ inv
   | .stmts ((.loop _ _ inv _ _) :: _) _, aid => (aid.label, aid.expr) ∈ inv
-  | .block _ _ inner, aid => isAtAssert inner aid
+  | .block _ _ _ inner, aid => isAtAssert inner aid
   | .seq inner _, aid => isAtAssert inner aid
   | _, _ => False
 
-omit [HasFvar P] [HasBool P] [HasNot P] in
-/-- If a config has no matching assert, then `isAtAssert` doesn't match. -/
-private theorem noMatchingAssert_not_isAtAssert
-    (cfg : Config P (Cmd P)) (label : String) (expr : P.Expr)
-    (hno : cfg.noMatchingAssert label) :
-    ¬ isAtAssert P cfg ⟨label, expr⟩ := by
-  match cfg with
-  | .stmt (.cmd (.assert l _ _)) _ =>
-    simp [Config.noMatchingAssert, Stmt.noMatchingAssert] at hno
-    simp [isAtAssert]; exact fun h _ => hno (h ▸ rfl)
-  | .stmt (.cmd (.init ..)) _ | .stmt (.cmd (.set ..)) _
-  | .stmt (.cmd (.assume ..)) _
-  | .stmt (.cmd (.cover ..)) _
-  | .stmt (.block ..) _ | .stmt (.ite ..) _
-  | .stmt (.exit ..) _ | .stmt (.funcDecl ..) _ | .stmt (.typeDecl ..) _ =>
-    simp [isAtAssert]
-  | .stmt (.loop _ _ inv _ _) _ =>
-    simp [Config.noMatchingAssert, Stmt.noMatchingAssert] at hno
-    intro hat
-    exact hno.1 label expr hat rfl
-  | .stmts [] _ => simp [isAtAssert]
-  | .stmts ((.cmd (.assert l _ _)) :: _) _ =>
-    simp [Config.noMatchingAssert, Stmt.noMatchingAssert.Stmts.noMatchingAssert, Stmt.noMatchingAssert] at hno
-    simp [isAtAssert]; exact fun h _ => hno.1 (h ▸ rfl)
-  | .stmts ((.cmd (.init ..)) :: _) _ | .stmts ((.cmd (.set ..)) :: _) _
-  | .stmts ((.cmd (.assume ..)) :: _) _
-  | .stmts ((.cmd (.cover ..)) :: _) _
-  | .stmts ((.block ..) :: _) _ | .stmts ((.ite ..) :: _) _
-  | .stmts ((.exit ..) :: _) _
-  | .stmts ((.funcDecl ..) :: _) _ | .stmts ((.typeDecl ..) :: _) _ =>
-    simp [isAtAssert]
-  | .stmts ((.loop _ _ inv _ _) :: _) _ =>
-    simp [Config.noMatchingAssert, Stmt.noMatchingAssert.Stmts.noMatchingAssert,
-      Stmt.noMatchingAssert] at hno
-    intro hat
-    exact hno.1.1 label expr hat rfl
-  | .terminal _ | .exiting _ _ => simp [isAtAssert]
-  | .block _ _ inner => exact noMatchingAssert_not_isAtAssert inner label expr hno
-  | .seq inner _ => exact noMatchingAssert_not_isAtAssert inner label expr hno.1
-
-omit [HasFvar P] [HasBool P] [HasNot P] in
-/-- Helper: `Stmts.noMatchingAssert` for concatenation. -/
-private theorem stmts_noMatchingAssert_append
-    (ss₁ ss₂ : List (Stmt P (Cmd P))) (label : String)
-    (h₁ : Stmt.noMatchingAssert.Stmts.noMatchingAssert ss₁ label)
-    (h₂ : Stmt.noMatchingAssert.Stmts.noMatchingAssert ss₂ label) :
-    Stmt.noMatchingAssert.Stmts.noMatchingAssert (ss₁ ++ ss₂) label := by
-  induction ss₁ with
-  | nil => exact h₂
-  | cons s ss ih =>
-    exact ⟨h₁.1, ih h₁.2⟩
-
-/-- A single step preserves `Config.noMatchingAssert`. -/
-private def step_preserves_noMatchingAssert
-    (c₁ c₂ : Config P (Cmd P)) (label : String)
-    (hstep : StepStmt P (EvalCmd P) extendEval c₁ c₂)
-    (hno : c₁.noMatchingAssert label) :
-    c₂.noMatchingAssert label := by
-  cases hstep with
-  | step_cmd => trivial
-  | step_block => exact hno
-  | step_ite_true => exact hno.1
-  | step_ite_false => exact hno.2
-  | step_ite_nondet_true => exact hno.1
-  | step_ite_nondet_false => exact hno.2
-  | step_loop_enter =>
-    -- New shape: .seq (.block .none ρ.store (.stmts body ρ')) [loop]
-    -- noMatchingAssert: inner covers, AND [loop] covers.
-    simp only [Config.noMatchingAssert, Stmt.noMatchingAssert] at hno ⊢
-    exact ⟨hno.2, hno, True.intro⟩
-  | step_loop_exit => trivial
-  | step_loop_nondet_enter =>
-    simp only [Config.noMatchingAssert, Stmt.noMatchingAssert] at hno ⊢
-    exact ⟨hno.2, hno, True.intro⟩
-  | step_loop_nondet_exit => trivial
-  | step_exit => trivial
-  | step_funcDecl => trivial
-  | step_typeDecl => trivial
-  | step_stmts_nil => trivial
-  | step_stmts_cons => exact ⟨hno.1, hno.2⟩
-  | step_seq_inner h =>
-    constructor
-    · apply step_preserves_noMatchingAssert; exact h; exact hno.1
-    · exact hno.2
-  | step_seq_done => exact hno.2
-  | step_seq_exit => trivial
-  | step_block_body h =>
-    have := step_preserves_noMatchingAssert (c₁ := _) (c₂ := _) (label := _) h hno
-    exact this
-  | step_block_done => trivial
-  | step_block_exit_match => trivial
-  | step_block_exit_mismatch => trivial
-
-/-- The syntactic check implies that no reachable config from `st`
-    satisfies `isAtAssert` for the given label and expression. -/
-theorem noMatchingAssert_implies_no_reachable_assert
-    (st : Stmt P (Cmd P)) (label : String) (expr : P.Expr)
-    (hno : st.noMatchingAssert label) :
-    ∀ (ρ : Env P) (cfg : Config P (Cmd P)),
-      StepStmtStar P (EvalCmd P) extendEval (.stmt st ρ) cfg →
-      ¬ isAtAssert P cfg ⟨label, expr⟩ := by
-  intro ρ cfg hstar
-  suffices ∀ (c₁ c₂ : Config P (Cmd P)),
-      c₁.noMatchingAssert label →
-      StepStmtStar P (EvalCmd P) extendEval c₁ c₂ →
-      c₂.noMatchingAssert label from
-    noMatchingAssert_not_isAtAssert P cfg label expr
-      (this (.stmt st ρ) cfg (show Config.noMatchingAssert (.stmt st ρ) label from hno) hstar)
-  intro c₁ c₂ hno_c hstar_c
-  induction hstar_c with
-  | refl => exact hno_c
-  | step _ _ _ hstep _ ih =>
-    exact ih (@step_preserves_noMatchingAssert P _ _ _ extendEval _ _ _ hstep hno_c)
-
-/-! ## isAtAssert inversion lemmas -/
-
-/-- If execution inside a block reaches a config where isAtAssert holds,
-    then the config must be `.block label inner` where `inner` is reachable
-    from the block's body and satisfies `isAtAssert`. -/
-theorem block_isAtAssert_inner
-    (label : String) (σ_parent : SemanticStore P) (inner₀ cfg : Config P (Cmd P)) (a : AssertId P)
-    (hstar : StepStmtStar P (EvalCmd P) extendEval (.block label σ_parent inner₀) cfg)
-    (hat : isAtAssert P cfg a) :
-    ∃ inner, cfg = .block label σ_parent inner ∧
-      StepStmtStar P (EvalCmd P) extendEval inner₀ inner ∧
-      isAtAssert P inner a := by
-  generalize hsrc : Config.block label σ_parent inner₀ = src at hstar
-  induction hstar generalizing inner₀ with
-  | refl => subst hsrc; exact ⟨inner₀, rfl, .refl _, hat⟩
-  | step _ mid _ hstep hrest ih =>
-    subst hsrc; cases hstep with
-    | step_block_body hinner =>
-      have ⟨inner, heq, hreach, hat'⟩ := ih _ hat rfl
-      exact ⟨inner, heq, .step _ _ _ hinner hreach, hat'⟩
-    | step_block_done => cases hrest with
-      | refl => exact absurd hat (by simp [isAtAssert])
-      | step _ _ _ h _ => exact absurd h (by intro h; cases h)
-    | step_block_exit_match => cases hrest with
-      | refl => exact absurd hat (by simp [isAtAssert])
-      | step _ _ _ h _ => exact absurd h (by intro h; cases h)
-    | step_block_exit_mismatch => cases hrest with
-      | refl => exact absurd hat (by simp [isAtAssert])
-      | step _ _ _ h _ => exact absurd h (by intro h; cases h)
-
-/-- If execution inside a seq reaches a config where isAtAssert holds,
-    then either the inner config matches (first disjunct), or the inner
-    completed and we're in the tail (second disjunct). -/
-theorem seq_isAtAssert_cases
-    (inner₀ cfg : Config P (Cmd P)) (ss : List (Stmt P (Cmd P))) (a : AssertId P)
-    (hstar : StepStmtStar P (EvalCmd P) extendEval (.seq inner₀ ss) cfg)
-    (hat : isAtAssert P cfg a) :
-    (∃ inner, cfg = .seq inner ss ∧
-      StepStmtStar P (EvalCmd P) extendEval inner₀ inner ∧
-      isAtAssert P inner a) ∨
-    (∃ ρ', StepStmtStar P (EvalCmd P) extendEval inner₀ (.terminal ρ') ∧
-      StepStmtStar P (EvalCmd P) extendEval (.stmts ss ρ') cfg ∧
-      isAtAssert P cfg a) := by
-  generalize hsrc : Config.seq inner₀ ss = src at hstar
-  induction hstar generalizing inner₀ ss with
-  | refl => subst hsrc; exact .inl ⟨inner₀, rfl, .refl _, hat⟩
-  | step _ mid _ hstep hrest ih =>
-    subst hsrc; cases hstep with
-    | step_seq_inner hinner =>
-      match ih _ _ hat rfl with
-      | .inl ⟨inner, heq, hreach, hat'⟩ =>
-        exact .inl ⟨inner, heq, .step _ _ _ hinner hreach, hat'⟩
-      | .inr ⟨ρ', hterm, hstmts, hat'⟩ =>
-        exact .inr ⟨ρ', .step _ _ _ hinner hterm, hstmts, hat'⟩
-    | step_seq_done =>
-      exact .inr ⟨_, .refl _, hrest, hat⟩
-    | step_seq_exit => cases hrest with
-      | refl => exact absurd hat (by simp [isAtAssert])
-      | step _ _ _ h _ => exact absurd h (by intro h; cases h)
-
-/-- For a single assert command, any config reachable from `.stmts [assert] ρ`
-    that satisfies `isAtAssert` has getEval = ρ.eval and getStore = ρ.store. -/
-theorem assert_tail_getEvalStore
-    (ρ : Env P) (l : String) (e : P.Expr) (md : MetaData P)
-    (cfg : Config P (Cmd P)) (a : AssertId P)
-    (hstar : StepStmtStar P (EvalCmd P) extendEval
-      (.stmts [Stmt.cmd (Cmd.assert l e md)] ρ) cfg)
-    (hat : isAtAssert P cfg a) :
-    cfg.getEval = ρ.eval ∧ cfg.getStore = ρ.store := by
-  cases hstar with
-  | refl => exact ⟨rfl, rfl⟩
-  | step _ _ _ h1 hr1 => cases h1 with
-    | step_stmts_cons => cases hr1 with
-      | refl => exact ⟨rfl, rfl⟩
-      | step _ _ _ h2 hr2 =>
-        cases h2 with
-        | step_seq_inner hi =>
-          cases hi with
-          | step_cmd =>
-            cases hr2 with
-            | refl => exact absurd hat (by simp [isAtAssert])
-            | step _ _ _ h3 hr3 =>
-              cases h3 with
-              | step_seq_inner h_t => exact absurd h_t (by intro h; cases h)
-              | step_seq_done =>
-                cases hr3 with
-                | refl => exact absurd hat (by simp [isAtAssert])
-                | step _ _ _ h4 hr4 =>
-                  cases h4 with
-                  | step_stmts_nil =>
-                    cases hr4 with
-                    | refl => exact absurd hat (by simp [isAtAssert])
-                    | step _ _ _ h5 _ => exact absurd h5 (by intro h; cases h)
-
-/-! ## hasFailure preservation
-
-The lemmas below are abstract over the command type `CmdT`, the command
-evaluator `EvalCmd`, and an `IsAtAssert` predicate.  Language extensions
-(such as Core, whose commands are `CmdExt Expression`) supply their own
-`IsAtAssert` predicate together with a few simple hypotheses relating it
-to the loop / seq / block structure of configurations. -/
-
-omit [HasFvar P] in
-/-- Helper: when all asserts at a loop config pass (via `hv`), the
-    loop-step's `hasInvFailure` boolean is forced to `false`. -/
-theorem loop_step_hasInvFailure_false
-    {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
-    (IsAtAssert : Config P CmdT → AssertId P → Prop)
-    (h_IsAtAssert_loop : ∀ {g m inv body md ρ lbl e},
-      (lbl, e) ∈ inv →
-      IsAtAssert (.stmt (.loop g m inv body md) ρ) ⟨lbl, e⟩)
-    {c : Config P CmdT} {ρ : Env P}
-    {inv : List (String × P.Expr)} {guard : ExprOrNondet P}
-    {m : Option P.Expr} {body : List (Stmt P CmdT)} {md : MetaData P}
-    {hasInvFailure : Bool}
-    (hc_shape : c = .stmt (.loop guard m inv body md) ρ)
-    (hv : ∀ a cfg, StepStmtStar P EvalCmd extendEval c cfg →
-      IsAtAssert cfg a → cfg.getEval cfg.getStore a.expr = some HasBool.tt)
-    (hff_iff : hasInvFailure = true ↔ ∃ le, le ∈ inv ∧
-      ρ.eval ρ.store le.snd = some HasBool.ff) :
-    hasInvFailure = false := by
-  cases hb : hasInvFailure with
-  | false => rfl
-  | true =>
-    exfalso
-    rw [hb] at hff_iff
-    have ⟨⟨lbl, e⟩, hmem, he_ff⟩ := hff_iff.mp rfl
-    have hat : IsAtAssert c ⟨lbl, e⟩ := hc_shape ▸ h_IsAtAssert_loop hmem
-    have htt := hv ⟨lbl, e⟩ c (.refl _) hat
-    rw [hc_shape] at htt
-    simp only [Config.getEval, Config.getStore, Config.getEnv] at htt
-    rw [he_ff] at htt
-    exact absurd (Option.some.inj htt) HasBool.tt_is_not_ff.symm
-
-omit [HasFvar P] in
-/-- Single-step: if hasFailure is false and all reachable asserts pass,
-    then hasFailure stays false after one step.
-
-    Parameterized over an abstract `IsAtAssert` predicate so the lemma
-    applies to both the base Imperative dialect and language extensions
-    (e.g., Core). -/
-theorem step_preserves_noFailure
-    {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
-    (IsAtAssert : Config P CmdT → AssertId P → Prop)
-    (h_failure_implies_assert_ff :
-      ∀ {ρ : Env P} {c : CmdT} {σ'},
-        EvalCmd ρ.eval ρ.store c σ' true →
-        ∃ a : AssertId P, IsAtAssert (.stmt (.cmd c) ρ) a ∧
-          ρ.eval ρ.store a.expr = some HasBool.ff)
-    (h_IsAtAssert_loop : ∀ {g m inv body md ρ lbl e},
-      (lbl, e) ∈ inv →
-      IsAtAssert (.stmt (.loop g m inv body md) ρ) ⟨lbl, e⟩)
-    (h_IsAtAssert_seq : ∀ {inner ss a},
-      IsAtAssert inner a → IsAtAssert (.seq inner ss) a)
-    (h_IsAtAssert_block : ∀ {label σ_parent inner a},
-      IsAtAssert inner a → IsAtAssert (.block label σ_parent inner) a)
-    (c₁ c₂ : Config P CmdT)
-    (hv : ∀ a cfg, StepStmtStar P EvalCmd extendEval c₁ cfg →
-      IsAtAssert cfg a → cfg.getEval cfg.getStore a.expr = some HasBool.tt)
-    (hnf : c₁.getEnv.hasFailure = false)
-    (hstep : StepStmt P EvalCmd extendEval c₁ c₂) :
-    c₂.getEnv.hasFailure = false := by
-  induction hstep with
-  | step_cmd hcmd =>
-    simp only [Config.getEnv] at hnf ⊢
-    -- The per-command failure flag can be either true or false.
-    match h : ‹Bool› with
-    | false => simp [hnf, h]
-    | true =>
-      exfalso
-      have ⟨a, hat, hff⟩ := h_failure_implies_assert_ff (h ▸ hcmd)
-      have htt := hv a _ (.refl _) hat
-      simp only [Config.getEval, Config.getStore, Config.getEnv] at htt
-      rw [hff] at htt
-      exact absurd (Option.some.inj htt) HasBool.tt_is_not_ff.symm
-  | step_block | step_funcDecl => simp [Config.getEnv]; exact hnf
-  | step_loop_enter _ _ hff_iff _ | step_loop_exit _ _ hff_iff _
-  | step_loop_nondet_enter _ hff_iff | step_loop_nondet_exit _ hff_iff =>
-    simp only [Config.getEnv]
-    have hinv := loop_step_hasInvFailure_false (P := P) (extendEval := extendEval)
-      IsAtAssert h_IsAtAssert_loop rfl hv hff_iff
-    simp [Config.getEnv] at hnf
-    rw [hnf, Bool.false_or]; exact hinv
-  | step_seq_inner h ih =>
-    exact ih
-      (fun a cfg hr hat =>
-        hv a (.seq cfg _) (seq_inner_star P EvalCmd extendEval _ _ _ hr) (h_IsAtAssert_seq hat)) hnf
-  | step_block_body h ih =>
-    exact ih
-      (fun a cfg hr hat =>
-        hv a (.block _ _ cfg) (block_inner_star P EvalCmd extendEval _ _ _ _ hr) (h_IsAtAssert_block hat)) hnf
-  | _ => intros; exact hnf
-
-theorem allAssertsValid_preserves_noFailure
-    {ρ₀ ρ' : Env P}
-    (st : Stmt P (Cmd P))
-    (hvalid : ∀ (a : AssertId P) (cfg : Config P (Cmd P)),
-      StepStmtStar P (EvalCmd P) extendEval (.stmt st ρ₀) cfg →
-      isAtAssert P cfg a → cfg.getEval cfg.getStore a.expr = some HasBool.tt)
-    (hf₀ : ρ₀.hasFailure = false)
-    (hstar : StepStmtStar P (EvalCmd P) extendEval (.stmt st ρ₀) (.terminal ρ')) :
-    ρ'.hasFailure = false := by
-  suffices ∀ c₁ c₂,
-      (∀ a cfg, StepStmtStar P (EvalCmd P) extendEval c₁ cfg →
-        isAtAssert P cfg a → cfg.getEval cfg.getStore a.expr = some HasBool.tt) →
-      c₁.getEnv.hasFailure = false →
-      StepStmtStar P (EvalCmd P) extendEval c₁ c₂ →
-      c₂.getEnv.hasFailure = false by
-    exact this _ _ hvalid hf₀ hstar
-  intro c₁ c₂ hv hnf hstar_c
-  induction hstar_c with
-  | refl => exact hnf
-  | step _ mid _ hstep _ ih =>
-    refine ih
-      (fun a cfg h hat => hv a _ (.step _ _ _ hstep h) hat)
-      (step_preserves_noFailure (P := P) (extendEval := extendEval)
-        (isAtAssert P)
-        (fun hcmd => by
-          cases hcmd with
-          | eval_assert_fail hff _ => exact ⟨⟨_, _⟩, ⟨rfl, rfl⟩, hff⟩)
-        (fun hmem => hmem)
-        (fun h => h)
-        (fun h => h)
-        _ _ hv hnf hstep)
-
 end -- section
 
 end -- public section
diff --git a/Strata/DL/Imperative/StmtSemanticsProps.lean b/Strata/DL/Imperative/StmtSemanticsProps.lean
new file mode 100644
index 0000000000..41b3ddc1b9
--- /dev/null
+++ b/Strata/DL/Imperative/StmtSemanticsProps.lean
@@ -0,0 +1,1859 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.DL.Imperative.StmtSemantics
+import all Strata.DL.Imperative.StmtSemantics
+public import Strata.DL.Imperative.CmdSemanticsProps
+import all Strata.DL.Imperative.CmdSemanticsProps
+import all Strata.DL.Imperative.Cmd
+import all Strata.DL.Util.Relations
+
+namespace Imperative
+
+public section
+
+variable {P : PureExpr} {CmdT : Type}
+
+/-- If every var that's defined in `σ'` is also defined in `σ`, then projection
+    through `σ` is the identity on `σ'`. -/
+theorem projectStore_id {P : PureExpr} {σ σ' : SemanticStore P}
+    (h : ∀ x, σ' x ≠ none → σ x ≠ none) :
+    projectStore σ σ' = σ' := by
+  funext x
+  simp [projectStore]
+  intro hx
+  cases heq : σ' x
+  · rfl
+  · exact absurd hx (h x (by simp [heq]))
+
+/-- Projecting a store through itself is the identity. -/
+theorem projectStore_self {P : PureExpr} (σ : SemanticStore P) :
+    projectStore σ σ = σ := projectStore_id (fun _ h => h)
+
+/-- Projecting a store through itself, lifted to envs. -/
+theorem projectStore_self_env {P : PureExpr} (ρ : Env P) :
+    ({ ρ with store := projectStore ρ.store ρ.store } : Env P) = ρ := by
+  have h : projectStore ρ.store ρ.store = ρ.store := projectStore_self ρ.store
+  simp [h]
+
+/-- `projectStore` preserves `isSome` for any variable that is `isSome`
+    in both the parent and the inner store. -/
+theorem projectStore_isSome {P : PureExpr} {σ_parent σ_inner : SemanticStore P}
+    {n : P.Ident}
+    (hp : (σ_parent n).isSome) (hi : (σ_inner n).isSome) :
+    (projectStore σ_parent σ_inner n).isSome := by
+  simp [projectStore, hp, hi]
+
+/-! ## Multi-step execution: properties -/
+
+section
+
+variable
+  {CmdT : Type}
+  (P : PureExpr)
+  [HasBool P] [HasBoolOps P] [HasOps P]
+  (EvalCmd : EvalCmdParam P CmdT)
+  (extendEval : ExtendEval P)
+
+omit [HasOps P] in
+/-- Empty statement list evaluation. -/
+theorem evalStmtsSmallNil
+    (ρ : Env P) :
+    EvalStmtsSmall P EvalCmd extendEval ρ [] ρ := by
+  unfold EvalStmtsSmall
+  exact .step _ _ _ StepStmt.step_stmts_nil (.refl _)
+
+omit [HasOps P] in
+/-- Terminal configurations are indeed terminal. -/
+theorem terminalIsTerminal
+    (ρ : Env P) :
+    IsTerminal P EvalCmd extendEval (.terminal ρ) := by
+  unfold IsTerminal
+  intro c' h
+  cases h
+
+omit [HasOps P] in
+/-- Helper: if the inner config of a `.seq` takes multiple steps, the
+    enclosing `.seq` takes the same number of steps.
+    Proved by induction on the multi-step derivation. -/
+theorem seq_inner_star
+    (inner inner' : Config P CmdT)
+    (ss : List (Stmt P CmdT))
+    (h : StepStmtStar P EvalCmd extendEval inner inner') :
+    StepStmtStar P EvalCmd extendEval
+      (.seq inner ss)
+      (.seq inner' ss) := by
+  induction h with
+  | refl => exact .refl _
+  | step _ mid _ hstep _ ih =>
+    exact .step _ _ _ (.step_seq_inner hstep) ih
+
+omit [HasOps P] in
+/-- Helper: if the inner config of a `.block` takes multiple steps, the
+    enclosing `.block` takes the same number of steps. -/
+theorem block_inner_star
+    (inner inner' : Config P CmdT)
+    (label : Option String)
+    (σ_parent : SemanticStore P)
+    (e_parent : SemanticEval P)
+    (h : StepStmtStar P EvalCmd extendEval inner inner') :
+    StepStmtStar P EvalCmd extendEval
+      (.block label σ_parent e_parent inner) (.block label σ_parent e_parent inner') := by
+  induction h with
+  | refl => exact .refl _
+  | step _ mid _ hstep _ ih => exact .step _ _ _ (.step_block_body hstep) ih
+
+omit [HasOps P] in
+/-- When executing `.stmts (s :: ss) ρ`, if the head statement `s`
+    multi-steps to `.terminal ρ'`, then the whole list multi-steps to
+    `.stmts ss ρ'`.
+
+    This captures the fundamental sequencing behaviour of statement lists
+    in the small-step semantics. -/
+theorem stmts_cons_step
+    (s : Stmt P CmdT) (ss : List (Stmt P CmdT))
+    (ρ ρ' : Env P)
+    (hstmt : StepStmtStar P EvalCmd extendEval
+      (.stmt s ρ) (.terminal ρ')) :
+    StepStmtStar P EvalCmd extendEval
+      (.stmts (s :: ss) ρ)
+      (.stmts ss ρ') := by
+  -- Step 1: .stmts (s :: ss) ρ  →  .seq (.stmt s ρ) ss
+  --         via step_stmts_cons
+  apply ReflTrans.step _ (.seq (.stmt s ρ) ss)
+  · exact .step_stmts_cons
+  -- Step 2: .seq (.stmt s ρ) ss  →*  .seq (.terminal ρ') ss
+  --         by lifting hstmt through the seq context
+  have h2 := seq_inner_star P EvalCmd extendEval _ _ ss hstmt
+  -- Step 3: .seq (.terminal ρ') ss  →  .stmts ss ρ'
+  --         via step_seq_done, then chain with h2 by induction
+  suffices h3 : StepStmtStar P EvalCmd extendEval
+      (.seq (.terminal ρ') ss) (.stmts ss ρ') from
+    ReflTrans_Transitive _ _ _ _ h2 h3
+  exact .step _ _ _ .step_seq_done (.refl _)
+
+/-! ## Inversion lemmas for seq and block execution -/
+
+omit [HasOps P] in
+/-- Invert a seq execution reaching terminal: the inner terminates,
+    then the tail stmts run to terminal. -/
+theorem seq_reaches_terminal
+    {inner : Config P CmdT} {ss : List (Stmt P CmdT)} {ρ' : Env P}
+    (hstar : StepStmtStar P EvalCmd extendEval (.seq inner ss) (.terminal ρ')) :
+    ∃ ρ₁, StepStmtStar P EvalCmd extendEval inner (.terminal ρ₁) ∧
+      StepStmtStar P EvalCmd extendEval (.stmts ss ρ₁) (.terminal ρ') := by
+  suffices h_gen : ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt →
+      ∀ inner ss ρ', src = .seq inner ss → tgt = .terminal ρ' →
+      ∃ ρ₁, StepStmtStar P EvalCmd extendEval inner (.terminal ρ₁) ∧
+        StepStmtStar P EvalCmd extendEval (.stmts ss ρ₁) (.terminal ρ') from
+    h_gen _ _ hstar _ _ _ rfl rfl
+  intro src tgt hstar_g
+  induction hstar_g with
+  | refl => intro _ _ _ hsrc htgt; subst hsrc; cases htgt
+  | step _ mid _ hstep hrest ih =>
+    intro inner ss ρ' hsrc htgt; subst hsrc
+    cases hstep with
+    | step_seq_inner h =>
+      have ⟨ρ₁, hterm, htail⟩ := ih _ _ _ rfl htgt
+      exact ⟨ρ₁, .step _ _ _ h hterm, htail⟩
+    | step_seq_done => subst htgt; exact ⟨_, .refl _, hrest⟩
+    | step_seq_exit => subst htgt; cases hrest with | step _ _ _ h _ => cases h
+
+omit [HasOps P] in
+/-- Invert a seq execution reaching exiting: either the inner exited
+    (propagated), or the inner terminated and the tail exited. -/
+theorem seq_reaches_exiting
+    {inner : Config P CmdT} {ss : List (Stmt P CmdT)} {lbl : String} {ρ' : Env P}
+    (hstar : StepStmtStar P EvalCmd extendEval (.seq inner ss) (.exiting lbl ρ')) :
+    (StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ')) ∨
+    (∃ ρ₁, StepStmtStar P EvalCmd extendEval inner (.terminal ρ₁) ∧
+      StepStmtStar P EvalCmd extendEval (.stmts ss ρ₁) (.exiting lbl ρ')) := by
+  suffices h_gen : ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt →
+      ∀ inner ss lbl ρ', src = .seq inner ss → tgt = .exiting lbl ρ' →
+      (StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ')) ∨
+      (∃ ρ₁, StepStmtStar P EvalCmd extendEval inner (.terminal ρ₁) ∧
+        StepStmtStar P EvalCmd extendEval (.stmts ss ρ₁) (.exiting lbl ρ')) from
+    h_gen _ _ hstar _ _ _ _ rfl rfl
+  intro src tgt hstar_g
+  induction hstar_g with
+  | refl => intro _ _ _ _ hsrc htgt; subst hsrc; cases htgt
+  | step _ mid _ hstep hrest ih =>
+    intro inner ss lbl ρ' hsrc htgt; subst hsrc
+    cases hstep with
+    | step_seq_inner h =>
+      match ih _ _ _ _ rfl htgt with
+      | .inl hexit => exact .inl (.step _ _ _ h hexit)
+      | .inr ⟨ρ₁, hterm, htail⟩ => exact .inr ⟨ρ₁, .step _ _ _ h hterm, htail⟩
+    | step_seq_done => subst htgt; exact .inr ⟨_, .refl _, hrest⟩
+    | step_seq_exit => exact .inl (htgt ▸ hrest)
+
+/-! ### EvalExtensionOf preservation along block executions -/
+
+omit [HasOps P] in
+/-- Structural invariant: every "stacked" eval inside `c` (the active eval
+    plus every `e_parent` saved at a `.block` wrapper) extends `e_root`. -/
+def Config.evalExtendsOf (e_root : SemanticEval P) :
+    Config P CmdT → Prop
+  | .stmt _ ρ => EvalExtensionOf extendEval e_root ρ.eval
+  | .stmts _ ρ => EvalExtensionOf extendEval e_root ρ.eval
+  | .terminal ρ => EvalExtensionOf extendEval e_root ρ.eval
+  | .exiting _ ρ => EvalExtensionOf extendEval e_root ρ.eval
+  | .block _ _ e_parent inner =>
+    EvalExtensionOf extendEval e_root e_parent ∧
+    Config.evalExtendsOf e_root inner
+  | .seq inner _ => Config.evalExtendsOf e_root inner
+
+omit [HasOps P] in
+/-- A single `StepStmt` step preserves `Config.evalExtendsOf e_root`. -/
+private theorem step_preserves_evalExtendsOf
+    {c c' : Config P CmdT} {e_root : SemanticEval P}
+    (hinv : Config.evalExtendsOf P extendEval e_root c)
+    (h : StepStmt P EvalCmd extendEval c c') :
+    Config.evalExtendsOf P extendEval e_root c' := by
+  induction h with
+  -- Rules whose post-config has the same active eval as the pre-config,
+  -- and no stacked block frames are added or removed.
+  | step_cmd _ | step_exit | step_typeDecl
+  | step_stmts_nil | step_stmts_cons | step_seq_done | step_seq_exit
+  | step_loop_exit _ _ _ _ | step_loop_nondet_exit _ _ =>
+    simp only [Config.evalExtendsOf] at hinv ⊢; exact hinv
+  -- Rules that wrap the body in a fresh block (or seq-of-block).  The active
+  -- eval is unchanged, and the new block's e_parent is also the pre-config's
+  -- eval, so both halves of the resulting product are `hinv`.
+  | step_block
+  | step_ite_true _ _ | step_ite_false _ _
+  | step_ite_nondet_true | step_ite_nondet_false
+  | step_loop_enter _ _ _ _ | step_loop_nondet_enter _ _ =>
+    simp only [Config.evalExtendsOf] at hinv ⊢; exact ⟨hinv, hinv⟩
+  -- Block-exit rules: drop the inner active eval and restore e_parent.
+  | step_block_done | step_block_exit_match _ | step_block_exit_mismatch _ =>
+    simp only [Config.evalExtendsOf] at hinv ⊢; exact hinv.1
+  -- Recursive (inner) cases.
+  | step_seq_inner _ ih =>
+    simp only [Config.evalExtendsOf] at hinv ⊢; exact ih hinv
+  | step_block_body _ ih =>
+    simp only [Config.evalExtendsOf] at hinv ⊢; exact ⟨hinv.1, ih hinv.2⟩
+  -- The only rule that mutates the active eval.
+  | step_funcDecl =>
+    simp only [Config.evalExtendsOf] at hinv ⊢
+    rename_i decl _ _ _
+    exact .step _ decl hinv
+
+omit [HasOps P] in
+/-- Multi-step lift of `step_preserves_evalExtendsOf`. -/
+theorem star_preserves_evalExtendsOf
+    {c c' : Config P CmdT} {e_root : SemanticEval P}
+    (hinv : Config.evalExtendsOf P extendEval e_root c)
+    (h : StepStmtStar P EvalCmd extendEval c c') :
+    Config.evalExtendsOf P extendEval e_root c' := by
+  induction h with
+  | refl => exact hinv
+  | step _ _ _ hstep _ ih =>
+    exact ih (step_preserves_evalExtendsOf P EvalCmd extendEval hinv hstep)
+
+omit [HasOps P] in
+/-- Invert a block execution reaching terminal: the inner either
+    terminated or exited (caught by the block).  In both cases the inner
+    reaches a config whose env projects to `ρ'` via the parent store. -/
+theorem block_reaches_terminal
+    {inner : Config P CmdT} {l : Option String}
+    {σ_parent : SemanticStore P} {e_parent : SemanticEval P} {ρ' : Env P}
+    (hstar : StepStmtStar P EvalCmd extendEval (.block l σ_parent e_parent inner) (.terminal ρ')) :
+    (∃ ρ_inner, StepStmtStar P EvalCmd extendEval inner (.terminal ρ_inner) ∧
+      ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store, eval := e_parent }) ∨
+    (∃ lbl ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ_inner) ∧
+      ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store, eval := e_parent }) := by
+  suffices h_gen : ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt →
+      ∀ inner ρ', src = .block l σ_parent e_parent inner → tgt = .terminal ρ' →
+      (∃ ρ_inner, StepStmtStar P EvalCmd extendEval inner (.terminal ρ_inner) ∧
+        ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store, eval := e_parent }) ∨
+      (∃ lbl ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ_inner) ∧
+        ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store, eval := e_parent }) from
+    h_gen _ _ hstar _ _ rfl rfl
+  intro src tgt hstar_g
+  induction hstar_g with
+  | refl => intro _ _ hsrc htgt; subst hsrc; cases htgt
+  | step _ mid _ hstep hrest ih =>
+    intro inner ρ' hsrc htgt; subst hsrc
+    cases hstep with
+    | step_block_body h =>
+      match ih _ _ rfl htgt with
+      | .inl ⟨ρ_inner, hterm, heq⟩ => exact .inl ⟨ρ_inner, .step _ _ _ h hterm, heq⟩
+      | .inr ⟨lbl, ρ_inner, hexit, heq⟩ => exact .inr ⟨lbl, ρ_inner, .step _ _ _ h hexit, heq⟩
+    | step_block_done =>
+      subst htgt; cases hrest with
+      | refl => exact .inl ⟨_, .refl _, rfl⟩
+      | step _ _ _ h _ => cases h
+    | step_block_exit_match =>
+      subst htgt; cases hrest with
+      | refl => exact .inr ⟨_, _, .refl _, rfl⟩
+      | step _ _ _ h _ => cases h
+    | step_block_exit_mismatch =>
+      subst htgt; cases hrest with | step _ _ _ h _ => cases h
+
+omit [HasOps P] in
+/-- Invert a block execution reaching exiting: the inner must have
+    exited with a label that didn't match the block.  The env is projected. -/
+theorem block_reaches_exiting
+    {inner : Config P CmdT} {l : Option String}
+    {σ_parent : SemanticStore P} {e_parent : SemanticEval P} {lbl : String} {ρ' : Env P}
+    (hstar : StepStmtStar P EvalCmd extendEval (.block l σ_parent e_parent inner) (.exiting lbl ρ')) :
+    ∃ lbl_inner ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl_inner ρ_inner) ∧
+      ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store, eval := e_parent } := by
+  suffices h_gen : ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt →
+      ∀ inner lbl ρ', src = .block l σ_parent e_parent inner → tgt = .exiting lbl ρ' →
+      ∃ lbl_inner ρ_inner, StepStmtStar P EvalCmd extendEval inner (.exiting lbl_inner ρ_inner) ∧
+        ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store, eval := e_parent } from
+    h_gen _ _ hstar _ _ _ rfl rfl
+  intro src tgt hstar_g
+  induction hstar_g with
+  | refl => intro _ _ _ hsrc htgt; subst hsrc; cases htgt
+  | step _ mid _ hstep hrest ih =>
+    intro inner lbl ρ' hsrc htgt; subst hsrc
+    cases hstep with
+    | step_block_body h =>
+      have ⟨lbl_inner, ρ_inner, hexit, heq⟩ := ih _ _ _ rfl htgt
+      exact ⟨lbl_inner, ρ_inner, .step _ _ _ h hexit, heq⟩
+    | step_block_exit_mismatch =>
+      subst htgt; cases hrest with
+      | refl => exact ⟨_, _, .refl _, rfl⟩
+      | step _ _ _ h _ => cases h
+    | step_block_done | step_block_exit_match =>
+      subst htgt; cases hrest with | step _ _ _ h _ => cases h
+
+/-! ## Trace construction helpers -/
+
+omit [HasOps P] in
+/-- Entering a block: a single step from `.stmt (.block l body md) ρ`
+    to `.block (.some l) (.stmts body ρ)`. -/
+theorem step_block_enter (l : String) (body : List (Stmt P CmdT))
+    (md : MetaData P) (ρ : Env P) :
+    StepStmtStar P EvalCmd extendEval
+      (.stmt (.block l body md) ρ) (.block (.some l) ρ.store ρ.eval (.stmts body ρ)) :=
+  .step _ _ _ .step_block (.refl _)
+
+omit [HasOps P] in
+/-- If a prefix of a statement list terminates, the full list steps
+    to the suffix starting from the terminal environment. -/
+theorem stmts_prefix_terminal_append
+    (pfx sfx : List (Stmt P CmdT)) (ρ ρ' : Env P)
+    (h : StepStmtStar P EvalCmd extendEval (.stmts pfx ρ) (.terminal ρ')) :
+    StepStmtStar P EvalCmd extendEval (.stmts (pfx ++ sfx) ρ) (.stmts sfx ρ') := by
+  induction pfx generalizing ρ with
+  | nil =>
+    cases h with
+    | step _ _ _ h_step h_rest => cases h_step with
+      | step_stmts_nil => cases h_rest with
+        | refl => exact .refl _
+        | step _ _ _ h _ => exact nomatch h
+  | cons s rest ih =>
+    cases h with
+    | step _ _ _ h_step h_rest => cases h_step with
+      | step_stmts_cons =>
+        have ⟨ρ₁, h_s, h_r⟩ := seq_reaches_terminal P EvalCmd extendEval h_rest
+        exact ReflTrans_Transitive _ _ _ _
+          (stmts_cons_step P EvalCmd extendEval s (rest ++ sfx) ρ ρ₁ h_s) (ih ρ₁ h_r)
+
+omit [HasOps P] in
+/-- Decompose a terminating execution of `ss₁ ++ ss₂` into a terminating
+    execution of `ss₁` followed by a terminating execution of `ss₂`. -/
+theorem stmts_append_terminates
+    (ss₁ ss₂ : List (Stmt P CmdT)) (ρ ρ' : Env P)
+    (h : StepStmtStar P EvalCmd extendEval (.stmts (ss₁ ++ ss₂) ρ) (.terminal ρ')) :
+    ∃ ρ₁, StepStmtStar P EvalCmd extendEval (.stmts ss₁ ρ) (.terminal ρ₁) ∧
+           StepStmtStar P EvalCmd extendEval (.stmts ss₂ ρ₁) (.terminal ρ') := by
+  induction ss₁ generalizing ρ with
+  | nil =>
+    exact ⟨ρ, .step _ _ _ .step_stmts_nil (.refl _), h⟩
+  | cons s rest ih =>
+    cases h with
+    | step _ _ _ hstep hrest => cases hstep with
+      | step_stmts_cons =>
+        have ⟨ρ_mid, h_s, h_rest_ss₂⟩ :=
+          seq_reaches_terminal P EvalCmd extendEval hrest
+        have ⟨ρ₁, h_rest, h_ss₂⟩ := ih ρ_mid h_rest_ss₂
+        exact ⟨ρ₁, ReflTrans_Transitive _ _ _ _
+          (stmts_cons_step P EvalCmd extendEval
+            s rest ρ ρ_mid h_s) h_rest, h_ss₂⟩
+
+/-- Try every non-recursive `StepStmt` constructor, using `‹_›` (term-level
+    assumption) to fill arguments so that no hypothesis names are needed. -/
+local macro "apply_step" : tactic => `(tactic| first
+  | exact .step_cmd ‹_›        | exact .step_ite_true ‹_› ‹_›
+  | exact .step_ite_false ‹_› ‹_›
+  | exact .step_loop_enter ‹_› ‹_› ‹_› ‹_›
+  | exact .step_loop_exit ‹_› ‹_› ‹_› ‹_›
+  | exact .step_block
+  | exact .step_exit            | exact .step_funcDecl
+  | exact .step_typeDecl        | exact .step_stmts_nil
+  | exact .step_stmts_cons)
+
+/-! ## Store/eval simulation and hasFailure irrelevance -/
+
+/-- Two configs agree on store/eval (may differ on hasFailure). -/
+private def ConfigSE : Config P CmdT → Config P CmdT → Prop
+  | .stmt s₁ ρ₁, .stmt s₂ ρ₂ => s₁ = s₂ ∧ ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval
+  | .stmts ss₁ ρ₁, .stmts ss₂ ρ₂ => ss₁ = ss₂ ∧ ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval
+  | .terminal ρ₁, .terminal ρ₂ => ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval
+  | .exiting l₁ ρ₁, .exiting l₂ ρ₂ => l₁ = l₂ ∧ ρ₁.store = ρ₂.store ∧ ρ₁.eval = ρ₂.eval
+  | .block l₁ σ₁ e₁ i₁, .block l₂ σ₂ e₂ i₂ => l₁ = l₂ ∧ σ₁ = σ₂ ∧ e₁ = e₂ ∧ ConfigSE i₁ i₂
+  | .seq i₁ ss₁, .seq i₂ ss₂ => ss₁ = ss₂ ∧ ConfigSE i₁ i₂
+  | _, _ => False
+
+/-- Single-step simulation: if two configs agree on store/eval and one steps,
+    the other can take the same step with store/eval preserved. -/
+private def step_simulation
+    (c₁ c₁' c₂ : Config P CmdT)
+    (hstep : StepStmt P EvalCmd extendEval c₁ c₁')
+    (heq : ConfigSE P c₁ c₂) :
+    ∃ c₂', StepStmt P EvalCmd extendEval c₂ c₂' ∧ ConfigSE P c₁' c₂' := by
+  cases hstep with
+  -- Non-recursive cases where c₁ is `.stmt` or `.stmts`: exactly one c₂
+  -- constructor is valid, and the output ConfigSE follows by `simp_all`.
+  | step_cmd _ | step_block | step_ite_true _ _ | step_ite_false _ _
+  | step_loop_enter _ _ _ _ | step_loop_exit _ _ _ _
+  | step_exit | step_funcDecl | step_typeDecl | step_stmts_nil | step_stmts_cons =>
+    cases c₂ <;> try contradiction
+    obtain ⟨rfl, hs, he⟩ := heq; rename_i ρ₂; cases ρ₂; subst hs; subst he
+    exact ⟨_, by apply_step, by simp_all [ConfigSE]⟩
+  | step_ite_nondet_true =>
+    cases c₂ <;> try contradiction
+    obtain ⟨rfl, hs, he⟩ := heq; rename_i ρ₂; cases ρ₂; simp at hs he; subst hs; subst he
+    exact ⟨_, .step_ite_nondet_true, by simp [ConfigSE]⟩
+  | step_ite_nondet_false =>
+    cases c₂ <;> try contradiction
+    obtain ⟨rfl, hs, he⟩ := heq; rename_i ρ₂; cases ρ₂; simp at hs he; subst hs; subst he
+    exact ⟨_, .step_ite_nondet_false, by simp [ConfigSE]⟩
+  | step_loop_nondet_enter _ _ =>
+    cases c₂ <;> try contradiction
+    obtain ⟨rfl, hs, he⟩ := heq; rename_i ρ₂; cases ρ₂; simp at hs he; subst hs; subst he
+    exact ⟨_, .step_loop_nondet_enter ‹_› ‹_›, by simp_all [ConfigSE]⟩
+  | step_loop_nondet_exit _ _ =>
+    cases c₂ <;> try contradiction
+    obtain ⟨rfl, hs, he⟩ := heq; rename_i ρ₂; cases ρ₂; simp at hs he; subst hs; subst he
+    exact ⟨_, .step_loop_nondet_exit ‹_› ‹_›, by simp_all [ConfigSE]⟩
+  | step_seq_inner h =>
+    cases c₂ with
+    | seq i₂ _ =>
+      have hrs := heq.1; subst hrs
+      have ⟨c₂', h₂, heq₂⟩ := step_simulation _ _ _ h heq.2
+      exact ⟨_, .step_seq_inner h₂, ⟨rfl, heq₂⟩⟩
+    | _ => exact nomatch heq
+  | step_seq_done =>
+    cases c₂ with
+    | seq i₂ _ =>
+      have hrs := heq.1; subst hrs
+      cases i₂ with
+      | terminal ρ₂ => exact ⟨_, .step_seq_done, ⟨rfl, heq.2.1, heq.2.2⟩⟩
+      | _ => exact nomatch heq.2
+    | _ => exact nomatch heq
+  | step_seq_exit =>
+    cases c₂ with
+    | seq i₂ _ =>
+      cases i₂ with
+      | exiting _ _ => exact ⟨_, .step_seq_exit, ⟨heq.2.1, heq.2.2.1, heq.2.2.2⟩⟩
+      | _ => exact nomatch heq.2
+    | _ => exact nomatch heq
+  | step_block_body h =>
+    cases c₂ with
+    | block _ _ _ i₂ =>
+      have hrs := heq.1; subst hrs
+      have hσ := heq.2.1; subst hσ
+      have he := heq.2.2.1; subst he
+      have ⟨c₂', h₂, heq₂⟩ := step_simulation _ _ _ h heq.2.2.2
+      exact ⟨_, .step_block_body h₂, ⟨rfl, rfl, rfl, heq₂⟩⟩
+    | _ => exact nomatch heq
+  | step_block_done =>
+    cases c₂ with
+    | block _ _ _ i₂ =>
+      have hrs := heq.1; subst hrs
+      have hσ := heq.2.1; subst hσ
+      have he := heq.2.2.1; subst he
+      cases i₂ with
+      | terminal ρ₂ =>
+        have hse := heq.2.2.2
+        exact ⟨_, .step_block_done, ⟨congrArg (projectStore _) hse.1, rfl⟩⟩
+      | _ => exact nomatch heq.2.2.2
+    | _ => exact nomatch heq
+  | step_block_exit_match hl =>
+    cases c₂ with
+    | block _ _ _ i₂ =>
+      have hlb := heq.1; subst hlb
+      have hσ := heq.2.1; subst hσ
+      have he := heq.2.2.1; subst he
+      cases i₂ with
+      | exiting l₂ ρ₂ =>
+        have hl₂ := heq.2.2.2.1; subst hl₂
+        have hse := heq.2.2.2.2
+        exact ⟨_, .step_block_exit_match hl, ⟨congrArg (projectStore _) hse.1, rfl⟩⟩
+      | _ => exact nomatch heq.2.2.2
+    | _ => exact nomatch heq
+  | step_block_exit_mismatch hl =>
+    cases c₂ with
+    | block _ _ _ i₂ =>
+      have hlb := heq.1; subst hlb
+      have hσ := heq.2.1; subst hσ
+      have he := heq.2.2.1; subst he
+      cases i₂ with
+      | exiting l₂ ρ₂ =>
+        have hl₂ := heq.2.2.2.1; subst hl₂
+        have hse := heq.2.2.2.2
+        exact ⟨_, .step_block_exit_mismatch hl, ⟨rfl, congrArg (projectStore _) hse.1, rfl⟩⟩
+      | _ => exact nomatch heq.2.2.2
+    | _ => exact nomatch heq
+
+omit [HasOps P] in
+/-- The terminal state's store and eval are independent of the starting
+    `hasFailure` flag.  Proved by simulation: each step preserves
+    store/eval equivalence, so the terminal states agree. -/
+theorem smallStep_hasFailure_irrel
+    (s : Stmt P CmdT) (ρ ρ' : Env P)
+    (h : StepStmtStar P EvalCmd extendEval (.stmt s ρ) (.terminal ρ')) :
+    ∀ (ρ₂ : Env P), ρ₂.store = ρ.store → ρ₂.eval = ρ.eval →
+    ∃ ρ₂', StepStmtStar P EvalCmd extendEval (.stmt s ρ₂) (.terminal ρ₂') ∧
+      ρ₂'.store = ρ'.store ∧ ρ₂'.eval = ρ'.eval := by
+  intro ρ₂ hs he
+  suffices h_sim : ∀ (c₁ c₂ : Config P CmdT),
+      ConfigSE P c₁ c₂ →
+      ∀ c₁', StepStmtStar P EvalCmd extendEval c₁ c₁' →
+      ∃ c₂', StepStmtStar P EvalCmd extendEval c₂ c₂' ∧ ConfigSE P c₁' c₂' by
+    have heq_init : ConfigSE P (.stmt s ρ) (.stmt s ρ₂) := ⟨rfl, hs.symm, he.symm⟩
+    have ⟨c₂', hstar₂, heq₂⟩ := h_sim _ _ heq_init _ h
+    match c₂', heq₂ with
+    | .terminal ρ₂', heq_t => exact ⟨ρ₂', hstar₂, heq_t.1.symm, heq_t.2.symm⟩
+  intro c₁ c₂ heq c₁' hstar
+  induction hstar generalizing c₂ with
+  | refl => exact ⟨c₂, .refl _, heq⟩
+  | step _ mid _ hstep _ ih =>
+    have ⟨mid₂, hstep₂, heq_mid⟩ := step_simulation P EvalCmd extendEval _ _ _ hstep heq
+    have ⟨c₂', hstar₂, heq_final⟩ := ih _ heq_mid
+    exact ⟨c₂', .step _ _ _ hstep₂ hstar₂, heq_final⟩
+
+/-! ## Well-paired exits: preservation and no-escape -/
+
+omit [HasBool P] [HasBoolOps P] [HasOps P] in
+/-- Helper: when the inner of a block reaches `.exiting l` and the
+    block's label (if some) doesn't match `l`, then `l` must be in the outer
+    labels list.  The conclusion is `l ∈ labels`, which is exactly the
+    `Config.exitsCoveredByBlocks` of `.exiting l ρ''` for any ρ''. -/
+private theorem block_exit_mismatch_unfold {labels : List String}
+    {label : Option String} {σ_parent : SemanticStore P} {e_parent : SemanticEval P}
+    {l : String} {ρ' ρ'' : Env P}
+    (h : Config.exitsCoveredByBlocks labels
+          (.block label σ_parent e_parent (.exiting l ρ' : Config P CmdT)))
+    (hne : label ≠ .some l) :
+    Config.exitsCoveredByBlocks labels (.exiting l ρ'' : Config P CmdT) := by
+  show l ∈ labels
+  cases label with
+  | none => exact h
+  | some lb =>
+    have h' : l ∈ lb :: labels := h
+    rw [List.mem_cons] at h'
+    rcases h' with hh | hh
+    · exact absurd (by rw [hh]) hne
+    · exact hh
+
+omit [HasOps P] in
+/-- A single step preserves `Config.exitsCoveredByBlocks`. -/
+theorem step_preserves_exitsCoveredByBlocks
+    (labels : List String)
+    (c₁ c₂ : Config P CmdT)
+    (hstep : StepStmt P EvalCmd extendEval c₁ c₂)
+    (hwp : c₁.exitsCoveredByBlocks labels) :
+    c₂.exitsCoveredByBlocks labels := by
+  -- Prove a generalized version where labels is universally quantified,
+  -- so the IH works at any nesting depth (needed for step_block_body).
+  suffices h_gen : ∀ c₁ c₂, StepStmt P EvalCmd extendEval c₁ c₂ →
+      ∀ labels, c₁.exitsCoveredByBlocks labels → c₂.exitsCoveredByBlocks labels by
+    exact h_gen c₁ c₂ hstep labels hwp
+  intro c₁ c₂ hstep
+  induction hstep with
+  | step_cmd => intro _ _; trivial
+  | step_block => intro _ hwp; exact hwp
+  | step_ite_true => intro _ hwp; exact hwp.1
+  | step_ite_false => intro _ hwp; exact hwp.2
+  | step_ite_nondet_true => intro _ hwp; exact hwp.1
+  | step_ite_nondet_false => intro _ hwp; exact hwp.2
+  | step_loop_enter _ _ =>
+    intro labels hwp
+    -- Goal: .seq (.block .none ρ.store (.stmts body ρ')) [.loop ...] covers labels.
+    -- The .block .none label doesn't extend the labels list (Config.exitsCoveredByBlocks's
+    -- .block none case just descends).
+    simp only [Config.exitsCoveredByBlocks, Stmt.exitsCoveredByBlocks] at hwp ⊢
+    exact ⟨hwp, hwp, True.intro⟩
+  | step_loop_exit => intro _ _; trivial
+  | step_loop_nondet_enter =>
+    intro labels hwp
+    simp only [Config.exitsCoveredByBlocks, Stmt.exitsCoveredByBlocks] at hwp ⊢
+    exact ⟨hwp, hwp, True.intro⟩
+  | step_loop_nondet_exit => intro _ _; trivial
+  | step_exit =>
+    intro labels hwp
+    -- hwp : l ∈ labels (from .stmt (.exit l)), goal: .exiting (.some l) covers labels = l ∈ labels
+    exact hwp
+  | step_funcDecl => intro _ _; trivial
+  | step_typeDecl => intro _ _; trivial
+  | step_stmts_nil => intro _ _; trivial
+  | step_stmts_cons => intro _ hwp; exact ⟨hwp.1, hwp.2⟩
+  | step_seq_inner _ ih => intro labels hwp; exact ⟨ih labels hwp.1, hwp.2⟩
+  | step_seq_done => intro _ hwp; exact hwp.2
+  | step_seq_exit => intro _ hwp; exact hwp.1
+  | step_block_body _ ih =>
+    intro labels hwp
+    rename_i inner inner' label σ_parent e_parent _
+    cases label with
+    | none => exact ih labels hwp
+    | some l => exact ih (l :: labels) hwp
+  | step_block_done => intro _ _; trivial
+  | step_block_exit_match => intro _ _; trivial
+  | step_block_exit_mismatch hne =>
+    intro labels hwp
+    exact block_exit_mismatch_unfold (P := P) (CmdT := CmdT) hwp hne
+
+omit [HasOps P] in
+/-- Well-paired statements cannot escape via `.exiting`:
+    if all exits in `s` are caught by enclosing blocks
+    (`s.exitsCoveredByBlocks []`), then `s` never reaches `.exiting`. -/
+theorem exitsCoveredByBlocks_noEscape
+    (s : Stmt P CmdT)
+    (hwp : s.exitsCoveredByBlocks []) :
+    ∀ (ρ : Env P) (lbl : String) (ρ' : Env P),
+      ¬ StepStmtStar P EvalCmd extendEval (.stmt s ρ) (.exiting lbl ρ') := by
+  intro ρ lbl ρ' hstar
+  -- Prove Config.exitsCoveredByBlocks [] is preserved, then show .exiting contradicts it.
+  suffices h_pres : ∀ c₁ c₂,
+      c₁.exitsCoveredByBlocks ([] : List String) →
+      StepStmtStar P EvalCmd extendEval c₁ c₂ →
+      c₂.exitsCoveredByBlocks ([] : List String) by
+    have hwp' := h_pres _ _ (show Config.exitsCoveredByBlocks [] (.stmt s ρ) from hwp) hstar
+    -- Config.exitsCoveredByBlocks [] (.exiting lbl ρ') requires lbl ∈ [] (False).
+    exact absurd hwp' (by simp [Config.exitsCoveredByBlocks])
+  intro c₁ c₂ hwp_c hstar_c
+  induction hstar_c with
+  | refl => exact hwp_c
+  | step _ _ _ hstep _ ih =>
+    exact ih (step_preserves_exitsCoveredByBlocks P EvalCmd extendEval [] _ _ hstep hwp_c)
+
+omit [HasOps P] in
+/-- Well-paired statement lists cannot escape via `.exiting`:
+    if all exits in `bss` are caught by enclosing blocks
+    (`Block.exitsCoveredByBlocks [] bss`), then `.stmts bss ρ` never reaches `.exiting`. -/
+theorem block_exitsCoveredByBlocks_noEscape
+    (bss : List (Stmt P CmdT))
+    (hwp : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks [] bss) :
+    ∀ (ρ : Env P) (lbl : String) (ρ' : Env P),
+      ¬ StepStmtStar P EvalCmd extendEval (.stmts bss ρ) (.exiting lbl ρ') := by
+  intro ρ lbl ρ' hstar
+  suffices h_pres : ∀ c₁ c₂,
+      c₁.exitsCoveredByBlocks ([] : List String) →
+      StepStmtStar P EvalCmd extendEval c₁ c₂ →
+      c₂.exitsCoveredByBlocks ([] : List String) by
+    have hwp' := h_pres _ _ (show Config.exitsCoveredByBlocks [] (.stmts bss ρ) from hwp) hstar
+    exact absurd hwp' (by simp [Config.exitsCoveredByBlocks])
+  intro c₁ c₂ hwp_c hstar_c
+  induction hstar_c with
+  | refl => exact hwp_c
+  | step _ _ _ hstep _ ih =>
+    exact ih (step_preserves_exitsCoveredByBlocks P EvalCmd extendEval [] _ _ hstep hwp_c)
+
+omit [HasOps P] in
+/-- If `.block l inner →* cfg`, the inner config never reaches `.exiting`,
+    and `cfg` is neither terminal nor exiting, then `cfg = .block l inner'`
+    for some `inner'` with `inner →* inner'`. -/
+theorem block_star_extract_inner
+    {l : Option String} {σ_parent : SemanticStore P} {e_parent : SemanticEval P}
+    {inner cfg : Config P CmdT}
+    (h_star : StepStmtStar P EvalCmd extendEval (.block l σ_parent e_parent inner) cfg)
+    (h_no_exit : ∀ lbl ρ', ¬ StepStmtStar P EvalCmd extendEval
+        inner (.exiting lbl ρ'))
+    (h_not_terminal : ∀ ρ', cfg ≠ .terminal ρ')
+    (h_not_exiting : ∀ lbl ρ', cfg ≠ .exiting lbl ρ') :
+    ∃ inner', cfg = .block l σ_parent e_parent inner' ∧
+      StepStmtStar P EvalCmd extendEval inner inner' := by
+  suffices h_gen : ∀ c₁ c₂,
+      StepStmtStar P EvalCmd extendEval c₁ c₂ →
+      ∀ inner₀, c₁ = .block l σ_parent e_parent inner₀ →
+      (∀ lbl ρ', ¬ StepStmtStar P EvalCmd extendEval inner₀ (.exiting lbl ρ')) →
+      (∀ ρ', c₂ ≠ .terminal ρ') → (∀ lbl ρ', c₂ ≠ .exiting lbl ρ') →
+      ∃ inner', c₂ = .block l σ_parent e_parent inner' ∧
+        StepStmtStar P EvalCmd extendEval inner₀ inner' from
+    h_gen _ _ h_star _ rfl h_no_exit h_not_terminal h_not_exiting
+  intro c₁ c₂ h_star
+  induction h_star with
+  | refl => intro inner₀ heq _ _ _; subst heq; exact ⟨inner₀, rfl, .refl _⟩
+  | step _ mid _ hstep hrest ih =>
+    intro inner₀ heq h_ne h_nt h_nx; subst heq
+    cases hstep with
+    | step_block_body h_inner_step =>
+      have h_ne' : ∀ lbl ρ', ¬ StepStmtStar P EvalCmd extendEval _ (.exiting lbl ρ') :=
+        fun lbl ρ' h => h_ne lbl ρ' (.step _ _ _ h_inner_step h)
+      obtain ⟨inner', rfl, h_inner_star⟩ := ih _ rfl h_ne' h_nt h_nx
+      exact ⟨inner', rfl, .step _ _ _ h_inner_step h_inner_star⟩
+    | step_block_done =>
+      cases hrest with
+      | refl => exact absurd rfl (h_nt _)
+      | step _ _ _ h _ => exact nomatch h
+    | step_block_exit_match => exact absurd (.refl _) (h_ne _ _)
+    | step_block_exit_mismatch => exact absurd (.refl _) (h_ne _ _)
+
+/-! ## noFuncDecl preserves eval (small-step) -/
+
+omit [HasOps P] in
+/-- A single step preserves eval when noFuncDecl holds.
+    The only step that changes eval is step_funcDecl, which is excluded. -/
+private theorem step_preserves_eval_noFuncDecl
+    (c₁ c₂ : Config P CmdT)
+    (hstep : StepStmt P EvalCmd extendEval c₁ c₂)
+    (hnofd : Config.noFuncDecl c₁) :
+    c₂.getEnv.eval = c₁.getEnv.eval ∧ Config.noFuncDecl c₂ := by
+  suffices h_gen : ∀ c₁ c₂, StepStmt P EvalCmd extendEval c₁ c₂ →
+      ∀ (_ : Config.noFuncDecl c₁),
+      c₂.getEnv.eval = c₁.getEnv.eval ∧ Config.noFuncDecl c₂ by
+    exact h_gen c₁ c₂ hstep hnofd
+  intro c₁ c₂ hstep
+  induction hstep with
+  | step_cmd => intro _; exact ⟨rfl, trivial⟩
+  | step_block =>
+    intro hnofd
+    simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd ⊢
+    exact ⟨rfl, hnofd, rfl⟩
+  | step_ite_true =>
+    intro hnofd
+    simp only [Config.noFuncDecl, Stmt.noFuncDecl, Bool.and_eq_true] at hnofd
+    exact ⟨rfl, hnofd.1, rfl⟩
+  | step_ite_false =>
+    intro hnofd
+    simp only [Config.noFuncDecl, Stmt.noFuncDecl, Bool.and_eq_true] at hnofd
+    exact ⟨rfl, hnofd.2, rfl⟩
+  | step_ite_nondet_true =>
+    intro hnofd
+    simp only [Config.noFuncDecl, Stmt.noFuncDecl, Bool.and_eq_true] at hnofd
+    exact ⟨rfl, hnofd.1, rfl⟩
+  | step_ite_nondet_false =>
+    intro hnofd
+    simp only [Config.noFuncDecl, Stmt.noFuncDecl, Bool.and_eq_true] at hnofd
+    exact ⟨rfl, hnofd.2, rfl⟩
+  | step_loop_enter =>
+    intro hnofd
+    simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd
+    refine ⟨rfl, ⟨⟨?_, ?_⟩, ?_⟩⟩
+    · -- Goal: Block.noFuncDecl body = true
+      exact hnofd
+    · -- Goal: ρ.eval = (.stmts body ρ').getEnv.eval where ρ' is hasFailure-modified ρ
+      rfl
+    · -- Goal: rest = [loop ...] has Block.noFuncDecl
+      simp [Block.noFuncDecl, Stmt.noFuncDecl, hnofd]
+  | step_loop_exit => intro _; exact ⟨rfl, trivial⟩
+  | step_loop_nondet_enter =>
+    intro hnofd
+    simp only [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd
+    refine ⟨rfl, ⟨⟨?_, ?_⟩, ?_⟩⟩
+    · exact hnofd
+    · rfl
+    · simp [Block.noFuncDecl, Stmt.noFuncDecl, hnofd]
+  | step_loop_nondet_exit => intro _; exact ⟨rfl, trivial⟩
+  | step_exit => intro _; exact ⟨rfl, trivial⟩
+  | step_funcDecl =>
+    intro hnofd; simp [Config.noFuncDecl, Stmt.noFuncDecl] at hnofd
+  | step_typeDecl => intro _; exact ⟨rfl, trivial⟩
+  | step_stmts_nil => intro _; exact ⟨rfl, trivial⟩
+  | step_stmts_cons =>
+    intro hnofd
+    refine ⟨rfl, ?_⟩
+    simp only [Config.noFuncDecl, Block.noFuncDecl, Bool.and_eq_true] at hnofd ⊢
+    exact hnofd
+  | step_seq_inner _ ih =>
+    intro hnofd
+    have ⟨heq, hnofd'⟩ := ih hnofd.1
+    exact ⟨heq, hnofd', hnofd.2⟩
+  | step_seq_done => intro hnofd; exact ⟨rfl, hnofd.2⟩
+  | step_seq_exit => intro _; exact ⟨rfl, trivial⟩
+  | step_block_body _ ih =>
+    intro hnofd
+    -- hnofd : inner.noFuncDecl ∧ e_parent = inner.getEnv.eval
+    have ⟨heq_inner, hnofd_inner⟩ := ih hnofd.1
+    -- heq_inner : inner'.getEnv.eval = inner.getEnv.eval
+    refine ⟨heq_inner, hnofd_inner, ?_⟩
+    -- Goal: e_parent = inner'.getEnv.eval
+    rw [heq_inner]; exact hnofd.2
+  | step_block_done =>
+    intro hnofd
+    refine ⟨?_, trivial⟩
+    simp only [Config.getEnv]
+    exact hnofd.2
+  | step_block_exit_match =>
+    intro hnofd
+    refine ⟨?_, trivial⟩
+    simp only [Config.getEnv]
+    exact hnofd.2
+  | step_block_exit_mismatch =>
+    intro hnofd
+    refine ⟨?_, trivial⟩
+    simp only [Config.getEnv]
+    exact hnofd.2
+
+omit [HasOps P] in
+/-- When a statement has no function declarations, small-step execution
+    preserves the evaluator. -/
+theorem smallStep_noFuncDecl_preserves_eval
+    (s : Stmt P CmdT) (ρ ρ' : Env P)
+    (hnofd : Stmt.noFuncDecl s = true)
+    (hstar : StepStmtStar P EvalCmd extendEval (.stmt s ρ) (.terminal ρ')) :
+    ρ'.eval = ρ.eval := by
+  suffices h_gen : ∀ c₁ c₂,
+      Config.noFuncDecl c₁ →
+      StepStmtStar P EvalCmd extendEval c₁ c₂ →
+      c₂.getEnv.eval = c₁.getEnv.eval by
+    exact h_gen _ _ (show Config.noFuncDecl (.stmt s ρ) from hnofd) hstar
+  intro c₁ c₂ hnofd_c hstar_c
+  induction hstar_c with
+  | refl => rfl
+  | step _ mid _ hstep _ ih =>
+    have ⟨heq, hnofd_mid⟩ := step_preserves_eval_noFuncDecl P EvalCmd extendEval _ _ hstep hnofd_c
+    rw [ih hnofd_mid, heq]
+
+omit [HasOps P] in
+/-- When a block has no function declarations, small-step execution
+    preserves the evaluator. -/
+theorem smallStep_noFuncDecl_preserves_eval_block
+    (bss : List (Stmt P CmdT)) (ρ ρ' : Env P)
+    (hnofd : Block.noFuncDecl bss = true)
+    (hstar : StepStmtStar P EvalCmd extendEval (.stmts bss ρ) (.terminal ρ')) :
+    ρ'.eval = ρ.eval := by
+  suffices h_gen : ∀ c₁ c₂,
+      Config.noFuncDecl c₁ →
+      StepStmtStar P EvalCmd extendEval c₁ c₂ →
+      c₂.getEnv.eval = c₁.getEnv.eval by
+    exact h_gen _ _ (show Config.noFuncDecl (.stmts bss ρ) from hnofd) hstar
+  intro c₁ c₂ hnofd_c hstar_c
+  induction hstar_c with
+  | refl => rfl
+  | step _ mid _ hstep _ ih =>
+    have ⟨heq, hnofd_mid⟩ := step_preserves_eval_noFuncDecl P EvalCmd extendEval _ _ hstep hnofd_c
+    rw [ih hnofd_mid, heq]
+
+omit [HasOps P] in
+/-- Alias for `smallStep_noFuncDecl_preserves_eval_block`, matching the
+    `Block.noFuncDecl` naming convention. -/
+theorem block_noFuncDecl_preserves_eval
+    (ss : List (Stmt P CmdT)) (ρ ρ' : Env P)
+    (hnofd : Block.noFuncDecl ss = true)
+    (hterm : StepStmtStar P EvalCmd extendEval (.stmts ss ρ) (.terminal ρ')) :
+    ρ'.eval = ρ.eval :=
+  smallStep_noFuncDecl_preserves_eval_block P EvalCmd extendEval ss ρ ρ' hnofd hterm
+
+omit [HasOps P] in
+/-- `.exiting` variant: When a block has no function declarations, an exiting
+    execution preserves the evaluator. -/
+theorem block_noFuncDecl_preserves_eval_exiting
+    (ss : List (Stmt P CmdT)) (ρ ρ' : Env P) (lbl : String)
+    (hnofd : Block.noFuncDecl ss = true)
+    (hexit : StepStmtStar P EvalCmd extendEval (.stmts ss ρ) (.exiting lbl ρ')) :
+    ρ'.eval = ρ.eval := by
+  suffices h_gen : ∀ c₁ c₂,
+      Config.noFuncDecl c₁ →
+      StepStmtStar P EvalCmd extendEval c₁ c₂ →
+      c₂.getEnv.eval = c₁.getEnv.eval by
+    exact h_gen _ _ (show Config.noFuncDecl (.stmts ss ρ) from hnofd) hexit
+  intro c₁ c₂ hnofd_c hstar_c
+  induction hstar_c with
+  | refl => rfl
+  | step _ mid _ hstep _ ih =>
+    have ⟨heq, hnofd_mid⟩ := step_preserves_eval_noFuncDecl P EvalCmd extendEval _ _ hstep hnofd_c
+    rw [ih hnofd_mid, heq]
+
+
+end -- section
+
+section
+
+variable (P : PureExpr) [HasFvar P] [HasBool P] [HasBoolOps P] [HasOps P]
+variable (extendEval : ExtendEval P)
+
+omit [HasFvar P] [HasOps P] [HasBool P] [HasBoolOps P] in
+/-- If a config has no matching assert, then `isAtAssert` doesn't match. -/
+private theorem noMatchingAssert_not_isAtAssert
+    (cfg : Config P (Cmd P)) (label : String) (expr : P.Expr)
+    (hno : cfg.noMatchingAssert label) :
+    ¬ isAtAssert P cfg ⟨label, expr⟩ := by
+  match cfg with
+  | .stmt (.cmd (.assert l _ _)) _ =>
+    simp [Config.noMatchingAssert, Stmt.noMatchingAssert] at hno
+    simp [isAtAssert]; exact fun h _ => hno (h ▸ rfl)
+  | .stmt (.cmd (.init ..)) _ | .stmt (.cmd (.set ..)) _
+  | .stmt (.cmd (.assume ..)) _
+  | .stmt (.cmd (.cover ..)) _
+  | .stmt (.block ..) _ | .stmt (.ite ..) _
+  | .stmt (.exit ..) _ | .stmt (.funcDecl ..) _ | .stmt (.typeDecl ..) _ =>
+    simp [isAtAssert]
+  | .stmt (.loop _ m inv _ _) _ =>
+    simp [Config.noMatchingAssert, Stmt.noMatchingAssert] at hno
+    intro hat
+    exact hno.1 label expr hat rfl
+  | .stmts [] _ => simp [isAtAssert]
+  | .stmts ((.cmd (.assert l _ _)) :: _) _ =>
+    simp [Config.noMatchingAssert, Stmt.noMatchingAssert.Stmts.noMatchingAssert, Stmt.noMatchingAssert] at hno
+    simp [isAtAssert]; exact fun h _ => hno.1 (h ▸ rfl)
+  | .stmts ((.cmd (.init ..)) :: _) _ | .stmts ((.cmd (.set ..)) :: _) _
+  | .stmts ((.cmd (.assume ..)) :: _) _
+  | .stmts ((.cmd (.cover ..)) :: _) _
+  | .stmts ((.block ..) :: _) _ | .stmts ((.ite ..) :: _) _
+  | .stmts ((.exit ..) :: _) _
+  | .stmts ((.funcDecl ..) :: _) _ | .stmts ((.typeDecl ..) :: _) _ =>
+    simp [isAtAssert]
+  | .stmts ((.loop _ m inv _ _) :: _) _ =>
+    simp [Config.noMatchingAssert, Stmt.noMatchingAssert.Stmts.noMatchingAssert,
+      Stmt.noMatchingAssert] at hno
+    intro hat
+    exact hno.1.1 label expr hat rfl
+  | .terminal _ | .exiting _ _ => simp [isAtAssert]
+  | .block _ _ _ inner => exact noMatchingAssert_not_isAtAssert inner label expr hno
+  | .seq inner _ => exact noMatchingAssert_not_isAtAssert inner label expr hno.1
+
+omit [HasFvar P] [HasBool P] [HasBoolOps P] [HasOps P] in
+/-- Helper: `Stmts.noMatchingAssert` for concatenation. -/
+private theorem stmts_noMatchingAssert_append
+    (ss₁ ss₂ : List (Stmt P (Cmd P))) (label : String)
+    (h₁ : Stmt.noMatchingAssert.Stmts.noMatchingAssert ss₁ label)
+    (h₂ : Stmt.noMatchingAssert.Stmts.noMatchingAssert ss₂ label) :
+    Stmt.noMatchingAssert.Stmts.noMatchingAssert (ss₁ ++ ss₂) label := by
+  induction ss₁ with
+  | nil => exact h₂
+  | cons s ss ih =>
+    exact ⟨h₁.1, ih h₁.2⟩
+
+/-- A single step preserves `Config.noMatchingAssert`. -/
+private def step_preserves_noMatchingAssert
+    (c₁ c₂ : Config P (Cmd P)) (label : String)
+    (hstep : StepStmt P (EvalCmd P) extendEval c₁ c₂)
+    (hno : c₁.noMatchingAssert label) :
+    c₂.noMatchingAssert label := by
+  cases hstep with
+  | step_cmd => trivial
+  | step_block => exact hno
+  | step_ite_true => exact hno.1
+  | step_ite_false => exact hno.2
+  | step_ite_nondet_true => exact hno.1
+  | step_ite_nondet_false => exact hno.2
+  | step_loop_enter =>
+    -- New shape: .seq (.block .none ρ.store (.stmts body ρ')) [loop]
+    -- noMatchingAssert: inner covers, AND [loop] covers.
+    simp only [Config.noMatchingAssert, Stmt.noMatchingAssert] at hno ⊢
+    exact ⟨hno.2, hno, True.intro⟩
+  | step_loop_exit => trivial
+  | step_loop_nondet_enter =>
+    simp only [Config.noMatchingAssert, Stmt.noMatchingAssert] at hno ⊢
+    exact ⟨hno.2, hno, True.intro⟩
+  | step_loop_nondet_exit => trivial
+  | step_exit => trivial
+  | step_funcDecl => trivial
+  | step_typeDecl => trivial
+  | step_stmts_nil => trivial
+  | step_stmts_cons => exact ⟨hno.1, hno.2⟩
+  | step_seq_inner h =>
+    constructor
+    · apply step_preserves_noMatchingAssert; exact h; exact hno.1
+    · exact hno.2
+  | step_seq_done => exact hno.2
+  | step_seq_exit => trivial
+  | step_block_body h =>
+    have h_inner :=
+      step_preserves_noMatchingAssert (c₁ := _) (c₂ := _) (label := _) h hno
+    exact h_inner
+  | step_block_done => trivial
+  | step_block_exit_match => trivial
+  | step_block_exit_mismatch => trivial
+
+omit [HasOps P] in
+/-- The syntactic check implies that no reachable config from `st`
+    satisfies `isAtAssert` for the given label and expression. -/
+theorem noMatchingAssert_implies_no_reachable_assert
+    (st : Stmt P (Cmd P)) (label : String) (expr : P.Expr)
+    (hno : st.noMatchingAssert label) :
+    ∀ (ρ : Env P) (cfg : Config P (Cmd P)),
+      StepStmtStar P (EvalCmd P) extendEval (.stmt st ρ) cfg →
+      ¬ isAtAssert P cfg ⟨label, expr⟩ := by
+  intro ρ cfg hstar
+  suffices h_pres : ∀ (c₁ c₂ : Config P (Cmd P)),
+      c₁.noMatchingAssert label →
+      StepStmtStar P (EvalCmd P) extendEval c₁ c₂ →
+      c₂.noMatchingAssert label from
+    noMatchingAssert_not_isAtAssert P cfg label expr
+      (h_pres (.stmt st ρ) cfg (show Config.noMatchingAssert (.stmt st ρ) label from hno) hstar)
+  intro c₁ c₂ hno_c hstar_c
+  induction hstar_c with
+  | refl => exact hno_c
+  | step _ _ _ hstep _ ih =>
+    exact ih (step_preserves_noMatchingAssert (P := P) (extendEval := extendEval) _ _ _ hstep hno_c)
+
+/-! ## isAtAssert inversion lemmas -/
+
+omit [HasOps P] in
+/-- If execution inside a block reaches a config where isAtAssert holds,
+    then the config must be `.block label inner` where `inner` is reachable
+    from the block's body and satisfies `isAtAssert`. -/
+theorem block_isAtAssert_inner
+    (label : Option String) (σ_parent : SemanticStore P) (e_parent : SemanticEval P)
+    (inner₀ cfg : Config P (Cmd P)) (a : AssertId P)
+    (hstar : StepStmtStar P (EvalCmd P) extendEval (.block label σ_parent e_parent inner₀) cfg)
+    (hat : isAtAssert P cfg a) :
+    ∃ inner, cfg = .block label σ_parent e_parent inner ∧
+      StepStmtStar P (EvalCmd P) extendEval inner₀ inner ∧
+      isAtAssert P inner a := by
+  generalize hsrc : Config.block label σ_parent e_parent inner₀ = src at hstar
+  induction hstar generalizing inner₀ with
+  | refl => subst hsrc; exact ⟨inner₀, rfl, .refl _, hat⟩
+  | step _ mid _ hstep hrest ih =>
+    subst hsrc; cases hstep with
+    | step_block_body hinner =>
+      have ⟨inner, heq, hreach, hat'⟩ := ih _ hat rfl
+      exact ⟨inner, heq, .step _ _ _ hinner hreach, hat'⟩
+    | step_block_done => cases hrest with
+      | refl => exact absurd hat (by simp [isAtAssert])
+      | step _ _ _ h _ => exact absurd h (by intro h; cases h)
+    | step_block_exit_match => cases hrest with
+      | refl => exact absurd hat (by simp [isAtAssert])
+      | step _ _ _ h _ => exact absurd h (by intro h; cases h)
+    | step_block_exit_mismatch => cases hrest with
+      | refl => exact absurd hat (by simp [isAtAssert])
+      | step _ _ _ h _ => exact absurd h (by intro h; cases h)
+
+omit [HasOps P] in
+/-- If execution inside a seq reaches a config where isAtAssert holds,
+    then either the inner config matches (first disjunct), or the inner
+    completed and we're in the tail (second disjunct). -/
+theorem seq_isAtAssert_cases
+    (inner₀ cfg : Config P (Cmd P)) (ss : List (Stmt P (Cmd P))) (a : AssertId P)
+    (hstar : StepStmtStar P (EvalCmd P) extendEval (.seq inner₀ ss) cfg)
+    (hat : isAtAssert P cfg a) :
+    (∃ inner, cfg = .seq inner ss ∧
+      StepStmtStar P (EvalCmd P) extendEval inner₀ inner ∧
+      isAtAssert P inner a) ∨
+    (∃ ρ', StepStmtStar P (EvalCmd P) extendEval inner₀ (.terminal ρ') ∧
+      StepStmtStar P (EvalCmd P) extendEval (.stmts ss ρ') cfg ∧
+      isAtAssert P cfg a) := by
+  generalize hsrc : Config.seq inner₀ ss = src at hstar
+  induction hstar generalizing inner₀ ss with
+  | refl => subst hsrc; exact .inl ⟨inner₀, rfl, .refl _, hat⟩
+  | step _ mid _ hstep hrest ih =>
+    subst hsrc; cases hstep with
+    | step_seq_inner hinner =>
+      match ih _ _ hat rfl with
+      | .inl ⟨inner, heq, hreach, hat'⟩ =>
+        exact .inl ⟨inner, heq, .step _ _ _ hinner hreach, hat'⟩
+      | .inr ⟨ρ', hterm, hstmts, hat'⟩ =>
+        exact .inr ⟨ρ', .step _ _ _ hinner hterm, hstmts, hat'⟩
+    | step_seq_done =>
+      exact .inr ⟨_, .refl _, hrest, hat⟩
+    | step_seq_exit => cases hrest with
+      | refl => exact absurd hat (by simp [isAtAssert])
+      | step _ _ _ h _ => exact absurd h (by intro h; cases h)
+
+omit [HasOps P] in
+/-- For a single assert command, any config reachable from `.stmts [assert] ρ`
+    that satisfies `isAtAssert` has getEval = ρ.eval and getStore = ρ.store. -/
+theorem assert_tail_getEvalStore
+    (ρ : Env P) (l : String) (e : P.Expr) (md : MetaData P)
+    (cfg : Config P (Cmd P)) (a : AssertId P)
+    (hstar : StepStmtStar P (EvalCmd P) extendEval
+      (.stmts [Stmt.cmd (Cmd.assert l e md)] ρ) cfg)
+    (hat : isAtAssert P cfg a) :
+    cfg.getEval = ρ.eval ∧ cfg.getStore = ρ.store := by
+  cases hstar with
+  | refl => exact ⟨rfl, rfl⟩
+  | step _ _ _ h1 hr1 => cases h1 with
+    | step_stmts_cons => cases hr1 with
+      | refl => exact ⟨rfl, rfl⟩
+      | step _ _ _ h2 hr2 =>
+        cases h2 with
+        | step_seq_inner hi =>
+          cases hi with
+          | step_cmd =>
+            cases hr2 with
+            | refl => exact absurd hat (by simp [isAtAssert])
+            | step _ _ _ h3 hr3 =>
+              cases h3 with
+              | step_seq_inner h_t => exact absurd h_t (by intro h; cases h)
+              | step_seq_done =>
+                cases hr3 with
+                | refl => exact absurd hat (by simp [isAtAssert])
+                | step _ _ _ h4 hr4 =>
+                  cases h4 with
+                  | step_stmts_nil =>
+                    cases hr4 with
+                    | refl => exact absurd hat (by simp [isAtAssert])
+                    | step _ _ _ h5 _ => exact absurd h5 (by intro h; cases h)
+
+/-! ## hasFailure preservation
+
+The lemmas below are abstract over the command type `CmdT`, the command
+evaluator `EvalCmd`, and an `IsAtAssert` predicate.  Language extensions
+(such as Core, whose commands are `CmdExt Expression`) supply their own
+`IsAtAssert` predicate together with a few simple hypotheses relating it
+to the loop / seq / block structure of configurations. -/
+
+omit [HasFvar P] [HasOps P] in
+/-- Helper: when all asserts at a loop config pass (via `hv`), the
+    loop-step's `hasInvFailure` boolean is forced to `false`. -/
+theorem loop_step_hasInvFailure_false
+    {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
+    (IsAtAssert : Config P CmdT → AssertId P → Prop)
+    (h_IsAtAssert_loop_inv : ∀ {g m inv body md ρ lbl e},
+      (lbl, e) ∈ inv →
+      IsAtAssert (.stmt (.loop g m inv body md) ρ) ⟨lbl, e⟩)
+    {c : Config P CmdT} {ρ : Env P}
+    {inv : List (String × P.Expr)} {guard : ExprOrNondet P}
+    {m : Option P.Expr} {body : List (Stmt P CmdT)} {md : MetaData P}
+    {hasInvFailure : Bool}
+    (hc_shape : c = .stmt (.loop guard m inv body md) ρ)
+    (hv : ∀ a cfg, StepStmtStar P EvalCmd extendEval c cfg →
+      IsAtAssert cfg a → cfg.getEval cfg.getStore a.expr = some HasBool.tt)
+    (hff_iff : hasInvFailure = true ↔ ∃ le, le ∈ inv ∧
+      ρ.eval ρ.store le.snd = some HasBool.ff) :
+    hasInvFailure = false := by
+  cases hb : hasInvFailure with
+  | false => rfl
+  | true =>
+    exfalso
+    rw [hb] at hff_iff
+    have ⟨⟨lbl, e⟩, hmem, he_ff⟩ := hff_iff.mp rfl
+    have hat : IsAtAssert c ⟨lbl, e⟩ := hc_shape ▸ h_IsAtAssert_loop_inv hmem
+    have htt := hv ⟨lbl, e⟩ c (.refl _) hat
+    rw [hc_shape] at htt
+    simp only [Config.getEval, Config.getStore, Config.getEnv] at htt
+    rw [he_ff] at htt
+    exact absurd (Option.some.inj htt) HasBool.tt_is_not_ff.symm
+
+omit [HasFvar P] [HasOps P] in
+/-- Single-step: if hasFailure is false and all reachable asserts pass,
+    then hasFailure stays false after one step.
+
+    Parameterized over an abstract `IsAtAssert` predicate so the lemma
+    applies to both the base Imperative dialect and language extensions
+    (e.g., Core). -/
+theorem step_preserves_noFailure
+    {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
+    (IsAtAssert : Config P CmdT → AssertId P → Prop)
+    (h_failure_implies_assert_ff :
+      ∀ {ρ : Env P} {c : CmdT} {σ'},
+        EvalCmd ρ.eval ρ.store c σ' true →
+        ∃ a : AssertId P, IsAtAssert (.stmt (.cmd c) ρ) a ∧
+          ρ.eval ρ.store a.expr = some HasBool.ff)
+    (h_IsAtAssert_loop : ∀ {g m inv body md ρ lbl e},
+      (lbl, e) ∈ inv →
+      IsAtAssert (.stmt (.loop g m inv body md) ρ) ⟨lbl, e⟩)
+    (h_IsAtAssert_seq : ∀ {inner ss a},
+      IsAtAssert inner a → IsAtAssert (.seq inner ss) a)
+    (h_IsAtAssert_block : ∀ {label σ_parent e_parent inner a},
+      IsAtAssert inner a → IsAtAssert (.block label σ_parent e_parent inner) a)
+    (c₁ c₂ : Config P CmdT)
+    (hv : ∀ a cfg, StepStmtStar P EvalCmd extendEval c₁ cfg →
+      IsAtAssert cfg a → cfg.getEval cfg.getStore a.expr = some HasBool.tt)
+    (hnf : c₁.getEnv.hasFailure = false)
+    (hstep : StepStmt P EvalCmd extendEval c₁ c₂) :
+    c₂.getEnv.hasFailure = false := by
+  induction hstep with
+  | step_cmd hcmd =>
+    simp only [Config.getEnv] at hnf ⊢
+    -- The per-command failure flag can be either true or false.
+    match h : ‹Bool› with
+    | false => simp [hnf, h]
+    | true =>
+      exfalso
+      have ⟨a, hat, hff⟩ := h_failure_implies_assert_ff (h ▸ hcmd)
+      have htt := hv a _ (.refl _) hat
+      simp only [Config.getEval, Config.getStore, Config.getEnv] at htt
+      rw [hff] at htt
+      exact absurd (Option.some.inj htt) HasBool.tt_is_not_ff.symm
+  | step_block | step_funcDecl => simp [Config.getEnv]; exact hnf
+  | step_loop_enter _ _ hff_iff _
+  | step_loop_exit _ _ hff_iff _
+  | step_loop_nondet_enter _ hff_iff | step_loop_nondet_exit _ hff_iff =>
+    simp only [Config.getEnv]
+    have hinv := loop_step_hasInvFailure_false (P := P) (extendEval := extendEval)
+      IsAtAssert h_IsAtAssert_loop rfl hv hff_iff
+    simp [Config.getEnv] at hnf
+    rw [hnf, Bool.false_or]; exact hinv
+  | step_seq_inner h ih =>
+    exact ih
+      (fun a cfg hr hat =>
+        hv a (.seq cfg _) (seq_inner_star P EvalCmd extendEval _ _ _ hr) (h_IsAtAssert_seq hat)) hnf
+  | step_block_body h ih =>
+    exact ih
+      (fun a cfg hr hat =>
+        hv a (.block _ _ _ cfg) (block_inner_star P EvalCmd extendEval _ _ _ _ _ hr) (h_IsAtAssert_block hat)) hnf
+  | _ => intros; exact hnf
+
+omit [HasOps P] in
+theorem allAssertsValid_preserves_noFailure
+    {ρ₀ ρ' : Env P}
+    (st : Stmt P (Cmd P))
+    (hvalid : ∀ (a : AssertId P) (cfg : Config P (Cmd P)),
+      StepStmtStar P (EvalCmd P) extendEval (.stmt st ρ₀) cfg →
+      isAtAssert P cfg a → cfg.getEval cfg.getStore a.expr = some HasBool.tt)
+    (hf₀ : ρ₀.hasFailure = false)
+    (hstar : StepStmtStar P (EvalCmd P) extendEval (.stmt st ρ₀) (.terminal ρ')) :
+    ρ'.hasFailure = false := by
+  suffices h_gen : ∀ c₁ c₂,
+      (∀ a cfg, StepStmtStar P (EvalCmd P) extendEval c₁ cfg →
+        isAtAssert P cfg a → cfg.getEval cfg.getStore a.expr = some HasBool.tt) →
+      c₁.getEnv.hasFailure = false →
+      StepStmtStar P (EvalCmd P) extendEval c₁ c₂ →
+      c₂.getEnv.hasFailure = false by
+    exact h_gen _ _ hvalid hf₀ hstar
+  intro c₁ c₂ hv hnf hstar_c
+  induction hstar_c with
+  | refl => exact hnf
+  | step _ mid _ hstep _ ih =>
+    refine ih
+      (fun a cfg h hat => hv a _ (.step _ _ _ hstep h) hat)
+      (step_preserves_noFailure (P := P) (extendEval := extendEval)
+        (isAtAssert P)
+        (fun hcmd => by
+          cases hcmd with
+          | eval_assert_fail hff _ => exact ⟨⟨_, _⟩, ⟨rfl, rfl⟩, hff⟩)
+        (fun hmem => hmem)
+        (fun h => h)
+        (fun h => h)
+        _ _ hv hnf hstep)
+
+/-! ### hasFailure monotonicity and irrelevance
+
+`hasFailure` is never consulted by any `StepStmt` premise,
+so it is both *monotone* (once `true`, stays `true`) and *irrelevant*
+(changing only `hasFailure` in the input env yields an execution with the
+same `store` and `eval` in the output).
+-/
+
+private theorem step_hasFailure_monotone
+  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
+  {extendEval : ExtendEval P}
+  [HasBool P] [HasBoolOps P] [HasOps P]
+  {c c' : Config P CmdT}
+  (hstep : StepStmt P EvalCmd extendEval c c')
+  (hf : c.getEnv.hasFailure = true) :
+  c'.getEnv.hasFailure = true := by
+  induction hstep with
+  | step_seq_inner _ ih | step_block_body _ ih => exact ih hf
+  | _ => simp_all [Config.getEnv]
+
+theorem EvalStmtSmall_hasFailure_monotone
+  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
+  {extendEval : ExtendEval P}
+  {ρ ρ' : Env P} {s : Stmt P CmdT}
+  [HasBool P] [HasBoolOps P] [HasFvars P] [HasOps P] [HasInt P]:
+  EvalStmtSmall P EvalCmd extendEval ρ s ρ' →
+  ρ.hasFailure = true → ρ'.hasFailure = true := by
+  intro Heval Hf
+  suffices h_gen : ∀ c c', StepStmtStar P EvalCmd extendEval c c' →
+      c.getEnv.hasFailure = true → c'.getEnv.hasFailure = true by
+    exact h_gen _ _ Heval Hf
+  intro c c' hstar hf
+  induction hstar with
+  | refl => exact hf
+  | step _ _ _ hstep _ ih => exact ih (step_hasFailure_monotone hstep hf)
+
+theorem EvalStmtsSmall_hasFailure_monotone
+  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
+  {extendEval : ExtendEval P}
+  {ρ ρ' : Env P} {ss : List (Stmt P CmdT)}
+  [HasBool P] [HasBoolOps P] [HasOps P] :
+  EvalStmtsSmall P EvalCmd extendEval ρ ss ρ' →
+  ρ.hasFailure = true → ρ'.hasFailure = true := by
+  intro Heval Hf
+  suffices h_gen : ∀ c c', StepStmtStar P EvalCmd extendEval c c' →
+      c.getEnv.hasFailure = true → c'.getEnv.hasFailure = true by
+    exact h_gen _ _ Heval Hf
+  intro c c' hstar hf
+  induction hstar with
+  | refl => exact hf
+  | step _ _ _ hstep _ ih => exact ih (step_hasFailure_monotone hstep hf)
+
+theorem StepStmtStar_hasFailure_monotone
+  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
+  {extendEval : ExtendEval P}
+  [HasBool P] [HasBoolOps P] [HasFvars P] [HasOps P] [HasInt P]
+  {c c' : Config P CmdT}
+  (hstar : StepStmtStar P EvalCmd extendEval c c')
+  (hf : c.getEnv.hasFailure = true) :
+  c'.getEnv.hasFailure = true := by
+  induction hstar with
+  | refl => exact hf
+  | step _ _ _ hstep _ ih => exact ih (step_hasFailure_monotone hstep hf)
+
+theorem EvalStmtSmall_hasFailure_irrel
+  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
+  {extendEval : ExtendEval P}
+  {ρ ρ' : Env P} {s : Stmt P CmdT}
+  [HasBool P] [HasBoolOps P] [HasFvars P] [HasOps P] [HasInt P]:
+  EvalStmtSmall P EvalCmd extendEval ρ s ρ' →
+  ∀ (ρ₂ : Env P), ρ₂.store = ρ.store → ρ₂.eval = ρ.eval →
+  ∃ ρ₂', EvalStmtSmall P EvalCmd extendEval ρ₂ s ρ₂' ∧
+    ρ₂'.store = ρ'.store ∧ ρ₂'.eval = ρ'.eval :=
+  smallStep_hasFailure_irrel P EvalCmd extendEval s ρ ρ'
+
+theorem EvalStmtsSmall_hasFailure_irrel
+  {P : PureExpr} {CmdT : Type} {EvalCmd : EvalCmdParam P CmdT}
+  {extendEval : ExtendEval P}
+  {ρ ρ' : Env P} {ss : List (Stmt P CmdT)}
+  [HasBool P] [HasBoolOps P] [HasOps P] :
+  EvalStmtsSmall P EvalCmd extendEval ρ ss ρ' →
+  ∀ (ρ₂ : Env P), ρ₂.store = ρ.store → ρ₂.eval = ρ.eval →
+  ∃ ρ₂', EvalStmtsSmall P EvalCmd extendEval ρ₂ ss ρ₂' ∧
+    ρ₂'.store = ρ'.store ∧ ρ₂'.eval = ρ'.eval := by
+  intro Heval ρ₂ Hstore Heval_eq
+  -- Reuse the simulation-based proof from StmtSemantics
+  -- smallStep_hasFailure_irrel works on .stmt configs; we need .stmts
+  -- Use the same simulation technique directly
+  suffices h_sim : ∀ (c₁ c₂ : Config P CmdT),
+      ConfigSE P c₁ c₂ →
+      ∀ c₁', StepStmtStar P EvalCmd extendEval c₁ c₁' →
+      ∃ c₂', StepStmtStar P EvalCmd extendEval c₂ c₂' ∧ ConfigSE P c₁' c₂' by
+    have heq_init : ConfigSE P (.stmts ss ρ) (.stmts ss ρ₂) := ⟨rfl, Hstore.symm, Heval_eq.symm⟩
+    have ⟨c₂', hstar₂, heq₂⟩ := h_sim _ _ heq_init _ Heval
+    match c₂', heq₂ with
+    | .terminal ρ₂', heq_t => exact ⟨ρ₂', hstar₂, heq_t.1.symm, heq_t.2.symm⟩
+  intro c₁ c₂ heq c₁' hstar
+  induction hstar generalizing c₂ with
+  | refl => exact ⟨c₂, .refl _, heq⟩
+  | step _ mid _ hstep _ ih =>
+    have ⟨mid₂, hstep₂, heq_mid⟩ := step_simulation P EvalCmd extendEval _ _ _ hstep heq
+    have ⟨c₂', hstar₂, heq_final⟩ := ih _ heq_mid
+    exact ⟨c₂', .step _ _ _ hstep₂ hstar₂, heq_final⟩
+
+end -- section
+
+section AssertSetProps
+
+variable {P : PureExpr} [HasFvar P] [HasBool P] [HasBoolOps P] [HasOps P]
+variable {extendEval : ExtendEval P}
+
+/-! ### Assert command properties (statement-level) -/
+
+theorem eval_stmt_assert_store_cst :
+  EvalStmtSmall P (EvalCmd P) extendEval ρ (.cmd (Cmd.assert l e md)) ρ' → ρ.store = ρ'.store := by
+  intro Heval
+  unfold EvalStmtSmall at Heval
+  match Heval with
+  | .step _ _ _ (.step_cmd hcmd) hrest =>
+    cases hrest with
+    | refl => simp; exact eval_assert_store_cst hcmd
+    | step _ _ _ hstep _ => exact absurd hstep (by intro h; cases h)
+
+omit [HasOps P] in
+theorem eval_stmt_assert_eval_cst :
+  EvalStmtSmall P (EvalCmd P) extendEval ρ (.cmd (Cmd.assert l e md)) ρ' → ρ.eval = ρ'.eval := by
+  intro Heval
+  unfold EvalStmtSmall at Heval
+  match Heval with
+  | .step _ _ _ (.step_cmd _) hrest =>
+    cases hrest with
+    | refl => simp
+    | step _ _ _ hstep _ => exact absurd hstep (by intro h; cases h)
+
+theorem eval_stmts_assert_store_cst :
+  EvalStmtsSmall P (EvalCmd P) extendEval ρ [(.cmd (Cmd.assert l e md))] ρ' → ρ.store = ρ'.store := by
+  intro Heval
+  have hstmt : EvalStmtSmall P (EvalCmd P) extendEval ρ (.cmd (Cmd.assert l e md)) ρ' := by
+    unfold EvalStmtsSmall at Heval
+    unfold EvalStmtSmall
+    match Heval with
+    | .step _ _ _ .step_stmts_cons hrest =>
+      have ⟨ρ₁, hterm, htail⟩ := seq_reaches_terminal P (EvalCmd P) extendEval hrest
+      match htail with
+      | .step _ _ _ .step_stmts_nil hrest' =>
+        cases hrest' with
+        | refl => exact hterm
+        | step _ _ _ h _ => exact absurd h (by intro h; cases h)
+  exact eval_stmt_assert_store_cst hstmt
+
+omit [HasOps P] in
+theorem eval_stmt_assert_eq_of_pure_expr_eq :
+  WellFormedSemanticEvalBool ρ.eval →
+  (EvalStmtSmall P (EvalCmd P) extendEval ρ (.cmd (Cmd.assert l1 e md1)) ρ' ↔
+  EvalStmtSmall P (EvalCmd P) extendEval ρ (.cmd (Cmd.assert l2 e md2)) ρ') := by
+  intro Hwf
+  constructor <;>
+  (
+    intro Heval
+    unfold EvalStmtSmall at Heval ⊢
+    match Heval with
+    | .step _ _ _ (.step_cmd hcmd) hrest =>
+      cases hrest with
+      | refl =>
+        cases hcmd with
+        | eval_assert_pass htt _ =>
+          exact .step _ _ _ (.step_cmd (EvalCmd.eval_assert_pass htt Hwf)) (.refl _)
+        | eval_assert_fail hne _ =>
+          exact .step _ _ _ (.step_cmd (EvalCmd.eval_assert_fail hne Hwf)) (.refl _)
+      | step _ _ _ hstep _ => exact absurd hstep (by intro h; cases h)
+  )
+
+/-! ### Assert elimination -/
+
+theorem eval_stmts_assert_elim :
+  WellFormedSemanticEvalBool ρ.eval →
+  EvalStmtsSmall P (EvalCmd P) extendEval ρ (.cmd (.assert l1 e md1) :: cmds) ρ' →
+  ∃ ρ'', EvalStmtsSmall P (EvalCmd P) extendEval ρ cmds ρ'' ∧
+    ρ''.store = ρ'.store ∧ ρ''.eval = ρ'.eval ∧
+    (ρ'.hasFailure = false → ρ''.hasFailure = false) := by
+  intro Hwf Heval
+  unfold EvalStmtsSmall at Heval
+  match Heval with
+  | .step _ _ _ .step_stmts_cons hrest =>
+    have ⟨ρ₁, hterm_assert, htail⟩ := seq_reaches_terminal P (EvalCmd P) extendEval hrest
+    -- The assert takes exactly one step_cmd to terminal
+    have ⟨hcmd, hσ, hδ⟩ : (∃ σ' f, EvalCmd P ρ.eval ρ.store (.assert l1 e md1) σ' f) ∧
+        ρ.store = ρ₁.store ∧ ρ.eval = ρ₁.eval := by
+      match hterm_assert with
+      | .step _ _ _ (.step_cmd hcmd) (.refl _) =>
+        exact ⟨⟨_, _, hcmd⟩, eval_assert_store_cst hcmd, rfl⟩
+    -- Use hasFailure_irrel to re-run cmds from ρ
+    have ⟨ρ'', Hblock, Hstore, Heval_eq⟩ := EvalStmtsSmall_hasFailure_irrel htail ρ hσ hδ
+    -- Determine whether the assert passed or failed
+    match hterm_assert with
+    | .step _ _ _ (.step_cmd hcmd) (.refl _) =>
+      cases hcmd with
+      | eval_assert_pass =>
+        -- ρ₁ = { ρ with hasFailure := ρ.hasFailure || false } = ρ
+        exists ρ'
+        refine ⟨?_, rfl, rfl, id⟩
+        show StepStmtStar P (EvalCmd P) extendEval (.stmts cmds ρ) (.terminal ρ')
+        have h_eta : ρ = { store := ρ.store, eval := ρ.eval, hasFailure := ρ.hasFailure || false } := by
+          cases ρ; simp
+        rw [h_eta]; exact htail
+      | eval_assert_fail =>
+        exists ρ''
+        refine ⟨Hblock, Hstore, Heval_eq, ?_⟩
+        intro Hf
+        -- ρ₁.hasFailure = ρ.hasFailure || true = true
+        -- By monotonicity, ρ'.hasFailure = true, contradicting Hf
+        have hf1 : (Env.mk ρ.store ρ.eval (ρ.hasFailure || true)).hasFailure = true := by simp
+        exact absurd (EvalStmtsSmall_hasFailure_monotone htail hf1) (by simp [Hf])
+
+omit [HasOps P] in
+theorem assert_elim :
+  WellFormedSemanticEvalBool ρ.eval →
+  EvalStmtsSmall P (EvalCmd P) extendEval ρ (.cmd (.assert l1 e md1) :: [.cmd (.assert l2 e md2)]) ρ' →
+  EvalStmtsSmall P (EvalCmd P) extendEval ρ [.cmd (.assert l3 e md3)] ρ' := by
+  intro Hwf Heval
+  unfold EvalStmtsSmall at Heval ⊢
+  -- Invert: first assert
+  match Heval with
+  | .step _ _ _ .step_stmts_cons hrest =>
+    have ⟨ρ₁, hterm1, htail1⟩ := seq_reaches_terminal P (EvalCmd P) extendEval hrest
+    match hterm1 with
+    | .step _ _ _ (.step_cmd hcmd1) (.refl _) =>
+      -- Invert: second assert (from htail1 which is .stmts [assert2] ρ₁ →* .terminal ρ')
+      match htail1 with
+      | .step _ _ _ .step_stmts_cons hrest2 =>
+        have ⟨ρ₂, hterm2, htail2⟩ := seq_reaches_terminal P (EvalCmd P) extendEval hrest2
+        match hterm2 with
+        | .step _ _ _ (.step_cmd hcmd2) (.refl _) =>
+          match htail2 with
+          | .step _ _ _ .step_stmts_nil (.refl _) =>
+            cases hcmd1 with
+            | eval_assert_pass h1 _ =>
+              cases hcmd2 with
+              | eval_assert_pass _ _ =>
+                apply ReflTrans.step _ _ _ .step_stmts_cons
+                apply ReflTrans.step _ _ _ (.step_seq_inner (.step_cmd (EvalCmd.eval_assert_pass h1 Hwf)))
+                apply ReflTrans.step _ _ _ .step_seq_done
+                apply ReflTrans.step _ _ _ .step_stmts_nil
+                simp_all [Bool.or_false]; exact .refl _
+              | eval_assert_fail h2 _ =>
+                simp at h2
+                exact absurd (h1.symm.trans h2)
+                  (by exact fun h => HasBool.tt_is_not_ff (Option.some.inj h))
+            | eval_assert_fail h1 _ =>
+              cases hcmd2 with
+              | eval_assert_pass h2 _ =>
+                simp at h2
+                exact absurd (h2.symm.trans h1)
+                  (by exact fun h => HasBool.tt_is_not_ff (Option.some.inj h))
+              | eval_assert_fail _ _ =>
+                apply ReflTrans.step _ _ _ .step_stmts_cons
+                apply ReflTrans.step _ _ _ (.step_seq_inner (.step_cmd (EvalCmd.eval_assert_fail h1 Hwf)))
+                apply ReflTrans.step _ _ _ .step_seq_done
+                apply ReflTrans.step _ _ _ .step_stmts_nil
+                simp_all [Bool.or_true]; exact .refl _
+
+/-! ### Set command commutation -/
+
+theorem eval_stmt_set_comm
+  [HasVarsImp P (List (Stmt P (Cmd P)))] [HasVarsImp P (Cmd P)] [HasFvars P]
+  [DecidableEq P.Ident]:
+  WellFormedSemanticEvalExprCongr ρ.eval →
+  ¬ x1 = x2 →
+  ¬ x1 ∈ HasFvars.getFvars v2 →
+  ¬ x2 ∈ HasFvars.getFvars v1 →
+  EvalStmtSmall P (EvalCmd P) evalFun ρ (.cmd (Cmd.set x1 (.det v1) md1)) ρ1 →
+  EvalStmtSmall P (EvalCmd P) evalFun ρ1 (.cmd (Cmd.set x2 (.det v2) md2)) ρ' →
+  EvalStmtSmall P (EvalCmd P) evalFun ρ (.cmd (Cmd.set x2 (.det v2) md2')) ρ2 →
+  EvalStmtSmall P (EvalCmd P) evalFun ρ2 (.cmd (Cmd.set x1 (.det v1) md1')) ρ'' →
+  ρ'.store = ρ''.store := by
+  intro Hwf Hneq Hnin1 Hnin2 Hs1 Hs2 Hs3 Hs4
+  unfold EvalStmtSmall at Hs1 Hs2 Hs3 Hs4
+  match Hs1, Hs2, Hs3, Hs4 with
+  | .step _ _ _ (.step_cmd Hc1) (.refl _),
+    .step _ _ _ (.step_cmd Hc2) (.refl _),
+    .step _ _ _ (.step_cmd Hc3) (.refl _),
+    .step _ _ _ (.step_cmd Hc4) (.refl _) =>
+    simp
+    exact eval_cmd_set_comm Hwf Hneq Hnin1 Hnin2 Hc1 Hc2 Hc3 Hc4
+
+theorem eval_stmts_set_comm
+  [HasVarsImp P (List (Stmt P (Cmd P)))] [HasVarsImp P (Cmd P)] [HasFvars P]
+  [DecidableEq P.Ident] :
+  WellFormedSemanticEvalExprCongr ρ.eval →
+  ¬ x1 = x2 →
+  ¬ x1 ∈ HasFvars.getFvars v2 →
+  ¬ x2 ∈ HasFvars.getFvars v1 →
+  EvalStmtsSmall P (EvalCmd P) evalFun ρ [(.cmd (Cmd.set x1 (.det v1) md1)), (.cmd (Cmd.set x2 (.det v2) md2))] ρ' →
+  EvalStmtsSmall P (EvalCmd P) evalFun ρ [(.cmd (Cmd.set x2 (.det v2) md2')), (.cmd (Cmd.set x1 (.det v1) md1'))] ρ'' →
+  ρ'.store = ρ''.store := by
+  intro Hwf Hneq Hnin1 Hnin2 Heval1 Heval2
+  -- Extract the four EvalCmd's from the two list executions
+  have extract := fun (s1 s2 : Stmt P (Cmd P)) (ρ₀ ρ_final : Env P)
+      (h : EvalStmtsSmall P (EvalCmd P) evalFun ρ₀ [s1, s2] ρ_final) =>
+    show ∃ ρ_mid, EvalStmtSmall P (EvalCmd P) evalFun ρ₀ s1 ρ_mid ∧
+        EvalStmtSmall P (EvalCmd P) evalFun ρ_mid s2 ρ_final from by
+      unfold EvalStmtsSmall EvalStmtSmall at *
+      match h with
+      | .step _ _ _ .step_stmts_cons hrest =>
+        have ⟨ρ₁, hterm1, htail1⟩ := seq_reaches_terminal P (EvalCmd P) evalFun hrest
+        match htail1 with
+        | .step _ _ _ .step_stmts_cons hrest2 =>
+          have ⟨ρ₂, hterm2, htail2⟩ := seq_reaches_terminal P (EvalCmd P) evalFun hrest2
+          match htail2 with
+          | .step _ _ _ .step_stmts_nil (.refl _) =>
+            exact ⟨ρ₁, hterm1, hterm2⟩
+  have ⟨ρ_mid1, Hs1, Hs2⟩ := extract _ _ _ _ Heval1
+  have ⟨ρ_mid2, Hs3, Hs4⟩ := extract _ _ _ _ Heval2
+  exact eval_stmt_set_comm Hwf Hneq Hnin1 Hnin2 Hs1 Hs2 Hs3 Hs4
+
+end AssertSetProps
+
+/-! ## `ReflTransT` decomposition helpers
+
+Structural inversion lemmas for multi-step derivations indexed in `Type`
+(so step counts can be used by `termination_by`).  Generic over `CmdT`
+and the command-evaluation parameter. -/
+
+section ReflTransTHelpers
+
+variable {P : PureExpr} {CmdT : Type}
+  [HasBool P] [HasBoolOps P] [HasOps P]
+  {EvalCmd : EvalCmdParam P CmdT} {extendEval : ExtendEval P}
+
+omit [HasOps P] in
+/-- Invert a `.seq` execution reaching terminal in `ReflTransT`: the inner
+    terminates first, then the tail stmts run to terminal.  Length bound
+    is strict so callers can recurse on `hstar.len`. -/
+theorem seqT_reaches_terminal
+    {inner : Config P CmdT} {ss : List (Stmt P CmdT)} {ρ' : Env P}
+    (hstar : ReflTransT (StepStmt P EvalCmd extendEval) (.seq inner ss) (.terminal ρ')) :
+    ∃ (ρ₁ : Env P), ∃ (h1 : ReflTransT (StepStmt P EvalCmd extendEval) inner (.terminal ρ₁)),
+      ∃ (h2 : ReflTransT (StepStmt P EvalCmd extendEval) (.stmts ss ρ₁) (.terminal ρ')),
+      h1.len + h2.len < hstar.len := by
+  match hstar with
+  | .step _ _ _ (.step_seq_inner h) hrest =>
+    have ⟨ρ₁, hterm, htail, hlen⟩ := seqT_reaches_terminal hrest
+    exact ⟨ρ₁, .step _ _ _ h hterm, htail, by simp [ReflTransT.len]; omega⟩
+  | .step _ _ _ .step_seq_done hrest =>
+    exact ⟨_, .refl _, hrest, by show 0 + hrest.len < 1 + hrest.len; omega⟩
+  | .step _ _ _ .step_seq_exit hrest =>
+    match hrest with
+    | .step _ _ _ h _ => exact nomatch h
+
+omit [HasOps P] in
+/-- Invert a `.stmts (s :: rest)` execution reaching terminal in `ReflTransT`. -/
+theorem stmtsT_cons_terminal
+    {s : Stmt P CmdT} {rest : List (Stmt P CmdT)} {ρ₀ ρ' : Env P}
+    (hstar : ReflTransT (StepStmt P EvalCmd extendEval) (.stmts (s :: rest) ρ₀) (.terminal ρ')) :
+    ∃ (ρ₁ : Env P), ∃ (h1 : ReflTransT (StepStmt P EvalCmd extendEval) (.stmt s ρ₀) (.terminal ρ₁)),
+      ∃ (h2 : ReflTransT (StepStmt P EvalCmd extendEval) (.stmts rest ρ₁) (.terminal ρ')),
+      h1.len + h2.len + 2 ≤ hstar.len := by
+  match hstar with
+  | .step _ _ _ .step_stmts_cons hrest =>
+    have ⟨ρ₁, h1, h2, hlen⟩ := seqT_reaches_terminal hrest
+    exact ⟨ρ₁, h1, h2, by simp [ReflTransT.len]; omega⟩
+
+omit [HasOps P] in
+/-- Invert a block execution reaching terminal when the inner config cannot
+    exit: the inner reaches terminal with a strictly shorter derivation. -/
+theorem blockT_reaches_terminal_noExit
+    {inner : Config P CmdT} {l : Option String} {σ_parent : SemanticStore P}
+    {e_parent : SemanticEval P} {ρ' : Env P}
+    (hstar : ReflTransT (StepStmt P EvalCmd extendEval) (.block l σ_parent e_parent inner) (.terminal ρ'))
+    (h_no_exit : ∀ lbl ρ_x,
+      ¬ StepStmtStar P EvalCmd extendEval inner (.exiting lbl ρ_x)) :
+    ∃ (ρ_inner : Env P) (h : ReflTransT (StepStmt P EvalCmd extendEval) inner (.terminal ρ_inner)),
+      ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store, eval := e_parent } ∧
+      h.len < hstar.len := by
+  match hstar with
+  | .step _ (.block _ _ _ inner₁) _ (.step_block_body h) hrest =>
+    have h_no_exit' : ∀ lbl ρ_x,
+        ¬ StepStmtStar P EvalCmd extendEval inner₁ (.exiting lbl ρ_x) := by
+      intro lbl ρ_x hinner₁
+      exact h_no_exit lbl ρ_x (.step _ _ _ h hinner₁)
+    have ⟨ρ_inner, hterm, heq, hlen⟩ := blockT_reaches_terminal_noExit hrest h_no_exit'
+    exact ⟨ρ_inner, .step _ _ _ h hterm, heq, by simp [ReflTransT.len]; omega⟩
+  | .step _ _ _ .step_block_done hrest =>
+    match hrest with
+    | .refl _ => exact ⟨_, .refl _, rfl, by simp [ReflTransT.len]⟩
+    | .step _ _ _ h _ => exact nomatch h
+  | .step _ _ _ (.step_block_exit_match _) hrest =>
+    exfalso
+    exact h_no_exit _ _ (.refl _)
+  | .step _ _ _ (.step_block_exit_mismatch _) hrest =>
+    match hrest with
+    | .step _ _ _ h _ => exact nomatch h
+
+omit [HasOps P] in
+/-- Decompose `.stmts (ss₁ ++ [s])` reaching terminal into: a full `.stmts ss₁`
+    run to some intermediate `ρ₁` followed by a strictly shorter `s`-run.
+    The escape-free hypothesis `hcov` rules out the exiting case. -/
+theorem stmtsT_append_terminal
+    (ss₁ : List (Stmt P CmdT)) (s : Stmt P CmdT) (ρ₀ ρ' : Env P)
+    (hstar : ReflTransT (StepStmt P EvalCmd extendEval) (.stmts (ss₁ ++ [s]) ρ₀) (.terminal ρ'))
+    (hcov : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks (P := P) (CmdT := CmdT) [] ss₁) :
+    ∃ (ρ₁ : Env P), ∃ (_ : StepStmtStar P EvalCmd extendEval (.stmts ss₁ ρ₀) (.terminal ρ₁)),
+      ∃ (hs : ReflTransT (StepStmt P EvalCmd extendEval) (.stmt s ρ₁) (.terminal ρ')),
+      hs.len < hstar.len := by
+  induction ss₁ generalizing ρ₀ with
+  | nil =>
+    have ⟨ρ₁, h1, h2, hlen⟩ := stmtsT_cons_terminal hstar
+    have hρ : ρ₁ = ρ' := by
+      match h2 with
+      | .step _ _ _ .step_stmts_nil (.refl _) => rfl
+    subst hρ
+    exact ⟨ρ₀, .step _ _ _ .step_stmts_nil (.refl _), h1, by grind⟩
+  | cons s' rest' ih =>
+    have ⟨ρ₁, h_s', h_rest, hlen₁⟩ := stmtsT_cons_terminal hstar
+    have ⟨ρ₂, h_rest', h_s, hlen₂⟩ := ih ρ₁ h_rest hcov.2
+    exact ⟨ρ₂,
+      ReflTrans_Transitive _ _ _ _
+        (stmts_cons_step P EvalCmd extendEval s' rest' ρ₀ ρ₁ (reflTransT_to_prop h_s'))
+        h_rest',
+      h_s, by grind⟩
+
+/-! ## Failing-state decomposition helpers -/
+
+omit [HasOps P] in
+/-- Decompose a `.seq` execution reaching a failing config in `ReflTransT`:
+    either failure happens inside `inner`, or `inner` terminates and
+    failure happens in the tail. -/
+theorem seqT_canfail
+    {inner : Config P CmdT} {ss : List (Stmt P CmdT)} {cfg : Config P CmdT}
+    (hstar : ReflTransT (StepStmt P EvalCmd extendEval) (.seq inner ss) cfg)
+    (hf : cfg.getEnv.hasFailure = true) :
+    (∃ (cfg' : Config P CmdT),
+      ∃ (h : ReflTransT (StepStmt P EvalCmd extendEval) inner cfg'),
+        cfg'.getEnv.hasFailure = true ∧ h.len ≤ hstar.len) ∨
+    (∃ (ρ₁ : Env P),
+      ∃ (h1 : ReflTransT (StepStmt P EvalCmd extendEval) inner (.terminal ρ₁)),
+      ∃ (h2 : ReflTransT (StepStmt P EvalCmd extendEval) (.stmts ss ρ₁) cfg),
+        h1.len + h2.len < hstar.len) := by
+  match hstar with
+  | .refl _ => exact .inl ⟨inner, .refl _, hf, Nat.le_refl _⟩
+  | .step _ _ _ (.step_seq_inner h) hrest =>
+    match seqT_canfail hrest hf with
+    | .inl ⟨cfg', h_inner, hf', _⟩ =>
+      exact .inl ⟨cfg', .step _ _ _ h h_inner, hf', by simp [ReflTransT.len]; omega⟩
+    | .inr ⟨ρ₁, h1, h2, _⟩ =>
+      exact .inr ⟨ρ₁, .step _ _ _ h h1, h2, by simp [ReflTransT.len]; omega⟩
+  | .step _ _ _ .step_seq_done hrest =>
+    exact .inr ⟨_, .refl _, hrest, by simp [ReflTransT.len]⟩
+  | .step _ _ _ .step_seq_exit hrest =>
+    match hrest with
+    | .refl _ => exact .inl ⟨_, .refl _, hf, by simp [ReflTransT.len]⟩
+    | .step _ _ _ h _ => exact nomatch h
+
+omit [HasOps P] in
+/-- An empty-statement-list run that reaches a failing config must already
+    have been failing. -/
+theorem stmts_nil_canfail_env
+    {ρ : Env P} {cfg : Config P CmdT}
+    (hstar : StepStmtStar P EvalCmd extendEval
+      (.stmts ([] : List (Stmt P CmdT)) ρ) cfg)
+    (hf : cfg.getEnv.hasFailure = true) :
+    ρ.hasFailure = true := by
+  cases hstar with
+  | refl => exact hf
+  | step _ _ _ h1 r1 => cases h1 with
+    | step_stmts_nil => cases r1 with
+      | refl => exact hf
+      | step _ _ _ h _ => cases h
+
+omit [HasOps P] in
+/-- Decompose `.stmts [s] ρ₀` reaching a failing config: extract a failing
+    trace from `.stmt s ρ₀`, with a length bound `≤`. -/
+theorem stmtsT_singleton_canfail
+    {s : Stmt P CmdT} {ρ₀ : Env P} {cfg : Config P CmdT}
+    (hstar : ReflTransT (StepStmt P EvalCmd extendEval) (.stmts [s] ρ₀) cfg)
+    (hf : cfg.getEnv.hasFailure = true) :
+    ∃ (cfg' : Config P CmdT)
+      (h : ReflTransT (StepStmt P EvalCmd extendEval) (.stmt s ρ₀) cfg'),
+        cfg'.getEnv.hasFailure = true ∧ h.len ≤ hstar.len := by
+  match hstar with
+  | .refl _ =>
+    have hf₀ : ρ₀.hasFailure = true := hf
+    refine ⟨.stmt s ρ₀, .refl _, ?_, ?_⟩
+    · exact hf₀
+    · simp [ReflTransT.len]
+  | .step _ _ _ .step_stmts_cons hrest =>
+    match seqT_canfail hrest hf with
+    | .inl ⟨cfg', h_inner, hf', hlen⟩ =>
+      refine ⟨cfg', h_inner, hf', ?_⟩
+      simp [ReflTransT.len] at hlen ⊢; omega
+    | .inr ⟨ρ_x, h1, h2, hlen⟩ =>
+      have hf_x : ρ_x.hasFailure = true := stmts_nil_canfail_env (reflTransT_to_prop h2) hf
+      refine ⟨_, h1, hf_x, ?_⟩
+      simp [ReflTransT.len] at hlen ⊢; omega
+
+omit [HasOps P] in
+/-- Decompose `.stmts (ss₁ ++ [s])` reaching a failing config: either
+    failure happens before reaching `s`, or `ss₁` terminates at `ρ₁` and
+    the failure happens in `s`. -/
+theorem stmtsT_append_canfail
+    (ss₁ : List (Stmt P CmdT)) (s : Stmt P CmdT) (ρ₀ : Env P)
+    {cfg : Config P CmdT}
+    (hstar : ReflTransT (StepStmt P EvalCmd extendEval)
+      (.stmts (ss₁ ++ [s]) ρ₀) cfg)
+    (hf : cfg.getEnv.hasFailure = true) :
+    (∃ cfg', cfg'.getEnv.hasFailure = true ∧
+      StepStmtStar P EvalCmd extendEval (.stmts ss₁ ρ₀) cfg') ∨
+    (∃ (ρ₁ : Env P),
+      StepStmtStar P EvalCmd extendEval (.stmts ss₁ ρ₀) (.terminal ρ₁) ∧
+      ∃ (cfg₂ : Config P CmdT),
+      ∃ (hs : ReflTransT (StepStmt P EvalCmd extendEval) (.stmt s ρ₁) cfg₂),
+        cfg₂.getEnv.hasFailure = true ∧ hs.len < hstar.len) := by
+  induction ss₁ generalizing ρ₀ with
+  | nil =>
+    match hstar with
+    | .refl _ =>
+      exact .inl ⟨.stmts [] ρ₀, hf, .refl _⟩
+    | .step _ _ _ .step_stmts_cons hrest =>
+      match seqT_canfail hrest hf with
+      | .inl ⟨cfg', h, hf', _⟩ =>
+        exact .inr ⟨ρ₀, .step _ _ _ .step_stmts_nil (.refl _), cfg', h, hf',
+          by simp [ReflTransT.len]; omega⟩
+      | .inr ⟨ρ₁, h1, h2, _⟩ =>
+        exact .inr ⟨ρ₀, .step _ _ _ .step_stmts_nil (.refl _), .terminal ρ₁, h1,
+          stmts_nil_canfail_env (reflTransT_to_prop h2) hf,
+          by simp [ReflTransT.len]; omega⟩
+  | cons s' rest' ih =>
+    match hstar with
+    | .refl _ =>
+      exact .inl ⟨.stmts (s' :: rest') ρ₀, hf, .refl _⟩
+    | .step _ _ _ .step_stmts_cons hrest =>
+      match seqT_canfail hrest hf with
+      | .inl ⟨cfg', h, hf', _⟩ =>
+        exact .inl ⟨.seq cfg' rest', hf',
+          .step _ _ _ .step_stmts_cons
+            (seq_inner_star P EvalCmd extendEval _ cfg' rest' (reflTransT_to_prop h))⟩
+      | .inr ⟨ρ₁, h1, h2, _⟩ =>
+        have hpre := stmts_cons_step P EvalCmd extendEval s' rest' ρ₀ ρ₁
+          (reflTransT_to_prop h1)
+        match ih ρ₁ h2 with
+        | .inl ⟨cfg'_rest, hf'_rest, hstar_rest⟩ =>
+          exact .inl ⟨cfg'_rest, hf'_rest,
+            ReflTrans_Transitive _ _ _ _ hpre hstar_rest⟩
+        | .inr ⟨ρ₂, hterm_rest, cfg₂, hs, hf₂, _⟩ =>
+          exact .inr ⟨ρ₂, ReflTrans_Transitive _ _ _ _ hpre hterm_rest,
+            cfg₂, hs, hf₂, by simp [ReflTransT.len]; omega⟩
+
+omit [HasOps P] in
+/-- Unwrap a failing `.block l σ_parent e_parent inner` execution to a failing run on `inner`. -/
+theorem block_canfail_to_inner
+    {inner : Config P CmdT} {l : Option String} {σ_parent : SemanticStore P}
+    {e_parent : SemanticEval P} {cfg : Config P CmdT}
+    (hstar : StepStmtStar P EvalCmd extendEval (.block l σ_parent e_parent inner) cfg)
+    (hf : cfg.getEnv.hasFailure = true) :
+    ∃ inner', inner'.getEnv.hasFailure = true ∧
+      StepStmtStar P EvalCmd extendEval inner inner' := by
+  suffices h_gen : ∀ src tgt, StepStmtStar P EvalCmd extendEval src tgt →
+      ∀ (inner : Config P CmdT), src = .block l σ_parent e_parent inner →
+      tgt.getEnv.hasFailure = true →
+      ∃ inner', inner'.getEnv.hasFailure = true ∧
+        StepStmtStar P EvalCmd extendEval inner inner' from
+    h_gen _ _ hstar _ rfl hf
+  intro src tgt hstar_g
+  induction hstar_g with
+  | refl =>
+    intro inner hsrc hf; subst hsrc; exact ⟨inner, hf, .refl _⟩
+  | step _ mid _ hstep hrest ih =>
+    intro inner hsrc hf; subst hsrc
+    match hstep with
+    | .step_block_body h =>
+      have ⟨inner', hf', hstar'⟩ := ih _ rfl hf
+      exact ⟨inner', hf', .step _ _ _ h hstar'⟩
+    | .step_block_done
+    | .step_block_exit_match _ | .step_block_exit_mismatch _ =>
+      match hrest with
+      | .refl _ => refine ⟨_, ?_, .refl _⟩; simp [Config.getEnv] at hf ⊢; exact hf
+      | .step _ _ _ h _ => exact nomatch h
+
+omit [HasOps P] in
+/-- Type-level variant of `block_canfail_to_inner` preserving length bounds
+    on the inner derivation.  Required when the inner derivation must
+    decrease for a recursive call. -/
+theorem blockT_canfail_to_inner
+    {inner : Config P CmdT} {l : Option String} {σ_parent : SemanticStore P}
+    {e_parent : SemanticEval P} {cfg : Config P CmdT}
+    (hstar : ReflTransT (StepStmt P EvalCmd extendEval) (.block l σ_parent e_parent inner) cfg)
+    (hf : cfg.getEnv.hasFailure = true) :
+    ∃ (inner' : Config P CmdT),
+      ∃ (h : ReflTransT (StepStmt P EvalCmd extendEval) inner inner'),
+        inner'.getEnv.hasFailure = true ∧ h.len ≤ hstar.len := by
+  match hstar with
+  | .refl _ => exact ⟨inner, .refl _, hf, Nat.le_refl _⟩
+  | .step _ _ _ (.step_block_body h) hrest =>
+    have ⟨inner', h_inner', hf', hlen⟩ := blockT_canfail_to_inner hrest hf
+    exact ⟨inner', .step _ _ _ h h_inner', hf',
+      by simp [ReflTransT.len]; omega⟩
+  | .step _ _ _ .step_block_done hrest =>
+    match hrest with
+    | .refl _ =>
+      refine ⟨.terminal _, .refl _, ?_, by simp [ReflTransT.len]⟩
+      simp [Config.getEnv] at hf ⊢; exact hf
+    | .step _ _ _ h _ => exact nomatch h
+  | .step _ _ _ (.step_block_exit_match _) hrest =>
+    match hrest with
+    | .refl _ =>
+      refine ⟨.exiting _ _, .refl _, ?_, by simp [ReflTransT.len]⟩
+      simp [Config.getEnv] at hf ⊢; exact hf
+    | .step _ _ _ h _ => exact nomatch h
+  | .step _ _ _ (.step_block_exit_mismatch _) hrest =>
+    match hrest with
+    | .refl _ =>
+      refine ⟨.exiting _ _, .refl _, ?_, by simp [ReflTransT.len]⟩
+      simp [Config.getEnv] at hf ⊢; exact hf
+    | .step _ _ _ h _ => exact nomatch h
+  termination_by hstar.len
+  decreasing_by all_goals (simp_wf; try simp [ReflTransT.len]; try omega)
+
+omit [HasOps P] in
+/-- Prop-level seq-canfail decomposition (without length bounds). -/
+theorem seq_canfail_prop
+    {inner : Config P CmdT} {ss : List (Stmt P CmdT)} {cfg : Config P CmdT}
+    (hstar : StepStmtStar P EvalCmd extendEval (.seq inner ss) cfg)
+    (hf : cfg.getEnv.hasFailure = true) :
+    (∃ cfg', cfg'.getEnv.hasFailure = true ∧
+      StepStmtStar P EvalCmd extendEval inner cfg') ∨
+    (∃ ρ₁, StepStmtStar P EvalCmd extendEval inner (.terminal ρ₁) ∧
+      ∃ cfg', cfg'.getEnv.hasFailure = true ∧
+        StepStmtStar P EvalCmd extendEval (.stmts ss ρ₁) cfg') :=
+  match seqT_canfail (reflTrans_to_T hstar) hf with
+  | .inl ⟨cfg', h, hf', _⟩ => .inl ⟨cfg', hf', reflTransT_to_prop h⟩
+  | .inr ⟨ρ₁, h1, h2, _⟩ => .inr ⟨ρ₁, reflTransT_to_prop h1, _, hf, reflTransT_to_prop h2⟩
+
+end ReflTransTHelpers
+
+end -- public section
+end Imperative
diff --git a/Strata/DL/Lambda/Lambda.lean b/Strata/DL/Lambda.lean
similarity index 100%
rename from Strata/DL/Lambda/Lambda.lean
rename to Strata/DL/Lambda.lean
diff --git a/Strata/DL/Lambda/Denote/LExprResolveAnnotated.lean b/Strata/DL/Lambda/Denote/LExprResolveAnnotated.lean
index cdffac5e35..bbf2ca08e4 100644
--- a/Strata/DL/Lambda/Denote/LExprResolveAnnotated.lean
+++ b/Strata/DL/Lambda/Denote/LExprResolveAnnotated.lean
@@ -235,164 +235,119 @@ private theorem ResolveAuxWF.aliasFree_preserved
     `xv` with exactly its context type `xty`. Proved by well-founded induction on
     expression size, mirroring the structure of `resolveAux`. -/
 private theorem resolveAux_allFvarAnnot_aux
-  [DecidableEq T.IDMeta] [HasGen T.IDMeta] :
-    ∀ (n : Nat) (e : LExpr T.mono), e.sizeOf = n →
-    ∀ (C : LContext T) (Env Env' : TEnv T.IDMeta)
-      (et : LExprT T.mono) (xv : T.Identifier) (xty : LMonoTy),
-    resolveAux C Env e = Except.ok (et, Env') →
-    Env.context.types.find? xv = some (.forAll [] xty) →
-    ResolveAuxWF Env →
-    FactoryWF C.functions →
-    LMonoTy.aliasFree Env.context.aliases xty →
+  [DecidableEq T.IDMeta] [HasGen T.IDMeta]
+    (C : LContext T) (Env Env' : TEnv T.IDMeta)
+    (e : LExpr T.mono) (et : LExprT T.mono)
+    (xv : T.Identifier) (xty : LMonoTy)
+    (h_res : resolveAux C Env e = Except.ok (et, Env'))
+    (h_ctx : Env.context.types.find? xv = some (.forAll [] xty))
+    (h_envwf : TEnvWF Env)
+    (h_ne : Env.context.types ≠ [])
+    (h_fwf : FactoryWF C.functions)
+    (h_af : LMonoTy.aliasFree Env.context.aliases xty) :
     LExprT.allFvarAnnot xv xty et := by
-  intro n
-  induction n using Nat.strongRecOn with
-  | _ n ih =>
-    intro e h_eq C Env Env' et xv xty h_res h_ctx ⟨h_envwf, h_ne, h_resolved⟩ h_fwf h_af
-    match e with
-    | .fvar m x fty =>
-      simp only [resolveAux, Bind.bind, Except.bind] at h_res
-      elim_err h_res
-      rename_i v1 h_infer
-      obtain ⟨ty_res, Env_res⟩ := v1
-      simp at h_res h_infer
-      obtain ⟨h_et, h_env'⟩ := h_res
-      subst h_et h_env'
-      simp only [LExprT.allFvarAnnot]
-      intro h_xeq
-      subst h_xeq
-      exact inferFVar_mono_aliasFree C Env x fty ty_res Env_res h_infer h_ctx h_af
-    | .const _ _ =>
-      simp only [resolveAux, Bind.bind, Except.bind] at h_res
-      elim_err h_res
-      rename_i v1 h_ic; obtain ⟨ty, Env1⟩ := v1; simp at h_res
-      obtain ⟨h_et, _⟩ := h_res; subst h_et
-      simp [LExprT.allFvarAnnot]
-    | .op _ _ _ =>
-      simp only [resolveAux, Bind.bind, Except.bind] at h_res
-      elim_errs h_res
-      split at h_res
-      · simp only [Except.ok.injEq, Prod.mk.injEq] at h_res
-        obtain ⟨h_et, _⟩ := h_res; subst h_et; simp [LExprT.allFvarAnnot]
-      · elim_errs h_res
-        simp only [Except.ok.injEq, Prod.mk.injEq] at h_res
-        obtain ⟨h_et, _⟩ := h_res; subst h_et; simp [LExprT.allFvarAnnot]
-    | .bvar _ _ =>
-      simp only [resolveAux] at h_res
-      simp at h_res
-    | .app m e1 e2 =>
-      simp only [resolveAux, Bind.bind, Except.bind] at h_res
-      elim_err h_res
-      rename_i v1 h_res1; obtain ⟨e1t, Env1⟩ := v1; simp at h_res h_res1
-      elim_err h_res
-      rename_i v2 h_res2; obtain ⟨e2t, Env2⟩ := v2; simp at h_res h_res2
-      elim_errs h_res
-      simp only [Except.ok.injEq, Prod.mk.injEq] at h_res
-      obtain ⟨h_et, _⟩ := h_res; subst h_et
-      simp only [LExprT.allFvarAnnot]
-      have h_sz1 : e1.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-      have h_sz2 : e2.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-      have ⟨h_wf1, h_ctx_eq1⟩ := ResolveAuxWF.mk_from_resolveAux (T := T) e1 e1t C Env Env1 h_res1 ⟨h_envwf, h_ne, h_resolved⟩ h_fwf
-      have h_ctx1 : Env1.context.types.find? xv = some (.forAll [] xty) := h_ctx_eq1 ▸ h_ctx
-      exact ⟨ih e1.sizeOf h_sz1 e1 rfl C Env Env1 e1t xv xty h_res1 h_ctx ⟨h_envwf, h_ne, h_resolved⟩ h_fwf h_af,
-             ih e2.sizeOf h_sz2 e2 rfl C Env1 Env2 e2t xv xty h_res2 h_ctx1 h_wf1 h_fwf (ResolveAuxWF.aliasFree_preserved h_ctx_eq1 h_af)⟩
-    | .abs m name bty body =>
-      simp only [resolveAux, Bind.bind, Except.bind] at h_res
-      elim_err h_res
-      rename_i v1 h_tbv; obtain ⟨xv', xty', Env1⟩ := v1; simp at h_res h_tbv
-      elim_err h_res
-      rename_i v2 h_res_body; obtain ⟨et_body, Env2⟩ := v2; simp at h_res h_res_body
-      obtain ⟨h_et, _⟩ := h_res; subst h_et
-      simp only [LExprT.allFvarAnnot]
-      have h_ne_xv : xv ≠ xv' := by
-        intro heq; subst heq
-        have h_fresh := typeBoundVar_xv_fresh_in_context C Env bty xv xty' Env1 h_tbv
-        have h_none := Maps.find?_of_all_none Env.context.types xv h_fresh
-        rw [h_ctx] at h_none; exact absurd h_none (by simp)
-      have h_ctx1 := typeBoundVar_preserves_find C Env bty xv' xty' Env1 h_tbv xv (.forAll [] xty) h_ne_xv h_ctx
-      have h_envwf1 := TEnvWF.of_typeBoundVar C Env bty xv' xty' Env1 h_tbv h_envwf
-      have h_ne1 := typeBoundVar_context_types_ne_nil C Env bty xv' xty' Env1 h_tbv
-      have h_aliases_eq := typeBoundVar_aliases_eq C Env bty xv' xty' Env1 h_tbv
-      have h_resolved1 : TContext.AliasesResolved Env1.context := by
-        intro a h_mem; rw [h_aliases_eq] at h_mem ⊢; exact h_resolved a h_mem
-      have h_af1 : LMonoTy.aliasFree Env1.context.aliases xty := by
-        rw [h_aliases_eq]; exact h_af
-      have h_sz : (LExpr.varOpen 0 (xv', some xty') body).sizeOf < n := by
-        subst h_eq; simp [LExpr.sizeOf, LExpr.varOpen_sizeOf]
-      have h_ih_body := ih _ h_sz _ rfl C Env1 Env2 et_body xv xty h_res_body h_ctx1 ⟨h_envwf1, h_ne1, h_resolved1⟩ h_fwf h_af1
-      exact allFvarAnnot_varCloseT_ne xv xv' xty 0 et_body h_ih_body
-    | .quant m qk name bty tr body =>
-      simp only [resolveAux, Bind.bind, Except.bind] at h_res
-      elim_err h_res
-      rename_i v1 h_tbv; obtain ⟨xv', xty', Env1⟩ := v1; simp at h_res h_tbv
-      elim_err h_res
-      rename_i v2 h_res_body; obtain ⟨et_body, Env2⟩ := v2; simp at h_res h_res_body
-      elim_err h_res
-      rename_i v3 h_res_tr; obtain ⟨et_tr, Env3⟩ := v3; simp at h_res h_res_tr
-      split at h_res <;> cases h_res
-      simp only [LExprT.allFvarAnnot]
-      have h_ne_xv : xv ≠ xv' := by
-        intro heq; subst heq
-        have h_fresh := typeBoundVar_xv_fresh_in_context C Env bty xv xty' Env1 h_tbv
-        have h_none := Maps.find?_of_all_none Env.context.types xv h_fresh
-        rw [h_ctx] at h_none; exact absurd h_none (by simp)
-      have h_ctx1 := typeBoundVar_preserves_find C Env bty xv' xty' Env1 h_tbv xv (.forAll [] xty) h_ne_xv h_ctx
-      have h_envwf1 := TEnvWF.of_typeBoundVar C Env bty xv' xty' Env1 h_tbv h_envwf
-      have h_ne1 := typeBoundVar_context_types_ne_nil C Env bty xv' xty' Env1 h_tbv
-      have h_aliases_eq := typeBoundVar_aliases_eq C Env bty xv' xty' Env1 h_tbv
-      have h_resolved1 : TContext.AliasesResolved Env1.context := by
-        intro a h_mem; rw [h_aliases_eq] at h_mem ⊢; exact h_resolved a h_mem
-      have h_af1 : LMonoTy.aliasFree Env1.context.aliases xty := by
-        rw [h_aliases_eq]; exact h_af
-      have h_sz_body : (LExpr.varOpen 0 (xv', some xty') body).sizeOf < n := by
-        subst h_eq; simp [LExpr.sizeOf, LExpr.varOpen_sizeOf]; omega
-      have h_ih_body := ih _ h_sz_body _ rfl C Env1 Env2 et_body xv xty h_res_body h_ctx1 ⟨h_envwf1, h_ne1, h_resolved1⟩ h_fwf h_af1
-      have ⟨h_wf2, h_ctx_eq2⟩ := ResolveAuxWF.mk_from_resolveAux (T := T)
-        (LExpr.varOpen 0 (xv', some xty') body) et_body C Env1 Env2 h_res_body ⟨h_envwf1, h_ne1, h_resolved1⟩ h_fwf
-      have h_ctx2 := h_ctx_eq2 ▸ h_ctx1
-      have h_sz_tr : (LExpr.varOpen 0 (xv', some xty') tr).sizeOf < n := by
-        subst h_eq; simp [LExpr.sizeOf, LExpr.varOpen_sizeOf]; omega
-      have h_ih_tr := ih _ h_sz_tr _ rfl C Env2 Env3 et_tr xv xty h_res_tr h_ctx2 h_wf2 h_fwf (ResolveAuxWF.aliasFree_preserved h_ctx_eq2 h_af1)
-      exact ⟨allFvarAnnot_varCloseT_ne xv xv' xty 0 et_tr h_ih_tr,
-             allFvarAnnot_varCloseT_ne xv xv' xty 0 et_body h_ih_body⟩
-    | .ite m c th el =>
-      simp only [resolveAux, Bind.bind, Except.bind] at h_res
-      elim_err h_res
-      rename_i v1 h_res_c; obtain ⟨ct, Env1⟩ := v1; simp at h_res h_res_c
-      elim_err h_res
-      rename_i v2 h_res_th; obtain ⟨tht, Env2⟩ := v2; simp at h_res h_res_th
-      elim_err h_res
-      rename_i v3 h_res_el; obtain ⟨elt, Env3⟩ := v3; simp at h_res h_res_el
-      elim_err h_res
+  revert h_af h_ctx xty xv
+  apply resolveAux_ind
+    (P := fun e et _C Env _Env' => ∀ (xv : T.Identifier) (xty : LMonoTy),
+      Env.context.types.find? xv = some (.forAll [] xty) →
+      LMonoTy.aliasFree Env.context.aliases xty →
+      LExprT.allFvarAnnot xv xty et)
+    (e := e) (et := et) (C := C) (Env := Env) (Env' := Env')
+    (h_res := h_res) (h_envwf := h_envwf) (h_ne := h_ne) (h_fwf := h_fwf)
+  case h_const =>
+    intro m c et C Env Env' h_res h_envwf h_ne h_fwf xv xty h_ctx h_af
+    simp only [resolveAux, Bind.bind, Except.bind] at h_res
+    elim_err h_res
+    rename_i v1 h_ic; obtain ⟨ty, Env1⟩ := v1; simp at h_res
+    obtain ⟨h_et, _⟩ := h_res; subst h_et
+    simp [LExprT.allFvarAnnot]
+  case h_op =>
+    intro m o oty et C Env Env' h_res h_envwf h_ne h_fwf xv xty h_ctx h_af
+    simp only [resolveAux, Bind.bind, Except.bind] at h_res
+    elim_errs h_res
+    split at h_res
+    · simp only [Except.ok.injEq, Prod.mk.injEq] at h_res
+      obtain ⟨h_et, _⟩ := h_res; subst h_et; simp [LExprT.allFvarAnnot]
+    · elim_errs h_res
       simp only [Except.ok.injEq, Prod.mk.injEq] at h_res
-      obtain ⟨h_et, _⟩ := h_res; subst h_et
-      simp only [LExprT.allFvarAnnot]
-      have h_sz_c : c.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-      have h_sz_th : th.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-      have h_sz_el : el.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-      have ⟨h_wf1, h_ctx_eq1⟩ := ResolveAuxWF.mk_from_resolveAux (T := T) c ct C Env Env1 h_res_c ⟨h_envwf, h_ne, h_resolved⟩ h_fwf
-      have h_ctx1 : Env1.context.types.find? xv = some (.forAll [] xty) := h_ctx_eq1 ▸ h_ctx
-      have ⟨h_wf2, h_ctx_eq2⟩ := ResolveAuxWF.mk_from_resolveAux (T := T) th tht C Env1 Env2 h_res_th h_wf1 h_fwf
-      have h_ctx2 : Env2.context.types.find? xv = some (.forAll [] xty) := h_ctx_eq2 ▸ h_ctx1
-      exact ⟨ih c.sizeOf h_sz_c c rfl C Env Env1 ct xv xty h_res_c h_ctx ⟨h_envwf, h_ne, h_resolved⟩ h_fwf h_af,
-             ih th.sizeOf h_sz_th th rfl C Env1 Env2 tht xv xty h_res_th h_ctx1 h_wf1 h_fwf (ResolveAuxWF.aliasFree_preserved h_ctx_eq1 h_af),
-             ih el.sizeOf h_sz_el el rfl C Env2 Env3 elt xv xty h_res_el h_ctx2 h_wf2 h_fwf (ResolveAuxWF.aliasFree_preserved h_ctx_eq2 (ResolveAuxWF.aliasFree_preserved h_ctx_eq1 h_af))⟩
-    | .eq m e1 e2 =>
-      simp only [resolveAux, Bind.bind, Except.bind] at h_res
-      elim_err h_res
-      rename_i v1 h_res1; obtain ⟨e1t, Env1⟩ := v1; simp at h_res h_res1
-      elim_err h_res
-      rename_i v2 h_res2; obtain ⟨e2t, Env2⟩ := v2; simp at h_res h_res2
-      elim_err h_res
-      simp only [Except.ok.injEq, Prod.mk.injEq] at h_res
-      obtain ⟨h_et, _⟩ := h_res; subst h_et
-      simp only [LExprT.allFvarAnnot]
-      have h_sz1 : e1.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-      have h_sz2 : e2.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-      have ⟨h_wf1, h_ctx_eq1⟩ := ResolveAuxWF.mk_from_resolveAux (T := T) e1 e1t C Env Env1 h_res1 ⟨h_envwf, h_ne, h_resolved⟩ h_fwf
-      have h_ctx1 : Env1.context.types.find? xv = some (.forAll [] xty) := h_ctx_eq1 ▸ h_ctx
-      exact ⟨ih e1.sizeOf h_sz1 e1 rfl C Env Env1 e1t xv xty h_res1 h_ctx ⟨h_envwf, h_ne, h_resolved⟩ h_fwf h_af,
-             ih e2.sizeOf h_sz2 e2 rfl C Env1 Env2 e2t xv xty h_res2 h_ctx1 h_wf1 h_fwf (ResolveAuxWF.aliasFree_preserved h_ctx_eq1 h_af)⟩
+      obtain ⟨h_et, _⟩ := h_res; subst h_et; simp [LExprT.allFvarAnnot]
+  case h_fvar =>
+    intro m x fty et C Env Env' h_res h_envwf h_ne h_fwf xv xty h_ctx h_af
+    simp only [resolveAux, Bind.bind, Except.bind] at h_res
+    elim_err h_res
+    rename_i v1 h_infer
+    obtain ⟨ty_res, Env_res⟩ := v1
+    simp at h_res h_infer
+    obtain ⟨h_et, h_env'⟩ := h_res
+    subst h_et h_env'
+    simp only [LExprT.allFvarAnnot]
+    intro h_xeq
+    subst h_xeq
+    exact inferFVar_mono_aliasFree C Env x fty ty_res Env_res h_infer h_ctx h_af
+  case h_app =>
+    intro m e1 e2 et C Env Env' e1t Env1 e2t Env2 fresh_name Env_gen substInfo
+      h_res h1 h2 h_gen h_unify h_et _ _ _ _ _ _ h_envwf h_ne h_fwf h_envwf1 h_ctx1 h_envwf2 h_ctx2
+      h_ih1 h_ih2 xv xty h_ctx h_af
+    subst h_et
+    simp only [LExprT.allFvarAnnot]
+    have h_ctx1' : Env1.context.types.find? xv = some (.forAll [] xty) := h_ctx1 ▸ h_ctx
+    have h_af1 : LMonoTy.aliasFree Env1.context.aliases xty := h_ctx1 ▸ h_af
+    exact ⟨h_ih1 xv xty h_ctx h_af, h_ih2 xv xty h_ctx1' h_af1⟩
+  case h_abs =>
+    intro m name bty body et C Env Env' xvb xtyb Env1 et_body Env2
+      h_res h_tbv h_res_body h_et h_env' h_envwf h_ne h_fwf h_envwf1 h_ne1 h_aliases_eq
+      h_ih xv xty h_ctx h_af
+    subst h_et
+    simp only [LExprT.allFvarAnnot]
+    have h_ne_xv : xv ≠ xvb := by
+      intro heq; subst heq
+      have h_fresh := typeBoundVar_xv_fresh_in_context C Env bty xv xtyb Env1 h_tbv
+      have h_none := Maps.find?_of_all_none Env.context.types xv h_fresh
+      rw [h_ctx] at h_none; exact absurd h_none (by simp)
+    have h_ctx1 := typeBoundVar_preserves_find C Env bty xvb xtyb Env1 h_tbv xv (.forAll [] xty) h_ne_xv h_ctx
+    have h_af1 : LMonoTy.aliasFree Env1.context.aliases xty := h_aliases_eq ▸ h_af
+    have h_ih_body := h_ih xv xty h_ctx1 h_af1
+    exact allFvarAnnot_varCloseT_ne xv xvb xty 0 et_body h_ih_body
+  case h_quant =>
+    intro m qk name bty triggers body et C Env Env' xvb xtyb Env1 et_body Env2 et_tr Env3
+      h_res h_tbv h_res_body h_res_tr h_et h_env' _ h_envwf h_ne h_fwf h_envwf1 h_ne1 h_aliases_eq
+      h_envwf2 h_ctx2 h_ih_body h_ih_tr xv xty h_ctx h_af
+    subst h_et
+    simp only [LExprT.allFvarAnnot]
+    have h_ne_xv : xv ≠ xvb := by
+      intro heq; subst heq
+      have h_fresh := typeBoundVar_xv_fresh_in_context C Env bty xv xtyb Env1 h_tbv
+      have h_none := Maps.find?_of_all_none Env.context.types xv h_fresh
+      rw [h_ctx] at h_none; exact absurd h_none (by simp)
+    have h_ctx1 := typeBoundVar_preserves_find C Env bty xvb xtyb Env1 h_tbv xv (.forAll [] xty) h_ne_xv h_ctx
+    have h_af1 : LMonoTy.aliasFree Env1.context.aliases xty := h_aliases_eq ▸ h_af
+    have h_ctx2' : Env2.context.types.find? xv = some (.forAll [] xty) := h_ctx2 ▸ h_ctx1
+    have h_af2 : LMonoTy.aliasFree Env2.context.aliases xty :=
+      (congrArg TContext.aliases h_ctx2) ▸ h_af1
+    have h_ih_b := h_ih_body xv xty h_ctx1 h_af1
+    have h_ih_t := h_ih_tr xv xty h_ctx2' h_af2
+    exact ⟨allFvarAnnot_varCloseT_ne xv xvb xty 0 et_tr h_ih_t,
+           allFvarAnnot_varCloseT_ne xv xvb xty 0 et_body h_ih_b⟩
+  case h_eq =>
+    intro m e1 e2 et C Env Env' e1t Env1 e2t Env2 substInfo
+      h_res h1 h2 h_unify h_et _ _ _ h_envwf h_ne h_fwf h_envwf1 h_ctx1 h_envwf2 h_ctx2
+      h_ih1 h_ih2 xv xty h_ctx h_af
+    subst h_et
+    simp only [LExprT.allFvarAnnot]
+    have h_ctx1' : Env1.context.types.find? xv = some (.forAll [] xty) := h_ctx1 ▸ h_ctx
+    have h_af1 : LMonoTy.aliasFree Env1.context.aliases xty := h_ctx1 ▸ h_af
+    exact ⟨h_ih1 xv xty h_ctx h_af, h_ih2 xv xty h_ctx1' h_af1⟩
+  case h_ite =>
+    intro m c th el et C Env Env' ct Env1 tht Env2 elt Env3 substInfo
+      h_res hc ht he h_unify h_et _ _ _ h_envwf h_ne h_fwf h_envwf1 h_ctx1 h_envwf2 h_ctx2
+      h_envwf3 h_ctx3 h_ihc h_iht h_ihe xv xty h_ctx h_af
+    subst h_et
+    simp only [LExprT.allFvarAnnot]
+    have h_ctx1' : Env1.context.types.find? xv = some (.forAll [] xty) := h_ctx1 ▸ h_ctx
+    have h_af1 : LMonoTy.aliasFree Env1.context.aliases xty := h_ctx1 ▸ h_af
+    have h_ctx2' : Env2.context.types.find? xv = some (.forAll [] xty) := h_ctx2 ▸ h_ctx
+    have h_af2 : LMonoTy.aliasFree Env2.context.aliases xty := h_ctx2 ▸ h_af
+    exact ⟨h_ihc xv xty h_ctx h_af, h_iht xv xty h_ctx1' h_af1, h_ihe xv xty h_ctx2' h_af2⟩
 
 /-- `resolveAux` annotates every free occurrence of a context variable with its
     context type. Public interface to `resolveAux_allFvarAnnot_aux`. -/
@@ -405,11 +360,10 @@ theorem resolveAux_allFvarAnnot [DecidableEq T.IDMeta] [HasGen T.IDMeta]
     (h_envwf : TEnvWF Env)
     (h_ne : Env.context.types ≠ [])
     (h_fwf : FactoryWF C.functions)
-    (h_resolved : TContext.AliasesResolved Env.context)
     (h_af : LMonoTy.aliasFree Env.context.aliases xty) :
-    LExprT.allFvarAnnot xv xty et := by
-  exact resolveAux_allFvarAnnot_aux e.sizeOf e rfl C Env Env' et xv xty
-    h_res h_ctx ⟨h_envwf, h_ne, h_resolved⟩ h_fwf h_af
+    LExprT.allFvarAnnot xv xty et :=
+  resolveAux_allFvarAnnot_aux C Env Env' e et xv xty
+    h_res h_ctx h_envwf h_ne h_fwf h_af
 
 omit [Std.ToFormat T.IDMeta] in
 /-- Generalized `varCloseT` typing: if `et` is well-typed in context `Δ` and every
@@ -589,21 +543,25 @@ theorem resolve_TEnvWF [DecidableEq T.IDMeta] [HasGen T.IDMeta]
 /-- Core soundness lemma: for any substitution `S` absorbing the output substitution,
     the resolved and substituted expression satisfies `HasTypeA`. Proved by
     well-founded induction on expression size. -/
-private theorem resolveAux_HasTypeA_aux [DecidableEq T.IDMeta] [HasGen T.IDMeta] :
-    ∀ (n : Nat) (e : LExpr T.mono), e.sizeOf = n →
-      ∀ (et : LExprT T.mono) (C : LContext T) (Env Env' : TEnv T.IDMeta),
-      resolveAux C Env e = Except.ok (et, Env') →
-      ResolveAuxWF Env →
-      FactoryWF C.functions →
+private theorem resolveAux_HasTypeA_aux [DecidableEq T.IDMeta] [HasGen T.IDMeta]
+    (e : LExpr T.mono) (et : LExprT T.mono) (C : LContext T)
+    (Env Env' : TEnv T.IDMeta)
+    (h_res : resolveAux C Env e = Except.ok (et, Env'))
+    (h_envwf : TEnvWF Env)
+    (h_ne : Env.context.types ≠ [])
+    (h_fwf : FactoryWF C.functions)
+    (h_resolved : TContext.AliasesResolved Env.context)
+    (S : Subst) (h_absorbs : Subst.absorbs S Env'.stateSubstInfo.subst) :
+    HasTypeA [] (applySubstT et S).unresolved ((applySubstT et S).toLMonoTy) := by
+  revert h_absorbs S h_resolved
+  apply resolveAux_ind
+    (P := fun e et _C Env Env' => TContext.AliasesResolved Env.context →
       ∀ (S : Subst), Subst.absorbs S Env'.stateSubstInfo.subst →
-      HasTypeA [] (applySubstT et S).unresolved
-                 ((applySubstT et S).toLMonoTy) := by
-  intro n
-  induction n using Nat.strongRecOn with
-  | _ n ih =>
-  intro e h_eq et C Env Env' h ⟨h_envwf, h_ne, h_resolved⟩ h_fwf S h_absorbs
-  match e with
-  | .const _ _ =>
+        HasTypeA [] (applySubstT et S).unresolved ((applySubstT et S).toLMonoTy))
+    (e := e) (et := et) (C := C) (Env := Env) (Env' := Env')
+    (h_res := h_res) (h_envwf := h_envwf) (h_ne := h_ne) (h_fwf := h_fwf)
+  case h_const =>
+    intro m c et C Env Env' h h_envwf h_ne h_fwf h_resolved S h_absorbs
     simp only [resolveAux, inferConst, Bind.bind, Except.bind] at h
     elim_err h
     have heq := h
@@ -619,19 +577,20 @@ private theorem resolveAux_HasTypeA_aux [DecidableEq T.IDMeta] [HasGen T.IDMeta]
       rw [LConst.ty_subst]
       exact HasTypeA.const
     · simp at heq_inferConst
-  | .op _ _ _ =>
+  case h_op =>
+    intro m o oty et C Env Env' h h_envwf h_ne h_fwf h_resolved S h_absorbs
     simp only [resolveAux, Bind.bind, Except.bind] at h
     elim_errs h
     split at h
-    . cases h
+    · cases h
       simp [applySubstT, replaceMetadata, unresolved, toLMonoTy]
       exact HasTypeA.op
-    . elim_errs h
+    · elim_errs h
       cases h
       simp [applySubstT, replaceMetadata, unresolved, toLMonoTy]
       exact HasTypeA.op
-  | .bvar _ _ => simp [resolveAux] at h
-  | .fvar _ _ _ =>
+  case h_fvar =>
+    intro m x fty et C Env Env' h h_envwf h_ne h_fwf h_resolved S h_absorbs
     simp only [resolveAux, Bind.bind, Except.bind] at h
     elim_err h
     rename_i ty_env h_infer
@@ -640,153 +599,68 @@ private theorem resolveAux_HasTypeA_aux [DecidableEq T.IDMeta] [HasGen T.IDMeta]
     subst h_et h_env
     simp [applySubstT, replaceMetadata, unresolved, toLMonoTy]
     exact HasTypeA.fvar
-  | .app m_app e1 e2 =>
-    simp only [resolveAux, Bind.bind, Except.bind] at h
-    elim_err h
-    rename_i e1t_env heq_e1
-    elim_err h
-    rename_i e2t_env heq_e2
-    elim_err h
-    rename_i genEnv heq_gen
-    elim_err h
-    rename_i substInfo heq_unify
-    cases h
-    have h_unify : Constraints.unify
-        [(toLMonoTy e1t_env.fst, LMonoTy.tcons "arrow" [toLMonoTy e2t_env.fst, LMonoTy.ftvar genEnv.fst])]
-        genEnv.snd.stateSubstInfo = .ok substInfo :=
-      unify_of_mapError heq_unify
-    have h_gen_subst := TEnv.genTyVar_subst e2t_env.snd genEnv.fst genEnv.snd heq_gen
-    have h_gen_ctx := TEnv.genTyVar_context e2t_env.snd genEnv.fst genEnv.snd heq_gen
-    have h_gen_tyGen := genTyVar_tyGen e2t_env.snd genEnv.fst genEnv.snd heq_gen
-    have h_gen_name := genTyVar_name_eq e2t_env.snd genEnv.fst genEnv.snd heq_gen
-    have ⟨h_wf1, _⟩ := ResolveAuxWF.mk_from_resolveAux (T := T) e1 e1t_env.fst C Env e1t_env.snd heq_e1 ⟨h_envwf, h_ne, h_resolved⟩ h_fwf
-    have h_props1 := resolveAux_properties e1 e1t_env.fst C Env e1t_env.snd heq_e1
-      h_ne h_envwf.aliasesWF h_fwf h_envwf.substFreshForGen h_envwf.ctxFreshForGen
-      h_envwf.boundVarsFresh
-    have h_props2 := resolveAux_properties e2 e2t_env.fst C e1t_env.snd e2t_env.snd heq_e2
-      h_wf1.ne h_wf1.envwf.aliasesWF h_fwf h_wf1.envwf.substFreshForGen h_wf1.envwf.ctxFreshForGen
-      h_wf1.envwf.boundVarsFresh
-    -- Absorption: h_absorbs : S.absorbs (Maps.remove substInfo.subst genEnv.fst)
-    have h_abs_S_rem : S.absorbs (Maps.remove substInfo.subst genEnv.fst) := by
-      simp [TEnv.updateSubst] at h_absorbs; exact h_absorbs
-    rw [h_gen_subst] at h_unify
-    have h_abs_unify := Constraints.unify_absorbs _ _ _ h_unify
-    -- Freshness: genEnv.fst not in Env.subst and e1t_env.snd.subst
-    have h_fresh_Env : Maps.find? Env.stateSubstInfo.subst genEnv.fst = none ∧
-        (∀ a t, Maps.find? Env.stateSubstInfo.subst a = some t →
-          genEnv.fst ∉ LMonoTy.freeVars t) :=
-      genTyVar_fresh_wrt_input_subst Env e2t_env.snd genEnv.snd genEnv.fst heq_gen
-        h_envwf.substFreshForGen
-        (Nat.le_trans h_props1.genState_mono h_props2.genState_mono)
-    have h_fresh_e1 : Maps.find? e1t_env.snd.stateSubstInfo.subst genEnv.fst = none ∧
-        (∀ a t, Maps.find? e1t_env.snd.stateSubstInfo.subst a = some t →
-          genEnv.fst ∉ LMonoTy.freeVars t) :=
-      genTyVar_fresh_wrt_input_subst e1t_env.snd e2t_env.snd genEnv.snd genEnv.fst heq_gen
-        h_wf1.envwf.substFreshForGen h_props2.genState_mono
-    have h_fresh_e2 : Maps.find? e2t_env.snd.stateSubstInfo.subst genEnv.fst = none ∧
-        (∀ a t, Maps.find? e2t_env.snd.stateSubstInfo.subst a = some t →
-          genEnv.fst ∉ LMonoTy.freeVars t) :=
-      genTyVar_fresh_wrt_input_subst e2t_env.snd e2t_env.snd genEnv.snd genEnv.fst heq_gen
-        h_props2.preserves.1 (Nat.le_refl _)
-    have h_abs_rem_e2 := Subst.absorbs_of_remove
-      substInfo.subst e2t_env.snd.stateSubstInfo.subst genEnv.fst
-      h_abs_unify h_fresh_e2.1 h_fresh_e2.2
-    have h_abs_rem_e1 := Subst.absorbs_of_remove
-      substInfo.subst e1t_env.snd.stateSubstInfo.subst genEnv.fst
-      (Subst.absorbs_trans _ _ _ h_props2.absorbs h_abs_unify)
-      h_fresh_e1.1 h_fresh_e1.2
-    have h_abs_e2 : S.absorbs e2t_env.snd.stateSubstInfo.subst :=
+  case h_app =>
+    intro m e1 e2 et C Env Env' e1t Env1 e2t Env2 fresh_name Env_gen substInfo
+      h_res h1 h2 h_gen h_unify h_et h_subeq h_abs_rem_e1 h_abs_rem_e2
+      h_e1t_no_fresh h_e2t_no_fresh h_unify_eq
+      h_envwf h_ne h_fwf h_envwf1 h_ctx1 h_envwf2 h_ctx2 h_ih1 h_ih2 h_resolved S h_absorbs
+    subst h_et
+    rw [h_subeq] at h_absorbs
+    have h_abs_S_rem := h_absorbs
+    have h_abs_e2 : S.absorbs Env2.stateSubstInfo.subst :=
       Subst.absorbs_trans _ _ _ h_abs_rem_e2 h_abs_S_rem
-    have h_abs_e1 : S.absorbs e1t_env.snd.stateSubstInfo.subst :=
+    have h_abs_e1 : S.absorbs Env1.stateSubstInfo.subst :=
       Subst.absorbs_trans _ _ _ h_abs_rem_e1 h_abs_S_rem
-    -- fresh_name ∉ freeVars e1t.toLMonoTy and e2t.toLMonoTy
-    have h_e1t_no_fresh : genEnv.fst ∉ LMonoTy.freeVars e1t_env.fst.toLMonoTy := by
-      intro h_mem
-      exact absurd h_gen_name
-        (h_props1.preserves.2 genEnv.fst h_mem e2t_env.snd.genEnv.genState.tyGen
-          h_props2.genState_mono)
-    have h_e2t_no_fresh : genEnv.fst ∉ LMonoTy.freeVars e2t_env.fst.toLMonoTy := by
-      intro h_mem
-      exact absurd h_gen_name
-        (h_props2.preserves.2 genEnv.fst h_mem e2t_env.snd.genEnv.genState.tyGen
-          (Nat.le_refl _))
-    -- Unification soundness + absorption to derive type equality
-    have h_unify_eq : LMonoTy.subst substInfo.subst e1t_env.fst.toLMonoTy =
-        LMonoTy.subst substInfo.subst
-          (LMonoTy.tcons "arrow" [e2t_env.fst.toLMonoTy, .ftvar genEnv.fst]) := by
-      have h_p := Constraints.unify_sound _ _ _ h_unify _ (List.Mem.head _)
-      simp at h_p; exact h_p
-    have h_subst_e1t : LMonoTy.subst S (LMonoTy.subst substInfo.subst e1t_env.fst.toLMonoTy) =
-        LMonoTy.subst S e1t_env.fst.toLMonoTy := by
-      rw [← LMonoTy.subst_remove_not_fv substInfo.subst genEnv.fst
-            e1t_env.fst.toLMonoTy h_e1t_no_fresh]
-      exact LMonoTy.subst_absorbs S (Maps.remove substInfo.subst genEnv.fst)
-        e1t_env.fst.toLMonoTy h_abs_S_rem
-    have h_subst_e2t : LMonoTy.subst S (LMonoTy.subst substInfo.subst e2t_env.fst.toLMonoTy) =
-        LMonoTy.subst S e2t_env.fst.toLMonoTy := by
-      rw [← LMonoTy.subst_remove_not_fv substInfo.subst genEnv.fst
-            e2t_env.fst.toLMonoTy h_e2t_no_fresh]
-      exact LMonoTy.subst_absorbs S (Maps.remove substInfo.subst genEnv.fst)
-        e2t_env.fst.toLMonoTy h_abs_S_rem
-    -- Key equality: subst S e1t.toLMonoTy = arrow [subst S e2t.toLMonoTy, subst S (subst substInfo (ftvar fresh))]
-    have h_eq_S : LMonoTy.subst S e1t_env.fst.toLMonoTy =
+    have h_resolved1 : TContext.AliasesResolved Env1.context := h_ctx1 ▸ h_resolved
+    have h_subst_e1t : LMonoTy.subst S (LMonoTy.subst substInfo.subst e1t.toLMonoTy) =
+        LMonoTy.subst S e1t.toLMonoTy := by
+      rw [← LMonoTy.subst_remove_not_fv substInfo.subst fresh_name
+            e1t.toLMonoTy h_e1t_no_fresh]
+      exact LMonoTy.subst_absorbs S (Maps.remove substInfo.subst fresh_name)
+        e1t.toLMonoTy h_abs_S_rem
+    have h_subst_e2t : LMonoTy.subst S (LMonoTy.subst substInfo.subst e2t.toLMonoTy) =
+        LMonoTy.subst S e2t.toLMonoTy := by
+      rw [← LMonoTy.subst_remove_not_fv substInfo.subst fresh_name
+            e2t.toLMonoTy h_e2t_no_fresh]
+      exact LMonoTy.subst_absorbs S (Maps.remove substInfo.subst fresh_name)
+        e2t.toLMonoTy h_abs_S_rem
+    have h_eq_S : LMonoTy.subst S e1t.toLMonoTy =
         LMonoTy.tcons "arrow"
-          [LMonoTy.subst S e2t_env.fst.toLMonoTy,
-           LMonoTy.subst S (LMonoTy.subst substInfo.subst (.ftvar genEnv.fst))] := by
+          [LMonoTy.subst S e2t.toLMonoTy,
+           LMonoTy.subst S (LMonoTy.subst substInfo.subst (.ftvar fresh_name))] := by
       have h_congr := congrArg (LMonoTy.subst S) h_unify_eq
       rw [h_subst_e1t] at h_congr
       rw [LMonoTy.subst_tcons_pair substInfo.subst "arrow"
-            e2t_env.fst.toLMonoTy (.ftvar genEnv.fst)] at h_congr
+            e2t.toLMonoTy (.ftvar fresh_name)] at h_congr
       rw [LMonoTy.subst_tcons_pair S "arrow"
-            (LMonoTy.subst substInfo.subst e2t_env.fst.toLMonoTy)
-            (LMonoTy.subst substInfo.subst (.ftvar genEnv.fst))] at h_congr
+            (LMonoTy.subst substInfo.subst e2t.toLMonoTy)
+            (LMonoTy.subst substInfo.subst (.ftvar fresh_name))] at h_congr
       rw [h_subst_e2t] at h_congr
       exact h_congr
-    have h_sz1 : e1.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-    have h_sz2 : e2.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-    have h_ih_e1 := ih e1.sizeOf h_sz1 e1 rfl e1t_env.fst C Env e1t_env.snd heq_e1
-      ⟨h_envwf, h_ne, h_resolved⟩ h_fwf S h_abs_e1
-    have h_ih_e2 := ih e2.sizeOf h_sz2 e2 rfl e2t_env.fst C e1t_env.snd e2t_env.snd heq_e2
-      h_wf1 h_fwf S h_abs_e2
+    have h_ih_e1 := h_ih1 h_resolved S h_abs_e1
+    have h_ih_e2 := h_ih2 h_resolved1 S h_abs_e2
     simp [applySubstT, replaceMetadata, unresolved, toLMonoTy]
     rw [applySubstT_toLMonoTy] at h_ih_e1 h_ih_e2
     rw [h_eq_S] at h_ih_e1
     exact HasTypeA.app h_ih_e1 h_ih_e2
-  | .abs m_abs name_abs bty_abs e_body =>
-    simp only [resolveAux, Bind.bind, Except.bind] at h
-    elim_err h
-    rename_i v1 h_tbv
-    obtain ⟨xv, xty, Env1⟩ := v1
-    dsimp at h h_tbv
-    elim_err h
-    rename_i v2 h_res_body
-    obtain ⟨et_body, Env2⟩ := v2
-    dsimp at h h_res_body
-    simp at h
-    obtain ⟨h_et, h_env'⟩ := h
+  case h_abs =>
+    intro m name bty body et C Env Env' xv xty Env1 et_body Env2
+      h_res h_tbv h_res_body h_et h_env' h_envwf h_ne h_fwf h_envwf1 h_ne1 h_aliases_eq
+      h_ih h_resolved S h_absorbs
     subst h_et h_env'
-    have h_envwf1 : TEnvWF Env1 :=
-      TEnvWF.of_typeBoundVar C Env bty_abs xv xty Env1 h_tbv h_envwf
-    have h_ne1 : Env1.context.types ≠ [] :=
-      typeBoundVar_context_types_ne_nil C Env bty_abs xv xty Env1 h_tbv
-    have h_sz_body : (LExpr.varOpen 0 (xv, some xty) e_body).sizeOf < n := by
-      subst h_eq; simp [LExpr.sizeOf, LExpr.varOpen_sizeOf]
+    have h_resolved1 : TContext.AliasesResolved Env1.context := by
+      intro a h_mem; rw [h_aliases_eq] at h_mem ⊢; exact h_resolved a h_mem
     have h_abs_Env2 : S.absorbs Env2.stateSubstInfo.subst := by
       simp [TEnv.eraseFromContext, TEnv.updateContext] at h_absorbs
       exact h_absorbs
-    have h_aliases_eq1 := typeBoundVar_aliases_eq C Env bty_abs xv xty Env1 h_tbv
-    have h_resolved1 : TContext.AliasesResolved Env1.context := by
-      intro a h_mem; rw [h_aliases_eq1] at h_mem ⊢; exact h_resolved a h_mem
-    have h_ih_body := ih (LExpr.varOpen 0 (xv, some xty) e_body).sizeOf h_sz_body
-      (LExpr.varOpen 0 (xv, some xty) e_body) rfl et_body C Env1 Env2 h_res_body
-      ⟨h_envwf1, h_ne1, h_resolved1⟩ h_fwf S h_abs_Env2
+    have h_ih_body := h_ih h_resolved1 S h_abs_Env2
     show HasTypeA []
-      (applySubstT (.abs ⟨m_abs, LMonoTy.subst Env2.stateSubstInfo.subst
+      (applySubstT (.abs ⟨m, LMonoTy.subst Env2.stateSubstInfo.subst
         (LMonoTy.tcons "arrow" [xty, (LExpr.varCloseT 0 xv et_body).toLMonoTy])⟩
-        name_abs bty_abs (LExpr.varCloseT 0 xv et_body)) S).unresolved
-      ((applySubstT (.abs ⟨m_abs, LMonoTy.subst Env2.stateSubstInfo.subst
+        name bty (LExpr.varCloseT 0 xv et_body)) S).unresolved
+      ((applySubstT (.abs ⟨m, LMonoTy.subst Env2.stateSubstInfo.subst
         (LMonoTy.tcons "arrow" [xty, (LExpr.varCloseT 0 xv et_body).toLMonoTy])⟩
-        name_abs bty_abs (LExpr.varCloseT 0 xv et_body)) S).toLMonoTy)
+        name bty (LExpr.varCloseT 0 xv et_body)) S).toLMonoTy)
     rw [varCloseT_toLMonoTy, applySubstT_toLMonoTy]
     conv => rhs; simp only [toLMonoTy]
             rw [LMonoTy.subst_absorbs S Env2.stateSubstInfo.subst _ h_abs_Env2,
@@ -808,89 +682,48 @@ private theorem resolveAux_HasTypeA_aux [DecidableEq T.IDMeta] [HasGen T.IDMeta]
       rw [varCloseT_toLMonoTy, applySubstT_toLMonoTy]
     rw [h_ty_eq]
     have h_ctx_xv : Env1.context.types.find? xv = some (.forAll [] xty) :=
-      typeBoundVar_adds_to_context C Env bty_abs xv xty Env1 h_tbv
+      typeBoundVar_adds_to_context C Env bty xv xty Env1 h_tbv
     have h_xty_af : LMonoTy.aliasFree Env1.context.aliases xty := by
-      rw [h_aliases_eq1]; exact typeBoundVar_xty_aliasFree C Env bty_abs xv xty Env1 h_tbv h_resolved
+      rw [h_aliases_eq]; exact typeBoundVar_xty_aliasFree C Env bty xv xty Env1 h_tbv h_resolved
     have h_annot_raw : LExprT.allFvarAnnot xv xty et_body :=
       resolveAux_allFvarAnnot C Env1 Env2
-        (LExpr.varOpen 0 (xv, some xty) e_body) et_body xv xty h_res_body h_ctx_xv
-        h_envwf1 h_ne1 h_fwf h_resolved1 h_xty_af
+        (LExpr.varOpen 0 (xv, some xty) body) et_body xv xty h_res_body h_ctx_xv
+        h_envwf1 h_ne1 h_fwf h_xty_af
     have h_annot : LExprT.allFvarAnnot xv (LMonoTy.subst S xty) (applySubstT et_body S) :=
       applySubstT_allFvarAnnot xv xty et_body S h_annot_raw
     exact varCloseT_unresolved_HasTypeA_nil xv (LMonoTy.subst S xty)
       (applySubstT et_body S) h_ih_body h_annot
-  | .quant m_q qk_q name_q bty_q trigger_q e_q =>
-    simp only [resolveAux, Bind.bind, Except.bind] at h
-    elim_err h
-    rename_i v1 h_tbv
-    obtain ⟨xv, xty, Env1⟩ := v1
-    dsimp at h h_tbv
-    elim_err h
-    rename_i v2 h_res_body
-    obtain ⟨et_body, Env2⟩ := v2
-    dsimp at h h_res_body
-    elim_err h
-    rename_i v3 h_res_tr
-    obtain ⟨et_tr, Env3⟩ := v3
-    dsimp at h h_res_tr
-    elim_err h
-    simp at h
-    obtain ⟨h_et, h_env'⟩ := h
+  case h_quant =>
+    intro m qk name bty triggers body et C Env Env' xv xty Env1 et_body Env2 et_tr Env3
+      h_res h_tbv h_res_body h_res_tr h_et h_env' h_body_ty_bool h_envwf h_ne h_fwf h_envwf1 h_ne1 h_aliases_eq
+      h_envwf2 h_ctx2 h_ih_body h_ih_tr h_resolved S h_absorbs
     subst h_et h_env'
-    rename_i h_body_bool
-    have h_body_ty_bool : toLMonoTy et_body = LMonoTy.bool := by
-      simp [bne] at h_body_bool; exact h_body_bool
-    have h_envwf1 : TEnvWF Env1 :=
-      TEnvWF.of_typeBoundVar C Env bty_q xv xty Env1 h_tbv h_envwf
-    have h_ne1 : Env1.context.types ≠ [] :=
-      typeBoundVar_context_types_ne_nil C Env bty_q xv xty Env1 h_tbv
-    have h_props_body := resolveAux_properties
-      (LExpr.varOpen 0 (xv, some xty) e_q) et_body C Env1 Env2 h_res_body
-      h_ne1 h_envwf1.aliasesWF h_fwf h_envwf1.substFreshForGen
-      h_envwf1.ctxFreshForGen h_envwf1.boundVarsFresh
-    have h_ctx_body : Env2.context = Env1.context := h_props_body.context
-    have h_envwf2 := TEnvWF.of_resolveAux
-      (LExpr.varOpen 0 (xv, some xty) e_q) et_body C Env1 Env2
-      h_res_body h_envwf1 h_ne1 h_fwf h_ctx_body
-    have h_ne2 : Env2.context.types ≠ [] := h_ctx_body ▸ h_ne1
-    -- Absorption chain
+    have h_ne2 : Env2.context.types ≠ [] := h_ctx2 ▸ h_ne1
+    have h_resolved1 : TContext.AliasesResolved Env1.context := by
+      intro a h_mem; rw [h_aliases_eq] at h_mem ⊢; exact h_resolved a h_mem
+    have h_resolved2 : TContext.AliasesResolved Env2.context := h_ctx2 ▸ h_resolved1
     have h_abs_Env3 : S.absorbs Env3.stateSubstInfo.subst := by
       simp [TEnv.eraseFromContext, TEnv.updateContext] at h_absorbs
       exact h_absorbs
     have h_abs_Env2 : S.absorbs Env2.stateSubstInfo.subst := by
       have h_props_tr := resolveAux_properties
-        (LExpr.varOpen 0 (xv, some xty) trigger_q) et_tr C Env2 Env3 h_res_tr
+        (LExpr.varOpen 0 (xv, some xty) triggers) et_tr C Env2 Env3 h_res_tr
         h_ne2 h_envwf2.aliasesWF h_fwf h_envwf2.substFreshForGen
         h_envwf2.ctxFreshForGen h_envwf2.boundVarsFresh
       exact Subst.absorbs_trans _ _ _ h_props_tr.absorbs h_abs_Env3
-    -- AliasesResolved for Env1 and Env2
-    have h_aliases_eq1 := typeBoundVar_aliases_eq C Env bty_q xv xty Env1 h_tbv
-    have h_resolved1 : TContext.AliasesResolved Env1.context := by
-      intro a h_mem; rw [h_aliases_eq1] at h_mem ⊢; exact h_resolved a h_mem
-    have h_resolved2 : TContext.AliasesResolved Env2.context :=
-      h_ctx_body ▸ h_resolved1
-    have h_sz_body : (LExpr.varOpen 0 (xv, some xty) e_q).sizeOf < n := by
-      subst h_eq; simp [LExpr.sizeOf, LExpr.varOpen_sizeOf]; omega
-    have h_ih_body := ih (LExpr.varOpen 0 (xv, some xty) e_q).sizeOf h_sz_body
-      (LExpr.varOpen 0 (xv, some xty) e_q) rfl et_body C Env1 Env2 h_res_body
-      ⟨h_envwf1, h_ne1, h_resolved1⟩ h_fwf S h_abs_Env2
-    have h_sz_tr : (LExpr.varOpen 0 (xv, some xty) trigger_q).sizeOf < n := by
-      subst h_eq; simp [LExpr.sizeOf, LExpr.varOpen_sizeOf]; omega
-    have h_ih_tr := ih (LExpr.varOpen 0 (xv, some xty) trigger_q).sizeOf h_sz_tr
-      (LExpr.varOpen 0 (xv, some xty) trigger_q) rfl et_tr C Env2 Env3 h_res_tr
-      ⟨h_envwf2, h_ne2, h_resolved2⟩ h_fwf S h_abs_Env3
-    -- Simplify goal: RHS is already bool via toLMonoTy of quant
+    have h_ih_b := h_ih_body h_resolved1 S h_abs_Env2
+    have h_ih_t := h_ih_tr h_resolved2 S h_abs_Env3
     show HasTypeA []
-      (applySubstT (.quant ⟨m_q, LMonoTy.subst Env3.stateSubstInfo.subst xty⟩
-        qk_q name_q (some (LMonoTy.subst Env3.stateSubstInfo.subst xty))
+      (applySubstT (.quant ⟨m, LMonoTy.subst Env3.stateSubstInfo.subst xty⟩
+        qk name (some (LMonoTy.subst Env3.stateSubstInfo.subst xty))
         (LExpr.varCloseT 0 xv et_tr) (LExpr.varCloseT 0 xv et_body)) S).unresolved
-      ((applySubstT (.quant ⟨m_q, LMonoTy.subst Env3.stateSubstInfo.subst xty⟩
-        qk_q name_q (some (LMonoTy.subst Env3.stateSubstInfo.subst xty))
+      ((applySubstT (.quant ⟨m, LMonoTy.subst Env3.stateSubstInfo.subst xty⟩
+        qk name (some (LMonoTy.subst Env3.stateSubstInfo.subst xty))
         (LExpr.varCloseT 0 xv et_tr) (LExpr.varCloseT 0 xv et_body)) S).toLMonoTy)
     simp only [toLMonoTy]
     simp only [applySubstT, replaceMetadata, unresolved]
     change HasTypeA []
-      (.quant m_q qk_q name_q (some (LMonoTy.subst S (LMonoTy.subst Env3.stateSubstInfo.subst xty)))
+      (.quant m qk name (some (LMonoTy.subst S (LMonoTy.subst Env3.stateSubstInfo.subst xty)))
         (applySubstT (LExpr.varCloseT 0 xv et_tr) S).unresolved
         (applySubstT (LExpr.varCloseT 0 xv et_body) S).unresolved)
       LMonoTy.bool
@@ -899,154 +732,102 @@ private theorem resolveAux_HasTypeA_aux [DecidableEq T.IDMeta] [HasGen T.IDMeta]
     rw [LMonoTy.subst_absorbs S Env3.stateSubstInfo.subst xty h_abs_Env3]
     refine HasTypeA.quant (τ_tr := (LExpr.varCloseT 0 xv (applySubstT et_tr S)).toLMonoTy) ?_ ?_
     · have h_ctx_xv : Env1.context.types.find? xv = some (.forAll [] xty) :=
-        typeBoundVar_adds_to_context C Env bty_q xv xty Env1 h_tbv
+        typeBoundVar_adds_to_context C Env bty xv xty Env1 h_tbv
       have h_ctx_xv2 : Env2.context.types.find? xv = some (.forAll [] xty) :=
-        h_ctx_body ▸ h_ctx_xv
+        h_ctx2 ▸ h_ctx_xv
       have h_xty_af2 : LMonoTy.aliasFree Env2.context.aliases xty := by
-        rw [show Env2.context.aliases = Env1.context.aliases from by
-          rw [show Env2.context = Env1.context from h_ctx_body]]
-        rw [h_aliases_eq1]
-        exact typeBoundVar_xty_aliasFree C Env bty_q xv xty Env1 h_tbv h_resolved
+        rw [show Env2.context.aliases = Env1.context.aliases from by rw [h_ctx2]]
+        rw [h_aliases_eq]
+        exact typeBoundVar_xty_aliasFree C Env bty xv xty Env1 h_tbv h_resolved
       have h_annot_tr_raw : LExprT.allFvarAnnot xv xty et_tr :=
         resolveAux_allFvarAnnot C Env2 Env3
-          (LExpr.varOpen 0 (xv, some xty) trigger_q) et_tr xv xty h_res_tr h_ctx_xv2
-          h_envwf2 h_ne2 h_fwf h_resolved2 h_xty_af2
+          (LExpr.varOpen 0 (xv, some xty) triggers) et_tr xv xty h_res_tr h_ctx_xv2
+          h_envwf2 h_ne2 h_fwf h_xty_af2
       have h_annot_tr : LExprT.allFvarAnnot xv (LMonoTy.subst S xty) (applySubstT et_tr S) :=
         applySubstT_allFvarAnnot xv xty et_tr S h_annot_tr_raw
       exact varCloseT_unresolved_HasTypeA_nil xv (LMonoTy.subst S xty)
-        (applySubstT et_tr S) h_ih_tr h_annot_tr
+        (applySubstT et_tr S) h_ih_t h_annot_tr
     · have h_body_ty_eq : (LExpr.varCloseT 0 xv (applySubstT et_body S)).toLMonoTy = LMonoTy.bool := by
         rw [varCloseT_toLMonoTy, applySubstT_toLMonoTy, h_body_ty_bool, LMonoTy.subst_bool]
       rw [← h_body_ty_eq]
       have h_ctx_xv : Env1.context.types.find? xv = some (.forAll [] xty) :=
-        typeBoundVar_adds_to_context C Env bty_q xv xty Env1 h_tbv
+        typeBoundVar_adds_to_context C Env bty xv xty Env1 h_tbv
       have h_xty_af1 : LMonoTy.aliasFree Env1.context.aliases xty := by
-        rw [h_aliases_eq1]
-        exact typeBoundVar_xty_aliasFree C Env bty_q xv xty Env1 h_tbv h_resolved
+        rw [h_aliases_eq]
+        exact typeBoundVar_xty_aliasFree C Env bty xv xty Env1 h_tbv h_resolved
       have h_annot_body_raw : LExprT.allFvarAnnot xv xty et_body :=
         resolveAux_allFvarAnnot C Env1 Env2
-          (LExpr.varOpen 0 (xv, some xty) e_q) et_body xv xty h_res_body h_ctx_xv
-          h_envwf1 h_ne1 h_fwf h_resolved1 h_xty_af1
+          (LExpr.varOpen 0 (xv, some xty) body) et_body xv xty h_res_body h_ctx_xv
+          h_envwf1 h_ne1 h_fwf h_xty_af1
       have h_annot_body : LExprT.allFvarAnnot xv (LMonoTy.subst S xty) (applySubstT et_body S) :=
         applySubstT_allFvarAnnot xv xty et_body S h_annot_body_raw
       exact varCloseT_unresolved_HasTypeA_nil xv (LMonoTy.subst S xty)
-        (applySubstT et_body S) h_ih_body h_annot_body
-  | .eq m_eq e1 e2 =>
-    simp only [resolveAux, Bind.bind, Except.bind] at h
-    elim_err h
-    rename_i e1t_env heq_e1
-    elim_err h
-    rename_i e2t_env heq_e2
-    elim_err h
-    rename_i substInfo heq_unify
-    cases h
-    have h_unify : Constraints.unify [(e1t_env.fst.toLMonoTy, e2t_env.fst.toLMonoTy)]
-        e2t_env.snd.stateSubstInfo = .ok substInfo := by
-      revert heq_unify
-      generalize Constraints.unify [(e1t_env.fst.toLMonoTy, e2t_env.fst.toLMonoTy)]
-        e2t_env.snd.stateSubstInfo = res
-      intro h_me; match res, h_me with
-      | .ok _, h_me => simp [Except.mapError] at h_me; rw [h_me]
-      | .error _, h_me => simp [Except.mapError] at h_me
-    have ⟨h_wf1, _⟩ := ResolveAuxWF.mk_from_resolveAux (T := T) e1 e1t_env.fst C Env e1t_env.snd heq_e1 ⟨h_envwf, h_ne, h_resolved⟩ h_fwf
-    have h_props2 := resolveAux_properties e2 e2t_env.fst C e1t_env.snd e2t_env.snd heq_e2
-      h_wf1.ne h_wf1.envwf.aliasesWF h_fwf h_wf1.envwf.substFreshForGen h_wf1.envwf.ctxFreshForGen
-      h_wf1.envwf.boundVarsFresh
-    -- Absorption chain
+        (applySubstT et_body S) h_ih_b h_annot_body
+  case h_eq =>
+    intro m e1 e2 et C Env Env' e1t Env1 e2t Env2 substInfo
+      h_res h1 h2 h_unify h_et h_subeq h_abs1 h_abs2 h_envwf h_ne h_fwf
+      h_envwf1 h_ctx1 h_envwf2 h_ctx2 h_ih1 h_ih2 h_resolved S h_absorbs
+    subst h_et
+    rw [h_subeq] at h_absorbs
+    have h_resolved1 : TContext.AliasesResolved Env1.context := h_ctx1 ▸ h_resolved
     have h_abs_unify := Constraints.unify_absorbs _ _ _ h_unify
-    have h_abs_e2 : S.absorbs e2t_env.snd.stateSubstInfo.subst :=
-      Subst.absorbs_trans _ _ _
-        h_abs_unify h_absorbs
-    have h_abs_e1 : S.absorbs e1t_env.snd.stateSubstInfo.subst :=
-      Subst.absorbs_trans _ _ _
-        h_props2.absorbs h_abs_e2
-    have h_S_abs_substInfo : S.absorbs substInfo.subst := by
-      simp [TEnv.updateSubst] at h_absorbs; exact h_absorbs
-    -- Unification soundness: both types become equal under S
-    have h_eq_types : toLMonoTy (applySubstT e1t_env.fst S) = toLMonoTy (applySubstT e2t_env.fst S) := by
+    have h_abs_e2 : S.absorbs Env2.stateSubstInfo.subst :=
+      Subst.absorbs_trans _ _ _ h_abs_unify h_absorbs
+    have h_abs_e1 : S.absorbs Env1.stateSubstInfo.subst :=
+      Subst.absorbs_trans _ _ _ h_abs2 h_abs_e2
+    have h_eq_types : toLMonoTy (applySubstT e1t S) = toLMonoTy (applySubstT e2t S) := by
       rw [applySubstT_toLMonoTy, applySubstT_toLMonoTy]
       have h_sound := Constraints.unify_sound _ _ _ h_unify
       have h_pair := h_sound _ (List.Mem.head _)
       simp at h_pair
-      exact LMonoTy.subst_eq_of_absorbs S substInfo.subst _ _ h_S_abs_substInfo h_pair
+      exact LMonoTy.subst_eq_of_absorbs S substInfo.subst _ _ h_absorbs h_pair
     simp [applySubstT, replaceMetadata, unresolved, toLMonoTy]
     rw [LMonoTy.subst_bool]
-    apply HasTypeA.eq (τ := toLMonoTy (applySubstT e1t_env.fst S))
-    · have h_sz : e1.sizeOf < n := by subst h_eq; simp_all [LExpr.sizeOf]; omega
-      exact ih e1.sizeOf h_sz e1 rfl e1t_env.fst C Env e1t_env.snd heq_e1 ⟨h_envwf, h_ne, h_resolved⟩ h_fwf S h_abs_e1
+    apply HasTypeA.eq (τ := toLMonoTy (applySubstT e1t S))
+    · exact h_ih1 h_resolved S h_abs_e1
     · rw [h_eq_types]
-      have h_sz2 : e2.sizeOf < n := by subst h_eq; simp_all [LExpr.sizeOf]; omega
-      exact ih e2.sizeOf h_sz2 e2 rfl e2t_env.fst C e1t_env.snd e2t_env.snd heq_e2 h_wf1 h_fwf S h_abs_e2
-  | .ite m_ite c_expr th_expr el_expr =>
-    simp only [resolveAux, Bind.bind, Except.bind] at h
-    elim_err h
-    rename_i ct_env heq_c
-    elim_err h
-    rename_i tht_env heq_th
-    elim_err h
-    rename_i elt_env heq_el
-    elim_err h
-    rename_i substInfo heq_unify
-    cases h
-    have h_unify : Constraints.unify
-        [(ct_env.fst.toLMonoTy, LMonoTy.bool),
-         (tht_env.fst.toLMonoTy, elt_env.fst.toLMonoTy)]
-        elt_env.snd.stateSubstInfo = .ok substInfo := by
-      revert heq_unify
-      generalize Constraints.unify _ elt_env.snd.stateSubstInfo = res
-      intro h_me; match res, h_me with
-      | .ok _, h_me => simp [Except.mapError] at h_me; rw [h_me]
-      | .error _, h_me => simp [Except.mapError] at h_me
-    have ⟨h_wf_c, _⟩ := ResolveAuxWF.mk_from_resolveAux (T := T) c_expr ct_env.fst C Env ct_env.snd heq_c ⟨h_envwf, h_ne, h_resolved⟩ h_fwf
-    have ⟨h_wf_th, _⟩ := ResolveAuxWF.mk_from_resolveAux (T := T) th_expr tht_env.fst C ct_env.snd tht_env.snd heq_th h_wf_c h_fwf
-    have h_props_el := resolveAux_properties el_expr elt_env.fst C tht_env.snd elt_env.snd heq_el
-      h_wf_th.ne h_wf_th.envwf.aliasesWF h_fwf h_wf_th.envwf.substFreshForGen h_wf_th.envwf.ctxFreshForGen
-      h_wf_th.envwf.boundVarsFresh
-    have h_props_th := resolveAux_properties th_expr tht_env.fst C ct_env.snd tht_env.snd heq_th
-      h_wf_c.ne h_wf_c.envwf.aliasesWF h_fwf h_wf_c.envwf.substFreshForGen h_wf_c.envwf.ctxFreshForGen
-      h_wf_c.envwf.boundVarsFresh
-    -- Absorption chain
+      exact h_ih2 h_resolved1 S h_abs_e2
+  case h_ite =>
+    intro m c th el et C Env Env' ct Env1 tht Env2 elt Env3 substInfo
+      h_res hc ht he h_unify h_et h_subeq h_abs_th2 h_abs_el3 h_envwf h_ne h_fwf
+      h_envwf1 h_ctx1 h_envwf2 h_ctx2 h_envwf3 h_ctx3 h_ihc h_iht h_ihe h_resolved S h_absorbs
+    subst h_et
+    rw [h_subeq] at h_absorbs
+    have h_resolved1 : TContext.AliasesResolved Env1.context := h_ctx1 ▸ h_resolved
+    have h_resolved2 : TContext.AliasesResolved Env2.context := h_ctx2 ▸ h_resolved
     have h_abs_unify := Constraints.unify_absorbs _ _ _ h_unify
-    have h_S_abs_substInfo : S.absorbs substInfo.subst := by
-      simp [TEnv.updateSubst] at h_absorbs; exact h_absorbs
-    have h_abs_el : S.absorbs elt_env.snd.stateSubstInfo.subst :=
-      Subst.absorbs_trans _ _ _ h_abs_unify h_S_abs_substInfo
-    have h_abs_th : S.absorbs tht_env.snd.stateSubstInfo.subst :=
-      Subst.absorbs_trans _ _ _ h_props_el.absorbs h_abs_el
-    have h_abs_c : S.absorbs ct_env.snd.stateSubstInfo.subst :=
-      Subst.absorbs_trans _ _ _ h_props_th.absorbs h_abs_th
-    -- Unification soundness
+    have h_abs_el : S.absorbs Env3.stateSubstInfo.subst :=
+      Subst.absorbs_trans _ _ _ h_abs_unify h_absorbs
+    have h_abs_th : S.absorbs Env2.stateSubstInfo.subst :=
+      Subst.absorbs_trans _ _ _ h_abs_el3 h_abs_el
+    have h_abs_c : S.absorbs Env1.stateSubstInfo.subst :=
+      Subst.absorbs_trans _ _ _ h_abs_th2 h_abs_th
     have h_sound := Constraints.unify_sound _ _ _ h_unify
-    have h_c_bool : LMonoTy.subst substInfo.subst ct_env.fst.toLMonoTy = LMonoTy.bool := by
+    have h_c_bool : LMonoTy.subst substInfo.subst ct.toLMonoTy = LMonoTy.bool := by
       have h_p := h_sound _ (List.Mem.head _)
       simp [LMonoTy.subst_bool] at h_p; exact h_p
-    have h_th_el : LMonoTy.subst substInfo.subst tht_env.fst.toLMonoTy =
-        LMonoTy.subst substInfo.subst elt_env.fst.toLMonoTy := by
+    have h_th_el : LMonoTy.subst substInfo.subst tht.toLMonoTy =
+        LMonoTy.subst substInfo.subst elt.toLMonoTy := by
       have h_p := h_sound _ (List.Mem.tail _ (List.Mem.head _))
       simp at h_p; exact h_p
-    -- c has type bool under S
-    have h_c_type_bool : LMonoTy.subst S (toLMonoTy ct_env.fst) = LMonoTy.bool := by
-      have h_c_bool' : LMonoTy.subst substInfo.subst ct_env.fst.toLMonoTy =
+    have h_c_type_bool : LMonoTy.subst S (toLMonoTy ct) = LMonoTy.bool := by
+      have h_c_bool' : LMonoTy.subst substInfo.subst ct.toLMonoTy =
           LMonoTy.subst substInfo.subst LMonoTy.bool := by
         rw [h_c_bool, LMonoTy.subst_bool]
-      have h_lifted := LMonoTy.subst_eq_of_absorbs S substInfo.subst _ _ h_S_abs_substInfo h_c_bool'
+      have h_lifted := LMonoTy.subst_eq_of_absorbs S substInfo.subst _ _ h_absorbs h_c_bool'
       rw [LMonoTy.subst_bool] at h_lifted; exact h_lifted
-    -- th and el have equal types under S
-    have h_th_el_eq : LMonoTy.subst S (toLMonoTy tht_env.fst) = LMonoTy.subst S (toLMonoTy elt_env.fst) :=
-      LMonoTy.subst_eq_of_absorbs S substInfo.subst _ _ h_S_abs_substInfo h_th_el
-    have h_sz_c : c_expr.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-    have h_sz_th : th_expr.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-    have h_sz_el : el_expr.sizeOf < n := by subst h_eq; simp [LExpr.sizeOf]; omega
-    change HasTypeA [] (LExpr.ite m_ite (applySubstT ct_env.fst S).unresolved
-      (applySubstT tht_env.fst S).unresolved (applySubstT elt_env.fst S).unresolved)
-      (LMonoTy.subst S (toLMonoTy tht_env.fst))
-    rw [← applySubstT_toLMonoTy tht_env.fst S]
+    have h_th_el_eq : LMonoTy.subst S (toLMonoTy tht) = LMonoTy.subst S (toLMonoTy elt) :=
+      LMonoTy.subst_eq_of_absorbs S substInfo.subst _ _ h_absorbs h_th_el
+    change HasTypeA [] (LExpr.ite m (applySubstT ct S).unresolved
+      (applySubstT tht S).unresolved (applySubstT elt S).unresolved)
+      (LMonoTy.subst S (toLMonoTy tht))
+    rw [← applySubstT_toLMonoTy tht S]
     apply HasTypeA.ite
-    · have h_ih_c := ih c_expr.sizeOf h_sz_c c_expr rfl ct_env.fst C Env ct_env.snd heq_c ⟨h_envwf, h_ne, h_resolved⟩ h_fwf S h_abs_c
+    · have h_ih_c := h_ihc h_resolved S h_abs_c
       rw [applySubstT_toLMonoTy, h_c_type_bool] at h_ih_c
       exact h_ih_c
-    · exact ih th_expr.sizeOf h_sz_th th_expr rfl tht_env.fst C ct_env.snd tht_env.snd heq_th h_wf_c h_fwf S h_abs_th
-    · have h_ih_el := ih el_expr.sizeOf h_sz_el el_expr rfl elt_env.fst C tht_env.snd elt_env.snd heq_el h_wf_th h_fwf S h_abs_el
+    · exact h_iht h_resolved1 S h_abs_th
+    · have h_ih_el := h_ihe h_resolved2 S h_abs_el
       rw [applySubstT_toLMonoTy] at h_ih_el
       rw [applySubstT_toLMonoTy, h_th_el_eq]
       exact h_ih_el
@@ -1064,7 +845,7 @@ theorem resolveAux_HasTypeA [DecidableEq T.IDMeta] [HasGen T.IDMeta]
     HasTypeA [] (applySubstT et Env'.stateSubstInfo.subst).unresolved
                ((applySubstT et Env'.stateSubstInfo.subst).toLMonoTy) := by
   have h_absorbs := Subst.absorbs_refl Env'.stateSubstInfo.subst Env'.stateSubstInfo.isWF
-  exact resolveAux_HasTypeA_aux e.sizeOf e rfl et C Env Env' h ⟨h_envwf, h_ne, h_resolved⟩ h_fwf
+  exact resolveAux_HasTypeA_aux e et C Env Env' h h_envwf h_ne h_fwf h_resolved
     Env'.stateSubstInfo.subst h_absorbs
 
 /-- Main soundness theorem: `LExpr.resolve` produces a well-typed and
diff --git a/Strata/DL/Lambda/Factory.lean b/Strata/DL/Lambda/Factory.lean
index 54840acf07..36a3438d02 100644
--- a/Strata/DL/Lambda/Factory.lean
+++ b/Strata/DL/Lambda/Factory.lean
@@ -113,7 +113,7 @@ theorem LFunc.type_inputs_nodup {T : LExprParams} [DecidableEq T.IDMeta] (f : LF
   split at h <;> try contradiction
   simp_all
 
-def LFunc.opExpr [Inhabited T.Metadata] (f: LFunc T) : LExpr T.mono :=
+@[expose] def LFunc.opExpr [Inhabited T.Metadata] (f: LFunc T) : LExpr T.mono :=
   let input_tys := f.inputs.values
   let output_tys := Lambda.LMonoTy.destructArrow f.output
   let ty := match input_tys with
@@ -124,6 +124,9 @@ def LFunc.opExpr [Inhabited T.Metadata] (f: LFunc T) : LExpr T.mono :=
 def LFunc.inputPolyTypes (f : (LFunc T)) : @LTySignature T.IDMeta :=
   f.inputs.map (fun (id, mty) => (id, .forAll f.typeArgs mty))
 
+def LFunc.inputMonoSignature (f : (LFunc T)) : @LTySignature T.IDMeta :=
+  f.inputs.map (fun (id, mty) => (id, .forAll [] mty))
+
 def LFunc.outputPolyType (f : (LFunc T)) : LTy :=
   .forAll f.typeArgs f.output
 
diff --git a/Strata/DL/Lambda/FactoryWF.lean b/Strata/DL/Lambda/FactoryWF.lean
index 35cc617ea7..7a3b34558d 100644
--- a/Strata/DL/Lambda/FactoryWF.lean
+++ b/Strata/DL/Lambda/FactoryWF.lean
@@ -60,7 +60,7 @@ structure WFLFunc (T : LExprParams) where
 def WFLFunc.name (f : WFLFunc T) : T.Identifier := f.func.name
 
 /-- The operator expression for the underlying LFunc. -/
-def WFLFunc.opExpr [Inhabited T.Metadata] (f : WFLFunc T) : LExpr T.mono :=
+@[expose] def WFLFunc.opExpr [Inhabited T.Metadata] (f : WFLFunc T) : LExpr T.mono :=
   f.func.opExpr
 
 /-- An array of well-formed LFuncs with a proof that function
@@ -71,7 +71,7 @@ structure WFLFactory (T : LExprParams) where
 
 /-- Construct a `WFLFactory` from an array of `WFLFunc`s.
     The `name_nodup` proof defaults to `by decide`. -/
-def WFLFactory.ofArray {T} (funcs : Array (WFLFunc T))
+@[expose] def WFLFactory.ofArray {T} (funcs : Array (WFLFunc T))
     (name_nodup : List.Nodup (funcs.toList.map (·.func.name.name)) := by decide)
     : WFLFactory T :=
   let a := funcs.map (·.func)
diff --git a/Strata/DL/Lambda/LExpr.lean b/Strata/DL/Lambda/LExpr.lean
index 5e348832f7..7d55c80344 100644
--- a/Strata/DL/Lambda/LExpr.lean
+++ b/Strata/DL/Lambda/LExpr.lean
@@ -313,6 +313,7 @@ def LExpr.getVars (e : LExpr T) : List (Identifier T.base.IDMeta) := match e wit
   | .ite _ c t e => LExpr.getVars c ++ LExpr.getVars t ++ LExpr.getVars e
   | .eq _ e1 e2 => LExpr.getVars e1 ++ LExpr.getVars e2
 
+@[expose]
 def getOps (e : LExpr T) := match e with
   | .op _ name _ => [name]
   | .const _ _ => [] | .bvar _ _ => [] | .fvar _ _ _ => []
@@ -339,6 +340,47 @@ def collectFvarNames {T : LExprParamsT} : LExpr T → List (Identifier T.base.ID
   | .eq _ e1 e2 => collectFvarNames e1 ++ collectFvarNames e2
   | _ => []
 
+/-- Collects type variables from user-written binder annotations (abs/quant only). Used to rule out unbound type variables in `FunctionType.lean`.
+    fvar/op annotations are excluded because they carry type variables from
+    external declarations unrelated to the current expression's typeArgs.
+
+    For `.op`: function references carry the callee's own type parameters. E.g.:
+      ```
+      function g<U>(x: U): U { x }
+      function f<T>(y: T): T { g(y) }
+      ```
+      After translation, `f`'s body contains `.op () "g" (some (arrow (ftvar "U") (ftvar "U")))`, but "U" should not be considered unbound here,
+      merely not-yet-resolved.
+      The same applies to datatype destructors (e.g. `List.head` carries `(arrow (list T) T)`
+      where T is from the datatype declaration).
+
+    For `.fvar`: references to variables from an enclosing scope carry that scope's type
+    parameters. E.g.:
+      ```
+      procedure p<V>(x: V) (z: V) {
+        function g<T>(y: T): T { if x == z then y else y }
+        g(0);
+      }
+      ```
+      Here `x` and `z` appear as `.fvar` with type annotation `(ftvar "V")`.
+      "V" is not unbound here either, since it is fixed from the outer context.-/
+def tyVarsOfBinderAnnotations (e : LExpr ⟨⟨M, IDMeta⟩, LMonoTy⟩) : Std.HashSet TyIdentifier :=
+  match e with
+  | .fvar _ _ (some _) => {}
+  | .fvar _ _ none => {}
+  | .op _ _ (some _) => {}
+  | .op _ _ none => {}
+  | .const _ _ => {}
+  | .bvar _ _ => {}
+  | .abs _ _ (some ty) body => LMonoTy.freeVars ty |>.foldl .insert (tyVarsOfBinderAnnotations body)
+  | .abs _ _ none body => tyVarsOfBinderAnnotations body
+  | .quant _ _ _ (some ty) tr body =>
+    LMonoTy.freeVars ty |>.foldl .insert (tyVarsOfBinderAnnotations tr |>.union (tyVarsOfBinderAnnotations body))
+  | .quant _ _ _ none tr body => (tyVarsOfBinderAnnotations tr).union (tyVarsOfBinderAnnotations body)
+  | .app _ e1 e2 => (tyVarsOfBinderAnnotations e1).union (tyVarsOfBinderAnnotations e2)
+  | .ite _ c t f => (tyVarsOfBinderAnnotations c).union ((tyVarsOfBinderAnnotations t).union (tyVarsOfBinderAnnotations f))
+  | .eq _ e1 e2 => (tyVarsOfBinderAnnotations e1).union (tyVarsOfBinderAnnotations e2)
+
 /-- Checks if the expression contains a lambda abstraction anywhere. -/
 def hasAbs {T : LExprParamsT} : LExpr T → Bool
   | .abs _ _ _ _ => true
diff --git a/Strata/DL/Lambda/LExprTypeSpec.lean b/Strata/DL/Lambda/LExprTypeSpec.lean
index 8370fa992e..23798e232d 100644
--- a/Strata/DL/Lambda/LExprTypeSpec.lean
+++ b/Strata/DL/Lambda/LExprTypeSpec.lean
@@ -10,6 +10,8 @@ import all Strata.DL.Lambda.LExprWF
 import all Strata.DL.Lambda.LExpr
 import all Strata.DL.Lambda.LTy
 import all Strata.DL.Lambda.LTyUnify
+public import Strata.DL.Lambda.LTyUnifyProps
+import all Strata.DL.Lambda.LTyUnifyProps
 import all Strata.DL.Util.Map
 import all Strata.DL.Util.Maps
 import all Strata.DL.Lambda.Identifiers
@@ -39,6 +41,18 @@ namespace Lambda
 
 open Std (ToFormat Format format)
 
+/-- Splits on `h` once, then closes every resulting branch that `simp at h` or
+    `contradiction` can fully discharge. Fails unless at least one branch is
+    closed, so a `split` that produces no error branch is rejected. Handles
+    error branches in any position — first, last, or interleaved. -/
+macro "elim_err" h:ident : tactic =>
+  `(tactic| (split at $h:ident; any_goals (solve | simp at $h:ident | contradiction)))
+
+/-- Repeatedly applies the `elim_err` step to `h`: splits and closes error
+    branches until a split no longer produces a closable branch. -/
+macro "elim_errs" h:ident : tactic =>
+  `(tactic| repeat (split at $h:ident; any_goals (solve | simp at $h:ident | contradiction)))
+
 public section
 
 namespace LExpr
@@ -309,18 +323,27 @@ theorem applySubstT_toLMonoTy {T : LExprParamsT}
 /-!
 ### Proof architecture for `resolve_HasType`
 
-The proof is structured in two layers:
+The proof is structured in three layers:
 
-1. **`resolveAux_HasType`**: The core theorem, proved by induction on `e`.
+1. **`resolveAux_HasType`**: The induction core, proved via the `resolveAux`
+  induction principle.
    States that if `resolveAux C Env e = .ok (et, Env')`, then:
    - `Env'.context = Env.context` (context is preserved), and
    - for any substitution `S` that absorbs `Env'.stateSubstInfo.subst`,
      `HasType C (TContext.subst Env.context S) e (.forAll [] (LMonoTy.subst S et.toLMonoTy))`.
 
-2. **`resolve_HasType`**: The top-level theorem. Since `resolve` is just
-   `resolveAux` followed by `applySubstT`, we decompose the hypothesis,
-   apply `resolveAux_HasType` (instantiating `S` with the final substitution),
-   and use `applySubstT_toLMonoTy`.
+2. **`resolve_HasType_core`**: Lifts `resolveAux_HasType` through `resolve` (which is
+   `resolveAux` followed by `applySubstT`, plus the empty-context guard). It exposes the
+   *universally-quantified-over-`S`* typing conclusion together with idempotence and
+   `TEnvWF Env'`, under the **minimal** preconditions (`TEnvWF`, `FactoryWF`,
+   `WellScoped` — no `checkContextTypesClosed`/`allKeysFresh`). This is the form
+   consumed by callers that compose substitutions themselves (e.g. `CmdType.inferType_HasType`).
+
+3. **`resolve_HasType`**: The top-level theorem. Building on `resolve_HasType_core`, it adds
+   the composability postconditions (`checkContextTypesClosed Env'`,
+   `allKeysFresh Env'.subst Env'.context`) under the extra `checkContextTypesClosed Env` /
+   `allKeysFresh Env` preconditions, then specializes the universal conclusion to the final
+   substitution `Env'.stateSubstInfo.subst`.
 
 #### Key definitions and supporting lemmas (quite a few of these are in LTyUnify.lean):
 
@@ -404,7 +427,7 @@ def Subst.allKeysFresh {T : LExprParams} [DecidableEq T.IDMeta]
     **polymorphic** entries in the context (those with non-empty bound variables).
     This condition is preserved through `typeBoundVar` (which adds monomorphic entries)
     and suffices for the polymorphic `fvar` case of `inferFVar_HasType`. -/
-def Subst.polyKeysFresh {T : LExprParams} [DecidableEq T.IDMeta]
+@[expose] def Subst.polyKeysFresh {T : LExprParams} [DecidableEq T.IDMeta]
     (S : Subst) (Γ : TContext T.IDMeta) : Prop :=
   ∀ a, a ∈ Maps.keys S → ∀ (x : T.Identifier) (ty : LTy),
     Γ.types.find? x = some ty → LTy.boundVars ty ≠ [] → a ∉ LTy.freeVars ty
@@ -434,12 +457,11 @@ private theorem LMonoTys.instantiate_context {IDMeta : Type} [ToFormat IDMeta]
     (h : LMonoTys.instantiate ids mtys Env = .ok (mtys', Env')) :
     Env'.context = Env.context := by
   simp [LMonoTys.instantiate, Bind.bind, Except.bind] at h
-  split at h
-  · simp at h
-  · rename_i v1 h_gen
-    obtain ⟨tvs, Env1⟩ := v1; simp at h h_gen
-    obtain ⟨_, h2⟩ := h; rw [← h2]
-    exact TGenEnv.genTyVars_context ids.length Env tvs Env1 h_gen
+  elim_err h
+  rename_i v1 h_gen
+  obtain ⟨tvs, Env1⟩ := v1; simp at h h_gen
+  obtain ⟨_, h2⟩ := h; rw [← h2]
+  exact TGenEnv.genTyVars_context ids.length Env tvs Env1 h_gen
 
 /-- `instantiateEnv` preserves the context. -/
 theorem LMonoTys.instantiateEnv_context {IDMeta : Type} [ToFormat IDMeta]
@@ -472,14 +494,13 @@ theorem LMonoTy.resolveAliases_context {IDMeta : Type} [ToFormat IDMeta]
     obtain ⟨_, h2⟩ := h; rw [← h2]
   | .tcons name args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_args
-      obtain ⟨args', Env1⟩ := v1; simp at h h_args
-      -- tconsAliasSimple doesn't change context (Env' = Env1)
-      simp only [LMonoTy.tconsAliasSimple] at h
-      split at h <;> (obtain ⟨_, h2⟩ := h; rw [← h2])
-      all_goals exact LMonoTys.resolveAliases_context args Env args' Env1 h_args
+    elim_err h
+    rename_i v1 h_args
+    obtain ⟨args', Env1⟩ := v1; simp at h h_args
+    -- tconsAliasSimple doesn't change context (Env' = Env1)
+    simp only [LMonoTy.tconsAliasSimple] at h
+    split at h <;> (obtain ⟨_, h2⟩ := h; rw [← h2])
+    all_goals exact LMonoTys.resolveAliases_context args Env args' Env1 h_args
 theorem LMonoTys.resolveAliases_context {IDMeta : Type} [ToFormat IDMeta]
     (mtys : LMonoTys) (Env : TEnv IDMeta) (mtys' : LMonoTys) (Env' : TEnv IDMeta)
     (h : LMonoTys.resolveAliases mtys Env = .ok (mtys', Env')) :
@@ -489,17 +510,15 @@ theorem LMonoTys.resolveAliases_context {IDMeta : Type} [ToFormat IDMeta]
     simp [LMonoTys.resolveAliases] at h; grind
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_hd
-      obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-      split at h
-      · simp at h
-      · rename_i v2 h_tl
-        obtain ⟨mrest', Env2⟩ := v2
-        simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-        rw [LMonoTys.resolveAliases_context mrest Env1 mrest' Env2 h_tl,
-            LMonoTy.resolveAliases_context mty Env mty' Env1 h_hd]
+    elim_err h
+    rename_i v1 h_hd
+    obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
+    elim_err h
+    rename_i v2 h_tl
+    obtain ⟨mrest', Env2⟩ := v2
+    simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+    rw [LMonoTys.resolveAliases_context mrest Env1 mrest' Env2 h_tl,
+        LMonoTy.resolveAliases_context mty Env mty' Env1 h_hd]
 end
 
 ---------------------------------------------------------------------
@@ -520,13 +539,12 @@ private theorem LMonoTy.resolveAliases_env {IDMeta : Type} [ToFormat IDMeta]
     obtain ⟨_, h2⟩ := h; exact h2.symm
   | .tcons name args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_args
-      obtain ⟨args', Env1⟩ := v1; simp at h h_args
-      simp only [LMonoTy.tconsAliasSimple] at h
-      split at h <;> (obtain ⟨_, h2⟩ := h; rw [← h2])
-      all_goals exact LMonoTys.resolveAliases_env args Env args' Env1 h_args
+    elim_err h
+    rename_i v1 h_args
+    obtain ⟨args', Env1⟩ := v1; simp at h h_args
+    simp only [LMonoTy.tconsAliasSimple] at h
+    split at h <;> (obtain ⟨_, h2⟩ := h; rw [← h2])
+    all_goals exact LMonoTys.resolveAliases_env args Env args' Env1 h_args
 private theorem LMonoTys.resolveAliases_env {IDMeta : Type} [ToFormat IDMeta]
     (mtys : LMonoTys) (Env : TEnv IDMeta) (mtys' : LMonoTys) (Env' : TEnv IDMeta)
     (h : LMonoTys.resolveAliases mtys Env = .ok (mtys', Env')) :
@@ -537,17 +555,15 @@ private theorem LMonoTys.resolveAliases_env {IDMeta : Type} [ToFormat IDMeta]
     obtain ⟨_, h2⟩ := h; exact h2.symm
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_hd
-      obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-      split at h
-      · simp at h
-      · rename_i v2 h_tl
-        obtain ⟨mrest', Env2⟩ := v2
-        simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-        rw [LMonoTys.resolveAliases_env mrest Env1 mrest' Env2 h_tl,
-            LMonoTy.resolveAliases_env mty Env mty' Env1 h_hd]
+    elim_err h
+    rename_i v1 h_hd
+    obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
+    elim_err h
+    rename_i v2 h_tl
+    obtain ⟨mrest', Env2⟩ := v2
+    simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+    rw [LMonoTys.resolveAliases_env mrest Env1 mrest' Env2 h_tl,
+        LMonoTy.resolveAliases_env mty Env mty' Env1 h_hd]
 end
 
 /-- The alias stored by `addTypeAlias` preserves the user-supplied `typeArgs`. -/
@@ -561,21 +577,10 @@ theorem TEnv.addTypeAlias_preserves_typeArgs
               stored.typeArgs = alias.typeArgs := by
   unfold TEnv.addTypeAlias at h
   simp only [Bind.bind, Except.bind] at h
-  split at h
-  · cases h
-  · split at h
-    · cases h
-    · split at h
-      · cases h
-      · -- Now in the success branch: resolveAliases
-        split at h
-        · cases h
-        · -- instantiateWithCheck
-          split at h
-          · cases h
-          · -- h : Except.ok (...) = Except.ok Env'
-            have h := Except.ok.inj h; rw [← h]
-            exact ⟨⟨alias.name, alias.typeArgs, _⟩, rfl, rfl, rfl⟩
+  elim_errs h
+  -- h : Except.ok (...) = Except.ok Env'
+  have h := Except.ok.inj h; rw [← h]
+  exact ⟨⟨alias.name, alias.typeArgs, _⟩, rfl, rfl, rfl⟩
 
 -- TODO (#follow-up): `TEnv.addTypeAlias_stored_dealiased` — the stored type is
 -- a fixpoint of `resolveAliases`. Proof requires showing idempotence of
@@ -590,12 +595,11 @@ theorem LTy.instantiate_context {IDMeta : Type} [ToFormat IDMeta]
   simp [LTy.instantiate, Bind.bind, Except.bind] at h
   split at h
   · simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-  · split at h
-    · simp at h
-    · rename_i v1 h_gen
-      obtain ⟨tvs, Env1⟩ := v1; simp at h h_gen
-      obtain ⟨_, h2⟩ := h; rw [← h2]
-      exact TGenEnv.genTyVars_context _ Env tvs Env1 h_gen
+  · elim_err h
+    rename_i v1 h_gen
+    obtain ⟨tvs, Env1⟩ := v1; simp at h h_gen
+    obtain ⟨_, h2⟩ := h; rw [← h2]
+    exact TGenEnv.genTyVars_context _ Env tvs Env1 h_gen
 
 /-- `LTy.resolveAliases` preserves the context. -/
 theorem LTy.resolveAliases_context {IDMeta : Type} [ToFormat IDMeta]
@@ -603,13 +607,12 @@ theorem LTy.resolveAliases_context {IDMeta : Type} [ToFormat IDMeta]
     (h : LTy.resolveAliases ty Env = .ok (mty, Env')) :
     Env'.context = Env.context := by
   simp [LTy.resolveAliases, Bind.bind, Except.bind] at h
-  split at h
-  · simp at h
-  · rename_i v1 h_inst
-    obtain ⟨mty0, genEnv'⟩ := v1; simp at h h_inst
-    have h_ra := LMonoTy.resolveAliases_context _ _ mty Env' h
-    rw [h_ra]; simp [TEnv.context]
-    exact LTy.instantiate_context ty Env.genEnv mty0 genEnv' h_inst
+  elim_err h
+  rename_i v1 h_inst
+  obtain ⟨mty0, genEnv'⟩ := v1; simp at h h_inst
+  have h_ra := LMonoTy.resolveAliases_context _ _ mty Env' h
+  rw [h_ra]; simp [TEnv.context]
+  exact LTy.instantiate_context ty Env.genEnv mty0 genEnv' h_inst
 
 variable {T : LExprParams} [ToString T.IDMeta] [DecidableEq T.IDMeta]
   [Std.ToFormat T.IDMeta] [HasGen T.IDMeta] [Std.ToFormat (LFunc T)]
@@ -639,9 +642,9 @@ private theorem LMonoTy.freeVars_subst_single_mem
       simp only [LMonoTy.subst, hS_false] at hb
       by_cases hax : a = x
       · subst hax
-        have : Maps.find? [[(a, t)]] a = some t := by
+        have h_find : Maps.find? [[(a, t)]] a = some t := by
           simp [Maps.find?, Map.find?]
-        rw [this] at hb; exact absurd hb hb_not_t
+        rw [h_find] at hb; exact absurd hb hb_not_t
       · have h_find_none : Maps.find? [[(a, t)]] x = none :=
           Maps.not_mem_keys_find?_none' [[(a, t)]] x (by
             simp [Maps.keys, Map.keys]; exact fun h => hax h.symm)
@@ -691,12 +694,12 @@ theorem HasType_subst_fresh_all
   · -- Strong induction on relevantKeys S mty
     -- Thread the freshness condition through the suffices, since SubstWF
     -- guarantees that relevant keys only shrink through substitution steps.
-    suffices ∀ (n : Nat) (mty : LMonoTy),
+    suffices h_gen : ∀ (n : Nat) (mty : LMonoTy),
         relevantKeys S mty = n →
         (∀ a, a ∈ Maps.keys S → a ∈ LMonoTy.freeVars mty → TContext.isFresh (T := T) a Γ) →
         HasType C Γ e (.forAll [] mty) →
         HasType C Γ e (.forAll [] (LMonoTy.subst S mty)) from
-      this (relevantKeys S mty) mty rfl h_fresh h
+      h_gen (relevantKeys S mty) mty rfl h_fresh h
     intro n
     induction n using Nat.strongRecOn with
     | _ n ih =>
@@ -721,8 +724,8 @@ theorem HasType_subst_fresh_all
           -- b ∈ freeVars(subst [[(a,t)]] mty) and b ∈ keys(S)
           -- By SubstWF, b ∉ Subst.freeVars S, and freeVars(t) ⊆ Subst.freeVars S
           have hb_not_fvS : b ∉ Subst.freeVars S := by
-            have := h_wf; simp [SubstWF, List.all_eq_true] at this
-            exact this b hb_key
+            have h_wf' := h_wf; simp [SubstWF, List.all_eq_true] at h_wf'
+            exact h_wf' b hb_key
           have hb_not_t : b ∉ LMonoTy.freeVars t :=
             fun h => hb_not_fvS (Subst.freeVars_of_find_subset S h_find h)
           -- So b ∈ freeVars(mty) by freeVars_subst_single_mem
@@ -753,27 +756,26 @@ private theorem unify_singleton_eq_unifyOne (ty1 ty2 : LMonoTy) (S S_new : Subst
       Constraint.unifyOne (ty1, ty2) S = .ok relS ∧ S_new = relS.newS := by
   simp only [Constraints.unify, Bind.bind, Except.bind] at h
   -- Split on unifyCore result
-  split at h
-  · simp at h
-  · rename_i relS_core h_core
-    simp at h; subst h
-    -- Now decompose unifyCore [(ty1, ty2)] S
-    -- unifyCore for a single-element list calls unifyOne, then unifyCore []
-    -- unifyCore [] returns the substitution unchanged
-    -- So relS_core.newS = relS_one.newS
-    simp only [Constraints.unifyCore, Bind.bind, Except.bind, Except.mapError] at h_core
-    -- h_core involves: match (unifyOne ...) |> mapError with ... then match unifyCore [] with ...
-    -- The unifyOne result determines everything
-    -- Extract the unifyOne result
-    revert h_core
-    generalize h_one_gen : Constraint.unifyOne (ty1, ty2) S = res_one
-    intro h_core
-    match res_one with
-    | .error e =>
-      simp at h_core
-    | .ok relS_one =>
-      simp at h_core
-      exact ⟨relS_one, rfl, congrArg ValidSubstRelation.newS h_core.symm⟩
+  elim_err h
+  rename_i relS_core h_core
+  simp at h; subst h
+  -- Now decompose unifyCore [(ty1, ty2)] S
+  -- unifyCore for a single-element list calls unifyOne, then unifyCore []
+  -- unifyCore [] returns the substitution unchanged
+  -- So relS_core.newS = relS_one.newS
+  simp only [Constraints.unifyCore, Bind.bind, Except.bind, Except.mapError] at h_core
+  -- h_core involves: match (unifyOne ...) |> mapError with ... then match unifyCore [] with ...
+  -- The unifyOne result determines everything
+  -- Extract the unifyOne result
+  revert h_core
+  generalize h_one_gen : Constraint.unifyOne (ty1, ty2) S = res_one
+  intro h_core
+  match res_one with
+  | .error e =>
+    simp at h_core
+  | .ok relS_one =>
+    simp at h_core
+    exact ⟨relS_one, rfl, congrArg ValidSubstRelation.newS h_core.symm⟩
 
 /--
 Unification produces a substitution that makes the two types equal.
@@ -795,47 +797,46 @@ theorem unify_makes_equal₂ (ty1 ty2 ty3 ty4 : LMonoTy) (S_old S_new : SubstInf
     LMonoTy.subst S_new.subst ty3 = LMonoTy.subst S_new.subst ty4 := by
   -- Decompose Constraints.unify into unifyCore
   simp only [Constraints.unify, Bind.bind, Except.bind] at h
-  split at h
-  · simp at h
-  · rename_i relS_final h_core
-    simp only [Except.ok.injEq] at h; subst h
-    -- Decompose unifyCore [(ty1,ty2), (ty3,ty4)] S_old
-    simp only [Constraints.unifyCore, Bind.bind, Except.bind, Except.mapError] at h_core
+  elim_err h
+  rename_i relS_final h_core
+  simp only [Except.ok.injEq] at h; subst h
+  -- Decompose unifyCore [(ty1,ty2), (ty3,ty4)] S_old
+  simp only [Constraints.unifyCore, Bind.bind, Except.bind, Except.mapError] at h_core
+  revert h_core
+  generalize h_one1 : Constraint.unifyOne (ty1, ty2) S_old = res1
+  intro h_core
+  match res1 with
+  | .error e => simp at h_core
+  | .ok relS1 =>
+    simp at h_core
+    -- Decompose unifyCore [(ty3,ty4)] relS1.newS
     revert h_core
-    generalize h_one1 : Constraint.unifyOne (ty1, ty2) S_old = res1
+    generalize h_one2 : Constraint.unifyOne (ty3, ty4) relS1.newS = res2
     intro h_core
-    match res1 with
+    match res2 with
     | .error e => simp at h_core
-    | .ok relS1 =>
+    | .ok relS2 =>
       simp at h_core
-      -- Decompose unifyCore [(ty3,ty4)] relS1.newS
-      revert h_core
-      generalize h_one2 : Constraint.unifyOne (ty3, ty4) relS1.newS = res2
-      intro h_core
-      match res2 with
-      | .error e => simp at h_core
-      | .ok relS2 =>
-        simp at h_core
-        -- After unifyCore [] on relS2.newS, the result is unchanged
-        have h_final_eq : relS_final.newS = relS2.newS :=
-          congrArg ValidSubstRelation.newS h_core.symm
-        -- Constraint.unifyOne_sound on each pair
-        have ih1 := Constraint.unifyOne_sound (ty1, ty2) S_old relS1 h_one1
-        have ih2 := Constraint.unifyOne_sound (ty3, ty4) relS1.newS relS2 h_one2
-        have h_eq1 := ih1.sound
-        have h_eq2 := ih2.sound
-        -- Lift h_eq1 to the final substitution via absorption
-        have h_abs := ih2.absorbs
-        constructor
-        · rw [h_final_eq]
-          calc LMonoTy.subst relS2.newS.subst ty1
-              = LMonoTy.subst relS2.newS.subst (LMonoTy.subst relS1.newS.subst ty1) :=
-                (LMonoTy.subst_absorbs relS2.newS.subst relS1.newS.subst ty1 h_abs).symm
-            _ = LMonoTy.subst relS2.newS.subst (LMonoTy.subst relS1.newS.subst ty2) := by
-                rw [h_eq1]
-            _ = LMonoTy.subst relS2.newS.subst ty2 :=
-                LMonoTy.subst_absorbs relS2.newS.subst relS1.newS.subst ty2 h_abs
-        · rw [h_final_eq]; exact h_eq2
+      -- After unifyCore [] on relS2.newS, the result is unchanged
+      have h_final_eq : relS_final.newS = relS2.newS :=
+        congrArg ValidSubstRelation.newS h_core.symm
+      -- Constraint.unifyOne_sound on each pair
+      have ih1 := Constraint.unifyOne_sound (ty1, ty2) S_old relS1 h_one1
+      have ih2 := Constraint.unifyOne_sound (ty3, ty4) relS1.newS relS2 h_one2
+      have h_eq1 := ih1.sound
+      have h_eq2 := ih2.sound
+      -- Lift h_eq1 to the final substitution via absorption
+      have h_abs := ih2.absorbs
+      constructor
+      · rw [h_final_eq]
+        calc LMonoTy.subst relS2.newS.subst ty1
+            = LMonoTy.subst relS2.newS.subst (LMonoTy.subst relS1.newS.subst ty1) :=
+              (LMonoTy.subst_absorbs relS2.newS.subst relS1.newS.subst ty1 h_abs).symm
+          _ = LMonoTy.subst relS2.newS.subst (LMonoTy.subst relS1.newS.subst ty2) := by
+              rw [h_eq1]
+          _ = LMonoTy.subst relS2.newS.subst ty2 :=
+              LMonoTy.subst_absorbs relS2.newS.subst relS1.newS.subst ty2 h_abs
+      · rw [h_final_eq]; exact h_eq2
 
 
 
@@ -848,11 +849,10 @@ theorem Constraints.unify_keys_incl
     ∀ k, k ∈ Maps.keys S'.subst →
       k ∈ Maps.keys S.subst ∨ k ∈ Constraints.freeVars cs ∨ k ∈ Subst.freeVars S.subst := by
   simp only [Constraints.unify, Bind.bind, Except.bind] at h_unify
-  split at h_unify
-  · simp at h_unify
-  · rename_i relS h_core
-    simp at h_unify; subst h_unify
-    exact (Constraints.unifyCore_sound cs S relS h_core).keys_incl
+  elim_err h_unify
+  rename_i relS h_core
+  simp at h_unify; subst h_unify
+  exact (Constraints.unifyCore_sound cs S relS h_core).keys_incl
 
 /-- Free variables of a substitution `[zip ids (map ftvar freshtvs)]` are a
     subset of `freshtvs`. -/
@@ -911,22 +911,21 @@ theorem LMonoTys.instantiateEnv_freeVars_fresh {T : LExprParams}
   | .ok (a, gE), h_inst =>
     simp at h; obtain ⟨h1, _⟩ := h; rw [← h1] at h_tv
     simp [LMonoTys.instantiate, Bind.bind, Except.bind] at h_inst
-    split at h_inst
-    · simp at h_inst
-    · rename_i v1 h_gen
-      obtain ⟨freshtvs, genEnv1⟩ := v1; simp at h_inst h_gen
-      obtain ⟨h_eq, _⟩ := h_inst; rw [← h_eq] at h_tv
-      -- h_tv : tv ∈ freeVars (subst [zip ids (map ftvar freshtvs)] mtys)
-      -- By freeVars_of_subst_subset, tv ∈ freeVars mtys ++ freeVars [zip ...]
-      have h_subset := LMonoTys.freeVars_of_subst_subset
-        [List.zip ids (List.map LMonoTy.ftvar freshtvs)] mtys h_tv
-      rw [List.mem_append] at h_subset
-      rcases h_subset with h_orig | h_subst_fv
-      · exact h_orig_fresh tv h_orig
-      · have h_len : freshtvs.length = ids.length :=
-          TGenEnv.genTyVars_length _ _ _ _ h_gen
-        have h_in_fresh := Subst.freeVars_zip_ftvar ids freshtvs h_len h_subst_fv
-        exact TGenEnv.genTyVars_allFresh ids.length _ freshtvs genEnv1 h_gen tv h_in_fresh
+    elim_err h_inst
+    rename_i v1 h_gen
+    obtain ⟨freshtvs, genEnv1⟩ := v1; simp at h_inst h_gen
+    obtain ⟨h_eq, _⟩ := h_inst; rw [← h_eq] at h_tv
+    -- h_tv : tv ∈ freeVars (subst [zip ids (map ftvar freshtvs)] mtys)
+    -- By freeVars_of_subst_subset, tv ∈ freeVars mtys ++ freeVars [zip ...]
+    have h_subset := LMonoTys.freeVars_of_subst_subset
+      [List.zip ids (List.map LMonoTy.ftvar freshtvs)] mtys h_tv
+    rw [List.mem_append] at h_subset
+    rcases h_subset with h_orig | h_subst_fv
+    · exact h_orig_fresh tv h_orig
+    · have h_len : freshtvs.length = ids.length :=
+        TGenEnv.genTyVars_length _ _ _ _ h_gen
+      have h_in_fresh := Subst.freeVars_zip_ftvar ids freshtvs h_len h_subst_fv
+      exact TGenEnv.genTyVars_allFresh ids.length _ freshtvs genEnv1 h_gen tv h_in_fresh
 
 /-- If `tv ∈ ids`, then `Maps.find? [zip ids (map ftvar freshtvs)] tv` returns
     some `ftvar ftv` where `ftv ∈ freshtvs`. -/
@@ -1115,18 +1114,17 @@ theorem LMonoTy.resolveAliases_allKeysFresh
     simp [LMonoTy.resolveAliases] at h; grind
   | .tcons name args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_args
-      obtain ⟨args', Env1⟩ := v1; simp at h h_args
-      -- tconsAliasSimple: split on the alias find? match
-      -- tconsAliasSimple doesn't change Env; proof simplified
-      simp only [LMonoTy.tconsAliasSimple] at h
-      split at h <;> (obtain ⟨_, h2⟩ := h; subst h2)
-      -- Env' = Env1 (tconsAliasSimple doesn't change Env). Delegate to list version.
-      <;> exact LMonoTys.resolveAliases_allKeysFresh args Env args' Env1 h_args
-          h_fresh h_vals_fresh h_alias_wf
-          (fun tv htv => h_fvs tv (by simp [LMonoTy.freeVars]; exact htv))
+    elim_err h
+    rename_i v1 h_args
+    obtain ⟨args', Env1⟩ := v1; simp at h h_args
+    -- tconsAliasSimple: split on the alias find? match
+    -- tconsAliasSimple doesn't change Env; proof simplified
+    simp only [LMonoTy.tconsAliasSimple] at h
+    split at h <;> (obtain ⟨_, h2⟩ := h; subst h2)
+    -- Env' = Env1 (tconsAliasSimple doesn't change Env). Delegate to list version.
+    <;> exact LMonoTys.resolveAliases_allKeysFresh args Env args' Env1 h_args
+        h_fresh h_vals_fresh h_alias_wf
+        (fun tv htv => h_fvs tv (by simp [LMonoTy.freeVars]; exact htv))
 
 /-- `LMonoTy.resolveAliases` preserves substitution value freshness. -/
 theorem LMonoTy.resolveAliases_vals_fresh
@@ -1145,18 +1143,17 @@ theorem LMonoTy.resolveAliases_vals_fresh
     simp [LMonoTy.resolveAliases] at h; grind
   | .tcons name args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_args
-      obtain ⟨args', Env1⟩ := v1; simp at h h_args
-      -- tconsAliasSimple: split on the alias find? match
-      -- tconsAliasSimple doesn't change Env; proof simplified
-      simp only [LMonoTy.tconsAliasSimple] at h
-      split at h <;> (obtain ⟨_, h2⟩ := h; subst h2)
-      -- Env' = Env1 (tconsAliasSimple doesn't change Env). Delegate to list version.
-      <;> exact LMonoTys.resolveAliases_vals_fresh args Env args' Env1 h_args
-          h_vals_fresh h_alias_wf
-          (fun tv htv => h_fvs tv (by simp [LMonoTy.freeVars]; exact htv))
+    elim_err h
+    rename_i v1 h_args
+    obtain ⟨args', Env1⟩ := v1; simp at h h_args
+    -- tconsAliasSimple: split on the alias find? match
+    -- tconsAliasSimple doesn't change Env; proof simplified
+    simp only [LMonoTy.tconsAliasSimple] at h
+    split at h <;> (obtain ⟨_, h2⟩ := h; subst h2)
+    -- Env' = Env1 (tconsAliasSimple doesn't change Env). Delegate to list version.
+    <;> exact LMonoTys.resolveAliases_vals_fresh args Env args' Env1 h_args
+        h_vals_fresh h_alias_wf
+        (fun tv htv => h_fvs tv (by simp [LMonoTy.freeVars]; exact htv))
 
 /-- `LMonoTys.resolveAliases` preserves key freshness. -/
 theorem LMonoTys.resolveAliases_allKeysFresh
@@ -1174,34 +1171,32 @@ theorem LMonoTys.resolveAliases_allKeysFresh
     simp [LMonoTys.resolveAliases] at h; grind
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_hd
-      obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-      split at h
-      · simp at h
-      · rename_i v2 h_tl
-        obtain ⟨mrest', Env2⟩ := v2
-        simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-        have h_ctx_eq := LMonoTy.resolveAliases_context mty Env mty' Env1 h_hd
-        have h_hd_fvs : ∀ tv, tv ∈ LMonoTy.freeVars mty →
-            TContext.isFresh (T := T) tv Env.context := by
-          intro tv htv; exact h_fvs tv (by simp [LMonoTys.freeVars]; left; exact htv)
-        have h_hd_fresh :=
-          LMonoTy.resolveAliases_allKeysFresh mty Env mty' Env1 h_hd
-            h_fresh h_vals_fresh h_alias_wf h_hd_fvs
-        have h_vals_fresh_mid :=
-          LMonoTy.resolveAliases_vals_fresh mty Env mty' Env1 h_hd
-            h_vals_fresh h_alias_wf h_hd_fvs
-        have h_alias_wf' : TContext.AliasesWF Env1.context := by
-          rw [show Env1.context = Env.context from h_ctx_eq]; exact h_alias_wf
-        have h_tl_fvs : ∀ tv, tv ∈ LMonoTys.freeVars mrest →
-            TContext.isFresh (T := T) tv Env1.context := by
-          intro tv htv; rw [h_ctx_eq]
-          exact h_fvs tv (by simp [LMonoTys.freeVars]; right; exact htv)
-        rw [← h_ctx_eq]
-        exact LMonoTys.resolveAliases_allKeysFresh mrest Env1 mrest' Env2 h_tl
-          (h_ctx_eq ▸ h_hd_fresh) (h_ctx_eq ▸ h_vals_fresh_mid) h_alias_wf' h_tl_fvs
+    elim_err h
+    rename_i v1 h_hd
+    obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
+    elim_err h
+    rename_i v2 h_tl
+    obtain ⟨mrest', Env2⟩ := v2
+    simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+    have h_ctx_eq := LMonoTy.resolveAliases_context mty Env mty' Env1 h_hd
+    have h_hd_fvs : ∀ tv, tv ∈ LMonoTy.freeVars mty →
+        TContext.isFresh (T := T) tv Env.context := by
+      intro tv htv; exact h_fvs tv (by simp [LMonoTys.freeVars]; left; exact htv)
+    have h_hd_fresh :=
+      LMonoTy.resolveAliases_allKeysFresh mty Env mty' Env1 h_hd
+        h_fresh h_vals_fresh h_alias_wf h_hd_fvs
+    have h_vals_fresh_mid :=
+      LMonoTy.resolveAliases_vals_fresh mty Env mty' Env1 h_hd
+        h_vals_fresh h_alias_wf h_hd_fvs
+    have h_alias_wf' : TContext.AliasesWF Env1.context := by
+      rw [show Env1.context = Env.context from h_ctx_eq]; exact h_alias_wf
+    have h_tl_fvs : ∀ tv, tv ∈ LMonoTys.freeVars mrest →
+        TContext.isFresh (T := T) tv Env1.context := by
+      intro tv htv; rw [h_ctx_eq]
+      exact h_fvs tv (by simp [LMonoTys.freeVars]; right; exact htv)
+    rw [← h_ctx_eq]
+    exact LMonoTys.resolveAliases_allKeysFresh mrest Env1 mrest' Env2 h_tl
+      (h_ctx_eq ▸ h_hd_fresh) (h_ctx_eq ▸ h_vals_fresh_mid) h_alias_wf' h_tl_fvs
 
 /-- `LMonoTys.resolveAliases` preserves substitution value freshness. -/
 theorem LMonoTys.resolveAliases_vals_fresh
@@ -1218,31 +1213,29 @@ theorem LMonoTys.resolveAliases_vals_fresh
     simp [LMonoTys.resolveAliases] at h; grind
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_hd
-      obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-      split at h
-      · simp at h
-      · rename_i v2 h_tl
-        obtain ⟨mrest', Env2⟩ := v2
-        simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-        have h_ctx_eq := LMonoTy.resolveAliases_context mty Env mty' Env1 h_hd
-        have h_hd_fvs : ∀ tv, tv ∈ LMonoTy.freeVars mty →
-            TContext.isFresh (T := T) tv Env.context := by
-          intro tv htv; exact h_fvs tv (by simp [LMonoTys.freeVars]; left; exact htv)
-        have h_vals_fresh_mid :=
-          LMonoTy.resolveAliases_vals_fresh mty Env mty' Env1 h_hd
-            h_vals_fresh h_alias_wf h_hd_fvs
-        have h_alias_wf' : TContext.AliasesWF Env1.context := by
-          rw [show Env1.context = Env.context from h_ctx_eq]; exact h_alias_wf
-        have h_tl_fvs : ∀ tv, tv ∈ LMonoTys.freeVars mrest →
-            TContext.isFresh (T := T) tv Env1.context := by
-          intro tv htv; rw [h_ctx_eq]
-          exact h_fvs tv (by simp [LMonoTys.freeVars]; right; exact htv)
-        rw [← h_ctx_eq]
-        exact LMonoTys.resolveAliases_vals_fresh mrest Env1 mrest' Env2 h_tl
-          (h_ctx_eq ▸ h_vals_fresh_mid) h_alias_wf' h_tl_fvs
+    elim_err h
+    rename_i v1 h_hd
+    obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
+    elim_err h
+    rename_i v2 h_tl
+    obtain ⟨mrest', Env2⟩ := v2
+    simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+    have h_ctx_eq := LMonoTy.resolveAliases_context mty Env mty' Env1 h_hd
+    have h_hd_fvs : ∀ tv, tv ∈ LMonoTy.freeVars mty →
+        TContext.isFresh (T := T) tv Env.context := by
+      intro tv htv; exact h_fvs tv (by simp [LMonoTys.freeVars]; left; exact htv)
+    have h_vals_fresh_mid :=
+      LMonoTy.resolveAliases_vals_fresh mty Env mty' Env1 h_hd
+        h_vals_fresh h_alias_wf h_hd_fvs
+    have h_alias_wf' : TContext.AliasesWF Env1.context := by
+      rw [show Env1.context = Env.context from h_ctx_eq]; exact h_alias_wf
+    have h_tl_fvs : ∀ tv, tv ∈ LMonoTys.freeVars mrest →
+        TContext.isFresh (T := T) tv Env1.context := by
+      intro tv htv; rw [h_ctx_eq]
+      exact h_fvs tv (by simp [LMonoTys.freeVars]; right; exact htv)
+    rw [← h_ctx_eq]
+    exact LMonoTys.resolveAliases_vals_fresh mrest Env1 mrest' Env2 h_tl
+      (h_ctx_eq ▸ h_vals_fresh_mid) h_alias_wf' h_tl_fvs
 
 /-- `LMonoTy.resolveAliases` preserves freshness of type free vars. -/
 theorem LMonoTy.resolveAliases_fvs_fresh
@@ -1262,7 +1255,7 @@ theorem LMonoTy.resolveAliases_fvs_fresh
     simp [LMonoTy.resolveAliases] at h; grind
   | .tcons name args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     · rename_i v1 h_args_ra
       obtain ⟨args', Env1⟩ := v1; simp at h h_args_ra
       -- tconsAliasSimple doesn't change Env; proof simplified
@@ -1312,10 +1305,10 @@ theorem LMonoTys.resolveAliases_fvs_fresh
     simp [LMonoTys.resolveAliases] at h; grind
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     · rename_i v1 h_hd
       obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-      split at h; · simp at h
+      elim_err h
       · rename_i v2 h_tl
         obtain ⟨mrest', Env2⟩ := v2
         simp at h; obtain ⟨h1, _⟩ := h; subst h1
@@ -1372,16 +1365,15 @@ private theorem LMonoTy.resolveAliases_absorbs
     exact Subst.absorbs_refl _ Env.stateSubstInfo.isWF
   | .tcons name args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_args
-      obtain ⟨args', Env1⟩ := v1; simp at h h_args
-      -- tconsAliasSimple: split on the alias find? match
-      -- tconsAliasSimple doesn't change Env; proof simplified
-      simp only [LMonoTy.tconsAliasSimple] at h
-      split at h <;> (obtain ⟨_, h2⟩ := h; subst h2)
-      -- Env' = Env1 (tconsAliasSimple doesn't change Env)
-      all_goals exact LMonoTys.resolveAliases_absorbs args Env args' Env1 h_args
+    elim_err h
+    rename_i v1 h_args
+    obtain ⟨args', Env1⟩ := v1; simp at h h_args
+    -- tconsAliasSimple: split on the alias find? match
+    -- tconsAliasSimple doesn't change Env; proof simplified
+    simp only [LMonoTy.tconsAliasSimple] at h
+    split at h <;> (obtain ⟨_, h2⟩ := h; subst h2)
+    -- Env' = Env1 (tconsAliasSimple doesn't change Env)
+    all_goals exact LMonoTys.resolveAliases_absorbs args Env args' Env1 h_args
 
 /-- `LMonoTys.resolveAliases` produces a substitution that absorbs the input. -/
 private theorem LMonoTys.resolveAliases_absorbs
@@ -1395,20 +1387,18 @@ private theorem LMonoTys.resolveAliases_absorbs
     exact Subst.absorbs_refl _ Env.stateSubstInfo.isWF
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_hd
-      obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-      split at h
-      · simp at h
-      · rename_i v2 h_tl
-        obtain ⟨mrest', Env2⟩ := v2
-        simp at h
-        obtain ⟨_, h2⟩ := h; rw [← h2]
-        exact Subst.absorbs_trans
-          Env.stateSubstInfo.subst Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst
-          (LMonoTy.resolveAliases_absorbs mty Env mty' Env1 h_hd)
-          (LMonoTys.resolveAliases_absorbs mrest Env1 mrest' Env2 h_tl)
+    elim_err h
+    rename_i v1 h_hd
+    obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
+    elim_err h
+    rename_i v2 h_tl
+    obtain ⟨mrest', Env2⟩ := v2
+    simp at h
+    obtain ⟨_, h2⟩ := h; rw [← h2]
+    exact Subst.absorbs_trans
+      Env.stateSubstInfo.subst Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst
+      (LMonoTy.resolveAliases_absorbs mty Env mty' Env1 h_hd)
+      (LMonoTys.resolveAliases_absorbs mrest Env1 mrest' Env2 h_tl)
 end
 
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
@@ -1418,14 +1408,13 @@ private theorem LTy_resolveAliases_absorbs
     (h : LTy.resolveAliases ty Env = .ok (mty, Env')) :
     Subst.absorbs Env'.stateSubstInfo.subst Env.stateSubstInfo.subst := by
   simp only [LTy.resolveAliases, Bind.bind, Except.bind] at h
-  split at h
-  · simp at h
-  · rename_i v1 h_inst
-    obtain ⟨mty0, genEnv'⟩ := v1; simp at h h_inst
-    -- After ty.instantiate, only genEnv changes; stateSubstInfo is preserved.
-    have h_subst_eq : ({Env with genEnv := genEnv'} : TEnv T.IDMeta).stateSubstInfo =
-        Env.stateSubstInfo := rfl
-    exact h_subst_eq ▸ LMonoTy.resolveAliases_absorbs mty0 {Env with genEnv := genEnv'} mty Env' h
+  elim_err h
+  rename_i v1 h_inst
+  obtain ⟨mty0, genEnv'⟩ := v1; simp at h h_inst
+  -- After ty.instantiate, only genEnv changes; stateSubstInfo is preserved.
+  have h_subst_eq : ({Env with genEnv := genEnv'} : TEnv T.IDMeta).stateSubstInfo =
+      Env.stateSubstInfo := rfl
+  exact h_subst_eq ▸ LMonoTy.resolveAliases_absorbs mty0 {Env with genEnv := genEnv'} mty Env' h
 
 /-- Helper: extract a `Constraints.unify` hypothesis from a `mapError` wrapper. -/
 theorem unify_of_mapError {constraints : Constraints} {S : SubstInfo} {S' : SubstInfo}
@@ -1444,20 +1433,16 @@ private theorem LTy_instantiateWithCheck_absorbs
     (h : LTy.instantiateWithCheck ty C Env = .ok (mty, Env')) :
     Subst.absorbs Env'.stateSubstInfo.subst Env.stateSubstInfo.subst := by
   simp only [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h
-  split at h
-  · simp at h
-  · rename_i v1 h_res
-    obtain ⟨mty0, Env1⟩ := v1
-    dsimp at h h_res
-    -- h contains `if !checkNoFutureGenVars then error else if isInstanceOfKnownType then ... else ...`
-    split at h; · simp at h  -- checkNoFutureGenVars failed
-    split at h
-    · -- true branch: return (mty0, Env1)
-      simp at h
-      obtain ⟨_, h2⟩ := h; rw [← h2]
-      exact LTy_resolveAliases_absorbs ty Env mty0 Env1 h_res
-    · -- false branch: error
-      simp at h
+  elim_err h
+  rename_i v1 h_res
+  obtain ⟨mty0, Env1⟩ := v1
+  dsimp at h h_res
+  -- h contains `if !checkNoFutureGenVars then error else if isInstanceOfKnownType then ... else ...`
+  elim_errs h
+  -- true branch: return (mty0, Env1)
+  simp at h
+  obtain ⟨_, h2⟩ := h; rw [← h2]
+  exact LTy_resolveAliases_absorbs ty Env mty0 Env1 h_res
 
 omit [ToString
   T.IDMeta] [DecidableEq T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
@@ -1467,30 +1452,24 @@ private theorem LMonoTy_instantiateWithCheck_absorbs
     (h : LMonoTy.instantiateWithCheck mty_in C Env = .ok (mty, Env')) :
     Subst.absorbs Env'.stateSubstInfo.subst Env.stateSubstInfo.subst := by
   simp only [LMonoTy.instantiateWithCheck] at h
-  split at h
-  · simp at h
-  · rename_i instTypes Env1 h_inst
-    simp [Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v2 h_res
-      obtain ⟨mtyi, Env2⟩ := v2
-      dsimp at h h_res
-      split at h; · simp at h  -- checkNoFutureGenVars failed
-      split at h
-      · -- true branch: return (mtyi, Env2)
-        simp at h
-        obtain ⟨_, h2⟩ := h; rw [← h2]
-        -- instantiateEnv only changes genEnv
-        have h_subst_eq : Env1.stateSubstInfo = Env.stateSubstInfo := by
-          simp [LMonoTys.instantiateEnv] at h_inst
-          split at h_inst
-          · simp at h_inst
-          · simp at h_inst; obtain ⟨_, h_env⟩ := h_inst; rw [← h_env]
-        rw [← h_subst_eq]
-        exact LMonoTy.resolveAliases_absorbs _ Env1 mtyi Env2 h_res
-      · -- false branch: error
-        simp at h
+  elim_err h
+  rename_i instTypes Env1 h_inst
+  simp [Bind.bind, Except.bind] at h
+  elim_err h
+  rename_i v2 h_res
+  obtain ⟨mtyi, Env2⟩ := v2
+  dsimp at h h_res
+  elim_errs h
+  -- true branch: return (mtyi, Env2)
+  simp at h
+  obtain ⟨_, h2⟩ := h; rw [← h2]
+  -- instantiateEnv only changes genEnv
+  have h_subst_eq : Env1.stateSubstInfo = Env.stateSubstInfo := by
+    simp [LMonoTys.instantiateEnv] at h_inst
+    elim_err h_inst
+    simp at h_inst; obtain ⟨_, h_env⟩ := h_inst; rw [← h_env]
+  rw [← h_subst_eq]
+  exact LMonoTy.resolveAliases_absorbs _ Env1 mtyi Env2 h_res
 
 omit [ToString T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- `inferFVar` produces a substitution that absorbs the input. -/
@@ -1500,43 +1479,39 @@ private theorem inferFVar_absorbs
     (h : inferFVar C Env x fty = .ok (ty_res, Env')) :
     Subst.absorbs Env'.stateSubstInfo.subst Env.stateSubstInfo.subst := by
   simp only [inferFVar, Bind.bind, Except.bind] at h
-  split at h
-  · simp at h
-  · rename_i ty h_find
-    -- Split on result of LTy.instantiateWithCheck
-    split at h
-    · simp at h
-    · rename_i v1 h_inst
-      obtain ⟨mty, Env1⟩ := v1
-      dsimp at h h_inst
-      -- Now h has `match fty with | none => ... | some fty => ...`
-      -- Split on fty
-      cases fty with
-      | none =>
-        simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-        exact LTy_instantiateWithCheck_absorbs ty C Env mty Env1 h_inst
-      | some fty_val =>
-        simp only [Except.mapError] at h
-        -- Split on result of LMonoTy.instantiateWithCheck
-        split at h
-        · simp at h
-        · rename_i v2 h_inst2
-          obtain ⟨fty_inst, Env2⟩ := v2
-          dsimp at h h_inst2
-          -- Split on result of Constraints.unify (wrapped in mapError)
-          split at h
-          · simp at h
-          · rename_i v3 h_mapError
-            simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-            simp [TEnv.updateSubst]
-            have h_unify := unify_of_mapError h_mapError
-            exact Subst.absorbs_trans
-              Env.stateSubstInfo.subst Env2.stateSubstInfo.subst v3.subst
-              (Subst.absorbs_trans
-                Env.stateSubstInfo.subst Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst
-                (LTy_instantiateWithCheck_absorbs ty C Env mty Env1 h_inst)
-                (LMonoTy_instantiateWithCheck_absorbs fty_val C Env1 fty_inst Env2 h_inst2))
-              (Constraints.unify_absorbs _ _ _ h_unify)
+  elim_err h
+  rename_i ty h_find
+  -- Split on result of LTy.instantiateWithCheck
+  elim_err h
+  rename_i v1 h_inst
+  obtain ⟨mty, Env1⟩ := v1
+  dsimp at h h_inst
+  -- Now h has `match fty with | none => ... | some fty => ...`
+  -- Split on fty
+  cases fty with
+  | none =>
+    simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+    exact LTy_instantiateWithCheck_absorbs ty C Env mty Env1 h_inst
+  | some fty_val =>
+    simp only [Except.mapError] at h
+    -- Split on result of LMonoTy.instantiateWithCheck
+    elim_err h
+    rename_i v2 h_inst2
+    obtain ⟨fty_inst, Env2⟩ := v2
+    dsimp at h h_inst2
+    -- Split on result of Constraints.unify (wrapped in mapError)
+    elim_err h
+    rename_i v3 h_mapError
+    simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+    simp [TEnv.updateSubst]
+    have h_unify := unify_of_mapError h_mapError
+    exact Subst.absorbs_trans
+      Env.stateSubstInfo.subst Env2.stateSubstInfo.subst v3.subst
+      (Subst.absorbs_trans
+        Env.stateSubstInfo.subst Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst
+        (LTy_instantiateWithCheck_absorbs ty C Env mty Env1 h_inst)
+        (LMonoTy_instantiateWithCheck_absorbs fty_val C Env1 fty_inst Env2 h_inst2))
+      (Constraints.unify_absorbs _ _ _ h_unify)
 
 omit [ToString T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- `typeBoundVar` produces a substitution that absorbs the input.
@@ -1552,43 +1527,39 @@ private theorem typeBoundVar_absorbs
     Subst.absorbs Env'.stateSubstInfo.subst Env.stateSubstInfo.subst := by
   simp only [typeBoundVar, liftGenEnv, Bind.bind, Except.bind] at h
   -- Split on the result of HasGen.genVar (returns Except)
+  elim_err h
+  -- HasGen.genVar succeeded
+  rename_i genResult h_gen
+  -- Extract: liftGenEnv preserves stateSubstInfo
+  have h_gen_subst : genResult.snd.stateSubstInfo = Env.stateSubstInfo := by
+    elim_err h_gen
+    have h_gen_eq := Except.ok.inj h_gen; rw [← h_gen_eq]
+  -- Now case split on bty
   split at h
-  · contradiction
-  · -- HasGen.genVar succeeded
-    rename_i genResult h_gen
-    -- Extract: liftGenEnv preserves stateSubstInfo
-    have h_gen_subst : genResult.snd.stateSubstInfo = Env.stateSubstInfo := by
-      split at h_gen
-      · contradiction
-      · have := Except.ok.inj h_gen; rw [← this]
-    -- Now case split on bty
-    split at h
-    · -- some bty_val
-      -- Split on the instantiateWithCheck result
-      split at h
-      · contradiction
-      · -- instantiateWithCheck succeeded
-        rename_i _ bty_mty _ _ Env_inst h_inst
-        simp at h
-        obtain ⟨_, _, h_env⟩ := h; rw [← h_env]
-        simp only [TEnv.addInNewestContext, TEnv.updateContext]
-        have := LMonoTy_instantiateWithCheck_absorbs bty_mty C
-          genResult.snd _ _ h_inst
-        rw [h_gen_subst] at this
-        exact this
-    · -- none
-      -- Split on result of genTyVar
-      split at h
-      · contradiction
-      · rename_i v1 h_genTy
-        obtain ⟨xtyid, Env1⟩ := v1
-        simp at h
-        obtain ⟨_, _, h_env⟩ := h; rw [← h_env]
-        simp only [TEnv.addInNewestContext, TEnv.updateContext]
-        -- genTyVar preserves stateSubstInfo
-        have h_subst := TEnv.genTyVar_subst _ xtyid Env1 h_genTy
-        rw [h_subst, h_gen_subst]
-        exact Subst.absorbs_refl _ Env.stateSubstInfo.isWF
+  · -- some bty_val
+    -- Split on the instantiateWithCheck result
+    elim_err h
+    -- instantiateWithCheck succeeded
+    rename_i _ bty_mty _ _ Env_inst h_inst
+    simp at h
+    obtain ⟨_, _, h_env⟩ := h; rw [← h_env]
+    simp only [TEnv.addInNewestContext, TEnv.updateContext]
+    have h_abs := LMonoTy_instantiateWithCheck_absorbs bty_mty C
+      genResult.snd _ _ h_inst
+    rw [h_gen_subst] at h_abs
+    exact h_abs
+  · -- none
+    -- Split on result of genTyVar
+    elim_err h
+    rename_i v1 h_genTy
+    obtain ⟨xtyid, Env1⟩ := v1
+    simp at h
+    obtain ⟨_, _, h_env⟩ := h; rw [← h_env]
+    simp only [TEnv.addInNewestContext, TEnv.updateContext]
+    -- genTyVar preserves stateSubstInfo
+    have h_subst := TEnv.genTyVar_subst _ xtyid Env1 h_genTy
+    rw [h_subst, h_gen_subst]
+    exact Subst.absorbs_refl _ Env.stateSubstInfo.isWF
 
 /-- `subst (remove S k) mty = subst S mty` when `k ∉ freeVars mty`.
     Since `LMonoTy.subst` is single-pass, removing a key that doesn't
@@ -1680,31 +1651,27 @@ private theorem inferFVar_tyGen_mono
     (h : inferFVar C Env x fty = .ok (ty_res, Env')) :
     Env'.genEnv.genState.tyGen ≥ Env.genEnv.genState.tyGen := by
   simp only [inferFVar] at h
-  split at h
-  · simp at h
-  · rename_i ty h_find
-    simp only [Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_iwc
-      obtain ⟨ty_inst, Env1⟩ := v1; simp at h h_iwc
-      cases fty with
-      | none =>
-        simp at h; obtain ⟨_, h_env⟩ := h; subst h_env
-        exact LTy_instantiateWithCheck_tyGen_mono ty C Env ty_inst Env1 h_iwc
-      | some fty_val =>
-        simp only [Except.mapError] at h
-        split at h
-        · simp at h
-        · rename_i v2 h_iwc2
-          obtain ⟨fty_inst, Env2⟩ := v2; simp at h h_iwc2
-          split at h
-          · simp at h
-          · simp at h; obtain ⟨_, h_env⟩ := h; subst h_env
-            simp [TEnv.updateSubst]
-            exact Nat.le_trans
-              (LTy_instantiateWithCheck_tyGen_mono ty C Env ty_inst Env1 h_iwc)
-              (LMonoTy_instantiateWithCheck_tyGen_mono fty_val C Env1 fty_inst Env2 h_iwc2)
+  elim_err h
+  rename_i ty h_find
+  simp only [Bind.bind, Except.bind] at h
+  elim_err h
+  rename_i v1 h_iwc
+  obtain ⟨ty_inst, Env1⟩ := v1; simp at h h_iwc
+  cases fty with
+  | none =>
+    simp at h; obtain ⟨_, h_env⟩ := h; subst h_env
+    exact LTy_instantiateWithCheck_tyGen_mono ty C Env ty_inst Env1 h_iwc
+  | some fty_val =>
+    simp only [Except.mapError] at h
+    elim_err h
+    rename_i v2 h_iwc2
+    obtain ⟨fty_inst, Env2⟩ := v2; simp at h h_iwc2
+    elim_err h
+    simp at h; obtain ⟨_, h_env⟩ := h; subst h_env
+    simp [TEnv.updateSubst]
+    exact Nat.le_trans
+      (LTy_instantiateWithCheck_tyGen_mono ty C Env ty_inst Env1 h_iwc)
+      (LMonoTy_instantiateWithCheck_tyGen_mono fty_val C Env1 fty_inst Env2 h_iwc2)
 
 omit [ToString T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] [DecidableEq T.IDMeta] in
 private theorem typeBoundVar_tyGen_mono
@@ -1714,43 +1681,39 @@ private theorem typeBoundVar_tyGen_mono
     Env'.genEnv.genState.tyGen ≥ Env.genEnv.genState.tyGen := by
   simp only [typeBoundVar, liftGenEnv, Bind.bind, Except.bind] at h
   -- Split on the result of HasGen.genVar (returns Except)
+  elim_err h
+  -- HasGen.genVar succeeded
+  rename_i genResult h_gen
+  -- Extract: genResult.snd.genEnv.genState.tyGen ≥ Env.genEnv.genState.tyGen
+  have h_gen_tyGen : genResult.snd.genEnv.genState.tyGen ≥ Env.genEnv.genState.tyGen := by
+    elim_err h_gen
+    rename_i _ _ h_genVar
+    have h_gen_eq := Except.ok.inj h_gen; rw [← h_gen_eq]
+    simp
+    exact _root_.Lambda.HasGen.genVar_tyGen_mono Env.genEnv _ _ h_genVar
+  -- Now case split on bty
   split at h
-  · contradiction
-  · -- HasGen.genVar succeeded
-    rename_i genResult h_gen
-    -- Extract: genResult.snd.genEnv.genState.tyGen ≥ Env.genEnv.genState.tyGen
-    have h_gen_tyGen : genResult.snd.genEnv.genState.tyGen ≥ Env.genEnv.genState.tyGen := by
-      split at h_gen
-      · contradiction
-      · rename_i _ _ h_genVar
-        have := Except.ok.inj h_gen; rw [← this]
-        simp
-        exact _root_.Lambda.HasGen.genVar_tyGen_mono Env.genEnv _ _ h_genVar
-    -- Now case split on bty
-    split at h
-    · -- some bty_val
-      -- Split on the instantiateWithCheck result
-      split at h
-      · contradiction
-      · -- instantiateWithCheck succeeded
-        rename_i _ bty_mty _ _ Env_inst h_inst
-        simp at h
-        obtain ⟨_, _, h_env⟩ := h; rw [← h_env]
-        simp only [TEnv.addInNewestContext, TEnv.updateContext]
-        exact Nat.le_trans h_gen_tyGen
-          (LMonoTy_instantiateWithCheck_tyGen_mono bty_mty C
-            genResult.snd _ _ h_inst)
-    · -- none
-      -- Split on result of genTyVar
-      split at h
-      · contradiction
-      · rename_i v1 h_genTy
-        obtain ⟨xtyid, Env1⟩ := v1
-        simp at h
-        obtain ⟨_, _, h_env⟩ := h; rw [← h_env]
-        simp only [TEnv.addInNewestContext, TEnv.updateContext]
-        have h_tyGen := genTyVar_tyGen _ xtyid Env1 h_genTy
-        omega
+  · -- some bty_val
+    -- Split on the instantiateWithCheck result
+    elim_err h
+    -- instantiateWithCheck succeeded
+    rename_i _ bty_mty _ _ Env_inst h_inst
+    simp at h
+    obtain ⟨_, _, h_env⟩ := h; rw [← h_env]
+    simp only [TEnv.addInNewestContext, TEnv.updateContext]
+    exact Nat.le_trans h_gen_tyGen
+      (LMonoTy_instantiateWithCheck_tyGen_mono bty_mty C
+        genResult.snd _ _ h_inst)
+  · -- none
+    -- Split on result of genTyVar
+    elim_err h
+    rename_i v1 h_genTy
+    obtain ⟨xtyid, Env1⟩ := v1
+    simp at h
+    obtain ⟨_, _, h_env⟩ := h; rw [← h_env]
+    simp only [TEnv.addInNewestContext, TEnv.updateContext]
+    have h_tyGen := genTyVar_tyGen _ xtyid Env1 h_genTy
+    omega
 
 /-- Prove `e_i.sizeOf < n` (or `≤`) from a hypothesis `h : LExpr.sizeOf e = n`. -/
 macro "expr_size" h:ident : tactic =>
@@ -1795,11 +1758,10 @@ private theorem unify_preserves_SubstFreshForGen
     have h_incl : Subst.freeVars S'.subst ⊆
         Constraints.freeVars cs ++ Subst.freeVars S.subst := by
       simp only [Constraints.unify, Bind.bind, Except.bind] at h_unify
-      split at h_unify
-      · simp at h_unify
-      · rename_i relS h_core
-        simp at h_unify; subst h_unify
-        exact relS.goodSubset
+      elim_err h_unify
+      rename_i relS h_core
+      simp at h_unify; subst h_unify
+      exact relS.goodSubset
     rcases List.mem_append.mp (h_incl h_fv) with h | h
     · exact h_fresh_cs v h n hn
     · exact h_fresh_S v (Or.inr h) n hn
@@ -1813,18 +1775,17 @@ theorem genTyVar_genFresh'
     (h : TGenEnv.genTyVar Env = .ok (tv, Env')) :
     ∀ n, n ≥ Env'.genState.tyGen → tv ≠ TState.tyPrefix ++ toString n := by
   simp only [TGenEnv.genTyVar] at h
-  split at h
-  · simp at h
-  · simp at h; obtain ⟨h_tv, h_env⟩ := h
-    rw [← h_tv, ← h_env]
-    simp only [TState.genTySym, TState.incTyGen]
-    simp [-Nat.toString_eq_repr]
-    intro n hn h_eq
-    -- genTySym gives tyPrefix ++ toString Env.genState.tyGen
-    -- Env'.genState.tyGen = Env.genState.tyGen + 1
-    -- So the name has index Env.genState.tyGen < n, hence ≠
-    have h_ne : Env.genState.tyGen ≠ n := by omega
-    exact absurd (Nat.toString_injective h_eq) h_ne
+  elim_err h
+  simp at h; obtain ⟨h_tv, h_env⟩ := h
+  rw [← h_tv, ← h_env]
+  simp only [TState.genTySym, TState.incTyGen]
+  simp [-Nat.toString_eq_repr]
+  intro n hn h_eq
+  -- genTySym gives tyPrefix ++ toString Env.genState.tyGen
+  -- Env'.genState.tyGen = Env.genState.tyGen + 1
+  -- So the name has index Env.genState.tyGen < n, hence ≠
+  have h_ne : Env.genState.tyGen ≠ n := by omega
+  exact absurd (Nat.toString_injective h_eq) h_ne
 
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- All vars produced by `TGenEnv.genTyVars` satisfy gen-freshness for the
@@ -1841,9 +1802,9 @@ theorem genTyVars_genFresh'
     simp [TGenEnv.genTyVars] at h; grind
   | succ k ih =>
     simp [TGenEnv.genTyVars, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_gen1; obtain ⟨tv1, Env1⟩ := v1; simp at h
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_gen_rest; obtain ⟨rest, Env2⟩ := v2; simp at h
     obtain ⟨h_tvs, h_env⟩ := h; subst h_tvs; subst h_env
     intro tv h_mem n hn
@@ -1874,20 +1835,19 @@ theorem instantiateEnv_freeVars_genFresh_closed
   | .ok (a, gE), h_inst =>
     simp at h; obtain ⟨h1, h2⟩ := h; rw [← h1] at h_tv; rw [← h2]
     simp [LMonoTys.instantiate, Bind.bind, Except.bind] at h_inst
-    split at h_inst
-    · simp at h_inst
-    · rename_i v1 h_gen
-      obtain ⟨freshtvs, genEnv1⟩ := v1; simp at h_inst h_gen
-      obtain ⟨h_eq, h_env⟩ := h_inst; rw [← h_eq] at h_tv; rw [← h_env]
-      have h_len : freshtvs.length = ids.length :=
-        TGenEnv.genTyVars_length _ _ _ _ h_gen
-      have h_in_fresh := LMonoTys.freeVars_subst_closed ids freshtvs h_len mtys h_closed tv h_tv
-      -- Apply genTyVars gen-freshness: each fresh var is tyPrefix ++ toString k
-      -- for k < genEnv1.genState.tyGen, so ≠ tyPrefix ++ toString n for n ≥ that.
-      have h_gen_fresh : ∀ tv', tv' ∈ freshtvs →
-          ∀ m, m ≥ genEnv1.genState.tyGen → tv' ≠ TState.tyPrefix ++ toString m :=
-        genTyVars_genFresh' ids.length _ freshtvs genEnv1 h_gen
-      exact h_gen_fresh tv h_in_fresh
+    elim_err h_inst
+    rename_i v1 h_gen
+    obtain ⟨freshtvs, genEnv1⟩ := v1; simp at h_inst h_gen
+    obtain ⟨h_eq, h_env⟩ := h_inst; rw [← h_eq] at h_tv; rw [← h_env]
+    have h_len : freshtvs.length = ids.length :=
+      TGenEnv.genTyVars_length _ _ _ _ h_gen
+    have h_in_fresh := LMonoTys.freeVars_subst_closed ids freshtvs h_len mtys h_closed tv h_tv
+    -- Apply genTyVars gen-freshness: each fresh var is tyPrefix ++ toString k
+    -- for k < genEnv1.genState.tyGen, so ≠ tyPrefix ++ toString n for n ≥ that.
+    have h_gen_fresh : ∀ tv', tv' ∈ freshtvs →
+        ∀ m, m ≥ genEnv1.genState.tyGen → tv' ≠ TState.tyPrefix ++ toString m :=
+      genTyVars_genFresh' ids.length _ freshtvs genEnv1 h_gen
+    exact h_gen_fresh tv h_in_fresh
 
 
 
@@ -1902,7 +1862,7 @@ private theorem LMonoTy_resolveAliases_genState_mono
     simp [LMonoTy.resolveAliases] at h; grind
   | .tcons name args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_args; obtain ⟨args', Env1⟩ := v1; simp at h h_args
     -- tconsAliasSimple: split on the alias find? match
     -- tconsAliasSimple doesn't change Env; proof simplified
@@ -1919,9 +1879,9 @@ private theorem LMonoTys_resolveAliases_genState_mono
     simp [LMonoTys.resolveAliases] at h; grind
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_hd; obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_tl; obtain ⟨mrest', Env2⟩ := v2
     simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
     exact Nat.le_trans
@@ -1929,6 +1889,7 @@ private theorem LMonoTys_resolveAliases_genState_mono
       (LMonoTys_resolveAliases_genState_mono mrest Env1 mrest' Env2 h_tl)
 end
 
+
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 mutual
 /-- `LMonoTy.resolveAliases` preserves `SubstFreshForGen`.
@@ -1948,7 +1909,7 @@ private theorem LMonoTy_resolveAliases_preserves_SubstFreshForGen
     simp [LMonoTy.resolveAliases] at h; grind
   | .tcons name args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_args; obtain ⟨args', Env1⟩ := v1; simp at h h_args
     have h_args_result := LMonoTys_resolveAliases_preserves_SubstFreshForGen args Env args' Env1 h_args
           h_fresh h_aw (fun v hv => h_input v (by simp [LMonoTy.freeVars]; exact hv))
@@ -1985,9 +1946,9 @@ private theorem LMonoTys_resolveAliases_preserves_SubstFreshForGen
     simp [LMonoTys.resolveAliases] at h; grind
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_hd; obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_tl; obtain ⟨mrest', Env2⟩ := v2
     simp at h; obtain ⟨h1, h2⟩ := h; subst h1; subst h2
     have h_ctx_hd := LMonoTy.resolveAliases_context mty Env mty' Env1 h_hd
@@ -2030,7 +1991,7 @@ private theorem LTy_resolveAliases_preserves_SubstFreshForGen
       ∀ n, n ≥ Env.genEnv.genState.tyGen → v ≠ TState.tyPrefix ++ toString n) :
     SubstFreshForGen Env'.stateSubstInfo Env'.genEnv.genState := by
   simp only [LTy.resolveAliases, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v1 h_inst; obtain ⟨mty0, genEnv'⟩ := v1; simp at h h_inst
   have h_eq : ({Env with genEnv := genEnv'} : TEnv T.IDMeta).stateSubstInfo = Env.stateSubstInfo := rfl
   have h_ctx_eq : ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context = Env.context := by
@@ -2041,7 +2002,7 @@ private theorem LTy_resolveAliases_preserves_SubstFreshForGen
     simp [LTy.instantiate, Bind.bind, Except.bind] at h_inst
     split at h_inst
     · grind
-    · split at h_inst; · simp at h_inst
+    · elim_err h_inst
       rename_i v2 h_gen; obtain ⟨freshtvs, Env1⟩ := v2; simp at h_inst
       obtain ⟨_, h2⟩ := h_inst; rw [← h2]
       exact genTyVars_tyGen_mono _ Env.genEnv freshtvs Env1 h_gen
@@ -2063,7 +2024,7 @@ private theorem LTy_resolveAliases_preserves_SubstFreshForGen
       -- Polymorphic: genTyVars generates fresh vars, then body is substituted.
       -- Decompose h_inst to extract freshtvs
       simp [LTy.instantiate, Bind.bind, Except.bind] at h_inst
-      split at h_inst; · simp at h_inst
+      elim_err h_inst
       rename_i v_gen h_gen; obtain ⟨freshtvs, Env1⟩ := v_gen; simp at h_inst h_gen
       obtain ⟨h_mty, h_env⟩ := h_inst; subst h_mty; subst h_env
       -- mty0 = subst [zip (x::xs) (map ftvar freshtvs)] body
@@ -2091,11 +2052,11 @@ private theorem LTy_resolveAliases_preserves_SubstFreshForGen
           obtain ⟨mty_val, h_in_vals, h_fv⟩ := h_subst_fvs
           -- mty_val ∈ Map.values (zip (x::xs) (map ftvar freshtvs))
           -- Map.values of zip = second components ⊆ map ftvar freshtvs
-          suffices ∀ (vars : List TyIdentifier) (tvs : List TyIdentifier),
+          suffices h_val_ftvar : ∀ (vars : List TyIdentifier) (tvs : List TyIdentifier),
               mty_val ∈ Map.values (List.zip vars (tvs.map LMonoTy.ftvar)) →
               ∃ t ∈ tvs, mty_val = .ftvar t by
             simp at h_in_vals
-            obtain ⟨t, h_t_mem, h_eq⟩ := this (x :: xs) freshtvs h_in_vals
+            obtain ⟨t, h_t_mem, h_eq⟩ := h_val_ftvar (x :: xs) freshtvs h_in_vals
             rw [h_eq] at h_fv; simp [LMonoTy.freeVars] at h_fv
             rw [h_fv]; exact h_t_mem
           intro vars tvs h_val
@@ -2130,13 +2091,11 @@ private theorem LTy_instantiateWithCheck_preserves_SubstFreshForGen
       ∀ n, n ≥ Env.genEnv.genState.tyGen → v ≠ TState.tyPrefix ++ toString n) :
     SubstFreshForGen Env'.stateSubstInfo Env'.genEnv.genState := by
   simp only [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v1 h_res; obtain ⟨mty0, Env1⟩ := v1; dsimp at h h_res
-  split at h; · simp at h  -- checkNoFutureGenVars
-  split at h
-  · simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-    exact LTy_resolveAliases_preserves_SubstFreshForGen ty Env mty0 Env1 h_res h_fresh h_aw h_ty_fresh h_bv_fresh
-  · simp at h
+  elim_errs h  -- checkNoFutureGenVars
+  simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+  exact LTy_resolveAliases_preserves_SubstFreshForGen ty Env mty0 Env1 h_res h_fresh h_aw h_ty_fresh h_bv_fresh
 
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- `LMonoTy.instantiateWithCheck` preserves `SubstFreshForGen`. -/
@@ -2147,40 +2106,38 @@ private theorem LMonoTy_instantiateWithCheck_preserves_SubstFreshForGen
     (h_aw : TContext.AliasesWF Env.context) :
     SubstFreshForGen Env'.stateSubstInfo Env'.genEnv.genState := by
   simp only [LMonoTy.instantiateWithCheck] at h
-  split at h; · simp at h
+  elim_err h
   rename_i instTypes Env1 h_inst
   simp [Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v2 h_res; obtain ⟨mtyi, Env2⟩ := v2; dsimp at h h_res
-  split at h; · simp at h  -- checkNoFutureGenVars
-  split at h
-  · simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-    have h_subst_eq : Env1.stateSubstInfo = Env.stateSubstInfo := by
-      simp [LMonoTys.instantiateEnv] at h_inst
-      split at h_inst; · simp at h_inst
-      simp at h_inst; obtain ⟨_, h_env⟩ := h_inst; rw [← h_env]
-    have h_mono : Env1.genEnv.genState.tyGen ≥ Env.genEnv.genState.tyGen :=
-      LMonoTys.instantiateEnv_tyGen_mono _ _ Env _ _ h_inst
-    have h_ctx_eq : Env1.context = Env.context :=
-      LMonoTys.instantiateEnv_context _ _ Env _ Env1 h_inst
-    exact (LMonoTy_resolveAliases_preserves_SubstFreshForGen _ Env1 mtyi Env2 h_res
-      (h_subst_eq ▸ SubstFreshForGen.mono _ _ _ h_fresh h_mono)
-      (h_ctx_eq ▸ h_aw)
-      (by -- instTypes[0] freeVars gen-fresh: instantiateEnv replaces all freeVars with
-          -- generated vars (since domain = mty_in.freeVars = all freeVars of [mty_in])
-          have h_closed : ∀ tv, tv ∈ LMonoTys.freeVars [mty_in] → tv ∈ mty_in.freeVars := by
-            simp [LMonoTys.freeVars]
-          have h_gen := instantiateEnv_freeVars_genFresh_closed
-            mty_in.freeVars [mty_in] Env instTypes Env1 h_inst h_closed
-          intro v hv n hn
-          have h_in_all : v ∈ LMonoTys.freeVars instTypes := by
-            have h_len : 0 < instTypes.length := by
-              have := LMonoTys.instantiateEnv_length _ _ _ _ _ h_inst; simp at this; omega
-            cases instTypes with
-            | nil => simp at h_len
-            | cons hd tl => simp [LMonoTys.freeVars]; left; exact hv
-          exact h_gen v h_in_all n hn)).1
-  · simp at h
+  elim_errs h  -- checkNoFutureGenVars
+  simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+  have h_subst_eq : Env1.stateSubstInfo = Env.stateSubstInfo := by
+    simp [LMonoTys.instantiateEnv] at h_inst
+    elim_err h_inst
+    simp at h_inst; obtain ⟨_, h_env⟩ := h_inst; rw [← h_env]
+  have h_mono : Env1.genEnv.genState.tyGen ≥ Env.genEnv.genState.tyGen :=
+    LMonoTys.instantiateEnv_tyGen_mono _ _ Env _ _ h_inst
+  have h_ctx_eq : Env1.context = Env.context :=
+    LMonoTys.instantiateEnv_context _ _ Env _ Env1 h_inst
+  exact (LMonoTy_resolveAliases_preserves_SubstFreshForGen _ Env1 mtyi Env2 h_res
+    (h_subst_eq ▸ SubstFreshForGen.mono _ _ _ h_fresh h_mono)
+    (h_ctx_eq ▸ h_aw)
+    (by -- instTypes[0] freeVars gen-fresh: instantiateEnv replaces all freeVars with
+        -- generated vars (since domain = mty_in.freeVars = all freeVars of [mty_in])
+        have h_closed : ∀ tv, tv ∈ LMonoTys.freeVars [mty_in] → tv ∈ mty_in.freeVars := by
+          simp [LMonoTys.freeVars]
+        have h_gen := instantiateEnv_freeVars_genFresh_closed
+          mty_in.freeVars [mty_in] Env instTypes Env1 h_inst h_closed
+        intro v hv n hn
+        have h_in_all : v ∈ LMonoTys.freeVars instTypes := by
+          have h_len : 0 < instTypes.length := by
+            have h_len := LMonoTys.instantiateEnv_length _ _ _ _ _ h_inst; simp at h_len; omega
+          cases instTypes with
+          | nil => simp at h_len
+          | cons hd tl => simp [LMonoTys.freeVars]; left; exact hv
+        exact h_gen v h_in_all n hn)).1
 
 /-- Generated names with different indices are different. -/
 private theorem tyPrefix_ne_of_ne (a b : Nat) (h : a ≠ b) :
@@ -2233,14 +2190,12 @@ theorem LTy_instantiateWithCheck_context'
     (h : LTy.instantiateWithCheck ty C Env = .ok (mty, Env')) :
     Env'.context = Env.context := by
   simp [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v1 h_ra; obtain ⟨mty', Env1⟩ := v1
-  split at h; · simp at h  -- checkNoFutureGenVars
-  split at h
-  · simp at h
-    obtain ⟨_, h2⟩ := h; rw [← h2]
-    exact LTy.resolveAliases_context ty Env mty' Env1 h_ra
-  · simp at h
+  elim_errs h  -- checkNoFutureGenVars
+  simp at h
+  obtain ⟨_, h2⟩ := h; rw [← h2]
+  exact LTy.resolveAliases_context ty Env mty' Env1 h_ra
 
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- Context preservation for `LMonoTy.instantiateWithCheck`. -/
@@ -2250,16 +2205,15 @@ theorem LMonoTy_instantiateWithCheck_context'
     (h : LMonoTy.instantiateWithCheck mty_in C Env = .ok (mty, Env')) :
     Env'.context = Env.context := by
   simp [LMonoTy.instantiateWithCheck, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v1 h_inst; obtain ⟨instTypes, Env_mid⟩ := v1
-  split at h; · simp at h
+  elim_err h
   rename_i v2 h_ra; obtain ⟨mty', Env2⟩ := v2; simp at h h_ra
-  split at h; · simp at h  -- checkNoFutureGenVars
-  split at h
-  · simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-    rw [LMonoTy.resolveAliases_context _ _ mty' Env2 h_ra]
-    exact LMonoTys.instantiateEnv_context _ _ Env _ _ h_inst
-  · simp at h
+  elim_errs h  -- checkNoFutureGenVars
+  simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+  rw [LMonoTy.resolveAliases_context _ _ mty' Env2 h_ra]
+  exact LMonoTys.instantiateEnv_context _ _ Env _ _ h_inst
+
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 private theorem LTy_instantiateWithCheck_freeVars_fresh
     (ty : LTy) (C : LContext T) (Env : TEnv T.IDMeta) (mty : LMonoTy) (Env' : TEnv T.IDMeta)
@@ -2268,17 +2222,16 @@ private theorem LTy_instantiateWithCheck_freeVars_fresh
       ∀ n, n ≥ Env'.genEnv.genState.tyGen → v ≠ TState.tyPrefix ++ toString n := by
   -- Extract the checkNoFutureGenVars success from h
   simp only [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v1 h_res; obtain ⟨mty0, Env1⟩ := v1; dsimp at h h_res
-  split at h; · simp at h  -- checkNoFutureGenVars failed → contradiction
+  elim_err h  -- checkNoFutureGenVars failed → contradiction
   rename_i h_check
-  split at h
-  · simp at h; obtain ⟨h_mty, h_env⟩ := h
-    rw [← h_mty, ← h_env]
-    -- h_check : !checkNoFutureGenVars mty0 Env1.genEnv.genState = false
-    -- i.e., checkNoFutureGenVars mty0 Env1.genEnv.genState = true
-    exact checkNoFutureGenVars_imp_fresh mty0 Env1.genEnv.genState (by simp at h_check; exact h_check)
-  · simp at h
+  elim_err h
+  simp at h; obtain ⟨h_mty, h_env⟩ := h
+  rw [← h_mty, ← h_env]
+  -- h_check : !checkNoFutureGenVars mty0 Env1.genEnv.genState = false
+  -- i.e., checkNoFutureGenVars mty0 Env1.genEnv.genState = true
+  exact checkNoFutureGenVars_imp_fresh mty0 Env1.genEnv.genState (by simp at h_check; exact h_check)
 
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- Free vars of `LMonoTy.instantiateWithCheck` output satisfy freshness for the output gen state. -/
@@ -2288,18 +2241,17 @@ private theorem LMonoTy_instantiateWithCheck_freeVars_fresh
     ∀ v, v ∈ LMonoTy.freeVars mty →
       ∀ n, n ≥ Env'.genEnv.genState.tyGen → v ≠ TState.tyPrefix ++ toString n := by
   simp only [LMonoTy.instantiateWithCheck] at h
-  split at h; · simp at h
+  elim_err h
   rename_i instTypes Env1 h_inst
   simp [Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v2 h_res; obtain ⟨mtyi, Env2⟩ := v2; dsimp at h h_res
-  split at h; · simp at h  -- checkNoFutureGenVars failed
+  elim_err h  -- checkNoFutureGenVars failed
   rename_i h_check
-  split at h
-  · simp at h; obtain ⟨h_mty, h_env⟩ := h
-    rw [← h_mty, ← h_env]
-    exact checkNoFutureGenVars_imp_fresh mtyi Env2.genEnv.genState (by simp at h_check; exact h_check)
-  · simp at h
+  elim_err h
+  simp at h; obtain ⟨h_mty, h_env⟩ := h
+  rw [← h_mty, ← h_env]
+  exact checkNoFutureGenVars_imp_fresh mtyi Env2.genEnv.genState (by simp at h_check; exact h_check)
 
 omit [ToString T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- `inferFVar` preserves `SubstFreshForGen`. -/
@@ -2315,9 +2267,9 @@ private theorem inferFVar_preserves_SubstFreshForGen
         ∀ n, n ≥ Env.genEnv.genState.tyGen → v ≠ TState.tyPrefix ++ toString n) :
     SubstFreshForGen Env'.stateSubstInfo Env'.genEnv.genState := by
   simp only [inferFVar, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i ty_found h_find_ctx
-  split at h; · simp at h
+  elim_err h
   rename_i v1 h_inst; obtain ⟨mty, Env1⟩ := v1; dsimp at h h_inst
   have h_ctx1 : ContextFreshForGen Env1.context Env1.genEnv.genState := by
     rw [LTy_instantiateWithCheck_context' _ C Env mty Env1 h_inst]
@@ -2332,9 +2284,9 @@ private theorem inferFVar_preserves_SubstFreshForGen
       (h_bvf _ _ h_find_ctx)
   | some fty_val =>
     simp only [Except.mapError] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_inst2; obtain ⟨fty_inst, Env2⟩ := v2; dsimp at h h_inst2
-    split at h; · simp at h
+    elim_err h
     rename_i v3 h_mapError
     simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]; simp [TEnv.updateSubst]
     have h_fresh1 := LTy_instantiateWithCheck_preserves_SubstFreshForGen
@@ -2385,20 +2337,20 @@ theorem typeBoundVar_xv_fresh_in_context
     ∀ m, m ∈ Env.context.types → Map.find? m xv = none := by
   -- Decompose typeBoundVar (without unfolding liftGenEnv) to extract xv
   simp only [typeBoundVar, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen
   -- xv_raw is fresh in Env.context via liftGenEnv_genVar_fresh
   have h_fresh := liftGenEnv_genVar_fresh Env xv_raw Env_g h_gen
   -- Extract xv = xv_raw
   revert h; cases bty with
   | some bty_val =>
-    simp only []; intro h; split at h; · simp at h
+    simp only []; intro h; elim_err h
     rename_i v_ic _; obtain ⟨_, _⟩ := v_ic
     simp at h
     obtain ⟨h_xv, _, _⟩ := h; subst h_xv
     exact not_mem_knownVars_find_none Env.context xv_raw h_fresh
   | none =>
-    simp; intro h; split at h; · simp at h
+    simp; intro h; elim_err h
     rename_i v_tg _; obtain ⟨_, _⟩ := v_tg
     simp at h
     obtain ⟨h_xv, _, _⟩ := h; subst h_xv
@@ -2413,11 +2365,11 @@ theorem typeBoundVar_adds_to_context (C : LContext T) (Env : TEnv T.IDMeta)
     Env'.context.types.find? xv = some (.forAll [] xty) := by
   have h_fresh := typeBoundVar_xv_fresh_in_context C Env bty xv xty Env' h
   simp only [typeBoundVar, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen
   simp at h; cases bty with
   | some bty_val =>
-    simp at h; split at h; · simp at h
+    simp at h; elim_err h
     rename_i v_ic h_ic; obtain ⟨bty_mty, Env_mid⟩ := v_ic
     simp at h; obtain ⟨h_xv, h_xty, h_env⟩ := h
     subst h_xv; subst h_xty; subst h_env
@@ -2429,7 +2381,7 @@ theorem typeBoundVar_adds_to_context (C : LContext T) (Env : TEnv T.IDMeta)
     rw [show bty_mty.context.types = Env.context.types from congrArg TContext.types h_ctx]
     exact Maps.find?_addInNewest_self Env.context.types xv_raw _ h_fresh
   | none =>
-    simp at h; split at h; · simp at h
+    simp at h; elim_err h
     rename_i v_tg h_tg; obtain ⟨tv, Env_mid⟩ := v_tg
     simp at h; obtain ⟨h_xv, h_xty, h_env⟩ := h
     subst h_xv; subst h_xty; subst h_env
@@ -2451,11 +2403,11 @@ theorem typeBoundVar_preserves_find (C : LContext T) (Env : TEnv T.IDMeta)
     (h_ctx : Env.context.types.find? y = some yty) :
     Env'.context.types.find? y = some yty := by
   simp only [typeBoundVar, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen
   simp at h; cases bty with
   | some bty_val =>
-    simp at h; split at h; · simp at h
+    simp at h; elim_err h
     rename_i v_ic h_ic; obtain ⟨bty_mty, Env_mid⟩ := v_ic
     simp at h; obtain ⟨h_xv, _, h_env⟩ := h
     subst h_xv; subst h_env
@@ -2467,7 +2419,7 @@ theorem typeBoundVar_preserves_find (C : LContext T) (Env : TEnv T.IDMeta)
     rw [h_ctx_eq, Maps.find?_addInNewest_ne Env.context.types xv_raw _ y h_ne]
     exact h_ctx
   | none =>
-    simp at h; split at h; · simp at h
+    simp at h; elim_err h
     rename_i v_tg h_tg; obtain ⟨tv, Env_mid⟩ := v_tg
     simp at h; obtain ⟨h_xv, _, h_env⟩ := h
     subst h_xv; subst h_env
@@ -2488,24 +2440,55 @@ theorem typeBoundVar_context_types_ne_nil
     (h : typeBoundVar C Env bty = .ok (xv, xty, Env1)) :
     Env1.context.types ≠ [] := by
   simp only [typeBoundVar, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v_gen _; obtain ⟨_, Env_g⟩ := v_gen
   revert h; cases bty with
   | some bty_val =>
-    simp only []; intro h; split at h; · simp at h
+    simp only []; intro h; elim_err h
     rename_i v_ic _; obtain ⟨_, Env_mid⟩ := v_ic
     simp at h
     obtain ⟨_, _, h_env1⟩ := h; rw [← h_env1]
     simp [TEnv.addInNewestContext, TEnv.updateContext, TEnv.context,
           Maps.addInNewest, Maps.push, Maps.pop, Maps.newest]
   | none =>
-    simp; intro h; split at h; · simp at h
+    simp; intro h; elim_err h
     rename_i v_tg _; obtain ⟨_, Env_mid⟩ := v_tg
     simp at h
     obtain ⟨_, _, h_env1⟩ := h; rw [← h_env1]
     simp [TEnv.addInNewestContext, TEnv.updateContext, TEnv.context,
           Maps.addInNewest, Maps.push, Maps.pop, Maps.newest]
 
+omit [ToString T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
+theorem typeBoundVar_aliases_eq
+    (C : LContext T) (Env : TEnv T.IDMeta) (bty : Option LMonoTy)
+    (xv : T.Identifier) (xty : LMonoTy) (Env' : TEnv T.IDMeta)
+    (h : typeBoundVar C Env bty = .ok (xv, xty, Env')) :
+    Env'.context.aliases = Env.context.aliases := by
+  simp only [typeBoundVar, Bind.bind, Except.bind] at h
+  elim_err h
+  rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen
+  dsimp at h; cases bty with
+  | some bty_val =>
+    dsimp at h; elim_err h
+    rename_i v_ic h_ic; obtain ⟨bty_ic, Env_ic⟩ := v_ic
+    cases h
+    simp only [TEnv.addInNewestContext, TEnv.updateContext, TEnv.context]
+    have h_ctx_g := liftGenEnv_context Env xv Env_g h_gen
+    have h_ctx_ic := LMonoTy_instantiateWithCheck_context' bty_val C Env_g _ ⟨bty_ic, Env_ic⟩ h_ic
+    have h_ctx : (⟨bty_ic, Env_ic⟩ : TEnv T.IDMeta).context = Env.context := by
+      simp [TEnv.context] at h_ctx_ic h_ctx_g ⊢; rw [h_ctx_ic, h_ctx_g]
+    exact congrArg TContext.aliases h_ctx
+  | none =>
+    dsimp at h; elim_err h
+    rename_i v_tg h_tg; obtain ⟨tv, Env_tv⟩ := v_tg
+    cases h
+    simp only [TEnv.addInNewestContext, TEnv.updateContext, TEnv.context]
+    have h_ctx_g := liftGenEnv_context Env xv Env_g h_gen
+    have h_ctx_tg := TEnv.genTyVar_context Env_g tv Env_tv h_tg
+    have h_ctx : Env_tv.context = Env.context := by
+      simp [TEnv.context] at h_ctx_tg h_ctx_g ⊢; rw [h_ctx_tg, h_ctx_g]
+    exact congrArg TContext.aliases h_ctx
+
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [ToFormat T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- Backward direction: vars in knownTypeVars after addInNewest come from
     the old context or from the new type's freeVars. -/
@@ -2531,10 +2514,10 @@ private theorem knownTypeVars_addInNewestContext_cases
     simp only [Maps.addInNewest, Maps.newest, Maps.pop, Maps.push,
       TContext.types.knownTypeVars, List.mem_append] at h ⊢
     rcases h with h_go | h_rest
-    · suffices ∀ (m' : List (T.Identifier × LTy)),
+    · suffices h_go_append : ∀ (m' : List (T.Identifier × LTy)),
           ∀ w, w ∈ TContext.types.knownTypeVars.go (m' ++ [(xv, ty)]) →
             w ∈ TContext.types.knownTypeVars.go m' ∨ w ∈ LTy.freeVars ty by
-        rcases this m v h_go with h_old | h_new
+        rcases h_go_append m v h_go with h_old | h_new
         · exact Or.inl (Or.inl h_old)
         · exact Or.inr h_new
       intro m'; induction m' with
@@ -2586,7 +2569,7 @@ theorem typeBoundVar_preserves_boundVarsNodup
   -- Decompose typeBoundVar: liftGenEnv → instantiateWithCheck/genTyVar → addInNewestContext
   -- After addInNewestContext, find? either returns the new entry or an old one.
   simp only [typeBoundVar, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen
   have h_g_ctx : Env_g.context = Env.context := liftGenEnv_context Env _ Env_g h_gen
   -- Case split on bty to extract Env_mid with Env_mid.context = Env.context
@@ -2613,7 +2596,7 @@ theorem typeBoundVar_preserves_boundVarsNodup
     · rw [h_old] at h_find
       exact h_bvnd y ty_found h_find
   | none =>
-    simp; intro h; split at h; · simp at h
+    simp; intro h; elim_err h
     rename_i v_tg h_tg; obtain ⟨xtyid, Env_mid⟩ := v_tg
     simp at h
     obtain ⟨h_xv, h_xty, h_env'⟩ := h
@@ -2657,23 +2640,23 @@ theorem typeBoundVar_preserves_invariant
     TypeBoundVarInvariant Env' := by
   -- Decompose typeBoundVar: liftGenEnv genVar → match bty → addInNewestContext
   simp only [typeBoundVar, liftGenEnv, Bind.bind, Except.bind] at h
-  split at h; · contradiction
+  elim_err h
   rename_i genResult h_gen
   -- liftGenEnv preserves stateSubstInfo
   have h_gen_subst : genResult.snd.stateSubstInfo = Env.stateSubstInfo := by
-    split at h_gen; · contradiction
-    have := Except.ok.inj h_gen; rw [← this]
+    elim_err h_gen
+    have h_gen_eq := Except.ok.inj h_gen; rw [← h_gen_eq]
   -- liftGenEnv genVar: tyGen is monotone
   have h_gen_tyGen : genResult.snd.genEnv.genState.tyGen ≥ Env.genEnv.genState.tyGen := by
-    split at h_gen; · contradiction
+    elim_err h_gen
     rename_i _ _ h_genVar
-    have := Except.ok.inj h_gen; rw [← this]; simp
+    have h_gen_eq := Except.ok.inj h_gen; rw [← h_gen_eq]; simp
     exact _root_.Lambda.HasGen.genVar_tyGen_mono Env.genEnv _ _ h_genVar
   -- liftGenEnv preserves context
   have h_gen_ctx : genResult.snd.context = Env.context := by
-    split at h_gen; · contradiction
+    elim_err h_gen
     rename_i _ _ h_genVar
-    have := Except.ok.inj h_gen; rw [← this]; simp [TEnv.context]
+    have h_gen_eq := Except.ok.inj h_gen; rw [← h_gen_eq]; simp [TEnv.context]
     exact HasGen.genVar_context Env.genEnv _ _ h_genVar
   -- Lifted invariants for genResult.snd
   have h_ctx_gen : ContextFreshForGen genResult.snd.context genResult.snd.genEnv.genState :=
@@ -2681,7 +2664,7 @@ theorem typeBoundVar_preserves_invariant
   have h_g_ctx : genResult.snd.context = Env.context := h_gen_ctx
   split at h
   · ---- bty = some bty_val: instantiateWithCheck then addInNewestContext
-    split at h; · contradiction
+    elim_err h
     rename_i _ bty_mty _ _ Env_inst h_inst
     simp at h; obtain ⟨_, _, h_env⟩ := h; rw [← h_env]
     have h_iwc_ctx := LMonoTy_instantiateWithCheck_context' bty_mty C genResult.snd _ Env_inst h_inst
@@ -2721,7 +2704,7 @@ theorem typeBoundVar_preserves_invariant
           exact h_bf y ty_found h_find v hv n (Nat.le_trans (Nat.le_trans h_gen_tyGen h_iwc_mono) hn)
     }
   · ---- bty = none: genTyVar then addInNewestContext
-    split at h; · contradiction
+    elim_err h
     rename_i v1 h_genTy
     obtain ⟨xtyid, Env1⟩ := v1
     simp at h; obtain ⟨_, _, h_env⟩ := h; rw [← h_env]
@@ -2793,16 +2776,13 @@ theorem LTy_instantiateWithCheck_context
     (h : LTy.instantiateWithCheck ty C Env = .ok (mty, Env')) :
     Env'.context = Env.context := by
   simp [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h
-  split at h
-  · simp at h
-  · rename_i v1 h_ra
-    obtain ⟨mty', Env1⟩ := v1
-    split at h; · simp at h  -- checkNoFutureGenVars
-    split at h
-    · simp at h
-      obtain ⟨_, h2⟩ := h; rw [← h2]
-      exact LTy.resolveAliases_context ty Env mty' Env1 h_ra
-    · simp at h
+  elim_err h
+  rename_i v1 h_ra
+  obtain ⟨mty', Env1⟩ := v1
+  elim_errs h  -- checkNoFutureGenVars
+  simp at h
+  obtain ⟨_, h2⟩ := h; rw [← h2]
+  exact LTy.resolveAliases_context ty Env mty' Env1 h_ra
 
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- Context preservation for `LMonoTy.instantiateWithCheck`. -/
@@ -2812,20 +2792,16 @@ theorem LMonoTy_instantiateWithCheck_context
     (h : LMonoTy.instantiateWithCheck mty_in C Env = .ok (mty, Env')) :
     Env'.context = Env.context := by
   simp [LMonoTy.instantiateWithCheck, Bind.bind, Except.bind] at h
-  split at h
-  · simp at h
-  · rename_i v1 h_inst
-    obtain ⟨instTypes, Env_mid⟩ := v1
-    split at h
-    · simp at h
-    · rename_i v2 h_ra
-      obtain ⟨mty', Env2⟩ := v2; simp at h h_ra
-      split at h; · simp at h  -- checkNoFutureGenVars
-      split at h
-      · simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-        rw [LMonoTy.resolveAliases_context _ _ mty' Env2 h_ra]
-        exact LMonoTys.instantiateEnv_context _ _ Env _ _ h_inst
-      · simp at h
+  elim_err h
+  rename_i v1 h_inst
+  obtain ⟨instTypes, Env_mid⟩ := v1
+  elim_err h
+  rename_i v2 h_ra
+  obtain ⟨mty', Env2⟩ := v2; simp at h h_ra
+  elim_errs h  -- checkNoFutureGenVars
+  simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+  rw [LMonoTy.resolveAliases_context _ _ mty' Env2 h_ra]
+  exact LMonoTys.instantiateEnv_context _ _ Env _ _ h_inst
 
 omit [ToString T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- `inferFVar` preserves the context. -/
@@ -2835,31 +2811,27 @@ private theorem inferFVar_context
     (h : inferFVar C Env x fty = .ok (ty, Env')) :
     Env'.context = Env.context := by
   simp only [inferFVar, Bind.bind, Except.bind] at h
+  elim_err h
+  rename_i ty_scheme h_find
+  elim_err h
+  rename_i v1 h_inst
+  obtain ⟨mty, Env1⟩ := v1; simp at h h_inst
   split at h
-  · simp at h
-  · rename_i ty_scheme h_find
-    split at h
-    · simp at h
-    · rename_i v1 h_inst
-      obtain ⟨mty, Env1⟩ := v1; simp at h h_inst
-      split at h
-      · -- fty = none
-        simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-        exact LTy_instantiateWithCheck_context _ C Env mty Env1 h_inst
-      · -- fty = some fty_val
-        rename_i fty_val
-        split at h
-        · simp at h
-        · rename_i v2 h_inst2
-          obtain ⟨fty_inst, Env2⟩ := v2; simp at h h_inst2
-          split at h
-          · simp at h
-          · rename_i v3 h_mapError
-            simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
-            -- updateSubst preserves context
-            show Env2.context = Env.context
-            rw [LMonoTy_instantiateWithCheck_context _ C Env1 fty_inst Env2 h_inst2,
-                LTy_instantiateWithCheck_context _ C Env mty Env1 h_inst]
+  · -- fty = none
+    simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+    exact LTy_instantiateWithCheck_context _ C Env mty Env1 h_inst
+  · -- fty = some fty_val
+    rename_i fty_val
+    elim_err h
+    rename_i v2 h_inst2
+    obtain ⟨fty_inst, Env2⟩ := v2; simp at h h_inst2
+    elim_err h
+    rename_i v3 h_mapError
+    simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
+    -- updateSubst preserves context
+    show Env2.context = Env.context
+    rw [LMonoTy_instantiateWithCheck_context _ C Env1 fty_inst Env2 h_inst2,
+        LTy_instantiateWithCheck_context _ C Env mty Env1 h_inst]
 
 omit [ToString T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- `typeBoundVar` then `eraseFromContext` restores the original context. -/
@@ -2883,10 +2855,10 @@ private theorem typeBoundVar_erase_context
     -- Decompose typeBoundVar to extract what it does to context
     revert h_fresh_xv h_nonempty h_ctx
     -- We generalize to avoid issues with simp/subst
-    suffices ∀ Env1, typeBoundVar C Env bty = .ok (xv, xty, Env1) →
+    suffices h_ctx_add : ∀ Env1, typeBoundVar C Env bty = .ok (xv, xty, Env1) →
         Env1.context.types = Env.context.types.addInNewest [(xv, .forAll [] xty)] ∧
         Env1.context.aliases = Env.context.aliases by
-      intro h_ctx h_nonempty h_fresh_xv; exact this Env1 h
+      intro h_ctx h_nonempty h_fresh_xv; exact h_ctx_add Env1 h
     -- Decompose typeBoundVar to extract that Env1.context = addInNewest on Env.context
     -- typeBoundVar does: liftGenEnv genVar >> (instantiateWithCheck|genTyVar) >> addInNewestContext
     -- Each intermediate step preserves context, then addInNewestContext modifies types
@@ -3013,8 +2985,8 @@ private theorem freeVars_destructArrow_subset_combined (n : Nat) :
         have h_trest_sz : mtysSize trest < n := by
           simp only [mtySize, mtysSize] at h_sz ⊢
           omega
-        have := (ih (mtysSize trest) h_trest_sz).2 trest (Nat.le_refl _)
-        exact List.mem_append_right _ (this h2)
+        have h_trest_sub := (ih (mtysSize trest) h_trest_sz).2 trest (Nat.le_refl _)
+        exact List.mem_append_right _ (h_trest_sub h2)
     · -- non-arrow case: returns [mty]
       simp [LMonoTys.freeVars]
   · -- List case
@@ -3059,8 +3031,7 @@ private theorem LFunc.type_freeVars_eq_nil [DecidableEq T.IDMeta]
   simp [LTy.freeVars]
   apply List.removeAll_eq_nil_of_forall_mem
   unfold LFunc.type at h_type; simp only [Bind.bind, Except.bind] at h_type
-  split at h_type; · simp at h_type
-  split at h_type; · simp at h_type
+  elim_errs h_type
   generalize h_vals : func.inputs.values = vals at h_type
   cases vals with
   | nil =>
@@ -3075,7 +3046,7 @@ private theorem LFunc.type_freeVars_eq_nil [DecidableEq T.IDMeta]
     · exact h_wf.inputs_typevars_in_typeArgs ity (h_vals ▸ List.mem_cons_self) hx_ity
     · have h_irest_sub : ∀ ty, ty ∈ irest → ty ∈ func.inputs.values :=
         fun ty ht => h_vals ▸ List.mem_cons_of_mem _ ht
-      have : ∀ (xs : LMonoTys), (∀ ty, ty ∈ xs → ty ∈ func.inputs.values) →
+      have h_inputs_fv : ∀ (xs : LMonoTys), (∀ ty, ty ∈ xs → ty ∈ func.inputs.values) →
           ∀ v, v ∈ LMonoTys.freeVars xs → v ∈ func.typeArgs := by
         intro xs h_sub v hv
         induction xs with
@@ -3085,7 +3056,7 @@ private theorem LFunc.type_freeVars_eq_nil [DecidableEq T.IDMeta]
           rcases hv with hv_t | hv_ts
           · exact h_wf.inputs_typevars_in_typeArgs t (h_sub t List.mem_cons_self) hv_t
           · exact ih (fun ty ht => h_sub ty (List.mem_cons_of_mem _ ht)) hv_ts
-      exact this irest h_irest_sub x hx_irest
+      exact h_inputs_fv irest h_irest_sub x hx_irest
     · exact h_wf.output_typevars_in_typeArgs (LMonoTy.freeVars_destructArrow_subset func.output hx_destr)
 
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [ToFormat T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
@@ -3094,8 +3065,7 @@ private theorem LFunc.type_boundVars_eq_typeArgs [DecidableEq T.IDMeta]
     (func : LFunc T) (ty : LTy) (h_type : func.type = .ok ty) :
     LTy.boundVars ty = func.typeArgs := by
   unfold LFunc.type at h_type; simp only [Bind.bind, Except.bind] at h_type
-  split at h_type; · simp at h_type
-  split at h_type; · simp at h_type
+  elim_errs h_type
   generalize h_vals : func.inputs.values = vals at h_type
   cases vals with
   | nil =>
@@ -3116,7 +3086,7 @@ private theorem LMonoTy_resolveAliases_freeVars_subset
     simp [LMonoTy.resolveAliases] at h; grind
   | .tcons name args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_args; obtain ⟨args', Env1⟩ := v1; simp at h h_args
     simp only [LMonoTy.tconsAliasSimple] at h
     generalize h_alias_find : List.find? _ Env1.context.aliases = alias_opt at h
@@ -3148,9 +3118,9 @@ private theorem LMonoTys_resolveAliases_freeVars_subset
     simp [LMonoTys.resolveAliases] at h; grind
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_hd; obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_tl; obtain ⟨mrest', Env2⟩ := v2
     simp at h; obtain ⟨h1, _⟩ := h; subst h1
     have h_ctx_eq := LMonoTy.resolveAliases_context mty Env mty' Env1 h_hd
@@ -3236,16 +3206,15 @@ private theorem resolveAux_properties_aux :
   match e with
   | .const m c =>
     simp [resolveAux, inferConst] at h
-    split at h
-    · simp [Bind.bind, Except.bind] at h; obtain ⟨h_et, h2⟩ := h; rw [← h2]
-      exact ⟨Nat.le_refl _, rfl,
-        ⟨h_sf, fun v hv => by rw [← h_et] at hv; simp [toLMonoTy, LConst.ty_freeVars] at hv⟩,
-        Subst.absorbs_refl _ Env.stateSubstInfo.isWF⟩
-    · exact absurd h (by simp [Bind.bind, Except.bind])
+    elim_err h
+    simp [Bind.bind, Except.bind] at h; obtain ⟨h_et, h2⟩ := h; rw [← h2]
+    exact ⟨Nat.le_refl _, rfl,
+      ⟨h_sf, fun v hv => by rw [← h_et] at hv; simp [toLMonoTy, LConst.ty_freeVars] at hv⟩,
+      Subst.absorbs_refl _ Env.stateSubstInfo.isWF⟩
   | .bvar _ _ => simp [resolveAux] at h
   | .fvar m x fty =>
     simp only [resolveAux, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_infer; obtain ⟨ty_res, Env_res⟩ := v1; simp at h
     obtain ⟨h_et, h2⟩ := h; rw [← h2]
     refine ⟨inferFVar_tyGen_mono C Env x fty _ Env_res h_infer,
@@ -3257,28 +3226,28 @@ private theorem resolveAux_properties_aux :
     intro v hv k hk
     simp [toLMonoTy] at hv
     simp only [inferFVar, Bind.bind, Except.bind] at h_infer
-    split at h_infer; · simp at h_infer
+    elim_err h_infer
     rename_i ty_found h_find_ctx
-    split at h_infer; · simp at h_infer
+    elim_err h_infer
     rename_i v2 h_inst; obtain ⟨mty, Env1⟩ := v2; dsimp at h_infer h_inst
     have h_mty_fresh := LTy_instantiateWithCheck_freeVars_fresh _ C Env mty Env1 h_inst
     cases fty with
     | none => grind
     | some fty_val =>
       simp only [Except.mapError] at h_infer
-      split at h_infer; · simp at h_infer
+      elim_err h_infer
       rename_i v3 h_inst2; obtain ⟨fty_inst, Env2⟩ := v3; dsimp at h_infer h_inst2
-      split at h_infer; · simp at h_infer
+      elim_err h_infer
       simp at h_infer; obtain ⟨h_ty, h_env2⟩ := h_infer
       rw [← h_ty] at hv; rw [← h_env2] at hk; simp [TEnv.updateSubst] at hk
       exact h_mty_fresh v hv k (Nat.le_trans (LMonoTy_instantiateWithCheck_tyGen_mono fty_val C Env1 fty_inst Env2 h_inst2) hk)
   | .op m o oty =>
     simp only [resolveAux, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i func h_find
-    split at h; · simp at h
+    elim_err h
     rename_i type_val h_type
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_inst; obtain ⟨ty_inst, Env1⟩ := v1; dsimp at h h_inst
     have h_func_mem : func ∈ C.functions.toArray := Factory.getElem?_is_some_implies_mem h_find
     have h_func_wf : LFuncWF func := h_fwf.lfuncs_wf func h_func_mem
@@ -3301,9 +3270,9 @@ private theorem resolveAux_properties_aux :
              LTy_instantiateWithCheck_absorbs type_val C Env ty_inst Env1 h_inst⟩
     | some oty_val =>
       simp only [Except.mapError] at h
-      split at h; · simp at h
+      elim_err h
       rename_i v2 h_inst2; obtain ⟨oty_inst, Env2⟩ := v2; dsimp at h h_inst2
-      split at h; · simp at h
+      elim_err h
       rename_i v3 h_mapError
       simp at h; obtain ⟨h_et, h2⟩ := h; subst h_et h2; simp [TEnv.updateSubst]
       have h_aw1 : TContext.AliasesWF Env1.context :=
@@ -3343,13 +3312,13 @@ private theorem resolveAux_properties_aux :
           (Nat.le_trans (LMonoTy_instantiateWithCheck_tyGen_mono oty_val C Env1 oty_inst Env2 h_inst2) hk)
   | .app m e1 e2 =>
     simp only [resolveAux, Bind.bind, Except.bind, Except.mapError] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_res1; obtain ⟨e1t, Env1⟩ := v1; dsimp at h h_res1
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_res2; obtain ⟨e2t, Env2⟩ := v2; dsimp at h h_res2
-    split at h; · simp at h
+    elim_err h
     rename_i v3 h_gen; obtain ⟨fresh_name, Env3⟩ := v3; dsimp at h h_gen
-    split at h; · simp at h
+    elim_err h
     rename_i v4 h_mapError
     simp at h; obtain ⟨h_et, h2⟩ := h; subst h_et h2; simp [TEnv.updateSubst]
     have h_sz1 : e1.sizeOf < n := by expr_size h_eq
@@ -3420,9 +3389,9 @@ private theorem resolveAux_properties_aux :
       · exact h_sf4 v (Or.inr hv_fv) k hk
   | .abs m _ bty body =>
     simp only [resolveAux, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_tbv; obtain ⟨xv_id, xty_val, Env1⟩ := v1; simp at h h_tbv
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_rec; obtain ⟨et', Env2⟩ := v2; simp at h
     obtain ⟨h_et, h_env⟩ := h; rw [← h_env]; simp [TEnv.eraseFromContext, TEnv.updateContext]
     have h_sz : (varOpen 0 (xv_id, some xty_val) body).sizeOf < n := by expr_size h_eq
@@ -3449,25 +3418,25 @@ private theorem resolveAux_properties_aux :
       rcases hv_ty with hv_xty | hv_ety
       · -- v from xty_val: gen-fresh from typeBoundVar
         simp only [typeBoundVar, liftGenEnv, Bind.bind, Except.bind] at h_tbv
-        split at h_tbv; · contradiction
+        elim_err h_tbv
         rename_i genResult h_gen
         have h_gen_tyGen : genResult.snd.genEnv.genState.tyGen ≥ Env.genEnv.genState.tyGen := by
-          split at h_gen; · contradiction
-          rename_i _ _ h_gv; have := Except.ok.inj h_gen; rw [← this]; simp
+          elim_err h_gen
+          rename_i _ _ h_gv; have h_gen_eq := Except.ok.inj h_gen; rw [← h_gen_eq]; simp
           exact HasGen.genVar_tyGen_mono Env.genEnv _ _ h_gv
         have h_gen_ctx : genResult.snd.context = Env.context := by
-          split at h_gen; · contradiction
-          rename_i _ _ h_gv; have := Except.ok.inj h_gen; rw [← this]; simp [TEnv.context]
+          elim_err h_gen
+          rename_i _ _ h_gv; have h_gen_eq := Except.ok.inj h_gen; rw [← h_gen_eq]; simp [TEnv.context]
           exact HasGen.genVar_context Env.genEnv _ _ h_gv
         split at h_tbv
-        · split at h_tbv; · contradiction
+        · elim_err h_tbv
           rename_i _ bty_mty _ _ Env_inst h_inst
           simp at h_tbv; obtain ⟨_, rfl, h_env1_eq⟩ := h_tbv
           have h_fv_fresh := LMonoTy_instantiateWithCheck_freeVars_fresh _ C genResult.snd _ Env_inst h_inst
           have h_gen_eq : Env1.genEnv.genState = Env_inst.genEnv.genState := by
             rw [← h_env1_eq]; simp [TEnv.addInNewestContext, TEnv.updateContext]
           exact h_fv_fresh v hv_xty k (by rw [h_gen_eq] at h_mono_body; omega)
-        · split at h_tbv; · contradiction
+        · elim_err h_tbv
           rename_i v_gen h_genTy; obtain ⟨xtyid, Env_ty⟩ := v_gen; simp at h_tbv
           obtain ⟨_, rfl, h_env1_eq⟩ := h_tbv
           simp [LMonoTy.freeVars] at hv_xty; rw [hv_xty]
@@ -3477,57 +3446,56 @@ private theorem resolveAux_properties_aux :
           rw [genTyVar_name_eq genResult.snd xtyid Env_ty h_genTy]
           exact generated_name_fresh _ _ (by rw [h_gen_eq] at h_mono_body; omega) k hk
       · -- v from varCloseT et': varCloseT preserves toLMonoTy
-        have : (Lambda.LExpr.varCloseT 0 xv_id et').toLMonoTy = et'.toLMonoTy := by
+        have h_close_ty : (Lambda.LExpr.varCloseT 0 xv_id et').toLMonoTy = et'.toLMonoTy := by
           match et' with
           | .const _ _ | .op _ _ _ | .bvar _ _ | .abs _ _ _ _ | .app _ _ _
           | .ite _ _ _ _ | .eq _ _ _ | .quant _ _ _ _ _ _ => rfl
           | .fvar _ y _ => simp only [Lambda.LExpr.varCloseT]; split <;> rfl
-        rw [this] at hv_ety
+        rw [h_close_ty] at hv_ety
         exact h_otf_body v hv_ety k hk
     · exact h_sf_body v (Or.inr hv_subst) k hk
   | .quant m qk _ bty tr body =>
     simp only [resolveAux, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_tbv; obtain ⟨xv_id, xty_val, Env1⟩ := v1; simp at h h_tbv
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_rec_e; obtain ⟨et', Env2⟩ := v2; simp at h h_rec_e
-    split at h; · simp at h
+    elim_err h
     rename_i v3 h_rec_tr; obtain ⟨trT, Env3⟩ := v3; simp at h h_rec_tr
-    split at h
-    · simp at h; obtain ⟨h_et, h_env⟩ := h; rw [← h_env]; simp [TEnv.eraseFromContext, TEnv.updateContext]
-      have h_sz_e : (varOpen 0 (xv_id, some xty_val) body).sizeOf < n := by expr_size h_eq
-      have h_sz_tr : (varOpen 0 (xv_id, some xty_val) tr).sizeOf < n := by expr_size h_eq
-      have h_inv1 := typeBoundVar_preserves_invariant C Env bty xv_id xty_val Env1 h_tbv h_sf h_cf h_aw h_bvf
-      have h_ne1 : Env1.context.types ≠ [] := typeBoundVar_context_types_ne_nil C Env bty xv_id xty_val Env1 h_tbv
-      -- IH for body
-      have ⟨h_mono_e, h_ctx2_eq, ⟨h_sf2, _⟩, h_abs_e⟩ :=
-        ih _ h_sz_e _ rfl et' C Env1 Env2 h_rec_e h_ne1
-          h_inv1.aliasesWF h_fwf h_inv1.substFreshForGen h_inv1.ctxFreshForGen h_inv1.boundVarsFresh
-      have h_ne2 := h_ctx2_eq ▸ h_ne1
-      have h_cf2 : ContextFreshForGen Env2.context Env2.genEnv.genState :=
-        h_ctx2_eq ▸ ContextFreshForGen.mono _ _ _ h_inv1.ctxFreshForGen h_mono_e
-      have h_aw2 : TContext.AliasesWF Env2.context := h_ctx2_eq ▸ h_inv1.aliasesWF
-      have h_bvf2 := transfer_boundVarsFresh h_inv1.boundVarsFresh h_ctx2_eq h_mono_e
-      -- IH for trigger
-      have ⟨h_mono_tr, h_ctx3_eq, ⟨h_sf3, _⟩, h_abs_tr⟩ :=
-        ih _ h_sz_tr _ rfl trT C Env2 Env3 h_rec_tr h_ne2 h_aw2 h_fwf h_sf2 h_cf2 h_bvf2
-      refine ⟨Nat.le_trans (Nat.le_trans (typeBoundVar_tyGen_mono C Env bty xv_id xty_val Env1 h_tbv) h_mono_e) h_mono_tr,
-              typeBoundVar_erase_context C Env bty xv_id xty_val Env1 h_tbv Env3
-                (h_ctx3_eq.trans h_ctx2_eq)
-                (typeBoundVar_xv_fresh_in_context C Env bty xv_id xty_val Env1 h_tbv) h_ne,
-              ⟨h_sf3, fun v hv n hn => by rw [← h_et] at hv; simp [toLMonoTy, LMonoTy.bool, LMonoTy.freeVars, LMonoTys.freeVars] at hv⟩,
-              Subst.absorbs_trans Env.stateSubstInfo.subst Env2.stateSubstInfo.subst Env3.stateSubstInfo.subst
-                (Subst.absorbs_trans Env.stateSubstInfo.subst Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst
-                  (typeBoundVar_absorbs C Env bty xv_id xty_val Env1 h_tbv) h_abs_e)
-                h_abs_tr⟩
-    · simp at h
+    elim_err h
+    simp at h; obtain ⟨h_et, h_env⟩ := h; rw [← h_env]; simp [TEnv.eraseFromContext, TEnv.updateContext]
+    have h_sz_e : (varOpen 0 (xv_id, some xty_val) body).sizeOf < n := by expr_size h_eq
+    have h_sz_tr : (varOpen 0 (xv_id, some xty_val) tr).sizeOf < n := by expr_size h_eq
+    have h_inv1 := typeBoundVar_preserves_invariant C Env bty xv_id xty_val Env1 h_tbv h_sf h_cf h_aw h_bvf
+    have h_ne1 : Env1.context.types ≠ [] := typeBoundVar_context_types_ne_nil C Env bty xv_id xty_val Env1 h_tbv
+    -- IH for body
+    have ⟨h_mono_e, h_ctx2_eq, ⟨h_sf2, _⟩, h_abs_e⟩ :=
+      ih _ h_sz_e _ rfl et' C Env1 Env2 h_rec_e h_ne1
+        h_inv1.aliasesWF h_fwf h_inv1.substFreshForGen h_inv1.ctxFreshForGen h_inv1.boundVarsFresh
+    have h_ne2 := h_ctx2_eq ▸ h_ne1
+    have h_cf2 : ContextFreshForGen Env2.context Env2.genEnv.genState :=
+      h_ctx2_eq ▸ ContextFreshForGen.mono _ _ _ h_inv1.ctxFreshForGen h_mono_e
+    have h_aw2 : TContext.AliasesWF Env2.context := h_ctx2_eq ▸ h_inv1.aliasesWF
+    have h_bvf2 := transfer_boundVarsFresh h_inv1.boundVarsFresh h_ctx2_eq h_mono_e
+    -- IH for trigger
+    have ⟨h_mono_tr, h_ctx3_eq, ⟨h_sf3, _⟩, h_abs_tr⟩ :=
+      ih _ h_sz_tr _ rfl trT C Env2 Env3 h_rec_tr h_ne2 h_aw2 h_fwf h_sf2 h_cf2 h_bvf2
+    refine ⟨Nat.le_trans (Nat.le_trans (typeBoundVar_tyGen_mono C Env bty xv_id xty_val Env1 h_tbv) h_mono_e) h_mono_tr,
+            typeBoundVar_erase_context C Env bty xv_id xty_val Env1 h_tbv Env3
+              (h_ctx3_eq.trans h_ctx2_eq)
+              (typeBoundVar_xv_fresh_in_context C Env bty xv_id xty_val Env1 h_tbv) h_ne,
+            ⟨h_sf3, fun v hv n hn => by rw [← h_et] at hv; simp [toLMonoTy, LMonoTy.bool, LMonoTy.freeVars, LMonoTys.freeVars] at hv⟩,
+            Subst.absorbs_trans Env.stateSubstInfo.subst Env2.stateSubstInfo.subst Env3.stateSubstInfo.subst
+              (Subst.absorbs_trans Env.stateSubstInfo.subst Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst
+                (typeBoundVar_absorbs C Env bty xv_id xty_val Env1 h_tbv) h_abs_e)
+              h_abs_tr⟩
   | .eq m e1 e2 =>
     simp only [resolveAux, Bind.bind, Except.bind, Except.mapError] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_res1; obtain ⟨e1t, Env1⟩ := v1; dsimp at h h_res1
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_res2; obtain ⟨e2t, Env2⟩ := v2; dsimp at h h_res2
-    split at h; · simp at h
+    elim_err h
     rename_i v3 h_mapError
     simp at h; obtain ⟨h_et, h2⟩ := h; subst h_et h2; simp [TEnv.updateSubst]
     have h_sz1 : e1.sizeOf < n := by expr_size h_eq
@@ -3560,13 +3528,13 @@ private theorem resolveAux_properties_aux :
       intro v hv; simp [toLMonoTy, LMonoTy.freeVars, LMonoTys.freeVars] at hv
   | .ite m c t e =>
     simp only [resolveAux, Bind.bind, Except.bind, Except.mapError] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_res_c; obtain ⟨ct, Env1⟩ := v1; dsimp at h h_res_c
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_res_t; obtain ⟨tht, Env2⟩ := v2; dsimp at h h_res_t
-    split at h; · simp at h
+    elim_err h
     rename_i v3 h_res_e; obtain ⟨elt, Env3⟩ := v3; dsimp at h h_res_e
-    split at h; · simp at h
+    elim_err h
     rename_i v4 h_mapError
     simp at h; obtain ⟨h_et, h2⟩ := h; subst h_et h2; simp [TEnv.updateSubst]
     have h_sz_c : c.sizeOf < n := by expr_size h_eq
@@ -3753,20 +3721,20 @@ private theorem TGenEnv.genTyVars_is_genName
     simp [TGenEnv.genTyVars] at h; grind
   | succ m ih =>
     simp only [TGenEnv.genTyVars, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_gen1; obtain ⟨tv1, Env1⟩ := v1
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_gen_rest; obtain ⟨rest, Env2⟩ := v2
     simp at h
     obtain ⟨h_tvs, h_env⟩ := h; subst h_tvs; subst h_env
     have h_tv1_name : tv1 = TState.tyPrefix ++ toString Env.genState.tyGen := by
       simp only [TGenEnv.genTyVar] at h_gen1
-      split at h_gen1; · simp at h_gen1
+      elim_err h_gen1
       simp at h_gen1; rw [← h_gen1.1]
       simp [TState.genTySym, TState.incTyGen]
     have h_gen1_mono : Env1.genState.tyGen = Env.genState.tyGen + 1 := by
       simp only [TGenEnv.genTyVar] at h_gen1
-      split at h_gen1; · simp at h_gen1
+      elim_err h_gen1
       simp at h_gen1; rw [← h_gen1.2]
       simp [TState.genTySym, TState.incTyGen]
     rcases List.mem_cons.mp h_mem with h_eq | h_rest
@@ -3797,36 +3765,35 @@ private theorem HasType_LTy_instantiate
   | cons x xs =>
     -- Polymorphic: LTy.instantiate (.forAll (x :: xs) body) generates fresh vars
     simp only [LTy.instantiate, Bind.bind, Except.bind] at h_inst
-    split at h_inst
-    · simp at h_inst
-    · rename_i v1 h_gen
-      obtain ⟨freshtvs, genEnv1⟩ := v1
-      simp at h_inst h_gen
-      obtain ⟨h_eq, _⟩ := h_inst; rw [← h_eq]
-      have h_len_gen := TGenEnv.genTyVars_length (x :: xs).length genEnv freshtvs genEnv1 h_gen
-      have h_map_len : (List.map LMonoTy.ftvar freshtvs).length = (x :: xs).length := by
-        simp [h_len_gen]
-      apply HasType_tinst_all C Γ e (x :: xs) body (List.map LMonoTy.ftvar freshtvs)
-        h_map_len
-      · -- Nodup: from h_nodup, since boundVars (.forAll (x :: xs) body) = x :: xs
-        have : LTy.boundVars (.forAll (x :: xs) body) = x :: xs := by simp [LTy.boundVars]
-        rw [this] at h_nodup; exact h_nodup
-      · -- No clash: bound variables don't appear in fresh type variables
-        intro v hv t ht
-        simp [List.mem_map] at ht
-        obtain ⟨tv, htv_mem, h_tv⟩ := ht
-        rw [← h_tv]; simp [LMonoTy.freeVars]
-        -- v ∈ (x :: xs) = boundVars ty
-        have h_v_bv : v ∈ LTy.boundVars (.forAll (x :: xs) body) := by
-          simp [LTy.boundVars]; exact List.mem_cons.mp hv
-        -- tv ∈ freshtvs, so tv = tyPrefix ++ toString k for some k ≥ genEnv.genState.tyGen
-        -- (each genTyVar output is tyPrefix ++ toString genState.tyGen, then counter increments)
-        have h_tv_is_gen := TGenEnv.genTyVars_is_genName
-          (x :: xs).length genEnv freshtvs genEnv1 h_gen tv htv_mem
-        obtain ⟨k, h_k_ge, h_tv_eq⟩ := h_tv_is_gen
-        -- v ≠ tv: h_bv_fresh says v ≠ tyPrefix ++ toString k for k ≥ genState.tyGen
-        exact fun h_eq => absurd (h_tv_eq ▸ h_eq) (h_bv_fresh v h_v_bv k h_k_ge)
-      · exact h_ty
+    elim_err h_inst
+    rename_i v1 h_gen
+    obtain ⟨freshtvs, genEnv1⟩ := v1
+    simp at h_inst h_gen
+    obtain ⟨h_eq, _⟩ := h_inst; rw [← h_eq]
+    have h_len_gen := TGenEnv.genTyVars_length (x :: xs).length genEnv freshtvs genEnv1 h_gen
+    have h_map_len : (List.map LMonoTy.ftvar freshtvs).length = (x :: xs).length := by
+      simp [h_len_gen]
+    apply HasType_tinst_all C Γ e (x :: xs) body (List.map LMonoTy.ftvar freshtvs)
+      h_map_len
+    · -- Nodup: from h_nodup, since boundVars (.forAll (x :: xs) body) = x :: xs
+      have h_bv : LTy.boundVars (.forAll (x :: xs) body) = x :: xs := by simp [LTy.boundVars]
+      rw [h_bv] at h_nodup; exact h_nodup
+    · -- No clash: bound variables don't appear in fresh type variables
+      intro v hv t ht
+      simp [List.mem_map] at ht
+      obtain ⟨tv, htv_mem, h_tv⟩ := ht
+      rw [← h_tv]; simp [LMonoTy.freeVars]
+      -- v ∈ (x :: xs) = boundVars ty
+      have h_v_bv : v ∈ LTy.boundVars (.forAll (x :: xs) body) := by
+        simp [LTy.boundVars]; exact List.mem_cons.mp hv
+      -- tv ∈ freshtvs, so tv = tyPrefix ++ toString k for some k ≥ genEnv.genState.tyGen
+      -- (each genTyVar output is tyPrefix ++ toString genState.tyGen, then counter increments)
+      have h_tv_is_gen := TGenEnv.genTyVars_is_genName
+        (x :: xs).length genEnv freshtvs genEnv1 h_gen tv htv_mem
+      obtain ⟨k, h_k_ge, h_tv_eq⟩ := h_tv_is_gen
+      -- v ≠ tv: h_bv_fresh says v ≠ tyPrefix ++ toString k for k ≥ genState.tyGen
+      exact fun h_eq => absurd (h_tv_eq ▸ h_eq) (h_bv_fresh v h_v_bv k h_k_ge)
+    · exact h_ty
 
 
 
@@ -3842,11 +3809,11 @@ private theorem subst_openVars_comm
   · -- S is empty: subst S is identity
     rw [LMonoTy.subst_emptyS hS]
     -- substLogic S vals = vals when hasEmptyScopes
-    have : LMonoTys.substLogic S vals = vals := by
+    have h_substLogic : LMonoTys.substLogic S vals = vals := by
       induction vals with
       | nil => simp [LMonoTys.substLogic, hS]
       | cons hd tl ih => simp [LMonoTys.substLogic, hS]
-    rw [this]
+    rw [h_substLogic]
   · -- S is non-empty
     have hS_ne : Subst.hasEmptyScopes S = false := by
       revert hS; cases Subst.hasEmptyScopes S <;> simp
@@ -3943,8 +3910,8 @@ private theorem subst_single_scope_eq_openVars
   cases vars with
   | nil =>
     -- vars = [], vals = [] (by h_len). Both sides reduce to body.
-    have : vals = [] := by simpa using h_len.symm
-    subst this
+    have h_vals_nil : vals = [] := by simpa using h_len.symm
+    subst h_vals_nil
     -- LHS: subst [zip [] []] body. zip [] [] = []. hasEmptyScopes [[]] = true.
     -- So subst [[]] body = body. And openVars [] [] body = body.
     show LMonoTy.subst [List.zipWith Prod.mk [] []] body = LMonoTy.openVars [] [] body
@@ -3994,8 +3961,8 @@ private theorem subst_single_scope_eq_openVarsList
     LMonoTys.substLogic [List.zip vars vals] bodies = LMonoTys.openVars vars vals bodies := by
   cases vars with
   | nil =>
-    have : vals = [] := by simpa using h_len.symm
-    subst this
+    have h_vals_nil : vals = [] := by simpa using h_len.symm
+    subst h_vals_nil
     show LMonoTys.substLogic [List.zipWith Prod.mk [] []] bodies =
          LMonoTys.openVars [] [] bodies
     have h_zip_nil : List.zipWith Prod.mk ([] : List TyIdentifier) ([] : LMonoTys) = [] := rfl
@@ -4003,9 +3970,9 @@ private theorem subst_single_scope_eq_openVarsList
     have hS : Subst.hasEmptyScopes [([] : Map TyIdentifier LMonoTy)] = true := by
       simp [Subst.hasEmptyScopes, List.all, Map.isEmpty]
     -- substLogic [[]] bodies = bodies (since hasEmptyScopes [[]] = true)
-    have : LMonoTys.substLogic [([] : Map TyIdentifier LMonoTy)] bodies = bodies := by
+    have h_substLogic_nil : LMonoTys.substLogic [([] : Map TyIdentifier LMonoTy)] bodies = bodies := by
       unfold LMonoTys.substLogic; rw [hS]; simp
-    rw [this]
+    rw [h_substLogic_nil]
     exact (openVarsList_nil_id bodies).symm
   | cons v vs =>
     cases vals with
@@ -4177,7 +4144,7 @@ private theorem polyKeysFresh_typeBoundVar {T : LExprParams} [DecidableEq T.IDMe
     Subst.polyKeysFresh (T := T) S Env1.context := by
   intro a ha x ty hf hbv
   simp only [typeBoundVar, Bind.bind, Except.bind] at h_tbv
-  split at h_tbv; · simp at h_tbv
+  elim_err h_tbv
   rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen; simp at h_tbv
   have h_g_ctx := liftGenEnv_context Env xv_raw Env_g h_gen
   revert h_tbv; cases bty with
@@ -4354,7 +4321,7 @@ private theorem subst_compose_ftvar_open (S : Subst)
           fun a ha => ih_args a ha (fun v hv hni => by
             apply h_extra v _ hni; simp only [LMonoTy.freeVars]
             -- v ∈ freeVars a and a ∈ args → v ∈ LMonoTys.freeVars args
-            have : ∀ (l : LMonoTys), a ∈ l → v ∈ LMonoTy.freeVars a → v ∈ LMonoTys.freeVars l := by
+            have h_mem_fv : ∀ (l : LMonoTys), a ∈ l → v ∈ LMonoTy.freeVars a → v ∈ LMonoTys.freeVars l := by
               intro l h_mem h_fv; induction l with
               | nil => exact absurd h_mem (by simp)
               | cons x xs ih_l =>
@@ -4362,7 +4329,7 @@ private theorem subst_compose_ftvar_open (S : Subst)
                 cases h_mem with
                 | head => exact List.mem_append_left _ h_fv
                 | tail _ h_rest => exact List.mem_append_right _ (ih_l h_rest)
-            exact this args ha hv)
+            exact h_mem_fv args ha hv)
         show LMonoTy.subst S (LMonoTy.subst [List.zip (id :: ids') (List.map LMonoTy.ftvar (ftv :: ftvs'))] (.tcons name args)) =
              LMonoTy.subst [List.zip (id :: ids') (List.map (fun v => LMonoTy.subst S (.ftvar v)) (ftv :: ftvs'))] (.tcons name args)
 
@@ -4372,13 +4339,13 @@ private theorem subst_compose_ftvar_open (S : Subst)
           -- Goal: .tcons name (subst S (subst [zip1] args)) = .tcons name (subst [zip2] args)
           exact congrArg _ h_list
         -- Prove h_list by induction on args (using a suffices to avoid generalization issues)
-        suffices ∀ (l : LMonoTys),
+        suffices h_list_gen : ∀ (l : LMonoTys),
             (∀ a, a ∈ l →
               LMonoTy.subst S (LMonoTy.subst [List.zip (id :: ids') (List.map LMonoTy.ftvar (ftv :: ftvs'))] a) =
               LMonoTy.subst [List.zip (id :: ids') (List.map (fun v => LMonoTy.subst S (.ftvar v)) (ftv :: ftvs'))] a) →
             LMonoTys.subst S (LMonoTys.subst [List.zip (id :: ids') (List.map LMonoTy.ftvar (ftv :: ftvs'))] l) =
             LMonoTys.subst [List.zip (id :: ids') (List.map (fun v => LMonoTy.subst S (.ftvar v)) (ftv :: ftvs'))] l from
-          this args h_per_arg
+          h_list_gen args h_per_arg
         intro l h_pa
         induction l with
         | nil =>
@@ -4410,11 +4377,10 @@ private theorem instantiateEnv_decompose
     simp at h; obtain ⟨h1, h2⟩ := h; subst h1; subst h2
     -- Now unfold instantiate
     simp only [LMonoTys.instantiate, Bind.bind, Except.bind] at h_inner
-    split at h_inner
-    · simp at h_inner
-    · rename_i v h_gv; obtain ⟨ftvs, gE⟩ := v; simp at h_inner h_gv
-      obtain ⟨h_res, h_ge⟩ := h_inner; subst h_ge
-      exact ⟨ftvs, gE, h_gv, h_res.symm, rfl⟩
+    elim_err h_inner
+    rename_i v h_gv; obtain ⟨ftvs, gE⟩ := v; simp at h_inner h_gv
+    obtain ⟨h_res, h_ge⟩ := h_inner; subst h_ge
+    exact ⟨ftvs, gE, h_gv, h_res.symm, rfl⟩
 
 
 /-- Prepending a binding `(v, vl)` to `vars`/`vals` doesn't affect `openVarsList` on
@@ -4492,132 +4458,131 @@ private theorem tconsAlias_expand_eq
   -- Now h_tcons is in the `some alias` branch
   simp at h_tcons
   -- Decompose: instantiateEnv, then unify
-  split at h_tcons
-  · simp at h_tcons  -- instantiateEnv failed
-  · rename_i instTypes updatedEnv h_inst
-    -- h_inst : LMonoTys.instantiateEnv alias.typeArgs [aliasPattern, alias.type] Env = .ok (instTypes, updatedEnv)
-    have h_len_inst : 1 < instTypes.length := by
-      have := LMonoTys.instantiateEnv_length _ _ _ _ _ h_inst; simp at this; omega
-    -- Decompose: unify
-    generalize h_u : Constraints.unify _ _ = u at h_tcons
-    match u with
-    | .error e => simp at h_tcons
-    | .ok substInfo =>
-      simp at h_tcons
-      obtain ⟨h_mty, h_env⟩ := h_tcons
-      rw [← h_mty, ← h_env]
-      simp only [TEnv.updateSubst]
-
-      -- Step 1: Idempotency. subst S (subst S x) = subst S x
-      rw [LMonoTy.subst_absorbs substInfo.subst substInfo.subst
-        (instTypes[1]?.getD _) (Subst.absorbs_refl _ substInfo.isWF)]
-      -- Goal: subst S (instTypes.getD 1 inputMty) = expand alias (subst S args)
-
-      -- Step 2: Decompose instantiateEnv to get freshtvs
-      obtain ⟨freshtvs, genEnv', h_gen, h_it, h_ue⟩ :=
-        instantiateEnv_decompose alias.typeArgs
-          [LMonoTy.tcons name (alias.typeArgs.map .ftvar), alias.type] Env instTypes updatedEnv h_inst
-      subst h_ue
-      let fvs := List.map LMonoTy.ftvar freshtvs
-      have h_flen : freshtvs.length = alias.typeArgs.length :=
-        TGenEnv.genTyVars_length (IDMeta := T.IDMeta) _ Env.genEnv freshtvs genEnv' h_gen
-      have h_fvs_len : alias.typeArgs.length = fvs.length := by
-        show alias.typeArgs.length = (List.map LMonoTy.ftvar freshtvs).length
-        rw [List.length_map]; exact h_flen.symm
-
-      -- Step 3: Case-split instTypes to get concrete elements (avoids dependent indexing)
-      have h_len2 : instTypes.length = 2 := by
-        have := LMonoTys.instantiateEnv_length _ _ _ _ _ h_inst; simp at this; omega
-      -- Decompose instTypes into [elt0, elt1]
-      cases instTypes with
+  elim_err h_tcons  -- instantiateEnv failed
+  rename_i instTypes updatedEnv h_inst
+  -- h_inst : LMonoTys.instantiateEnv alias.typeArgs [aliasPattern, alias.type] Env = .ok (instTypes, updatedEnv)
+  have h_len_inst : 1 < instTypes.length := by
+    have h_len := LMonoTys.instantiateEnv_length _ _ _ _ _ h_inst; simp at h_len; omega
+  -- Decompose: unify
+  generalize h_u : Constraints.unify _ _ = u at h_tcons
+  match u with
+  | .error e => simp at h_tcons
+  | .ok substInfo =>
+    simp at h_tcons
+    obtain ⟨h_mty, h_env⟩ := h_tcons
+    rw [← h_mty, ← h_env]
+    simp only [TEnv.updateSubst]
+
+    -- Step 1: Idempotency. subst S (subst S x) = subst S x
+    rw [LMonoTy.subst_absorbs substInfo.subst substInfo.subst
+      (instTypes[1]?.getD _) (Subst.absorbs_refl _ substInfo.isWF)]
+    -- Goal: subst S (instTypes.getD 1 inputMty) = expand alias (subst S args)
+
+    -- Step 2: Decompose instantiateEnv to get freshtvs
+    obtain ⟨freshtvs, genEnv', h_gen, h_it, h_ue⟩ :=
+      instantiateEnv_decompose alias.typeArgs
+        [LMonoTy.tcons name (alias.typeArgs.map .ftvar), alias.type] Env instTypes updatedEnv h_inst
+    subst h_ue
+    let fvs := List.map LMonoTy.ftvar freshtvs
+    have h_flen : freshtvs.length = alias.typeArgs.length :=
+      TGenEnv.genTyVars_length (IDMeta := T.IDMeta) _ Env.genEnv freshtvs genEnv' h_gen
+    have h_fvs_len : alias.typeArgs.length = fvs.length := by
+      show alias.typeArgs.length = (List.map LMonoTy.ftvar freshtvs).length
+      rw [List.length_map]; exact h_flen.symm
+
+    -- Step 3: Case-split instTypes to get concrete elements (avoids dependent indexing)
+    have h_len2 : instTypes.length = 2 := by
+      have h_len := LMonoTys.instantiateEnv_length _ _ _ _ _ h_inst; simp at h_len; omega
+    -- Decompose instTypes into [elt0, elt1]
+    cases instTypes with
+    | nil => simp at h_len2
+    | cons a tl =>
+      cases tl with
       | nil => simp at h_len2
-      | cons a tl =>
-        cases tl with
-        | nil => simp at h_len2
-        | cons b rest =>
-          cases rest with
-          | cons _ _ => simp at h_len2
-          | nil =>
-          have h_rhs_eq : LMonoTys.subst [List.zip alias.typeArgs fvs]
-              [LMonoTy.tcons name (alias.typeArgs.map .ftvar), alias.type] =
-              [LMonoTy.subst [List.zip alias.typeArgs fvs] (.tcons name (alias.typeArgs.map .ftvar)),
-               LMonoTy.subst [List.zip alias.typeArgs fvs] alias.type] := by
-            rw [LMonoTys.subst_eq_substLogic]; unfold LMonoTys.substLogic
-            split <;> rename_i hS
-            · simp [LMonoTy.subst_emptyS hS]
-            · simp; congr 1
-              -- Need: substLogic S [alias.type] = [subst S alias.type]
-              unfold LMonoTys.substLogic
-              have hS_false : Subst.hasEmptyScopes [List.zip alias.typeArgs fvs] = false := by
-                revert hS; cases Subst.hasEmptyScopes [List.zip alias.typeArgs fvs] <;> simp
-              simp only [hS_false]
-              -- Inner substLogic on the empty tail
-              unfold LMonoTys.substLogic
-              simp [hS_false]
-          -- Now h_it : [a, b] = [subst [S_inst] pattern, subst [S_inst] alias.type]
-          rw [h_rhs_eq] at h_it
-          -- Extract a = subst [S_inst] pattern, b = subst [S_inst] alias.type
-          have h_b : b = LMonoTy.subst [List.zip alias.typeArgs fvs] alias.type :=
-            (List.cons.inj (List.cons.inj h_it).2).1
-          have h_a : a = LMonoTy.subst [List.zip alias.typeArgs fvs]
-              (.tcons name (alias.typeArgs.map .ftvar)) :=
-            (List.cons.inj h_it).1
-          -- Goal: subst S ([a, b][1]?.getD default) = expand alias (subst S args)
-          -- First simplify [a, b][1]?.getD d = b
-          have h_getD_b : ([a, b] : LMonoTys)[1]?.getD (.tcons name args) = b := rfl
-          rw [h_getD_b]
-          -- Now goal: subst S b = expand alias (subst S args)
-          rw [h_b, subst_single_scope_eq_openVars alias.typeArgs fvs alias.type h_wf.fvs_closed h_fvs_len,
-              subst_openVars_comm substInfo.subst alias.typeArgs fvs alias.type h_wf.fvs_closed h_fvs_len]
-          simp only [TypeAlias.expand]; congr 1
-          -- Goal: substLogic substInfo.subst fvs = subst substInfo.subst args
-
-          -- From unify_makes_equal: subst S (tcons name args) = subst S a
-          have h_unify_eq := unify_makes_equal (.tcons name args) a
-            ({Env with genEnv := genEnv'} : TEnv T.IDMeta).stateSubstInfo substInfo h_u
-          -- Rewrite a and apply sub-lemmas
-          have h_pat_wf : ∀ tv, tv ∈ LMonoTy.freeVars (.tcons name (alias.typeArgs.map .ftvar)) → tv ∈ alias.typeArgs := by
-            intro tv htv; simp only [LMonoTy.freeVars] at htv
-            have : ∀ (ids : List TyIdentifier), tv ∈ LMonoTys.freeVars (ids.map .ftvar) → tv ∈ ids := by
-              intro ids h; induction ids with
-              | nil => simp [LMonoTys.freeVars] at h
-              | cons x xs ih =>
-                simp only [List.map, LMonoTys.freeVars, LMonoTy.freeVars] at h
-                cases List.mem_append.mp h <;> grind
-            exact this alias.typeArgs htv
-          rw [h_a,
-              subst_single_scope_eq_openVars alias.typeArgs fvs _ h_pat_wf h_fvs_len,
-              subst_openVars_comm substInfo.subst alias.typeArgs fvs _ h_pat_wf h_fvs_len] at h_unify_eq
-          -- h_unify_eq : subst S (tcons name args) =
-          --   openVars typeArgs (substLogic S fvs) (tcons name (typeArgs.map ftvar))
-          -- Unfold openVars on tcons:
-          simp only [LMonoTy.openVars] at h_unify_eq
-          -- h_unify_eq : subst S (tcons name args) = tcons name (LMonoTys.openVars ...)
-          -- Extract args component via tcons-wrapper trick
-          -- subst S (tcons name args) = tcons name (subst S args) [modulo hasEmptyScopes]
-          have h_extract : ∀ (S : Subst) (xs : LMonoTys),
-              LMonoTy.subst S (.tcons name xs) = .tcons name (LMonoTys.subst S xs) := by
-            intro S' xs'
-            by_cases hS' : Subst.hasEmptyScopes S'
-            · simp [LMonoTy.subst, LMonoTys.subst, hS']
-            · have := show Subst.hasEmptyScopes S' = false by
-                revert hS'; cases Subst.hasEmptyScopes S' <;> simp
-              simp [LMonoTy.subst, this]
-          rw [h_extract] at h_unify_eq
-          -- h_unify_eq : tcons name (subst S args) = tcons name (openVarsList typeArgs (substLogic S fvs) (typeArgs.map ftvar))
-          -- Extract: subst S args = openVarsList typeArgs (substLogic S fvs) (typeArgs.map ftvar)
-          have h_args_eq := (LMonoTy.tcons.inj h_unify_eq).2
-          -- Need: substLogic S fvs = subst S args
-          -- = openVarsList typeArgs (substLogic S fvs) (typeArgs.map ftvar)
-          -- openVarsList on (typeArgs.map ftvar) with vals where length matches
-          -- gives vals back (each ftvar aᵢ maps to vals[i])
-          rw [h_args_eq]
-          -- Need: substLogic S fvs = openVarsList typeArgs (substLogic S fvs) (typeArgs.map ftvar)
-          -- openVarsList vars vals (vars.map ftvar) = vals
-          -- (each ftvar aᵢ matches vars[i] and maps to vals[i])
-          symm
-          exact openVarsList_map_ftvar_id alias.typeArgs _ (by
-            rw [LMonoTys.substLogic_length]; exact h_fvs_len) (by assumption)
+      | cons b rest =>
+        cases rest with
+        | cons _ _ => simp at h_len2
+        | nil =>
+        have h_rhs_eq : LMonoTys.subst [List.zip alias.typeArgs fvs]
+            [LMonoTy.tcons name (alias.typeArgs.map .ftvar), alias.type] =
+            [LMonoTy.subst [List.zip alias.typeArgs fvs] (.tcons name (alias.typeArgs.map .ftvar)),
+              LMonoTy.subst [List.zip alias.typeArgs fvs] alias.type] := by
+          rw [LMonoTys.subst_eq_substLogic]; unfold LMonoTys.substLogic
+          split <;> rename_i hS
+          · simp [LMonoTy.subst_emptyS hS]
+          · simp; congr 1
+            -- Need: substLogic S [alias.type] = [subst S alias.type]
+            unfold LMonoTys.substLogic
+            have hS_false : Subst.hasEmptyScopes [List.zip alias.typeArgs fvs] = false := by
+              revert hS; cases Subst.hasEmptyScopes [List.zip alias.typeArgs fvs] <;> simp
+            simp only [hS_false]
+            -- Inner substLogic on the empty tail
+            unfold LMonoTys.substLogic
+            simp [hS_false]
+        -- Now h_it : [a, b] = [subst [S_inst] pattern, subst [S_inst] alias.type]
+        rw [h_rhs_eq] at h_it
+        -- Extract a = subst [S_inst] pattern, b = subst [S_inst] alias.type
+        have h_b : b = LMonoTy.subst [List.zip alias.typeArgs fvs] alias.type :=
+          (List.cons.inj (List.cons.inj h_it).2).1
+        have h_a : a = LMonoTy.subst [List.zip alias.typeArgs fvs]
+            (.tcons name (alias.typeArgs.map .ftvar)) :=
+          (List.cons.inj h_it).1
+        -- Goal: subst S ([a, b][1]?.getD default) = expand alias (subst S args)
+        -- First simplify [a, b][1]?.getD d = b
+        have h_getD_b : ([a, b] : LMonoTys)[1]?.getD (.tcons name args) = b := rfl
+        rw [h_getD_b]
+        -- Now goal: subst S b = expand alias (subst S args)
+        rw [h_b, subst_single_scope_eq_openVars alias.typeArgs fvs alias.type h_wf.fvs_closed h_fvs_len,
+            subst_openVars_comm substInfo.subst alias.typeArgs fvs alias.type h_wf.fvs_closed h_fvs_len]
+        simp only [TypeAlias.expand]; congr 1
+        -- Goal: substLogic substInfo.subst fvs = subst substInfo.subst args
+
+        -- From unify_makes_equal: subst S (tcons name args) = subst S a
+        have h_unify_eq := unify_makes_equal (.tcons name args) a
+          ({Env with genEnv := genEnv'} : TEnv T.IDMeta).stateSubstInfo substInfo h_u
+        -- Rewrite a and apply sub-lemmas
+        have h_pat_wf : ∀ tv, tv ∈ LMonoTy.freeVars (.tcons name (alias.typeArgs.map .ftvar)) → tv ∈ alias.typeArgs := by
+          intro tv htv; simp only [LMonoTy.freeVars] at htv
+          have h_ftvar_mem : ∀ (ids : List TyIdentifier), tv ∈ LMonoTys.freeVars (ids.map .ftvar) → tv ∈ ids := by
+            intro ids h; induction ids with
+            | nil => simp [LMonoTys.freeVars] at h
+            | cons x xs ih =>
+              simp only [List.map, LMonoTys.freeVars, LMonoTy.freeVars] at h
+              cases List.mem_append.mp h <;> grind
+          exact h_ftvar_mem alias.typeArgs htv
+        rw [h_a,
+            subst_single_scope_eq_openVars alias.typeArgs fvs _ h_pat_wf h_fvs_len,
+            subst_openVars_comm substInfo.subst alias.typeArgs fvs _ h_pat_wf h_fvs_len] at h_unify_eq
+        -- h_unify_eq : subst S (tcons name args) =
+        --   openVars typeArgs (substLogic S fvs) (tcons name (typeArgs.map ftvar))
+        -- Unfold openVars on tcons:
+        simp only [LMonoTy.openVars] at h_unify_eq
+        -- h_unify_eq : subst S (tcons name args) = tcons name (LMonoTys.openVars ...)
+        -- Extract args component via tcons-wrapper trick
+        -- subst S (tcons name args) = tcons name (subst S args) [modulo hasEmptyScopes]
+        have h_extract : ∀ (S : Subst) (xs : LMonoTys),
+            LMonoTy.subst S (.tcons name xs) = .tcons name (LMonoTys.subst S xs) := by
+          intro S' xs'
+          by_cases hS' : Subst.hasEmptyScopes S'
+          · simp [LMonoTy.subst, LMonoTys.subst, hS']
+          · have hS'_false := show Subst.hasEmptyScopes S' = false by
+              revert hS'; cases Subst.hasEmptyScopes S' <;> simp
+            simp [LMonoTy.subst, hS'_false]
+        rw [h_extract] at h_unify_eq
+        -- h_unify_eq : tcons name (subst S args) = tcons name (openVarsList typeArgs (substLogic S fvs) (typeArgs.map ftvar))
+        -- Extract: subst S args = openVarsList typeArgs (substLogic S fvs) (typeArgs.map ftvar)
+        have h_args_eq := (LMonoTy.tcons.inj h_unify_eq).2
+        -- Need: substLogic S fvs = subst S args
+        -- = openVarsList typeArgs (substLogic S fvs) (typeArgs.map ftvar)
+        -- openVarsList on (typeArgs.map ftvar) with vals where length matches
+        -- gives vals back (each ftvar aᵢ maps to vals[i])
+        rw [h_args_eq]
+        -- Need: substLogic S fvs = openVarsList typeArgs (substLogic S fvs) (typeArgs.map ftvar)
+        -- openVarsList vars vals (vars.map ftvar) = vals
+        -- (each ftvar aᵢ matches vars[i] and maps to vals[i])
+        symm
+        exact openVarsList_map_ftvar_id alias.typeArgs _ (by
+          rw [LMonoTys.substLogic_length]; exact h_fvs_len) (by assumption)
 
 
 
@@ -4736,7 +4701,7 @@ private theorem resolveAliases_aliasEquiv
     obtain ⟨rfl, _⟩ := h; exact .refl
   | .tcons name args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_args; obtain ⟨args', Env1⟩ := v1; simp at h h_args
     -- tconsAliasSimple is pure: split on find?
     simp only [LMonoTy.tconsAliasSimple] at h
@@ -4769,9 +4734,9 @@ private theorem resolveAliasList_aliasEquiv
     obtain ⟨rfl, _⟩ := h; exact .nil
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_hd; obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_tl; obtain ⟨mrest', Env2⟩ := v2
     simp at h; obtain ⟨rfl, _⟩ := h
     have h_ctx_pres := LMonoTy.resolveAliases_context mty Env mty' Env1 h_hd
@@ -4794,7 +4759,7 @@ private theorem LMonoTy_resolveAliases_subst_eq
     simp [LMonoTy.resolveAliases] at h; grind
   | .tcons _ args =>
     simp [LMonoTy.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_args; obtain ⟨args', Env1⟩ := v1; simp at h h_args
     simp only [LMonoTy.tconsAliasSimple] at h
     split at h <;> (obtain ⟨_, h2⟩ := h; rw [← h2])
@@ -4809,9 +4774,9 @@ private theorem LMonoTys_resolveAliases_subst_eq
     simp [LMonoTys.resolveAliases] at h; grind
   | mty :: mrest =>
     simp [LMonoTys.resolveAliases, Bind.bind, Except.bind] at h
-    split at h; · simp at h
+    elim_err h
     rename_i v1 h_hd; obtain ⟨mty', Env1⟩ := v1; simp at h h_hd
-    split at h; · simp at h
+    elim_err h
     rename_i v2 h_tl; obtain ⟨mrest', Env2⟩ := v2
     simp at h; obtain ⟨_, h2⟩ := h; rw [← h2]
     exact (LMonoTys_resolveAliases_subst_eq mrest Env1 mrest' Env2 h_tl).trans
@@ -4842,11 +4807,11 @@ theorem AnnotCompat_subst {aliases : List TypeAlias} {ann xty : LMonoTy}
       Maps.find? [(LMonoTy.freeVars ann).map (fun v => (v, g v))] v = some (g v) := by
     intro v hv; unfold Maps.find?; rw [Map.find?_of_map_self _ g v hv]
   -- Prove by structural induction with freeVars subset condition
-  suffices ∀ (mty : LMonoTy),
+  suffices h_subst_gen : ∀ (mty : LMonoTy),
       (∀ v, v ∈ LMonoTy.freeVars mty → v ∈ LMonoTy.freeVars ann) →
       LMonoTy.subst [(LMonoTy.freeVars ann).map (fun v => (v, g v))] mty =
         LMonoTy.subst S (LMonoTy.subst [σ] mty) from
-    this ann (fun v hv => hv)
+    h_subst_gen ann (fun v hv => hv)
   intro mty h_sub
   -- Abbreviate the constructed map
   let σ' := (LMonoTy.freeVars ann).map (fun v => (v, g v))
@@ -4940,7 +4905,7 @@ private theorem typeBoundVar_AnnotCompat [Std.ToFormat T.Metadata]
     AnnotCompat Env.context.aliases bty_val xty := by
   simp only [typeBoundVar, Bind.bind, Except.bind] at h
   -- liftGenEnv genVar
-  split at h; · simp at h
+  elim_err h
   rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen; simp at h
   have h_g_ctx : Env_g.context = Env.context := liftGenEnv_context Env _ Env_g h_gen
   -- instantiateWithCheck
@@ -4998,9 +4963,9 @@ private theorem SubstWF.key_not_in_freeVars_subst
       -- Need: a ∉ LMonoTys.freeVars (LMonoTys.subst S args)
       -- Use subst_eq_substLogic to convert to map form
       rw [LMonoTys.subst_eq_substLogic]
-      suffices ∀ (l : LMonoTys), (∀ m, m ∈ l → a ∉ LMonoTy.freeVars (LMonoTy.subst S m)) →
+      suffices h_notfv_gen : ∀ (l : LMonoTys), (∀ m, m ∈ l → a ∉ LMonoTy.freeVars (LMonoTy.subst S m)) →
           a ∉ LMonoTys.freeVars (LMonoTys.substLogic S l) by
-        exact this args (fun m hm => ih m hm)
+        exact h_notfv_gen args (fun m hm => ih m hm)
       intro l h_all
       induction l with
       | nil => simp [LMonoTys.substLogic, LMonoTys.freeVars]
@@ -5145,311 +5110,303 @@ theorem inferFVar_HasType
         HasType C (TContext.subst Env.context S) (.fvar m x fty)
           (.forAll [] (LMonoTy.subst S ty_res)) := by
   simp only [inferFVar, Bind.bind, Except.bind] at h
+  elim_err h  -- context lookup failed
+  rename_i ty h_find
+  elim_err h  -- instantiateWithCheck failed
+  rename_i v1 h_inst
+  obtain ⟨mty, Env1⟩ := v1
+  simp at h h_inst
   split at h
-  · simp at h  -- context lookup failed
-  · rename_i ty h_find
-    split at h
-    · simp at h  -- instantiateWithCheck failed
-    · rename_i v1 h_inst
-      obtain ⟨mty, Env1⟩ := v1
-      simp at h h_inst
-      split at h
-      · -- Case fty = none: return (mty, Env1)
-        simp at h
-        obtain ⟨h_ty, h_env⟩ := h
-        subst h_ty; subst h_env
-        constructor
-        · exact LTy_instantiateWithCheck_context ty C Env mty Env1 h_inst
-        · intro S h_abs_S h_wf_S h_fresh_ctx
-          -- Decompose instantiateWithCheck to get instantiate + resolveAliases
-          simp only [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h_inst
-          split at h_inst; · simp at h_inst
-          rename_i v_ra h_ra; obtain ⟨mty_ra, Env_ra⟩ := v_ra; dsimp at h_inst h_ra
-          split at h_inst; · simp at h_inst
-          split at h_inst
-          · simp at h_inst
-            obtain ⟨h_mty, h_env⟩ := h_inst; subst h_mty; subst h_env
-            -- Decompose resolveAliases to get instantiate + resolveAliases
-            simp only [LTy.resolveAliases, Bind.bind, Except.bind] at h_ra
-            split at h_ra; · simp at h_ra
-            rename_i v_inst h_lty_inst; obtain ⟨mty_inst, genEnv'⟩ := v_inst
-            simp at h_ra h_lty_inst
-            -- h_lty_inst : ty.instantiate Env.genEnv = .ok (mty_inst, genEnv')
-            -- h_ra : LMonoTy.resolveAliases mty_inst ... = .ok (mty, ...)
-            -- Step 1: tvar in substituted context
-            have h_find_S := _root_.Lambda.TContext_types_subst_find
-              Env.context.types S x ty h_find
-            have h_tvar_S := HasType.tvar (C := C) (TContext.subst Env.context S) m x
-              (LTy.subst S ty) h_find_S
-            -- Step 2: Instantiate LTy.subst S ty
-            have h_nodup := h_bvnd x ty h_find
-            have h_bv_fresh_ty := h_bvf x ty h_find
-            have ⟨mty', h_inst_S⟩ := _root_.Lambda.LTy_subst_instantiate S ty
-              Env.genEnv mty_inst genEnv' h_lty_inst
-            have h_bv_eq := _root_.Lambda.LTy_subst_boundVars S ty
-            have h_nodup_S : (LTy.subst S ty).boundVars.Nodup := h_bv_eq ▸ h_nodup
-            have h_bv_fresh_S : ∀ v, v ∈ (LTy.subst S ty).boundVars →
-                ∀ n, n ≥ Env.genEnv.genState.tyGen → v ≠ TState.tyPrefix ++ toString n := by
-              rw [h_bv_eq]; exact h_bv_fresh_ty
-            have h_mono_S := HasType_LTy_instantiate C (TContext.subst Env.context S)
-              (.fvar m x none) (LTy.subst S ty) mty'
-              Env.genEnv genEnv' h_tvar_S h_inst_S h_nodup_S h_bv_fresh_S
-            -- h_mono_S : HasType C (Γ.subst S) (.fvar m x none) (.forAll [] mty')
-            -- Step 3: Alias resolution in substituted context
-            have h_ctx_inst := LTy.instantiate_context ty Env.genEnv mty_inst genEnv' h_lty_inst
-            have h_aliases_subst : (TContext.subst Env.context S).aliases = Env.context.aliases :=
-              _root_.Lambda.TContext.subst_aliases Env.context S
-            have h_aw_subst : TContext.AliasesWF (TContext.subst Env.context S) := by
-              rw [TContext.AliasesWF]; rw [h_aliases_subst]; exact h_aw
-            -- AliasEquiv from resolveAliases: AliasEquiv aliases mty_inst mty
-            have h_aliases_env : Env.context.aliases =
-                ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context.aliases := by
-              simp [TEnv.context]; rw [h_ctx_inst]
-            have h_ae := resolveAliases_aliasEquiv mty_inst
-              ({Env with genEnv := genEnv'} : TEnv T.IDMeta) mty_ra Env_ra h_ra
-              h_aliases_env (by unfold TContext.AliasesWF; exact h_aw)
-            -- h_ae : AliasEquiv Env.context.aliases mty_inst mty_ra
-            -- Step 4: Bridge mty' to subst S mty_ra via AliasEquiv
-            -- For nil case: mty' = subst S body = subst S mty_inst, so
-            --   AliasEquiv (subst S mty_inst) (subst S mty_ra) by AliasEquiv_subst
-            -- For cons case: mty' = subst [zip bvs ftv] (subst (go bvs S) body)
-            --   while mty_inst = subst [zip bvs ftv] body — needs commutation
-            -- We handle both via AliasEquiv_subst on mty_inst → mty_ra, then bridge mty' to subst S mty_inst
-            have h_ae_S := AliasEquiv_subst Env.context.aliases mty_inst mty_ra S h_ae
-              (fun a ha => h_aw a ha)
-            -- h_ae_S : AliasEquiv aliases (subst S mty_inst) (subst S mty_ra)
-            -- Case split on bound vars of ty for the final proof
-            cases ty with
-            | forAll xs body =>
-            cases xs with
-            | nil =>
-              -- MONOMORPHIC: mty' = subst S body = subst S mty_inst (go [] S = S)
-              simp [LTy.instantiate] at h_lty_inst
-              obtain ⟨h1, _⟩ := h_lty_inst; subst h1
-              simp [LTy.subst, LTy.subst.go, LTy.instantiate] at h_inst_S
-              obtain ⟨h2, _⟩ := h_inst_S; subst h2
-              -- mty' = subst S mty_inst, so AliasEquiv .refl → trans with h_ae_S
-              exact HasType.talias (TContext.subst Env.context S) _ _ _
-                (h_aliases_subst ▸ h_ae_S) h_mono_S
-            | cons x_bv rest =>
-              -- POLYMORPHIC: use allKeysFresh to show LTy.subst S ty = ty,
-              -- then reconstruct proof via original instantiate + resolveAliases
-              -- + HasType_subst_fresh_all.
-              have h_go_irrel := polyKeysFresh_go_body_irrel S Env.context
-                x (x_bv :: rest) body h_fresh_ctx h_find (List.cons_ne_nil _ _)
-              have h_subst_ty_eq : LTy.subst S (.forAll (x_bv :: rest) body) =
-                  .forAll (x_bv :: rest) body := by
-                simp [LTy.subst, h_go_irrel]
-              -- Rewrite h_tvar_S: now HasType with the un-substituted type
-              rw [h_subst_ty_eq] at h_tvar_S
-              -- Apply the original HasType_LTy_instantiate in ctx.subst S
-              have h_mono := HasType_LTy_instantiate C (TContext.subst Env.context S)
-                (.fvar m x none) (.forAll (x_bv :: rest) body) mty_inst
-                Env.genEnv genEnv' h_tvar_S h_lty_inst h_nodup h_bv_fresh_ty
-              -- Apply HasType_resolveAliases in ctx.subst S (aliases are the same)
-              have h_aliases_S_eq : (TContext.subst Env.context S).aliases =
-                  ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context.aliases := by
-                rw [h_aliases_subst]; simp [TEnv.context]; rw [h_ctx_inst]
-              have h_typed := HasType_resolveAliases C (TContext.subst Env.context S)
-                (.fvar m x none) mty_inst mty_ra
-                {Env with genEnv := genEnv'} Env_ra h_mono h_ra h_aliases_S_eq h_aw_subst
-              -- Apply HasType_subst_fresh_all (freshness from SubstWF_key_isFresh_ctx_subst)
-              exact HasType_subst_fresh_all C (TContext.subst Env.context S)
-                (.fvar m x none) mty_ra S h_typed
-                (fun a ha_key _ => TContext.isFresh_subst_of_key Env.context S a ha_key h_wf_S)
-                h_wf_S
-          · simp at h_inst
-      · -- Case fty = some fty_val
-        rename_i fty_val
+  · -- Case fty = none: return (mty, Env1)
+    simp at h
+    obtain ⟨h_ty, h_env⟩ := h
+    subst h_ty; subst h_env
+    constructor
+    · exact LTy_instantiateWithCheck_context ty C Env mty Env1 h_inst
+    · intro S h_abs_S h_wf_S h_fresh_ctx
+      -- Decompose instantiateWithCheck to get instantiate + resolveAliases
+      simp only [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h_inst
+      elim_err h_inst
+      rename_i v_ra h_ra; obtain ⟨mty_ra, Env_ra⟩ := v_ra; dsimp at h_inst h_ra
+      elim_errs h_inst
+      simp at h_inst
+      obtain ⟨h_mty, h_env⟩ := h_inst; subst h_mty; subst h_env
+      -- Decompose resolveAliases to get instantiate + resolveAliases
+      simp only [LTy.resolveAliases, Bind.bind, Except.bind] at h_ra
+      elim_err h_ra
+      rename_i v_inst h_lty_inst; obtain ⟨mty_inst, genEnv'⟩ := v_inst
+      simp at h_ra h_lty_inst
+      -- h_lty_inst : ty.instantiate Env.genEnv = .ok (mty_inst, genEnv')
+      -- h_ra : LMonoTy.resolveAliases mty_inst ... = .ok (mty, ...)
+      -- Step 1: tvar in substituted context
+      have h_find_S := _root_.Lambda.TContext_types_subst_find
+        Env.context.types S x ty h_find
+      have h_tvar_S := HasType.tvar (C := C) (TContext.subst Env.context S) m x
+        (LTy.subst S ty) h_find_S
+      -- Step 2: Instantiate LTy.subst S ty
+      have h_nodup := h_bvnd x ty h_find
+      have h_bv_fresh_ty := h_bvf x ty h_find
+      have ⟨mty', h_inst_S⟩ := _root_.Lambda.LTy_subst_instantiate S ty
+        Env.genEnv mty_inst genEnv' h_lty_inst
+      have h_bv_eq := _root_.Lambda.LTy_subst_boundVars S ty
+      have h_nodup_S : (LTy.subst S ty).boundVars.Nodup := h_bv_eq ▸ h_nodup
+      have h_bv_fresh_S : ∀ v, v ∈ (LTy.subst S ty).boundVars →
+          ∀ n, n ≥ Env.genEnv.genState.tyGen → v ≠ TState.tyPrefix ++ toString n := by
+        rw [h_bv_eq]; exact h_bv_fresh_ty
+      have h_mono_S := HasType_LTy_instantiate C (TContext.subst Env.context S)
+        (.fvar m x none) (LTy.subst S ty) mty'
+        Env.genEnv genEnv' h_tvar_S h_inst_S h_nodup_S h_bv_fresh_S
+      -- h_mono_S : HasType C (Γ.subst S) (.fvar m x none) (.forAll [] mty')
+      -- Step 3: Alias resolution in substituted context
+      have h_ctx_inst := LTy.instantiate_context ty Env.genEnv mty_inst genEnv' h_lty_inst
+      have h_aliases_subst : (TContext.subst Env.context S).aliases = Env.context.aliases :=
+        _root_.Lambda.TContext.subst_aliases Env.context S
+      have h_aw_subst : TContext.AliasesWF (TContext.subst Env.context S) := by
+        rw [TContext.AliasesWF]; rw [h_aliases_subst]; exact h_aw
+      -- AliasEquiv from resolveAliases: AliasEquiv aliases mty_inst mty
+      have h_aliases_env : Env.context.aliases =
+          ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context.aliases := by
+        simp [TEnv.context]; rw [h_ctx_inst]
+      have h_ae := resolveAliases_aliasEquiv mty_inst
+        ({Env with genEnv := genEnv'} : TEnv T.IDMeta) mty_ra Env_ra h_ra
+        h_aliases_env (by unfold TContext.AliasesWF; exact h_aw)
+      -- h_ae : AliasEquiv Env.context.aliases mty_inst mty_ra
+      -- Step 4: Bridge mty' to subst S mty_ra via AliasEquiv
+      -- For nil case: mty' = subst S body = subst S mty_inst, so
+      --   AliasEquiv (subst S mty_inst) (subst S mty_ra) by AliasEquiv_subst
+      -- For cons case: mty' = subst [zip bvs ftv] (subst (go bvs S) body)
+      --   while mty_inst = subst [zip bvs ftv] body — needs commutation
+      -- We handle both via AliasEquiv_subst on mty_inst → mty_ra, then bridge mty' to subst S mty_inst
+      have h_ae_S := AliasEquiv_subst Env.context.aliases mty_inst mty_ra S h_ae
+        (fun a ha => h_aw a ha)
+      -- h_ae_S : AliasEquiv aliases (subst S mty_inst) (subst S mty_ra)
+      -- Case split on bound vars of ty for the final proof
+      cases ty with
+      | forAll xs body =>
+      cases xs with
+      | nil =>
+        -- MONOMORPHIC: mty' = subst S body = subst S mty_inst (go [] S = S)
+        simp [LTy.instantiate] at h_lty_inst
+        obtain ⟨h1, _⟩ := h_lty_inst; subst h1
+        simp [LTy.subst, LTy.subst.go, LTy.instantiate] at h_inst_S
+        obtain ⟨h2, _⟩ := h_inst_S; subst h2
+        -- mty' = subst S mty_inst, so AliasEquiv .refl → trans with h_ae_S
+        exact HasType.talias (TContext.subst Env.context S) _ _ _
+          (h_aliases_subst ▸ h_ae_S) h_mono_S
+      | cons x_bv rest =>
+        -- POLYMORPHIC: use allKeysFresh to show LTy.subst S ty = ty,
+        -- then reconstruct proof via original instantiate + resolveAliases
+        -- + HasType_subst_fresh_all.
+        have h_go_irrel := polyKeysFresh_go_body_irrel S Env.context
+          x (x_bv :: rest) body h_fresh_ctx h_find (List.cons_ne_nil _ _)
+        have h_subst_ty_eq : LTy.subst S (.forAll (x_bv :: rest) body) =
+            .forAll (x_bv :: rest) body := by
+          simp [LTy.subst, h_go_irrel]
+        -- Rewrite h_tvar_S: now HasType with the un-substituted type
+        rw [h_subst_ty_eq] at h_tvar_S
+        -- Apply the original HasType_LTy_instantiate in ctx.subst S
+        have h_mono := HasType_LTy_instantiate C (TContext.subst Env.context S)
+          (.fvar m x none) (.forAll (x_bv :: rest) body) mty_inst
+          Env.genEnv genEnv' h_tvar_S h_lty_inst h_nodup h_bv_fresh_ty
+        -- Apply HasType_resolveAliases in ctx.subst S (aliases are the same)
+        have h_aliases_S_eq : (TContext.subst Env.context S).aliases =
+            ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context.aliases := by
+          rw [h_aliases_subst]; simp [TEnv.context]; rw [h_ctx_inst]
+        have h_typed := HasType_resolveAliases C (TContext.subst Env.context S)
+          (.fvar m x none) mty_inst mty_ra
+          {Env with genEnv := genEnv'} Env_ra h_mono h_ra h_aliases_S_eq h_aw_subst
+        -- Apply HasType_subst_fresh_all (freshness from SubstWF_key_isFresh_ctx_subst)
+        exact HasType_subst_fresh_all C (TContext.subst Env.context S)
+          (.fvar m x none) mty_ra S h_typed
+          (fun a ha_key _ => TContext.isFresh_subst_of_key Env.context S a ha_key h_wf_S)
+          h_wf_S
+  · -- Case fty = some fty_val
+    rename_i fty_val
+    elim_err h  -- LMonoTy.instantiateWithCheck failed
+    rename_i v2 h_inst2
+    obtain ⟨fty_inst, Env2⟩ := v2
+    simp at h h_inst2
+    elim_err h  -- unify failed (via mapError)
+    rename_i S_info h_unify_raw
+    simp at h
+    obtain ⟨h_ty, h_env⟩ := h
+    subst h_ty; subst h_env
+    -- Extract unify hypothesis from mapError wrapper
+    have h_unify : Constraints.unify [(fty_inst, mty)]
+        Env2.stateSubstInfo = .ok S_info := by
+      revert h_unify_raw
+      generalize Constraints.unify [(fty_inst, mty)]
+        Env2.stateSubstInfo = res
+      intro h_me
+      match res, h_me with
+      | .ok val, h_me => simp [Except.mapError] at h_me; rw [h_me]
+      | .error _, h_me => simp [Except.mapError] at h_me
+    constructor
+    · -- Context preservation
+      simp [TEnv.updateSubst, TEnv.context]
+      have h1 := LTy_instantiateWithCheck_context ty C Env mty Env1 h_inst
+      have h2 := LMonoTy_instantiateWithCheck_context fty_val C Env1
+        fty_inst Env2 h_inst2
+      simp [TEnv.context] at h1 h2
+      rw [h2, h1]
+    · -- HasType with arbitrary absorbing S in substituted context
+      intro S h_abs_S h_wf_S h_fresh_ctx
+      simp [TEnv.updateSubst] at h_abs_S
+      -- Decompose instantiateWithCheck for ty
+      simp only [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h_inst
+      elim_err h_inst
+      rename_i v_ra h_ra; obtain ⟨mty_ra, Env_ra⟩ := v_ra; dsimp at h_inst h_ra
+      elim_errs h_inst
+      simp at h_inst
+      obtain ⟨h_mty_eq, h_env_eq⟩ := h_inst; subst h_mty_eq; subst h_env_eq
+      -- Decompose resolveAliases into instantiate + LMonoTy.resolveAliases
+      simp only [LTy.resolveAliases, Bind.bind, Except.bind] at h_ra
+      elim_err h_ra
+      rename_i v_inst h_lty_inst; obtain ⟨mty_inst, genEnv'⟩ := v_inst
+      simp at h_ra h_lty_inst
+      -- h_lty_inst : ty.instantiate Env.genEnv = .ok (mty_inst, genEnv')
+      -- h_ra : mty_inst.resolveAliases {Env with genEnv := genEnv'} = .ok (mty_ra, Env_ra)
+      -- Context chain
+      have h_ctx_inst := LTy.instantiate_context ty Env.genEnv mty_inst genEnv' h_lty_inst
+      have h_ra_ctx : ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context = Env.context := by
+        simp [TEnv.context]; exact h_ctx_inst
+      have h_env_ra_ctx : Env_ra.context = Env.context := by
+        rw [LMonoTy.resolveAliases_context _ _ _ _ h_ra]; exact h_ra_ctx
+      have h_aliases_eq : Env.context.aliases =
+          ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context.aliases := by
+        simp [TEnv.context]; rw [h_ctx_inst]
+      -- AliasEquiv from resolveAliases: mty_inst ~ mty_ra (= mty after subst)
+      have h_ae := resolveAliases_aliasEquiv mty_inst {Env with genEnv := genEnv'}
+        mty_ra Env_ra h_ra h_aliases_eq (by unfold TContext.AliasesWF; exact h_aw)
+      -- Under S: subst S mty_inst ~ subst S mty_ra
+      have h_ae_S := AliasEquiv_subst Env.context.aliases mty_inst mty_ra S h_ae
+        (fun a ha => h_aw a ha)
+      -- AnnotCompat: decompose h_inst2 to get substitution structure
+      have ⟨mty_fty_ie, Env_fty_ie, Env_fty_ra, h_fty_ie, h_fty_ra⟩ :=
+        LMonoTy.instantiateWithCheck_decompose fty_val C Env_ra fty_inst Env2 h_inst2
+      have ⟨freshtvs_fty, _, h_gen_fty, h_fty_result, _⟩ :=
+        instantiateEnv_decompose _ _ _ _ _ h_fty_ie
+      have h_fty_eq : mty_fty_ie = LMonoTy.subst
+          [List.zip (LMonoTy.freeVars fty_val)
+            (List.map LMonoTy.ftvar freshtvs_fty)] fty_val := by
+        have h := h_fty_result; simp only [LMonoTys.subst] at h
         split at h
-        · simp at h  -- LMonoTy.instantiateWithCheck failed
-        · rename_i v2 h_inst2
-          obtain ⟨fty_inst, Env2⟩ := v2
-          simp at h h_inst2
-          split at h
-          · simp at h  -- unify failed (via mapError)
-          · rename_i S_info h_unify_raw
-            simp at h
-            obtain ⟨h_ty, h_env⟩ := h
-            subst h_ty; subst h_env
-            -- Extract unify hypothesis from mapError wrapper
-            have h_unify : Constraints.unify [(fty_inst, mty)]
-                Env2.stateSubstInfo = .ok S_info := by
-              revert h_unify_raw
-              generalize Constraints.unify [(fty_inst, mty)]
-                Env2.stateSubstInfo = res
-              intro h_me
-              match res, h_me with
-              | .ok val, h_me => simp [Except.mapError] at h_me; rw [h_me]
-              | .error _, h_me => simp [Except.mapError] at h_me
-            constructor
-            · -- Context preservation
-              simp [TEnv.updateSubst, TEnv.context]
-              have h1 := LTy_instantiateWithCheck_context ty C Env mty Env1 h_inst
-              have h2 := LMonoTy_instantiateWithCheck_context fty_val C Env1
-                fty_inst Env2 h_inst2
-              simp [TEnv.context] at h1 h2
-              rw [h2, h1]
-            · -- HasType with arbitrary absorbing S in substituted context
-              intro S h_abs_S h_wf_S h_fresh_ctx
-              simp [TEnv.updateSubst] at h_abs_S
-              -- Decompose instantiateWithCheck for ty
-              simp only [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h_inst
-              split at h_inst; · simp at h_inst
-              rename_i v_ra h_ra; obtain ⟨mty_ra, Env_ra⟩ := v_ra; dsimp at h_inst h_ra
-              split at h_inst; · simp at h_inst
-              split at h_inst
-              · simp at h_inst
-                obtain ⟨h_mty_eq, h_env_eq⟩ := h_inst; subst h_mty_eq; subst h_env_eq
-                -- Decompose resolveAliases into instantiate + LMonoTy.resolveAliases
-                simp only [LTy.resolveAliases, Bind.bind, Except.bind] at h_ra
-                split at h_ra; · simp at h_ra
-                rename_i v_inst h_lty_inst; obtain ⟨mty_inst, genEnv'⟩ := v_inst
-                simp at h_ra h_lty_inst
-                -- h_lty_inst : ty.instantiate Env.genEnv = .ok (mty_inst, genEnv')
-                -- h_ra : mty_inst.resolveAliases {Env with genEnv := genEnv'} = .ok (mty_ra, Env_ra)
-                -- Context chain
-                have h_ctx_inst := LTy.instantiate_context ty Env.genEnv mty_inst genEnv' h_lty_inst
-                have h_ra_ctx : ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context = Env.context := by
-                  simp [TEnv.context]; exact h_ctx_inst
-                have h_env_ra_ctx : Env_ra.context = Env.context := by
-                  rw [LMonoTy.resolveAliases_context _ _ _ _ h_ra]; exact h_ra_ctx
-                have h_aliases_eq : Env.context.aliases =
-                    ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context.aliases := by
-                  simp [TEnv.context]; rw [h_ctx_inst]
-                -- AliasEquiv from resolveAliases: mty_inst ~ mty_ra (= mty after subst)
-                have h_ae := resolveAliases_aliasEquiv mty_inst {Env with genEnv := genEnv'}
-                  mty_ra Env_ra h_ra h_aliases_eq (by unfold TContext.AliasesWF; exact h_aw)
-                -- Under S: subst S mty_inst ~ subst S mty_ra
-                have h_ae_S := AliasEquiv_subst Env.context.aliases mty_inst mty_ra S h_ae
-                  (fun a ha => h_aw a ha)
-                -- AnnotCompat: decompose h_inst2 to get substitution structure
-                have ⟨mty_fty_ie, Env_fty_ie, Env_fty_ra, h_fty_ie, h_fty_ra⟩ :=
-                  LMonoTy.instantiateWithCheck_decompose fty_val C Env_ra fty_inst Env2 h_inst2
-                have ⟨freshtvs_fty, _, h_gen_fty, h_fty_result, _⟩ :=
-                  instantiateEnv_decompose _ _ _ _ _ h_fty_ie
-                have h_fty_eq : mty_fty_ie = LMonoTy.subst
-                    [List.zip (LMonoTy.freeVars fty_val)
-                      (List.map LMonoTy.ftvar freshtvs_fty)] fty_val := by
-                  have h := h_fty_result; simp only [LMonoTys.subst] at h
-                  split at h
-                  · rename_i hS; simp at h; rw [h]; exact (LMonoTy.subst_emptyS hS).symm
-                  · simp [LMonoTys.subst.substAux] at h; exact h
-                -- AliasEquiv from resolveAliases on annotation
-                have h_fty_ie_ctx := LMonoTys.instantiateEnv_context _ _ Env_ra _ _ h_fty_ie
-                have h_ae_fty : AliasEquiv Env.context.aliases
-                    (LMonoTy.subst [List.zip (LMonoTy.freeVars fty_val)
-                      (List.map LMonoTy.ftvar freshtvs_fty)] fty_val) fty_inst := by
-                  have h_ctx_chain : Env_fty_ie.context.aliases = Env.context.aliases := by
-                    rw [h_fty_ie_ctx, h_env_ra_ctx]
-                  rw [← h_fty_eq]
-                  exact h_ctx_chain ▸ resolveAliases_aliasEquiv mty_fty_ie Env_fty_ie fty_inst Env_fty_ra
-                    h_fty_ra rfl (by rw [h_fty_ie_ctx, h_env_ra_ctx]; exact h_aw)
-                -- Apply S to annotation AliasEquiv
-                have h_ae_fty_S := AliasEquiv_subst Env.context.aliases _ _ S h_ae_fty
-                  (fun a ha => h_aw a ha)
-                -- Unification + absorption: subst S fty_inst = subst S mty_ra
-                have h_eq_abs : LMonoTy.subst S fty_inst = LMonoTy.subst S mty_ra := by
-                  have h_eq := unify_makes_equal fty_inst mty_ra Env2.stateSubstInfo S_info h_unify
-                  have := congrArg (LMonoTy.subst S) h_eq
-                  rw [LMonoTy.subst_absorbs S S_info.subst fty_inst h_abs_S,
-                      LMonoTy.subst_absorbs S S_info.subst mty_ra h_abs_S] at this
-                  exact this
-                rw [h_eq_abs] at h_ae_fty_S
-                -- Compose substitution: subst S (subst [σ_fty] fty_val) → subst [σ'] fty_val
-                have h_fty_len : (LMonoTy.freeVars fty_val).length = freshtvs_fty.length :=
-                  (TGenEnv.genTyVars_length _ _ _ _ h_gen_fty).symm
-                rw [subst_compose_ftvar_closed' S _ freshtvs_fty h_fty_len fty_val
-                    (fun v hv => hv)] at h_ae_fty_S
-                -- Bridge to subst S mty_inst via symm of h_ae_S
-                have h_ae_fty_mty : AliasEquiv Env.context.aliases
-                    (LMonoTy.subst [List.zip (LMonoTy.freeVars fty_val)
-                      (List.map (fun v => LMonoTy.subst S (.ftvar v)) freshtvs_fty)] fty_val)
-                    (LMonoTy.subst S mty_inst) :=
-                  .trans h_ae_fty_S (AliasEquiv.symm h_ae_S)
-                have h_annot : AnnotCompat Env.context.aliases fty_val (LMonoTy.subst S mty_inst) :=
-                  ⟨_, h_ae_fty_mty⟩
-                -- Case split on ty's bound vars for openFull construction
-                have h_aliases_subst : (TContext.subst Env.context S).aliases = Env.context.aliases :=
-                  _root_.Lambda.TContext.subst_aliases Env.context S
-                have h_find_S := _root_.Lambda.TContext_types_subst_find
-                  Env.context.types S x ty h_find
-                cases ty with
-                | forAll vars body =>
-                simp [LTy.boundVars] at h_bvnd h_bvf
-                cases vars with
-                | nil =>
-                  -- Monomorphic case: mty_inst = body
-                  simp [LTy.instantiate] at h_lty_inst
-                  obtain ⟨h_eq_inst, _⟩ := h_lty_inst; subst h_eq_inst
-                  -- LTy.subst S (forAll [] body) = forAll [] (subst (go [] S) body)
-                  -- go [] S = S, so openFull (forAll [] (subst S body)) [] = subst S body
-                  have h_open : LTy.openFull (LTy.subst S (.forAll [] body)) [] =
-                      LMonoTy.subst S body := by
-                    simp [LTy.subst, LTy.subst.go, LTy.openFull, LTy.boundVars, LTy.toMonoTypeUnsafe]
-                    exact LMonoTy.subst_emptyS (by simp [Subst.hasEmptyScopes, Map.isEmpty])
-                  have h_bv_subst : (LTy.subst S (.forAll [] body)).boundVars = [] := by
-                    rw [_root_.Lambda.LTy_subst_boundVars]; simp [LTy.boundVars]
-                  rw [← h_aliases_subst] at h_annot h_ae_S
-                  exact HasType.talias (TContext.subst Env.context S) _ _ _ h_ae_S
-                    (HasType.tvar_annotated (C := C) (TContext.subst Env.context S) m x
-                      (LTy.subst S (.forAll [] body)) (LMonoTy.subst S body) [] fty_val
-                      h_find_S (by simp [h_bv_subst]) h_open h_annot)
-                | cons x' xs' =>
-                  -- Polymorphic case: use allKeysFresh + subst_compose_ftvar_open
-                  simp only [LTy.instantiate, Bind.bind, Except.bind] at h_lty_inst
-                  split at h_lty_inst; · simp at h_lty_inst
-                  rename_i v_gen h_gen'; obtain ⟨ftvs, gE⟩ := v_gen
-                  simp at h_lty_inst h_gen'
-                  obtain ⟨h_eq_inst, _⟩ := h_lty_inst; subst h_eq_inst
-                  -- mty_inst = subst [zip (x'::xs') (map ftvar ftvs)] body
-                  have h_len := TGenEnv.genTyVars_length _ _ _ _ h_gen'
-                  let tys := List.map (fun tv => LMonoTy.subst S (.ftvar tv)) ftvs
-                  have h_tys_len : tys.length = (x' :: xs').length := by simp [tys, h_len]
-                  -- Show go-identity from allKeysFresh
-                  have h_go_irrel := polyKeysFresh_go_body_irrel S Env.context
-                    x (x' :: xs') body h_fresh_ctx h_find (List.cons_ne_nil _ _)
-                  -- LTy.subst S ty = ty (since go-identity holds)
-                  have h_subst_ty : LTy.subst S (.forAll (x' :: xs') body) =
-                      .forAll (x' :: xs') body := by
-                    simp [LTy.subst, h_go_irrel]
-                  -- h_extra: free vars of body outside bound vars are not keys of S
-                  have h_extra : ∀ v, v ∈ LMonoTy.freeVars body → v ∉ (x' :: xs') →
-                      v ∉ Maps.keys S := by
-                    intro v hv hni
-                    intro h_key
-                    have h_fresh_v := h_fresh_ctx v h_key
-                    have h_bv_ne : LTy.boundVars (.forAll (x' :: xs') body) ≠ [] := by
-                      simp [LTy.boundVars]
-                    have h_not_fv := h_fresh_v x (.forAll (x' :: xs') body) h_find h_bv_ne
-                    exact h_not_fv (by
-                      show v ∈ (LMonoTy.freeVars body).removeAll (x' :: xs')
-                      simp only [List.removeAll, List.mem_filter, List.elem_eq_mem,
-                                 Bool.not_eq_true', decide_eq_false_iff_not]
-                      exact ⟨hv, hni⟩)
-                  -- Composition: subst S mty_inst = subst [zip bvs tys] body
-                  have h_compose := subst_compose_ftvar_open S (x' :: xs') ftvs
-                    h_len.symm body h_extra
-                  -- openFull (LTy.subst S ty) tys = subst [zip bvs tys] body = subst S mty_inst
-                  have h_open : LTy.openFull (LTy.subst S (.forAll (x' :: xs') body)) tys =
-                      LMonoTy.subst S (LMonoTy.subst [List.zip (x' :: xs')
-                        (List.map LMonoTy.ftvar ftvs)] body) := by
-                    rw [h_subst_ty]
-                    simp only [LTy.openFull, LTy.boundVars, LTy.toMonoTypeUnsafe, tys]
-                    exact h_compose.symm
-                  have h_bv_subst : (LTy.subst S (.forAll (x' :: xs') body)).boundVars =
-                      x' :: xs' := by
-                    rw [_root_.Lambda.LTy_subst_boundVars]; simp [LTy.boundVars]
-                  rw [← h_aliases_subst] at h_annot h_ae_S
-                  exact HasType.talias (TContext.subst Env.context S) _ _ _ h_ae_S
-                    (HasType.tvar_annotated (C := C) (TContext.subst Env.context S) m x
-                      (LTy.subst S (.forAll (x' :: xs') body))
-                      (LMonoTy.subst S (LMonoTy.subst [List.zip (x' :: xs')
-                        (List.map LMonoTy.ftvar ftvs)] body))
-                      tys fty_val h_find_S
-                      (by simp [h_bv_subst]; exact h_tys_len)
-                      h_open h_annot)
-              · simp at h_inst
+        · rename_i hS; simp at h; rw [h]; exact (LMonoTy.subst_emptyS hS).symm
+        · simp [LMonoTys.subst.substAux] at h; exact h
+      -- AliasEquiv from resolveAliases on annotation
+      have h_fty_ie_ctx := LMonoTys.instantiateEnv_context _ _ Env_ra _ _ h_fty_ie
+      have h_ae_fty : AliasEquiv Env.context.aliases
+          (LMonoTy.subst [List.zip (LMonoTy.freeVars fty_val)
+            (List.map LMonoTy.ftvar freshtvs_fty)] fty_val) fty_inst := by
+        have h_ctx_chain : Env_fty_ie.context.aliases = Env.context.aliases := by
+          rw [h_fty_ie_ctx, h_env_ra_ctx]
+        rw [← h_fty_eq]
+        exact h_ctx_chain ▸ resolveAliases_aliasEquiv mty_fty_ie Env_fty_ie fty_inst Env_fty_ra
+          h_fty_ra rfl (by rw [h_fty_ie_ctx, h_env_ra_ctx]; exact h_aw)
+      -- Apply S to annotation AliasEquiv
+      have h_ae_fty_S := AliasEquiv_subst Env.context.aliases _ _ S h_ae_fty
+        (fun a ha => h_aw a ha)
+      -- Unification + absorption: subst S fty_inst = subst S mty_ra
+      have h_eq_abs : LMonoTy.subst S fty_inst = LMonoTy.subst S mty_ra := by
+        have h_eq := unify_makes_equal fty_inst mty_ra Env2.stateSubstInfo S_info h_unify
+        have h_congr := congrArg (LMonoTy.subst S) h_eq
+        rw [LMonoTy.subst_absorbs S S_info.subst fty_inst h_abs_S,
+            LMonoTy.subst_absorbs S S_info.subst mty_ra h_abs_S] at h_congr
+        exact h_congr
+      rw [h_eq_abs] at h_ae_fty_S
+      -- Compose substitution: subst S (subst [σ_fty] fty_val) → subst [σ'] fty_val
+      have h_fty_len : (LMonoTy.freeVars fty_val).length = freshtvs_fty.length :=
+        (TGenEnv.genTyVars_length _ _ _ _ h_gen_fty).symm
+      rw [subst_compose_ftvar_closed' S _ freshtvs_fty h_fty_len fty_val
+          (fun v hv => hv)] at h_ae_fty_S
+      -- Bridge to subst S mty_inst via symm of h_ae_S
+      have h_ae_fty_mty : AliasEquiv Env.context.aliases
+          (LMonoTy.subst [List.zip (LMonoTy.freeVars fty_val)
+            (List.map (fun v => LMonoTy.subst S (.ftvar v)) freshtvs_fty)] fty_val)
+          (LMonoTy.subst S mty_inst) :=
+        .trans h_ae_fty_S (AliasEquiv.symm h_ae_S)
+      have h_annot : AnnotCompat Env.context.aliases fty_val (LMonoTy.subst S mty_inst) :=
+        ⟨_, h_ae_fty_mty⟩
+      -- Case split on ty's bound vars for openFull construction
+      have h_aliases_subst : (TContext.subst Env.context S).aliases = Env.context.aliases :=
+        _root_.Lambda.TContext.subst_aliases Env.context S
+      have h_find_S := _root_.Lambda.TContext_types_subst_find
+        Env.context.types S x ty h_find
+      cases ty with
+      | forAll vars body =>
+      simp [LTy.boundVars] at h_bvnd h_bvf
+      cases vars with
+      | nil =>
+        -- Monomorphic case: mty_inst = body
+        simp [LTy.instantiate] at h_lty_inst
+        obtain ⟨h_eq_inst, _⟩ := h_lty_inst; subst h_eq_inst
+        -- LTy.subst S (forAll [] body) = forAll [] (subst (go [] S) body)
+        -- go [] S = S, so openFull (forAll [] (subst S body)) [] = subst S body
+        have h_open : LTy.openFull (LTy.subst S (.forAll [] body)) [] =
+            LMonoTy.subst S body := by
+          simp [LTy.subst, LTy.subst.go, LTy.openFull, LTy.boundVars, LTy.toMonoTypeUnsafe]
+          exact LMonoTy.subst_emptyS (by simp [Subst.hasEmptyScopes, Map.isEmpty])
+        have h_bv_subst : (LTy.subst S (.forAll [] body)).boundVars = [] := by
+          rw [_root_.Lambda.LTy_subst_boundVars]; simp [LTy.boundVars]
+        rw [← h_aliases_subst] at h_annot h_ae_S
+        exact HasType.talias (TContext.subst Env.context S) _ _ _ h_ae_S
+          (HasType.tvar_annotated (C := C) (TContext.subst Env.context S) m x
+            (LTy.subst S (.forAll [] body)) (LMonoTy.subst S body) [] fty_val
+            h_find_S (by simp [h_bv_subst]) h_open h_annot)
+      | cons x' xs' =>
+        -- Polymorphic case: use allKeysFresh + subst_compose_ftvar_open
+        simp only [LTy.instantiate, Bind.bind, Except.bind] at h_lty_inst
+        elim_err h_lty_inst
+        rename_i v_gen h_gen'; obtain ⟨ftvs, gE⟩ := v_gen
+        simp at h_lty_inst h_gen'
+        obtain ⟨h_eq_inst, _⟩ := h_lty_inst; subst h_eq_inst
+        -- mty_inst = subst [zip (x'::xs') (map ftvar ftvs)] body
+        have h_len := TGenEnv.genTyVars_length _ _ _ _ h_gen'
+        let tys := List.map (fun tv => LMonoTy.subst S (.ftvar tv)) ftvs
+        have h_tys_len : tys.length = (x' :: xs').length := by simp [tys, h_len]
+        -- Show go-identity from allKeysFresh
+        have h_go_irrel := polyKeysFresh_go_body_irrel S Env.context
+          x (x' :: xs') body h_fresh_ctx h_find (List.cons_ne_nil _ _)
+        -- LTy.subst S ty = ty (since go-identity holds)
+        have h_subst_ty : LTy.subst S (.forAll (x' :: xs') body) =
+            .forAll (x' :: xs') body := by
+          simp [LTy.subst, h_go_irrel]
+        -- h_extra: free vars of body outside bound vars are not keys of S
+        have h_extra : ∀ v, v ∈ LMonoTy.freeVars body → v ∉ (x' :: xs') →
+            v ∉ Maps.keys S := by
+          intro v hv hni
+          intro h_key
+          have h_fresh_v := h_fresh_ctx v h_key
+          have h_bv_ne : LTy.boundVars (.forAll (x' :: xs') body) ≠ [] := by
+            simp [LTy.boundVars]
+          have h_not_fv := h_fresh_v x (.forAll (x' :: xs') body) h_find h_bv_ne
+          exact h_not_fv (by
+            show v ∈ (LMonoTy.freeVars body).removeAll (x' :: xs')
+            simp only [List.removeAll, List.mem_filter, List.elem_eq_mem,
+                        Bool.not_eq_true', decide_eq_false_iff_not]
+            exact ⟨hv, hni⟩)
+        -- Composition: subst S mty_inst = subst [zip bvs tys] body
+        have h_compose := subst_compose_ftvar_open S (x' :: xs') ftvs
+          h_len.symm body h_extra
+        -- openFull (LTy.subst S ty) tys = subst [zip bvs tys] body = subst S mty_inst
+        have h_open : LTy.openFull (LTy.subst S (.forAll (x' :: xs') body)) tys =
+            LMonoTy.subst S (LMonoTy.subst [List.zip (x' :: xs')
+              (List.map LMonoTy.ftvar ftvs)] body) := by
+          rw [h_subst_ty]
+          simp only [LTy.openFull, LTy.boundVars, LTy.toMonoTypeUnsafe, tys]
+          exact h_compose.symm
+        have h_bv_subst : (LTy.subst S (.forAll (x' :: xs') body)).boundVars =
+            x' :: xs' := by
+          rw [_root_.Lambda.LTy_subst_boundVars]; simp [LTy.boundVars]
+        rw [← h_aliases_subst] at h_annot h_ae_S
+        exact HasType.talias (TContext.subst Env.context S) _ _ _ h_ae_S
+          (HasType.tvar_annotated (C := C) (TContext.subst Env.context S) m x
+            (LTy.subst S (.forAll (x' :: xs') body))
+            (LMonoTy.subst S (LMonoTy.subst [List.zip (x' :: xs')
+              (List.map LMonoTy.ftvar ftvs)] body))
+            tys fty_val h_find_S
+            (by simp [h_bv_subst]; exact h_tys_len)
+            h_open h_annot)
 
 /-!
 ### Core theorem: `resolveAux_HasType`
@@ -5495,6 +5452,347 @@ theorem TEnvWF.of_resolveAux
     boundVarsFresh := transfer_boundVarsFresh h_envwf.boundVarsFresh h_ctx
       props.genState_mono }
 
+omit [ToString T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
+/-- Reusable induction principle for `resolveAux`. Handles strong induction on
+    expression size, monadic decomposition, and propagation of `TEnvWF` /
+    `types ≠ []` through the chain of environments. -/
+theorem resolveAux_ind
+    (P : (e : LExpr T.mono) → (et : LExprT T.mono) → (C : LContext T) →
+         (Env Env' : TEnv T.IDMeta) → Prop)
+    -- Base cases
+    (h_const : ∀ m c et C Env Env',
+      resolveAux C Env (.const m c) = .ok (et, Env') →
+      TEnvWF Env → Env.context.types ≠ [] → FactoryWF C.functions →
+      P (.const m c) et C Env Env')
+    (h_op : ∀ m o oty et C Env Env',
+      resolveAux C Env (.op m o oty) = .ok (et, Env') →
+      TEnvWF Env → Env.context.types ≠ [] → FactoryWF C.functions →
+      P (.op m o oty) et C Env Env')
+    (h_fvar : ∀ m x fty et C Env Env',
+      resolveAux C Env (.fvar m x fty) = .ok (et, Env') →
+      TEnvWF Env → Env.context.types ≠ [] → FactoryWF C.functions →
+      P (.fvar m x fty) et C Env Env')
+    -- Recursive: app (fully decomposed)
+    (h_app : ∀ m e1 e2 et C Env Env'
+      (e1t : LExprT T.mono) (Env1 : TEnv T.IDMeta)
+      (e2t : LExprT T.mono) (Env2 : TEnv T.IDMeta)
+      (fresh_name : String) (Env_gen : TEnv T.IDMeta)
+      (substInfo : SubstInfo),
+      resolveAux C Env (.app m e1 e2) = .ok (et, Env') →
+      resolveAux C Env e1 = .ok (e1t, Env1) →
+      resolveAux C Env1 e2 = .ok (e2t, Env2) →
+      TEnv.genTyVar Env2 = .ok (fresh_name, Env_gen) →
+      Constraints.unify [(e1t.toLMonoTy, .tcons "arrow" [e2t.toLMonoTy, .ftvar fresh_name])]
+        Env_gen.stateSubstInfo = .ok substInfo →
+      et = .app ⟨m, LMonoTy.subst substInfo.subst (.ftvar fresh_name)⟩ e1t e2t →
+      Env'.stateSubstInfo.subst = Maps.remove substInfo.subst fresh_name →
+      Subst.absorbs (Maps.remove substInfo.subst fresh_name) Env1.stateSubstInfo.subst →
+      Subst.absorbs (Maps.remove substInfo.subst fresh_name) Env2.stateSubstInfo.subst →
+      fresh_name ∉ LMonoTy.freeVars e1t.toLMonoTy →
+      fresh_name ∉ LMonoTy.freeVars e2t.toLMonoTy →
+      LMonoTy.subst substInfo.subst e1t.toLMonoTy =
+        LMonoTy.subst substInfo.subst (.tcons "arrow" [e2t.toLMonoTy, .ftvar fresh_name]) →
+      TEnvWF Env → Env.context.types ≠ [] → FactoryWF C.functions →
+      TEnvWF Env1 → Env1.context = Env.context →
+      TEnvWF Env2 → Env2.context = Env.context →
+      P e1 e1t C Env Env1 → P e2 e2t C Env1 Env2 →
+      P (.app m e1 e2) et C Env Env')
+    -- Recursive: abs
+    (h_abs : ∀ m name bty body et C Env Env'
+      (xv : T.Identifier) (xty : LMonoTy) (Env1 : TEnv T.IDMeta)
+      (et_body : LExprT T.mono) (Env2 : TEnv T.IDMeta),
+      resolveAux C Env (.abs m name bty body) = .ok (et, Env') →
+      typeBoundVar C Env bty = .ok (xv, xty, Env1) →
+      resolveAux C Env1 (LExpr.varOpen 0 (xv, some xty) body) = .ok (et_body, Env2) →
+      et = .abs ⟨m, LMonoTy.subst Env2.stateSubstInfo.subst
+        (.tcons "arrow" [xty, (LExpr.varCloseT 0 xv et_body).toLMonoTy])⟩
+        name bty (LExpr.varCloseT 0 xv et_body) →
+      Env' = Env2.eraseFromContext xv →
+      TEnvWF Env → Env.context.types ≠ [] → FactoryWF C.functions →
+      TEnvWF Env1 → Env1.context.types ≠ [] →
+      Env1.context.aliases = Env.context.aliases →
+      P (LExpr.varOpen 0 (xv, some xty) body) et_body C Env1 Env2 →
+      P (.abs m name bty body) et C Env Env')
+    -- Recursive: quant
+    (h_quant : ∀ m qk name bty triggers body et C Env Env'
+      (xv : T.Identifier) (xty : LMonoTy) (Env1 : TEnv T.IDMeta)
+      (et_body : LExprT T.mono) (Env2 : TEnv T.IDMeta)
+      (et_tr : LExprT T.mono) (Env3 : TEnv T.IDMeta),
+      resolveAux C Env (.quant m qk name bty triggers body) = .ok (et, Env') →
+      typeBoundVar C Env bty = .ok (xv, xty, Env1) →
+      resolveAux C Env1 (LExpr.varOpen 0 (xv, some xty) body) = .ok (et_body, Env2) →
+      resolveAux C Env2 (LExpr.varOpen 0 (xv, some xty) triggers) = .ok (et_tr, Env3) →
+      et = .quant ⟨m, LMonoTy.subst Env3.stateSubstInfo.subst xty⟩ qk name
+        (LMonoTy.subst Env3.stateSubstInfo.subst xty)
+        (LExpr.varCloseT 0 xv et_tr) (LExpr.varCloseT 0 xv et_body) →
+      Env' = Env3.eraseFromContext xv →
+      et_body.toLMonoTy = LMonoTy.bool →
+      TEnvWF Env → Env.context.types ≠ [] → FactoryWF C.functions →
+      TEnvWF Env1 → Env1.context.types ≠ [] →
+      Env1.context.aliases = Env.context.aliases →
+      TEnvWF Env2 → Env2.context = Env1.context →
+      P (LExpr.varOpen 0 (xv, some xty) body) et_body C Env1 Env2 →
+      P (LExpr.varOpen 0 (xv, some xty) triggers) et_tr C Env2 Env3 →
+      P (.quant m qk name bty triggers body) et C Env Env')
+    -- Recursive: eq (with unify decomposition)
+    (h_eq : ∀ m e1 e2 et C Env Env'
+      (e1t : LExprT T.mono) (Env1 : TEnv T.IDMeta)
+      (e2t : LExprT T.mono) (Env2 : TEnv T.IDMeta)
+      (substInfo : SubstInfo),
+      resolveAux C Env (.eq m e1 e2) = .ok (et, Env') →
+      resolveAux C Env e1 = .ok (e1t, Env1) →
+      resolveAux C Env1 e2 = .ok (e2t, Env2) →
+      Constraints.unify [(e1t.toLMonoTy, e2t.toLMonoTy)]
+        Env2.stateSubstInfo = .ok substInfo →
+      et = .eq ⟨m, LMonoTy.bool⟩ e1t e2t →
+      Env'.stateSubstInfo.subst = substInfo.subst →
+      Subst.absorbs Env1.stateSubstInfo.subst Env.stateSubstInfo.subst →
+      Subst.absorbs Env2.stateSubstInfo.subst Env1.stateSubstInfo.subst →
+      TEnvWF Env → Env.context.types ≠ [] → FactoryWF C.functions →
+      TEnvWF Env1 → Env1.context = Env.context →
+      TEnvWF Env2 → Env2.context = Env.context →
+      P e1 e1t C Env Env1 → P e2 e2t C Env1 Env2 →
+      P (.eq m e1 e2) et C Env Env')
+    -- Recursive: ite (with unify decomposition)
+    (h_ite : ∀ m c th el et C Env Env'
+      (ct : LExprT T.mono) (Env1 : TEnv T.IDMeta)
+      (tht : LExprT T.mono) (Env2 : TEnv T.IDMeta)
+      (elt : LExprT T.mono) (Env3 : TEnv T.IDMeta)
+      (substInfo : SubstInfo),
+      resolveAux C Env (.ite m c th el) = .ok (et, Env') →
+      resolveAux C Env c = .ok (ct, Env1) →
+      resolveAux C Env1 th = .ok (tht, Env2) →
+      resolveAux C Env2 el = .ok (elt, Env3) →
+      Constraints.unify [(ct.toLMonoTy, LMonoTy.bool), (tht.toLMonoTy, elt.toLMonoTy)]
+        Env3.stateSubstInfo = .ok substInfo →
+      et = .ite ⟨m, tht.toLMonoTy⟩ ct tht elt →
+      Env'.stateSubstInfo.subst = substInfo.subst →
+      Subst.absorbs Env2.stateSubstInfo.subst Env1.stateSubstInfo.subst →
+      Subst.absorbs Env3.stateSubstInfo.subst Env2.stateSubstInfo.subst →
+      TEnvWF Env → Env.context.types ≠ [] → FactoryWF C.functions →
+      TEnvWF Env1 → Env1.context = Env.context →
+      TEnvWF Env2 → Env2.context = Env.context →
+      TEnvWF Env3 → Env3.context = Env.context →
+      P c ct C Env Env1 → P th tht C Env1 Env2 → P el elt C Env2 Env3 →
+      P (.ite m c th el) et C Env Env')
+    -- Main statement
+    (e : LExpr T.mono) (et : LExprT T.mono) (C : LContext T)
+    (Env Env' : TEnv T.IDMeta)
+    (h_res : resolveAux C Env e = .ok (et, Env'))
+    (h_envwf : TEnvWF Env)
+    (h_ne : Env.context.types ≠ [])
+    (h_fwf : FactoryWF C.functions) :
+    P e et C Env Env' := by
+  have h_main : ∀ (n : Nat) (e : LExpr T.mono), e.sizeOf = n →
+      ∀ (et : LExprT T.mono) (C : LContext T) (Env Env' : TEnv T.IDMeta),
+      resolveAux C Env e = .ok (et, Env') →
+      TEnvWF Env → Env.context.types ≠ [] → FactoryWF C.functions →
+      P e et C Env Env' := by
+    intro n
+    induction n using Nat.strongRecOn with
+    | _ n ih =>
+    intro e h_sz et C Env Env' h_res h_envwf' h_ne' h_fwf'
+    match e with
+    | .const m c => exact h_const m c et C Env Env' h_res h_envwf' h_ne' h_fwf'
+    | .op m o oty => exact h_op m o oty et C Env Env' h_res h_envwf' h_ne' h_fwf'
+    | .fvar m x fty => exact h_fvar m x fty et C Env Env' h_res h_envwf' h_ne' h_fwf'
+    | .bvar _ _ => simp [resolveAux] at h_res
+    | .app m e1 e2 =>
+      have h_orig := h_res
+      simp only [resolveAux, Bind.bind, Except.bind] at h_res
+      elim_err h_res
+      rename_i v1 h1; obtain ⟨e1t, Env1⟩ := v1; dsimp at h_res h1
+      elim_err h_res
+      rename_i v2 h2; obtain ⟨e2t, Env2⟩ := v2; dsimp at h_res h2
+      elim_err h_res
+      rename_i v3 h3; obtain ⟨fresh_name, Env_gen⟩ := v3; dsimp at h_res h3
+      elim_err h_res
+      rename_i substInfo h_unify
+      have h_unify' := unify_of_mapError h_unify
+      have h_sz1 : e1.sizeOf < n := by subst h_sz; simp [LExpr.sizeOf]; omega
+      have h_sz2 : e2.sizeOf < n := by subst h_sz; simp [LExpr.sizeOf]; omega
+      have h_props1 := resolveAux_properties e1 e1t C Env Env1 h1 h_ne'
+        h_envwf'.aliasesWF h_fwf' h_envwf'.substFreshForGen h_envwf'.ctxFreshForGen
+        h_envwf'.boundVarsFresh
+      have h_ctx1 := h_props1.context
+      have h_envwf1 := TEnvWF.of_resolveAux e1 e1t C Env Env1 h1 h_envwf' h_ne' h_fwf' h_ctx1
+      have h_ne1 : Env1.context.types ≠ [] := h_ctx1 ▸ h_ne'
+      have h_props2 := resolveAux_properties e2 e2t C Env1 Env2 h2 h_ne1
+        h_envwf1.aliasesWF h_fwf' h_envwf1.substFreshForGen h_envwf1.ctxFreshForGen
+        h_envwf1.boundVarsFresh
+      have h_ctx2 : Env2.context = Env.context := h_props2.context ▸ h_ctx1
+      have h_envwf2 := TEnvWF.of_resolveAux e2 e2t C Env1 Env2 h2 h_envwf1 h_ne1 h_fwf' h_props2.context
+      -- genTyVar facts and freshness/absorption derivations (S-independent)
+      have h_gen_subst := TEnv.genTyVar_subst Env2 fresh_name Env_gen h3
+      have h_gen_name := genTyVar_name_eq Env2 fresh_name Env_gen h3
+      have h_unify_gen := h_unify'
+      rw [h_gen_subst] at h_unify_gen
+      have h_abs_unify := Constraints.unify_absorbs _ _ _ h_unify_gen
+      have h_fresh_e1 : Maps.find? Env1.stateSubstInfo.subst fresh_name = none ∧
+          (∀ a t, Maps.find? Env1.stateSubstInfo.subst a = some t →
+            fresh_name ∉ LMonoTy.freeVars t) :=
+        genTyVar_fresh_wrt_input_subst Env1 Env2 Env_gen fresh_name h3
+          h_envwf1.substFreshForGen h_props2.genState_mono
+      have h_fresh_e2 : Maps.find? Env2.stateSubstInfo.subst fresh_name = none ∧
+          (∀ a t, Maps.find? Env2.stateSubstInfo.subst a = some t →
+            fresh_name ∉ LMonoTy.freeVars t) :=
+        genTyVar_fresh_wrt_input_subst Env2 Env2 Env_gen fresh_name h3
+          h_props2.preserves.1 (Nat.le_refl _)
+      have h_abs_rem_e2 := Subst.absorbs_of_remove
+        substInfo.subst Env2.stateSubstInfo.subst fresh_name
+        h_abs_unify h_fresh_e2.1 h_fresh_e2.2
+      have h_abs_rem_e1 := Subst.absorbs_of_remove
+        substInfo.subst Env1.stateSubstInfo.subst fresh_name
+        (Subst.absorbs_trans _ _ _ h_props2.absorbs h_abs_unify)
+        h_fresh_e1.1 h_fresh_e1.2
+      have h_e1t_no_fresh : fresh_name ∉ LMonoTy.freeVars e1t.toLMonoTy := by
+        intro h_mem
+        exact absurd h_gen_name
+          (h_props1.preserves.2 fresh_name h_mem Env2.genEnv.genState.tyGen
+            h_props2.genState_mono)
+      have h_e2t_no_fresh : fresh_name ∉ LMonoTy.freeVars e2t.toLMonoTy := by
+        intro h_mem
+        exact absurd h_gen_name
+          (h_props2.preserves.2 fresh_name h_mem Env2.genEnv.genState.tyGen
+            (Nat.le_refl _))
+      have h_unify_eq : LMonoTy.subst substInfo.subst e1t.toLMonoTy =
+          LMonoTy.subst substInfo.subst
+            (LMonoTy.tcons "arrow" [e2t.toLMonoTy, .ftvar fresh_name]) := by
+        have h_p := Constraints.unify_sound _ _ _ h_unify_gen _ (List.Mem.head _)
+        simp at h_p; exact h_p
+      cases h_res
+      have h_ih1 := ih e1.sizeOf h_sz1 e1 rfl e1t C Env Env1 h1 h_envwf' h_ne' h_fwf'
+      have h_ih2 := ih e2.sizeOf h_sz2 e2 rfl e2t C Env1 Env2 h2 h_envwf1 h_ne1 h_fwf'
+      exact h_app m e1 e2 _ C Env _ e1t Env1 e2t Env2 fresh_name Env_gen substInfo
+        h_orig h1 h2 h3 h_unify' rfl rfl h_abs_rem_e1 h_abs_rem_e2
+        h_e1t_no_fresh h_e2t_no_fresh h_unify_eq
+        h_envwf' h_ne' h_fwf' h_envwf1 h_ctx1 h_envwf2 h_ctx2
+        h_ih1 h_ih2
+    | .abs m name bty body =>
+      have h_orig := h_res
+      simp only [resolveAux, Bind.bind, Except.bind] at h_res
+      elim_err h_res
+      rename_i v1 h_tbv; obtain ⟨xv, xty, Env1⟩ := v1; dsimp at h_res h_tbv
+      elim_err h_res
+      rename_i v2 h_res_body; obtain ⟨et_body, Env2⟩ := v2; dsimp at h_res h_res_body
+      have h_sz_body : (LExpr.varOpen 0 (xv, some xty) body).sizeOf < n := by
+        subst h_sz; simp [LExpr.sizeOf, LExpr.varOpen_sizeOf]
+      have h_envwf1 := TEnvWF.of_typeBoundVar C Env bty xv xty Env1 h_tbv h_envwf'
+      have h_ne1 := typeBoundVar_context_types_ne_nil C Env bty xv xty Env1 h_tbv
+      have h_aliases_eq := typeBoundVar_aliases_eq C Env bty xv xty Env1 h_tbv
+      have h_ih := ih _ h_sz_body _ rfl et_body C Env1 Env2 h_res_body h_envwf1 h_ne1 h_fwf'
+      simp only [Except.ok.injEq, Prod.mk.injEq] at h_res
+      obtain ⟨h_et, h_env'⟩ := h_res
+      subst h_et h_env'
+      exact h_abs m name bty body _ C Env _ xv xty Env1 et_body Env2
+        h_orig h_tbv h_res_body rfl rfl h_envwf' h_ne' h_fwf' h_envwf1 h_ne1 h_aliases_eq h_ih
+    | .quant m qk name bty triggers body =>
+      have h_orig := h_res
+      simp only [resolveAux, Bind.bind, Except.bind] at h_res
+      elim_err h_res
+      rename_i v1 h_tbv; obtain ⟨xv, xty, Env1⟩ := v1; dsimp at h_res h_tbv
+      elim_err h_res
+      rename_i v2 h_res_body; obtain ⟨et_body, Env2⟩ := v2; dsimp at h_res h_res_body
+      elim_err h_res
+      rename_i v3 h_res_tr; obtain ⟨et_tr, Env3⟩ := v3; dsimp at h_res h_res_tr
+      have h_sz_body : (LExpr.varOpen 0 (xv, some xty) body).sizeOf < n := by
+        subst h_sz; simp [LExpr.sizeOf, LExpr.varOpen_sizeOf]; omega
+      have h_sz_tr : (LExpr.varOpen 0 (xv, some xty) triggers).sizeOf < n := by
+        subst h_sz; simp [LExpr.sizeOf, LExpr.varOpen_sizeOf]; omega
+      have h_envwf1 := TEnvWF.of_typeBoundVar C Env bty xv xty Env1 h_tbv h_envwf'
+      have h_ne1 := typeBoundVar_context_types_ne_nil C Env bty xv xty Env1 h_tbv
+      have h_aliases_eq := typeBoundVar_aliases_eq C Env bty xv xty Env1 h_tbv
+      have h_props_body := resolveAux_properties (LExpr.varOpen 0 (xv, some xty) body) et_body
+        C Env1 Env2 h_res_body h_ne1 h_envwf1.aliasesWF h_fwf'
+        h_envwf1.substFreshForGen h_envwf1.ctxFreshForGen h_envwf1.boundVarsFresh
+      have h_ctx2 := h_props_body.context
+      have h_envwf2 := TEnvWF.of_resolveAux (LExpr.varOpen 0 (xv, some xty) body) et_body
+        C Env1 Env2 h_res_body h_envwf1 h_ne1 h_fwf' h_ctx2
+      have h_ne2 : Env2.context.types ≠ [] := h_ctx2 ▸ h_ne1
+      have h_ih_body := ih _ h_sz_body _ rfl et_body C Env1 Env2 h_res_body h_envwf1 h_ne1 h_fwf'
+      have h_ih_tr := ih _ h_sz_tr _ rfl et_tr C Env2 Env3 h_res_tr h_envwf2 h_ne2 h_fwf'
+      elim_err h_res
+      rename_i h_ety_bool
+      have h_ety_eq_bool : et_body.toLMonoTy = LMonoTy.bool := by
+        revert h_ety_bool; intro h; simp_all
+      simp only [Except.ok.injEq, Prod.mk.injEq] at h_res
+      obtain ⟨h_et, h_env'⟩ := h_res
+      subst h_et h_env'
+      exact h_quant m qk name bty triggers body _ C Env _ xv xty Env1 et_body Env2 et_tr Env3
+        h_orig h_tbv h_res_body h_res_tr rfl rfl h_ety_eq_bool h_envwf' h_ne' h_fwf' h_envwf1 h_ne1 h_aliases_eq
+        h_envwf2 h_ctx2 h_ih_body h_ih_tr
+    | .eq m e1 e2 =>
+      have h_orig := h_res
+      simp only [resolveAux, Bind.bind, Except.bind] at h_res
+      elim_err h_res
+      rename_i v1 h1; obtain ⟨e1t, Env1⟩ := v1; dsimp at h_res h1
+      elim_err h_res
+      rename_i v2 h2; obtain ⟨e2t, Env2⟩ := v2; dsimp at h_res h2
+      elim_err h_res
+      rename_i substInfo h_unify
+      have h_unify' := unify_of_mapError h_unify
+      have h_sz1 : e1.sizeOf < n := by subst h_sz; simp [LExpr.sizeOf]; omega
+      have h_sz2 : e2.sizeOf < n := by subst h_sz; simp [LExpr.sizeOf]; omega
+      have h_props1 := resolveAux_properties e1 e1t C Env Env1 h1 h_ne'
+        h_envwf'.aliasesWF h_fwf' h_envwf'.substFreshForGen h_envwf'.ctxFreshForGen
+        h_envwf'.boundVarsFresh
+      have h_ctx1 := h_props1.context
+      have h_envwf1 := TEnvWF.of_resolveAux e1 e1t C Env Env1 h1 h_envwf' h_ne' h_fwf' h_ctx1
+      have h_ne1 : Env1.context.types ≠ [] := h_ctx1 ▸ h_ne'
+      have h_props2 := resolveAux_properties e2 e2t C Env1 Env2 h2 h_ne1
+        h_envwf1.aliasesWF h_fwf' h_envwf1.substFreshForGen h_envwf1.ctxFreshForGen
+        h_envwf1.boundVarsFresh
+      have h_ctx2 : Env2.context = Env.context := h_props2.context ▸ h_ctx1
+      have h_envwf2 := TEnvWF.of_resolveAux e2 e2t C Env1 Env2 h2 h_envwf1 h_ne1 h_fwf' h_props2.context
+      cases h_res
+      have h_ih1 := ih e1.sizeOf h_sz1 e1 rfl e1t C Env Env1 h1 h_envwf' h_ne' h_fwf'
+      have h_ih2 := ih e2.sizeOf h_sz2 e2 rfl e2t C Env1 Env2 h2 h_envwf1 h_ne1 h_fwf'
+      exact h_eq m e1 e2 _ C Env _ e1t Env1 e2t Env2 substInfo
+        h_orig h1 h2 h_unify' rfl rfl h_props1.absorbs h_props2.absorbs
+        h_envwf' h_ne' h_fwf' h_envwf1 h_ctx1 h_envwf2 h_ctx2
+        h_ih1 h_ih2
+    | .ite m c th el =>
+      have h_orig := h_res
+      simp only [resolveAux, Bind.bind, Except.bind] at h_res
+      elim_err h_res
+      rename_i vc hc; obtain ⟨ct, Env1⟩ := vc; dsimp at h_res hc
+      elim_err h_res
+      rename_i vt ht; obtain ⟨tht, Env2⟩ := vt; dsimp at h_res ht
+      elim_err h_res
+      rename_i ve he; obtain ⟨elt, Env3⟩ := ve; dsimp at h_res he
+      elim_err h_res
+      rename_i substInfo h_unify
+      have h_unify' := unify_of_mapError h_unify
+      have h_szc : c.sizeOf < n := by subst h_sz; simp [LExpr.sizeOf]; omega
+      have h_szt : th.sizeOf < n := by subst h_sz; simp [LExpr.sizeOf]; omega
+      have h_sze : el.sizeOf < n := by subst h_sz; simp [LExpr.sizeOf]; omega
+      have h_props1 := resolveAux_properties c ct C Env Env1 hc h_ne'
+        h_envwf'.aliasesWF h_fwf' h_envwf'.substFreshForGen h_envwf'.ctxFreshForGen
+        h_envwf'.boundVarsFresh
+      have h_ctx1 := h_props1.context
+      have h_envwf1 := TEnvWF.of_resolveAux c ct C Env Env1 hc h_envwf' h_ne' h_fwf' h_ctx1
+      have h_ne1 : Env1.context.types ≠ [] := h_ctx1 ▸ h_ne'
+      have h_props2 := resolveAux_properties th tht C Env1 Env2 ht h_ne1
+        h_envwf1.aliasesWF h_fwf' h_envwf1.substFreshForGen h_envwf1.ctxFreshForGen
+        h_envwf1.boundVarsFresh
+      have h_ctx2 : Env2.context = Env.context := h_props2.context ▸ h_ctx1
+      have h_envwf2 := TEnvWF.of_resolveAux th tht C Env1 Env2 ht h_envwf1 h_ne1 h_fwf' h_props2.context
+      have h_ne2 : Env2.context.types ≠ [] := h_ctx2 ▸ h_ne'
+      have h_props3 := resolveAux_properties el elt C Env2 Env3 he h_ne2
+        h_envwf2.aliasesWF h_fwf' h_envwf2.substFreshForGen h_envwf2.ctxFreshForGen
+        h_envwf2.boundVarsFresh
+      have h_ctx3 : Env3.context = Env.context := h_props3.context ▸ h_ctx2
+      have h_envwf3 := TEnvWF.of_resolveAux el elt C Env2 Env3 he h_envwf2 h_ne2 h_fwf' h_props3.context
+      cases h_res
+      have h_ihc := ih c.sizeOf h_szc c rfl ct C Env Env1 hc h_envwf' h_ne' h_fwf'
+      have h_iht := ih th.sizeOf h_szt th rfl tht C Env1 Env2 ht h_envwf1 h_ne1 h_fwf'
+      have h_ihe := ih el.sizeOf h_sze el rfl elt C Env2 Env3 he h_envwf2 h_ne2 h_fwf'
+      exact h_ite m c th el _ C Env _ ct Env1 tht Env2 elt Env3 substInfo
+        h_orig hc ht he h_unify' rfl rfl h_props2.absorbs h_props3.absorbs
+        h_envwf' h_ne' h_fwf' h_envwf1 h_ctx1 h_envwf2 h_ctx2
+        h_envwf3 h_ctx3 h_ihc h_iht h_ihe
+  exact h_main e.sizeOf e rfl et C Env Env' h_res h_envwf h_ne h_fwf
+
 omit [ToString T.IDMeta] [ToFormat T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- `varCloseT` preserves `toLMonoTy`: it only changes fvars to bvars without
     affecting the root metadata. -/
@@ -5532,7 +5830,7 @@ private theorem resolveAux_output_type_no_future_vars :
     reference must be bound in the context.
     Propagates through `varOpen`: if `WellScoped e Γ`, then
     `WellScoped (varOpen 0 (xv, some xty) e) (extend Γ xv)`. -/
-def WellScoped (e : LExpr T.mono) (Γ : TContext T.IDMeta) : Prop :=
+@[expose] def WellScoped (e : LExpr T.mono) (Γ : TContext T.IDMeta) : Prop :=
   ∀ x ∈ LExpr.freeVars e, x.1 ∈ TContext.knownVars Γ
 
 omit [ToString T.IDMeta] [DecidableEq T.IDMeta] [ToFormat T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
@@ -5641,7 +5939,7 @@ private theorem typeBoundVar_knownVars_mono
     v ∈ TContext.knownVars Env'.context := by
   -- Decompose typeBoundVar: liftGenEnv → instantiateWithCheck/genTyVar → addInNewestContext
   simp only [typeBoundVar, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen
   have h_g_ctx : Env_g.context = Env.context := liftGenEnv_context Env _ Env_g h_gen
   revert h; cases bty with
@@ -5658,7 +5956,7 @@ private theorem typeBoundVar_knownVars_mono
     rw [show Env_mid.genEnv.context.types = Env.genEnv.context.types from congrArg TContext.types h_mid_ctx]
     exact knownVars_go_addInNewest_mono _ _ _ v hv
   | none =>
-    simp; intro h; split at h; · simp at h
+    simp; intro h; elim_err h
     rename_i v_tg h_tg; obtain ⟨xtyid, Env_mid⟩ := v_tg
     simp at h
     obtain ⟨_, _, h_env'⟩ := h; subst h_env'
@@ -5675,7 +5973,7 @@ private theorem typeBoundVar_xv_in_knownVars
     (h : typeBoundVar C Env bty = .ok (xv, xty, Env')) :
     xv ∈ TContext.knownVars Env'.context := by
   simp only [typeBoundVar, Bind.bind, Except.bind] at h
-  split at h; · simp at h
+  elim_err h
   rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen
   revert h; cases bty with
   | some bty_val =>
@@ -5689,7 +5987,7 @@ private theorem typeBoundVar_xv_in_knownVars
     simp only [TEnv.addInNewestContext, TEnv.updateContext, TEnv.context, TContext.knownVars]
     exact knownVars_go_addInNewest_mem _ _ _
   | none =>
-    simp; intro h; split at h; · simp at h
+    simp; intro h; elim_err h
     rename_i v_tg h_tg; obtain ⟨xtyid, Env_mid⟩ := v_tg
     simp at h
     obtain ⟨h_xv, _, h_env'⟩ := h; subst h_xv; subst h_env'
@@ -5724,95 +6022,46 @@ theorem resolveAux_HasType :
         Subst.polyKeysFresh (T := T) S Env.context →
         HasType C (TContext.subst Env.context S) e
           (.forAll [] (LMonoTy.subst S et.toLMonoTy)) := by
-  suffices h_strong : ∀ (n : Nat) (e : LExpr T.mono), LExpr.sizeOf e = n →
-      ∀ (et : LExprT T.mono) (C : LContext T) (Env Env' : TEnv T.IDMeta),
-      resolveAux C Env e = .ok (et, Env') →
-      TEnvWF Env →
-      Env.context.types ≠ [] →
-      FactoryWF C.functions →
-      WellScoped e Env.context →
+  intro e et C Env Env' h_res h_envwf h_ne h_fwf h_ws
+  revert h_ws
+  apply resolveAux_ind
+    (P := fun e et C Env Env' => WellScoped e Env.context →
       Env'.context = Env.context ∧
       ∀ (S : Subst), Subst.absorbs S Env'.stateSubstInfo.subst → SubstWF S →
         Subst.polyKeysFresh (T := T) S Env.context →
         HasType C (TContext.subst Env.context S) e
-          (.forAll [] (LMonoTy.subst S et.toLMonoTy)) from
-    fun e => h_strong (LExpr.sizeOf e) e rfl
-  intro n
-  induction n using Nat.strongRecOn with
-  | _ n ih_n =>
-  intro e h_sz
-  -- Helper to apply IH to any e' with LExpr.sizeOf e' < n
-  have ih_sub : ∀ (e' : LExpr T.mono), LExpr.sizeOf e' < n →
-      ∀ (et : LExprT T.mono) (C : LContext T) (Env Env' : TEnv T.IDMeta),
-      resolveAux C Env e' = .ok (et, Env') →
-      TEnvWF Env →
-      Env.context.types ≠ [] →
-      FactoryWF C.functions →
-      WellScoped e' Env.context →
-      Env'.context = Env.context ∧
-      ∀ (S : Subst), Subst.absorbs S Env'.stateSubstInfo.subst → SubstWF S →
-        Subst.polyKeysFresh (T := T) S Env.context →
-        HasType C (TContext.subst Env.context S) e'
-          (.forAll [] (LMonoTy.subst S et.toLMonoTy)) :=
-    fun e' h_lt => ih_n (LExpr.sizeOf e') h_lt e' rfl
-  match e with
-  | .const m c =>
-    intro et C Env Env' h h_envwf _ _ _
+          (.forAll [] (LMonoTy.subst S et.toLMonoTy)))
+    (e := e) (et := et) (C := C) (Env := Env) (Env' := Env')
+    (h_res := h_res) (h_envwf := h_envwf) (h_ne := h_ne) (h_fwf := h_fwf)
+  case h_const =>
+    intro m c et C Env Env' h h_envwf h_ne h_fwf _
     have h_aw := h_envwf.aliasesWF
     simp [resolveAux, inferConst] at h
-    split at h
-    · rename_i h_known
-      simp [Bind.bind, Except.bind] at h
-      obtain ⟨h_et, h_env⟩ := h
-      constructor
-      · rw [← h_env]
-      · intro S h_abs_S h_wf_S _
-        rw [← h_et]; simp [toLMonoTy]
-        rw [LConst.ty_subst]
-        cases c with
-        | boolConst b => exact HasType.tbool_const _ _ _ h_known
-        | intConst i => exact HasType.tint_const _ _ _ h_known
-        | realConst r => exact HasType.treal_const _ _ _ h_known
-        | strConst s => exact HasType.tstr_const _ _ _ h_known
-        | bitvecConst n b => exact HasType.tbitvec_const _ _ _ _ h_known
-    · exact absurd h (by simp [Bind.bind, Except.bind])
-  | .bvar m i =>
-    intro et C Env Env' h h_envwf _ _ _
-    have h_aw := h_envwf.aliasesWF
-    simp [resolveAux] at h
-  | .fvar m x fty =>
-    -- resolveAux calls inferFVar, which looks up x in context, instantiates
-    -- bound type variables, and optionally unifies with the annotation.
-    intro et C Env Env' h h_envwf _ _ _
-    have h_aw := h_envwf.aliasesWF
-    simp only [resolveAux, Bind.bind, Except.bind] at h
-    split at h
-    · simp at h
-    · rename_i v1 h_infer
-      obtain ⟨ty_res, Env_res⟩ := v1
-      simp at h
-      obtain ⟨h_et, h_env'⟩ := h
-      rw [← h_et, ← h_env']
-      simp [toLMonoTy]
-      have ⟨h_ctx_pres, h_base_ty⟩ := inferFVar_HasType C Env x fty ty_res Env_res m
-        h_infer h_envwf.boundVarsNodup h_envwf.boundVarsFresh h_envwf.aliasesWF
-      constructor
-      · exact h_ctx_pres
-      · -- h_base_ty : ∀ S, absorbs S Env_res.subst → SubstWF S → polyKeysFresh S ctx →
-        --   HasType C (TContext.subst Env.context S) (.fvar m x fty) (.forAll [] (subst S ty_res))
-        -- Apply directly with the caller's S
-        intro S h_abs_S h_wf_S h_poly_fresh
-        exact h_base_ty S h_abs_S h_wf_S h_poly_fresh
-  | .op m o oty =>
-    intro et C Env Env' h h_envwf h_ne h_fwf h_ws
+    elim_err h
+    rename_i h_known
+    simp [Bind.bind, Except.bind] at h
+    obtain ⟨h_et, h_env⟩ := h
+    constructor
+    · rw [← h_env]
+    · intro S h_abs_S h_wf_S _
+      rw [← h_et]; simp [toLMonoTy]
+      rw [LConst.ty_subst]
+      cases c with
+      | boolConst b => exact HasType.tbool_const _ _ _ h_known
+      | intConst i => exact HasType.tint_const _ _ _ h_known
+      | realConst r => exact HasType.treal_const _ _ _ h_known
+      | strConst s => exact HasType.tstr_const _ _ _ h_known
+      | bitvecConst n b => exact HasType.tbitvec_const _ _ _ _ h_known
+  case h_op =>
+    intro m o oty et C Env Env' h h_envwf h_ne h_fwf h_ws
     have h_aw := h_envwf.aliasesWF
     -- Decompose resolveAux for .op
     simp only [resolveAux, Bind.bind, Except.bind] at h
-    split at h; · simp at h  -- function not found
+    elim_err h  -- function not found
     rename_i func h_find
-    split at h; · simp at h  -- func.type error
+    elim_err h  -- func.type error
     rename_i type_val h_type
-    split at h; · simp at h  -- instantiateWithCheck error
+    elim_err h  -- instantiateWithCheck error
     rename_i v1 h_inst; obtain ⟨ty_inst, Env1⟩ := v1; dsimp at h h_inst
     cases oty with
     | none =>
@@ -5838,52 +6087,50 @@ theorem resolveAux_HasType :
             (h_eq ▸ (by rw [String.toList_append]; exact isPrefixOf_append_self _ _))
         -- Decompose instantiateWithCheck to get the genEnv for instantiate
         simp only [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h_inst
-        split at h_inst; · simp at h_inst
+        elim_err h_inst
         rename_i v_ra h_ra; obtain ⟨mty_ra, Env_ra⟩ := v_ra; dsimp at h_inst h_ra
-        split at h_inst; · simp at h_inst
-        split at h_inst
-        · simp at h_inst; obtain ⟨h_mty, h_env⟩ := h_inst
-          subst h_mty; subst h_env
-          -- ty_inst = mty_ra from resolveAliases
-          -- Decompose resolveAliases to get the instantiate step
-          simp only [LTy.resolveAliases, Bind.bind, Except.bind] at h_ra
-          split at h_ra; · simp at h_ra
-          rename_i v_inst h_lty_inst; obtain ⟨mty_inst, genEnv'⟩ := v_inst
-          simp at h_ra h_lty_inst
-          have h_ctx_inst := LTy.instantiate_context type_val Env.genEnv mty_inst genEnv' h_lty_inst
-          have h_mono := HasType_LTy_instantiate C (TContext.subst Env.context S) (.op m o none) type_val mty_inst
-            Env.genEnv genEnv' h_top h_lty_inst h_nodup h_bv_fresh
-          -- h_mono : HasType C (TContext.subst Env.context S) (.op m o none) (.forAll [] mty_inst)
-          -- Alias resolution: resolveAliases preserves HasType via talias
-          have h_ra_ctx : ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context = Env.context := by
-            simp [TEnv.context]; exact h_ctx_inst
-          have h_aw_ra : TContext.AliasesWF ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context :=
-            h_ra_ctx ▸ h_aw
-          -- Aliases of substituted context = aliases of original context
-          have h_aliases_subst : (TContext.subst Env.context S).aliases = Env.context.aliases :=
-            _root_.Lambda.TContext.subst_aliases Env.context S
-          have h_aliases_eq : (TContext.subst Env.context S).aliases =
-            ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context.aliases := by
-            rw [h_aliases_subst]; simp [TEnv.context]; rw [h_ctx_inst]
-          have h_aw_subst : TContext.AliasesWF (TContext.subst Env.context S) := by
-            rw [TContext.AliasesWF]; rw [h_aliases_subst]; exact h_aw
-          -- HasType_resolveAliases gives HasType ... (.forAll [] mty_ra) via AliasEquiv
-          have h_typed := HasType_resolveAliases C (TContext.subst Env.context S) (.op m o none) mty_inst mty_ra
-            {Env with genEnv := genEnv'} Env_ra h_mono h_ra h_aliases_eq
-            h_aw_subst
-          -- h_typed : HasType C (TContext.subst Env.context S) (.op ...) (.forAll [] mty_ra)
-          -- Goal: HasType C (TContext.subst Env.context S) (.op ...) (.forAll [] (LMonoTy.subst S mty_ra))
-          -- Use HasType_subst_fresh_all: keys of S in freeVars mty_ra are fresh in TContext.subst Γ S
-          -- (because SubstWF S means S is idempotent, so keys don't appear in substituted types)
-          exact HasType_subst_fresh_all C (TContext.subst Env.context S) (.op m o none) mty_ra S h_typed
-            (fun a h_key _ => TContext.isFresh_subst_of_key Env.context S a h_key h_wf_S)
-            h_wf_S
-        · simp at h_inst
+        elim_errs h_inst
+        simp at h_inst; obtain ⟨h_mty, h_env⟩ := h_inst
+        subst h_mty; subst h_env
+        -- ty_inst = mty_ra from resolveAliases
+        -- Decompose resolveAliases to get the instantiate step
+        simp only [LTy.resolveAliases, Bind.bind, Except.bind] at h_ra
+        elim_err h_ra
+        rename_i v_inst h_lty_inst; obtain ⟨mty_inst, genEnv'⟩ := v_inst
+        simp at h_ra h_lty_inst
+        have h_ctx_inst := LTy.instantiate_context type_val Env.genEnv mty_inst genEnv' h_lty_inst
+        have h_mono := HasType_LTy_instantiate C (TContext.subst Env.context S) (.op m o none) type_val mty_inst
+          Env.genEnv genEnv' h_top h_lty_inst h_nodup h_bv_fresh
+        -- h_mono : HasType C (TContext.subst Env.context S) (.op m o none) (.forAll [] mty_inst)
+        -- Alias resolution: resolveAliases preserves HasType via talias
+        have h_ra_ctx : ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context = Env.context := by
+          simp [TEnv.context]; exact h_ctx_inst
+        have h_aw_ra : TContext.AliasesWF ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context :=
+          h_ra_ctx ▸ h_aw
+        -- Aliases of substituted context = aliases of original context
+        have h_aliases_subst : (TContext.subst Env.context S).aliases = Env.context.aliases :=
+          _root_.Lambda.TContext.subst_aliases Env.context S
+        have h_aliases_eq : (TContext.subst Env.context S).aliases =
+          ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context.aliases := by
+          rw [h_aliases_subst]; simp [TEnv.context]; rw [h_ctx_inst]
+        have h_aw_subst : TContext.AliasesWF (TContext.subst Env.context S) := by
+          rw [TContext.AliasesWF]; rw [h_aliases_subst]; exact h_aw
+        -- HasType_resolveAliases gives HasType ... (.forAll [] mty_ra) via AliasEquiv
+        have h_typed := HasType_resolveAliases C (TContext.subst Env.context S) (.op m o none) mty_inst mty_ra
+          {Env with genEnv := genEnv'} Env_ra h_mono h_ra h_aliases_eq
+          h_aw_subst
+        -- h_typed : HasType C (TContext.subst Env.context S) (.op ...) (.forAll [] mty_ra)
+        -- Goal: HasType C (TContext.subst Env.context S) (.op ...) (.forAll [] (LMonoTy.subst S mty_ra))
+        -- Use HasType_subst_fresh_all: keys of S in freeVars mty_ra are fresh in TContext.subst Γ S
+        -- (because SubstWF S means S is idempotent, so keys don't appear in substituted types)
+        exact HasType_subst_fresh_all C (TContext.subst Env.context S) (.op m o none) mty_ra S h_typed
+          (fun a h_key _ => TContext.isFresh_subst_of_key Env.context S a h_key h_wf_S)
+          h_wf_S
     | some oty_val =>
       simp only [Except.mapError] at h
-      split at h; · simp at h
+      elim_err h
       rename_i v2 h_inst2; obtain ⟨oty_inst, Env2⟩ := v2; dsimp at h h_inst2
-      split at h; · simp at h
+      elim_err h
       rename_i v3 h_mapError
       simp at h; obtain ⟨h_et, h_env⟩ := h; rw [← h_env]
       constructor
@@ -5906,893 +6153,590 @@ theorem resolveAux_HasType :
         -- Decompose instantiateWithCheck for type_val
         -- After subst: ty_inst → mty_ra, Env1 → Env_ra
         simp only [LTy.instantiateWithCheck, Bind.bind, Except.bind] at h_inst
-        split at h_inst; · simp at h_inst
+        elim_err h_inst
         rename_i v_ra h_ra; obtain ⟨mty_ra, Env_ra⟩ := v_ra; dsimp at h_inst h_ra
-        split at h_inst; · simp at h_inst
-        split at h_inst
-        · simp at h_inst
-          obtain ⟨h_mty_eq, h_env_eq⟩ := h_inst; subst h_mty_eq; subst h_env_eq
-          -- After subst: goal uses mty_ra, h_inst2 uses Env_ra, h_unify uses mty_ra
-          -- Decompose resolveAliases into instantiate + LMonoTy.resolveAliases
-          simp only [LTy.resolveAliases, Bind.bind, Except.bind] at h_ra
-          split at h_ra; · simp at h_ra
-          rename_i v_inst h_lty_inst; obtain ⟨mty_inst, genEnv'⟩ := v_inst
-          simp at h_ra h_lty_inst
-          -- Context chain
-          have h_ctx_inst := LTy.instantiate_context type_val Env.genEnv mty_inst genEnv' h_lty_inst
-          have h_ra_ctx : ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context = Env.context := by
-            simp [TEnv.context]; exact h_ctx_inst
-          have h_aliases_eq : Env.context.aliases =
-              ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context.aliases := by
-            simp [TEnv.context]; rw [h_ctx_inst]
-          have h_aw_ra : TContext.AliasesWF ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context :=
-            h_ra_ctx ▸ h_aw
-          -- AliasEquiv from resolveAliases: mty_inst ~ mty_ra
-          have h_ae := resolveAliases_aliasEquiv mty_inst {Env with genEnv := genEnv'}
-            mty_ra Env_ra h_ra h_aliases_eq h_aw
-          -- Under S: subst S mty_inst ~ subst S mty_ra
-          have h_ae_S := AliasEquiv_subst Env.context.aliases mty_inst mty_ra S h_ae
-            (fun a ha => h_aw a ha)
-          -- Env_ra context = Env context (via resolveAliases context preservation)
-          have h_env_ra_ctx : Env_ra.context = Env.context := by
-            rw [LMonoTy.resolveAliases_context _ _ _ _ h_ra]; exact h_ra_ctx
-          -- AnnotCompat: decompose h_inst2 to get substitution structure
-          have h_aw1 : TContext.AliasesWF Env_ra.context := h_env_ra_ctx ▸ h_aw
-          have ⟨mty_fty_ie, Env_fty_ie, Env_fty_ra, h_fty_ie, h_fty_ra⟩ :=
-            LMonoTy.instantiateWithCheck_decompose oty_val C Env_ra oty_inst Env2 h_inst2
-          have ⟨freshtvs_fty, _, h_gen_fty, h_fty_result, _⟩ :=
-            instantiateEnv_decompose _ _ _ _ _ h_fty_ie
-          have h_fty_eq : mty_fty_ie = LMonoTy.subst
-              [List.zip (LMonoTy.freeVars oty_val)
-                (List.map LMonoTy.ftvar freshtvs_fty)] oty_val := by
-            have h := h_fty_result; simp only [LMonoTys.subst] at h
-            split at h
-            · rename_i hS; simp at h; rw [h]; exact (LMonoTy.subst_emptyS hS).symm
-            · simp [LMonoTys.subst.substAux] at h; exact h
-          -- AliasEquiv from resolveAliases on annotation: subst [σ] oty_val ~ oty_inst
-          have h_fty_ie_ctx := LMonoTys.instantiateEnv_context _ _ Env_ra _ _ h_fty_ie
-          have h_ae_fty : AliasEquiv Env.context.aliases
-              (LMonoTy.subst [List.zip (LMonoTy.freeVars oty_val)
-                (List.map LMonoTy.ftvar freshtvs_fty)] oty_val) oty_inst := by
-            have h_ctx_chain : Env_fty_ie.context.aliases = Env.context.aliases := by
-              rw [h_fty_ie_ctx, h_env_ra_ctx]
-            rw [← h_fty_eq]
-            exact h_ctx_chain ▸ resolveAliases_aliasEquiv mty_fty_ie Env_fty_ie oty_inst Env_fty_ra
-              h_fty_ra rfl (by rw [h_fty_ie_ctx, h_env_ra_ctx]; exact h_aw)
-          -- Apply S to annotation AliasEquiv
-          have h_ae_fty_S := AliasEquiv_subst Env.context.aliases _ _ S h_ae_fty
-            (fun a ha => h_aw a ha)
-          -- Unification + absorption: subst S oty_inst = subst S mty_ra
-          have h_eq_abs : LMonoTy.subst S oty_inst = LMonoTy.subst S mty_ra := by
-            have h_eq := unify_makes_equal mty_ra oty_inst Env2.stateSubstInfo v3 h_unify
-            have := congrArg (LMonoTy.subst S) h_eq
-            rw [LMonoTy.subst_absorbs S v3.subst mty_ra h_abs_S,
-                LMonoTy.subst_absorbs S v3.subst oty_inst h_abs_S] at this
-            exact this.symm
-          rw [h_eq_abs] at h_ae_fty_S
-          -- Compose substitution: subst S (subst [σ_fty] oty_val) → subst [σ'] oty_val
-          have h_fty_len : (LMonoTy.freeVars oty_val).length = freshtvs_fty.length :=
-            (TGenEnv.genTyVars_length _ _ _ _ h_gen_fty).symm
-          rw [subst_compose_ftvar_closed' S _ freshtvs_fty h_fty_len oty_val
-              (fun v hv => hv)] at h_ae_fty_S
-          -- Bridge to subst S mty_inst via symm of h_ae_S
-          have h_ae_fty_mty : AliasEquiv Env.context.aliases
-              (LMonoTy.subst [List.zip (LMonoTy.freeVars oty_val)
-                (List.map (fun v => LMonoTy.subst S (.ftvar v)) freshtvs_fty)] oty_val)
-              (LMonoTy.subst S mty_inst) :=
-            .trans h_ae_fty_S (AliasEquiv.symm h_ae_S)
-          have h_annot : AnnotCompat Env.context.aliases oty_val (LMonoTy.subst S mty_inst) :=
-            ⟨_, h_ae_fty_mty⟩
-          -- Case split on type_val's bound vars for openFull construction
-          cases type_val with
-          | forAll vars body =>
-          simp [LTy.freeVars] at h_ty_closed
-          cases vars with
-          | nil =>
-            -- Monomorphic case: mty_inst = body
-            simp [LTy.instantiate] at h_lty_inst
-            obtain ⟨h_eq_inst, _⟩ := h_lty_inst; subst h_eq_inst
-            -- body has no freeVars (closed type)
-            have h_body_fv_nil : LMonoTy.freeVars body = [] := by
-              simp only [List.removeAll, List.filter_eq_nil_iff] at h_ty_closed
-              match h_fv : LMonoTy.freeVars body with
-              | [] => rfl
-              | a :: _ => exfalso; have := h_ty_closed a (by simp [h_fv])
-                          simp at this
-            -- subst S body = body (no free vars to substitute)
-            have h_subst_body : LMonoTy.subst S body = body :=
-              LMonoTy.subst_no_relevant_keys S body
-                (fun x hx => by simp [h_body_fv_nil] at hx)
-            rw [h_subst_body] at h_annot h_ae_S
-            have h_open : LTy.openFull (.forAll [] body) [] = body := by
-              simp only [LTy.openFull, LTy.boundVars, LTy.toMonoTypeUnsafe, List.zip_nil_left]
-              exact LMonoTy.subst_emptyS (by simp [Subst.hasEmptyScopes, Map.isEmpty])
-            have h_aliases_subst : (TContext.subst Env.context S).aliases = Env.context.aliases :=
-              _root_.Lambda.TContext.subst_aliases Env.context S
-            rw [← h_aliases_subst] at h_annot h_ae_S
-            exact HasType.talias (TContext.subst Env.context S) _ _ _ h_ae_S
-              (HasType.top_annotated (TContext.subst Env.context S) m func o (.forAll [] body) body [] oty_val
-                h_find h_type (by simp [LTy.boundVars]) h_open h_annot)
-          | cons x' xs' =>
-            -- Polymorphic case
-            simp only [LTy.instantiate, Bind.bind, Except.bind] at h_lty_inst
-            split at h_lty_inst; · simp at h_lty_inst
-            rename_i v_gen h_gen'; obtain ⟨ftvs, gE⟩ := v_gen
-            simp at h_lty_inst h_gen'
-            obtain ⟨h_eq_inst, _⟩ := h_lty_inst; subst h_eq_inst
-            -- Closed condition: all freeVars of body are in bound vars
-            have h_body_cl : ∀ tv, tv ∈ LMonoTy.freeVars body → tv ∈ (x' :: xs') := by
-              intro tv htv
-              simp only [List.removeAll, List.filter_eq_nil_iff] at h_ty_closed
-              have := h_ty_closed tv htv
-              simp only [List.elem_eq_mem, Bool.not_eq_true', decide_eq_false_iff_not,
-                         Decidable.not_not] at this
-              exact this
-            have h_len := TGenEnv.genTyVars_length _ _ _ _ h_gen'
-            -- tys = map (fun tv => subst S (ftvar tv)) ftvs
-            let tys := List.map (fun tv => LMonoTy.subst S (.ftvar tv)) ftvs
-            have h_tys_len : tys.length = (x' :: xs').length := by simp [tys, h_len]
-            -- Composition: subst S (subst [zip vars (map ftvar ftvs)] body) = subst [zip vars tys] body
-            rw [subst_compose_ftvar_closed' S (x' :: xs') ftvs h_len.symm body h_body_cl] at h_annot h_ae_S
-            have h_open : LTy.openFull (.forAll (x' :: xs') body) tys =
-                LMonoTy.subst [List.zip (x' :: xs')
-                  (List.map (fun v => LMonoTy.subst S (.ftvar v)) ftvs)] body := by
-              simp only [LTy.openFull, LTy.boundVars, LTy.toMonoTypeUnsafe, tys]
-            rw [← h_open] at h_annot h_ae_S
-            have h_aliases_subst : (TContext.subst Env.context S).aliases = Env.context.aliases :=
-              _root_.Lambda.TContext.subst_aliases Env.context S
-            rw [← h_aliases_subst] at h_annot h_ae_S
-            exact HasType.talias (TContext.subst Env.context S) _ _ _ h_ae_S
-              (HasType.top_annotated (TContext.subst Env.context S) m func o (.forAll (x' :: xs') body)
-                (LTy.openFull (.forAll (x' :: xs') body) tys) tys oty_val
-                h_find h_type (by simp [LTy.boundVars]; exact h_tys_len) rfl h_annot)
-        · simp at h_inst
-  | .app m e1 e2 =>
-    intro et C Env Env' h h_envwf h_ne h_fwf h_ws
-    have h_aw := h_envwf.aliasesWF
-    simp only [resolveAux, Bind.bind, Except.bind, Except.mapError] at h
-    -- Decompose: resolveAux C Env e1
-    split at h
-    · simp at h
-    · rename_i v1 h_res1
-      obtain ⟨e1t, Env1⟩ := v1
-      dsimp at h h_res1
-      -- Decompose: resolveAux C Env1 e2
-      split at h
-      · simp at h
-      · rename_i v2 h_res2
-        obtain ⟨e2t, Env2⟩ := v2
-        dsimp at h h_res2
-        -- Decompose: TEnv.genTyVar Env2
-        split at h
-        · simp at h
-        · rename_i v3 h_genTyVar
-          obtain ⟨fresh_name, Env3⟩ := v3
-          dsimp at h h_genTyVar
-          -- Decompose: Constraints.unify (wrapped in mapError)
+        elim_errs h_inst
+        simp at h_inst
+        obtain ⟨h_mty_eq, h_env_eq⟩ := h_inst; subst h_mty_eq; subst h_env_eq
+        -- After subst: goal uses mty_ra, h_inst2 uses Env_ra, h_unify uses mty_ra
+        -- Decompose resolveAliases into instantiate + LMonoTy.resolveAliases
+        simp only [LTy.resolveAliases, Bind.bind, Except.bind] at h_ra
+        elim_err h_ra
+        rename_i v_inst h_lty_inst; obtain ⟨mty_inst, genEnv'⟩ := v_inst
+        simp at h_ra h_lty_inst
+        -- Context chain
+        have h_ctx_inst := LTy.instantiate_context type_val Env.genEnv mty_inst genEnv' h_lty_inst
+        have h_ra_ctx : ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context = Env.context := by
+          simp [TEnv.context]; exact h_ctx_inst
+        have h_aliases_eq : Env.context.aliases =
+            ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context.aliases := by
+          simp [TEnv.context]; rw [h_ctx_inst]
+        have h_aw_ra : TContext.AliasesWF ({Env with genEnv := genEnv'} : TEnv T.IDMeta).context :=
+          h_ra_ctx ▸ h_aw
+        -- AliasEquiv from resolveAliases: mty_inst ~ mty_ra
+        have h_ae := resolveAliases_aliasEquiv mty_inst {Env with genEnv := genEnv'}
+          mty_ra Env_ra h_ra h_aliases_eq h_aw
+        -- Under S: subst S mty_inst ~ subst S mty_ra
+        have h_ae_S := AliasEquiv_subst Env.context.aliases mty_inst mty_ra S h_ae
+          (fun a ha => h_aw a ha)
+        -- Env_ra context = Env context (via resolveAliases context preservation)
+        have h_env_ra_ctx : Env_ra.context = Env.context := by
+          rw [LMonoTy.resolveAliases_context _ _ _ _ h_ra]; exact h_ra_ctx
+        -- AnnotCompat: decompose h_inst2 to get substitution structure
+        have h_aw1 : TContext.AliasesWF Env_ra.context := h_env_ra_ctx ▸ h_aw
+        have ⟨mty_fty_ie, Env_fty_ie, Env_fty_ra, h_fty_ie, h_fty_ra⟩ :=
+          LMonoTy.instantiateWithCheck_decompose oty_val C Env_ra oty_inst Env2 h_inst2
+        have ⟨freshtvs_fty, _, h_gen_fty, h_fty_result, _⟩ :=
+          instantiateEnv_decompose _ _ _ _ _ h_fty_ie
+        have h_fty_eq : mty_fty_ie = LMonoTy.subst
+            [List.zip (LMonoTy.freeVars oty_val)
+              (List.map LMonoTy.ftvar freshtvs_fty)] oty_val := by
+          have h := h_fty_result; simp only [LMonoTys.subst] at h
           split at h
-          · simp at h
-          · rename_i v4 h_mapError
-            simp at h
-            obtain ⟨h_et, h_env'⟩ := h
-            -- Extract the underlying unify hypothesis from the mapError wrapper
-            have h_unify := unify_of_mapError h_mapError
-            -- genTyVar preserves subst and context
-            have h_gen_subst := TEnv.genTyVar_subst Env2 fresh_name Env3 h_genTyVar
-            have h_gen_ctx := TEnv.genTyVar_context Env2 fresh_name Env3 h_genTyVar
-            have h_gen_fresh := TEnv.genTyVar_isFresh Env2 fresh_name Env3 h_genTyVar
-            -- IHs from recursive calls (using strong induction)
-            have ih1 := ih_sub e1 (by expr_size h_sz)
-            have ih2 := ih_sub e2 (by expr_size h_sz)
-            have ⟨h_ctx1, h_ty1⟩ := ih1 e1t C Env Env1 h_res1 h_envwf h_ne h_fwf (fun x hx => h_ws x (by simp [LExpr.freeVars, List.mem_append]; left; exact hx))
-            have h_ne1 := h_ctx1 ▸ h_ne
-            -- Build TEnvWF for Env1 (context preserved, subst/gen extended)
-            have h_envwf1 := TEnvWF.of_resolveAux e1 e1t C Env Env1 h_res1 h_envwf h_ne h_fwf h_ctx1
-            have h_ws2 : WellScoped e2 Env1.context := by
-              rw [h_ctx1]; intro x hx; exact h_ws x (by simp [LExpr.freeVars, List.mem_append]; right; exact hx)
-            have ⟨h_ctx2, h_ty2⟩ := ih2 e2t C Env1 Env2 h_res2 h_envwf1 h_ne1 h_fwf h_ws2
-            -- Absorption chain: v4 absorbs Env3.subst = Env2.subst
-            have h_abs_v4_Env3 := Constraints.unify_absorbs
-              [(e1t.toLMonoTy, LMonoTy.tcons "arrow" [e2t.toLMonoTy, .ftvar fresh_name])]
-              Env3.stateSubstInfo v4 h_unify
-            rw [h_gen_subst] at h_abs_v4_Env3
-            -- Now h_abs_v4_Env3 : absorbs v4.subst Env2.subst
-            -- Use ResolveAuxProperties for e1 and e2
-            have props1 := resolveAux_properties e1 e1t C Env Env1 h_res1 h_ne h_aw h_fwf h_envwf.substFreshForGen h_envwf.ctxFreshForGen h_envwf.boundVarsFresh
-            have props2 := resolveAux_properties e2 e2t C Env1 Env2 h_res2 h_ne1 h_envwf1.aliasesWF h_fwf h_envwf1.substFreshForGen h_envwf1.ctxFreshForGen h_envwf1.boundVarsFresh
-            have h_abs_v4_Env1 := Subst.absorbs_trans
-              Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst v4.subst
-              props2.absorbs h_abs_v4_Env3
-            constructor
-            · -- Context preservation
-              rw [← h_env']
-              simp [TEnv.updateSubst, TEnv.context]
-              change Env3.context = Env.context
-              rw [h_gen_ctx, h_ctx2, h_ctx1]
-            · -- Typing under arbitrary absorbing S
-              intro S h_abs_S h_wf_S h_poly_fresh
-              rw [← h_et]; simp [toLMonoTy]
-              -- Goal: HasType C Γ (.app m e1 e2) (.forAll [] (subst S (subst v4 (ftvar fresh))))
-              -- We need: S absorbs Env1.subst and S absorbs Env2.subst
-              -- Chain: S absorbs erase(v4, fresh) and v4 absorbs Env2 absorbs Env1
-              -- Derive absorbs S (erase v4.subst fresh_name) from h_abs_S
-              have h_abs_S_rem : Subst.absorbs S (Maps.remove v4.subst fresh_name) := by
-                rw [← h_env'] at h_abs_S
-                simp [TEnv.updateSubst] at h_abs_S
-                exact h_abs_S
-              -- Freshness: fresh_name not in Env1.subst keys/values
-              have h_fresh_Env1 := genTyVar_fresh_wrt_input_subst
-                Env1 Env2 Env3 fresh_name h_genTyVar
-                h_envwf1.substFreshForGen
-                props2.genState_mono
-              -- Freshness: fresh_name not in Env2.subst keys/values
-              have h_fresh_Env2 := genTyVar_fresh_wrt_input_subst
-                Env2 Env2 Env3 fresh_name h_genTyVar
-                props2.preserves.1
-                (Nat.le_refl _)
-              -- absorbs (remove v4 fresh) Env1.subst and Env2.subst
-              have h_abs_rem_Env1 := Subst.absorbs_of_remove
-                v4.subst Env1.stateSubstInfo.subst fresh_name
-                h_abs_v4_Env1 h_fresh_Env1.1 h_fresh_Env1.2
-              have h_abs_rem_Env2 := Subst.absorbs_of_remove
-                v4.subst Env2.stateSubstInfo.subst fresh_name
-                h_abs_v4_Env3 h_fresh_Env2.1 h_fresh_Env2.2
-              -- Chain: S absorbs (remove v4 fresh) absorbs Env1/Env2
-              have h_abs_S_Env1 : Subst.absorbs S Env1.stateSubstInfo.subst :=
-                Subst.absorbs_trans
-                  Env1.stateSubstInfo.subst (Maps.remove v4.subst fresh_name) S
-                  h_abs_rem_Env1 h_abs_S_rem
-              have h_abs_S_Env2 : Subst.absorbs S Env2.stateSubstInfo.subst :=
-                Subst.absorbs_trans
-                  Env2.stateSubstInfo.subst (Maps.remove v4.subst fresh_name) S
-                  h_abs_rem_Env2 h_abs_S_rem
-              have h_ty1_S := h_ty1 S h_abs_S_Env1 h_wf_S h_poly_fresh
-              rw [h_ctx1] at h_ty2
-              have h_ty2_S := h_ty2 S h_abs_S_Env2 h_wf_S h_poly_fresh
-              -- Unification makes: subst v4 ty1 = tcons "arrow" [subst v4 ty2, subst v4 freshty]
-              have h_eq := unify_makes_equal
-                e1t.toLMonoTy
-                (LMonoTy.tcons "arrow" [e2t.toLMonoTy, .ftvar fresh_name])
-                Env3.stateSubstInfo v4 h_unify
-              -- Key: fresh_name ∉ freeVars e1t.toLMonoTy and e2t.toLMonoTy
-              -- (These follow from SubstFreshForGen + genTyVar freshness but are not yet proven)
-              have h_gen_name := genTyVar_name_eq Env2 fresh_name Env3 h_genTyVar
-              have h_e1t_no_fresh : fresh_name ∉ LMonoTy.freeVars e1t.toLMonoTy := by
-                intro h_mem
-                exact absurd h_gen_name (props1.preserves.2 fresh_name h_mem Env2.genEnv.genState.tyGen props2.genState_mono)
-              have h_e2t_no_fresh : fresh_name ∉ LMonoTy.freeVars e2t.toLMonoTy := by
-                intro h_mem
-                exact absurd h_gen_name (props2.preserves.2 fresh_name h_mem Env2.genEnv.genState.tyGen (Nat.le_refl _))
-              -- subst v4 x = subst (remove v4 fresh) x when fresh ∉ freeVars x
-              have h_subst_e1t : LMonoTy.subst S (LMonoTy.subst v4.subst e1t.toLMonoTy) =
-                  LMonoTy.subst S e1t.toLMonoTy := by
-                rw [← LMonoTy.subst_remove_not_fv v4.subst fresh_name e1t.toLMonoTy h_e1t_no_fresh]
-                exact LMonoTy.subst_absorbs S (Maps.remove v4.subst fresh_name) e1t.toLMonoTy h_abs_S_rem
-              have h_subst_e2t : LMonoTy.subst S (LMonoTy.subst v4.subst e2t.toLMonoTy) =
-                  LMonoTy.subst S e2t.toLMonoTy := by
-                rw [← LMonoTy.subst_remove_not_fv v4.subst fresh_name e2t.toLMonoTy h_e2t_no_fresh]
-                exact LMonoTy.subst_absorbs S (Maps.remove v4.subst fresh_name) e2t.toLMonoTy h_abs_S_rem
-              -- Apply subst S to h_eq and simplify using absorption
-              -- Result: subst S e1t.toLMonoTy = tcons "arrow" [subst S e2t.toLMonoTy, subst S (subst v4 (ftvar fresh))]
-              have h_eq_S : LMonoTy.subst S e1t.toLMonoTy =
-                  LMonoTy.tcons "arrow"
-                    [LMonoTy.subst S e2t.toLMonoTy,
-                     LMonoTy.subst S (LMonoTy.subst v4.subst (.ftvar fresh_name))] := by
-                have h := congrArg (LMonoTy.subst S) h_eq
-                rw [h_subst_e1t] at h
-                rw [LMonoTy.subst_tcons_pair v4.subst "arrow" e2t.toLMonoTy (.ftvar fresh_name)] at h
-                rw [LMonoTy.subst_tcons_pair S "arrow" (LMonoTy.subst v4.subst e2t.toLMonoTy)
-                    (LMonoTy.subst v4.subst (.ftvar fresh_name))] at h
-                rw [h_subst_e2t] at h
-                exact h
-              rw [h_eq_S] at h_ty1_S
-              -- Apply HasType.tapp with result type = subst S (subst v4 (ftvar fresh))
-              exact HasType.tapp (TContext.subst Env.context S) m e1 e2
-                (.forAll [] (LMonoTy.subst S (LMonoTy.subst v4.subst (.ftvar fresh_name))))
-                (.forAll [] (LMonoTy.subst S e2t.toLMonoTy))
-                (by simp [LTy.isMonoType, LTy.boundVars])
-                (by simp [LTy.isMonoType, LTy.boundVars])
-                (by simp [LTy.toMonoType]; exact h_ty1_S)
-                h_ty2_S
-  | .abs m pn bty e_body =>
-    intro et C Env Env' h h_envwf h_ne h_fwf h_ws
+          · rename_i hS; simp at h; rw [h]; exact (LMonoTy.subst_emptyS hS).symm
+          · simp [LMonoTys.subst.substAux] at h; exact h
+        -- AliasEquiv from resolveAliases on annotation: subst [σ] oty_val ~ oty_inst
+        have h_fty_ie_ctx := LMonoTys.instantiateEnv_context _ _ Env_ra _ _ h_fty_ie
+        have h_ae_fty : AliasEquiv Env.context.aliases
+            (LMonoTy.subst [List.zip (LMonoTy.freeVars oty_val)
+              (List.map LMonoTy.ftvar freshtvs_fty)] oty_val) oty_inst := by
+          have h_ctx_chain : Env_fty_ie.context.aliases = Env.context.aliases := by
+            rw [h_fty_ie_ctx, h_env_ra_ctx]
+          rw [← h_fty_eq]
+          exact h_ctx_chain ▸ resolveAliases_aliasEquiv mty_fty_ie Env_fty_ie oty_inst Env_fty_ra
+            h_fty_ra rfl (by rw [h_fty_ie_ctx, h_env_ra_ctx]; exact h_aw)
+        -- Apply S to annotation AliasEquiv
+        have h_ae_fty_S := AliasEquiv_subst Env.context.aliases _ _ S h_ae_fty
+          (fun a ha => h_aw a ha)
+        -- Unification + absorption: subst S oty_inst = subst S mty_ra
+        have h_eq_abs : LMonoTy.subst S oty_inst = LMonoTy.subst S mty_ra := by
+          have h_eq := unify_makes_equal mty_ra oty_inst Env2.stateSubstInfo v3 h_unify
+          have h_congr := congrArg (LMonoTy.subst S) h_eq
+          rw [LMonoTy.subst_absorbs S v3.subst mty_ra h_abs_S,
+              LMonoTy.subst_absorbs S v3.subst oty_inst h_abs_S] at h_congr
+          exact h_congr.symm
+        rw [h_eq_abs] at h_ae_fty_S
+        -- Compose substitution: subst S (subst [σ_fty] oty_val) → subst [σ'] oty_val
+        have h_fty_len : (LMonoTy.freeVars oty_val).length = freshtvs_fty.length :=
+          (TGenEnv.genTyVars_length _ _ _ _ h_gen_fty).symm
+        rw [subst_compose_ftvar_closed' S _ freshtvs_fty h_fty_len oty_val
+            (fun v hv => hv)] at h_ae_fty_S
+        -- Bridge to subst S mty_inst via symm of h_ae_S
+        have h_ae_fty_mty : AliasEquiv Env.context.aliases
+            (LMonoTy.subst [List.zip (LMonoTy.freeVars oty_val)
+              (List.map (fun v => LMonoTy.subst S (.ftvar v)) freshtvs_fty)] oty_val)
+            (LMonoTy.subst S mty_inst) :=
+          .trans h_ae_fty_S (AliasEquiv.symm h_ae_S)
+        have h_annot : AnnotCompat Env.context.aliases oty_val (LMonoTy.subst S mty_inst) :=
+          ⟨_, h_ae_fty_mty⟩
+        -- Case split on type_val's bound vars for openFull construction
+        cases type_val with
+        | forAll vars body =>
+        simp [LTy.freeVars] at h_ty_closed
+        cases vars with
+        | nil =>
+          -- Monomorphic case: mty_inst = body
+          simp [LTy.instantiate] at h_lty_inst
+          obtain ⟨h_eq_inst, _⟩ := h_lty_inst; subst h_eq_inst
+          -- body has no freeVars (closed type)
+          have h_body_fv_nil : LMonoTy.freeVars body = [] := by
+            simp only [List.removeAll, List.filter_eq_nil_iff] at h_ty_closed
+            match h_fv : LMonoTy.freeVars body with
+            | [] => rfl
+            | a :: _ => exfalso; have h_a := h_ty_closed a (by simp [h_fv])
+                        simp at h_a
+          -- subst S body = body (no free vars to substitute)
+          have h_subst_body : LMonoTy.subst S body = body :=
+            LMonoTy.subst_no_relevant_keys S body
+              (fun x hx => by simp [h_body_fv_nil] at hx)
+          rw [h_subst_body] at h_annot h_ae_S
+          have h_open : LTy.openFull (.forAll [] body) [] = body := by
+            simp only [LTy.openFull, LTy.boundVars, LTy.toMonoTypeUnsafe, List.zip_nil_left]
+            exact LMonoTy.subst_emptyS (by simp [Subst.hasEmptyScopes, Map.isEmpty])
+          have h_aliases_subst : (TContext.subst Env.context S).aliases = Env.context.aliases :=
+            _root_.Lambda.TContext.subst_aliases Env.context S
+          rw [← h_aliases_subst] at h_annot h_ae_S
+          exact HasType.talias (TContext.subst Env.context S) _ _ _ h_ae_S
+            (HasType.top_annotated (TContext.subst Env.context S) m func o (.forAll [] body) body [] oty_val
+              h_find h_type (by simp [LTy.boundVars]) h_open h_annot)
+        | cons x' xs' =>
+          -- Polymorphic case
+          simp only [LTy.instantiate, Bind.bind, Except.bind] at h_lty_inst
+          elim_err h_lty_inst
+          rename_i v_gen h_gen'; obtain ⟨ftvs, gE⟩ := v_gen
+          simp at h_lty_inst h_gen'
+          obtain ⟨h_eq_inst, _⟩ := h_lty_inst; subst h_eq_inst
+          -- Closed condition: all freeVars of body are in bound vars
+          have h_body_cl : ∀ tv, tv ∈ LMonoTy.freeVars body → tv ∈ (x' :: xs') := by
+            intro tv htv
+            simp only [List.removeAll, List.filter_eq_nil_iff] at h_ty_closed
+            have h_tv := h_ty_closed tv htv
+            simp only [List.elem_eq_mem, Bool.not_eq_true', decide_eq_false_iff_not,
+                        Decidable.not_not] at h_tv
+            exact h_tv
+          have h_len := TGenEnv.genTyVars_length _ _ _ _ h_gen'
+          -- tys = map (fun tv => subst S (ftvar tv)) ftvs
+          let tys := List.map (fun tv => LMonoTy.subst S (.ftvar tv)) ftvs
+          have h_tys_len : tys.length = (x' :: xs').length := by simp [tys, h_len]
+          -- Composition: subst S (subst [zip vars (map ftvar ftvs)] body) = subst [zip vars tys] body
+          rw [subst_compose_ftvar_closed' S (x' :: xs') ftvs h_len.symm body h_body_cl] at h_annot h_ae_S
+          have h_open : LTy.openFull (.forAll (x' :: xs') body) tys =
+              LMonoTy.subst [List.zip (x' :: xs')
+                (List.map (fun v => LMonoTy.subst S (.ftvar v)) ftvs)] body := by
+            simp only [LTy.openFull, LTy.boundVars, LTy.toMonoTypeUnsafe, tys]
+          rw [← h_open] at h_annot h_ae_S
+          have h_aliases_subst : (TContext.subst Env.context S).aliases = Env.context.aliases :=
+            _root_.Lambda.TContext.subst_aliases Env.context S
+          rw [← h_aliases_subst] at h_annot h_ae_S
+          exact HasType.talias (TContext.subst Env.context S) _ _ _ h_ae_S
+            (HasType.top_annotated (TContext.subst Env.context S) m func o (.forAll (x' :: xs') body)
+              (LTy.openFull (.forAll (x' :: xs') body) tys) tys oty_val
+              h_find h_type (by simp [LTy.boundVars]; exact h_tys_len) rfl h_annot)
+  case h_fvar =>
+    intro m x fty et C Env Env' h h_envwf h_ne h_fwf _
     have h_aw := h_envwf.aliasesWF
-    -- The abs case of resolveAux calls typeBoundVar then recurses on the opened body.
     simp only [resolveAux, Bind.bind, Except.bind] at h
-    -- Decompose: typeBoundVar C Env bty
-    split at h
-    · simp at h
-    · rename_i v1 h_tbv
-      obtain ⟨xv, xty, Env1⟩ := v1
-      dsimp at h h_tbv
-      -- Decompose: resolveAux C Env1 (varOpen 0 (xv, some xty) e_body)
-      split at h
-      · simp at h
-      · rename_i v2 h_res_body
-        obtain ⟨et_body, Env2⟩ := v2
-        dsimp at h h_res_body
-        simp at h
-        obtain ⟨h_et, h_env'⟩ := h
-        -- h_tbv : typeBoundVar C Env bty = .ok (xv, xty, Env1)
-        -- h_res_body : resolveAux C Env1 (varOpen 0 (xv, some xty) e_body) = .ok (et_body, Env2)
-        -- h_et : et = .abs ⟨m, mty⟩ bty (varCloseT 0 xv et_body) where mty = subst S (arrow [xty, ety])
-        -- h_env' : Env' = eraseFromContext Env2 xv
-        -- Apply IH to the opened body using strong induction
-        -- sizeOf (varOpen 0 (xv, some xty) e_body) = sizeOf e_body < 2 + sizeOf e_body = sizeOf (.abs m _ bty e_body) = n
-        have ih_body := ih_sub (varOpen 0 (xv, some xty) e_body)
-          (by expr_size h_sz)
-        -- Build TEnvWF for Env1 (typeBoundVar extends context)
-        have h_envwf1 : TEnvWF Env1 :=
-          let h_inv := typeBoundVar_preserves_invariant C Env bty xv xty Env1 h_tbv h_envwf.substFreshForGen h_envwf.ctxFreshForGen h_envwf.aliasesWF h_envwf.boundVarsFresh
-          { aliasesWF := h_inv.aliasesWF
-            substFreshForGen := h_inv.substFreshForGen
-            ctxFreshForGen := h_inv.ctxFreshForGen
-            boundVarsNodup := typeBoundVar_preserves_boundVarsNodup C Env bty xv xty Env1 h_tbv h_envwf.boundVarsNodup
-            boundVarsFresh := h_inv.boundVarsFresh }
-        have h_ne1 : Env1.context.types ≠ [] :=
-          typeBoundVar_context_types_ne_nil C Env bty xv xty Env1 h_tbv
-        -- WellScoped for the opened body
-        have h_ws_body : WellScoped e_body Env.context :=
-          fun x hx => h_ws x (by simp [LExpr.freeVars]; exact hx)
-        have h_ws_open := WellScoped_varOpen_typeBoundVar C Env bty xv xty Env1
-          e_body h_tbv h_ws_body
-        have ⟨h_ctx_body, h_ty_body⟩ := ih_body et_body C Env1 Env2 h_res_body h_envwf1 h_ne1 h_fwf h_ws_open
-        -- h_ctx_body : Env2.context = Env1.context
-        -- h_ty_body : HasType C Env1.context (varOpen 0 (xv, some xty) e_body)
-        --             (.forAll [] (subst Env2.subst et_body.toLMonoTy))
-        constructor
-        · -- Context preservation: Env'.context = Env.context
-          -- Env' = eraseFromContext Env2 xv
-          -- Env2.context = Env1.context (from IH)
-          -- Env1 = typeBoundVar result, adds xv to Env's context
-          -- eraseFromContext removes xv → back to Env.context
-          rw [← h_env']
-          exact typeBoundVar_erase_context C Env bty xv xty Env1 h_tbv Env2 h_ctx_body
-            (typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv) h_ne
-        · -- Typing under arbitrary absorbing S
-          intro S h_abs_S h_wf_S h_poly_fresh
-          -- Step 1: Simplify et.toLMonoTy
-          -- h_et : et = .abs ⟨m, subst Env2.subst (tcons "arrow" [xty, (varCloseT ..).toLMonoTy])⟩ bty (varCloseT ..)
-          -- We need: HasType ... (.forAll [] (subst S et.toLMonoTy))
-          -- et.toLMonoTy = subst Env2.subst (tcons "arrow" [xty, (varCloseT ..).toLMonoTy])
-          -- (varCloseT ..).toLMonoTy = et_body.toLMonoTy
-          have h_et_ty : et.toLMonoTy = LMonoTy.subst Env2.stateSubstInfo.subst
-              (.tcons "arrow" [xty, et_body.toLMonoTy]) := by
-            subst h_et
-            -- Unfold outer toLMonoTy (.abs ⟨_, mty⟩ _ _) = mty, keeping inner intact
-            change (LMonoTy.subst Env2.stateSubstInfo.subst
-              (.tcons "arrow" [xty, (LExpr.varCloseT 0 xv et_body).toLMonoTy]))
-              = LMonoTy.subst Env2.stateSubstInfo.subst (.tcons "arrow" [xty, et_body.toLMonoTy])
-            rw [varCloseT_toLMonoTy]
-          rw [h_et_ty]
-          -- Step 2: Absorption: S absorbs Env2.subst
-          have h_abs_Env2 : Subst.absorbs S Env2.stateSubstInfo.subst := by
-            rw [← h_env'] at h_abs_S
-            simp [TEnv.eraseFromContext, TEnv.updateContext] at h_abs_S
-            exact h_abs_S
-          -- Build context bridge (needed for polyKeysFresh extension and later)
-          have h_xv_fresh_maps : Maps.find? Env.context.types xv = none := by
+    elim_err h
+    rename_i v1 h_infer
+    obtain ⟨ty_res, Env_res⟩ := v1
+    simp at h
+    obtain ⟨h_et, h_env'⟩ := h
+    rw [← h_et, ← h_env']
+    simp [toLMonoTy]
+    have ⟨h_ctx_pres, h_base_ty⟩ := inferFVar_HasType C Env x fty ty_res Env_res m
+      h_infer h_envwf.boundVarsNodup h_envwf.boundVarsFresh h_envwf.aliasesWF
+    constructor
+    · exact h_ctx_pres
+    · intro S h_abs_S h_wf_S h_poly_fresh
+      exact h_base_ty S h_abs_S h_wf_S h_poly_fresh
+  case h_app =>
+    intro m e1 e2 et C Env Env' e1t Env1 e2t Env2 fresh_name Env_gen substInfo
+      h_res h_res1 h_res2 h_genTyVar h_unify h_et h_subeq h_abs_rem_Env1 h_abs_rem_Env2
+      h_e1t_no_fresh h_e2t_no_fresh h_unify_eq
+      h_envwf h_ne h_fwf h_envwf1 h_ctx1 h_envwf2 h_ctx2 h_ih1 h_ih2 h_ws
+    have h_aw := h_envwf.aliasesWF
+    subst h_et
+    have h_ne1 := h_ctx1 ▸ h_ne
+    have h_ws1 : WellScoped e1 Env.context :=
+      fun x hx => h_ws x (by simp [LExpr.freeVars, List.mem_append]; left; exact hx)
+    have ⟨_, h_ty1⟩ := h_ih1 h_ws1
+    have h_ws2 : WellScoped e2 Env1.context := by
+      rw [h_ctx1]; intro x hx; exact h_ws x (by simp [LExpr.freeVars, List.mem_append]; right; exact hx)
+    have ⟨_, h_ty2⟩ := h_ih2 h_ws2
+    constructor
+    · -- Context preservation, from resolveAux_properties on the app-level result
+      exact (resolveAux_properties (.app m e1 e2) _ C Env Env' h_res h_ne h_aw h_fwf
+        h_envwf.substFreshForGen h_envwf.ctxFreshForGen h_envwf.boundVarsFresh).context
+    · -- Typing under arbitrary absorbing S
+      intro S h_abs_S h_wf_S h_poly_fresh
+      simp [toLMonoTy]
+      rw [h_subeq] at h_abs_S
+      have h_abs_S_Env1 : Subst.absorbs S Env1.stateSubstInfo.subst :=
+        Subst.absorbs_trans Env1.stateSubstInfo.subst (Maps.remove substInfo.subst fresh_name) S
+          h_abs_rem_Env1 h_abs_S
+      have h_abs_S_Env2 : Subst.absorbs S Env2.stateSubstInfo.subst :=
+        Subst.absorbs_trans Env2.stateSubstInfo.subst (Maps.remove substInfo.subst fresh_name) S
+          h_abs_rem_Env2 h_abs_S
+      have h_ty1_S := h_ty1 S h_abs_S_Env1 h_wf_S h_poly_fresh
+      rw [h_ctx1] at h_ty2
+      have h_ty2_S := h_ty2 S h_abs_S_Env2 h_wf_S h_poly_fresh
+      -- subst substInfo x = subst (remove substInfo fresh) x when fresh ∉ freeVars x
+      have h_subst_e1t : LMonoTy.subst S (LMonoTy.subst substInfo.subst e1t.toLMonoTy) =
+          LMonoTy.subst S e1t.toLMonoTy := by
+        rw [← LMonoTy.subst_remove_not_fv substInfo.subst fresh_name e1t.toLMonoTy h_e1t_no_fresh]
+        exact LMonoTy.subst_absorbs S (Maps.remove substInfo.subst fresh_name) e1t.toLMonoTy h_abs_S
+      have h_subst_e2t : LMonoTy.subst S (LMonoTy.subst substInfo.subst e2t.toLMonoTy) =
+          LMonoTy.subst S e2t.toLMonoTy := by
+        rw [← LMonoTy.subst_remove_not_fv substInfo.subst fresh_name e2t.toLMonoTy h_e2t_no_fresh]
+        exact LMonoTy.subst_absorbs S (Maps.remove substInfo.subst fresh_name) e2t.toLMonoTy h_abs_S
+      -- Apply subst S to h_unify_eq: subst S e1t = arrow [subst S e2t, subst S (subst substInfo (ftvar fresh))]
+      have h_eq_S : LMonoTy.subst S e1t.toLMonoTy =
+          LMonoTy.tcons "arrow"
+            [LMonoTy.subst S e2t.toLMonoTy,
+             LMonoTy.subst S (LMonoTy.subst substInfo.subst (.ftvar fresh_name))] := by
+        have h := congrArg (LMonoTy.subst S) h_unify_eq
+        rw [h_subst_e1t] at h
+        rw [LMonoTy.subst_tcons_pair substInfo.subst "arrow" e2t.toLMonoTy (.ftvar fresh_name)] at h
+        rw [LMonoTy.subst_tcons_pair S "arrow" (LMonoTy.subst substInfo.subst e2t.toLMonoTy)
+            (LMonoTy.subst substInfo.subst (.ftvar fresh_name))] at h
+        rw [h_subst_e2t] at h
+        exact h
+      rw [h_eq_S] at h_ty1_S
+      exact HasType.tapp (TContext.subst Env.context S) m e1 e2
+        (.forAll [] (LMonoTy.subst S (LMonoTy.subst substInfo.subst (.ftvar fresh_name))))
+        (.forAll [] (LMonoTy.subst S e2t.toLMonoTy))
+        (by simp [LTy.isMonoType, LTy.boundVars])
+        (by simp [LTy.isMonoType, LTy.boundVars])
+        (by simp [LTy.toMonoType]; exact h_ty1_S)
+        h_ty2_S
+  case h_abs =>
+    intro m pn bty e_body et C Env Env' xv xty Env1 et_body Env2
+      h_res h_tbv h_res_body h_et h_env' h_envwf h_ne h_fwf h_envwf1 h_ne1 h_aliases_eq h_ih h_ws
+    have h_aw := h_envwf.aliasesWF
+    -- WellScoped for the opened body
+    have h_ws_body : WellScoped e_body Env.context :=
+      fun x hx => h_ws x (by simp [LExpr.freeVars]; exact hx)
+    have h_ws_open := WellScoped_varOpen_typeBoundVar C Env bty xv xty Env1
+      e_body h_tbv h_ws_body
+    have ⟨h_ctx_body, h_ty_body⟩ := h_ih h_ws_open
+    subst h_env'
+    constructor
+    · -- Context preservation: Env'.context = Env.context
+      exact typeBoundVar_erase_context C Env bty xv xty Env1 h_tbv Env2 h_ctx_body
+        (typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv) h_ne
+    · -- Typing under arbitrary absorbing S
+      intro S h_abs_S h_wf_S h_poly_fresh
+      -- Step 1: Simplify et.toLMonoTy
+      have h_et_ty : et.toLMonoTy = LMonoTy.subst Env2.stateSubstInfo.subst
+          (.tcons "arrow" [xty, et_body.toLMonoTy]) := by
+        subst h_et
+        change (LMonoTy.subst Env2.stateSubstInfo.subst
+          (.tcons "arrow" [xty, (LExpr.varCloseT 0 xv et_body).toLMonoTy]))
+          = LMonoTy.subst Env2.stateSubstInfo.subst (.tcons "arrow" [xty, et_body.toLMonoTy])
+        rw [varCloseT_toLMonoTy]
+      rw [h_et_ty]
+      -- Step 2: Absorption: S absorbs Env2.subst
+      have h_abs_Env2 : Subst.absorbs S Env2.stateSubstInfo.subst := by
+        simp [TEnv.eraseFromContext, TEnv.updateContext] at h_abs_S
+        exact h_abs_S
+      -- Build context bridge (needed for polyKeysFresh extension and later)
+      have h_xv_fresh_maps : Maps.find? Env.context.types xv = none := by
+        have h_per_scope := typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv
+        suffices h_all_none : ∀ (types : Maps T.Identifier LTy),
+            (∀ m, m ∈ types → Map.find? m xv = none) →
+            Maps.find? types xv = none by
+          exact h_all_none _ h_per_scope
+        intro types h_all; induction types with
+        | nil => simp [Maps.find?]
+        | cons scope rest ih =>
+          simp [Maps.find?]
+          rw [h_all scope (List.mem_cons_self ..)]
+          exact ih (fun m hm => h_all m (List.mem_cons_of_mem _ hm))
+      have ⟨Env_mid, h_mid_ctx, h_env1_eq⟩ :
+          ∃ Env_mid : TEnv T.IDMeta, Env_mid.context = Env.context ∧
+            Env1 = TEnv.addInNewestContext Env_mid [(xv, .forAll [] xty)] := by
+        simp only [typeBoundVar, Bind.bind, Except.bind] at h_tbv
+        elim_err h_tbv
+        rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen; simp at h_tbv
+        have h_g_ctx := liftGenEnv_context Env _ Env_g h_gen
+        revert h_tbv; cases bty with
+        | some bty_val =>
+          simp only []; intro h_tbv
+          generalize h_ic : LMonoTy.instantiateWithCheck bty_val C Env_g = res_ic at h_tbv
+          match res_ic with
+          | .error _ => simp at h_tbv
+          | .ok (_, Env_ic) =>
+            simp at h_tbv
+            obtain ⟨h_xv_eq, h_xty_eq, h_env1⟩ := h_tbv
+            subst h_xv_eq; subst h_xty_eq
+            exact ⟨Env_ic,
+              (LMonoTy_instantiateWithCheck_context' bty_val C Env_g _ Env_ic h_ic).trans h_g_ctx,
+              h_env1.symm⟩
+        | none =>
+          simp; intro h_tbv; elim_err h_tbv
+          rename_i v_tg h_tg; obtain ⟨xtyid, Env_tg⟩ := v_tg
+          simp at h_tbv
+          obtain ⟨h_xv_eq, h_xty_eq, h_env1⟩ := h_tbv
+          subst h_xv_eq; subst h_xty_eq
+          exact ⟨Env_tg,
+            (TEnv.genTyVar_context Env_g xtyid Env_tg h_tg).trans h_g_ctx,
+            h_env1.symm⟩
+      have h_ctx_bridge : Env1.context =
+          { Env.context with types := Env.context.types.insert xv (.forAll [] xty) } := by
+        subst h_env1_eq
+        simp only [TEnv.addInNewestContext, TEnv.updateContext, TEnv.context] at h_mid_ctx ⊢
+        rw [congrArg TContext.types h_mid_ctx, congrArg TContext.aliases h_mid_ctx]
+        congr 1
+        exact (Maps.insert_eq_addInNewest_fresh _ _ _ h_xv_fresh_maps).symm
+      -- Step 3: Use IH to get body typing under S
+      have h_poly_fresh_ext : Subst.polyKeysFresh (T := T) S Env1.context := by
+        rw [h_ctx_bridge]
+        exact polyKeysFresh_insert_mono S Env.context xv xty h_poly_fresh h_xv_fresh_maps
+      have h_body_S := h_ty_body S h_abs_Env2 h_wf_S h_poly_fresh_ext
+      rw [LMonoTy.subst_absorbs S Env2.stateSubstInfo.subst
+        (.tcons "arrow" [xty, et_body.toLMonoTy]) h_abs_Env2]
+      rw [LMonoTy.subst_tcons_pair S "arrow" xty et_body.toLMonoTy]
+      have h_ctx_subst_bridge : Env1.context.subst S =
+          { Env.context.subst S with types :=
+            (Env.context.subst S).types.insert xv (.forAll [] (LMonoTy.subst S xty)) } := by
+        rw [h_ctx_bridge]
+        exact _root_.Lambda.TContext_subst_insert_fresh Env.context S xv (.forAll [] xty) h_xv_fresh_maps
+      have h_tabs := HasType.tabs (TContext.subst Env.context S) m pn (xv, some xty)
+        (.forAll [] (LMonoTy.subst S xty))
+        e_body (.forAll [] (LMonoTy.subst S et_body.toLMonoTy)) bty
+        (by intro h_mem
+            have h_in_ctx := h_ws (xv, some xty) (by simp [LExpr.freeVars]; exact h_mem)
             have h_per_scope := typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv
-            suffices ∀ (types : Maps T.Identifier LTy),
-                (∀ m, m ∈ types → Map.find? m xv = none) →
-                Maps.find? types xv = none by
-              exact this _ h_per_scope
-            intro types h_all; induction types with
-            | nil => simp [Maps.find?]
-            | cons scope rest ih =>
-              simp [Maps.find?]
-              rw [h_all scope (List.mem_cons_self ..)]
-              exact ih (fun m hm => h_all m (List.mem_cons_of_mem _ hm))
-          have ⟨Env_mid, h_mid_ctx, h_env1_eq⟩ :
-              ∃ Env_mid : TEnv T.IDMeta, Env_mid.context = Env.context ∧
-                Env1 = TEnv.addInNewestContext Env_mid [(xv, .forAll [] xty)] := by
-            simp only [typeBoundVar, Bind.bind, Except.bind] at h_tbv
-            split at h_tbv; · simp at h_tbv
-            rename_i v_gen h_gen; obtain ⟨xv_raw, Env_g⟩ := v_gen; simp at h_tbv
-            have h_g_ctx := liftGenEnv_context Env _ Env_g h_gen
-            revert h_tbv; cases bty with
+            have h_not_known : xv ∉ TContext.knownVars Env.context := by
+              intro h_kv
+              simp [TContext.knownVars] at h_kv
+              have h_not_in_go : ∀ (types : Maps T.Identifier LTy),
+                  (∀ m, m ∈ types → Map.find? m xv = none) →
+                  xv ∉ TContext.knownVars.go types := by
+                intro types h_all h_in
+                induction types with
+                | nil => simp [TContext.knownVars.go] at h_in
+                | cons scope rest ih =>
+                  simp [TContext.knownVars.go, List.mem_append] at h_in
+                  rcases h_in with h_key | h_rest
+                  · exact Map.find?_of_not_mem_values scope
+                      (h_all scope (List.mem_cons_self ..)) h_key
+                  · exact ih (fun m hm => h_all m (List.mem_cons_of_mem _ hm)) h_rest
+              exact h_not_in_go _ h_per_scope h_kv
+            exact h_not_known h_in_ctx)
+        (by simp [LTy.isMonoType, LTy.boundVars])
+        (by simp [LTy.isMonoType, LTy.boundVars])
+        (by rw [h_ctx_subst_bridge] at h_body_S
+            exact h_body_S)
+        (by cases bty with
+            | none => exact Or.inl rfl
             | some bty_val =>
-              simp only []; intro h_tbv
-              generalize h_ic : LMonoTy.instantiateWithCheck bty_val C Env_g = res_ic at h_tbv
-              match res_ic with
-              | .error _ => simp at h_tbv
-              | .ok (_, Env_ic) =>
-                simp at h_tbv
-                obtain ⟨h_xv_eq, h_xty_eq, h_env1⟩ := h_tbv
-                subst h_xv_eq; subst h_xty_eq
-                exact ⟨Env_ic,
-                  (LMonoTy_instantiateWithCheck_context' bty_val C Env_g _ Env_ic h_ic).trans h_g_ctx,
-                  h_env1.symm⟩
-            | none =>
-              simp; intro h_tbv; split at h_tbv; · simp at h_tbv
-              rename_i v_tg h_tg; obtain ⟨xtyid, Env_tg⟩ := v_tg
+              right; exact ⟨bty_val, rfl,
+                (TContext.subst_aliases Env.context S) ▸
+                AnnotCompat_subst S
+                  (typeBoundVar_AnnotCompat C Env bty_val xv xty Env1 h_tbv h_aw)
+                  (fun a ha => h_aw a ha)⟩)
+      simp [LTy.toMonoType] at h_tabs
+      exact h_tabs
+  case h_quant =>
+    intro m qk pn bty tr e_body et C Env Env' xv xty Env1 et_body Env2 triggersT Env3
+      h_res h_tbv h_res_body h_res_tr h_et h_env' h_ety_eq_bool h_envwf h_ne h_fwf h_envwf1 h_ne1 h_aliases_eq
+      h_envwf2 h_ctx2 h_ih_body h_ih_tr h_ws
+    have h_aw := h_envwf.aliasesWF
+    have h_ne2 := h_ctx2 ▸ h_ne1
+    have h_ws_open_body : WellScoped (varOpen 0 (xv, some xty) e_body) Env1.context :=
+      WellScoped_varOpen_typeBoundVar C Env bty xv xty Env1 e_body h_tbv
+        (fun x hx => h_ws x (by simp [LExpr.freeVars, List.mem_append]; right; exact hx))
+    have ⟨h_ctx_body, h_ty_body⟩ := h_ih_body h_ws_open_body
+    have h_ws_tr : WellScoped (varOpen 0 (xv, some xty) tr) Env1.context :=
+      WellScoped_varOpen_typeBoundVar C Env bty xv xty Env1 tr h_tbv
+        (fun x hx => h_ws x (by simp [LExpr.freeVars, List.mem_append]; left; exact hx))
+    have ⟨h_ctx_tr, h_ty_tr⟩ := h_ih_tr (by rw [h_ctx2]; exact h_ws_tr)
+    subst h_env'
+    constructor
+    · -- Context preservation: eraseFromContext Env3 xv → Env.context
+      exact typeBoundVar_erase_context C Env bty xv xty Env1 h_tbv Env3
+        (h_ctx_tr.trans h_ctx2)
+        (typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv) h_ne
+    · -- Typing: quant result type is bool, subst S bool = bool
+      intro S h_abs_S h_wf_S h_poly_fresh
+      subst h_et; simp [toLMonoTy, LMonoTy.subst_bool]
+      -- S absorbs Env3.subst (eraseFromContext doesn't change subst)
+      have h_abs_S_Env3 : Subst.absorbs S Env3.stateSubstInfo.subst := by
+        simp [TEnv.eraseFromContext, TEnv.updateContext] at h_abs_S
+        exact h_abs_S
+      have props_tr := resolveAux_properties _ triggersT C Env2 Env3 h_res_tr h_ne2 h_envwf2.aliasesWF h_fwf h_envwf2.substFreshForGen h_envwf2.ctxFreshForGen h_envwf2.boundVarsFresh
+      have h_abs_S_Env2 : Subst.absorbs S Env2.stateSubstInfo.subst :=
+        Subst.absorbs_trans Env2.stateSubstInfo.subst Env3.stateSubstInfo.subst S
+          props_tr.absorbs h_abs_S_Env3
+      have h_poly_fresh_ext : Subst.polyKeysFresh (T := T) S Env1.context :=
+        polyKeysFresh_typeBoundVar S C Env bty xv xty Env1 h_tbv h_poly_fresh
+      have h_body_S := h_ty_body S h_abs_S_Env2 h_wf_S h_poly_fresh_ext
+      rw [h_ety_eq_bool, LMonoTy.subst_bool] at h_body_S
+      have h_tr_S := h_ty_tr S h_abs_S_Env3 h_wf_S (h_ctx2 ▸ h_poly_fresh_ext)
+      rw [h_ctx2] at h_tr_S
+      -- Freshness and bridge setup (same as abs case)
+      have h_xv_fresh_maps : Maps.find? Env.context.types xv = none := by
+        have h_per_scope := typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv
+        suffices h_all_none : ∀ (types : Maps T.Identifier LTy),
+            (∀ m, m ∈ types → Map.find? m xv = none) →
+            Maps.find? types xv = none by
+          exact h_all_none _ h_per_scope
+        intro types h_all
+        induction types with
+        | nil => simp [Maps.find?]
+        | cons m rest ih =>
+          unfold Maps.find?
+          rw [h_all m (.head _)]
+          exact ih (fun m' hm' => h_all m' (.tail _ hm'))
+      have ⟨Env_mid, h_mid_ctx, h_env1_eq⟩ : ∃ Env_mid : TEnv T.IDMeta,
+          Env_mid.context = Env.context ∧
+          Env1 = Env_mid.addInNewestContext [(xv, .forAll [] xty)] := by
+        simp only [typeBoundVar, Bind.bind, Except.bind] at h_tbv
+        generalize h_lift : liftGenEnv HasGen.genVar Env = res_lift at h_tbv
+        match res_lift with
+        | .error _ => simp at h_tbv
+        | .ok (xv_raw, Env_g) =>
+          have h_g_ctx : Env_g.context = Env.context := liftGenEnv_context Env xv_raw Env_g h_lift
+          revert h_tbv; cases bty with
+          | some bty_val =>
+            simp only []; intro h_tbv
+            generalize h_ic : LMonoTy.instantiateWithCheck bty_val C Env_g = res_ic at h_tbv
+            match res_ic with
+            | .error _ => simp at h_tbv
+            | .ok (mty_ic, Env_mid) =>
               simp at h_tbv
               obtain ⟨h_xv_eq, h_xty_eq, h_env1⟩ := h_tbv
               subst h_xv_eq; subst h_xty_eq
-              exact ⟨Env_tg,
-                (TEnv.genTyVar_context Env_g xtyid Env_tg h_tg).trans h_g_ctx,
+              exact ⟨Env_mid,
+                (LMonoTy_instantiateWithCheck_context bty_val C Env_g mty_ic Env_mid h_ic).trans h_g_ctx,
                 h_env1.symm⟩
-          have h_ctx_bridge : Env1.context =
-              { Env.context with types := Env.context.types.insert xv (.forAll [] xty) } := by
-            subst h_env1_eq
-            simp only [TEnv.addInNewestContext, TEnv.updateContext, TEnv.context] at h_mid_ctx ⊢
-            rw [congrArg TContext.types h_mid_ctx, congrArg TContext.aliases h_mid_ctx]
-            congr 1
-            exact (Maps.insert_eq_addInNewest_fresh _ _ _ h_xv_fresh_maps).symm
-          -- Step 3: Use IH to get body typing under S
-          -- Derive polyKeysFresh S Env1.context from polyKeysFresh S Env.context:
-          -- Env1.context adds (xv, forAll [] xty) which has boundVars = [], so the
-          -- polyKeysFresh condition is vacuously satisfied for the new entry.
-          have h_poly_fresh_ext : Subst.polyKeysFresh (T := T) S Env1.context := by
-            rw [h_ctx_bridge]
-            exact polyKeysFresh_insert_mono S Env.context xv xty h_poly_fresh h_xv_fresh_maps
-          have h_body_S := h_ty_body S h_abs_Env2 h_wf_S h_poly_fresh_ext
-          -- After rw [← h_et]; simp [toLMonoTy], goal is:
-          -- HasType ... (.forAll [] (subst S (subst Env2.subst (tcons "arrow" [xty, et_body.toLMonoTy]))))
-          -- By absorption: subst S (subst Env2.subst x) = subst S x
-          rw [LMonoTy.subst_absorbs S Env2.stateSubstInfo.subst
-            (.tcons "arrow" [xty, et_body.toLMonoTy]) h_abs_Env2]
-          -- Goal: HasType ... (.forAll [] (subst S (tcons "arrow" [xty, et_body.toLMonoTy])))
-          -- Distribute subst over tcons:
-          rw [LMonoTy.subst_tcons_pair S "arrow" xty et_body.toLMonoTy]
-          -- Goal: HasType ... (.forAll [] (tcons "arrow" [subst S xty, subst S et_body.toLMonoTy]))
-          -- Step 4: Apply tabs to get arrow [xty, subst S ety], then HasType_subst_fresh_all for S
-          -- tabs gives: arrow [xty, subst S et_body.toLMonoTy]
-          -- Then HasType_subst_fresh_all gives: subst S (arrow [xty, subst S ety])
-          --   = arrow [subst S xty, subst S (subst S ety)]
-          --   = arrow [subst S xty, subst S ety]  (by idempotence: SubstWF → absorbs S S)
-          -- Apply tabs with substituted context directly
-          -- Build the substituted context bridge
-          have h_ctx_subst_bridge : Env1.context.subst S =
-              { Env.context.subst S with types :=
-                (Env.context.subst S).types.insert xv (.forAll [] (LMonoTy.subst S xty)) } := by
-            rw [h_ctx_bridge]
-            exact _root_.Lambda.TContext_subst_insert_fresh Env.context S xv (.forAll [] xty) h_xv_fresh_maps
-          have h_tabs := HasType.tabs (TContext.subst Env.context S) m pn (xv, some xty)
-            (.forAll [] (LMonoTy.subst S xty))
-            e_body (.forAll [] (LMonoTy.subst S et_body.toLMonoTy)) bty
-            (by -- LExpr.fresh (xv, some xty) e_body
-                intro h_mem
-                have h_in_ctx := h_ws (xv, some xty) (by simp [LExpr.freeVars]; exact h_mem)
-                have h_per_scope := typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv
-                have h_not_known : xv ∉ TContext.knownVars Env.context := by
-                  intro h_kv
-                  simp [TContext.knownVars] at h_kv
-                  have : ∀ (types : Maps T.Identifier LTy),
-                      (∀ m, m ∈ types → Map.find? m xv = none) →
-                      xv ∉ TContext.knownVars.go types := by
-                    intro types h_all h_in
-                    induction types with
-                    | nil => simp [TContext.knownVars.go] at h_in
-                    | cons scope rest ih =>
-                      simp [TContext.knownVars.go, List.mem_append] at h_in
-                      rcases h_in with h_key | h_rest
-                      · exact Map.find?_of_not_mem_values scope
-                          (h_all scope (List.mem_cons_self ..)) h_key
-                      · exact ih (fun m hm => h_all m (List.mem_cons_of_mem _ hm)) h_rest
-                  exact this _ h_per_scope h_kv
-                exact h_not_known h_in_ctx)
-            (by simp [LTy.isMonoType, LTy.boundVars])
-            (by simp [LTy.isMonoType, LTy.boundVars])
-            (by -- Body typing: h_body_S gives typing in Env1.context.subst S
-                -- which equals {Env.context.subst S with insert xv (.forAll [] (subst S xty))}
-                -- This matches exactly what tabs needs
-                rw [h_ctx_subst_bridge] at h_body_S
-                exact h_body_S)
-            (by cases bty with
-                | none => exact Or.inl rfl
-                | some bty_val =>
-                  right; exact ⟨bty_val, rfl,
-                    (TContext.subst_aliases Env.context S) ▸
-                    AnnotCompat_subst S
-                      (typeBoundVar_AnnotCompat C Env bty_val xv xty Env1 h_tbv h_aw)
-                      (fun a ha => h_aw a ha)⟩)
-          simp [LTy.toMonoType] at h_tabs
-          -- h_tabs : HasType C (Env.context.subst S) (.abs m _ bty e_body)
-          --   (.forAll [] (.tcons "arrow" [subst S xty, subst S et_body.toLMonoTy]))
-          exact h_tabs
-  | .quant m qk pn bty tr e_body =>
-    intro et C Env Env' h h_envwf h_ne h_fwf h_ws
-    have h_aw := h_envwf.aliasesWF
-    -- Decompose resolveAux for quant
-    simp only [resolveAux, Bind.bind, Except.bind] at h
-    -- typeBoundVar
-    split at h; · simp at h
-    rename_i v1 h_tbv; obtain ⟨xv, xty, Env1⟩ := v1; dsimp at h h_tbv
-    -- resolveAux on opened body
-    split at h; · simp at h
-    rename_i v2 h_res_body; obtain ⟨et_body, Env2⟩ := v2; dsimp at h h_res_body
-    -- resolveAux on opened triggers
-    split at h; · simp at h
-    rename_i v3 h_res_tr; obtain ⟨triggersT, Env3⟩ := v3; dsimp at h h_res_tr
-    -- if check (ety != bool): split gives two branches
-    split at h
-    · -- ety ≠ bool → error path
-      simp at h
-    · -- ety = bool → success path
-      simp at h; obtain ⟨h_et, h_env'⟩ := h
-      -- Build TEnvWF for Env1
-      have h_envwf1 : TEnvWF Env1 :=
-        let h_inv := typeBoundVar_preserves_invariant C Env bty xv xty Env1 h_tbv h_envwf.substFreshForGen h_envwf.ctxFreshForGen h_envwf.aliasesWF h_envwf.boundVarsFresh
-        { aliasesWF := h_inv.aliasesWF
-          substFreshForGen := h_inv.substFreshForGen
-          ctxFreshForGen := h_inv.ctxFreshForGen
-          boundVarsNodup := typeBoundVar_preserves_boundVarsNodup C Env bty xv xty Env1 h_tbv h_envwf.boundVarsNodup
-          boundVarsFresh := h_inv.boundVarsFresh }
-      have h_ne1 : Env1.context.types ≠ [] :=
-        typeBoundVar_context_types_ne_nil C Env bty xv xty Env1 h_tbv
-      -- IH for body
-      have ih_body := ih_sub (varOpen 0 (xv, some xty) e_body)
-        (by expr_size h_sz)
-      have ⟨h_ctx2, _⟩ := ih_body et_body C Env1 Env2 h_res_body h_envwf1 h_ne1 h_fwf (WellScoped_varOpen_typeBoundVar C Env bty xv xty Env1 e_body h_tbv
-              (fun x hx => h_ws x (by simp [LExpr.freeVars, List.mem_append]; right; exact hx)))
-      -- IH for triggers (need TEnvWF Env2)
-      have ih_tr := ih_sub (varOpen 0 (xv, some xty) tr)
-        (by expr_size h_sz)
-      have h_envwf2 := TEnvWF.of_resolveAux _ et_body C Env1 Env2 h_res_body h_envwf1 h_ne1 h_fwf h_ctx2
-      have h_ne2 := h_ctx2 ▸ h_ne1
-      have h_ws_tr : WellScoped (varOpen 0 (xv, some xty) tr) Env1.context :=
-        WellScoped_varOpen_typeBoundVar C Env bty xv xty Env1 tr h_tbv
-          (fun x hx => h_ws x (by simp [LExpr.freeVars, List.mem_append]; left; exact hx))
-      have ⟨h_ctx3, _⟩ := ih_tr triggersT C Env2 Env3 h_res_tr h_envwf2 h_ne2 h_fwf
-        (by rw [h_ctx2]; exact h_ws_tr)
-      constructor
-      · -- Context preservation: eraseFromContext Env3 xv → Env.context
-        rw [← h_env']
-        exact typeBoundVar_erase_context C Env bty xv xty Env1 h_tbv Env3
-          (h_ctx3.trans h_ctx2)
-          (typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv) h_ne
-      · -- Typing: quant result type is bool, subst S bool = bool
-        intro S h_abs_S h_wf_S h_poly_fresh
-        rw [← h_et]; simp [toLMonoTy, LMonoTy.subst_bool]
-        -- Goal: HasType C (Env.context.subst S) (.quant m qk _ bty tr e_body) (.forAll [] .bool)
-        -- Use tquant rule with x = (xv, some xty), x_ty = .forAll [] (subst S xty)
-        -- The if-check gives et_body.toLMonoTy = .bool (ety = bool)
-        rename_i h_ety_bool
-        -- h_ety_bool : ¬(et_body.toLMonoTy != LMonoTy.bool) = true
-        -- i.e., et_body.toLMonoTy = LMonoTy.bool
-        have h_ety_eq_bool : et_body.toLMonoTy = LMonoTy.bool := by
-          revert h_ety_bool; intro h; simp_all
-        -- Get body and trigger typings from IH (under S via absorption)
-        -- S absorbs Env'.subst = Env3.subst (eraseFromContext doesn't change subst)
-        have h_abs_S_Env3 : Subst.absorbs S Env3.stateSubstInfo.subst := by
-          rw [← h_env'] at h_abs_S
-          simp [TEnv.eraseFromContext, TEnv.updateContext] at h_abs_S
-          exact h_abs_S
-        have props_tr := resolveAux_properties _ triggersT C Env2 Env3 h_res_tr h_ne2 h_envwf2.aliasesWF h_fwf h_envwf2.substFreshForGen h_envwf2.ctxFreshForGen h_envwf2.boundVarsFresh
-        have h_abs_Env3_Env2 : Subst.absorbs Env3.stateSubstInfo.subst Env2.stateSubstInfo.subst :=
-          props_tr.absorbs
-        have h_abs_S_Env2 : Subst.absorbs S Env2.stateSubstInfo.subst :=
-          Subst.absorbs_trans Env2.stateSubstInfo.subst Env3.stateSubstInfo.subst S
-            h_abs_Env3_Env2 h_abs_S_Env3
-        have h_poly_fresh_ext : Subst.polyKeysFresh (T := T) S Env1.context :=
-          polyKeysFresh_typeBoundVar S C Env bty xv xty Env1 h_tbv h_poly_fresh
-        have ⟨_, h_ty_body⟩ := ih_body et_body C Env1 Env2 h_res_body h_envwf1 h_ne1 h_fwf (WellScoped_varOpen_typeBoundVar C Env bty xv xty Env1 e_body h_tbv
-              (fun x hx => h_ws x (by simp [LExpr.freeVars, List.mem_append]; right; exact hx)))
-        have h_body_S := h_ty_body S h_abs_S_Env2 h_wf_S h_poly_fresh_ext
-        rw [h_ety_eq_bool, LMonoTy.subst_bool] at h_body_S
-        -- h_body_S : HasType C (Env1.context.subst S) (varOpen 0 (xv, some xty) e_body) (.forAll [] .bool)
-        -- Trigger typing from IH
-        have h_ws_tr' : WellScoped (varOpen 0 (xv, some xty) tr) Env1.context :=
-          WellScoped_varOpen_typeBoundVar C Env bty xv xty Env1 tr h_tbv
-            (fun x hx => h_ws x (by simp [LExpr.freeVars, List.mem_append]; left; exact hx))
-        have ⟨_, h_ty_tr⟩ := ih_tr triggersT C Env2 Env3 h_res_tr h_envwf2 h_ne2 h_fwf
-          (by rw [h_ctx2]; exact h_ws_tr')
-        have h_tr_S := h_ty_tr S h_abs_S_Env3 h_wf_S (h_ctx2 ▸ h_poly_fresh_ext)
-        rw [h_ctx2] at h_tr_S
-        -- h_tr_S : HasType C (Env1.context.subst S) (varOpen 0 (xv, some xty) tr) (...)
-        -- Freshness and bridge setup (same as abs case)
-        have h_xv_fresh_maps : Maps.find? Env.context.types xv = none := by
-          have h_per_scope := typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv
-          suffices ∀ (types : Maps T.Identifier LTy),
-              (∀ m, m ∈ types → Map.find? m xv = none) →
-              Maps.find? types xv = none by
-            exact this _ h_per_scope
-          intro types h_all
-          induction types with
-          | nil => simp [Maps.find?]
-          | cons m rest ih =>
-            unfold Maps.find?
-            rw [h_all m (.head _)]
-            exact ih (fun m' hm' => h_all m' (.tail _ hm'))
-        -- Extract Env_mid from typeBoundVar decomposition
-        have ⟨Env_mid, h_mid_ctx, h_env1_eq⟩ : ∃ Env_mid : TEnv T.IDMeta,
-            Env_mid.context = Env.context ∧
-            Env1 = Env_mid.addInNewestContext [(xv, .forAll [] xty)] := by
-          simp only [typeBoundVar, Bind.bind, Except.bind] at h_tbv
-          generalize h_lift : liftGenEnv HasGen.genVar Env = res_lift at h_tbv
-          match res_lift with
-          | .error _ => simp at h_tbv
-          | .ok (xv_raw, Env_g) =>
-            have h_g_ctx : Env_g.context = Env.context := liftGenEnv_context Env xv_raw Env_g h_lift
-            revert h_tbv; cases bty with
+          | none =>
+            simp; intro h_tbv
+            generalize h_tg : TEnv.genTyVar Env_g = res_tg at h_tbv
+            match res_tg with
+            | .error _ => simp at h_tbv
+            | .ok (xtyid, Env_mid) =>
+              simp at h_tbv
+              obtain ⟨h_xv_eq, h_xty_eq, h_env1⟩ := h_tbv
+              subst h_xv_eq; subst h_xty_eq
+              exact ⟨Env_mid,
+                (TEnv.genTyVar_context Env_g xtyid Env_mid h_tg).trans h_g_ctx,
+                h_env1.symm⟩
+      have h_ctx_bridge : Env1.context =
+          { Env.context with types := Env.context.types.insert xv (.forAll [] xty) } := by
+        subst h_env1_eq
+        simp only [TEnv.addInNewestContext, TEnv.updateContext, TEnv.context] at h_mid_ctx ⊢
+        have h_types_eq : Env_mid.genEnv.context.types = Env.genEnv.context.types :=
+          congrArg TContext.types h_mid_ctx
+        have h_aliases_eq2 : Env_mid.genEnv.context.aliases = Env.genEnv.context.aliases :=
+          congrArg TContext.aliases h_mid_ctx
+        rw [h_types_eq, h_aliases_eq2]
+        congr 1
+        exact (Maps.insert_eq_addInNewest_fresh _ _ _ h_xv_fresh_maps).symm
+      have h_ctx_subst_bridge : Env1.context.subst S =
+          { Env.context.subst S with types :=
+            (Env.context.subst S).types.insert xv (.forAll [] (LMonoTy.subst S xty)) } := by
+        rw [h_ctx_bridge]
+        exact _root_.Lambda.TContext_subst_insert_fresh Env.context S xv (.forAll [] xty) h_xv_fresh_maps
+      have h_tquant := HasType.tquant (TContext.subst Env.context S) m qk pn tr
+        (.forAll [] (LMonoTy.subst S (triggersT.toLMonoTy)))
+        (xv, some xty) (.forAll [] (LMonoTy.subst S xty)) e_body bty
+        (by intro h_mem
+            have h_in_ctx := h_ws (xv, some xty) (by
+              simp [LExpr.freeVars, List.mem_append]; right; exact h_mem)
+            have h_per_scope := typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv
+            have h_not_known : xv ∉ TContext.knownVars Env.context := by
+              intro h_kv
+              have h_not_in_go : ∀ (types : Maps T.Identifier LTy),
+                  (∀ m, m ∈ types → Map.find? m xv = none) →
+                  xv ∉ TContext.knownVars.go types := by
+                intro types h_all h_in
+                induction types with
+                | nil => simp [TContext.knownVars.go] at h_in
+                | cons scope rest ih =>
+                  simp [TContext.knownVars.go, List.mem_append] at h_in
+                  rcases h_in with h_key | h_rest
+                  · exact Map.find?_of_not_mem_values scope
+                      (h_all scope (List.mem_cons_self ..)) h_key
+                  · exact ih (fun m hm => h_all m (List.mem_cons_of_mem _ hm)) h_rest
+              exact h_not_in_go _ h_per_scope h_kv
+            exact h_not_known h_in_ctx)
+        (by simp [LTy.isMonoType, LTy.boundVars])
+        (by rw [h_ctx_subst_bridge] at h_body_S
+            exact h_body_S)
+        (by rw [h_ctx_subst_bridge] at h_tr_S
+            exact h_tr_S)
+        (by cases bty with
+            | none => exact Or.inl rfl
             | some bty_val =>
-              simp only []; intro h_tbv
-              generalize h_ic : LMonoTy.instantiateWithCheck bty_val C Env_g = res_ic at h_tbv
-              match res_ic with
-              | .error _ => simp at h_tbv
-              | .ok (mty_ic, Env_mid) =>
-                simp at h_tbv
-                obtain ⟨h_xv_eq, h_xty_eq, h_env1⟩ := h_tbv
-                subst h_xv_eq; subst h_xty_eq
-                exact ⟨Env_mid,
-                  (LMonoTy_instantiateWithCheck_context bty_val C Env_g mty_ic Env_mid h_ic).trans h_g_ctx,
-                  h_env1.symm⟩
-            | none =>
-              simp; intro h_tbv
-              generalize h_tg : TEnv.genTyVar Env_g = res_tg at h_tbv
-              match res_tg with
-              | .error _ => simp at h_tbv
-              | .ok (xtyid, Env_mid) =>
-                simp at h_tbv
-                obtain ⟨h_xv_eq, h_xty_eq, h_env1⟩ := h_tbv
-                subst h_xv_eq; subst h_xty_eq
-                exact ⟨Env_mid,
-                  (TEnv.genTyVar_context Env_g xtyid Env_mid h_tg).trans h_g_ctx,
-                  h_env1.symm⟩
-        have h_ctx_bridge : Env1.context =
-            { Env.context with types := Env.context.types.insert xv (.forAll [] xty) } := by
-          subst h_env1_eq
-          simp only [TEnv.addInNewestContext, TEnv.updateContext, TEnv.context] at h_mid_ctx ⊢
-          have h_types_eq : Env_mid.genEnv.context.types = Env.genEnv.context.types :=
-            congrArg TContext.types h_mid_ctx
-          have h_aliases_eq : Env_mid.genEnv.context.aliases = Env.genEnv.context.aliases :=
-            congrArg TContext.aliases h_mid_ctx
-          rw [h_types_eq, h_aliases_eq]
-          congr 1
-          exact (Maps.insert_eq_addInNewest_fresh _ _ _ h_xv_fresh_maps).symm
-        -- Build the substituted context bridge (same as abs case)
-        have h_ctx_subst_bridge : Env1.context.subst S =
-            { Env.context.subst S with types :=
-              (Env.context.subst S).types.insert xv (.forAll [] (LMonoTy.subst S xty)) } := by
-          rw [h_ctx_bridge]
-          exact _root_.Lambda.TContext_subst_insert_fresh Env.context S xv (.forAll [] xty) h_xv_fresh_maps
-        -- Apply tquant with substituted context and substituted x_ty
-        have h_tquant := HasType.tquant (TContext.subst Env.context S) m qk pn tr
-          (.forAll [] (LMonoTy.subst S (triggersT.toLMonoTy)))
-          (xv, some xty) (.forAll [] (LMonoTy.subst S xty)) e_body bty
-          (by -- LExpr.fresh (xv, some xty) e_body
-              intro h_mem
-              have h_in_ctx := h_ws (xv, some xty) (by
-                simp [LExpr.freeVars, List.mem_append]; right; exact h_mem)
-              have h_per_scope := typeBoundVar_xv_fresh_in_context C Env bty xv xty Env1 h_tbv
-              have h_not_known : xv ∉ TContext.knownVars Env.context := by
-                intro h_kv
-                have : ∀ (types : Maps T.Identifier LTy),
-                    (∀ m, m ∈ types → Map.find? m xv = none) →
-                    xv ∉ TContext.knownVars.go types := by
-                  intro types h_all h_in
-                  induction types with
-                  | nil => simp [TContext.knownVars.go] at h_in
-                  | cons scope rest ih =>
-                    simp [TContext.knownVars.go, List.mem_append] at h_in
-                    rcases h_in with h_key | h_rest
-                    · exact Map.find?_of_not_mem_values scope
-                        (h_all scope (List.mem_cons_self ..)) h_key
-                    · exact ih (fun m hm => h_all m (List.mem_cons_of_mem _ hm)) h_rest
-                exact this _ h_per_scope h_kv
-              exact h_not_known h_in_ctx)
-          (by simp [LTy.isMonoType, LTy.boundVars])
-          (by -- Body typing in substituted context
-              rw [h_ctx_subst_bridge] at h_body_S
-              exact h_body_S)
-          (by -- Trigger typing in substituted context
-              rw [h_ctx_subst_bridge] at h_tr_S
-              exact h_tr_S)
-          (by -- annotation
-              cases bty with
-              | none => exact Or.inl rfl
-              | some bty_val =>
-                right; exact ⟨bty_val, rfl,
-                  (TContext.subst_aliases Env.context S) ▸
-                  AnnotCompat_subst S
-                    (typeBoundVar_AnnotCompat C Env bty_val xv xty Env1 h_tbv h_aw)
-                    (fun a ha => h_aw a ha)⟩)
-        simp at h_tquant
-        exact h_tquant
-  | .ite m c t e =>
-    -- resolveAux recurses on c, t, e, then unifies [(cty, bool), (tty, ety)].
-    -- Result type is tty (the then-branch type), and the HasType rule is `tif`.
-    intro et C Env Env' h h_envwf h_ne h_fwf h_ws
+              right; exact ⟨bty_val, rfl,
+                (TContext.subst_aliases Env.context S) ▸
+                AnnotCompat_subst S
+                  (typeBoundVar_AnnotCompat C Env bty_val xv xty Env1 h_tbv h_aw)
+                  (fun a ha => h_aw a ha)⟩)
+      simp at h_tquant
+      exact h_tquant
+  case h_eq =>
+    intro m e1 e2 et C Env Env' e1t Env1 e2t Env2 substInfo
+      h_res h_res1 h_res2 h_unify h_et h_subeq h_abs1 h_abs2 h_envwf h_ne h_fwf
+      h_envwf1 h_ctx1 h_envwf2 h_ctx2 h_ih1 h_ih2 h_ws
     have h_aw := h_envwf.aliasesWF
-    simp only [resolveAux, Bind.bind, Except.bind, Except.mapError] at h
-    -- Decompose: resolveAux C Env c
-    split at h
-    · simp at h
-    · rename_i v1 h_res_c
-      obtain ⟨ct, Env1⟩ := v1
-      dsimp at h h_res_c
-      -- Decompose: resolveAux C Env1 t
-      split at h
-      · simp at h
-      · rename_i v2 h_res_t
-        obtain ⟨tht, Env2⟩ := v2
-        dsimp at h h_res_t
-        -- Decompose: resolveAux C Env2 e
-        split at h
-        · simp at h
-        · rename_i v3 h_res_e
-          obtain ⟨elt, Env3⟩ := v3
-          dsimp at h h_res_e
-          -- Decompose: Constraints.unify (wrapped in mapError)
-          split at h
-          · simp at h
-          · rename_i v4 h_mapError
-            simp at h
-            obtain ⟨h_et, h_env'⟩ := h
-            -- Extract the underlying unify hypothesis from the mapError wrapper
-            have h_unify := unify_of_mapError h_mapError
-            -- IHs from recursive calls (using strong induction)
-            have ih_c := ih_sub c (by expr_size h_sz)
-            have ih_t := ih_sub t (by expr_size h_sz)
-            have ih_e := ih_sub e (by expr_size h_sz)
-            have ⟨h_ctx1, h_ty_c⟩ := ih_c ct C Env Env1 h_res_c h_envwf h_ne h_fwf (by intro x hx; apply h_ws; simp only [WellScoped, LExpr.freeVars] at h_ws ⊢; exact List.mem_append_left _ (List.mem_append_left _ hx))
-            have h_ne1 := h_ctx1 ▸ h_ne
-            -- (h_sf1 removed: keysFresh no longer in TEnvWF)
-            -- Build TEnvWF for Env1
-            have h_envwf1 := TEnvWF.of_resolveAux c ct C Env Env1 h_res_c h_envwf h_ne h_fwf h_ctx1
-            have ⟨h_ctx2, h_ty_t⟩ := ih_t tht C Env1 Env2 h_res_t h_envwf1 h_ne1 h_fwf (by rw [h_ctx1]; intro x hx; apply h_ws; simp only [LExpr.freeVars]; exact List.mem_append_left _ (List.mem_append_right _ hx))
-            have h_ne2 := h_ctx2 ▸ h_ne1
-            -- Build TEnvWF for Env2
-            have h_envwf2 := TEnvWF.of_resolveAux t tht C Env1 Env2 h_res_t h_envwf1 h_ne1 h_fwf h_ctx2
-            have ⟨h_ctx3, h_ty_e⟩ := ih_e elt C Env2 Env3 h_res_e h_envwf2 h_ne2 h_fwf (by rw [h_ctx2, h_ctx1]; intro x hx; apply h_ws; simp only [LExpr.freeVars]; exact List.mem_append_right _ hx)
-            -- Absorption chain: v4 absorbs Env3 absorbs Env2 absorbs Env1 absorbs Env
-            have h_abs_v4_Env3 := Constraints.unify_absorbs
-              [(ct.toLMonoTy, LMonoTy.bool), (tht.toLMonoTy, elt.toLMonoTy)]
-              Env3.stateSubstInfo v4 h_unify
-            have h_ne3 := h_ctx3 ▸ h_ne2
-            have props_c := resolveAux_properties c ct C Env Env1 h_res_c h_ne h_aw h_fwf h_envwf.substFreshForGen h_envwf.ctxFreshForGen h_envwf.boundVarsFresh
-            have props_t := resolveAux_properties t tht C Env1 Env2 h_res_t h_ne1 h_envwf1.aliasesWF h_fwf h_envwf1.substFreshForGen h_envwf1.ctxFreshForGen h_envwf1.boundVarsFresh
-            have props_e := resolveAux_properties e elt C Env2 Env3 h_res_e h_ne2 h_envwf2.aliasesWF h_fwf h_envwf2.substFreshForGen h_envwf2.ctxFreshForGen h_envwf2.boundVarsFresh
-            have h_abs_Env3_Env2 := props_e.absorbs
-            have h_abs_Env2_Env1 := props_t.absorbs
-            have h_abs_Env1_Env := props_c.absorbs
-            have h_abs_v4_Env2 := Subst.absorbs_trans
-              Env2.stateSubstInfo.subst Env3.stateSubstInfo.subst v4.subst
-              h_abs_Env3_Env2 h_abs_v4_Env3
-            have h_abs_v4_Env1 := Subst.absorbs_trans
-              Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst v4.subst
-              h_abs_Env2_Env1 h_abs_v4_Env2
-            constructor
-            · -- Context preservation
-              rw [← h_env']
-              simp [TEnv.updateSubst, TEnv.context]
-              change Env3.context = Env.context
-              rw [h_ctx3, h_ctx2, h_ctx1]
-            · -- Typing under arbitrary absorbing S
-              intro S h_abs_S h_wf_S h_poly_fresh
-              rw [← h_et]; simp [toLMonoTy]
-              -- Goal: HasType C Γ (.ite m c t e) (.forAll [] (subst S tht.toLMonoTy))
-              -- We need: S absorbs Env1.subst, Env2.subst, Env3.subst
-              -- Derive absorbs S v4.subst from h_abs_S (Env'.subst = v4.subst)
-              have h_abs_S_v4 : Subst.absorbs S v4.subst := by
-                rw [← h_env'] at h_abs_S
-                simp [TEnv.updateSubst] at h_abs_S
-                exact h_abs_S
-              have h_abs_S_Env1 : Subst.absorbs S Env1.stateSubstInfo.subst :=
-                Subst.absorbs_trans
-                  Env1.stateSubstInfo.subst v4.subst S h_abs_v4_Env1 h_abs_S_v4
-              have h_abs_S_Env2 : Subst.absorbs S Env2.stateSubstInfo.subst :=
-                Subst.absorbs_trans
-                  Env2.stateSubstInfo.subst v4.subst S h_abs_v4_Env2 h_abs_S_v4
-              have h_abs_S_Env3 : Subst.absorbs S Env3.stateSubstInfo.subst :=
-                Subst.absorbs_trans
-                  Env3.stateSubstInfo.subst v4.subst S h_abs_v4_Env3 h_abs_S_v4
-              have h_ty_c_S := h_ty_c S h_abs_S_Env1 h_wf_S h_poly_fresh
-              rw [h_ctx1] at h_ty_t
-              have h_ty_t_S := h_ty_t S h_abs_S_Env2 h_wf_S h_poly_fresh
-              rw [h_ctx2, h_ctx1] at h_ty_e
-              have h_ty_e_S := h_ty_e S h_abs_S_Env3 h_wf_S h_poly_fresh
-              -- Unification makes: subst v4 cty = bool, subst v4 tty = subst v4 ety
-              have ⟨h_eq_bool, h_eq_te⟩ := unify_makes_equal₂
-                ct.toLMonoTy LMonoTy.bool tht.toLMonoTy elt.toLMonoTy
-                Env3.stateSubstInfo v4 h_unify
-              -- Apply subst S to unification equalities and use absorption
-              -- subst S ct.toLMonoTy = subst S bool = bool (ground type)
-              have h_eq_bool_S : LMonoTy.subst S ct.toLMonoTy = LMonoTy.bool := by
-                have h := congrArg (LMonoTy.subst S) h_eq_bool
-                rw [LMonoTy.subst_absorbs S v4.subst _ h_abs_S_v4,
-                    LMonoTy.subst_absorbs S v4.subst _ h_abs_S_v4,
-                    LMonoTy.subst_bool] at h
-                exact h
-              -- subst S tht.toLMonoTy = subst S elt.toLMonoTy
-              have h_eq_te_S : LMonoTy.subst S tht.toLMonoTy = LMonoTy.subst S elt.toLMonoTy := by
-                have h := congrArg (LMonoTy.subst S) h_eq_te
-                rw [LMonoTy.subst_absorbs S v4.subst _ h_abs_S_v4,
-                    LMonoTy.subst_absorbs S v4.subst _ h_abs_S_v4] at h
-                exact h
-              -- Condition has type bool
-              rw [h_eq_bool_S] at h_ty_c_S
-              -- Then and else branches have the same type
-              rw [← h_eq_te_S] at h_ty_e_S
-              exact HasType.tif (Env.context.subst S) m c t e
-                (.forAll [] (LMonoTy.subst S tht.toLMonoTy))
-                h_ty_c_S h_ty_t_S h_ty_e_S
-  | .eq m e1 e2 =>
-    -- resolveAux recurses on e1 and e2, then unifies their types.
-    -- Result type is LMonoTy.bool (ground), so subst S bool = bool for any S.
-    -- We upgrade both IHs to the final substitution via absorption.
-    intro et C Env Env' h h_envwf h_ne h_fwf h_ws
+    have h_ne1 := h_ctx1 ▸ h_ne
+    have h_ws1 : WellScoped e1 Env.context :=
+      fun x hx => h_ws x (by simp [LExpr.freeVars, List.mem_append]; left; exact hx)
+    have ⟨_, h_ty1⟩ := h_ih1 h_ws1
+    have h_ws2 : WellScoped e2 Env1.context := by
+      rw [h_ctx1]; intro x hx; exact h_ws x (by simp [LExpr.freeVars, List.mem_append]; right; exact hx)
+    have ⟨_, h_ty2⟩ := h_ih2 h_ws2
+    subst h_et
+    constructor
+    · -- Context preservation
+      exact (resolveAux_properties (.eq m e1 e2) _ C Env Env' h_res h_ne h_aw h_fwf
+        h_envwf.substFreshForGen h_envwf.ctxFreshForGen h_envwf.boundVarsFresh).context
+    · intro S h_abs_S h_wf_S h_poly_fresh
+      simp [toLMonoTy]
+      rw [LMonoTy.subst_bool]
+      rw [h_subeq] at h_abs_S
+      have h_abs_unify := Constraints.unify_absorbs [(e1t.toLMonoTy, e2t.toLMonoTy)]
+        Env2.stateSubstInfo substInfo h_unify
+      have h_abs_S_Env2 : Subst.absorbs S Env2.stateSubstInfo.subst :=
+        Subst.absorbs_trans Env2.stateSubstInfo.subst substInfo.subst S h_abs_unify h_abs_S
+      have h_abs_S_Env1 : Subst.absorbs S Env1.stateSubstInfo.subst :=
+        Subst.absorbs_trans Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst S h_abs2 h_abs_S_Env2
+      have h_ty1_S := h_ty1 S h_abs_S_Env1 h_wf_S h_poly_fresh
+      rw [h_ctx1] at h_ty2
+      have h_ty2_S := h_ty2 S h_abs_S_Env2 h_wf_S h_poly_fresh
+      have h_eq := unify_makes_equal e1t.toLMonoTy e2t.toLMonoTy
+        Env2.stateSubstInfo substInfo h_unify
+      have h_eq_S : LMonoTy.subst S e1t.toLMonoTy = LMonoTy.subst S e2t.toLMonoTy := by
+        have h := congrArg (LMonoTy.subst S) h_eq
+        rw [LMonoTy.subst_absorbs S substInfo.subst _ h_abs_S,
+            LMonoTy.subst_absorbs S substInfo.subst _ h_abs_S] at h
+        exact h
+      rw [h_eq_S] at h_ty1_S
+      exact HasType.teq (Env.context.subst S) m e1 e2
+        (.forAll [] (LMonoTy.subst S e2t.toLMonoTy))
+        h_ty1_S h_ty2_S
+  case h_ite =>
+    intro m c t e et C Env Env' ct Env1 tht Env2 elt Env3 substInfo
+      h_res h_res_c h_res_t h_res_e h_unify h_et h_subeq h_abs_th2 h_abs_el3 h_envwf h_ne h_fwf
+      h_envwf1 h_ctx1 h_envwf2 h_ctx2 h_envwf3 h_ctx3 h_ih_c h_ih_t h_ih_e h_ws
     have h_aw := h_envwf.aliasesWF
-    simp only [resolveAux, Bind.bind, Except.bind, Except.mapError] at h
-    -- Decompose: resolveAux C Env e1
-    split at h
-    · simp at h
-    · rename_i v1 h_res1
-      obtain ⟨e1t, Env1⟩ := v1
-      dsimp at h h_res1
-      -- Decompose: resolveAux C Env1 e2
-      split at h
-      · simp at h
-      · rename_i v2 h_res2
-        obtain ⟨e2t, Env2⟩ := v2
-        dsimp at h h_res2
-        -- Decompose: Constraints.unify (wrapped in mapError)
-        split at h
-        · simp at h
-        · rename_i v3 h_mapError
-          simp at h
-          obtain ⟨h_et, h_env'⟩ := h
-          -- Extract the underlying unify hypothesis from the mapError wrapper
-          have h_unify := unify_of_mapError h_mapError
-          -- IHs from recursive calls (using strong induction)
-          have ih1 := ih_sub e1 (by expr_size h_sz)
-          have ih2 := ih_sub e2 (by expr_size h_sz)
-          have ⟨h_ctx1, h_ty1⟩ := ih1 e1t C Env Env1 h_res1 h_envwf h_ne h_fwf (fun x hx => h_ws x (by simp [LExpr.freeVars, List.mem_append]; left; exact hx))
-          have h_ne1 := h_ctx1 ▸ h_ne
-          -- (h_sf1 removed: keysFresh no longer in TEnvWF)
-          -- Build TEnvWF for Env1
-          have h_envwf1 := TEnvWF.of_resolveAux e1 e1t C Env Env1 h_res1 h_envwf h_ne h_fwf h_ctx1
-          have ⟨h_ctx2, h_ty2⟩ := ih2 e2t C Env1 Env2 h_res2 h_envwf1 h_ne1 h_fwf (by rw [h_ctx1]; intro x hx; exact h_ws x (by simp [LExpr.freeVars, List.mem_append]; right; exact hx))
-          -- Absorption chain: v3 absorbs Env2 absorbs Env1 absorbs Env
-          have h_abs_v3_Env2 := Constraints.unify_absorbs [(e1t.toLMonoTy, e2t.toLMonoTy)]
-            Env2.stateSubstInfo v3 h_unify
-          have props1 := resolveAux_properties e1 e1t C Env Env1 h_res1 h_ne h_aw h_fwf h_envwf.substFreshForGen h_envwf.ctxFreshForGen h_envwf.boundVarsFresh
-          have props2 := resolveAux_properties e2 e2t C Env1 Env2 h_res2 h_ne1 h_envwf1.aliasesWF h_fwf h_envwf1.substFreshForGen h_envwf1.ctxFreshForGen h_envwf1.boundVarsFresh
-          have h_abs_Env2_Env1 := props2.absorbs
-          have h_abs_Env1_Env := props1.absorbs
-          have h_abs_v3_Env1 := Subst.absorbs_trans
-            Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst v3.subst
-            h_abs_Env2_Env1 h_abs_v3_Env2
-          constructor
-          · -- Context preservation
-            rw [← h_env']
-            simp [TEnv.updateSubst, TEnv.context]
-            change Env2.context = Env.context
-            rw [h_ctx2, h_ctx1]
-          · -- Typing under arbitrary absorbing S
-            intro S h_abs_S h_wf_S h_poly_fresh
-            rw [← h_et]; simp [toLMonoTy]
-            rw [LMonoTy.subst_bool]
-            -- Env'.subst = v3.subst, S absorbs v3.subst
-            -- We need: S absorbs Env1.subst, Env2.subst
-            -- Derive absorbs S v3.subst from h_abs_S (Env'.subst = v3.subst)
-            have h_abs_S_v3 : Subst.absorbs S v3.subst := by
-              rw [← h_env'] at h_abs_S
-              simp [TEnv.updateSubst] at h_abs_S
-              exact h_abs_S
-            have h_abs_S_Env1 : Subst.absorbs S Env1.stateSubstInfo.subst :=
-              Subst.absorbs_trans
-                Env1.stateSubstInfo.subst v3.subst S h_abs_v3_Env1 h_abs_S_v3
-            have h_abs_S_Env2 : Subst.absorbs S Env2.stateSubstInfo.subst :=
-              Subst.absorbs_trans
-                Env2.stateSubstInfo.subst v3.subst S h_abs_v3_Env2 h_abs_S_v3
-            have h_ty1_S := h_ty1 S h_abs_S_Env1 h_wf_S h_poly_fresh
-            rw [h_ctx1] at h_ty2
-            have h_ty2_S := h_ty2 S h_abs_S_Env2 h_wf_S h_poly_fresh
-            -- Unification makes types equal under v3.subst
-            have h_eq := unify_makes_equal e1t.toLMonoTy e2t.toLMonoTy
-              Env2.stateSubstInfo v3 h_unify
-            -- Apply subst S to unification equality and use absorption
-            have h_eq_S : LMonoTy.subst S e1t.toLMonoTy = LMonoTy.subst S e2t.toLMonoTy := by
-              have h := congrArg (LMonoTy.subst S) h_eq
-              rw [LMonoTy.subst_absorbs S v3.subst _ h_abs_S_v3,
-                  LMonoTy.subst_absorbs S v3.subst _ h_abs_S_v3] at h
-              exact h
-            rw [h_eq_S] at h_ty1_S
-            exact HasType.teq (Env.context.subst S) m e1 e2
-              (.forAll [] (LMonoTy.subst S e2t.toLMonoTy))
-              h_ty1_S h_ty2_S
+    have h_ne1 := h_ctx1 ▸ h_ne
+    have h_ws_c : WellScoped c Env.context := by
+      intro x hx; apply h_ws; simp only [WellScoped, LExpr.freeVars] at h_ws ⊢
+      exact List.mem_append_left _ (List.mem_append_left _ hx)
+    have ⟨_, h_ty_c⟩ := h_ih_c h_ws_c
+    have h_ws_t : WellScoped t Env1.context := by
+      rw [h_ctx1]; intro x hx; apply h_ws; simp only [LExpr.freeVars]
+      exact List.mem_append_left _ (List.mem_append_right _ hx)
+    have ⟨_, h_ty_t⟩ := h_ih_t h_ws_t
+    have h_ws_e : WellScoped e Env2.context := by
+      rw [h_ctx2]; intro x hx; apply h_ws; simp only [LExpr.freeVars]
+      exact List.mem_append_right _ hx
+    have ⟨_, h_ty_e⟩ := h_ih_e h_ws_e
+    subst h_et
+    constructor
+    · -- Context preservation
+      exact (resolveAux_properties (.ite m c t e) _ C Env Env' h_res h_ne h_aw h_fwf
+        h_envwf.substFreshForGen h_envwf.ctxFreshForGen h_envwf.boundVarsFresh).context
+    · intro S h_abs_S h_wf_S h_poly_fresh
+      simp [toLMonoTy]
+      rw [h_subeq] at h_abs_S
+      have h_abs_unify := Constraints.unify_absorbs
+        [(ct.toLMonoTy, LMonoTy.bool), (tht.toLMonoTy, elt.toLMonoTy)]
+        Env3.stateSubstInfo substInfo h_unify
+      have h_abs_S_Env3 : Subst.absorbs S Env3.stateSubstInfo.subst :=
+        Subst.absorbs_trans Env3.stateSubstInfo.subst substInfo.subst S h_abs_unify h_abs_S
+      have h_abs_S_Env2 : Subst.absorbs S Env2.stateSubstInfo.subst :=
+        Subst.absorbs_trans Env2.stateSubstInfo.subst Env3.stateSubstInfo.subst S h_abs_el3 h_abs_S_Env3
+      have h_abs_S_Env1 : Subst.absorbs S Env1.stateSubstInfo.subst :=
+        Subst.absorbs_trans Env1.stateSubstInfo.subst Env2.stateSubstInfo.subst S h_abs_th2 h_abs_S_Env2
+      have h_ty_c_S := h_ty_c S h_abs_S_Env1 h_wf_S h_poly_fresh
+      rw [h_ctx1] at h_ty_t
+      have h_ty_t_S := h_ty_t S h_abs_S_Env2 h_wf_S h_poly_fresh
+      rw [h_ctx2] at h_ty_e
+      have h_ty_e_S := h_ty_e S h_abs_S_Env3 h_wf_S h_poly_fresh
+      have ⟨h_eq_bool, h_eq_te⟩ := unify_makes_equal₂
+        ct.toLMonoTy LMonoTy.bool tht.toLMonoTy elt.toLMonoTy
+        Env3.stateSubstInfo substInfo h_unify
+      have h_eq_bool_S : LMonoTy.subst S ct.toLMonoTy = LMonoTy.bool := by
+        have h := congrArg (LMonoTy.subst S) h_eq_bool
+        rw [LMonoTy.subst_absorbs S substInfo.subst _ h_abs_S,
+            LMonoTy.subst_absorbs S substInfo.subst _ h_abs_S,
+            LMonoTy.subst_bool] at h
+        exact h
+      have h_eq_te_S : LMonoTy.subst S tht.toLMonoTy = LMonoTy.subst S elt.toLMonoTy := by
+        have h := congrArg (LMonoTy.subst S) h_eq_te
+        rw [LMonoTy.subst_absorbs S substInfo.subst _ h_abs_S,
+            LMonoTy.subst_absorbs S substInfo.subst _ h_abs_S] at h
+        exact h
+      rw [h_eq_bool_S] at h_ty_c_S
+      rw [← h_eq_te_S] at h_ty_e_S
+      exact HasType.tif (Env.context.subst S) m c t e
+        (.forAll [] (LMonoTy.subst S tht.toLMonoTy))
+        h_ty_c_S h_ty_t_S h_ty_e_S
 
 omit [ToString T.IDMeta] [ToFormat T.IDMeta] [HasGen T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
 /-- `HasType` transfers from `{types := [[]], aliases}` to `{types := [], aliases}`.
@@ -6866,8 +6810,8 @@ private theorem ctx_closed_of_check (Env : TEnv T.IDMeta)
   -- Maps.find? returns a type from some scope. That type passes the check.
   intro y ty h_find
   -- Walk the scopes to find where find? matched
-  have : Env.context.types = Env.genEnv.context.types := rfl
-  rw [this] at h_find
+  have h_types_eq : Env.context.types = Env.genEnv.context.types := rfl
+  rw [h_types_eq] at h_find
   simp only [LExpr.checkContextTypesClosed, TEnv.context] at h
   exact go Env.genEnv.context.types h h_find
 where
@@ -6926,6 +6870,135 @@ theorem Subst.allKeysFresh_of_ctx_closed
   simp [h_ctx_closed x ty hf]
 
 
+/-- Core resolve soundness: if `LExpr.resolve` succeeds, the result is well-typed
+    (universally over absorbing substitutions), idempotent, and preserves `TEnvWF`.
+    No `checkContextTypesClosed` or `allKeysFresh` preconditions needed. -/
+theorem resolve_HasType_core :
+    ∀ (e : LExpr T.mono) (e_typed : LExprT T.mono) (C : LContext T)
+      (Env : TEnv T.IDMeta) Env',
+      e.resolve C Env = .ok ⟨e_typed, Env'⟩ →
+      TEnvWF Env →
+      FactoryWF C.functions →
+      WellScoped e Env.context →
+      (∀ S, Subst.absorbs S Env'.stateSubstInfo.subst → SubstWF S →
+        Subst.polyKeysFresh (T := T) S Env.context →
+        HasType C (TContext.subst Env.context S) e (.forAll [] (LMonoTy.subst S e_typed.toLMonoTy))) ∧
+      LMonoTy.subst Env'.stateSubstInfo.subst e_typed.toLMonoTy = e_typed.toLMonoTy ∧
+      TEnvWF Env' := by
+  intro e e_typed C Env Env' h h_envwf h_fwf h_ws
+  unfold LExpr.resolve at h
+  simp only [Bind.bind, Except.bind] at h
+  cases h_types : Env.context.types with
+  | nil =>
+    simp [Maps.isEmpty, h_types] at h
+    elim_err h
+    rename_i v h_aux
+    obtain ⟨et, Env'⟩ := v
+    simp at h
+    obtain ⟨h_typed, h_env'⟩ := h
+    let Env_upd := Env.updateContext { Env.context with types := [[]] }
+    have h_upd_ne : Env_upd.context.types ≠ [] := List.cons_ne_nil _ _
+    have h_envwf_upd : TEnvWF Env_upd := {
+      aliasesWF := by simp [Env_upd, TEnv.updateContext, TEnv.context]; exact h_envwf.aliasesWF
+      substFreshForGen := by simp [Env_upd, TEnv.updateContext]; exact h_envwf.substFreshForGen
+      ctxFreshForGen := by
+        simp only [Env_upd, TEnv.updateContext, TEnv.context, ContextFreshForGen, TContext.knownTypeVars]
+        intro v hv
+        simp [TContext.types.knownTypeVars, TContext.types.knownTypeVars.go] at hv
+      boundVarsNodup := by
+        intro y ty h_f; simp only [Env_upd, TEnv.updateContext, TEnv.context] at h_f
+        simp [Maps.find?, Map.find?] at h_f
+      boundVarsFresh := by
+        intro y ty h_f; simp only [Env_upd, TEnv.updateContext, TEnv.context] at h_f
+        simp [Maps.find?, Map.find?] at h_f
+    }
+    have h_ws_upd : WellScoped e Env_upd.context := by
+      have h_kv_eq : Env_upd.context.knownVars = Env.context.knownVars := by
+        simp only [Env_upd, TEnv.updateContext, TEnv.context, TContext.knownVars]
+        simp only [TEnv.context] at h_types
+        rw [h_types]
+        simp [TContext.knownVars.go, Map.keys]
+      unfold WellScoped at h_ws ⊢
+      rw [h_kv_eq]
+      exact h_ws
+    have h_aux' : resolveAux C Env_upd e = .ok (et, Env') := by
+      simp only [Env_upd, TEnv.updateContext] at h_aux ⊢
+      exact h_aux
+    subst h_env'
+    have ⟨h_ctx_upd, h_hastype⟩ := resolveAux_HasType e et C Env_upd Env' h_aux' h_envwf_upd h_upd_ne h_fwf h_ws_upd
+    have h_envwf' := TEnvWF.of_resolveAux e et C Env_upd Env' h_aux' h_envwf_upd h_upd_ne h_fwf h_ctx_upd
+    have h_idem : LMonoTy.subst Env'.stateSubstInfo.subst e_typed.toLMonoTy = e_typed.toLMonoTy := by
+      rw [← h_typed, applySubstT_toLMonoTy]
+      exact LMonoTy.subst_idempotent Env'.stateSubstInfo.subst Env'.stateSubstInfo.isWF (et.toLMonoTy)
+    refine ⟨fun S h_abs h_wf h_pkf => ?_, h_idem, h_envwf'⟩
+    rw [← h_typed, applySubstT_toLMonoTy, LMonoTy.subst_absorbs S Env'.stateSubstInfo.subst _ h_abs]
+    have h_upd_eq : Env_upd.context = { types := [[]], aliases := Env.context.aliases } := by
+      simp [Env_upd, TEnv.updateContext, TEnv.context]
+    have h_pkf_upd : Subst.polyKeysFresh (T := T) S Env_upd.context := by
+      intro a ha x ty hf _
+      simp [Env_upd, TEnv.updateContext, TEnv.context, Maps.find?, Map.find?] at hf
+    have h_ht := h_hastype S h_abs h_wf h_pkf_upd
+    have h_ctx_subst_id : TContext.subst Env.context S = Env.context := by
+      unfold TContext.subst
+      rw [h_types]
+      simp only [TContext.types.subst]
+      exact congrArg (TContext.mk · _) h_types.symm
+    have h_upd_subst_id : TContext.subst Env_upd.context S = Env_upd.context := by
+      simp [Env_upd, TEnv.updateContext, TEnv.context, TContext.subst, TContext.types.subst, TContext.types.subst.go]
+    rw [h_upd_subst_id, h_upd_eq] at h_ht
+    rw [h_ctx_subst_id]
+    have h_result := HasType_transfer_empty_scope C Env.context.aliases e _ h_ht
+    suffices h_ctx_empty : Env.context = { types := [], aliases := Env.context.aliases } by
+      rw [h_ctx_empty]; exact h_result
+    cases h_ctx : Env.context with
+    | mk t a => grind
+  | cons hd tl =>
+    simp [Maps.isEmpty, h_types] at h
+    elim_err h
+    rename_i v h_aux
+    obtain ⟨et, Env'⟩ := v
+    simp at h
+    obtain ⟨h_typed, h_env'⟩ := h
+    subst h_env'
+    have h_ne : Env.context.types ≠ [] := by rw [h_types]; exact List.cons_ne_nil _ _
+    have ⟨h_ctx_pres, h_hastype⟩ := resolveAux_HasType e et C Env Env' h_aux h_envwf h_ne h_fwf h_ws
+    have h_envwf' := TEnvWF.of_resolveAux e et C Env Env' h_aux h_envwf h_ne h_fwf h_ctx_pres
+    have h_idem : LMonoTy.subst Env'.stateSubstInfo.subst e_typed.toLMonoTy = e_typed.toLMonoTy := by
+      rw [← h_typed, applySubstT_toLMonoTy]
+      exact LMonoTy.subst_idempotent Env'.stateSubstInfo.subst Env'.stateSubstInfo.isWF (et.toLMonoTy)
+    refine ⟨fun S h_abs h_wf h_pkf => ?_, h_idem, h_envwf'⟩
+    rw [← h_typed, applySubstT_toLMonoTy]
+    have h_ht := h_hastype S h_abs h_wf h_pkf
+    rw [LMonoTy.subst_absorbs S Env'.stateSubstInfo.subst _ h_abs]
+    exact h_ht
+
+omit [ToString T.IDMeta] [ToFormat (LFunc T)] [ToFormat T.Metadata] in
+theorem resolve_preserves_context
+    (e : LExpr T.mono) (e_typed : LExprT T.mono) (C : LContext T)
+    (Env Env' : TEnv T.IDMeta)
+    (h : e.resolve C Env = .ok ⟨e_typed, Env'⟩)
+    (h_envwf : TEnvWF Env)
+    (h_ne : Env.context.types ≠ [])
+    (h_fwf : FactoryWF C.functions) :
+    Env'.context = Env.context := by
+  unfold LExpr.resolve at h
+  simp only [Bind.bind, Except.bind] at h
+  cases h_types : Env.context.types with
+  | nil => exact absurd h_types h_ne
+  | cons hd tl =>
+    simp [Maps.isEmpty, h_types] at h
+    elim_err h
+    rename_i v h_aux
+    obtain ⟨et, Env_r⟩ := v
+    simp at h
+    obtain ⟨_, h_env'⟩ := h
+    subst h_env'
+    have h_props := resolveAux_properties e et C Env Env_r h_aux
+      (by rw [h_types]; exact List.cons_ne_nil _ _)
+      h_envwf.aliasesWF h_fwf h_envwf.substFreshForGen h_envwf.ctxFreshForGen
+      h_envwf.boundVarsFresh
+    exact h_props.context
+
 /-- Top-level soundness: if `LExpr.resolve` succeeds, the result is well-typed
     and the output environment is well-formed.
 
@@ -6939,6 +7012,12 @@ theorem Subst.allKeysFresh_of_ctx_closed
     (together with `checkContextTypesClosed Env'`, which is also preserved
     since `resolveAux` does not modify the context).
 
+    This builds on `resolve_HasType_core` (which proves the universally-quantified
+    typing conclusion under the minimal preconditions). Here we additionally derive
+    the composability postconditions `checkContextTypesClosed Env'` and
+    `allKeysFresh Env'.subst Env'.context`, then specialize the universal typing
+    conclusion to the final substitution `Env'.stateSubstInfo.subst`.
+
     Note: `resolve` ensures `context.types ≠ []` internally (adding an empty
     scope if needed), so the caller does not need this precondition. -/
 theorem resolve_HasType :
@@ -6955,34 +7034,34 @@ theorem resolve_HasType :
       LExpr.checkContextTypesClosed Env' ∧
       Subst.allKeysFresh Env'.stateSubstInfo.subst Env'.context := by
   intro e e_typed C Env Env' h h_envwf h_fwf h_ws h_all_fresh h_check
-  -- Derive the find?-based closedness from checkContextTypesClosed
+  have ⟨h_ht, h_idem, h_envwf'⟩ := resolve_HasType_core e e_typed C Env Env' h h_envwf h_fwf h_ws
   have h_ctx_closed : ∀ y ty, Env.context.types.find? y = some ty → LTy.freeVars ty = [] :=
     ctx_closed_of_check Env h_check
-  -- Decompose resolve: it ensures types ≠ [] then calls resolveAux
-  unfold LExpr.resolve at h
-  simp only [Bind.bind, Except.bind] at h
-  -- Case-split on whether Env.context.types is [] or nonempty
-  cases h_types : Env.context.types with
-  | nil =>
-    -- types was empty: resolve initialized to [[]]
-    simp [Maps.isEmpty, h_types] at h
-    split at h
-    · simp at h
-    · rename_i v h_aux
+  -- Derive the composability postconditions by unfolding `resolve` (which ensures
+  -- `context.types ≠ []`) and case-splitting on whether the input context was empty.
+  have ⟨h_check', h_fresh'⟩ : LExpr.checkContextTypesClosed Env' ∧
+      Subst.allKeysFresh (T := T) Env'.stateSubstInfo.subst Env'.context := by
+    unfold LExpr.resolve at h
+    simp only [Bind.bind, Except.bind] at h
+    cases h_types : Env.context.types with
+    | nil =>
+      simp [Maps.isEmpty, h_types] at h
+      elim_err h
+      rename_i v h_aux
       obtain ⟨et, Env'⟩ := v
       simp at h
       obtain ⟨h_typed, h_env'⟩ := h
-      -- resolveAux was called on Env with types replaced by [[]]
-      -- Build TEnvWF for the updated env
+      subst h_env'
       let Env_upd := Env.updateContext { Env.context with types := [[]] }
+      have h_aux' : resolveAux C Env_upd e = .ok (et, Env') := by
+        simp only [Env_upd, TEnv.updateContext] at h_aux ⊢; exact h_aux
       have h_upd_ne : Env_upd.context.types ≠ [] := List.cons_ne_nil _ _
       have h_envwf_upd : TEnvWF Env_upd := {
         aliasesWF := by simp [Env_upd, TEnv.updateContext, TEnv.context]; exact h_envwf.aliasesWF
         substFreshForGen := by simp [Env_upd, TEnv.updateContext]; exact h_envwf.substFreshForGen
         ctxFreshForGen := by
           simp only [Env_upd, TEnv.updateContext, TEnv.context, ContextFreshForGen, TContext.knownTypeVars]
-          intro v hv
-          simp [TContext.types.knownTypeVars, TContext.types.knownTypeVars.go] at hv
+          intro v hv; simp [TContext.types.knownTypeVars, TContext.types.knownTypeVars.go] at hv
         boundVarsNodup := by
           intro y ty h_f; simp only [Env_upd, TEnv.updateContext, TEnv.context] at h_f
           simp [Maps.find?, Map.find?] at h_f
@@ -6990,92 +7069,47 @@ theorem resolve_HasType :
           intro y ty h_f; simp only [Env_upd, TEnv.updateContext, TEnv.context] at h_f
           simp [Maps.find?, Map.find?] at h_f
       }
-      -- WellScoped transfers: both [] and [[]] have knownVars = []
       have h_ws_upd : WellScoped e Env_upd.context := by
-        -- h_ws : WellScoped e Env.context where Env.context.types = []
-        -- Goal: WellScoped e Env_upd.context where Env_upd.context.types = [[]]
-        -- WellScoped says all fvars ∈ knownVars. knownVars collects keys from types.
-        -- Both [] and [[]] have the same keys (none), so knownVars is the same.
         have h_kv_eq : Env_upd.context.knownVars = Env.context.knownVars := by
           simp only [Env_upd, TEnv.updateContext, TEnv.context, TContext.knownVars]
-          simp only [TEnv.context] at h_types
-          rw [h_types]
+          simp only [TEnv.context] at h_types; rw [h_types]
           simp [TContext.knownVars.go, Map.keys]
-        unfold WellScoped at h_ws ⊢
-        rw [h_kv_eq]
-        exact h_ws
-      have h_aux' : resolveAux C Env_upd e = .ok (et, Env') := by
-        simp only [Env_upd, TEnv.updateContext] at h_aux ⊢
-        exact h_aux
-      subst h_env'
-      have ⟨h_ctx_upd, h_hastype⟩ := resolveAux_HasType e et C Env_upd Env' h_aux' h_envwf_upd h_upd_ne h_fwf h_ws_upd
-      have h_envwf' := TEnvWF.of_resolveAux e et C Env_upd Env' h_aux' h_envwf_upd h_upd_ne h_fwf h_ctx_upd
-      rw [← h_typed, applySubstT_toLMonoTy]
-      -- Env.context.subst S = Env.context since types = []
-      have h_ctx_subst_id : TContext.subst Env.context Env'.stateSubstInfo.subst = Env.context := by
-        unfold TContext.subst
-        rw [h_types]
-        simp only [TContext.types.subst]
-        exact congrArg (TContext.mk · _) h_types.symm
-      -- Env_upd.context.subst S = Env_upd.context since types = [[]]
-      have h_upd_subst_id : TContext.subst Env_upd.context Env'.stateSubstInfo.subst = Env_upd.context := by
-        simp [Env_upd, TEnv.updateContext, TEnv.context, TContext.subst, TContext.types.subst, TContext.types.subst.go]
-      exact ⟨by
-        rw [h_ctx_subst_id]
-        have h_upd_eq : Env_upd.context = { types := [[]], aliases := Env.context.aliases } := by
-          simp [Env_upd, TEnv.updateContext, TEnv.context]
-        have h_ht := h_hastype Env'.stateSubstInfo.subst
-          (Subst.absorbs_refl _ Env'.stateSubstInfo.isWF) Env'.stateSubstInfo.isWF
-          (by -- polyKeysFresh holds vacuously: Env_upd.context has types = [[]], so
-              -- find? always returns none (empty scope), making the condition vacuous.
-              intro a _ x ty hf _
-              simp [Env_upd, TEnv.updateContext, TEnv.context, Maps.find?, Map.find?] at hf)
-        rw [h_upd_subst_id, h_upd_eq] at h_ht
-        have h_result := HasType_transfer_empty_scope C Env.context.aliases e _ h_ht
-        suffices Env.context = { types := [], aliases := Env.context.aliases } by
-          rw [this]; exact h_result
-        have h_t : Env.context.types = [] := h_types
-        cases h_ctx : Env.context
-        simp [TEnv.context] at h_t
-        simp_all,
-      h_envwf',
-      -- checkContextTypesClosed for Env': Env'.context = Env_upd.context with types = [[]]
-      by have h_check_upd : LExpr.checkContextTypesClosed Env_upd := by
-           simp [LExpr.checkContextTypesClosed, Env_upd, TEnv.updateContext, TEnv.context]
-         exact checkContextTypesClosed_of_ctx_eq h_check_upd h_ctx_upd,
-      -- allKeysFresh for Env'.subst / Env'.context: from closed types
-      by have h_check_upd : LExpr.checkContextTypesClosed Env_upd := by
-           simp [LExpr.checkContextTypesClosed, Env_upd, TEnv.updateContext, TEnv.context]
-         have h_check' := checkContextTypesClosed_of_ctx_eq h_check_upd h_ctx_upd
-         exact Subst.allKeysFresh_of_ctx_closed (ctx_closed_of_check Env' h_check')⟩
-  | cons hd tl =>
-    -- types was non-empty: resolve passes Env unchanged to resolveAux
-    simp [Maps.isEmpty, h_types] at h
-    split at h
-    · simp at h
-    · rename_i v h_aux
+        unfold WellScoped at h_ws ⊢; rw [h_kv_eq]; exact h_ws
+      have ⟨h_ctx_upd, _⟩ := resolveAux_HasType e et C Env_upd Env' h_aux' h_envwf_upd h_upd_ne h_fwf h_ws_upd
+      have h_check_upd : LExpr.checkContextTypesClosed Env_upd := by
+        simp [LExpr.checkContextTypesClosed, Env_upd, TEnv.updateContext, TEnv.context]
+      have h_check' : LExpr.checkContextTypesClosed Env' :=
+        checkContextTypesClosed_of_ctx_eq h_check_upd h_ctx_upd
+      have h_all_fresh' : Subst.allKeysFresh (T := T) Env'.stateSubstInfo.subst Env'.context := by
+        rw [h_ctx_upd]
+        exact Subst.allKeysFresh_of_ctx_closed (by
+          intro y ty hf
+          simp only [Env_upd, TEnv.updateContext, TEnv.context, Maps.find?] at hf
+          exact absurd hf (by simp [Map.find?]))
+      exact ⟨h_check', h_all_fresh'⟩
+    | cons hd tl =>
+      simp [Maps.isEmpty, h_types] at h
+      elim_err h
+      rename_i v h_aux
       obtain ⟨et, Env'⟩ := v
       simp at h
       obtain ⟨h_typed, h_env'⟩ := h
       subst h_env'
       have h_ne : Env.context.types ≠ [] := by rw [h_types]; exact List.cons_ne_nil _ _
-      have ⟨h_ctx_pres, h_hastype⟩ := resolveAux_HasType e et C Env Env' h_aux h_envwf h_ne h_fwf h_ws
-      have h_envwf' := TEnvWF.of_resolveAux e et C Env Env' h_aux h_envwf h_ne h_fwf h_ctx_pres
-      rw [← h_typed, applySubstT_toLMonoTy]
-      have h_all_fresh' : Subst.allKeysFresh Env'.stateSubstInfo.subst Env.context :=
-        Subst.allKeysFresh_of_ctx_closed h_ctx_closed
-      -- checkContextTypesClosed for Env': context preserved, so types remain closed
+      have ⟨h_ctx_pres, _⟩ := resolveAux_HasType e et C Env Env' h_aux h_envwf h_ne h_fwf h_ws
+      have h_all_fresh' : Subst.allKeysFresh (T := T) Env'.stateSubstInfo.subst Env'.context := by
+        rw [h_ctx_pres]; exact Subst.allKeysFresh_of_ctx_closed h_ctx_closed
       have h_check' : LExpr.checkContextTypesClosed Env' :=
         checkContextTypesClosed_of_ctx_eq h_check h_ctx_pres
-      -- contextTypesClosed for Env' (find?-based, for allKeysFresh)
-      have h_ctx_closed' : ∀ y ty, Env'.context.types.find? y = some ty → LTy.freeVars ty = [] :=
-        ctx_closed_of_check Env' h_check'
-      -- allKeysFresh for Env'.subst / Env'.context: from closed types
-      have h_all_fresh_out : Subst.allKeysFresh Env'.stateSubstInfo.subst Env'.context :=
-        Subst.allKeysFresh_of_ctx_closed h_ctx_closed'
-      exact ⟨h_hastype Env'.stateSubstInfo.subst (Subst.absorbs_refl _ Env'.stateSubstInfo.isWF) Env'.stateSubstInfo.isWF
-        (Subst.allKeysFresh_implies_polyKeysFresh _ _ h_all_fresh'),
-        h_envwf', h_check', h_all_fresh_out⟩
+      exact ⟨h_check', h_all_fresh'⟩
+  refine ⟨?_, h_envwf', h_check', h_fresh'⟩
+  have h_akf : Subst.allKeysFresh (T := T) Env'.stateSubstInfo.subst Env.context :=
+    Subst.allKeysFresh_of_ctx_closed h_ctx_closed
+  have h_hastype := h_ht Env'.stateSubstInfo.subst (Subst.absorbs_refl _ Env'.stateSubstInfo.isWF)
+    Env'.stateSubstInfo.isWF
+    (Subst.allKeysFresh_implies_polyKeysFresh _ _ h_akf)
+  rw [h_idem] at h_hastype
+  exact h_hastype
 
 end Proofs
 
diff --git a/Strata/DL/Lambda/LTy.lean b/Strata/DL/Lambda/LTy.lean
index f44bd3eac2..3ce80250e6 100644
--- a/Strata/DL/Lambda/LTy.lean
+++ b/Strata/DL/Lambda/LTy.lean
@@ -374,6 +374,42 @@ theorem LMonoTys.freeVars_exists
     | inl h => exact ⟨ty, .head _, h⟩
     | inr h => obtain ⟨t, ht, htv⟩ := ih h; exact ⟨t, .tail _ ht, htv⟩
 
+/--
+Check if two monotypes are alpha-equivalent (equal up to consistent renaming of
+free type variables). Returns the backward mapping (ty2 vars → ty1 vars) on
+success, used to rename body annotations back to the declared type parameter names.
+-/
+def LMonoTy.alphaEquivMap (ty1 ty2 : LMonoTy) :
+    Option (Std.HashMap TyIdentifier TyIdentifier) :=
+  (go ty1 ty2 {} {}).map (·.2)
+where
+  go (t1 t2 : LMonoTy) (fwd : Std.HashMap TyIdentifier TyIdentifier)
+     (bwd : Std.HashMap TyIdentifier TyIdentifier) :
+     Option (Std.HashMap TyIdentifier TyIdentifier × Std.HashMap TyIdentifier TyIdentifier) :=
+    match t1, t2 with
+    | .ftvar x, .ftvar y =>
+      match fwd[x]? with
+      | some y' => if y' == y then some (fwd, bwd) else none
+      | none =>
+        match bwd[y]? with
+        | some x' => if x' == x then some (fwd, bwd) else none
+        | none => some (fwd.insert x y, bwd.insert y x)
+    | .bitvec n, .bitvec m => if n == m then some (fwd, bwd) else none
+    | .tcons n1 args1, .tcons n2 args2 =>
+      if n1 != n2 then none
+      else goList args1 args2 fwd bwd
+    | _, _ => none
+  goList (ts1 ts2 : List LMonoTy) (fwd : Std.HashMap TyIdentifier TyIdentifier)
+     (bwd : Std.HashMap TyIdentifier TyIdentifier) :
+     Option (Std.HashMap TyIdentifier TyIdentifier × Std.HashMap TyIdentifier TyIdentifier) :=
+    match ts1, ts2 with
+    | [], [] => some (fwd, bwd)
+    | t1 :: rest1, t2 :: rest2 =>
+      match go t1 t2 fwd bwd with
+      | some (fwd', bwd') => goList rest1 rest2 fwd' bwd'
+      | none => none
+    | _, _ => none
+
 /--
 Get all type constructors in monotype `mty`.
 -/
diff --git a/Strata/DL/Lambda/LTyUnify.lean b/Strata/DL/Lambda/LTyUnify.lean
index 314fd21cfb..a197abf4cf 100644
--- a/Strata/DL/Lambda/LTyUnify.lean
+++ b/Strata/DL/Lambda/LTyUnify.lean
@@ -1526,832 +1526,6 @@ def Constraints.unify (constraints : Constraints) (S : SubstInfo) :
     let relS ← Constraints.unifyCore constraints S
     .ok relS.newS
 
-/-- A key in a well-formed substitution does not appear in its own image. -/
-theorem SubstWF.not_mem_freeVars_of_find (S : Subst) (a : TyIdentifier) (t : LMonoTy)
-    (h_find : Maps.find? S a = some t) (h_wf : SubstWF S) :
-    a ∉ LMonoTy.freeVars t := by
-  simp [SubstWF] at h_wf
-  have h_key := Maps.find?_mem_keys S h_find
-  have h_fv_subset := Subst.freeVars_of_find_subset S h_find
-  grind
-
-/-- Absorption for type lists: the single substitution is absorbed element-wise. -/
-theorem LMonoTys.subst_absorbs_single (S : Subst) (a : TyIdentifier) (t : LMonoTy)
-    (mtys : LMonoTys)
-    (hS : Subst.hasEmptyScopes S = false)
-    (hSingle : Subst.hasEmptyScopes [[(a, t)]] = false)
-    (ih : ∀ m, m ∈ mtys → LMonoTy.subst S (LMonoTy.subst [[(a, t)]] m) = LMonoTy.subst S m) :
-    LMonoTys.subst S (LMonoTys.subst [[(a, t)]] mtys) = LMonoTys.subst S mtys := by
-  rw [LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic]
-  induction mtys with
-  | nil => simp [LMonoTys.substLogic, hS, hSingle]
-  | cons m rest ih_rest =>
-    simp only [LMonoTys.substLogic, hS, hSingle, Bool.false_eq_true, ↓reduceIte]
-    grind
-
-/--
-#### Absorption: relating substitutions produced by successive resolveAux calls
-
-Absorption: `subst S (subst [(a,t)] mty) = subst S mty` when `Maps.find? S a = some t`
-and `SubstWF S`. The single-variable substitution `[(a,t)]` is "absorbed" by `S`
-because `S` already maps `a` to `t`.
--/
-theorem LMonoTy.subst_absorbs_single (S : Subst) (a : TyIdentifier) (t : LMonoTy)
-    (mty : LMonoTy) (h_find : Maps.find? S a = some t) (h_wf : SubstWF S) :
-    LMonoTy.subst S (LMonoTy.subst [[(a, t)]] mty) = LMonoTy.subst S mty := by
-  have hS : Subst.hasEmptyScopes S = false :=
-    Subst.hasEmptyScopes_false_of_find S a t h_find
-  have hSingle : Subst.hasEmptyScopes [[(a, t)]] = false := by
-    simp [Subst.hasEmptyScopes, Map.isEmpty]
-  induction mty with
-  | ftvar x =>
-    by_cases h_eq : a = x
-    · -- x = a: inner subst gives t, then subst S t = t = subst S (ftvar a)
-      subst h_eq
-      have h_inner : LMonoTy.subst [[(a, t)]] (.ftvar a) = t := by
-        simp [LMonoTy.subst, Subst.hasEmptyScopes, Map.isEmpty, Maps.find?, Map.find?]
-      rw [h_inner]
-      simp [LMonoTy.subst, hS, h_find]
-      exact LMonoTy.subst_idempotent_value S a t h_find h_wf
-    · -- x ≠ a: inner subst is identity
-      have h_inner : LMonoTy.subst [[(a, t)]] (.ftvar x) = .ftvar x := by
-        simp [LMonoTy.subst, Subst.hasEmptyScopes, Map.isEmpty, Maps.find?, Map.find?, h_eq]
-      rw [h_inner]
-  | bitvec n =>
-    simp [LMonoTy.subst]
-  | tcons name args ih =>
-    simp only [LMonoTy.subst, hSingle, hS, Bool.false_eq_true, ↓reduceIte]
-    congr 1
-    exact LMonoTys.subst_absorbs_single S a t args hS hSingle ih
-
-/-!
-When `resolveAux` processes subexpressions, each call extends the substitution.
-The key property is that later substitutions "absorb" earlier ones: applying the
-outer substitution after the inner one is the same as applying the outer alone.
-
-This lets us upgrade typing judgments from an inner substitution to the final one.
--/
-
-/--
-`S_outer` absorbs `S_inner` means: for every binding `a ↦ t` in `S_inner`,
-`subst S_outer t = subst S_outer (ftvar a)`. In other words, `S_outer` already
-"knows about" every binding in `S_inner`.
--/
-def Subst.absorbs (S_outer S_inner : Subst) : Prop :=
-  ∀ a t, Maps.find? S_inner a = some t →
-    LMonoTy.subst S_outer t = LMonoTy.subst S_outer (.ftvar a)
-
-/--
-Absorption implies substitution composition collapses:
-`subst S_outer (subst S_inner mty) = subst S_outer mty`.
--/
-theorem LMonoTy.subst_absorbs (S_outer S_inner : Subst) (mty : LMonoTy)
-    (h : Subst.absorbs S_outer S_inner) :
-    LMonoTy.subst S_outer (LMonoTy.subst S_inner mty) = LMonoTy.subst S_outer mty := by
-  by_cases h_emptyI : Subst.hasEmptyScopes S_inner
-  · rw [LMonoTy.subst_emptyS h_emptyI]
-  · have hInner : Subst.hasEmptyScopes S_inner = false := by
-      revert h_emptyI; cases Subst.hasEmptyScopes S_inner <;> simp
-    induction mty with
-    | ftvar x =>
-      cases h_find : Maps.find? S_inner x with
-      | none =>
-        have : LMonoTy.subst S_inner (.ftvar x) = .ftvar x := by
-          simp [LMonoTy.subst, hInner, h_find]
-        rw [this]
-      | some t =>
-        have : LMonoTy.subst S_inner (.ftvar x) = t := by
-          simp [LMonoTy.subst, hInner, h_find]
-        rw [this]; exact h x t h_find
-    | bitvec n => simp [LMonoTy.subst]
-    | tcons name args ih =>
-      have h_inner : LMonoTy.subst S_inner (.tcons name args) =
-          .tcons name (LMonoTys.subst S_inner args) := by
-        unfold LMonoTy.subst; simp only [hInner, Bool.false_eq_true, ↓reduceIte]
-      rw [h_inner]
-      by_cases h_emptyO : Subst.hasEmptyScopes S_outer
-      · rw [LMonoTy.subst_emptyS h_emptyO, LMonoTy.subst_emptyS h_emptyO]
-        congr 1
-        rw [LMonoTys.subst_eq_substLogic]
-        suffices ∀ xs, (∀ m, m ∈ xs → LMonoTy.subst S_inner m = m) →
-            LMonoTys.substLogic S_inner xs = xs by
-          exact this args (fun m hm => by
-            have := ih m hm
-            simp only [LMonoTy.subst_emptyS h_emptyO] at this; exact this)
-        intro xs; induction xs with
-        | nil => intro _; simp [LMonoTys.substLogic, hInner]
-        | cons a rest ih_rest =>
-          intro ih_cons
-          simp only [LMonoTys.substLogic, hInner, Bool.false_eq_true, ↓reduceIte]
-          rw [ih_cons a List.mem_cons_self,
-              ih_rest (fun m hm => ih_cons m (List.mem_cons_of_mem a hm))]
-      · have hOuter : Subst.hasEmptyScopes S_outer = false := by
-          revert h_emptyO; cases Subst.hasEmptyScopes S_outer <;> simp
-        have h_l : LMonoTy.subst S_outer (.tcons name (LMonoTys.subst S_inner args)) =
-            .tcons name (LMonoTys.subst S_outer (LMonoTys.subst S_inner args)) := by
-          unfold LMonoTy.subst; simp only [hOuter, Bool.false_eq_true, ↓reduceIte]
-        have h_r : LMonoTy.subst S_outer (.tcons name args) =
-            .tcons name (LMonoTys.subst S_outer args) := by
-          unfold LMonoTy.subst; simp only [hOuter, Bool.false_eq_true, ↓reduceIte]
-        rw [h_l, h_r]; congr 1
-        rw [LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic,
-            LMonoTys.subst_eq_substLogic]
-        suffices ∀ xs,
-            (∀ m, m ∈ xs → LMonoTy.subst S_outer (LMonoTy.subst S_inner m) =
-              LMonoTy.subst S_outer m) →
-            LMonoTys.substLogic S_outer (LMonoTys.substLogic S_inner xs) =
-              LMonoTys.substLogic S_outer xs by
-          exact this args (fun m hm => ih m hm)
-        intro xs; induction xs with
-        | nil => intro _; simp [LMonoTys.substLogic, hOuter, hInner]
-        | cons a rest ih_rest =>
-          intro ih_cons
-          simp only [LMonoTys.substLogic, hOuter, hInner, Bool.false_eq_true, ↓reduceIte]
-          rw [ih_cons a List.mem_cons_self,
-              ih_rest (fun m hm => ih_cons m (List.mem_cons_of_mem a hm))]
-
-/-- If `S` absorbs `S_inner` and two types are equal under `S_inner`, they are
-    equal under `S`. -/
-theorem LMonoTy.subst_eq_of_absorbs (S S_inner : Subst) (ty1 ty2 : LMonoTy)
-    (h_abs : Subst.absorbs S S_inner)
-    (h_eq : LMonoTy.subst S_inner ty1 = LMonoTy.subst S_inner ty2) :
-    LMonoTy.subst S ty1 = LMonoTy.subst S ty2 := by
-  have h1 := (LMonoTy.subst_absorbs S S_inner ty1 h_abs).symm
-  have h2 := LMonoTy.subst_absorbs S S_inner ty2 h_abs
-  rw [h1, h_eq, h2]
-
-/-- Every well-formed substitution absorbs itself. -/
-theorem Subst.absorbs_refl (S : Subst) (h_wf : SubstWF S) :
-    Subst.absorbs S S := by
-  intro a t h_find
-  have h_not_empty := Subst.hasEmptyScopes_false_of_find S a t h_find
-  have : LMonoTy.subst S (.ftvar a) = t := by
-    simp [LMonoTy.subst, h_not_empty, h_find]
-  rw [this]
-  exact LMonoTy.subst_idempotent_value S a t h_find h_wf
-
-/-- Absorption is transitive: if `S2` absorbs `S1` and `S3` absorbs `S2`,
-    then `S3` absorbs `S1`. -/
-theorem Subst.absorbs_trans (S1 S2 S3 : Subst)
-    (h12 : Subst.absorbs S2 S1) (h23 : Subst.absorbs S3 S2) :
-    Subst.absorbs S3 S1 := by
-  intro a t h_find
-  have h1 := h12 a t h_find
-  rw [← LMonoTy.subst_absorbs S3 S2 t h23, h1,
-      LMonoTy.subst_absorbs S3 S2 (.ftvar a) h23]
-
-/--
-Composition lemma: applying a singleton substitution `[[(v, t)]]` followed by
-`[ys]` equals applying the merged substitution `[(v, t) :: ys]`, provided
-`subst [ys] t = t` (i.e., `t` is stable under `ys`).
-
-This is a key lemma for proving that sequential `tinst` applications
-(each substituting one bound variable) produce the same result as a
-single parallel substitution with all bindings.
--/
-
-theorem LMonoTy.subst_cons_single
-    (v : TyIdentifier) (t : LMonoTy) (ys : SubstOne) (mty : LMonoTy)
-    (h_t : LMonoTy.subst [ys] t = t) :
-    LMonoTy.subst [ys] (LMonoTy.subst [[(v, t)]] mty) =
-    LMonoTy.subst [((v, t) :: ys)] mty := by
-  have hSingle : Subst.hasEmptyScopes [[(v, t)]] = false := by
-    simp [Subst.hasEmptyScopes, Map.isEmpty]
-  have hCons : Subst.hasEmptyScopes [((v, t) :: ys)] = false := by
-    simp [Subst.hasEmptyScopes, Map.isEmpty]
-  by_cases hYs : Subst.hasEmptyScopes [ys]
-  · -- ys is empty, so subst [ys] is identity
-    have h_ys_empty : ys = [] := by
-      simp [Subst.hasEmptyScopes, Map.isEmpty] at hYs
-      cases ys with
-      | nil => rfl
-      | cons _ _ => simp at hYs
-    subst h_ys_empty
-    simp only [LMonoTy.subst_emptyS hYs]
-  · have hYs_ne : Subst.hasEmptyScopes [ys] = false := by
-      revert hYs; cases Subst.hasEmptyScopes [ys] <;> simp
-    induction mty with
-    | ftvar x =>
-      by_cases h_eq : v = x
-      · -- v = x: inner subst gives t, then subst [ys] t = t by h_t
-        subst h_eq
-        have h_inner : LMonoTy.subst [[(v, t)]] (.ftvar v) = t := by
-          simp [LMonoTy.subst, Subst.hasEmptyScopes, Map.isEmpty, Maps.find?, Map.find?]
-        rw [h_inner, h_t]
-        -- RHS: subst [(v,t)::ys] (ftvar v) = t (first match in (v,t)::ys)
-        simp [LMonoTy.subst, hCons, Maps.find?, Map.find?]
-      · -- v ≠ x: inner subst is identity, lookup x in ys
-        have h_inner : LMonoTy.subst [[(v, t)]] (.ftvar x) = .ftvar x := by
-          simp [LMonoTy.subst, Subst.hasEmptyScopes, Map.isEmpty, Maps.find?, Map.find?, h_eq]
-        rw [h_inner]
-        -- Both sides look up x in ys (since v ≠ x, (v,t)::ys skips (v,t))
-        simp [LMonoTy.subst, hYs_ne, hCons, Maps.find?, Map.find?, h_eq]
-    | bitvec n =>
-      simp [LMonoTy.subst]
-    | tcons name args ih =>
-      simp only [LMonoTy.subst, hSingle, hYs_ne, hCons, Bool.false_eq_true, ↓reduceIte]
-      congr 1
-      rw [LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic,
-          LMonoTys.subst_eq_substLogic]
-      suffices ∀ xs,
-          (∀ m, m ∈ xs → LMonoTy.subst [ys] (LMonoTy.subst [[(v, t)]] m) =
-            LMonoTy.subst [((v, t) :: ys)] m) →
-          LMonoTys.substLogic [ys] (LMonoTys.substLogic [[(v, t)]] xs) =
-            LMonoTys.substLogic [((v, t) :: ys)] xs by
-        exact this args ih
-      intro xs; induction xs with
-      | nil => intro _; simp [LMonoTys.substLogic, hSingle, hYs_ne, hCons]
-      | cons a rest ih_rest =>
-        intro ih_xs
-        simp only [LMonoTys.substLogic, hSingle, hYs_ne, hCons, Bool.false_eq_true, ↓reduceIte]
-        rw [ih_xs a List.mem_cons_self,
-            ih_rest (fun m hm => ih_xs m (List.mem_cons_of_mem a hm))]
-
--- Helper: applyLogic preserves some bindings.
-private theorem Map.find?_applyLogic_some_h' {new old : SubstOne} {a : TyIdentifier} {t : LMonoTy}
-    (h : Map.find? old a = some t) :
-    Map.find? (SubstOne.applyLogic new old) a = some (LMonoTy.subst [new] t) := by
-  induction old with
-  | nil => simp [Map.find?] at h
-  | cons hd rest ih =>
-    simp only [SubstOne.applyLogic, Map.find?]
-    simp only [Map.find?] at h
-    grind
-
--- Helper: applyLogic preserves none bindings.
-private theorem Map.find?_applyLogic_none_h' {new old : SubstOne} {a : TyIdentifier}
-    (h : Map.find? old a = none) :
-    Map.find? (SubstOne.applyLogic new old) a = none := by
-  induction old with
-  | nil => simp [SubstOne.applyLogic, Map.find?]
-  | cons hd rest ih =>
-    simp [SubstOne.applyLogic, Map.find?]
-    simp [Map.find?] at h
-    grind
-
--- Helper: Subst.apply preserves some bindings.
-private theorem Maps.find?_apply_some_h' {new : SubstOne} {old : Subst} {a : TyIdentifier} {t : LMonoTy}
-    (h : Maps.find? old a = some t) :
-    Maps.find? (Subst.apply new old) a = some (LMonoTy.subst [new] t) := by
-  induction old with
-  | nil => simp [Maps.find?] at h
-  | cons m rest ih =>
-    simp only [Subst.apply, Maps.find?]
-    simp only [Maps.find?] at h
-    rw [SubstOne.apply_eq_applyLogic]
-    cases h_ma : Map.find? m a with
-    | none =>
-      rw [h_ma] at h
-      rw [Map.find?_applyLogic_none_h' h_ma]
-      exact ih h
-    | some val =>
-      rw [h_ma] at h; simp only [Option.some.injEq] at h; subst h
-      rw [Map.find?_applyLogic_some_h' h_ma]
-
--- Helper: Except.mapError preserves ok values.
-private theorem Except.mapError_ok_h' {α β γ : Type} {f : α → β} {e : Except α γ} {v : γ}
-    (h : Except.mapError f e = .ok v) : e = .ok v := by
-  cases e with
-  | error a => simp [Except.mapError] at h
-  | ok val => simp [Except.mapError] at h; exact congrArg Except.ok h
-
--- Helper: insert+apply produces an absorbing substitution.
-private theorem absorbs_of_insert_apply_h' (S : SubstInfo) (id : TyIdentifier) (lty : LMonoTy)
-    (h_none : Maps.find? S.subst id = none)
-    (h_wf : SubstWF ((Subst.apply [(id, lty)] S.subst).insert id lty)) :
-    Subst.absorbs ((Subst.apply [(id, lty)] S.subst).insert id lty) S.subst := by
-  intro a t h_find
-  have h_a_ne_id : a ≠ id := by
-    intro h_eq; subst h_eq; rw [h_find] at h_none; simp at h_none
-  let S_new := (Subst.apply [(id, lty)] S.subst).insert id lty
-  have h_apply_a := Maps.find?_apply_some_h' (new := [(id, lty)]) h_find
-  have h_find_new : Maps.find? S_new a = some (LMonoTy.subst [[(id, lty)]] t) := by
-    show Maps.find? (Maps.insert _ id lty) a = _
-    rw [Maps.find?_insert_ne _ _ _ _ h_a_ne_id]
-    exact h_apply_a
-  have h_find_id : Maps.find? S_new id = some lty := Maps.find?_insert_self _ id lty
-  have h_not_empty := Subst.hasEmptyScopes_false_of_find S_new a _ h_find_new
-  have h_subst_ftvar : LMonoTy.subst S_new (.ftvar a) = LMonoTy.subst [[(id, lty)]] t := by
-    simp [LMonoTy.subst, h_not_empty, h_find_new]
-  have h_idem := LMonoTy.subst_idempotent_value S_new a _ h_find_new h_wf
-  have h_abs := LMonoTy.subst_absorbs_single S_new id lty t h_find_id h_wf
-  rw [h_subst_ftvar, ← h_abs, h_idem]
-
-/-- After inserting `(id, lty)` into the applied substitution, `subst _ (ftvar id) = lty`. -/
-private theorem subst_ftvar_new_binding
-    (S : Subst) (id : TyIdentifier) (lty : LMonoTy)
-    (_h_none : Maps.find? S id = none) :
-    LMonoTy.subst (Maps.insert (Subst.apply [(id, lty)] S) id lty) (LMonoTy.ftvar id) = lty := by
-  have h_find := Maps.find?_insert_self (Subst.apply [(id, lty)] S) id lty
-  have h_not_empty : ¬Subst.hasEmptyScopes (Maps.insert (Subst.apply [(id, lty)] S) id lty) := by
-    intro h_empty
-    exact absurd ((Subst.isEmpty_implies_keys_empty h_empty) ▸ Maps.find?_mem_keys _ h_find) (by simp)
-  unfold LMonoTy.subst; simp [h_not_empty, h_find]
-
-/-- When `S.find? id = none`, the new substitution absorbs `S` and maps `orig_lty` to `lty`. -/
-private theorem subst_orig_new_binding
-    (S : Subst) (id : TyIdentifier) (lty orig_lty : LMonoTy)
-    (h_none : Maps.find? S id = none)
-    (h_lty : lty = LMonoTy.subst S orig_lty)
-    (h_occurs : ¬(id ∈ lty.freeVars)) :
-    LMonoTy.subst (Maps.insert (Subst.apply [(id, lty)] S) id lty) orig_lty = lty := by
-  subst h_lty
-  have h_find_S'_id : Maps.find? (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
-      id (LMonoTy.subst S orig_lty)) id = some (LMonoTy.subst S orig_lty) :=
-    Maps.find?_insert_self _ _ _
-  have hS' : Subst.hasEmptyScopes (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
-      id (LMonoTy.subst S orig_lty)) = false :=
-    Subst.hasEmptyScopes_false_of_find _ id _ h_find_S'_id
-  have h_find_ne : ∀ x, x ≠ id →
-      Maps.find? (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
-        id (LMonoTy.subst S orig_lty)) x =
-      (Maps.find? S x).map (LMonoTy.subst [[(id, LMonoTy.subst S orig_lty)]]) := fun x hx =>
-    (Maps.find?_insert_ne _ _ _ _ hx).trans (Subst.find?_apply _ _ _)
-  have h_single_noop : ∀ t : LMonoTy, ¬(id ∈ t.freeVars) →
-      LMonoTy.subst [[(id, LMonoTy.subst S orig_lty)]] t = t := fun t ht =>
-    LMonoTy.subst_no_relevant_keys _ _ (fun x hx => by
-      simp [Maps.keys, Map.keys]; intro heq; subst heq; exact ht hx)
-  by_cases hS : Subst.hasEmptyScopes S
-  · simp only [LMonoTy.subst_emptyS hS] at h_occurs h_find_ne ⊢
-    apply LMonoTy.subst_no_relevant_keys
-    intro x hx
-    have h_ne : x ≠ id := fun h => h_occurs (h ▸ hx)
-    exact Maps.find?_of_not_mem_values _ (by
-      rw [h_find_ne x h_ne, Maps.not_mem_keys_find?_none' S x
-        ((Subst.isEmpty_implies_keys_empty hS) ▸ (by simp))]; simp)
-  · have hS_ne : Subst.hasEmptyScopes S = false := by
-      revert hS; cases Subst.hasEmptyScopes S <;> simp
-    suffices ∀ mty, ¬(id ∈ (LMonoTy.subst S mty).freeVars) →
-        LMonoTy.subst (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
-          id (LMonoTy.subst S orig_lty)) mty = LMonoTy.subst S mty from
-      this orig_lty h_occurs
-    intro mty h_nf
-    induction mty with
-    | ftvar x =>
-      by_cases h_id : x = id
-      · subst h_id; exfalso; apply h_nf
-        simp [LMonoTy.subst, hS_ne, h_none, LMonoTy.freeVars]
-      · unfold LMonoTy.subst
-        simp only [hS', hS_ne, Bool.false_eq_true, ↓reduceIte, h_find_ne x h_id]
-        cases h_fx : Maps.find? S x with
-        | none => simp
-        | some t =>
-          simp only [Option.map]
-          exact h_single_noop t (by
-            have : LMonoTy.subst S (.ftvar x) = t := by
-              simp [LMonoTy.subst, hS_ne, h_fx]
-            rwa [this] at h_nf)
-    | bitvec n => simp [LMonoTy.subst]
-    | tcons name args ih =>
-      unfold LMonoTy.subst
-      simp only [hS', hS_ne, Bool.false_eq_true, ↓reduceIte]
-      congr 1
-      rw [LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic]
-      have h_nf' : ¬(id ∈ LMonoTys.freeVars (LMonoTys.substLogic S args)) := by
-        have h_eq : LMonoTy.subst S (.tcons name args) =
-            .tcons name (LMonoTys.subst S args) := by
-          unfold LMonoTy.subst; simp [hS_ne]
-        simp only [h_eq, LMonoTy.freeVars, LMonoTys.subst_eq_substLogic] at h_nf
-        exact h_nf
-      suffices ∀ xs,
-          (∀ m, m ∈ xs → ¬(id ∈ (LMonoTy.subst S m).freeVars) →
-            LMonoTy.subst (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
-              id (LMonoTy.subst S orig_lty)) m = LMonoTy.subst S m) →
-          ¬(id ∈ LMonoTys.freeVars (LMonoTys.substLogic S xs)) →
-          LMonoTys.substLogic (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
-            id (LMonoTy.subst S orig_lty)) xs = LMonoTys.substLogic S xs by
-        exact this args (fun m hm h_nfm => ih m hm h_nfm) h_nf'
-      intro xs; induction xs with
-      | nil => intros; simp [LMonoTys.substLogic, hS', hS_ne]
-      | cons a rest ih_rest =>
-        intro ih_xs h_nf_xs
-        simp only [LMonoTys.substLogic, hS', hS_ne, Bool.false_eq_true, ↓reduceIte]
-        have h_eq_cons : LMonoTys.substLogic S (a :: rest) =
-            LMonoTy.subst S a :: LMonoTys.substLogic S rest := by
-          simp [LMonoTys.substLogic, hS_ne]
-        rw [h_eq_cons, LMonoTys.freeVars_of_cons] at h_nf_xs
-        have h1 : ¬(id ∈ (LMonoTy.subst S a).freeVars) :=
-          fun h => h_nf_xs (List.mem_append_left _ h)
-        have h2 : ¬(id ∈ LMonoTys.freeVars (LMonoTys.substLogic S rest)) :=
-          fun h => h_nf_xs (List.mem_append_right _ h)
-        rw [ih_xs a (.head _) h1,
-            ih_rest (fun m hm => ih_xs m (.tail _ hm)) h2]
-
-/-- Bundled result for the three properties proved simultaneously about `unifyOne`:
-    soundness (constraint is equalized), absorption (output absorbs input),
-    and key inclusion (output keys come from input keys, constraint freeVars,
-    or input value freeVars). -/
-structure Constraint.UnifyOneProperties (c : Constraint) (S : SubstInfo)
-    (relS : ValidSubstRelation [c] S) : Prop where
-  sound : LMonoTy.subst relS.newS.subst c.1 = LMonoTy.subst relS.newS.subst c.2
-  absorbs : Subst.absorbs relS.newS.subst S.subst
-  keys_incl : ∀ k, k ∈ Maps.keys relS.newS.subst →
-    k ∈ Maps.keys S.subst ∨ k ∈ Constraint.freeVars c ∨ k ∈ Subst.freeVars S.subst
-
-/-- Bundled result for the three properties proved simultaneously about `unifyCore`. -/
-structure Constraints.UnifyCoreProperties (cs : Constraints) (S : SubstInfo)
-    (relS : ValidSubstRelation cs S) : Prop where
-  sound : ∀ p, p ∈ cs → LMonoTy.subst relS.newS.subst p.1 = LMonoTy.subst relS.newS.subst p.2
-  absorbs : Subst.absorbs relS.newS.subst S.subst
-  keys_incl : ∀ k, k ∈ Maps.keys relS.newS.subst →
-    k ∈ Maps.keys S.subst ∨ k ∈ Constraints.freeVars cs ∨ k ∈ Subst.freeVars S.subst
-
--- Combined soundness, absorption, and key-inclusion for `unifyOne`/`unifyCore`.
--- A single mutual induction on `Constraint.unifyOne.induct` proves all three
--- properties simultaneously, sharing the 17-case decomposition.
---
--- The theorem proves `motive1` (for `unifyOne`) directly; `motive2` (for
--- `unifyCore`) is proved as part of the same induction and is exposed
--- separately via `Constraints.unifyCore_sound`.
-theorem Constraint.unifyOne_sound (c : Constraint) (S : SubstInfo)
-    (relS : ValidSubstRelation [c] S)
-    (h : Constraint.unifyOne c S = .ok relS) :
-    Constraint.UnifyOneProperties c S relS := by
-  suffices ∀ relS, Constraint.unifyOne c S = .ok relS →
-      Constraint.UnifyOneProperties c S relS from this relS h
-  apply Constraint.unifyOne.induct
-    (motive1 := fun c S => ∀ relS, Constraint.unifyOne c S = .ok relS →
-      Constraint.UnifyOneProperties c S relS)
-    (motive2 := fun cs S => ∀ relS, Constraints.unifyCore cs S = .ok relS →
-      Constraints.UnifyCoreProperties cs S relS)
-  -- Case 1: t1 == t2
-  · intro S t1 t2 h_eq _ relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
-    · simp only [Except.ok.injEq] at h; subst h
-      exact ⟨by grind, Subst.absorbs_refl S.subst S.isWF, fun k hk => Or.inl hk⟩
-    · exact absurd h_eq ‹_›
-  -- Case 2: ftvar id, orig_lty; ftvar id == lty
-  · intro S id orig_lty h_neq _lty _ _ h_eq_lty relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
-    · exact absurd ‹_› h_neq
-    · simp only [Except.ok.injEq] at h; subst h
-      refine ⟨?_, Subst.absorbs_refl S.subst S.isWF, fun k hk => Or.inl hk⟩
-      show LMonoTy.subst S.subst (.ftvar id) = LMonoTy.subst S.subst orig_lty
-      have h_id_eq : LMonoTy.ftvar id = LMonoTy.subst S.subst orig_lty := eq_of_beq h_eq_lty
-      rw [h_id_eq]; exact LMonoTy.subst_idempotent S.subst S.isWF orig_lty
-  -- Case 3: ftvar id, orig_lty; occurs check — error
-  · intro S id orig_lty h_neq _lty _ _ h_neq_lty h_occurs relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h <;> grind
-  -- Case 4: ftvar id, orig_lty; some sty — recursive
-  · intro S id orig_lty h_neq _lty _ _ h_neq_lty h_not_occurs sty h_some ih_rec relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
-    · exact absurd ‹_› h_neq
-    · split at h
-      · rename_i sty' h_some'
-        rw [h_some] at h_some'; simp only [Option.some.injEq] at h_some'; subst h_some'
-        simp only [bind, Except.bind] at h
-        split at h
-        · simp at h
-        · rename_i relS' h_call
-          simp only [Except.ok.injEq] at h; rw [← h]
-          have ih := ih_rec relS' h_call
-          -- Absorption (from IH)
-          have h_abs := ih.absorbs
-          -- Soundness: subst S' (ftvar id) = subst S' orig_lty
-          have h_sound : LMonoTy.subst relS'.newS.subst (.ftvar id) =
-              LMonoTy.subst relS'.newS.subst orig_lty := by
-            have h_ftvar : LMonoTy.subst relS'.newS.subst (.ftvar id) =
-                LMonoTy.subst relS'.newS.subst sty := by
-              have := h_abs id sty h_some; simp only [this]
-            have h_orig : LMonoTy.subst relS'.newS.subst (LMonoTy.subst S.subst orig_lty) =
-                LMonoTy.subst relS'.newS.subst orig_lty :=
-              LMonoTy.subst_absorbs relS'.newS.subst S.subst orig_lty h_abs
-            rw [h_ftvar, ih.sound, h_orig]
-          -- Key inclusion (from IH, lifting freeVars)
-          have h_keys : ∀ k, k ∈ Maps.keys relS'.newS.subst →
-              k ∈ Maps.keys S.subst ∨
-              k ∈ Constraint.freeVars (LMonoTy.ftvar id, orig_lty) ∨
-              k ∈ Subst.freeVars S.subst := by
-            intro k hk
-            rcases ih.keys_incl k hk with h1 | h2 | h3
-            · left; exact h1
-            · simp only [Constraint.freeVars, List.mem_append] at h2
-              rcases h2 with h_sty | h_lty
-              · right; right; exact Subst.freeVars_of_find_subset S.subst h_some h_sty
-              · rcases List.mem_append.mp (LMonoTy.freeVars_of_subst_subset S.subst orig_lty h_lty) with
-                  h_orig | h_vals
-                · right; left; simp [Constraint.freeVars]; right; exact h_orig
-                · right; right; exact h_vals
-            · right; right; exact h3
-          exact ⟨h_sound, h_abs, h_keys⟩
-      · rename_i h_none; rw [h_some] at h_none; simp at h_none
-  -- Case 5: ftvar id, orig_lty; none — insert+apply
-  · intro S id orig_lty h_neq _lty _ _ h_neq_lty h_not_occurs h_none _ _ _ns h' _nS _ _ relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
-    · exact absurd ‹_› h_neq
-    · split at h
-      · rename_i sty h_some; rw [h_none] at h_some; simp at h_some
-      · simp only [Except.ok.injEq] at h; subst h
-        refine ⟨?_, ?_, ?_⟩
-        · -- Soundness
-          exact Eq.trans
-            (subst_ftvar_new_binding S.subst id (LMonoTy.subst S.subst orig_lty) h_none)
-            (subst_orig_new_binding S.subst id (LMonoTy.subst S.subst orig_lty)
-              orig_lty h_none rfl h_not_occurs).symm
-        · -- Absorption
-          exact absorbs_of_insert_apply_h' S id (LMonoTy.subst S.subst orig_lty) h_none
-            (SubstWF.cons_of_subst_apply S id orig_lty _ rfl
-              (SubstWF.single_subst id h_not_occurs) (SubstWF.apply_one_substituted_type S id orig_lty))
-        · -- Key inclusion
-          intro k hk
-          have hk' := Maps.insert_keys_subset (ms := Subst.apply [(_,_)] S.subst) (key := _) (val := _) hk
-          rw [Subst.keys_of_apply_eq] at hk'
-          rcases List.mem_cons.mp hk' with rfl | h_old
-          · right; left; simp [Constraint.freeVars, LMonoTy.freeVars]
-          · left; exact h_old
-  -- Case 6: orig_lty, ftvar id; ftvar id == lty
-  · intro S orig_lty id h_neq _ _lty _ _ h_eq_lty relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
-    · exact absurd ‹_› h_neq
-    · simp only [Except.ok.injEq] at h; subst h
-      refine ⟨?_, Subst.absorbs_refl S.subst S.isWF, fun k hk => Or.inl hk⟩
-      show LMonoTy.subst S.subst orig_lty = LMonoTy.subst S.subst (.ftvar id)
-      have h_id_eq : LMonoTy.ftvar id = LMonoTy.subst S.subst orig_lty := eq_of_beq h_eq_lty
-      rw [h_id_eq]; exact (LMonoTy.subst_idempotent S.subst S.isWF orig_lty).symm
-  -- Case 7: orig_lty, ftvar id; occurs check — error
-  · intro S orig_lty id h_neq _ _lty _ _ h_neq_lty h_occurs relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
-    · exact absurd ‹_› h_neq
-    · simp at h
-  -- Case 8: orig_lty, ftvar id; some sty — recursive (symmetric to case 4)
-  · intro S orig_lty id h_neq _ _lty _ _ h_neq_lty h_not_occurs sty h_some ih_rec relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
-    · exact absurd ‹_› h_neq
-    · split at h
-      · rename_i sty' h_some'
-        rw [h_some] at h_some'; simp only [Option.some.injEq] at h_some'; subst h_some'
-        simp only [bind, Except.bind] at h
-        split at h
-        · simp at h
-        · rename_i relS' h_call
-          simp only [Except.ok.injEq] at h; rw [← h]
-          have ih := ih_rec relS' h_call
-          have h_abs := ih.absorbs
-          -- Soundness: subst S' orig_lty = subst S' (ftvar id)
-          have h_sound : LMonoTy.subst relS'.newS.subst orig_lty =
-              LMonoTy.subst relS'.newS.subst (.ftvar id) := by
-            have h_ftvar : LMonoTy.subst relS'.newS.subst (.ftvar id) =
-                LMonoTy.subst relS'.newS.subst sty := by
-              have := h_abs id sty h_some; simp only [this]
-            have h_orig : LMonoTy.subst relS'.newS.subst (LMonoTy.subst S.subst orig_lty) =
-                LMonoTy.subst relS'.newS.subst orig_lty :=
-              LMonoTy.subst_absorbs relS'.newS.subst S.subst orig_lty h_abs
-            rw [← h_orig, ← ih.sound, h_ftvar]
-          -- Key inclusion (symmetric to case 4)
-          have h_keys : ∀ k, k ∈ Maps.keys relS'.newS.subst →
-              k ∈ Maps.keys S.subst ∨
-              k ∈ Constraint.freeVars (orig_lty, LMonoTy.ftvar id) ∨
-              k ∈ Subst.freeVars S.subst := by
-            intro k hk
-            rcases ih.keys_incl k hk with h1 | h2 | h3
-            · left; exact h1
-            · simp only [Constraint.freeVars, List.mem_append] at h2
-              rcases h2 with h_sty | h_lty
-              · right; right; exact Subst.freeVars_of_find_subset S.subst h_some h_sty
-              · rcases List.mem_append.mp (LMonoTy.freeVars_of_subst_subset S.subst orig_lty h_lty) with
-                  h_orig | h_vals
-                · right; left; simp [Constraint.freeVars]; left; exact h_orig
-                · right; right; exact h_vals
-            · right; right; exact h3
-          exact ⟨h_sound, h_abs, h_keys⟩
-      · rename_i h_none; rw [h_some] at h_none; simp at h_none
-  -- Case 9: orig_lty, ftvar id; none — insert+apply (symmetric to case 5)
-  · intro S orig_lty id h_neq _ _lty _ _ h_neq_lty h_not_occurs h_none _ _ _ns h' _nS _ _ relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
-    · exact absurd ‹_› h_neq
-    · split at h
-      · rename_i sty h_some; rw [h_none] at h_some; simp at h_some
-      · simp only [Except.ok.injEq] at h; subst h
-        refine ⟨?_, ?_, ?_⟩
-        · -- Soundness
-          exact Eq.symm (Eq.trans
-            (subst_ftvar_new_binding S.subst id (LMonoTy.subst S.subst orig_lty) h_none)
-            (subst_orig_new_binding S.subst id (LMonoTy.subst S.subst orig_lty)
-              orig_lty h_none rfl h_not_occurs).symm)
-        · -- Absorption
-          exact absorbs_of_insert_apply_h' S id (LMonoTy.subst S.subst orig_lty) h_none
-            (SubstWF.cons_of_subst_apply S id orig_lty _ rfl
-              (SubstWF.single_subst id h_not_occurs) (SubstWF.apply_one_substituted_type S id orig_lty))
-        · -- Key inclusion
-          intro k hk
-          have hk' := Maps.insert_keys_subset (ms := Subst.apply [(_,_)] S.subst) (key := _) (val := _) hk
-          rw [Subst.keys_of_apply_eq] at hk'
-          rcases List.mem_cons.mp hk' with rfl | h_old
-          · right; left; simp [Constraint.freeVars, LMonoTy.freeVars]
-          · left; exact h_old
-  -- Case 10: bitvec n1 == n2 contradiction
-  · intro S n1 n2 h_neq h_eq_n relS h; grind
-  -- Case 11: bitvec n1 ≠ n2 — error
-  · intro S n1 n2 h_neq h_neq_n relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h <;> grind
-  -- Case 12: tcons match — recursive unifyCore
-  · intro S name1 args1 name2 args2 h_neq h_match _nc ih_core relS h
-    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
-    · exact absurd ‹_› h_neq
-    · simp only [bind, Except.bind] at h
-      split at h
-      · simp at h
-      · rename_i relS' h_call
-        simp only [Except.ok.injEq] at h; rw [← h]
-        have ih := ih_core relS' h_call
-        refine ⟨?_, ih.absorbs, ?_⟩
-        · -- Soundness: subst S' (tcons name1 args1) = subst S' (tcons name2 args2)
-          have h_name_eq : name1 = name2 := by
-            have := (Bool.and_eq_true _ _ ▸ h_match : _ ∧ _).1; exact eq_of_beq this
-          have h_len_eq : args1.length = args2.length := by
-            have := (Bool.and_eq_true _ _ ▸ h_match : _ ∧ _).2; exact of_decide_eq_true this
-          subst h_name_eq
-          have ih_pw := ih.sound
-          have h_args_eq : ∀ (l1 l2 : LMonoTys), l1.length = l2.length →
-              (∀ p, p ∈ l1.zip l2 →
-                LMonoTy.subst relS'.newS.subst p.1 = LMonoTy.subst relS'.newS.subst p.2) →
-              LMonoTys.subst relS'.newS.subst l1 = LMonoTys.subst relS'.newS.subst l2 := by
-            intro l1 l2 h_len h_pw
-            rw [LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic]
-            by_cases hS : Subst.hasEmptyScopes relS'.newS.subst
-            · have h_id : ∀ l, LMonoTys.substLogic relS'.newS.subst l = l := by
-                intro l; induction l with
-                | nil => simp [LMonoTys.substLogic, hS]
-                | cons _ _ _ => simp [LMonoTys.substLogic, hS]
-              rw [h_id, h_id]
-              induction l1 generalizing l2 with
-              | nil => cases l2 with | nil => rfl | cons _ _ => simp at h_len
-              | cons a rest ih_l =>
-                cases l2 with
-                | nil => simp at h_len
-                | cons b rest2 =>
-                  simp at h_len
-                  have h_ab := h_pw (a, b) List.mem_cons_self
-                  simp [LMonoTy.subst_emptyS hS] at h_ab
-                  rw [h_ab, ih_l rest2 h_len fun p hp => h_pw p (List.mem_cons_of_mem _ hp)]
-            · have hS_ne : Subst.hasEmptyScopes relS'.newS.subst = false := by
-                revert hS; cases Subst.hasEmptyScopes relS'.newS.subst <;> simp
-              induction l1 generalizing l2 with
-              | nil => cases l2 with | nil => simp [LMonoTys.substLogic, hS_ne] | cons _ _ => simp at h_len
-              | cons a rest ih_l =>
-                cases l2 with
-                | nil => simp at h_len
-                | cons b rest2 =>
-                  simp at h_len
-                  simp only [LMonoTys.substLogic, hS_ne, Bool.false_eq_true, ↓reduceIte]
-                  have h_ab : LMonoTy.subst relS'.newS.subst a = LMonoTy.subst relS'.newS.subst b :=
-                    h_pw (a, b) List.mem_cons_self
-                  rw [h_ab, ih_l rest2 h_len fun p hp => h_pw p (List.mem_cons_of_mem _ hp)]
-          have h_list := h_args_eq args1 args2 h_len_eq ih_pw
-          by_cases hS_final : Subst.hasEmptyScopes relS'.newS.subst
-          · simp [LMonoTy.subst_emptyS hS_final]
-            simp [LMonoTys.subst, hS_final] at h_list; rw [h_list]
-          · have hS_ne : Subst.hasEmptyScopes relS'.newS.subst = false := by
-              revert hS_final; cases Subst.hasEmptyScopes relS'.newS.subst <;> simp
-            simp [LMonoTy.subst, hS_ne]; exact h_list
-        · -- Key inclusion
-          intro k hk
-          rcases ih.keys_incl k hk with h1 | h2 | h3
-          · left; exact h1
-          · right; left; simp only [Constraint.freeVars, LMonoTy.freeVars, List.mem_append]
-            exact List.mem_append.mp (Constraints.freeVars_of_zip_subset h2)
-          · right; right; exact h3
-  -- Case 13: tcons name/length mismatch — error
-  · intro S name1 args1 name2 args2 h_neq h_mismatch relS h
-    rw [Constraint.unifyOne.eq_def] at h; grind
-  -- Case 14: bitvec, tcons — error
-  · intro S size name args h_neq relS h
-    rw [Constraint.unifyOne.eq_def] at h; grind
-  -- Case 15: tcons, bitvec — error
-  · intro S name args size h_neq relS h
-    rw [Constraint.unifyOne.eq_def] at h; grind
-  -- Case 16: unifyCore []
-  · intro S relS h
-    rw [Constraints.unifyCore.eq_def] at h; simp only at h
-    simp only [Except.ok.injEq] at h; subst h
-    exact ⟨fun p hp => by grind, Subst.absorbs_refl S.subst S.isWF, fun k hk => Or.inl hk⟩
-  -- Case 17: unifyCore c :: rest
-  · intro S c c_rest ih1 ih2 relS h
-    rw [Constraints.unifyCore.eq_def] at h; simp only at h
-    simp only [Bind.bind, Except.bind, Except.mapError] at h
-    split at h
-    · simp at h
-    · rename_i relS_one h_one_raw
-      have h_one := Except.mapError_ok_h' h_one_raw
-      split at h
-      · simp at h
-      · rename_i relS_rest h_rest
-        simp only [Except.ok.injEq] at h; subst h
-        have ih_one := ih1 relS_one h_one
-        have ih_rest := ih2 relS_one relS_rest h_rest
-        refine ⟨?_, ?_, ?_⟩
-        · -- Soundness: all pairs in c :: c_rest are equalized
-          intro p hp
-          cases List.mem_cons.mp hp with
-          | inl h_pc =>
-            subst h_pc
-            have h_sound_one := ih_one.sound
-            have h_abs := ih_rest.absorbs
-            calc LMonoTy.subst relS_rest.newS.subst p.1
-                = LMonoTy.subst relS_rest.newS.subst (LMonoTy.subst relS_one.newS.subst p.1) :=
-                  (LMonoTy.subst_absorbs _ _ _ h_abs).symm
-              _ = LMonoTy.subst relS_rest.newS.subst (LMonoTy.subst relS_one.newS.subst p.2) := by
-                  rw [h_sound_one]
-              _ = LMonoTy.subst relS_rest.newS.subst p.2 :=
-                  LMonoTy.subst_absorbs _ _ _ h_abs
-          | inr h_rest_mem =>
-            exact ih_rest.sound p h_rest_mem
-        · -- Absorption: transitive
-          exact Subst.absorbs_trans S.subst relS_one.newS.subst relS_rest.newS.subst
-            ih_one.absorbs ih_rest.absorbs
-        · -- Key inclusion
-          intro k hk
-          rcases ih_rest.keys_incl k hk with hk1 | hk2 | hk3
-          · rcases ih_one.keys_incl k hk1 with h1a | h1b | h1c
-            · left; exact h1a
-            · right; left; simp [Constraints.freeVars]; left; exact h1b
-            · right; right; exact h1c
-          · right; left; simp [Constraints.freeVars]; right; exact hk2
-          · rcases List.mem_append.mp (relS_one.goodSubset hk3) with h_c | h_s
-            · right; left; simp [Constraints.freeVars]; left
-              simp [Constraints.freeVars] at h_c; exact h_c
-            · right; right; exact h_s
-
-/-- Combined soundness, absorption, and key-inclusion for `unifyCore`.
-    Proved by simple list induction, delegating to `Constraint.unifyOne_sound`
-    for each head constraint. -/
-theorem Constraints.unifyCore_sound (cs : Constraints) (S : SubstInfo)
-    (relS : ValidSubstRelation cs S)
-    (h : Constraints.unifyCore cs S = .ok relS) :
-    Constraints.UnifyCoreProperties cs S relS := by
-  induction cs generalizing S with
-  | nil =>
-    rw [Constraints.unifyCore.eq_def] at h; simp only at h
-    simp only [Except.ok.injEq] at h; subst h
-    exact ⟨fun p hp => by grind, Subst.absorbs_refl S.subst S.isWF, fun k hk => Or.inl hk⟩
-  | cons c rest ih =>
-    rw [Constraints.unifyCore.eq_def] at h; simp only at h
-    simp only [Bind.bind, Except.bind, Except.mapError] at h
-    split at h
-    · simp at h
-    · rename_i relS_one h_one_raw
-      have h_one := Except.mapError_ok_h' h_one_raw
-      split at h
-      · simp at h
-      · rename_i relS_rest h_rest
-        simp only [Except.ok.injEq] at h; subst h
-        have ih_one := Constraint.unifyOne_sound c S relS_one h_one
-        have ih_rest := ih relS_one.newS relS_rest h_rest
-        refine ⟨?_, ?_, ?_⟩
-        · -- Soundness
-          intro p hp
-          cases List.mem_cons.mp hp with
-          | inl h_pc =>
-            subst h_pc
-            have h_abs := ih_rest.absorbs
-            calc LMonoTy.subst relS_rest.newS.subst p.1
-                = LMonoTy.subst relS_rest.newS.subst (LMonoTy.subst relS_one.newS.subst p.1) :=
-                  (LMonoTy.subst_absorbs _ _ _ h_abs).symm
-              _ = LMonoTy.subst relS_rest.newS.subst (LMonoTy.subst relS_one.newS.subst p.2) := by
-                  rw [ih_one.sound]
-              _ = LMonoTy.subst relS_rest.newS.subst p.2 :=
-                  LMonoTy.subst_absorbs _ _ _ h_abs
-          | inr h_rest_mem =>
-            exact ih_rest.sound p h_rest_mem
-        · -- Absorption
-          exact Subst.absorbs_trans S.subst relS_one.newS.subst relS_rest.newS.subst
-            ih_one.absorbs ih_rest.absorbs
-        · -- Key inclusion
-          intro k hk
-          rcases ih_rest.keys_incl k hk with hk1 | hk2 | hk3
-          · rcases ih_one.keys_incl k hk1 with h1a | h1b | h1c
-            · left; exact h1a
-            · right; left; simp [Constraints.freeVars]; left; exact h1b
-            · right; right; exact h1c
-          · right; left; simp [Constraints.freeVars]; right; exact hk2
-          · rcases List.mem_append.mp (relS_one.goodSubset hk3) with h_c | h_s
-            · right; left; simp [Constraints.freeVars]; left
-              simp [Constraints.freeVars] at h_c; exact h_c
-            · right; right; exact h_s
-
-/-- Unification produces a substitution that absorbs the input substitution. -/
-theorem Constraints.unify_absorbs (constraints : Constraints) (S_old S_new : SubstInfo)
-    (h : Constraints.unify constraints S_old = .ok S_new) :
-    Subst.absorbs S_new.subst S_old.subst := by
-  simp only [Constraints.unify, bind, Except.bind] at h
-  split at h
-  · simp at h
-  · rename_i relS h_core
-    simp only [Except.ok.injEq] at h; subst h
-    exact (Constraints.unifyCore_sound constraints S_old relS h_core).absorbs
-
-/-- Unification produces a substitution that makes every constraint pair equal. -/
-theorem Constraints.unify_sound (constraints : Constraints) (S_old S_new : SubstInfo)
-    (h : Constraints.unify constraints S_old = .ok S_new) :
-    ∀ p, p ∈ constraints →
-      LMonoTy.subst S_new.subst p.1 = LMonoTy.subst S_new.subst p.2 := by
-  simp only [Constraints.unify, bind, Except.bind] at h
-  split at h
-  · simp at h
-  · rename_i relS h_core
-    simp only [Except.ok.injEq] at h; subst h
-    exact (Constraints.unifyCore_sound constraints S_old relS h_core).sound
-
 ---------------------------------------------------------------------
 
 end -- public section
diff --git a/Strata/DL/Lambda/LTyUnifyProps.lean b/Strata/DL/Lambda/LTyUnifyProps.lean
new file mode 100644
index 0000000000..455ec0c511
--- /dev/null
+++ b/Strata/DL/Lambda/LTyUnifyProps.lean
@@ -0,0 +1,853 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.DL.Lambda.LTyUnify
+import all Strata.DL.Lambda.LTyUnify
+import all Strata.DL.Util.List
+import all Strata.DL.Util.Maps
+import all Strata.DL.Util.Map
+import Std.Tactic.BVDecide.Normalize.BitVec
+
+/-!
+## Theorems for Type Substitution and Unification
+
+Properties of substitution and the soundness of `Constraints.unify`.
+-/
+
+---------------------------------------------------------------------
+
+namespace Lambda
+
+open Std (ToFormat Format format)
+
+public section
+
+theorem SubstWF.not_mem_freeVars_of_find (S : Subst) (a : TyIdentifier) (t : LMonoTy)
+    (h_find : Maps.find? S a = some t) (h_wf : SubstWF S) :
+    a ∉ LMonoTy.freeVars t := by
+  simp [SubstWF] at h_wf
+  have h_key := Maps.find?_mem_keys S h_find
+  have h_fv_subset := Subst.freeVars_of_find_subset S h_find
+  grind
+
+/-- Absorption for type lists: the single substitution is absorbed element-wise. -/
+theorem LMonoTys.subst_absorbs_single (S : Subst) (a : TyIdentifier) (t : LMonoTy)
+    (mtys : LMonoTys)
+    (hS : Subst.hasEmptyScopes S = false)
+    (hSingle : Subst.hasEmptyScopes [[(a, t)]] = false)
+    (ih : ∀ m, m ∈ mtys → LMonoTy.subst S (LMonoTy.subst [[(a, t)]] m) = LMonoTy.subst S m) :
+    LMonoTys.subst S (LMonoTys.subst [[(a, t)]] mtys) = LMonoTys.subst S mtys := by
+  rw [LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic]
+  induction mtys with
+  | nil => simp [LMonoTys.substLogic, hS, hSingle]
+  | cons m rest ih_rest =>
+    simp only [LMonoTys.substLogic, hS, hSingle, Bool.false_eq_true, ↓reduceIte]
+    grind
+
+/--
+#### Absorption: relating substitutions produced by successive resolveAux calls
+
+Absorption: `subst S (subst [(a,t)] mty) = subst S mty` when `Maps.find? S a = some t`
+and `SubstWF S`. The single-variable substitution `[(a,t)]` is "absorbed" by `S`
+because `S` already maps `a` to `t`.
+-/
+theorem LMonoTy.subst_absorbs_single (S : Subst) (a : TyIdentifier) (t : LMonoTy)
+    (mty : LMonoTy) (h_find : Maps.find? S a = some t) (h_wf : SubstWF S) :
+    LMonoTy.subst S (LMonoTy.subst [[(a, t)]] mty) = LMonoTy.subst S mty := by
+  have hS : Subst.hasEmptyScopes S = false :=
+    Subst.hasEmptyScopes_false_of_find S a t h_find
+  have hSingle : Subst.hasEmptyScopes [[(a, t)]] = false := by
+    simp [Subst.hasEmptyScopes, Map.isEmpty]
+  induction mty with
+  | ftvar x =>
+    by_cases h_eq : a = x
+    · -- x = a: inner subst gives t, then subst S t = t = subst S (ftvar a)
+      subst h_eq
+      have h_inner : LMonoTy.subst [[(a, t)]] (.ftvar a) = t := by
+        simp [LMonoTy.subst, Subst.hasEmptyScopes, Map.isEmpty, Maps.find?, Map.find?]
+      rw [h_inner]
+      simp [LMonoTy.subst, hS, h_find]
+      exact LMonoTy.subst_idempotent_value S a t h_find h_wf
+    · -- x ≠ a: inner subst is identity
+      have h_inner : LMonoTy.subst [[(a, t)]] (.ftvar x) = .ftvar x := by
+        simp [LMonoTy.subst, Subst.hasEmptyScopes, Map.isEmpty, Maps.find?, Map.find?, h_eq]
+      rw [h_inner]
+  | bitvec n =>
+    simp [LMonoTy.subst]
+  | tcons name args ih =>
+    simp only [LMonoTy.subst, hSingle, hS, Bool.false_eq_true, ↓reduceIte]
+    congr 1
+    exact LMonoTys.subst_absorbs_single S a t args hS hSingle ih
+
+/-!
+When `resolveAux` processes subexpressions, each call extends the substitution.
+The key property is that later substitutions "absorb" earlier ones: applying the
+outer substitution after the inner one is the same as applying the outer alone.
+
+This lets us upgrade typing judgments from an inner substitution to the final one.
+-/
+
+/--
+`S_outer` absorbs `S_inner` means: for every binding `a ↦ t` in `S_inner`,
+`subst S_outer t = subst S_outer (ftvar a)`. In other words, `S_outer` already
+"knows about" every binding in `S_inner`.
+-/
+def Subst.absorbs (S_outer S_inner : Subst) : Prop :=
+  ∀ a t, Maps.find? S_inner a = some t →
+    LMonoTy.subst S_outer t = LMonoTy.subst S_outer (.ftvar a)
+
+/--
+Absorption implies substitution composition collapses:
+`subst S_outer (subst S_inner mty) = subst S_outer mty`.
+-/
+theorem LMonoTy.subst_absorbs (S_outer S_inner : Subst) (mty : LMonoTy)
+    (h : Subst.absorbs S_outer S_inner) :
+    LMonoTy.subst S_outer (LMonoTy.subst S_inner mty) = LMonoTy.subst S_outer mty := by
+  by_cases h_emptyI : Subst.hasEmptyScopes S_inner
+  · rw [LMonoTy.subst_emptyS h_emptyI]
+  · have hInner : Subst.hasEmptyScopes S_inner = false := by
+      revert h_emptyI; cases Subst.hasEmptyScopes S_inner <;> simp
+    induction mty with
+    | ftvar x =>
+      cases h_find : Maps.find? S_inner x with
+      | none =>
+        have : LMonoTy.subst S_inner (.ftvar x) = .ftvar x := by
+          simp [LMonoTy.subst, hInner, h_find]
+        rw [this]
+      | some t =>
+        have : LMonoTy.subst S_inner (.ftvar x) = t := by
+          simp [LMonoTy.subst, hInner, h_find]
+        rw [this]; exact h x t h_find
+    | bitvec n => simp [LMonoTy.subst]
+    | tcons name args ih =>
+      have h_inner : LMonoTy.subst S_inner (.tcons name args) =
+          .tcons name (LMonoTys.subst S_inner args) := by
+        unfold LMonoTy.subst; simp only [hInner, Bool.false_eq_true, ↓reduceIte]
+      rw [h_inner]
+      by_cases h_emptyO : Subst.hasEmptyScopes S_outer
+      · rw [LMonoTy.subst_emptyS h_emptyO, LMonoTy.subst_emptyS h_emptyO]
+        congr 1
+        rw [LMonoTys.subst_eq_substLogic]
+        suffices ∀ xs, (∀ m, m ∈ xs → LMonoTy.subst S_inner m = m) →
+            LMonoTys.substLogic S_inner xs = xs by
+          exact this args (fun m hm => by
+            have := ih m hm
+            simp only [LMonoTy.subst_emptyS h_emptyO] at this; exact this)
+        intro xs; induction xs with
+        | nil => intro _; simp [LMonoTys.substLogic, hInner]
+        | cons a rest ih_rest =>
+          intro ih_cons
+          simp only [LMonoTys.substLogic, hInner, Bool.false_eq_true, ↓reduceIte]
+          rw [ih_cons a List.mem_cons_self,
+              ih_rest (fun m hm => ih_cons m (List.mem_cons_of_mem a hm))]
+      · have hOuter : Subst.hasEmptyScopes S_outer = false := by
+          revert h_emptyO; cases Subst.hasEmptyScopes S_outer <;> simp
+        have h_l : LMonoTy.subst S_outer (.tcons name (LMonoTys.subst S_inner args)) =
+            .tcons name (LMonoTys.subst S_outer (LMonoTys.subst S_inner args)) := by
+          unfold LMonoTy.subst; simp only [hOuter, Bool.false_eq_true, ↓reduceIte]
+        have h_r : LMonoTy.subst S_outer (.tcons name args) =
+            .tcons name (LMonoTys.subst S_outer args) := by
+          unfold LMonoTy.subst; simp only [hOuter, Bool.false_eq_true, ↓reduceIte]
+        rw [h_l, h_r]; congr 1
+        rw [LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic,
+            LMonoTys.subst_eq_substLogic]
+        suffices ∀ xs,
+            (∀ m, m ∈ xs → LMonoTy.subst S_outer (LMonoTy.subst S_inner m) =
+              LMonoTy.subst S_outer m) →
+            LMonoTys.substLogic S_outer (LMonoTys.substLogic S_inner xs) =
+              LMonoTys.substLogic S_outer xs by
+          exact this args (fun m hm => ih m hm)
+        intro xs; induction xs with
+        | nil => intro _; simp [LMonoTys.substLogic, hOuter, hInner]
+        | cons a rest ih_rest =>
+          intro ih_cons
+          simp only [LMonoTys.substLogic, hOuter, hInner, Bool.false_eq_true, ↓reduceIte]
+          rw [ih_cons a List.mem_cons_self,
+              ih_rest (fun m hm => ih_cons m (List.mem_cons_of_mem a hm))]
+
+theorem LMonoTy.subst_eq_of_absorbs (S S_inner : Subst) (ty1 ty2 : LMonoTy)
+    (h_abs : Subst.absorbs S S_inner)
+    (h_eq : LMonoTy.subst S_inner ty1 = LMonoTy.subst S_inner ty2) :
+    LMonoTy.subst S ty1 = LMonoTy.subst S ty2 := by
+  have h1 := (LMonoTy.subst_absorbs S S_inner ty1 h_abs).symm
+  have h2 := LMonoTy.subst_absorbs S S_inner ty2 h_abs
+  rw [h1, h_eq, h2]
+
+/-- Every well-formed substitution absorbs itself. -/
+theorem Subst.absorbs_refl (S : Subst) (h_wf : SubstWF S) :
+    Subst.absorbs S S := by
+  intro a t h_find
+  have h_not_empty := Subst.hasEmptyScopes_false_of_find S a t h_find
+  have : LMonoTy.subst S (.ftvar a) = t := by
+    simp [LMonoTy.subst, h_not_empty, h_find]
+  rw [this]
+  exact LMonoTy.subst_idempotent_value S a t h_find h_wf
+
+/-- Absorption is transitive: if `S2` absorbs `S1` and `S3` absorbs `S2`,
+    then `S3` absorbs `S1`. -/
+theorem Subst.absorbs_trans (S1 S2 S3 : Subst)
+    (h12 : Subst.absorbs S2 S1) (h23 : Subst.absorbs S3 S2) :
+    Subst.absorbs S3 S1 := by
+  intro a t h_find
+  have h1 := h12 a t h_find
+  rw [← LMonoTy.subst_absorbs S3 S2 t h23, h1,
+      LMonoTy.subst_absorbs S3 S2 (.ftvar a) h23]
+
+/--
+Composition lemma: applying a singleton substitution `[[(v, t)]]` followed by
+`[ys]` equals applying the merged substitution `[(v, t) :: ys]`, provided
+`subst [ys] t = t` (i.e., `t` is stable under `ys`).
+
+This is a key lemma for proving that sequential `tinst` applications
+(each substituting one bound variable) produce the same result as a
+single parallel substitution with all bindings.
+-/
+
+theorem LMonoTy.subst_cons_single
+    (v : TyIdentifier) (t : LMonoTy) (ys : SubstOne) (mty : LMonoTy)
+    (h_t : LMonoTy.subst [ys] t = t) :
+    LMonoTy.subst [ys] (LMonoTy.subst [[(v, t)]] mty) =
+    LMonoTy.subst [((v, t) :: ys)] mty := by
+  have hSingle : Subst.hasEmptyScopes [[(v, t)]] = false := by
+    simp [Subst.hasEmptyScopes, Map.isEmpty]
+  have hCons : Subst.hasEmptyScopes [((v, t) :: ys)] = false := by
+    simp [Subst.hasEmptyScopes, Map.isEmpty]
+  by_cases hYs : Subst.hasEmptyScopes [ys]
+  · -- ys is empty, so subst [ys] is identity
+    have h_ys_empty : ys = [] := by
+      simp [Subst.hasEmptyScopes, Map.isEmpty] at hYs
+      cases ys with
+      | nil => rfl
+      | cons _ _ => simp at hYs
+    subst h_ys_empty
+    simp only [LMonoTy.subst_emptyS hYs]
+  · have hYs_ne : Subst.hasEmptyScopes [ys] = false := by
+      revert hYs; cases Subst.hasEmptyScopes [ys] <;> simp
+    induction mty with
+    | ftvar x =>
+      by_cases h_eq : v = x
+      · -- v = x: inner subst gives t, then subst [ys] t = t by h_t
+        subst h_eq
+        have h_inner : LMonoTy.subst [[(v, t)]] (.ftvar v) = t := by
+          simp [LMonoTy.subst, Subst.hasEmptyScopes, Map.isEmpty, Maps.find?, Map.find?]
+        rw [h_inner, h_t]
+        -- RHS: subst [(v,t)::ys] (ftvar v) = t (first match in (v,t)::ys)
+        simp [LMonoTy.subst, hCons, Maps.find?, Map.find?]
+      · -- v ≠ x: inner subst is identity, lookup x in ys
+        have h_inner : LMonoTy.subst [[(v, t)]] (.ftvar x) = .ftvar x := by
+          simp [LMonoTy.subst, Subst.hasEmptyScopes, Map.isEmpty, Maps.find?, Map.find?, h_eq]
+        rw [h_inner]
+        -- Both sides look up x in ys (since v ≠ x, (v,t)::ys skips (v,t))
+        simp [LMonoTy.subst, hYs_ne, hCons, Maps.find?, Map.find?, h_eq]
+    | bitvec n =>
+      simp [LMonoTy.subst]
+    | tcons name args ih =>
+      simp only [LMonoTy.subst, hSingle, hYs_ne, hCons, Bool.false_eq_true, ↓reduceIte]
+      congr 1
+      rw [LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic,
+          LMonoTys.subst_eq_substLogic]
+      suffices ∀ xs,
+          (∀ m, m ∈ xs → LMonoTy.subst [ys] (LMonoTy.subst [[(v, t)]] m) =
+            LMonoTy.subst [((v, t) :: ys)] m) →
+          LMonoTys.substLogic [ys] (LMonoTys.substLogic [[(v, t)]] xs) =
+            LMonoTys.substLogic [((v, t) :: ys)] xs by
+        exact this args ih
+      intro xs; induction xs with
+      | nil => intro _; simp [LMonoTys.substLogic, hSingle, hYs_ne, hCons]
+      | cons a rest ih_rest =>
+        intro ih_xs
+        simp only [LMonoTys.substLogic, hSingle, hYs_ne, hCons, Bool.false_eq_true, ↓reduceIte]
+        rw [ih_xs a List.mem_cons_self,
+            ih_rest (fun m hm => ih_xs m (List.mem_cons_of_mem a hm))]
+
+-- Helper: applyLogic preserves some bindings.
+private theorem Map.find?_applyLogic_some_h' {new old : SubstOne} {a : TyIdentifier} {t : LMonoTy}
+    (h : Map.find? old a = some t) :
+    Map.find? (SubstOne.applyLogic new old) a = some (LMonoTy.subst [new] t) := by
+  induction old with
+  | nil => simp [Map.find?] at h
+  | cons hd rest ih =>
+    simp only [SubstOne.applyLogic, Map.find?]
+    simp only [Map.find?] at h
+    grind
+
+-- Helper: applyLogic preserves none bindings.
+private theorem Map.find?_applyLogic_none_h' {new old : SubstOne} {a : TyIdentifier}
+    (h : Map.find? old a = none) :
+    Map.find? (SubstOne.applyLogic new old) a = none := by
+  induction old with
+  | nil => simp [SubstOne.applyLogic, Map.find?]
+  | cons hd rest ih =>
+    simp [SubstOne.applyLogic, Map.find?]
+    simp [Map.find?] at h
+    grind
+
+-- Helper: Subst.apply preserves some bindings.
+private theorem Maps.find?_apply_some_h' {new : SubstOne} {old : Subst} {a : TyIdentifier} {t : LMonoTy}
+    (h : Maps.find? old a = some t) :
+    Maps.find? (Subst.apply new old) a = some (LMonoTy.subst [new] t) := by
+  induction old with
+  | nil => simp [Maps.find?] at h
+  | cons m rest ih =>
+    simp only [Subst.apply, Maps.find?]
+    simp only [Maps.find?] at h
+    rw [SubstOne.apply_eq_applyLogic]
+    cases h_ma : Map.find? m a with
+    | none =>
+      rw [h_ma] at h
+      rw [Map.find?_applyLogic_none_h' h_ma]
+      exact ih h
+    | some val =>
+      rw [h_ma] at h; simp only [Option.some.injEq] at h; subst h
+      rw [Map.find?_applyLogic_some_h' h_ma]
+
+-- Helper: Except.mapError preserves ok values.
+private theorem Except.mapError_ok_h' {α β γ : Type} {f : α → β} {e : Except α γ} {v : γ}
+    (h : Except.mapError f e = .ok v) : e = .ok v := by
+  cases e with
+  | error a => simp [Except.mapError] at h
+  | ok val => simp [Except.mapError] at h; exact congrArg Except.ok h
+
+-- Helper: insert+apply produces an absorbing substitution.
+private theorem absorbs_of_insert_apply_h' (S : SubstInfo) (id : TyIdentifier) (lty : LMonoTy)
+    (h_none : Maps.find? S.subst id = none)
+    (h_wf : SubstWF ((Subst.apply [(id, lty)] S.subst).insert id lty)) :
+    Subst.absorbs ((Subst.apply [(id, lty)] S.subst).insert id lty) S.subst := by
+  intro a t h_find
+  have h_a_ne_id : a ≠ id := by
+    intro h_eq; subst h_eq; rw [h_find] at h_none; simp at h_none
+  let S_new := (Subst.apply [(id, lty)] S.subst).insert id lty
+  have h_apply_a := Maps.find?_apply_some_h' (new := [(id, lty)]) h_find
+  have h_find_new : Maps.find? S_new a = some (LMonoTy.subst [[(id, lty)]] t) := by
+    show Maps.find? (Maps.insert _ id lty) a = _
+    rw [Maps.find?_insert_ne _ _ _ _ h_a_ne_id]
+    exact h_apply_a
+  have h_find_id : Maps.find? S_new id = some lty := Maps.find?_insert_self _ id lty
+  have h_not_empty := Subst.hasEmptyScopes_false_of_find S_new a _ h_find_new
+  have h_subst_ftvar : LMonoTy.subst S_new (.ftvar a) = LMonoTy.subst [[(id, lty)]] t := by
+    simp [LMonoTy.subst, h_not_empty, h_find_new]
+  have h_idem := LMonoTy.subst_idempotent_value S_new a _ h_find_new h_wf
+  have h_abs := LMonoTy.subst_absorbs_single S_new id lty t h_find_id h_wf
+  rw [h_subst_ftvar, ← h_abs, h_idem]
+
+/-- After inserting `(id, lty)` into the applied substitution, `subst _ (ftvar id) = lty`. -/
+private theorem subst_ftvar_new_binding
+    (S : Subst) (id : TyIdentifier) (lty : LMonoTy)
+    (_h_none : Maps.find? S id = none) :
+    LMonoTy.subst (Maps.insert (Subst.apply [(id, lty)] S) id lty) (LMonoTy.ftvar id) = lty := by
+  have h_find := Maps.find?_insert_self (Subst.apply [(id, lty)] S) id lty
+  have h_not_empty : ¬Subst.hasEmptyScopes (Maps.insert (Subst.apply [(id, lty)] S) id lty) := by
+    intro h_empty
+    exact absurd ((Subst.isEmpty_implies_keys_empty h_empty) ▸ Maps.find?_mem_keys _ h_find) (by simp)
+  unfold LMonoTy.subst; simp [h_not_empty, h_find]
+
+/-- When `S.find? id = none`, the new substitution absorbs `S` and maps `orig_lty` to `lty`. -/
+private theorem subst_orig_new_binding
+    (S : Subst) (id : TyIdentifier) (lty orig_lty : LMonoTy)
+    (h_none : Maps.find? S id = none)
+    (h_lty : lty = LMonoTy.subst S orig_lty)
+    (h_occurs : ¬(id ∈ lty.freeVars)) :
+    LMonoTy.subst (Maps.insert (Subst.apply [(id, lty)] S) id lty) orig_lty = lty := by
+  subst h_lty
+  have h_find_S'_id : Maps.find? (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
+      id (LMonoTy.subst S orig_lty)) id = some (LMonoTy.subst S orig_lty) :=
+    Maps.find?_insert_self _ _ _
+  have hS' : Subst.hasEmptyScopes (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
+      id (LMonoTy.subst S orig_lty)) = false :=
+    Subst.hasEmptyScopes_false_of_find _ id _ h_find_S'_id
+  have h_find_ne : ∀ x, x ≠ id →
+      Maps.find? (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
+        id (LMonoTy.subst S orig_lty)) x =
+      (Maps.find? S x).map (LMonoTy.subst [[(id, LMonoTy.subst S orig_lty)]]) := fun x hx =>
+    (Maps.find?_insert_ne _ _ _ _ hx).trans (Subst.find?_apply _ _ _)
+  have h_single_noop : ∀ t : LMonoTy, ¬(id ∈ t.freeVars) →
+      LMonoTy.subst [[(id, LMonoTy.subst S orig_lty)]] t = t := fun t ht =>
+    LMonoTy.subst_no_relevant_keys _ _ (fun x hx => by
+      simp [Maps.keys, Map.keys]; intro heq; subst heq; exact ht hx)
+  by_cases hS : Subst.hasEmptyScopes S
+  · simp only [LMonoTy.subst_emptyS hS] at h_occurs h_find_ne ⊢
+    apply LMonoTy.subst_no_relevant_keys
+    intro x hx
+    have h_ne : x ≠ id := fun h => h_occurs (h ▸ hx)
+    exact Maps.find?_of_not_mem_values _ (by
+      rw [h_find_ne x h_ne, Maps.not_mem_keys_find?_none' S x
+        ((Subst.isEmpty_implies_keys_empty hS) ▸ (by simp))]; simp)
+  · have hS_ne : Subst.hasEmptyScopes S = false := by
+      revert hS; cases Subst.hasEmptyScopes S <;> simp
+    suffices ∀ mty, ¬(id ∈ (LMonoTy.subst S mty).freeVars) →
+        LMonoTy.subst (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
+          id (LMonoTy.subst S orig_lty)) mty = LMonoTy.subst S mty from
+      this orig_lty h_occurs
+    intro mty h_nf
+    induction mty with
+    | ftvar x =>
+      by_cases h_id : x = id
+      · subst h_id; exfalso; apply h_nf
+        simp [LMonoTy.subst, hS_ne, h_none, LMonoTy.freeVars]
+      · unfold LMonoTy.subst
+        simp only [hS', hS_ne, Bool.false_eq_true, ↓reduceIte, h_find_ne x h_id]
+        cases h_fx : Maps.find? S x with
+        | none => simp
+        | some t =>
+          simp only [Option.map]
+          exact h_single_noop t (by
+            have : LMonoTy.subst S (.ftvar x) = t := by
+              simp [LMonoTy.subst, hS_ne, h_fx]
+            rwa [this] at h_nf)
+    | bitvec n => simp [LMonoTy.subst]
+    | tcons name args ih =>
+      unfold LMonoTy.subst
+      simp only [hS', hS_ne, Bool.false_eq_true, ↓reduceIte]
+      congr 1
+      rw [LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic]
+      have h_nf' : ¬(id ∈ LMonoTys.freeVars (LMonoTys.substLogic S args)) := by
+        have h_eq : LMonoTy.subst S (.tcons name args) =
+            .tcons name (LMonoTys.subst S args) := by
+          unfold LMonoTy.subst; simp [hS_ne]
+        simp only [h_eq, LMonoTy.freeVars, LMonoTys.subst_eq_substLogic] at h_nf
+        exact h_nf
+      suffices ∀ xs,
+          (∀ m, m ∈ xs → ¬(id ∈ (LMonoTy.subst S m).freeVars) →
+            LMonoTy.subst (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
+              id (LMonoTy.subst S orig_lty)) m = LMonoTy.subst S m) →
+          ¬(id ∈ LMonoTys.freeVars (LMonoTys.substLogic S xs)) →
+          LMonoTys.substLogic (Maps.insert (Subst.apply [(id, LMonoTy.subst S orig_lty)] S)
+            id (LMonoTy.subst S orig_lty)) xs = LMonoTys.substLogic S xs by
+        exact this args (fun m hm h_nfm => ih m hm h_nfm) h_nf'
+      intro xs; induction xs with
+      | nil => intros; simp [LMonoTys.substLogic, hS', hS_ne]
+      | cons a rest ih_rest =>
+        intro ih_xs h_nf_xs
+        simp only [LMonoTys.substLogic, hS', hS_ne, Bool.false_eq_true, ↓reduceIte]
+        have h_eq_cons : LMonoTys.substLogic S (a :: rest) =
+            LMonoTy.subst S a :: LMonoTys.substLogic S rest := by
+          simp [LMonoTys.substLogic, hS_ne]
+        rw [h_eq_cons, LMonoTys.freeVars_of_cons] at h_nf_xs
+        have h1 : ¬(id ∈ (LMonoTy.subst S a).freeVars) :=
+          fun h => h_nf_xs (List.mem_append_left _ h)
+        have h2 : ¬(id ∈ LMonoTys.freeVars (LMonoTys.substLogic S rest)) :=
+          fun h => h_nf_xs (List.mem_append_right _ h)
+        rw [ih_xs a (.head _) h1,
+            ih_rest (fun m hm => ih_xs m (.tail _ hm)) h2]
+
+/-- Bundled result for the three properties proved simultaneously about `unifyOne`:
+    soundness (constraint is equalized), absorption (output absorbs input),
+    and key inclusion (output keys come from input keys, constraint freeVars,
+    or input value freeVars). -/
+structure Constraint.UnifyOneProperties (c : Constraint) (S : SubstInfo)
+    (relS : ValidSubstRelation [c] S) : Prop where
+  sound : LMonoTy.subst relS.newS.subst c.1 = LMonoTy.subst relS.newS.subst c.2
+  absorbs : Subst.absorbs relS.newS.subst S.subst
+  keys_incl : ∀ k, k ∈ Maps.keys relS.newS.subst →
+    k ∈ Maps.keys S.subst ∨ k ∈ Constraint.freeVars c ∨ k ∈ Subst.freeVars S.subst
+
+/-- Bundled result for the three properties proved simultaneously about `unifyCore`. -/
+structure Constraints.UnifyCoreProperties (cs : Constraints) (S : SubstInfo)
+    (relS : ValidSubstRelation cs S) : Prop where
+  sound : ∀ p, p ∈ cs → LMonoTy.subst relS.newS.subst p.1 = LMonoTy.subst relS.newS.subst p.2
+  absorbs : Subst.absorbs relS.newS.subst S.subst
+  keys_incl : ∀ k, k ∈ Maps.keys relS.newS.subst →
+    k ∈ Maps.keys S.subst ∨ k ∈ Constraints.freeVars cs ∨ k ∈ Subst.freeVars S.subst
+
+-- Combined soundness, absorption, and key-inclusion for `unifyOne`/`unifyCore`.
+-- A single mutual induction on `Constraint.unifyOne.induct` proves all three
+-- properties simultaneously, sharing the 17-case decomposition.
+--
+-- The theorem proves `motive1` (for `unifyOne`) directly; `motive2` (for
+-- `unifyCore`) is proved as part of the same induction and is exposed
+-- separately via `Constraints.unifyCore_sound`.
+theorem Constraint.unifyOne_sound (c : Constraint) (S : SubstInfo)
+    (relS : ValidSubstRelation [c] S)
+    (h : Constraint.unifyOne c S = .ok relS) :
+    Constraint.UnifyOneProperties c S relS := by
+  suffices ∀ relS, Constraint.unifyOne c S = .ok relS →
+      Constraint.UnifyOneProperties c S relS from this relS h
+  apply Constraint.unifyOne.induct
+    (motive1 := fun c S => ∀ relS, Constraint.unifyOne c S = .ok relS →
+      Constraint.UnifyOneProperties c S relS)
+    (motive2 := fun cs S => ∀ relS, Constraints.unifyCore cs S = .ok relS →
+      Constraints.UnifyCoreProperties cs S relS)
+  -- Case 1: t1 == t2
+  · intro S t1 t2 h_eq _ relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
+    · simp only [Except.ok.injEq] at h; subst h
+      exact ⟨by grind, Subst.absorbs_refl S.subst S.isWF, fun k hk => Or.inl hk⟩
+    · exact absurd h_eq ‹_›
+  -- Case 2: ftvar id, orig_lty; ftvar id == lty
+  · intro S id orig_lty h_neq _lty _ _ h_eq_lty relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
+    · exact absurd ‹_› h_neq
+    · simp only [Except.ok.injEq] at h; subst h
+      refine ⟨?_, Subst.absorbs_refl S.subst S.isWF, fun k hk => Or.inl hk⟩
+      show LMonoTy.subst S.subst (.ftvar id) = LMonoTy.subst S.subst orig_lty
+      have h_id_eq : LMonoTy.ftvar id = LMonoTy.subst S.subst orig_lty := eq_of_beq h_eq_lty
+      rw [h_id_eq]; exact LMonoTy.subst_idempotent S.subst S.isWF orig_lty
+  -- Case 3: ftvar id, orig_lty; occurs check — error
+  · intro S id orig_lty h_neq _lty _ _ h_neq_lty h_occurs relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h <;> grind
+  -- Case 4: ftvar id, orig_lty; some sty — recursive
+  · intro S id orig_lty h_neq _lty _ _ h_neq_lty h_not_occurs sty h_some ih_rec relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
+    · exact absurd ‹_› h_neq
+    · split at h
+      · rename_i sty' h_some'
+        rw [h_some] at h_some'; simp only [Option.some.injEq] at h_some'; subst h_some'
+        simp only [bind, Except.bind] at h
+        split at h
+        · simp at h
+        · rename_i relS' h_call
+          simp only [Except.ok.injEq] at h; rw [← h]
+          have ih := ih_rec relS' h_call
+          -- Absorption (from IH)
+          have h_abs := ih.absorbs
+          -- Soundness: subst S' (ftvar id) = subst S' orig_lty
+          have h_sound : LMonoTy.subst relS'.newS.subst (.ftvar id) =
+              LMonoTy.subst relS'.newS.subst orig_lty := by
+            have h_ftvar : LMonoTy.subst relS'.newS.subst (.ftvar id) =
+                LMonoTy.subst relS'.newS.subst sty := by
+              have := h_abs id sty h_some; simp only [this]
+            have h_orig : LMonoTy.subst relS'.newS.subst (LMonoTy.subst S.subst orig_lty) =
+                LMonoTy.subst relS'.newS.subst orig_lty :=
+              LMonoTy.subst_absorbs relS'.newS.subst S.subst orig_lty h_abs
+            rw [h_ftvar, ih.sound, h_orig]
+          -- Key inclusion (from IH, lifting freeVars)
+          have h_keys : ∀ k, k ∈ Maps.keys relS'.newS.subst →
+              k ∈ Maps.keys S.subst ∨
+              k ∈ Constraint.freeVars (LMonoTy.ftvar id, orig_lty) ∨
+              k ∈ Subst.freeVars S.subst := by
+            intro k hk
+            rcases ih.keys_incl k hk with h1 | h2 | h3
+            · left; exact h1
+            · simp only [Constraint.freeVars, List.mem_append] at h2
+              rcases h2 with h_sty | h_lty
+              · right; right; exact Subst.freeVars_of_find_subset S.subst h_some h_sty
+              · rcases List.mem_append.mp (LMonoTy.freeVars_of_subst_subset S.subst orig_lty h_lty) with
+                  h_orig | h_vals
+                · right; left; simp [Constraint.freeVars]; right; exact h_orig
+                · right; right; exact h_vals
+            · right; right; exact h3
+          exact ⟨h_sound, h_abs, h_keys⟩
+      · rename_i h_none; rw [h_some] at h_none; simp at h_none
+  -- Case 5: ftvar id, orig_lty; none — insert+apply
+  · intro S id orig_lty h_neq _lty _ _ h_neq_lty h_not_occurs h_none _ _ _ns h' _nS _ _ relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
+    · exact absurd ‹_› h_neq
+    · split at h
+      · rename_i sty h_some; rw [h_none] at h_some; simp at h_some
+      · simp only [Except.ok.injEq] at h; subst h
+        refine ⟨?_, ?_, ?_⟩
+        · -- Soundness
+          exact Eq.trans
+            (subst_ftvar_new_binding S.subst id (LMonoTy.subst S.subst orig_lty) h_none)
+            (subst_orig_new_binding S.subst id (LMonoTy.subst S.subst orig_lty)
+              orig_lty h_none rfl h_not_occurs).symm
+        · -- Absorption
+          exact absorbs_of_insert_apply_h' S id (LMonoTy.subst S.subst orig_lty) h_none
+            (SubstWF.cons_of_subst_apply S id orig_lty _ rfl
+              (SubstWF.single_subst id h_not_occurs) (SubstWF.apply_one_substituted_type S id orig_lty))
+        · -- Key inclusion
+          intro k hk
+          have hk' := Maps.insert_keys_subset (ms := Subst.apply [(_,_)] S.subst) (key := _) (val := _) hk
+          rw [Subst.keys_of_apply_eq] at hk'
+          rcases List.mem_cons.mp hk' with rfl | h_old
+          · right; left; simp [Constraint.freeVars, LMonoTy.freeVars]
+          · left; exact h_old
+  -- Case 6: orig_lty, ftvar id; ftvar id == lty
+  · intro S orig_lty id h_neq _ _lty _ _ h_eq_lty relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
+    · exact absurd ‹_› h_neq
+    · simp only [Except.ok.injEq] at h; subst h
+      refine ⟨?_, Subst.absorbs_refl S.subst S.isWF, fun k hk => Or.inl hk⟩
+      show LMonoTy.subst S.subst orig_lty = LMonoTy.subst S.subst (.ftvar id)
+      have h_id_eq : LMonoTy.ftvar id = LMonoTy.subst S.subst orig_lty := eq_of_beq h_eq_lty
+      rw [h_id_eq]; exact (LMonoTy.subst_idempotent S.subst S.isWF orig_lty).symm
+  -- Case 7: orig_lty, ftvar id; occurs check — error
+  · intro S orig_lty id h_neq _ _lty _ _ h_neq_lty h_occurs relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
+    · exact absurd ‹_› h_neq
+    · simp at h
+  -- Case 8: orig_lty, ftvar id; some sty — recursive (symmetric to case 4)
+  · intro S orig_lty id h_neq _ _lty _ _ h_neq_lty h_not_occurs sty h_some ih_rec relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
+    · exact absurd ‹_› h_neq
+    · split at h
+      · rename_i sty' h_some'
+        rw [h_some] at h_some'; simp only [Option.some.injEq] at h_some'; subst h_some'
+        simp only [bind, Except.bind] at h
+        split at h
+        · simp at h
+        · rename_i relS' h_call
+          simp only [Except.ok.injEq] at h; rw [← h]
+          have ih := ih_rec relS' h_call
+          have h_abs := ih.absorbs
+          -- Soundness: subst S' orig_lty = subst S' (ftvar id)
+          have h_sound : LMonoTy.subst relS'.newS.subst orig_lty =
+              LMonoTy.subst relS'.newS.subst (.ftvar id) := by
+            have h_ftvar : LMonoTy.subst relS'.newS.subst (.ftvar id) =
+                LMonoTy.subst relS'.newS.subst sty := by
+              have := h_abs id sty h_some; simp only [this]
+            have h_orig : LMonoTy.subst relS'.newS.subst (LMonoTy.subst S.subst orig_lty) =
+                LMonoTy.subst relS'.newS.subst orig_lty :=
+              LMonoTy.subst_absorbs relS'.newS.subst S.subst orig_lty h_abs
+            rw [← h_orig, ← ih.sound, h_ftvar]
+          -- Key inclusion (symmetric to case 4)
+          have h_keys : ∀ k, k ∈ Maps.keys relS'.newS.subst →
+              k ∈ Maps.keys S.subst ∨
+              k ∈ Constraint.freeVars (orig_lty, LMonoTy.ftvar id) ∨
+              k ∈ Subst.freeVars S.subst := by
+            intro k hk
+            rcases ih.keys_incl k hk with h1 | h2 | h3
+            · left; exact h1
+            · simp only [Constraint.freeVars, List.mem_append] at h2
+              rcases h2 with h_sty | h_lty
+              · right; right; exact Subst.freeVars_of_find_subset S.subst h_some h_sty
+              · rcases List.mem_append.mp (LMonoTy.freeVars_of_subst_subset S.subst orig_lty h_lty) with
+                  h_orig | h_vals
+                · right; left; simp [Constraint.freeVars]; left; exact h_orig
+                · right; right; exact h_vals
+            · right; right; exact h3
+          exact ⟨h_sound, h_abs, h_keys⟩
+      · rename_i h_none; rw [h_some] at h_none; simp at h_none
+  -- Case 9: orig_lty, ftvar id; none — insert+apply (symmetric to case 5)
+  · intro S orig_lty id h_neq _ _lty _ _ h_neq_lty h_not_occurs h_none _ _ _ns h' _nS _ _ relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
+    · exact absurd ‹_› h_neq
+    · split at h
+      · rename_i sty h_some; rw [h_none] at h_some; simp at h_some
+      · simp only [Except.ok.injEq] at h; subst h
+        refine ⟨?_, ?_, ?_⟩
+        · -- Soundness
+          exact Eq.symm (Eq.trans
+            (subst_ftvar_new_binding S.subst id (LMonoTy.subst S.subst orig_lty) h_none)
+            (subst_orig_new_binding S.subst id (LMonoTy.subst S.subst orig_lty)
+              orig_lty h_none rfl h_not_occurs).symm)
+        · -- Absorption
+          exact absorbs_of_insert_apply_h' S id (LMonoTy.subst S.subst orig_lty) h_none
+            (SubstWF.cons_of_subst_apply S id orig_lty _ rfl
+              (SubstWF.single_subst id h_not_occurs) (SubstWF.apply_one_substituted_type S id orig_lty))
+        · -- Key inclusion
+          intro k hk
+          have hk' := Maps.insert_keys_subset (ms := Subst.apply [(_,_)] S.subst) (key := _) (val := _) hk
+          rw [Subst.keys_of_apply_eq] at hk'
+          rcases List.mem_cons.mp hk' with rfl | h_old
+          · right; left; simp [Constraint.freeVars, LMonoTy.freeVars]
+          · left; exact h_old
+  -- Case 10: bitvec n1 == n2 contradiction
+  · intro S n1 n2 h_neq h_eq_n relS h; grind
+  -- Case 11: bitvec n1 ≠ n2 — error
+  · intro S n1 n2 h_neq h_neq_n relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h <;> grind
+  -- Case 12: tcons match — recursive unifyCore
+  · intro S name1 args1 name2 args2 h_neq h_match _nc ih_core relS h
+    rw [Constraint.unifyOne.eq_def] at h; simp only at h; split at h
+    · exact absurd ‹_› h_neq
+    · simp only [bind, Except.bind] at h
+      split at h
+      · simp at h
+      · rename_i relS' h_call
+        simp only [Except.ok.injEq] at h; rw [← h]
+        have ih := ih_core relS' h_call
+        refine ⟨?_, ih.absorbs, ?_⟩
+        · -- Soundness: subst S' (tcons name1 args1) = subst S' (tcons name2 args2)
+          have h_name_eq : name1 = name2 := by
+            have := (Bool.and_eq_true _ _ ▸ h_match : _ ∧ _).1; exact eq_of_beq this
+          have h_len_eq : args1.length = args2.length := by
+            have := (Bool.and_eq_true _ _ ▸ h_match : _ ∧ _).2; exact of_decide_eq_true this
+          subst h_name_eq
+          have ih_pw := ih.sound
+          have h_args_eq : ∀ (l1 l2 : LMonoTys), l1.length = l2.length →
+              (∀ p, p ∈ l1.zip l2 →
+                LMonoTy.subst relS'.newS.subst p.1 = LMonoTy.subst relS'.newS.subst p.2) →
+              LMonoTys.subst relS'.newS.subst l1 = LMonoTys.subst relS'.newS.subst l2 := by
+            intro l1 l2 h_len h_pw
+            rw [LMonoTys.subst_eq_substLogic, LMonoTys.subst_eq_substLogic]
+            by_cases hS : Subst.hasEmptyScopes relS'.newS.subst
+            · have h_id : ∀ l, LMonoTys.substLogic relS'.newS.subst l = l := by
+                intro l; induction l with
+                | nil => simp [LMonoTys.substLogic, hS]
+                | cons _ _ _ => simp [LMonoTys.substLogic, hS]
+              rw [h_id, h_id]
+              induction l1 generalizing l2 with
+              | nil => cases l2 with | nil => rfl | cons _ _ => simp at h_len
+              | cons a rest ih_l =>
+                cases l2 with
+                | nil => simp at h_len
+                | cons b rest2 =>
+                  simp at h_len
+                  have h_ab := h_pw (a, b) List.mem_cons_self
+                  simp [LMonoTy.subst_emptyS hS] at h_ab
+                  rw [h_ab, ih_l rest2 h_len fun p hp => h_pw p (List.mem_cons_of_mem _ hp)]
+            · have hS_ne : Subst.hasEmptyScopes relS'.newS.subst = false := by
+                revert hS; cases Subst.hasEmptyScopes relS'.newS.subst <;> simp
+              induction l1 generalizing l2 with
+              | nil => cases l2 with | nil => simp [LMonoTys.substLogic, hS_ne] | cons _ _ => simp at h_len
+              | cons a rest ih_l =>
+                cases l2 with
+                | nil => simp at h_len
+                | cons b rest2 =>
+                  simp at h_len
+                  simp only [LMonoTys.substLogic, hS_ne, Bool.false_eq_true, ↓reduceIte]
+                  have h_ab : LMonoTy.subst relS'.newS.subst a = LMonoTy.subst relS'.newS.subst b :=
+                    h_pw (a, b) List.mem_cons_self
+                  rw [h_ab, ih_l rest2 h_len fun p hp => h_pw p (List.mem_cons_of_mem _ hp)]
+          have h_list := h_args_eq args1 args2 h_len_eq ih_pw
+          by_cases hS_final : Subst.hasEmptyScopes relS'.newS.subst
+          · simp [LMonoTy.subst_emptyS hS_final]
+            simp [LMonoTys.subst, hS_final] at h_list; rw [h_list]
+          · have hS_ne : Subst.hasEmptyScopes relS'.newS.subst = false := by
+              revert hS_final; cases Subst.hasEmptyScopes relS'.newS.subst <;> simp
+            simp [LMonoTy.subst, hS_ne]; exact h_list
+        · -- Key inclusion
+          intro k hk
+          rcases ih.keys_incl k hk with h1 | h2 | h3
+          · left; exact h1
+          · right; left; simp only [Constraint.freeVars, LMonoTy.freeVars, List.mem_append]
+            exact List.mem_append.mp (Constraints.freeVars_of_zip_subset h2)
+          · right; right; exact h3
+  -- Case 13: tcons name/length mismatch — error
+  · intro S name1 args1 name2 args2 h_neq h_mismatch relS h
+    rw [Constraint.unifyOne.eq_def] at h; grind
+  -- Case 14: bitvec, tcons — error
+  · intro S size name args h_neq relS h
+    rw [Constraint.unifyOne.eq_def] at h; grind
+  -- Case 15: tcons, bitvec — error
+  · intro S name args size h_neq relS h
+    rw [Constraint.unifyOne.eq_def] at h; grind
+  -- Case 16: unifyCore []
+  · intro S relS h
+    rw [Constraints.unifyCore.eq_def] at h; simp only at h
+    simp only [Except.ok.injEq] at h; subst h
+    exact ⟨fun p hp => by grind, Subst.absorbs_refl S.subst S.isWF, fun k hk => Or.inl hk⟩
+  -- Case 17: unifyCore c :: rest
+  · intro S c c_rest ih1 ih2 relS h
+    rw [Constraints.unifyCore.eq_def] at h; simp only at h
+    simp only [Bind.bind, Except.bind, Except.mapError] at h
+    split at h
+    · simp at h
+    · rename_i relS_one h_one_raw
+      have h_one := Except.mapError_ok_h' h_one_raw
+      split at h
+      · simp at h
+      · rename_i relS_rest h_rest
+        simp only [Except.ok.injEq] at h; subst h
+        have ih_one := ih1 relS_one h_one
+        have ih_rest := ih2 relS_one relS_rest h_rest
+        refine ⟨?_, ?_, ?_⟩
+        · -- Soundness: all pairs in c :: c_rest are equalized
+          intro p hp
+          cases List.mem_cons.mp hp with
+          | inl h_pc =>
+            subst h_pc
+            have h_sound_one := ih_one.sound
+            have h_abs := ih_rest.absorbs
+            calc LMonoTy.subst relS_rest.newS.subst p.1
+                = LMonoTy.subst relS_rest.newS.subst (LMonoTy.subst relS_one.newS.subst p.1) :=
+                  (LMonoTy.subst_absorbs _ _ _ h_abs).symm
+              _ = LMonoTy.subst relS_rest.newS.subst (LMonoTy.subst relS_one.newS.subst p.2) := by
+                  rw [h_sound_one]
+              _ = LMonoTy.subst relS_rest.newS.subst p.2 :=
+                  LMonoTy.subst_absorbs _ _ _ h_abs
+          | inr h_rest_mem =>
+            exact ih_rest.sound p h_rest_mem
+        · -- Absorption: transitive
+          exact Subst.absorbs_trans S.subst relS_one.newS.subst relS_rest.newS.subst
+            ih_one.absorbs ih_rest.absorbs
+        · -- Key inclusion
+          intro k hk
+          rcases ih_rest.keys_incl k hk with hk1 | hk2 | hk3
+          · rcases ih_one.keys_incl k hk1 with h1a | h1b | h1c
+            · left; exact h1a
+            · right; left; simp [Constraints.freeVars]; left; exact h1b
+            · right; right; exact h1c
+          · right; left; simp [Constraints.freeVars]; right; exact hk2
+          · rcases List.mem_append.mp (relS_one.goodSubset hk3) with h_c | h_s
+            · right; left; simp [Constraints.freeVars]; left
+              simp [Constraints.freeVars] at h_c; exact h_c
+            · right; right; exact h_s
+
+/-- Combined soundness, absorption, and key-inclusion for `unifyCore`.
+    Proved by simple list induction, delegating to `Constraint.unifyOne_sound`
+    for each head constraint. -/
+theorem Constraints.unifyCore_sound (cs : Constraints) (S : SubstInfo)
+    (relS : ValidSubstRelation cs S)
+    (h : Constraints.unifyCore cs S = .ok relS) :
+    Constraints.UnifyCoreProperties cs S relS := by
+  induction cs generalizing S with
+  | nil =>
+    rw [Constraints.unifyCore.eq_def] at h; simp only at h
+    simp only [Except.ok.injEq] at h; subst h
+    exact ⟨fun p hp => by grind, Subst.absorbs_refl S.subst S.isWF, fun k hk => Or.inl hk⟩
+  | cons c rest ih =>
+    rw [Constraints.unifyCore.eq_def] at h; simp only at h
+    simp only [Bind.bind, Except.bind, Except.mapError] at h
+    split at h
+    · simp at h
+    · rename_i relS_one h_one_raw
+      have h_one := Except.mapError_ok_h' h_one_raw
+      split at h
+      · simp at h
+      · rename_i relS_rest h_rest
+        simp only [Except.ok.injEq] at h; subst h
+        have ih_one := Constraint.unifyOne_sound c S relS_one h_one
+        have ih_rest := ih relS_one.newS relS_rest h_rest
+        refine ⟨?_, ?_, ?_⟩
+        · -- Soundness
+          intro p hp
+          cases List.mem_cons.mp hp with
+          | inl h_pc =>
+            subst h_pc
+            have h_abs := ih_rest.absorbs
+            calc LMonoTy.subst relS_rest.newS.subst p.1
+                = LMonoTy.subst relS_rest.newS.subst (LMonoTy.subst relS_one.newS.subst p.1) :=
+                  (LMonoTy.subst_absorbs _ _ _ h_abs).symm
+              _ = LMonoTy.subst relS_rest.newS.subst (LMonoTy.subst relS_one.newS.subst p.2) := by
+                  rw [ih_one.sound]
+              _ = LMonoTy.subst relS_rest.newS.subst p.2 :=
+                  LMonoTy.subst_absorbs _ _ _ h_abs
+          | inr h_rest_mem =>
+            exact ih_rest.sound p h_rest_mem
+        · -- Absorption
+          exact Subst.absorbs_trans S.subst relS_one.newS.subst relS_rest.newS.subst
+            ih_one.absorbs ih_rest.absorbs
+        · -- Key inclusion
+          intro k hk
+          rcases ih_rest.keys_incl k hk with hk1 | hk2 | hk3
+          · rcases ih_one.keys_incl k hk1 with h1a | h1b | h1c
+            · left; exact h1a
+            · right; left; simp [Constraints.freeVars]; left; exact h1b
+            · right; right; exact h1c
+          · right; left; simp [Constraints.freeVars]; right; exact hk2
+          · rcases List.mem_append.mp (relS_one.goodSubset hk3) with h_c | h_s
+            · right; left; simp [Constraints.freeVars]; left
+              simp [Constraints.freeVars] at h_c; exact h_c
+            · right; right; exact h_s
+
+/-- Unification produces a substitution that absorbs the input substitution. -/
+theorem Constraints.unify_absorbs (constraints : Constraints) (S_old S_new : SubstInfo)
+    (h : Constraints.unify constraints S_old = .ok S_new) :
+    Subst.absorbs S_new.subst S_old.subst := by
+  simp only [Constraints.unify, bind, Except.bind] at h
+  split at h
+  · simp at h
+  · rename_i relS h_core
+    simp only [Except.ok.injEq] at h; subst h
+    exact (Constraints.unifyCore_sound constraints S_old relS h_core).absorbs
+
+/-- Unification produces a substitution that makes every constraint pair equal. -/
+theorem Constraints.unify_sound (constraints : Constraints) (S_old S_new : SubstInfo)
+    (h : Constraints.unify constraints S_old = .ok S_new) :
+    ∀ p, p ∈ constraints →
+      LMonoTy.subst S_new.subst p.1 = LMonoTy.subst S_new.subst p.2 := by
+  simp only [Constraints.unify, bind, Except.bind] at h
+  split at h
+  · simp at h
+  · rename_i relS h_core
+    simp only [Except.ok.injEq] at h; subst h
+    exact (Constraints.unifyCore_sound constraints S_old relS h_core).sound
+
+end -- public section
+end Lambda
diff --git a/Strata/DL/Lambda/Preconditions.lean b/Strata/DL/Lambda/Preconditions.lean
index 1057d3cd27..f24fe64199 100644
--- a/Strata/DL/Lambda/Preconditions.lean
+++ b/Strata/DL/Lambda/Preconditions.lean
@@ -98,6 +98,19 @@ where
           let lhsObs := go F lhs implications
           let rhsObs := go F rhs ((md, lhs) :: implications)
           lhsObs ++ rhsObs
+        else if opName == (@boolAndFunc T).name then
+          -- Short-circuit &&: rhs is only reached when lhs is true.
+          -- E.g. `0 <= j && j < n && Sequence.select(s, j)` — the prefix
+          -- is a hypothesis for the select's out-of-bounds check.
+          let lhsObs := go F lhs implications
+          let rhsObs := go F rhs ((md, lhs) :: implications)
+          lhsObs ++ rhsObs
+        else if opName == (@boolOrFunc T).name then
+          -- Short-circuit ||: rhs is only reached when lhs is false.
+          -- E.g. `i == 0 || x / i > 1` — ¬(i == 0) is a hypothesis for x / i.
+          let lhsObs := go F lhs implications
+          let rhsObs := go F rhs ((md, .app md (@boolNotFunc T).opExpr lhs) :: implications)
+          lhsObs ++ rhsObs
         else
           go F lhs implications ++ go F rhs implications
       /- Let-binding encoded as (λ x. body) arg:
diff --git a/Strata/DL/SMT.lean b/Strata/DL/SMT.lean
index e5dabbc7ee..cf63850ec6 100644
--- a/Strata/DL/SMT.lean
+++ b/Strata/DL/SMT.lean
@@ -11,6 +11,7 @@ public import Strata.DL.SMT.Factory
 public import Strata.DL.SMT.Function
 public import Strata.DL.SMT.IncrementalSolver
 public import Strata.DL.SMT.Op
+public import Strata.DL.SMT.SmtArray
 public import Strata.DL.SMT.Solver
 public import Strata.DL.SMT.Term
 public import Strata.DL.SMT.TermType
diff --git a/Strata/DL/SMT/Denote.lean b/Strata/DL/SMT/Denote.lean
index 66c44a18c4..d0ba40839c 100644
--- a/Strata/DL/SMT/Denote.lean
+++ b/Strata/DL/SMT/Denote.lean
@@ -5,6 +5,7 @@
 -/
 module
 
+public import Strata.DL.SMT.SmtArray
 public import Strata.Languages.Core.SMTEncoder
 import Std.Tactic.BVDecide.Normalize.Prop
 
@@ -167,6 +168,10 @@ def denoteSortAux (sctx : SortContext) (ty : TermType) : Option (SortDenoteResul
   | .option ty =>
     let ty ← denoteSortAux sctx ty
     return fun sΓ => Option (ty sΓ)
+  | .constr "Array" [kTy, vTy] =>
+    let kTy ← denoteSortAux sctx kTy
+    let vTy ← denoteSortAux sctx vTy
+    return fun sΓ => SmtArray (kTy sΓ) (vTy sΓ)
   | .constr id args =>
     match hi : sctx.uss.findIdx? (·.name == id) with
     | some i =>
@@ -203,6 +208,10 @@ Returns `none` when we lack an interpretation (e.g. for reals).
   | .option ty =>
     let ty ← denoteSort sctx ty
     return fun sΓ => Option (ty sΓ)
+  | .constr "Array" [kTy, vTy] =>
+    let kTy ← denoteSort sctx kTy
+    let vTy ← denoteSort sctx vTy
+    return fun sΓ => SmtArray (kTy sΓ) (vTy sΓ)
   | .constr id args =>
     match hi : sctx.uss.findIdx? (·.name == id) with
     | some i =>
@@ -255,6 +264,22 @@ theorem denoteSortOption_Some :
   (denoteSort sctx (.option ty)).get h sΓ = Option ((denoteSort sctx ty).get (denoteSortOption_isSome h) sΓ) := by
   simp [denoteSort]
 
+theorem denoteSortArray_isSome_key (h : (denoteSort sctx (.constr "Array" [kTy, vTy])).isSome) :
+    (denoteSort sctx kTy).isSome := by
+  exact Option.isSome_of_isSome_bind h
+
+theorem denoteSortArray_isSome_val (h : (denoteSort sctx (.constr "Array" [kTy, vTy])).isSome) :
+    (denoteSort sctx vTy).isSome := by
+  simp only [denoteSort, Bind.bind] at h
+  rewrite [Option.bind_comm (denoteSort sctx kTy) (denoteSort sctx vTy)] at h
+  apply Option.isSome_of_isSome_bind h
+
+theorem denoteSortArray_Some :
+  (denoteSort sctx (.constr "Array" [kTy, vTy])).get h sΓ =
+   SmtArray ((denoteSort sctx kTy).get (denoteSortArray_isSome_key h) sΓ)
+            ((denoteSort sctx vTy).get (denoteSortArray_isSome_val h) sΓ) := by
+  simp [denoteSort]
+
 theorem denoteFunSortCons_isSome (h : (denoteFunSort sctx (a :: as) out).isSome) :
     (denoteSort sctx a.ty).isSome ∧ (denoteFunSort sctx as out).isSome := by
   simp only [denoteFunSort, Option.pure_def, Option.bind_eq_bind,
@@ -888,6 +913,23 @@ and semantics when successful.
   | .some a =>
     let ⟨ty, h, a⟩ ← denoteTerm ctx a
     return ⟨.option ty, isSome_denoteSortOption h, fun Γ => denoteSortOption_Some ▸ some (a Γ)⟩
+  -- Array datatype
+  | .app .select [x, i] _ =>
+    let ⟨.constr "Array" [αTy, βTy], h, x⟩ ← denoteTerm ctx x | none
+    let ⟨αTy', _, i⟩ ← denoteTerm ctx i
+    if hα' : αTy' = αTy then
+      return ⟨βTy, denoteSortArray_isSome_val h, fun Γ => (denoteSortArray_Some ▸ x Γ).select (hα' ▸ i Γ)⟩
+    else
+      none
+  | .app .store [x, i, v] _ =>
+    let ⟨.constr "Array" [αTy, βTy], h, x⟩ ← denoteTerm ctx x | none
+    let ⟨αTy', _, i⟩ ← denoteTerm ctx i
+    let ⟨βTy', _, v⟩ ← denoteTerm ctx v
+    if hαβ : αTy' = αTy ∧ βTy' = βTy then
+      return ⟨.constr "Array" [αTy, βTy], h, fun Γ => denoteSortArray_Some ▸
+              @SmtArray.store _ _ (Classical.typeDecidableEq _) (denoteSortArray_Some ▸ x Γ) (hαβ.left ▸ i Γ) (hαβ.right ▸ v Γ)⟩
+    else
+      none
   | _ => none
 
 -- Note: Using `List.mapM` breaks definitional equality for some reason, so we use a recursive function instead.
diff --git a/Strata/DL/SMT/SmtArray.lean b/Strata/DL/SMT/SmtArray.lean
new file mode 100644
index 0000000000..61b229bf69
--- /dev/null
+++ b/Strata/DL/SMT/SmtArray.lean
@@ -0,0 +1,86 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+/-!
+# A Lean Model of SMT-LIB Arrays
+
+This module provides a shallow Lean model of the SMT-LIB `ArraysEx` theory,
+defining an `SmtArray α β` as the total function space `α → β` and giving
+function-based implementations of `select`, `store`, and constant arrays.
+
+The standard SMT-LIB array axioms
+(<https://smt-lib.org/theories-ArraysEx.shtml>) are proved as theorems against
+this model:
+
+- `select_const`       — reading any index of a constant array returns the
+                         constant value.
+- `select_store_self`  — reading the index just written returns the stored
+                         value (read-over-write, same index).
+- `select_store_of_ne` — reading a different index than the one just written
+                         returns the original array's value at that index
+                         (read-over-write, distinct indices).
+- `ext`                — two arrays that agree pointwise are equal
+                         (extensionality).
+
+This model is intended as a semantic reference and a source of rewrite lemmas
+for reasoning about SMT array operations inside Lean.
+-/
+
+public section
+
+/-- An SMT-LIB array from indices of type `α` to values of type `β`,
+modeled as the total function `α → β`. -/
+structure SmtArray (α : Type u) (β : Type v) where
+  private mk ::
+  private toFun : α → β
+
+namespace SmtArray
+
+variable {α : Type u} {β : Type v}
+
+/-- The constant array that maps every index to `v`. -/
+def const (v : β) : SmtArray α β :=
+  { toFun := fun _ => v }
+
+/-- Read the value stored at index `i` in array `a`. -/
+def select (a : SmtArray α β) (i : α) : β :=
+  a.toFun i
+
+/-- Return a new array that agrees with `a` everywhere except at index `i`,
+where it stores value `v`. -/
+def store [DecidableEq α] (a : SmtArray α β) (i : α) (v : β) : SmtArray α β :=
+  { toFun := fun j => if j = i then v else a.toFun j }
+
+/-- Selecting any index from a constant array yields the constant value. -/
+@[grind =]
+theorem select_const (v : β) (i : α) : (const v).select i = v := by
+  simp [select, const]
+
+/-- Read-over-write at the same index: reading the index just written returns
+the stored value. -/
+@[grind =]
+theorem select_store_self [DecidableEq α] (a : SmtArray α β) (i : α) (v : β) :
+    (a.store i v).select i = v := by
+  simp [select, store]
+
+/-- Read-over-write at distinct indices: reading an index other than the one
+just written returns the original array's value at that index. -/
+@[grind =]
+theorem select_store_of_ne [DecidableEq α] (a : SmtArray α β) (i j : α) (v : β)
+    (hij : j ≠ i) : (a.store i v).select j = a.select j := by
+  simp [select, store, hij]
+
+/-- Extensionality: two arrays that agree on every index are equal. -/
+@[ext, grind ext]
+theorem ext (a b : SmtArray α β) (h : ∀ i, a.select i = b.select i) : a = b := by
+  obtain ⟨a⟩ := a
+  obtain ⟨b⟩ := b
+  congr
+  funext i
+  exact h i
+
+end SmtArray
diff --git a/Strata/DL/SMT/Translate.lean b/Strata/DL/SMT/Translate.lean
index 3a1f0ae4fa..c0b8dde627 100644
--- a/Strata/DL/SMT/Translate.lean
+++ b/Strata/DL/SMT/Translate.lean
@@ -7,6 +7,7 @@ module
 
 import Lean.Meta.Basic
 
+public import Strata.DL.SMT.SmtArray
 public import Strata.Languages.Core.SMTEncoder
 
 public section
@@ -106,6 +107,11 @@ private def getBitVecWidth (α : Expr) : TranslateM Nat :=
     | none => throw m!"Error: expected natural number for BitVec width, got '{w}'"
   | _ => throw m!"Error: expected BitVec type, got '{α}'"
 
+private def getArrayTypes (α : Expr) : TranslateM (Expr × Expr) :=
+  match α with
+  | mkApp2 (.const ``SmtArray [0, 0]) αTy βTy => return (αTy, βTy)
+  | _ => throw m!"Error: expected Array type, got '{α}'"
+
 private def mkString : Expr :=
   toTypeExpr String
 
@@ -293,6 +299,10 @@ def translateSort (ty : TermType) : TranslateM Expr := do
   | .option ty => do
     let ty ← translateSort ty
     return .app (.const ``Option [0]) ty
+  | .constr "Array" [α, β] => do
+    let α ← translateSort α
+    let β ← translateSort β
+    return mkApp2 (.const ``SmtArray [0, 0]) α β
   | .constr n as =>
     let (_, t) ← findVar (.us { name := n, arity := as.length })
     let as ← as.mapM translateSort
@@ -533,6 +543,18 @@ def translateTerm (t : SMT.Term) : TranslateM (Expr × Expr) := do
   | .app (.int_to_bv n) [x] _ =>
     let (_, x) ← translateTerm x
     return (mkBitVec n, mkApp2 (.const ``BitVec.ofInt []) (toExpr n) x)
+  -- SMT-Lib theory of arrays
+  | .app .select [x, i] _ =>
+    let (τ, x) ← translateTerm x
+    let (_, i) ← translateTerm i
+    let (α, β) ← getArrayTypes τ
+    return (β, mkApp4 (.const ``SmtArray.select [0, 0]) α β x i)
+  | .app .store [x, i, v] _ =>
+    let (τ, x) ← translateTerm x
+    let (_, i) ← translateTerm i
+    let (_, v) ← translateTerm v
+    let (α, β) ← getArrayTypes τ
+    return (τ, mkApp6 (.const ``SmtArray.store [0, 0]) α β (.app (.const ``Classical.typeDecidableEq [1]) α) x i v)
   -- SMT-Lib theory of strings
   | .prim (.string s) =>
     return (mkString, toExpr s)
diff --git a/Strata/Languages/B3/Verifier.lean b/Strata/Languages/B3/Verifier.lean
index 9707fe9be5..23958109c4 100644
--- a/Strata/Languages/B3/Verifier.lean
+++ b/Strata/Languages/B3/Verifier.lean
@@ -5,7 +5,7 @@
 -/
 module
 
-import StrataDDM.Integration.Lean.HashCommands -- shake: keep
+public meta import StrataDDM.Integration.Lean.HashCommands -- shake: keep
 public import Strata.Languages.B3.Verifier.Expression
 public import Strata.Languages.B3.Verifier.Formatter
 public import Strata.Languages.B3.Verifier.State
diff --git a/Strata/Languages/C_Simp/C_Simp.lean b/Strata/Languages/C_Simp/C_Simp.lean
index 447726873e..67df735438 100644
--- a/Strata/Languages/C_Simp/C_Simp.lean
+++ b/Strata/Languages/C_Simp/C_Simp.lean
@@ -42,7 +42,7 @@ abbrev Command := Imperative.Cmd Expression
 abbrev Statement := Imperative.Stmt Expression Command
 
 instance : Imperative.HasVarsImp Expression Command where
-  definedVars := Imperative.Cmd.definedVars
+  definedVars c _excludeScoped := Imperative.Cmd.definedVars c
   modifiedVars := Imperative.Cmd.modifiedVars
 
 -- Our statement language is `DL/Imp` with `DL/Lambda` as the expression language
diff --git a/Strata/Languages/C_Simp/Verify.lean b/Strata/Languages/C_Simp/Verify.lean
index 5e734c747d..d9207662f0 100644
--- a/Strata/Languages/C_Simp/Verify.lean
+++ b/Strata/Languages/C_Simp/Verify.lean
@@ -169,7 +169,7 @@ def loop_elimination_function(f : C_Simp.Function) : Core.Procedure :=
               outputs := [("return", f.ret_ty)]},
               spec := {preconditions := core_preconditions,
                        postconditions := core_postconditions},
-                       body := f.body.map loop_elimination_statement}
+                       body := .structured (f.body.map loop_elimination_statement)}
 
 
 def loop_elimination(program : C_Simp.Program) : Core.Program :=
diff --git a/Strata/Languages/Core/CallGraph.lean b/Strata/Languages/Core/CallGraph.lean
index c4589bf765..6e5ddcff18 100644
--- a/Strata/Languages/Core/CallGraph.lean
+++ b/Strata/Languages/Core/CallGraph.lean
@@ -230,12 +230,17 @@ def extractCallsFromFunction (func : Function) : List String :=
   | some body => extractFunctionCallsFromExpr body
   | none => []
 
+/-- Extract procedure calls from a CmdExt -/
+def extractCallsFromCmdExt (cmd : Command) : List String :=
+  match cmd with
+  | .call procName _ _ => [procName]
+  | .cmd _ => []
+
 mutual
 /-- Extract procedure calls from a single statement -/
 def extractCallsFromStatement (stmt : Statement) : List String :=
   match stmt with
-  | .cmd (.call procName _ _) => [procName]
-  | .cmd _ => []
+  | .cmd c => extractCallsFromCmdExt c
   | .block _ body _ => extractCallsFromStatements body
   | .ite _ thenBody elseBody _ =>
     extractCallsFromStatements thenBody ++
@@ -253,9 +258,16 @@ def extractCallsFromStatements (stmts : List Statement) : List String :=
                  extractCallsFromStatements rest
 end
 
+/-- Extract procedure calls from a deterministic CFG -/
+def extractCallsFromDetCFG (cfg : DetCFG) : List String :=
+  cfg.blocks.flatMap fun (_, blk) =>
+    blk.cmds.flatMap extractCallsFromCmdExt
+
 /-- Extract all procedure calls from a procedure's body -/
 def extractCallsFromProcedure (proc : Procedure) : List String :=
-  extractCallsFromStatements proc.body
+  match proc.body with
+  | .structured ss => extractCallsFromStatements ss
+  | .cfg c => extractCallsFromDetCFG c
 
 @[expose] abbrev ProcedureCG := CallGraph
 @[expose] abbrev FunctionCG := CallGraph
diff --git a/Strata/Languages/Core/DDMTransform/FormatCore.lean b/Strata/Languages/Core/DDMTransform/FormatCore.lean
index db589b303d..6015bb1832 100644
--- a/Strata/Languages/Core/DDMTransform/FormatCore.lean
+++ b/Strata/Languages/Core/DDMTransform/FormatCore.lean
@@ -989,7 +989,12 @@ def procToCST {M} [Inhabited M] (proc : Core.Procedure) : ToCSTM M (Command M) :
       ⟨default, none⟩
     else
       ⟨default, some (Spec.spec_mk default specAnn)⟩
-  let bodyCST ← blockToCST proc.body
+  let bodyStmts ← match proc.body with
+    | .structured ss => pure ss
+    | .cfg _ => do
+        ToCSTM.logError "procToCST" "CFG bodies not yet supported in CST conversion" proc.header.name.toPretty
+        pure []
+  let bodyCST ← blockToCST bodyStmts
   let body : Ann (Option (CoreDDM.Block M)) M := ⟨default, some bodyCST⟩
   modify ToCSTContext.popScope
   pure (.command_procedure default name typeArgs arguments spec body)
diff --git a/Strata/Languages/Core/DDMTransform/Grammar.lean b/Strata/Languages/Core/DDMTransform/Grammar.lean
index 57b5dab261..e5fc5a538a 100644
--- a/Strata/Languages/Core/DDMTransform/Grammar.lean
+++ b/Strata/Languages/Core/DDMTransform/Grammar.lean
@@ -24,7 +24,7 @@ namespace Strata
 
 -- Sequence operations and lambda/application syntax increase the grammar size enough
 -- to require higher recursion and heartbeat limits.
-set_option maxRecDepth 10000
+set_option maxRecDepth 20000
 set_option maxHeartbeats 400000
 
 /- DDM support for parsing and pretty-printing Strata Core -/
@@ -469,6 +469,59 @@ op datatype_decl (name : Ident,
 op command_datatypes (@[nonempty] datatypes : NewlineSepBy DatatypeDecl) : Command =>
   datatypes ";\n";
 
+// =====================================================================
+// CFG (Unstructured Control Flow) Syntax
+// =====================================================================
+
+// Transfer commands: how a basic block ends
+category Transfer;
+
+// Unconditional goto: exactly one target.
+op transfer_goto (label : Ident) : Transfer =>
+  "goto " label ";";
+
+// Nondeterministic goto: exactly two targets chosen nondeterministically.
+op transfer_nondet_goto (label1 : Ident, label2 : Ident) : Transfer =>
+  "goto " label1 ", " label2 ";";
+
+// Conditional goto (deterministic: condition selects between two targets)
+// NOTE: We use "branch" instead of "if" to avoid ambiguity with the
+// structured if-statement syntax. The DDM parser registers tokens globally,
+// so "if (" in Transfer would conflict with "if (" in Statement.
+op transfer_cond_goto (c : Expr, lt : Ident, lf : Ident) : Transfer =>
+  "branch (" c ") goto " lt " else " "goto " lf ";";
+
+// Return/finish (terminate execution)
+op transfer_return : Transfer =>
+  "return;";
+
+// A single CFG basic block: label, commands, transfer
+category CFGBlock;
+@[scope(cmds)]
+op cfg_block (label : Ident, cmds : Seq Statement, tr : Transfer) : CFGBlock =>
+  label ":" " {\n" indent(2, cmds) "  " tr "\n}";
+
+// A list of CFG blocks
+category CFGBlocks;
+op cfg_blocks_one (b : CFGBlock) : CFGBlocks => b;
+op cfg_blocks_cons (b : CFGBlock, rest : CFGBlocks) : CFGBlocks =>
+  b "\n" rest;
+
+// CFG body: entry label + blocks
+category CFGBody;
+op cfg_body (entry : Ident, blocks : CFGBlocks) : CFGBody =>
+  "cfg " entry " {\n" indent(2, blocks) "\n}";
+
+// Procedure with CFG body
+op command_cfg_procedure (name : Ident,
+                          typeArgs : Option TypeArgs,
+                          @[scope(typeArgs)] b : Bindings,
+                          @[scope(b)] s : Option Spec,
+                          @[scope(b)] body : CFGBody) :
+  Command =>
+  @[prec(10)] "procedure " name typeArgs b "\n"
+              s body ";\n";
+
 #end
 
 ---------------------------------------------------------------------
diff --git a/Strata/Languages/Core/DDMTransform/Translate.lean b/Strata/Languages/Core/DDMTransform/Translate.lean
index e03bfc5a12..e01318cbde 100644
--- a/Strata/Languages/Core/DDMTransform/Translate.lean
+++ b/Strata/Languages/Core/DDMTransform/Translate.lean
@@ -1680,7 +1680,7 @@ def translateProcedure (p : Program) (bindings : TransBindings) (op : Operation)
                               outputs := ret },
                   spec := { preconditions := requires,
                             postconditions := ensures },
-                  body := body
+                  body := .structured body
                 }
                 md,
           origBindings)
@@ -1699,13 +1699,137 @@ def translateBlockCommand (p : Program) (bindings : TransBindings) (op : Operati
                               outputs := [] },
                   spec := { preconditions := [],
                             postconditions := [] },
-                  body := body
+                  body := .structured body
                 }
                 md,
           bindings)
 
 ---------------------------------------------------------------------
 
+/-- Translate a transfer command from the CFG syntax -/
+
+private instance : Inhabited TransBindings := ⟨{}⟩
+private instance : Inhabited (Imperative.DetTransferCmd String Core.Expression) := ⟨.finish .empty⟩
+private instance : Inhabited (Imperative.BasicBlock (Imperative.DetTransferCmd String Core.Expression) Core.Command) := ⟨⟨[], .finish .empty⟩⟩
+private instance : Inhabited (Imperative.CFG String (Imperative.DetBlock String Core.Command Core.Expression)) := ⟨⟨"", []⟩⟩
+
+partial def translateTransfer (p : Program) (bindings : TransBindings) (arg : Arg) :
+  TransM (List Core.Command × Imperative.DetTransferCmd String Core.Expression × TransBindings) := do
+  let .op op := arg
+    | TransM.error s!"translateTransfer expected op {repr arg}"
+  let md ← getOpMetaData op
+  match op.name with
+  | q`Core.transfer_goto =>
+    let label ← translateIdent String op.args[0]!
+    return ([], .condGoto (Lambda.LExpr.boolConst () Bool.true) label label md, bindings)
+  | q`Core.transfer_nondet_goto =>
+    let label1 ← translateIdent String op.args[0]!
+    let label2 ← translateIdent String op.args[1]!
+    -- Nondeterministic choice: use a fresh boolean variable as the branch
+    -- condition, declared by the `init` command below (prepended to the block in
+    -- `translateCFGBlock`) so the type checker can see it. The symbolic evaluator
+    -- leaves the fvar unchanged, so `evalCFGStep` forks into both paths; the
+    -- concrete interpreter (runCFG) errors on it, as expected.
+    let condName : Core.CoreIdent := ⟨s!"$__nondet_{bindings.gen.var_def}", ()⟩
+    let bindings := incrNum .var_def bindings
+    let boolMono := Lambda.LMonoTy.bool
+    let boolTy : Lambda.LTy := .forAll [] boolMono
+    let initCmd : Core.Command := .cmd (.init condName boolTy .nondet md)
+    let condExpr := Lambda.LExpr.fvar () condName (some boolMono)
+    return ([initCmd], .condGoto condExpr label1 label2 md, bindings)
+  | q`Core.transfer_cond_goto =>
+    let cond ← translateExpr p bindings op.args[0]!
+    let lt ← translateIdent String op.args[1]!
+    let lf ← translateIdent String op.args[2]!
+    return ([], .condGoto cond lt lf md, bindings)
+  | q`Core.transfer_return =>
+    return ([], .finish md, bindings)
+  | _ => TransM.error s!"translateTransfer: unknown transfer {repr op.name}"
+
+/-- Translate a single CFG block -/
+partial def translateCFGBlock (p : Program) (bindings : TransBindings) (arg : Arg) :
+  TransM (String × Imperative.BasicBlock (Imperative.DetTransferCmd String Core.Expression) Core.Command × TransBindings) := do
+  let .op op := arg
+    | TransM.error s!"translateCFGBlock expected op {repr arg}"
+  let label ← translateIdent String op.args[0]!
+  -- Translate commands - handle both Seq and empty cases
+  let stmts : Array Arg := match op.args[1]! with
+    | .seq _ _ arr => arr
+    | other => #[other]  -- single statement or empty
+  let mut cmds : Array Core.Command := #[]
+  let mut bindings := bindings
+  for s in stmts do
+    -- Skip empty/null args
+    if let .op _ := s then
+      let (translated, bindings') ← translateStmt p bindings s
+      bindings := bindings'
+      for stmt in translated do
+        match stmt with
+        | .cmd c => cmds := cmds.push c
+        | _ => TransM.error s!"translateCFGBlock: only commands allowed in CFG blocks, got statement"
+  let (transferCmds, transfer, bindings') ← translateTransfer p bindings op.args[2]!
+  -- Append any commands the transfer needs declared in scope (e.g. the
+  -- `$__nondet_N` declaration for a nondeterministic goto).
+  return (label, ⟨cmds.toList ++ transferCmds, transfer⟩, bindings')
+
+/-- Translate a list of CFG blocks -/
+partial def translateCFGBlocks (p : Program) (bindings : TransBindings) (arg : Arg) :
+  TransM (List (String × Imperative.BasicBlock (Imperative.DetTransferCmd String Core.Expression) Core.Command) × TransBindings) := do
+  let .op op := arg
+    | TransM.error s!"translateCFGBlocks expected op {repr arg}"
+  match op.name with
+  | q`Core.cfg_blocks_one =>
+    let (label, blk, bindings) ← translateCFGBlock p bindings op.args[0]!
+    return ([(label, blk)], bindings)
+  | q`Core.cfg_blocks_cons =>
+    let (label, blk, bindings) ← translateCFGBlock p bindings op.args[0]!
+    let (rest, bindings) ← translateCFGBlocks p bindings op.args[1]!
+    return ((label, blk) :: rest, bindings)
+  | _ => TransM.error s!"translateCFGBlocks: unknown {repr op.name}"
+
+/-- Translate a CFG body -/
+partial def translateCFGBody (p : Program) (bindings : TransBindings) (arg : Arg) :
+  TransM (Imperative.CFG String (Imperative.DetBlock String Core.Command Core.Expression) × TransBindings) := do
+  let .op op := arg
+    | TransM.error s!"translateCFGBody expected op {repr arg}"
+  let entry ← translateIdent String op.args[0]!
+  let (blocks, bindings) ← translateCFGBlocks p bindings op.args[1]!
+  return ({ entry := entry, blocks := blocks }, bindings)
+
+/-- Translate a procedure with CFG body -/
+def translateCFGProcedure (p : Program) (bindings : TransBindings) (op : Operation) :
+  TransM (Core.Decl × TransBindings) := do
+  let _ ← @checkOp (Core.Decl × TransBindings) op q`Core.command_cfg_procedure 5
+  let pname ← translateIdent Core.CoreIdent op.args[0]!
+  let typeArgs ← translateTypeArgs op.args[1]!
+  let (sig, ret) ← translateBindingsPartitioned bindings op.args[2]!
+  let in_bindings := (sig.map (fun (v, ty) => (LExpr.fvar () v ty))).toArray
+  let out_bindings_only := (ret.filter (fun (v, _) => !sig.any (fun (iv, _) => iv == v))).map
+    (fun (v, ty) => (LExpr.fvar () v ty))
+  let out_bindings := out_bindings_only.toArray
+  let origBindings := bindings
+  let bbindings := bindings.boundVars ++ in_bindings ++ out_bindings
+  let bindings := { bindings with boundVars := bbindings }
+  let .option _ speca := op.args[3]!
+    | TransM.error s!"translateCFGProcedure spec expected: {repr op.args[3]!}"
+  let (requires, ensures) ←
+    if speca.isSome then translateSpec p pname bindings speca.get! else pure ([], [])
+  let (cfg, bindings) ← translateCFGBody p bindings op.args[4]!
+  let origBindings := { origBindings with gen := bindings.gen }
+  let md ← getOpMetaData op
+  return (.proc { header := { name := pname,
+                              typeArgs := typeArgs.toList,
+                              inputs := sig,
+                              outputs := ret },
+                  spec := { preconditions := requires,
+                            postconditions := ensures },
+                  body := .cfg cfg
+                }
+                md,
+          origBindings)
+
+---------------------------------------------------------------------
+
 def translateConstant (bindings : TransBindings) (op : Operation) :
   TransM (Core.Decl × TransBindings) := do
   let _ ← @checkOp (Core.Decl × TransBindings) op q`Core.command_constdecl 3
@@ -2115,6 +2239,8 @@ partial def translateCoreDecls (p : Program) (bindings : TransBindings) :
         translateRecFuncBlock p bindings op
       | q`Core.command_block =>
         translateBlockCommand p bindings op
+      | q`Core.command_cfg_procedure =>
+        translateCFGProcedure p bindings op
       | _ => TransM.error s!"translateCoreDecls unimplemented for {repr op}"
     acc := acc.push decl
     bindings := bindings'
diff --git a/Strata/Languages/Core/Expressions.lean b/Strata/Languages/Core/Expressions.lean
index 2366150f4f..9c691c921d 100644
--- a/Strata/Languages/Core/Expressions.lean
+++ b/Strata/Languages/Core/Expressions.lean
@@ -30,8 +30,11 @@ abbrev Expression : Imperative.PureExpr :=
      TyContext := @Lambda.LContext ⟨ExpressionMetadata, Unit⟩,
      EvalEnv := Lambda.LState ⟨ExpressionMetadata, Unit⟩ }
 
-instance : Imperative.HasVarsPure Expression Expression.Expr where
-  getVars := Lambda.LExpr.LExpr.getVars
+instance : Imperative.HasFvars Expression where
+  getFvars := Lambda.LExpr.LExpr.getVars
+
+instance : Imperative.HasOps Expression where
+  getOps := Lambda.LExpr.getOps
 
 instance : Inhabited Expression.Expr where
   default := .intConst () 0
diff --git a/Strata/Languages/Core/Factory.lean b/Strata/Languages/Core/Factory.lean
index 1297855c0f..d25bd42640 100644
--- a/Strata/Languages/Core/Factory.lean
+++ b/Strata/Languages/Core/Factory.lean
@@ -865,10 +865,7 @@ def bv64Extract_15_0_Func  := bvExtractFunc 64 15  0
 def bv64Extract_7_0_Func   := bvExtractFunc 64  7  0
 
 @[expose]
-def WFFactory : Lambda.WFLFactory CoreLParams :=
-  -- (T := CoreLParams) annotations needed for IntBoolFactory
-  -- functions to resolve typeclass instances.
-  WFLFactory.ofArray (name_nodup := by native_decide) (#[
+def WFFactoryArray : Array (Lambda.WFLFunc CoreLParams) := #[
   intAddFunc (T := CoreLParams),
   intSubFunc (T := CoreLParams),
   intMulFunc (T := CoreLParams),
@@ -973,11 +970,21 @@ def WFFactory : Lambda.WFLFactory CoreLParams :=
   bv64Extract_7_0_Func,
 ] ++ (ExpandBVOpFuncNames [1,8,16,32,64])
   ++ (ExpandBVSafeOpFuncNames [1,8,16,32,64])
-  ++ (ExpandBVSafeDivOpFuncNames [1,8,16,32,64]))
+  ++ (ExpandBVSafeDivOpFuncNames [1,8,16,32,64])
+
+@[expose]
+def WFFactory : Lambda.WFLFactory CoreLParams :=
+  WFLFactory.ofArray (name_nodup := by native_decide) WFFactoryArray
 
 @[expose]
 def Factory : @Factory CoreLParams := WFLFactory.toFactory WFFactory
 
+def FactoryFuncNames : List String :=
+  (WFFactoryArray.map (·.func.name.name)).toList
+
+/-- Decidable predicate: is `s` the name of a built-in factory function? -/
+def isNameInFactory (s : String) : Bool := s ∈ FactoryFuncNames
+
 end -- public section
 
 public meta section
diff --git a/Strata/Languages/Core/FunctionType.lean b/Strata/Languages/Core/FunctionType.lean
index fd7f670439..5cd56bf6a7 100644
--- a/Strata/Languages/Core/FunctionType.lean
+++ b/Strata/Languages/Core/FunctionType.lean
@@ -22,12 +22,14 @@ open Std (ToFormat Format format)
 
 def typeCheck (C: Core.Expression.TyContext) (Env : Core.Expression.TyEnv) (func : Function) :
     Except Format (Function × Core.Expression.TyEnv) := do
-  -- (FIXME) Very similar to `Lambda.inferOp`, except that the body is annotated
-  -- using `LExprT.resolve`. Can we share code here?
-  --
   -- `LFunc.type` below will also catch any ill-formed functions (e.g.,
   -- where there are duplicates in the formals, etc.).
+  let origTypeArgs := func.typeArgs
   let type ← func.type
+  let undeclaredVars := LTy.freeVars type
+  if undeclaredVars != [] then
+    .error f!"Function '{func.name}': type variables {undeclaredVars} appear in \
+              the signature but are not declared in typeArgs {func.typeArgs}"
   let (monoty, Env) ← LTy.instantiateWithCheck type C Env
   let monotys := monoty.destructArrow
   -- Use the number of formal parameters to determine which arrow components are
@@ -46,22 +48,54 @@ def typeCheck (C: Core.Expression.TyContext) (Env : Core.Expression.TyEnv) (func
                   typeArgs := monoty.freeVars.eraseDups,
                   inputs := func.inputs.keys.zip input_mtys,
                   output := output_mty}
+  -- Substitution to rename fresh type variables back to user-supplied names.
+  -- Only pairs where the fresh name actually survived alias resolution are included.
+  let userTypeArgs := func.typeArgs.zip origTypeArgs
+  let userSubst : Subst :=
+    [userTypeArgs.map (fun (fresh, orig) => (fresh, .ftvar orig))]
   match func.body with
-  | none => .ok (func, Env)
+  | none =>
+    let func := { func with
+      typeArgs := userTypeArgs.map (·.2),
+      inputs := func.inputs.map (fun (id, mty) => (id, LMonoTy.subst userSubst mty)),
+      output := LMonoTy.subst userSubst func.output }
+    .ok (func, Env)
   | some body =>
-    -- Temporarily add formals in the context.
+    -- Reject body annotations referencing type variables not in typeArgs.
+    let bodyVars := body.tyVarsOfBinderAnnotations
+    let strayVars := bodyVars.filter (· ∉ origTypeArgs)
+    if !strayVars.isEmpty then
+      .error f!"Function '{func.name}': body contains undeclared type variables \
+                {strayVars.toList} (not in typeArgs {origTypeArgs})"
+    -- Add formals with monomorphic types (type parameters are fixed in the body).
     let Env := Env.pushEmptyContext
-    let Env := Env.addInNewestContext (LFunc.inputPolyTypes func)
-    -- Type check and annotate the body, and ensure that it unifies with the
-    -- return type.
+    let Env := Env.addInNewestContext (LFunc.inputMonoSignature func)
+    -- Type check the body and unify with the return type.
     let (bodya, Env) ← LExpr.resolve C Env body
     let bodyty := bodya.toLMonoTy
-    let (retty, Env) ← (LFunc.outputPolyType func).instantiateWithCheck C Env
+    let retty := func.output
     let S ← Constraints.unify [(retty, bodyty)] (TEnv.stateSubstInfo Env) |>.mapError format
+    -- The inferred type must be alpha-equivalent to the declared signature.
+    -- Unlike OCaml, where annotations are lower bounds (the body may be more
+    -- specific), we require exact polymorphism: if f<a>(x:a):a is declared,
+    -- the body cannot force a=int. This is appropriate for an IR where
+    -- the user can give annotations as needed.
+    let inferredTy := LMonoTy.subst S.subst monoty
+    let bwdMap ← match LMonoTy.alphaEquivMap monoty inferredTy with
+      | some m => pure m
+      | none =>
+        let displayInferred := LMonoTy.subst userSubst inferredTy
+        let displayMono := LMonoTy.subst userSubst monoty
+        .error f!"Function '{func.name}': body constrains the type to '{displayInferred}', \
+                  incompatible with declared polymorphic signature '{displayMono}'"
     let Env := TEnv.updateSubst Env S
-    -- Apply the outer unification substitution back to the body so that type
-    -- variables introduced inside it are resolved.
+    -- Apply S to the body, then rename type variables to match the
+    -- instantiated typeArgs so that body annotations are consistent.
     let bodya := LExpr.applySubstT bodya S.subst
+    -- Identity entries are no-ops: bijectivity of bwdMap ensures no other key maps to k.
+    let renameSubst : Subst :=
+      [bwdMap.toList.filterMap (fun (k, v) => if k == v then none else some (k, .ftvar v))]
+    let bodya := LExpr.applySubstT bodya renameSubst
     -- Validate the measure expression type for int-recursive functions.
     -- Only validates non-fvar measures (fvar measures are validated in TermCheck
     -- using the TypeFactory, which has ADT information).
@@ -76,8 +110,13 @@ def typeCheck (C: Core.Expression.TyContext) (Env : Core.Expression.TyEnv) (func
           .error f!"recursive function '{func.name}': non-variable decreases expression must have type int, got '{measurety}'. For structural recursion, use a parameter name"
     | none => pure ()
     let Env := TEnv.popContext Env
-    -- Resolve type aliases and monomorphize the body.
-    let new_func := { func with body := some bodya.unresolved }
+    -- Rename back to user type variable names.
+    let bodya := LExpr.applySubstT bodya userSubst
+    let new_func := { func with
+      typeArgs := userTypeArgs.map (·.2),
+      inputs := func.inputs.map (fun (id, mty) => (id, LMonoTy.subst userSubst mty)),
+      output := LMonoTy.subst userSubst func.output,
+      body := some bodya.unresolved }
     .ok (new_func, Env)
 
 end Function
diff --git a/Strata/Languages/Core/ObligationExtraction.lean b/Strata/Languages/Core/ObligationExtraction.lean
index 09b43e1943..fa8ecb2b37 100644
--- a/Strata/Languages/Core/ObligationExtraction.lean
+++ b/Strata/Languages/Core/ObligationExtraction.lean
@@ -100,7 +100,10 @@ def extractObligations (p : Program) : Except String (ProofObligations Expressio
       .ok (axiomPc ++ [.assumption a.name a.e], allObs)
     | .proc proc _md => do
       let globalPc : PathConditions Expression := [axiomPc]
-      let obs ← extractFromStatements globalPc proc.body
+      let obs ← match proc.body with
+        | .structured ss => extractFromStatements globalPc ss
+        -- CFG bodies are not supported on procedure-body branch.
+        | .cfg _ => .ok #[]
       .ok (axiomPc, allObs ++ obs)
     | _ => .ok (axiomPc, allObs)
   return allObs
diff --git a/Strata/Languages/Core/Procedure.lean b/Strata/Languages/Core/Procedure.lean
index 9734c4655e..16161be5f4 100644
--- a/Strata/Languages/Core/Procedure.lean
+++ b/Strata/Languages/Core/Procedure.lean
@@ -6,6 +6,8 @@
 module
 
 
+public import Strata.DL.Imperative.HasVars
+public import Strata.DL.Imperative.BasicBlock
 public import Strata.Languages.Core.Statement
 
 ---------------------------------------------------------------------
@@ -277,49 +279,145 @@ def Procedure.Spec.updateCheckExprs
   | e :: erest, c :: crest =>
     { c with expr := e } :: go erest crest
 
+/-- A deterministic control-flow graph over Core commands and expressions. -/
+@[expose] abbrev DetCFG := Imperative.CFG String (Imperative.DetBlock String Command Expression)
+
+/-- The body of a Core procedure: either structured (a list of statements) or
+unstructured (a control-flow graph of basic blocks). An empty structured body
+(`structured []`) represents an abstract/bodyless procedure. -/
+inductive Procedure.Body where
+  /-- A structured body: a sequential list of statements. -/
+  | structured : List Statement → Procedure.Body
+  /-- An unstructured body: a control-flow graph of deterministic basic blocks.
+      Labels are strings; each block contains Core commands and ends with a
+      deterministic transfer (conditional goto or finish). -/
+  | cfg : DetCFG → Procedure.Body
+  deriving Inhabited
+
+/-- Extract the structured statements, or error if the body is a CFG. -/
+@[simp, expose]
+def Procedure.Body.getStructured : Procedure.Body → Except String (List Statement)
+  | .structured ss => .ok ss
+  | .cfg _ => .error "expected structured body, got CFG"
+
+/-- Extract the CFG, or error if the body is structured. -/
+@[simp]
+def Procedure.Body.getCfg : Procedure.Body → Except String DetCFG
+  | .cfg c => .ok c
+  | .structured _ => .error "expected CFG body, got structured"
+
+/-- Get variables referenced in the body. For a CFG body, this includes the
+variables read by the guard of each conditional transfer (`condGoto`), mirroring
+how the structured form collects the condition variables of `if`/`while`. -/
+@[simp]
+def Procedure.Body.getVars : Procedure.Body → List Expression.Ident
+  | .structured ss => ss.flatMap Imperative.HasVarsPure.getVars
+  | .cfg c => c.blocks.flatMap fun (_, blk) =>
+    blk.cmds.flatMap Imperative.HasVarsPure.getVars ++
+    (match blk.transfer with
+      | .condGoto p _ _ _ => Imperative.HasFvars.getFvars p
+      | .finish _ => [])
+
+/-- Is this body abstract (no implementation)? Only empty structured bodies
+    are abstract. CFG bodies always have an implementation. -/
+@[simp]
+def Procedure.Body.isAbstract : Procedure.Body → Bool
+  | .structured ss => ss.isEmpty
+  | .cfg _ => false
+
+/-- Does this body have a structured implementation? -/
+@[simp]
+def Procedure.Body.isStructured : Procedure.Body → Bool
+  | .structured _ => true
+  | .cfg _ => false
+
+/-- Does this body have a CFG implementation? -/
+@[simp]
+def Procedure.Body.isCfg : Procedure.Body → Bool
+  | .structured _ => false
+  | .cfg _ => true
+
+def Procedure.Body.structuredLength : Procedure.Body → Nat
+  | .structured ss => ss.length
+  | .cfg _ => 0
+
 /--
 A Strata Core procedure: the main verification unit.
 
 A procedure consists of a header (name, type parameters, input/output signatures),
-a specification (contract), and an optional body (list of statements). If the body
-is empty, the procedure is abstract and can only be reasoned about via its contract.
-If the body is present, it is verified against the specification.
+a specification (contract), and an optional body (list of statements or a CFG).
+If the body is empty, the procedure is abstract and can only be reasoned about
+via its contract. If the body is present, it is verified against the specification.
 -/
 structure Procedure where
   /-- The procedure header: name, type parameters, and parameter signatures. -/
   header : Procedure.Header
   /-- The procedure's contract: modifies clause, preconditions, and postconditions. -/
   spec   : Procedure.Spec
-  /-- The procedure body. Empty for abstract (bodyless) procedures. -/
-  body   : List Statement
+  /-- The procedure body. -/
+  body   : Procedure.Body := .structured []
   deriving Inhabited
 
 ---------------------------------------------------------------------
 
 open Imperative
 
-def Procedure.definedVars (_ : Procedure) : List Expression.Ident := []
-def Procedure.modifiedVars (p : Procedure) : List Expression.Ident :=
-  p.header.outputs.keys
-
 def Procedure.getVars (p : Procedure) : List Expression.Ident :=
-  (p.spec.postconditions.values.map Procedure.Check.expr).flatMap HasVarsPure.getVars ++
-  (p.spec.preconditions.values.map Procedure.Check.expr).flatMap HasVarsPure.getVars ++
-  p.body.flatMap HasVarsPure.getVars |> List.filter (not $ Membership.mem p.header.inputs.keys ·)
+  (p.spec.postconditions.values.map Procedure.Check.expr).flatMap HasFvars.getFvars ++
+  (p.spec.preconditions.values.map Procedure.Check.expr).flatMap HasFvars.getFvars ++
+  p.body.getVars |> List.filter (not $ Membership.mem p.header.inputs.keys ·)
 
 instance : HasVarsPure Expression Procedure where
   getVars := Procedure.getVars
 
+instance : HasVarsPure Expression Procedure.Body where
+  getVars := Procedure.Body.getVars
+
+instance : HasVarsImp Expression DetCFG where
+  definedVars cfg _ := cfg.blocks.flatMap fun (_, blk) =>
+    blk.cmds.flatMap Command.definedVars
+  modifiedVars cfg := cfg.blocks.flatMap fun (_, blk) =>
+    blk.cmds.flatMap Command.modifiedVars
+
+instance : HasVarsImp Expression Procedure.Body where
+  definedVars b excludeScoped := match b with
+    | .structured ss => HasVarsImp.definedVars ss excludeScoped
+    | .cfg cfgBody => HasVarsImp.definedVars cfgBody excludeScoped
+  modifiedVars b := match b with
+    | .structured ss => HasVarsImp.modifiedVars ss
+    | .cfg cfgBody => HasVarsImp.modifiedVars cfgBody
+
 instance : HasVarsImp Expression Procedure where
-  definedVars := Procedure.definedVars
-  modifiedVars := Procedure.modifiedVars
+  definedVars _ _ := []
+  modifiedVars p := p.header.outputs.keys
+
+def DetCFG.eraseTypes (cfg : DetCFG) : DetCFG :=
+  { cfg with blocks := cfg.blocks.map fun (lbl, blk) =>
+      (lbl, { blk with cmds := blk.cmds.map Command.eraseTypes,
+                        transfer := match blk.transfer with
+                          | .condGoto p lt lf md => .condGoto p.eraseTypes lt lf md
+                          | .finish md => .finish md }) }
+
+-- Only transfer metadata is stripped because command metadata (on assert,
+-- assume, init, set, cover) is not included in formatted output — formatCmd
+-- discards it. Transfer metadata, however, appears in CFG formatting.
+def DetCFG.stripMetaData (cfg : DetCFG) : DetCFG :=
+  { cfg with blocks := cfg.blocks.map fun (lbl, blk) =>
+      (lbl, { blk with transfer := match blk.transfer with
+                          | .condGoto p lt lf _ => .condGoto p lt lf .empty
+                          | .finish _ => .finish .empty }) }
 
 def Procedure.eraseTypes (p : Procedure) : Procedure :=
-  { p with body := Statements.eraseTypes p.body, spec := p.spec }
+  let body' := match p.body with
+    | .structured ss => .structured (Statements.eraseTypes ss)
+    | .cfg c => .cfg c.eraseTypes
+  { p with body := body', spec := p.spec }
 
-/-- Remove all metadata from procedure. -/
 def Procedure.stripMetaData (p : Procedure) : Procedure :=
-  { p with body := Imperative.Block.stripMetaData p.body }
+  let body' := match p.body with
+    | .structured ss => .structured (Imperative.Block.stripMetaData ss)
+    | .cfg c => .cfg c.stripMetaData
+  { p with body := body' }
 
 /-- Transitive variable lookup for procedures.
     This is a version that looks into the body,
diff --git a/Strata/Languages/Core/ProcedureEval.lean b/Strata/Languages/Core/ProcedureEval.lean
index ffc69fcbaa..4fbc16aa27 100644
--- a/Strata/Languages/Core/ProcedureEval.lean
+++ b/Strata/Languages/Core/ProcedureEval.lean
@@ -112,8 +112,14 @@ def eval (E : Env) (p : Procedure) : Env × Statistics :=
       /- the assumptions from preconditions are set to have empty metadata  -/
       (.assume label check.expr check.md))
       p.spec.preconditions
-  let (ssEs, evalStats) := Statement.eval E old_g_subst (precond_assumes ++ p.body ++ postcond_asserts)
-  (mergeResults E (ssEs.map (fun sE => fixupError sE)), evalStats)
+  match p.body with
+  | .structured bodyStmts =>
+    let (ssEs, evalStats) := Statement.eval E old_g_subst (precond_assumes ++ bodyStmts ++ postcond_asserts)
+    (mergeResults E (ssEs.map (fun sE => fixupError sE)), evalStats)
+  | .cfg _ =>
+    -- CFG bodies are not supported here.
+    let errEnv := { E with error := some (.Misc s!"procedure '{p.header.name}': CFG bodies not supported yet") }
+    (errEnv, {})
 
 ---------------------------------------------------------------------
 
diff --git a/Strata/Languages/Core/ProcedureType.lean b/Strata/Languages/Core/ProcedureType.lean
index c3a4e4f1b3..2059f60c05 100644
--- a/Strata/Languages/Core/ProcedureType.lean
+++ b/Strata/Languages/Core/ProcedureType.lean
@@ -16,7 +16,7 @@ public section
 namespace Core
 
 open Std (ToFormat Format format)
-open Imperative (MetaData)
+open Imperative (MetaData HasVarsImp)
 open Strata (DiagnosticModel FileRange)
 
 namespace Procedure
@@ -30,10 +30,10 @@ private def checkNoDuplicates (proc : Procedure) (sourceLoc : FileRange) :
 
 private def checkModificationRights (proc : Procedure) (sourceLoc : FileRange) :
     Except DiagnosticModel Unit := do
-  let modifiedVars := (Imperative.Block.modifiedVars proc.body).eraseDups
-  let definedVars := (Imperative.Block.definedVars proc.body).eraseDups
+  let modifiedVars := (HasVarsImp.modifiedVars (P := Expression) proc.body).eraseDups
+  let definedVars := (HasVarsImp.definedVars (P := Expression) proc.body false).eraseDups
   let allowedVars := proc.header.outputs.keys ++ definedVars
-  let disallowed := modifiedVars.filter (fun v => v ∉ allowedVars)
+  let disallowed := modifiedVars.filter (fun v => !allowedVars.contains v)
   if !disallowed.isEmpty then
     .error <| DiagnosticModel.withRange sourceLoc f!"[{proc.header.name}]: This procedure modifies variables it \
               is not allowed to!\n\
@@ -111,7 +111,12 @@ def typeCheck (C : Core.Expression.TyContext) (Env : Core.Expression.TyEnv) (p :
   -- Type check body.
   -- Note that `Statement.typeCheck` already reports source locations in
   -- error messages.
-  let (annotated_body, finalEnv) ← Statement.typeCheck C envAfterPostconds p (.some proc) proc.body
+  let bodyStmts : List Statement ← match proc.body with
+    | .structured ss => pure ss
+    | .cfg _ =>
+      Except.error (DiagnosticModel.withRange fileRange
+        f!"[{proc.header.name}]: CFG procedures not supported yet")
+  let (annotated_body, finalEnv) ← Statement.typeCheck C envAfterPostconds p (.some proc) bodyStmts
 
   -- Remove formals and returns from the context -- they ought to be local to
   -- the procedure body.
@@ -126,7 +131,7 @@ def typeCheck (C : Core.Expression.TyContext) (Env : Core.Expression.TyEnv) (p :
                                     outputs := out_mty_sig }
   let new_spec := { proc.spec with preconditions := finalPreconditions,
                                    postconditions := finalPostconditions }
-  let new_proc := { proc with header := new_hdr, spec := new_spec, body := annotated_body }
+  let new_proc := { proc with header := new_hdr, spec := new_spec, body := .structured annotated_body }
 
   return (new_proc, finalEnv)
 
diff --git a/Strata/Languages/Core/ProgramEval.lean b/Strata/Languages/Core/ProgramEval.lean
index 764910d1a8..3590776d31 100644
--- a/Strata/Languages/Core/ProgramEval.lean
+++ b/Strata/Languages/Core/ProgramEval.lean
@@ -54,6 +54,12 @@ def eval (E : Env) : Except Strata.DiagnosticModel (List Env × Statistics) :=
 
     | .proc proc _md =>
       let (E, procStats) := Procedure.eval declsE proc
+      -- Reset path conditions to the pre-procedure state so a procedure's
+      -- assumptions don't leak into later ones: a structured `exit` bypasses
+      -- `Env.merge` and leaves its frames unpopped, which would otherwise be
+      -- threaded into the next procedure (strata-org/Strata#1390). Deferred
+      -- obligations and fresh names carry forward.
+      let E := { E with pathConditions := declsE.pathConditions }
       go rest E (stats.merge procStats)
 
     | .func func _ => do
diff --git a/Strata/Languages/Core/Statement.lean b/Strata/Languages/Core/Statement.lean
index be30b7d37d..4a03fad01f 100644
--- a/Strata/Languages/Core/Statement.lean
+++ b/Strata/Languages/Core/Statement.lean
@@ -191,20 +191,28 @@ end
 
 ---------------------------------------------------------------------
 
-def Command.getVars (c : Command) : List Expression.Ident :=
+@[expose] def Command.getVars (c : Command) : List Expression.Ident :=
   match c with
   | .cmd c => c.getVars
-  | .call _ args _ => (CallArg.getInputExprs args).flatMap HasVarsPure.getVars
+  | .call _ args _ => (CallArg.getInputExprs args).flatMap HasFvars.getFvars
 
 instance : HasVarsPure Expression Command where
   getVars := Command.getVars
 
-def Command.definedVars (c : Command) : List Expression.Ident :=
+@[expose] def Command.getOps (c : Command) : List Expression.Ident :=
+  match c with
+  | .cmd c => Cmd.getOps c
+  | .call _ args _ => (CallArg.getInputExprs args).flatMap HasOps.getOps
+
+instance : HasOpsImp Expression Command where
+  getOps := Command.getOps
+
+@[expose] def Command.definedVars (c : Command) : List Expression.Ident :=
   match c with
   | .cmd c => c.definedVars
   | _ => []
 
-def Command.modifiedVars (c : Command) : List Expression.Ident :=
+@[expose] def Command.modifiedVars (c : Command) : List Expression.Ident :=
   match c with
   | .cmd c => c.modifiedVars
   | .call _ args _ => CallArg.getLhs args
@@ -213,20 +221,16 @@ def Command.modifiedOrDefinedVars (c : Command) : List Expression.Ident :=
   Command.definedVars c ++ Command.modifiedVars c
 
 instance : HasVarsImp Expression Command where
-  definedVars := Command.definedVars
+  definedVars c _ := Command.definedVars c
   modifiedVars := Command.modifiedVars
-  modifiedOrDefinedVars := Command.modifiedOrDefinedVars
 
 instance : HasVarsImp Expression Statement where
   definedVars := Stmt.definedVars
   modifiedVars := Stmt.modifiedVars
-  modifiedOrDefinedVars := Stmt.modifiedOrDefinedVars
 
 instance : HasVarsImp Expression (List Statement) where
   definedVars := Block.definedVars
   modifiedVars := Block.modifiedVars
-  -- order matters for Havoc, so needs to override the default
-  modifiedOrDefinedVars := Block.modifiedOrDefinedVars
 
 ---------------------------------------------------------------------
 
@@ -276,7 +280,7 @@ def Command.getVarsTrans
   | .cmd c => Cmd.getVars (P:=Expression) c
   | .call f args _ =>
     let lhs := CallArg.getLhs args
-    (CallArg.getInputExprs args).flatMap HasVarsPure.getVars ++
+    (CallArg.getInputExprs args).flatMap HasFvars.getFvars ++
     match π f with
     | some proc => lhs ++ HasVarsTrans.getVarsTrans π proc
     | none => []
@@ -300,7 +304,7 @@ def Statement.getVarsTrans
     match decl.body with
     | none => []
     | some body =>
-      let bodyVars := HasVarsPure.getVars body
+      let bodyVars := HasFvars.getFvars body
       let formals := decl.inputs.map (·.1)
       bodyVars.filter (fun v => formals.all (fun f => v.name != f.name))
   | .typeDecl _ _ => []  -- Type declarations don't reference variables
@@ -324,13 +328,13 @@ def Command.definedVarsTrans
 -- since call statement does not define any new variables
 def Statement.definedVarsTrans
   (_ : String → Option ProcType) (s : Statement) :=
-  Stmt.definedVars s
+  Stmt.definedVars s false
 
 -- don't need to transitively lookup for procedures
 -- since call statement does not define any new variables
 def Statements.definedVarsTrans
   (_ : String → Option ProcType) (s : Statements) :=
-  Block.definedVars s
+  Block.definedVars s false
 
 mutual
 /-- get all variables modified or defined by the statement `s` (write-set, transitive). -/
@@ -404,7 +408,7 @@ def Statement.substFvar (s : Core.Statement)
           (Block.substFvar elseb fr to) metadata
   | .loop guard measure invariant body metadata =>
     .loop (guard.map (Lambda.LExpr.substFvar · fr to))
-          (Option.map (Lambda.LExpr.substFvar · fr to) measure)
+          (measure.map (Lambda.LExpr.substFvar · fr to))
           (invariant.map (fun (l, e) => (l, Lambda.LExpr.substFvar e fr to)))
           (Block.substFvar body fr to)
           metadata
diff --git a/Strata/Languages/Core/StatementEval.lean b/Strata/Languages/Core/StatementEval.lean
index bdf236dd97..3e32b77a80 100644
--- a/Strata/Languages/Core/StatementEval.lean
+++ b/Strata/Languages/Core/StatementEval.lean
@@ -765,7 +765,7 @@ def Command.runCall (lhs : List Expression.Ident) (procName : String) (args : Li
     match Program.Procedure.find? E.program ⟨procName, ()⟩ with
     | none => CmdEval.updateError E (.Misc s!"procedure '{procName}' not found")
     | some proc =>
-      if proc.body.isEmpty then CmdEval.updateError E (.Misc s!"procedure '{proc.header.name}' has no body")
+      if proc.body.isAbstract then CmdEval.updateError E (.Misc s!"procedure '{proc.header.name}' has no body")
       else
         match args.mapM (LExpr.run E.exprEnv) with
         | .error s => CmdEval.updateError E (.Misc s)
@@ -805,9 +805,14 @@ def Command.runCall (lhs : List Expression.Ident) (procName : String) (args : Li
               hasError := fun E => E.error.isSome
               addError := fun E msg => CmdEval.updateError E (.Misc msg)
             }
-            let config : Imperative.RunConfig Expression Command Env :=
-              .stmts proc.body callEnv
-            let configAfter := Imperative.runStmt ops fuel' config
+            let configAfter := match proc.body with
+              | .structured ss =>
+                let config : Imperative.RunConfig Expression Command Env :=
+                  .stmts ss callEnv
+                Imperative.runStmt ops fuel' config
+              | .cfg _ =>
+                .terminal (CmdEval.updateError callEnv
+                  (.Misc s!"procedure '{procName}': CFG bodies not supported yet"))
             match configAfter with
             | .terminal callEnv' =>
               match callEnv'.error with
diff --git a/Strata/Languages/Core/StatementSemantics.lean b/Strata/Languages/Core/StatementSemantics.lean
index 3dae95242c..76545a3cc5 100644
--- a/Strata/Languages/Core/StatementSemantics.lean
+++ b/Strata/Languages/Core/StatementSemantics.lean
@@ -6,6 +6,8 @@
 module
 
 public import Strata.DL.Imperative.StmtSemantics
+public import Strata.DL.Imperative.CFGSemantics
+public import Strata.Languages.Core.CoreGen
 public import Strata.Languages.Core.Procedure
 public import Strata.Languages.Core.Factory
 import Std.Tactic.BVDecide.Normalize.Prop
@@ -37,12 +39,6 @@ instance : HasSubstFvar Core.Expression where
   substFvar := Lambda.LExpr.substFvar
   substFvars := Lambda.LExpr.substFvars
 
-instance : HasIntOrder Core.Expression where
-  eq    e1 e2 := .eq () e1 e2
-  lt    e1 e2 := .app () (.app () Core.intLtOp e1) e2
-  zero        := .intConst () 0
-  intTy       := .forAll [] (.tcons "int" [])
-
 instance : HasIdent Core.Expression where
   ident s := ⟨s, ()⟩
 
@@ -51,17 +47,65 @@ def Core.true : Core.Expression.Expr := .boolConst () Bool.true
 @[expose, match_pattern]
 def Core.false : Core.Expression.Expr := .boolConst () Bool.false
 
+/-- Syntactic check for integer numeral literals in Core. -/
+def Core.isNumeral : Core.Expression.Expr → Bool
+  | .const _ (.intConst _) => Bool.true
+  | _ => Bool.false
+
 instance : HasBool Core.Expression where
   tt := Core.true
   ff := Core.false
   tt_is_not_ff := by unfold Core.true Core.false; unfold Lambda.LExpr.boolConst; simp
   boolTy := .forAll [] (.tcons "bool" [])
+  boolIsVal := ⟨Value.const, Value.const⟩
+
+theorem numeralHasNoVars_aux : ∀ (n : Core.Expression.Expr),
+    Core.isNumeral n = Bool.true →
+    HasFvars.getFvars (P := Core.Expression) n = []
+  | .const _ (.intConst _), _ => rfl
+  | .const _ (.boolConst _), hn => by simp [Core.isNumeral] at hn
+  | .const _ (.strConst _), hn => by simp [Core.isNumeral] at hn
+  | .const _ (.realConst _), hn => by simp [Core.isNumeral] at hn
+  | .const _ (.bitvecConst _ _), hn => by simp [Core.isNumeral] at hn
+  | .bvar _ _, hn => by simp [Core.isNumeral] at hn
+  | .fvar _ _ _, hn => by simp [Core.isNumeral] at hn
+  | .op _ _ _, hn => by simp [Core.isNumeral] at hn
+  | .abs _ _ _ _, hn => by simp [Core.isNumeral] at hn
+  | .quant _ _ _ _ _ _, hn => by simp [Core.isNumeral] at hn
+  | .app _ _ _, hn => by simp [Core.isNumeral] at hn
+  | .ite _ _ _ _, hn => by simp [Core.isNumeral] at hn
+  | .eq _ _ _, hn => by simp [Core.isNumeral] at hn
+
+instance : HasInt Core.Expression where
+  zero        := .intConst () 0
+  intTy       := .forAll [] (.tcons "int" [])
+  isNumeral   := Core.isNumeral
+  numeralIsValue n hn := by
+    show Value n
+    cases n with
+    | const m c =>
+      cases c with
+      | intConst _ => exact Value.const
+      | _ => simp [Core.isNumeral] at hn
+    | _ => simp [Core.isNumeral] at hn
+  zeroIsNumeral := by
+    show Core.isNumeral (.intConst () 0) = Bool.true
+    rfl
+  numeralHasNoFvars := numeralHasNoVars_aux
+
+instance : HasIntOps Core.Expression where
+  eq    e1 e2 := .eq () e1 e2
+  lt    e1 e2 := .app () (.app () Core.intLtOp e1) e2
 
-instance : HasNot Core.Expression where
+instance : HasBoolOps Core.Expression where
   not
   | Core.true => Core.false
   | Core.false => Core.true
   | e => Lambda.LExpr.app () (Lambda.boolNotFunc (T:=CoreLParams)).opExpr e
+  and e1 e2 := Lambda.LExpr.app () (Lambda.LExpr.app ()
+    (Lambda.boolAndFunc (T:=CoreLParams)).opExpr e1) e2
+  imp e1 e2 := Lambda.LExpr.app () (Lambda.LExpr.app ()
+    (Lambda.boolImpliesFunc (T:=CoreLParams)).opExpr e1) e2
 
 @[expose] abbrev CoreEval := SemanticEval Expression
 @[expose] abbrev CoreStore := SemanticStore Expression
@@ -98,11 +142,11 @@ structure WellFormedCoreEvalCong (δ : CoreEval): Prop where
     /-- Definedness-propagation properties for compound expressions. -/
     definedness : WellFormedCoreEvalDefinedness δ
 
-inductive EvalExpressions {P} [HasVarsPure P P.Expr] : SemanticEval P → SemanticStore P → List P.Expr → List P.Expr → Prop where
+inductive EvalExpressions {P} [HasFvars P] : SemanticEval P → SemanticStore P → List P.Expr → List P.Expr → Prop where
   | eval_none :
     EvalExpressions δ σ [] []
   | eval_some :
-    isDefined σ (HasVarsPure.getVars e) →
+    isDefined σ (HasFvars.getFvars e) →
     δ σ e = .some v →
     EvalExpressions δ σ es vs →
     EvalExpressions δ σ (e :: es) (v :: vs)
@@ -210,7 +254,7 @@ def WellFormedCoreEvalTwoState (δ : CoreEval) (σ₀ σ : CoreStore) : Prop :=
 Build a list of substitutions from the store for the given identifiers.
 Returns pairs of (identifier, value) for each identifier that has a value in the store.
 -/
-def buildSubstitutions (σ : CoreStore) (ids : List Expression.Ident) : List (Expression.Ident × Expression.Expr) :=
+@[expose] def buildSubstitutions (σ : CoreStore) (ids : List Expression.Ident) : List (Expression.Ident × Expression.Expr) :=
   ids.filterMap (fun id =>
     match σ id with
     | some v => some (id, v)
@@ -221,16 +265,16 @@ Apply closure capture to a function declaration by substituting current variable
 values into the function body and axioms. Variables that are function parameters
 are not substituted (they are bound, not free in the closure sense).
 -/
-def closureCapture
+@[expose] def closureCapture
     (σ : CoreStore) (decl : PureFunc Expression) : PureFunc Expression :=
   let paramNames := decl.inputs.map (·.1)
   -- Get free variables from body (if it exists), excluding parameters
   let bodyFreeVars := match decl.body with
-    | some body => (HasVarsPure.getVars body).filter (· ∉ paramNames)
+    | some body => (HasFvars.getFvars body).filter (· ∉ paramNames)
     | none => []
   -- Get free variables from axioms, excluding parameters
   let axiomFreeVars := decl.axioms.flatMap (fun ax =>
-    (HasVarsPure.getVars ax).filter (· ∉ paramNames))
+    (HasFvars.getFvars ax).filter (· ∉ paramNames))
   -- Combine and deduplicate
   let allFreeVars := (bodyFreeVars ++ axiomFreeVars).eraseDups
   -- Build substitutions from the store
@@ -249,7 +293,7 @@ the newly declared function by substituting arguments into the captured body.
 Takes a parameter `φ` that specifies how to extend the evaluator with a captured
 closure (without the store, since closure capture is handled here).
 -/
-def EvalPureFunc (φ : CoreEval → PureFunc Expression → CoreEval) : Imperative.ExtendEval Expression :=
+@[expose] def EvalPureFunc (φ : CoreEval → PureFunc Expression → CoreEval) : Imperative.ExtendEval Expression :=
   fun δ σ decl =>
     let capturedDecl := closureCapture σ decl
     φ δ capturedDecl
@@ -284,6 +328,24 @@ inductive CoreStepStar
     ----
     CoreStepStar π φ c₁ c₃
 
+/-- Execution of a procedure body. Only structured bodies have an executable
+    semantics; the `.cfg` arm of `Procedure.Body` has no inhabitant of
+    `CoreBodyExec`.
+
+    For structured bodies, the body is wrapped in `Stmt.block "" ss #[]` so that
+    `funcDecl` extensions and other inner scoping introduced by the body do not
+    leak past the procedure boundary.  This wrapping mirrors
+    `Specification.AssertValidInProcedure` and the `procToVerifyStmt` pipeline. -/
+inductive CoreBodyExec
+    (π : String → Option Procedure)
+    (φ : CoreEval → PureFunc Expression → CoreEval) :
+    Procedure.Body → CoreStore → CoreEval → CoreStore → CoreEval → Bool → Prop where
+  | structured :
+    CoreStepStar π φ
+      (.stmt (Stmt.block "" ss #[]) ⟨σ, δ, false⟩)
+      (.terminal ρ') →
+    CoreBodyExec π φ (.structured ss) σ δ ρ'.store ρ'.eval ρ'.hasFailure
+
 inductive EvalCommand (π : String → Option Procedure) (φ : CoreEval → PureFunc Expression → CoreEval) : CoreEval →
   CoreStore → Command → CoreStore → Bool → Prop where
   | cmd_sem {δ σ c σ' f} :
@@ -294,7 +356,7 @@ inductive EvalCommand (π : String → Option Procedure) (φ : CoreEval → Pure
   /-- Arguments are matched positionally: `inArgs` (from `getInputExprs`)
       aligns with `p.header.inputs`, and `lhs` (from `getLhs`) aligns
       with `p.header.outputs`. -/
-  | call_sem {δ σ₀ σ inArgs vals oVals σA σAO n p modvals callArgs σ' ρ' md} :
+  | call_sem {δ σ₀ σ inArgs vals oVals σA σAO n p modvals callArgs σ' σ_final δ_final failed md} :
     π n = .some p →
     -- inArg exprs + fvar refs for inoutArg ids
     CallArg.getInputExprs callArgs = inArgs →
@@ -314,15 +376,13 @@ inductive EvalCommand (π : String → Option Procedure) (φ : CoreEval → Pure
     -- positional: oVals[i] initializes p.header.outputs[i]
     InitStates σA (ListMap.keys (p.header.outputs)) oVals σAO →
     (∀ pre, (Procedure.Spec.getCheckExprs p.spec.preconditions).contains pre →
-      isDefinedOver (HasVarsPure.getVars) σAO pre ∧
+      isDefinedOver (HasFvars.getFvars) σAO pre ∧
       δ σAO pre = .some HasBool.tt) →
-    CoreStepStar π φ
-      (.stmts p.body ⟨σAO, δ, false⟩)
-      (.terminal ρ') →
+    CoreBodyExec π φ p.body σAO δ σ_final δ_final failed →
     (∀ post, (Procedure.Spec.getCheckExprs p.spec.postconditions).contains post →
-      isDefinedOver (HasVarsPure.getVars) σAO post ∧
-      δ ρ'.store post = .some HasBool.tt) →
-    ReadValues ρ'.store (ListMap.keys (p.header.outputs)) modvals →
+      isDefinedOver (HasFvars.getFvars) σAO post ∧
+      δ_final σ_final post = .some HasBool.tt) →
+    ReadValues σ_final (ListMap.keys (p.header.outputs)) modvals →
     -- positional: modvals[i] written back to lhs[i]
     UpdateStates σ lhs modvals σ' →
     ----
@@ -372,9 +432,11 @@ def withOldBindings
     aid.label = label ∧ aid.expr = expr
   | .stmts ((.cmd (.cmd (.assert label expr _))) :: _) _, aid =>
     aid.label = label ∧ aid.expr = expr
-  | .stmt (.loop _ _ inv _ _) _, aid => (aid.label, aid.expr) ∈ inv
-  | .stmts ((.loop _ _ inv _ _) :: _) _, aid => (aid.label, aid.expr) ∈ inv
-  | .block _ _ inner, aid => coreIsAtAssert inner aid
+  | .stmt (.loop _ _ inv _ _) _, aid =>
+    (aid.label, aid.expr) ∈ inv
+  | .stmts ((.loop _ _ inv _ _) :: _) _, aid =>
+    (aid.label, aid.expr) ∈ inv
+  | .block _ _ _ inner, aid => coreIsAtAssert inner aid
   | .seq inner _, aid => coreIsAtAssert inner aid
   | _, _ => False
 
@@ -425,11 +487,11 @@ inductive EvalCommandContract : (String → Option Procedure)  → CoreEval →
     -- positional: oVals[i] initializes p.header.outputs[i]
     InitStates σA (ListMap.keys (p.header.outputs)) oVals σAO →
     (∀ pre, (Procedure.Spec.getCheckExprs p.spec.preconditions).contains pre →
-      isDefinedOver (HasVarsPure.getVars) σAO pre ∧
+      isDefinedOver (HasFvars.getFvars) σAO pre ∧
       δ σAO pre = .some HasBool.tt) →
     HavocVars σAO (ListMap.keys p.header.outputs) σO →
     (∀ post, (Procedure.Spec.getCheckExprs p.spec.postconditions).contains post →
-      isDefinedOver (HasVarsPure.getVars) σAO post ∧
+      isDefinedOver (HasFvars.getFvars) σAO post ∧
       δ σO post = .some HasBool.tt) →
     ReadValues σO (ListMap.keys (p.header.outputs)) modvals →
     -- positional: modvals[i] written back to lhs[i]
diff --git a/Strata/Languages/Core/StatementSemanticsProps.lean b/Strata/Languages/Core/StatementSemanticsProps.lean
index 59ae6d6aaf..862a8c099c 100644
--- a/Strata/Languages/Core/StatementSemanticsProps.lean
+++ b/Strata/Languages/Core/StatementSemanticsProps.lean
@@ -6,7 +6,11 @@
 module
 
 import all Strata.DL.Imperative.CmdSemantics
+public import Strata.DL.Imperative.CmdSemanticsProps
+import all Strata.DL.Imperative.CmdSemanticsProps
 import all Strata.DL.Imperative.StmtSemantics
+public import Strata.DL.Imperative.StmtSemanticsProps
+import all Strata.DL.Imperative.StmtSemanticsProps
 import all Strata.DL.Imperative.HasVars
 import all Strata.DL.Util.Nodup
 public import Strata.DL.Util.ListUtils
@@ -48,7 +52,7 @@ theorem TouchVarsEmpty :
 theorem EvalBlockEmpty' {P : PureExpr} {Cmd : Type} {EvalCmd : EvalCmdParam P Cmd}
   {extendEval : ExtendEval P}
   { ρ ρ' : Env P }
-  [HasBool P] [HasNot P] :
+  [HasBool P] [HasBoolOps P] [HasFvars P] [HasInt P] [HasIntOps P] :
   EvalStmtsSmall P EvalCmd extendEval ρ ([]: (List (Stmt P Cmd))) ρ' → ρ = ρ' := by
   intro H
   match H with
@@ -1746,32 +1750,12 @@ theorem EvalCmdDefMonotone' :
   EvalCmd Core.Expression δ σ c σ' f →
   isDefined σ' v := by
   intros Hdef Heval
-  cases Heval <;> try exact Hdef
-  next _ Hup => exact InitStateDefMonotone Hdef Hup  -- eval_init
-  next Hup => exact InitStateDefMonotone Hdef Hup    -- eval_init_unconstrained
-  next _ Hup => exact UpdateStateDefMonotone Hdef Hup
-  next Hup => exact UpdateStateDefMonotone Hdef Hup
-
-theorem EvalCmdTouch
-  [HasVal P] [HasFvar P] [HasBool P] [HasBoolVal P] [HasNot P] :
-  EvalCmd P δ σ c σ' f →
-  TouchVars σ (HasVarsImp.modifiedOrDefinedVars c) σ' := by
-  intro Heval
-  induction Heval <;> simp [HasVarsImp.modifiedOrDefinedVars, Cmd.definedVars, Cmd.modifiedVars]
-  case eval_init x' δ σ x v σ' σ₀ e Hsm Hup Hwf =>
-    apply TouchVars.init_some Hup
-    constructor
-  case eval_init_unconstrained x' δ σ x v σ' σ₀ Hup Hwf =>
-    apply TouchVars.init_some Hup
-    constructor
-  case eval_set δ σ x v σ' σ₀ e Hsm Hup Hwf =>
-    exact TouchVars.update_some Hup TouchVars.none
-  case eval_set_nondet x v σ' σ₀ e Hsm Hup Hwf =>
-    exact TouchVars.update_some Hup TouchVars.none
-  case eval_assert_pass => exact TouchVars.none
-  case eval_assert_fail => exact TouchVars.none
-  case eval_assume => exact TouchVars.none
-  case eval_cover => exact TouchVars.none
+  cases Heval with
+  | eval_init Hsm Hup Hwf => exact InitStateDefMonotone Hdef Hup
+  | eval_init_unconstrained Hup Hwf => exact InitStateDefMonotone Hdef Hup
+  | eval_set Hsm Hup Hwf => exact UpdateStateDefMonotone Hdef Hup
+  | eval_set_nondet Hup Hwf => exact UpdateStateDefMonotone Hdef Hup
+  | _ => exact Hdef
 
 theorem UpdateStatesHavocVars : UpdateStates σ vars modvals σ' → HavocVars σ vars σ' := by
   intros H
@@ -2095,8 +2079,8 @@ private theorem StepStmt_refines_contract
   | step_ite_false h1 h2 => exact .step_ite_false h1 h2
   | step_ite_nondet_true => exact .step_ite_nondet_true
   | step_ite_nondet_false => exact .step_ite_nondet_false
-  | step_loop_enter h1 h2 => exact .step_loop_enter h1 h2
-  | step_loop_exit h1 h2 => exact .step_loop_exit h1 h2
+  | step_loop_enter h1 h2 h3 h4 h5 h6 h7 => exact .step_loop_enter h1 h2 h3 h4 h5 h6 h7
+  | step_loop_exit h1 h2 h3 h4 => exact .step_loop_exit h1 h2 h3 h4
   | step_loop_nondet_enter => exact .step_loop_nondet_enter
   | step_loop_nondet_exit => exact .step_loop_nondet_exit
   | step_exit => exact .step_exit
@@ -2143,12 +2127,12 @@ theorem EvalExpressionIsDefined :
   WellFormedCoreEvalCong δ →
   WellFormedSemanticEvalVar δ →
   (δ σ e).isSome →
-  isDefined σ (HasVarsPure.getVars e) := by
+  isDefined σ (HasFvars.getFvars e) := by
   intros Hwfc Hwfvr Hsome
   intros v Hin
   simp [WellFormedSemanticEvalVar] at Hwfvr
   induction e generalizing v <;>
-    simp [HasVarsPure.getVars, Lambda.LExpr.LExpr.getVars] at *
+    simp [HasFvars.getFvars, Lambda.LExpr.LExpr.getVars] at *
   case fvar m v' ty' =>
     specialize Hwfvr (Lambda.LExpr.fvar m v' ty') v' σ
     simp [HasFvar.getFvar] at Hwfvr
@@ -2243,10 +2227,11 @@ theorem core_block_inner_star
     {π : String → Option Procedure}
     {φ : CoreEval → PureFunc Expression → CoreEval}
     (inner inner' : CoreConfig) (label : Option String) (σ_parent : SemanticStore Expression)
+    (e_parent : Imperative.SemanticEval Expression)
     (h : CoreStepStar π φ inner inner') :
-    CoreStepStar π φ (.block label σ_parent inner) (.block label σ_parent inner') :=
+    CoreStepStar π φ (.block label σ_parent e_parent inner) (.block label σ_parent e_parent inner') :=
   StepStmtStar_to_CoreStepStar
-    (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) inner inner' label σ_parent
+    (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) inner inner' label σ_parent e_parent
       (CoreStepStar_to_StepStmtStar h))
 
 /-- Lift `seq_reaches_terminal` from `StepStmtStar` to `CoreStepStar`. -/
@@ -2268,130 +2253,292 @@ theorem core_seq_reaches_terminal
 variable (π : String → Option Procedure)
 variable (φ : CoreEval → PureFunc Expression → CoreEval)
 
-theorem core_step_preserves_wfBool
+/-! ### Config-level WF predicates for Core
+
+`step_block_done`/`exit_match`/`exit_mismatch` restore `eval := e_parent`, so
+preservation of WF along a trace requires WF of every captured `e_parent`
+snapshot in addition to WF of the inner eval. -/
+
+@[expose] def CoreConfig.wfBool : CoreConfig → Prop
+  | .stmt _ ρ => WellFormedSemanticEvalBool ρ.eval
+  | .stmts _ ρ => WellFormedSemanticEvalBool ρ.eval
+  | .terminal ρ => WellFormedSemanticEvalBool ρ.eval
+  | .exiting _ ρ => WellFormedSemanticEvalBool ρ.eval
+  | .block _ _ e_parent inner =>
+    WellFormedSemanticEvalBool e_parent ∧ CoreConfig.wfBool inner
+  | .seq inner _ => CoreConfig.wfBool inner
+
+@[expose] def CoreConfig.wfVar : CoreConfig → Prop
+  | .stmt _ ρ => WellFormedSemanticEvalVar ρ.eval
+  | .stmts _ ρ => WellFormedSemanticEvalVar ρ.eval
+  | .terminal ρ => WellFormedSemanticEvalVar ρ.eval
+  | .exiting _ ρ => WellFormedSemanticEvalVar ρ.eval
+  | .block _ _ e_parent inner =>
+    WellFormedSemanticEvalVar e_parent ∧ CoreConfig.wfVar inner
+  | .seq inner _ => CoreConfig.wfVar inner
+
+@[expose] def CoreConfig.wfCong : CoreConfig → Prop
+  | .stmt _ ρ => WellFormedCoreEvalCong ρ.eval
+  | .stmts _ ρ => WellFormedCoreEvalCong ρ.eval
+  | .terminal ρ => WellFormedCoreEvalCong ρ.eval
+  | .exiting _ ρ => WellFormedCoreEvalCong ρ.eval
+  | .block _ _ e_parent inner =>
+    WellFormedCoreEvalCong e_parent ∧ CoreConfig.wfCong inner
+  | .seq inner _ => CoreConfig.wfCong inner
+
+@[expose] def CoreConfig.wfExprCongr : CoreConfig → Prop
+  | .stmt _ ρ => @Imperative.WellFormedSemanticEvalExprCongr Expression _ ρ.eval
+  | .stmts _ ρ => @Imperative.WellFormedSemanticEvalExprCongr Expression _ ρ.eval
+  | .terminal ρ => @Imperative.WellFormedSemanticEvalExprCongr Expression _ ρ.eval
+  | .exiting _ ρ => @Imperative.WellFormedSemanticEvalExprCongr Expression _ ρ.eval
+  | .block _ _ e_parent inner =>
+    @Imperative.WellFormedSemanticEvalExprCongr Expression _ e_parent ∧
+    CoreConfig.wfExprCongr inner
+  | .seq inner _ => CoreConfig.wfExprCongr inner
+
+private theorem core_step_preserves_cfg_wfBool
     (h_wf_ext : WFEvalExtension φ)
     (c₁ c₂ : CoreConfig)
-    (hwf : WellFormedSemanticEvalBool c₁.getEnv.eval)
+    (hwf : c₁.wfBool)
     (hstep : CoreStep π φ c₁ c₂) :
-    WellFormedSemanticEvalBool c₂.getEnv.eval := by
+    c₂.wfBool := by
   induction hstep with
   | step_cmd hcmd => cases hcmd with
-    | cmd_sem _ | call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ =>
-        simp [Config.getEnv]; exact hwf
-  | step_block => simp [Config.getEnv]; exact hwf
-  | step_funcDecl => simp [Config.getEnv]; exact h_wf_ext.preserves_wfBool _ _ _ hwf
-  | step_seq_inner _ ih | step_block_body _ ih => exact ih hwf
+    | cmd_sem _ | @call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ =>
+        exact hwf
+  | step_block | step_ite_true | step_ite_false | step_ite_nondet_true
+  | step_ite_nondet_false | step_loop_enter | step_loop_nondet_enter => exact ⟨hwf, hwf⟩
+  | step_block_done | step_block_exit_match | step_block_exit_mismatch => exact hwf.1
+  | step_seq_inner _ ih => exact ih hwf
+  | step_block_body _ ih => exact ⟨hwf.1, ih hwf.2⟩
+  | step_funcDecl => exact h_wf_ext.preserves_wfBool _ _ _ hwf
   | _ => exact hwf
 
-theorem core_wfBool_preserved
+private theorem core_step_preserves_cfg_wfVar
     (h_wf_ext : WFEvalExtension φ)
     (c₁ c₂ : CoreConfig)
-    (hwf₀ : WellFormedSemanticEvalBool c₁.getEnv.eval)
-    (hstar : CoreStepStar π φ c₁ c₂) :
-    WellFormedSemanticEvalBool c₂.getEnv.eval := by
-  suffices h_gen : ∀ c₁ c₂, WellFormedSemanticEvalBool c₁.getEnv.eval →
-      Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ →
-      WellFormedSemanticEvalBool c₂.getEnv.eval from
-    h_gen c₁ c₂ hwf₀ (CoreStepStar_to_StepStmtStar hstar)
-  intro c₁ c₂ hwf₀ h
-  induction h with
-  | refl => exact hwf₀
-  | step _ _ _ hstep _ ih =>
-    exact ih (core_step_preserves_wfBool π φ h_wf_ext _ _ hwf₀ hstep)
-
-theorem core_step_preserves_wfVar
-    (h_wf_ext : WFEvalExtension φ)
-    (c₁ c₂ : CoreConfig)
-    (hwf : WellFormedSemanticEvalVar c₁.getEnv.eval)
+    (hwf : c₁.wfVar)
     (hstep : CoreStep π φ c₁ c₂) :
-    WellFormedSemanticEvalVar c₂.getEnv.eval := by
+    c₂.wfVar := by
   induction hstep with
   | step_cmd hcmd => cases hcmd with
-    | cmd_sem _ | call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ =>
-        simp [Config.getEnv]; exact hwf
-  | step_block => simp [Config.getEnv]; exact hwf
-  | step_funcDecl => simp [Config.getEnv]; exact h_wf_ext.preserves_wfVar _ _ _ hwf
-  | step_seq_inner _ ih | step_block_body _ ih => exact ih hwf
+    | cmd_sem _ | @call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ =>
+        exact hwf
+  | step_block | step_ite_true | step_ite_false | step_ite_nondet_true
+  | step_ite_nondet_false | step_loop_enter | step_loop_nondet_enter => exact ⟨hwf, hwf⟩
+  | step_block_done | step_block_exit_match | step_block_exit_mismatch => exact hwf.1
+  | step_seq_inner _ ih => exact ih hwf
+  | step_block_body _ ih => exact ⟨hwf.1, ih hwf.2⟩
+  | step_funcDecl => exact h_wf_ext.preserves_wfVar _ _ _ hwf
   | _ => exact hwf
 
-theorem core_wfVar_preserved
+private theorem core_step_preserves_cfg_wfCong
     (h_wf_ext : WFEvalExtension φ)
     (c₁ c₂ : CoreConfig)
-    (hwf₀ : WellFormedSemanticEvalVar c₁.getEnv.eval)
-    (hstar : CoreStepStar π φ c₁ c₂) :
-    WellFormedSemanticEvalVar c₂.getEnv.eval := by
-  suffices h_gen : ∀ c₁ c₂, WellFormedSemanticEvalVar c₁.getEnv.eval →
-      Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ →
-      WellFormedSemanticEvalVar c₂.getEnv.eval from
-    h_gen c₁ c₂ hwf₀ (CoreStepStar_to_StepStmtStar hstar)
-  intro c₁ c₂ hwf₀ h
-  induction h with
-  | refl => exact hwf₀
-  | step _ _ _ hstep _ ih =>
-    exact ih (core_step_preserves_wfVar π φ h_wf_ext _ _ hwf₀ hstep)
+    (hwf : c₁.wfCong)
+    (hstep : CoreStep π φ c₁ c₂) :
+    c₂.wfCong := by
+  induction hstep with
+  | step_cmd hcmd => cases hcmd with
+    | cmd_sem _ | @call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ =>
+        exact hwf
+  | step_block | step_ite_true | step_ite_false | step_ite_nondet_true
+  | step_ite_nondet_false | step_loop_enter | step_loop_nondet_enter => exact ⟨hwf, hwf⟩
+  | step_block_done | step_block_exit_match | step_block_exit_mismatch => exact hwf.1
+  | step_seq_inner _ ih => exact ih hwf
+  | step_block_body _ ih => exact ⟨hwf.1, ih hwf.2⟩
+  | step_funcDecl => exact h_wf_ext.preserves_wfCong _ _ _ hwf
+  | _ => exact hwf
 
-theorem core_step_preserves_wfCong
+private theorem core_step_preserves_cfg_wfExprCongr
     (h_wf_ext : WFEvalExtension φ)
     (c₁ c₂ : CoreConfig)
-    (hwf : WellFormedCoreEvalCong c₁.getEnv.eval)
+    (hwf : c₁.wfExprCongr)
     (hstep : CoreStep π φ c₁ c₂) :
-    WellFormedCoreEvalCong c₂.getEnv.eval := by
+    c₂.wfExprCongr := by
   induction hstep with
   | step_cmd hcmd => cases hcmd with
-    | cmd_sem _ | call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ =>
-        simp [Config.getEnv]; exact hwf
-  | step_block => simp [Config.getEnv]; exact hwf
-  | step_funcDecl => simp [Config.getEnv]; exact h_wf_ext.preserves_wfCong _ _ _ hwf
-  | step_seq_inner _ ih | step_block_body _ ih => exact ih hwf
+    | cmd_sem _ | @call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ =>
+        exact hwf
+  | step_block | step_ite_true | step_ite_false | step_ite_nondet_true
+  | step_ite_nondet_false | step_loop_enter | step_loop_nondet_enter => exact ⟨hwf, hwf⟩
+  | step_block_done | step_block_exit_match | step_block_exit_mismatch => exact hwf.1
+  | step_seq_inner _ ih => exact ih hwf
+  | step_block_body _ ih => exact ⟨hwf.1, ih hwf.2⟩
+  | step_funcDecl => exact h_wf_ext.preserves_wfExprCongr _ _ _ hwf
   | _ => exact hwf
 
-theorem core_wfCong_preserved
+private theorem CoreConfig.wfBool_implies_wfEval (cfg : CoreConfig) :
+    cfg.wfBool → WellFormedSemanticEvalBool cfg.getEnv.eval := by
+  induction cfg with
+  | stmt | stmts | terminal | exiting => intro h; exact h
+  | block _ _ _ inner ih => intro h; exact ih h.2
+  | seq inner _ ih => intro h; exact ih h
+
+private theorem CoreConfig.wfVar_implies_wfEval (cfg : CoreConfig) :
+    cfg.wfVar → WellFormedSemanticEvalVar cfg.getEnv.eval := by
+  induction cfg with
+  | stmt | stmts | terminal | exiting => intro h; exact h
+  | block _ _ _ inner ih => intro h; exact ih h.2
+  | seq inner _ ih => intro h; exact ih h
+
+private theorem CoreConfig.wfCong_implies_wfEval (cfg : CoreConfig) :
+    cfg.wfCong → WellFormedCoreEvalCong cfg.getEnv.eval := by
+  induction cfg with
+  | stmt | stmts | terminal | exiting => intro h; exact h
+  | block _ _ _ inner ih => intro h; exact ih h.2
+  | seq inner _ ih => intro h; exact ih h
+
+private theorem CoreConfig.wfExprCongr_implies_wfEval (cfg : CoreConfig) :
+    cfg.wfExprCongr → @Imperative.WellFormedSemanticEvalExprCongr Expression _ cfg.getEnv.eval := by
+  induction cfg with
+  | stmt | stmts | terminal | exiting => intro h; exact h
+  | block _ _ _ inner ih => intro h; exact ih h.2
+  | seq inner _ ih => intro h; exact ih h
+
+private theorem core_star_preserves_cfg_wfBool
     (h_wf_ext : WFEvalExtension φ)
-    (c₁ c₂ : CoreConfig)
-    (hwf₀ : WellFormedCoreEvalCong c₁.getEnv.eval)
-    (hstar : CoreStepStar π φ c₁ c₂) :
-    WellFormedCoreEvalCong c₂.getEnv.eval := by
-  suffices h_gen : ∀ c₁ c₂, WellFormedCoreEvalCong c₁.getEnv.eval →
+    {c₁ c₂ : CoreConfig}
+    (hstar : CoreStepStar π φ c₁ c₂)
+    (hwf : c₁.wfBool) :
+    c₂.wfBool := by
+  suffices ∀ (c₁ c₂ : CoreConfig),
       Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ →
-      WellFormedCoreEvalCong c₂.getEnv.eval from
-    h_gen c₁ c₂ hwf₀ (CoreStepStar_to_StepStmtStar hstar)
-  intro c₁ c₂ hwf₀ h
-  induction h with
-  | refl => exact hwf₀
+      c₁.wfBool → c₂.wfBool from
+    this c₁ c₂ (CoreStepStar_to_StepStmtStar hstar) hwf
+  intro c₁ c₂ hstar
+  induction hstar with
+  | refl => intro h; exact h
   | step _ _ _ hstep _ ih =>
-    exact ih (core_step_preserves_wfCong π φ h_wf_ext _ _ hwf₀ hstep)
+    intro h; exact ih (core_step_preserves_cfg_wfBool π φ h_wf_ext _ _ h hstep)
 
-theorem core_step_preserves_wfExprCongr
+private theorem core_star_preserves_cfg_wfVar
     (h_wf_ext : WFEvalExtension φ)
-    (c₁ c₂ : CoreConfig)
-    (hwf : @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₁.getEnv.eval)
-    (hstep : CoreStep π φ c₁ c₂) :
-    @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₂.getEnv.eval := by
-  induction hstep with
-  | step_cmd hcmd => cases hcmd with
-    | cmd_sem _ | call_sem _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ =>
-        simp [Config.getEnv]; exact hwf
-  | step_block => simp [Config.getEnv]; exact hwf
-  | step_funcDecl => simp [Config.getEnv]; exact h_wf_ext.preserves_wfExprCongr _ _ _ hwf
-  | step_seq_inner _ ih | step_block_body _ ih => exact ih hwf
-  | _ => exact hwf
+    {c₁ c₂ : CoreConfig}
+    (hstar : CoreStepStar π φ c₁ c₂)
+    (hwf : c₁.wfVar) :
+    c₂.wfVar := by
+  suffices ∀ (c₁ c₂ : CoreConfig),
+      Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ →
+      c₁.wfVar → c₂.wfVar from
+    this c₁ c₂ (CoreStepStar_to_StepStmtStar hstar) hwf
+  intro c₁ c₂ hstar
+  induction hstar with
+  | refl => intro h; exact h
+  | step _ _ _ hstep _ ih =>
+    intro h; exact ih (core_step_preserves_cfg_wfVar π φ h_wf_ext _ _ h hstep)
 
-theorem core_wfExprCongr_preserved
+private theorem core_star_preserves_cfg_wfCong
     (h_wf_ext : WFEvalExtension φ)
-    (c₁ c₂ : CoreConfig)
-    (hwf₀ : @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₁.getEnv.eval)
-    (hstar : CoreStepStar π φ c₁ c₂) :
-    @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₂.getEnv.eval := by
-  suffices h_gen : ∀ c₁ c₂,
-      @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₁.getEnv.eval →
+    {c₁ c₂ : CoreConfig}
+    (hstar : CoreStepStar π φ c₁ c₂)
+    (hwf : c₁.wfCong) :
+    c₂.wfCong := by
+  suffices ∀ (c₁ c₂ : CoreConfig),
       Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ →
-      @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₂.getEnv.eval from
-    h_gen c₁ c₂ hwf₀ (CoreStepStar_to_StepStmtStar hstar)
-  intro c₁ c₂ hwf₀ h
-  induction h with
-  | refl => exact hwf₀
+      c₁.wfCong → c₂.wfCong from
+    this c₁ c₂ (CoreStepStar_to_StepStmtStar hstar) hwf
+  intro c₁ c₂ hstar
+  induction hstar with
+  | refl => intro h; exact h
   | step _ _ _ hstep _ ih =>
-    exact ih (core_step_preserves_wfExprCongr π φ h_wf_ext _ _ hwf₀ hstep)
+    intro h; exact ih (core_step_preserves_cfg_wfCong π φ h_wf_ext _ _ h hstep)
+
+private theorem core_star_preserves_cfg_wfExprCongr
+    (h_wf_ext : WFEvalExtension φ)
+    {c₁ c₂ : CoreConfig}
+    (hstar : CoreStepStar π φ c₁ c₂)
+    (hwf : c₁.wfExprCongr) :
+    c₂.wfExprCongr := by
+  suffices ∀ (c₁ c₂ : CoreConfig),
+      Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ) c₁ c₂ →
+      c₁.wfExprCongr → c₂.wfExprCongr from
+    this c₁ c₂ (CoreStepStar_to_StepStmtStar hstar) hwf
+  intro c₁ c₂ hstar
+  induction hstar with
+  | refl => intro h; exact h
+  | step _ _ _ hstep _ ih =>
+    intro h; exact ih (core_step_preserves_cfg_wfExprCongr π φ h_wf_ext _ _ h hstep)
+
+theorem core_wfBool_preserved_stmt
+    (h_wf_ext : WFEvalExtension φ)
+    {s : Statement} {ρ : Env Expression} {c₂ : CoreConfig}
+    (hwf₀ : WellFormedSemanticEvalBool ρ.eval)
+    (hstar : CoreStepStar π φ (.stmt s ρ) c₂) :
+    WellFormedSemanticEvalBool c₂.getEnv.eval :=
+  CoreConfig.wfBool_implies_wfEval _
+    (core_star_preserves_cfg_wfBool π φ h_wf_ext hstar
+      (show CoreConfig.wfBool (.stmt s ρ) from hwf₀))
+
+theorem core_wfBool_preserved_stmts
+    (h_wf_ext : WFEvalExtension φ)
+    {ss : List Statement} {ρ : Env Expression} {c₂ : CoreConfig}
+    (hwf₀ : WellFormedSemanticEvalBool ρ.eval)
+    (hstar : CoreStepStar π φ (.stmts ss ρ) c₂) :
+    WellFormedSemanticEvalBool c₂.getEnv.eval :=
+  CoreConfig.wfBool_implies_wfEval _
+    (core_star_preserves_cfg_wfBool π φ h_wf_ext hstar
+      (show CoreConfig.wfBool (.stmts ss ρ) from hwf₀))
+
+theorem core_wfVar_preserved_stmt
+    (h_wf_ext : WFEvalExtension φ)
+    {s : Statement} {ρ : Env Expression} {c₂ : CoreConfig}
+    (hwf₀ : WellFormedSemanticEvalVar ρ.eval)
+    (hstar : CoreStepStar π φ (.stmt s ρ) c₂) :
+    WellFormedSemanticEvalVar c₂.getEnv.eval :=
+  CoreConfig.wfVar_implies_wfEval _
+    (core_star_preserves_cfg_wfVar π φ h_wf_ext hstar
+      (show CoreConfig.wfVar (.stmt s ρ) from hwf₀))
+
+theorem core_wfVar_preserved_stmts
+    (h_wf_ext : WFEvalExtension φ)
+    {ss : List Statement} {ρ : Env Expression} {c₂ : CoreConfig}
+    (hwf₀ : WellFormedSemanticEvalVar ρ.eval)
+    (hstar : CoreStepStar π φ (.stmts ss ρ) c₂) :
+    WellFormedSemanticEvalVar c₂.getEnv.eval :=
+  CoreConfig.wfVar_implies_wfEval _
+    (core_star_preserves_cfg_wfVar π φ h_wf_ext hstar
+      (show CoreConfig.wfVar (.stmts ss ρ) from hwf₀))
+
+theorem core_wfCong_preserved_stmt
+    (h_wf_ext : WFEvalExtension φ)
+    {s : Statement} {ρ : Env Expression} {c₂ : CoreConfig}
+    (hwf₀ : WellFormedCoreEvalCong ρ.eval)
+    (hstar : CoreStepStar π φ (.stmt s ρ) c₂) :
+    WellFormedCoreEvalCong c₂.getEnv.eval :=
+  CoreConfig.wfCong_implies_wfEval _
+    (core_star_preserves_cfg_wfCong π φ h_wf_ext hstar
+      (show CoreConfig.wfCong (.stmt s ρ) from hwf₀))
+
+theorem core_wfCong_preserved_stmts
+    (h_wf_ext : WFEvalExtension φ)
+    {ss : List Statement} {ρ : Env Expression} {c₂ : CoreConfig}
+    (hwf₀ : WellFormedCoreEvalCong ρ.eval)
+    (hstar : CoreStepStar π φ (.stmts ss ρ) c₂) :
+    WellFormedCoreEvalCong c₂.getEnv.eval :=
+  CoreConfig.wfCong_implies_wfEval _
+    (core_star_preserves_cfg_wfCong π φ h_wf_ext hstar
+      (show CoreConfig.wfCong (.stmts ss ρ) from hwf₀))
+
+theorem core_wfExprCongr_preserved_stmt
+    (h_wf_ext : WFEvalExtension φ)
+    {s : Statement} {ρ : Env Expression} {c₂ : CoreConfig}
+    (hwf₀ : @Imperative.WellFormedSemanticEvalExprCongr Expression _ ρ.eval)
+    (hstar : CoreStepStar π φ (.stmt s ρ) c₂) :
+    @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₂.getEnv.eval :=
+  CoreConfig.wfExprCongr_implies_wfEval _
+    (core_star_preserves_cfg_wfExprCongr π φ h_wf_ext hstar
+      (show CoreConfig.wfExprCongr (.stmt s ρ) from hwf₀))
+
+theorem core_wfExprCongr_preserved_stmts
+    (h_wf_ext : WFEvalExtension φ)
+    {ss : List Statement} {ρ : Env Expression} {c₂ : CoreConfig}
+    (hwf₀ : @Imperative.WellFormedSemanticEvalExprCongr Expression _ ρ.eval)
+    (hstar : CoreStepStar π φ (.stmts ss ρ) c₂) :
+    @Imperative.WellFormedSemanticEvalExprCongr Expression _ c₂.getEnv.eval :=
+  CoreConfig.wfExprCongr_implies_wfEval _
+    (core_star_preserves_cfg_wfExprCongr π φ h_wf_ext hstar
+      (show CoreConfig.wfExprCongr (.stmts ss ρ) from hwf₀))
 
 /-! ## projectStore and expression evaluation -/
 
@@ -2408,7 +2555,7 @@ theorem eval_projectStore_to_full
     δ σ e = some v := by
   have h_def := EvalExpressionIsDefined h_wfCong h_wfVar
     (show (δ (projectStore σ₀ σ) e).isSome from by rw [h_eval]; simp)
-  have h_agree : ∀ x ∈ HasVarsPure.getVars e, (projectStore σ₀ σ) x = σ x := by
+  have h_agree : ∀ x ∈ HasFvars.getFvars e, (projectStore σ₀ σ) x = σ x := by
     intro x hx
     have h_x_def : (projectStore σ₀ σ x).isSome = true := h_def x hx
     simp only [projectStore] at h_x_def ⊢
@@ -2482,8 +2629,8 @@ private theorem coreIsAtAssert_seq_of_inner
     (h : coreIsAtAssert inner a) : coreIsAtAssert (.seq inner ss) a := h
 
 private theorem coreIsAtAssert_block_of_inner
-    {label} {σ_parent} {inner : CoreConfig} {a}
-    (h : coreIsAtAssert inner a) : coreIsAtAssert (.block label σ_parent inner) a := h
+    {label} {σ_parent} {e_parent} {inner : CoreConfig} {a}
+    (h : coreIsAtAssert inner a) : coreIsAtAssert (.block label σ_parent e_parent inner) a := h
 
 private theorem evalCommand_failure_implies_assert_ff
     {π : String → Option Procedure} {φ : CoreEval → PureFunc Expression → CoreEval}
diff --git a/Strata/Languages/Core/Verifier.lean b/Strata/Languages/Core/Verifier.lean
index bceeaa81a0..cd5c30cdf5 100644
--- a/Strata/Languages/Core/Verifier.lean
+++ b/Strata/Languages/Core/Verifier.lean
@@ -663,7 +663,12 @@ def buildEnv (options : VerifyOptions) (program : Program)
         for func in funcs do E ← E.addFactoryFunc func
       | .distinct _ es _ => E := { E with distinct := es :: E.distinct }
       | .proc proc _ =>
-        for stmt in proc.body.flatMap collectFuncDecls do
+        let stmts := match proc.body with
+          | .structured ss => ss
+          -- CFG bodies cannot contain local function declarations;
+          -- funcDecl is a structured statement-level construct only.
+          | .cfg _ => []
+        for stmt in stmts.flatMap collectFuncDecls do
           match E.exprEnv.addFactoryFunc stmt with
           | .ok σ' => E := { E with exprEnv := σ' }
           | .error _ => pure ()
@@ -742,7 +747,7 @@ def toCoreProofObligationProgram (options : VerifyOptions) (program : Program)
     | some name => [Decl.proc {
         header := { name := name, typeArgs := [], inputs := [], outputs := [] },
         spec := { preconditions := [], postconditions := [] },
-        body := body
+        body := .structured body
       } .empty]
     | none => []
 
@@ -1953,7 +1958,7 @@ structure Diagnostic where
   ending : Lean.Position
   message : String
   type : DiagnosticType
-  deriving Repr, BEq
+  deriving Repr, BEq, Lean.ToExpr
 
 def DiagnosticModel.toDiagnostic (files: Map Strata.Uri Lean.FileMap) (dm: DiagnosticModel): Diagnostic :=
   let fileMap := (files.find? dm.fileRange.file).getD
diff --git a/Strata/Languages/Core/WF.lean b/Strata/Languages/Core/WF.lean
index dc8fc161d2..527e058e7b 100644
--- a/Strata/Languages/Core/WF.lean
+++ b/Strata/Languages/Core/WF.lean
@@ -114,7 +114,7 @@ structure WFPreProp (p : Program) (d : Procedure) (pp : CoreLabel × Procedure.C
 
 structure WFPostProp (p : Program) (d : Procedure) (pp : CoreLabel × Procedure.Check)
   : Prop extends WFPrePostProp p d pp where
-  oldOnlyInout : ∀ id ∈ Imperative.HasVarsPure.getVars (P := Expression) pp.2.expr,
+  oldOnlyInout : ∀ id ∈ Imperative.HasFvars.getFvars (P := Expression) pp.2.expr,
     CoreIdent.isOldIdent id → id ∈ ListMap.keys (d.header.getInoutParams.map
       (fun (x, ty) => (CoreIdent.mkOld x.name, ty)))
 
@@ -136,16 +136,22 @@ structure WFAxiomDeclarationProp (p : Program) (f : Axiom) : Prop where
 
 structure WFDistinctDeclarationProp (p : Program) (l : Expression.Ident) (es : List (Expression.Expr)) : Prop where
 
+-- NOTE: For CFG procedures, the structured-body fields (`wfstmts`, `wfloclnd`,
+-- `bodyExitsCovered`) are vacuously satisfied. CFG-specific well-formedness
+-- (e.g., label uniqueness, reachability) is not yet captured here:
+--   * verify block labels are unique
+--   * all variables used are declared/initialized
+--   * target labels of transfer commands exist
 structure WFProcedureProp (p : Program) (d : Procedure) : Prop where
-  wfstmts : WFStatementsProp p d.body
-  wfloclnd : (HasVarsImp.definedVars (P:=Expression) d.body).Nodup
+  wfstmts : ∀ ss, d.body = .structured ss → WFStatementsProp p ss
+  wfloclnd : ∀ ss, d.body = .structured ss → (HasVarsImp.definedVars (P:=Expression) ss false).Nodup
   inputsNodup : (ListMap.keys d.header.inputs).Nodup
   outputsNodup : (ListMap.keys d.header.outputs).Nodup
   ioNotOld : ∀ id ∈ ListMap.keys d.header.inputs ++ ListMap.keys d.header.outputs,
       ∀ x, id ≠ CoreIdent.mkOld x
   wfspec : WFSpecProp p d.spec d
-  -- There is no exit statement that cannot be caught by any block in the procedure.
-  bodyExitsCovered : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks [] d.body
+  bodyExitsCovered : ∀ ss, d.body = .structured ss →
+    Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks [] ss
 structure WFFunctionProp (p : Program) (f : Function) : Prop where
 
 structure WFRecFuncBlockProp (p : Program) (fs : List Function) : Prop where
diff --git a/Strata/Languages/Laurel.lean b/Strata/Languages/Laurel.lean
index 720d817ffc..f223ac14d0 100644
--- a/Strata/Languages/Laurel.lean
+++ b/Strata/Languages/Laurel.lean
@@ -118,7 +118,7 @@ an error message if the input program contains constructs that are not yet
 supported.
 -/
 def laurelToCore (p : Laurel.Program) : IO (Except String Core.Program) := do
-  let (coreOpt, diags) ← Laurel.translate { emitResolutionErrors := true } p
+  let (coreOpt, diags) ← Laurel.translate { } p
   match coreOpt with
   | some core => return .ok core
   | none => return .error s!"Laurel to Core translation failed: {diags.map (·.message)}"
diff --git a/Strata/Languages/Laurel/ConstrainedTypeElim.lean b/Strata/Languages/Laurel/ConstrainedTypeElim.lean
index 49cca37de7..566dab3ae6 100644
--- a/Strata/Languages/Laurel/ConstrainedTypeElim.lean
+++ b/Strata/Languages/Laurel/ConstrainedTypeElim.lean
@@ -6,6 +6,7 @@
 module
 
 public import Strata.Languages.Laurel.Resolution
+public import Strata.Languages.Laurel.LaurelPass
 import Strata.Languages.Laurel.MapStmtExpr
 import Strata.Util.Tactics
 
@@ -30,8 +31,6 @@ namespace Strata.Laurel
 open Strata
 
 abbrev ConstrainedTypeMap := Std.HashMap String ConstrainedType
-/-- Map from variable name to its constrained HighType (e.g. UserDefined "nat") -/
-abbrev PredVarMap := Std.HashMap String HighType
 
 def buildConstrainedTypeMap (types : List TypeDefinition) : ConstrainedTypeMap :=
   types.foldl (init := {}) fun m td =>
@@ -51,20 +50,32 @@ def resolveType (ptMap : ConstrainedTypeMap) (ty : HighTypeMd) : HighTypeMd :=
 def isConstrainedType (ptMap : ConstrainedTypeMap) (ty : HighType) : Bool :=
   match ty with | .UserDefined name => ptMap.contains name.text | _ => false
 
-/-- Build a call to the constraint function for a constrained type, or `none` if not constrained -/
-def constraintCallFor (ptMap : ConstrainedTypeMap) (ty : HighType)
-    (varName : Identifier) (src : Option FileRange := none) : Option StmtExprMd :=
+/-- Build a call to the constraint function for a constrained type, asserting
+    the constraint on the read-back expression `ref`. Returns `none` if `ty` is
+    not a constrained type.
+
+    `ref` is the expression whose value is checked (e.g. a local read
+    `x` or a field read `c#count`), allowing this to serve every assignment
+    target kind uniformly. -/
+def constraintCallForExpr (ptMap : ConstrainedTypeMap) (ty : HighType)
+    (ref : StmtExprMd) (src : Option FileRange := none) : Option StmtExprMd :=
   match ty with
   | .UserDefined name => if ptMap.contains name.text then
-      some ⟨.StaticCall (mkId s!"{name.text}$constraint") [⟨.Var (.Local varName), src⟩], src⟩
+      some ⟨.StaticCall (mkId s!"{name.text}$constraint") [ref], src⟩
     else none
   | _ => none
 
+/-- Build a call to the constraint function for a constrained type, checking a
+    local variable read, or `none` if not constrained. -/
+def constraintCallFor (ptMap : ConstrainedTypeMap) (ty : HighType)
+    (varName : Identifier) (src : Option FileRange := none) : Option StmtExprMd :=
+  constraintCallForExpr ptMap ty ⟨.Var (.Local varName), src⟩ src
+
 /-- Generate a constraint function for a constrained type.
     For nested types, the function calls the parent's constraint function. -/
 def mkConstraintFunc (ptMap : ConstrainedTypeMap) (ct : ConstrainedType) : Procedure :=
   let baseType := resolveType ptMap ct.base
-  let bodyExpr := match ct.base.val with
+  let bodyExpr: StmtExprMd := match ct.base.val with
     | .UserDefined parent =>
       if ptMap.contains parent.text then
         let paramId := { ct.valueName with uniqueId := none }
@@ -78,15 +89,11 @@ def mkConstraintFunc (ptMap : ConstrainedTypeMap) (ct : ConstrainedType) : Proce
   { name := mkId s!"{ct.name.text}$constraint"
     inputs := [{ name := ct.valueName, type := baseType }]
     outputs := [{ name := mkId "result", type := { val := .TBool, source := none } }]
-    body := .Transparent { val := .Block [bodyExpr] none, source := none }
+    body := .Transparent { val := .Return bodyExpr, source := none }
     isFunctional := true
     decreases := none
     preconditions := [] }
 
-private def wrap (stmts : List StmtExprMd) (src : Option FileRange)
-    : StmtExprMd :=
-  match stmts with | [s] => s | ss => ⟨.Block ss none, src⟩
-
 def resolveVariable (ptMap : ConstrainedTypeMap) (v : VariableMd) : VariableMd :=
   match v.val with
   | .Declare param => ⟨.Declare { param with type := resolveType ptMap param.type }, v.source⟩
@@ -117,88 +124,60 @@ def resolveExprNode (ptMap : ConstrainedTypeMap) (expr : StmtExprMd) : StmtExprM
   | .IsType t ty => ⟨.IsType t (resolveType ptMap ty), source⟩
   | _ => expr
 
-abbrev ElimM := StateM PredVarMap
-
-private def inScope (action : ElimM α) : ElimM α := do
-  let saved ← get
-  let result ← action
-  set saved
-  return result
-
-def elimStmt (ptMap : ConstrainedTypeMap)
-    (stmt : StmtExprMd) : ElimM (List StmtExprMd) := do
-  let source := stmt.source
-
-  match _h : stmt.val with
+/-- Per-node constrained-type elimination, applied bottom-up (with flattening)
+    by `mapStmtExprFlattenM`. `resultUsed` is `true` when the node occupies a
+    value position.
+
+    - Uninitialized constrained declaration `var x: T;` → assume its constraint.
+    - Assignment to constrained target(s) → emit the assignment followed by an
+      `assert T$constraint(<read-back>)` per constrained target. The constraint
+      is checked on a *read-back* of the target rather than on the RHS, so the
+      RHS is evaluated exactly once. In value position the read-back is also
+      appended as the final statement, so the resulting value-block evaluates to
+      the assigned value (this covers expression-position assignments such as
+      `y := (x := -1) + 1`); in statement position it is omitted.
+    - All other nodes are returned unchanged; the traversal handles recursion. -/
+def elimNode (ptMap : ConstrainedTypeMap) (model : SemanticModel)
+    (resultUsed : Bool) (node : StmtExprMd) : List StmtExprMd :=
+  let source := node.source
+  match node.val with
   | .Var (.Declare param) =>
-    let callOpt := constraintCallFor ptMap param.type.val param.name (src := source)
-    if callOpt.isSome then modify fun pv => pv.insert param.name.text param.type.val
-    let check := match callOpt with
-      | some c => [⟨.Assume c, source⟩]
-      | none => []
-    pure ([stmt] ++ check)
-
+    let check := (constraintCallFor ptMap param.type.val param.name (src := source)).toList.map
+      fun c => ⟨.Assume c, source⟩
+    [node] ++ check
   | .Assign targets _value =>
-    -- Handle Declare targets for constrained type elimination
-    let declareChecks ← targets.foldlM (init := ([] : List StmtExprMd)) fun acc target =>
-      match target.val with
-      | .Declare param => do
-        let callOpt := constraintCallFor ptMap param.type.val param.name (src := source)
-        if callOpt.isSome then modify fun pv => pv.insert param.name.text param.type.val
-        pure (acc ++ callOpt.toList.map fun c => ⟨.Assert { condition := c }, source⟩)
-      | .Local name => do
-        match (← get).get? name.text with
-        | some ty =>
-          let assert := (constraintCallFor ptMap ty name (src := source)).toList.map
-            fun c => ⟨.Assert { condition := c }, source⟩
-          pure (acc ++ assert)
-        | none => pure acc
-      | _ => pure acc
-    pure ([stmt] ++ declareChecks)
-
-  | .Block stmts sep =>
-    let stmtss ← inScope (stmts.mapM (elimStmt ptMap))
-    pure [⟨.Block stmtss.flatten sep, source⟩]
-
-  | .IfThenElse cond thenBr (some elseBr) =>
-    let thenSs ← inScope (elimStmt ptMap thenBr)
-    let elseSs ← inScope (elimStmt ptMap elseBr)
-    pure [⟨.IfThenElse cond (wrap thenSs source) (some (wrap elseSs source)), source⟩]
-  | .IfThenElse cond thenBr none =>
-    let thenSs ← inScope (elimStmt ptMap thenBr)
-    pure [⟨.IfThenElse cond (wrap thenSs source) none, source⟩]
-
-  | .While cond inv dec body =>
-    let bodySs ← inScope (elimStmt ptMap body)
-    pure [⟨.While cond inv dec (wrap bodySs source), source⟩]
-
-  | _ => pure [stmt]
-termination_by sizeOf stmt
-decreasing_by
-  all_goals simp_wf
-  all_goals (try have := AstNode.sizeOf_val_lt stmt)
-  all_goals (try term_by_mem)
-  all_goals omega
-
-def elimProc (ptMap : ConstrainedTypeMap) (proc : Procedure) : Procedure :=
+    let asserts: List StmtExprMd := targets.filterMap (fun target =>
+      let ref : StmtExprMd := VariableMd.toReadbackExpr target
+      let ty : HighType := (computeExprType model ref).val
+      (constraintCallForExpr ptMap ty ref (src := source)).map (⟨.Assert { condition := · }, source⟩))
+    let suffix := match targets with
+      | [single] => if resultUsed then [VariableMd.toReadbackExpr single] else []
+      | _ => []
+    [node] ++ asserts ++ suffix
+  | _ => [node]
+
+/-- Apply `elimNode` across a body via the flattening, `resultUsed`-aware
+    traversal. A procedure body is a statement, so the top-level `resultUsed`
+    is `false`. -/
+def elimStmts (ptMap : ConstrainedTypeMap) (model : SemanticModel) (body : StmtExprMd) : StmtExprMd :=
+  mapStmtExprFlattenM (m := Id) (fun _ _ => none) (elimNode ptMap model) false body
+
+def elimProc (ptMap : ConstrainedTypeMap) (model : SemanticModel) (proc : Procedure) : Procedure :=
   let inputRequires : List Condition := proc.inputs.filterMap fun p =>
     (constraintCallFor ptMap p.type.val p.name (src := p.type.source)).map
       fun c => { condition := c }
   let outputEnsures : List Condition := if proc.isFunctional then [] else proc.outputs.filterMap fun p =>
     (constraintCallFor ptMap p.type.val p.name (src := p.type.source)).map
       fun c => { condition := ⟨c.val, p.type.source⟩ }
-  let initVars : PredVarMap := proc.inputs.foldl (init := {}) fun s p =>
-    if isConstrainedType ptMap p.type.val then s.insert p.name.text p.type.val else s
   let body' := match proc.body with
   | .Transparent bodyExpr =>
-    let (stmts, _) := (elimStmt ptMap bodyExpr).run initVars
-    let body := wrap stmts bodyExpr.source
+    let body := elimStmts ptMap model bodyExpr
     if outputEnsures.isEmpty then .Transparent body
     else
       let retBody := if proc.isFunctional then ⟨.Return (some body), bodyExpr.source⟩ else body
       .Opaque outputEnsures (some retBody) []
   | .Opaque postconds impl modif =>
-    let impl' := impl.map fun b => wrap ((elimStmt ptMap b).run initVars).1 b.source
+    let impl' := impl.map (elimStmts ptMap model)
     .Opaque (postconds ++ outputEnsures) impl' modif
   | .Abstract postconds => .Abstract (postconds ++ outputEnsures)
   | .External => .External
@@ -230,7 +209,20 @@ private def mkWitnessProc (ptMap : ConstrainedTypeMap) (ct : ConstrainedType) :
     isFunctional := false
     decreases := none }
 
-public def constrainedTypeElim (_model : SemanticModel) (program : Program)
+/-- Eliminate constrained types within a composite type definition: resolve
+    constrained field types to their base types and run constrained type
+    elimination on the composite's instance procedures.
+
+    This is necessary because `constrainedTypeElim` removes the constrained type
+    definitions from the program. Any reference to a constrained type left inside
+    a composite (e.g. a `count: nat` field) would otherwise dangle and fail to
+    resolve in later passes and the final Core translation. -/
+def elimCompositeType (ptMap : ConstrainedTypeMap) (model : SemanticModel) (ct : CompositeType) : CompositeType :=
+  { ct with
+    fields := ct.fields.map fun f => { f with type := resolveType ptMap f.type }
+    instanceProcedures := ct.instanceProcedures.map (elimProc ptMap model) }
+
+public def constrainedTypeElim (model : SemanticModel) (program : Program)
     : Program × List DiagnosticModel :=
   let ptMap := buildConstrainedTypeMap program.types
   if ptMap.isEmpty then (program, []) else
@@ -243,9 +235,21 @@ public def constrainedTypeElim (_model : SemanticModel) (program : Program)
       acc.cons (diagnosticFromSource proc.name.source "constrained return types on functions are not yet supported")
     else acc
   ({ program with
-    staticProcedures := constraintFuncs ++ program.staticProcedures.map (elimProc ptMap)
+    staticProcedures := constraintFuncs ++ program.staticProcedures.map (elimProc ptMap model)
                         ++ witnessProcedures
-    types := program.types.filter fun | .Constrained _ => false | _ => true },
+    types := program.types.filterMap fun
+      | .Constrained _ => none
+      | .Composite ct => some (.Composite (elimCompositeType ptMap model ct))
+      | other => some other },
    funcDiags)
 
+/-- Pipeline pass: constrained type elimination. -/
+public def constrainedTypeElimPass : LoweringPass where
+  name := "ConstrainedTypeElim"
+  documentation := "Eliminates constrained types by replacing them with their base types and generating constraint-checking functions and witness procedures. Type tests against constrained types are rewritten to call the generated constraint function."
+  needsResolves := true
+  run := fun p m _ =>
+    let (p', diags) := constrainedTypeElim m p
+    (p', diags, {})
+
 end Strata.Laurel
diff --git a/Strata/Languages/Laurel/ContractPass.lean b/Strata/Languages/Laurel/ContractPass.lean
new file mode 100644
index 0000000000..cc93ba02f9
--- /dev/null
+++ b/Strata/Languages/Laurel/ContractPass.lean
@@ -0,0 +1,461 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Languages.Laurel.MapStmtExpr
+public import Strata.Languages.Laurel.LaurelPass
+import Strata.Languages.Laurel.EliminateReturnStatements
+import Strata.Util.Tactics
+
+/-!
+## Contract Pass (Laurel → Laurel)
+
+Removes pre- and postconditions from all procedures and replaces them with
+explicit precondition/postcondition helper procedures, assumptions, and
+assertions.
+
+For each procedure with contracts:
+- Generate a separate precondition procedure (`foo$pre0`, `foo$pre1`, ...) for each precondition.
+- Generate a separate postcondition procedure (`foo$post0`, `foo$post1`, ...) for each postcondition.
+  Each takes all inputs and all outputs as parameters and returns the condition.
+- Insert `assume foo$pre0(inputs); assume foo$pre1(inputs); ...` at the start of the body.
+- Insert `assert foo$post0(inputs, outputs); assert foo$post1(inputs, outputs); ...` at the end of the body.
+
+For each call to a contracted procedure:
+- Assign all input arguments to temporary variables before the call.
+- Insert `assert foo$pre0(temps); assert foo$pre1(temps); ...` before the call.
+- After the call, insert `assume foo$post0(temps, outputs); assume foo$post1(temps, outputs); ...`.
+-/
+
+namespace Strata.Laurel
+
+public section
+
+private def mkMd (e : StmtExpr) : StmtExprMd := { val := e, source := none }
+private def mkVarMd (v : Variable) : VariableMd := { val := v, source := none }
+
+/-- Name for the i-th precondition helper procedure. -/
+def preCondProcName (procName : String) (i : Nat) : String := s!"{procName}$pre{i}"
+
+/-- Name for the i-th postcondition helper procedure. -/
+def postCondProcName (procName : String) (i : Nat) : String := s!"{procName}$post{i}"
+
+/-- Get postconditions from a procedure body. -/
+private def getPostconditions (body : Body) : List Condition :=
+  match body with
+  | .Opaque postconds _ _ => postconds
+  | .Abstract postconds => postconds
+  | _ => []
+
+/-- Build a call expression. -/
+private def mkCall (callee : String) (args : List StmtExprMd) : StmtExprMd :=
+  mkMd (.StaticCall (mkId callee) args)
+
+/-- Convert parameters to identifier expressions. -/
+private def paramsToArgs (params : List Parameter) : List StmtExprMd :=
+  params.map fun p => mkMd (.Var (.Local p.name))
+
+/-- Build a helper function for a single condition over the given parameters.
+    Preconditions pass `proc.inputs`; postconditions use `mkPostConditionProc`. -/
+private def mkConditionProc (name : String) (params : List Parameter)
+    (condition : Condition) : Procedure :=
+  { name := mkId name
+    inputs := params
+    outputs := [⟨mkId "$result", { val := .TBool, source := none }⟩]
+    preconditions := []
+    decreases := none
+    isFunctional := true
+    body := .Transparent condition.condition }
+
+/-- Suffix appended to a procedure's output-parameter names when they are lowered
+    into a postcondition helper *function*.
+
+    A postcondition helper takes both the procedure's inputs and outputs as plain
+    function parameters. When an output shares a name with an input (e.g. an inout
+    `$heap`, which the heap-parameterization pass lists in both `inputs` and
+    `outputs`), the two would collide in the helper's single parameter scope and
+    produce "Duplicate definition '…' is already defined in this scope". Suffixing
+    every output keeps the two distinct. The choice is heap-agnostic: it applies to
+    all outputs, not just `$heap`. -/
+public def outParamSuffix : String := "$out"
+
+/-- Rewrite a postcondition body so it refers to the renamed output parameters.
+
+    In a postcondition, a bare reference to an output parameter denotes its
+    post-state value, while `old(x)` denotes the pre-state value of an inout
+    parameter (the corresponding *input*). The helper is a pure function with two
+    distinct parameters, so:
+    - bare `Var (Local n)` where `n` is an output → suffixed name (`n ++ outParamSuffix`)
+    - `old(Var (Local n))` → `Var (Local n)`, i.e. strip `old` and keep the
+      un-suffixed name so it resolves to the input parameter (functions have no
+      two-state semantics, so an unstripped `old` would later be rejected).
+
+    `pushOldInward` guarantees every `old` immediately wraps a local variable. -/
+private def renameOutputsInPostExpr (outputNames : List String) (expr : StmtExprMd) : StmtExprMd :=
+  let suffixIfOutput (n : Identifier) : Identifier :=
+    if outputNames.contains n.text then mkId (n.text ++ outParamSuffix) else n
+  mapStmtExprPrePostM (m := Id)
+    (fun e =>
+      match e.val with
+      | .Old value =>
+        match value.val with
+        | .Var (.Local _) => some value
+        | _ => none
+      | _ => none)
+    (fun e =>
+      match e.val with
+      | .Var (.Local n) => ⟨.Var (.Local (suffixIfOutput n)), e.source⟩
+      | _ => e)
+    expr
+
+/-- Build a postcondition helper function over the procedure's inputs and outputs.
+    Output parameters are renamed (see `outParamSuffix`) to avoid colliding with
+    identically-named inputs, and the condition body is rewritten to match. -/
+private def mkPostConditionProc (name : String) (inputs outputs : List Parameter)
+    (condition : Condition) : Procedure :=
+  let outputNames := outputs.map (·.name.text)
+  let renamedOutputs := outputs.map (fun p => { p with name := mkId (p.name.text ++ outParamSuffix) })
+  { name := mkId name
+    inputs := inputs ++ renamedOutputs
+    outputs := [⟨mkId "$result", { val := .TBool, source := none }⟩]
+    preconditions := []
+    decreases := none
+    isFunctional := true
+    body := .Transparent (renameOutputsInPostExpr outputNames condition.condition) }
+
+/-- Information about a procedure's contracts. -/
+private structure ContractInfo where
+  preNames : List (String × Option String)  -- (procName, summary) for each precondition
+  postNames : List (String × Option String) -- (procName, summary) for each postcondition
+  inputParams : List Parameter
+  outputParams : List Parameter
+
+private def ContractInfo.hasPreCondition (info : ContractInfo) : Bool := !info.preNames.isEmpty
+private def ContractInfo.hasPostCondition (info : ContractInfo) : Bool := !info.postNames.isEmpty
+
+/-- Collect contract info for all procedures with contracts. -/
+private def collectContractInfo (procs : List Procedure) : Std.HashMap String ContractInfo :=
+  procs.foldl (fun m proc =>
+    let postconds := getPostconditions proc.body
+    let hasPre := !proc.preconditions.isEmpty
+    let hasPost := !postconds.isEmpty
+    if !proc.isFunctional && (hasPre || hasPost) then
+      let preNames := proc.preconditions.zipIdx.map fun (c, i) =>
+        (preCondProcName proc.name.text i, c.summary)
+      let postNames := postconds.zipIdx.map fun (c, i) =>
+        (postCondProcName proc.name.text i, c.summary)
+      m.insert proc.name.text {
+        preNames := preNames
+        postNames := postNames
+        inputParams := proc.inputs
+        outputParams := proc.outputs
+      }
+    else m) {}
+
+/-- Transform a procedure body to add assume/assert for its own contracts. -/
+private def transformProcBody (proc : Procedure) (info : ContractInfo) : Body :=
+  let inputArgs := paramsToArgs proc.inputs
+  let postconds := getPostconditions proc.body
+  let preAssumes : List StmtExprMd :=
+    proc.preconditions.zip info.preNames |>.map fun (pc, name, _) =>
+      ⟨.Assume (mkCall name inputArgs), pc.condition.source⟩
+  match proc.body with
+  | .Transparent body =>
+    let postAsserts : List StmtExprMd :=
+      postconds.zip info.postNames |>.map fun (pc, _name, _summary) =>
+        let summary := pc.summary.getD "postcondition"
+        ⟨.Assert { condition := pc.condition, summary := some summary }, pc.condition.source⟩
+    .Transparent ⟨.Block (preAssumes ++ [body] ++ postAsserts) none, body.source⟩
+  | .Opaque _ (some impl) _ =>
+    .Opaque postconds (some ⟨.Block (preAssumes ++ [impl]) none, impl.source⟩) []
+  | .Opaque _ none mods =>
+    .Opaque postconds none mods
+  | .Abstract _ =>
+    .Abstract postconds
+  | b => b
+
+/-- Monad used by the contract-pass rewriter; carries a global counter for
+    generating fresh temporary variable names. -/
+private abbrev ContractM := StateM Nat
+
+/-- Allocate a fresh temporary name with the `$cp_` prefix.  The global counter
+    guarantees uniqueness across the entire pass. -/
+private def freshTemp : ContractM String := do
+  let n ← get
+  set (n + 1)
+  return s!"$cp_{n}"
+
+/-- Generate temporary variable assignments for input arguments at a call site.
+    Returns (temp declarations+assignments, temp variable references). -/
+private def mkTempAssignments (args : List StmtExprMd)
+    (inputParams : List Parameter) (src : Option FileRange)
+    : ContractM (List StmtExprMd × List StmtExprMd) := do
+  let mut decls : List StmtExprMd := []
+  let mut refs : List StmtExprMd := []
+  for arg in args, i in List.range args.length do
+    let tempName ← freshTemp
+    let paramType := match inputParams[i]? with
+      | some p => p.type
+      | none => { val := .Unknown, source := none }
+    let param : Parameter := { name := mkId tempName, type := paramType }
+    decls := decls ++ [⟨StmtExpr.Assign [mkVarMd (.Declare param)] arg, src⟩]
+    refs := refs ++ [mkMd (.Var (.Local (mkId tempName)))]
+  return (decls, refs)
+
+/-- Generate precondition checks (one per precondition) for a call site. -/
+private def mkPreChecks (info : ContractInfo) (isFunctional : Bool)
+    (tempRefs : List StmtExprMd) (src : Option FileRange) : List StmtExprMd :=
+  if !info.hasPreCondition then []
+  else info.preNames.map fun (name, summary) =>
+    let call := mkCall name tempRefs
+    if isFunctional then
+      ⟨.Assume call, src⟩
+    else
+      ⟨.Assert { condition := call, summary := some (summary.getD "precondition") }, src⟩
+
+/-- Generate postcondition assumes (one per postcondition) for a call site. -/
+private def mkPostAssumes (info : ContractInfo)
+    (tempRefs : List StmtExprMd) (outputArgs : List StmtExprMd) (src : Option FileRange) : List StmtExprMd :=
+  if !info.hasPostCondition then []
+  else info.postNames.map fun (name, _) =>
+    ⟨.Assume (mkCall name (tempRefs ++ outputArgs)), src⟩
+
+/-- Names of the callee's inout parameters: those appearing in both the input and
+    output lists. By the Laurel inout convention an inout is declared by giving the
+    input and output the same name, so at a call site the inout argument is the same
+    variable as the corresponding output target — and the Core lowering relies on
+    that identity. -/
+private def ContractInfo.inoutNames (info : ContractInfo) : List String :=
+  info.inputParams.filterMap fun p =>
+    if info.outputParams.any (·.name.text == p.name.text) then some p.name.text else none
+
+/-- Build the positional argument list for the rewritten call.
+
+    Ordinary inputs are passed via their snapshot temp (so pre/postconditions can
+    reference the pre-call value). Inout inputs, however, are passed as the
+    *original* argument variable rather than the temp: the call mutates that
+    variable in place, so it must coincide with the corresponding output target
+    (the Laurel inout invariant). The temp is still created and used by
+    `mkPostAssumes` to supply the inout's pre-state to `$post*`. -/
+private def mkCallArgs (info : ContractInfo) (origArgs tempRefs : List StmtExprMd) : List StmtExprMd :=
+  let inout := info.inoutNames
+  tempRefs.zipIdx.map fun (tempRef, i) =>
+    match info.inputParams[i]? with
+    | some p => if inout.contains p.name.text then origArgs[i]?.getD tempRef else tempRef
+    | none => tempRef
+
+/-- Rewrite call sites in a statement/expression tree. -/
+private def rewriteCallSites (contractInfoMap : Std.HashMap String ContractInfo)
+    (isFunctional : Bool) (expr : StmtExprMd) : ContractM StmtExprMd := do
+  let rewriteStaticCall (callee : Identifier) (args : List StmtExprMd)
+      (info : ContractInfo) (src : Option FileRange)
+      : ContractM (List StmtExprMd) := do
+    let (tempDecls, tempRefs) ← mkTempAssignments args info.inputParams src
+    let preCheck := mkPreChecks info isFunctional tempRefs src
+    let (callStmt, postAssume, returnValue) ←
+      if info.hasPostCondition && !info.outputParams.isEmpty then do
+        let mut outputTempDecls : List VariableMd := []
+        let mut outputRefs : List StmtExprMd := []
+        for p in info.outputParams do
+          let tempName ← freshTemp
+          outputTempDecls := outputTempDecls ++ [mkVarMd (.Declare { name := mkId tempName, type := p.type })]
+          outputRefs := outputRefs ++ [mkMd (.Var (.Local (mkId tempName)))]
+        let callWithOutputs : StmtExprMd :=
+          ⟨.Assign outputTempDecls ⟨.StaticCall callee tempRefs, src⟩, src⟩
+        let assume := mkPostAssumes info tempRefs outputRefs src
+        let retVal : List StmtExprMd := match outputRefs with
+          | [single] => [single]
+          | _ => []
+        pure (callWithOutputs, assume, retVal)
+      else
+        pure (⟨.StaticCall callee tempRefs, src⟩, [], [])
+    return tempDecls ++ preCheck ++ [callStmt] ++ postAssume ++ returnValue
+  let result ←
+    mapStmtExprFlattenM (m := ContractM)
+      -- Pre: intercept Assign targets (StaticCall ...) before recursion
+      (fun _ e => do
+        match e.val with
+        | .Assign targets (.mk (.StaticCall callee args) callSrc) =>
+          match contractInfoMap.get? callee.text with
+          | some info =>
+            let src := e.source
+            -- Recurse into arguments
+            let args' ← args.mapM (mapStmtExprM (m := ContractM) (fun e' => do
+              match e'.val with
+              | .StaticCall callee' args' =>
+                match contractInfoMap.get? callee'.text with
+                | some info' =>
+                  let stmts ← rewriteStaticCall callee' args' info' e'.source
+                  return ⟨.Block stmts none, e'.source⟩
+                | none => return e'
+              | _ => return e'))
+            let (tempDecls, tempRefs) ← mkTempAssignments args' info.inputParams src
+            let callArgs := mkCallArgs info args' tempRefs
+            let callWithTemps : StmtExprMd := ⟨.Assign targets ⟨.StaticCall callee callArgs, callSrc⟩, src⟩
+            let preCheck := mkPreChecks info isFunctional tempRefs src
+            let outputArgs := targets.filterMap fun t =>
+              match t.val with
+              | .Local name => some (mkMd (.Var (.Local name)))
+              | .Declare param => some (mkMd (.Var (.Local param.name)))
+              | _ => none
+            let postAssume := mkPostAssumes info tempRefs outputArgs src
+            return some (tempDecls ++ preCheck ++ [callWithTemps] ++ postAssume)
+          | none => return none
+        | _ => return none)
+      -- Post: handle bare StaticCall
+      (fun _ e => do
+        match e.val with
+        | .StaticCall callee args =>
+          match contractInfoMap.get? callee.text with
+          | some info =>
+            let stmts ← rewriteStaticCall callee args info e.source
+            return stmts
+          | none => return [e]
+        | _ => return [e]) true expr
+  return result
+
+/-- Rewrite call sites in all bodies of a procedure. -/
+private def rewriteCallSitesInProc (contractInfoMap : Std.HashMap String ContractInfo)
+    (proc : Procedure) : ContractM Procedure := do
+  let rw := rewriteCallSites contractInfoMap proc.isFunctional
+  match proc.body with
+  | .Transparent body =>
+    let body' ← rw body
+    return { proc with body := .Transparent body' }
+  | .Opaque posts impl mods =>
+    let posts' ← posts.mapM (·.mapM rw)
+    let impl' ← impl.mapM rw
+    let mods' ← mods.mapM rw
+    return { proc with body := Body.Opaque posts' impl' mods' }
+  | _ => return proc
+
+/-- Conjoin a list of conditions into a single expression with `&&`. -/
+private def conjoin (conds : List Condition) : Option StmtExprMd :=
+  match conds.map (·.condition) with
+  | [] => none
+  | e :: rest => some (rest.foldl (fun acc x => mkMd (.PrimitiveOp .And [acc, x])) e)
+
+/-- Build an axiom expression from `invokeOn` trigger and ensures clauses.
+    Produces `∀ p1, ∀ p2, ..., ∀ pn :: { trigger } (preconds => ensures)`.
+    The trigger controls when the SMT solver instantiates the axiom. -/
+private def mkInvokeOnAxiom (params : List Parameter) (trigger : StmtExprMd)
+    (preconds : List Condition) (postconds : List Condition) : StmtExprMd :=
+  let ensures := (conjoin postconds).getD (mkMd (.LiteralBool true))
+  let body := match conjoin preconds with
+    | some pre => mkMd (.PrimitiveOp .Implies [pre, ensures])
+    | none => ensures
+  -- Wrap in nested Forall from last param (innermost) to first (outermost).
+  -- The trigger is placed on the innermost quantifier.
+  params.foldr (init := (body, true)) (fun p (acc, isInnermost) =>
+    let trig := if isInnermost then some trigger else none
+    (mkMd (.Quantifier .Forall p trig acc), false)) |>.1
+
+/-- Check whether a `StmtExprMd` tree mentions a local variable by name. -/
+private def exprMentions (name : String) (expr : StmtExprMd) : Bool :=
+  match expr with
+  | AstNode.mk val _ =>
+  match val with
+  | .Var (.Local id) => id.text == name
+  | .StaticCall _ args => args.attach.any (fun x => exprMentions name x.val)
+  | .PrimitiveOp _ args _ => args.attach.any (fun x => exprMentions name x.val)
+  | .IfThenElse c t e => exprMentions name c || exprMentions name t ||
+      match e with | some el => exprMentions name el | none => false
+  | .Block stmts _ => stmts.attach.any (fun x => exprMentions name x.val)
+  | .Quantifier _ _ trigger body => exprMentions name body ||
+      match trigger with | some t => exprMentions name t | none => false
+  | .ReferenceEquals l r => exprMentions name l || exprMentions name r
+  | .Assign _ v => exprMentions name v
+  | .Old v => exprMentions name v
+  | .Fresh v => exprMentions name v
+  | .Assume c => exprMentions name c
+  | .Assert c => exprMentions name c.condition
+  | .Return (some v) => exprMentions name v
+  | .InstanceCall t _ args => exprMentions name t || args.attach.any (fun x => exprMentions name x.val)
+  | .AsType t _ => exprMentions name t
+  | .IsType t _ => exprMentions name t
+  | .PureFieldUpdate t _ v => exprMentions name t || exprMentions name v
+  | .ProveBy v p => exprMentions name v || exprMentions name p
+  | .ContractOf _ f => exprMentions name f
+  | .Assigned n => exprMentions name n
+  | _ => false
+  termination_by expr
+  decreasing_by
+    all_goals (try cases x)
+    all_goals (try simp_all)
+    all_goals (try have := Condition.sizeOf_condition_lt ‹_›)
+    all_goals (try term_by_mem)
+    all_goals omega
+
+/-- Emit a diagnostic if an `invokeOn` procedure has postconditions referencing
+    output parameters (which are not quantified in the axiom). -/
+private def invokeOnOutputRefError (proc : Procedure) : Option DiagnosticModel :=
+  if proc.invokeOn.isNone then none else
+    let postconds := getPostconditions proc.body
+    let referenced := proc.outputs.filterMap (fun out =>
+      if postconds.any (fun c => exprMentions out.name.text c.condition)
+      then some out.name.text else none)
+    match referenced with
+    | [] => none
+    | names => some (diagnosticFromSource proc.name.source
+        s!"'invokeOn' procedure '{proc.name.text}' has an ensures referencing its output(s) ({String.intercalate ", " names}); the auto-invocation axiom is quantified over inputs only."
+        DiagnosticType.UserError)
+
+/-- Run the contract pass on a Laurel program.
+    All procedures with contracts are transformed. -/
+def lowerContracts (program : Program) : Program × List DiagnosticModel :=
+  let contractInfoMap := collectContractInfo program.staticProcedures
+
+  -- Check for output-referencing ensures in invokeOn procedures
+  let diagnostics := program.staticProcedures.filterMap invokeOnOutputRefError
+
+  -- Generate helper procedures for all procedures with contracts
+  let helperProcs := (program.staticProcedures.filter (fun proc => !proc.isFunctional)).flatMap fun proc =>
+    let postconds := getPostconditions proc.body
+    let preProcs := proc.preconditions.zipIdx.map fun (c, i) =>
+      mkConditionProc (preCondProcName proc.name.text i) proc.inputs c
+    let postProcs := postconds.zipIdx.map fun (c, i) =>
+      mkPostConditionProc (postCondProcName proc.name.text i) proc.inputs proc.outputs c
+    preProcs ++ postProcs
+
+  -- Transform procedures: strip contracts, add assume/assert, rewrite call sites
+  -- Run all call-site rewriting in a single ContractM to share the global counter.
+  let (transformedProcs, _) := (program.staticProcedures.mapM fun (proc : Procedure) => do
+    if proc.isFunctional then
+      return proc
+    else
+      let proc : Procedure := match proc.invokeOn with
+        | some trigger =>
+          let postconds := getPostconditions proc.body
+          if postconds.isEmpty then { proc with invokeOn := none }
+          else if invokeOnOutputRefError proc |>.isSome then
+            -- Skip axiom generation; diagnostic already emitted
+            { proc with invokeOn := none }
+          else { proc with
+            axioms := [mkInvokeOnAxiom proc.inputs trigger proc.preconditions postconds]
+            invokeOn := none }
+        | none => proc
+      let proc : Procedure := match contractInfoMap.get? proc.name.text with
+        | some info =>
+          { proc with
+            preconditions := []
+            body := transformProcBody proc info }
+        | none => proc
+      -- Rewrite call sites in the procedure body
+      rewriteCallSitesInProc contractInfoMap proc).run 0
+
+  ({ program with staticProcedures := helperProcs ++ transformedProcs }, diagnostics)
+
+public def contractPass : LoweringPass where
+  name := "ContractPass"
+  documentation := "Lowers pre and postcondition to assertions and assumptions around call-sites and procedure bodies"
+  comesAfter := [⟨ eliminateReturnStatementsPass.meta, "The contract pass wraps the body of procedures to get: `assume preconditions; body; assert postconditions`. Eliminating returns first means that the postcondition assertions are guaranteed to execute."⟩ ]
+  needsResolves := true
+  run := fun p _m _ =>
+    let (p', diags) := lowerContracts p
+    (p', diags, {})
+
+end -- public section
+end Strata.Laurel
diff --git a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean
index 15bb1fecf9..dfe3e09782 100644
--- a/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean
+++ b/Strata/Languages/Laurel/CoreDefinitionsForLaurel.lean
@@ -6,7 +6,7 @@
 module
 
 public import StrataDDM.AST
-import StrataDDM.Integration.Lean.HashCommands -- shake: keep
+public import StrataDDM.Integration.Lean.HashCommands -- shake: keep
 public import Strata.Languages.Laurel.LaurelAST
 import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
 import Strata.Languages.Laurel.Grammar.LaurelGrammar
@@ -27,16 +27,21 @@ program Laurel;
 
 datatype LaurelResolutionErrorPlaceholder {}
 datatype Float64IsNotSupportedYet {}
+datatype LaurelUnit { MkLaurelUnit() }
 
 // The types for these Map functions are incorrect.
 // We'll fix them when Laurel supports polymorphism
-function select(map: int, key: int) : int
+// And then we can remove the datatype Box as well
+// And remove the hacky filter in HeapParameterization
+datatype Box { MkBox() }
+
+function select(map: int, key: int) : Box
   external;
 
-function update(map: int, key: int, value: int) : int
+function update(map: int, key: int, value: int) : Box
   external;
 
-function const(value: int) : int
+function const(value: int) : Box
   external;
 
 #end
diff --git a/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean b/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean
index 8a84b0c545..57007a95a5 100644
--- a/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean
+++ b/Strata/Languages/Laurel/CoreGroupingAndOrdering.lean
@@ -5,7 +5,9 @@
 -/
 
 module
-public import Strata.Languages.Laurel.TransparencyPass
+public import Strata.Languages.Laurel.LaurelAST
+public import Strata.Languages.Laurel.UnorderedCore
+public import Strata.Languages.Laurel.LaurelPass
 import Strata.DL.Lambda.LExpr
 import StrataDDM.Util.Graph.Tarjan
 import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
@@ -27,13 +29,13 @@ declarations before they are emitted as Strata Core declarations.
 namespace Strata.Laurel
 
 open Lambda (LMonoTy LExpr)
+open Std (Format ToFormat)
 
 /-- Collect all `UserDefined` type names referenced in a `HighType`, including nested ones. -/
 def collectTypeRefs : HighTypeMd → List String
   | ⟨.UserDefined name, _⟩ => [name.text]
   | ⟨.TSet elem, _⟩ => collectTypeRefs elem
   | ⟨.TMap k v, _⟩ => collectTypeRefs k ++ collectTypeRefs v
-  | ⟨.TTypedField vt, _⟩ => collectTypeRefs vt
   | ⟨.Applied base args, _⟩ =>
       collectTypeRefs base ++ args.flatMap collectTypeRefs
   | ⟨.Pure base, _⟩ => collectTypeRefs base
@@ -55,7 +57,7 @@ def collectStaticCallNames (expr : StmtExprMd) : List String :=
   match val with
   | .StaticCall callee args =>
       callee.text :: args.flatMap (fun a => collectStaticCallNames a)
-  | .PrimitiveOp _ args => args.flatMap (fun a => collectStaticCallNames a)
+  | .PrimitiveOp _ args _ => args.flatMap (fun a => collectStaticCallNames a)
   | .IfThenElse cond t e =>
       collectStaticCallNames cond ++
       collectStaticCallNames t ++
@@ -74,7 +76,7 @@ def collectStaticCallNames (expr : StmtExprMd) : List String :=
       match v with
       | some x => collectStaticCallNames x
       | none => []
-  | .While cond invs dec body =>
+  | .While cond invs dec body _ =>
       collectStaticCallNames cond ++
       invs.flatMap (fun i => collectStaticCallNames i) ++
       (match dec with
@@ -114,18 +116,18 @@ Build the procedure call graph, run Tarjan's SCC algorithm, and return each SCC
 as a list of procedures paired with a flag indicating whether the SCC is recursive.
 Results are in reverse topological order: dependencies before dependents.
 
-Procedures with `invokeOn` are placed as early as possible — before
+Procedures with axioms are placed as early as possible — before
 unrelated procedures without them — by stably partitioning them first before building
 the graph. Tarjan then naturally assigns them lower indices, causing them to appear
 earlier in the output.
 -/
 public def computeSccDecls (program : UnorderedCoreWithLaurelTypes) : List (List Procedure × Bool) :=
-  -- Stable partition: procedures with invokeOn come first, preserving relative
+  -- Stable partition: procedures with axioms come first, preserving relative
   -- order within each group. Tarjan then places them earlier in the topological output.
   let allProcs := program.functions ++ program.coreProcedures
-  let (withInvokeOn, withoutInvokeOn) :=
-    allProcs.partition (fun p => p.invokeOn.isSome)
-  let orderedProcs : List Procedure := withInvokeOn ++ withoutInvokeOn
+  let (withAxioms, withoutAxioms) :=
+    allProcs.partition (fun p => !p.axioms.isEmpty)
+  let orderedProcs : List Procedure := withAxioms ++ withoutAxioms
 
   -- Build a call-graph over all procedures.
   -- An edge proc → callee means proc's body/contracts contain a StaticCall to callee.
@@ -143,7 +145,8 @@ public def computeSccDecls (program : UnorderedCoreWithLaurelTypes) : List (List
       | _ => []
     let contractExprs : List StmtExprMd :=
       proc.preconditions.map (·.condition) ++
-      proc.invokeOn.toList
+      proc.invokeOn.toList ++
+      proc.axioms
     (bodyExprs ++ contractExprs).flatMap collectStaticCallNames
 
   -- Build the OutGraph for Tarjan.
@@ -226,7 +229,7 @@ Functions are grouped into SCCs (for mutual recursion). Proofs are emitted
 as individual `procedure` decls. Both participate in the topological ordering
 so that axioms are available to functions that need them.
 -/
-public def orderFunctionsAndProcedures (program : UnorderedCoreWithLaurelTypes) : CoreWithLaurelTypes :=
+def orderFunctionsAndProcedures (program : UnorderedCoreWithLaurelTypes) : CoreWithLaurelTypes :=
   let datatypeDecls := (groupDatatypesByScc' program).map OrderedDecl.datatypes
   let constantDecls := program.constants.map OrderedDecl.constant
   let funcNames : Std.HashSet String :=
@@ -255,4 +258,16 @@ where
       let members := comp.toList.filterMap fun idx => dtsArr[idx]?
       if members.isEmpty then none else some members
 
+public def orderingPass : LaurelPass UnorderedCoreWithLaurelTypes CoreWithLaurelTypes where
+  name := "OrderingPass"
+  comesBefore := []
+  documentation := "Produce a `CoreWithLaurelTypes` from a `UnorderedCoreWithLaurelTypes` by
+computing a combined ordering of functions and proofs using the call graph,
+then collecting datatypes and constants.
+Functions are grouped into SCCs (for mutual recursion). Proofs are emitted
+as individual `procedure` decls. Both participate in the topological ordering
+so that axioms are available to functions that need them."
+  run := fun p _ _ =>
+    (orderFunctionsAndProcedures p, [], {})
+
 end Strata.Laurel
diff --git a/Strata/Languages/Laurel/DesugarShortCircuit.lean b/Strata/Languages/Laurel/DesugarShortCircuit.lean
index aa870c57e9..b8d65c1e40 100644
--- a/Strata/Languages/Laurel/DesugarShortCircuit.lean
+++ b/Strata/Languages/Laurel/DesugarShortCircuit.lean
@@ -6,6 +6,7 @@
 module
 
 public import Strata.Languages.Laurel.Resolution
+public import Strata.Languages.Laurel.LaurelPass
 import Strata.Languages.Laurel.LiftImperativeExpressions
 import Strata.Languages.Laurel.MapStmtExpr
 
@@ -24,11 +25,11 @@ namespace Strata.Laurel
 
 public section
 
-private def bare (v : StmtExpr) : StmtExprMd := ⟨v, none⟩
 
 /-- Local rewrite of a single short-circuit node. Recursion is handled by `mapStmtExpr`. -/
-private def desugarShortCircuitNode (model : SemanticModel) (expr : StmtExprMd) : StmtExprMd :=
+private def desugarShortCircuitNode (imperativeCallees : List String) (expr : StmtExprMd) : StmtExprMd :=
   let source := expr.source
+  let wrap (v : StmtExpr) : StmtExprMd := ⟨v, source⟩
   match expr.val with
   | .PrimitiveOp op args _ =>
     match op, args with
@@ -36,20 +37,31 @@ private def desugarShortCircuitNode (model : SemanticModel) (expr : StmtExprMd)
     -- short-circuits converted to IfThenElse). The check still works because
     -- `containsAssignmentOrImperativeCall` recurses into IfThenElse.
     | .AndThen, [a, b] | .Implies, [a, b] =>
-      if containsAssignmentOrImperativeCall model b then
+      if containsAssignmentOrImperativeCall imperativeCallees b then
         let elseVal := match op with | .AndThen => false | _ => true
-        ⟨.IfThenElse a b (some (bare (.LiteralBool elseVal))), source⟩
+        ⟨.IfThenElse a b (some (wrap (.LiteralBool elseVal))), source⟩
       else expr
     | .OrElse, [a, b] =>
-      if containsAssignmentOrImperativeCall model b then
-        ⟨.IfThenElse a (bare (.LiteralBool true)) (some b), source⟩
+      if containsAssignmentOrImperativeCall imperativeCallees b then
+        ⟨.IfThenElse a (wrap (.LiteralBool true)) (some b), source⟩
       else expr
     | _, _ => expr
   | _ => expr
 
 /-- Desugar short-circuit operators in a program. -/
-def desugarShortCircuit (model : SemanticModel) (program : Program) : Program :=
-  mapProgram (mapStmtExpr (desugarShortCircuitNode model)) program
+def desugarShortCircuit (program : Program) : Program :=
+  let imperativeCallees := (program.staticProcedures.filter (!·.isFunctional)).map (·.name.text)
+  mapProgram (mapStmtExpr (desugarShortCircuitNode imperativeCallees)) program
 
 end -- public section
+
+/-- Pipeline pass: desugar short-circuit operators. -/
+public def desugarShortCircuitPass : LoweringPass where
+  name := "DesugarShortCircuit"
+  documentation := "Rewrites short-circuit boolean operators (`&&` and `||`) into equivalent conditional expressions. This simplifies subsequent passes and the final translation to Core, which does not have short-circuit semantics built in."
+  run := fun p _ _ =>
+    (desugarShortCircuit p, [], {})
+  comesBefore := [
+      ⟨ liftImperativeExpressionsPass.meta, "The desugar short circuit pass introduces if-then-else expressions whose control-flow must be taken into account by the lifting pass."⟩]
+
 end Strata.Laurel
diff --git a/Strata/Languages/Laurel/EliminateHoles.lean b/Strata/Languages/Laurel/EliminateDeterministicHoles.lean
similarity index 74%
rename from Strata/Languages/Laurel/EliminateHoles.lean
rename to Strata/Languages/Laurel/EliminateDeterministicHoles.lean
index 2d06622e47..d7286e86c7 100644
--- a/Strata/Languages/Laurel/EliminateHoles.lean
+++ b/Strata/Languages/Laurel/EliminateDeterministicHoles.lean
@@ -6,6 +6,7 @@
 module
 
 public import Strata.Util.Statistics
+public import Strata.Languages.Laurel.LaurelPass
 public import Strata.Languages.Laurel.LaurelAST
 import Strata.Languages.Laurel.MapStmtExpr
 
@@ -26,8 +27,6 @@ namespace Laurel
 
 public section
 
-private def bare (v : StmtExpr) : StmtExprMd := { val := v, source := none }
-
 structure ElimHoleState where
   counter : Nat := 0
   currentInputs : List Parameter := []
@@ -36,7 +35,7 @@ structure ElimHoleState where
 private abbrev ElimHoleM := StateM ElimHoleState
 
 /-- Generate a fresh uninterpreted function for a typed hole and return a call to it. -/
-private def mkHoleCall (holeType : HighTypeMd) : ElimHoleM StmtExprMd := do
+private def mkHoleCall (source : Option FileRange) (holeType : HighTypeMd) : ElimHoleM StmtExprMd := do
   let s ← get
   let n := s.counter
   modify fun s => { s with counter := n + 1 }
@@ -52,14 +51,14 @@ private def mkHoleCall (holeType : HighTypeMd) : ElimHoleM StmtExprMd := do
     body := .Opaque [] none []
   }
   modify fun s => { s with generatedFunctions := s.generatedFunctions ++ [holeProc] }
-  return bare (.StaticCall holeName (inputs.map (fun p => bare (.Var (.Local p.name)))))
+  return ⟨ .StaticCall holeName (inputs.map (fun p => ⟨ .Var (.Local p.name), source⟩)), source⟩
 
 /-- Replace a deterministic `.Hole` with a call to a fresh uninterpreted function.
     Non-hole nodes pass through unchanged; recursion is handled by `mapStmtExprM`. -/
 private def elimHoleNode (expr : StmtExprMd) : ElimHoleM StmtExprMd := do
   match expr.val with
-  | .Hole true (some ty) => mkHoleCall ty
-  | .Hole true none => mkHoleCall { val := .Unknown, source := expr.source }
+  | .Hole true (some ty) => mkHoleCall expr.source ty
+  | .Hole true none => mkHoleCall expr.source  { val := .Unknown, source := expr.source }
   | .Hole false _ => return expr -- Non-deterministic holes are preserved
   | _ => return expr
 
@@ -81,7 +80,7 @@ After this pass the program contains only non-deterministic `Hole` nodes.
 
 Assumes `inferHoleTypes` has already annotated holes with types.
 -/
-def eliminateHoles (program : Program) : Program × Statistics :=
+def eliminateDeterministicHoles (program : Program) : Program × Statistics :=
   let initState : ElimHoleState := {}
   let (procs, finalState) := (program.staticProcedures.mapM elimProcedure).run initState
   let stats := ({} : Statistics)
@@ -89,4 +88,13 @@ def eliminateHoles (program : Program) : Program × Statistics :=
   ({ program with staticProcedures := finalState.generatedFunctions ++ procs }, stats)
 
 end -- public section
+
+/-- Pipeline pass: eliminate deterministic holes. -/
+public def eliminateDeterministicHolesPass : LoweringPass where
+  name := "EliminateDeterministicHoles"
+  documentation := "Replaces every deterministic hole with a call to a freshly generated uninterpreted function. After this pass the program contains only non-deterministic holes. Assumes `InferHoleTypes` has already annotated holes with types."
+  run := fun p _m _ =>
+    let (p', stats) := eliminateDeterministicHoles p
+    (p', [], stats)
+
 end Laurel
diff --git a/Strata/Languages/Laurel/EliminateDoWhile.lean b/Strata/Languages/Laurel/EliminateDoWhile.lean
new file mode 100644
index 0000000000..345b1ad694
--- /dev/null
+++ b/Strata/Languages/Laurel/EliminateDoWhile.lean
@@ -0,0 +1,82 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Languages.Laurel.LaurelAST
+public import Strata.Languages.Laurel.LaurelPass
+import Strata.Languages.Laurel.MapStmtExpr
+import Strata.Util.Tactics
+
+/-!
+# Eliminate Do-While
+
+Lowers post-test `While` loops (`postTest = true`, the `do … while` form) into
+the pre-test `while` machinery. Runs early so that no later pass (or the Core
+translator) observes `postTest = true`.
+
+The desugaring of `do BODY while(COND) invariant I` is:
+```
+  { while(true) invariant I { BODY; if (!COND) exit L } } L
+```
+`BODY` runs once per iteration with `COND` re-checked after it; the real guard
+reaches post-loop code via the structured `exit L`, so the encoding is sound,
+complete, and linear (a single body in the IR — no peeling/duplication). The
+invariant `I` is checked at the loop head (before each body), matching `while`.
+
+The fresh exit label `L` is `$dowhile_exit_{n}` for a per-program monotonic
+counter `n`. The leading `$` keeps it out of the user-name space (no source
+identifier can contain `$`), so it can never capture, or be captured by, a user
+`break`/`continue` label, and the counter keeps nested do-whiles distinct.
+
+The traversal is the generic bottom-up `mapStmtExprM`, so inner do-whiles are
+eliminated before their enclosing ones.
+-/
+
+namespace Strata.Laurel
+
+/-- Monotonic counter feeding fresh exit labels (scheme described in the module header). -/
+private structure ElimState where
+  freshCounter : Nat := 0
+
+private abbrev ElimM := StateM ElimState
+
+private def freshExitLabel : ElimM String :=
+  modifyGet fun s => (s!"$dowhile_exit_{s.freshCounter}", { s with freshCounter := s.freshCounter + 1 })
+
+/-- Rewrites a post-test `While` to its pre-test desugaring; all other nodes pass through. -/
+private def rewriteNode (node : StmtExprMd) : ElimM StmtExprMd := do
+  match node.val with
+  | .While cond invs dec body true =>
+    let source := node.source
+    let exitLabel ← freshExitLabel
+    let notCond : StmtExprMd := ⟨.PrimitiveOp .Not [cond], source⟩
+    let exitStmt : StmtExprMd := ⟨.Exit exitLabel, source⟩
+    let guardCheck : StmtExprMd := ⟨.IfThenElse notCond exitStmt none, source⟩
+    let loopBody : StmtExprMd := ⟨.Block [body, guardCheck] none, source⟩
+    let trueCond : StmtExprMd := ⟨.LiteralBool true, source⟩
+    -- Thread `dec` onto the `while(true)` rather than dropping it: each desugared
+    -- iteration is one pass through that loop's head, so the measure decreases
+    -- across exactly those iterations. The emitted loop is pre-test
+    -- (`postTest := false`), so it is not rewritten again.
+    let whileStmt : StmtExprMd := ⟨.While trueCond invs dec loopBody false, source⟩
+    pure ⟨.Block [whileStmt] (some exitLabel), source⟩
+  | _ => pure node
+
+public section
+
+/-- Eliminate every post-test `While` in a Laurel program; afterward every `While` has `postTest = false`. -/
+def eliminateDoWhile (program : Program) : Program :=
+  let rewrite : Procedure → ElimM Procedure := mapProcedureM (mapStmtExprM rewriteNode)
+  (mapProgramProceduresM rewrite program |>.run {}).fst
+
+/-- Pipeline pass: eliminate post-test (`do … while`) loops. -/
+public def eliminateDoWhilePass : LoweringPass where
+  name := "EliminateDoWhile"
+  documentation := "Lowers post-test `While` loops (the `do … while` form) into the pre-test loop `{ while(true) invariant I { BODY; if (!COND) exit L } } L`, with a fresh `$`-prefixed exit label `L`. Runs early so no later pass observes a post-test loop; the invariant is checked at the loop head, matching `while`."
+  run := fun p _m _ => (eliminateDoWhile p, [], {})
+
+end -- public section
+end Strata.Laurel
diff --git a/Strata/Languages/Laurel/EliminateIncrDecr.lean b/Strata/Languages/Laurel/EliminateIncrDecr.lean
new file mode 100644
index 0000000000..7f1c06a2a5
--- /dev/null
+++ b/Strata/Languages/Laurel/EliminateIncrDecr.lean
@@ -0,0 +1,109 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Languages.Laurel.LaurelAST
+public import Strata.Languages.Laurel.LaurelPass
+import Strata.Languages.Laurel.MapStmtExpr
+import Strata.Util.Tactics
+
+/-!
+# Eliminate Increment / Decrement
+
+Lowers `.IncrDecr` nodes (Java-style `++x`, `x++`, `--x`, `x--`) into
+existing Laurel constructs. Runs before `LiftImperativeExpressions` so that
+later passes never see `.IncrDecr`.
+
+The lowering, parameterised on `op` (`Incr | Decr`) and `mode` (`Pre | Post`):
+
+* **Prefix** (`++x`, `--x`) — yields the **new** value:
+  ```
+  ++x  ⇝  (x := x + 1)
+  --x  ⇝  (x := x - 1)
+  ```
+  An assignment used as an expression already evaluates to the new value, so
+  no extra arithmetic is needed.
+
+* **Postfix** (`x++`, `x--`) — yields the **old** value, recovered by
+  applying the inverse delta to the new value:
+  ```
+  x++  ⇝  ((x := x + 1) - 1)
+  x--  ⇝  ((x := x - 1) + 1)
+  ```
+
+The pass uses the generic `mapStmtExpr` bottom-up traversal from
+`MapStmtExpr.lean`. The only constructor that changes is `.IncrDecr`; all
+other nodes are left as-is by the traversal's default recursion.
+
+The target of `.IncrDecr` must be a `Variable.Local` or `Variable.Field` —
+the concrete-to-abstract translator already enforces this.
+-/
+
+namespace Strata.Laurel
+
+public section
+
+/-- Reconstruct the read-side `StmtExprMd` for a `Variable`. -/
+private def targetAsRead (target : VariableMd) : StmtExprMd :=
+  let source := target.source
+  match target.val with
+  | .Local name => ⟨.Var (.Local name), source⟩
+  | .Field tgt fieldName => ⟨.Var (.Field tgt fieldName), source⟩
+  | .Declare param => ⟨.Var (.Local param.name), source⟩
+
+/-- Build `.Assign [target] (target ⊕ 1)` where `⊕` is `Add` for `Incr` and
+    `Sub` for `Decr`. The resulting assignment expression yields the new value. -/
+private def lowerToAssign (op : IncrDecrOp) (target : VariableMd)
+    (source : Option FileRange) : StmtExprMd :=
+  let primOp : Operation := match op with
+    | .Incr => .Add
+    | .Decr => .Sub
+  let one : StmtExprMd := ⟨.LiteralInt 1, source⟩
+  let read := targetAsRead target
+  let updated : StmtExprMd := ⟨.PrimitiveOp primOp [read, one], source⟩
+  ⟨.Assign [target] updated, source⟩
+
+/-- Lower a single `.IncrDecr` node to the expression form that yields the
+    correct value for the given `mode` (Pre or Post). -/
+private def lowerIncrDecr (mode : IncrDecrMode) (op : IncrDecrOp)
+    (target : VariableMd) (source : Option FileRange) : StmtExprMd :=
+  let assign := lowerToAssign op target source
+  match mode with
+  | .Pre => assign
+  | .Post =>
+    -- Recover the old value: apply the inverse delta to the new value.
+    let inverseOp : Operation := match op with
+      | .Incr => .Sub
+      | .Decr => .Add
+    let one : StmtExprMd := ⟨.LiteralInt 1, source⟩
+    ⟨.PrimitiveOp inverseOp [assign, one], source⟩
+
+/-- The rewrite step applied bottom-up by `mapStmtExpr`. Replaces `.IncrDecr`
+    with its lowered form; all other nodes pass through unchanged. -/
+private def rewriteNode (node : StmtExprMd) : StmtExprMd :=
+  match node.val with
+  | .IncrDecr mode op target => lowerIncrDecr mode op target node.source
+  | _ => node
+
+/-- Apply the rewrite to a procedure (body, preconditions, decreases, invokeOn). -/
+private def lowerProcedure (proc : Procedure) : Procedure :=
+  mapProcedureM (m := Id) (mapStmtExpr rewriteNode) proc
+
+/--
+Eliminate every `.IncrDecr` node in a Laurel program by lowering it to
+existing constructs. After this pass, no `.IncrDecr` node remains.
+-/
+def eliminateIncrDecr (program : Program) : Program :=
+  mapProgramProcedures lowerProcedure program
+
+/-- Pipeline pass: eliminate increment/decrement operators. -/
+public def eliminateIncrDecrPass : LoweringPass where
+  name := "EliminateIncrDecr"
+  documentation := "Lowers Java-style increment/decrement operators (`++x`, `x++`, `--x`, `x--`) into existing Laurel assignment and arithmetic constructs. Prefix forms yield the new value; postfix forms yield the old value. Runs early so that no later pass observes an `.IncrDecr` node."
+  run := fun p _m _ => (eliminateIncrDecr p, [], {})
+
+end -- public section
+end Strata.Laurel
diff --git a/Strata/Languages/Laurel/EliminateReturnStatements.lean b/Strata/Languages/Laurel/EliminateReturnStatements.lean
new file mode 100644
index 0000000000..d2a7743765
--- /dev/null
+++ b/Strata/Languages/Laurel/EliminateReturnStatements.lean
@@ -0,0 +1,83 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Languages.Laurel.MapStmtExpr
+public import Strata.Languages.Laurel.LaurelPass
+
+/-!
+# Eliminate Return Statements
+
+Replaces `return` statements in imperative procedure bodies with assignments
+to the output parameters followed by an `exit` to a labelled block that wraps
+the entire body. This ensures that code placed after the body block (e.g.,
+postcondition assertions inserted by the contract pass) is always reached.
+
+This pass should run after `EliminateReturnsInExpression` (which handles
+functional/expression-position returns) and before the contract pass.
+-/
+
+namespace Strata.Laurel
+
+public section
+
+private def returnLabel : String := "$return"
+
+
+
+
+/-- Transform a single procedure: wrap body in a labelled block and replace returns. -/
+private def eliminateReturnStmts (proc : Procedure) : Procedure :=
+  match proc.body with
+  | .Opaque postconds (some impl) mods =>
+    let impl' := replaceReturn proc.outputs impl
+    let wrapped := match impl'.val with
+      | .Block stmts none => ⟨.Block stmts (some returnLabel), impl'.source⟩
+      | _ => ⟨ .Block [impl'] (some returnLabel), proc.name.source ⟩
+    { proc with body := .Opaque postconds (some wrapped) mods }
+  | .Transparent body =>
+    let body' := replaceReturn proc.outputs body
+    let wrapped := match body'.val with
+      | .Block stmts none => ⟨.Block stmts (some returnLabel), body'.source⟩
+      | _ => ⟨ .Block [body'] (some returnLabel), proc.name.source ⟩
+    { proc with body := .Transparent wrapped }
+  | _ => proc
+where
+
+  /-- Replace `Return val` with `output := val; exit "$return"` (or just `exit`
+    for valueless returns). Uses `mapStmtExpr` for bottom-up traversal. -/
+  replaceReturn (outputs : List Parameter) (expr : StmtExprMd) : StmtExprMd :=
+    mapStmtExpr (fun e =>
+      match e.val with
+      | .Return (some val) =>
+        /- Handling valued return is required because the heap param pass introduces valued return in
+        Strata/Languages/Laurel/HeapParameterizationConstants.lean
+        We should change that so we can remove this case.
+        -/
+        match outputs with
+        | [out] =>
+          let assign := ⟨ .Assign [⟨ .Local out.name, expr.source ⟩] val, expr.source ⟩
+          let exit := ⟨ .Exit returnLabel, expr.source ⟩
+          ⟨.Block [assign, exit] none, e.source⟩
+        | _ => ⟨ .Exit returnLabel, expr.source ⟩
+      | .Return none => ⟨ .Exit returnLabel, expr.source ⟩
+      | _ => e) expr
+
+/-- Transform a program by eliminating return statements in all procedure bodies. -/
+def eliminateReturnStatements (program : Program) : Program :=
+  { program with staticProcedures := program.staticProcedures.map eliminateReturnStmts }
+
+public def eliminateReturnStatementsPass : LoweringPass where
+  name := "EliminateReturnStatements"
+  documentation := "Lower return statements to exit statements. Wrap each procedure body with a 'return' block"
+  run := fun p _m _ =>
+    let p' := eliminateReturnStatements p
+    (p', [], {})
+  -- comesBefore := [contractPass]
+
+end -- public section
+
+end Strata.Laurel
diff --git a/Strata/Languages/Laurel/EliminateReturnsInExpression.lean b/Strata/Languages/Laurel/EliminateReturnsInExpression.lean
deleted file mode 100644
index d6bb187cbf..0000000000
--- a/Strata/Languages/Laurel/EliminateReturnsInExpression.lean
+++ /dev/null
@@ -1,120 +0,0 @@
-/-
-  Copyright Strata Contributors
-
-  SPDX-License-Identifier: Apache-2.0 OR MIT
--/
-module
-
-public import Strata.Languages.Laurel.LaurelAST
-import Strata.Util.Tactics
-
-/-!
-# Eliminate Returns in Expression Position
-
-Rewrites functional procedure bodies so that `return` statements are removed
-and early-return guard patterns become if-then-else expressions. This makes
-the body a pure expression tree suitable for translation to a Core function.
-
-The algorithm walks a block backwards (from last statement to first),
-accumulating a result expression:
-
-- The last statement is converted via `lastStmtToExpr` which strips `return`,
-  recurses into blocks, and handles if-then-else.
-- Each preceding statement wraps around the accumulated result via `stmtsToExpr`:
-  - `if (cond) { body }` (no else) becomes `if cond then lastStmtToExpr(body) else acc`
-  - Other statements are kept in a two-element block with the accumulator.
-
--/
-
-namespace Strata.Laurel
-
-/-- Appending a singleton strictly increases `sizeOf`. -/
-private theorem List.sizeOf_lt_append_singleton [SizeOf α] (xs : List α) (y : α) :
-    sizeOf xs < sizeOf (xs ++ [y]) := by
-  induction xs with
-  | nil => simp_all; omega
-  | cons hd tl ih => simp_all [List.cons_append]
-
-/-- `dropLast` of a non-empty list has strictly smaller `sizeOf`. -/
-private theorem List.sizeOf_dropLast_lt [SizeOf α] {l : List α} (h_ne : l ≠ []) :
-    sizeOf l.dropLast < sizeOf l := by
-  have h_concat := List.dropLast_concat_getLast h_ne
-  have : sizeOf l = sizeOf (l.dropLast ++ [l.getLast h_ne]) := by rw [h_concat]
-  rw [this]
-  exact List.sizeOf_lt_append_singleton l.dropLast (l.getLast h_ne)
-
-mutual
-
-/--
-Fold a list of preceding statements (right-to-left) around an accumulator
-expression. Each `if-then` (no else) guard wraps as
-`if cond then lastStmtToExpr(body) else acc`; other statements produce
-`Block [stmt, acc]`.
--/
-def stmtsToExpr (stmts : List StmtExprMd) (acc : StmtExprMd)
-    : StmtExprMd :=
-  match stmts with
-  | [] => acc
-  | s :: rest =>
-    let acc' := stmtsToExpr rest acc
-    match s with
-    | ⟨.IfThenElse cond thenBr none, ssrc⟩ =>
-      ⟨.IfThenElse cond (lastStmtToExpr thenBr) (some acc'), ssrc⟩
-    | _ =>
-      { val := .Block [s, acc'] none, source := none }
-  termination_by (sizeOf stmts, 1)
-
-/--
-Convert the last statement of a block into an expression.
-- `return expr` → `expr`
-- A non-empty block → process last element, fold preceding statements
-- `if cond then A else B` → recurse into both branches
-- Anything else → kept as-is
--/
-def lastStmtToExpr (stmt : StmtExprMd) : StmtExprMd :=
-  match stmt with
-  | ⟨.Return (some val), _⟩ => val
-  | ⟨.Block stmts _, _⟩ =>
-    match h_last : stmts.getLast? with
-    | some last =>
-      have := List.mem_of_getLast? h_last
-      let lastExpr := lastStmtToExpr last
-      let dropped := stmts.dropLast
-      have h : sizeOf stmts.dropLast < sizeOf stmts :=
-        List.sizeOf_dropLast_lt (by intro h; simp [h] at h_last)
-      stmtsToExpr dropped lastExpr
-    | none => stmt
-  | ⟨.IfThenElse cond thenBr (some elseBr), source⟩ =>
-    ⟨.IfThenElse cond (lastStmtToExpr thenBr) (some (lastStmtToExpr elseBr)), source⟩
-  | _ => stmt
-  termination_by (sizeOf stmt, 0)
-  decreasing_by
-    all_goals (simp_all; term_by_mem)
-
-end
-
-/--
-Apply return elimination to a functional procedure's body.
-The entire body is treated as an expression to be converted.
--/
-def eliminateReturnsInExpression (proc : Procedure) : Procedure :=
-  if !proc.isFunctional then proc
-  else
-    match proc.body with
-    | .Transparent bodyExpr =>
-      { proc with body := .Transparent (lastStmtToExpr bodyExpr) }
-    | .Opaque postconds (some impl) modif =>
-      { proc with body := .Opaque postconds (some (lastStmtToExpr impl)) modif }
-    | _ => proc
-
-public section
-
-/--
-Transform a program by eliminating returns in all functional procedure bodies.
--/
-def eliminateReturnsInExpressionTransform (program : Program) : Program :=
-  { program with staticProcedures := program.staticProcedures.map eliminateReturnsInExpression }
-
-end -- public section
-
-end Laurel
diff --git a/Strata/Languages/Laurel/EliminateValueInReturns.lean b/Strata/Languages/Laurel/EliminateValueInReturns.lean
new file mode 100644
index 0000000000..d209465bf6
--- /dev/null
+++ b/Strata/Languages/Laurel/EliminateValueInReturns.lean
@@ -0,0 +1,100 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Languages.Laurel.LaurelAST
+public import Strata.Languages.Laurel.LaurelPass
+import Strata.Languages.Laurel.MapStmtExpr
+import Strata.Util.Tactics
+
+/-!
+# Eliminate Values In Returns
+
+Rewrites `return expr` into `outParam := expr; return` for imperative
+(non-functional) procedures that have an output parameter.
+
+The pass is a Laurel-to-Laurel rewrite that runs before Core translation.
+It only applies to static procedures, hence LiftInstanceProcedures must
+be executed before it.
+-/
+
+namespace Strata.Laurel
+
+/-- Rewrite a single `Return (some value)` node into the list
+    `[Assign outParam value, Return none]`.
+    When used with `mapStmtExprFlattenM`, these statements are flattened
+    into the enclosing block rather than wrapped in a nested block. -/
+private def eliminateValueReturnNode (outParam : Identifier) (stmt : StmtExprMd) : Id (List StmtExprMd) :=
+  match stmt.val with
+  | .Return (some value) =>
+    -- Synthesized nodes use default metadata since no diagnostics should be reported on them
+    let target : VariableMd := { val := .Local outParam, source := stmt.source }
+    let assign : StmtExprMd := { val := .Assign [target] value, source := stmt.source }
+    let ret : StmtExprMd := { val := .Return none, source := stmt.source }
+    [assign, ret]
+  | _ => [stmt]
+
+/-- Check whether a statement tree contains any `Return (some _)`. -/
+def hasValuedReturn (stmt : StmtExprMd) : Bool :=
+  match _h : stmt.val with
+  | .Return (some _) => true
+  | .Block stmts _ => stmts.attach.any fun ⟨s, _⟩ => hasValuedReturn s
+  | .IfThenElse _ thenBr (some elseBr) =>
+    hasValuedReturn thenBr || hasValuedReturn elseBr
+  | .IfThenElse _ thenBr none => hasValuedReturn thenBr
+  | .While _ _ _ body _ => hasValuedReturn body
+  | _ => false
+  termination_by sizeOf stmt
+  decreasing_by
+    all_goals simp_wf
+    all_goals (try have := AstNode.sizeOf_val_lt stmt)
+    all_goals (try term_by_mem)
+    all_goals omega
+
+/-- Apply value-return elimination to a single procedure. Rewrites `return expr`
+    into `outParam := expr; return` for any procedure with exactly one output
+    parameter (functional and non-functional alike).
+    Emits an error if a valued return is used with zero or multiple output parameters. -/
+def eliminateValueReturnsInProc (proc : Procedure) : Procedure :=
+  match proc.outputs with
+  | [outParam] =>
+    let pre (_: Bool) (stmt : StmtExprMd) : Id (Option (List StmtExprMd)) :=
+      match stmt.val with
+      | .Return (some value) =>
+        let target : VariableMd := { val := .Local outParam.name, source := stmt.source }
+        let assign : StmtExprMd := { val := .Assign [target] value, source := stmt.source }
+        let ret : StmtExprMd := { val := .Return none, source := stmt.source }
+        some [assign, ret]
+      | _ => none
+    let post (_: Bool) (stmt : StmtExprMd) : Id (List StmtExprMd) := pure [stmt]
+    let rewrite := mapStmtExprFlattenM (m := Id) pre post true
+    match proc.body with
+    | .Transparent body =>
+      { proc with body := .Transparent (rewrite body) }
+    | .Opaque postconds (some impl) modif =>
+      { proc with body := .Opaque postconds (some (rewrite impl)) modif }
+    | _ => proc
+  | _ =>
+  -- Procedures without any out param (void) or with multiple output
+  -- cannot have return statements. This raises a Resolution error
+  -- (see `Check.return` in Resolution.lean)
+    proc
+
+public section
+
+/-- Transform a program by eliminating value returns in all imperative procedures. -/
+def eliminateValueInReturnsTransform (program : Program) : Program  :=
+  { program with staticProcedures := program.staticProcedures.map eliminateValueReturnsInProc }
+
+end -- public section
+
+/-- Pipeline pass: eliminate value returns. -/
+public def eliminateValueInReturnsPass : LoweringPass where
+  name := "EliminateValueInReturns"
+  documentation := "Rewrites `return expr` into `outParam := expr; return` for imperative procedures that have an output parameter. This decouples the return-value assignment from the final Core translation, which no longer needs to know about output parameters when translating returns."
+  run := fun p _m _ => (eliminateValueInReturnsTransform p, [], {})
+
+end Laurel
diff --git a/Strata/Languages/Laurel/EliminateValueReturns.lean b/Strata/Languages/Laurel/EliminateValueReturns.lean
deleted file mode 100644
index 33df774b4e..0000000000
--- a/Strata/Languages/Laurel/EliminateValueReturns.lean
+++ /dev/null
@@ -1,94 +0,0 @@
-/-
-  Copyright Strata Contributors
-
-  SPDX-License-Identifier: Apache-2.0 OR MIT
--/
-module
-
-public import Strata.Languages.Laurel.LaurelAST
-import Strata.Languages.Laurel.MapStmtExpr
-import Strata.Util.Tactics
-
-/-!
-# Eliminate Value Returns
-
-Rewrites `return expr` into `outParam := expr; return` for imperative
-(non-functional) procedures that have an output parameter. This decouples
-the return-value assignment from the `LaurelToCoreTranslator`, which no
-longer needs to know about output parameters when translating returns.
-
-The pass is a Laurel-to-Laurel rewrite that runs before Core translation.
--/
-
-namespace Strata.Laurel
-
-/-- Rewrite a single `Return (some value)` node into
-    `Block [Assign [Identifier outParam] value, Return none]`.
-    Recursion into children is handled by `mapStmtExpr`. -/
-private def eliminateValueReturnNode (outParam : Identifier) (stmt : StmtExprMd) : StmtExprMd :=
-  match stmt.val with
-  | .Return (some value) =>
-    -- Synthesized nodes use default metadata since no diagnostics should be reported on them
-    let target : VariableMd := { val := .Local outParam, source := none }
-    let assign : StmtExprMd := { val := .Assign [target] value, source := none }
-    let ret : StmtExprMd := { val := .Return none, source := stmt.source }
-    { val := .Block [assign, ret] none, source := none }
-  | _ => stmt
-
-/-- Check whether a statement tree contains any `Return (some _)`. -/
-def hasValuedReturn (stmt : StmtExprMd) : Bool :=
-  match _h : stmt.val with
-  | .Return (some _) => true
-  | .Block stmts _ => stmts.attach.any fun ⟨s, _⟩ => hasValuedReturn s
-  | .IfThenElse _ thenBr (some elseBr) =>
-    hasValuedReturn thenBr || hasValuedReturn elseBr
-  | .IfThenElse _ thenBr none => hasValuedReturn thenBr
-  | .While _ _ _ body => hasValuedReturn body
-  | _ => false
-  termination_by sizeOf stmt
-  decreasing_by
-    all_goals simp_wf
-    all_goals (try have := AstNode.sizeOf_val_lt stmt)
-    all_goals (try term_by_mem)
-    all_goals omega
-
-/-- Apply value-return elimination to a single procedure. Only applies to
-    non-functional procedures with exactly one output parameter.
-    Emits an error if a valued return is used with multiple output parameters. -/
-def eliminateValueReturnsInProc (proc : Procedure) : Procedure × Array DiagnosticModel :=
-  if proc.isFunctional then (proc, #[])
-  else match proc.outputs with
-  | [outParam] =>
-    let rewrite := mapStmtExpr (eliminateValueReturnNode outParam.name)
-    match proc.body with
-    | .Transparent body =>
-      ({ proc with body := .Transparent (rewrite body) }, #[])
-    | .Opaque postconds (some impl) modif =>
-      ({ proc with body := .Opaque postconds (some (rewrite impl)) modif }, #[])
-    | _ => (proc, #[])
-  | other =>
-    let bodyHasValuedReturn := match proc.body with
-      | .Transparent body => hasValuedReturn body
-      | .Opaque _ (some impl) _ => hasValuedReturn impl
-      | _ => false
-    if bodyHasValuedReturn then
-      let msg := if other.isEmpty then
-        "Valued return is not supported for procedures with no output parameters"
-      else
-        "Valued return is not supported for procedures with multiple output parameters"
-      (proc, #[diagnosticFromSource proc.name.source msg DiagnosticType.UserError])
-    else (proc, #[])
-
-public section
-
-/-- Transform a program by eliminating value returns in all imperative procedures. -/
-def eliminateValueReturnsTransform (program : Program) : Program × Array DiagnosticModel :=
-  let (procs, diags) := program.staticProcedures.foldl (fun (ps, ds) proc =>
-    let (proc', procDiags) := eliminateValueReturnsInProc proc
-    (proc' :: ps, ds ++ procDiags)
-  ) ([], #[])
-  ({ program with staticProcedures := procs.reverse }, diags)
-
-end -- public section
-
-end Laurel
diff --git a/Strata/Languages/Laurel/FilterPrelude.lean b/Strata/Languages/Laurel/FilterPrelude.lean
index 8ae871b35f..52fd25fcbc 100644
--- a/Strata/Languages/Laurel/FilterPrelude.lean
+++ b/Strata/Languages/Laurel/FilterPrelude.lean
@@ -71,14 +71,13 @@ private partial def collectHighTypeNames (ty : HighTypeMd) : CollectM Unit := do
   match ty.val with
   | .UserDefined name => addTypeName name.text
   | .TCore _ => pure ()
-  | .TTypedField vt => collectHighTypeNames vt
   | .TSet et => collectHighTypeNames et
   | .TMap kt vt => collectHighTypeNames kt; collectHighTypeNames vt
   | .Applied base args =>
     collectHighTypeNames base; args.forM collectHighTypeNames
   | .Pure base => collectHighTypeNames base
   | .Intersection types => types.forM collectHighTypeNames
-  | .TVoid | .TBool | .TInt | .TFloat64 | .TReal | .TString | .THeap
+  | .TVoid | .TBool | .TInt | .TFloat64 | .TReal | .TString
   | .TBv _ | .Unknown | .MultiValuedExpr _ => pure ()
 
 /-- Collect all referenced names (procedure calls, type references) from a StmtExpr tree. -/
@@ -93,7 +92,7 @@ private partial def collectExprNames (expr : StmtExprMd) : CollectM Unit := do
     collectExprNames cond; collectExprNames thenB
     elseB.forM collectExprNames
   | .Block stmts _ => stmts.forM collectExprNames
-  | .While cond invs dec body =>
+  | .While cond invs dec body _ =>
     collectExprNames cond; invs.forM collectExprNames
     dec.forM collectExprNames
     collectExprNames body
@@ -104,6 +103,11 @@ private partial def collectExprNames (expr : StmtExprMd) : CollectM Unit := do
       | .Field target _ => collectExprNames target
       | .Local _ => pure ()
       | .Declare param => collectHighTypeNames param.type
+  | .IncrDecr _ _ target =>
+    match target.val with
+    | .Field tgt _ => collectExprNames tgt
+    | .Local _ => pure ()
+    | .Declare param => collectHighTypeNames param.type
   | .Var (.Field target _) => collectExprNames target
   | .Var (.Declare param) => collectHighTypeNames param.type
   | .PureFieldUpdate target _ newVal =>
@@ -123,7 +127,7 @@ private partial def collectExprNames (expr : StmtExprMd) : CollectM Unit := do
   | .ContractOf _ func => collectExprNames func
   | .ReferenceEquals lhs rhs => collectExprNames lhs; collectExprNames rhs
   | .Hole _ ty => ty.forM collectHighTypeNames
-  | .Exit _ | .LiteralInt _ | .LiteralBool _ | .LiteralString _ | .LiteralDecimal _
+  | .Exit _ | .LiteralInt _ | .LiteralBool _ | .LiteralString _ | .LiteralDecimal _ | .LiteralBv _ _
   | .Var (.Local _) | .This | .Abstract | .All => pure ()
 
 /-- Collect names from a procedure body. -/
@@ -182,7 +186,7 @@ private partial def collectInvokeOnTargets (expr : StmtExprMd)
     let rest ← args.flatMapM collectInvokeOnTargets
     return callee.text :: rest
   | .Var (.Local _) | .LiteralInt _ | .LiteralBool _ | .LiteralString _
-  | .LiteralDecimal _ => return []
+  | .LiteralDecimal _ | .LiteralBv _ _ => return []
   | _ =>
     throw s!"FilterPrelude.collectInvokeOnTargets: unexpected node in invokeOn expression"
 
@@ -217,8 +221,6 @@ private def buildDependencyMap (prog : Laurel.Program)
         for c in dt.constructors do
           insertNew c.name.text (deps.insert name)
             s!"constructor '{c.name.text}' of datatype '{name}'"
-          insertNew (dt.testerName c) (deps.insert name)
-            s!"tester '{dt.testerName c}' of datatype '{name}'"
           for a in c.args do
             insertNew (dt.destructorName a) (deps.insert name)
               s!"destructor '{dt.destructorName a}'"
diff --git a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean
index 6d74634452..145c39694f 100644
--- a/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean
+++ b/Strata/Languages/Laurel/Grammar/AbstractToConcreteTreeTranslator.lean
@@ -49,9 +49,7 @@ partial def highTypeValToArg : HighType → Arg
   | .UserDefined name => laurelOp "compositeType" #[ident name.text]
   | .TCore s => laurelOp "coreType" #[ident s]
   | .TVoid => laurelOp "compositeType" #[ident "void"]
-  | .THeap => laurelOp "compositeType" #[ident "Heap"]
-  -- Type parameters discarded; the grammar cannot represent Field[T] or Set[T]
-  | .TTypedField _vt => laurelOp "compositeType" #[ident "Field"]
+  -- Type parameters discarded; the grammar cannot represent Set[T]
   | .TSet _et => laurelOp "compositeType" #[ident "Set"]
   | .Applied base _args =>
     -- Applied types are not directly representable in the grammar;
@@ -96,6 +94,7 @@ where
       | .negSucc n => laurelOp "neg" #[laurelOp "int" #[.num sr (n + 1)]]
     | .LiteralDecimal d => laurelOp "real" #[.decimal sr d]
     | .LiteralString s => laurelOp "string" #[.strlit sr s]
+    | .LiteralBv value width => laurelOp "bvLiteral" #[.num sr value, .num sr width]
     | .Hole true _ => laurelOp "hole"
     | .Hole false _ => laurelOp "nondetHole"
     | .Var (.Local name) => laurelOp "identifier" #[ident name.text]
@@ -130,6 +129,18 @@ where
         laurelOp "assign" #[targetArg, stmtExprToArg value]
     | .Var (.Field target field) =>
       laurelOp "fieldAccess" #[stmtExprToArg target, ident field.text]
+    | .IncrDecr mode op target =>
+      let opName := match mode, op with
+        | .Pre,  .Incr => "preIncr"
+        | .Pre,  .Decr => "preDecr"
+        | .Post, .Incr => "postIncr"
+        | .Post, .Decr => "postDecr"
+      let targetArg := match target.val with
+        | .Field obj fieldName =>
+          laurelOp "fieldAccess" #[stmtExprToArg obj, ident fieldName.text]
+        | .Local name => laurelOp "identifier" #[ident name.text]
+        | .Declare param => laurelOp "identifier" #[ident param.name.text]
+      laurelOp opName #[targetArg]
     | .StaticCall callee args =>
       let calleeArg := laurelOp "identifier" #[ident callee.text]
       let argsArr := args.map stmtExprToArg |>.toArray
@@ -145,11 +156,15 @@ where
     | .IfThenElse cond thenBr elseBr =>
       let elseOpt := optionArg (elseBr.map fun e => laurelOp "elseBranch" #[stmtExprToArg e])
       laurelOp "ifThenElse" #[stmtExprToArg cond, stmtExprToArg thenBr, elseOpt]
-    | .While cond invs _decreases body =>
+    | .While cond invs _decreases body postTest =>
       let invArgs := invs.map (fun i => laurelOp "invariantClause" #[stmtExprToArg i]) |>.toArray
-      laurelOp "while" #[stmtExprToArg cond, seqArg invArgs, stmtExprToArg body]
-    | .Return (some value) => laurelOp "return" #[stmtExprToArg value]
-    | .Return none => laurelOp "return" #[laurelOp "block" #[semicolonSep #[]]]
+      if postTest then
+        -- `do … while`; grammar op order is `doWhile(body, cond, invariants)`.
+        laurelOp "doWhile" #[stmtExprToArg body, stmtExprToArg cond, seqArg invArgs]
+      else
+        laurelOp "while" #[stmtExprToArg cond, seqArg invArgs, stmtExprToArg body]
+    | .Return (some value) => laurelOp "return" #[optionArg (some (stmtExprToArg value))]
+    | .Return none => laurelOp "return" #[optionArg none]
     | .Exit label => laurelOp "exit" #[ident label]
     | .Assert cond =>
       let errOpt := optionArg (cond.summary.map fun msg =>
@@ -178,7 +193,7 @@ where
     | .ReferenceEquals lhs rhs =>
       laurelOp "eq" #[stmtExprToArg lhs, stmtExprToArg rhs]
     | .Assigned name => laurelOp "call" #[laurelOp "identifier" #[ident "assigned"], commaSep #[stmtExprToArg name]]
-    | .Old value => laurelOp "call" #[laurelOp "identifier" #[ident "old"], commaSep #[stmtExprToArg value]]
+    | .Old value => laurelOp "old" #[stmtExprToArg value]
     | .Fresh value => laurelOp "call" #[laurelOp "identifier" #[ident "fresh"], commaSep #[stmtExprToArg value]]
     | .ProveBy value _proof => stmtExprValToArg value.val
     | .ContractOf _type fn => stmtExprValToArg fn.val
@@ -241,7 +256,14 @@ private def procedureToOp (proc : Procedure) : StrataDDM.Operation :=
     laurelOp "invokeOnClause" #[stmtExprToArg e])
   let (opaqueSpecArg, bodyArg) := match proc.body with
     | .Transparent body =>
-      (optionArg none, optionArg (some (laurelOp "body" #[stmtExprToArg body])))
+      -- For functions, the body is implicitly wrapped in a Return by ConcreteToAbstract;
+      -- unwrap it here so the concrete output doesn't show an explicit `return`.
+      let emitBody := if proc.isFunctional then
+        match body.val with
+        | .Return (some inner) => inner
+        | _ => body
+      else body
+      (optionArg none, optionArg (some (laurelOp "body" #[stmtExprToArg emitBody])))
     | .Opaque postconds impl modifies =>
       let ens := postconds.map ensuresClauseToArg |>.toArray
       let mods := if modifies.isEmpty then #[] else modifiesClausesToArgs modifies
diff --git a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean
index 22ab16379f..bf5e10dd12 100644
--- a/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean
+++ b/Strata/Languages/Laurel/Grammar/ConcreteToAbstractTreeTranslator.lean
@@ -184,6 +184,20 @@ def getUnaryOp? (name : QualifiedIdent) : Option Operation :=
   | q`Laurel.neg => some Operation.Neg
   | _ => none
 
+/-- Translate a `Seq InvariantClause` into the list of invariant conditions,
+    using `translate` for each clause body. Shared by the `while`, `forLoop`,
+    and `doWhile` arms. Takes `translate` as a parameter so it can stay outside
+    the `translateStmtExpr` mutual block and thus be a total `def`. -/
+def translateInvariantClauses (translate : Arg → TransM StmtExprMd) (arg : Arg) :
+    TransM (List StmtExprMd) := do
+  match arg with
+  | .seq _ _ clauses => clauses.toList.mapM fun clause => match clause with
+      | .op invOp => match invOp.name, invOp.args with
+        | q`Laurel.invariantClause, #[exprArg] => translate exprArg
+        | _, _ => TransM.error "Expected invariantClause"
+      | _ => TransM.error "Expected operation"
+  | _ => pure []
+
 mutual
 
 partial def translateStmtExpr (arg : Arg) : TransM StmtExprMd := do
@@ -223,6 +237,10 @@ partial def translateStmtExpr (arg : Arg) : TransM StmtExprMd := do
     | q`Laurel.string, #[arg0] =>
       let s ← translateString arg0
       return mkStmtExprMd (.LiteralString s) src
+    | q`Laurel.bvLiteral, #[valueArg, widthArg] =>
+      let value ← translateNat valueArg
+      let width ← translateNat widthArg
+      return mkStmtExprMd (.LiteralBv value width) src
     | q`Laurel.hole, #[] => return mkStmtExprMd (.Hole true none) src
     | q`Laurel.nondetHole, #[] => return mkStmtExprMd (.Hole false none) src
     | q`Laurel.varDecl, #[arg0, typeArg, assignArg] =>
@@ -252,6 +270,18 @@ partial def translateStmtExpr (arg : Arg) : TransM StmtExprMd := do
         | _ => TransM.error s!"assign target must be a variable or field access"
       let value ← translateStmtExpr arg1
       return mkStmtExprMd (.Assign [targetVar] value) src
+    | q`Laurel.preIncr, #[arg0] =>
+      let target ← translateIncrDecrTarget arg0 "preIncr"
+      return mkStmtExprMd (.IncrDecr .Pre .Incr target) src
+    | q`Laurel.preDecr, #[arg0] =>
+      let target ← translateIncrDecrTarget arg0 "preDecr"
+      return mkStmtExprMd (.IncrDecr .Pre .Decr target) src
+    | q`Laurel.postIncr, #[arg0] =>
+      let target ← translateIncrDecrTarget arg0 "postIncr"
+      return mkStmtExprMd (.IncrDecr .Post .Incr target) src
+    | q`Laurel.postDecr, #[arg0] =>
+      let target ← translateIncrDecrTarget arg0 "postDecr"
+      return mkStmtExprMd (.IncrDecr .Post .Decr target) src
     | q`Laurel.multiAssign, #[targetsSeq, valueArg] =>
       let targets ← match targetsSeq with
         | .seq _ .comma args => args.toList.mapM fun targ => do
@@ -287,16 +317,25 @@ partial def translateStmtExpr (arg : Arg) : TransM StmtExprMd := do
       return mkStmtExprMd (.AsType target (mkHighTypeMd (.UserDefined typeName) src)) src
     | q`Laurel.call, #[arg0, argsSeq] =>
       let callee ← translateStmtExpr arg0
-      let calleeName := match callee.val with
-        | .Var (.Local name) => name
-        | _ => ""
       let argsList ← match argsSeq with
         | .seq _ .comma args => args.toList.mapM translateStmtExpr
         | _ => pure []
-      return mkStmtExprMd (.StaticCall calleeName argsList) src
+      -- `obj#method(args)` parses as `call(fieldAccess(obj, method), args)`.
+      -- Treat such calls as instance-method calls; everything else stays a
+      -- static call by callee text (empty when the callee is a higher-order
+      -- expression — preserved to match prior behavior).
+      match callee.val with
+      | .Var (.Field target fieldName) =>
+        return mkStmtExprMd (.InstanceCall target fieldName argsList) src
+      | .Var (.Local name) =>
+        return mkStmtExprMd (.StaticCall name argsList) src
+      | _ =>
+        return mkStmtExprMd (.StaticCall (mkId "") argsList) src
     | q`Laurel.return, #[arg0] =>
-      let value ← translateStmtExpr arg0
-      return mkStmtExprMd (.Return (some value)) src
+      let value ← match arg0 with
+        | .option _ (some valArg) => some <$> translateStmtExpr valArg
+        | _ => pure none
+      return mkStmtExprMd (.Return value) src
     | q`Laurel.ifThenElse, #[arg0, arg1, elseArg] =>
       let cond ← translateStmtExpr arg0
       let thenBranch ← translateStmtExpr arg1
@@ -313,30 +352,28 @@ partial def translateStmtExpr (arg : Arg) : TransM StmtExprMd := do
       return mkStmtExprMd (.Var (.Field obj field)) fieldSrc
     | q`Laurel.while, #[condArg, invSeqArg, bodyArg] =>
       let cond ← translateStmtExpr condArg
-      let invariants ← match invSeqArg with
-        | .seq _ _ clauses => clauses.toList.mapM fun arg => match arg with
-            | .op invOp => match invOp.name, invOp.args with
-              | q`Laurel.invariantClause, #[exprArg] => translateStmtExpr exprArg
-              | _, _ => TransM.error "Expected invariantClause"
-            | _ => TransM.error "Expected operation"
-        | _ => pure []
+      let invariants ← translateInvariantClauses translateStmtExpr invSeqArg
       let body ← translateStmtExpr bodyArg
       return mkStmtExprMd (.While cond invariants none body) src
     | q`Laurel.forLoop, #[initArg, condArg, stepArg, invSeqArg, bodyArg] =>
       let init ← translateStmtExpr initArg
       let cond ← translateStmtExpr condArg
       let step ← translateStmtExpr stepArg
-      let invariants ← match invSeqArg with
-        | .seq _ _ clauses => clauses.toList.mapM fun arg => match arg with
-            | .op invOp => match invOp.name, invOp.args with
-              | q`Laurel.invariantClause, #[exprArg] => translateStmtExpr exprArg
-              | _, _ => TransM.error "Expected invariantClause"
-            | _ => TransM.error "Expected operation"
-        | _ => pure []
+      let invariants ← translateInvariantClauses translateStmtExpr invSeqArg
       let body ← translateStmtExpr bodyArg
       let whileBody := mkStmtExprMd (.Block [body, step] none) src
       let whileStmt := mkStmtExprMd (.While cond invariants none whileBody) src
       return mkStmtExprMd (.Block [init, whileStmt] none) src
+    | q`Laurel.doWhile, #[bodyArg, condArg, invSeqArg] =>
+      -- A `do … while` is a post-test `While`. The `EliminateDoWhile` pass
+      -- lowers `postTest := true` to the pre-test form later.
+      let body ← translateStmtExpr bodyArg
+      let cond ← translateStmtExpr condArg
+      let invariants ← translateInvariantClauses translateStmtExpr invSeqArg
+      return mkStmtExprMd (.While cond invariants none body (postTest := true)) src
+    | q`Laurel.old, #[arg0] =>
+      let inner ← translateStmtExpr arg0
+      return mkStmtExprMd (.Old inner) src
     | q`Laurel.forallExpr, #[nameArg, tyArg, triggerArg, bodyArg] =>
       let name ← translateIdent nameArg
       let ty ← translateHighType tyArg
@@ -385,6 +422,19 @@ partial def translateSeqCommand (arg : Arg) : TransM (List StmtExprMd) := do
 partial def translateCommand (arg : Arg) : TransM StmtExprMd := do
   translateStmtExpr arg
 
+/--
+Translate the target of an increment/decrement operator. The target must be an
+lvalue: either a local variable reference (`Var (.Local _)`) or a field access
+(`Var (.Field _ _)`). Anything else is reported as a translation error.
+-/
+partial def translateIncrDecrTarget (arg : Arg) (opName : String) : TransM VariableMd := do
+  let inner ← translateStmtExpr arg
+  match inner.val with
+  | .Var v@(.Local _) => pure ⟨v, inner.source⟩
+  | .Var v@(.Field _ _) => pure ⟨v, inner.source⟩
+  | _ =>
+    TransM.error s!"{opName} target must be a local variable or field access"
+
 end
 
 def translateModifiesExprs (arg : Arg) : TransM (List StmtExprMd) := do
@@ -518,6 +568,11 @@ def parseProcedure (arg : Arg) : TransM Procedure := do
         | _, _ => TransM.error s!"Expected body or externalBody operation, got {repr bodyOp.name}"
       | .option _ none => pure none
       | _ => TransM.error s!"Expected body, got {repr bodyArg}"
+    -- For functions, wrap the body in a Return so the last expression
+    -- is treated as the return value by downstream passes.
+    let body := if op.name == q`Laurel.function then
+      body.map fun b => ⟨.Return (some b), b.source⟩
+    else body
     -- Determine procedure body kind
     let procBody :=
       if isExternal then Body.External
diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean
index c1d24aa7ee..dc54d7617a 100644
--- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean
+++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.lean
@@ -3,13 +3,12 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
--- Grammar updated: renamed Optional* categories (op names updated)
-module
 
+module
 -- Laurel dialect definition, loaded from LaurelGrammar.st
 -- NOTE: Changes to LaurelGrammar.st are not automatically tracked by the build system.
 -- Update this file (e.g. this comment) to trigger a recompile after modifying LaurelGrammar.st.
--- Last grammar change: block format uses indent(2) with leading spaces for vertical layout.
+-- Last grammar change: fieldAccess prec raised 90 -> 95 (paren-free `c#n++`); shares prec(95) with `call`.
 public import StrataDDM.AST
 import StrataDDM.BuiltinDialects.Init
 import StrataDDM.Integration.Lean.HashCommands
diff --git a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st
index 5ddc8609f5..53f0c33f99 100644
--- a/Strata/Languages/Laurel/Grammar/LaurelGrammar.st
+++ b/Strata/Languages/Laurel/Grammar/LaurelGrammar.st
@@ -20,6 +20,7 @@ op literalBool (b: Bool): StmtExpr => b;
 op int(n : Num) : StmtExpr => n;
 op real(d : Decimal) : StmtExpr => d;
 op string (s: Str): StmtExpr => s;
+op bvLiteral(value: Num, width: Num): StmtExpr => value "bv" width;
 op hole: StmtExpr => "<?>";
 op nondetHole: StmtExpr => "<??>";
 
@@ -33,13 +34,16 @@ op initializer(value: StmtExpr): Initializer => " := " value:0;
 op varDecl (name: Ident, varType: Option TypeAnnotation, assignment: Option Initializer): StmtExpr
   => @[prec(0)] "var " name varType assignment;
 
-op call(callee: StmtExpr, args: CommaSepBy StmtExpr): StmtExpr => callee "(" args ")";
+op call(callee: StmtExpr, args: CommaSepBy StmtExpr): StmtExpr =>
+  @[prec(95)] callee:89 "(" args ")";
 
 // Instantiation
 op new(name: Ident): StmtExpr => "new " name;
 
-// Field access
-op fieldAccess (obj: StmtExpr, field: Ident): StmtExpr => @[prec(90)] obj "#" field;
+// Field access. prec coupled to `call` (also 95, via its `callee:89`): keep them
+// equal or `a#b(x)` parsing shifts. prec 95 > postfix `++`/`--` (90) is what lets
+// `c#n++` parse paren-free as `(c#n)++`.
+op fieldAccess (obj: StmtExpr, field: Ident): StmtExpr => @[prec(95), leftassoc] obj "#" field;
 
 // Identifiers/Variables - must come after fieldAccess so c.value parses as fieldAccess not identifier
 op identifier (name: Ident): StmtExpr => name;
@@ -77,12 +81,25 @@ op or (lhs: StmtExpr, rhs: StmtExpr): StmtExpr => @[prec(20), leftassoc] lhs " |
 op andThen (lhs: StmtExpr, rhs: StmtExpr): StmtExpr => @[prec(30), leftassoc] lhs " && " rhs;
 op orElse (lhs: StmtExpr, rhs: StmtExpr): StmtExpr => @[prec(20), leftassoc] lhs " || " rhs;
 op implies (lhs: StmtExpr, rhs: StmtExpr): StmtExpr => @[prec(15), rightassoc] lhs " ==> " rhs;
-op strConcat (lhs: StmtExpr, rhs: StmtExpr): StmtExpr => @[prec(60), leftassoc] lhs " ++ " rhs;
+// String concatenation. Uses `^` (OCaml-style) so that `++` is reserved for the
+// Java-style increment operator below.
+op strConcat (lhs: StmtExpr, rhs: StmtExpr): StmtExpr => @[prec(60), leftassoc] lhs " ^ " rhs;
 
 // Unary operators
 op not (inner: StmtExpr): StmtExpr => @[prec(80)] "!" inner;
 op neg (inner: StmtExpr): StmtExpr => @[prec(80)] "-" inner;
 
+// Refer to the pre-state value of an expression (for use in postconditions, modifies clauses).
+op old (inner: StmtExpr): StmtExpr => "old(" inner ")";
+
+// Java-style increment / decrement.
+// Prefix forms (leading parsers): yield the new value.
+op preIncr (target: StmtExpr): StmtExpr => @[prec(80)] "++" target;
+op preDecr (target: StmtExpr): StmtExpr => @[prec(80)] "--" target;
+// Postfix forms (trailing parsers): yield the old value.
+op postIncr (target: StmtExpr): StmtExpr => @[prec(90)] target "++";
+op postDecr (target: StmtExpr): StmtExpr => @[prec(90)] target "--";
+
 // Quantifiers
 category Trigger;
 op trigger(trigger: StmtExpr): Trigger => "{" trigger "}";
@@ -98,14 +115,14 @@ op errorSummary(msg: Str): ErrorSummary => " summary " msg;
 
 // If-else
 category ElseBranch;
-op elseBranch(stmts : StmtExpr) : ElseBranch => @[prec(0)] " else " stmts;
+op elseBranch(stmts : StmtExpr) : ElseBranch => @[prec(0)] "\nelse " stmts;
 
 op ifThenElse (cond: StmtExpr, thenBranch: StmtExpr, elseBranch: Option ElseBranch): StmtExpr =>
-  @[prec(20)] "if " cond " then " thenBranch:0 elseBranch:0;
+  @[prec(20)] "if " cond "\nthen " thenBranch:0 elseBranch:0;
 
 op assert (cond : StmtExpr, errorMessage: Option ErrorSummary) : StmtExpr => @[prec(0)] "assert " cond:0 errorMessage:0;
 op assume (cond : StmtExpr) : StmtExpr => @[prec(0)] "assume " cond:0;
-op return (value : StmtExpr) : StmtExpr => @[prec(0)] "return " value:0;
+op return (value : Option StmtExpr) : StmtExpr => @[prec(0)] "return " value:0;
 op block (stmts : SemicolonSepBy StmtExpr) : StmtExpr => @[prec(1000)] "{\n  " indent(2, stmts) "\n}";
 op labelledBlock (stmts : SemicolonSepBy StmtExpr, label : Ident) : StmtExpr => @[prec(1000)] "{\n  " indent(2, stmts) "\n}" label;
 op exit (label : Ident) : StmtExpr => @[prec(0)] "exit " label;
@@ -120,6 +137,9 @@ op while (cond: StmtExpr, invariants: Seq InvariantClause, body: StmtExpr): Stmt
 op forLoop (init: StmtExpr, cond: StmtExpr, step: StmtExpr, invariants: Seq InvariantClause, body: StmtExpr): StmtExpr
   => "for" "(" init ";" cond ";" step ")" invariants " " body:0;
 
+op doWhile (body: StmtExpr, cond: StmtExpr, invariants: Seq InvariantClause): StmtExpr
+  => "do " body:0 " while" "(" cond ")" invariants;
+
 category Parameter;
 op parameter (name: Ident, paramType: LaurelType): Parameter => name ": " paramType;
 
diff --git a/Strata/Languages/Laurel/HeapParameterization.lean b/Strata/Languages/Laurel/HeapParameterization.lean
index 3af4f1f68a..4fb4ff74a4 100644
--- a/Strata/Languages/Laurel/HeapParameterization.lean
+++ b/Strata/Languages/Laurel/HeapParameterization.lean
@@ -6,11 +6,14 @@
 module
 
 public import Strata.Languages.Laurel.Resolution
+public import Strata.Languages.Laurel.LaurelPass
 import Std.Tactic.BVDecide.Normalize.Prop
 import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
 import Strata.Languages.Laurel.HeapParameterizationConstants
 import Strata.Languages.Laurel.LaurelTypes
 import Strata.Util.Tactics
+import Strata.Languages.Laurel.LiftImperativeExpressions
+import Strata.Languages.Laurel.EliminateValueInReturns
 
 /-
 Heap Parameterization Pass
@@ -21,12 +24,12 @@ and a `nextReference: int` for allocating new objects. Box is a sum type with co
 primitive type (BoxInt, BoxBool, BoxFloat64, BoxComposite). Composite is a type synonym for int.
 
 1. Procedures that write the heap get an inout heap parameter
-   - Input: `heap : THeap`
-   - Output: `heap : THeap`
+   - Input: `heap : Heap`
+   - Output: `heap : Heap`
    - Field writes become: `heap := updateField(heap, obj, field, BoxT(value))`
 
 2. Procedures that only read the heap get an in heap parameter
-   - Input: `heap : THeap`
+   - Input: `heap : Heap`
    - Field reads become: `Box..tVal(readField(heap, obj, field))`
 
 3. Procedure calls are transformed:
@@ -64,7 +67,7 @@ def collectExpr (expr : StmtExpr) : StateM AnalysisResult Unit := do
   | .StaticCall callee args => modify fun s => { s with callees := callee :: s.callees }; for a in args do collectExprMd a
   | .IfThenElse c t e => collectExprMd c; collectExprMd t; if let some x := e then collectExprMd x
   | .Block stmts _ => for s in stmts do collectExprMd s
-  | .While c invs d b => collectExprMd c; collectExprMd b; for inv in invs do collectExprMd inv; if let some x := d then collectExprMd x
+  | .While c invs d b _ => collectExprMd c; collectExprMd b; for inv in invs do collectExprMd inv; if let some x := d then collectExprMd x
   | .Return v => if let some x := v then collectExprMd x
   | .Assign assignTargets v =>
       -- Check if any target is a field assignment (heap write)
@@ -172,7 +175,12 @@ private def isDatatype (model : SemanticModel) (name : Identifier) : Bool :=
 
 /-- Get the Box destructor name for a given Laurel HighType.
     For UserDefined datatypes, uses "Box..<datatypeName>Val!";
-    for Composite types, uses "Box..compositeVal!". -/
+    for Composite types, uses "Box..compositeVal!".
+
+    Constrained types do not need resolving here: `ConstrainedTypeElim` runs
+    before this pass and has already lowered every constrained type to its base
+    type (and removed the constrained type definitions), so `ty` is never a
+    constrained-type reference. -/
 def boxDestructorName (model : SemanticModel) (ty : HighType) : Identifier :=
   match ty with
   | .TInt => "Box..intVal!"
@@ -183,6 +191,7 @@ def boxDestructorName (model : SemanticModel) (ty : HighType) : Identifier :=
   | .UserDefined name =>
       if isDatatype model name then s!"Box..{name.text}Val!"
       else "Box..compositeVal!"
+  | .TBv n => s!"Box..bv{n}Val!"
   | .TCore name => s!"Box..{name}Val!"
   | _ => dbg_trace f!"BUG, boxDestructorName bad type {ty}"; "boxDestructorNameError"
 
@@ -199,6 +208,7 @@ def boxConstructorName (model : SemanticModel) (ty : HighType) : Identifier :=
   | .UserDefined name =>
       if isDatatype model name then s!"Box..{name.text}"
       else "BoxComposite"
+  | .TBv n => s!"BoxBv{n}"
   | .TCore name => s!"Box..{name}"
   | ty => dbg_trace s!"BUG, boxConstructorName bad type: {repr ty}"; "boxConstructorNameError"
 
@@ -215,6 +225,8 @@ private def boxConstructorDef (model : SemanticModel) (ty : HighType) : Option D
         some { name := s!"Box..{name.text}", args := [{ name := s!"{name.text}Val", type := ⟨.UserDefined name, none⟩ }] }
       else
         some { name := "BoxComposite", args := [{ name := "compositeVal", type := ⟨.UserDefined "Composite", none⟩ }] }
+  | .TBv n =>
+        some { name := s!"BoxBv{n}", args := [{ name := s!"bv{n}Val", type := ⟨.TBv n, none⟩ }] }
   | .TCore name =>
         some { name := s!"Box..{name}", args := [{ name := s!"{name}Val", type := ⟨.TCore name, none⟩ }] }
   | ty => dbg_trace s!"BUG, boxConstructorDef bad type: {repr ty}"; none
@@ -235,7 +247,7 @@ def readsHeap (name : Identifier) : TransformM Bool := do
 def writesHeap (name : Identifier) : TransformM Bool := do
   return (← get).heapWriters.contains name
 
-def freshVarName : TransformM Identifier := do
+private def freshVarName : TransformM Identifier := do
   let s ← get
   set { s with freshCounter := s.freshCounter + 1 }
   return s!"$tmp{s.freshCounter}"
@@ -278,7 +290,8 @@ where
           | return [⟨ .Hole, source ⟩]
 
         let valTy := (model.get fieldName).getType
-        let readExpr := ⟨ .StaticCall "readField" [mkMd (.Var (.Local heapVar)), selectTarget, mkMd (.StaticCall qualifiedName [])], source ⟩
+        let selectTarget' ← recurseOne selectTarget
+        let readExpr := ⟨ .StaticCall "readField" [mkMd (.Var (.Local heapVar)), selectTarget', mkMd (.StaticCall qualifiedName [])], source ⟩
         -- Unwrap Box: apply the appropriate destructor
         recordBoxConstructor model valTy.val
         return [mkMd <| .StaticCall (boxDestructorName model valTy.val) [readExpr]]
@@ -327,9 +340,9 @@ where
           termination_by (sizeOf remaining, 0)
         let stmts' ← processStmts 0 stmts
         return [⟨ .Block stmts' label, source ⟩]
-    | .While c invs d b =>
+    | .While c invs d b postTest =>
         let invs' ← invs.mapM (recurseOne ·)
-        return [⟨ .While (← recurseOne c) invs' d (← recurseOne b false), source ⟩]
+        return [⟨ .While (← recurseOne c) invs' d (← recurseOne b false) postTest, source ⟩]
     | .Return v =>
         let v' ← match v with | some x => some <$> recurseOne x | none => pure none
         return [⟨ .Return v', source ⟩]
@@ -401,20 +414,24 @@ where
     | .PureFieldUpdate t f v => return [⟨ .PureFieldUpdate (← recurseOne t) f (← recurseOne v), source ⟩]
     | .PrimitiveOp op args _ =>
       let args' ← args.mapM (recurseOne ·)
-      -- For == and != on Composite types, compare refs instead
+      -- For == and != on Composite types, compare refs instead. Note
+      -- `.UserDefined` covers BOTH composites (heap references — `ref!` is
+      -- correct) and datatypes (values — `ref!` is wrong and would unify a
+      -- datatype value against `Composite`). Only ref-compare composites;
+      -- datatype equality falls through to structural comparison.
       match op, args with
       | .Eq, [e1, _e2] =>
-        let ty := (computeExprType model e1).val
-        match ty with
-        | .UserDefined _ =>
+        match (computeExprType model e1).val with
+        | .UserDefined name =>
+          if isDatatype model name then return [⟨ .PrimitiveOp op args', source ⟩]
           let ref1 := mkMd (.StaticCall "Composite..ref!" [args'[0]!])
           let ref2 := mkMd (.StaticCall "Composite..ref!" [args'[1]!])
           return [⟨ .PrimitiveOp .Eq [ref1, ref2], source ⟩]
         | _ => return [⟨ .PrimitiveOp op args', source ⟩]
       | .Neq, [e1, _e2] =>
-        let ty := (computeExprType model e1).val
-        match ty with
-        | .UserDefined _ =>
+        match (computeExprType model e1).val with
+        | .UserDefined name =>
+          if isDatatype model name then return [⟨ .PrimitiveOp op args', source ⟩]
           let ref1 := mkMd (.StaticCall "Composite..ref!" [args'[0]!])
           let ref2 := mkMd (.StaticCall "Composite..ref!" [args'[1]!])
           return [⟨ .PrimitiveOp .Neq [ref1, ref2], source ⟩]
@@ -460,37 +477,31 @@ where
 
 def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : TransformM Procedure := do
   let heapName := heapVarName
-  let heapInName := heapInVarName
   let readsHeap := (← get).heapReaders.contains proc.name
   let writesHeap := (← get).heapWriters.contains proc.name
 
   if writesHeap then
-    -- This procedure writes the heap - add $heap_in as input and $heap as output
-    -- At the start, assign $heap_in to $heap, then use $heap throughout
-    let heapInParam : Parameter := { name := heapInName, type := ⟨.THeap, none⟩ }
-    let heapOutParam : Parameter := { name := heapName, type := ⟨.THeap, none⟩ }
+    -- This procedure writes the heap — $heap appears in both inputs and outputs
+    -- (true inout). Core's two-state semantics provide `old $heap` automatically.
+    let heapParam : Parameter := { name := heapName, type := ⟨.UserDefined "Heap", proc.name.source⟩ }
 
-    let inputs' := heapInParam :: proc.inputs
-    let outputs' := heapOutParam :: proc.outputs
+    let inputs' := heapParam :: proc.inputs
+    let outputs' := heapParam :: proc.outputs
 
-    -- Preconditions use $heap_in (the input state)
-    let preconditions' ← proc.preconditions.mapM (·.mapM (heapTransformExpr heapInName model))
+    -- Preconditions reference $heap (evaluated at entry before any mutation)
+    let preconditions' ← proc.preconditions.mapM (·.mapM (heapTransformExpr heapName model))
 
     let bodyValueIsUsed := !proc.outputs.isEmpty
     let body' ← match proc.body with
       | .Transparent bodyExpr =>
-          -- First assign $heap_in to $heap, then transform body using $heap
-          let assignHeap := mkMd (.Assign [mkVarMd (.Local heapName)] (mkMd (.Var (.Local heapInName))))
           let bodyExpr' ← heapTransformExpr heapName model bodyExpr bodyValueIsUsed
-          pure (.Transparent (mkMd (.Block [assignHeap, bodyExpr'] none)))
+          pure (.Transparent bodyExpr')
       | .Opaque postconds impl modif =>
-          -- Postconditions use $heap (the output state)
           let postconds' ← postconds.mapM (·.mapM (heapTransformExpr heapName model))
           let impl' ← match impl with
             | some implExpr =>
-                let assignHeap := mkMd (.Assign [mkVarMd (.Local heapName)] (mkMd (.Var (.Local heapInName))))
                 let implExpr' ← heapTransformExpr heapName model implExpr bodyValueIsUsed
-                pure (some (mkMd (.Block [assignHeap, implExpr'] none)))
+                pure (some implExpr')
             | none => pure none
           let modif' ← modif.mapM (heapTransformExpr heapName model ·)
           pure (.Opaque postconds' impl' modif')
@@ -506,8 +517,10 @@ def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : Transform
       body := body' }
 
   else if readsHeap then
-    -- This procedure only reads the heap - add $heap as input only
-    let heapParam : Parameter := { name := heapName, type := ⟨.THeap, none⟩ }
+    -- This procedure only reads the heap - add $heap as input only.
+    -- Use the prelude `Heap` datatype for the parameter type (see the
+    -- writes-heap branch above for rationale).
+    let heapParam : Parameter := { name := heapName, type := ⟨.UserDefined "Heap", proc.name.source⟩ }
     let inputs' := heapParam :: proc.inputs
 
     let preconditions' ← proc.preconditions.mapM (·.mapM (heapTransformExpr heapName model))
@@ -536,16 +549,10 @@ def heapTransformProcedure (model: SemanticModel) (proc : Procedure) : Transform
     return proc
 
 def heapParameterization (model: SemanticModel) (program : Program) : Program :=
-  let program := { program with
-    types := program.types
-    staticProcedures := program.staticProcedures }
-  let instanceProcs := program.types.foldl (fun acc td =>
-    match td with
-    | .Composite ct => acc ++ ct.instanceProcedures
-    | _ => acc) ([] : List Procedure)
-  let allProcs := program.staticProcedures ++ instanceProcs
-  let heapReaders := computeReadsHeap allProcs
-  let heapWriters := computeWritesHeap allProcs
+  -- Instance procedures are already lifted to `staticProcedures` by an earlier
+  -- pass, so they're covered by the calls below.
+  let heapReaders := computeReadsHeap program.staticProcedures
+  let heapWriters := computeWritesHeap program.staticProcedures
   let initState : TransformState := { heapReaders, heapWriters }
   let (procs', state1) := (program.staticProcedures.mapM (heapTransformProcedure model)).run initState
   -- Collect all qualified field names and generate a Field datatype
@@ -555,21 +562,33 @@ def heapParameterization (model: SemanticModel) (program : Program) : Program :=
     | _ => acc) ([] : List Identifier)
   let fieldDatatype : TypeDefinition :=
     .Datatype { name := "Field", typeArgs := [], constructors := fieldNames.map fun n => { name := n, args := [] } }
-  -- Remove fields from composite types since they are now stored in the heap
-  -- Also transform instance procedures, accumulating used Box constructors
-  let (types', state2) := program.types.foldl (fun (accTypes, accState) td =>
+  -- Remove fields from composite types since they are now stored in the heap.
+  let types' := program.types.map fun td =>
     match td with
-    | .Composite ct =>
-      let (instProcs', s') := (ct.instanceProcedures.mapM (heapTransformProcedure model)).run accState
-      (accTypes ++ [.Composite { ct with fields := [], instanceProcedures := instProcs' }], s')
-    | other => (accTypes ++ [other], accState))
-    ([], state1)
+    | .Composite ct => .Composite { ct with fields := [] }
+    | other => other
   -- Generate Box datatype from all constructors used during transformation
   let boxDatatype : TypeDefinition :=
-    .Datatype { name := "Box", typeArgs := [], constructors := state2.usedBoxConstructors }
+    .Datatype { name := "Box", typeArgs := [], constructors := state1.usedBoxConstructors }
+
+  let types := fieldDatatype :: boxDatatype :: heapConstants.types ++
+    -- The filter is a hack to deal with another hack,
+    -- the box that was added in CoreDefinitionsForLaurel.lean
+    -- because Laurel does not support polymorphism yet
+    types'.filter (fun td => td.name.text != "Box")
   { program with
     staticProcedures := heapConstants.staticProcedures ++ procs',
-    types := fieldDatatype :: boxDatatype :: heapConstants.types ++ types' }
+    types }
+
+/-- Pipeline pass: heap parameterization. -/
+public def heapParameterizationPass : LoweringPass where
+  name := "HeapParameterization"
+  documentation := "Transforms procedures that interact with the heap by adding explicit heap parameters. The heap is modeled as `Map Composite (Map Field Box)`. Procedures that write the heap receive both an input and output heap parameter; procedures that only read the heap receive an input heap parameter. Field reads and writes are rewritten to use `readField` and `updateField` functions."
+  needsResolves := false -- Only resolve again after completing HeapParam, ModifiesClauses and TypeHierarchy. These are logically one pass.
+  run := fun p m _ =>
+    (heapParameterization m p, [], {})
+  comesAfter := [⟨ eliminateValueInReturnsPass.meta, "eliminate value in returns need to come before any passes that change the amount of output parameters of procedures." ⟩]
+  comesBefore := [⟨ liftImperativeExpressionsPass.meta, "the heap parameterization pass introduces assignments (to the heap variables) that need to be lifted."⟩]
 
 end Strata.Laurel
 
diff --git a/Strata/Languages/Laurel/HeapParameterizationConstants.lean b/Strata/Languages/Laurel/HeapParameterizationConstants.lean
index 7258f29d6a..a9c6e80206 100644
--- a/Strata/Languages/Laurel/HeapParameterizationConstants.lean
+++ b/Strata/Languages/Laurel/HeapParameterizationConstants.lean
@@ -18,9 +18,6 @@ public section
 /-- The name of the heap variable used by the heap parameterization pass. -/
 def heapVarName : Identifier := "$heap"
 
-/-- The name of the input heap parameter used by the heap parameterization pass. -/
-def heapInVarName : Identifier := "$heap_in"
-
 /--
 The Laurel Core prelude defines the heap model types and operations
 used by the Laurel-to-Core translator. These declarations are expressed
diff --git a/Strata/Languages/Laurel/InferHoleTypes.lean b/Strata/Languages/Laurel/InferHoleTypes.lean
index 0e0b499421..994627c3e1 100644
--- a/Strata/Languages/Laurel/InferHoleTypes.lean
+++ b/Strata/Languages/Laurel/InferHoleTypes.lean
@@ -6,8 +6,10 @@
 module
 
 public import Strata.Util.Statistics
+public import Strata.Languages.Laurel.LaurelPass
 public import Strata.Languages.Laurel.Resolution
 import Strata.Languages.Laurel.LaurelTypes
+import Strata.Languages.Laurel.EliminateDeterministicHoles
 
 /-!
 # Hole Type Inference
@@ -143,11 +145,11 @@ private def inferExpr (expr : StmtExprMd) (expectedType : HighTypeMd) : InferHol
           | .Declare param => param.type
         | _ => ⟨ .Unknown, source ⟩
       return ⟨.Assign targets (← inferExpr value targetType), source⟩
-  | .While cond invs dec body =>
+  | .While cond invs dec body postTest =>
       let dec' ← match dec with
         | some d => pure (some (← inferExpr d (⟨ .TInt, source ⟩)))
         | none => pure none
-      return ⟨.While (← inferExpr cond ⟨ .TBool, source ⟩) (← invs.mapM (inferExpr · ⟨ .TBool, source ⟩)) dec' (← inferExpr body ⟨ .TVoid, source⟩), source⟩
+      return ⟨.While (← inferExpr cond ⟨ .TBool, source ⟩) (← invs.mapM (inferExpr · ⟨ .TBool, source ⟩)) dec' (← inferExpr body ⟨ .TVoid, source⟩) postTest, source⟩
   | .Assert ⟨condExpr, summary, free⟩ =>
       return ⟨.Assert { condition := ← inferExpr condExpr ⟨ .TBool, source ⟩, summary, free }, source⟩
   | .Assume cond =>
@@ -188,4 +190,15 @@ def inferHoleTypes (model : SemanticModel) (program : Program) : Program × List
   ({ program with staticProcedures := procs }, finalState.diagnostics, finalState.statistics)
 
 end -- public section
+
+/-- Pipeline pass: infer hole types. -/
+public def inferHoleTypesPass : LoweringPass where
+  name := "InferHoleTypes"
+  documentation := "Annotates every verification hole (`.Hole`) in the program with a type inferred from context. This type information is needed by subsequent passes that replace holes with uninterpreted functions or nondeterministic values."
+  run := fun p m _ =>
+    let (p', diags, stats) := inferHoleTypes m p
+    (p', diags, stats)
+  comesBefore := [
+      ⟨ eliminateDeterministicHolesPass.meta, "eliminating deterministic holes relies on knowing the type of holes"⟩]
+
 end Laurel
diff --git a/Strata/Languages/Laurel/LaurelAST.lean b/Strata/Languages/Laurel/LaurelAST.lean
index 1f0d9b6fb0..fb02d7cd59 100644
--- a/Strata/Languages/Laurel/LaurelAST.lean
+++ b/Strata/Languages/Laurel/LaurelAST.lean
@@ -104,6 +104,20 @@ inductive Operation : Type where
   | StrConcat
   deriving Repr
 
+instance : ToString Operation where
+  toString
+    | .Eq => "=="          | .Neq => "!="
+    | .And => "&&"         | .Or => "||"
+    | .Not => "!"          | .Implies => "==>"
+    | .AndThen => "&&!"    | .OrElse => "||!"
+    | .Neg => "-"          | .Add => "+"
+    | .Sub => "-"          | .Mul => "*"
+    | .Div => "/"          | .Mod => "%"
+    | .DivT => "/t"        | .ModT => "%t"
+    | .Lt => "<"           | .Leq => "<="
+    | .Gt => ">"           | .Geq => ">="
+    | .StrConcat => "++"
+
 /--
 A wrapper that pairs a value with source-level metadata such as source
 locations and annotations. All Laurel AST nodes are wrapped in
@@ -121,8 +135,7 @@ structure AstNode (t : Type) : Type where
 The type system for Laurel programs.
 
 `HighType` covers primitive types (`TVoid`, `TBool`, `TInt`, `TReal`, `TFloat64`,
-`TString`), internal types used by the heap parameterization pass (`THeap`,
-`TTypedField`), collection types (`TSet`), user-defined types (`UserDefined`),
+`TString`), collection types (`TSet`), user-defined types (`UserDefined`),
 generic applications (`Applied`), value types (`Pure`), and intersection types
 (`Intersection`).
 -/
@@ -139,10 +152,6 @@ inductive HighType : Type where
   | TReal
   /-- String type for text data. -/
   | TString
-  /-- Internal type representing the heap. Introduced by the heap parameterization pass; not accessible via grammar. -/
-  | THeap
-  /-- Internal type for a field constant with a known value type. Introduced by the heap parameterization pass; not accessible via grammar. -/
-  | TTypedField (valueType : AstNode HighType)
   /-- Set type, e.g. `Set int`. -/
   | TSet (elementType : AstNode HighType)
   /-- Map type. -/
@@ -177,6 +186,23 @@ inductive QuantifierMode where
   | Exists
   deriving Repr, BEq, Inhabited
 
+/-- Whether an increment/decrement operator is in prefix or postfix form.
+    Prefix form yields the new value; postfix form yields the old value. -/
+inductive IncrDecrMode where
+  /-- Prefix form: `++x` or `--x`. Yields the new value. -/
+  | Pre
+  /-- Postfix form: `x++` or `x--`. Yields the old value. -/
+  | Post
+  deriving Repr, BEq, Inhabited
+
+/-- Whether an increment/decrement operator increments by 1 or decrements by 1. -/
+inductive IncrDecrOp where
+  /-- `++` — adds 1 to the target. -/
+  | Incr
+  /-- `--` — subtracts 1 from the target. -/
+  | Decr
+  deriving Repr, BEq, Inhabited
+
 mutual
 
 /--
@@ -193,7 +219,6 @@ structure Procedure : Type where
   outputs : List Parameter
   /-- The preconditions that callers must satisfy. -/
   preconditions : List Condition
-  -- TODO: add back determinism together with an implementation
   /-- Optional termination measure for recursive procedures. -/
   decreases : Option (AstNode StmtExpr) -- optionally prove termination
   /-- If true, the body may only have functional constructs, so no destructive assignments or loops. -/
@@ -204,6 +229,9 @@ structure Procedure : Type where
       whose body is the ensures clause universally quantified over the procedure's inputs,
       with this expression as the SMT trigger. -/
   invokeOn : Option (AstNode StmtExpr) := none
+  /-- Axioms to emit alongside this procedure. Populated by the contract pass from
+      `invokeOn` and ensures clauses. -/
+  axioms : List (AstNode StmtExpr) := []
 
 /--
 A typed parameter for a procedure.
@@ -242,6 +270,8 @@ inductive Body where
       (postconditions : List Condition)
       (implementation : Option (AstNode StmtExpr))
       (modifies : List (AstNode StmtExpr))
+      -- TODO: add back non-determinism together with an implementation
+      -- deterministic : Bool
   /-- An abstract body that must be overridden in extending types. A type containing any members with abstract bodies cannot be instantiated. -/
   | Abstract (postconditions : List Condition)
   /-- An external body for procedures that are not translated to Core (e.g., built-in primitives). -/
@@ -271,10 +301,21 @@ inductive StmtExpr : Type where
   | IfThenElse (cond : AstNode StmtExpr) (thenBranch : AstNode StmtExpr) (elseBranch : Option (AstNode StmtExpr))
   /-- A sequence of statements with an optional label for `Exit`. -/
   | Block (statements : List (AstNode StmtExpr)) (label : Option String)
-  /-- A while loop with a condition, invariants, optional termination measure, and body. Only allowed in impure contexts. -/
+  /-- A while loop with a condition, invariants, optional termination measure, and body.
+      Only allowed in impure contexts.
+
+      `postTest` selects when the condition is tested relative to the body:
+      - `false` (default) — a *pre-test* loop (`while`): the condition is checked
+        before the body, so the body may run zero times.
+      - `true` — a *post-test* loop (`do … while`): the body runs once before the
+        condition is first checked, so it always runs at least once.
+
+      Invariants are checked at the loop head (before each body) in both cases.
+      A post-test loop is lowered to the pre-test form by the `EliminateDoWhile` pass. -/
   | While (cond : AstNode StmtExpr) (invariants : List (AstNode StmtExpr))
     (decreases : Option (AstNode StmtExpr))
     (body : AstNode StmtExpr)
+    (postTest : Bool := false)
   /-- Exit a labelled block. Models `break` and `continue` statements. -/
   | Exit (target : String)
   /-- Return from the enclosing procedure with an optional value. -/
@@ -287,12 +328,20 @@ inductive StmtExpr : Type where
   | LiteralString (value : String)
   /-- A decimal literal. -/
   | LiteralDecimal (value : Decimal)
+  /-- A bitvector literal with value and width. -/
+  | LiteralBv (value : Nat) (width : Nat)
   /-- A variable reference or declaration. When `var` is `Variable.Local`, this is a reference
       that evaluates to the variable's value. When `var` is `Variable.Declare`, this is a
       declaration without an initializer (used as a standalone statement in a block). -/
   | Var (var : Variable)
   /-- Assignment to one or more targets. Multiple targets are only supported with identifier targets and a call as the RHS. -/
   | Assign (targets : List (AstNode Variable)) (value : AstNode StmtExpr)
+  /-- Java-style increment/decrement operator. The target must be a `Local` or `Field`
+      `Variable`. As an expression, prefix form yields the new value (after the update)
+      and postfix form yields the old value (before the update). As a statement the
+      yielded value is discarded.
+      Eliminated by the `EliminateIncrDecr` pass before lifting imperative expressions. -/
+  | IncrDecr (mode : IncrDecrMode) (op : IncrDecrOp) (target : AstNode Variable)
   /-- Update a field on a pure (value) type, producing a new value. -/
   | PureFieldUpdate (target : AstNode StmtExpr) (fieldName : Identifier) (newValue : AstNode StmtExpr)
   /-- Call a static procedure by name with the given arguments. -/
@@ -334,22 +383,79 @@ inductive StmtExpr : Type where
   | Abstract
   /-- Refers to all objects in the heap. Used in reads or modifies clauses. -/
   | All
-  /-- A hole representing an unknown expression.
+  /-- A hole represents an unknown expression.
+      This can be used to represent programs that are still under development, for example the program `3 + `
+      The defining property of a hole is that interaction with it and other code should not produce any errors.
+      Besides representing partial user programs,
+      holes can also be used to handle under development parts of compilers that target Laurel.
       - `deterministic`: if true, the hole represents a deterministic unknown
         (translated as an uninterpreted function); if false, a nondeterministic
         unknown (translated as a havoced variable). Nondeterministic holes are
         not allowed in functions.
-      - `type`: inferred by the hole type inference pass; `none` means not yet inferred. -/
+      - `type`: this property is used internally by Laurel and can be left to its default value.
+        Internal usage: inferred by the hole type inference pass; `none` means not yet inferred. -/
   | Hole (deterministic : Bool := true) (type : Option (AstNode HighType) := none)
 
 inductive ContractType where
   | Reads | Modifies | Precondition | PostCondition
 end
 
+/-- A short user-facing name for the construct, used in diagnostic messages. -/
+def StmtExpr.constrName : StmtExpr → String
+  | .IfThenElse ..       => "if"
+  | .Block ..            => "block"
+  | .While ..            => "while"
+  | .Exit ..             => "exit"
+  | .Return ..           => "return"
+  | .LiteralInt ..       => "integer literal"
+  | .LiteralBool ..      => "boolean literal"
+  | .LiteralString ..    => "string literal"
+  | .LiteralDecimal ..   => "decimal literal"
+  | .LiteralBv ..        => "bitvector literal"
+  | .Var ..              => "variable"
+  | .Assign ..           => ":="
+  | .IncrDecr _ .Incr .. => "++"
+  | .IncrDecr _ .Decr .. => "--"
+  | .PureFieldUpdate ..  => "field update"
+  | .StaticCall ..       => "call"
+  | .PrimitiveOp op ..   => toString op
+  | .New ..              => "new"
+  | .This                => "this"
+  | .ReferenceEquals ..  => "reference equality"
+  | .AsType ..           => "as"
+  | .IsType ..           => "is"
+  | .InstanceCall ..     => "method call"
+  | .Quantifier ..       => "quantifier"
+  | .Assigned ..         => "assigned"
+  | .Old ..              => "old"
+  | .Fresh ..            => "fresh"
+  | .Assert ..           => "assert"
+  | .Assume ..           => "assume"
+  | .ProveBy ..          => "by"
+  | .ContractOf ..       => "contractOf"
+  | .Abstract            => "abstract"
+  | .All                 => "all"
+  | .Hole ..             => "hole"
+
 @[expose] abbrev HighTypeMd := AstNode HighType
 @[expose] abbrev StmtExprMd := AstNode StmtExpr
 @[expose] abbrev VariableMd := AstNode Variable
 
+/-- The label of the implicit block that wraps every procedure body.
+
+    `LaurelToCoreTranslator` lowers each procedure body to a single
+    `Core.Statement.block bodyLabel …`, and lowers an early `return`
+    (or, in the Python frontend, a Python `return`) to `Exit bodyLabel`,
+    so that jumping to the end of the body falls through past the block.
+    The resolution pass pre-registers this label in scope (via `withLabel`)
+    before walking a body, so those `Exit bodyLabel` jumps resolve even
+    though the label has no syntactic declaration site.
+
+    Shared here so the translator, the resolver, and frontends agree on the
+    exact string rather than each hard-coding it. The leading `$` keeps it
+    out of the user-name space (no source identifier can contain `$`). -/
+def bodyLabel : String := "$body"
+
 theorem AstNode.sizeOf_val_lt {t : Type} [SizeOf t] (e : AstNode t) : sizeOf e.val < sizeOf e := by
   cases e; grind
 
@@ -380,6 +486,7 @@ theorem Variable.sizeOf_field_target_lt_of_eq {v : AstNode Variable}
   omega
 
 /-- Apply a monadic transformation to the condition expression, preserving the summary. -/
+@[expose]
 def Condition.mapM [Monad m] (f : AstNode StmtExpr → m (AstNode StmtExpr)) (c : Condition) : m Condition :=
   return { c with condition := ← f c.condition }
 
@@ -387,11 +494,15 @@ def Condition.mapM [Monad m] (f : AstNode StmtExpr → m (AstNode StmtExpr)) (c
 def Condition.mapCondition (f : AstNode StmtExpr → AstNode StmtExpr) (c : Condition) : Condition :=
   { c with condition := f c.condition }
 
+/-- Build a provenance from an optional source location. -/
+def fileRangeToProvenance (source : Option FileRange) : Provenance :=
+  match source with
+  | some fr => Provenance.ofSourceRange fr.file fr.range
+  | none => .synthesized .laurel
+
 /-- Build Core metadata from an optional source location. -/
 def fileRangeToCoreMd (source : Option FileRange) : Imperative.MetaData Core.Expression :=
-  match source with
-  | some fr => Imperative.MetaData.ofSourceRange fr.file fr.range
-  | none => Imperative.MetaData.ofProvenance (.synthesized .laurel)
+  Imperative.MetaData.ofProvenance (fileRangeToProvenance source)
 
 /-- Build Core metadata from an AstNode's source location. -/
 def astNodeToCoreMd (node : AstNode α) : Imperative.MetaData Core.Expression :=
@@ -426,12 +537,11 @@ def highEq (a : HighTypeMd) (b : HighTypeMd) : Bool := match _a: a.val, _b: b.va
   | HighType.TFloat64, HighType.TFloat64 => true
   | HighType.TReal, HighType.TReal => true
   | HighType.TString, HighType.TString => true
-  | HighType.THeap, HighType.THeap => true
   | HighType.TBv n1, HighType.TBv n2 => n1 == n2
-  | HighType.TTypedField t1, HighType.TTypedField t2 => highEq t1 t2
   | HighType.TSet t1, HighType.TSet t2 => highEq t1 t2
   | HighType.TMap k1 v1, HighType.TMap k2 v2 => highEq k1 k2 && highEq v1 v2
   | HighType.UserDefined r1, HighType.UserDefined r2 => r1.text == r2.text
+  | HighType.TCore s1, HighType.TCore s2 => s1 == s2
   | HighType.Applied b1 args1, HighType.Applied b2 args2 =>
       highEq b1 b2 && args1.length == args2.length && (args1.attach.zip args2 |>.all (fun (a1, a2) => highEq a1.1 a2))
   | HighType.Pure b1, HighType.Pure b2 => highEq b1 b2
@@ -453,6 +563,158 @@ instance : BEq HighTypeMd where
 
 deriving instance BEq for HighType
 
+/-- Lookup tables threaded through subtyping/consistency checks. Built from
+    the program's `TypeDefinition`s by the resolution pass:
+    - `unfoldMap` maps an alias or constrained type's name to the type it
+      unwraps to (alias target / constrained base). Followed transitively to
+      reach a non-alias, non-constrained type.
+    - `extendingMap` maps a composite type's name to the *direct* parents in
+      its `extending` list. Walked transitively for the subtype check.
+
+    Keyed by type-name *text* (`String`), not `Identifier`: this is consistent
+    with how `highEq` decides `UserDefined` equality (by `.text`), and is forced
+    because the lattice is built from the *unresolved* program in
+    `TypeLattice.ofTypes`, before the resolution pass assigns `uniqueId`s.
+    Consequence: nominal type identity is by name text, so subtyping
+    (`ancestors` walking `extendingMap`) assumes type names are globally unique.
+    Safe today (no module system); revisit when modules / namespacing / imports
+    land, since two distinct same-named types would otherwise share an
+    inheritance chain. -/
+structure TypeLattice where
+  unfoldMap : Std.HashMap String HighTypeMd := {}
+  extendingMap : Std.HashMap String (List String) := {}
+  deriving Inhabited
+
+/-- Unfold aliases and constrained types to their underlying type.
+    Composites and primitives are returned unchanged. A `visited` set guards
+    against cycles in the alias/constrained graph (already cycle-checked
+    elsewhere, but keeps `unfold` safe to call independently). -/
+partial def TypeLattice.unfold (ctx : TypeLattice) (ty : HighTypeMd)
+    (visited : Std.HashSet String := {}) : HighTypeMd :=
+  match ty.val with
+  | .UserDefined name =>
+    if visited.contains name.text then ty
+    else match ctx.unfoldMap.get? name.text with
+      | some target => ctx.unfold target (visited.insert name.text)
+      | none => ty
+  | _ => ty
+
+/-- All ancestors of a composite type (including itself), reachable via
+    repeated `extending` lookups. Implemented as a visited-set BFS over the
+    `extending` graph: the accumulator `acc` doubles as the visited set, and
+    every node is `insert`ed before its parents are enqueued, so each name is
+    processed at most once. The accumulator only grows, hence cycles in the
+    (possibly malformed) graph terminate — no `fuel` parameter is needed. -/
+partial def TypeLattice.ancestors (ctx : TypeLattice) (name : String) : Std.HashSet String :=
+  let rec go (acc : Std.HashSet String) (frontier : List String) : Std.HashSet String :=
+    match frontier with
+    | [] => acc
+    | n :: rest =>
+      if acc.contains n then go acc rest
+      else
+        let acc' := acc.insert n
+        let parents := (ctx.extendingMap.get? n).getD []
+        go acc' (parents ++ rest)
+  go {} [name]
+
+/-- Pure subtyping `<:`. Walks the `extending` chain for `CompositeType`
+    (via `TypeLattice.ancestors`), unfolds `TypeAlias` to its target, and
+    unwraps `ConstrainedType` to its base (both via `TypeLattice.unfold`),
+    then falls back to structural equality via `highEq`.
+
+    Used together with `isConsistent` to form `isConsistentSubtype`, which
+    is what the bidirectional checker invokes at every check-mode boundary
+    (rule `[⇐] Sub`). -/
+def isSubtype (ctx : TypeLattice) (sub sup : HighTypeMd) : Bool :=
+  let sub' := ctx.unfold sub
+  let sup' := ctx.unfold sup
+  match sub'.val, sup'.val with
+  | .UserDefined subName, .UserDefined supName =>
+    -- After unfolding, both sides are composites (or unresolved). A composite
+    -- is a subtype of any type in its extending chain.
+    (ctx.ancestors subName.text).contains supName.text || highEq sub' sup'
+  | _, _ => highEq sub' sup'
+
+/- ### Variance policy (covers `isSubtype` and `isConsistent`)
+   All child-carrying constructors are INVARIANT by design: `isConsistent`
+   bottoms out in `highEq` (structural equality) for `TSet`, `TMap`,
+   `Applied`, `Pure`, and `Intersection`. So `TSet Unknown ~
+   TSet TInt` is FALSE — `Unknown` is a wildcard only at the TOP of a type,
+   never under a constructor. This is intentional: `TSet` / `TMap` are MUTABLE
+   collections, where covariance would be unsound; if you don't know the
+   element type, write a bare `Unknown`, not `TSet Unknown`.
+
+   `MultiValuedExpr` is the SOLE exception that recurses (element-wise
+   consistency, not equality). It is not a mutable container: it is a transient
+   tuple of independent procedure-output values matched against multi-assignment
+   targets, so per-element consistency (letting an `Unknown` output flow into
+   one slot) is correct rather than unsound.
+
+   `Pure b` is invariant today, but it is the one constructor where covariance
+   would be SOUND and desirable — it is the immutable value-view of a composite,
+   and immutability is exactly the condition that makes covariance safe.
+   TODO: Pure could be covariant once it matters (immutable value-view ⇒ covariance is sound)
+
+   `Applied` (generics) is invariant as the safe default for not-yet-designed
+   parametric types; real variance is per-constructor and deliberately deferred.
+
+   `Intersection` is NOT a variance question: `A & B` has lattice structure
+   (`A & B <: A`, `A & B <: B`, etc.) that is not modeled, and the current
+   `highEq` arm zips element-wise IN DECLARATION ORDER, so `A & B ≠ B & A` even
+   though intersection is conceptually unordered. Known limitation, to fix with
+   bespoke subtyping rules when intersections become live. -/
+/-- Consistency `~` (Siek–Taha): the symmetric gradual relation. `Unknown`
+    is the dynamic type and is consistent with everything; otherwise
+    structural equality after unfolding aliases / constrained types.
+
+    `TCore _` is also treated as gradual — consistent with everything —
+    pending its removal from the type representation.
+    `MultiValuedExpr` is checked element-wise so the same equivalence
+    propagates through procedure-output tuples.
+
+    Used directly by `[⇒] Op-Eq`, where the operand types must be mutually
+    consistent (no subtype direction is privileged), and as one half of
+    `isConsistentSubtype`. -/
+def isConsistent (ctx : TypeLattice) (a b : HighTypeMd) : Bool :=
+  -- `MultiValuedExpr` is checked element-wise *before* unfolding so elements
+  -- remain demonstrable subterms of `a`/`b`. `unfold` is `partial`, and is in
+  -- any case the identity on `MultiValuedExpr`, so this loses no precision.
+  match _a: a.val, _b: b.val with
+  | .MultiValuedExpr ts1, .MultiValuedExpr ts2 =>
+    ts1.length == ts2.length &&
+      (ts1.attach.zip ts2).all (fun (t1, t2) => isConsistent ctx t1.1 t2)
+  | _, _ =>
+    let a' := ctx.unfold a
+    let b' := ctx.unfold b
+    match a'.val, b'.val with
+    | .Unknown, _ | _, .Unknown => true
+    | .TCore _, _ | _, .TCore _ => true
+    | _, _ => highEq a' b'
+  termination_by (SizeOf.sizeOf a)
+  decreasing_by
+    all_goals (cases a; cases b; try term_by_mem)
+    cases t1; term_by_mem
+
+/-- Consistent subtyping: `∃ R. sub ~ R ∧ R <: sup`. For our flat lattice
+    this collapses to `sub ~ sup ∨ sub <: sup` — the standard collapse.
+
+    Used by rule `[⇐] Sub` (and every bespoke check rule). That single
+    choice is what makes the system *gradual*: an expression of type
+    `Unknown` (a hole, an unresolved name, a `Hole _ none`) flows freely
+    into any typed slot, and any expression flows freely into a slot of
+    type `Unknown`. Strict checking is applied between fully-known types
+    only.
+
+    A previous iteration was synth-only with two *bivariantly-compatible*
+    wildcards: `Unknown` and `UserDefined`. The `UserDefined` carve-out was
+    load-bearing: no assignment, call argument, or comparison involving a
+    user type was ever rejected. The bidirectional design retires that
+    carve-out — user-defined types are now a regular participant in `<:`,
+    with `isSubtype` walking inheritance chains and unwrapping aliases
+    and constrained types to deliver real checking on user-defined code. -/
+def isConsistentSubtype (ctx : TypeLattice) (sub sup : HighTypeMd) : Bool :=
+  isConsistent ctx sub sup || isSubtype ctx sub sup
+
 def HighType.isBool : HighType → Bool
   | TBool => true
   | _ => false
@@ -469,6 +731,7 @@ def StmtExpr.constructorName (e : StmtExpr) : String :=
   | .LiteralBool .. => "LiteralBool"
   | .LiteralString .. => "LiteralString"
   | .LiteralDecimal .. => "LiteralDecimal"
+  | .LiteralBv .. => "LiteralBv"
   | .Var .. => "Var"
   | .Assign .. => "Assign"
   | .PureFieldUpdate .. => "PureFieldUpdate"
@@ -491,6 +754,22 @@ def StmtExpr.constructorName (e : StmtExpr) : String :=
   | .Abstract => "Abstract"
   | .All => "All"
   | .Hole .. => "Hole"
+  | .IncrDecr .. => "IncrDecr"
+
+/-- Build an expression that reads back the value of a variable reference.
+
+    The result is always a `Var` expression that evaluates to the variable's
+    value. A `Declare` is read back as a `Local` reference to the declared name
+    (so a declaration target reads back the variable it introduces). -/
+def Variable.toReadbackExpr : Variable → StmtExpr
+  | .Local name => .Var (.Local name)
+  | .Declare param => .Var (.Local param.name)
+  | .Field target fieldName => .Var (.Field target fieldName)
+
+/-- Source-preserving read-back expression for a `VariableMd`
+    (see `Variable.toReadbackExpr`). -/
+def VariableMd.toReadbackExpr (v : VariableMd) : StmtExprMd :=
+  ⟨ v.val.toReadbackExpr, v.source ⟩
 
 /-- Check whether a single modifies entry is the wildcard (`*`). -/
 def StmtExprMd.isWildcard (m : StmtExprMd) : Bool := match m.val with | .All => true | _ => false
@@ -561,6 +840,9 @@ structure ConstrainedType where
 structure DatatypeConstructor where
   name : Identifier
   args : List Parameter
+  /-- Identifier for the auto-generated tester function (e.g. `IntList..isNil`).
+      Populated with a `uniqueId` during resolution. -/
+  testerName : Identifier := mkId ""
 
 /-- A Laurel datatype definition with optional type parameters.
     Zero constructors produces an opaque (abstract) type in Core.
@@ -625,6 +907,19 @@ def TypeDefinition.name : TypeDefinition → Identifier
   | .Datatype ty => ty.name
   | .Alias ty => ty.name
 
+/-- Build a `TypeLattice` from a list of `TypeDefinition`s.
+    Aliases populate `unfoldMap` with their target; constrained types populate
+    it with their base; composites populate `extendingMap` with their direct
+    parents. Datatypes contribute nothing — they're nominal and irreducible. -/
+def TypeLattice.ofTypes (types : List TypeDefinition) : TypeLattice :=
+  types.foldl (init := {}) fun ctx td =>
+    match td with
+    | .Alias ta => { ctx with unfoldMap := ctx.unfoldMap.insert ta.name.text ta.target }
+    | .Constrained ct => { ctx with unfoldMap := ctx.unfoldMap.insert ct.name.text ct.base }
+    | .Composite c =>
+      { ctx with extendingMap := ctx.extendingMap.insert c.name.text (c.extending.map (·.text)) }
+    | .Datatype _ => ctx
+
 structure Constant where
   name : Identifier
   type : HighTypeMd
diff --git a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean
index c2f7bceef0..298b93f1b6 100644
--- a/Strata/Languages/Laurel/LaurelCompilationPipeline.lean
+++ b/Strata/Languages/Laurel/LaurelCompilationPipeline.lean
@@ -5,24 +5,33 @@
 -/
 module
 
-public import Strata.Languages.Laurel.LaurelToCoreTranslator
+public import Strata.Languages.Laurel.LaurelToCoreSchemaPass
 import Strata.Languages.Laurel.DesugarShortCircuit
-import Strata.Languages.Laurel.EliminateReturnsInExpression
-
-import Strata.Languages.Laurel.EliminateValueReturns
+import Strata.Languages.Laurel.EliminateReturnStatements
+import Strata.Languages.Laurel.EliminateDoWhile
+import Strata.Languages.Laurel.EliminateIncrDecr
+import Strata.Languages.Laurel.MergeAndLiftReturns
+import Strata.Languages.Laurel.EliminateValueInReturns
+import Strata.Languages.Laurel.ModifiesClauses
+import Strata.Languages.Laurel.HeapParameterization
+import Strata.Languages.Laurel.TypeHierarchy
+import Strata.Languages.Laurel.InferHoleTypes
+import Strata.Languages.Laurel.EliminateDeterministicHoles
+import Strata.Languages.Laurel.CoreDefinitionsForLaurel
+import Strata.Languages.Laurel.CoreGroupingAndOrdering
+import Strata.Languages.Laurel.TransparencyPass
+import Strata.Languages.Laurel.LiftImperativeExpressions
 import Strata.Languages.Laurel.ConstrainedTypeElim
-
+import Strata.Languages.Laurel.ContractPass
+import Strata.Languages.Laurel.PushOldInward
+import Strata.Languages.Laurel.LiftInstanceProcedures
 import Strata.Languages.Laurel.TypeAliasElim
+public import Strata.Languages.Laurel.LaurelPass
 public import Strata.Languages.Core
 import Strata.Languages.Core.DDMTransform.ASTtoCST
-import Strata.Languages.Laurel.CoreDefinitionsForLaurel
-import Strata.Languages.Laurel.EliminateHoles
+import Strata.Languages.Core.Verifier
 import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
-import Strata.Languages.Laurel.HeapParameterization
-import Strata.Languages.Laurel.InferHoleTypes
-import Strata.Languages.Laurel.LiftImperativeExpressions
-import Strata.Languages.Laurel.ModifiesClauses
-import Strata.Languages.Laurel.TypeHierarchy
+import Strata.Util.Statistics
 
 /-!
 ## Laurel Compilation Pipeline
@@ -33,7 +42,7 @@ to Strata Core. The pipeline is:
 1. Prepend core definitions for Laurel.
 2. Run a sequence of Laurel-to-Laurel lowering passes (resolution, heap
    parameterization, type hierarchy, modifies clauses, hole inference,
-   desugaring, lifting, constrained type elimination).
+   desugaring, lifting, constrained type elimination, contract pass).
 3. Run the transparency pass to produce an `UnorderedCoreWithLaurelTypes`.
 4. Group and order declarations into a `CoreWithLaurelTypes`.
 5. Translate the `CoreWithLaurelTypes` to a `Core.Program`.
@@ -87,63 +96,25 @@ public section
     Laurel-to-Laurel passes, before the final translation to Core). -/
 abbrev TranslateResultWithLaurel := (Option Core.Program) × (List DiagnosticModel) × Program × Statistics
 
-/-- A single Laurel-to-Laurel pass. Each pass receives the current program and
-    semantic model and returns the (possibly modified) program, accumulated
-    diagnostics, and statistics. -/
-structure LaurelPass where
-  /-- Human-readable name, used for profiling and file emission. -/
-  name : String
-  /-- Whether `resolve` should be run after the pass. -/
-  needsResolves : Bool := false
-  /-- The pass action. -/
-  run : Program → SemanticModel → Program × List DiagnosticModel × Statistics
-
 /-- The ordered sequence of Laurel-to-Laurel lowering passes. -/
-private def laurelPipeline : Array LaurelPass := #[
-  { name := "FilterNonCompositeModifies"
-    run := fun p m =>
-      let (p', diags) := filterNonCompositeModifies m p
-      (p', diags, {}) },
-  { name := "EliminateValueReturns"
-    run := fun p _m =>
-      let (p', diags) := eliminateValueReturnsTransform p
-      (p', diags.toList, {}) },
-  { name := "HeapParameterization"
-    needsResolves := true
-    run := fun p m =>
-      (heapParameterization m p, [], {}) },
-  { name := "TypeHierarchyTransform"
-    needsResolves := true
-    run := fun p m =>
-      (typeHierarchyTransform m p, [], {}) },
-  { name := "ModifiesClausesTransform"
-    needsResolves := true
-    run := fun p m =>
-      let (p', diags) := modifiesClausesTransform m p
-      (p', diags, {}) },
-  { name := "InferHoleTypes"
-    run := fun p m =>
-      let (p', diags, stats) := inferHoleTypes m p
-      (p', diags, stats) },
-  { name := "EliminateHoles"
-    run := fun p _m =>
-      let (p', stats) := eliminateHoles p
-      (p', [], stats) },
-  { name := "DesugarShortCircuit"
-    run := fun p m =>
-      (desugarShortCircuit m p, [], {}) },
-  { name := "LiftExpressionAssignments"
-    run := fun p m =>
-      (liftExpressionAssignments m p, [], {}) },
-  { name := "EliminateReturns"
-    needsResolves := true
-    run := fun p _m =>
-      (eliminateReturnsInExpressionTransform p, [], {}) },
-  { name := "ConstrainedTypeElim"
-    needsResolves := true
-    run := fun p m =>
-      let (p', diags) := constrainedTypeElim m p
-      (p', diags, {}) }
+def laurelPipeline : Array LoweringPass := #[
+  eliminateDoWhilePass,
+  eliminateIncrDecrPass,
+  typeAliasElimPass,
+  constrainedTypeElimPass,
+  filterNonCompositeModifiesPass,
+  mergeAndLiftReturnsPass,
+  liftInstanceProceduresPass,
+  eliminateValueInReturnsPass,
+  heapParameterizationPass,
+  typeHierarchyTransformPass,
+  modifiesClausesTransformPass,
+  pushOldInwardPass,
+  inferHoleTypesPass,
+  eliminateDeterministicHolesPass,
+  desugarShortCircuitPass,
+  eliminateReturnStatementsPass,
+  contractPass
 ]
 
 /--
@@ -154,7 +125,8 @@ When `keepAllFilesPrefix` is provided (via the `PipelineM` context), the
 program state after each named Laurel pass is written to
 `{prefix}.{n}.{passName}.laurel.st`.
 -/
-private def runLaurelPasses (options : LaurelTranslateOptions)
+private def runLaurelPasses
+    (options: LaurelTranslateOptions)
     (pctx : Strata.Pipeline.PipelineContext) (program : Program)
     : PipelineM (Program × SemanticModel × List DiagnosticModel × Statistics) := do
   let program := { program with
@@ -167,23 +139,16 @@ private def runLaurelPasses (options : LaurelTranslateOptions)
 
   -- Initial resolution
   let result := resolve program
-  let resolutionErrors : List DiagnosticModel :=
-    if options.emitResolutionErrors then result.errors.toList else []
+  let resolutionErrors : Std.HashSet DiagnosticModel := Std.HashSet.ofArray result.errors
   let (program, model) := (result.program, result.model)
-  emit "Resolve" "laurel.st" program
-
-  let program := typeAliasElim model program
-  emit "TypeAliasElim" "laurel.st" program
-
-  let diamondErrors := validateDiamondFieldAccesses model program
 
   let mut program := program
   let mut model := model
-  let mut allDiags : List DiagnosticModel := resolutionErrors ++ diamondErrors
+  let mut allDiags : List DiagnosticModel := result.errors.toList
   let mut allStats : Statistics := {}
 
   for pass in laurelPipeline do
-    let (program', diags, stats) ← pctx.withPhase pass.name do pure (pass.run program model)
+    let (program', diags, stats) ← pctx.withPhase pass.name do pure (pass.run program model options)
     program := program'
     allDiags := allDiags ++ diags
     allStats := allStats.merge stats
@@ -192,13 +157,24 @@ private def runLaurelPasses (options : LaurelTranslateOptions)
       let result := resolve program (some model)
       let newErrors := result.errors.filter fun e => !resolutionErrors.contains e
       if !newErrors.isEmpty then
+        let newDiags := newErrors.toList.map fun d =>
+          { d with
+              message :=
+                s!"Internal error: resolution after '{pass.name}' introduced this diagnostic: {d}. Existing diagnostics were: {resolutionErrors.toList}"
+              type := .StrataBug }
         emit pass.name "laurel.st" program
+        return (program, model, allDiags ++ newDiags, allStats)
       program := result.program
       model := result.model
     emit pass.name "laurel.st" program
 
   return (program, model, allDiags, allStats)
 
+/-- The ordered sequence of passes on the unordered Core representation. -/
+private def unorderedCorePipeline : Array (LaurelPass UnorderedCoreWithLaurelTypes UnorderedCoreWithLaurelTypes) := #[
+  liftImperativeExpressionsPass
+]
+
 /--
 Translate Laurel Program to Core Program, also returning the lowered Laurel program.
 
@@ -212,38 +188,55 @@ def translateWithLaurel (options : LaurelTranslateOptions) (program : Program)
     | some ctx => pure ctx
     | none => Strata.Pipeline.PipelineContext.create (outputMode := .quiet)
   runPipelineM options.keepAllFilesPrefix do
-    let (program, model, passDiags, stats) ← runLaurelPasses options pctx program
-    let unorderedCore := transparencyPass program
-    emit "transparencyPass" "core.st" unorderedCore
-
-    -- Resolve so that identifiers introduced by earlier passes get uniqueIds.
-    let compositeTypes := program.types.filter (fun t => match t with | .Composite _ => true | _ => false)
-    let (unorderedCore, model) := resolveUnorderedCore unorderedCore (existingModel := some model) (additionalTypes := compositeTypes)
-
-    let coreWithLaurelTypes := orderFunctionsAndProcedures unorderedCore
-
-    -- This early return is a simple way to protect against duplicative errors. Without this return,
-    -- resolution errors reported by Laurel would also be reported by Core.
-    -- There might be better solution that allows getting some resolution errors from Laurel and some verification errors from Core,
-    -- but that would need more consideration.
-    if passDiags.any (·.type != .Warning) then
-      return (none, passDiags, program, stats)
-
-    emit "CoreWithLaurelTypes" "core.st" coreWithLaurelTypes
-    let initState : TranslateState := { model := model, overflowChecks := options.overflowChecks }
-    let (coreProgramOption, translateState) :=
-      runTranslateM initState (translateLaurelToCore options coreWithLaurelTypes)
-    -- Because of the duplication between functions and procedures, this translation is liable to create duplicate diagnostics
-    let mut allDiagnostics: List DiagnosticModel := passDiags ++ translateState.diagnostics.eraseDups;
-
-    if !translateState.coreDiagnostics.isEmpty && allDiagnostics.isEmpty then
-      allDiagnostics := allDiagnostics ++ translateState.coreDiagnostics
-
-    if coreProgramOption.isSome then
-      emit "Core" "core.st" coreProgramOption.get!
-    let coreProgramOption :=
-      if translateState.coreDiagnostics.isEmpty then coreProgramOption else none
-    return (coreProgramOption, allDiagnostics, program, stats)
+  let (program, model, passDiags, stats) ← runLaurelPasses options pctx program
+
+  -- Sanity check: `LiftInstanceProcedures` should have cleared every
+  -- composite's `instanceProcedures` list.
+  let mut passDiags := passDiags
+  for td in program.types do
+    if let .Composite ct := td then
+      for proc in ct.instanceProcedures do
+        passDiags := passDiags ++ [diagnosticFromSource proc.name.source
+          s!"Instance procedure '{proc.name.text}' on composite type '{ct.name.text}' was not lifted before Core translation (pipeline-ordering bug)"
+          DiagnosticType.StrataBug]
+
+  -- This early return is a simple way to protect against duplicative errors. Without this return,
+  -- resolution errors reported by Laurel would also be reported by Core.
+  -- There might be better solution that allows getting some resolution errors from Laurel and some verification errors from Core,
+  -- but that would need more consideration.
+  if passDiags.any (·.type != .Warning) then
+    return (none, passDiags, program, stats)
+
+  let unorderedCore := (transparencyPass.run program model options).1
+  emit "transparencyPass" "core.st" unorderedCore
+  let mut unorderedCore := unorderedCore
+  let mut fnModel := model
+
+  for pass in unorderedCorePipeline do
+    unorderedCore := (pass.run unorderedCore fnModel options).1
+    if pass.needsResolves then
+      let compositeTypes := program.types.filter (fun t => match t with | .Composite _ => true | _ => false)
+      let (uc', m', errors) := resolveUnorderedCore unorderedCore (some fnModel) compositeTypes
+      if !errors.isEmpty then
+        let newDiags := errors.toList.map fun d =>
+          { d with message :=
+              s!"Internal error: resolution after '{pass.name}' introduced this diagnostic: {d.message}" }
+        emit pass.name "unorderedCoreWithLaurelTypes.st" unorderedCore
+        return (none, passDiags ++ newDiags, program, stats)
+      unorderedCore := uc'
+      fnModel := m'
+    emit pass.name "unorderedCoreWithLaurelTypes.st" unorderedCore
+
+  let coreWithLaurelTypes := (orderingPass.run unorderedCore model options).1
+
+  emit "CoreWithLaurelTypes" "core.st" coreWithLaurelTypes
+  let (coreProgram, coreDiagnostics, _) := laurelToCoreSchemaPass.run coreWithLaurelTypes fnModel options
+  let mut allDiagnostics: List DiagnosticModel := passDiags ++ coreDiagnostics;
+
+  emit "Core" "core.st" coreProgram
+  let coreProgramOption :=
+    if coreDiagnostics.isEmpty then some coreProgram else none
+  return (coreProgramOption, allDiagnostics, program, stats)
 
 /--
 Translate Laurel Program to Core Program.
@@ -252,8 +245,36 @@ def translate (options : LaurelTranslateOptions) (program : Program) : IO Transl
   let (core, diags, _, _) ← translateWithLaurel options program
   return (core, diags)
 
+/-- Run `Core.verify` on a translated Core program, returning the verify-phase
+    failure as a **structured** `DiagnosticModel` value (via `.toBaseIO`) rather
+    than throwing it.
+
+    `Core.verify : EIO DiagnosticModel VCResults` carries its error as a
+    `DiagnosticModel` (with byte-offset `fileRange`). Capturing it as an
+    `Except` here is the single point where that structure is preserved, so the
+    throwing (`verifyToVcResults`) and capturing
+    (`verifyToDiagnosticModelsCapturing`) entry points can't drift apart: both
+    share this verify setup (the `removeIrrelevantAxioms := .Precise` option and
+    the `vcDirectory` temp-dir handling) and only differ in how they treat the
+    `.error` case. -/
+private def runVerify (coreProgram : Core.Program) (options : LaurelVerifyOptions)
+    : IO (Except DiagnosticModel VCResults) := do
+  let verifyOptions := { options.verifyOptions with removeIrrelevantAxioms := .Precise }
+  let runner tempDir : IO (Except DiagnosticModel VCResults) :=
+    (_root_.Core.verify coreProgram tempDir (proceduresToVerify := none) verifyOptions).toBaseIO
+  match verifyOptions.vcDirectory with
+  | .none => IO.FS.withTempDir runner
+  | .some p => IO.FS.createDirAll ⟨p.toString⟩; runner ⟨p.toString⟩
+
 /--
 Verify a Laurel program using an SMT solver.
+
+A verify-phase failure (a type-checking / symbolic-evaluation error) is
+**thrown** as an `IO` exception, exactly as before file-relative reporting was
+introduced: the structured error is intercepted at the `runVerify` boundary and
+re-thrown via `toString`, so the CLI's control flow and exit codes are
+unchanged. Tests that need the structured error as a value (to render it to
+`line:col`) call `verifyToDiagnosticModelsCapturing` instead.
 -/
 def verifyToVcResults (program : Program)
     (options : LaurelVerifyOptions := default)
@@ -262,14 +283,11 @@ def verifyToVcResults (program : Program)
 
   match coreProgramOption with
   | some coreProgram =>
-    let options := { options.verifyOptions with removeIrrelevantAxioms := .Precise }
-    let runner tempDir :=
-      EIO.toIO (fun f => IO.Error.userError (toString f))
-          (_root_.Core.verify coreProgram tempDir .none options)
-    let ioResult ← match options.vcDirectory with
-      | .none => IO.FS.withTempDir runner
-      | .some p => IO.FS.createDirAll ⟨p.toString⟩; runner ⟨p.toString⟩
-    return (some ioResult, translateDiags)
+    match ← runVerify coreProgram options with
+    | .ok ioResult => return (some ioResult, translateDiags)
+    -- Reconstruct the throwing path: stringify the structured error exactly as
+    -- the previous `EIO.toIO (fun f => .userError (toString f))` did.
+    | .error dm => throw (IO.userError (toString dm))
   | none => return (none, translateDiags)
 
 /--
@@ -301,5 +319,60 @@ def verifyToDiagnosticModels (program : Program) (options : LaurelVerifyOptions
   | some vcResults => vcResults.toList.filterMap (fun (vcr : VCResult) => toDiagnosticModel vcr phases)
   return (results.snd ++ vcDiags).toArray
 
+/-- Like `verifyToDiagnosticModels`, but a verify-phase failure is **captured**
+    as a structured `DiagnosticModel` (the same value `verifyToVcResults` would
+    have thrown via `toString`) and returned in the list, rather than thrown.
+
+    This is the test-framework entry point: the structured error still carries
+    its byte-offset `fileRange`, so the caller can render it to snippet-local /
+    file-relative `line:col` like every other diagnostic — instead of the raw
+    byte offset that a stringified exception would leave in its message text.
+    Production code keeps using the throwing `verifyTo*` functions above.
+
+    Shares the `runVerify` boundary with `verifyToVcResults`, differing only in
+    that it returns the captured `.error` as a value instead of re-throwing it —
+    so the two can't drift apart on verify options or temp-dir handling. -/
+def verifyToDiagnosticModelsCapturing (program : Program)
+    (options : LaurelVerifyOptions := default) : IO (Array DiagnosticModel) := do
+  let (coreProgramOption, translateDiags) ← translate options.translateOptions program
+  match coreProgramOption with
+  | none => return translateDiags.toArray
+  | some coreProgram =>
+    match ← runVerify coreProgram options with
+    | .error dm => return (translateDiags ++ [dm]).toArray
+    | .ok results =>
+      let phases := Core.coreAbstractedPhases
+      let vcDiags := results.mergeByAssertion.toList.filterMap (toDiagnosticModel · phases)
+      return (translateDiags ++ vcDiags).toArray
+
 end -- public section
+
+public def allPasses: Array PassMeta := laurelPipeline.map (fun p => p.meta) ++
+  [transparencyPass.meta] ++
+  unorderedCorePipeline.map (fun p => p.meta) ++
+  [orderingPass.meta, laurelToCoreSchemaPass.meta]
+
+/-- Every `comesBefore` and `comesAfter` constraint is respected by the
+    pipeline order. A `comesBefore` dependency requires this pass to appear
+    earlier than its target; a `comesAfter` dependency requires it to appear
+    later. -/
+def orderingRespected : Bool :=
+  let names := allPasses.map (·.name)
+  (List.range allPasses.size).zip allPasses.toList |>.all fun (i, p) =>
+    (p.comesBefore.all fun cb =>
+      match names.findIdx? (· == cb.pass.name) with
+      | some j => i < j
+      | none   => false)  -- target not in allPasses
+    &&
+    (p.comesAfter.all fun ca =>
+      match names.findIdx? (· == ca.pass.name) with
+      | some j => j < i
+      | none   => false)  -- target not in allPasses
+
+-- Use `initialize` to check at load time instead of `#guard` which requires
+-- interpreter IR that is not available for passes defined in `module` files.
+initialize do
+  unless orderingRespected do
+    throw <| .userError "laurelPipeline: comesBefore/comesAfter ordering constraints violated"
+
 end Laurel
diff --git a/Strata/Languages/Laurel/LaurelPass.lean b/Strata/Languages/Laurel/LaurelPass.lean
new file mode 100644
index 0000000000..130ae2cf09
--- /dev/null
+++ b/Strata/Languages/Laurel/LaurelPass.lean
@@ -0,0 +1,66 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Languages.Laurel.SemanticModel
+public import Strata.Util.Statistics
+public import Strata.Languages.Core.Options
+
+namespace Strata.Laurel
+
+public section
+
+structure LaurelTranslateOptions where
+  inlineFunctionsWhenPossible : Bool := false
+  overflowChecks : Core.OverflowChecks := {}
+  keepAllFilesPrefix : Option String := none
+
+instance : Inhabited LaurelTranslateOptions where
+  default := {}
+
+mutual
+
+/-- The parameter-free metadata of a pass, independent of the `Input`/`Output`
+    types it operates on. `LaurelPass` extends this so that passes with
+    different parameterizations (e.g. `LaurelPass Program Program` and
+    `LaurelPass UnorderedCoreWithLaurelTypes UnorderedCoreWithLaurelTypes`)
+    share a common, type-parameter-free view that can be collected into a
+    single homogeneous list. -/
+structure PassMeta where
+  /-- Human-readable name, used for profiling and file emission. -/
+  name : String
+  /-- Whether `resolve` should be run after the pass. -/
+  needsResolves : Bool := false
+  /-- A description of what this pass does, used for documentation generation. -/
+  documentation : String
+  /-- Passes that must run before this one. -/
+  comesBefore : List PassDependency := []
+  /-- Passes that must run after this one. -/
+  comesAfter : List PassDependency := []
+
+structure PassDependency where
+  pass : PassMeta
+  reason: String
+end
+
+/-- A single Laurel-to-Laurel pass. Each pass receives the current program and
+    semantic model and returns the (possibly modified) program, accumulated
+    diagnostics, and statistics. Extends `PassMeta` with the `run` action; the
+    metadata fields remain directly accessible (e.g. `p.name`). -/
+structure LaurelPass (Input: Type) (Output: Type) extends PassMeta where
+  /-- The pass action. -/
+  run : Input → SemanticModel → LaurelTranslateOptions → Output × List DiagnosticModel × Statistics
+
+abbrev LoweringPass := LaurelPass Laurel.Program Laurel.Program
+
+/-- Project a `LaurelPass` to its parameter-free metadata, discarding the
+    `run` action and the `Input`/`Output` type parameters. -/
+abbrev LaurelPass.meta {Input Output : Type} (p : LaurelPass Input Output) : PassMeta :=
+  p.toPassMeta
+
+end -- public section
+
+end Strata.Laurel
diff --git a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean b/Strata/Languages/Laurel/LaurelToCoreSchemaPass.lean
similarity index 77%
rename from Strata/Languages/Laurel/LaurelToCoreTranslator.lean
rename to Strata/Languages/Laurel/LaurelToCoreSchemaPass.lean
index d1219dad55..3c6cda03cd 100644
--- a/Strata/Languages/Laurel/LaurelToCoreTranslator.lean
+++ b/Strata/Languages/Laurel/LaurelToCoreSchemaPass.lean
@@ -7,6 +7,7 @@ module
 
 public import Strata.Languages.Core.Program
 public import Strata.Languages.Core.Options
+public import Strata.Languages.Laurel.PushOldInward
 public import Strata.Languages.Laurel.CoreGroupingAndOrdering
 import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
 import Strata.Util.Tactics
@@ -47,6 +48,12 @@ structure TranslateState where
   model : SemanticModel
   /-- Overflow check configuration -/
   overflowChecks : Core.OverflowChecks := {}
+  /-- Do not process the produces Core program, since it has superfluous errors -/
+  coreProgramHasSuperfluousErrors: Bool := false
+  /-- Inout parameter names of the procedure currently being translated.
+      Used by the `.Old (Var (Local n))` arm to defensively check `n` against
+      the procedure's inout list. Empty when not translating a procedure body. -/
+  currentProcInouts : List String := []
   /-- Diagnostics that indicate the Core program should not be processed further.
       When non-empty, the produced Core program is suppressed. Each entry records
       why the program was deemed invalid so that if no other diagnostics explain
@@ -79,17 +86,14 @@ def translateType (ty : HighTypeMd) : TranslateM LMonoTy := do
   | .TString => return LMonoTy.string
   | .TBv n => return LMonoTy.bitvec n
   | .TVoid => return LMonoTy.bool -- Using bool as placeholder for void
-  | .THeap => return .tcons "Heap" []
-  | .TTypedField _ => return .tcons "Field" []
   | .TSet elementType => return Core.mapTy (← translateType elementType) LMonoTy.bool
   | .TMap keyType valueType => return Core.mapTy (← translateType keyType) (← translateType valueType)
   | .UserDefined name =>
     match model.get? name with
-    | some (.compositeType _) => return .tcons "Composite" []
     | some (.datatypeDefinition dt) => return .tcons dt.name.text []
     | some (.datatypeConstructor typeName _) => return .tcons typeName.text []
     | _ => do -- resolution should have already emitted a diagnostic
-      emitCoreDiagnostic (diagnosticFromSource ty.source s!"UserDefined type could not be resolved to a composite or datatype" DiagnosticType.StrataBug)
+      emitCoreDiagnostic (diagnosticFromSource ty.source s!"UserDefined type {name} could not be resolved to a composite or datatype" DiagnosticType.StrataBug)
       return .tcons "Composite" []
   | .TCore s => return .tcons s []
   | .TReal => return LMonoTy.real
@@ -141,16 +145,14 @@ def translateExpr (expr : StmtExprMd)
   let model := s.model
   let md := astNodeToCoreMd expr
   let disallowed (source : Option FileRange) (msg : String) : TranslateM Core.Expression.Expr := do
-    if isPureContext then
       throwExprDiagnostic $ diagnosticFromSource source msg
-    else
-      throwExprDiagnostic $ diagnosticFromSource source s!"{msg} (should have been lifted)" DiagnosticType.StrataBug
 
   match h: expr.val with
   | .LiteralBool b => return .const () (.boolConst b)
   | .LiteralInt i => return .const () (.intConst i)
   | .LiteralString s => return .const () (.strConst s)
   | .LiteralDecimal d => return .const () (.realConst (StrataDDM.Decimal.toRat d))
+  | .LiteralBv value width => return .const () (.bitvecConst width (BitVec.ofNat width value))
   | .Var (.Local name) =>
       -- First check if this name is bound by an enclosing quantifier
       match boundVars.findIdx? (· == name) with
@@ -253,7 +255,10 @@ def translateExpr (expr : StmtExprMd)
       return .eq () re1 re2
   | .Assign _ _ =>
       disallowed expr.source "destructive assignments are not supported in transparent bodies or contracts"
-  | .While _ _ _ _ =>
+  | .IncrDecr _ _ _ =>
+      throwExprDiagnostic $ diagnosticFromSource expr.source
+        "IncrDecr should have been eliminated by EliminateIncrDecr pass" DiagnosticType.StrataBug
+  | .While _ _ _ _ _ =>
       disallowed expr.source "loops are not supported in functions or contracts"
   | .Exit _ => disallowed expr.source "exit is not supported in expression position"
 
@@ -274,24 +279,48 @@ def translateExpr (expr : StmtExprMd)
   | .Block (⟨ .IfThenElse cond thenBranch (some elseBranch), innerSrc⟩ :: rest) label =>
     disallowed innerSrc "if-then-else only supported as the last statement in a block"
 
-  | .IsType _ _ =>
-      throwExprDiagnostic $ diagnosticFromSource expr.source "IsType should have been lowered" DiagnosticType.StrataBug
-  | .New _ => throwExprDiagnostic $ diagnosticFromSource expr.source s!"New should have been eliminated by typeHierarchyTransform" DiagnosticType.StrataBug
   | .Var (.Field target fieldId) =>
       -- Field selects should have been eliminated by heap parameterization
       -- If we see one here, it's an error in the pipeline
       throwExprDiagnostic $ diagnosticFromSource expr.source s!"FieldSelect should have been eliminated by heap parameterization: {Std.ToFormat.format target}#{fieldId.text}" DiagnosticType.StrataBug
   | .Block (⟨ .Assign _ _, assignSource⟩ :: tail) _ =>
       disallowed assignSource "destructive assignments are not supported in transparent bodies or contracts"
+  | .Block (⟨ .While _ _ _ _ _, whileSource⟩ :: tail) _ =>
+      disallowed whileSource "loops are not supported in functions or contracts"
   | .Block (head :: tail) _ =>
       throwExprDiagnostic $ diagnosticFromSource expr.source s!"block expression starting with {head.val.constructorName} should have been lowered in a separate pass" DiagnosticType.StrataBug
   | .Block [] _ =>
       throwExprDiagnostic $ diagnosticFromSource expr.source "empty block expression should have been lowered in a separate pass" DiagnosticType.StrataBug
   | .Return _ => disallowed expr.source "return expression should be lowered in a separate pass"
-
+  | .IsType _ _ =>
+      throwExprDiagnostic $ diagnosticFromSource expr.source "IsType should have been lowered" DiagnosticType.StrataBug
+  | .New _ => throwExprDiagnostic $ diagnosticFromSource expr.source s!"New should have been eliminated by typeHierarchyTransform" DiagnosticType.StrataBug
   | .AsType target _ => throwExprDiagnostic $ diagnosticFromSource expr.source "AsType expression translation" DiagnosticType.NotYetImplemented
   | .Assigned _ => throwExprDiagnostic $ diagnosticFromSource expr.source "assigned expression translation" DiagnosticType.NotYetImplemented
-  | .Old value => throwExprDiagnostic $ diagnosticFromSource expr.source "old expression translation" DiagnosticType.NotYetImplemented
+  | .Old value =>
+      -- `pushOldInward` is expected to leave every `Old` wrapping `Var (Local n)`
+      -- with `n` an inout parameter of the enclosing procedure. We do not rely on
+      -- a static proof of this; the guarantee is enforced at translate time: if
+      -- PushOldInward has a bug or a later pass mutates the AST, we emit a
+      -- StrataBug diagnostic instead of silently producing a dangling `mkOld n`
+      -- name.
+      match value.val with
+      | .Var (.Local name) =>
+          let inouts := s.currentProcInouts
+          if !inouts.contains name.text then
+            throwExprDiagnostic $ diagnosticFromSource expr.source
+              s!"old({name.text}) refers to a name that is not an inout parameter \
+                 of the enclosing procedure (inouts: {inouts}). This violates the \
+                 pushOldInward normalization invariant."
+              DiagnosticType.StrataBug
+          else
+            let coreTy ← translateType (model.get name).getType
+            return .fvar () (Core.CoreIdent.mkOld name.text) (some coreTy)
+      | _ =>
+          throwExprDiagnostic $ diagnosticFromSource expr.source
+            "old(...) should have been pushed inward to a variable reference. \
+             This violates the pushOldInward normalization invariant."
+            DiagnosticType.StrataBug
   | .Fresh _ => throwExprDiagnostic $ diagnosticFromSource expr.source "fresh expression translation" DiagnosticType.NotYetImplemented
   | .Assert _ => throwExprDiagnostic $ diagnosticFromSource expr.source "assert expression translation" DiagnosticType.NotYetImplemented
   | .Assume _ => throwExprDiagnostic $ diagnosticFromSource expr.source "assume expression translation" DiagnosticType.NotYetImplemented
@@ -345,6 +374,45 @@ def throwStmtDiagnostic (d : DiagnosticModel): TranslateM (List Core.Statement)
   emitCoreDiagnostic d
   return []
 
+/--
+Look up the callee's signature and convert positional `coreArgs` into Core
+`CallArg`s, emitting `.inoutArg ident` for parameters that appear in both
+inputs and outputs (true inout) and `.inArg` otherwise. Returns the call args
+along with the callee's outputs and inout names so the caller can build the
+matching `.outArg` list. `md` locates the StrataBug diagnostic emitted when
+an inout argument is not a variable reference.
+-/
+private def buildCallArgs (calleeId : Identifier) (coreArgs : List Core.Expression.Expr)
+    (md : Imperative.MetaData Core.Expression)
+    : TranslateM (List (Core.CallArg Core.Expression) × List Parameter × List String) := do
+  let s ← get
+  let (calleeInputs, calleeOutputs) := match s.model.get calleeId with
+    | .staticProcedure proc => (proc.inputs, proc.outputs)
+    | .instanceProcedure _ proc => (proc.inputs, proc.outputs)
+    | _ => ([], [])
+  let calleeInputNames := calleeInputs.map (·.name.text)
+  let calleeOutputNames := calleeOutputs.map (·.name.text)
+  let calleeInoutNames := calleeInputNames.filter (calleeOutputNames.contains ·)
+  let inoutInputIndices := calleeInputNames.zipIdx.filterMap fun (name, i) =>
+    if calleeInoutNames.contains name then some i else none
+  let mut callArgs : List (Core.CallArg Core.Expression) := []
+  for (arg, i) in coreArgs.zipIdx do
+    if inoutInputIndices.contains i then
+      match arg with
+      | .fvar _ ident _ => callArgs := callArgs ++ [.inoutArg ident]
+      | _ =>
+        -- Non-fvar inout arg can't be wired as `.inoutArg`; flag it.
+        emitDiagnostic $ md.toDiagnostic
+          s!"inout argument at index {i} of call to '{calleeId.text}' is not a \
+             variable reference, so the output side of the inout cannot be \
+             wired through. This should not happen after the preceding passes."
+          DiagnosticType.StrataBug
+        modify fun st => { st with coreProgramHasSuperfluousErrors := true }
+        callArgs := callArgs ++ [.inArg arg]
+    else
+      callArgs := callArgs ++ [.inArg arg]
+  return (callArgs, calleeOutputs, calleeInoutNames)
+
 /--
 Translate Laurel StmtExpr to Core Statements using the `TranslateM` monad.
 Diagnostics are emitted into the monad state.
@@ -414,12 +482,14 @@ def translateStmt (stmt : StmtExprMd)
             lhs := lhs ++ [ident]
           | .Field _ _ => pure () -- already handled above
         return (inits, lhs)
-      -- Translate a procedure/instance call: init Declare targets with nondet, then emit call
-      let translateCallTargets (calleeName : String) (args : List StmtExprMd) : TranslateM (List Core.Statement) := do
+      -- Translate a procedure/instance call: init Declare targets with nondet, then emit call.
+      let translateCallTargets (calleeId : Identifier) (args : List StmtExprMd) : TranslateM (List Core.Statement) := do
         let coreArgs ← args.mapM (fun a => translateExpr a)
         let (inits, lhs) ← initTargetsNondet
-        let outArgs : List (Core.CallArg Core.Expression) := lhs.map .outArg
-        return inits ++ [Core.Statement.call calleeName (coreArgs.map .inArg ++ outArgs) md]
+        let (callArgs, _, calleeInoutNames) ← buildCallArgs calleeId coreArgs md
+        let outArgs : List (Core.CallArg Core.Expression) :=
+          lhs.filter (fun id => !calleeInoutNames.contains id.name) |>.map .outArg
+        return inits ++ [Core.Statement.call calleeId.text (callArgs ++ outArgs) md]
       -- Match on the value to decide how to translate
       match _hv : value.val with
       | .StaticCall callee args =>
@@ -435,9 +505,9 @@ def translateStmt (stmt : StmtExprMd)
           | _ =>
             throwStmtDiagnostic $ md.toDiagnostic "function call without a single target" DiagnosticType.StrataBug
         else
-          translateCallTargets callee.text args
+          translateCallTargets callee args
       | .InstanceCall _target callee args =>
-          translateCallTargets callee.text args
+          translateCallTargets callee args
       | .Hole _ _ =>
           -- Hole RHS: havoc all targets (unmodeled call side-effect).
           dispatchTargets
@@ -466,39 +536,46 @@ def translateStmt (stmt : StmtExprMd)
         exprAsUnusedInit stmt md
       else
         let coreArgs ← args.mapM (fun a => translateExpr a)
-        -- Generate throwaway LHS variables for all outputs so Core arity
-        -- checking passes (lhs.length == outputs.length).
-        let outputs := match model.get callee with
-          | .staticProcedure proc => proc.outputs
-          | .instanceProcedure _ proc => proc.outputs
-          | _ => []
+        let (callArgs, calleeOutputs, calleeInoutNames) ← buildCallArgs callee coreArgs md
+        -- Generate throwaway LHS for output-only params so Core arity checking passes.
         let mut inits : List Core.Statement := []
-        let mut lhs : List Core.CoreIdent := []
-        for out in outputs do
+        let mut outArgs : List (Core.CallArg Core.Expression) := []
+        for out in calleeOutputs do
+          if calleeInoutNames.contains out.name.text then continue
           let id ← freshId
           let ident : Core.CoreIdent := ⟨s!"$unused_{id}", ()⟩
           let coreType := LTy.forAll [] (← translateType out.type)
           inits := inits ++ [Core.Statement.init ident coreType .nondet md]
-          lhs := lhs ++ [ident]
-        let outArgs : List (Core.CallArg Core.Expression) := lhs.map .outArg
-        return inits ++ [Core.Statement.call callee.text (coreArgs.map .inArg ++ outArgs) md]
+          outArgs := outArgs ++ [.outArg ident]
+        return inits ++ [Core.Statement.call callee.text (callArgs ++ outArgs) md]
   | .InstanceCall .. =>
       -- Instance method call as statement: no return value, treated as no-op
       return ([])
   | .Return valueOpt =>
       match valueOpt with
       | none =>
-          return [.exit "$body" md]
+          return [.exit bodyLabel md]
       | some _ =>
           let d := md.toDiagnostic "Return statement with value should have been eliminated by EliminateValueReturns pass" DiagnosticType.StrataBug
           emitCoreDiagnostic d
-          return [.exit "$body" md]
-  | .While cond invariants decreasesExpr body =>
+          return [.exit bodyLabel md]
+  | .While cond invariants decreasesExpr body postTest =>
+      if postTest then
+        return ← throwStmtDiagnostic (diagnosticFromSource cond.source
+          "post-test while (do-while) should have been eliminated by EliminateDoWhile pass" DiagnosticType.StrataBug)
       let condExpr ← translateExpr cond
       let invExprs ← invariants.mapM (fun i => do return ("", ← translateExpr i))
       let decreasingExprCore ← decreasesExpr.mapM (translateExpr)
       let bodyStmts ← translateStmt body
-      return [Imperative.Stmt.loop (.det condExpr) decreasingExprCore invExprs bodyStmts md]
+      -- Attach each invariant's source provenance to the loop metadata, in
+      -- invariant order, so loop elimination can point an invariant's
+      -- verification condition at the specific invariant rather than the whole
+      -- loop. (The Core loop IR stores invariants as `(label, expr)` pairs with
+      -- no per-invariant metadata slot, and Core expressions carry no source
+      -- range, so we thread the ranges through the loop metadata instead.)
+      let mdWithInvs := invariants.foldl
+        (fun acc i => acc.pushInvariantProvenance (fileRangeToProvenance i.source)) md
+      return [Imperative.Stmt.loop (.det condExpr) decreasingExprCore invExprs bodyStmts mdWithInvs]
   | .Exit target =>
       return [Imperative.Stmt.exit target md]
   | .Hole _ _ =>
@@ -519,12 +596,13 @@ Translate a list of checks (preconditions or postconditions) to Core checks.
 Each check gets a label like `"requires"` or `"requires_0"`, `"requires_1"`, etc.
 -/
 private def translateChecks (checks : List Condition) (labelBase : String) (overrideFree: Bool)
+    (defaultSummary : Option String := none)
     : TranslateM (ListMap Core.CoreLabel Core.Procedure.Check) :=
   checks.mapIdxM (fun i check => do
     let label := if checks.length == 1 then labelBase else s!"{labelBase}_{i}"
     let checkExpr ← translateExpr check.condition [] (isPureContext := true)
     let baseMd := astNodeToCoreMd check.condition
-    let md := match check.summary with
+    let md := match check.summary.orElse (fun _ => defaultSummary) with
       | some msg => baseMd.pushElem Imperative.MetaData.propertySummary (.msg msg)
       | none => baseMd
     let attr := if check.free || overrideFree then Core.Procedure.CheckAttr.Free else .Default
@@ -545,6 +623,9 @@ Diagnostics from disallowed constructs in preconditions, postconditions, and bod
 are emitted into the monad state.
 -/
 def translateProcedure (proc : Procedure) : TranslateM Core.Procedure := do
+  -- Track inout parameter names for the `.Old (Var (Local n))` defensive check.
+  -- Reset to [] after the procedure so siblings start fresh.
+  modify fun s => { s with currentProcInouts := procInoutNames proc }
   let inputPairs ← proc.inputs.mapM translateParameterToCore
   let inputs := inputPairs
   let outputs ← proc.outputs.mapM translateParameterToCore
@@ -568,61 +649,20 @@ def translateProcedure (proc : Procedure) : TranslateM Core.Procedure := do
     | _ =>
       pure none
 
-  -- Translate postconditions for Opaque and Abstract bodies
+  -- Translate postconditions for Opaque and Abstract bodies. A bodiless
+  -- procedure (bodyStmts = none) gets its postconditions marked `free`
+  -- (overrideFree) so they are assumed, not checked — and an empty body.
   let postconditions : ListMap Core.CoreLabel Core.Procedure.Check ←
     match proc.body with
     | .Opaque postconds _ _ | .Abstract postconds =>
         translateChecks postconds s!"postcondition" bodyStmts.isNone
+          (defaultSummary := "postcondition")
     | _ => pure []
-
-  let body : List Core.Statement := [.block "$body" (bodyStmts.getD []) mdWithUnknownLoc]
+  -- Wrap body in a labeled block so early returns (exit) work correctly.
+  -- `bodyLabel` is the shared "$body" constant the resolver pre-registers.
+  let body : List Core.Statement := [.block bodyLabel (bodyStmts.getD []) mdWithUnknownLoc]
   let spec : Core.Procedure.Spec := { preconditions, postconditions }
-  return { header, spec, body }
-
-def translateInvokeOnAxiom (proc : Procedure) (trigger : StmtExprMd)
-    : TranslateM (Option Core.Decl) := do
-  let postconds := match proc.body with
-    | .Opaque postconds _ _ | .Abstract postconds => postconds
-    | _ => []
-  if postconds.isEmpty then return none
-  -- All input param names become bound variables.
-  -- buildQuants nests ∀ p1, ∀ p2, ..., ∀ pn :: body, so inside body the innermost
-  -- binder (pn) is de Bruijn index 0, and the outermost (p1) is index n-1.
-  -- translateExpr uses findIdx? on boundVars, so we must list params innermost-first
-  -- (i.e. reversed) so that pn → 0, ..., p1 → n-1.
-  let boundVars := proc.inputs.reverse.map (·.name)
-  -- Translate postconditions and trigger with the full bound-var context
-  let postcondExprs ← postconds.mapM (fun pc => translateExpr pc.condition boundVars (isPureContext := true))
-  let bodyExpr : Core.Expression.Expr := match postcondExprs with
-    | [] => .const () (.boolConst true)
-    | [e] => e
-    | e :: rest => rest.foldl (fun acc x => LExpr.mkApp () boolAndOp [acc, x]) e
-  let triggerExpr ← translateExpr trigger boundVars (isPureContext := true)
-  -- Wrap in ∀ from outermost (first param) to innermost (last param).
-  -- The trigger is placed on the innermost quantifier.
-  let quantified ← buildQuants proc.inputs bodyExpr triggerExpr
-  return some (.ax { name := s!"invokeOn_{proc.name.text}", e := quantified } (identifierToCoreMd proc.name))
-where
-  /-- Build `∀ p1 ... pn :: { trigger } body`. The trigger is on the innermost quantifier. -/
-  buildQuants (params : List Parameter)
-      (body : Core.Expression.Expr) (trigger : Core.Expression.Expr)
-      : TranslateM Core.Expression.Expr := do
-    match params with
-    | [] => return body
-    | [p] =>
-      return LExpr.allTr () p.name.text (some (← translateType p.type)) trigger body
-    | p :: rest => do
-      let inner ← buildQuants rest body trigger
-      return LExpr.all () p.name.text (some (← translateType p.type)) inner
-
-structure LaurelTranslateOptions where
-  emitResolutionErrors : Bool := true
-  inlineFunctionsWhenPossible : Bool := false
-  overflowChecks : Core.OverflowChecks := {}
-  keepAllFilesPrefix : Option String := none
-
-instance : Inhabited LaurelTranslateOptions where
-  default := {}
+  return { header, spec, body := .structured body }
 
 structure LaurelVerifyOptions where
   translateOptions : LaurelTranslateOptions := {}
@@ -631,11 +671,21 @@ structure LaurelVerifyOptions where
 instance : Inhabited LaurelVerifyOptions where
   default := {}
 
+/-- Unwrap the pattern produced by EliminateValuesInReturns + EliminateReturnStatements:
+    `{ result := <expr>; exit "$return" } $return` → `<expr>` -/
+private def unwrapReturnBlock (b : StmtExprMd) : StmtExprMd :=
+  match b.val with
+  | .Block [⟨.Assign [⟨.Local _, _⟩] value, _⟩, ⟨.Exit "$return", _⟩] (some "$return") => value
+  | _ => b
+
 /--
 Translate a Laurel Procedure to a Core Function (when applicable) using `TranslateM`.
 Diagnostics for disallowed constructs in the function body are emitted into the monad state.
 -/
 def translateProcedureToFunction (options: LaurelTranslateOptions) (isRecursive: Bool) (proc : Procedure) : TranslateM Core.Decl := do
+  -- Functions are pure: no inout parameters, so the `.Old` defensive check
+  -- will reject any old(...) reference (which is the correct behavior here).
+  modify fun s => { s with currentProcInouts := [] }
   let inputs ← proc.inputs.mapM translateParameterToCore
   let outputTy ← match proc.outputs.head? with
     | some p => translateType p.type
@@ -666,10 +716,11 @@ def translateProcedureToFunction (options: LaurelTranslateOptions) (isRecursive:
     | none => if options.inlineFunctionsWhenPossible then #[.inline] else #[]
 
   let body ← match proc.body with
-    | .Transparent bodyExpr => some <$> translateExpr bodyExpr [] (isPureContext := true)
+    | .Transparent bodyExpr =>
+      some <$> translateExpr (unwrapReturnBlock bodyExpr) [] (isPureContext := true)
     | .Opaque _ (some bodyExpr) _ =>
       emitDiagnostic (diagnosticFromSource proc.name.source "functions with postconditions are not yet supported")
-      some <$> translateExpr bodyExpr [] (isPureContext := true)
+      some <$> translateExpr (unwrapReturnBlock bodyExpr) [] (isPureContext := true)
     | _ => pure none
   let f : Core.Function := {
     name := ⟨proc.name.text, ()⟩
@@ -711,7 +762,6 @@ abbrev TranslateResult := (Option Core.Program) × (List DiagnosticModel)
 
 /--
 Translate a `CoreWithLaurelTypes` program to a `Core.Program`.
-The `program` parameter is the lowered Laurel program, used for type definitions.
 -/
 def translateLaurelToCore (options: LaurelTranslateOptions) (ordered : CoreWithLaurelTypes): TranslateM Core.Program := do
 
@@ -728,13 +778,11 @@ def translateLaurelToCore (options: LaurelTranslateOptions) (ordered : CoreWithL
         return coreFuncs
     | .procedure proc => do
       let procDecl ← translateProcedure proc
-      -- Translate axioms from invokeOn
-      let invokeOnDecls ← match proc.invokeOn with
-        | some trigger => do
-          let axDecl? ← translateInvokeOnAxiom proc trigger
-          pure axDecl?.toList
-        | none => pure []
-      return [Core.Decl.proc procDecl (identifierToCoreMd proc.name)] ++ invokeOnDecls
+      -- Translate axioms (populated by the contract pass from invokeOn + ensures)
+      let axiomDecls ← proc.axioms.mapM fun ax => do
+        let coreExpr ← translateExpr ax [] (isPureContext := true)
+        return Core.Decl.ax { name := s!"invokeOn_{proc.name.text}", e := coreExpr } (identifierToCoreMd proc.name)
+      return [Core.Decl.proc procDecl (identifierToCoreMd proc.name)] ++ axiomDecls
     | .datatypes dts => do
       let ldatatypes ← dts.mapM translateDatatypeDefinition
       return [Core.Decl.type (.data ldatatypes) mdWithUnknownLoc]
@@ -751,5 +799,22 @@ def translateLaurelToCore (options: LaurelTranslateOptions) (ordered : CoreWithL
 
   pure { decls := coreDecls }
 
+public def laurelToCoreSchemaPass : LaurelPass CoreWithLaurelTypes Core.Program where
+  name := "LaurelToCoreSchemaPass"
+  comesBefore := []
+  documentation := "Produce a `Core` program from a `CoreWithLaurelTypes` program. Intended to be dumb 1-to-1 translation. However, there are several smart translations still happening:
+  - The @[cases] parameter is inferred for recursive functions.
+  - Laurel parameter definitions are translated to Core ones.
+  - Laurel calling conventions are translated to Core ones."
+  run := fun p fnModel options =>
+    let initState : TranslateState := { model := fnModel, overflowChecks := options.overflowChecks }
+    let (coreProgramOption, translateState) :=
+      runTranslateM initState (translateLaurelToCore options p)
+    let diagnostics : List DiagnosticModel :=
+      -- Because of the duplication between functions and procedures, this translation is liable to create duplicate diagnostics
+      let d := translateState.diagnostics.eraseDups
+      if d.isEmpty then translateState.coreDiagnostics else d
+    (coreProgramOption.getD default, diagnostics, {})
+
 end -- public section
 end Laurel
diff --git a/Strata/Languages/Laurel/LaurelTypes.lean b/Strata/Languages/Laurel/LaurelTypes.lean
index d1e5126e2e..d462f5242e 100644
--- a/Strata/Languages/Laurel/LaurelTypes.lean
+++ b/Strata/Languages/Laurel/LaurelTypes.lean
@@ -5,7 +5,7 @@
 -/
 module
 
-public import Strata.Languages.Laurel.Resolution
+public import Strata.Languages.Laurel.SemanticModel
 
 public section
 
@@ -23,7 +23,8 @@ def getCallType (source : Option FileRange) (model : SemanticModel) (callee : Id
     | .datatypeConstructor t _ => ⟨ .UserDefined t, source ⟩
     | .datatypeDestructor _ fld => fld.type
     | .parameter p => p.type
-    | .staticProcedure proc => match proc.outputs with
+    | .staticProcedure proc | .instanceProcedure _ proc => match proc.outputs with
+      | [] => { val := .TVoid, source := source }
       | [singleOutput] => singleOutput.type
       | outputs => { val := .MultiValuedExpr (outputs.map (·.type)), source := none }
     | .unresolved source => { val := HighType.Unknown, source := source }
@@ -45,6 +46,7 @@ def computeExprType (model : SemanticModel) (expr : StmtExprMd) : HighTypeMd :=
   | .LiteralBool _ => ⟨ .TBool, source ⟩
   | .LiteralString _ => ⟨ .TString, source ⟩
   | .LiteralDecimal _ => ⟨ .TReal, source ⟩
+  | .LiteralBv _ width => ⟨ .TBv width, source ⟩
   -- Variables
   | .Var (.Local id) => (model.get id).getType
   | .Var (.Declare _) => ⟨ .TVoid, source ⟩
@@ -77,10 +79,16 @@ def computeExprType (model : SemanticModel) (expr : StmtExprMd) : HighTypeMd :=
         computeExprType model last
     | none => ⟨ .TVoid, source ⟩
   -- Statements
-  | .While _ _ _ _ => ⟨ .TVoid, source ⟩
+  | .While _ _ _ _ _ => ⟨ .TVoid, source ⟩
   | .Exit _ => ⟨ .TVoid, source ⟩
   | .Return _ => ⟨ .TVoid, source ⟩
   | .Assign _ value => computeExprType model value
+  | .IncrDecr _ _ target =>
+    -- The expression's type is the type of the target variable.
+    match target.val with
+    | .Local id => (model.get id).getType
+    | .Field _ fieldName => (model.get fieldName).getType
+    | .Declare _ => ⟨ .TVoid, source ⟩  -- shouldn't happen; rejected by translator
   | .Assert _ => ⟨ .TVoid, source ⟩
   | .Assume _ => ⟨ .TVoid, source ⟩
   -- Instance related
@@ -121,6 +129,7 @@ triggers heap parameterization. -/
 def isHeapRelevantType (ty : HighType) : Bool :=
   (classifyModifiesHighType ty).isSome
 
+
 end Strata.Laurel
 
 end
diff --git a/Strata/Languages/Laurel/LiftImperativeExpressions.lean b/Strata/Languages/Laurel/LiftImperativeExpressions.lean
index 30edec6ca5..971bafbf91 100644
--- a/Strata/Languages/Laurel/LiftImperativeExpressions.lean
+++ b/Strata/Languages/Laurel/LiftImperativeExpressions.lean
@@ -6,8 +6,10 @@
 module
 
 import Strata.Util.Tactics
+public import Strata.Languages.Laurel.LaurelPass
 public import Strata.Languages.Laurel.Resolution
 import Strata.Languages.Laurel.LaurelTypes
+import Strata.Languages.Laurel.TransparencyPass
 
 namespace Strata
 namespace Laurel
@@ -79,47 +81,38 @@ structure LiftState where
   condCounter : Nat := 0
   /-- All procedures in the program, used to look up return types of imperative calls -/
   procedures : List Procedure := []
+  /-- Names of callees whose calls should be treated as imperative (lifted) -/
+  imperativeCallees : List String := []
 
 @[expose] abbrev LiftM := StateM LiftState
 
-private def emptyMd : Option String := none
-
 private def freshTempFor (varName : Identifier) : LiftM Identifier := do
   let counters := (← get).varCounters
   let counter := counters.find? (·.1 == varName) |>.map (·.2) |>.getD 0
   modify fun s => { s with varCounters := (varName, counter + 1) :: s.varCounters.filter (·.1 != varName) }
   return s!"${varName.text}_{counter}"
 
-private def freshCondVar : LiftM Identifier := do
+private def freshTempVar : LiftM Identifier := do
   let n := (← get).condCounter
   modify fun s => { s with condCounter := n + 1 }
-  return s!"$c_{n}"
+  return s!"$cndtn_{n}"
 
 private def prepend (stmt : StmtExprMd) : LiftM Unit :=
   modify fun s => { s with prependedStmts := stmt :: s.prependedStmts }
 
+private def prependList (stmts : List StmtExprMd) : LiftM Unit :=
+  modify fun s => { s with prependedStmts := stmts ++ s.prependedStmts }
+
 private def onlyKeepSideEffectStmtsAndLast (stmts : List StmtExprMd) : LiftM (List StmtExprMd) := do
   match stmts with
   | [] => return []
   | _ =>
+    -- return stmts
     let last := stmts.getLast!
     let nonLast ← stmts.dropLast.flatMapM (fun s =>
       match s.val with
       | .Var (.Declare ..) | .Assign ([⟨.Declare .., _⟩]) _ => do
-          -- This addPrepend is a hack to work around Core not having let expressions
-          -- Otherwise we could keep them in the block
-          prepend s
-          pure []
-      | .Assert _ => do
-          -- Hack to work around Core not supporting assert expressions
-          -- Otherwise we could keep them in the block
-          prepend s
-          pure []
-      | .Assume _ => do
-          -- Hack to work around Core not supporting assume expressions
-          -- Otherwise we could keep them in the block
-          prepend s
-          pure []
+          pure [s]
 
       /-
       Any other impure StmtExpr, like .Assign, .Exit or .Return,
@@ -148,95 +141,104 @@ private def computeType (expr : StmtExprMd) : LiftM HighTypeMd := do
   let s ← get
   return computeExprType s.model expr
 
-/-- Check if an expression contains any assignments (recursively). -/
-def containsAssignment (expr : StmtExprMd) : Bool :=
+/-- Check if an expression contains any assignments or imperative calls
+(recursively). When `liftsAssertsAssumes` is set, asserts and assumes also
+count — these are lifted into statement position by `transformExpr`, so an
+if-then-else whose branch contains one must itself be lifted to keep the
+statement guarded by the condition. -/
+def containsAssignmentOrImperativeCall (imperativeCallees : List String) (expr : StmtExprMd)
+    (liftsAssertsAssumes : Bool := false) : Bool :=
   match expr with
   | AstNode.mk val _ =>
   match val with
   | .Assign .. => true
-  | .StaticCall _ args => args.attach.any (fun x => containsAssignment x.val)
-  | .PrimitiveOp _ args _ => args.attach.any (fun x => containsAssignment x.val)
-  | .Block stmts _ => stmts.attach.any (fun x => containsAssignment x.val)
+  | .IncrDecr .. => true
+  | .StaticCall name args1 =>
+    imperativeCallees.contains name.text ||
+      args1.attach.any (fun x => containsAssignmentOrImperativeCall imperativeCallees x.val liftsAssertsAssumes)
+  | .PrimitiveOp _ args2 _ => args2.attach.any (fun x => containsAssignmentOrImperativeCall imperativeCallees x.val liftsAssertsAssumes)
+  | .Block stmts _ => stmts.attach.any (fun x => containsAssignmentOrImperativeCall imperativeCallees x.val liftsAssertsAssumes)
   | .IfThenElse cond th el =>
-      containsAssignment cond || containsAssignment th ||
-      match el with | some e => containsAssignment e | none => false
+      containsAssignmentOrImperativeCall imperativeCallees cond liftsAssertsAssumes ||
+      containsAssignmentOrImperativeCall imperativeCallees th liftsAssertsAssumes ||
+      match el with | some e => containsAssignmentOrImperativeCall imperativeCallees e liftsAssertsAssumes | none => false
+  | .Assume cond => liftsAssertsAssumes || containsAssignmentOrImperativeCall imperativeCallees cond liftsAssertsAssumes
+  | .Assert cond => liftsAssertsAssumes || containsAssignmentOrImperativeCall imperativeCallees cond.condition liftsAssertsAssumes
+  | .InstanceCall target _ args =>
+      containsAssignmentOrImperativeCall imperativeCallees target liftsAssertsAssumes ||
+      args.attach.any (fun x => containsAssignmentOrImperativeCall imperativeCallees x.val liftsAssertsAssumes)
+  | .Quantifier _ _ trigger body =>
+      containsAssignmentOrImperativeCall imperativeCallees body liftsAssertsAssumes ||
+      match trigger with | some t => containsAssignmentOrImperativeCall imperativeCallees t liftsAssertsAssumes | none => false
+  | .Old value => containsAssignmentOrImperativeCall imperativeCallees value liftsAssertsAssumes
+  | .Fresh value => containsAssignmentOrImperativeCall imperativeCallees value liftsAssertsAssumes
+  | .ProveBy value proof =>
+      containsAssignmentOrImperativeCall imperativeCallees value liftsAssertsAssumes ||
+      containsAssignmentOrImperativeCall imperativeCallees proof liftsAssertsAssumes
+  | .ReferenceEquals lhs rhs =>
+      containsAssignmentOrImperativeCall imperativeCallees lhs liftsAssertsAssumes ||
+      containsAssignmentOrImperativeCall imperativeCallees rhs liftsAssertsAssumes
+  | .PureFieldUpdate target _ newValue =>
+      containsAssignmentOrImperativeCall imperativeCallees target liftsAssertsAssumes ||
+      containsAssignmentOrImperativeCall imperativeCallees newValue liftsAssertsAssumes
+  | .AsType target _ => containsAssignmentOrImperativeCall imperativeCallees target liftsAssertsAssumes
+  | .IsType target _ => containsAssignmentOrImperativeCall imperativeCallees target liftsAssertsAssumes
+  | .Assigned name => containsAssignmentOrImperativeCall imperativeCallees name liftsAssertsAssumes
+  | .ContractOf _ func => containsAssignmentOrImperativeCall imperativeCallees func liftsAssertsAssumes
+  | .Return (some v) => containsAssignmentOrImperativeCall imperativeCallees v liftsAssertsAssumes
   | _ => false
   termination_by expr
   decreasing_by
-    all_goals ((try cases x); simp_all; try term_by_mem)
+    all_goals (try cases x)
+    all_goals (try simp_all)
+    all_goals (try have := Condition.sizeOf_condition_lt ‹_›)
+    all_goals (try term_by_mem)
+    all_goals omega
 
-/-- Like containsAssignment but does NOT recurse into Blocks (treats them as opaque).
-    Used by assert/assume handlers to allow generated Block wrappers through. -/
-def containsBareAssignment (expr : StmtExprMd) : Bool :=
-  match expr with
-  | AstNode.mk val _ =>
-  match val with
-  | .Assign .. => true
-  | .StaticCall _ args => args.attach.any (fun x => containsBareAssignment x.val)
-  | .PrimitiveOp _ args _ => args.attach.any (fun x => containsBareAssignment x.val)
-  | .Block _ _ => false
-  | .IfThenElse cond th el =>
-      containsBareAssignment cond || containsBareAssignment th ||
-      match el with | some e => containsBareAssignment e | none => false
-  | _ => false
-  termination_by expr
-  decreasing_by
-    all_goals ((try cases x); simp_all; try term_by_mem)
+mutual
 
-/-- Check if an expression contains any non-functional procedure calls (recursively). -/
-def containsImperativeCall (model : SemanticModel) (expr : StmtExprMd) : Bool :=
-  match expr with
-  | AstNode.mk val _ =>
-  match val with
-  | .StaticCall name args =>
-    (match model.get name with
-    | .staticProcedure proc => !proc.isFunctional
-    | _ => false) ||
-      args.attach.any (fun x => containsImperativeCall model x.val)
-  | .PrimitiveOp _ args _ => args.attach.any (fun x => containsImperativeCall model x.val)
-  | .Block stmts _ => stmts.attach.any (fun x => containsImperativeCall model x.val)
-  | .IfThenElse cond th el =>
-      containsImperativeCall model cond ||
-      containsImperativeCall model th ||
-      match el with | some e => containsImperativeCall model e | none => false
-  | _ => false
-  termination_by expr
-  decreasing_by
-    all_goals ((try cases x); simp_all; try term_by_mem)
+def asLifted { t: Type } (runner: LiftM t) : LiftM t := do
+  let savedState ← get
+  modify fun s => { s with prependedStmts := [], subst := []}
+  let result ← runner
+  modify fun _ => savedState
+  return result
 
-/-- Check if an expression contains any assignments or non-functional procedure calls (recursively). -/
-def containsAssignmentOrImperativeCall (model : SemanticModel) (expr : StmtExprMd) : Bool :=
-  containsAssignment expr || containsImperativeCall model expr
+/--
+Process an expression in expression context, traversing arguments right to left.
+Assignments are lifted to prependedStmts and replaced with snapshot variable references.
+-/
+def transformLiftedExpr (expr : StmtExprMd) : LiftM (List StmtExprMd × StmtExprMd) := do
+  let savedSubst := (← get).subst
+  let savedPrepends ← takePrepends
+  modify fun s => { s with prependedStmts := [], subst := []}
+  let result ← transformExpr expr
+  let newPrepends ← takePrepends
+  modify fun s => { s with prependedStmts := savedPrepends, subst := savedSubst }
+  return (newPrepends, result)
+  termination_by (sizeOf expr, 3)
 
 /--
-Shared logic for lifting an assignment in expression position:
-prepends the assignment, creates before-snapshots for all targets,
-and updates substitutions. The value should already be transformed by the caller.
+Process an expression in expression context, traversing arguments right to left.
+Assignments are lifted to prependedStmts and replaced with snapshot variable references.
 -/
-private def liftAssignExpr (targets : List VariableMd) (seqValue : StmtExprMd)
-    (source : Option FileRange) : LiftM Unit := do
-  -- Prepend the assignment itself
-  prepend (⟨.Assign targets seqValue, source⟩)
-  -- Create a before-snapshot for each target and update substitutions
-  for target in targets do
-    match target.val with
-    | .Local varName =>
-        let snapshotName ← freshTempFor varName
-        let varType ← computeType (⟨ .Var (.Local varName), source⟩)
-        -- Snapshot goes before the assignment (cons pushes to front)
-        prepend (⟨.Assign [⟨.Declare ⟨snapshotName, varType⟩, source⟩] (⟨.Var (.Local varName), source⟩), source⟩)
-        setSubst varName snapshotName
-    | _ => pure ()
+def transformLiftedStmt (expr : StmtExprMd) : LiftM Unit := do
+  let savedSubst := (← get).subst
+  let previousPrepends := (← get).prependedStmts
+  modify fun s => { s with subst := [], prependedStmts := [] }
+  let result ← transformStmt expr
+  modify fun s => { s with subst := savedSubst, prependedStmts := previousPrepends }
+  prependList result
+  termination_by (sizeOf expr, 1)
 
-mutual
 /--
 Process an expression in expression context, traversing arguments right to left.
 Assignments are lifted to prependedStmts and replaced with snapshot variable references.
 -/
 def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do
-  match expr with
+  match h_node : expr with
   | AstNode.mk val source =>
-  match val with
+  match h_val : val with
   | .Var (.Local name) =>
       return ⟨.Var (.Local (← getSubst name)), source⟩
 
@@ -244,7 +246,7 @@ def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do
 
   | .Hole false (some holeType) =>
       -- Nondeterministic typed hole: lift to a fresh variable with no initializer (havoc)
-      let holeVar ← freshCondVar
+      let holeVar ← freshTempVar
       prepend ⟨ .Var (.Declare ⟨holeVar, holeType⟩), source⟩
       return ⟨ .Var (.Local holeVar), source ⟩
 
@@ -263,14 +265,23 @@ def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do
           if hasSubst then
             pure (⟨.Var (.Local (← getSubst param.name)), source⟩)
           else
-            return expr
+            pure (⟨.Var (.Local param.name), source⟩)
         | _ =>
           dbg_trace "Strata bug: non-identifier targets should have been removed before the lift expression phase";
           return expr
 
-      -- Use the original value (not seqValue) for the prepended assignment,
-      -- because prepended statements execute in program order and don't need substitutions.
-      liftAssignExpr targets value source
+      transformLiftedStmt expr
+
+      -- Create a before-snapshot for each target and update substitutions
+      for target in targets do
+        match target.val with
+        | .Local varName =>
+            let snapshotName ← freshTempFor varName
+            let varType ← computeType ⟨ .Var (.Local varName), source ⟩
+            -- Snapshot goes before the assignment (cons pushes to front)
+            prepend (⟨.Assign [⟨.Declare ⟨snapshotName, varType⟩, source⟩] (⟨.Var (.Local varName), source⟩), source⟩)
+            setSubst varName snapshotName
+        | _ => pure ()
 
       return resultExpr
 
@@ -280,71 +291,76 @@ def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do
       return ⟨.PrimitiveOp op seqArgs.reverse, source⟩
 
   | .StaticCall callee args =>
-    let model := (← get).model
-    let seqArgs ← args.reverse.mapM transformExpr
-    let seqCall := ⟨.StaticCall callee seqArgs.reverse, source⟩
-    if model.isFunction callee then
+    let imperativeCallees := (← get).imperativeCallees
+    if !imperativeCallees.contains callee.text then
+      let seqArgs ← args.reverse.mapM transformExpr
+      let seqCall := ⟨.StaticCall callee seqArgs.reverse, source⟩
       return seqCall
     else
-      -- Imperative call in expression position: lift to an assignment.
-      -- Only valid for single-output procedures (or unresolved ones where we
-      -- fall back to a single target). Multi-output procedures in expression
-      -- position are a bug in the upstream translation — Resolution should
-      -- emit a diagnostic for that case.
-      let outputs := match model.get callee with
-        | .staticProcedure proc => proc.outputs
-        | .instanceProcedure _ proc => proc.outputs
-        | _ => []
-      let callResultVar ← freshCondVar
-      let callResultType ← match outputs with
-        | [single] => pure single.type
-        | _ => computeType expr
-      let liftedCall := [
-        ⟨.Var (.Declare ⟨callResultVar, callResultType⟩), source⟩,
-        ⟨.Assign [⟨.Local callResultVar, source⟩] seqCall, source⟩
-      ]
-      modify fun s => { s with prependedStmts := s.prependedStmts ++ liftedCall}
+      let callResultVar ← freshTempVar
+      let callResultType ← computeType expr
+
+      let prepends ← asLifted (transformStmtAssignImperativeCall
+        [⟨ .Declare ⟨callResultVar, callResultType⟩, source⟩] callee args source source)
+      prependList prepends
       return ⟨.Var (.Local callResultVar), source⟩
 
   | .IfThenElse cond thenBranch elseBranch =>
-      let model :=  (← get).model
-      let thenHasAssign := containsAssignmentOrImperativeCall model thenBranch
+      let imperativeCallees := (← get).imperativeCallees
+      -- A branch must be lifted if it contains anything `transformExpr` would
+      -- hoist: assignments, imperative calls, asserts, or assumes. (Asserts and
+      -- assumes matter because hoisting them out of the branch would drop the
+      -- condition's guard — see `liftsAssertsAssumes`.)
+      let thenHasAssign := containsAssignmentOrImperativeCall imperativeCallees thenBranch (liftsAssertsAssumes := true)
       let elseHasAssign := match elseBranch with
-        | some e => containsAssignmentOrImperativeCall model e
+        | some e => containsAssignmentOrImperativeCall imperativeCallees e (liftsAssertsAssumes := true)
         | none => false
       if thenHasAssign || elseHasAssign then
+
+        -- Infer type from the ORIGINAL then-branch (not the transformed one),
+        -- because the transformed expression may reference freshly generated
+        -- variables (e.g. $c_2) that don't exist in the SemanticModel yet.
+        let condType ← computeType thenBranch
+        let needsCondVar := condType.val != .TVoid
+
         -- Lift the entire if-then-else. Introduce a fresh variable for the result.
-        let condVar ← freshCondVar
-        let seqCond ← transformExpr cond
+        let condVar ← freshTempVar
         -- Save outer state
         let savedSubst := (← get).subst
-        let savedPrepends := (← get).prependedStmts
+        let savedPrepends ← takePrepends
+
+        let seqCond ← transformExpr cond
+        let condPrepends ← takePrepends
         -- Process then-branch from scratch
         modify fun s => { s with prependedStmts := [], subst := [] }
         let seqThen ← transformExpr thenBranch
         let thenPrepends ← takePrepends
-        let thenBlock := ⟨.Block (thenPrepends ++ [⟨.Assign [⟨ .Local condVar, source⟩] seqThen, source⟩]) none, source⟩
+        let assignStmts := if needsCondVar then [⟨.Assign [⟨ .Local condVar, source⟩] seqThen, source⟩] else [seqThen]
+        let thenBlock := ⟨.Block (thenPrepends ++ assignStmts) none, source ⟩
         -- Process else-branch from scratch
         modify fun s => { s with prependedStmts := [], subst := [] }
         let seqElse ← match elseBranch with
           | some e => do
               let se ← transformExpr e
               let elsePrepends ← takePrepends
-              pure (some ⟨.Block (elsePrepends ++ [⟨.Assign [⟨ .Local condVar, source⟩] se, source⟩]) none, source⟩)
+              let assignStmts: List StmtExprMd := if needsCondVar then [⟨.Assign [⟨ .Local condVar, source⟩] se, source⟩] else [se];
+              pure (some (⟨.Block (elsePrepends ++ assignStmts) none, source ⟩))
           | none => pure none
         -- Restore outer state
         modify fun s => { s with subst := savedSubst, prependedStmts := savedPrepends }
-        -- Infer type from the ORIGINAL then-branch (not the transformed one),
-        -- because the transformed expression may reference freshly generated
-        -- variables (e.g. $c_2) that don't exist in the SemanticModel yet.
-        let condType ← computeType thenBranch
         -- IfThenElse added first (cons puts it deeper), then declaration (cons puts it on top)
         -- Output order: declaration, then if-then-else
         prepend (⟨.IfThenElse seqCond thenBlock seqElse, source⟩)
-        prepend ⟨.Var (.Declare ⟨condVar, condType⟩), source⟩
-        return ⟨.Var (.Local condVar), source⟩
+        if needsCondVar then
+          prepend ⟨.Var (.Declare ⟨condVar, condType⟩), source ⟩
+          modify fun s => { s with prependedStmts := condPrepends ++ s.prependedStmts }
+          return ⟨.Var (.Local condVar), source⟩
+        else
+          modify fun s => { s with prependedStmts := condPrepends ++ s.prependedStmts }
+          -- Unused value
+          return ⟨ .Hole, expr.source ⟩
       else
-        -- No assignments in branches — recurse normally
+        -- No liftable statements in branches — recurse normally.
         let seqCond ← transformExpr cond
         let seqThen ← transformExpr thenBranch
         let seqElse ← match elseBranch with
@@ -390,10 +406,105 @@ def transformExpr (expr : StmtExprMd) : LiftM StmtExprMd := do
       else
         return expr
 
+  | .Assume cond =>
+      let (argPrepends, newCond) ← transformLiftedExpr cond
+      prepend ⟨ .Assume newCond, source⟩
+      prependList argPrepends
+      default
+
+  | .Assert cond =>
+      let (argPrepends, newCond) ← transformLiftedExpr cond.condition
+      prepend ⟨ .Assert {cond with condition := newCond}, source⟩
+      prependList argPrepends
+      default
+
+  | .Return (some retExpr) =>
+      let seqRet ← transformExpr retExpr
+      return ⟨.Return (some seqRet), source⟩
+
+  | .While cond invs dec body =>
+      let seqCond ← transformExpr cond
+      let seqInvs ← invs.mapM transformExpr
+      let seqDec ← match dec with
+        | some d => pure (some (← transformExpr d))
+        | none => pure none
+      let seqBody ← transformExpr body
+      return ⟨.While seqCond seqInvs seqDec seqBody, source⟩
+
+  | .PureFieldUpdate target fieldName newValue =>
+      let seqTarget ← transformExpr target
+      let seqNewValue ← transformExpr newValue
+      return ⟨.PureFieldUpdate seqTarget fieldName seqNewValue, source⟩
+
+  | .ReferenceEquals lhs rhs =>
+      let seqRhs ← transformExpr rhs
+      let seqLhs ← transformExpr lhs
+      return ⟨.ReferenceEquals seqLhs seqRhs, source⟩
+
+  | .AsType target ty =>
+      let seqTarget ← transformExpr target
+      return ⟨.AsType seqTarget ty, source⟩
+
+  | .IsType target ty =>
+      let seqTarget ← transformExpr target
+      return ⟨.IsType seqTarget ty, source⟩
+
+  | .InstanceCall target callee args =>
+      let seqArgs ← args.reverse.mapM transformExpr
+      let seqTarget ← transformExpr target
+      return ⟨.InstanceCall seqTarget callee seqArgs.reverse, source⟩
+
+  | .Quantifier mode param trigger body =>
+      let seqBody ← transformExpr body
+      let seqTrigger ← match trigger with
+        | some t => pure (some (← transformExpr t))
+        | none => pure none
+      return ⟨.Quantifier mode param seqTrigger seqBody, source⟩
+
+  | .Old value =>
+      let seqValue ← transformExpr value
+      return ⟨.Old seqValue, source⟩
+
+  | .Fresh value =>
+      let seqValue ← transformExpr value
+      return ⟨.Fresh seqValue, source⟩
+
+  | .Assigned name =>
+      let seqName ← transformExpr name
+      return ⟨.Assigned seqName, source⟩
+
+  | .ProveBy value proof =>
+      let seqValue ← transformExpr value
+      let seqProof ← transformExpr proof
+      return ⟨.ProveBy seqValue seqProof, source⟩
+
+  | .ContractOf ty func =>
+      let seqFunc ← transformExpr func
+      return ⟨.ContractOf ty seqFunc, source⟩
+
   | _ => return expr
-  termination_by (sizeOf expr, 0)
+  termination_by (sizeOf expr, 2)
   decreasing_by
-    all_goals (simp_all; try term_by_mem)
+    all_goals first
+      | (apply Prod.Lex.left; (try have := Condition.sizeOf_condition_lt ‹_›); term_by_mem)
+      | (apply Prod.Lex.left; simp <;> omega)
+      | (try subst h_node; try subst h_val; apply Prod.Lex.right; omega)
+
+def transformStmtAssignImperativeCall
+    (targets : List (AstNode Variable))
+    (callee: Identifier)
+    (args: List StmtExprMd)
+    (source: Option FileRange)
+    (callSource: Option FileRange): LiftM (List StmtExprMd) := do
+  let seqArgs ← args.reverse.mapM transformExpr
+  let argPrepends ← takePrepends
+  modify fun s => { s with subst := [] }
+  return argPrepends ++ [⟨.Assign targets ⟨.StaticCall callee seqArgs.reverse, callSource⟩, source⟩]
+  termination_by (sizeOf args, 0)
+  decreasing_by
+    all_goals try (apply Prod.Lex.right; omega)
+    all_goals (try simp_all; try have := Condition.sizeOf_condition_lt ‹_›; try term_by_mem)
+    all_goals (try (apply Prod.Lex.left); try term_by_mem; try omega)
 
 /--
 Process a statement, handling any assignments in its sub-expressions.
@@ -404,26 +515,24 @@ def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do
   | AstNode.mk val source =>
   match val with
   | .Assert cond =>
-      -- Do not transform assert conditions with bare assignments — they are
-      -- semantic errors that should be rejected downstream.
-      -- But Blocks with assignments (generated multi-output call wrappers)
-      -- are handled by the Block case in transformExpr above.
-      if !containsBareAssignment cond.condition then
+      -- Do not transform assert conditions with assignments — they must be rejected.
+      -- But nondeterministic holes need to be lifted.
+      -- if containsNondetHole cond.condition && !containsAssignmentOrImperativeCall (← get).model cond.condition then
         let seqCond ← transformExpr cond.condition
         let prepends ← takePrepends
         modify fun s => { s with subst := [] }
         return prepends ++ [⟨.Assert { cond with condition := seqCond }, source⟩]
-      else
-        return [stmt]
+      -- else
+      --   return [stmt]
 
   | .Assume cond =>
-      if !containsBareAssignment cond then
+      -- if containsNondetHole cond && !containsAssignmentOrImperativeCall (← get).model cond then
         let seqCond ← transformExpr cond
         let prepends ← takePrepends
         modify fun s => { s with subst := [] }
         return prepends ++ [⟨.Assume seqCond, source⟩]
-      else
-        return [stmt]
+      -- else
+      --   return [stmt]
 
   | .Block stmts metadata =>
       let seqStmts ← stmts.mapM transformStmt
@@ -436,20 +545,17 @@ def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do
       -- If the RHS is a direct imperative StaticCall, don't lift it —
       -- translateStmt handles Assign + StaticCall directly as a call statement.
       match _: valueMd with
-      | AstNode.mk value _ =>
+      | AstNode.mk value callSource =>
       match _: value with
       | .StaticCall callee args =>
-          let model := (← get).model
-          if model.isFunction callee then
+          let imperativeCallees := (← get).imperativeCallees
+          if imperativeCallees.contains callee.text then
+            transformStmtAssignImperativeCall targets callee args source callSource
+          else
             let seqValue ← transformExpr valueMd
             let prepends ← takePrepends
             modify fun s => { s with subst := [] }
             return prepends ++ [⟨.Assign targets seqValue, source⟩]
-          else
-            let seqArgs ← args.mapM transformExpr
-            let argPrepends ← takePrepends
-            modify fun s => { s with subst := [] }
-            return argPrepends ++ [⟨.Assign targets ⟨.StaticCall callee seqArgs, source⟩, source⟩]
       | _ =>
           let seqValue ← transformExpr valueMd
           let prepends ← takePrepends
@@ -461,15 +567,15 @@ def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do
       let condPrepends ← takePrepends
       let seqThen ← do
         let stmts ← transformStmt thenBranch
-        pure ⟨.Block stmts none, source⟩
+        pure ⟨ .Block stmts none, source ⟩
       let seqElse ← match elseBranch with
         | some e => do
             let se ← transformStmt e
-            pure $ some ⟨.Block se none, source⟩
+            pure (some (⟨.Block se none, source ⟩))
         | none => pure none
       return condPrepends ++ [⟨.IfThenElse seqCond seqThen seqElse, source⟩]
 
-  | .While cond invs dec body =>
+  | .While cond invs dec body postTest =>
       let seqCond ← transformExpr cond
       let condPrepends ← takePrepends
       -- Process invariants and decreases through transformExpr for nondet holes
@@ -483,41 +589,62 @@ def transformStmt (stmt : StmtExprMd) : LiftM (List StmtExprMd) := do
         let stmts ← transformStmt body
         pure ⟨.Block stmts none, source⟩
       return condPrepends ++ invPrepends ++ decPrepends ++
-        [⟨.While seqCond seqInvs seqDec seqBody, source⟩]
+        [⟨.While seqCond seqInvs seqDec seqBody postTest, source⟩]
 
   | .StaticCall name args =>
       let seqArgs ← args.mapM transformExpr
       let prepends ← takePrepends
       return prepends ++ [⟨.StaticCall name seqArgs, source⟩]
 
+  | .PrimitiveOp _ args =>
+      -- A `PrimitiveOp` in statement position. If it carries any side effects
+      -- (an embedded assignment or imperative call — typically the result of
+      -- the postfix increment lowering `(x := x + 1) - 1`), lift them out and
+      -- discard the unused pure result. Otherwise leave the expression
+      -- statement intact so the Core translator can preserve it via
+      -- `exprAsUnusedInit`.
+      let imperativeCallees := (← get).imperativeCallees
+      if containsAssignmentOrImperativeCall imperativeCallees stmt then
+        let _ ← args.reverse.mapM transformExpr
+        let prepends ← takePrepends
+        modify fun s => { s with subst := [] }
+        return prepends
+      else
+        return [stmt]
+
   | .Return (some retExpr) =>
       let seqRet ← transformExpr retExpr
       let prepends ← takePrepends
       modify fun s => { s with subst := [] }
       return prepends ++ [⟨.Return (some seqRet), source⟩]
 
+  | .PrimitiveOp name args _ =>
+      let seqArgs ← args.mapM transformExpr
+      let prepends ← takePrepends
+      return prepends ++ [⟨.PrimitiveOp name seqArgs, source⟩]
   | _ =>
       return [stmt]
   termination_by (sizeOf stmt, 0)
   decreasing_by
-    all_goals (try term_by_mem)
-    all_goals (apply Prod.Lex.left; try term_by_mem)
+    all_goals try (apply Prod.Lex.right; omega)
+    all_goals (try simp_all; try have := Condition.sizeOf_condition_lt ‹_›; try term_by_mem)
+    all_goals (try (apply Prod.Lex.left); try term_by_mem; try omega)
 end
 
-def transformProcedureBody (proc : Procedure) (body : StmtExprMd) : LiftM StmtExprMd := do
+def transformProcedureBody (source: Option FileRange) (body : StmtExprMd) : LiftM StmtExprMd := do
   let stmts ← transformStmt body
   match stmts with
   | [single] => pure single
-  | multiple => pure ⟨.Block multiple none, proc.name.source⟩
+  | multiple => pure ⟨.Block multiple none, source ⟩
 
 def transformProcedure (proc : Procedure) : LiftM Procedure := do
   modify fun s => { s with subst := [], prependedStmts := [], varCounters := [] }
   match proc.body with
   | .Transparent bodyExpr =>
-      let seqBody ← transformProcedureBody proc bodyExpr
+      let seqBody ← transformProcedureBody proc.name.source bodyExpr
       pure { proc with body := .Transparent seqBody }
   | .Opaque postconds impl modif =>
-      let impl' ← impl.mapM (transformProcedureBody proc)
+      let impl' ← impl.mapM (transformProcedureBody proc.name.source)
       pure { proc with body := .Opaque postconds impl' modif }
   | .Abstract _ =>
       pure proc
@@ -526,11 +653,42 @@ def transformProcedure (proc : Procedure) : LiftM Procedure := do
 
 /--
 Transform a program to lift all assignments that occur in an expression context.
+When `procedureNames` is non-empty, only procedures whose name appears in the
+list are transformed; all others are left unchanged. When `procedureNames` is
+empty, no procedures are transformed.
 -/
-def liftExpressionAssignments (model: SemanticModel) (program : Program) : Program :=
-  let initState : LiftState := { model := model }
-  let (seqProcedures, _) := (program.staticProcedures.mapM transformProcedure).run initState
+def liftExpressionAssignments (program : Program)
+    (model : SemanticModel) (imperativeCallees : List String) : Program :=
+  let initState : LiftState := { model := model, imperativeCallees := imperativeCallees }
+  let transform := program.staticProcedures.mapM transformProcedure
+  let (seqProcedures, _) := transform.run initState
   { program with staticProcedures := seqProcedures }
 
 end -- public section
+
+/--
+Apply `liftExpressionAssignments` to the core (non-functional) procedures in an
+`UnorderedCoreWithLaurelTypes`. Only procedures whose names appear in the core
+procedure list are transformed; functions are left unchanged.
+-/
+def liftImperativeExpressionsInCore (uc : UnorderedCoreWithLaurelTypes)
+    (model : SemanticModel) : UnorderedCoreWithLaurelTypes :=
+  let imperativeCallees := uc.coreProcedures.map (·.name.text)
+  let liftedProgram := liftExpressionAssignments
+    { staticProcedures := uc.coreProcedures, staticFields := [], types := [], constants := [] }
+    model imperativeCallees
+  let liftedProcs := liftedProgram.staticProcedures
+  { uc with
+    functions := uc.functions
+    coreProcedures := liftedProcs
+  }
+
+public def liftImperativeExpressionsPass : LaurelPass UnorderedCoreWithLaurelTypes UnorderedCoreWithLaurelTypes where
+  name := "LiftImperativeExpressionsPass"
+  documentation := "Lifts assignments and other imperative expressions that appear in expression contexts into preceding statements. This is necessary because Strata Core does not support assignments within expressions. The pass introduces fresh temporary variables where needed."
+  comesAfter := [⟨ transparencyPass.meta, "The imperative expression lifting is only done in procedures, so it comes after the transparency pass"⟩]
+  needsResolves := true
+  run := fun p m _ =>
+    (liftImperativeExpressionsInCore p m, [], {})
+
 end Laurel
diff --git a/Strata/Languages/Laurel/LiftInstanceProcedures.lean b/Strata/Languages/Laurel/LiftInstanceProcedures.lean
new file mode 100644
index 0000000000..34ae4366c0
--- /dev/null
+++ b/Strata/Languages/Laurel/LiftInstanceProcedures.lean
@@ -0,0 +1,135 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Languages.Laurel.MapStmtExpr
+public import Strata.Languages.Laurel.Resolution
+public import Strata.Languages.Laurel.LaurelPass
+import Strata.Languages.Laurel.EliminateValueInReturns
+
+
+/-!
+# Lift Instance Procedures
+
+A Laurel-to-Laurel pass that lifts every instance procedure (a procedure
+defined inside a `composite` block) to a top-level static procedure with a
+mangled name `<CompositeName>$<methodName>`, then rewrites every call site
+that resolved to such an instance procedure to use the lifted name.
+
+After this pass:
+- `CompositeType.instanceProcedures` is empty for every composite.
+- `program.staticProcedures` contains the lifted procedures.
+- Every `InstanceCall` (from `obj#method(args)` surface syntax) points
+  at the lifted name. For `InstanceCall`, the receiver is prepended to
+  the argument list to match the lifted procedure's `self : <CompositeName>`
+  parameter.
+-/
+
+namespace Strata.Laurel
+
+/-! ## Lifting + call-site rewriting
+
+Lift instance procedures to static scope (e.g., procedure `proc`
+of composite type `T` will be lifted to `T$proc`).
+Then, rewrite caller-side of `obj#proc` to call the lifted procedure
+
+-/
+
+/-- Top-level name produced for a lifted instance procedure. -/
+def liftedProcName (typeName methodName : Identifier) : Identifier :=
+  {mkId s!"{typeName.text}${methodName.text}" with source := methodName.source}
+
+/-- Rewrite a single node so that any callee resolving to an instance procedure
+    is replaced by its lifted name. -/
+private def rewriteCallNode (model : SemanticModel) (expr : StmtExprMd) : StmtExprMd :=
+  match expr.val with
+  | .StaticCall callee args =>
+    match model.get? callee with
+    | some (.instanceProcedure typeName _) =>
+      let lifted := liftedProcName typeName callee
+      { expr with val := .StaticCall lifted args }
+    | _ => expr
+  | .InstanceCall target callee args =>
+    -- `obj#method(args)` surface syntax parses to InstanceCall. Flatten it to
+    -- a static call against the lifted name, prepending the receiver as the
+    -- first argument to match the lifted procedure's `self` parameter.
+    match model.get? callee with
+    | some (.instanceProcedure typeName _) =>
+      let lifted := liftedProcName typeName callee
+      { expr with val := .StaticCall lifted (target :: args) }
+    | _ => expr
+  | _ => expr
+
+/-- Apply call-site rewriting to every expression in a procedure. -/
+private def rewriteCallsInProc (model : SemanticModel) (proc : Procedure) : Procedure :=
+  let f := mapStmtExpr (rewriteCallNode model)
+  let resolveBody : Body → Body := fun body => match body with
+    | .Transparent b => .Transparent (f b)
+    | .Opaque ps impl modif =>
+      .Opaque (ps.map (·.mapCondition f)) (impl.map f) (modif.map f)
+    | .Abstract ps => .Abstract (ps.map (·.mapCondition f))
+    | .External => .External
+  { proc with
+    body := resolveBody proc.body
+    preconditions := proc.preconditions.map (·.mapCondition f)
+    decreases := proc.decreases.map f
+    invokeOn := proc.invokeOn.map f }
+
+/-- Apply call-site rewriting to a constrained type's constraint and witness. -/
+private def rewriteCallsInType (model : SemanticModel) (td : TypeDefinition) : TypeDefinition :=
+  match td with
+  | .Constrained ct =>
+    let f := mapStmtExpr (rewriteCallNode model)
+    .Constrained { ct with constraint := f ct.constraint, witness := f ct.witness }
+  | _ => td
+
+public section
+
+/--
+Lift every `proc ∈ ct.instanceProcedures` to a top-level static procedure
+named via `liftedProcName`, rewrite call sites that resolved to an instance
+procedure, and clear `instanceProcedures` on every composite.
+-/
+def liftInstanceProcedures (model : SemanticModel) (program : Program) : Program :=
+  -- Step 1: collect lifted clones
+  let liftedProcs : List Procedure :=
+    program.types.foldl (init := []) fun acc td =>
+      match td with
+      | .Composite ct =>
+        acc ++ ct.instanceProcedures.map fun proc =>
+          { proc with name := liftedProcName ct.name proc.name }
+      | _ => acc
+
+  if liftedProcs.isEmpty then program else
+
+  -- Step 2: rewrite call sites in procedure bodies and constrained-type
+  let rewrittenStaticProcs := program.staticProcedures.map (rewriteCallsInProc model)
+  let rewrittenLiftedProcs := liftedProcs.map (rewriteCallsInProc model)
+  let rewrittenTypes := program.types.map (rewriteCallsInType model)
+
+  -- Step 3: clear instanceProcedures on every composite.
+  let cleanedTypes := rewrittenTypes.map fun td =>
+    match td with
+    | .Composite ct => .Composite { ct with instanceProcedures := [] }
+    | _ => td
+
+  -- Step 4: append lifted procs.
+  { program with
+    staticProcedures := rewrittenStaticProcs ++ rewrittenLiftedProcs
+    types := cleanedTypes }
+
+end -- public section
+
+/-- Pipeline pass: lift instance procedures to top-level static procedures
+    and rewrite call sites to use the lifted names. -/
+public def liftInstanceProceduresPass : LoweringPass where
+  name := "LiftInstanceProcedures"
+  documentation := "Lifts every procedure declared inside a `composite` block to a top-level static procedure named `<CompositeName>$<methodName>` and rewrites call sites resolved to an instance procedure (including `obj#method(args)` surface syntax) to point at the lifted name. Clears `instanceProcedures` on every composite. Must run before HeapParameterization."
+  needsResolves := true
+  run := fun p m _ => (liftInstanceProcedures m p, [], {})
+  comesBefore := [⟨ eliminateValueInReturnsPass.meta, "eliminateValueInReturns only applies to static methods, hence all instance methods must have been lifted before." ⟩]
+
+end Strata.Laurel
diff --git a/Strata/Languages/Laurel/MapStmtExpr.lean b/Strata/Languages/Laurel/MapStmtExpr.lean
index 78567d5cc4..2ba11ebea7 100644
--- a/Strata/Languages/Laurel/MapStmtExpr.lean
+++ b/Strata/Languages/Laurel/MapStmtExpr.lean
@@ -22,78 +22,111 @@ Also provides `mapProcedureBodiesM` and `mapProgramM` to eliminate the
 
 namespace Strata.Laurel
 
+/-- Shared termination tactic for the `mapStmtExpr*` traversals. The argument is
+    the variable representing the expression being recursed on. -/
+local syntax "map_stmt_expr_decreasing" ident : tactic
+macro_rules
+  | `(tactic| map_stmt_expr_decreasing $x:ident) =>
+    `(tactic| (
+      all_goals simp_wf
+      all_goals (try have := AstNode.sizeOf_val_lt $x)
+      all_goals (try have := Condition.sizeOf_condition_lt ‹_›)
+      all_goals (try term_by_mem)
+      all_goals (revert $x; intro x; cases x; simp_all; omega)))
+
 public section
 
 /--
-Bottom-up monadic traversal of `StmtExprMd`. Recurses into all `StmtExprMd`
-children first, then applies `f` to the rebuilt node.
+Bottom-up monadic traversal that also tells `f` whether the node's *result is
+used* (`resultUsed`): `true` when the node sits in a value position (an operand,
+a condition, an assignment RHS, the value of a used block, …) and `false` when
+its result is discarded (a non-final statement of a block, a `while` body, …).
+
+`resultUsed` is an inherited (top-down) attribute, threaded into the recursive
+calls per constructor:
+- value-consuming positions (call/operator args, conditions, `Assign` RHS,
+  field targets, `Return`/`Assert`/`Assume`/quantifier/… operands) → `true`;
+- a `Block`'s statements → `false`, except the last, which inherits the block's
+  own `resultUsed` (the block evaluates to its last statement);
+- `IfThenElse` branches inherit the conditional's `resultUsed`; its condition is
+  always used;
+- a `While` body → `false`.
+
+The top-level `resultUsed` defaults to `false` (a procedure body is a statement).
 -/
-def mapStmtExprM [Monad m] (f : StmtExprMd → m StmtExprMd) (expr : StmtExprMd) : m StmtExprMd := do
+def mapStmtExprUsedM [Monad m] (f : Bool → StmtExprMd → m StmtExprMd)
+    (resultUsed : Bool) (expr : StmtExprMd) : m StmtExprMd := do
   let source := expr.source
   -- `.attach` wraps each element with a proof of membership, which the
   -- termination checker uses to show the recursive call is on a smaller value.
   let rebuilt ← match _h : expr.val with
   | .IfThenElse cond th el =>
-    pure ⟨.IfThenElse (← mapStmtExprM f cond) (← mapStmtExprM f th)
-      (← el.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e), source⟩
+    pure ⟨.IfThenElse (← mapStmtExprUsedM f true cond) (← mapStmtExprUsedM f resultUsed th)
+      (← el.attach.mapM fun ⟨e, _⟩ => mapStmtExprUsedM f resultUsed e), source⟩
   | .Block stmts label =>
-    pure ⟨.Block (← stmts.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e) label, source⟩
-  | .While cond invs dec body =>
-    pure ⟨.While (← mapStmtExprM f cond)
-      (← invs.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e)
-      (← dec.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e)
-      (← mapStmtExprM f body), source⟩
+    -- Only the last statement is in value position (and only if the block is).
+    let stmts' ← stmts.attach.mapIdxM fun i ⟨e, _⟩ =>
+      mapStmtExprUsedM f (resultUsed && i + 1 == stmts.length) e
+    pure ⟨.Block stmts' label, source⟩
+  | .While cond invs dec body postTest =>
+    pure ⟨.While (← mapStmtExprUsedM f true cond)
+      (← invs.attach.mapM fun ⟨e, _⟩ => mapStmtExprUsedM f true e)
+      (← dec.attach.mapM fun ⟨e, _⟩ => mapStmtExprUsedM f true e)
+      (← mapStmtExprUsedM f false body) postTest, source⟩
   | .Return v =>
-    pure ⟨.Return (← v.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e), source⟩
+    pure ⟨.Return (← v.attach.mapM fun ⟨e, _⟩ => mapStmtExprUsedM f true e), source⟩
   | .Assign targets value =>
     let targets' ← targets.attach.mapM fun ⟨v, _⟩ => do
       let ⟨vv, vs⟩ := v
       match vv with
       | .Field target fieldName =>
-        pure ⟨Variable.Field (← mapStmtExprM f target) fieldName, vs⟩
+        pure ⟨Variable.Field (← mapStmtExprUsedM f true target) fieldName, vs⟩
       | .Local _ | .Declare _ => pure v
-    pure ⟨.Assign targets' (← mapStmtExprM f value), source⟩
+    pure ⟨.Assign targets' (← mapStmtExprUsedM f true value), source⟩
   | .Var (.Field target fieldName) =>
-    pure ⟨.Var (.Field (← mapStmtExprM f target) fieldName), source⟩
+    pure ⟨.Var (.Field (← mapStmtExprUsedM f true target) fieldName), source⟩
+  | .IncrDecr mode op ⟨.Field tgt fieldName, vs⟩ =>
+    pure ⟨.IncrDecr mode op ⟨.Field (← mapStmtExprUsedM f true tgt) fieldName, vs⟩, source⟩
+  | .IncrDecr _ _ ⟨.Local _, _⟩ | .IncrDecr _ _ ⟨.Declare _, _⟩ => pure expr
   | .PureFieldUpdate target fieldName newValue =>
-    pure ⟨.PureFieldUpdate (← mapStmtExprM f target) fieldName (← mapStmtExprM f newValue), source⟩
+    pure ⟨.PureFieldUpdate (← mapStmtExprUsedM f true target) fieldName (← mapStmtExprUsedM f true newValue), source⟩
   | .StaticCall callee args =>
-    pure ⟨.StaticCall callee (← args.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e), source⟩
+    pure ⟨.StaticCall callee (← args.attach.mapM fun ⟨e, _⟩ => mapStmtExprUsedM f true e), source⟩
   | .PrimitiveOp op args skipProof =>
-    pure ⟨.PrimitiveOp op (← args.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e) skipProof, source⟩
+    pure ⟨.PrimitiveOp op (← args.attach.mapM fun ⟨e, _⟩ => mapStmtExprUsedM f true e) skipProof, source⟩
   | .ReferenceEquals lhs rhs =>
-    pure ⟨.ReferenceEquals (← mapStmtExprM f lhs) (← mapStmtExprM f rhs), source⟩
+    pure ⟨.ReferenceEquals (← mapStmtExprUsedM f true lhs) (← mapStmtExprUsedM f true rhs), source⟩
   | .AsType target ty =>
-    pure ⟨.AsType (← mapStmtExprM f target) ty, source⟩
+    pure ⟨.AsType (← mapStmtExprUsedM f true target) ty, source⟩
   | .IsType target ty =>
-    pure ⟨.IsType (← mapStmtExprM f target) ty, source⟩
+    pure ⟨.IsType (← mapStmtExprUsedM f true target) ty, source⟩
   | .InstanceCall target callee args =>
-    pure ⟨.InstanceCall (← mapStmtExprM f target) callee
-      (← args.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e), source⟩
+    pure ⟨.InstanceCall (← mapStmtExprUsedM f true target) callee
+      (← args.attach.mapM fun ⟨e, _⟩ => mapStmtExprUsedM f true e), source⟩
   | .Quantifier mode param trigger body =>
-    pure ⟨.Quantifier mode param (← trigger.attach.mapM fun ⟨e, _⟩ => mapStmtExprM f e)
-      (← mapStmtExprM f body), source⟩
+    pure ⟨.Quantifier mode param (← trigger.attach.mapM fun ⟨e, _⟩ => mapStmtExprUsedM f true e)
+      (← mapStmtExprUsedM f true body), source⟩
   | .Assigned name =>
-    pure ⟨.Assigned (← mapStmtExprM f name), source⟩
+    pure ⟨.Assigned (← mapStmtExprUsedM f true name), source⟩
   | .Old value =>
-    pure ⟨.Old (← mapStmtExprM f value), source⟩
+    pure ⟨.Old (← mapStmtExprUsedM f true value), source⟩
   | .Fresh value =>
-    pure ⟨.Fresh (← mapStmtExprM f value), source⟩
+    pure ⟨.Fresh (← mapStmtExprUsedM f true value), source⟩
   | .Assert cond =>
-    pure ⟨.Assert { cond with condition := ← mapStmtExprM f cond.condition }, source⟩
+    pure ⟨.Assert { cond with condition := ← mapStmtExprUsedM f true cond.condition }, source⟩
   | .Assume cond =>
-    pure ⟨.Assume (← mapStmtExprM f cond), source⟩
+    pure ⟨.Assume (← mapStmtExprUsedM f true cond), source⟩
   | .ProveBy value proof =>
-    pure ⟨.ProveBy (← mapStmtExprM f value) (← mapStmtExprM f proof), source⟩
+    pure ⟨.ProveBy (← mapStmtExprUsedM f true value) (← mapStmtExprUsedM f true proof), source⟩
   | .ContractOf ty func =>
-    pure ⟨.ContractOf ty (← mapStmtExprM f func), source⟩
+    pure ⟨.ContractOf ty (← mapStmtExprUsedM f true func), source⟩
   -- Leaves: no StmtExprMd children.
   -- ⚠ If a new StmtExpr constructor with StmtExprMd children is added,
   -- it must get its own arm above; otherwise all passes will silently
   -- skip recursion into those children.
-  | .Exit _ | .LiteralInt _ | .LiteralBool _ | .LiteralString _ | .LiteralDecimal _
+  | .Exit _ | .LiteralInt _ | .LiteralBool _ | .LiteralString _ | .LiteralDecimal _ | .LiteralBv _ _
   | .Var (.Local _) | .Var (.Declare _) | .New _ | .This | .Abstract | .All | .Hole .. => pure expr
-  f rebuilt
+  f resultUsed rebuilt
 termination_by sizeOf expr
 decreasing_by
   all_goals simp_wf
@@ -102,11 +135,197 @@ decreasing_by
   all_goals (try term_by_mem)
   all_goals (cases expr; simp_all; omega)
 
+/--
+Bottom-up monadic traversal of `StmtExprMd`. Recurses into all `StmtExprMd`
+children first, then applies `f` to the rebuilt node. A `resultUsed`-agnostic
+wrapper over `mapStmtExprUsedM`.
+-/
+def mapStmtExprM [Monad m] (f : StmtExprMd → m StmtExprMd) (expr : StmtExprMd) : m StmtExprMd :=
+  mapStmtExprUsedM (fun _ e => f e) false expr
+
 /-- Pure bottom-up traversal of `StmtExprMd`. -/
 def mapStmtExpr (f : StmtExprMd → StmtExprMd) (expr : StmtExprMd) : StmtExprMd :=
   (mapStmtExprM (m := Id) f expr)
 
+/--
+Bottom-up monadic traversal where `post` returns a list of statements, and both
+callbacks are told whether the node's *result is used* (`resultUsed`, threaded
+exactly as in `mapStmtExprUsedM`).
+- For `Block` nodes: each child is processed and the resulting lists are
+  flattened into the block's statement list. Only the last statement is in value
+  position (and only if the block itself is).
+- For all other nodes: if `post` returns a single element, that element is used
+  directly. If it returns multiple elements, they are wrapped in a new
+  `Block none` (whose value is its last element) — so returning
+  `[stmt, …, value]` in a *used* position yields a value-block, while the same
+  list flattens into siblings in statement position.
+
+`pre` works like in `mapStmtExprPrePostM`: returning `some` skips recursion.
+-/
+def mapStmtExprFlattenM [Monad m] (pre : Bool → StmtExprMd → m (Option (List StmtExprMd)))
+    (post : Bool → StmtExprMd → m (List StmtExprMd)) (resultUsed : Bool) (expr : StmtExprMd) : m StmtExprMd := do
+  let collapse (results : List StmtExprMd) (src : Option FileRange) : StmtExprMd :=
+    match results with
+    | [single] => single
+    | many => ⟨.Block many none, src⟩
+  -- `go` returns the (post-expanded) statement list for `e`. Value-position
+  -- children collapse that list into a single node (a value-block when it has
+  -- multiple statements); `Block` children keep their lists and splice them.
+  let rec go (used : Bool) (e : StmtExprMd) : m (List StmtExprMd) := do
+    match ← pre used e with
+    | some results => return results
+    | none =>
+    let source := e.source
+    let rebuilt ← match _h : e.val with
+    | .IfThenElse cond th el =>
+      pure ⟨.IfThenElse (collapse (← go true cond) cond.source) (collapse (← go used th) th.source)
+        (← el.attach.mapM fun ⟨x, _⟩ => do pure (collapse (← go used x) x.source)), source⟩
+    | .Block stmts label =>
+      let nested ← stmts.attach.mapIdxM fun i ⟨x, _⟩ => go (used && i + 1 == stmts.length) x
+      pure ⟨.Block nested.flatten label, source⟩
+    | .While cond invs dec body postTest =>
+      pure ⟨.While (collapse (← go true cond) cond.source)
+        (← invs.attach.mapM fun ⟨x, _⟩ => do pure (collapse (← go true x) x.source))
+        (← dec.attach.mapM fun ⟨x, _⟩ => do pure (collapse (← go true x) x.source))
+        (collapse (← go false body) body.source) postTest, source⟩
+    | .Return v =>
+      pure ⟨.Return (← v.attach.mapM fun ⟨x, _⟩ => do pure (collapse (← go true x) x.source)), source⟩
+    | .Assign targets value =>
+      let targets' ← targets.attach.mapM fun ⟨v, _⟩ => do
+        let ⟨vv, vs⟩ := v
+        match vv with
+        | .Field target fieldName =>
+          pure ⟨Variable.Field (collapse (← go true target) target.source) fieldName, vs⟩
+        | .Local _ | .Declare _ => pure v
+      pure ⟨.Assign targets' (collapse (← go true value) value.source), source⟩
+    | .Var (.Field target fieldName) =>
+      pure ⟨.Var (.Field (collapse (← go true target) target.source) fieldName), source⟩
+    | .IncrDecr mode op ⟨.Field tgt fieldName, vs⟩ =>
+      pure ⟨.IncrDecr mode op ⟨.Field (collapse (← go true tgt) tgt.source) fieldName, vs⟩, source⟩
+    | .IncrDecr _ _ ⟨.Local _, _⟩ | .IncrDecr _ _ ⟨.Declare _, _⟩ => pure e
+    | .PureFieldUpdate target fieldName newValue =>
+      pure ⟨.PureFieldUpdate (collapse (← go true target) target.source) fieldName
+        (collapse (← go true newValue) newValue.source), source⟩
+    | .StaticCall callee args =>
+      pure ⟨.StaticCall callee (← args.attach.mapM fun ⟨x, _⟩ => do pure (collapse (← go true x) x.source)), source⟩
+    | .PrimitiveOp op args skipProofs =>
+      pure ⟨.PrimitiveOp op (← args.attach.mapM fun ⟨x, _⟩ => do pure (collapse (← go true x) x.source)) skipProofs, source⟩
+    | .ReferenceEquals lhs rhs =>
+      pure ⟨.ReferenceEquals (collapse (← go true lhs) lhs.source) (collapse (← go true rhs) rhs.source), source⟩
+    | .AsType target ty =>
+      pure ⟨.AsType (collapse (← go true target) target.source) ty, source⟩
+    | .IsType target ty =>
+      pure ⟨.IsType (collapse (← go true target) target.source) ty, source⟩
+    | .InstanceCall target callee args =>
+      pure ⟨.InstanceCall (collapse (← go true target) target.source) callee
+        (← args.attach.mapM fun ⟨x, _⟩ => do pure (collapse (← go true x) x.source)), source⟩
+    | .Quantifier mode param trigger body =>
+      pure ⟨.Quantifier mode param (← trigger.attach.mapM fun ⟨x, _⟩ => do pure (collapse (← go true x) x.source))
+        (collapse (← go true body) body.source), source⟩
+    | .Assigned name => pure ⟨.Assigned (collapse (← go true name) name.source), source⟩
+    | .Old value => pure ⟨.Old (collapse (← go true value) value.source), source⟩
+    | .Fresh value => pure ⟨.Fresh (collapse (← go true value) value.source), source⟩
+    | .Assert cond =>
+      pure ⟨.Assert { cond with condition := collapse (← go true cond.condition) cond.condition.source }, source⟩
+    | .Assume cond => pure ⟨.Assume (collapse (← go true cond) cond.source), source⟩
+    | .ProveBy value proof =>
+      pure ⟨.ProveBy (collapse (← go true value) value.source) (collapse (← go true proof) proof.source), source⟩
+    | .ContractOf ty func => pure ⟨.ContractOf ty (collapse (← go true func) func.source), source⟩
+    | .Exit _ | .LiteralInt _ | .LiteralBool _ | .LiteralString _ | .LiteralDecimal _ | .LiteralBv _ _
+    | .Var (.Local _) | .Var (.Declare _) | .New _ | .This | .Abstract | .All | .Hole .. => pure e
+    post used rebuilt
+  termination_by sizeOf e
+  decreasing_by map_stmt_expr_decreasing e
+  return collapse (← go resultUsed expr) expr.source
+
+/-- Pure `resultUsed`-aware bottom-up traversal (see `mapStmtExprUsedM`). -/
+def mapStmtExprUsed (f : Bool → StmtExprMd → StmtExprMd) (resultUsed : Bool) (expr : StmtExprMd) : StmtExprMd :=
+  (mapStmtExprUsedM (m := Id) f resultUsed expr)
+
+/-
+Bottom-up monadic traversal with a pre-filter. Before recursing into a node's
+children, `pre` is called. If `pre` returns `some result`, that result is used
+directly (children are NOT recursed into). If `pre` returns `none`, normal
+bottom-up recursion proceeds and `post` is applied after children are rebuilt.
+-/
+def mapStmtExprPrePostM [Monad m] (pre : StmtExprMd → m (Option StmtExprMd))
+    (post : StmtExprMd → m StmtExprMd) (expr : StmtExprMd) : m StmtExprMd := do
+  match ← pre expr with
+  | some result => return result
+  | none =>
+  let source := expr.source
+  let rebuilt ← match _h : expr.val with
+  | .IfThenElse cond th el =>
+    pure ⟨.IfThenElse (← mapStmtExprPrePostM pre post cond) (← mapStmtExprPrePostM pre post th)
+      (← el.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e), source⟩
+  | .Block stmts label =>
+    pure ⟨.Block (← stmts.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e) label, source⟩
+  | .While cond invs dec body postTest =>
+    pure ⟨.While (← mapStmtExprPrePostM pre post cond)
+      (← invs.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e)
+      (← dec.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e)
+      (← mapStmtExprPrePostM pre post body) postTest, source⟩
+  | .Return v =>
+    pure ⟨.Return (← v.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e), source⟩
+  | .Assign targets value =>
+    let targets' ← targets.attach.mapM fun ⟨v, _⟩ => do
+      let ⟨vv, vs⟩ := v
+      match vv with
+      | .Field target fieldName =>
+        pure ⟨Variable.Field (← mapStmtExprPrePostM pre post target) fieldName, vs⟩
+      | .Local _ | .Declare _ => pure v
+    pure ⟨.Assign targets' (← mapStmtExprPrePostM pre post value), source⟩
+  | .Var (.Field target fieldName) =>
+    pure ⟨.Var (.Field (← mapStmtExprPrePostM pre post target) fieldName), source⟩
+  | .IncrDecr mode op target => match target with
+    | ⟨.Field tgt fieldName, vs⟩ => pure ⟨.IncrDecr mode op ⟨.Field (← mapStmtExprPrePostM pre post tgt) fieldName, vs⟩, source⟩
+    | ⟨.Local _, _⟩
+    | ⟨.Declare _, _⟩ => pure expr
+
+  | .PureFieldUpdate target fieldName newValue =>
+    pure ⟨.PureFieldUpdate (← mapStmtExprPrePostM pre post target) fieldName (← mapStmtExprPrePostM pre post newValue), source⟩
+  | .StaticCall callee args =>
+    pure ⟨.StaticCall callee (← args.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e), source⟩
+  | .PrimitiveOp op args skipProofs =>
+    pure ⟨.PrimitiveOp op (← args.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e) skipProofs, source⟩
+  | .ReferenceEquals lhs rhs =>
+    pure ⟨.ReferenceEquals (← mapStmtExprPrePostM pre post lhs) (← mapStmtExprPrePostM pre post rhs), source⟩
+  | .AsType target ty =>
+    pure ⟨.AsType (← mapStmtExprPrePostM pre post target) ty, source⟩
+  | .IsType target ty =>
+    pure ⟨.IsType (← mapStmtExprPrePostM pre post target) ty, source⟩
+  | .InstanceCall target callee args =>
+    pure ⟨.InstanceCall (← mapStmtExprPrePostM pre post target) callee
+      (← args.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e), source⟩
+  | .Quantifier mode param trigger body =>
+    pure ⟨.Quantifier mode param (← trigger.attach.mapM fun ⟨e, _⟩ => mapStmtExprPrePostM pre post e)
+      (← mapStmtExprPrePostM pre post body), source⟩
+  | .Assigned name =>
+    pure ⟨.Assigned (← mapStmtExprPrePostM pre post name), source⟩
+  | .Old value =>
+    pure ⟨.Old (← mapStmtExprPrePostM pre post value), source⟩
+  | .Fresh value =>
+    pure ⟨.Fresh (← mapStmtExprPrePostM pre post value), source⟩
+  | .Assert cond =>
+    pure ⟨.Assert { cond with condition := ← mapStmtExprPrePostM pre post cond.condition }, source⟩
+  | .Assume cond =>
+    pure ⟨.Assume (← mapStmtExprPrePostM pre post cond), source⟩
+  | .ProveBy value proof =>
+    pure ⟨.ProveBy (← mapStmtExprPrePostM pre post value) (← mapStmtExprPrePostM pre post proof), source⟩
+  | .ContractOf ty func =>
+    pure ⟨.ContractOf ty (← mapStmtExprPrePostM pre post func), source⟩
+  -- Leaves: no StmtExprMd children.
+  -- ⚠ If a new StmtExpr constructor with StmtExprMd children is added,
+  -- it must get its own arm above; otherwise all passes will silently
+  -- skip recursion into those children.
+  | .Exit _ | .LiteralInt _ | .LiteralBool _ | .LiteralString _ | .LiteralDecimal _ | .LiteralBv _ _
+  | .Var (.Local _) | .Var (.Declare _) | .New _ | .This | .Abstract | .All | .Hole .. => pure expr
+  post rebuilt
+termination_by sizeOf expr
+decreasing_by map_stmt_expr_decreasing expr
+
 /-- Apply a monadic transformation to all procedure bodies. -/
+@[expose]
 def mapProcedureBodiesM [Monad m] (f : StmtExprMd → m StmtExprMd) (proc : Procedure) : m Procedure := do
   match proc.body with
   | .Transparent b => return { proc with body := .Transparent (← f b) }
@@ -116,13 +335,30 @@ def mapProcedureBodiesM [Monad m] (f : StmtExprMd → m StmtExprMd) (proc : Proc
   | .External => return proc
 
 /-- Apply a monadic transformation to all `StmtExprMd` nodes in a procedure
-    (preconditions, decreases, body, and invokeOn). -/
+    (preconditions, decreases, body, invokeOn, and axioms). -/
 def mapProcedureM [Monad m] (f : StmtExprMd → m StmtExprMd) (proc : Procedure) : m Procedure := do
   let proc ← mapProcedureBodiesM f proc
   return { proc with
     preconditions := ← proc.preconditions.mapM (·.mapM f)
     decreases := ← proc.decreases.mapM f
-    invokeOn := ← proc.invokeOn.mapM f }
+    invokeOn := ← proc.invokeOn.mapM f
+    axioms := ← proc.axioms.mapM f }
+
+/-- Apply a monadic transformation to every procedure in a program — both
+    top-level static procedures and the instance procedures of composite types.
+    The single place that knows where procedures live in a `Program`, so passes
+    don't each re-enumerate `staticProcedures` and composite `instanceProcedures`. -/
+def mapProgramProceduresM [Monad m] (f : Procedure → m Procedure) (program : Program) : m Program := do
+  let staticProcedures ← program.staticProcedures.mapM f
+  let types ← program.types.mapM fun td =>
+    match td with
+    | .Composite ct => return .Composite { ct with instanceProcedures := ← ct.instanceProcedures.mapM f }
+    | other => pure other
+  return { program with staticProcedures := staticProcedures, types := types }
+
+/-- Pure variant of `mapProgramProceduresM`. -/
+def mapProgramProcedures (f : Procedure → Procedure) (program : Program) : Program :=
+  mapProgramProceduresM (m := Id) f program
 
 /-- Apply a monadic transformation to procedure bodies in a program.
     Does **not** traverse preconditions, decreases, or invokeOn — use
@@ -134,5 +370,107 @@ def mapProgramM [Monad m] (f : StmtExprMd → m StmtExprMd) (program : Program)
 def mapProgram (f : StmtExprMd → StmtExprMd) (program : Program) : Program :=
   mapProgramM (m := Id) f program
 
+/-! ## Type-annotation traversals
+
+`mapStmtExprHighTypesM` and friends apply a `HighType → HighType` rewrite to
+*every* type annotation reachable from a node / procedure / program, reusing
+`mapStmtExprM` for the structural recursion. This is the single source of truth
+for "rewrite all type references", so passes don't have to enumerate the
+type-carrying constructors by hand (and silently miss one). The supplied `f` is
+responsible for recursing into compound types (`TSet`/`TMap`/`Applied`/…). -/
+
+/-- Rewrite the declared type carried by a `Variable` (only `Declare` carries one). -/
+def mapVariableHighTypesM [Monad m] (f : HighTypeMd → m HighTypeMd) (v : Variable) : m Variable := do
+  match v with
+  | .Declare param => pure (.Declare { param with type := ← f param.type })
+  | .Local _ | .Field _ _ => pure v
+
+/--
+Apply `f` to every `HighType` annotation carried *directly* by a single
+`StmtExpr` node: local declarations (in `Var`, `Assign` targets, and `IncrDecr`
+targets), quantifier binders, `AsType`/`IsType` type arguments, and typed
+`Hole`s. Does **not** recurse into child expressions — compose with
+`mapStmtExprM` (see `mapStmtExprHighTypesM`) for a whole-tree traversal.
+-/
+def mapNodeHighTypesM [Monad m] (f : HighTypeMd → m HighTypeMd) (expr : StmtExprMd) : m StmtExprMd := do
+  let source := expr.source
+  match expr.val with
+  | .Var v => pure ⟨.Var (← mapVariableHighTypesM f v), source⟩
+  | .Assign targets value =>
+    let targets' ← targets.mapM (fun t => do pure (⟨← mapVariableHighTypesM f t.val, t.source⟩ : VariableMd))
+    pure ⟨.Assign targets' value, source⟩
+  | .IncrDecr mode op target =>
+    pure ⟨.IncrDecr mode op ⟨← mapVariableHighTypesM f target.val, target.source⟩, source⟩
+  | .Quantifier mode param trigger body =>
+    pure ⟨.Quantifier mode { param with type := ← f param.type } trigger body, source⟩
+  | .AsType target ty => pure ⟨.AsType target (← f ty), source⟩
+  | .IsType target ty => pure ⟨.IsType target (← f ty), source⟩
+  | .Hole det (some ty) => pure ⟨.Hole det (some (← f ty)), source⟩
+  | _ => pure expr
+
+/-- Apply `f` to every `HighType` annotation appearing anywhere in a `StmtExprMd`. -/
+def mapStmtExprHighTypesM [Monad m] (f : HighTypeMd → m HighTypeMd) (expr : StmtExprMd) : m StmtExprMd :=
+  mapStmtExprM (mapNodeHighTypesM f) expr
+
+/-- Pure version of `mapStmtExprHighTypesM`. -/
+def mapStmtExprHighTypes (f : HighTypeMd → HighTypeMd) (expr : StmtExprMd) : StmtExprMd :=
+  mapStmtExprHighTypesM (m := Id) f expr
+
+/-- Apply `f` to every `HighType` annotation in a procedure: parameter types,
+    body, preconditions, decreases measure, and auto-invocation trigger. -/
+def mapProcedureHighTypesM [Monad m] (f : HighTypeMd → m HighTypeMd) (proc : Procedure) : m Procedure := do
+  let mapExpr := mapStmtExprHighTypesM f
+  let mapParam (p : Parameter) : m Parameter := do pure { p with type := ← f p.type }
+  let body' ← match proc.body with
+    | .Transparent b => pure (.Transparent (← mapExpr b))
+    | .Opaque ps impl mods =>
+      pure (.Opaque (← ps.mapM (·.mapM mapExpr)) (← impl.mapM mapExpr) (← mods.mapM mapExpr))
+    | .Abstract ps => pure (.Abstract (← ps.mapM (·.mapM mapExpr)))
+    | .External => pure .External
+  return { proc with
+    inputs := ← proc.inputs.mapM mapParam
+    outputs := ← proc.outputs.mapM mapParam
+    body := body'
+    preconditions := ← proc.preconditions.mapM (·.mapM mapExpr)
+    decreases := ← proc.decreases.mapM mapExpr
+    invokeOn := ← proc.invokeOn.mapM mapExpr }
+
+/-- Apply `f` to every `HighType` annotation in a type definition: composite
+    fields and instance procedures, constrained base/constraint/witness,
+    datatype constructor argument types, and alias targets. -/
+def mapTypeDefinitionHighTypesM [Monad m] (f : HighTypeMd → m HighTypeMd) (td : TypeDefinition) : m TypeDefinition := do
+  match td with
+  | .Composite ct =>
+    pure (.Composite { ct with
+      fields := ← ct.fields.mapM (fun fld => do pure { fld with type := ← f fld.type })
+      instanceProcedures := ← ct.instanceProcedures.mapM (mapProcedureHighTypesM f) })
+  | .Constrained ct =>
+    pure (.Constrained { ct with
+      base := ← f ct.base
+      constraint := ← mapStmtExprHighTypesM f ct.constraint
+      witness := ← mapStmtExprHighTypesM f ct.witness })
+  | .Datatype dt =>
+    pure (.Datatype { dt with
+      constructors := ← dt.constructors.mapM (fun ctor => do
+        pure { ctor with args := ← ctor.args.mapM (fun p => do pure { p with type := ← f p.type }) }) })
+  | .Alias ta => pure (.Alias { ta with target := ← f ta.target })
+
+/-- Apply `f` to a constant's declared type and (optional) initializer. -/
+def mapConstantHighTypesM [Monad m] (f : HighTypeMd → m HighTypeMd) (c : Constant) : m Constant := do
+  pure { c with type := ← f c.type, initializer := ← c.initializer.mapM (mapStmtExprHighTypesM f) }
+
+/-- Apply `f` to every `HighType` annotation anywhere in a program: procedures,
+    static fields, type definitions, and constants. -/
+def mapProgramHighTypesM [Monad m] (f : HighTypeMd → m HighTypeMd) (program : Program) : m Program := do
+  return { program with
+    staticProcedures := ← program.staticProcedures.mapM (mapProcedureHighTypesM f)
+    staticFields := ← program.staticFields.mapM (fun fld => do pure { fld with type := ← f fld.type })
+    types := ← program.types.mapM (mapTypeDefinitionHighTypesM f)
+    constants := ← program.constants.mapM (mapConstantHighTypesM f) }
+
+/-- Pure version of `mapProgramHighTypesM`. -/
+def mapProgramHighTypes (f : HighTypeMd → HighTypeMd) (program : Program) : Program :=
+  mapProgramHighTypesM (m := Id) f program
+
 end -- public section
 end Strata.Laurel
diff --git a/Strata/Languages/Laurel/MergeAndLiftReturns.lean b/Strata/Languages/Laurel/MergeAndLiftReturns.lean
new file mode 100644
index 0000000000..06f44102d1
--- /dev/null
+++ b/Strata/Languages/Laurel/MergeAndLiftReturns.lean
@@ -0,0 +1,100 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Languages.Laurel.LaurelAST
+import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
+import Strata.Util.Tactics
+import Strata.Languages.Laurel.EliminateValueInReturns
+public import Strata.Languages.Laurel.LaurelPass
+
+/-!
+
+Given a transparent body, merge the returns into a single outer return.
+Emits a diagnostic if it fails at any step.
+
+-/
+
+namespace Strata.Laurel
+
+/-- Recurse into a statement, applying the guard-return rewrite inside blocks and branches.
+    Returns `Except DiagnosticModel StmtExprMd` so that unsupported statement forms produce
+    a diagnostic instead of panicking. -/
+def removeReturns (stmt : StmtExprMd) : Except DiagnosticModel StmtExprMd :=
+  match _h : stmt.val with
+  | .Return (some expr) => .ok expr
+  | .Block [head] _ => removeReturns head
+  | .Block (head :: tail) label => do
+    let newTail ← removeReturns ⟨.Block tail none, stmt.source⟩
+    let passThrough: StmtExprMd :=
+      let tailList := match newTail.val with
+        | .Block stmts _ => stmts
+        | _ => [newTail]
+      ⟨ .Block (head :: tailList) label, stmt.source ⟩
+    match _hhead : head.val with
+    | .IfThenElse cond thenBr none =>
+      let newThen ← removeReturns thenBr
+      .ok ⟨ .IfThenElse cond newThen newTail, head.source ⟩
+    | .Assign _ _ => .ok passThrough
+    | .Assume _ => .ok passThrough
+    | .Assert _ => .ok passThrough
+    | .Block _ _ => .ok passThrough
+    | .IfThenElse _ _ (some _) => .error (diagnosticFromSource head.source "in a transparent body, if-then-else is only supported as the last statement in a block")
+    | _ => .error (diagnosticFromSource head.source
+        s!"unsupported statement {head.val.constructorName} in block head")
+  | .IfThenElse cond thenBr (some elseBr) => do
+      let thenExpr ← removeReturns thenBr
+      let elseExpr ← removeReturns elseBr
+      .ok ⟨ .IfThenElse cond thenExpr (some elseExpr), stmt.source⟩
+  | _ => .error (diagnosticFromSource stmt.source
+      s!"ending a transparent body with a {stmt.val.constructorName} statement is not supported")
+termination_by sizeOf stmt.val
+decreasing_by
+  all_goals
+    simp only [_h, StmtExpr.Block.sizeOf_spec, StmtExpr.IfThenElse.sizeOf_spec,
+      List.cons.sizeOf_spec, List.nil.sizeOf_spec, Option.none.sizeOf_spec,
+      Option.some.sizeOf_spec]
+    try have hhd := AstNode.sizeOf_val_lt head
+    try have htb := AstNode.sizeOf_val_lt thenBr
+    try have heb := AstNode.sizeOf_val_lt elseBr
+    try simp only [_hhead, StmtExpr.IfThenElse.sizeOf_spec, Option.none.sizeOf_spec] at hhd
+    omega
+
+/-- Transform a single procedure by applying the guard-return elimination to its body.
+    Returns the procedure and any diagnostic emitted on failure. -/
+private def eliminateReturnsInExpression (proc : Procedure) : Procedure × List DiagnosticModel :=
+  match proc.body with
+  | .Transparent body =>
+    match removeReturns body with
+    | .ok result => ({ proc with body := .Transparent ⟨.Return result, body.source ⟩ }, [])
+    | .error diag => (proc, [diag])
+  | _ => (proc, [])
+
+public section
+
+/--
+Transform a program by eliminating returns in all procedure bodies.
+-/
+def mergeAndLiftReturns (program : Program) : Program × List DiagnosticModel :=
+  let (procs, diags) := program.staticProcedures.foldl (fun (ps, ds) proc =>
+    let (proc', procDiags) := eliminateReturnsInExpression proc
+    (proc' :: ps, ds ++ procDiags)
+  ) ([], [])
+  ({ program with staticProcedures := procs.reverse }, diags)
+
+end -- public section
+
+/-- Pipeline pass: merge and lift returns. -/
+public def mergeAndLiftReturnsPass : LoweringPass where
+  name := "MergeAndLiftReturns"
+  documentation := "Attempts to merge and lift returns so that only a single outer return remains, enabling the procedure to be more easily converted to a functional form."
+  needsResolves := true
+  comesBefore := [⟨ eliminateValueInReturnsPass.meta, "Lifts returns with a value, so the value should not yet have been lowered."⟩]
+  run := fun p _m _ =>
+    let (p', diags) := mergeAndLiftReturns p
+    (p', diags, {})
+
+end Laurel
diff --git a/Strata/Languages/Laurel/ModifiesClauses.lean b/Strata/Languages/Laurel/ModifiesClauses.lean
index 7a96f95766..dbe7eef50f 100644
--- a/Strata/Languages/Laurel/ModifiesClauses.lean
+++ b/Strata/Languages/Laurel/ModifiesClauses.lean
@@ -6,7 +6,9 @@
 module
 
 public import Strata.Languages.Laurel.Resolution
+public import Strata.Languages.Laurel.LaurelPass
 import Strata.Languages.Laurel.HeapParameterizationConstants
+import Strata.Languages.Laurel.HeapParameterization
 import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
 import Strata.Languages.Laurel.LaurelTypes
 
@@ -18,7 +20,7 @@ and conjoining it with the postcondition. After this pass, the modifies list
 is cleared since its semantics have been absorbed into the postcondition.
 
 This pass should run after heap parameterization, which has already:
-- Added explicit heap parameters ($heap_in, $heap)
+- Added explicit heap parameter ($heap as inout)
 - Transformed field accesses to readField/updateField calls
 - Collected field constants
 
@@ -27,7 +29,7 @@ all field values are preserved between the input and output heaps.
 
 Generates:
   forall $obj: Composite, $fld: Field =>
-    $obj < $heap_in.nextReference && notModified($obj) ==> readField($heap_in, $obj, $fld) == readField($heap, $obj, $fld)
+    $obj < old($heap).nextReference && notModified($obj) ==> readField(old($heap), $obj, $fld) == readField($heap, $obj, $fld)
 
 where `notModified($obj)` is the conjunction of `$obj != e` for each single entry `e`,
 and `!(select(s, $obj))` for each set entry `s`.
@@ -94,20 +96,20 @@ Build the modifies frame condition as a Laurel StmtExpr.
 Generates a single quantified formula:
 
   forall $obj: Composite, $fld: Field =>
-    notModified($obj) && $obj < $heap_in.nextReference ==> readField($heap_in, $obj, $fld) == readField($heap, $obj, $fld)
+    notModified($obj) && $obj < old($heap).nextReference ==> readField(old($heap), $obj, $fld) == readField($heap, $obj, $fld)
 
 Returns `none` if there are no entries.
 -/
 def buildModifiesEnsures (proc: Procedure) (model: SemanticModel) (modifiesExprs : List StmtExprMd)
-    (heapInName heapOutName : Identifier) : Option StmtExprMd :=
+    (heapName : Identifier) : Option StmtExprMd :=
   let entries := extractModifiesEntries model modifiesExprs
   let objName : Identifier := "$modifies_obj"
   let fldName : Identifier := "$modifies_fld"
   let obj := mkMd <| .Var (.Local objName)
   let fld := mkMd <| .Var (.Local fldName)
-  let heapIn := mkMd <| .Var (.Local heapInName)
-  let heapOut := mkMd <| .Var (.Local heapOutName)
-      -- Build the "obj is allocated" condition: Composite..ref($obj) < $heap_in.nextReference
+  let heapIn := mkMd <| .Old (mkMd (.Var (.Local heapName)))
+  let heapOut := mkMd <| .Var (.Local heapName)
+      -- Build the "obj is allocated" condition: Composite..ref($obj) < old($heap).nextReference
   let heapCounter := mkMd <| .StaticCall "Heap..nextReference!" [heapIn]
   let objRef := mkMd <| .StaticCall "Composite..ref!" [obj]
   let objAllocated := mkMd <| .PrimitiveOp .Lt [objRef, heapCounter]
@@ -115,17 +117,17 @@ def buildModifiesEnsures (proc: Procedure) (model: SemanticModel) (modifiesExprs
     then objAllocated
     else
       -- Build the "not modified" precondition from all entries
-      -- Combine: $obj < $heap_in.nextReference && notModified($obj)
+      -- Combine: $obj < old($heap).nextReference && notModified($obj)
       let notModified := conjoinAll (entries.map (buildNotModifiedForEntry obj))
       mkMd <| .PrimitiveOp .And [objAllocated, notModified]
-  -- Build: readField($heap_in, $obj, $fld) == readField($heap, $obj, $fld)
+  -- Build: readField(old($heap), $obj, $fld) == readField($heap, $obj, $fld)
   let readIn := mkMd <| .StaticCall "readField" [heapIn, obj, fld]
   let readOut := mkMd <| .StaticCall "readField" [heapOut, obj, fld]
   let heapUnchanged := mkMd <| .PrimitiveOp .Eq [readIn, readOut]
   -- Build: antecedent ==> heapUnchanged
   let implBody := mkMd <| .PrimitiveOp .Implies [antecedent, heapUnchanged]
   -- Build: forall $obj: Composite, $fld: Field => ...
-  let innerForall := mkMd <| .Quantifier .Forall ⟨ fldName, { val := .TTypedField { val := .TInt, source := none }, source := none } ⟩ none implBody
+  let innerForall := mkMd <| .Quantifier .Forall ⟨ fldName, { val := .UserDefined "Field", source := none } ⟩ none implBody
   let outerForall : StmtExprMd := { val := .Quantifier .Forall ⟨ objName, { val := .UserDefined "Composite", source := none } ⟩ none innerForall, source := proc.name.source }
   some outerForall
 
@@ -145,7 +147,7 @@ may modify anything on the heap), and the modifies list is simply cleared.
 
 If the procedure has a `$heap` but no modifies clause, adds a postcondition
 that all allocated objects are preserved between heaps:
-  `forall $obj: Composite, $fld: Field => $obj < $heap_in.nextReference ==> readField($heap_in, $obj, $fld) == readField($heap, $obj, $fld)`
+  `forall $obj: Composite, $fld: Field => $obj < old($heap).nextReference ==> readField(old($heap), $obj, $fld) == readField($heap, $obj, $fld)`
 
 If the modifies clause uses a wildcard (`*`), the frame condition is skipped
 entirely — the procedure may modify anything.
@@ -159,9 +161,8 @@ def transformModifiesClauses (model: SemanticModel)
         -- modifies * means the procedure can modify anything; no frame condition
         .ok { proc with body := .Opaque postconds impl [] }
       else if hasHeapOut proc then
-        let heapInName := heapInVarName
         let heapName := heapVarName
-        let frameCondition := buildModifiesEnsures proc model modifiesExprs heapInName heapName
+        let frameCondition := buildModifiesEnsures proc model modifiesExprs heapName
         let postconds' := match frameCondition with
           | some frame => postconds ++ [{ condition := frame, summary := "modifies clause" }]
           | none => postconds
@@ -231,4 +232,23 @@ def modifiesClausesTransform (model: SemanticModel) (program : Program) : Progra
   ({ program with staticProcedures := procs' }, errors)
 
 end -- public section
+
+/-- Pipeline pass: filter non-composite modifies clauses. -/
+public def filterNonCompositeModifiesPass : LoweringPass where
+  name := "FilterNonCompositeModifies"
+  documentation := "Filters modifies clauses that refer to non-composite types (e.g. primitives), which cannot be heap-parameterized. Emits a warning for each removed clause. Should run before heap parameterization so that phase remains agnostic to modifies clauses."
+  run := fun p m _ =>
+    let (p', diags) := filterNonCompositeModifies m p
+    (p', diags, {})
+
+/-- Pipeline pass: translate modifies clauses into ensures clauses. -/
+public def modifiesClausesTransformPass : LoweringPass where
+  name := "ModifiesClausesTransform"
+  documentation := "Translates modifies clauses into additional ensures clauses. The modifies clause of a procedure is translated into a quantified assertion that states objects not mentioned in the modifies clause have their field values preserved between the input and output heap."
+  needsResolves := true
+  comesAfter := [⟨ heapParameterizationPass.meta, "the modifies pass refers to several types and variables introduced by heap parameterization: Composite, Field, $heap_in, $heap."⟩]
+  run := fun p m _ =>
+    let (p', diags) := modifiesClausesTransform m p
+    (p', diags, {})
+
 end Strata.Laurel
diff --git a/Strata/Languages/Laurel/PushOldInward.lean b/Strata/Languages/Laurel/PushOldInward.lean
new file mode 100644
index 0000000000..c9db47123a
--- /dev/null
+++ b/Strata/Languages/Laurel/PushOldInward.lean
@@ -0,0 +1,89 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Languages.Laurel.MapStmtExpr
+public import Strata.Languages.Laurel.LaurelPass
+
+/-!
+# Push `Old` Inward
+
+Distribute `StmtExpr.Old` over its sub-expressions until each `Old` immediately
+wraps an inout `Var`. Warns on `old(e)` where `e` mentions no inout, and on
+nested `old(old(...))`.
+-/
+
+namespace Strata
+namespace Laurel
+
+public section
+
+structure PushOldState where
+  inoutNames : List String := []
+  diagnostics : List DiagnosticModel := []
+
+abbrev PushOldM := StateM PushOldState
+
+@[expose]
+def warn (source : Option FileRange) (msg : String) : PushOldM Unit :=
+  modify fun s => { s with diagnostics := s.diagnostics ++ [diagnosticFromSource source msg .Warning] }
+
+@[expose]
+def insideOld (expr : StmtExprMd) : StateT Bool PushOldM StmtExprMd := do
+  match expr.val with
+  | .Var (.Local name) =>
+    if (← getThe PushOldState).inoutNames.contains name.text then
+      set true
+      return ⟨.Old expr, expr.source⟩
+    else
+      return expr
+  | .Old inner =>
+    warn expr.source "nested `old(...)` has no effect"
+    return inner
+  | _ => return expr
+
+@[expose]
+def visitOld (expr : StmtExprMd) : PushOldM (Option StmtExprMd) := do
+  match expr.val with
+  | .Old inner =>
+    let (inner', changed) ← (mapStmtExprM insideOld inner).run false
+    if !changed then
+      warn expr.source "`old(...)` has no effect: expression contains no inout parameter"
+    return some inner'
+  | _ => return none
+
+@[expose]
+def pushOldInwardExpr (expr : StmtExprMd) : PushOldM StmtExprMd :=
+  mapStmtExprPrePostM visitOld pure expr
+
+@[expose]
+def procInoutNames (proc : Procedure) : List String :=
+  proc.inputs.filterMap fun inp =>
+    if proc.outputs.any (·.name == inp.name) then some inp.name.text else none
+
+@[expose]
+def transformProcedurePushOld (proc : Procedure) : PushOldM Procedure := do
+  modify fun s => { s with inoutNames := procInoutNames proc }
+  mapProcedureM pushOldInwardExpr proc
+
+/-- Push every `StmtExpr.Old` inward until it immediately wraps an inout
+    variable. Returns the rewritten program and any warnings emitted. -/
+def pushOldInward (program : Program) : Program × List DiagnosticModel :=
+  let (program', finalState) :=
+    (program.staticProcedures.mapM transformProcedurePushOld).run {}
+  ({ program with staticProcedures := program' }, finalState.diagnostics)
+
+/-- Pipeline pass: translate modifies clauses into ensures clauses. -/
+public def pushOldInwardPass : LoweringPass where
+  name := "pushOldInward"
+  documentation := "Distributes `old(...)` over its subexpressions until each `old` immediately wraps an inout variable. Warns on `old(e)` where `e` mentions no inout parameter and on nested `old(old(...))`."
+  run := fun p _ _ =>
+    let (p', diags) := pushOldInward p
+    (p', diags, {})
+
+end -- public section
+end Laurel
+end Strata
diff --git a/Strata/Languages/Laurel/Resolution.lean b/Strata/Languages/Laurel/Resolution.lean
index fc6246e871..a3e3e5090d 100644
--- a/Strata/Languages/Laurel/Resolution.lean
+++ b/Strata/Languages/Laurel/Resolution.lean
@@ -6,32 +6,83 @@
 module
 
 public import Strata.Languages.Laurel.LaurelAST
+public import Strata.Languages.Laurel.UnorderedCore
 public import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
-public import Strata.Languages.Laurel.TransparencyPass
 import Strata.Util.Tactics
+public import Strata.Languages.Laurel.SemanticModel
+public import Strata.Languages.Laurel.LaurelTypes
 import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
 
 /-!
 # Name Resolution Pass
 
-Assigns a unique numeric ID to every definition and reference node in a
-Laurel program, then resolves references to their definitions.
+Turns a freshly parsed Laurel `Program` (where every `Identifier` has
+`uniqueId := none`) into a program where every definition has a fresh numeric
+ID and every reference points to the ID of the definition it names. The pass
+also synthesizes a `HighType` for every `StmtExpr` and emits diagnostics for
+unresolved names, duplicate definitions, kind mismatches (e.g. using a
+constant where a type is expected), and type mismatches.
+
+The entry point is `resolve`. It returns a `ResolutionResult` containing the
+resolved program, a `SemanticModel` (the `refToDef` map and ID counters), and
+the accumulated diagnostics.
 
 ## Design
 
-The resolution pass operates in two phases:
+The resolution pass operates in two phases.
 
 ### Phase 1: ID Assignment and Reference Resolution
-Walks the AST, assigning fresh unique IDs to all definition nodes and
-resolving references by looking up names in the current lexical scope.
-After this phase, every definition and reference node has its `id` field
-filled in.
+
+Walks the AST under `ResolveM`, a state monad over `ResolveState`. Phase 1:
+- assigns fresh unique IDs to all definition nodes via `defineNameCheckDup`,
+- resolves references by looking up names in the current lexical scope via
+  `resolveRef` (and `resolveFieldRef` for fields, which uses the target's
+  declared type to build a qualified lookup key),
+- opens fresh nested scopes via `withScope` for blocks, quantifiers,
+  procedure bodies, and constrained-type constraint/witness expressions,
+- synthesizes a `HighType` for every `StmtExpr` and checks it (via
+  `Check.resolveStmtExpr` for fresh subexpressions, or `checkSubtype` when a type is
+  already in hand) on assignments, call arguments, condition positions,
+  functional bodies, and constant initializers.
+
+Before any bodies are walked, `preRegisterTopLevel` registers every top-level
+name (types and their constructors / testers / destructors / instance
+procedures / fields, constants, static procedures) into scope with a
+placeholder `ResolvedNode`. The placeholders are overwritten with real nodes
+as each definition is fully resolved. This is what allows declaration order to
+not matter inside a Laurel program.
+
+When a reference fails to resolve, or a `UserDefined` type reference resolves
+to the wrong kind, Phase 1 records the name as `ResolvedNode.unresolved` (or
+the type as `HighType.Unknown`) and continues. Both are treated as wildcards
+by the type checker, so subsequent uses do not produce cascading errors.
+
+After this phase, every definition and reference node has its `uniqueId`
+field filled in.
 
 ### Phase 2: Build refToDef Map
+
 Walks the *resolved* AST (where all definitions already have their UUIDs)
-and builds a map from each definition's ID to its `ResolvedNode`. Because this
-happens after Phase 1, the `ResolvedNode` values in the map contain the fully
-resolved sub-trees (e.g. a procedure's parameters already have their IDs).
+and builds a map from each definition's ID to its `ResolvedNode`. Because
+this happens after Phase 1, the `ResolvedNode` values in the map contain the
+fully resolved sub-trees (e.g. a procedure's parameters already have their
+IDs).
+
+### Scopes
+
+Three forms of scope are maintained on `ResolveState`:
+- `scope` — the current lexical scope, mapping name → `(uniqueId, ResolvedNode)`,
+  saved and restored by `withScope`.
+- `currentScopeNames` — names defined at the current nesting level only, used
+  by `defineNameCheckDup` to detect duplicates.
+- `typeScopes` — per-composite-type scopes mapping field names to scope
+  entries. Built by `resolveTypeDefinition` *before* descending into instance
+  procedures (and inheriting from `extending` parents), so that field
+  references inside method bodies can be resolved.
+- `instanceTypeName` — when resolving inside an instance procedure, the
+  owning composite type's name. Used by `resolveFieldRef` as a fallback so
+  that a bare `self.field` reference resolves through the type scope when
+  `self` has type `Any`.
 
 ### Definition nodes (introduce a name into scope)
 - `Variable.Declare` — local variable declaration (in `Assign` targets or `Var`)
@@ -52,148 +103,21 @@ resolved sub-trees (e.g. a procedure's parameters already have their IDs).
 - `StmtExpr.Exit` — exit a labelled block
 - `HighType.UserDefined` — type reference
 
-Each of these nodes carries an `id : Nat` field (defaulting to `0`).
-The ID assignment pass fills in unique values. The resolution pass then
-builds a map from reference IDs to `ResolvedNode` values describing the
-definition each reference resolves to.
+Each of these nodes carries a `uniqueId : Option Nat` field (defaulting to
+`none`). Phase 1 fills in unique values; Phase 2 then builds a map from
+reference IDs to `ResolvedNode` values describing the definition each
+reference resolves to.
 -/
 
 namespace Strata.Laurel
 
 public section
 
-/-! ## ResolvedNode — the target of a resolved reference -/
 
-/-- The kind (constructor tag) of a `ResolvedNode`, used to assert that a reference
-    resolves to the expected sort of definition. -/
-inductive ResolvedNodeKind where
-  | var
-  | parameter
-  | staticProcedure
-  | instanceProcedure
-  | field
-  | compositeType
-  | constrainedType
-  | datatypeDefinition
-  | datatypeConstructor
-  | datatypeDestructor
-  | typeAlias
-  | constant
-  | quantifierVar
-  | unresolved
-  deriving Repr, BEq
-
-def ResolvedNodeKind.name : ResolvedNodeKind → String
-  | .var               => "variable"
-  | .parameter         => "parameter"
-  | .staticProcedure   => "static procedure"
-  | .instanceProcedure => "instance procedure"
-  | .field             => "field"
-  | .compositeType     => "composite type"
-  | .constrainedType   => "constrained type"
-  | .datatypeDefinition => "datatype definition"
-  | .datatypeConstructor => "datatype constructor"
-  | .datatypeDestructor => "datatype destructor"
-  | .typeAlias         => "type alias"
-  | .constant          => "constant"
-  | .quantifierVar     => "quantifier variable"
-  | .unresolved        => "unresolved"
-
-/-- A definition-site AST node that a reference can resolve to. -/
-inductive ResolvedNode where
-  /-- A local variable declaration. -/
-  | var (name : Identifier) (type : HighTypeMd)
-  /-- A procedure parameter. -/
-  | parameter (param : Parameter)
-  /-- A static procedure. -/
-  | staticProcedure (proc : Procedure)
-  /-- An instance procedure (method) on a composite type. -/
-  | instanceProcedure (typeName : Identifier) (proc : Procedure)
-  /-- A field on a composite type. -/
-  | field (typeName : Identifier) (fld : Field)
-  /-- A composite type definition. -/
-  | compositeType (ty : CompositeType)
-  /-- A constrained type definition. -/
-  | constrainedType (ty : ConstrainedType)
-  /-- A datatype definition. -/
-  | datatypeDefinition (ty : DatatypeDefinition)
-  /-- A datatype constructor. -/
-  | datatypeConstructor (typeName : Identifier) (ctor : DatatypeConstructor)
-  /-- An auto-generated destructor (or unsafe `!`-destructor) for a datatype field.
-      `typeName` is the resolved Identifier of the parent datatype (with its
-      `uniqueId`), and `field` is the underlying constructor parameter. -/
-  | datatypeDestructor (typeName : Identifier) (field : Parameter)
-  /-- A type alias. -/
-  | typeAlias (ty : TypeAlias)
-  /-- A constant. -/
-  | constant (c : Constant)
-  /-- A quantifier-bound variable. -/
-  | quantifierVar (name : Identifier) (type : HighTypeMd)
-  | unresolved (referenceSource: Option FileRange)
-  deriving Repr
-
-instance : Inhabited ResolvedNode where
-  default := ResolvedNode.unresolved none
-
-/-- Return the constructor tag of a `ResolvedNode`. -/
-def ResolvedNode.kind : ResolvedNode → ResolvedNodeKind
-  | .var ..               => .var
-  | .parameter ..         => .parameter
-  | .staticProcedure ..   => .staticProcedure
-  | .instanceProcedure .. => .instanceProcedure
-  | .field ..             => .field
-  | .compositeType ..     => .compositeType
-  | .constrainedType ..   => .constrainedType
-  | .datatypeDefinition .. => .datatypeDefinition
-  | .datatypeConstructor .. => .datatypeConstructor
-  | .datatypeDestructor .. => .datatypeDestructor
-  | .typeAlias ..         => .typeAlias
-  | .constant ..          => .constant
-  | .quantifierVar ..     => .quantifierVar
-  | .unresolved _          => .unresolved
-
-def ResolvedNode.getType (node: ResolvedNode): HighTypeMd := match node with
- | .var _ type => type
- | .parameter p => p.type
- | .field _ f => f.type
- | .datatypeConstructor type _ => ⟨ .UserDefined type, none ⟩
- | .datatypeDestructor _ fld => fld.type
- | .constant c => c.type
- | .quantifierVar _ type => type
- | .unresolved source => ⟨ .Unknown, source ⟩
- | .staticProcedure _ | .instanceProcedure _ _ | .compositeType _
- | .constrainedType _ | .datatypeDefinition _ | .typeAlias _ => ⟨ .Unknown, none ⟩
-
-/-! ## Resolution result -/
-
-structure SemanticModel where
-  nextId: Nat
-  compositeCount: Nat
-  private refToDef: Std.HashMap Nat ResolvedNode
-  deriving Repr
-
-/-- Look up the resolved node for an identifier, returning `none` if the identifier
-    has no `uniqueId` or is not in the model. -/
-def SemanticModel.get? (model: SemanticModel) (iden: Identifier): Option ResolvedNode :=
-  iden.uniqueId.bind model.refToDef.get?
-
-def SemanticModel.get (model: SemanticModel) (iden: Identifier): ResolvedNode :=
-  (model.get? iden).getD default
-
-def SemanticModel.isFunction (model: SemanticModel) (id: Identifier): Bool :=
-  match model.get id with
-      | .staticProcedure proc => proc.isFunctional
-      | .parameter _ => true
-      | .datatypeConstructor _ _ => true
-      | .datatypeDestructor _ _ => true
-      | .constant _ => true
-      | .unresolved _ => true -- functions calls are more permissive, so true avoids possibly incorrect errors
-      | node =>
-          dbg_trace s!"Sound but incomplete BUG! id: {repr id}, is not a procedure, but a node {repr node}"
-          false
+/-! ## ResolvedNode — the target of a resolved reference -/
 
 /-- The output of the resolution pass. -/
-structure ResolutionResult where
+public structure ResolutionResult where
   /-- The program with unique IDs on all definition and reference nodes. -/
   program : Program
   /-- Map from reference node ID to the definition it resolves to. -/
@@ -204,13 +128,13 @@ structure ResolutionResult where
 /-! ## Phase 1: ID assignment and reference resolution -/
 
 /-- A scope entry stores the definition-site ID and the ResolvedNode for type lookups. -/
-@[expose] abbrev ScopeEntry := Nat × ResolvedNode
+abbrev ScopeEntry := Nat × ResolvedNode
 
 /-- Scope maps a name to its definition-site ID and optional ResolvedNode. -/
-@[expose] abbrev Scope := Std.HashMap String ScopeEntry
+abbrev Scope := Std.HashMap String ScopeEntry
 
 /-- Per-composite-type scope mapping field names to their scope entries. -/
-@[expose] abbrev TypeScopes := Std.HashMap String Scope
+abbrev TypeScopes := Std.HashMap String Scope
 
 /-- State threaded through the resolution pass. -/
 structure ResolveState where
@@ -218,21 +142,41 @@ structure ResolveState where
   nextId : Nat := 1
   /-- Current lexical scope (name → definition ID). -/
   scope : Scope := {}
+  /-- Map from definition uniqueId to its ResolvedNode. Populated alongside
+      `scope` whenever a definition is registered. Unlike `scope`, this map is
+      *not* saved/restored by `withScope` — uniqueIds are global. Used by
+      `getVarType` to look up types for references whose `text` doesn't match
+      a scope key (notably fields, which are scoped under qualified keys). -/
+  idToNode : Std.HashMap Nat ResolvedNode := {}
   /-- Names defined at the current scope level (for duplicate detection). -/
   currentScopeNames : Std.HashSet String := {}
   /-- Per-composite-type field scopes (type name → field name → scope entry). -/
   typeScopes : TypeScopes := {}
+  /-- Labels of enclosing labeled blocks, used by `Check.exit` to validate
+      that an `exit l` targets an in-scope label. Maintained as a separate
+      namespace (not part of `scope`) because labels are referenced by raw
+      string, not by `uniqueId`. -/
+  labelScope : Std.HashSet String := {}
   /-- Diagnostics collected during resolution. -/
   errors : Array DiagnosticModel := #[]
   /-- When resolving inside an instance procedure, the owning composite type name.
       Used by `resolveFieldRef` to resolve `self.field` when `self` has type `Any`. -/
   instanceTypeName : Option String := none
-  /-- True when resolving inside an expression where the value is used (e.g., as an
-      argument to another call or operator). Multi-output calls are only diagnosed
-      in value context, not in statement position or direct assignment RHS. -/
-  inValueContext : Bool := false
-
-@[expose] abbrev ResolveM := StateM ResolveState
+  /-- The declared output types of the enclosing procedure body, in
+      declaration order. `none` means we are not currently resolving
+      inside any procedure body (e.g. while resolving a constant
+      initializer); in that case `Return` cannot occur and is not
+      type-checked. Bound by `resolveProcedure` /
+      `resolveInstanceProcedure` on entry, restored on exit, and read
+      only by `Check.return` to type-check the optional payload of
+      `return e`. -/
+  answerType : Option (List HighTypeMd) := none
+  /-- Type-relation tables (alias/constrained unfolding + composite extending
+      chains) used by the subtyping/consistency checks. Built once from
+      `program.types` at the start of `resolve`. -/
+  typeLattice : TypeLattice := {}
+
+abbrev ResolveM := StateM ResolveState
 
 /-- Allocate a fresh unique ID. -/
 private def freshId : ResolveM Nat := do
@@ -260,8 +204,10 @@ def defineNameCheckDup (iden : Identifier) (node : ResolvedNode) (overrideResolu
         let id ← freshId
         pure ({ iden with uniqueId := some (id) }, id)
 
-    modify fun s => { s with scope := s.scope.insert resolutionName (uniqueId, node),
-                             currentScopeNames := s.currentScopeNames.insert resolutionName }
+    modify fun s => { s with
+      scope := s.scope.insert resolutionName (uniqueId, node),
+      idToNode := s.idToNode.insert uniqueId node,
+      currentScopeNames := s.currentScopeNames.insert resolutionName }
     return name'
 
 /-- Resolve a reference: look up the name in scope and assign the definition's ID.
@@ -285,10 +231,30 @@ def resolveRef (name : Identifier) (source : Option FileRange := none)
     modify fun s => { s with errors := s.errors.push diag }
     return { name with uniqueId := none }
 
-/-- Extract the UserDefined type name from a resolved target expression by looking up its scope entry. -/
+/-- Scope key for a name nested inside a container (composite, datatype),
+    used to disambiguate members in the flat global scope. -/
+private def containerScopedName (containerName memberName : Identifier) : Identifier :=
+  mkId s!"{containerName.text}${memberName.text}"
+
+/-- Declared type of `fieldName` in the scope of composite type `typeName`; `none` if
+    unknown. Shared by `targetTypeName` and `incrDecrTargetType`. (`resolveFieldInTypeScope`
+    below is the same walk returning the field's *id* instead of its type.) -/
+private def fieldTypeInScope (typeName : String) (fieldName : Identifier) : ResolveM (Option HighType) := do
+  let s ← get
+  match s.typeScopes.get? typeName with
+  | some typeScope =>
+    match typeScope.get? fieldName.text with
+    | some (_, node) => pure (some node.getType.val)
+    | none => pure none
+  | none => pure none
+
+/-- UserDefined type name of a resolved target: a local directly, or a chained field
+    access (`a#b#c`) by recursing on the inner target then `fieldTypeInScope`.
+    Self-recursive on `.Var (.Field inner _)`; the `decreasing_by` proof below holds
+    only because `inner` is a strict subterm of `target`, so recurse only on subterms. -/
 private def targetTypeName (target : StmtExprMd) : ResolveM (Option String) := do
   let s ← get
-  match target.val with
+  match _h : target.val with
   | .Var (.Local ref) =>
     match s.scope.get? ref.text with
     | some (_, node) =>
@@ -296,7 +262,20 @@ private def targetTypeName (target : StmtExprMd) : ResolveM (Option String) := d
       | .UserDefined typRef => pure (some typRef.text)
       | _ => pure none
     | none => pure none
+  | .Var (.Field inner fieldName) => do
+    match (← targetTypeName inner) with
+    | none => pure none
+    | some innerTy =>
+      match (← fieldTypeInScope innerTy fieldName) with
+      | some (.UserDefined typRef) => pure (some typRef.text)
+      | _ => pure none
   | _ => pure none
+  termination_by sizeOf target
+  decreasing_by
+    have := AstNode.sizeOf_val_lt target
+    have : sizeOf target.val = sizeOf (StmtExpr.Var (Variable.Field inner fieldName)) := congrArg sizeOf _h
+    simp at this
+    omega
 
 /-- Try to resolve a field name via a type scope lookup. Returns `some id` on success. -/
 private def resolveFieldInTypeScope (typeName : String) (fieldName : Identifier) : ResolveM (Option Identifier) := do
@@ -333,6 +312,17 @@ def withScope (action : ResolveM α) : ResolveM α := do
   modify fun s => { s with scope := savedScope, currentScopeNames := savedNames }
   return result
 
+/-- Run `action` with `label` (if any) added to `labelScope`, restoring the
+    previous label scope on exit. Used by `Check.block` so that `Check.exit`
+    can validate that `exit l` targets an enclosing labeled block. -/
+def withLabel (label : Option String) (action : ResolveM α) : ResolveM α := do
+  let savedLabels := (← get).labelScope
+  if let some l := label then
+    modify fun s => { s with labelScope := s.labelScope.insert l }
+  let result ← action
+  modify fun s => { s with labelScope := savedLabels }
+  return result
+
 /-! ## AST traversal (Phase 1) -/
 
 
@@ -343,10 +333,20 @@ def resolveHighType (ty : HighTypeMd) : ResolveM HighTypeMd := do
   | .UserDefined ref =>
     let ref' ← resolveRef ref ty.source
       (expected := #[.compositeType, .constrainedType, .datatypeDefinition, .typeAlias])
-    pure (.UserDefined ref')
-  | .TTypedField vt =>
-    let vt' ← resolveHighType vt
-    pure (.TTypedField vt')
+    -- If the reference failed to resolve (name not defined) or resolved to the
+    -- wrong kind, treat the type as Unknown to avoid cascading errors. The single
+    -- "is not defined" / "wrong kind" diagnostic was already emitted by `resolveRef`;
+    -- collapsing the dangling `UserDefined` to `Unknown` keeps the variable's later
+    -- uses from being type-checked against a phantom type. A name that genuinely
+    -- resolves to a composite/datatype/alias/constrained type stays `UserDefined`
+    -- so real subtype checking still works.
+    let s ← get
+    let kindOk : Bool := match s.scope.get? ref.text with
+      | some (_, node) => node.kind == .unresolved ||
+          (#[ResolvedNodeKind.compositeType, .constrainedType, .datatypeDefinition, .typeAlias].contains node.kind)
+      | none => false  -- name not defined: resolveRef already reported it
+    if kindOk then pure (HighType.UserDefined ref')
+    else pure HighType.Unknown
   | .TSet et =>
     let et' ← resolveHighType et
     pure (.TSet et')
@@ -370,187 +370,2194 @@ def resolveHighType (ty : HighTypeMd) : ResolveM HighTypeMd := do
   | other => pure other
   return { val := val', source := ty.source }
 
-def resolveStmtExpr (exprMd : StmtExprMd) : ResolveM StmtExprMd := do
-  match _: exprMd with
-  | AstNode.mk expr source =>
-  let val' ← match _: expr with
-  | .IfThenElse cond thenBr elseBr =>
-    let saved := (← get).inValueContext
-    modify fun s => { s with inValueContext := true }
-    let cond' ← resolveStmtExpr cond
-    modify fun s => { s with inValueContext := saved }
-    let thenBr' ← resolveStmtExpr thenBr
-    let elseBr' ← elseBr.attach.mapM (fun a => have := a.property; resolveStmtExpr a.val)
-    pure (.IfThenElse cond' thenBr' elseBr')
-  | .Block stmts label =>
-    withScope do
-      let stmts' ← stmts.mapM resolveStmtExpr
-      pure (.Block stmts' label)
-  | .While cond invs dec body =>
-    let saved := (← get).inValueContext
-    modify fun s => { s with inValueContext := true }
-    let cond' ← resolveStmtExpr cond
-    modify fun s => { s with inValueContext := saved }
-    let invs' ← invs.attach.mapM (fun a => have := a.property; resolveStmtExpr a.val)
-    let dec' ← dec.attach.mapM (fun a => have := a.property; resolveStmtExpr a.val)
-    let body' ← resolveStmtExpr body
-    pure (.While cond' invs' dec' body')
-  | .Exit target => pure (.Exit target)
-  | .Return val => do
-    let val' ← val.attach.mapM (fun a => have := a.property; resolveStmtExpr a.val)
-    pure (.Return val')
-  | .LiteralInt v => pure (.LiteralInt v)
-  | .LiteralBool v => pure (.LiteralBool v)
-  | .LiteralString v => pure (.LiteralString v)
-  | .LiteralDecimal v => pure (.LiteralDecimal v)
-  | .Var (.Local ref) =>
-    let ref' ← resolveRef ref source
-    pure (.Var (.Local ref'))
-  | .Var (.Declare param) =>
-    let ty' ← resolveHighType param.type
-    let name' ← defineNameCheckDup param.name (.var param.name ty')
-    pure (.Var (.Declare ⟨name', ty'⟩))
-  | .Assign targets value =>
-    let targets' ← targets.attach.mapM fun ⟨v, _⟩ => do
-      let ⟨vv, vs⟩ := v
-      match vv with
-      | .Local ref =>
-        let ref' ← resolveRef ref source
-        pure (⟨.Local ref', vs⟩ : VariableMd)
-      | .Field target fieldName =>
-        let target' ← resolveStmtExpr target
-        let fieldName' ← resolveFieldRef target' fieldName source
-        pure (⟨.Field target' fieldName', vs⟩ : VariableMd)
-      | .Declare param =>
-        let ty' ← resolveHighType param.type
-        let name' ← defineNameCheckDup param.name (.var param.name ty')
-        pure (⟨.Declare ⟨name', ty'⟩, vs⟩ : VariableMd)
-    let value' ← resolveStmtExpr value
-    -- Check that LHS target count matches the number of outputs from the RHS
-    let expectedOutputCount ← match value'.val with
-      | .StaticCall callee _ => do
-        let s ← get
-        match s.scope.get? callee.text with
-        | some (_, .staticProcedure proc) => pure proc.outputs.length
-        | some (_, .instanceProcedure _ proc) => pure proc.outputs.length
-        | _ => pure 1
-      | .InstanceCall _ callee _ => do
-        let s ← get
-        match s.scope.get? callee.text with
-        | some (_, .instanceProcedure _ proc) => pure proc.outputs.length
-        | some (_, .staticProcedure proc) => pure proc.outputs.length
-        | _ => pure 1
-      | _ => pure 1
-    if targets'.length != expectedOutputCount then
+/-- Format a type for use in diagnostics. -/
+private def formatType (ty : HighTypeMd) : String :=
+  match ty.val with
+  | .MultiValuedExpr tys =>
+    let parts := tys.map (fun t => toString (formatHighTypeVal t.val))
+    "(" ++ ", ".intercalate parts ++ ")"
+  | other => toString (formatHighTypeVal other)
+
+/-- Emit a type mismatch diagnostic. With a `construct`, the message is
+    "'<construct.constrName>' <problem>, got '<actual>'"; without,
+    "<problem>, got '<actual>'". When `actual` is `Unknown` the trailing
+    `got '…'` is dropped — "we couldn't synthesize a type" is the
+    statement, not "the type we got was Unknown". -/
+private def typeMismatch (source : Option FileRange) (construct : Option StmtExpr)
+    (problem : String) (actual : HighTypeMd) : ResolveM Unit := do
+  let constructor := match construct with
+    | some c => s!"'{c.constrName}' "
+    | none   => ""
+  let suffix := match actual.val with
+    | .Unknown => ""
+    | _        => s!", got '{formatType actual}'"
+  let diag := diagnosticFromSource source s!"{constructor}{problem}{suffix}"
+  modify fun s => { s with errors := s.errors.push diag }
+
+/-- Type-level subtype check: emits the standard "expected/got" diagnostic when
+    `actual` is not a consistent subtype of `expected`. Used at sites where the
+    actual type is already in hand (assignment, call args, body vs declared
+    output) — equivalent to `Check.resolveStmtExpr e expected` but without re-synthesizing. -/
+private def checkSubtype (source : Option FileRange) (expected : HighTypeMd) (actual : HighTypeMd) : ResolveM Unit := do
+  let ctx := (← get).typeLattice
+  unless isConsistentSubtype ctx actual expected do
+    typeMismatch source none s!"expected '{formatType expected}'" actual
+
+/-- Test whether a type is in the set of numeric primitives
+    (`TInt` / `TReal` / `TFloat64` / `TBv`). `Unknown` is
+    accepted as a gradual escape hatch. Aliases and constrained types are
+    unfolded first so e.g. `nat` (constrained over `int`) counts as numeric.
+    Used by Op-Cmp / Op-Arith. -/
+private def isNumeric (ctx : TypeLattice) (ty : HighTypeMd) : Bool :=
+  match (ctx.unfold ty).val with
+  | .TInt | .TReal | .TFloat64 | .TBv _ | .Unknown => true
+  | _ => false
+
+/-- Least upper bound of two types under the consistency relation
+    (Siek–Taha). On Laurel's flat lattice the join collapses to the
+    "more informative" side: `Unknown` and `T` yields `T`; equal
+    types (after unfolding) yield themselves; everything else is
+    inconsistent and yields `none`.
+
+    Used by [⇒] Op-Arith to fold operand types into a single result
+    type: a homogeneous arithmetic expression `1 + 2` yields `TInt`,
+    `1 + <?>` yields `TInt` (Unknown promotes), `<?> + <?>` yields
+    `Unknown`, and `1 + 2.0` is rejected. -/
+private def join (ctx : TypeLattice)
+    (a b : HighTypeMd) : Option HighTypeMd :=
+  let a' := ctx.unfold a
+  let b' := ctx.unfold b
+  match a'.val, b'.val with
+  | .Unknown, _ => some b
+  | _, .Unknown => some a
+  | _, _ => if highEq a' b' then some a else none
+
+/-- Test whether a type is a user-defined reference type. `Unknown` is accepted
+    as a gradual escape hatch. Used by Fresh and ReferenceEquals, which only
+    make sense on composite/datatype references. -/
+private def isReference (ctx : TypeLattice) (ty : HighTypeMd) : Bool :=
+  match (ctx.unfold ty).val with
+  | .UserDefined _ | .Unknown => true
+  | _ => false
+
+/-- Get the type of a resolved reference. Prefers the resolved definition by
+    `uniqueId` (the post-resolution ground truth, populated as definitions are
+    registered and never shadowed): a field reference carries its field's
+    `uniqueId`, but its bare `text` may collide with a same-named local in
+    `scope`, so a name-keyed lookup would read the shadowing local's type
+    instead of the field's. Falls back to a name lookup for references whose
+    `uniqueId` is not filled in — notably local loads, which `Synth.varLocal`
+    passes here unresolved and which are correctly keyed by `text` — and
+    finally to `Unknown`. -/
+private def getVarType (ref : Identifier) : ResolveM HighTypeMd := do
+  let s ← get
+  match ref.uniqueId.bind s.idToNode.get? with
+  | some node => pure node.getType
+  | none =>
+    match s.scope.get? ref.text with
+    | some (_, node) => pure node.getType
+    | none => pure { val := .Unknown, source := ref.source }
+
+/-- Get the call return type and parameter types for a callee from scope. -/
+private def getCallInfo (callee : Identifier) : ResolveM (HighTypeMd × List HighTypeMd) := do
+  let s ← get
+  match s.scope.get? callee.text with
+  | some (_, .staticProcedure proc) | some (_, .instanceProcedure _ proc) =>
+    let retTy := match proc.outputs with
+      | [] => { val := .TVoid, source := callee.source }
+      | [singleOutput] => singleOutput.type
+      | outputs => { val := .MultiValuedExpr (outputs.map (·.type)), source := none }
+    pure (retTy, proc.inputs.map (·.type))
+  | some (_, .datatypeConstructor t _) =>
+    -- Testers (e.g. "Color..isRed") return Bool; constructors return the type
+    if (callee.text.splitOn "..is").length > 1 then
+      pure ({ val := .TBool, source := callee.source }, [])
+    else
+      pure ({ val := .UserDefined t, source := callee.source }, [])
+  | some (_, .parameter p) => pure (p.type, [])
+  | some (_, .constant c) => pure (c.type, [])
+  | _ => pure ({ val := .Unknown, source := callee.source }, [])
+
+/-- The number of positional arguments `callee` accepts, *only* when it
+    genuinely resolves to a procedure with a known parameter count. Returns
+    `none` for every other resolution kind — unresolved names (whose
+    `getCallInfo` `paramTypes` is `[]` purely because the name was not found),
+    datatype constructors/testers, parameters, and constants — so that the
+    over-arity check in the call rules does not fire on those (which would
+    duplicate the already-reported name-resolution error, or wrongly flag a
+    constructor/parameter/constant call).
+
+    For an instance procedure the implicit `self` receiver is not supplied
+    positionally at an `InstanceCall` site, so it is dropped here exactly as
+    the `dropSelf` logic in `Synth.instanceCall` does. `dropSelf` is passed by
+    the caller: `false` for `Synth.staticCall` (no `self`), and `true` for an
+    instance procedure reached through `Synth.instanceCall`. -/
+private def procArity (callee : Identifier) (dropSelf : Bool) : ResolveM (Option Nat) := do
+  match (← get).scope.get? callee.text with
+  | some (_, .staticProcedure proc) => pure (some proc.inputs.length)
+  | some (_, .instanceProcedure _ proc) =>
+    pure (some (if dropSelf then proc.inputs.length - 1 else proc.inputs.length))
+  | _ => pure none
+
+/-- Unfold any constrained types down to their underlying base type
+    (e.g. `nat` ⇒ `int`). `fuel` keeps the function total; chains longer than
+    `fuel` simply stop unfolding (the conservative, no-false-positive direction). -/
+private def underlyingBaseType (s : ResolveState) (fuel : Nat) (ty : HighType) : HighType :=
+  match fuel with
+  | 0 => ty
+  | fuel + 1 =>
+    match ty with
+    | .UserDefined typRef =>
+      match s.scope.get? typRef.text with
+      | some (_, .constrainedType ct) => underlyingBaseType s fuel ct.base.val
+      | _ => ty
+    | _ => ty
+
+/-- Look up the declared type of an `IncrDecr` target during resolution.
+    Handles `Local` (scope lookup) and `Field` (type-scope lookup); returns
+    `none` when the type cannot be determined (e.g. an unresolved name). -/
+private def incrDecrTargetType (target : VariableMd) : ResolveM (Option HighType) := do
+  let s ← get
+  match target.val with
+  | .Local ref =>
+    match s.scope.get? ref.text with
+    | some (_, node) => pure (some node.getType.val)
+    | none => pure none
+  | .Field tgt fieldName =>
+    match (← targetTypeName tgt) with
+    | some typeName => fieldTypeInScope typeName fieldName
+    | none => pure none
+  | .Declare param => pure (some param.type.val)
+
+/-- Emit a diagnostic if `++`/`--` is applied to an unsupported element type.
+    Only `int` and int-based constrained types (e.g. `nat`) are supported by the
+    `EliminateIncrDecr` lowering; `bv`, `real`, and `float64` are rejected here
+    with a clear Laurel diagnostic (and a source range) rather than leaking a raw
+    Core unification error from a later pass. Unknown/unresolved types are left
+    alone so that resolution errors are not duplicated as spurious incr/decr
+    errors. -/
+private def checkIncrDecrTargetType (op : IncrDecrOp) (target : VariableMd)
+    (source : Option FileRange) : ResolveM Unit := do
+  match (← incrDecrTargetType target) with
+  | none => pure ()
+  | some ty =>
+    let s ← get
+    let baseTy := underlyingBaseType s 100 ty
+    let unsupported? : Option String := match baseTy with
+      | .TReal => some "real"
+      | .TFloat64 => some "float64"
+      | .TBv n => some s!"bv{n}"
+      | _ => none
+    match unsupported? with
+    | none => pure ()
+    | some tyName =>
+      let opName := match op with
+        | .Incr => "increment ('++')"
+        | .Decr => "decrement ('--')"
       let diag := diagnosticFromSource source
-        s!"Assignment target count mismatch: {targets'.length} targets but right-hand side produces {expectedOutputCount} values"
+        s!"The {opName} operator is only supported on 'int' and int-based \
+           constrained types (e.g. 'nat'), but the operand has type '{tyName}'. \
+           Use an explicit assignment instead, e.g. 'x := x + 1'."
       modify fun s => { s with errors := s.errors.push diag }
-    pure (.Assign targets' value')
+
+/-! ## Typing rules
+
+The judgment is bidirectional:
+
+```
+Γ ⊢ e ⇒ A          (Synth.resolveStmtExpr)
+Γ ⊢ e ⇐ A          (Check.resolveStmtExpr)
+```
+
+- `Γ` — lexical scope (variables, fields). Block labels live in a
+  separate namespace `Γ_lbl` (`ResolveState.labelScope`), consulted
+  only by `Check.exit`.
+- `A` — *value type* of the term.
+
+The `Return` rules additionally depend on the enclosing procedure's
+declared output-type list, written `T_o-bar` in the rule statements.
+That list is bound on entry to a procedure body (by
+`resolveProcedure` / `resolveInstanceProcedure`, stored on
+`ResolveState.answerType`) and consulted only by `Check.return`;
+every other rule is independent of it.
+
+Several constructs are *statements*: their job is to have an effect,
+not to produce a value. They are handled by `Synth.resolveStmtExpr`
+and synthesize `TVoid`:
+
+- **Control-flow terminators** (`Exit`, `Return`): they jump somewhere
+  else and never hand a value back.
+- **Effect-only forms** (`Assert`, `Assume`, `While`, `Var-Declare`):
+  they run and fall through without producing a value.
+
+In either case, `Check.statement` (the `⋄` judgment) simply
+synthesizes and discards the type, so any expression — including
+value-producing ones like calls — is admitted in statement position.
+
+`Assign` is the one statement that *does* produce a value: it
+synthesizes the type of its right-hand side (so `x := e` can be used
+where that type is expected), and its check rule skips the \[⇐\] Sub
+boundary check only when the expected type is `TVoid` — i.e. when the
+assignment is used purely for effect. `Block` routes the surrounding
+expected type to its last statement (the block's value); non-last
+statements are in effect position (synthesized and discarded via
+`Check.statement`).
+
+Each typing rule is implemented as its own helper inside the mutual
+block below. Helpers are grouped by section to mirror the *Typing
+rules* index in `LaurelDoc.lean`:
+
+- Literals — `Synth.litInt`, `Synth.litBool`, `Synth.litString`, `Synth.litDecimal`
+- Variables — `Synth.varLocal`, `Synth.varField`, `Check.varDeclare`
+- Control flow — `Check.while`, `Check.exit`, `Check.return`,
+  `Check.block`, `Check.ifThenElse`
+- Verification statements — `Check.assert`, `Check.assume`
+- Assignment — `Synth.assign`, `Check.assign`
+- Calls — `Synth.staticCall`, `Synth.instanceCall`
+- Primitive operations — `Synth.primitiveOp`, `Check.primitiveOp`
+- Object forms — `Synth.new`, `Synth.asType`, `Synth.isType`, `Synth.refEq`,
+  `Synth.pureFieldUpdate`
+- Verification expressions — `Synth.quantifier`, `Synth.assigned`,
+  `Synth.fresh`, `Synth.old`/`Check.old`, `Synth.proveBy`/`Check.proveBy`
+- Self reference — `Synth.this`
+- Untyped forms — `Synth.abstract`, `Synth.all`
+- ContractOf — `Synth.contractOf`
+- Holes — `Check.holeSome`, `Check.holeNone`
+
+The dispatch functions `Synth.resolveStmtExpr` and `Check.resolveStmtExpr`
+pattern-match on the constructor and delegate to the corresponding helper. -/
+
+namespace Resolution
+
+-- The `h : exprMd.val = .Foo args ...` parameters on the recursive helpers
+-- look unused to the linter, but each one is referenced by that helper's
+-- `decreasing_by` tactic to relate `sizeOf args` to `sizeOf exprMd`.
+set_option linter.unusedVariables false in
+-- The well-founded-recursion termination proofs for every helper in this
+-- large mutual block share a single elaboration heartbeat budget. Each
+-- `decreasing_by` rewrites the node equation (`rw [h]`) and then discharges
+-- the size goal with `term_by_mem` (which adds `List`/`Array` membership-size
+-- lemmas, then `simp_all` and `omega`). Their cumulative cost across ~30
+-- functions sits above the 200k default, so the budget is raised for the block.
+set_option maxHeartbeats 400000 in
+mutual
+
+-- ### Dispatch
+
+/-- Synth-mode resolution: resolve `e` and synthesize its `HighType`,
+    written `Γ ⊢ e ⇒ T`. Each constructor with a synthesis rule delegates
+    to its rule's helper. Statement-shaped constructs (`While`, `Exit`,
+    `Return`, `Assert`, `Assume`, `Var-Declare`) synthesize `TVoid`.
+
+    Synthesis returns a type inferred from the expression itself;
+    checking (`Check.resolveStmtExpr`) verifies that the expression has
+    a given expected type. The two functions are mutually recursive,
+    with termination on a lexicographic measure `(exprMd, tag)` — tag
+    `2` for synth, `3` for check, helpers smaller — so that subsumption
+    (which calls synth on the *same* expression) can decrease via
+    `Prod.Lex.right`. -/
+def Synth.resolveStmtExpr (exprMd : StmtExprMd) : ResolveM (StmtExprMd × HighTypeMd) := do
+  match h_node: exprMd with
+  | AstNode.mk expr source =>
+  let (val', ty) ← match h_expr: expr with
+  | .LiteralInt v => pure (Synth.litInt v source)
+  | .LiteralBool v => pure (Synth.litBool v source)
+  | .LiteralString v => pure (Synth.litString v source)
+  | .LiteralDecimal v => pure (Synth.litDecimal v source)
+  | .LiteralBv v width => pure (Synth.litBv v width source)
+  | .Var (.Local ref) => Synth.varLocal ref source
+  | .IncrDecr mode op target =>
+    Synth.incrDecr exprMd mode op target source (by rw [h_node])
   | .Var (.Field target fieldName) =>
-    let target' ← resolveStmtExpr target
-    let fieldName' ← resolveFieldRef target' fieldName source
-    pure (.Var (.Field target' fieldName'))
+    Synth.varField exprMd target fieldName source (by rw [h_node])
+  | .Assign targets value =>
+    Synth.assign exprMd targets value source (by rw [h_node])
   | .PureFieldUpdate target fieldName newVal =>
-    let target' ← resolveStmtExpr target
-    let fieldName' ← resolveFieldRef target' fieldName source
-    let newVal' ← resolveStmtExpr newVal
-    pure (.PureFieldUpdate target' fieldName' newVal')
+    Synth.pureFieldUpdate exprMd target fieldName newVal (by rw [h_node])
   | .StaticCall callee args =>
-    let callee' ← resolveRef callee source
-      (expected := #[.parameter, .staticProcedure, .datatypeConstructor, .datatypeDestructor, .constant])
-    -- Resolve arguments in value context (their results are used as values)
-    let saved := (← get).inValueContext
-    modify fun s => { s with inValueContext := true }
-    let args' ← args.mapM resolveStmtExpr
-    modify fun s => { s with inValueContext := saved }
-    -- Multi-output procedures must not appear in value context: the extra
-    -- outputs (e.g. error channels) would be silently discarded.
-    let s ← get
-    if s.inValueContext then
-      let outputCount := match s.scope.get? callee'.text with
-        | some (_, .staticProcedure proc) => proc.outputs.length
-        | some (_, .instanceProcedure _ proc) => proc.outputs.length
-        | _ => 0
-      if outputCount > 1 then
-        let diag := diagnosticFromSource source
-          s!"Multi-output procedure '{callee'.text}' used in expression position; it returns {outputCount} values but only one can be used here. Use a multi-target assignment instead."
-        modify fun s => { s with errors := s.errors.push diag }
-    pure (.StaticCall callee' args')
+    Synth.staticCall exprMd callee args source (by rw [h_node])
   | .PrimitiveOp op args skipProof =>
-    -- Resolve arguments in value context
-    let saved := (← get).inValueContext
-    modify fun s => { s with inValueContext := true }
-    let args' ← args.mapM resolveStmtExpr
-    modify fun s => { s with inValueContext := saved }
-    pure (.PrimitiveOp op args' skipProof)
-  | .New ref =>
-    let ref' ← resolveRef ref source
-      (expected := #[.compositeType, .datatypeDefinition])
-    pure (.New ref')
-  | .This => pure .This
+    Synth.primitiveOp exprMd expr op args skipProof source h_expr (by rw [h_node])
+  | .New ref => Synth.new ref source
+  | .This => Synth.this source
   | .ReferenceEquals lhs rhs =>
-    let lhs' ← resolveStmtExpr lhs
-    let rhs' ← resolveStmtExpr rhs
-    pure (.ReferenceEquals lhs' rhs')
+    Synth.refEq exprMd expr lhs rhs source h_expr (by rw [h_node])
   | .AsType target ty =>
-    let target' ← resolveStmtExpr target
-    let ty' ← resolveHighType ty
-    pure (.AsType target' ty')
+    Synth.asType exprMd target ty (by rw [h_node])
   | .IsType target ty =>
-    let target' ← resolveStmtExpr target
-    let ty' ← resolveHighType ty
-    pure (.IsType target' ty')
+    Synth.isType exprMd target ty source (by rw [h_node])
   | .InstanceCall target callee args =>
-    let target' ← resolveStmtExpr target
-    let callee' ← resolveRef callee source
-      (expected := #[.instanceProcedure, .staticProcedure])
-    let args' ← args.mapM resolveStmtExpr
-    pure (.InstanceCall target' callee' args')
+    Synth.instanceCall exprMd target callee args source (by rw [h_node])
   | .Quantifier mode param trigger body =>
-    withScope do
-      let paramTy' ← resolveHighType param.type
-      let paramName' ← defineNameCheckDup param.name (.quantifierVar param.name paramTy')
-      let trigger' ← trigger.attach.mapM (fun pv => have := pv.property; resolveStmtExpr pv.val)
-      let body' ← resolveStmtExpr body
-      pure (.Quantifier mode ⟨paramName', paramTy'⟩ trigger' body')
+    Synth.quantifier exprMd mode param trigger body source (by rw [h_node])
   | .Assigned name =>
-    let name' ← resolveStmtExpr name
-    pure (.Assigned name')
-  | .Old val =>
-    let val' ← resolveStmtExpr val
-    pure (.Old val')
+    Synth.assigned exprMd name source (by rw [h_node])
   | .Fresh val =>
-    let val' ← resolveStmtExpr val
-    pure (.Fresh val')
-  | .Assert ⟨condExpr, summary, free⟩ =>
-    let saved := (← get).inValueContext
-    modify fun s => { s with inValueContext := true }
-    let cond' ← resolveStmtExpr condExpr
-    modify fun s => { s with inValueContext := saved }
-    pure (.Assert { condition := cond', summary, free })
-  | .Assume cond =>
-    let saved := (← get).inValueContext
-    modify fun s => { s with inValueContext := true }
-    let cond' ← resolveStmtExpr cond
-    modify fun s => { s with inValueContext := saved }
-    pure (.Assume cond')
+    Synth.fresh exprMd expr val source h_expr (by rw [h_node])
+  | .Old val =>
+    Synth.old exprMd val source (by rw [h_node])
   | .ProveBy val proof =>
-    let val' ← resolveStmtExpr val
-    let proof' ← resolveStmtExpr proof
-    pure (.ProveBy val' proof')
+    Synth.proveBy exprMd val proof source (by rw [h_node])
   | .ContractOf ty fn =>
-    let fn' ← resolveStmtExpr fn
-    pure (.ContractOf ty fn')
-  | .Abstract => pure .Abstract
-  | .All => pure .All
-  | .Hole det type => match type with
-    | some ty =>
-      let ty' ← resolveHighType ty
-      pure (.Hole det ty')
-    | none => pure (.Hole det none)
-  return { val := val', source := source }
-  termination_by exprMd
-  decreasing_by all_goals term_by_mem
+    Synth.contractOf exprMd ty fn source (by rw [h_node])
+  | .Abstract => pure (Synth.abstract source)
+  | .All => pure (Synth.all source)
+  | .IfThenElse cond thenBr elseBr =>
+    Synth.ifThenElse exprMd cond thenBr elseBr source (by rw [h_node])
+  | .Block [] label => pure (.Block [] label, Synth.emptyBlock source)
+  | .Block (head :: tail) label =>
+    Synth.block exprMd (head :: tail) label source (by rw [h_node])
+  -- Holes in synth position are gradual: an annotated hole synthesizes its
+  -- declared type; an unannotated one is `Unknown`. Without this carve-out,
+  -- a hole appearing as the target of e.g. a field access (`<?>.f`) would
+  -- emit "type cannot be synthesized" and abort, which over-reports against
+  -- code where the hole's type is genuinely unknown to begin with.
+  | .Hole det none =>
+    pure (.Hole det none, { val := .Unknown, source := source })
+  | .Hole det (some ty) =>
+    let ty' ← resolveHighType ty
+    pure (.Hole det (some ty'), ty')
+  | .Var (.Declare param) => do
+    let r ← Check.varDeclare param source
+    return (r, ⟨ .TVoid, source ⟩)
+  | .While cond invs dec body postTest => do
+    let r ← Check.while exprMd cond invs dec body postTest source (by rw [h_node])
+    return (r, ⟨ .TVoid, source ⟩)
+  | .Exit target => do
+    let r ← Check.exit target source
+    return (r, ⟨ .TVoid, source ⟩)
+  | .Return val => do
+    let r ← Check.return exprMd val source (by rw [h_node])
+    return (r, ⟨ .TVoid, source ⟩)
+  | .Assert ⟨condExpr, summary, free⟩ => do
+    let r ← Check.assert exprMd condExpr summary free source (by rw [h_node])
+    return (r, ⟨ .TVoid, source ⟩)
+  | .Assume cond => do
+    let r ← Check.assume exprMd cond source (by rw [h_node])
+    return (r, ⟨ .TVoid, source ⟩)
+  return ({ val := val', source := source }, ty)
+  termination_by (exprMd, 2)
+  decreasing_by all_goals first
+    | (apply Prod.Lex.left; term_by_mem)
+    | (try subst h_node; apply Prod.Lex.right; decide)
+    | (apply Prod.Lex.right; decide)
+
+/-- Check-mode resolution (rule **Sub** at the boundary): resolve `e` and
+    verify its type is a consistent subtype of `expected`, written
+    `Γ ⊢ e ⇐ T`. Bidirectional rules for individual constructs push
+    `expected` into subexpressions rather than bouncing through
+    synthesis, which keeps error messages localized and lets the
+    expected type propagate through nested control flow. Constructs
+    with a dedicated `Check.<construct>` rule:
+
+    - bindings — `Var (.Declare …)`, `Assign`
+    - control flow — `Block`, `IfThenElse`, `While`, `Exit`, `Return`
+    - verification — `Assert`, `Assume`, `Old`, `ProveBy`
+    - holes — `Hole` (typed and untyped)
+    - primitive operations — `PrimitiveOp` (arithmetic and boolean
+      families only; comparison/equality/string-concat fall through to
+      the synth-then-subsume wildcard)
+
+    Everything else falls back to subsumption — synthesize, then verify
+    `isConsistentSubtype actual expected`.
+
+    The right principle for new call sites is: when the position has a
+    known expected type (`TBool` for conditions, numeric for `decreases`,
+    the declared output for a constant initializer or a functional body),
+    use `Check.resolveStmtExpr`. When it doesn't, use `resolveStmtExpr`
+    (a thin wrapper that calls `Synth.resolveStmtExpr` and discards the
+    synthesized type, used at sites where typing is not enforced —
+    verification annotations, modifies/reads clauses). -/
+def Check.resolveStmtExpr (exprMd : StmtExprMd) (expected : HighTypeMd) : ResolveM StmtExprMd := do
+  match h_node: exprMd with
+  | AstNode.mk expr source =>
+  match h_expr: expr with
+  -- Empty block has a fixed type `TVoid` (Synth.emptyBlock); the wildcard
+  -- arm below routes it through synth-then-Sub. Non-empty blocks have no
+  -- synth rule and are typed structurally by Check.block.
+  | .Block (head :: tail) label =>
+    Check.block exprMd (head :: tail) label expected source (by rw [h_node])
+  | .IfThenElse cond thenBr elseBr =>
+    Check.ifThenElse exprMd cond thenBr elseBr expected source (by rw [h_node])
+  | .Assign targets value =>
+    Check.assign exprMd targets value expected source (by rw [h_node])
+  | .Hole det none => pure (Check.holeNone det expected source)
+  | .Hole det (some ty) => Check.holeSome det ty expected source
+  | .Old val =>
+    Check.old exprMd val expected source (by rw [h_node])
+  | .ProveBy val proof =>
+    Check.proveBy exprMd val proof expected source (by rw [h_node])
+  -- Only the arithmetic (`Neg`/`Add`/…/`ModT`) and boolean
+  -- (`And`/`Or`/…/`Implies`) families get a dedicated check arm: these push
+  -- `expected` inward through `Check.primitiveOp`. The remaining operators —
+  -- comparison/equality (`Eq`/`Neq`/`Lt`/…) and `StrConcat` — have no inward
+  -- push, so they are deliberately omitted here and fall through to the
+  -- synth-then-subsume wildcard at the bottom of this match.
+  --
+  -- The arms are written out one operator per line rather than collapsed: an
+  -- inner `match op` would duplicate the wildcard's subsumption body, and a
+  -- binder distributed across an or-pattern (`.PrimitiveOp (op@.Neg) …`)
+  -- defeats the `by rw [h_node]` dependent-match proof, so the explicit
+  -- enumeration is the form that actually typechecks.
+  | .PrimitiveOp .Neg args skipProof =>
+    Check.primitiveOp exprMd .Neg args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .Add args skipProof =>
+    Check.primitiveOp exprMd .Add args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .Sub args skipProof =>
+    Check.primitiveOp exprMd .Sub args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .Mul args skipProof =>
+    Check.primitiveOp exprMd .Mul args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .Div args skipProof =>
+    Check.primitiveOp exprMd .Div args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .Mod args skipProof =>
+    Check.primitiveOp exprMd .Mod args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .DivT args skipProof =>
+    Check.primitiveOp exprMd .DivT args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .ModT args skipProof =>
+    Check.primitiveOp exprMd .ModT args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .And args skipProof =>
+    Check.primitiveOp exprMd .And args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .Or args skipProof =>
+    Check.primitiveOp exprMd .Or args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .AndThen args skipProof =>
+    Check.primitiveOp exprMd .AndThen args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .OrElse args skipProof =>
+    Check.primitiveOp exprMd .OrElse args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .Not args skipProof =>
+    Check.primitiveOp exprMd .Not args skipProof expected source (by rw [h_node])
+  | .PrimitiveOp .Implies args skipProof =>
+    Check.primitiveOp exprMd .Implies args skipProof expected source (by rw [h_node])
+  | _ =>
+    -- Subsumption fallback: synth then check `actual <: expected`.
+    let (e', actual) ← Synth.resolveStmtExpr exprMd
+    checkSubtype source expected actual
+    pure e'
+  termination_by (exprMd, 3)
+  decreasing_by all_goals first
+    | (apply Prod.Lex.left; term_by_mem)
+    | (try subst_eqs; apply Prod.Lex.right; decide)
+    | (try subst h_node; apply Prod.Lex.right; decide)
+    | (apply Prod.Lex.right; decide)
+
+-- ### Literals
+
+/-- `Γ ⊢ LiteralInt n ⇒ TInt` -/
+def Synth.litInt (v : Int) (source : Option FileRange) : StmtExpr × HighTypeMd :=
+  (.LiteralInt v, { val := .TInt, source := source })
+
+/-- `Γ ⊢ LiteralBool b ⇒ TBool` -/
+def Synth.litBool (v : Bool) (source : Option FileRange) : StmtExpr × HighTypeMd :=
+  (.LiteralBool v, { val := .TBool, source := source })
+
+/-- `Γ ⊢ LiteralString s ⇒ TString` -/
+def Synth.litString (v : String) (source : Option FileRange) : StmtExpr × HighTypeMd :=
+  (.LiteralString v, { val := .TString, source := source })
+
+/-- `Γ ⊢ LiteralDecimal d ⇒ TReal` -/
+def Synth.litDecimal (v : StrataDDM.Decimal) (source : Option FileRange) : StmtExpr × HighTypeMd :=
+  (.LiteralDecimal v, { val := .TReal, source := source })
+
+/-- `Γ ⊢ LiteralBv v (width := n) ⇒ TBv n` — a bitvector literal's type is
+    fixed by its declared width. -/
+def Synth.litBv (v : Nat) (width : Nat) (source : Option FileRange) : StmtExpr × HighTypeMd :=
+  (.LiteralBv v width, { val := .TBv width, source := source })
+
+-- ### Variables
+
+/-- (Var-Local)
+    ```
+    Γ(x) = T
+    ──────────────────────
+    Γ ⊢ Var (.Local x) ⇒ T
+    ```
+    Resolves `ref` against the lexical scope and reads its declared type. -/
+def Synth.varLocal (ref : Identifier) (source : Option FileRange) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let ref' ← resolveRef ref source
+  let ty ← getVarType ref
+  pure (.Var (.Local ref'), ty)
+
+/-- (Var-Field)
+    ```
+    Γ ⊢ e ⇒ _
+    Γ(f) = T_f
+    ───────────────────────────
+    Γ ⊢ Var (.Field e f) ⇒ T_f
+    ```
+    `f` is looked up against the type of `e` (or the enclosing instance type
+    for `self.f`); the typing rule itself is path-agnostic. -/
+def Synth.varField (exprMd : StmtExprMd)
+    (target : StmtExprMd) (fieldName : Identifier) (source : Option FileRange)
+    (h : exprMd.val = .Var (.Field target fieldName)) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let (target', _) ← Synth.resolveStmtExpr target
+  let fieldName' ← resolveFieldRef target' fieldName source
+  let ty ← getVarType fieldName'
+  pure (.Var (.Field target' fieldName'), ty)
+  termination_by (exprMd, 1)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+/-- (Var-Declare)
+    ```
+    x ∉ dom(Γ)
+    ────────────────────────────────────────────────────
+    Γ ⊢ Var (.Declare ⟨x, T_x⟩) ⇒ TVoid ⊣ Γ, x : T_x
+    ```
+    `⊣ Γ, x : T_x` records that the surrounding scope is extended with
+    the new binding for the remainder of the enclosing block. The
+    declaration itself does no work other than registering `x : T_x`,
+    and yields no value, so it synthesizes `TVoid`.
+
+    `x ∉ dom(Γ)` is a soft side condition, not a hard premise: when `x`
+    is already bound in the current scope, `defineNameCheckDup` emits a
+    `"Duplicate definition '<x>' is already defined in this scope"`
+    diagnostic and still extends the scope — but with an *unresolved*
+    placeholder rather than `x : T_x`, so later uses of `x` do not
+    cascade further type errors. -/
+def Check.varDeclare (param : Parameter) (source : Option FileRange) :
+    ResolveM StmtExprMd := do
+  let ty' ← resolveHighType param.type
+  let name' ← defineNameCheckDup param.name (.var param.name ty')
+  pure { val := .Var (.Declare ⟨name', ty'⟩), source := source }
+
+-- ### Control flow
+
+/-- (While)
+    ```
+    Γ ⊢ cond ⇐ TBool
+    Γ ⊢ invs_i ⇐ TBool
+    Γ ⊢ decreases ⇒ U
+    Numeric U
+    Γ ⊢ body ⇐ Unknown
+    ─────────────────────────────────────────────────
+    Γ ⊢ While cond invs decreases body ⇒ TVoid
+    ```
+    `cond` is checked against `TBool`, and each invariant against
+    `TBool`. The body's *value type* is discarded — control either
+    re-enters the loop or falls through, so the body is checked at
+    `Unknown` (the gradual wildcard) and any value the body's tail
+    might produce is ignored. A loop is a statement: it yields no
+    value, so it synthesizes `TVoid`.
+
+    The optional `decreases` clause is synthesized and required to
+    have a numeric type, via the same `Numeric U` predicate
+    used by the arithmetic primitive ops. `Numeric` is a predicate,
+    not a single type, so the clause runs in synth mode rather than
+    check mode. -/
+def Check.while (exprMd : StmtExprMd)
+    (cond : StmtExprMd) (invs : List StmtExprMd)
+    (dec : Option StmtExprMd) (body : StmtExprMd) (postTest : Bool)
+    (source : Option FileRange)
+    (h : exprMd.val = .While cond invs dec body postTest) :
+    ResolveM StmtExprMd := do
+  let cond' ← Check.resolveStmtExpr cond { val := .TBool, source := cond.source }
+  let invs' ← invs.attach.mapM (fun a => have := a.property; do
+    Check.resolveStmtExpr a.val { val := .TBool, source := a.val.source })
+  let dec' ← dec.attach.mapM (fun a => have := a.property; do
+    let (e', decTy) ← Synth.resolveStmtExpr a.val
+    let ctx := (← get).typeLattice
+    unless isNumeric ctx decTy do
+      typeMismatch a.val.source none "expected a numeric type" decTy
+    pure e')
+  let body' ← Check.resolveStmtExpr body { val := .Unknown, source := body.source }
+  -- `postTest` (the `do … while` variant) resolves identically and is carried
+  -- through unchanged for the `EliminateDoWhile` pass to lower afterwards.
+  pure { val := .While cond' invs' dec' body' postTest, source := source }
+  termination_by (exprMd, 0)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+/-- (Exit)
+    ```
+    l ∈ Γ_lbl
+    ───────────────────
+    Γ ⊢ Exit l ⇒ TVoid
+    ```
+    `exit` is a control-flow terminator — an unconditional jump out of
+    the enclosing labeled block. Because it never falls through, it
+    never delivers a value, so it synthesizes `TVoid`.
+
+    The premise `l ∈ Γ_lbl` requires the target label to name an
+    enclosing labeled block; labels live in their own namespace
+    (`ResolveState.labelScope`, populated by `Check.block` via
+    `withLabel`). An unknown label is reported here as
+    `"label '<l>' is not in scope"`. -/
+def Check.exit (target : String) (source : Option FileRange) :
+    ResolveM StmtExprMd := do
+  unless (← get).labelScope.contains target do
+    let diag := diagnosticFromSource source
+      s!"label '{target}' is not in scope"
+    modify fun s => { s with errors := s.errors.push diag }
+  pure { val := .Exit target, source := source }
+
+/-- (Return)
+
+    Below, `T_o-bar` denotes the enclosing procedure's declared
+    output-type list (bound on entry to a procedure body, stored on
+    `ResolveState.answerType`).
+
+    ```
+    T_o-bar = []                                           (Return-None-Void)
+    ─────────────────────────
+    Γ ⊢ Return none ⇒ TVoid
+
+    T_o-bar = [T]                                          (Return-None-Single)
+    ──────────────────────────────────
+    Γ ⊢ Return none ⇒ TVoid
+
+    T_o-bar = [T_1;…;T_n]  n ≥ 2                           (Return-None-Multi)
+    ──────────────────────────────────
+    Γ ⊢ Return none ⇒ TVoid
+
+    T_o-bar = [T]    Γ ⊢ e ⇐ T                             (Return-Some)
+    ──────────────────────────────────
+    Γ ⊢ Return (some e) ⇒ TVoid
+
+    T_o-bar = []                                           (Return-Void-Error)
+    ───────────────────────────────────────────────────────────
+    Γ ⊢ Return (some e) ↝ "void procedure cannot return a value"
+
+    T_o-bar = [T_1;…;T_n]  n ≥ 2                           (Return-Multi-Error)
+    ───────────────────────────────────────────────────────────
+    Γ ⊢ Return (some e) ↝ "multi-output procedure cannot use 'return e'; assign to named outputs instead"
+    ```
+    `return` is the *only* rule whose premises depend on the enclosing
+    procedure's declared outputs. It is a control-flow terminator: it
+    transfers control out of the enclosing procedure and never falls
+    through, so it synthesizes `TVoid`. The returned value, if any, is
+    checked against the procedure's declared output. Anything after
+    `return` in the same block is dead code, flagged by
+    `Resolution.Check.block`.
+
+    When `answerType = none` we are not inside any procedure body (e.g.
+    resolving a constant initializer), so all `Return` checks are
+    skipped — `Return` should not occur there in well-formed input.
+
+    `return;` (no payload) is unconditionally accepted in all cases:
+    void-output procedures (Return-None-Void), single-output procedures
+    (Return-None-Single), and multi-output procedures (Return-None-Multi).
+    In the multi-output case it acts as an early-exit shorthand — each
+    declared output retains whatever was last assigned to it via
+    named-output assignment.
+
+    `return e` is checked against the declared output type in the
+    single-output case. Multi-output procedures use named-output
+    assignment (`r := …` on the declared output parameters); `return e`
+    syntactically takes a single `Option StmtExpr` and cannot carry
+    multiple values, so it is flagged with a diagnostic pointing users
+    at the named-output convention.
+
+    Regardless of which arm fires, `e` is always elaborated — it is
+    checked against the declared output in the single-output case,
+    otherwise synthesized — so any errors inside `e` are reported in
+    addition to the arity diagnostic. -/
+def Check.return (exprMd : StmtExprMd)
+    (val : Option StmtExprMd) (source : Option FileRange)
+    (h : exprMd.val = .Return val) :
+    ResolveM StmtExprMd := do
+  let expectedReturn := (← get).answerType
+  let val' ← val.attach.mapM (fun a => have := a.property; do
+    match expectedReturn with
+    | some [singleOutput] => Check.resolveStmtExpr a.val singleOutput
+    | _ => let (e', _) ← Synth.resolveStmtExpr a.val; pure e')
+  match val, expectedReturn with
+  | none,   some []          => pure ()
+  | none,   some [singleOutput] => pure ()
+  | none,   some _           => pure ()
+  | some _, some []          =>
+    let diag := diagnosticFromSource source
+      "void procedure cannot return a value"
+    modify fun s => { s with errors := s.errors.push diag }
+  | some _, some [_]         => pure ()
+  | some _, some _           =>
+    let diag := diagnosticFromSource source
+      "multi-output procedure cannot use 'return e'; assign to named outputs instead"
+    modify fun s => { s with errors := s.errors.push diag }
+  | _,      none             => pure ()
+  -- `return` is a control-flow jump; it doesn't deliver a value to the
+  -- enclosing block, so no TVoid-vs-expected subsumption is required.
+  -- The return value (if any) was already checked against the declared
+  -- output above via `answerType`.
+  pure { val := .Return val', source := source }
+  termination_by (exprMd, 0)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+/-- (Empty-Block)
+    ```
+    ─────────────────────────────────
+    Γ ⊢ Block [] label ⇒ TVoid
+    ```
+    The empty block has a fixed type `TVoid`. This is the only
+    block-level rule that synthesizes unconditionally: non-empty blocks
+    are typed structurally by `Resolution.Check.block` (last statement
+    carries the value, non-last positions via `Check.statement`),
+    which always splits off a last statement and so never reaches an
+    empty list. When an empty block appears in check position,
+    `Resolution.Check.resolveStmtExpr`'s wildcard arm synth-then-subsumes
+    via the standard \[⇐\] Sub fallback. -/
+def Synth.emptyBlock (source : Option FileRange) : HighTypeMd :=
+  { val := .TVoid, source := source }
+
+/-- (Synth-Discard) Check a statement in *effect position*, written `Γ ⊢ s ⋄`.
+
+    Laurel has no syntactic statement/expression split — everything is a
+    `StmtExpr` — so "what may appear where its value is discarded" is
+    defined by this rule rather than by the grammar. Every expression in
+    statement position is synthesized and its type discarded:
+
+    ```
+    Γ ⊢ s ⇒ _
+    ──────────────
+    Γ ⊢ s ⋄
+    ```
+
+    Statement-shaped forms (`Var-Declare`, `Assign`, `Assert`, `Assume`,
+    `While`, `Exit`, `Return`) synthesize `TVoid`; value-producing forms
+    (calls, `IncrDecr`, literals, etc.) synthesize their natural type,
+    which is then discarded. This means any expression is accepted in
+    statement position — the `f(x);` idiom works regardless of `f`'s
+    return type, and `x++;` is admitted even though `++` synthesizes the
+    target's type.
+
+    This is the single definition of "what counts as a statement". It is
+    used by `Check.block` for every non-last statement, and for the last
+    statement when the block itself sits in statement position
+    (`expected = TVoid`). -/
+def Check.statement (s : StmtExprMd) : ResolveM StmtExprMd := do
+  let (s', _) ← Synth.resolveStmtExpr s; pure s'
+  termination_by (s, 4)
+  decreasing_by all_goals (apply Prod.Lex.right; decide)
+
+/-- (Block) Check-mode typing rule for a non-empty block.
+
+    A block's value is the value of its **last** statement; every
+    earlier statement is run only for its effect. The rule splits the
+    statement list into `[s₁; … ; sₙ]` (all but the last) and `last`,
+    handling each part as follows:
+
+    * **non-last — `Γ ⊢ s ⋄`.** A non-last statement is in effect
+      position: it is synthesized and its type discarded (see
+      `Check.statement`). Any expression is accepted — statement-shaped
+      forms synthesize `TVoid`, value-producing forms (calls,
+      `IncrDecr`, etc.) synthesize their natural type which is then
+      discarded.
+
+    * **last — `Γ ⊢ last ⇐ T`.** The surrounding expected type `T` is
+      routed to the last statement, so a check-only trailing form
+      (`IfThenElse`, a nested `Block`, `Hole`, `Return`, …) still
+      receives its expected type. When `T = TVoid` (the block is in
+      statement position), the last statement is also in effect position
+      and goes through `Check.statement`.
+
+    A block most often occurs in check position (procedure bodies,
+    branches, loop bodies, assignment RHS, and call arguments all supply
+    an expected type). When one appears in synth-only operand position
+    with no contextual type, `Resolution.Synth.block` handles it with the
+    same structure, synthesizing the last statement instead.
+
+    The block opens a fresh nested scope (declarations made inside
+    don't leak), and emits a "dead code after `exit`/`return`"
+    diagnostic when a terminator is followed by further statements.
+    When `label` is `some l`, `l` is registered in
+    `ResolveState.labelScope` (via `withLabel`) for the block's extent
+    so nested `exit l` checks can see it. -/
+def Check.block (exprMd : StmtExprMd)
+    (stmts : List StmtExprMd) (label : Option String)
+    (expected : HighTypeMd) (source : Option FileRange)
+    (h : exprMd.val = .Block stmts label) : ResolveM StmtExprMd := do
+  -- A non-last statement is in effect position: admitted by `Check.statement`
+  -- (`Γ ⊢ s ⋄` — synthesized and the type discarded).
+  let checkNonLast (s : StmtExprMd) (_h_mem : s ∈ stmts) : ResolveM StmtExprMd :=
+    Check.statement s
+  -- The last statement carries the block's value: push `expected` in (so
+  -- check-only forms are reachable). When the block itself sits in statement
+  -- position (`expected = TVoid`), the last statement is also in effect
+  -- position and goes through `Check.statement`.
+  let checkLast (s : StmtExprMd) (_h_mem : s ∈ stmts) : ResolveM StmtExprMd := do
+    match expected.val with
+    | .TVoid => Check.statement s
+    | _ => Check.resolveStmtExpr s expected
+  withScope <| withLabel label do
+    let init' ← stmts.dropLast.attach.mapM fun ⟨s, hMem⟩ => do
+      have h_mem : s ∈ stmts := List.dropLast_subset stmts hMem
+      checkNonLast s h_mem
+    -- Dead-code diagnostic: a terminator (`Exit`/`Return`) among the
+    -- non-last statements is followed by at least one more statement.
+    -- Flag it once at the position of the next statement.
+    let isTerminator (s : StmtExprMd) : Bool :=
+      match s.val with
+      | .Exit _ | .Return _ => true
+      | _ => false
+    match init'.findIdx? isTerminator with
+    | some i =>
+      let nextSource : Option FileRange :=
+        match init'[i + 1]? with
+        | some next => next.source
+        | none      => -- terminator is the last of init', so the dead one
+                       -- is the block's actual last statement
+          (stmts.getLast?.bind (·.source))
+      let termName : String :=
+        match init'[i]? with
+        | some s => s.val.constrName
+        | none   => "exit"
+      let diag := diagnosticFromSource nextSource
+        s!"dead code after '{termName}'"
+      modify fun st => { st with errors := st.errors.push diag }
+    | none => pure ()
+    -- Check the last statement against `expected`. The dispatcher only
+    -- calls `Check.block` on `head :: tail`, so the `none` (empty-list)
+    -- arm is dead and kept only to remain total.
+    match _lastResult: stmts.getLast? with
+    | none =>
+      checkSubtype source expected (Synth.emptyBlock source)
+      pure { val := .Block init' label, source := source }
+    | some last =>
+      have := List.mem_of_getLast? _lastResult
+      let last' ← checkLast last ‹_›
+      pure { val := .Block (init' ++ [last']) label, source := source }
+  termination_by (exprMd, 0)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+/-- (If / If-NoElse)
+    ```
+    Γ ⊢ cond ⇐ TBool                                            (If)
+    Γ ⊢ thenBr ⇐ T
+    Γ ⊢ elseBr ⇐ T
+    ──────────────────────────────────────────────────────────────────
+    Γ ⊢ IfThenElse cond thenBr (some elseBr) ⇐ T
+
+    Γ ⊢ cond ⇐ TBool                                            (If-NoElse)
+    Γ ⊢ thenBr ⇐ T
+    TVoid <: T
+    ──────────────────────────────────────────────────────────────────
+    Γ ⊢ IfThenElse cond thenBr none ⇐ T
+    ```
+    Pushes the surrounding `T` into both branches (rather than going
+    through If-Synth + Sub at the boundary): errors fire at the
+    offending branch instead of at the `if`, and the expectation
+    propagates through nested `Block` / `IfThenElse` / `Hole` /
+    `Quantifier` constructs that have their own check rules.
+
+    Without an `else`, the implicit branch is an empty block of type
+    `TVoid`, so the rule degenerates to require `TVoid <: T` — the
+    standard \[⇐\] Sub boundary check that `Resolution.Synth.emptyBlock`
+    composes with for an empty block. -/
+def Check.ifThenElse (exprMd : StmtExprMd)
+    (cond thenBr : StmtExprMd) (elseBr : Option StmtExprMd)
+    (expected : HighTypeMd) (source : Option FileRange)
+    (h : exprMd.val = .IfThenElse cond thenBr elseBr) : ResolveM StmtExprMd := do
+  let cond' ← Check.resolveStmtExpr cond { val := .TBool, source := cond.source }
+  let thenBr' ← Check.resolveStmtExpr thenBr expected
+  let elseBr' ← elseBr.attach.mapM (fun ⟨e, _⟩ => Check.resolveStmtExpr e expected)
+  if elseBr.isNone then
+    checkSubtype source expected { val := .TVoid, source := source }
+  pure { val := .IfThenElse cond' thenBr' elseBr', source := source }
+  termination_by (exprMd, 0)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+/-- (If-Synth)
+    ```
+    Γ ⊢ cond ⇐ TBool   Γ ⊢ thenBr ⇒ T_t   Γ ⊢ elseBr ⇒ T_e
+    T_t ~ T_e   T = T_t ⨆ T_e (consistency join)                (If-Synth)
+    ──────────────────────────────────────────────────────────────────────────
+    Γ ⊢ IfThenElse cond thenBr (some elseBr) ⇒ T
+
+    Γ ⊢ cond ⇐ TBool   Γ ⊢ thenBr ⇒ _                          (If-Synth-NoElse)
+    ──────────────────────────────────────────────────────────────────────────
+    Γ ⊢ IfThenElse cond thenBr none ⇒ TVoid
+    ```
+    Synth-mode rule for an `if` used where no expected type is available
+    (e.g. as an operand of `==`/`<`/`++`, whose operands are synthesized).
+    `cond` is checked against `TBool`; both branches are *synthesized*.
+    With an `else`, the two branch types must be mutually consistent
+    (`isConsistent`, the symmetric gradual relation — `Unknown` flows
+    freely either way); when consistent, the result is their symmetric
+    `join` (`Unknown ⊔ T = T`), so a hole branch promotes to the other
+    branch's concrete type and the synthesized type is independent of
+    branch order. (`isConsistent` stays the accept/reject gate: it admits
+    a lone `TCore` corner where `join` is `none`, for which the result
+    falls back to the then-branch type, leaving that boundary unchanged.)
+    Inconsistent branches (e.g. `if c then 1 else "x"`) emit a diagnostic
+    and synthesize `Unknown` to suppress cascading errors. Without an
+    `else`, the `if` cannot produce a value on the missing branch, so it
+    synthesizes `TVoid`.
+
+    This is the synth counterpart to `Check.ifThenElse`: when an expected
+    type *is* available the dispatcher prefers the check rule (pushing the
+    type into both branches); this rule fires only at the synth wildcard. -/
+def Synth.ifThenElse (exprMd : StmtExprMd)
+    (cond thenBr : StmtExprMd) (elseBr : Option StmtExprMd)
+    (source : Option FileRange)
+    (h : exprMd.val = .IfThenElse cond thenBr elseBr) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let cond' ← Check.resolveStmtExpr cond { val := .TBool, source := cond.source }
+  let (thenBr', thenTy) ← Synth.resolveStmtExpr thenBr
+  match elseBr with
+  | none =>
+    pure (.IfThenElse cond' thenBr' none, { val := .TVoid, source := source })
+  | some e =>
+    let (e', elseTy) ← Synth.resolveStmtExpr e
+    let ctx := (← get).typeLattice
+    let ty ←
+      if isConsistent ctx thenTy elseTy then
+        pure ((join ctx thenTy elseTy).getD thenTy)
+      else
+        let diag := diagnosticFromSource source
+          s!"'if' branches have incompatible types '{formatType thenTy}' and '{formatType elseTy}'"
+        modify fun s => { s with errors := s.errors.push diag }
+        pure { val := .Unknown, source := source }
+    pure (.IfThenElse cond' thenBr' (some e'), ty)
+  termination_by (exprMd, 1)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      simp only [StmtExpr.IfThenElse.sizeOf_spec, Option.some.sizeOf_spec] at hsz
+      omega
+
+/-- (Block-Synth)
+    ```
+    Γ ⊢ sᵢ ⋄ (1 ≤ i ≤ n)   Γ ⊢ last ⇒ T          (Block-Synth)
+    ──────────────────────────────────────────────────────────────
+    Γ ⊢ Block [s₁; … ; sₙ; last] label ⇒ T
+    ```
+    Synth-mode rule for a non-empty block used where no expected type is
+    available (e.g. `{ x := 1; x } == y`). Mirrors `Check.block`'s
+    structure — fresh scope, optional label, non-last statements in
+    effect position (`Check.statement`), dead-code-after-terminator
+    diagnostic — but *synthesizes* the last statement instead of checking
+    it against an expected type, and returns that synthesized type as the
+    block's value type. The empty block is handled by `Synth.emptyBlock`
+    at the dispatch site; this rule only runs on a non-empty block. -/
+def Synth.block (exprMd : StmtExprMd)
+    (stmts : List StmtExprMd) (label : Option String)
+    (source : Option FileRange)
+    (h : exprMd.val = .Block stmts label) : ResolveM (StmtExpr × HighTypeMd) := do
+  withScope <| withLabel label do
+    let init' ← stmts.dropLast.attach.mapM fun ⟨s, hMem⟩ => do
+      have h_mem : s ∈ stmts := List.dropLast_subset stmts hMem
+      Check.statement s
+    let isTerminator (s : StmtExprMd) : Bool :=
+      match s.val with
+      | .Exit _ | .Return _ => true
+      | _ => false
+    match init'.findIdx? isTerminator with
+    | some i =>
+      let nextSource : Option FileRange :=
+        match init'[i + 1]? with
+        | some next => next.source
+        | none      => (stmts.getLast?.bind (·.source))
+      let termName : String :=
+        match init'[i]? with
+        | some s => s.val.constrName
+        | none   => "exit"
+      let diag := diagnosticFromSource nextSource
+        s!"dead code after '{termName}'"
+      modify fun st => { st with errors := st.errors.push diag }
+    | none => pure ()
+    match _lastResult: stmts.getLast? with
+    | none =>
+      pure (.Block init' label, Synth.emptyBlock source)
+    | some last =>
+      have := List.mem_of_getLast? _lastResult
+      let (last', lastTy) ← Synth.resolveStmtExpr last
+      pure (.Block (init' ++ [last']) label, lastTy)
+  termination_by (exprMd, 1)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+-- ### Verification statements
+
+/-- (Assert)
+    ```
+    Γ ⊢ cond ⇐ TBool
+    ──────────────────────────────────
+    Γ ⊢ Assert cond ⇒ TVoid
+    ```
+    `cond` is checked against `TBool`. `assert` is a statement: it
+    yields no value, so it synthesizes `TVoid`. -/
+def Check.assert (exprMd : StmtExprMd)
+    (condExpr : StmtExprMd) (summary : Option String) (free : Bool)
+    (source : Option FileRange)
+    (h : exprMd.val = .Assert ⟨condExpr, summary, free⟩) :
+    ResolveM StmtExprMd := do
+  let cond' ← Check.resolveStmtExpr condExpr { val := .TBool, source := condExpr.source }
+  pure { val := .Assert { condition := cond', summary, free }, source := source }
+  termination_by (exprMd, 0)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+/-- (Assume)
+    ```
+    Γ ⊢ cond ⇐ TBool
+    ──────────────────────────────────
+    Γ ⊢ Assume cond ⇒ TVoid
+    ```
+    `cond` is checked against `TBool`. `assume` is a statement: it
+    yields no value, so it synthesizes `TVoid`. -/
+def Check.assume (exprMd : StmtExprMd)
+    (cond : StmtExprMd) (source : Option FileRange)
+    (h : exprMd.val = .Assume cond) :
+    ResolveM StmtExprMd := do
+  let cond' ← Check.resolveStmtExpr cond { val := .TBool, source := cond.source }
+  pure { val := .Assume cond', source := source }
+  termination_by (exprMd, 0)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+-- ### Assignment
+
+/-- (Assign)
+    ```
+    Γ ⊢ targets_i ⇒ T_i
+    Γ ⊢ e ⇐ ExpectedTy
+    ─────────────────────────────────────────────────────────
+    Γ ⊢ Assign targets e ⇒ ExpectedTy
+    ```
+    where `ExpectedTy = T_1` if `|targets| = 1` and otherwise
+    `MultiValuedExpr [T_1; …; T_n]`. The target tuple type is pushed
+    into the RHS via `Check.resolveStmtExpr`, so bidirectional rules
+    in the RHS receive the assignment's type. The assignment
+    synthesizes `ExpectedTy` — the LHS-derived target tuple type —
+    so the surrounding context sees the type the RHS was checked
+    against. -/
+def Synth.assign (exprMd : StmtExprMd)
+    (targets : List VariableMd) (value : StmtExprMd) (source : Option FileRange)
+    (h : exprMd.val = .Assign targets value) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let targets' ← targets.attach.mapM fun ⟨v, _⟩ => do
+    let ⟨vv, vs⟩ := v
+    match vv with
+    | .Local ref =>
+      let ref' ← resolveRef ref source
+      pure (⟨.Local ref', vs⟩ : VariableMd)
+    | .Field target fieldName =>
+      let (target', _) ← Synth.resolveStmtExpr target
+      let fieldName' ← resolveFieldRef target' fieldName source
+      pure (⟨.Field target' fieldName', vs⟩ : VariableMd)
+    | .Declare param =>
+      let ty' ← resolveHighType param.type
+      let name' ← defineNameCheckDup param.name (.var param.name ty')
+      pure (⟨.Declare ⟨name', ty'⟩, vs⟩ : VariableMd)
+  let targetType (t : VariableMd) : ResolveM HighTypeMd := do
+    match t.val with
+    | .Local ref => getVarType ref
+    | .Declare param => pure param.type
+    | .Field _ fieldName => getVarType fieldName
+  let targetTys ← targets'.mapM targetType
+  let expectedTy : HighTypeMd := match targetTys with
+    | [single] => single
+    | _        => { val := .MultiValuedExpr targetTys, source := source }
+  let value' ← Check.resolveStmtExpr value expectedTy
+  pure (.Assign targets' value', expectedTy)
+  termination_by (exprMd, 1)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+/-- Check-mode rule for assignment. Synthesizes the assignment's type
+    by inlining the same work as `Synth.assign` (resolving targets,
+    pushing the LHS-derived `ExpectedTy` into the RHS via
+    `Check.resolveStmtExpr`), then runs the standard \[⇐\] Sub
+    boundary check `ExpectedTy <: T` against the surrounding `expected`
+    — *unless* `T = TVoid`, the marker for statement position
+    (e.g. last statement of a block whose value is being discarded).
+    `Sub` against `TVoid` would only succeed when `ExpectedTy = TVoid`,
+    which would reject every non-void assignment used as a statement,
+    so the subsumption is skipped there. The synthesized value is
+    discarded in statement position, exactly as for calls. -/
+def Check.assign (exprMd : StmtExprMd)
+    (targets : List VariableMd) (value : StmtExprMd)
+    (expected : HighTypeMd) (source : Option FileRange)
+    (h : exprMd.val = .Assign targets value) : ResolveM StmtExprMd := do
+  let targets' ← targets.attach.mapM fun ⟨v, _⟩ => do
+    let ⟨vv, vs⟩ := v
+    match vv with
+    | .Local ref =>
+      let ref' ← resolveRef ref source
+      pure (⟨.Local ref', vs⟩ : VariableMd)
+    | .Field target fieldName =>
+      let (target', _) ← Synth.resolveStmtExpr target
+      let fieldName' ← resolveFieldRef target' fieldName source
+      pure (⟨.Field target' fieldName', vs⟩ : VariableMd)
+    | .Declare param =>
+      let ty' ← resolveHighType param.type
+      let name' ← defineNameCheckDup param.name (.var param.name ty')
+      pure (⟨.Declare ⟨name', ty'⟩, vs⟩ : VariableMd)
+  let targetType (t : VariableMd) : ResolveM HighTypeMd := do
+    match t.val with
+    | .Local ref => getVarType ref
+    | .Declare param => pure param.type
+    | .Field _ fieldName => getVarType fieldName
+  let targetTys ← targets'.mapM targetType
+  let expectedTy : HighTypeMd := match targetTys with
+    | [single] => single
+    | _        => { val := .MultiValuedExpr targetTys, source := source }
+  let value' ← Check.resolveStmtExpr value expectedTy
+  unless expected.val matches .TVoid do
+    checkSubtype source expected expectedTy
+  pure { val := .Assign targets' value', source := source }
+  termination_by (exprMd, 0)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+-- ### Increment / decrement
+
+/-- (IncrDecr)
+    ```
+    Γ ⊢ target ⇒ T    T ∈ {int, int-based constrained}
+    ─────────────────────────────────────────────────
+    Γ ⊢ IncrDecr mode op target ⇒ T
+    ```
+    `++`/`--` reads and writes its target, so it synthesizes the target's
+    own type. The target is resolved the same way as an `Assign` target (a
+    `Local` is resolved against scope; a `Field` synthesizes its receiver
+    and resolves the field against it; the `Declare` form should not occur —
+    the translator rejects it — and is handled conservatively). The element
+    type is then checked by `checkIncrDecrTargetType`, which emits a Laurel
+    diagnostic when `++`/`--` is applied to an unsupported type (`bv`,
+    `real`, `float64`) rather than letting a raw Core unification error leak
+    from the later `EliminateIncrDecr` lowering. Used in expression position
+    (`var y := ++x`, `if x++ > 0`, `f(x++)`); in statement position the
+    yielded value is discarded by `Check.statement`. -/
+def Synth.incrDecr (exprMd : StmtExprMd)
+    (mode : IncrDecrMode) (op : IncrDecrOp) (target : VariableMd)
+    (source : Option FileRange)
+    (h : exprMd.val = .IncrDecr mode op target) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let target' ← match h_tgt : target.val with
+    | .Local ref =>
+      let ref' ← resolveRef ref source
+      pure (⟨.Local ref', target.source⟩ : VariableMd)
+    | .Field tgt fieldName =>
+      let (tgt', _) ← Synth.resolveStmtExpr tgt
+      let fieldName' ← resolveFieldRef tgt' fieldName source
+      pure (⟨.Field tgt' fieldName', target.source⟩ : VariableMd)
+    | .Declare param =>
+      -- Should not occur — the translator rejects a declaration target;
+      -- treat conservatively by resolving its type only.
+      let ty' ← resolveHighType param.type
+      pure (⟨.Declare ⟨param.name, ty'⟩, target.source⟩ : VariableMd)
+  checkIncrDecrTargetType op target' source
+  let resultTy ← match target'.val with
+    | .Local ref => getVarType ref
+    | .Declare param => pure param.type
+    | .Field _ fieldName => getVarType fieldName
+  pure (.IncrDecr mode op target', resultTy)
+  termination_by (exprMd, 1)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    have hsz2 := target.sizeOf_val_lt
+    rw [h_tgt] at hsz2
+    term_by_mem
+
+-- ### Calls
+
+/-- Cases on the arity of the callee's declared outputs.
+    ```
+    Γ(callee) = static-procedure with inputs Ts                  (Static-Call)
+      and output [T'] (single output)
+    Γ ⊢ args_i ⇐ Ts_i (pairwise)
+    ──────────────────────────────────────────────────────
+    Γ ⊢ StaticCall callee args ⇒ T'
+
+    Γ(callee) = static-procedure with inputs Ts                  (Static-Call-Multi)
+      and outputs [T_1; …; T_n] (n ≥ 2)
+    Γ ⊢ args_i ⇐ Ts_i (pairwise)
+    ──────────────────────────────────────────────────────
+    Γ ⊢ StaticCall callee args ⇒ MultiValuedExpr [T_1; …; T_n]
+    ```
+    A callee with *zero* outputs synthesizes `TVoid` (the n = 0 case).
+    The two rules differ only in *output* arity — argument checking is
+    identical. Callee is resolved against the expected kinds (parameter,
+    static procedure, datatype constructor, datatype destructor, constant);
+    each argument is *checked* against the corresponding parameter type. The
+    bidirectional push lets impure-expression arguments (`{x := 1; x}`,
+    `if c then …`, holes) flow through their own check rules instead of
+    bottoming out at the synth wildcard.
+
+    When the callee resolves to a static procedure with a known parameter
+    count and the call supplies *more* arguments than it declares, an
+    over-arity diagnostic is emitted (the surplus arguments are still
+    resolved first, against `Unknown`, so errors inside them are reported
+    too). The check fires *only* for genuine procedures (`procArity`); for an
+    unresolved name (where `paramTypes = []` purely because the name was not
+    found), a datatype constructor/tester, a parameter, or a constant, no
+    arity diagnostic is emitted — surplus arguments are checked against
+    `Unknown`, the gradual escape hatch, exactly as before, so no
+    spurious/duplicate diagnostic is produced. Under-arity (too few
+    arguments) is deliberately not flagged.
+
+    The result type is the (possibly multi-valued) declared output type
+    from `getCallInfo`. -/
+def Synth.staticCall (exprMd : StmtExprMd)
+    (callee : Identifier) (args : List StmtExprMd) (source : Option FileRange)
+    (h : exprMd.val = .StaticCall callee args) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+
+  -- Hack because we use these polymorphic map primitives but Laurel does not
+  -- support polymorphism yet, so they cannot be type-checked against their
+  -- placeholder `int` signatures. Instead we resolve the arguments and infer the
+  -- result type structurally from them, keeping a concrete `HighType` flowing into
+  -- Core translation:
+  --   * `select(map, key)`     ⇒ the map's value type
+  --   * `update(map, key, val)` ⇒ the map type itself
+  --   * `const(val)`           ⇒ `Map _ (typeof val)` (key type is not recoverable)
+  if callee == "select" || callee == "update" || callee == "const" then
+    let resolved ← args.attach.mapM (fun ⟨a, hMem⟩ => do
+      have := hMem
+      Synth.resolveStmtExpr a)
+    let args' := resolved.map (·.1)
+    let argTys := resolved.map (·.2)
+    let resultTy : HighTypeMd ←
+      match callee, argTys with
+      | "select", mapTy :: _ =>
+        match mapTy.val with
+        | .TMap _ valueTy => pure valueTy
+        | _ => pure ⟨ .Unknown, source ⟩
+      | "update", mapTy :: _ => pure mapTy
+      | "const", valTy :: _ => pure ⟨ .TMap ⟨.UserDefined "TypeTag", source⟩ valTy, source ⟩
+      | _, _ => pure ⟨ .Unknown, source ⟩
+    return (.StaticCall callee args', resultTy)
+
+  let callee' ← resolveRef callee source
+    (expected := #[.parameter, .staticProcedure, .datatypeConstructor, .datatypeDestructor, .constant])
+  let (retTy, paramTypes) ← getCallInfo callee
+  let unknownTy : HighTypeMd := { val := .Unknown, source := none }
+  let expectedTys : List HighTypeMd :=
+    paramTypes ++ List.replicate (args.length - paramTypes.length) unknownTy
+  let args' ← (args.attach.zip expectedTys).mapM (fun (⟨a, hMem⟩, paramTy) => do
+    have := hMem
+    Check.resolveStmtExpr a paramTy)
+  -- Over-arity check: reject calls that supply MORE arguments than the callee
+  -- declares, but *only* when the callee genuinely resolves to a procedure with
+  -- a known parameter count (`procArity`). For any other resolution kind —
+  -- unresolved name, datatype constructor/tester, parameter, constant — we leave
+  -- the Unknown-padding behavior above untouched, so no spurious/duplicate
+  -- arity diagnostic is emitted (an unresolved name already reported "not
+  -- defined"). Args are resolved above regardless, so errors inside surplus
+  -- arguments are still reported. The return type is unchanged to suppress
+  -- cascading errors. Under-arity (too few args) is deliberately not flagged.
+  if let some arity ← procArity callee (dropSelf := false) then
+    if args.length > arity then
+      let diag := diagnosticFromSource source
+        s!"call to '{callee}' expects {arity} argument(s) but {args.length} were provided"
+      modify fun s => { s with errors := s.errors.push diag }
+  pure (.StaticCall callee' args', retTy)
+  termination_by (exprMd, 1)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+/-- Cases on the arity of the callee's declared outputs.
+    ```
+    Γ ⊢ target ⇒ _                                            (Instance-Call)
+    Γ(callee) = instance- or static-procedure
+      with inputs [self; Ts] and output [T'] (single output)
+    Γ ⊢ args_i ⇐ Ts_i (pairwise; self dropped)
+    ─────────────────────────────────────────
+    Γ ⊢ InstanceCall target callee args ⇒ T'
+
+    Γ ⊢ target ⇒ _                                            (Instance-Call-Multi)
+    Γ(callee) = instance- or static-procedure
+      with inputs [self; Ts] and outputs [T_1; …; T_n] (n ≥ 2)
+    Γ ⊢ args_i ⇐ Ts_i (pairwise; self dropped)
+    ─────────────────────────────────────────
+    Γ ⊢ InstanceCall target callee args ⇒ MultiValuedExpr [T_1; …; T_n]
+    ```
+    A callee with *zero* outputs synthesizes `TVoid` (the n = 0 case).
+    The two rules differ only in *output* arity. Target is synthesized;
+    callee resolves to an instance or static procedure; arguments are
+    checked pairwise against the callee's parameter types after dropping
+    `self`. As in `Synth.staticCall`, supplying *more* arguments than the
+    callee declares (compared against the post-`self` parameter count) emits
+    an over-arity diagnostic when the callee genuinely resolves to a
+    procedure, while surplus arguments against any other resolution kind are
+    still checked against `Unknown` with no arity diagnostic. Like
+    `Synth.staticCall`, the push is bidirectional so block- and
+    conditional-shaped arguments route through their own check rules. -/
+def Synth.instanceCall (exprMd : StmtExprMd)
+    (target : StmtExprMd) (callee : Identifier) (args : List StmtExprMd)
+    (source : Option FileRange)
+    (h : exprMd.val = .InstanceCall target callee args) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let (target', _) ← Synth.resolveStmtExpr target
+  -- An instance procedure is registered under the container-scoped key
+  -- `TypeName$method` (see `preRegisterTopLevel` / `resolveInstanceProcedure`),
+  -- matching the lifted top-level static procedure that `LiftInstanceProcedures`
+  -- produces. Look the method up under that key, derived from the receiver's
+  -- type; fall back to the bare callee name when the target's type can't be
+  -- determined (an unresolved name, which already reported its own error).
+  let lookupKey ← match (← targetTypeName target') with
+    | some tyName => pure (containerScopedName (mkId tyName) callee)
+    | none => pure callee
+  let resolved ← resolveRef lookupKey source
+    (expected := #[.instanceProcedure, .staticProcedure])
+  -- Preserve the user-facing callee text for diagnostics; only stamp the
+  -- resolved `uniqueId` from the container-scoped lookup.
+  let callee' := { callee with uniqueId := resolved.uniqueId }
+  let (retTy, paramTypes) ← getCallInfo lookupKey
+  -- The callee resolves to either an instance- or a static-procedure. An
+  -- instance procedure's first parameter is the implicit `self` receiver,
+  -- which is not supplied positionally here, so it must be dropped before
+  -- pairing parameter types with `args`. A static procedure (also accepted
+  -- on this path) has no `self`, so all its parameters are real and none may
+  -- be dropped. We distinguish the two by the same scope lookup `getCallInfo`
+  -- uses.
+  let dropSelf : Bool := match (← get).scope.get? lookupKey.text with
+    | some (_, .instanceProcedure ..) => true
+    | _ => false
+  let callParamTypes :=
+    if dropSelf then (match paramTypes with | _ :: rest => rest | [] => [])
+    else paramTypes
+  let unknownTy : HighTypeMd := { val := .Unknown, source := none }
+  let expectedTys : List HighTypeMd :=
+    callParamTypes ++ List.replicate (args.length - callParamTypes.length) unknownTy
+  let args' ← (args.attach.zip expectedTys).mapM (fun (⟨a, hMem⟩, paramTy) => do
+    have := hMem
+    Check.resolveStmtExpr a paramTy)
+  -- Over-arity check (mirrors `Synth.staticCall`): reject calls supplying more
+  -- arguments than the callee declares, comparing against the post-`self`
+  -- parameter count. `procArity` is given the same `dropSelf` flag computed
+  -- above, so an instance procedure's implicit `self` is excluded; it returns
+  -- `none` for any non-procedure resolution, leaving the Unknown-padding (and
+  -- no duplicate diagnostic) for those. Args are resolved above regardless.
+  if let some arity ← procArity lookupKey dropSelf then
+    if args.length > arity then
+      let diag := diagnosticFromSource source
+        s!"call to '{callee}' expects {arity} argument(s) but {args.length} were provided"
+      modify fun s => { s with errors := s.errors.push diag }
+  pure (.InstanceCall target' callee' args', retTy)
+  termination_by (exprMd, 1)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+-- ### Primitive operations
+
+/-- Cases on the operator family.
+    ```
+    Γ ⊢ args_i ⇒ U_i                                            (Op-Bool)
+    U_i <: TBool
+    op ∈ {And, Or, AndThen, OrElse, Not, Implies}
+    ─────────────────────────────────────────────
+    Γ ⊢ PrimitiveOp op args ⇒ TBool
+
+    Γ ⊢ args_i ⇒ U_i                                            (Op-Cmp)
+    Numeric U_i
+    op ∈ {Lt, Leq, Gt, Geq}
+    ─────────────────────────────────────────────
+    Γ ⊢ PrimitiveOp op args ⇒ TBool
+
+    Γ ⊢ lhs ⇒ T_l                                               (Op-Eq)
+    Γ ⊢ rhs ⇒ T_r
+    T_l ~ T_r
+    op ∈ {Eq, Neq}
+    ─────────────────────────────────────────────
+    Γ ⊢ PrimitiveOp op [lhs; rhs] ⇒ TBool
+
+    Γ ⊢ args_i ⇒ U_i                                            (Op-Arith)
+    Numeric U_i
+    T = ⨆ U_i (consistency join)
+    op ∈ {Neg, Add, Sub, Mul, Div, Mod, DivT, ModT}
+    ─────────────────────────────────────────────
+    Γ ⊢ PrimitiveOp op args ⇒ T
+
+    Γ ⊢ args_i ⇒ U_i                                            (Op-Concat)
+    U_i <: TString
+    op = StrConcat
+    ─────────────────────────────────────────────
+    Γ ⊢ PrimitiveOp op args ⇒ TString
+    ```
+    `Numeric T` is the predicate "T unfolds to TInt / TReal / TFloat64 / TBv
+    (or Unknown via the gradual escape hatch)" — not a single type, so it
+    cannot serve as an `expected` for `Check.resolveStmtExpr`. `~` is
+    symmetric consistency under the gradual relation, so equality has no
+    privileged operand direction.
+
+    The result type is `TBool` for booleans/comparisons/equality, and
+    `TString` for concatenation. Boolean / Cmp / Eq / Concat all
+    synthesize operands first, then run a per-family check
+    (`checkSubtype` for boolean and concat, `isNumeric` for cmp,
+    `isConsistent` for equality).
+
+    Arithmetic follows the same shape as `Op-Eq` but for n operands:
+    synthesize each operand's type, require it to be `Numeric`, and
+    fold the operand types under `join` (the join on the
+    flat consistency lattice — `Unknown ⊔ T = T`, `T ⊔ T = T`,
+    everything else inconsistent). The fold's result is the
+    synthesized type. If any pair is inconsistent the rule emits a
+    `cannot apply '<op>' to operands of types …` diagnostic and
+    falls back to `Unknown`.
+
+    The boolean family additionally has a check-mode rule
+    (`Check.primitiveOp`) preferred when an `expected` type is
+    available; it pushes `TBool` into operands via
+    `Check.resolveStmtExpr` instead of synth-then-`checkSubtype`,
+    surfacing operand-shaped errors at their natural location. -/
+def Synth.primitiveOp (exprMd : StmtExprMd) (expr : StmtExpr)
+    (op : Operation) (args : List StmtExprMd) (skipProof : Bool) (source : Option FileRange)
+    (h_expr : expr = .PrimitiveOp op args skipProof)
+    (h : exprMd.val = .PrimitiveOp op args skipProof) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let _ := h_expr  -- carries the constructor identity for `expr` in diagnostics
+  -- Guard (all operator families): a `MultiValuedExpr` operand is a
+  -- multi-output call (`multi(x)` declared `returns (a, b)`) used in value
+  -- position. It is an internal pseudo-type with no Core lowering, so it must
+  -- never reach an operator slot — letting it through crashes a later pass as
+  -- a `StrataBug`. Emit the position-oriented diagnostic per offending operand
+  -- and return `true` so the caller short-circuits to the operator's natural
+  -- result type, suppressing the per-family check (and its cascading error)
+  -- on that operand.
+  let reportMultiValued (a : StmtExprMd) (aTy : HighTypeMd) : ResolveM Bool := do
+    match aTy.val with
+    | .MultiValuedExpr _ =>
+      let diag := diagnosticFromSource a.source
+        "multi-output call cannot be used as a value here; it returns multiple values. Unpack it into separate variables first"
+      modify fun s => { s with errors := s.errors.push diag }
+      pure true
+    | _ => pure false
+  match op with
+  -- Arithmetic: synth each operand's type, then take the join under
+  -- the consistency relation. This is the same discipline as
+  -- `Op-Eq`: operands must be pairwise consistent (with `Unknown`
+  -- promoting to whichever side is more informative). Each operand
+  -- is also required to be numeric.
+  | .Neg | .Add | .Sub | .Mul | .Div | .Mod | .DivT | .ModT =>
+    let results ← args.attach.mapM (fun a => have := a.property; do
+      Synth.resolveStmtExpr a.val)
+    let args' := results.map (·.1)
+    let argTypes := results.map (·.2)
+    let unknownTy : HighTypeMd := { val := .Unknown, source := source }
+    -- Multi-output operand guard: short-circuit to `Unknown` (arithmetic's
+    -- natural cascade-suppression type) once any operand is multi-valued.
+    let mut hasMulti := false
+    for (a, aTy) in args'.zip argTypes do
+      if (← reportMultiValued a aTy) then hasMulti := true
+    if hasMulti then
+      return (.PrimitiveOp op args' skipProof, unknownTy)
+    let ctx := (← get).typeLattice
+    -- Per-operand numeric check: surface the bad operand directly.
+    for (a, aTy) in args'.zip argTypes do
+      unless isNumeric ctx aTy do
+        typeMismatch a.source (some expr) "expected a numeric type" aTy
+    -- Fold operands by join, starting from `Unknown` so the
+    -- empty list (impossible for these ops, but kept for totality)
+    -- yields `Unknown` and a single-operand fold (`Neg`) yields the
+    -- operand's type.
+    let resultTy := argTypes.foldl
+      (fun acc aTy =>
+        match acc with
+        | some acc => join ctx acc aTy
+        | none => none)
+      (some unknownTy)
+    match resultTy with
+    | some ty => pure (.PrimitiveOp op args' skipProof, ty)
+    | none =>
+      let formatted := ", ".intercalate (argTypes.map (fun t => s!"'{formatType t}'"))
+      let diag := diagnosticFromSource source
+        s!"cannot apply '{op}' to operands of types {formatted}"
+      modify fun s => { s with errors := s.errors.push diag }
+      pure (.PrimitiveOp op args' skipProof, unknownTy)
+  | _ =>
+    let results ← args.attach.mapM (fun a => have := a.property; do
+      Synth.resolveStmtExpr a.val)
+    let args' := results.map (·.1)
+    let argTypes := results.map (·.2)
+    let resultTy := match op with
+      | .Eq | .Neq | .And | .Or | .AndThen | .OrElse | .Not | .Implies
+      | .Lt | .Leq | .Gt | .Geq => HighType.TBool
+      | .StrConcat => HighType.TString
+      -- Unreachable: filtered above.
+      | _ => HighType.Unknown
+    -- Multi-output operand guard: short-circuit to the operator's natural
+    -- result type (`TBool` for bool/cmp/eq, `TString` for concat) once any
+    -- operand is multi-valued, suppressing the per-family check below.
+    let mut hasMulti := false
+    for (a, aTy) in args'.zip argTypes do
+      if (← reportMultiValued a aTy) then hasMulti := true
+    if hasMulti then
+      return (.PrimitiveOp op args' skipProof, { val := resultTy, source := source })
+    match op with
+    | .And | .Or | .AndThen | .OrElse | .Not | .Implies =>
+      for (a, aTy) in args'.zip argTypes do
+        checkSubtype a.source { val := .TBool, source := a.source } aTy
+    | .Lt | .Leq | .Gt | .Geq =>
+      let ctx := (← get).typeLattice
+      for (a, aTy) in args'.zip argTypes do
+        unless isNumeric ctx aTy do
+          typeMismatch a.source (some expr) "expected a numeric type" aTy
+    | .Eq | .Neq =>
+      match argTypes with
+      | [lhsTy, rhsTy] =>
+        let ctx := (← get).typeLattice
+        unless isConsistent ctx lhsTy rhsTy do
+          let diag := diagnosticFromSource source
+            s!"cannot compare '{formatType lhsTy}' with '{formatType rhsTy}' using '{op}'"
+          modify fun s => { s with errors := s.errors.push diag }
+      | _ => pure ()
+    | .StrConcat =>
+      for (a, aTy) in args'.zip argTypes do
+        checkSubtype a.source { val := .TString, source := a.source } aTy
+    | _ => pure ()  -- unreachable
+    pure (.PrimitiveOp op args' skipProof, { val := resultTy, source := source })
+  termination_by (exprMd, 1)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+/-- Cases on the operator family.
+    ```
+    Numeric T                                                   (Op-Arith)
+    Γ ⊢ args_i ⇐ T
+    op ∈ {Neg, Add, Sub, Mul, Div, Mod, DivT, ModT}
+    ─────────────────────────────────────────────
+    Γ ⊢ PrimitiveOp op args ⇐ T
+
+    TBool <: T                                                  (Op-Bool)
+    Γ ⊢ args_i ⇐ TBool
+    op ∈ {And, Or, AndThen, OrElse, Not, Implies}
+    ─────────────────────────────────────────────
+    Γ ⊢ PrimitiveOp op args ⇐ T
+    ```
+    Both families run in check mode: the surrounding `expected` must
+    admit the family's natural result type (numeric for arithmetic,
+    `TBool` for boolean), and that operand type is pushed into every
+    operand via `Check.resolveStmtExpr`. Pushing `expected` (or `TBool`)
+    into operands replaces the synth-then-`checkSubtype` discipline of
+    `Synth.primitiveOp`, with two consequences: (a) control-flow
+    operands like `(if c then 1 else 2) + 3` or `(if c then a else b) && z`
+    are resolved correctly via `Check.ifThenElse` instead of hitting the
+    synth wildcard, and (b) `int + real` errors at the second operand
+    instead of being silently accepted under gradual mixing — the rule
+    now requires every operand to subtype the pushed type.
+
+    The remaining operator families (comparison, equality, string
+    concatenation) stay in `Synth.primitiveOp`: their result types are
+    fixed (`TBool` / `TString`) and their operand constraints can't be
+    expressed as a single pushable type (Numeric is a predicate;
+    equality is symmetric). The dispatcher routes those to the wildcard
+    `_ =>` arm of `Check.resolveStmtExpr`. -/
+def Check.primitiveOp (exprMd : StmtExprMd)
+    (op : Operation) (args : List StmtExprMd) (skipProof : Bool)
+    (expected : HighTypeMd) (source : Option FileRange)
+    (h : exprMd.val = .PrimitiveOp op args skipProof) :
+    ResolveM StmtExprMd := do
+  let operandTy : HighTypeMd ← match op with
+    | .Neg | .Add | .Sub | .Mul | .Div | .Mod | .DivT | .ModT =>
+      let ctx := (← get).typeLattice
+      unless isNumeric ctx expected do
+        typeMismatch source none "expected a numeric type" expected
+      pure expected
+    | .And | .Or | .AndThen | .OrElse | .Not | .Implies =>
+      let boolTy : HighTypeMd := { val := .TBool, source := source }
+      checkSubtype source expected boolTy
+      pure boolTy
+    | _ =>
+      -- Unreachable: dispatcher routes only the arithmetic and boolean
+      -- families to this rule. `Unknown` keeps the function total in
+      -- case the dispatcher's pattern list ever drifts.
+      pure { val := .Unknown, source := source }
+  let args' ← args.attach.mapM (fun a => have := a.property; do
+    Check.resolveStmtExpr a.val operandTy)
+  pure { val := .PrimitiveOp op args' skipProof, source := source }
+  termination_by (exprMd, 0)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+-- ### Object forms
+
+/-- Cases on whether `ref` resolves to a composite/datatype.
+    ```
+    ref is a composite or datatype,                (New-Ok)
+      or is unresolved, or is absent from Γ
+    ──────────────────────────────────────
+    Γ ⊢ New ref ⇒ UserDefined ref
+
+    ref resolves to a non-type kind               (New-Fallback)
+    ──────────────────────────────────────
+    Γ ⊢ New ref ⇒ Unknown
+    ```
+    When `ref` resolves to a composite or datatype, the type is
+    `UserDefined ref`. The `Unknown` fallback fires *only* when `ref`
+    resolves to a present definition whose kind is neither composite nor
+    datatype (e.g. a variable or procedure name); this suppresses
+    cascading errors after the kind diagnostic has already fired. An
+    *unresolved* `ref`, or one absent from scope, takes the `UserDefined`
+    branch instead — `resolveRef` has already reported the name, so
+    re-flagging it here would only duplicate that diagnostic. -/
+def Synth.new (ref : Identifier) (source : Option FileRange) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let ref' ← resolveRef ref source
+    (expected := #[.compositeType, .datatypeDefinition])
+  let s ← get
+  let kindOk : Bool := match s.scope.get? ref.text with
+    | some (_, node) => node.kind == .unresolved ||
+        (#[ResolvedNodeKind.compositeType, .datatypeDefinition].contains node.kind)
+    | none => true
+  let ty := if kindOk then { val := HighType.UserDefined ref', source := source }
+            else { val := HighType.Unknown, source := source }
+  pure (.New ref', ty)
+
+/-- (AsType)
+    ```
+    Γ ⊢ target ⇒ U
+    U ~ T  ∨  U <: T  ∨  T <: U
+    ──────────────────────────────────────────────
+    Γ ⊢ AsType target T ⇒ T
+    ```
+    `target` synthesizes some type `U`; the cast is allowed when `U` and
+    `T` sit in the same lineage modulo gradual `Unknown` — either
+    consistent after unfolding aliases/constrained types (e.g. `5 as Int`
+    where `Int` is a wrapper over `int`), or a subtype in either
+    direction (downcast `animal as Cat` when `Cat extends Animal`,
+    upcast `cat as Animal`). Sibling casts (`Dog as Cat`) and casts
+    between unrelated primitives (`"hi" as int`) are rejected. The
+    synthesized type is `T` — the user's claim is honored once the
+    relation check passes. -/
+def Synth.asType (exprMd : StmtExprMd)
+    (target : StmtExprMd) (ty : HighTypeMd)
+    (h : exprMd.val = .AsType target ty) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let (target', targetTy) ← Synth.resolveStmtExpr target
+  let ty' ← resolveHighType ty
+  let ctx := (← get).typeLattice
+  unless isConsistentSubtype ctx targetTy ty' || isConsistentSubtype ctx ty' targetTy do
+    let diag := diagnosticFromSource target.source
+      s!"cannot cast unrelated type '{formatType targetTy}' to '{formatType ty'}'"
+    modify fun s => { s with errors := s.errors.push diag }
+  pure (.AsType target' ty', ty')
+  termination_by (exprMd, 1)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+/-- (IsType)
+    ```
+    Γ ⊢ target ⇒ U
+    U ~ T  ∨  U <: T  ∨  T <: U
+    ──────────────────────────────────────────────
+    Γ ⊢ IsType target T ⇒ TBool
+    ```
+    Same lineage check as `AsType` — `is` only makes sense between types
+    that share a lineage modulo gradual `Unknown`; testing `5 is Cat`
+    is statically nonsense. The synthesized type is `TBool`. -/
+def Synth.isType (exprMd : StmtExprMd)
+    (target : StmtExprMd) (ty : HighTypeMd) (source : Option FileRange)
+    (h : exprMd.val = .IsType target ty) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let (target', targetTy) ← Synth.resolveStmtExpr target
+  let ty' ← resolveHighType ty
+  let ctx := (← get).typeLattice
+  unless isConsistentSubtype ctx targetTy ty' || isConsistentSubtype ctx ty' targetTy do
+    let diag := diagnosticFromSource target.source
+      s!"cannot test unrelated type '{formatType targetTy}' against '{formatType ty'}'"
+    modify fun s => { s with errors := s.errors.push diag }
+  pure (.IsType target' ty', { val := .TBool, source := source })
+  termination_by (exprMd, 1)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+/-- (RefEq)
+    ```
+    Γ ⊢ lhs ⇒ T_l
+    Γ ⊢ rhs ⇒ T_r
+    isReference T_l
+    isReference T_r
+    T_l ~ T_r
+    ──────────────────────────────────────────────────
+    Γ ⊢ ReferenceEquals lhs rhs ⇒ TBool
+    ```
+    Both operands must be reference types (`UserDefined` or `Unknown`) —
+    reference equality is meaningless on primitives. The operands must
+    also be mutually consistent (the symmetric `isConsistent`), so
+    `Cat === Dog` is rejected when `Cat` and `Dog` are unrelated
+    user-defined types, while `Cat === Animal` is accepted when `Cat`
+    extends `Animal` (the gradual `Unknown` wildcard makes either side
+    flow freely against the other). -/
+def Synth.refEq (exprMd : StmtExprMd) (expr : StmtExpr)
+    (lhs rhs : StmtExprMd) (source : Option FileRange)
+    (h_expr : expr = .ReferenceEquals lhs rhs)
+    (h : exprMd.val = .ReferenceEquals lhs rhs) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let _ := h_expr
+  let (lhs', lhsTy) ← Synth.resolveStmtExpr lhs
+  let (rhs', rhsTy) ← Synth.resolveStmtExpr rhs
+  let ctx := (← get).typeLattice
+  unless isReference ctx lhsTy do
+    typeMismatch lhs'.source (some expr) "expected a reference type" lhsTy
+  unless isReference ctx rhsTy do
+    typeMismatch rhs'.source (some expr) "expected a reference type" rhsTy
+  unless isConsistent ctx lhsTy rhsTy do
+    let diag := diagnosticFromSource source
+      s!"'{expr.constrName}' operands have incompatible types '{formatType lhsTy}' and '{formatType rhsTy}'"
+    modify fun s => { s with errors := s.errors.push diag }
+  pure (.ReferenceEquals lhs' rhs', { val := .TBool, source := source })
+  termination_by (exprMd, 1)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+/-- (PureFieldUpdate)
+    ```
+    Γ ⊢ target ⇒ T_t
+    Γ(f) = T_f
+    Γ ⊢ newVal ⇐ T_f
+    ─────────────────────────────────────────────────────
+    Γ ⊢ PureFieldUpdate target f newVal ⇒ T_t
+    ```
+    `target` is synthesized, `f` resolved against `T_t` (or the enclosing
+    instance type), and `newVal` checked against the field's declared
+    type. The synthesized type is `T_t` — updating a field on a pure type
+    produces a new value of the same type. -/
+def Synth.pureFieldUpdate (exprMd : StmtExprMd)
+    (target : StmtExprMd) (fieldName : Identifier) (newVal : StmtExprMd)
+    (h : exprMd.val = .PureFieldUpdate target fieldName newVal) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let (target', targetTy) ← Synth.resolveStmtExpr target
+  let fieldName' ← resolveFieldRef target' fieldName target.source
+  let fieldTy ← getVarType fieldName'
+  let newVal' ← Check.resolveStmtExpr newVal fieldTy
+  pure (.PureFieldUpdate target' fieldName' newVal', targetTy)
+  termination_by (exprMd, 1)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+-- ### Verification expressions
+
+/-- (Quantifier)
+    ```
+    Γ, x : T ⊢ body ⇐ TBool
+    ────────────────────────────────────────────
+    Γ ⊢ Quantifier mode ⟨x, T⟩ trig body ⇒ TBool
+    ```
+    Opens a fresh scope, binds `x : T` (in scope only for the body and
+    trigger), resolves the optional trigger, and checks the body against
+    `TBool` since a quantifier is a proposition. Without that body check,
+    `forall x: int :: x + 1` would be silently accepted. The construct
+    itself synthesizes `TBool`. -/
+def Synth.quantifier (exprMd : StmtExprMd)
+    (mode : QuantifierMode) (param : Parameter)
+    (trigger : Option StmtExprMd) (body : StmtExprMd) (source : Option FileRange)
+    (h : exprMd.val = .Quantifier mode param trigger body) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  withScope do
+    let paramTy' ← resolveHighType param.type
+    let paramName' ← defineNameCheckDup param.name (.quantifierVar param.name paramTy')
+    let trigger' ← trigger.attach.mapM (fun pv => have := pv.property; do
+      let (e', _) ← Synth.resolveStmtExpr pv.val; pure e')
+    let body' ← Check.resolveStmtExpr body { val := .TBool, source := body.source }
+    pure (.Quantifier mode ⟨paramName', paramTy'⟩ trigger' body', { val := .TBool, source := source })
+  termination_by (exprMd, 1)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+/-- (Assigned)
+    ```
+    Γ ⊢ name ⇒ _
+    ────────────────────────────
+    Γ ⊢ Assigned name ⇒ TBool
+    ```
+    `assigned x` is a verification predicate that holds when `x` has
+    been definitely assigned. The construct unconditionally synthesizes
+    `TBool`; the operand's synthesized type is discarded, and `Assigned`
+    imposes no constraint on it.
+
+    The operand is still resolved (via `Synth.resolveStmtExpr`) purely
+    for its name-resolution side effects — its identifier must point at a
+    definition so that downstream passes can reason about the binding —
+    but the result type is thrown away. `Assigned` is meant to name a
+    variable or field, yet its AST field is an arbitrary `StmtExpr`
+    (`Assigned (name : StmtExprMd)`), so this rule does *not* enforce
+    that shape: it is not correct-by-construction, and the type checker
+    deliberately leaves the operand unconstrained rather than rejecting,
+    say, `assigned (a + b)`. -/
+def Synth.assigned (exprMd : StmtExprMd)
+    (name : StmtExprMd) (source : Option FileRange)
+    (h : exprMd.val = .Assigned name) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let (name', _) ← Synth.resolveStmtExpr name
+  pure (.Assigned name', { val := .TBool, source := source })
+  termination_by (exprMd, 1)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+/-- (Old)
+    ```
+    Γ ⊢ v ⇐ T
+    ───────────────
+    Γ ⊢ Old v ⇐ T
+    ```
+    `old(v)` refers to the pre-state value of `v` in a postcondition.
+    It has the same type as `v`, so the surrounding expectation
+    propagates straight through: `v` is checked against the same `T`,
+    and the result is wrapped back up as `Old v'`.
+
+    The rule is type-transparent and deliberately does *not* restrict
+    `v` to an identifier or lvalue. `old` wraps an arbitrary expression
+    (`Old (value : StmtExprMd)`), matching Dafny, where `old(this.f +
+    g())` is legal — the pre-state is taken of the whole expression.
+    Whether `v` denotes something whose pre-state is meaningful is a
+    well-formedness question for the verifier's heap model, not a typing
+    one, so resolution only resolves names inside `v` and checks its
+    type; it imposes no syntactic shape on `v`. -/
+def Check.old (exprMd : StmtExprMd)
+    (val : StmtExprMd) (expected : HighTypeMd) (source : Option FileRange)
+    (h : exprMd.val = .Old val) :
+    ResolveM StmtExprMd := do
+  let val' ← Check.resolveStmtExpr val expected
+  pure { val := .Old val', source := source }
+  termination_by (exprMd, 0)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+/-- (Old-Synth)
+    ```
+    Γ ⊢ v ⇒ T
+    ───────────────
+    Γ ⊢ Old v ⇒ T
+    ```
+    `old` is a *universal morphism*: it is fully type-transparent, so
+    `old(v)` has exactly the type of `v` and passes through every
+    operation. When `old(...)` appears in a synthesis position (e.g. as
+    an operand of `==`/`<`/`++`, which synthesize their operands — the
+    documented postcondition pattern `ensures counter.value ==
+    old(counter.value) + 1`), `v` is synthesized and its type `T` is
+    returned unchanged, wrapped back up as `Old v'`. Without this rule the
+    construct would fall into the synth wildcard and spuriously report
+    that its type cannot be synthesized. -/
+def Synth.old (exprMd : StmtExprMd)
+    (val : StmtExprMd) (source : Option FileRange)
+    (h : exprMd.val = .Old val) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let (val', valTy) ← Synth.resolveStmtExpr val
+  pure (.Old val', valTy)
+  termination_by (exprMd, 1)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+/-- (Fresh)
+    ```
+    Γ ⊢ v ⇒ T
+    isReference T
+    ────────────────────────────
+    Γ ⊢ Fresh v ⇒ TBool
+    ```
+    `v` is synthesized and must have a reference type (`UserDefined` or
+    `Unknown`) — `Fresh` only makes sense on heap-allocated references, so
+    `fresh(5)` is rejected. The construct itself synthesizes `TBool`. -/
+def Synth.fresh (exprMd : StmtExprMd) (expr : StmtExpr)
+    (val : StmtExprMd) (source : Option FileRange)
+    (h_expr : expr = .Fresh val)
+    (h : exprMd.val = .Fresh val) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let _ := h_expr
+  let (val', valTy) ← Synth.resolveStmtExpr val
+  unless isReference (← get).typeLattice valTy do
+    typeMismatch val'.source (some expr) "expected a reference type" valTy
+  pure (.Fresh val', { val := .TBool, source := source })
+  termination_by (exprMd, 1)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+/-- (ProveBy)
+    ```
+    Γ ⊢ v ⇐ T
+    Γ ⊢ proof ⇒ _
+    ────────────────────────────
+    Γ ⊢ ProveBy v proof ⇐ T
+    ```
+    `ProveBy v proof` has the same type as `v` (the proof is just a hint
+    for downstream verification), so the surrounding expectation
+    propagates into `v`. The proof itself has no constraint on its type
+    and is still synthesized. -/
+def Check.proveBy (exprMd : StmtExprMd)
+    (val proof : StmtExprMd) (expected : HighTypeMd) (source : Option FileRange)
+    (h : exprMd.val = .ProveBy val proof) :
+    ResolveM StmtExprMd := do
+  let val' ← Check.resolveStmtExpr val expected
+  let (proof', _) ← Synth.resolveStmtExpr proof
+  pure { val := .ProveBy val' proof', source := source }
+  termination_by (exprMd, 0)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+/-- (ProveBy-Synth)
+    ```
+    Γ ⊢ v ⇒ T
+    Γ ⊢ proof ⇒ _
+    ────────────────────────────
+    Γ ⊢ ProveBy v proof ⇒ T
+    ```
+    Like `old`, `ProveBy v proof` is type-transparent in `v` — the proof
+    is just a hint for downstream verification and carries no typing
+    constraint. In a synthesis position `v` is synthesized for its type
+    `T`, `proof` is synthesized only for its name-resolution side effects
+    (its type is discarded), and `T` is returned. -/
+def Synth.proveBy (exprMd : StmtExprMd)
+    (val proof : StmtExprMd) (source : Option FileRange)
+    (h : exprMd.val = .ProveBy val proof) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let (val', valTy) ← Synth.resolveStmtExpr val
+  let (proof', _) ← Synth.resolveStmtExpr proof
+  pure (.ProveBy val' proof', valTy)
+  termination_by (exprMd, 1)
+  decreasing_by
+    all_goals
+      apply Prod.Lex.left
+      have hsz := exprMd.sizeOf_val_lt
+      rw [h] at hsz
+      term_by_mem
+
+-- ### Self reference
+
+/-- Cases on whether `instanceTypeName` is set (i.e., we're inside an
+    instance method).
+
+    ```
+    Γ.instanceTypeName = some T      (This-Inside)
+    ───────────────────────────
+    Γ ⊢ This ⇒ UserDefined T
+
+    Γ.instanceTypeName = none        (This-Outside)
+    ───────────────────────────
+    Γ ⊢ This ⇒ Unknown               (emits "'this' is not allowed outside instance methods")
+    ```
+    When `instanceTypeName` is set (we're inside an instance method,
+    populated on `ResolveState` by `resolveInstanceProcedure` for the
+    duration of an instance method body), `This` synthesizes
+    `UserDefined T`. With it, `this.field` and instance-method dispatch
+    synthesize real types instead of being wildcarded through `Unknown`.
+    Otherwise an error is emitted ("'this' is not allowed outside instance
+    methods") and the type collapses to `Unknown` to suppress cascading
+    errors. -/
+def Synth.this (source : Option FileRange) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let s ← get
+  match s.instanceTypeName with
+  | some typeName =>
+    let typeId : Identifier :=
+      match s.scope.get? typeName with
+      | some (uid, _) => { text := typeName, uniqueId := some uid, source := source }
+      | none => { text := typeName, source := source }
+    pure (.This, { val := .UserDefined typeId, source := source })
+  | none =>
+    let diag := diagnosticFromSource source "'this' is not allowed outside instance methods"
+    modify fun s => { s with errors := s.errors.push diag }
+    pure (.This, { val := .Unknown, source := source })
+
+-- ### Untyped forms
+
+/-- `Γ ⊢ Abstract ⇒ Unknown` -/
+def Synth.abstract (source : Option FileRange) : StmtExpr × HighTypeMd :=
+  (.Abstract, { val := .Unknown, source := source })
+
+/-- `Γ ⊢ All ⇒ Unknown` -/
+def Synth.all (source : Option FileRange) : StmtExpr × HighTypeMd :=
+  (.All, { val := .Unknown, source := source })
+
+-- ### ContractOf
+
+/-- Cases on the contract type `ty` and on whether `fn` is a procedure
+    reference.
+
+    ```
+    fn = Var (.Local id)                                       (ContractOf-Bool)
+    Γ(id) ∈ {staticProcedure, instanceProcedure, unresolved}
+    ────────────────────────────────────────────
+    Γ ⊢ ContractOf Precondition fn ⇒ TBool
+    Γ ⊢ ContractOf PostCondition fn ⇒ TBool
+
+    fn = Var (.Local id)                                       (ContractOf-Set)
+    Γ(id) ∈ {staticProcedure, instanceProcedure, unresolved}
+    ────────────────────────────────────────────
+    Γ ⊢ ContractOf Reads fn ⇒ TSet Unknown
+    Γ ⊢ ContractOf Modifies fn ⇒ TSet Unknown
+
+    fn is not a Var (.Local) resolving to a procedure          (ContractOf-Error)
+      or unresolved name
+    ────────────────────────────────────────────
+    Γ ⊢ ContractOf _ fn ↝ error: "'contractOf' expected a procedure reference"
+    ```
+    `ContractOf ty fn` extracts a procedure's contract clause as a value:
+    its preconditions (`Precondition`), postconditions (`PostCondition`),
+    reads set (`Reads`), or modifies set (`Modifies`). `fn` must be a
+    direct identifier reference resolving to a procedure — a contract
+    belongs to a *named* procedure, not an arbitrary expression. The
+    diagnostic *"'contractOf' expected a procedure reference"* fires (and
+    the construct synthesizes `Unknown` to suppress cascading errors) when
+    `fn` is anything other than a `Var (.Local id)`, or resolves to a
+    present definition that is not a procedure. An *unresolved* `id`, or
+    one absent from scope, is accepted without firing the diagnostic —
+    its name-resolution error was already reported.
+
+    `Precondition` and `PostCondition` are propositions, hence `TBool`.
+    `Reads` and `Modifies` are sets of heap-allocated locations —
+    composite/datatype references and fields. The element type is left as
+    `Unknown` for now since the rule doesn't yet recover it from `fn`'s
+    declared modifies/reads clauses.
+
+    The constructor is reserved for future use — Laurel's grammar has no
+    `contractOf` production today, and the translator emits "not yet
+    implemented" for it. The typing rule exists so resolution remains
+    exhaustive over `StmtExpr`. -/
+def Synth.contractOf (exprMd : StmtExprMd)
+    (ty : ContractType) (fn : StmtExprMd) (source : Option FileRange)
+    (h : exprMd.val = .ContractOf ty fn) :
+    ResolveM (StmtExpr × HighTypeMd) := do
+  let (fn', _) ← Synth.resolveStmtExpr fn
+  let s ← get
+  let fnIsProcRef : Bool := match fn'.val with
+    | .Var (.Local ref) =>
+      match s.scope.get? ref.text with
+      | some (_, node) =>
+        node.kind == .staticProcedure ||
+        node.kind == .instanceProcedure ||
+        node.kind == .unresolved
+      | none => true  -- unresolved name already reported
+    | _ => false
+  unless fnIsProcRef do
+    let diag := diagnosticFromSource fn.source
+      "'contractOf' expected a procedure reference"
+    modify fun s => { s with errors := s.errors.push diag }
+  let resultTy : HighType := match ty with
+    | .Precondition | .PostCondition => .TBool
+    | .Reads | .Modifies => .TSet { val := .Unknown, source := none }
+  pure (.ContractOf ty fn', { val := resultTy, source := source })
+  termination_by (exprMd, 1)
+  decreasing_by
+    apply Prod.Lex.left
+    have hsz := exprMd.sizeOf_val_lt
+    rw [h] at hsz
+    term_by_mem
+
+-- ### Holes
+
+/-- (Hole-Some)
+    ```
+    T_h <: T
+    ────────────────────────────
+    Γ ⊢ Hole d (some T_h) ⇐ T
+    ```
+    A typed hole carries the user's annotation `T_h`. The annotation is
+    resolved and verified against the surrounding `expected` type via
+    subsumption; the resolved annotation is preserved on the node so
+    downstream passes (hole elimination) can generate correctly typed
+    uninterpreted functions. -/
+def Check.holeSome (det : Bool) (ty : HighTypeMd) (expected : HighTypeMd)
+    (source : Option FileRange) : ResolveM StmtExprMd := do
+  let ty' ← resolveHighType ty
+  checkSubtype source expected ty'
+  pure { val := .Hole det (some ty'), source := source }
+
+/-- (Hole-None)
+    ```
+    ────────────────────────────────────────
+    Γ ⊢ Hole d none ⇐ T  ↦  Γ ⊢ Hole d (some T)
+    ```
+    An untyped hole in check mode records the expected type on the node
+    so downstream passes (hole elimination) don't have to infer it
+    again. -/
+def Check.holeNone (det : Bool) (expected : HighTypeMd) (source : Option FileRange) :
+    StmtExprMd :=
+  { val := .Hole det (some expected), source := source }
+
+end -- mutual
+end Resolution
+
+open Resolution
+
+/-- Resolve a statement expression, discarding the synthesized type.
+    Use when only the resolved expression is needed (invariants, decreases, etc.). -/
+private def resolveStmtExpr (e : StmtExprMd) : ResolveM StmtExprMd := do
+  let (e', _) ← Synth.resolveStmtExpr e; pure e'
 
 /-- Resolve a parameter: assign a fresh ID and add to scope. -/
 def resolveParameter (param : Parameter) : ResolveM Parameter := do
@@ -558,36 +2565,79 @@ def resolveParameter (param : Parameter) : ResolveM Parameter := do
   let name' ← defineNameCheckDup param.name (.parameter ⟨param.name, ty'⟩)
   return ⟨name', ty'⟩
 
-/-- Resolve a procedure body. -/
+/-- Resolve a procedure output parameter, given the names of the inputs already
+    in scope. A parameter whose name also appears in the inputs is a true inout
+    parameter (e.g. the `$heap` synthesized by heap parameterization): it denotes
+    the *same* variable as the input, so we resolve its name as a reference to the
+    existing input definition rather than re-defining it (which
+    `defineNameCheckDup` would otherwise flag as a duplicate). -/
+def resolveOutputParameter (inputNames : List String) (param : Parameter) : ResolveM Parameter := do
+  if inputNames.contains param.name.text then
+    let ty' ← resolveHighType param.type
+    let name' ← resolveRef param.name
+    return ⟨name', ty'⟩
+  else
+    resolveParameter param
+
+/-- Resolve a procedure body by synthesizing its body (if any).
+    Bodies without an body (`Abstract`, `External`) resolve
+    postconditions only. -/
 def resolveBody (body : Body) : ResolveM Body := do
   match body with
   | .Transparent b =>
-    let b' ← resolveStmtExpr b
+    let (b', _) ← Synth.resolveStmtExpr b
     return .Transparent b'
   | .Opaque posts impl mods =>
     let posts' ← posts.mapM (·.mapM resolveStmtExpr)
-    let impl' ← impl.mapM resolveStmtExpr
+    let impl' ← impl.mapM Synth.resolveStmtExpr
     let mods' ← mods.mapM resolveStmtExpr
-    return .Opaque posts' impl' mods'
+    return .Opaque posts' (impl'.map (fun t => t.1)) mods'
   | .Abstract posts =>
     let posts' ← posts.mapM (·.mapM resolveStmtExpr)
     return .Abstract posts'
   | .External => return .External
 
-/-- Resolve a procedure: resolve its name, then resolve params, contracts, and body in a new scope. -/
+/-- (Procedure)
+    ```
+    T_o-bar = proc.outputs.types
+    Γ_global, params(proc) ⊢ proc.body ⇒ _
+    ──────────────────────────────────────────────────────────
+    Γ_global ⊢ Procedure proc
+    ```
+    The body is synthesized (not checked against a computed expected
+    type) under a scope that includes the procedure's input and output
+    parameters. Outputs are matched only via `return e` (checked against
+    the declared output by `Check.return`) or via named-output
+    assignment. The procedure's declared output list `T_o-bar` is stored
+    on `ResolveState.answerType`, set on entry and restored on exit. -/
 def resolveProcedure (proc : Procedure) : ResolveM Procedure := do
   let procName' ← resolveRef proc.name
   withScope do
     let inputs' ← proc.inputs.mapM resolveParameter
-    let outputs' ← proc.outputs.mapM resolveParameter
+    let inputNames := inputs'.map (·.name.text)
+    let outputs' ← proc.outputs.mapM (resolveOutputParameter inputNames)
     let pres' ← proc.preconditions.mapM (·.mapM resolveStmtExpr)
     let dec' ← proc.decreases.mapM resolveStmtExpr
-    let body' ← resolveBody proc.body
+    let savedAnswer := (← get).answerType
+    modify fun s => { s with answerType := some (outputs'.map (·.type)) }
+    -- Pre-register the implicit `bodyLabel` block that the LaurelToCore
+    -- translator wraps every body in (`Core.Statement.block bodyLabel …`),
+    -- so that frontends emitting `Exit bodyLabel` for early-return lowering
+    -- (e.g. PythonToLaurel) don't trip Check.exit's label-scope check.
+    let body' ← withLabel (some bodyLabel) <| resolveBody proc.body
+    modify fun s => { s with answerType := savedAnswer }
+    -- Transparent (static) procedure bodies are supported (#1215): the
+    -- TransparencyPass derives a functional `$asFunction` copy, and the
+    -- LaurelToCore translator rejects the genuinely-unsupported constructs
+    -- (e.g. destructive assignments) inside a transparent body. So there is
+    -- no transparent-body rejection here, unlike `resolveInstanceProcedure`.
     let invokeOn' ← proc.invokeOn.mapM resolveStmtExpr
+    let axioms' ← proc.axioms.mapM resolveStmtExpr
     return { name := procName', inputs := inputs', outputs := outputs',
              isFunctional := proc.isFunctional,
              preconditions := pres', decreases := dec',
              invokeOn := invokeOn',
+             axioms := axioms',
              body := body' }
 
 /-- Resolve a field: define its name under the qualified key (OwnerType.fieldName) and resolve its type. -/
@@ -603,25 +2653,30 @@ def resolveField (ownerName : Identifier) (field : Field) : ResolveM Field := do
 
 /-- Resolve an instance procedure on a composite type. -/
 def resolveInstanceProcedure (typeName : Identifier) (proc : Procedure) : ResolveM Procedure := do
-  let procName' ← resolveRef proc.name
+  let scopedKey := containerScopedName typeName proc.name
+  let resolved ← resolveRef scopedKey
+  let procName' := { proc.name with uniqueId := resolved.uniqueId }
   withScope do
     let savedInstType := (← get).instanceTypeName
     modify fun s => { s with instanceTypeName := some typeName.text }
     let inputs' ← proc.inputs.mapM resolveParameter
-    let outputs' ← proc.outputs.mapM resolveParameter
+    let inputNames := inputs'.map (·.name.text)
+    let outputs' ← proc.outputs.mapM (resolveOutputParameter inputNames)
     let pres' ← proc.preconditions.mapM (·.mapM resolveStmtExpr)
     let dec' ← proc.decreases.mapM resolveStmtExpr
-    let body' ← resolveBody proc.body
-    if !proc.isFunctional && body'.isTransparent && !proc.name.text.any (· == '$') then
-      let diag := diagnosticFromSource proc.name.source
-        s!"transparent statement bodies are not supported. Add 'opaque' to make the procedure opaque"
-      modify fun s => { s with errors := s.errors.push diag }
+    let savedAnswer := (← get).answerType
+    modify fun s => { s with answerType := some (outputs'.map (·.type)) }
+    -- See `resolveProcedure` for the rationale on `bodyLabel`.
+    let body' ← withLabel (some bodyLabel) <| resolveBody proc.body
+    modify fun s => { s with answerType := savedAnswer }
     let invokeOn' ← proc.invokeOn.mapM resolveStmtExpr
     modify fun s => { s with instanceTypeName := savedInstType }
+    let axioms' ← proc.axioms.mapM resolveStmtExpr
     return { name := procName', inputs := inputs', outputs := outputs',
              isFunctional := proc.isFunctional,
              preconditions := pres', decreases := dec',
              invokeOn := invokeOn',
+             axioms := axioms',
              body := body' }
 
 /-- Resolve a type definition. -/
@@ -658,8 +2713,8 @@ def resolveTypeDefinition (td : TypeDefinition) : ResolveM TypeDefinition := do
     -- in scope when resolving the constraint and witness expressions.
     let (valueName', constraint', witness') ← withScope do
       let valueName' ← defineNameCheckDup ct.valueName (.quantifierVar ct.valueName base')
-      let constraint' ← resolveStmtExpr ct.constraint
-      let witness' ← resolveStmtExpr ct.witness
+      let (constraint', _) ← Synth.resolveStmtExpr ct.constraint
+      let (witness', _) ← Synth.resolveStmtExpr ct.witness
       return (valueName', constraint', witness')
     return .Constrained { name := ctName', base := base', valueName := valueName',
                           constraint := constraint', witness := witness' }
@@ -675,7 +2730,12 @@ def resolveTypeDefinition (td : TypeDefinition) : ResolveM TypeDefinition := do
         -- parameter's own name should stay unqualified.
         let destructorId := { p.name with uniqueId := resolved.uniqueId }
         return ⟨ destructorId, ty' ⟩
-      return { name := ctorName', args := args' : DatatypeConstructor }
+      -- Resolve the tester name so its uniqueId is set.
+      let testerResolved ← resolveRef (dt.testerName ctor)
+      let testerName' := { ctor.testerName with
+        text := testerResolved.text
+        uniqueId := testerResolved.uniqueId }
+      return { name := ctorName', args := args', testerName := testerName' : DatatypeConstructor }
     return .Datatype { name := dtName', typeArgs := dt.typeArgs, constructors := ctors' }
   | .Alias ta =>
     let target' ← resolveHighType ta.target
@@ -685,12 +2745,34 @@ def resolveTypeDefinition (td : TypeDefinition) : ResolveM TypeDefinition := do
 /-- Resolve a constant definition. -/
 def resolveConstant (c : Constant) : ResolveM Constant := do
   let ty' ← resolveHighType c.type
-  let init' ← c.initializer.mapM resolveStmtExpr
+  let init' ← c.initializer.mapM (Check.resolveStmtExpr · ty')
   let name' ← resolveRef c.name
   return { name := name', type := ty', initializer := init' }
 
 /-! ## Phase 2: Build refToDef map from the resolved program -/
 
+/-- Generate a virtual tester procedure for a single constructor of a datatype.
+    The tester takes a single argument of the datatype's type and returns `bool`.
+    Used during resolution to synthesize the scope entry for tester calls
+    (e.g. `IntList..isNil(x)`) without requiring a separate AST pass. -/
+private def mkTesterProcedure (dt : DatatypeDefinition) (ctor : DatatypeConstructor) : Procedure :=
+  let tName := dt.testerName ctor
+  let inputParam : Parameter := {
+    name := mkId "value"
+    type := { val := .UserDefined dt.name, source := none }
+  }
+  let outputParam : Parameter := {
+    name := mkId "$result"
+    type := { val := .TBool, source := none }
+  }
+  { name := mkId tName
+    inputs := [inputParam]
+    outputs := [outputParam]
+    preconditions := []
+    decreases := none
+    isFunctional := true
+    body := .External }
+
 /-- Insert a definition into the refToDef map using the ID already on the identifier. -/
 private def register (map : Std.HashMap Nat ResolvedNode) (iden : Identifier) (node : ResolvedNode)
     : Std.HashMap Nat ResolvedNode :=
@@ -703,7 +2785,6 @@ private def collectHighType (map : Std.HashMap Nat ResolvedNode) (ty : HighTypeM
   match ty with
   | AstNode.mk val _ =>
   match val with
-  | .TTypedField vt => collectHighType map vt
   | .TSet et => collectHighType map et
   | .TMap kt vt =>
     let map := collectHighType map kt
@@ -728,7 +2809,7 @@ private def collectStmtExpr (map : Std.HashMap Nat ResolvedNode) (expr : StmtExp
     | some e => collectStmtExpr map e
     | none => map
   | .Block stmts _ => stmts.foldl collectStmtExpr map
-  | .While cond invs dec body =>
+  | .While cond invs dec body _ =>
     let map := collectStmtExpr map cond
     let map := invs.foldl collectStmtExpr map
     let map := match dec with | some d => collectStmtExpr map d | none => map
@@ -746,6 +2827,8 @@ private def collectStmtExpr (map : Std.HashMap Nat ResolvedNode) (expr : StmtExp
         collectHighType map param.type
       | _ => map) map
     collectStmtExpr map value
+  | .IncrDecr _ _ ⟨.Field tgt _, _⟩ => collectStmtExpr map tgt
+  | .IncrDecr _ _ ⟨.Local _, _⟩ | .IncrDecr _ _ ⟨.Declare _, _⟩ => map
   | .Var (.Field target _) => collectStmtExpr map target
   | .PureFieldUpdate target _ newVal =>
     let map := collectStmtExpr map target
@@ -778,7 +2861,7 @@ private def collectStmtExpr (map : Std.HashMap Nat ResolvedNode) (expr : StmtExp
     let map := collectStmtExpr map val
     collectStmtExpr map proof
   | .ContractOf _ fn => collectStmtExpr map fn
-  | .New _ | .This | .Exit _ | .LiteralInt _ | .LiteralBool _ | .LiteralString _ | .LiteralDecimal _
+  | .New _ | .This | .Exit _ | .LiteralInt _ | .LiteralBool _ | .LiteralString _ | .LiteralDecimal _ | .LiteralBv _ _
   | .Abstract | .All | .Hole _ _ => map
 
 private def collectBody (map : Std.HashMap Nat ResolvedNode) (body : Body)
@@ -827,6 +2910,9 @@ private def collectTypeDefinition (map : Std.HashMap Nat ResolvedNode) (td : Typ
     let map := register map dt.name (.datatypeDefinition dt)
     dt.constructors.foldl (fun map ctor =>
       let map := register map ctor.name (.datatypeConstructor dt.name ctor)
+      -- Register the tester function in the refToDef map.
+      let testerProc := mkTesterProcedure dt ctor
+      let map := register map ctor.testerName (.staticProcedure testerProc)
       ctor.args.foldl (fun map p =>
         -- The constructor parameter's `uniqueId` (set by `resolveTypeDefinition`)
         -- is the shared uniqueId of the safe/unsafe destructor scope entries,
@@ -856,9 +2942,130 @@ def buildRefToDef (program : Program) : Std.HashMap Nat ResolvedNode :=
   let map := program.staticFields.foldl (collectField · "$static" ·) map
   program.staticProcedures.foldl (collectProcedure · · .staticProcedure) map
 
+/-! Additional checks-/
+
+/--
+Check if a field can be reached through a given type (directly declared or inherited).
+Returns true if the type or any of its ancestors declares the field.
+-/
+def canReachField (model : SemanticModel) (typeName : Identifier) (fieldName : Identifier) : Bool :=
+  match model.get fieldName with
+  | .field owner _ => ((computeAncestors model typeName).find? (fun t => t.name == owner)).isSome
+  | _ => false -- recover from a resolution error
+
+/--
+Check if a field is inherited through multiple parent paths (diamond inheritance).
+Returns true if more than one direct parent of the given type can reach the field.
+-/
+def isDiamondInheritedField (model : SemanticModel) (typeName : Identifier) (fieldName : Identifier) : Bool :=
+  match model.get typeName with
+  | .compositeType ct =>
+    -- If the field is directly declared on this type, it's not a diamond
+    if ct.fields.any (·.name == fieldName) then false
+    else
+      -- Count how many direct parents can reach this field
+      let parentsWithField := ct.extending.filter (canReachField model · fieldName)
+      parentsWithField.length > 1
+  | _ => false
+
+/--
+Check whether accessing `fieldName` on `target` is a diamond-inherited field access,
+and if so return a diagnostic error using the given `source` range.
+-/
+private def checkDiamondFieldAccess (model : SemanticModel) (target : StmtExprMd)
+    (fieldName : Identifier) (source : Option FileRange) : List DiagnosticModel :=
+  match (computeExprType model target).val with
+  | .UserDefined typeName =>
+    if isDiamondInheritedField model typeName fieldName then
+      match source with
+      | some fileRange =>
+        [DiagnosticModel.withRange fileRange s!"fields that are inherited multiple times can not be accessed."]
+      | none =>
+        [DiagnosticModel.fromMessage s!"fields that are inherited multiple times can not be accessed."]
+    else []
+  | _ => []
+
+/--
+Walk a StmtExpr AST and collect DiagnosticModel errors for diamond-inherited field accesses.
+-/
+def validateDiamondFieldAccessesForStmtExpr (model : SemanticModel)
+    (expr : StmtExprMd) : List DiagnosticModel :=
+  match _h : expr.val with
+  | .Var (.Field target fieldName) =>
+    let targetErrors := validateDiamondFieldAccessesForStmtExpr model target
+    let fieldError := checkDiamondFieldAccess model target fieldName expr.source
+    targetErrors ++ fieldError
+  | .Block stmts _ =>
+    stmts.flatMap (fun s => validateDiamondFieldAccessesForStmtExpr model s)
+  | .Assign targets value =>
+    let targetErrors := targets.attach.foldl (fun acc ⟨t, _⟩ =>
+      match _hv : t.val with
+      | .Field target fieldName =>
+        let innerErrors := validateDiamondFieldAccessesForStmtExpr model target
+        let fieldError := checkDiamondFieldAccess model target fieldName t.source
+        acc ++ innerErrors ++ fieldError
+      | .Local _ | .Declare _ => acc) []
+    targetErrors ++ validateDiamondFieldAccessesForStmtExpr model value
+  | .IfThenElse c t e =>
+    let errs := validateDiamondFieldAccessesForStmtExpr model c ++
+                validateDiamondFieldAccessesForStmtExpr model t
+    match e with
+    | some eb => errs ++ validateDiamondFieldAccessesForStmtExpr model eb
+    | none => errs
+  | .While c invs _ b _ =>
+    let errs := validateDiamondFieldAccessesForStmtExpr model c ++
+                validateDiamondFieldAccessesForStmtExpr model b
+    invs.attach.foldl (fun acc ⟨inv, _⟩ => acc ++ validateDiamondFieldAccessesForStmtExpr model inv) errs
+  | .Assert cond => validateDiamondFieldAccessesForStmtExpr model cond.condition
+  | .Assume cond => validateDiamondFieldAccessesForStmtExpr model cond
+  | .PrimitiveOp _ args _ =>
+    args.attach.foldl (fun acc ⟨a, _⟩ => acc ++ validateDiamondFieldAccessesForStmtExpr model a) []
+  | .StaticCall _ args =>
+    args.attach.foldl (fun acc ⟨a, _⟩ => acc ++ validateDiamondFieldAccessesForStmtExpr model a) []
+  | .Return (some v) => validateDiamondFieldAccessesForStmtExpr model v
+  | .IncrDecr _ _ target =>
+    match _htgt : target.val with
+    | .Field tgt fieldName =>
+      let innerErrors := validateDiamondFieldAccessesForStmtExpr model tgt
+      let fieldError := checkDiamondFieldAccess model tgt fieldName target.source
+      innerErrors ++ fieldError
+    | .Local _ | .Declare _ => []
+  | _ => []
+  termination_by sizeOf expr
+  decreasing_by
+    all_goals simp_wf
+    all_goals (try have := AstNode.sizeOf_val_lt expr)
+    all_goals (try have := AstNode.sizeOf_val_lt t)
+    all_goals (try have := Variable.sizeOf_field_target_lt_of_eq _htgt)
+    all_goals (try have := Condition.sizeOf_condition_lt ‹_›)
+    all_goals (try term_by_mem)
+    all_goals (try omega)
+    -- For nested Variable.Field in Var (.Field ..) or IncrDecr (.Field ..) cases
+    all_goals (cases expr; rename_i val _ _ _h; subst _h; simp_all; omega)
+
+/--
+Validate a Laurel program for diamond-inherited field accesses.
+Returns an array of DiagnosticModel errors.
+-/
+def validateDiamondFieldAccesses (model: SemanticModel) (program : Program) : List DiagnosticModel :=
+  let errors := program.staticProcedures.foldl (fun acc proc =>
+    let bodyErrors := match proc.body with
+      | .Transparent bodyExpr => validateDiamondFieldAccessesForStmtExpr model bodyExpr
+      | .Opaque postconds impl _ =>
+        let postErrors := postconds.foldl (fun acc2 pc => acc2 ++ validateDiamondFieldAccessesForStmtExpr model pc.condition) []
+        let implErrors := match impl with
+          | some implExpr => validateDiamondFieldAccessesForStmtExpr model implExpr
+          | none => []
+        postErrors ++ implErrors
+      | .Abstract postconds => postconds.foldl (fun acc p => acc ++ validateDiamondFieldAccessesForStmtExpr model p.condition) []
+      | .External => []
+    acc ++ bodyErrors) []
+  errors
+
 /-! ## Pre-registration: populate scope with all top-level names before resolving bodies -/
 
 
+
 /-- A default ResolvedNode used as a placeholder during pre-registration.
     It will be overwritten with the real node when the definition is fully resolved. -/
 private def placeholderNode : ResolvedNode := .var "$placeholder" { val := .TVoid, source := none }
@@ -878,19 +3085,19 @@ private def preRegisterTopLevel (program : Program) : ResolveM Unit := do
         let qualifiedName := ct.name.text ++ "." ++ field.name.text
         let _ ← defineNameCheckDup field.name (.field ct.name field) (some qualifiedName)
       for proc in ct.instanceProcedures do
+        let scopedKey := (containerScopedName ct.name proc.name).text
         let _ ← defineNameCheckDup proc.name (.instanceProcedure ct.name proc)
+                                   (some scopedKey)
     | .Constrained ct =>
       let _ ← defineNameCheckDup ct.name (.constrainedType ct)
     | .Datatype dt =>
       let _ ← defineNameCheckDup dt.name (.datatypeDefinition dt)
       for ctor in dt.constructors do
-        -- Register the tester override first; the second call reuses the
-        -- returned Identifier (now carrying a uniqueId) so the unprefixed
-        -- constructor name and the `TypeName..isCtor` tester name resolve to
-        -- the same uniqueId, which `buildRefToDef` in turn maps to
-        -- `.datatypeConstructor`.
-        let ctorName ← defineNameCheckDup ctor.name (.datatypeConstructor dt.name ctor) (some (dt.testerName ctor))
-        let _ ← defineNameCheckDup ctorName (.datatypeConstructor dt.name ctor)
+        let _ ← defineNameCheckDup ctor.name (.datatypeConstructor dt.name ctor)
+        -- Register the tester function (e.g. `IntList..isNil`) as a static procedure.
+        let testerProc := mkTesterProcedure dt ctor
+        let _ ← defineNameCheckDup (mkId (dt.testerName ctor))
+          (.staticProcedure testerProc) (some (dt.testerName ctor))
         for p in ctor.args do
           -- Same chaining trick for the safe and unsafe destructor names: both
           -- point to the same uniqueId so `IntList..head` and `IntList..head!`
@@ -909,19 +3116,9 @@ private def preRegisterTopLevel (program : Program) : ResolveM Unit := do
 /-! ## Entry point -/
 
 /-- Run the full resolution pass on a Laurel program. -/
-def resolve (program : Program) (existingModel: Option SemanticModel := none) : ResolutionResult :=
-
+public def resolve (program : Program) (existingModel: Option SemanticModel := none) : ResolutionResult :=
   -- Phase 1: pre-register all top-level names, then assign IDs and resolve references
   let phase1 : ResolveM Program := do
-
-    for td in program.types do
-      if let .Composite ct := td then
-        for proc in ct.instanceProcedures do
-          let diag := diagnosticFromSource proc.name.source
-            s!"Instance procedure '{proc.name.text}' on composite type '{ct.name.text}' is not yet supported"
-            DiagnosticType.NotYetImplemented
-          modify fun s => { s with errors := s.errors.push diag }
-
     preRegisterTopLevel program
     let types' ← program.types.mapM resolveTypeDefinition
     let constants' ← program.constants.mapM resolveConstant
@@ -930,16 +3127,19 @@ def resolve (program : Program) (existingModel: Option SemanticModel := none) :
     return { staticProcedures := staticProcs', staticFields := staticFields',
              types := types', constants := constants' }
   let nextId := existingModel.elim 1 (fun m => m.nextId)
-  let (program', finalState) := phase1.run { nextId := nextId }
+  let typeLattice := TypeLattice.ofTypes program.types
+  let (program', finalState) := phase1.run { nextId := nextId, typeLattice }
   -- Phase 2: build refToDef from the resolved program (all definitions now have UUIDs)
   let refToDef := buildRefToDef program'
+  let semanticModel := {
+    compositeCount := program.types.length,
+    refToDef := refToDef,
+    nextId := finalState.nextId
+  }
+  let diamondErrors := validateDiamondFieldAccesses semanticModel program'
   { program := program',
-    model := {
-      compositeCount := program.types.length,
-      refToDef := refToDef,
-      nextId := finalState.nextId
-    },
-    errors := finalState.errors
+    model := semanticModel,
+    errors := finalState.errors ++ diamondErrors
   }
 
 /-! ## Resolution for UnorderedCoreWithLaurelTypes -/
@@ -980,12 +3180,13 @@ are not part of the `UnorderedCoreWithLaurelTypes` but are needed for resolving
 `UserDefined` type references. These additional types should not be necessary
 but they are because certain type references have incorrectly not been updated.
 -/
-def resolveUnorderedCore (uc : UnorderedCoreWithLaurelTypes)
+public def resolveUnorderedCore (uc : UnorderedCoreWithLaurelTypes)
     (existingModel : Option SemanticModel := none)
     (additionalTypes : List TypeDefinition := [])
-    : UnorderedCoreWithLaurelTypes × SemanticModel :=
+    : UnorderedCoreWithLaurelTypes × SemanticModel × Array DiagnosticModel :=
   let fnProgram := unorderedCoreToProgram uc additionalTypes
   let fnResolveResult := resolve fnProgram existingModel
-  (fromResolvedProgram fnResolveResult.program, fnResolveResult.model)
+  (fromResolvedProgram fnResolveResult.program, fnResolveResult.model, fnResolveResult.errors)
 
-end
+end -- public section
+end Strata.Laurel
diff --git a/Strata/Languages/Laurel/SemanticModel.lean b/Strata/Languages/Laurel/SemanticModel.lean
new file mode 100644
index 0000000000..c41e15c5dd
--- /dev/null
+++ b/Strata/Languages/Laurel/SemanticModel.lean
@@ -0,0 +1,163 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Languages.Laurel.LaurelAST
+public import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
+import Strata.Util.Tactics
+
+namespace Strata.Laurel
+
+public section
+
+/-- The kind (constructor tag) of a `ResolvedNode`, used to assert that a reference
+    resolves to the expected sort of definition. -/
+inductive ResolvedNodeKind where
+  | var
+  | parameter
+  | staticProcedure
+  | instanceProcedure
+  | field
+  | compositeType
+  | constrainedType
+  | datatypeDefinition
+  | datatypeConstructor
+  | datatypeDestructor
+  | typeAlias
+  | constant
+  | quantifierVar
+  | unresolved
+  deriving Repr, BEq
+
+def ResolvedNodeKind.name : ResolvedNodeKind → String
+  | .var               => "variable"
+  | .parameter         => "parameter"
+  | .staticProcedure   => "static procedure"
+  | .instanceProcedure => "instance procedure"
+  | .field             => "field"
+  | .compositeType     => "composite type"
+  | .constrainedType   => "constrained type"
+  | .datatypeDefinition => "datatype definition"
+  | .datatypeConstructor => "datatype constructor"
+  | .datatypeDestructor => "datatype destructor"
+  | .typeAlias         => "type alias"
+  | .constant          => "constant"
+  | .quantifierVar     => "quantifier variable"
+  | .unresolved        => "unresolved"
+
+/-- A definition-site AST node that a reference can resolve to. -/
+inductive ResolvedNode where
+  /-- A local variable declaration. -/
+  | var (name : Identifier) (type : HighTypeMd)
+  /-- A procedure parameter. -/
+  | parameter (param : Parameter)
+  /-- A static procedure. -/
+  | staticProcedure (proc : Procedure)
+  /-- An instance procedure (method) on a composite type. -/
+  | instanceProcedure (typeName : Identifier) (proc : Procedure)
+  /-- A field on a composite type. -/
+  | field (typeName : Identifier) (fld : Field)
+  /-- A composite type definition. -/
+  | compositeType (ty : CompositeType)
+  /-- A constrained type definition. -/
+  | constrainedType (ty : ConstrainedType)
+  /-- A datatype definition. -/
+  | datatypeDefinition (ty : DatatypeDefinition)
+  /-- A datatype constructor. -/
+  | datatypeConstructor (typeName : Identifier) (ctor : DatatypeConstructor)
+  /-- An auto-generated destructor (or unsafe `!`-destructor) for a datatype field.
+      `typeName` is the resolved Identifier of the parent datatype (with its
+      `uniqueId`), and `field` is the underlying constructor parameter. -/
+  | datatypeDestructor (typeName : Identifier) (field : Parameter)
+  /-- A type alias. -/
+  | typeAlias (ty : TypeAlias)
+  /-- A constant. -/
+  | constant (c : Constant)
+  /-- A quantifier-bound variable. -/
+  | quantifierVar (name : Identifier) (type : HighTypeMd)
+  | unresolved (referenceSource: Option FileRange)
+  deriving Repr
+
+instance : Inhabited ResolvedNode where
+  default := ResolvedNode.unresolved none
+
+/-- Return the constructor tag of a `ResolvedNode`. -/
+def ResolvedNode.kind : ResolvedNode → ResolvedNodeKind
+  | .var ..               => .var
+  | .parameter ..         => .parameter
+  | .staticProcedure ..   => .staticProcedure
+  | .instanceProcedure .. => .instanceProcedure
+  | .field ..             => .field
+  | .compositeType ..     => .compositeType
+  | .constrainedType ..   => .constrainedType
+  | .datatypeDefinition .. => .datatypeDefinition
+  | .datatypeConstructor .. => .datatypeConstructor
+  | .datatypeDestructor .. => .datatypeDestructor
+  | .typeAlias ..         => .typeAlias
+  | .constant ..          => .constant
+  | .quantifierVar ..     => .quantifierVar
+  | .unresolved _          => .unresolved
+
+def ResolvedNode.getType (node: ResolvedNode): HighTypeMd := match node with
+ | .var _ type => type
+ | .parameter p => p.type
+ | .field _ f => f.type
+ | .datatypeConstructor type _ => ⟨ .UserDefined type, none ⟩
+ | .datatypeDestructor _ fld => fld.type
+ | .constant c => c.type
+ | .quantifierVar _ type => type
+ | .unresolved source => ⟨ .Unknown, source ⟩
+ | .staticProcedure _ | .instanceProcedure _ _ | .compositeType _
+ | .constrainedType _ | .datatypeDefinition _ | .typeAlias _ => ⟨ .Unknown, none ⟩
+
+/-! ## Resolution result -/
+
+structure SemanticModel where
+  nextId: Nat
+  compositeCount: Nat
+  refToDef: Std.HashMap Nat ResolvedNode
+  deriving Repr
+
+/-- Look up the resolved node for an identifier, returning `none` if the identifier
+    has no `uniqueId` or is not in the model. -/
+def SemanticModel.get? (model: SemanticModel) (iden: Identifier): Option ResolvedNode :=
+  iden.uniqueId.bind model.refToDef.get?
+
+def SemanticModel.get (model: SemanticModel) (iden: Identifier): ResolvedNode :=
+  (model.get? iden).getD default
+
+def SemanticModel.isFunction (model: SemanticModel) (id: Identifier): Bool :=
+  match model.get id with
+      | .staticProcedure proc => proc.isFunctional
+      | .parameter _ => true
+      | .datatypeConstructor _ _ => true
+      | .datatypeDestructor _ _ => true
+      | .constant _ => true
+      | .unresolved _ => true -- functions calls are more permissive, so true avoids possibly incorrect errors
+      | node =>
+          dbg_trace s!"Sound but incomplete BUG! id: {repr id}, is not a procedure, but a node {repr node}"
+          false
+
+/--
+Compute the flattened set of ancestors for a composite type, including itself.
+Traverses the `extending` list transitively.
+-/
+def computeAncestors (model: SemanticModel) (name : Identifier) : List CompositeType :=
+  let rec go (fuel : Nat) (current : Identifier) : List CompositeType :=
+    match fuel with
+    | 0 =>
+      match model.get current with
+      | .compositeType (ty : CompositeType) => [ty]
+      | _ => []
+    | fuel' + 1 =>
+      match model.get current with
+        | .compositeType (ty : CompositeType) =>
+          [ty] ++ ty.extending.flatMap (fun parent => go fuel' parent)
+        | _ => []
+  let seen : List Identifier := []
+  (go model.compositeCount name).foldl (fun (acc, seen) ct =>
+    if seen.contains ct.name then (acc, seen)
+    else (acc ++ [ct], seen ++ [ct.name])) ([], seen) |>.1
diff --git a/Strata/Languages/Laurel/TransparencyPass.lean b/Strata/Languages/Laurel/TransparencyPass.lean
index b4b59dcec4..c44751ff96 100644
--- a/Strata/Languages/Laurel/TransparencyPass.lean
+++ b/Strata/Languages/Laurel/TransparencyPass.lean
@@ -7,6 +7,8 @@ module
 
 public import Strata.Languages.Laurel.MapStmtExpr
 public import Strata.Languages.Laurel.LaurelAST
+public import Strata.Languages.Laurel.LaurelPass
+public import Strata.Languages.Laurel.CoreGroupingAndOrdering
 import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
 import Strata.DL.Lambda.TypeFactory
 
@@ -28,18 +30,6 @@ namespace Strata.Laurel
 
 public section
 
-/--
-An intermediate representation produced by the transparency pass.
-Functions are pure computational procedures (suffixed `$asFunction`);
-coreProcedures are the original procedures with any free postconditions
-embedded in their `Body.Opaque` postcondition lists.
--/
-public structure UnorderedCoreWithLaurelTypes where
-  functions : List Procedure
-  coreProcedures : List Procedure
-  datatypes : List DatatypeDefinition
-  constants : List Constant
-
 /-- Deep traversal that strips all Assert and Assume nodes from a StmtExpr tree.
     Assert/Assume nodes are replaced with `LiteralBool true`, and Block nodes
     are collapsed by filtering out trivial `LiteralBool true` leftovers. -/
@@ -84,6 +74,35 @@ private def rewriteCallsToFunctional (asFunctionNames : Std.HashSet String) (exp
     | .PrimitiveOp operator arguments _ => ⟨ .PrimitiveOp operator arguments true, e.source⟩
     | _ => e) expr
 
+/-- Rewrite quantifier bodies like function bodies: strip assert/assume and
+    rewrite calls to their `$asFunction` variants. This ensures that calls
+    inside quantifiers (e.g. in modifies frame conditions) reference the
+    pure functional version and are not treated as imperative by later passes. -/
+private def rewriteQuantifierBodies (nonExternalNames : Std.HashSet String) (expr : StmtExprMd) : StmtExprMd :=
+  mapStmtExpr (fun e =>
+    match e.val with
+    | .Quantifier mode param trigger body =>
+      let body' := rewriteCallsToFunctional nonExternalNames (stripAssertAssume body)
+      let trigger' := trigger.map (rewriteCallsToFunctional nonExternalNames)
+      ⟨.Quantifier mode param trigger' body', e.source⟩
+    | _ => e) expr
+
+/-- Apply quantifier body rewriting to all postconditions and the implementation
+    of a procedure. -/
+private def rewriteQuantifierBodiesInProc (nonExternalNames : Std.HashSet String) (proc : Procedure) : Procedure :=
+  let rewrite := rewriteQuantifierBodies nonExternalNames
+  match proc.body with
+  | .Opaque postconds impl modif =>
+    let postconds' := postconds.map fun c => { c with condition := rewrite c.condition }
+    let impl' := impl.map rewrite
+    { proc with body := .Opaque postconds' impl' modif }
+  | .Transparent body =>
+    { proc with body := .Transparent (rewrite body) }
+  | .Abstract postconds =>
+    let postconds' := postconds.map fun c => { c with condition := rewrite c.condition }
+    { proc with body := .Abstract postconds' }
+  | .External => proc
+
 /-- Build a free postcondition equating the procedure's output to its functional version.
     For a procedure `foo(a, b) returns (r)`, produces:
       `r == foo$asFunction(a, b)` -/
@@ -100,12 +119,15 @@ private def mkFreePostcondition (proc : Procedure) : StmtExprMd :=
     If the procedure is transparent, include a functional body.
     Otherwise the function is opaque. -/
 private def mkFunctionCopy (asFunctionNames : Std.HashSet String) (proc : Procedure) : Procedure :=
-  let funcName := { proc.name with text := proc.name.text ++ "$asFunction", uniqueId := none }
+  let hasProcedureTwin := asFunctionNames.contains proc.name.text
+  let funcName := if hasProcedureTwin then
+    { proc.name with text := proc.name.text ++ "$asFunction", uniqueId := none }
+    else proc.name
   let body := match proc.body with
-    | .Transparent b => .Transparent (rewriteCallsToFunctional asFunctionNames (stripAssertAssume b))
-    | .Opaque _ _ _ => .Opaque [] none []
+    | .Transparent b => .Transparent (rewriteCallsToFunctional asFunctionNames (if hasProcedureTwin then stripAssertAssume b else b))
+    | .Opaque _ _ _ => if hasProcedureTwin then .Opaque [] none [] else proc.body
     | x => x
-  { proc with name := funcName, isFunctional := true, body := body, preconditions := [] }
+  { proc with name := funcName, isFunctional := true, body := body }
 
 /-- Append a free postcondition to a procedure's body postconditions.
     For Opaque and Abstract bodies, the free condition is appended to the
@@ -126,46 +148,31 @@ private def addFreePostcondition (proc : Procedure) (freePost : StmtExprMd) : Pr
       { proc with body := .Opaque [freeCond] (some body) [] }
     | _ => proc
 
-/--
-Transparency pass: translate a Laurel program to the UnorderedCoreWithLaurelTypes IR.
-
-For each procedure:
-- Generate a function with the same signature, named `foo$asFunction`
-- If transparent, the function gets a functional body (assertions erased, calls to functional versions)
-- If the function has a body, add a free postcondition equating the procedure output to the function
--/
-def transparencyPass (program : Program) : UnorderedCoreWithLaurelTypes :=
-  let (skipped, notSkipped) := program.staticProcedures.partition (fun p => p.body.isExternal ||
-    -- Skip functions until we introduce a contract pass,
-    -- which enables lifting procedure calls from contracts
-    p.isFunctional)
-  let asFunctionNames : Std.HashSet String := notSkipped.foldl (fun s p => s.insert p.name.text) {}
-  let asFunctions := notSkipped.map (mkFunctionCopy asFunctionNames)
-
-  -- External procedures get a plain function copy (they have no $asFunction version)
-  let (skippedFunctions, skippedProcedures) := skipped.partition (fun p => p.isFunctional)
-  let functions := skippedFunctions ++ asFunctions
-  let coreProcedures := notSkipped.map fun p =>
-    let freePostcondition := mkFreePostcondition p
-    let p := addFreePostcondition p freePostcondition
-    { p with isFunctional := false }
+def createFunctionsForTransparentBodies (program : Program) : UnorderedCoreWithLaurelTypes :=
+  let (toUpdate, _) := program.staticProcedures.partition (fun p => !p.body.isExternal && !p.isFunctional)
+  let toUpdateNames : Std.HashSet String := toUpdate.foldl (fun s p => s.insert p.name.text) {}
+  -- $asFunction copies for non-external procedures
+  let functions := program.staticProcedures.map (mkFunctionCopy toUpdateNames)
+  let coreProcedures := toUpdate.map fun proc =>
+    let freePostcondition := mkFreePostcondition proc
+    let proc := { proc with isFunctional := false, axioms := proc.axioms.map (rewriteCallsToFunctional toUpdateNames) }
+    let proc := rewriteQuantifierBodiesInProc toUpdateNames proc
+    addFreePostcondition proc freePostcondition
   let datatypes := program.types.filterMap fun td => match td with
     | .Datatype dt => some dt
     | _ => none
-  let procs: List Procedure := skippedProcedures ++ coreProcedures
-  { functions, coreProcedures := procs, datatypes, constants := program.constants }
+  { functions, coreProcedures, datatypes, constants := program.constants }
 
-open Std (Format ToFormat)
-
-def formatUnorderedCoreWithLaurelTypes (p : UnorderedCoreWithLaurelTypes) : Format :=
-  let datatypeFmts := p.datatypes.map ToFormat.format
-  let constantFmts := p.constants.map ToFormat.format
-  let functionFmts := p.functions.map ToFormat.format
-  let procFmts := p.coreProcedures.map ToFormat.format
-  Format.joinSep (datatypeFmts ++ constantFmts ++ functionFmts ++ procFmts) "\n\n"
-
-instance : ToFormat UnorderedCoreWithLaurelTypes where
-  format := formatUnorderedCoreWithLaurelTypes
+public def transparencyPass : LaurelPass Laurel.Program UnorderedCoreWithLaurelTypes where
+  name := "TransparencyPass"
+  comesBefore := [⟨ orderingPass.meta, "Transparency pass creates functions that are not ordered" ⟩]
+  documentation := "Translate a Laurel program to the UnorderedCoreWithLaurelTypes IR.
+For each procedure:
+  - Generate a function with the same signature, named `foo$asFunction`
+  - If transparent, the function gets a functional body (assertions erased, calls to functional versions)
+  - If the function has a body, add a free postcondition equating the procedure output to the function"
+  run := fun p _ _ =>
+    (createFunctionsForTransparentBodies p, [], {})
 
 end -- public section
 end Strata.Laurel
diff --git a/Strata/Languages/Laurel/TypeAliasElim.lean b/Strata/Languages/Laurel/TypeAliasElim.lean
index efc898c443..65a3a462e2 100644
--- a/Strata/Languages/Laurel/TypeAliasElim.lean
+++ b/Strata/Languages/Laurel/TypeAliasElim.lean
@@ -6,6 +6,7 @@
 module
 
 public import Strata.Languages.Laurel.Resolution
+public import Strata.Languages.Laurel.LaurelPass
 import Strata.Languages.Laurel.MapStmtExpr
 
 /-!
@@ -38,7 +39,6 @@ partial def resolveAliasType (amap : AliasMap) (ty : HighTypeMd)
     else match amap.get? name.text with
       | some target => resolveAliasType amap target (visited.insert name.text)
       | none => ty
-  | .TTypedField vt => { val := .TTypedField (resolveAliasType amap vt visited), source := ty.source }
   | .TSet et => { val := .TSet (resolveAliasType amap et visited), source := ty.source }
   | .TMap kt vt =>
     { val := .TMap (resolveAliasType amap kt visited) (resolveAliasType amap vt visited), source := ty.source }
@@ -51,68 +51,20 @@ partial def resolveAliasType (amap : AliasMap) (ty : HighTypeMd)
     { val := .Intersection (tys.map (resolveAliasType amap · visited)), source := ty.source }
   | _ => ty
 
-def resolveAliasVariable (amap : AliasMap) (v : VariableMd) : VariableMd :=
-  match v.val with
-  | .Declare param => ⟨.Declare { param with type := resolveAliasType amap param.type }, v.source⟩
-  | _ => v
-
-/-- Resolve aliases in expression type positions. -/
-def resolveAliasExprNode (amap : AliasMap) (expr : StmtExprMd) : StmtExprMd :=
-  match expr.val with
-  | .Assign targets value =>
-    ⟨.Assign (targets.map (resolveAliasVariable amap)) value, expr.source⟩
-  | .Var (.Declare param) =>
-    ⟨.Var (.Declare { param with type := resolveAliasType amap param.type }), expr.source⟩
-  | .Quantifier mode param trigger body =>
-    { val := .Quantifier mode { param with type := resolveAliasType amap param.type } trigger body, source := expr.source }
-  | .AsType t ty => { val := .AsType t (resolveAliasType amap ty), source := expr.source }
-  | .IsType t ty => { val := .IsType t (resolveAliasType amap ty), source := expr.source }
-  | _ => expr
-
-def resolveAliasInProc (amap : AliasMap) (proc : Procedure) : Procedure :=
-  let resolve := mapStmtExpr (resolveAliasExprNode amap)
-  let resolveBody : Body → Body := fun body => match body with
-    | .Transparent b => .Transparent (resolve b)
-    | .Opaque ps impl modif => .Opaque (ps.map (·.mapCondition resolve)) (impl.map resolve) (modif.map resolve)
-    | .Abstract ps => .Abstract (ps.map (·.mapCondition resolve))
-    | .External => .External
-  { proc with
-    body := resolveBody proc.body
-    inputs := proc.inputs.map fun p => { p with type := resolveAliasType amap p.type }
-    outputs := proc.outputs.map fun p => { p with type := resolveAliasType amap p.type }
-    preconditions := proc.preconditions.map (·.mapCondition resolve)
-    decreases := proc.decreases.map resolve
-    invokeOn := proc.invokeOn.map resolve }
-
-def resolveAliasInType (amap : AliasMap) (td : TypeDefinition) : TypeDefinition :=
-  match td with
-  | .Composite ct =>
-    .Composite { ct with
-      fields := ct.fields.map fun f => { f with type := resolveAliasType amap f.type }
-      instanceProcedures := ct.instanceProcedures.map (resolveAliasInProc amap) }
-  | .Constrained ct =>
-    let resolve := mapStmtExpr (resolveAliasExprNode amap)
-    .Constrained { ct with
-      base := resolveAliasType amap ct.base
-      constraint := resolve ct.constraint
-      witness := resolve ct.witness }
-  | .Datatype dt =>
-    .Datatype { dt with
-      constructors := dt.constructors.map fun ctor =>
-        { ctor with args := ctor.args.map fun p => { p with type := resolveAliasType amap p.type } } }
-  | .Alias _ => td  -- will be removed
-
-/-- Eliminate all type aliases from a program. Replaces `UserDefined` references
-    with the alias target (transitively) and removes `.Alias` entries from `program.types`. -/
+/-- Eliminate all type aliases from a program. Replaces every `UserDefined`
+    reference (in any type position, via `mapProgramHighTypes`) with the alias
+    target (transitively) and removes `.Alias` entries from `program.types`. -/
 public def typeAliasElim (_model : SemanticModel) (program : Program) : Program :=
   let amap := buildAliasMap program.types
   if amap.isEmpty then program else
-  { program with
-    staticProcedures := program.staticProcedures.map (resolveAliasInProc amap)
-    staticFields := program.staticFields.map fun f => { f with type := resolveAliasType amap f.type }
-    types := (program.types.filter fun | .Alias _ => false | _ => true).map (resolveAliasInType amap)
-    constants := program.constants.map fun c => { c with
-      type := resolveAliasType amap c.type
-      initializer := c.initializer.map (mapStmtExpr (resolveAliasExprNode amap)) } }
+  let program := mapProgramHighTypes (resolveAliasType amap) program
+  { program with types := program.types.filter fun | .Alias _ => false | _ => true }
+
+/-- Pipeline pass: type alias elimination. -/
+public def typeAliasElimPass : LoweringPass where
+  name := "TypeAliasElim"
+  documentation := "Eliminates type aliases by replacing all UserDefined references to alias names with their resolved target types. Chained aliases are resolved transitively. Alias entries are removed from the type list."
+  needsResolves := true
+  run := fun p m _ => (typeAliasElim m p, [], {})
 
 end Strata.Laurel
diff --git a/Strata/Languages/Laurel/TypeHierarchy.lean b/Strata/Languages/Laurel/TypeHierarchy.lean
index 3ff6e2b1ac..0414298e6a 100644
--- a/Strata/Languages/Laurel/TypeHierarchy.lean
+++ b/Strata/Languages/Laurel/TypeHierarchy.lean
@@ -7,8 +7,10 @@ module
 
 import Strata.Languages.Laurel.HeapParameterizationConstants
 import Strata.Util.Tactics
+public import Strata.Languages.Laurel.LaurelPass
 public import Strata.Languages.Laurel.Resolution
 import Std.Tactic.BVDecide.Normalize.Prop
+import Strata.Languages.Laurel.HeapParameterization
 import Strata.Languages.Laurel.LaurelTypes
 import Strata.Languages.Laurel.MapStmtExpr
 
@@ -18,27 +20,6 @@ namespace Strata.Laurel
 
 open Strata
 
-/--
-Compute the flattened set of ancestors for a composite type, including itself.
-Traverses the `extending` list transitively.
--/
-def computeAncestors (model: SemanticModel) (name : Identifier) : List CompositeType :=
-  let rec go (fuel : Nat) (current : Identifier) : List CompositeType :=
-    match fuel with
-    | 0 =>
-      match model.get current with
-      | .compositeType (ty : CompositeType) => [ty]
-      | _ => []
-    | fuel' + 1 =>
-      match model.get current with
-        | .compositeType (ty : CompositeType) =>
-          [ty] ++ ty.extending.flatMap (fun parent => go fuel' parent)
-        | _ => []
-  let seen : List Identifier := []
-  (go model.compositeCount name).foldl (fun (acc, seen) ct =>
-    if seen.contains ct.name then (acc, seen)
-    else (acc ++ [ct], seen ++ [ct.name])) ([], seen) |>.1
-
 private def mkMd (e : StmtExpr) : StmtExprMd := ⟨e, none⟩
 private def mkVarMd (v : Variable) : VariableMd := ⟨v, none⟩
 
@@ -95,116 +76,6 @@ def generateTypeHierarchyDecls (model : SemanticModel) (program: Program) : List
       initializer := some outerMapExpr }
   ancestorsForDecls ++ [ancestorsDecl]
 
-/--
-Check if a field can be reached through a given type (directly declared or inherited).
-Returns true if the type or any of its ancestors declares the field.
--/
-def canReachField (model : SemanticModel) (typeName : Identifier) (fieldName : Identifier) : Bool :=
-  match model.get fieldName with
-  | .field owner _ => ((computeAncestors model typeName).find? (fun t => t.name == owner)).isSome
-  | _ => false -- recover from a resolution error
-
-/--
-Check if a field is inherited through multiple parent paths (diamond inheritance).
-Returns true if more than one direct parent of the given type can reach the field.
--/
-def isDiamondInheritedField (model : SemanticModel) (typeName : Identifier) (fieldName : Identifier) : Bool :=
-  match model.get typeName with
-  | .compositeType ct =>
-    -- If the field is directly declared on this type, it's not a diamond
-    if ct.fields.any (·.name == fieldName) then false
-    else
-      -- Count how many direct parents can reach this field
-      let parentsWithField := ct.extending.filter (canReachField model · fieldName)
-      parentsWithField.length > 1
-  | _ => false
-
-/--
-Check whether accessing `fieldName` on `target` is a diamond-inherited field access,
-and if so return a diagnostic error using the given `source` range.
--/
-private def checkDiamondFieldAccess (model : SemanticModel) (target : StmtExprMd)
-    (fieldName : Identifier) (source : Option FileRange) : List DiagnosticModel :=
-  match (computeExprType model target).val with
-  | .UserDefined typeName =>
-    if isDiamondInheritedField model typeName fieldName then
-      match source with
-      | some fileRange =>
-        [DiagnosticModel.withRange fileRange s!"fields that are inherited multiple times can not be accessed."]
-      | none =>
-        [DiagnosticModel.fromMessage s!"fields that are inherited multiple times can not be accessed."]
-    else []
-  | _ => []
-
-/--
-Walk a StmtExpr AST and collect DiagnosticModel errors for diamond-inherited field accesses.
--/
-def validateDiamondFieldAccessesForStmtExpr (model : SemanticModel)
-    (expr : StmtExprMd) : List DiagnosticModel :=
-  match _h : expr.val with
-  | .Var (.Field target fieldName) =>
-    let targetErrors := validateDiamondFieldAccessesForStmtExpr model target
-    let fieldError := checkDiamondFieldAccess model target fieldName expr.source
-    targetErrors ++ fieldError
-  | .Block stmts _ =>
-    stmts.flatMap (fun s => validateDiamondFieldAccessesForStmtExpr model s)
-  | .Assign targets value =>
-    let targetErrors := targets.attach.foldl (fun acc ⟨t, _⟩ =>
-      match _hv : t.val with
-      | .Field target fieldName =>
-        let innerErrors := validateDiamondFieldAccessesForStmtExpr model target
-        let fieldError := checkDiamondFieldAccess model target fieldName t.source
-        acc ++ innerErrors ++ fieldError
-      | .Local _ | .Declare _ => acc) []
-    targetErrors ++ validateDiamondFieldAccessesForStmtExpr model value
-  | .IfThenElse c t e =>
-    let errs := validateDiamondFieldAccessesForStmtExpr model c ++
-                validateDiamondFieldAccessesForStmtExpr model t
-    match e with
-    | some eb => errs ++ validateDiamondFieldAccessesForStmtExpr model eb
-    | none => errs
-  | .While c invs _ b =>
-    let errs := validateDiamondFieldAccessesForStmtExpr model c ++
-                validateDiamondFieldAccessesForStmtExpr model b
-    invs.attach.foldl (fun acc ⟨inv, _⟩ => acc ++ validateDiamondFieldAccessesForStmtExpr model inv) errs
-  | .Assert cond => validateDiamondFieldAccessesForStmtExpr model cond.condition
-  | .Assume cond => validateDiamondFieldAccessesForStmtExpr model cond
-  | .PrimitiveOp _ args _ =>
-    args.attach.foldl (fun acc ⟨a, _⟩ => acc ++ validateDiamondFieldAccessesForStmtExpr model a) []
-  | .StaticCall _ args =>
-    args.attach.foldl (fun acc ⟨a, _⟩ => acc ++ validateDiamondFieldAccessesForStmtExpr model a) []
-  | .Return (some v) => validateDiamondFieldAccessesForStmtExpr model v
-  | _ => []
-  termination_by sizeOf expr
-  decreasing_by
-    all_goals simp_wf
-    all_goals (try have := AstNode.sizeOf_val_lt expr)
-    all_goals (try have := AstNode.sizeOf_val_lt t)
-    all_goals (try have := Condition.sizeOf_condition_lt ‹_›)
-    all_goals (try term_by_mem)
-    all_goals (try omega)
-    -- For nested Variable.Field in Var (.Field ..) case
-    all_goals (cases expr; rename_i val _ _ _h; subst _h; simp_all; omega)
-
-/--
-Validate a Laurel program for diamond-inherited field accesses.
-Returns an array of DiagnosticModel errors.
--/
-def validateDiamondFieldAccesses (model: SemanticModel) (program : Program) : List DiagnosticModel :=
-  let errors := program.staticProcedures.foldl (fun acc proc =>
-    let bodyErrors := match proc.body with
-      | .Transparent bodyExpr => validateDiamondFieldAccessesForStmtExpr model bodyExpr
-      | .Opaque postconds impl _ =>
-        let postErrors := postconds.foldl (fun acc2 pc => acc2 ++ validateDiamondFieldAccessesForStmtExpr model pc.condition) []
-        let implErrors := match impl with
-          | some implExpr => validateDiamondFieldAccessesForStmtExpr model implExpr
-          | none => []
-        postErrors ++ implErrors
-      | .Abstract postconds => postconds.foldl (fun acc p => acc ++ validateDiamondFieldAccessesForStmtExpr model p.condition) []
-      | .External => []
-    acc ++ bodyErrors) []
-  errors
-
 /--
 Lower `IsType target ty` to Laurel-level map lookups:
   `select(select(ancestorsPerType(), Composite..typeTag!(target)), TypeName_TypeTag())`
@@ -253,6 +124,26 @@ private def rewriteTypeHierarchyNode (exprMd : StmtExprMd) : THM StmtExprMd := d
   | .IsType target ty => return lowerIsType target ty exprMd.source
   | _ => return exprMd
 
+/--
+Rewrite a type so that every reference to a composite type (a name in
+`composites`) becomes the flattened `Composite` datatype. After the type
+hierarchy pass all composite values are represented by `Composite` references,
+so their *static* types must follow suit; otherwise re-resolution sees a
+`Pixel`-typed value flowing into a `Composite`-typed slot (`readField`,
+`Composite..ref!`, an allocation `new C`, …). Recurses through compound types. -/
+partial def compositeRefToComposite (composites : Std.HashSet String) (ty : HighTypeMd) : HighTypeMd :=
+  match ty.val with
+  | .UserDefined name =>
+    if composites.contains name.text then { ty with val := .UserDefined "Composite" } else ty
+  | .TSet et => { ty with val := .TSet (compositeRefToComposite composites et) }
+  | .TMap kt vt =>
+    { ty with val := .TMap (compositeRefToComposite composites kt) (compositeRefToComposite composites vt) }
+  | .Applied base args =>
+    { ty with val := .Applied (compositeRefToComposite composites base) (args.map (compositeRefToComposite composites ·)) }
+  | .Pure base => { ty with val := .Pure (compositeRefToComposite composites base) }
+  | .Intersection tys => { ty with val := .Intersection (tys.map (compositeRefToComposite composites ·)) }
+  | _ => ty
+
 /--
 Type hierarchy transformation pass (Laurel → Laurel).
 
@@ -282,10 +173,28 @@ def typeHierarchyTransform (model: SemanticModel) (program : Program) : Program
           else c }
       else td
     | _ => td
-  { program with
-    staticProcedures := procs',
-    types := [typeTagDatatype] ++ remainingTypes,
-    constants := program.constants ++ typeHierarchyConstants }
+  let transformed : Program :=
+    { program with
+      staticProcedures := procs',
+      types := [typeTagDatatype] ++ remainingTypes,
+      constants := program.constants ++ typeHierarchyConstants }
+  -- Now that `New`/`IsType` have been lowered (they needed the original
+  -- composite names), flatten every remaining composite reference type to the
+  -- `Composite` datatype so the program re-resolves consistently. The
+  -- program-wide `HighType` traversal lives in `MapStmtExpr` so that every
+  -- type position is covered uniformly.
+  let compositeSet : Std.HashSet String :=
+    compositeNames.foldl (init := {}) (·.insert ·)
+  mapProgramHighTypes (compositeRefToComposite compositeSet) transformed
+
+/-- Pipeline pass: type hierarchy transform. -/
+public def typeHierarchyTransformPass : LoweringPass where
+  name := "TypeHierarchyTransform"
+  documentation := "Encodes the object-oriented type hierarchy (inheritance, dynamic dispatch, type tests, and casts) into explicit operations on a flat representation. Composite types with parents are flattened, and dynamic dispatch is resolved through type-test chains."
+  needsResolves := false -- Only resolve again after completing HeapParam, ModifiesClauses and TypeHierarchy. These are logically one pass.
+  comesAfter := [⟨ heapParameterizationPass.meta, "the type hierarchy pass modifies the 'Composite' datatype that is introduced by this pass."⟩]
+  run := fun p m _ =>
+    (typeHierarchyTransform m p, [], {})
 
 end Strata.Laurel
 
diff --git a/Strata/Languages/Laurel/UnorderedCore.lean b/Strata/Languages/Laurel/UnorderedCore.lean
new file mode 100644
index 0000000000..97c070902b
--- /dev/null
+++ b/Strata/Languages/Laurel/UnorderedCore.lean
@@ -0,0 +1,34 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+module
+public import Strata.Languages.Laurel.LaurelAST
+import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
+
+namespace Strata.Laurel
+
+open Std (Format ToFormat)
+/--
+An intermediate representation produced by the transparency pass.
+Functions are pure computational procedures (suffixed `$asFunction`);
+coreProcedures are the original procedures with any free postconditions
+embedded in their `Body.Opaque` postcondition lists.
+-/
+public structure UnorderedCoreWithLaurelTypes where
+  functions : List Procedure
+  coreProcedures : List Procedure
+  datatypes : List DatatypeDefinition
+  constants : List Constant
+
+public def formatUnorderedCoreWithLaurelTypes (p : UnorderedCoreWithLaurelTypes) : Format :=
+  let datatypeFmts := p.datatypes.map ToFormat.format
+  let constantFmts := p.constants.map ToFormat.format
+  let functionFmts := p.functions.map ToFormat.format
+  let procFmts := p.coreProcedures.map ToFormat.format
+  Format.joinSep (datatypeFmts ++ constantFmts ++ functionFmts ++ procFmts) "\n\n"
+
+public instance : ToFormat UnorderedCoreWithLaurelTypes where
+  format := formatUnorderedCoreWithLaurelTypes
diff --git a/Strata/MetaVerifier.lean b/Strata/MetaVerifier.lean
index 7be0fcadc0..d61d7a7916 100644
--- a/Strata/MetaVerifier.lean
+++ b/Strata/MetaVerifier.lean
@@ -100,20 +100,45 @@ namespace Strata
 
 open StrataDDM
 
+namespace MetaVerifier
+
+/--
+Options that affect the verification conditions generated by the metaverifier.
+
+This is intentionally a small subset of `Core.VerifyOptions`: most of its
+fields configure the solver, output, or pipeline stopping points, which have
+no bearing on the generated VCs or their denotation.
+-/
+structure Options where
+  /-- Use SMT-LIB Array theory for `Map` types instead of an uninterpreted
+  sort with axiomatized `select`/`update` functions. -/
+  useArrayTheory : Bool := true
+
+/--
+Interpret metaverifier options as options for the Core verification pipeline.
+-/
+def Options.toVerifyOptions (options : Options) : Core.VerifyOptions :=
+  { Core.VerifyOptions.default with
+    verbose := .quiet
+    useArrayTheory := options.useArrayTheory }
+
+end MetaVerifier
+
 /--
 Generate verification conditions for a `StrataDDM.Program` by translating it to the
 appropriate frontend verifier and collecting its deferred proof obligations.
 
 Note that this can be extended to new dialects by using
-`unsafe/@[implemented_by]` as in `StrataBoole.MetaVerifier`.
+`unsafe/@[implemented_by]` as in [`StrataBoole.MetaVerifier`](https://github.com/strata-org/Strata-Boole).
 -/
-def genCoreVCs (program : Program) : Option Core.coreVCs := do
+def genCoreVCs (program : Program)
+    (options : MetaVerifier.Options := {}) : Option Core.coreVCs := do
   if program.dialect == "Core" then
     let (program, #[]) := TransM.run default (translateProgram program) | none
-    Core.genVCs program { (default : Core.VerifyOptions) with verbose := .quiet : Core.VerifyOptions }
+    Core.genVCs program options.toVerifyOptions
   else if program.dialect == "C_Simp" then
     let (program, #[]) := C_Simp.TransM.run default (C_Simp.translateProgram program.commands) | none
-    C_Simp.genVCs program { (default : Core.VerifyOptions) with verbose := .quiet : Core.VerifyOptions }
+    C_Simp.genVCs program options.toVerifyOptions
   else
     none
 
@@ -127,9 +152,10 @@ At the moment this is semantically harmless for denotation because
 private def sanitizeSMTContext (ctx : Core.SMT.Context) : SMT.SanitizedContext :=
   SMT.SanitizedContext.ofCore ctx
 
-def Core.ProofObligation.toSMTObligation (E : Core.Env) (ob : Imperative.ProofObligation Core.Expression) :
+def Core.ProofObligation.toSMTObligation (E : Core.Env) (ob : Imperative.ProofObligation Core.Expression)
+  (options : MetaVerifier.Options := {}) :
   Option SMT.SMTVC := do
-    let maybeTerms := Core.ProofObligation.toSMTTerms E ob
+    let maybeTerms := Core.ProofObligation.toSMTTerms E ob (useArrayTheory := options.useArrayTheory)
     match maybeTerms with
     | .error _ => none
     | .ok (ts, varDefs, _varDecls, t, ctx, _stats) =>
@@ -156,35 +182,41 @@ where
     let q ← denoteQuery ctx.toCore ts t
     go vcs (p ∧ q)
 
-def toSMTVCs (vcs : Core.coreVCs) : Option SMT.SMTVCs := do
+def toSMTVCs (vcs : Core.coreVCs)
+    (options : MetaVerifier.Options := {}) : Option SMT.SMTVCs := do
   match vcs with
   | [] => return []
   | (E, ob) :: vcs =>
-    let (label, ctx, ts, t) ← Core.ProofObligation.toSMTObligation E ob
-    let vcs ← toSMTVCs vcs
+    let (label, ctx, ts, t) ← Core.ProofObligation.toSMTObligation E ob options
+    let vcs ← toSMTVCs vcs options
     return (label, ctx, ts, t) :: vcs
 
 /--
 Generate SMT verification conditions for a `StrataDDM.Program`.
 -/
-def genSMTVCs (program : Program) : Option SMT.SMTVCs := do
-  let coreVCs ← genCoreVCs program
-  toSMTVCs coreVCs
+def genSMTVCs (program : Program)
+    (options : MetaVerifier.Options := {}) : Option SMT.SMTVCs := do
+  let coreVCs ← genCoreVCs program options
+  toSMTVCs coreVCs options
 
 /--
 State semantic correctness of the SMT verification conditions generated for a
-program.
+program under the given metaverifier options. For example,
+`options.useArrayTheory` selects how the SMT encoder treats `Map` types: under
+`true` they become SMT-LIB arrays, under `false` an uninterpreted sort with
+axiomatized `select`/`update` functions.
 -/
-def smtVCsCorrect (program : Program) : Prop :=
-  match genSMTVCs program with
+def smtVCsCorrect (program : Program)
+    (options : MetaVerifier.Options := {}) : Prop :=
+  match genSMTVCs program options with
   | some vcs => (denoteQueries vcs).getD False
   | none     => False
 
 theorem toSMTVCs_cons :
-    toSMTVCs ((E, ob) :: coreVCs) = some vcs →
+    toSMTVCs ((E, ob) :: coreVCs) options = some vcs →
     ∃ label ctx ts t smtVCs, vcs = (label, ctx, ts, t) :: smtVCs ∧
-    Core.ProofObligation.toSMTObligation E ob = some (label, ctx, ts, t) ∧
-    toSMTVCs coreVCs = some smtVCs := by
+    Core.ProofObligation.toSMTObligation E ob options = some (label, ctx, ts, t) ∧
+    toSMTVCs coreVCs options = some smtVCs := by
   simp only [toSMTVCs, Option.bind_eq_bind, Option.bind]
   grind
 
@@ -317,10 +349,11 @@ where
 
 private unsafe def genSMTVCsUnsafe (mv : MVarId) : MetaM (List MVarId) := do
   let type ← mv.getType
-  let some program := type.app1? ``Strata.smtVCsCorrect | throwError "Expected a Strata.smtVCsCorrect goal"
+  let some (program, options) := type.app2? ``Strata.smtVCsCorrect
+    | throwError "Expected a Strata.smtVCsCorrect goal"
   trace[debug] m!"Generating SMT VCs for {program}"
   let mv ← Meta.unfoldTarget mv ``Strata.smtVCsCorrect
-  let ovcs := .app (.const ``Strata.genSMTVCs []) program
+  let ovcs := mkApp2 (.const ``Strata.genSMTVCs []) program options
   let ovcsType := .app (.const ``Option [0]) (.const ``Strata.SMT.SMTVCs [])
   let some evcs ← Meta.evalExpr (Option Strata.SMT.SMTVCs) ovcsType ovcs
     | throwError "Failed to generate VCs"
diff --git a/Strata/Transform/ANFEncoder.lean b/Strata/Transform/ANFEncoder.lean
index 6f30267052..7d37a35879 100644
--- a/Strata/Transform/ANFEncoder.lean
+++ b/Strata/Transform/ANFEncoder.lean
@@ -274,8 +274,13 @@ def anfEncodeProgram (p : Program) : Bool × Program :=
   let (revDecls, _, changed) := p.decls.foldl (fun (acc, idx, changed) decl =>
     match decl with
     | .proc proc md =>
-      let (body', idx') := anfEncodeBody proc.body idx
-      (.proc { proc with body := body' } md :: acc, idx', changed || idx' > idx)
+      match proc.body with
+      | .structured ss =>
+        let (body', idx') := anfEncodeBody ss idx
+        (.proc { proc with body := .structured body' } md :: acc, idx', changed || idx' > idx)
+      | .cfg _ =>
+        -- CFG bodies are not transformed by ANF encoding for now.
+        (.proc proc md :: acc, idx, changed)
     | other => (other :: acc, idx, changed)
   ) ([], 0, false)
   (changed, { decls := revDecls.reverse })
diff --git a/Strata/Transform/CoreSpecification.lean b/Strata/Transform/CoreSpecification.lean
index 3df3ff9df5..25dd9cbece 100644
--- a/Strata/Transform/CoreSpecification.lean
+++ b/Strata/Transform/CoreSpecification.lean
@@ -82,8 +82,19 @@ variable (φ : CoreEval → PureFunc Expression → CoreEval)
 @[expose] def AssertValidInProcedure
     (proc : Procedure)
     (a : Imperative.AssertId Expression) : Prop :=
-  Imperative.Specification.AssertValidWhen (Specification.Lang.core π φ)
-    (ProcEnvWF proc) (Stmt.block "" proc.body #[]) a
+  match proc.body with
+  | .structured ss =>
+    Imperative.Specification.AssertValidWhen (Specification.Lang.core π φ)
+      (ProcEnvWF proc) (Stmt.block "" ss #[]) a
+  -- CFG bodies don't yet have a small-step semantics, so there is nothing to
+  -- certify.  We pick `False` rather than `True` to be conservative: a CFG
+  -- procedure cannot be claimed asserts-valid (and hence cannot be proven
+  -- `ProcedureCorrect`) until CFG bodies gain an executable semantics.  This
+  -- is sound against the current proofs because the only producer of
+  -- `ProcedureCorrect` (`procBodyVerify_procedureCorrect`) is gated on
+  -- `procToVerifyStmt` succeeding, which forces `proc.body = .structured _`
+  -- (see `procToVerifyStmt_is_structured`), so this arm is never entered.
+  | .cfg _ => False
 
 /-- A procedure is correct with respect to its specification.
 
@@ -139,16 +150,21 @@ variable (φ : CoreEval → PureFunc Expression → CoreEval)
 structure ProcedureCorrect (proc : Procedure) (p : Program) : Prop where
   /-- (1) The asserts in the body of proc are valid. -/
   assertsValid : ∀ a, AssertValidInProcedure π φ proc a
-  /-- (2) The postconditions hold on termination. -/
+  /-- (2) The postconditions hold on termination.
+      Uses `CoreBodyExec` to abstract over both structured and CFG bodies.
+      For structured bodies, the terminal eval `δ'` comes from the terminal
+      `Env` (may differ from `δ` due to `funcDecl` extensions). For CFG
+      bodies, `δ' = δ` since `CoreCFGStepStar` does not track eval changes. -/
   postconditionsValid :
     WF.WFProcedureProp p proc →
-    ∀ (ρ₀ ρ' : Env Expression),
+    ∀ (ρ₀ : Env Expression),
       ProcEnvWF proc ρ₀ →
-      CoreStepStar π φ (.stmts proc.body ρ₀) (.terminal ρ') →
-      (∀ (label : CoreLabel) (check : Procedure.Check),
-        (label, check) ∈ proc.spec.postconditions.toList →
-        check.attr = Procedure.CheckAttr.Default →
-        ρ'.eval ρ'.store check.expr = some HasBool.tt) ∧
-      ρ'.hasFailure = Bool.false
+      ∀ (σ' : CoreStore) (δ' : CoreEval) (failed : Bool),
+        CoreBodyExec π φ proc.body ρ₀.store ρ₀.eval σ' δ' failed →
+        (∀ (label : CoreLabel) (check : Procedure.Check),
+          (label, check) ∈ proc.spec.postconditions.toList →
+          check.attr = Procedure.CheckAttr.Default →
+          δ' σ' check.expr = some HasBool.tt) ∧
+        failed = Bool.false
 
 end Core.Specification
diff --git a/Strata/Transform/CoreTransform.lean b/Strata/Transform/CoreTransform.lean
index cd26487211..9b5415e01f 100644
--- a/Strata/Transform/CoreTransform.lean
+++ b/Strata/Transform/CoreTransform.lean
@@ -330,10 +330,14 @@ def runProgram
           currentProcedureName := .some proc.header.name.1
         })
 
-        let (changed, new_body) ← runStmtsRec f proc.body
+        let bodyStmts ← match proc.body with
+          | .structured ss => pure ss
+          | .cfg _ => throw (Strata.DiagnosticModel.fromMessage
+              s!"runProgram: cannot apply statement-level transform to CFG body (procedure '{proc.header.name.1}')")
+        let (changed, new_body) ← runStmtsRec f bodyStmts
 
         if changed then
-          newDecls := newDecls.set i (Decl.proc { proc with body := new_body } md)
+          newDecls := newDecls.set i (Decl.proc { proc with body := .structured new_body } md)
           anyChanged := true
           modify (fun σ => { σ with
             currentProgram := .some { decls := newDecls }
diff --git a/Strata/Transform/DetToKleene.lean b/Strata/Transform/DetToKleene.lean
index 99c9075085..cfb398bf5a 100644
--- a/Strata/Transform/DetToKleene.lean
+++ b/Strata/Transform/DetToKleene.lean
@@ -20,7 +20,7 @@ mutual
 
 /-- Deterministic-to-Kleene transformation for a single statement.
     Returns `none` for unsupported constructs. -/
-def StmtToKleeneStmt {P : PureExpr} [Imperative.HasBool P] [HasNot P]
+def StmtToKleeneStmt {P : PureExpr} [Imperative.HasBool P] [HasBoolOps P]
   (st : Imperative.Stmt P (Cmd P)) :
   Option (Imperative.KleeneStmt P (Cmd P)) :=
   match st with
@@ -32,12 +32,12 @@ def StmtToKleeneStmt {P : PureExpr} [Imperative.HasBool P] [HasNot P]
     match cond with
     | .det c =>
       return .choice
-        (.seq (.assume "true_cond" c md) t)
-        (.seq (.assume "false_cond" (Imperative.HasNot.not c) md) e)
+        (.block (.seq (.assume "true_cond" c md) t))
+        (.block (.seq (.assume "false_cond" (Imperative.HasBoolOps.not c) md) e))
     | .nondet =>
-      return .choice t e
+      return .choice (.block t) (.block e)
   | .loop guard _measure inv bss md => do
-    -- With invariant checking in `StepStmt`, the deterministic semantics
+    -- With invariant in `StepStmt`, the deterministic semantics
     -- can signal `hasFailure` when a loop invariant evaluates to `ff`,
     -- but Kleene has no invariants and cannot reproduce that failure.
     -- To keep this transform sound, only translate loops with no invariants.
@@ -53,7 +53,7 @@ def StmtToKleeneStmt {P : PureExpr} [Imperative.HasBool P] [HasNot P]
 
 /-- Deterministic-to-Kleene transformation for a block.
     Returns `none` if any statement is unsupported. -/
-def BlockToKleeneStmt {P : Imperative.PureExpr} [Imperative.HasBool P] [HasNot P]
+def BlockToKleeneStmt {P : Imperative.PureExpr} [Imperative.HasBool P] [HasBoolOps P]
   (ss : Imperative.Block P (Cmd P)) :
   Option (Imperative.KleeneStmt P (Cmd P)) :=
   match ss with
diff --git a/Strata/Transform/DetToKleeneCorrect.lean b/Strata/Transform/DetToKleeneCorrect.lean
index c373712f9c..a182e0e596 100644
--- a/Strata/Transform/DetToKleeneCorrect.lean
+++ b/Strata/Transform/DetToKleeneCorrect.lean
@@ -9,9 +9,12 @@ public import Strata.DL.Imperative.KleeneStmtSemantics
 public import Strata.Transform.DetToKleene
 public import Strata.Transform.Specification
 import all Strata.Transform.Specification
+public import Strata.Transform.SpecificationProps
+import all Strata.Transform.SpecificationProps
 import all Strata.Transform.DetToKleene
 import all Strata.DL.Imperative.Stmt
 import all Strata.DL.Imperative.StmtSemantics
+import all Strata.DL.Imperative.StmtSemanticsProps
 import all Strata.DL.Imperative.CmdSemantics
 import all Strata.DL.Util.Relations
 import Std.Tactic.BVDecide.Normalize.Bool
@@ -27,7 +30,7 @@ public section
 
 open Imperative Specification
 
-variable {P : PureExpr} [HasFvar P] [HasBool P] [HasNot P] [HasVal P] [HasBoolVal P]
+variable {P : PureExpr} [HasFvar P] [HasBool P] [HasBoolOps P] [HasFvars P] [HasOps P]
 
 /-! ## Lang instances -/
 
@@ -52,15 +55,15 @@ abbrev Lang.kleene : Lang P where
 
 /-! ## Transform-success helpers: extract sub-transform results -/
 
-omit [HasFvar P] [HasVal P] [HasBoolVal P] in
+omit [HasFvar P] [HasFvars P] [HasOps P] in
 private theorem ite_transform_some_det
     (cond : P.Expr) (tss ess : List (Stmt P (Cmd P))) (md : MetaData P)
     (ns : KleeneStmt P (Cmd P))
     (ht : StmtToKleeneStmt (.ite (.det cond) tss ess md) = some ns) :
     ∃ t e, BlockToKleeneStmt tss = some t ∧ BlockToKleeneStmt ess = some e ∧
       ns = .choice
-        (.seq (.cmd (.assume "true_cond" cond md)) t)
-        (.seq (.cmd (.assume "false_cond" (HasNot.not cond) md)) e) := by
+        (.block (.seq (.cmd (.assume "true_cond" cond md)) t))
+        (.block (.seq (.cmd (.assume "false_cond" (HasBoolOps.not cond) md)) e)) := by
   simp [StmtToKleeneStmt] at ht
   match h1 : BlockToKleeneStmt tss, h2 : BlockToKleeneStmt ess with
   | some t, some e =>
@@ -69,13 +72,13 @@ private theorem ite_transform_some_det
   | some _, none => simp [h1, h2, Option.bind] at ht
   | none, _ => simp [h1, Option.bind] at ht
 
-omit [HasFvar P] [HasVal P] [HasBoolVal P] in
+omit [HasFvar P] [HasFvars P] [HasOps P] in
 private theorem ite_transform_some_nondet
     (tss ess : List (Stmt P (Cmd P))) (md : MetaData P)
     (ns : KleeneStmt P (Cmd P))
     (ht : StmtToKleeneStmt (.ite .nondet tss ess md) = some ns) :
     ∃ t e, BlockToKleeneStmt tss = some t ∧ BlockToKleeneStmt ess = some e ∧
-      ns = .choice t e := by
+      ns = .choice (.block t) (.block e) := by
   simp [StmtToKleeneStmt] at ht
   match h1 : BlockToKleeneStmt tss, h2 : BlockToKleeneStmt ess with
   | some t, some e =>
@@ -84,7 +87,7 @@ private theorem ite_transform_some_nondet
   | some _, none => simp [h1, h2, Option.bind] at ht
   | none, _ => simp [h1, Option.bind] at ht
 
-omit [HasFvar P] [HasVal P] [HasBoolVal P] in
+omit [HasFvar P] [HasFvars P] [HasOps P] in
 private theorem loop_transform_some_det
     (g : P.Expr) (m : Option P.Expr) (inv : List (String × P.Expr))
     (body : List (Stmt P (Cmd P))) (md : MetaData P)
@@ -101,7 +104,7 @@ private theorem loop_transform_some_det
     | none => simp [hb] at ht
   | _ :: _ => simp [Option.bind] at ht
 
-omit [HasFvar P] [HasVal P] [HasBoolVal P] in
+omit [HasFvar P] [HasFvars P] [HasOps P] in
 private theorem loop_transform_some_nondet
     (m : Option P.Expr) (inv : List (String × P.Expr))
     (body : List (Stmt P (Cmd P))) (md : MetaData P)
@@ -118,7 +121,7 @@ private theorem loop_transform_some_nondet
     | none => simp [hb] at ht
   | _ :: _ => simp [Option.bind] at ht
 
-omit [HasFvar P] [HasVal P] [HasBoolVal P] in
+omit [HasFvar P] [HasFvars P] [HasOps P] in
 private theorem block_transform_some
     (s : Stmt P (Cmd P)) (rest : List (Stmt P (Cmd P)))
     (ns : KleeneStmt P (Cmd P))
@@ -135,7 +138,7 @@ private theorem block_transform_some
 
 /-! ## exitsCoveredByBlocks from successful transform -/
 
-omit [HasFvar P] [HasVal P] [HasBoolVal P] in
+omit [HasFvar P] [HasFvars P] [HasOps P] in
 private theorem stmtToKleene_some_exitsCovered
     (labels : List String)
     (st : Stmt P (Cmd P)) (ns : KleeneStmt P (Cmd P))
@@ -186,7 +189,7 @@ where
 
 /-! ## noFuncDecl from successful transform -/
 
-omit [HasFvar P] [HasVal P] [HasBoolVal P] in
+omit [HasFvar P] [HasFvars P] [HasOps P] in
 private theorem stmtToKleene_some_noFuncDecl
     (st : Stmt P (Cmd P)) (ns : KleeneStmt P (Cmd P))
     (ht : StmtToKleeneStmt st = some ns) :
@@ -234,98 +237,6 @@ where
       simp [Block.noFuncDecl]
       exact ⟨stmtToKleene_some_noFuncDecl s s' hs, blockHelper rest r' hr⟩
 
-/-! ## ReflTransT decomposition helpers -/
-
-omit [HasVal P] [HasBoolVal P] in
-private theorem seqT_reaches_terminal
-    (extendEval : ExtendEval P)
-    {inner : Config P (Cmd P)} {ss : List (Stmt P (Cmd P))} {ρ' : Env P}
-    (hstar : ReflTransT (StepStmt P (EvalCmd P) extendEval) (.seq inner ss) (.terminal ρ')) :
-    ∃ (ρ₁ : Env P), ∃ (h1 : ReflTransT (StepStmt P (EvalCmd P) extendEval) inner (.terminal ρ₁)),
-      ∃ (h2 : ReflTransT (StepStmt P (EvalCmd P) extendEval) (.stmts ss ρ₁) (.terminal ρ')),
-      h1.len + h2.len < hstar.len := by
-  match hstar with
-  | .step _ _ _ (.step_seq_inner h) hrest =>
-    have ⟨ρ₁, hterm, htail, hlen⟩ := seqT_reaches_terminal extendEval hrest
-    exact ⟨ρ₁, .step _ _ _ h hterm, htail, by simp [ReflTransT.len]; omega⟩
-  | .step _ _ _ .step_seq_done hrest => exact ⟨_, .refl _, hrest, by show 0 + hrest.len < 1 + hrest.len; omega⟩
-  | .step _ _ _ .step_seq_exit hrest =>
-    match hrest with
-    | .step _ _ _ h _ => exact nomatch h
-
-omit [HasVal P] [HasBoolVal P] in
-private theorem stmtsT_cons_terminal
-    (extendEval : ExtendEval P)
-    {s : Stmt P (Cmd P)} {rest : List (Stmt P (Cmd P))} {ρ₀ ρ' : Env P}
-    (hstar : ReflTransT (StepStmt P (EvalCmd P) extendEval) (.stmts (s :: rest) ρ₀) (.terminal ρ')) :
-    ∃ (ρ₁ : Env P), ∃ (h1 : ReflTransT (StepStmt P (EvalCmd P) extendEval) (.stmt s ρ₀) (.terminal ρ₁)),
-      ∃ (h2 : ReflTransT (StepStmt P (EvalCmd P) extendEval) (.stmts rest ρ₁) (.terminal ρ')),
-      h1.len + h2.len + 2 ≤ hstar.len := by
-  match hstar with
-  | .step _ _ _ .step_stmts_cons hrest =>
-    have ⟨ρ₁, h1, h2, hlen⟩ := seqT_reaches_terminal extendEval hrest
-    exact ⟨ρ₁, h1, h2, by simp [ReflTransT.len]; omega⟩
-
-omit [HasVal P] [HasBoolVal P] in
-/-- Invert a block execution reaching terminal when the inner config cannot
-    exit: the inner reaches terminal with a strictly shorter derivation. -/
-private theorem blockT_reaches_terminal_noExit
-    (extendEval : ExtendEval P)
-    {inner : Config P (Cmd P)} {l : Option String} {σ_parent : SemanticStore P} {ρ' : Env P}
-    (hstar : ReflTransT (StepStmt P (EvalCmd P) extendEval) (.block l σ_parent inner) (.terminal ρ'))
-    (h_no_exit : ∀ lbl ρ_x,
-      ¬ StepStmtStar P (EvalCmd P) extendEval inner (.exiting lbl ρ_x)) :
-    ∃ (ρ_inner : Env P) (h : ReflTransT (StepStmt P (EvalCmd P) extendEval) inner (.terminal ρ_inner)),
-      ρ' = { ρ_inner with store := projectStore σ_parent ρ_inner.store } ∧
-      h.len < hstar.len := by
-  match hstar with
-  | .step _ (.block _ _ inner₁) _ (.step_block_body h) hrest =>
-    have h_no_exit' : ∀ lbl ρ_x,
-        ¬ StepStmtStar P (EvalCmd P) extendEval inner₁ (.exiting lbl ρ_x) := by
-      intro lbl ρ_x hinner₁
-      exact h_no_exit lbl ρ_x (.step _ _ _ h hinner₁)
-    have ⟨ρ_inner, hterm, heq, hlen⟩ := blockT_reaches_terminal_noExit extendEval hrest h_no_exit'
-    exact ⟨ρ_inner, .step _ _ _ h hterm, heq, by simp [ReflTransT.len]; omega⟩
-  | .step _ _ _ .step_block_done hrest =>
-    match hrest with
-    | .refl _ => exact ⟨_, .refl _, rfl, by simp [ReflTransT.len]⟩
-    | .step _ _ _ h _ => exact nomatch h
-  | .step _ _ _ (.step_block_exit_match _) hrest =>
-    exfalso
-    exact h_no_exit _ _ (.refl _)
-  | .step _ _ _ (.step_block_exit_mismatch _) hrest =>
-    match hrest with
-    | .step _ _ _ h _ => exact nomatch h
-
-omit [HasVal P] [HasBoolVal P] in
-private theorem stmtsT_append_terminal
-    (extendEval : ExtendEval P)
-    (ss₁ : List (Stmt P (Cmd P))) (s : Stmt P (Cmd P)) (ρ₀ ρ' : Env P)
-    (hstar : ReflTransT (StepStmt P (EvalCmd P) extendEval) (.stmts (ss₁ ++ [s]) ρ₀) (.terminal ρ'))
-    (hcov : Stmt.exitsCoveredByBlocks.Block.exitsCoveredByBlocks (P := P) (CmdT := Cmd P) [] ss₁) :
-    ∃ (ρ₁ : Env P), ∃ (_ : StepStmtStar P (EvalCmd P) extendEval (.stmts ss₁ ρ₀) (.terminal ρ₁)),
-      ∃ (hs : ReflTransT (StepStmt P (EvalCmd P) extendEval) (.stmt s ρ₁) (.terminal ρ')),
-      hs.len < hstar.len := by
-  induction ss₁ generalizing ρ₀ with
-  | nil =>
-    have ⟨ρ₁, h1, h2, hlen⟩ := stmtsT_cons_terminal extendEval hstar
-    -- h2 : ReflTransT ... (.stmts [] ρ₁) (.terminal ρ')
-    -- Must be: step via step_stmts_nil then refl, so ρ₁ = ρ'
-    have hρ : ρ₁ = ρ' := by
-      match h2 with
-      | .step _ _ _ .step_stmts_nil (.refl _) => rfl
-    subst hρ
-    exact ⟨ρ₀, .step _ _ _ .step_stmts_nil (.refl _), h1, by grind⟩
-  | cons s' rest' ih =>
-    -- Note: (s' :: rest') ++ [s] = s' :: (rest' ++ [s]) by definitional reduction
-    have ⟨ρ₁, h_s', h_rest, hlen₁⟩ := stmtsT_cons_terminal extendEval hstar
-    have ⟨ρ₂, h_rest', h_s, hlen₂⟩ := ih ρ₁ h_rest hcov.2
-    exact ⟨ρ₂,
-      ReflTrans_Transitive _ _ _ _
-        (stmts_cons_step P (EvalCmd P) extendEval s' rest' ρ₀ ρ₁ (reflTransT_to_prop h_s'))
-        h_rest',
-      h_s, by grind⟩
-
 /-! ## Loop simulation -/
 
 /-- With an empty invariant list, the `hasInvFailure` flag returned by any
@@ -375,9 +286,7 @@ private def loop_sim
         hasInvFailure _ _ hff_iff _) hrest, hlen =>
       have h_no : hasInvFailure = false := empty_inv_no_failure hff_iff
       subst h_no
-      have hρ : ({ ρ₀ with hasFailure := ρ₀.hasFailure || false } : Env P) = ρ₀ := by
-        rw [Bool.or_false]
-      rw [hρ] at hrest
+      rw [assume_env_eq] at hrest
       match hrest with
       | .refl _ => exact .step _ _ _ .step_loop_zero (.refl _)
       | .step _ _ _ h _ => exact nomatch h
@@ -390,16 +299,16 @@ private def loop_sim
       -- New shape: hrest : .seq (.block .none ρ₀'.store (.stmts body ρ₀')) [loop] →*T .terminal ρ'.
       -- Step 1: Split via seqT_reaches_terminal:
       have ⟨ρ_block, h_block_term, h_loop_stmts, hlen_seq⟩ :=
-        seqT_reaches_terminal extendEval hrest
+        seqT_reaches_terminal hrest
       -- Step 2: Unwrap the block. Body cannot exit (by hcov).
       have h_noescape_body : ∀ lbl ρ_x,
           ¬ StepStmtStar P (EvalCmd P) extendEval (.stmts body ρ₀') (.exiting lbl ρ_x) :=
         block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval body hcov ρ₀'
       have ⟨ρ_inner, h_inner_term, heq_ρ_block, hlen_inner⟩ :=
-        blockT_reaches_terminal_noExit extendEval h_block_term h_noescape_body
+        blockT_reaches_terminal_noExit h_block_term h_noescape_body
       -- Step 3: Decompose [loop] ρ_block via stmtsT_cons_terminal.
       have ⟨ρ_x, h_loop_T_T, h_nil, hlen_cons⟩ :=
-        stmtsT_cons_terminal extendEval h_loop_stmts
+        stmtsT_cons_terminal h_loop_stmts
       -- h_nil is .stmts [] ρ_x →*T .terminal ρ' — must be step_stmts_nil + refl.
       have hρ_x_eq : ρ_x = ρ' := by
         match h_nil with
@@ -421,11 +330,10 @@ private def loop_sim
       have h_kleene_assume_b : StepKleeneStar P (EvalCmd P)
           (.stmt (.seq (.cmd (.assume "guard" g md)) b) ρ₀) (.terminal ρ_inner) :=
         kleene_seq_terminal _ b ρ₀ ρ₀ ρ_inner h_assume h_sim_body
-      have hwfv_inner : WellFormedSemanticEvalVal ρ_inner.eval := by
-        have := block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval body ρ₀ ρ_inner hnofd_body hterm_body_eq
-        rw [this]; exact hwfv
+      have heval_inner : ρ_inner.eval = ρ₀.eval :=
+        block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval body ρ₀ ρ_inner hnofd_body hterm_body_eq
       have hwfv_block : WellFormedSemanticEvalVal ρ_block.eval := by
-        rw [heq_ρ_block]; exact hwfv_inner
+        rw [heq_ρ_block]; exact hρ₀_eq ▸ hwfv
       have h_kleene_loop : StepKleeneStar P (EvalCmd P)
           (.stmt (.loop (.seq (.cmd (.assume "guard" g md)) b)) ρ_block) (.terminal _) :=
         ih ρ_block _ hwfv_block h_loop_T_T (by simp [ReflTransT.len] at hlen; omega)
@@ -433,8 +341,9 @@ private def loop_sim
       -- Then use seq+block to reach (.terminal ρ_block) via h_kleene_assume_b + project.
       have heq_ρ_block_full : ρ_block =
           { ρ_inner with store := projectStore ρ₀.store ρ_inner.store } := by
-        have : ρ₀'.store = ρ₀.store := by rw [hρ₀_eq]
-        rw [heq_ρ_block, this]
+        have hstore : ρ₀'.store = ρ₀.store := by rw [hρ₀_eq]
+        rw [heq_ρ_block, hstore]
+        rw [show (ρ₀'.eval : SemanticEval P) = ρ_inner.eval from by rw [heval_inner, hρ₀_eq]]
       have h_block_to_ρ_block : StepKleeneStar P (EvalCmd P)
           (.block ρ₀.store (.stmt (.seq (.cmd (.assume "guard" g md)) b) ρ₀))
           (.terminal ρ_block) := by
@@ -474,6 +383,7 @@ private def loop_sim_kleene
       (.stmt (.loop b) ρ₀) (.terminal ρ') := by
   induction n generalizing ρ₀ ρ' with
   | zero =>
+    -- hstarT of length 0 = refl, impossible since src ≠ tgt.
     match hstarT, hlen with
     | .step _ _ _ _ _, hlen => simp [ReflTransT.len] at hlen
   | succ n ih =>
@@ -482,9 +392,7 @@ private def loop_sim_kleene
         hasInvFailure _ hff_iff) hrest, hlen =>
       have h_no : hasInvFailure = false := empty_inv_no_failure hff_iff
       subst h_no
-      have hρ : ({ ρ₀ with hasFailure := ρ₀.hasFailure || false } : Env P) = ρ₀ := by
-        rw [Bool.or_false]
-      rw [hρ] at hrest
+      rw [assume_env_eq] at hrest
       match hrest with
       | .refl _ => exact .step _ _ _ .step_loop_zero (.refl _)
       | .step _ _ _ h _ => exact nomatch h
@@ -494,16 +402,15 @@ private def loop_sim_kleene
       subst h_no
       let ρ₀' : Env P := {ρ₀ with hasFailure := ρ₀.hasFailure || false}
       have hρ₀_eq : ρ₀' = ρ₀ := by simp [ρ₀', Bool.or_false]
-      -- New shape: hrest : .seq (.block .none ρ₀'.store (.stmts body ρ₀')) [loop] →*T .terminal ρ'
       have ⟨ρ_block, h_block_term, h_loop_stmts, hlen_seq⟩ :=
-        seqT_reaches_terminal extendEval hrest
+        seqT_reaches_terminal hrest
       have h_noescape_body : ∀ lbl ρ_x,
           ¬ StepStmtStar P (EvalCmd P) extendEval (.stmts body ρ₀') (.exiting lbl ρ_x) :=
         block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval body hcov ρ₀'
       have ⟨ρ_inner, h_inner_term, heq_ρ_block, hlen_inner⟩ :=
-        blockT_reaches_terminal_noExit extendEval h_block_term h_noescape_body
+        blockT_reaches_terminal_noExit h_block_term h_noescape_body
       have ⟨ρ_x, h_loop_T_T, h_nil, hlen_cons⟩ :=
-        stmtsT_cons_terminal extendEval h_loop_stmts
+        stmtsT_cons_terminal h_loop_stmts
       have hρ_x_eq : ρ_x = ρ' := by
         match h_nil with
         | .step _ _ _ .step_stmts_nil hr2 =>
@@ -515,23 +422,20 @@ private def loop_sim_kleene
         hρ₀_eq ▸ reflTransT_to_prop h_inner_term
       have h_sim_body : StepKleeneStar P (EvalCmd P) (.stmt b ρ₀) (.terminal ρ_inner) :=
         sim_body ρ₀ ρ_inner hwfb hwfv hterm_body_eq
-      have hwfv_inner : WellFormedSemanticEvalVal ρ_inner.eval := by
-        have := block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval body ρ₀ ρ_inner hnofd_body hterm_body_eq
-        rw [this]; exact hwfv
-      have hwfb_inner : WellFormedSemanticEvalBool ρ_inner.eval := by
-        have := block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval body ρ₀ ρ_inner hnofd_body hterm_body_eq
-        rw [this]; exact hwfb
+      have heval_inner : ρ_inner.eval = ρ₀.eval :=
+        block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval body ρ₀ ρ_inner hnofd_body hterm_body_eq
       have hwfv_block : WellFormedSemanticEvalVal ρ_block.eval := by
-        rw [heq_ρ_block]; exact hwfv_inner
+        rw [heq_ρ_block]; exact hρ₀_eq ▸ hwfv
       have hwfb_block : WellFormedSemanticEvalBool ρ_block.eval := by
-        rw [heq_ρ_block]; exact hwfb_inner
+        rw [heq_ρ_block]; exact hρ₀_eq ▸ hwfb
       have h_kleene_loop : StepKleeneStar P (EvalCmd P)
           (.stmt (.loop b) ρ_block) (.terminal _) :=
         ih ρ_block _ hwfb_block hwfv_block h_loop_T_T (by simp [ReflTransT.len] at hlen; omega)
       have heq_ρ_block_full : ρ_block =
           { ρ_inner with store := projectStore ρ₀.store ρ_inner.store } := by
-        have : ρ₀'.store = ρ₀.store := by rw [hρ₀_eq]
-        rw [heq_ρ_block, this]
+        have hstore : ρ₀'.store = ρ₀.store := by rw [hρ₀_eq]
+        rw [heq_ρ_block, hstore]
+        rw [show (ρ₀'.eval : SemanticEval P) = ρ_inner.eval from by rw [heval_inner, hρ₀_eq]]
       have h_block_to_ρ_block : StepKleeneStar P (EvalCmd P)
           (.block ρ₀.store (.stmt b ρ₀))
           (.terminal ρ_block) := by
@@ -549,6 +453,7 @@ private def loop_sim_kleene
 
 /-! ## Core simulation by strong induction on statement/block size -/
 
+omit [HasOps P] [HasFvars P] in
 private theorem simulation
     (extendEval : ExtendEval P) (sz : Nat) :
     (∀ (st : Stmt P (Cmd P)) (ns : KleeneStmt P (Cmd P)),
@@ -612,10 +517,14 @@ private theorem simulation
               | .inl ⟨ρ_inner, hterm, heq_ρ'⟩ =>
                 have hsz_bss : Block.sizeOf bss ≤ n := by
                   simp_all [Stmt.sizeOf]; omega
+                have heval_inner : ρ_inner.eval = ρ₀.eval :=
+                  block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval bss ρ₀ ρ_inner
+                    (stmtToKleene_some_noFuncDecl.blockHelper bss b hb) hterm
                 subst heq_ρ'
-                exact .step _ _ _ .step_block
-                  (kleene_block_terminal ρ₀.store _ ρ_inner
-                    (ih.2 bss b hsz_bss hb ρ₀ ρ_inner hwfb hwfv hterm))
+                refine .step _ _ _ .step_block ?_
+                rw [show (ρ₀.eval : SemanticEval P) = ρ_inner.eval from heval_inner.symm]
+                exact kleene_block_terminal ρ₀.store _ ρ_inner
+                  (ih.2 bss b hsz_bss hb ρ₀ ρ_inner hwfb hwfv hterm)
               | .inr ⟨lbl, ρ_inner, hexit, _⟩ =>
                 exact absurd hexit (block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval bss
                   (stmtToKleene_some_exitsCovered.blockHelper [] bss b hb) ρ₀ lbl ρ_inner)
@@ -625,37 +534,86 @@ private theorem simulation
         | .det c =>
           have ⟨t, e, ht_tss, ht_ess, hns⟩ := ite_transform_some_det c tss ess md ns ht
           subst hns
+          have hcov_tss := stmtToKleene_some_exitsCovered.blockHelper [] tss t ht_tss
+          have hcov_ess := stmtToKleene_some_exitsCovered.blockHelper [] ess e ht_ess
           cases hstar with
           | step _ _ _ h1 r1 => cases h1 with
             | step_ite_true hcond hwfb =>
-              have : Block.sizeOf tss ≤ n := by
-                simp_all [Stmt.sizeOf]; omega
-              have hnd := ih.2 tss t this ht_tss ρ₀ ρ' hwfb hwfv r1
-              have h_assume := kleene_assume_terminal (label := "true_cond") (md := md) hcond hwfb
-              exact .step _ _ _ .step_choice_left
-                (kleene_seq_terminal _ t ρ₀ ρ₀ ρ' h_assume hnd)
+              have hsz_tss : Block.sizeOf tss ≤ n := by simp_all [Stmt.sizeOf]; omega
+              match block_reaches_terminal P (EvalCmd P) extendEval r1 with
+              | .inl ⟨ρ_inner, hterm, heq_ρ'⟩ =>
+                have heval_inner : ρ_inner.eval = ρ₀.eval :=
+                  block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval tss ρ₀ ρ_inner
+                    (stmtToKleene_some_noFuncDecl.blockHelper tss t ht_tss) hterm
+                subst heq_ρ'
+                have hnd := ih.2 tss t hsz_tss ht_tss ρ₀ ρ_inner hwfb hwfv hterm
+                have h_assume := kleene_assume_terminal (label := "true_cond") (md := md) hcond hwfb
+                refine .step _ _ _ .step_choice_left
+                  (.step _ _ _ .step_block ?_)
+                rw [show (ρ₀.eval : SemanticEval P) = ρ_inner.eval from heval_inner.symm]
+                exact kleene_block_terminal ρ₀.store _ ρ_inner
+                  (kleene_seq_terminal _ t ρ₀ ρ₀ ρ_inner h_assume hnd)
+              | .inr ⟨lbl, ρ_inner, hexit, _⟩ =>
+                exact absurd hexit (block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval tss
+                  hcov_tss ρ₀ lbl ρ_inner)
             | step_ite_false hcond hwfb =>
-              have : Block.sizeOf ess ≤ n := by
-                simp_all [Stmt.sizeOf]; omega
-              have hnd := ih.2 ess e this ht_ess ρ₀ ρ' hwfb hwfv r1
-              have h_assume := kleene_assume_terminal (label := "false_cond") (md := md) ((hwfb ρ₀.store c).2.mp hcond) hwfb
-              exact .step _ _ _ .step_choice_right
-                (kleene_seq_terminal _ e ρ₀ ρ₀ ρ' h_assume hnd)
+              have hsz_ess : Block.sizeOf ess ≤ n := by simp_all [Stmt.sizeOf]; omega
+              match block_reaches_terminal P (EvalCmd P) extendEval r1 with
+              | .inl ⟨ρ_inner, hterm, heq_ρ'⟩ =>
+                have heval_inner : ρ_inner.eval = ρ₀.eval :=
+                  block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval ess ρ₀ ρ_inner
+                    (stmtToKleene_some_noFuncDecl.blockHelper ess e ht_ess) hterm
+                subst heq_ρ'
+                have hnd := ih.2 ess e hsz_ess ht_ess ρ₀ ρ_inner hwfb hwfv hterm
+                have h_assume := kleene_assume_terminal (label := "false_cond") (md := md)
+                  ((hwfb ρ₀.store c).2.mp hcond) hwfb
+                refine .step _ _ _ .step_choice_right
+                  (.step _ _ _ .step_block ?_)
+                rw [show (ρ₀.eval : SemanticEval P) = ρ_inner.eval from heval_inner.symm]
+                exact kleene_block_terminal ρ₀.store _ ρ_inner
+                  (kleene_seq_terminal _ e ρ₀ ρ₀ ρ_inner h_assume hnd)
+              | .inr ⟨lbl, ρ_inner, hexit, _⟩ =>
+                exact absurd hexit (block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval ess
+                  hcov_ess ρ₀ lbl ρ_inner)
         | .nondet =>
           have ⟨t, e, ht_tss, ht_ess, hns⟩ := ite_transform_some_nondet tss ess md ns ht
           subst hns
+          have hcov_tss := stmtToKleene_some_exitsCovered.blockHelper [] tss t ht_tss
+          have hcov_ess := stmtToKleene_some_exitsCovered.blockHelper [] ess e ht_ess
           cases hstar with
           | step _ _ _ h1 r1 => cases h1 with
             | step_ite_nondet_true =>
-              have : Block.sizeOf tss ≤ n := by
-                simp_all [Stmt.sizeOf]; omega
-              exact .step _ _ _ .step_choice_left
-                (ih.2 tss t this ht_tss ρ₀ ρ' hwfb hwfv r1)
+              have hsz_tss : Block.sizeOf tss ≤ n := by simp_all [Stmt.sizeOf]; omega
+              match block_reaches_terminal P (EvalCmd P) extendEval r1 with
+              | .inl ⟨ρ_inner, hterm, heq_ρ'⟩ =>
+                have heval_inner : ρ_inner.eval = ρ₀.eval :=
+                  block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval tss ρ₀ ρ_inner
+                    (stmtToKleene_some_noFuncDecl.blockHelper tss t ht_tss) hterm
+                subst heq_ρ'
+                have hnd := ih.2 tss t hsz_tss ht_tss ρ₀ ρ_inner hwfb hwfv hterm
+                refine .step _ _ _ .step_choice_left
+                  (.step _ _ _ .step_block ?_)
+                rw [show (ρ₀.eval : SemanticEval P) = ρ_inner.eval from heval_inner.symm]
+                exact kleene_block_terminal ρ₀.store _ ρ_inner hnd
+              | .inr ⟨lbl, ρ_inner, hexit, _⟩ =>
+                exact absurd hexit (block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval tss
+                  hcov_tss ρ₀ lbl ρ_inner)
             | step_ite_nondet_false =>
-              have : Block.sizeOf ess ≤ n := by
-                simp_all [Stmt.sizeOf]; omega
-              exact .step _ _ _ .step_choice_right
-                (ih.2 ess e this ht_ess ρ₀ ρ' hwfb hwfv r1)
+              have hsz_ess : Block.sizeOf ess ≤ n := by simp_all [Stmt.sizeOf]; omega
+              match block_reaches_terminal P (EvalCmd P) extendEval r1 with
+              | .inl ⟨ρ_inner, hterm, heq_ρ'⟩ =>
+                have heval_inner : ρ_inner.eval = ρ₀.eval :=
+                  block_noFuncDecl_preserves_eval P (EvalCmd P) extendEval ess ρ₀ ρ_inner
+                    (stmtToKleene_some_noFuncDecl.blockHelper ess e ht_ess) hterm
+                subst heq_ρ'
+                have hnd := ih.2 ess e hsz_ess ht_ess ρ₀ ρ_inner hwfb hwfv hterm
+                refine .step _ _ _ .step_choice_right
+                  (.step _ _ _ .step_block ?_)
+                rw [show (ρ₀.eval : SemanticEval P) = ρ_inner.eval from heval_inner.symm]
+                exact kleene_block_terminal ρ₀.store _ ρ_inner hnd
+              | .inr ⟨lbl, ρ_inner, hexit, _⟩ =>
+                exact absurd hexit (block_exitsCoveredByBlocks_noEscape P (EvalCmd P) extendEval ess
+                  hcov_ess ρ₀ lbl ρ_inner)
 
       | .loop guard m' inv body md =>
         match guard with
@@ -733,6 +691,7 @@ private theorem simulation
               (ih.1 s s' hsz_s hs ρ₀ ρ₁ hwfb hwfv hterm_s)
               (ih.2 rest rest' hsz_r hr ρ₁ ρ' hwfb₁ hwfv₁ hterm_rest)
 
+omit [HasOps P] [HasFvars P] in
 /-- If det stmt reaches terminal, Kleene transform reaches terminal. -/
 theorem stmtToKleene_terminal
     (extendEval : ExtendEval P)
@@ -745,6 +704,7 @@ theorem stmtToKleene_terminal
     StepKleeneStar P (EvalCmd P) (.stmt ns ρ₀) (.terminal ρ') :=
   (simulation extendEval st.sizeOf).1 st ns (Nat.le_refl _) ht ρ₀ ρ' hwfb hwfv hstar
 
+omit [HasOps P] [HasFvars P] in
 /-- If det block reaches terminal, Kleene transform reaches terminal. -/
 theorem blockToKleene_terminal
     (extendEval : ExtendEval P)
@@ -759,6 +719,7 @@ theorem blockToKleene_terminal
 
 /-! ## Main theorem -/
 
+omit [HasOps P] in
 /-- `StmtToKleeneStmt` overapproximates: any terminal env reachable from the
     deterministic execution is also reachable from the nondeterministic one,
     provided the evaluator is well-formed.
diff --git a/Strata/Transform/LoopElim.lean b/Strata/Transform/LoopElim.lean
index 03758bb1f7..bdaff09d02 100644
--- a/Strata/Transform/LoopElim.lean
+++ b/Strata/Transform/LoopElim.lean
@@ -116,9 +116,11 @@ encoding.
 mutual
 
 def Stmt.removeLoopsM
-  [HasNot P] [HasVarsImp P C] [HasHavoc P C] [HasInit P C] [HasPassiveCmds P C]
+  {P : PureExpr} {C : Type}
+  [HasFvars P] [HasBool P] [HasBoolOps P]
+  [HasVarsImp P C] [HasHavoc P C] [HasInit P C] [HasPassiveCmds P C]
   [DecidableEq P.Ident]
-  [HasIdent P] [HasFvar P] [HasIntOrder P]
+  [HasIdent P] [HasFvar P] [HasInt P] [HasIntOps P]
   (s : Stmt P C) : StateM LoopElimState (Stmt P C) :=
   match s with
   | .loop guard measure invariants bss md => do
@@ -127,7 +129,7 @@ def Stmt.removeLoopsM
     -- Havoc only loop-carried variables. Variables declared inside the loop
     -- body are block-local and should not be treated as pre-existing state by
     -- the passive loop encoding.
-    let local_defs := Block.definedVars bss
+    let local_defs := Block.definedVars bss false
     let assigned_vars :=
       (Block.modifiedVars bss).filter (fun v => v ∉ local_defs)
     -- All of the replaced statements reuse the metadata md.
@@ -140,16 +142,34 @@ def Stmt.removeLoopsM
     -- reference to the source invariant.
     let invSuffix : Nat → String → String := fun i lbl =>
       if lbl.isEmpty then toString i else s!"{i}_{lbl}"
+    -- Per-invariant source provenance, threaded through the loop metadata by the
+    -- Laurel→Core translation (in invariant order). When present, each
+    -- invariant's generated assert/assume is attributed to that invariant's own
+    -- source location instead of the whole loop; otherwise we fall back to the
+    -- loop metadata `md` (e.g. for loops not originating from Laurel).
+    -- Contract: `invProvs` holds one provenance per invariant, in invariant
+    -- order, pushed by the Laurel→Core translation (`pushInvariantProvenance`).
+    -- When the sizes disagree (e.g. a loop not originating from Laurel, or a
+    -- future desync between push and retrieval) we fall back to the loop `md`
+    -- via the index lookup below, so a mismatch degrades gracefully rather than
+    -- mis-attributing ranges.
+    let invProvs := MetaData.getInvariantProvenances md
+    let invMd : Nat → MetaData P := fun i =>
+      -- Only real source locations (`.loc`) refine the diagnostic; a synthesized
+      -- provenance carries no usable range, so fall back to the loop `md`
+      match invProvs[i]? with
+      | some (p@(.loc ..)) => MetaData.ofProvenance p
+      | _ => md
     let entry_invariants := invariants.mapIdx fun i (lbl, inv) =>
-      Stmt.cmd (HasPassiveCmds.assert s!"entry_invariant_{loop_num}_{invSuffix i lbl}" inv md)
+      Stmt.cmd (HasPassiveCmds.assert s!"entry_invariant_{loop_num}_{invSuffix i lbl}" inv (invMd i))
     let entry_invariant_assumes := invariants.mapIdx fun i (lbl, inv) =>
-      Stmt.cmd (HasPassiveCmds.assume s!"assume_entry_invariant_{loop_num}_{invSuffix i lbl}" inv md)
+      Stmt.cmd (HasPassiveCmds.assume s!"assume_entry_invariant_{loop_num}_{invSuffix i lbl}" inv (invMd i))
     let first_iter_facts :=
       .block s!"first_iter_asserts_{loop_num}" (entry_invariants ++ entry_invariant_assumes) {}
     let inv_assumes := invariants.mapIdx fun i (lbl, inv) =>
-      Stmt.cmd (HasPassiveCmds.assume s!"{loopElimInvariantPrefix}{loop_num}_{invSuffix i lbl}" inv md)
+      Stmt.cmd (HasPassiveCmds.assume s!"{loopElimInvariantPrefix}{loop_num}_{invSuffix i lbl}" inv (invMd i))
     let maintain_invariants := invariants.mapIdx fun i (lbl, inv) =>
-      Stmt.cmd (HasPassiveCmds.assert s!"arbitrary_iter_maintain_invariant_{loop_num}_{invSuffix i lbl}" inv md)
+      Stmt.cmd (HasPassiveCmds.assert s!"arbitrary_iter_maintain_invariant_{loop_num}_{invSuffix i lbl}" inv (invMd i))
     -- Guard-specific parts: assume_guard, termination, not_guard
     let (guard_assumes, pre_termination, post_termination, exit_guard) ← match guard with
       | .det g => do
@@ -160,17 +180,17 @@ def Stmt.removeLoopsM
           | some m =>
             let m_old_ident    := HasIdent.ident s!"$__loop_measure_{loop_num}"
             let m_old_expr     := HasFvar.mkFvar m_old_ident
-            let init_m_old     := Stmt.cmd (HasInit.init m_old_ident HasIntOrder.intTy .nondet md)
+            let init_m_old     := Stmt.cmd (HasInit.init m_old_ident HasInt.intTy .nondet md)
             let assume_m_old   := Stmt.cmd (HasPassiveCmds.assume
-              s!"assume_measure_{loop_num}" (HasIntOrder.eq m_old_expr m) md)
+              s!"assume_measure_{loop_num}" (HasIntOps.eq m_old_expr m) md)
             let assert_lb      := Stmt.cmd (HasPassiveCmds.assert
               s!"measure_lb_{loop_num}"
-              (HasNot.not (HasIntOrder.lt m_old_expr HasIntOrder.zero)) md)
+              (HasBoolOps.not (HasIntOps.lt m_old_expr HasInt.zero)) md)
             let assert_decrease := Stmt.cmd (HasPassiveCmds.assert
-              s!"measure_decrease_{loop_num}" (HasIntOrder.lt m m_old_expr) md)
+              s!"measure_decrease_{loop_num}" (HasIntOps.lt m m_old_expr) md)
             pure ([init_m_old, assume_m_old, assert_lb], [assert_decrease])
         let (pre, post) := termination_stmts
-        let not_guard := [Stmt.cmd (HasPassiveCmds.assume s!"not_guard_{loop_num}" (HasNot.not g) md)]
+        let not_guard := [Stmt.cmd (HasPassiveCmds.assume s!"not_guard_{loop_num}" (HasBoolOps.not g) md)]
         pure (assume_guard, pre, post, not_guard)
       | .nondet =>
         -- Nondet loop: no guard assume, no termination, no not_guard
@@ -181,7 +201,7 @@ def Stmt.removeLoopsM
       ([havocd, arbitrary_iter_assumes] ++ pre_termination ++
        body_statements ++ maintain_invariants ++ post_termination) {}
     let invariant_assumes := invariants.mapIdx fun i (lbl, inv) =>
-      Stmt.cmd (HasPassiveCmds.assume s!"invariant_{loop_num}_{invSuffix i lbl}" inv md)
+      Stmt.cmd (HasPassiveCmds.assume s!"invariant_{loop_num}_{invSuffix i lbl}" inv (invMd i))
     let exit_state_assumes := [havocd] ++ exit_guard ++ invariant_assumes
     let loop_passive :=
       .ite guard (arbitrary_iter_facts :: exit_state_assumes) [] {}
@@ -213,9 +233,11 @@ def Stmt.removeLoopsM
   | .typeDecl _ _ => pure s  -- Type declarations pass through unchanged
 
 def Block.removeLoopsM
-  [HasNot P] [HasVarsImp P C] [HasHavoc P C] [HasInit P C] [HasPassiveCmds P C]
+  {P : PureExpr} {C : Type}
+  [HasFvars P] [HasBool P] [HasBoolOps P]
+  [HasVarsImp P C] [HasHavoc P C] [HasInit P C] [HasPassiveCmds P C]
   [DecidableEq P.Ident]
-  [HasIdent P] [HasFvar P] [HasIntOrder P]
+  [HasIdent P] [HasFvar P] [HasInt P] [HasIntOps P]
   (ss : List (Stmt P C)) : StateM LoopElimState (List (Stmt P C)) :=
   match ss with
   | [] => pure []
@@ -227,9 +249,11 @@ def Block.removeLoopsM
 end
 
 def Stmt.removeLoops
-  [HasNot P] [HasVarsImp P C] [HasHavoc P C] [HasInit P C] [HasPassiveCmds P C]
+  {P : PureExpr} {C : Type}
+  [HasFvars P] [HasBool P] [HasBoolOps P]
+  [HasVarsImp P C] [HasHavoc P C] [HasInit P C] [HasPassiveCmds P C]
   [DecidableEq P.Ident]
-  [HasIdent P] [HasFvar P] [HasIntOrder P]
+  [HasIdent P] [HasFvar P] [HasInt P] [HasIntOps P]
   (s : Stmt P C) : Stmt P C :=
   (StateT.run (removeLoopsM s) {}).fst
 
@@ -240,8 +264,13 @@ def loopElim (p : Program) : Program × Statistics :=
   let (decls, stats) := p.decls.foldl (fun (acc, stats) d =>
     match d with
     | .proc proc md =>
-      let (body, st) := StateT.run (Block.removeLoopsM proc.body) {}
-      ((.proc { proc with body := body } md) :: acc, stats.merge st.statistics)
+      match proc.body with
+      | .structured ss =>
+        let (body, st) := StateT.run (Block.removeLoopsM ss) {}
+        ((.proc { proc with body := .structured body } md) :: acc, stats.merge st.statistics)
+      -- CFG bodies have no structured loops; pass through unchanged. An
+      -- unstructured loop elimination process could be applied here later.
+      | .cfg _ => ((.proc proc md) :: acc, stats)
     | other => (other :: acc, stats)) ([], {})
   ({ decls := decls.reverse }, stats)
 
diff --git a/Strata/Transform/PrecondElim.lean b/Strata/Transform/PrecondElim.lean
index 1e4bc5dbe2..6f68e8d479 100644
--- a/Strata/Transform/PrecondElim.lean
+++ b/Strata/Transform/PrecondElim.lean
@@ -176,7 +176,7 @@ def mkContractWFProc (F : @Lambda.Factory CoreLParams) (proc : Procedure)
     some <| .proc {
       header := { proc.header with name := ⟨wfProcName name, ()⟩, noFilter := true }
       spec := { preconditions := [], postconditions := [] }
-      body := body
+      body := .structured body
     } md
   else
     none
@@ -232,7 +232,7 @@ def mkFuncWFProc (F : @Lambda.Factory CoreLParams) (func : Function)
         noFilter := true
       }
       spec := { preconditions := [], postconditions := [] }
-      body := wfStmts
+      body := .structured wfStmts
     } md)
 
 /-! ## Statement transformation -/
@@ -385,15 +385,19 @@ where
           acc := acc.push d
         else
           let F ← getFactory
-          let (bodyChanged, body') ← transformStmts proc.body
+          let (bodyChanged, proc') ← match proc.body with
+            | .structured ss =>
+              let (c, body') ← transformStmts ss
+              pure (c, { proc with body := .structured body' })
+            -- CFG bodies pass through untouched.
+            | .cfg _ => pure (false, proc)
           setFactory F
-          let proc' := { proc with body := body' }
           let procDecl := Decl.proc proc' md
           match mkContractWFProc F proc md with
           | some wfDecl => do
             incrementStat s!"{Stats.wfProceduresGenerated}"
             incrementStat s!"{Stats.wfProcedureBodyStmtsEmitted}"
-              (match wfDecl with | .proc p _ => p.body.length | _ => 0)
+              (match wfDecl with | .proc p _ => p.body.structuredLength | _ => 0)
             addWFProcToCallGraph (wfProcName (CoreIdent.toPretty proc.header.name))
             changed := true
             acc := acc.push wfDecl
@@ -415,7 +419,7 @@ where
         | some wfDecl => do
           incrementStat s!"{Stats.wfProceduresGenerated}"
           incrementStat s!"{Stats.wfProcedureBodyStmtsEmitted}"
-            (match wfDecl with | .proc p _ => p.body.length | _ => 0)
+            (match wfDecl with | .proc p _ => p.body.structuredLength | _ => 0)
           addWFProcToCallGraph (wfProcName (CoreIdent.toPretty func.name))
           changed := true
           acc := acc.push wfDecl
@@ -441,7 +445,7 @@ where
           | some wfDecl => do
             incrementStat s!"{Stats.wfProceduresGenerated}"
             incrementStat s!"{Stats.wfProcedureBodyStmtsEmitted}"
-              (match wfDecl with | .proc p _ => p.body.length | _ => 0)
+              (match wfDecl with | .proc p _ => p.body.structuredLength | _ => 0)
             addWFProcToCallGraph (wfProcName (CoreIdent.toPretty func.name))
             return some wfDecl
           | none => return none
diff --git a/Strata/Transform/ProcBodyVerify.lean b/Strata/Transform/ProcBodyVerify.lean
index 058f19a2d3..2d0b030c5d 100644
--- a/Strata/Transform/ProcBodyVerify.lean
+++ b/Strata/Transform/ProcBodyVerify.lean
@@ -85,8 +85,12 @@ open Core Imperative Transform
   -- Convert preconditions to assumes
   let assumes := requiresToAssumes proc.spec.preconditions
 
+  -- ProcBodyVerify expects a structured body: the prefix (inits + assumes) and
+  -- suffix (postcondition asserts) are statement-level constructs that embed
+  -- around the body. Unstructured CFG bodies are not supported here.
+  let bodyStmts ← proc.body.getStructured.mapError Strata.DiagnosticModel.fromMessage
   -- Wrap body in labeled block
-  let bodyBlock := Stmt.block bodyLabel proc.body #[]
+  let bodyBlock := Stmt.block bodyLabel bodyStmts #[]
 
   -- Convert postconditions to asserts
   let asserts := ensuresToAsserts proc.spec.postconditions
diff --git a/Strata/Transform/ProcBodyVerifyCorrect.lean b/Strata/Transform/ProcBodyVerifyCorrect.lean
index b8bb5896a6..7a7a3cf505 100644
--- a/Strata/Transform/ProcBodyVerifyCorrect.lean
+++ b/Strata/Transform/ProcBodyVerifyCorrect.lean
@@ -446,6 +446,17 @@ private theorem mapM_stateT_pure_eq {α β : Type} {σ : Type} {ε : Type}
 
 /-! ## Verification Statement Structure -/
 
+/-- if `procToVerifyStmt` succeeds, then the input procedure has `.structured` body -/
+theorem procToVerifyStmt_is_structured
+    (h : (procToVerifyStmt proc).run st = (Except.ok verifyStmt, st')) :
+      ∃ ss, proc.body = .structured ss := by
+    simp [ExceptT.run, procToVerifyStmt] at h
+    cases hb: proc.body with
+    | structured ss => simp
+    | cfg blk =>
+      simp [hb] at h
+      cases h
+
 /-- Structure: the output of `procToVerifyStmt` is a block
     `prefix ++ [bodyBlock] ++ postAsserts`, and all prefix statements
     are `.cmd` (init/assume commands).
@@ -458,16 +469,19 @@ theorem procToVerifyStmt_structure
     (π : String → Option Procedure)
     (φ : CoreEval → PureFunc Expression → CoreEval)
     (h_wf_proc : WF.WFProcedureProp p proc) :
-    ∃ (prefixStmts : List Statement),
+    ∃ (prefixStmts ss : List Statement),
+      proc.body = .structured ss ∧
       verifyStmt = Stmt.block s!"verify_{proc.header.name.name}"
-        (prefixStmts ++ [Stmt.block s!"body_{proc.header.name.name}" proc.body #[]] ++
+        (prefixStmts ++ [Stmt.block s!"body_{proc.header.name.name}" ss #[]] ++
           ensuresToAsserts proc.spec.postconditions) #[] ∧
       (∀ s ∈ prefixStmts, ∃ c, s = Stmt.cmd c) ∧
       (∀ ρ₀, Core.Specification.ProcEnvWF proc ρ₀ →
         ∃ ρ_init,
           Imperative.StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ)
             (.stmts prefixStmts ρ_init) (.terminal ρ₀)) := by
+  obtain ⟨ss, h_body_eq⟩ := procToVerifyStmt_is_structured h
   unfold procToVerifyStmt at h
+  rw [h_body_eq] at h
   simp only [bind, ExceptT.bind, ExceptT.mk, ExceptT.run, ExceptT.bindCont,
     pure, ExceptT.pure, StateT.bind] at h
   rw [mapM_stateT_pure_eq] at h
@@ -482,7 +496,8 @@ theorem procToVerifyStmt_structure
       (.det (LExpr.fvar () id none)) #[]
   let assumes := requiresToAssumes proc.spec.preconditions
   let prefixStmts := inputInits ++ outputOnlyInits ++ oldInoutInits ++ assumes
-  refine ⟨prefixStmts, h_eq.symm, ?_, ?_⟩
+  rw [h_body_eq]
+  refine ⟨prefixStmts, ss, rfl, h_eq.symm, ?_, ?_⟩
   · intro s hs
     simp only [prefixStmts, List.mem_append] at hs
     rcases hs with ((hs | hs) | hs) | hs
@@ -642,9 +657,13 @@ theorem procBodyVerify_procedureCorrect
     (h_wf_proc : WF.WFProcedureProp p proc) :
     -- Conclusion: ProcedureCorrect holds.
     Core.Specification.ProcedureCorrect π φ proc p := by
-
-  obtain ⟨prefixStmts, h_eq, h_prefix_cmd, h_prefix_trace⟩ :=
+  obtain ⟨ss, h_body_eq⟩ := procToVerifyStmt_is_structured h_transform
+  obtain ⟨prefixStmts, ss', h_body, h_eq, h_prefix_cmd, h_prefix_trace⟩ :=
     procToVerifyStmt_structure proc p st st' verifyStmt h_transform π φ h_wf_proc
+  have h_ss_eq : ss = ss' := by
+    have := h_body_eq.symm.trans h_body
+    exact Procedure.Body.structured.inj this
+  subst h_ss_eq
   let verifyLabel := s!"verify_{proc.header.name.name}"
   let bodyLabel := s!"body_{proc.header.name.name}"
   let postAsserts := ensuresToAsserts proc.spec.postconditions
@@ -655,18 +674,18 @@ theorem procBodyVerify_procedureCorrect
      verifyStmt context (block verifyLabel > seq > block bodyLabel). -/
   have h_embed_body : ∀ ρ₀ (h_wf : Specification.ProcEnvWF proc ρ₀)
       (cfg : CoreConfig),
-      CoreStepStar π φ (.stmts proc.body ρ₀) cfg →
+      CoreStepStar π φ (.stmts ss ρ₀) cfg →
       ∃ ρ_init,
         StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ)
           (.stmt verifyStmt ρ_init)
-          (.block (.some verifyLabel) ρ_init.store (.seq (.block (.some bodyLabel) ρ₀.store cfg) postAsserts)) := by
+          (.block (.some verifyLabel) ρ_init.store ρ_init.eval (.seq (.block (.some bodyLabel) ρ₀.store ρ₀.eval cfg) postAsserts)) := by
     intro ρ₀ h_wf cfg h_body
     obtain ⟨ρ_init, h_prefix⟩ := h_prefix_trace ρ₀ h_wf
     exact ⟨ρ_init, by
       rw [h_eq]
       exact ReflTrans_Transitive _ _ _ _
         (step_block_enter Expression (EvalCommand π φ) (EvalPureFunc φ) verifyLabel _ #[] ρ_init)
-        (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some verifyLabel) ρ_init.store
+        (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some verifyLabel) ρ_init.store ρ_init.eval
           (ReflTrans_Transitive _ _ _ _
             (by rw [List.append_assoc]
                 exact stmts_prefix_terminal_append Expression (EvalCommand π φ) (EvalPureFunc φ)
@@ -676,27 +695,27 @@ theorem procBodyVerify_procedureCorrect
               (seq_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ postAsserts
                 (ReflTrans_Transitive _ _ _ _
                   (step_block_enter Expression (EvalCommand π φ) (EvalPureFunc φ) bodyLabel _ #[] ρ₀)
-                  (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some bodyLabel) ρ₀.store
+                  (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some bodyLabel) ρ₀.store ρ₀.eval
                     (CoreStepStar_to_StepStmtStar h_body)))))))⟩
 
   /- Helper: coreIsAtAssert and getEval/getStore are preserved through
      the verifyStmt wrapping (block > seq > block). -/
-  have h_wrapped_assert : ∀ (σ_v σ_b : SemanticStore Expression) (cfg : CoreConfig) (a : AssertId Expression),
+  have h_wrapped_assert : ∀ (σ_v σ_b : SemanticStore Expression) (e_v e_b : SemanticEval Expression) (cfg : CoreConfig) (a : AssertId Expression),
       coreIsAtAssert cfg a →
-      coreIsAtAssert (.block (.some verifyLabel) σ_v (.seq (.block (.some bodyLabel) σ_b cfg) postAsserts)) a := by
-    intro σ_v σ_b cfg a h
+      coreIsAtAssert (.block (.some verifyLabel) σ_v e_v (.seq (.block (.some bodyLabel) σ_b e_b cfg) postAsserts)) a := by
+    intro σ_v σ_b e_v e_b cfg a h
     simp only [coreIsAtAssert]
     exact h
 
-  have h_wrapped_eval : ∀ (σ_v σ_b : SemanticStore Expression) (cfg : CoreConfig),
-      Config.getEval (.block (.some verifyLabel) σ_v (.seq (.block (.some bodyLabel) σ_b cfg) postAsserts)) =
+  have h_wrapped_eval : ∀ (σ_v σ_b : SemanticStore Expression) (e_v e_b : SemanticEval Expression) (cfg : CoreConfig),
+      Config.getEval (.block (.some verifyLabel) σ_v e_v (.seq (.block (.some bodyLabel) σ_b e_b cfg) postAsserts)) =
       Config.getEval cfg := by
-    intro σ_v σ_b cfg; simp [Config.getEval, Config.getEnv]
+    intro σ_v σ_b e_v e_b cfg; simp [Config.getEval, Config.getEnv]
 
-  have h_wrapped_store : ∀ (σ_v σ_b : SemanticStore Expression) (cfg : CoreConfig),
-      Config.getStore (.block (.some verifyLabel) σ_v (.seq (.block (.some bodyLabel) σ_b cfg) postAsserts)) =
+  have h_wrapped_store : ∀ (σ_v σ_b : SemanticStore Expression) (e_v e_b : SemanticEval Expression) (cfg : CoreConfig),
+      Config.getStore (.block (.some verifyLabel) σ_v e_v (.seq (.block (.some bodyLabel) σ_b e_b cfg) postAsserts)) =
       Config.getStore cfg := by
-    intro σ_v σ_b cfg; simp [Config.getStore, Config.getEnv]
+    intro σ_v σ_b e_v e_b cfg; simp [Config.getStore, Config.getEnv]
 
   -- Unfold h_correct for easier application
   have h_correct' : ∀ (a : AssertId Expression) (ρ_init : Env Expression)
@@ -711,14 +730,14 @@ theorem procBodyVerify_procedureCorrect
   -- Unified helper: all asserts reachable from proc.body are valid
   have body_asserts_valid : ∀ ρ₀ (h_wf : Specification.ProcEnvWF proc ρ₀)
       (a : AssertId Expression) (cfg : CoreConfig),
-      CoreStepStar π φ (.stmts proc.body ρ₀) cfg →
+      CoreStepStar π φ (.stmts ss ρ₀) cfg →
       coreIsAtAssert cfg a →
       cfg.getEval cfg.getStore a.expr = some HasBool.tt := by
     intro ρ₀ h_wf a cfg h_body h_assert
     obtain ⟨ρ_init, h_vt⟩ := h_embed_body ρ₀ h_wf cfg h_body
     have h_v := h_correct' a ρ_init
-      (.block (.some verifyLabel) ρ_init.store (.seq (.block (.some bodyLabel) ρ₀.store cfg) postAsserts))
-      h_vt (h_wrapped_assert ρ_init.store ρ₀.store cfg a h_assert)
+      (.block (.some verifyLabel) ρ_init.store ρ_init.eval (.seq (.block (.some bodyLabel) ρ₀.store ρ₀.eval cfg) postAsserts))
+      h_vt (h_wrapped_assert ρ_init.store ρ₀.store ρ_init.eval ρ₀.eval cfg a h_assert)
     rw [h_wrapped_eval, h_wrapped_store] at h_v
     exact h_v
 
@@ -726,23 +745,25 @@ theorem procBodyVerify_procedureCorrect
 
   · ----- Part 1: All asserts in proc.body are valid -----
     intro a
-    unfold Specification.AssertValidInProcedure Specification.AssertValidWhen
+    unfold Specification.AssertValidInProcedure
+    rw [h_body_eq]
+    unfold Specification.AssertValidWhen
     simp only [Specification.Lang.core, Specification.Lang.imperative]
     intro ρ₀ cfg (h_wf : Specification.ProcEnvWF proc ρ₀)
       (h_body : StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ)
-        (.stmt (Stmt.block "" proc.body #[]) ρ₀) cfg)
+        (.stmt (Stmt.block "" ss #[]) ρ₀) cfg)
       (h_assert : coreIsAtAssert cfg a)
     -- Extract first step: .stmt (block "" body #[]) ρ₀ → .block (.some "") ρ₀.store (.stmts body ρ₀)
     have h_block_star : StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ)
-        (.block (.some "") ρ₀.store (.stmts proc.body ρ₀)) cfg := by
+        (.block (.some "") ρ₀.store ρ₀.eval (.stmts ss ρ₀)) cfg := by
       cases h_body with
       | refl => simp [coreIsAtAssert] at h_assert
       | step _ _ _ hstep hrest => cases hstep; exact hrest
     -- Body never exits (from WFProcedureProp.bodyExitsCovered)
     have h_no_exit : ∀ lbl ρ', ¬ StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ)
-        (.stmts proc.body ρ₀) (.exiting lbl ρ') :=
-      block_exitsCoveredByBlocks_noEscape Expression (EvalCommand π φ) (EvalPureFunc φ)
-        proc.body h_wf_proc.bodyExitsCovered ρ₀
+        (.stmts ss ρ₀) (.exiting lbl ρ') :=
+      have hcov := h_wf_proc.bodyExitsCovered ss h_body_eq
+      block_exitsCoveredByBlocks_noEscape Expression (EvalCommand π φ) (EvalPureFunc φ) ss hcov ρ₀
     -- cfg is not terminal or exiting (has an assert)
     have h_nt : ∀ ρ', cfg ≠ .terminal ρ' := by
       intro ρ' heq; subst heq; exact coreIsAtAssert_not_terminal ρ' a h_assert
@@ -760,33 +781,72 @@ theorem procBodyVerify_procedureCorrect
     simpa [Config.getEval, Config.getStore] using h_valid
 
   · ----- Part 2: Postconditions + hasFailure on termination -----
-    intro h_wf_proc ρ₀ ρ' h_wf h_term
+    -- The unified field uses CoreBodyExec, which wraps the body in
+    -- `Stmt.block "" ss #[]`.  Since procToVerifyStmt only succeeds for
+    -- structured bodies, we invert the CoreBodyExec to get a CoreStepStar
+    -- witness through that wrapping.
+    intro h_wf_proc ρ₀ h_wf σ' δ' failed h_body_exec
+    rw [h_body_eq] at h_body_exec
+    -- ProcEnvWF gives us ρ₀.hasFailure = false, so
+    -- ⟨ρ₀.store, ρ₀.eval, false⟩ = ρ₀.
+    have h_env_eq : (⟨ρ₀.store, ρ₀.eval, false⟩ : Env Expression) = ρ₀ := by
+      have := h_wf.noFailure; cases ρ₀; simp_all
+    obtain ⟨ρ', h_term_block, rfl, rfl, rfl⟩ : ∃ ρ' : Env Expression,
+        CoreStepStar π φ (.stmt (Stmt.block "" ss #[]) ρ₀) (.terminal ρ') ∧
+        σ' = ρ'.store ∧ δ' = ρ'.eval ∧ failed = ρ'.hasFailure := by
+      cases h_body_exec with
+      | structured h_step => exact ⟨_, h_env_eq ▸ h_step, rfl, rfl, rfl⟩
     obtain ⟨ρ_init, h_prefix⟩ := h_prefix_trace ρ₀ h_wf
+    -- Decompose the outer block-wrapped trace into the inner body trace.
+    -- h_term_block : CoreStepStar π φ (.stmt (Stmt.block "" body #[]) ρ₀) (.terminal ρ')
+    -- First step is step_block to .block (.some "") ρ₀.store ρ₀.eval (.stmts body ρ₀);
+    -- then block_reaches_terminal yields either an inner terminal or exiting.
+    have h_term_block' := CoreStepStar_to_StepStmtStar h_term_block
+    have h_block_star : StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ)
+        (.block (.some "") ρ₀.store ρ₀.eval (.stmts ss ρ₀)) (.terminal ρ') := by
+      cases h_term_block' with
+      | step _ _ _ hstep hrest => cases hstep; exact hrest
+    have h_no_exit : ∀ lbl ρ_x, ¬ StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ)
+        (.stmts ss ρ₀) (.exiting lbl ρ_x) :=
+      block_exitsCoveredByBlocks_noEscape Expression (EvalCommand π φ) (EvalPureFunc φ)
+        ss (h_wf_proc.bodyExitsCovered ss h_body_eq) ρ₀
+    have ⟨ρ_inner, h_term, h_ρ'_eq⟩ : ∃ ρ_inner,
+        StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ)
+          (.stmts ss ρ₀) (.terminal ρ_inner) ∧
+        ρ' = { ρ_inner with store := projectStore ρ₀.store ρ_inner.store, eval := ρ₀.eval } := by
+      match block_reaches_terminal Expression (EvalCommand π φ) (EvalPureFunc φ) h_block_star with
+      | .inl ⟨ρ_inner, hterm, heq⟩ => exact ⟨ρ_inner, hterm, heq⟩
+      | .inr ⟨lbl, ρ_x, hexit, _⟩ => exact absurd hexit (h_no_exit lbl ρ_x)
+    -- Convert the inner trace to CoreStepStar.
+    have h_term_inner : CoreStepStar π φ (.stmts ss ρ₀) (.terminal ρ_inner) :=
+      StepStmtStar_to_CoreStepStar h_term
     -- h_valid: all asserts in body from ρ₀ evaluate to true
     have h_valid : ∀ (a : AssertId Expression) (cfg : CoreConfig),
-        CoreStepStar π φ (.stmts proc.body ρ₀) cfg →
+        CoreStepStar π φ (.stmts ss ρ₀) cfg →
         coreIsAtAssert cfg a →
         cfg.getEval cfg.getStore a.expr = some HasBool.tt :=
       fun a cfg h h' => body_asserts_valid ρ₀ h_wf a cfg h h'
-    -- hasFailure = false
-    have h_nf' : ρ'.hasFailure = Bool.false :=
+    -- hasFailure = false on the inner env, hence on ρ' too.
+    have h_nf_inner : ρ_inner.hasFailure = Bool.false :=
       Core.core_noFailure_preserved π φ
-        (.stmts proc.body ρ₀) (.terminal ρ') h_valid h_wf.noFailure h_term
+        (.stmts ss ρ₀) (.terminal ρ_inner) h_valid h_wf.noFailure h_term_inner
+    have h_nf' : ρ'.hasFailure = Bool.false := by
+      rw [h_ρ'_eq]; exact h_nf_inner
     -- wfBool preservation
-    have h_wfb_term : WellFormedSemanticEvalBool ρ'.eval :=
-      Core.core_wfBool_preserved π φ h_wf_ext
-        (.stmts proc.body ρ₀) (.terminal ρ') h_wf.wfBool h_term
+    have h_wfb_term : WellFormedSemanticEvalBool ρ_inner.eval :=
+      Core.core_wfBool_preserved_stmts π φ h_wf_ext h_wf.wfBool h_term_inner
 
-    -- After the body block terminates via step_block_done, the store is projected.
-    -- We define the projected env.
-    let ρ_proj : Env Expression := { ρ' with store := projectStore ρ₀.store ρ'.store }
+    -- After the body block terminates via step_block_done, the store and eval are projected.
+    -- ρ_proj coincides with ρ' by h_ρ'_eq.
+    let ρ_proj : Env Expression := { ρ_inner with store := projectStore ρ₀.store ρ_inner.store, eval := ρ₀.eval }
+    have h_ρ_proj_eq : ρ_proj = ρ' := by simp [ρ_proj, h_ρ'_eq]
 
     have h_to_post : StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ)
-        (.stmt verifyStmt ρ_init) (.block (.some verifyLabel) ρ_init.store (.stmts postAsserts ρ_proj)) := by
+        (.stmt verifyStmt ρ_init) (.block (.some verifyLabel) ρ_init.store ρ_init.eval (.stmts postAsserts ρ_proj)) := by
       rw [h_eq]
       exact ReflTrans_Transitive _ _ _ _
         (step_block_enter Expression (EvalCommand π φ) (EvalPureFunc φ) verifyLabel _ #[] ρ_init)
-        (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some verifyLabel) ρ_init.store
+        (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some verifyLabel) ρ_init.store ρ_init.eval
           (ReflTrans_Transitive _ _ _ _
             (by rw [List.append_assoc]
                 exact stmts_prefix_terminal_append Expression (EvalCommand π φ) (EvalPureFunc φ)
@@ -797,41 +857,26 @@ theorem procBodyVerify_procedureCorrect
                 (seq_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ postAsserts
                   (ReflTrans_Transitive _ _ _ _
                     (step_block_enter Expression (EvalCommand π φ) (EvalPureFunc φ) bodyLabel _ #[] ρ₀)
-                    (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some bodyLabel) ρ₀.store
-                      (CoreStepStar_to_StepStmtStar h_term))))
+                    (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some bodyLabel) ρ₀.store ρ₀.eval
+                      h_term)))
                 (ReflTrans_Transitive _ _ _ _
                   (seq_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ postAsserts
                     (.step _ _ _ .step_block_done (.refl _)))
                   (.step _ _ _ .step_seq_done (.refl _)))))))
 
-    have h_proj_store_agree : ∀ x, (ρ₀.store x).isSome →
-        ρ_proj.store x = ρ'.store x := by
-      intro x hx
-      simp only [ρ_proj, projectStore]
-      simp [hx]
-
-    have h_proj_eval : ρ_proj.eval = ρ'.eval := rfl
-    have h_proj_hasFailure : ρ_proj.hasFailure = ρ'.hasFailure := rfl
-    have h_wfVar_term : WellFormedSemanticEvalVar ρ'.eval :=
-      Core.core_wfVar_preserved π φ h_wf_ext
-        (.stmts proc.body ρ₀) (.terminal ρ') h_wf.wfVar h_term
-    have h_wfCong_term : Core.WellFormedCoreEvalCong ρ'.eval :=
-      Core.core_wfCong_preserved π φ h_wf_ext
-        (.stmts proc.body ρ₀) (.terminal ρ') h_wf.wfCong h_term
-    have h_wfExprCongr_term : WellFormedSemanticEvalExprCongr ρ'.eval :=
-      Core.core_wfExprCongr_preserved π φ h_wf_ext
-        (.stmts proc.body ρ₀) (.terminal ρ') h_wf.wfExprCongr h_term
+    have h_proj_eval : ρ_proj.eval = ρ₀.eval := rfl
 
     have h_all_post_valid : ∀ s ∈ postAsserts, ∀ l e md,
-        s = Statement.assert l e md → ρ'.eval ρ'.store e = some HasBool.tt := by
+        s = Statement.assert l e md →
+        ρ_proj.eval ρ_proj.store e = some HasBool.tt := by
       suffices h_sfx :
           ∀ (sfx : List Statement),
             (∀ s ∈ sfx, ∃ l e md, s = Statement.assert l e md) →
             StepStmtStar Expression (EvalCommand π φ) (EvalPureFunc φ)
-              (.stmt verifyStmt ρ_init) (.block (.some verifyLabel) ρ_init.store (.stmts sfx ρ_proj)) →
+              (.stmt verifyStmt ρ_init) (.block (.some verifyLabel) ρ_init.store ρ_init.eval (.stmts sfx ρ_proj)) →
             ∀ s ∈ sfx, ∀ l e md,
               s = Statement.assert l e md →
-              ρ'.eval ρ'.store e = some HasBool.tt by
+              ρ_proj.eval ρ_proj.store e = some HasBool.tt by
         exact h_sfx postAsserts
           (fun s hs => ensuresToAsserts_mem_is_assert hs) h_to_post
       intro sfx h_all_assert h_trace
@@ -842,13 +887,11 @@ theorem procBodyVerify_procedureCorrect
         have ⟨lh, eh, mdh, h_hd_eq⟩ := h_all_assert hd (.head _)
         subst h_hd_eq
         have h_at_head : coreIsAtAssert
-            (.block (.some verifyLabel) ρ_init.store (.stmts (Statement.assert lh eh mdh :: tl) ρ_proj))
+            (.block (.some verifyLabel) ρ_init.store ρ_init.eval (.stmts (Statement.assert lh eh mdh :: tl) ρ_proj))
             ⟨lh, eh⟩ := by
           simp only [coreIsAtAssert]; exact ⟨trivial, trivial⟩
-        have h_head_eval_proj := h_correct' ⟨lh, eh⟩ ρ_init _ h_trace h_at_head
-        simp only [Config.getEval, Config.getStore] at h_head_eval_proj
-        have h_head_eval : ρ'.eval ρ'.store eh = some HasBool.tt :=
-          eval_projectStore_to_full h_head_eval_proj h_wfVar_term h_wfCong_term h_wfExprCongr_term
+        have h_head_eval := h_correct' ⟨lh, eh⟩ ρ_init _ h_trace h_at_head
+        simp only [Config.getEval, Config.getStore] at h_head_eval
         cases h_mem with
         | head _ =>
           injection h_s_eq with h1; injection h1 with h2
@@ -862,13 +905,14 @@ theorem procBodyVerify_procedureCorrect
               .step _ _ _
                 (.step_cmd (@EvalCommand.cmd_sem π φ ρ_proj.eval ρ_proj.store
                   (Cmd.assert lh eh mdh) ρ_proj.store false
-                  (EvalCmd.eval_assert_pass h_head_eval_proj (by rw [h_proj_eval]; exact h_wfb_term))))
+                  (EvalCmd.eval_assert_pass h_head_eval
+                    (by rw [h_proj_eval]; exact h_wf.wfBool))))
                 (.refl _)
             have h2 : (⟨ρ_proj.store, ρ_proj.eval, ρ_proj.hasFailure || false⟩ : Env Expression) = ρ_proj := by
-              cases ρ'; simp [ρ_proj, Bool.or_false]
+              cases ρ_inner; simp [ρ_proj, Bool.or_false]
             rw [h2] at h1; exact h1
           have h_trace_tl := ReflTrans_Transitive _ _ _ _ h_trace
-            (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some verifyLabel) ρ_init.store
+            (block_inner_star Expression (EvalCommand π φ) (EvalPureFunc φ) _ _ (.some verifyLabel) ρ_init.store ρ_init.eval
               (stmts_cons_step Expression (EvalCommand π φ) (EvalPureFunc φ)
                 (Statement.assert lh eh mdh) tl ρ_proj ρ_proj h_assert_step))
           exact ih (fun s' hs' => h_all_assert s' (.tail _ hs'))
@@ -880,7 +924,9 @@ theorem procBodyVerify_procedureCorrect
       have h_in : Statement.assert label check.expr check.md ∈ postAsserts := by
         simp only [postAsserts, ensuresToAsserts, List.mem_filterMap]
         exact ⟨(label, check), h_mem, by simp [h_attr]⟩
-      exact h_all_post_valid _ h_in label check.expr check.md rfl
+      have h := h_all_post_valid _ h_in label check.expr check.md rfl
+      rw [h_ρ_proj_eq] at h
+      exact h
     · exact h_nf'
 
 end ProcBodyVerifyCorrect
diff --git a/Strata/Transform/ProcedureInlining.lean b/Strata/Transform/ProcedureInlining.lean
index 9b60c7844f..864ba9a27d 100644
--- a/Strata/Transform/ProcedureInlining.lean
+++ b/Strata/Transform/ProcedureInlining.lean
@@ -25,14 +25,15 @@ inductive Stats where
 
 -- Gathers all labels including those in assert and assume.
 mutual
-def Block.labels (b : Block): List String :=
-  List.flatMap (fun s => Statement.labels s) b
+def Block.labelsOfBlocksAndAssertAssumes (b : Block): List String :=
+  List.flatMap (fun s => Statement.labelsOfBlocksAndAssertAssumes s) b
 
-def Statement.labels (s : Core.Statement) : List String :=
+def Statement.labelsOfBlocksAndAssertAssumes (s : Core.Statement) : List String :=
   match s with
-  | .block lbl b _ => lbl :: (Block.labels b)
-  | .ite _ thenb elseb _ => (Block.labels thenb) ++ (Block.labels elseb)
-  | .loop _ _ _ body _ => Block.labels body
+  | .block lbl b _ => lbl :: (Block.labelsOfBlocksAndAssertAssumes b)
+  | .ite _ thenb elseb _ =>
+    (Block.labelsOfBlocksAndAssertAssumes thenb) ++ (Block.labelsOfBlocksAndAssertAssumes elseb)
+  | .loop _ _ _ body _ => Block.labelsOfBlocksAndAssertAssumes body
   | .assume lbl _ _ => [lbl]
   | .assert lbl _ _ => [lbl]
   | .cover lbl _ _ => [lbl]
@@ -44,23 +45,23 @@ def Statement.labels (s : Core.Statement) : List String :=
 end
 
 mutual
-def Block.replaceLabels (b : Block) (map:Map String String)
+def Block.replaceLabelsOfBlocksAndAssertAssumes (b : Block) (map:Map String String)
     : Block :=
-  b.map (fun s => Statement.replaceLabels s map)
+  b.map (fun s => Statement.replaceLabelsOfBlocksAndAssertAssumes s map)
 
-def Statement.replaceLabels
+def Statement.replaceLabelsOfBlocksAndAssertAssumes
     (s : Core.Statement) (map:Map String String) : Core.Statement :=
   let app (s:String) :=
     match Map.find? map s with
     | .none => s
     | .some s' => s'
   match s with
-  | .block lbl b m => .block (app lbl) (Block.replaceLabels b map) m
+  | .block lbl b m => .block (app lbl) (Block.replaceLabelsOfBlocksAndAssertAssumes b map) m
   | .exit lbl m => .exit (app lbl) m
   | .ite cond thenb elseb m =>
-    .ite cond (Block.replaceLabels thenb map) (Block.replaceLabels elseb map) m
+    .ite cond (Block.replaceLabelsOfBlocksAndAssertAssumes thenb map) (Block.replaceLabelsOfBlocksAndAssertAssumes elseb map) m
   | .loop g measure inv body m =>
-    .loop g measure inv (Block.replaceLabels body map) m
+    .loop g measure inv (Block.replaceLabelsOfBlocksAndAssertAssumes body map) m
   | .assume lbl e m => .assume (app lbl) e m
   | .assert lbl e m => .assert (app lbl) e m
   | .cover lbl e m => .cover (app lbl) e m
@@ -85,14 +86,17 @@ private def renameAllLocalNames (c:Procedure)
   let var_map: Map Expression.Ident Expression.Ident := []
   let proc_name := c.header.name.name
 
-  -- Make a map for renaming local variables
-  let lhs_vars := List.flatMap (fun (s:Statement) => s.definedVars) c.body
+  -- Extract local names from the body. Although ProcedureInlining only supports
+  -- structured bodies for inlining, extracting defined variables is a generic
+  -- facility that supports both structured and CFG bodies.
+  let bodyStmts : List Statement := match c.body with | .structured ss => ss | .cfg _ => []
+  let lhs_vars := List.flatMap (fun (s:Statement) => s.definedVars false) bodyStmts
   let lhs_vars := lhs_vars ++ c.header.inputs.unzip.fst ++
                   c.header.outputs.unzip.fst
   let var_map <- genOldToFreshIdMappings lhs_vars var_map proc_name
 
   -- Make a map for renaming label names
-  let labels := List.flatMap (fun s => Statement.labels s) c.body
+  let labels := List.flatMap (fun s => Statement.labelsOfBlocksAndAssertAssumes s) bodyStmts
   -- Reuse genOldToFreshIdMappings by introducing dummy data to Identifier
   let label_ids:List Expression.Ident := labels.map
       (fun s => { name:=s, metadata := () })
@@ -104,12 +108,17 @@ private def renameAllLocalNames (c:Procedure)
   -- by genOldToFreshIdMappings (counter-based), so a fresh new_id cannot collide with
   -- a later old_id. The iteration is intentionally sequential because each step also
   -- renames LHS variables and labels.
-  let new_body := List.map (fun (s0:Statement) =>
-    var_map.foldl (fun (s:Statement) (old_id,new_id) =>
-        let s := Statement.substFvar s old_id (.fvar () new_id .none)
-        let s := Statement.renameLhs s old_id new_id
-        Statement.replaceLabels s label_map)
-      s0) c.body
+  let new_body : Procedure.Body ← match c.body with
+    | .structured bodyStmts =>
+      pure <| .structured (List.map (fun (s0:Statement) =>
+        var_map.foldl (fun (s:Statement) (old_id,new_id) =>
+            let s := Statement.substFvar s old_id (.fvar () new_id .none)
+            let s := Statement.renameLhs s old_id new_id
+            Statement.replaceLabelsOfBlocksAndAssertAssumes s label_map)
+          s0) bodyStmts)
+    | .cfg _ =>
+      throw (Strata.DiagnosticModel.fromMessage
+        "renameAllLocalNames: CFG body renaming not yet implemented")
   let new_header := { c.header with
     inputs := c.header.inputs.map (fun (id,ty) =>
       match var_map.find? id with
@@ -241,7 +250,10 @@ def inlineCallCmd
         -- Declare each renamed output parameter with a nondet init.
         -- No havoc is needed since nondet already gives an
         -- unconstrained value.
-        let outputTrips ← genOutExprIdentsTrip sigOutputs sigOutputs.unzip.fst
+        -- Skip inout parameters (those already in inputs) to avoid double-init.
+        let inputNames := sigInputs.unzip.fst.map (·.name)
+        let sigOutputOnly := sigOutputs.filter fun (id, _) => !inputNames.contains id.name
+        let outputTrips ← genOutExprIdentsTrip sigOutputOnly sigOutputOnly.unzip.fst
         let outputInits := outputTrips.map (fun ((_, ty), orgvar) =>
           Statement.init orgvar ty .nondet md)
         -- Create a var statement for each procedure input arguments.
@@ -258,9 +270,17 @@ def inlineCallCmd
               Statement.set lhs_var (.fvar () out_var (.none)) md)
             outs_lhs_and_sig
 
+        -- Cannot inline unstructured (CFG) bodies into structured code.
+        -- CFG-level inlining is a separate, more complex pass that operates
+        -- entirely in the CFG domain (graph splicing).
+        let procBodyStmts ← match proc.body with
+        | .cfg _ => throw (Strata.DiagnosticModel.fromMessage
+            "cannot inline procedure with CFG body into structured code")
+        | .structured ss => pure ss
+
         let stmts:List (Imperative.Stmt Core.Expression Core.Command)
           := inputInits ++ outputInits
-             ++ Block.setCallSiteMetadata proc.body md
+             ++ Block.setCallSiteMetadata procBodyStmts md
              ++ outputSetStmts
 
         -- Update CallGraph if available
diff --git a/Strata/Transform/Specification.lean b/Strata/Transform/Specification.lean
index 370fa650b3..57c225199a 100644
--- a/Strata/Transform/Specification.lean
+++ b/Strata/Transform/Specification.lean
@@ -7,7 +7,6 @@ module
 
 public import Strata.DL.Imperative.StmtSemantics
 import all Strata.DL.Imperative.CmdSemantics
-import Strata.DL.Util.ListUtils
 
 /-! # Soundness Specification
 
@@ -78,7 +77,7 @@ namespace Specification
 
 /-- Bundles the abstract ingredients for small-step statement semantics,
     parameterized by a shared pure-expression system `P`. -/
-structure Lang (P : PureExpr) [HasFvar P] [HasBool P] [HasNot P] where
+structure Lang (P : PureExpr) where
   /-- Statement type. -/
   StmtT : Type
   /-- Configuration type. -/
@@ -98,19 +97,19 @@ structure Lang (P : PureExpr) [HasFvar P] [HasBool P] [HasNot P] where
 
 /-- Build a `Lang` from `Imperative.Stmt`/`Config` with a given command
     type and evaluator. -/
-abbrev Lang.imperative (P : PureExpr) [HasFvar P] [HasBool P] [HasNot P]
+abbrev Lang.imperative (P : PureExpr) [HasFvar P] [HasBool P] [HasBoolOps P] [HasFvars P]
     (CmdT : Type) (evalCmd : EvalCmdParam P CmdT) (extendEval : ExtendEval P)
     (isAtAssert : Config P CmdT → AssertId P → Prop) : Lang P :=
   ⟨Stmt P CmdT, Config P CmdT, StepStmtStar P evalCmd extendEval,
    .stmt, .terminal, .exiting, isAtAssert, Config.getEnv⟩
 
 /-- The standard `Lang` for `Cmd P` / `EvalCmd P` / `isAtAssert`. -/
-abbrev Lang.standard (P : PureExpr) [HasFvar P] [HasBool P] [HasNot P]
+abbrev Lang.standard (P : PureExpr) [HasFvar P] [HasBool P] [HasBoolOps P] [HasFvars P]
     (extendEval : ExtendEval P) : Lang P :=
   Lang.imperative P (Cmd P) (EvalCmd P) extendEval (Imperative.isAtAssert P)
 
 
-variable {P : PureExpr} [HasFvar P] [HasBool P] [HasNot P] [HasVal P]
+variable {P : PureExpr} [HasFvar P] [HasBool P] [HasBoolOps P] [HasFvars P] [HasInt P] [HasVal P]
 variable (L : Lang P)
 
 
@@ -177,27 +176,7 @@ def Triple
     L.star (L.stmtCfg s ρ₀) (L.terminalCfg ρ') →
     Post ρ' ∧ ρ'.hasFailure = false
 
-/-! ## Parametric Hoare rules -/
-
-omit [HasVal P] in
-/-- False precondition proves anything -/
-theorem false_pre (s : L.StmtT) (Post : Env P → Prop) :
-    Triple L (fun _ => False) s Post := by
-  intro _ _ hpre; exact absurd hpre id
-
-omit [HasVal P] in
-/-- Consequence (weakening): strengthen precondition, weaken postconditions. -/
-theorem consequence
-    {Pre Pre' : Env P → Prop} {Post Post' : Env P → Prop} {s : L.StmtT}
-    (h : Triple L Pre s Post)
-    (hpre : ∀ ρ, Pre' ρ → Pre ρ) (hpost : ∀ ρ, Post ρ → Post' ρ) :
-    Triple L Pre' s Post' := by
-  intro ρ₀ ρ' hpre' hwfb hf₀ hstar
-  have ⟨hp, hf⟩ := h ρ₀ ρ' (hpre ρ₀ hpre') hwfb hf₀ hstar
-  exact ⟨hpost ρ' hp, hf⟩
-
-
-/-! ## Structural Hoare rules (Imperative-specific) -/
+/-! ## Definitions for structural Hoare rules (Imperative-specific) -/
 
 section StmtRules
 
@@ -216,166 +195,24 @@ def TripleBlock
      ∃ lbl, StepStmtStar P evalCmd extendEval (.stmts ss ρ₀) (.exiting lbl ρ')) →
     Post ρ' ∧ ρ'.hasFailure = false
 
- omit [HasFvar P] [HasVal P] in
-/-- Empty statement list is skip. -/
-theorem skip_block (Pre : Env P → Prop) :
-    TripleBlock evalCmd extendEval Pre [] Pre := by
-  intro ρ₀ ρ' hpre _ hf₀ hstar
-  match hstar with
-  | .inl hterm =>
-    cases hterm with
-    | step _ _ _ h1 r1 => cases h1 with
-      | step_stmts_nil => cases r1 with
-        | refl => exact ⟨hpre, hf₀⟩
-        | step _ _ _ h _ => exact nomatch h
-  | .inr ⟨_, hexit⟩ =>
-    cases hexit with
-    | step _ _ _ h _ => cases h with
-      | step_stmts_nil => rename_i r; cases r with | step _ _ _ h _ => cases h
-
-omit [HasVal P] in
-/-- A single command. -/
-theorem cmd (c : CmdT) (Pre Post : Env P → Prop)
-    (h : ∀ ρ₀ σ' f, Pre ρ₀ → WellFormedSemanticEvalBool ρ₀.eval → ρ₀.hasFailure = false →
-      evalCmd ρ₀.eval ρ₀.store c σ' f →
-      Post { ρ₀ with store := σ', hasFailure := f } ∧ f = false) :
-    Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre (.cmd c) Post := by
-  intro ρ₀ ρ' hpre hwfb hf₀ hstar
-  cases hstar with
-  | step _ _ _ h1 r1 => cases h1 with
-    | step_cmd hcmd =>
-      cases r1 with
-      | refl =>
-        have ⟨hp, hfeq⟩ := h ρ₀ _ _ hpre hwfb hf₀ hcmd
-        simp [hf₀] at hp ⊢; exact ⟨hp, hfeq⟩
-      | step _ _ _ h _ => exact nomatch h
-
 omit [HasVal P] in
-/-- Sequential cons. -/
-theorem seq_cons {s : Stmt P CmdT} {ss : List (Stmt P CmdT)}
-    {Pre Mid Post : Env P → Prop}
-    (h₁ : Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre s Mid)
-    (h₂ : TripleBlock evalCmd extendEval Mid ss Post)
-    (hnofd : Stmt.noFuncDecl s = true)
-    (hnoesc : Stmt.exitsCoveredByBlocks [] s) :
-    TripleBlock evalCmd extendEval Pre (s :: ss) Post := by
-  intro ρ₀ ρ' hpre hwfb hf₀ hdone
-  have hwfb_preserved : ∀ ρ₁, StepStmtStar P evalCmd extendEval (.stmt s ρ₀) (.terminal ρ₁) →
-      WellFormedSemanticEvalBool ρ₁.eval := by
-    intro ρ₁ hterm
-    have this := smallStep_noFuncDecl_preserves_eval P evalCmd extendEval s ρ₀ ρ₁ hnofd hterm
-    rw [this]; exact hwfb
-  match hdone with
-  | .inl hterm =>
-    cases hterm with
-    | step _ _ _ hstep hrest => cases hstep with
-      | step_stmts_cons =>
-        have ⟨ρ₁, hterm_s, hrest_ss⟩ := seq_reaches_terminal P evalCmd extendEval hrest
-        have ⟨hmid, hf₁⟩ := h₁ ρ₀ ρ₁ hpre hwfb hf₀ hterm_s
-        exact h₂ ρ₁ ρ' hmid (hwfb_preserved ρ₁ hterm_s) hf₁ (.inl hrest_ss)
-  | .inr ⟨lbl, hexit⟩ =>
-    cases hexit with
-    | step _ _ _ hstep hrest => cases hstep with
-      | step_stmts_cons =>
-        match seq_reaches_exiting P evalCmd extendEval hrest with
-        | .inl hexit_inner =>
-          exact absurd hexit_inner
-            (exitsCoveredByBlocks_noEscape P evalCmd extendEval s hnoesc ρ₀ lbl ρ')
-        | .inr ⟨ρ₁, hterm_s, hexit_ss⟩ =>
-          have ⟨hmid, hf₁⟩ := h₁ ρ₀ ρ₁ hpre hwfb hf₀ hterm_s
-          exact h₂ ρ₁ ρ' hmid (hwfb_preserved ρ₁ hterm_s) hf₁ (.inr ⟨lbl, hexit_ss⟩)
-
-omit [HasVal P] in
-/-- A postcondition is well-formed if it is stable under `projectStore`. -/
+/-- A postcondition is well-formed if it is stable under `projectStore` and
+    `eval`-replacement by any parent eval that the inner `ρ.eval` extends. -/
 def PostWF (Post : Env P → Prop) : Prop :=
-  ∀ ρ σ_parent, Post ρ → ρ.hasFailure = false →
-    Post { ρ with store := projectStore σ_parent ρ.store } ∧
-      ({ ρ with store := projectStore σ_parent ρ.store } : Env P).hasFailure = false
-
-omit [HasVal P] in
-/-- Lift a `TripleBlock` to a `Triple` by wrapping in a block.
-    The postcondition `Post` is required to be stable under `projectStore`
-    (it only references variables defined before the block). -/
-theorem TripleBlock.toTriple {ss : List (Stmt P CmdT)} {l : String} {md : MetaData P}
-    {Pre Post : Env P → Prop}
-    (h : TripleBlock evalCmd extendEval Pre ss Post)
-    (hpost_proj : PostWF Post) :
-    Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre (.block l ss md) Post := by
-  intro ρ₀ ρ' hpre hwfb hf₀ hstar
-  cases hstar with
-  | step _ _ _ hstep hrest => cases hstep with
-    | step_block =>
-      match block_reaches_terminal P evalCmd extendEval hrest with
-      | .inl ⟨ρ_inner, hterm, heq⟩ =>
-        have ⟨hpost, hf⟩ := h ρ₀ ρ_inner hpre hwfb hf₀ (.inl hterm)
-        subst heq; exact hpost_proj ρ_inner _ hpost hf
-      | .inr ⟨lbl, ρ_inner, hexit, heq⟩ =>
-        have ⟨hpost, hf⟩ := h ρ₀ ρ_inner hpre hwfb hf₀ (.inr ⟨lbl, hexit⟩)
-        subst heq; exact hpost_proj ρ_inner _ hpost hf
-
-omit [HasVal P] in
-/-- Lift a `Triple` to a `TripleBlock` for a singleton list. -/
-theorem Triple.toTripleBlock {s : Stmt P CmdT}
-    {Pre Post : Env P → Prop}
-    (h : Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre s Post)
-    (hnoesc : Stmt.exitsCoveredByBlocks [] s) :
-    TripleBlock evalCmd extendEval Pre [s] Post := by
-  intro ρ₀ ρ' hpre hwfb hf₀ hdone
-  match hdone with
-  | .inl hterm =>
-    cases hterm with
-    | step _ _ _ hstep hrest => cases hstep with
-      | step_stmts_cons =>
-        have ⟨ρ₁, hterm_s, hrest_nil⟩ := seq_reaches_terminal P evalCmd extendEval hrest
-        have ⟨hp, hf⟩ := h ρ₀ ρ₁ hpre hwfb hf₀ hterm_s
-        cases hrest_nil with
-        | step _ _ _ h1 r1 => cases h1 with
-          | step_stmts_nil => cases r1 with
-            | refl => exact ⟨hp, hf⟩
-            | step _ _ _ h _ => exact nomatch h
-  | .inr ⟨lbl, hexit⟩ =>
-    cases hexit with
-    | step _ _ _ hstep hrest => cases hstep with
-      | step_stmts_cons =>
-        match seq_reaches_exiting P evalCmd extendEval hrest with
-        | .inl hexit_s =>
-          exact absurd hexit_s
-            (exitsCoveredByBlocks_noEscape P evalCmd extendEval s hnoesc ρ₀ lbl ρ')
-        | .inr ⟨ρ₁, hterm_s, hexit_nil⟩ =>
-          cases hexit_nil with
-          | step _ _ _ h _ => cases h with
-            | step_stmts_nil => rename_i r; cases r with | step _ _ _ h _ => cases h
-
-omit [HasVal P] in
-/-- Empty block is skip. -/
-theorem skip (l : String) (md : MetaData P) (Pre : Env P → Prop)
-    (hpre_proj : PostWF Pre) :
-    Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre (.block l [] md) Pre :=
-  TripleBlock.toTriple evalCmd extendEval isAtAssertFn (skip_block evalCmd extendEval Pre) hpre_proj
-
-omit [HasVal P] in
-/-- If-then-else rule. -/
-theorem ite {c : P.Expr} {tss ess : List (Stmt P CmdT)} {md : MetaData P}
-    {Pre Post : Env P → Prop}
-    (ht : TripleBlock evalCmd extendEval (fun ρ => Pre ρ ∧ ρ.eval ρ.store c = some HasBool.tt) tss Post)
-    (he : TripleBlock evalCmd extendEval (fun ρ => Pre ρ ∧ ρ.eval ρ.store c = some HasBool.ff) ess Post) :
-    Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre (.ite (.det c) tss ess md) Post := by
-  intro ρ₀ ρ' hpre hwfb hf₀ hstar
-  cases hstar with
-  | step _ _ _ h1 r1 => cases h1 with
-    | step_ite_true hc _ => exact ht ρ₀ ρ' ⟨hpre, hc⟩ hwfb hf₀ (.inl r1)
-    | step_ite_false hc _ => exact he ρ₀ ρ' ⟨hpre, hc⟩ hwfb hf₀ (.inl r1)
-
-/- TODO: the WHILE rule -/
+  ∀ ρ σ_parent e_parent,
+    EvalExtensionOf extendEval e_parent ρ.eval →
+    Post ρ → ρ.hasFailure = false →
+    Post { ρ with store := projectStore σ_parent ρ.store, eval := e_parent } ∧
+      ({ ρ with store := projectStore σ_parent ρ.store, eval := e_parent } : Env P).hasFailure = false
 
 end StmtRules
 
 
-/-! ## Connection between HoareTriple and AssertValid (standard Lang) -/
+/-! ## Definitions for connection between HoareTriple and AssertValid (standard Lang) -/
 
 section StandardConnection
 
-variable (P' : PureExpr) [HasFvar P'] [HasBool P'] [HasNot P']
+variable (P' : PureExpr) [HasFvar P'] [HasBool P'] [HasBoolOps P'] [HasFvars P'] [HasInt P'] [HasIntOps P']
 variable (extendEval : ExtendEval P')
 
 /-- The composite statement `assume pre; st; assert post` wrapped in a block. -/
@@ -388,158 +225,6 @@ def PredicatedStmt
     [.cmd (.assume pre_label pre_expr pre_md), st, .cmd (.assert post_label post_expr post_md)]
     block_md
 
-/-- **Direction 1**: Hoare triple implies assert validity for `PredicatedStmt`. -/
-theorem hoareTriple_implies_assertValid
-    (pre_label : String) (pre_expr : P'.Expr) (pre_md : MetaData P')
-    (st : Stmt P' (Cmd P'))
-    (post_label : String) (post_expr : P'.Expr) (post_md : MetaData P')
-    (block_label : String) (block_md : MetaData P')
-    (hoare : Triple (Lang.standard P' extendEval)
-      (fun ρ => ρ.eval ρ.store pre_expr = some HasBool.tt)
-      st
-      (fun ρ => ρ.eval ρ.store post_expr = some HasBool.tt))
-    (hno : st.noMatchingAssert post_label) :
-    AssertValid (Lang.standard P' extendEval)
-      (PredicatedStmt P' pre_label pre_expr pre_md st post_label post_expr post_md block_label block_md)
-      ⟨post_label, post_expr⟩ := by
-  intro ρ₀ cfg _ hreach hat
-  have hno_match := noMatchingAssert_implies_no_reachable_assert P' extendEval st post_label post_expr hno
-  unfold PredicatedStmt at hreach
-  cases hreach with
-  | refl => exact absurd hat (by simp [isAtAssert])
-  | step _ _ _ hstep hrest =>
-    cases hstep with
-    | step_block =>
-      have ⟨inner, heq_cfg, hinner_star, hat_inner⟩ :=
-        block_isAtAssert_inner P' extendEval _ _ _ _ _ hrest hat
-      subst heq_cfg
-      cases hinner_star with
-      | refl => exact absurd hat_inner (by simp [isAtAssert])
-      | step _ _ _ hstep2 hrest2 =>
-        cases hstep2 with
-        | step_stmts_cons =>
-          match seq_isAtAssert_cases P' extendEval _ _ _ _ hrest2 hat_inner with
-          | .inl ⟨_, _, hreach_assume, hat_assume⟩ =>
-            cases hreach_assume with
-            | refl => exact absurd hat_assume (by simp [isAtAssert])
-            | step _ _ _ h _ => cases h with
-              | step_cmd => rename_i hr; cases hr with
-                | refl => exact absurd hat_assume (by simp [isAtAssert])
-                | step _ _ _ h _ => exact absurd h (by intro h; cases h)
-          | .inr ⟨ρ₁, hterm_assume, hrest_stmts, hat_stmts⟩ =>
-            cases hrest_stmts with
-            | refl =>
-              have : ¬ isAtAssert P' (.stmts (st :: [.cmd (.assert post_label post_expr post_md)]) ρ₁)
-                  ⟨post_label, post_expr⟩ := by
-                intro h_at
-                match st with
-                | .cmd (.assert l e md') =>
-                  have h := hno_match ρ₁ (.stmt (.cmd (.assert l e md')) ρ₁) (.refl _)
-                  simp [isAtAssert] at h h_at
-                  exact h h_at.1 h_at.2
-                | .loop _ _ inv _ _ =>
-                  -- loop's isAtAssert: ∃ e, (post_label, e) ∈ inv ∧ post_expr = e
-                  have h := hno_match ρ₁ (.stmt (.loop _ _ inv _ _) ρ₁) (.refl _)
-                  exact h h_at
-                | .cmd (.init ..) | .cmd (.set ..) | .cmd (.assume ..)
-                | .cmd (.cover ..) | .block .. | .ite .. | .exit .. | .funcDecl ..
-                | .typeDecl .. =>
-                  simp [isAtAssert] at h_at
-              exact absurd hat_stmts this
-            | step _ _ _ hstep3 hrest3 =>
-              cases hstep3 with
-              | step_stmts_cons =>
-                match seq_isAtAssert_cases P' extendEval _ _ _ _ hrest3 hat_stmts with
-                | .inl ⟨_, _, hreach_st, hat_st⟩ =>
-                  exact absurd hat_st (hno_match ρ₁ _ hreach_st)
-                | .inr ⟨ρ', hterm_st, hrest_assert, hat_assert⟩ =>
-                  cases hterm_assume with
-                  | step _ _ _ h_assume_step h_assume_rest =>
-                    cases h_assume_step with
-                    | step_cmd hcmd =>
-                      cases hcmd with
-                      | eval_assume hpre hwfb =>
-                        cases h_assume_rest with
-                        | refl =>
-                          have ⟨ρ'_clean, hterm_clean, hs_eq, he_eq⟩ :=
-                            smallStep_hasFailure_irrel P' (EvalCmd P') extendEval
-                              st _ ρ' hterm_st { ρ₀ with hasFailure := false } rfl rfl
-                          have ⟨hpost, _⟩ := hoare { ρ₀ with hasFailure := false } ρ'_clean
-                            hpre hwfb rfl hterm_clean
-                          simp only [hs_eq, he_eq] at hpost
-                          have ⟨he, hs⟩ := assert_tail_getEvalStore P' extendEval
-                            ρ' post_label post_expr post_md inner ⟨post_label, post_expr⟩
-                            hrest_assert hat_inner
-                          dsimp [Config.getEval, Config.getStore, Config.getEnv] at he hs ⊢
-                          rw [he, hs]; exact hpost
-                        | step _ _ _ h _ => exact absurd h (by intro h; cases h)
-
-
-/-- **Direction 2**: Assert validity for `PredicatedStmt` implies Hoare triple. -/
-theorem allAssertsValid_implies_hoareTriple
-    (pre_label : String) (pre_expr : P'.Expr) (pre_md : MetaData P')
-    (st : Stmt P' (Cmd P'))
-    (post_label : String) (post_expr : P'.Expr) (post_md : MetaData P')
-    (block_label : String) (block_md : MetaData P')
-    (hvalid : AllAssertsValid (Lang.standard P' extendEval)
-      (PredicatedStmt P' pre_label pre_expr pre_md st post_label post_expr post_md block_label block_md)) :
-    Triple (Lang.standard P' extendEval)
-      (fun ρ => ρ.eval ρ.store pre_expr = some HasBool.tt)
-      st
-      (fun ρ => ρ.eval ρ.store post_expr = some HasBool.tt) := by
-  intro ρ₀ ρ' hpre hwfb hf₀ hstar
-  let assume_stmt : Stmt P' (Cmd P') := .cmd (.assume pre_label pre_expr pre_md)
-  let assert_stmt : Stmt P' (Cmd P') := .cmd (.assert post_label post_expr post_md)
-  let body : List (Stmt P' (Cmd P')) := [assume_stmt, st, assert_stmt]
-  have hvalid_st : ∀ (a : AssertId P') (cfg : Config P' (Cmd P')),
-      StepStmtStar P' (EvalCmd P') extendEval (.stmt st ρ₀) cfg →
-      isAtAssert P' cfg a →
-      cfg.getEval cfg.getStore a.expr = some HasBool.tt := by
-    intro a cfg hstar_st hat
-    have h_assume : StepStmtStar P' (EvalCmd P') extendEval
-        (.stmt assume_stmt ρ₀) (.terminal { ρ₀ with store := ρ₀.store, hasFailure := ρ₀.hasFailure || false }) :=
-      .step _ _ _ (StepStmt.step_cmd (EvalCmd.eval_assume hpre hwfb)) (.refl _)
-    have h_ρ₁_eq : ({ store := ρ₀.store, eval := ρ₀.eval, hasFailure := ρ₀.hasFailure || false } : Env P') = ρ₀ := by
-      cases ρ₀; simp [Bool.or_false]
-    have h1 := stmts_cons_step P' (EvalCmd P') extendEval assume_stmt [st, assert_stmt] ρ₀ _ h_assume
-    rw [h_ρ₁_eq] at h1
-    have h2 : StepStmtStar P' (EvalCmd P') extendEval
-        (.stmts [st, assert_stmt] ρ₀) (.seq (.stmt st ρ₀) [assert_stmt]) :=
-      .step _ _ _ StepStmt.step_stmts_cons (.refl _)
-    have h3 := seq_inner_star P' (EvalCmd P') extendEval _ _ [assert_stmt] hstar_st
-    have h_inner := ReflTrans_Transitive _ _ _ _ (ReflTrans_Transitive _ _ _ _ h1 h2) h3
-    have h_block := block_inner_star P' (EvalCmd P') extendEval _ _ (.some block_label) ρ₀.store h_inner
-    have h_start : StepStmtStar P' (EvalCmd P') extendEval
-        (.stmt (.block block_label body block_md) ρ₀) (.block (.some block_label) ρ₀.store (.stmts body ρ₀)) :=
-      .step _ _ _ StepStmt.step_block (.refl _)
-    have h_full := ReflTrans_Transitive _ _ _ _ h_start h_block
-    have h_result := hvalid a ρ₀ _ trivial h_full hat
-    dsimp [Config.getEval, Config.getStore, Config.getEnv] at h_result ⊢
-    exact h_result
-  have h_assume : StepStmtStar P' (EvalCmd P') extendEval
-      (.stmt assume_stmt ρ₀) (.terminal { ρ₀ with store := ρ₀.store, hasFailure := ρ₀.hasFailure || false }) :=
-    .step _ _ _ (StepStmt.step_cmd (EvalCmd.eval_assume hpre hwfb)) (.refl _)
-  have h_ρ₁_eq : ({ store := ρ₀.store, eval := ρ₀.eval, hasFailure := ρ₀.hasFailure || false } : Env P') = ρ₀ := by
-    cases ρ₀; simp [Bool.or_false]
-  have h1 := stmts_cons_step P' (EvalCmd P') extendEval assume_stmt [st, assert_stmt] ρ₀ _ h_assume
-  rw [h_ρ₁_eq] at h1
-  have h2 := stmts_cons_step P' (EvalCmd P') extendEval st [assert_stmt] ρ₀ ρ' hstar
-  have h3 : StepStmtStar P' (EvalCmd P') extendEval
-      (.stmts [assert_stmt] ρ') (.seq (.stmt assert_stmt ρ') []) :=
-    .step _ _ _ StepStmt.step_stmts_cons (.refl _)
-  have h_inner := ReflTrans_Transitive _ _ _ _ (ReflTrans_Transitive _ _ _ _ h1 h2) h3
-  have h_block := block_inner_star P' (EvalCmd P') extendEval _ _ (.some block_label) ρ₀.store h_inner
-  have h_start : StepStmtStar P' (EvalCmd P') extendEval
-      (.stmt (.block block_label body block_md) ρ₀) (.block (.some block_label) ρ₀.store (.stmts body ρ₀)) :=
-    .step _ _ _ StepStmt.step_block (.refl _)
-  have h_full := ReflTrans_Transitive _ _ _ _ h_start h_block
-  have h_at : isAtAssert P' (.block (.some block_label) ρ₀.store (.seq (.stmt assert_stmt ρ') [])) ⟨post_label, post_expr⟩ := by
-    simp [isAtAssert, assert_stmt]
-  have h_result := hvalid ⟨post_label, post_expr⟩ ρ₀ _ trivial h_full h_at
-  dsimp [Config.getEval, Config.getStore, Config.getEnv] at h_result
-  exact ⟨h_result, allAssertsValid_preserves_noFailure P' extendEval
-    (ρ₀ := ρ₀) (ρ' := ρ') st hvalid_st hf₀ hstar⟩
-
 end StandardConnection
 
 end Hoare
@@ -553,35 +238,6 @@ def Sound (L₁ L₂ : Lang P) (T : L₁.StmtT → Option L₂.StmtT) : Prop :=
   ∀ (s : L₁.StmtT) (s' : L₂.StmtT) (a : AssertId P),
     T s = some s' → AssertValid L₂ s' a → AssertValid L₁ s a
 
-omit [HasVal P] in
-theorem sound_comp (L₁ L₂ L₃ : Lang P)
-    (T₁ : L₁.StmtT → Option L₂.StmtT) (T₂ : L₂.StmtT → Option L₃.StmtT)
-    (h₁ : Sound L₁ L₂ T₁) (h₂ : Sound L₂ L₃ T₂) :
-    Sound L₁ L₃ (fun s => T₁ s >>= T₂) := by
-  intro s s'' a hrun hvalid
-  simp [bind, Option.bind] at hrun
-  match h1 : T₁ s with
-  | some s' => rw [h1] at hrun; exact h₁ s s' a h1 (h₂ s' s'' a hrun hvalid)
-  | none => rw [h1] at hrun; exact absurd hrun (by nofun)
-
-omit [HasVal P] in
-theorem sound_assertValid (L₁ L₂ : Lang P)
-    (T : L₁.StmtT → Option L₂.StmtT) (a : AssertId P)
-    (s : L₁.StmtT) (s' : L₂.StmtT)
-    (ht : T s = some s') (hsound : Sound L₁ L₂ T) (hvalid : AssertValid L₂ s' a) :
-    AssertValid L₁ s a := hsound s s' a ht hvalid
-
-omit [HasVal P] in
-theorem sound_allAsserts (L₁ L₂ : Lang P)
-    (T : L₁.StmtT → Option L₂.StmtT)
-    (s : L₁.StmtT) (s' : L₂.StmtT) (ht : T s = some s')
-    (hsound : Sound L₁ L₂ T) (hvalid : AllAssertsValid L₂ s') :
-    AllAssertsValid L₁ s := fun a => hsound s s' a ht (hvalid a)
-
-omit [HasVal P] in
-theorem sound_id : Sound L L some := by
-  intro s s' a ht hvalid; simp at ht; subst ht; exact hvalid
-
 /-! ## Overapproximate predicate
 
 `Overapproximates L₁ L₂ T` says that any terminal or exiting env reachable
@@ -602,48 +258,7 @@ def Overapproximates (L₁ L₂ : Lang P) (T : L₁.StmtT → Option L₂.StmtT)
       (∀ lbl, L₁.star (L₁.stmtCfg st ρ₀) (L₁.exitingCfg lbl ρ') →
               L₂.star (L₂.stmtCfg s' ρ₀) (L₂.exitingCfg lbl ρ'))
 
-/-- If `T` overapproximates and a Hoare triple holds on `T(st)` in L₂,
-    then the triple holds on `st` in L₁. -/
-theorem overapproximates_triple (L₁ L₂ : Lang P)
-    (T : L₁.StmtT → Option L₂.StmtT)
-    (st : L₁.StmtT) (s' : L₂.StmtT) (ht : T st = some s')
-    (hsem : Overapproximates L₁ L₂ T)
-    {Pre Post : Env P → Prop}
-    (htriple : Hoare.Triple L₂ Pre s' Post)
-    (hwfv : ∀ ρ₀ : Env P, Pre ρ₀ → WellFormedSemanticEvalVal ρ₀.eval) :
-    Hoare.Triple L₁ Pre st Post := by
-  intro ρ₀ ρ' hpre hwfb hf₀ hstar
-  exact htriple ρ₀ ρ' hpre hwfb hf₀
-    ((hsem st s' ht ρ₀ ρ' hwfb (hwfv ρ₀ hpre)).1 hstar)
-
-theorem overapproximates_id (L₁ : Lang P) :
-    Overapproximates L₁ L₁ some := by
-  intro st s' ht ρ₀ ρ' _ _
-  simp at ht; subst ht
-  exact ⟨id, fun _ => id⟩
-
-theorem overapproximates_comp (L₁ L₂ L₃ : Lang P)
-    (T₁ : L₁.StmtT → Option L₂.StmtT) (T₂ : L₂.StmtT → Option L₃.StmtT)
-    (h₁ : Overapproximates L₁ L₂ T₁)
-    (h₂ : Overapproximates L₂ L₃ T₂) :
-    Overapproximates L₁ L₃ (fun s => T₁ s >>= T₂) := by
-  intro st s'' ht ρ₀ ρ' hwfb hwfv
-  simp [bind, Option.bind] at ht
-  match h : T₁ st with
-  | some s' =>
-    rw [h] at ht
-    have hr₁ := h₁ st s' h ρ₀ ρ' hwfb hwfv
-    have hr₂ := h₂ s' s'' ht ρ₀ ρ' hwfb hwfv
-    refine ⟨?_, ?_⟩
-    · intro hstar; exact hr₂.1 (hr₁.1 hstar)
-    · intro lbl hstar; exact hr₂.2 lbl (hr₁.2 lbl hstar)
-  | none => rw [h] at ht; exact absurd ht (by nofun)
-
-/-! ## Statement-list overapproximation (Imperative-specific)
-
-Uses `Overapproximates L L T` (single-language): the proof decomposes
-seq execution into terminal/exiting outcomes of individual statements,
-which is exactly what `Overapproximates` provides. -/
+/-! ## Statement-list overapproximation (Imperative-specific) -/
 
 section ImperativeStmts
 
@@ -662,91 +277,6 @@ abbrev Lang.imperativeBlock : Lang P where
   isAtAssert := isAtAssertFn
   getEnv := Config.getEnv
 
-omit [HasFvar P] [HasBool P] [HasNot P] [HasVal P] in
-private theorem mapM_noFuncDecl
-    (T : Stmt P CmdT → Option (Stmt P CmdT))
-    (hnofd_T : ∀ s s', T s = some s' → Stmt.noFuncDecl s = true)
-    (ss : List (Stmt P CmdT)) (ss' : List (Stmt P CmdT))
-    (hmap : ss.mapM T = some ss') :
-    Block.noFuncDecl ss = true := by
-  induction ss generalizing ss' with
-  | nil => simp [Block.noFuncDecl]
-  | cons s rest ih =>
-    have ⟨s', rest', hs, hrm, hss'⟩ := List.mapM_cons_some hmap
-    simp [Block.noFuncDecl, hnofd_T s s' hs, ih rest' hrm]
-
-private theorem overapproximates_stmts_aux
-    (T : Stmt P CmdT → Option (Stmt P CmdT))
-    (hsem : Overapproximates (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) T)
-    (ss : List (Stmt P CmdT))
-    (hnofd : Block.noFuncDecl ss = true) :
-    ∀ (ss' : List (Stmt P CmdT)),
-      ss.mapM T = some ss' →
-      ∀ (ρ₀ ρ' : Env P),
-        WellFormedSemanticEvalBool ρ₀.eval →
-        WellFormedSemanticEvalVal ρ₀.eval →
-        (StepStmtStar P evalCmd extendEval (.stmts ss ρ₀) (.terminal ρ') →
-         StepStmtStar P evalCmd extendEval (.stmts ss' ρ₀) (.terminal ρ'))
-        ∧
-        (∀ lbl, StepStmtStar P evalCmd extendEval (.stmts ss ρ₀) (.exiting lbl ρ') →
-                StepStmtStar P evalCmd extendEval (.stmts ss' ρ₀) (.exiting lbl ρ')) := by
-  induction ss with
-  | nil =>
-    intro ss' hmap ρ₀ ρ' _ _
-    have : ss' = [] := by simp [List.mapM_nil] at hmap; exact hmap
-    subst this; exact ⟨id, fun _ => id⟩
-  | cons s rest ih =>
-    intro ss' hmap ρ₀ ρ' hwfb hwfv
-    simp [Block.noFuncDecl, Bool.and_eq_true] at hnofd
-    have ⟨hnofd_s, hnofd_rest⟩ := hnofd
-    have ⟨s', rest', hs, hrm, hss'⟩ := List.mapM_cons_some hmap
-    subst hss'
-    have eval_preserved : ∀ ρ₁ : Env P,
-        StepStmtStar P evalCmd extendEval (.stmt s ρ₀) (.terminal ρ₁) →
-        WellFormedSemanticEvalBool ρ₁.eval ∧ WellFormedSemanticEvalVal ρ₁.eval := by
-      intro ρ₁ hterm_s
-      have heq := smallStep_noFuncDecl_preserves_eval P evalCmd extendEval s ρ₀ ρ₁ hnofd_s hterm_s
-      exact ⟨heq ▸ hwfb, heq ▸ hwfv⟩
-    constructor
-    · intro hstar
-      cases hstar with
-      | step _ _ _ hstep hrest_exec => cases hstep with
-        | step_stmts_cons =>
-          have ⟨ρ₁, hterm_s, hterm_rest⟩ := seq_reaches_terminal P evalCmd extendEval hrest_exec
-          have ⟨hwfb₁, hwfv₁⟩ := eval_preserved ρ₁ hterm_s
-          exact ReflTrans_Transitive _ _ _ _
-            (stmts_cons_step P evalCmd extendEval s' rest' ρ₀ ρ₁
-              ((hsem s s' hs ρ₀ ρ₁ hwfb hwfv).1 hterm_s))
-            ((ih hnofd_rest rest' hrm ρ₁ ρ' hwfb₁ hwfv₁).1 hterm_rest)
-    · intro lbl hstar
-      cases hstar with
-      | step _ _ _ hstep hrest_exec => cases hstep with
-        | step_stmts_cons =>
-          match seq_reaches_exiting P evalCmd extendEval hrest_exec with
-          | .inl hexit_s =>
-            exact .step _ _ _ .step_stmts_cons
-              (ReflTrans_Transitive _ _ _ _ (seq_inner_star P evalCmd extendEval _ _ rest'
-                ((hsem s s' hs ρ₀ ρ' hwfb hwfv).2 lbl hexit_s))
-                (.step _ _ _ .step_seq_exit (.refl _)))
-          | .inr ⟨ρ₁, hterm_s, hexit_rest⟩ =>
-            have ⟨hwfb₁, hwfv₁⟩ := eval_preserved ρ₁ hterm_s
-            exact ReflTrans_Transitive _ _ _ _
-              (stmts_cons_step P evalCmd extendEval s' rest' ρ₀ ρ₁
-                ((hsem s s' hs ρ₀ ρ₁ hwfb hwfv).1 hterm_s))
-              ((ih hnofd_rest rest' hrm ρ₁ ρ' hwfb₁ hwfv₁).2 lbl hexit_rest)
-
-theorem overapproximates_stmts
-    (T : Stmt P CmdT → Option (Stmt P CmdT))
-    (hsem : Overapproximates (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) T)
-    (hnofd_T : ∀ s s', T s = some s' → Stmt.noFuncDecl s = true) :
-    Overapproximates
-      (Lang.imperativeBlock evalCmd extendEval isAtAssertFn)
-      (Lang.imperativeBlock evalCmd extendEval isAtAssertFn)
-      (fun ss => ss.mapM T) := by
-  intro ss ss' hmap ρ₀ ρ' hwfb hwfv
-  exact overapproximates_stmts_aux evalCmd extendEval isAtAssertFn T hsem ss
-    (mapM_noFuncDecl T hnofd_T ss ss' hmap) ss' hmap ρ₀ ρ' hwfb hwfv
-
 end ImperativeStmts
 
 end Transform
diff --git a/Strata/Transform/SpecificationProps.lean b/Strata/Transform/SpecificationProps.lean
new file mode 100644
index 0000000000..0b3e69faeb
--- /dev/null
+++ b/Strata/Transform/SpecificationProps.lean
@@ -0,0 +1,581 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+public import Strata.Transform.Specification
+import all Strata.Transform.Specification
+import all Strata.DL.Imperative.CmdSemantics
+import all Strata.DL.Imperative.CmdSemanticsProps
+import all Strata.DL.Imperative.StmtSemanticsProps
+import Strata.DL.Util.ListUtils
+
+/-! # Theorems for the Soundness Specification
+
+Theorems and proofs that complement the definitions in
+`Strata.Transform.Specification`. -/
+
+public section
+
+namespace Imperative
+
+namespace Specification
+
+variable {P : PureExpr} [HasFvar P] [HasFvars P] [HasOps P] [HasBool P] [HasBoolOps P] [HasVal P]
+variable (L : Lang P)
+
+namespace Hoare
+
+/-! ## Parametric Hoare rules -/
+
+omit [HasVal P] [HasOps P] [HasFvar P] [HasFvars P] in
+/-- False precondition proves anything -/
+theorem false_pre (s : L.StmtT) (Post : Env P → Prop) :
+    Triple L (fun _ => False) s Post := by
+  intro _ _ hpre; exact absurd hpre id
+
+omit [HasVal P] [HasOps P] [HasFvar P] [HasFvars P] in
+/-- Consequence (weakening): strengthen precondition, weaken postconditions. -/
+theorem consequence
+    {Pre Pre' : Env P → Prop} {Post Post' : Env P → Prop} {s : L.StmtT}
+    (h : Triple L Pre s Post)
+    (hpre : ∀ ρ, Pre' ρ → Pre ρ) (hpost : ∀ ρ, Post ρ → Post' ρ) :
+    Triple L Pre' s Post' := by
+  intro ρ₀ ρ' hpre' hwfb hf₀ hstar
+  have ⟨hp, hf⟩ := h ρ₀ ρ' (hpre ρ₀ hpre') hwfb hf₀ hstar
+  exact ⟨hpost ρ' hp, hf⟩
+
+
+/-! ## Structural Hoare rules (Imperative-specific) -/
+
+section StmtRules
+
+variable {CmdT : Type} (evalCmd : EvalCmdParam P CmdT) (extendEval : ExtendEval P)
+variable (isAtAssertFn : Config P CmdT → AssertId P → Prop)
+
+ omit [HasFvar P] [HasVal P] [HasOps P] [HasFvars P] in
+/-- Empty statement list is skip. -/
+theorem skip_block (Pre : Env P → Prop) :
+    TripleBlock evalCmd extendEval Pre [] Pre := by
+  intro ρ₀ ρ' hpre _ hf₀ hstar
+  match hstar with
+  | .inl hterm =>
+    cases hterm with
+    | step _ _ _ h1 r1 => cases h1 with
+      | step_stmts_nil => cases r1 with
+        | refl => exact ⟨hpre, hf₀⟩
+        | step _ _ _ h _ => exact nomatch h
+  | .inr ⟨_, hexit⟩ =>
+    cases hexit with
+    | step _ _ _ h _ => cases h with
+      | step_stmts_nil => rename_i r; cases r with | step _ _ _ h _ => cases h
+
+omit [HasVal P] [HasOps P] in
+/-- A single command. -/
+theorem cmd (c : CmdT) (Pre Post : Env P → Prop)
+    (h : ∀ ρ₀ σ' f, Pre ρ₀ → WellFormedSemanticEvalBool ρ₀.eval → ρ₀.hasFailure = false →
+      evalCmd ρ₀.eval ρ₀.store c σ' f →
+      Post { ρ₀ with store := σ', hasFailure := f } ∧ f = false) :
+    Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre (.cmd c) Post := by
+  intro ρ₀ ρ' hpre hwfb hf₀ hstar
+  cases hstar with
+  | step _ _ _ h1 r1 => cases h1 with
+    | step_cmd hcmd =>
+      cases r1 with
+      | refl =>
+        have ⟨hp, hfeq⟩ := h ρ₀ _ _ hpre hwfb hf₀ hcmd
+        simp [hf₀] at hp ⊢; exact ⟨hp, hfeq⟩
+      | step _ _ _ h _ => exact nomatch h
+
+omit [HasVal P] [HasOps P] in
+/-- Sequential cons. -/
+theorem seq_cons {s : Stmt P CmdT} {ss : List (Stmt P CmdT)}
+    {Pre Mid Post : Env P → Prop}
+    (h₁ : Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre s Mid)
+    (h₂ : TripleBlock evalCmd extendEval Mid ss Post)
+    (hnofd : Stmt.noFuncDecl s = true)
+    (hnoesc : Stmt.exitsCoveredByBlocks [] s) :
+    TripleBlock evalCmd extendEval Pre (s :: ss) Post := by
+  intro ρ₀ ρ' hpre hwfb hf₀ hdone
+  have hwfb_preserved : ∀ ρ₁, StepStmtStar P evalCmd extendEval (.stmt s ρ₀) (.terminal ρ₁) →
+      WellFormedSemanticEvalBool ρ₁.eval := by
+    intro ρ₁ hterm
+    have this := smallStep_noFuncDecl_preserves_eval P evalCmd extendEval s ρ₀ ρ₁ hnofd hterm
+    rw [this]; exact hwfb
+  match hdone with
+  | .inl hterm =>
+    cases hterm with
+    | step _ _ _ hstep hrest => cases hstep with
+      | step_stmts_cons =>
+        have ⟨ρ₁, hterm_s, hrest_ss⟩ := seq_reaches_terminal P evalCmd extendEval hrest
+        have ⟨hmid, hf₁⟩ := h₁ ρ₀ ρ₁ hpre hwfb hf₀ hterm_s
+        exact h₂ ρ₁ ρ' hmid (hwfb_preserved ρ₁ hterm_s) hf₁ (.inl hrest_ss)
+  | .inr ⟨lbl, hexit⟩ =>
+    cases hexit with
+    | step _ _ _ hstep hrest => cases hstep with
+      | step_stmts_cons =>
+        match seq_reaches_exiting P evalCmd extendEval hrest with
+        | .inl hexit_inner =>
+          exact absurd hexit_inner
+            (exitsCoveredByBlocks_noEscape P evalCmd extendEval s hnoesc ρ₀ lbl ρ')
+        | .inr ⟨ρ₁, hterm_s, hexit_ss⟩ =>
+          have ⟨hmid, hf₁⟩ := h₁ ρ₀ ρ₁ hpre hwfb hf₀ hterm_s
+          exact h₂ ρ₁ ρ' hmid (hwfb_preserved ρ₁ hterm_s) hf₁ (.inr ⟨lbl, hexit_ss⟩)
+
+omit [HasVal P] [HasOps P] in
+/-- Lift a `TripleBlock` to a `Triple` by wrapping in a block.
+    The postcondition `Post` is required to be stable under `projectStore`
+    (it only references variables defined before the block). -/
+theorem TripleBlock.toTriple {ss : List (Stmt P CmdT)} {l : String} {md : MetaData P}
+    {Pre Post : Env P → Prop}
+    (h : TripleBlock evalCmd extendEval Pre ss Post)
+    (hpost_proj : PostWF extendEval Post) :
+    Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre (.block l ss md) Post := by
+  intro ρ₀ ρ' hpre hwfb hf₀ hstar
+  cases hstar with
+  | step _ _ _ hstep hrest => cases hstep with
+    | step_block =>
+      -- At block entry the inner is `.stmts ss ρ₀` whose eval is `ρ₀.eval`,
+      -- which is exactly `e_parent`.  So `evalExtendsOf ρ₀.eval inner` is
+      -- reflexive, and `star_preserves_evalExtendsOf` lifts the inner trace.
+      have hinv₀ : Config.evalExtendsOf P extendEval ρ₀.eval (.stmts ss ρ₀) := by
+        simp only [Config.evalExtendsOf]; exact .refl
+      match block_reaches_terminal P evalCmd extendEval hrest with
+      | .inl ⟨ρ_inner, hterm, heq⟩ =>
+        have ⟨hpost, hf⟩ := h ρ₀ ρ_inner hpre hwfb hf₀ (.inl hterm)
+        have hext : EvalExtensionOf extendEval ρ₀.eval ρ_inner.eval :=
+          star_preserves_evalExtendsOf P evalCmd extendEval hinv₀ hterm
+        subst heq; exact hpost_proj ρ_inner _ _ hext hpost hf
+      | .inr ⟨lbl, ρ_inner, hexit, heq⟩ =>
+        have ⟨hpost, hf⟩ := h ρ₀ ρ_inner hpre hwfb hf₀ (.inr ⟨lbl, hexit⟩)
+        have hext : EvalExtensionOf extendEval ρ₀.eval ρ_inner.eval :=
+          star_preserves_evalExtendsOf P evalCmd extendEval hinv₀ hexit
+        subst heq; exact hpost_proj ρ_inner _ _ hext hpost hf
+
+omit [HasVal P] [HasOps P] in
+/-- Lift a `Triple` to a `TripleBlock` for a singleton list. -/
+theorem Triple.toTripleBlock {s : Stmt P CmdT}
+    {Pre Post : Env P → Prop}
+    (h : Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre s Post)
+    (hnoesc : Stmt.exitsCoveredByBlocks [] s) :
+    TripleBlock evalCmd extendEval Pre [s] Post := by
+  intro ρ₀ ρ' hpre hwfb hf₀ hdone
+  match hdone with
+  | .inl hterm =>
+    cases hterm with
+    | step _ _ _ hstep hrest => cases hstep with
+      | step_stmts_cons =>
+        have ⟨ρ₁, hterm_s, hrest_nil⟩ := seq_reaches_terminal P evalCmd extendEval hrest
+        have ⟨hp, hf⟩ := h ρ₀ ρ₁ hpre hwfb hf₀ hterm_s
+        cases hrest_nil with
+        | step _ _ _ h1 r1 => cases h1 with
+          | step_stmts_nil => cases r1 with
+            | refl => exact ⟨hp, hf⟩
+            | step _ _ _ h _ => exact nomatch h
+  | .inr ⟨lbl, hexit⟩ =>
+    cases hexit with
+    | step _ _ _ hstep hrest => cases hstep with
+      | step_stmts_cons =>
+        match seq_reaches_exiting P evalCmd extendEval hrest with
+        | .inl hexit_s =>
+          exact absurd hexit_s
+            (exitsCoveredByBlocks_noEscape P evalCmd extendEval s hnoesc ρ₀ lbl ρ')
+        | .inr ⟨ρ₁, hterm_s, hexit_nil⟩ =>
+          cases hexit_nil with
+          | step _ _ _ h _ => cases h with
+            | step_stmts_nil => rename_i r; cases r with | step _ _ _ h _ => cases h
+
+omit [HasVal P] [HasOps P] in
+/-- Empty block is skip. -/
+theorem skip (l : String) (md : MetaData P) (Pre : Env P → Prop)
+    (hpre_proj : PostWF extendEval Pre) :
+    Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre (.block l [] md) Pre :=
+  TripleBlock.toTriple evalCmd extendEval isAtAssertFn (skip_block evalCmd extendEval Pre) hpre_proj
+
+omit [HasVal P] [HasOps P] in
+/-- If-then-else rule. -/
+theorem ite {c : P.Expr} {tss ess : List (Stmt P CmdT)} {md : MetaData P}
+    {Pre Post : Env P → Prop}
+    (ht : TripleBlock evalCmd extendEval (fun ρ => Pre ρ ∧ ρ.eval ρ.store c = some HasBool.tt) tss Post)
+    (he : TripleBlock evalCmd extendEval (fun ρ => Pre ρ ∧ ρ.eval ρ.store c = some HasBool.ff) ess Post)
+    (hpost_proj : PostWF extendEval Post) :
+    Triple (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) Pre (.ite (.det c) tss ess md) Post := by
+  intro ρ₀ ρ' hpre hwfb hf₀ hstar
+  cases hstar with
+  | step _ _ _ h1 r1 => cases h1 with
+    | step_ite_true hc _ =>
+      have hinv₀ : Config.evalExtendsOf P extendEval ρ₀.eval (.stmts tss ρ₀) := by
+        simp only [Config.evalExtendsOf]; exact .refl
+      match block_reaches_terminal P evalCmd extendEval r1 with
+      | .inl ⟨ρ_inner, hterm, heq⟩ =>
+        have ⟨hpost, hf⟩ := ht ρ₀ ρ_inner ⟨hpre, hc⟩ hwfb hf₀ (.inl hterm)
+        have hext := star_preserves_evalExtendsOf P evalCmd extendEval hinv₀ hterm
+        subst heq; exact hpost_proj ρ_inner _ _ hext hpost hf
+      | .inr ⟨lbl, ρ_inner, hexit, heq⟩ =>
+        have ⟨hpost, hf⟩ := ht ρ₀ ρ_inner ⟨hpre, hc⟩ hwfb hf₀ (.inr ⟨lbl, hexit⟩)
+        have hext := star_preserves_evalExtendsOf P evalCmd extendEval hinv₀ hexit
+        subst heq; exact hpost_proj ρ_inner _ _ hext hpost hf
+    | step_ite_false hc _ =>
+      have hinv₀ : Config.evalExtendsOf P extendEval ρ₀.eval (.stmts ess ρ₀) := by
+        simp only [Config.evalExtendsOf]; exact .refl
+      match block_reaches_terminal P evalCmd extendEval r1 with
+      | .inl ⟨ρ_inner, hterm, heq⟩ =>
+        have ⟨hpost, hf⟩ := he ρ₀ ρ_inner ⟨hpre, hc⟩ hwfb hf₀ (.inl hterm)
+        have hext := star_preserves_evalExtendsOf P evalCmd extendEval hinv₀ hterm
+        subst heq; exact hpost_proj ρ_inner _ _ hext hpost hf
+      | .inr ⟨lbl, ρ_inner, hexit, heq⟩ =>
+        have ⟨hpost, hf⟩ := he ρ₀ ρ_inner ⟨hpre, hc⟩ hwfb hf₀ (.inr ⟨lbl, hexit⟩)
+        have hext := star_preserves_evalExtendsOf P evalCmd extendEval hinv₀ hexit
+        subst heq; exact hpost_proj ρ_inner _ _ hext hpost hf
+
+/- TODO: the WHILE rule -/
+
+end StmtRules
+
+
+/-! ## Connection between HoareTriple and AssertValid (standard Lang) -/
+
+section StandardConnection
+
+variable (P' : PureExpr) [HasFvar P'] [HasFvars P'] [HasOps P'] [HasBool P'] [HasBoolOps P']
+variable (extendEval : ExtendEval P')
+
+omit [HasOps P'] in
+/-- **Direction 1**: Hoare triple implies assert validity for `PredicatedStmt`. -/
+theorem hoareTriple_implies_assertValid
+    (pre_label : String) (pre_expr : P'.Expr) (pre_md : MetaData P')
+    (st : Stmt P' (Cmd P'))
+    (post_label : String) (post_expr : P'.Expr) (post_md : MetaData P')
+    (block_label : String) (block_md : MetaData P')
+    (hoare : Triple (Lang.standard P' extendEval)
+      (fun ρ => ρ.eval ρ.store pre_expr = some HasBool.tt)
+      st
+      (fun ρ => ρ.eval ρ.store post_expr = some HasBool.tt))
+    (hno : st.noMatchingAssert post_label) :
+    AssertValid (Lang.standard P' extendEval)
+      (PredicatedStmt P' pre_label pre_expr pre_md st post_label post_expr post_md block_label block_md)
+      ⟨post_label, post_expr⟩ := by
+  intro ρ₀ cfg _ hreach hat
+  have hno_match := noMatchingAssert_implies_no_reachable_assert P' extendEval st post_label post_expr hno
+  unfold PredicatedStmt at hreach
+  cases hreach with
+  | refl => exact absurd hat (by simp [isAtAssert])
+  | step _ _ _ hstep hrest =>
+    cases hstep with
+    | step_block =>
+      have ⟨inner, heq_cfg, hinner_star, hat_inner⟩ :=
+        block_isAtAssert_inner P' extendEval _ _ _ _ _ _ hrest hat
+      subst heq_cfg
+      cases hinner_star with
+      | refl => exact absurd hat_inner (by simp [isAtAssert])
+      | step _ _ _ hstep2 hrest2 =>
+        cases hstep2 with
+        | step_stmts_cons =>
+          match seq_isAtAssert_cases P' extendEval _ _ _ _ hrest2 hat_inner with
+          | .inl ⟨_, _, hreach_assume, hat_assume⟩ =>
+            cases hreach_assume with
+            | refl => exact absurd hat_assume (by simp [isAtAssert])
+            | step _ _ _ h _ => cases h with
+              | step_cmd => rename_i hr; cases hr with
+                | refl => exact absurd hat_assume (by simp [isAtAssert])
+                | step _ _ _ h _ => exact absurd h (by intro h; cases h)
+          | .inr ⟨ρ₁, hterm_assume, hrest_stmts, hat_stmts⟩ =>
+            cases hrest_stmts with
+            | refl =>
+              have : ¬ isAtAssert P' (.stmts (st :: [.cmd (.assert post_label post_expr post_md)]) ρ₁)
+                  ⟨post_label, post_expr⟩ := by
+                intro h_at
+                match st with
+                | .cmd (.assert l e md') =>
+                  have h := hno_match ρ₁ (.stmt (.cmd (.assert l e md')) ρ₁) (.refl _)
+                  simp [isAtAssert] at h h_at
+                  exact h h_at.1 h_at.2
+                | .loop _ _ inv _ _ =>
+                  -- loop's isAtAssert: ∃ e, (post_label, e) ∈ inv ∧ post_expr = e
+                  have h := hno_match ρ₁ (.stmt (.loop _ _ inv _ _) ρ₁) (.refl _)
+                  exact h h_at
+                | .cmd (.init ..) | .cmd (.set ..) | .cmd (.assume ..)
+                | .cmd (.cover ..) | .block .. | .ite .. | .exit .. | .funcDecl ..
+                | .typeDecl .. =>
+                  simp [isAtAssert] at h_at
+              exact absurd hat_stmts this
+            | step _ _ _ hstep3 hrest3 =>
+              cases hstep3 with
+              | step_stmts_cons =>
+                match seq_isAtAssert_cases P' extendEval _ _ _ _ hrest3 hat_stmts with
+                | .inl ⟨_, _, hreach_st, hat_st⟩ =>
+                  exact absurd hat_st (hno_match ρ₁ _ hreach_st)
+                | .inr ⟨ρ', hterm_st, hrest_assert, hat_assert⟩ =>
+                  cases hterm_assume with
+                  | step _ _ _ h_assume_step h_assume_rest =>
+                    cases h_assume_step with
+                    | step_cmd hcmd =>
+                      cases hcmd with
+                      | eval_assume hpre hwfb =>
+                        cases h_assume_rest with
+                        | refl =>
+                          have ⟨ρ'_clean, hterm_clean, hs_eq, he_eq⟩ :=
+                            smallStep_hasFailure_irrel P' (EvalCmd P') extendEval
+                              st _ ρ' hterm_st { ρ₀ with hasFailure := false } rfl rfl
+                          have ⟨hpost, _⟩ := hoare { ρ₀ with hasFailure := false } ρ'_clean
+                            hpre hwfb rfl hterm_clean
+                          simp only [hs_eq, he_eq] at hpost
+                          have ⟨he, hs⟩ := assert_tail_getEvalStore P' extendEval
+                            ρ' post_label post_expr post_md inner ⟨post_label, post_expr⟩
+                            hrest_assert hat_inner
+                          dsimp [Config.getEval, Config.getStore, Config.getEnv] at he hs ⊢
+                          rw [he, hs]; exact hpost
+                        | step _ _ _ h _ => exact absurd h (by intro h; cases h)
+
+
+omit [HasOps P'] in
+/-- **Direction 2**: Assert validity for `PredicatedStmt` implies Hoare triple. -/
+theorem allAssertsValid_implies_hoareTriple
+    (pre_label : String) (pre_expr : P'.Expr) (pre_md : MetaData P')
+    (st : Stmt P' (Cmd P'))
+    (post_label : String) (post_expr : P'.Expr) (post_md : MetaData P')
+    (block_label : String) (block_md : MetaData P')
+    (hvalid : AllAssertsValid (Lang.standard P' extendEval)
+      (PredicatedStmt P' pre_label pre_expr pre_md st post_label post_expr post_md block_label block_md)) :
+    Triple (Lang.standard P' extendEval)
+      (fun ρ => ρ.eval ρ.store pre_expr = some HasBool.tt)
+      st
+      (fun ρ => ρ.eval ρ.store post_expr = some HasBool.tt) := by
+  intro ρ₀ ρ' hpre hwfb hf₀ hstar
+  let assume_stmt : Stmt P' (Cmd P') := .cmd (.assume pre_label pre_expr pre_md)
+  let assert_stmt : Stmt P' (Cmd P') := .cmd (.assert post_label post_expr post_md)
+  let body : List (Stmt P' (Cmd P')) := [assume_stmt, st, assert_stmt]
+  have hvalid_st : ∀ (a : AssertId P') (cfg : Config P' (Cmd P')),
+      StepStmtStar P' (EvalCmd P') extendEval (.stmt st ρ₀) cfg →
+      isAtAssert P' cfg a →
+      cfg.getEval cfg.getStore a.expr = some HasBool.tt := by
+    intro a cfg hstar_st hat
+    have h_assume : StepStmtStar P' (EvalCmd P') extendEval
+        (.stmt assume_stmt ρ₀) (.terminal { ρ₀ with store := ρ₀.store, hasFailure := ρ₀.hasFailure || false }) :=
+      .step _ _ _ (StepStmt.step_cmd (EvalCmd.eval_assume hpre hwfb)) (.refl _)
+    have h_ρ₁_eq : ({ store := ρ₀.store, eval := ρ₀.eval, hasFailure := ρ₀.hasFailure || false } : Env P') = ρ₀ := by
+      cases ρ₀; simp [Bool.or_false]
+    have h1 := stmts_cons_step P' (EvalCmd P') extendEval assume_stmt [st, assert_stmt] ρ₀ _ h_assume
+    rw [h_ρ₁_eq] at h1
+    have h2 : StepStmtStar P' (EvalCmd P') extendEval
+        (.stmts [st, assert_stmt] ρ₀) (.seq (.stmt st ρ₀) [assert_stmt]) :=
+      .step _ _ _ StepStmt.step_stmts_cons (.refl _)
+    have h3 := seq_inner_star P' (EvalCmd P') extendEval _ _ [assert_stmt] hstar_st
+    have h_inner := ReflTrans_Transitive _ _ _ _ (ReflTrans_Transitive _ _ _ _ h1 h2) h3
+    have h_block := block_inner_star P' (EvalCmd P') extendEval _ _ (.some block_label) ρ₀.store ρ₀.eval h_inner
+    have h_start : StepStmtStar P' (EvalCmd P') extendEval
+        (.stmt (.block block_label body block_md) ρ₀)
+        (.block (.some block_label) ρ₀.store ρ₀.eval (.stmts body ρ₀)) :=
+      .step _ _ _ StepStmt.step_block (.refl _)
+    have h_full := ReflTrans_Transitive _ _ _ _ h_start h_block
+    have h_result := hvalid a ρ₀ _ trivial h_full hat
+    dsimp [Config.getEval, Config.getStore, Config.getEnv] at h_result ⊢
+    exact h_result
+  have h_assume : StepStmtStar P' (EvalCmd P') extendEval
+      (.stmt assume_stmt ρ₀) (.terminal { ρ₀ with store := ρ₀.store, hasFailure := ρ₀.hasFailure || false }) :=
+    .step _ _ _ (StepStmt.step_cmd (EvalCmd.eval_assume hpre hwfb)) (.refl _)
+  have h_ρ₁_eq : ({ store := ρ₀.store, eval := ρ₀.eval, hasFailure := ρ₀.hasFailure || false } : Env P') = ρ₀ := by
+    cases ρ₀; simp [Bool.or_false]
+  have h1 := stmts_cons_step P' (EvalCmd P') extendEval assume_stmt [st, assert_stmt] ρ₀ _ h_assume
+  rw [h_ρ₁_eq] at h1
+  have h2 := stmts_cons_step P' (EvalCmd P') extendEval st [assert_stmt] ρ₀ ρ' hstar
+  have h3 : StepStmtStar P' (EvalCmd P') extendEval
+      (.stmts [assert_stmt] ρ') (.seq (.stmt assert_stmt ρ') []) :=
+    .step _ _ _ StepStmt.step_stmts_cons (.refl _)
+  have h_inner := ReflTrans_Transitive _ _ _ _ (ReflTrans_Transitive _ _ _ _ h1 h2) h3
+  have h_block := block_inner_star P' (EvalCmd P') extendEval _ _ (.some block_label) ρ₀.store ρ₀.eval h_inner
+  have h_start : StepStmtStar P' (EvalCmd P') extendEval
+      (.stmt (.block block_label body block_md) ρ₀)
+      (.block (.some block_label) ρ₀.store ρ₀.eval (.stmts body ρ₀)) :=
+    .step _ _ _ StepStmt.step_block (.refl _)
+  have h_full := ReflTrans_Transitive _ _ _ _ h_start h_block
+  have h_at : isAtAssert P' (.block (.some block_label) ρ₀.store ρ₀.eval (.seq (.stmt assert_stmt ρ') [])) ⟨post_label, post_expr⟩ := by
+    simp [isAtAssert, assert_stmt]
+  have h_result := hvalid ⟨post_label, post_expr⟩ ρ₀ _ trivial h_full h_at
+  dsimp [Config.getEval, Config.getStore, Config.getEnv] at h_result
+  exact ⟨h_result, allAssertsValid_preserves_noFailure P' extendEval
+    (ρ₀ := ρ₀) (ρ' := ρ') st hvalid_st hf₀ hstar⟩
+
+end StandardConnection
+
+end Hoare
+
+
+namespace Transform
+
+omit [HasVal P] [HasOps P] [HasFvar P] [HasFvars P] [HasBoolOps P] in
+theorem sound_comp (L₁ L₂ L₃ : Lang P)
+    (T₁ : L₁.StmtT → Option L₂.StmtT) (T₂ : L₂.StmtT → Option L₃.StmtT)
+    (h₁ : Sound L₁ L₂ T₁) (h₂ : Sound L₂ L₃ T₂) :
+    Sound L₁ L₃ (fun s => T₁ s >>= T₂) := by
+  intro s s'' a hrun hvalid
+  simp [bind, Option.bind] at hrun
+  match h1 : T₁ s with
+  | some s' => rw [h1] at hrun; exact h₁ s s' a h1 (h₂ s' s'' a hrun hvalid)
+  | none => rw [h1] at hrun; exact absurd hrun (by nofun)
+
+omit [HasVal P] [HasOps P] [HasFvar P] [HasFvars P] [HasBoolOps P] in
+theorem sound_assertValid (L₁ L₂ : Lang P)
+    (T : L₁.StmtT → Option L₂.StmtT) (a : AssertId P)
+    (s : L₁.StmtT) (s' : L₂.StmtT)
+    (ht : T s = some s') (hsound : Sound L₁ L₂ T) (hvalid : AssertValid L₂ s' a) :
+    AssertValid L₁ s a := hsound s s' a ht hvalid
+
+omit [HasVal P] [HasOps P] [HasFvar P] [HasFvars P] [HasBoolOps P] in
+theorem sound_allAsserts (L₁ L₂ : Lang P)
+    (T : L₁.StmtT → Option L₂.StmtT)
+    (s : L₁.StmtT) (s' : L₂.StmtT) (ht : T s = some s')
+    (hsound : Sound L₁ L₂ T) (hvalid : AllAssertsValid L₂ s') :
+    AllAssertsValid L₁ s := fun a => hsound s s' a ht (hvalid a)
+
+omit [HasVal P] [HasOps P] [HasFvar P] [HasFvars P] [HasBoolOps P] in
+theorem sound_id : Sound L L some := by
+  intro s s' a ht hvalid; simp at ht; subst ht; exact hvalid
+
+omit [HasOps P] [HasFvar P] [HasFvars P] in
+/-- If `T` overapproximates and a Hoare triple holds on `T(st)` in L₂,
+    then the triple holds on `st` in L₁. -/
+theorem overapproximates_triple (L₁ L₂ : Lang P)
+    (T : L₁.StmtT → Option L₂.StmtT)
+    (st : L₁.StmtT) (s' : L₂.StmtT) (ht : T st = some s')
+    (hsem : Overapproximates L₁ L₂ T)
+    {Pre Post : Env P → Prop}
+    (htriple : Hoare.Triple L₂ Pre s' Post)
+    (hwfv : ∀ ρ₀ : Env P, Pre ρ₀ → WellFormedSemanticEvalVal ρ₀.eval) :
+    Hoare.Triple L₁ Pre st Post := by
+  intro ρ₀ ρ' hpre hwfb hf₀ hstar
+  exact htriple ρ₀ ρ' hpre hwfb hf₀
+    ((hsem st s' ht ρ₀ ρ' hwfb (hwfv ρ₀ hpre)).1 hstar)
+
+omit [HasOps P] [HasFvar P] [HasFvars P] in
+theorem overapproximates_id (L₁ : Lang P) :
+    Overapproximates L₁ L₁ some := by
+  intro st s' ht ρ₀ ρ' _ _
+  simp at ht; subst ht
+  exact ⟨id, fun _ => id⟩
+
+omit [HasOps P] [HasFvar P] [HasFvars P] in
+theorem overapproximates_comp (L₁ L₂ L₃ : Lang P)
+    (T₁ : L₁.StmtT → Option L₂.StmtT) (T₂ : L₂.StmtT → Option L₃.StmtT)
+    (h₁ : Overapproximates L₁ L₂ T₁)
+    (h₂ : Overapproximates L₂ L₃ T₂) :
+    Overapproximates L₁ L₃ (fun s => T₁ s >>= T₂) := by
+  intro st s'' ht ρ₀ ρ' hwfb hwfv
+  simp [bind, Option.bind] at ht
+  match h : T₁ st with
+  | some s' =>
+    rw [h] at ht
+    have hr₁ := h₁ st s' h ρ₀ ρ' hwfb hwfv
+    have hr₂ := h₂ s' s'' ht ρ₀ ρ' hwfb hwfv
+    refine ⟨?_, ?_⟩
+    · intro hstar; exact hr₂.1 (hr₁.1 hstar)
+    · intro lbl hstar; exact hr₂.2 lbl (hr₁.2 lbl hstar)
+  | none => rw [h] at ht; exact absurd ht (by nofun)
+
+/-! ## Statement-list overapproximation (Imperative-specific)
+
+Uses `Overapproximates L L T` (single-language): the proof decomposes
+seq execution into terminal/exiting outcomes of individual statements,
+which is exactly what `Overapproximates` provides. -/
+
+section ImperativeStmts
+
+variable {CmdT : Type} (evalCmd : EvalCmdParam P CmdT) (extendEval : ExtendEval P)
+variable (isAtAssertFn : Config P CmdT → AssertId P → Prop)
+
+omit [HasFvar P] [HasFvars P] [HasOps P] [HasBool P] [HasBoolOps P] [HasVal P] in
+private theorem mapM_noFuncDecl
+    (T : Stmt P CmdT → Option (Stmt P CmdT))
+    (hnofd_T : ∀ s s', T s = some s' → Stmt.noFuncDecl s = true)
+    (ss : List (Stmt P CmdT)) (ss' : List (Stmt P CmdT))
+    (hmap : ss.mapM T = some ss') :
+    Block.noFuncDecl ss = true := by
+  induction ss generalizing ss' with
+  | nil => simp [Block.noFuncDecl]
+  | cons s rest ih =>
+    have ⟨s', rest', hs, hrm, hss'⟩ := List.mapM_cons_some hmap
+    simp [Block.noFuncDecl, hnofd_T s s' hs, ih rest' hrm]
+
+omit [HasOps P] in
+private theorem overapproximates_stmts_aux
+    (T : Stmt P CmdT → Option (Stmt P CmdT))
+    (hsem : Overapproximates (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) T)
+    (ss : List (Stmt P CmdT))
+    (hnofd : Block.noFuncDecl ss = true) :
+    ∀ (ss' : List (Stmt P CmdT)),
+      ss.mapM T = some ss' →
+      ∀ (ρ₀ ρ' : Env P),
+        WellFormedSemanticEvalBool ρ₀.eval →
+        WellFormedSemanticEvalVal ρ₀.eval →
+        (StepStmtStar P evalCmd extendEval (.stmts ss ρ₀) (.terminal ρ') →
+         StepStmtStar P evalCmd extendEval (.stmts ss' ρ₀) (.terminal ρ'))
+        ∧
+        (∀ lbl, StepStmtStar P evalCmd extendEval (.stmts ss ρ₀) (.exiting lbl ρ') →
+                StepStmtStar P evalCmd extendEval (.stmts ss' ρ₀) (.exiting lbl ρ')) := by
+  induction ss with
+  | nil =>
+    intro ss' hmap ρ₀ ρ' _ _
+    have : ss' = [] := by simp [List.mapM_nil] at hmap; exact hmap
+    subst this; exact ⟨id, fun _ => id⟩
+  | cons s rest ih =>
+    intro ss' hmap ρ₀ ρ' hwfb hwfv
+    simp [Block.noFuncDecl, Bool.and_eq_true] at hnofd
+    have ⟨hnofd_s, hnofd_rest⟩ := hnofd
+    have ⟨s', rest', hs, hrm, hss'⟩ := List.mapM_cons_some hmap
+    subst hss'
+    have eval_preserved : ∀ ρ₁ : Env P,
+        StepStmtStar P evalCmd extendEval (.stmt s ρ₀) (.terminal ρ₁) →
+        WellFormedSemanticEvalBool ρ₁.eval ∧ WellFormedSemanticEvalVal ρ₁.eval := by
+      intro ρ₁ hterm_s
+      have heq := smallStep_noFuncDecl_preserves_eval P evalCmd extendEval s ρ₀ ρ₁ hnofd_s hterm_s
+      exact ⟨heq ▸ hwfb, heq ▸ hwfv⟩
+    constructor
+    · intro hstar
+      cases hstar with
+      | step _ _ _ hstep hrest_exec => cases hstep with
+        | step_stmts_cons =>
+          have ⟨ρ₁, hterm_s, hterm_rest⟩ := seq_reaches_terminal P evalCmd extendEval hrest_exec
+          have ⟨hwfb₁, hwfv₁⟩ := eval_preserved ρ₁ hterm_s
+          exact ReflTrans_Transitive _ _ _ _
+            (stmts_cons_step P evalCmd extendEval s' rest' ρ₀ ρ₁
+              ((hsem s s' hs ρ₀ ρ₁ hwfb hwfv).1 hterm_s))
+            ((ih hnofd_rest rest' hrm ρ₁ ρ' hwfb₁ hwfv₁).1 hterm_rest)
+    · intro lbl hstar
+      cases hstar with
+      | step _ _ _ hstep hrest_exec => cases hstep with
+        | step_stmts_cons =>
+          match seq_reaches_exiting P evalCmd extendEval hrest_exec with
+          | .inl hexit_s =>
+            exact .step _ _ _ .step_stmts_cons
+              (ReflTrans_Transitive _ _ _ _ (seq_inner_star P evalCmd extendEval _ _ rest'
+                ((hsem s s' hs ρ₀ ρ' hwfb hwfv).2 lbl hexit_s))
+                (.step _ _ _ .step_seq_exit (.refl _)))
+          | .inr ⟨ρ₁, hterm_s, hexit_rest⟩ =>
+            have ⟨hwfb₁, hwfv₁⟩ := eval_preserved ρ₁ hterm_s
+            exact ReflTrans_Transitive _ _ _ _
+              (stmts_cons_step P evalCmd extendEval s' rest' ρ₀ ρ₁
+                ((hsem s s' hs ρ₀ ρ₁ hwfb hwfv).1 hterm_s))
+              ((ih hnofd_rest rest' hrm ρ₁ ρ' hwfb₁ hwfv₁).2 lbl hexit_rest)
+
+omit [HasOps P] in
+theorem overapproximates_stmts
+    (T : Stmt P CmdT → Option (Stmt P CmdT))
+    (hsem : Overapproximates (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) (Lang.imperative P CmdT evalCmd extendEval isAtAssertFn) T)
+    (hnofd_T : ∀ s s', T s = some s' → Stmt.noFuncDecl s = true) :
+    Overapproximates
+      (Lang.imperativeBlock evalCmd extendEval isAtAssertFn)
+      (Lang.imperativeBlock evalCmd extendEval isAtAssertFn)
+      (fun ss => ss.mapM T) := by
+  intro ss ss' hmap ρ₀ ρ' hwfb hwfv
+  exact overapproximates_stmts_aux evalCmd extendEval isAtAssertFn T hsem ss
+    (mapM_noFuncDecl T hnofd_T ss ss' hmap) ss' hmap ρ₀ ρ' hwfb hwfv
+
+end ImperativeStmts
+
+end Transform
+end Specification
+end Imperative
+
+end -- public section
diff --git a/Strata/Transform/StructuredToUnstructured.lean b/Strata/Transform/StructuredToUnstructured.lean
index 77168ca4d1..3da0a61310 100644
--- a/Strata/Transform/StructuredToUnstructured.lean
+++ b/Strata/Transform/StructuredToUnstructured.lean
@@ -5,8 +5,12 @@
 -/
 module
 
+import Strata.DL.Imperative.PureExpr
 public import Strata.DL.Imperative.BasicBlock
+public import Strata.DL.Imperative.CFGSemantics
+import Strata.DL.Imperative.Cmd
 public import Strata.DL.Imperative.Stmt
+import Strata.DL.Lambda.LExpr
 public import Strata.DL.Util.LabelGen
 
 public section
@@ -21,10 +25,11 @@ def detCmdBlock [HasBool P] (c : CmdT) (k : Label) :
 
 open LabelGen
 
-/-- Flush the list of accumulated commands. If the list is empty, propagate the
-provided continuation. If the list is non-empty, create a block containing
-one command that jumps to the provided continuation and provide the new block's
-label as a new continuation.  -/
+/-- Flush the list of accumulated commands. If both the accumulator is empty
+and no explicit transfer is provided, propagate the continuation `k`.
+Otherwise emit a block: when `tr?` is `some tr`, use `tr` as the transfer
+(this is required for `condGoto` so the conditional is materialized even
+with empty accum); when `tr?` is `none`, use `.goto k`. -/
 def flushCmds
   [HasBool P]
   (pfx : String)
@@ -32,11 +37,17 @@ def flushCmds
   (tr? : Option (DetTransferCmd String P))
   (k : String) :
   StringGenM (String × DetBlocks String CmdT P) := do
-  if accum.isEmpty then
-    pure (k, [])
-  else
+  match tr? with
+  | none =>
+    if accum.isEmpty then
+      pure (k, [])
+    else
+      let l ← StringGenState.gen pfx
+      let b := (l, { cmds := accum.reverse, transfer := .goto k })
+      pure (l, [b])
+  | some tr =>
     let l ← StringGenState.gen pfx
-    let b := (l, { cmds := accum.reverse, transfer := tr?.getD (.goto k) })
+    let b := (l, { cmds := accum.reverse, transfer := tr })
     pure (l, [b])
 
 private abbrev synthesizedMd {P : PureExpr} : MetaData P :=
@@ -45,7 +56,7 @@ private abbrev synthesizedMd {P : PureExpr} : MetaData P :=
 /-- Translate a list of statements to basic blocks, accumulating commands -/
 def stmtsToBlocks
   [HasBool P] [HasPassiveCmds P CmdT] [HasInit P CmdT]
-  [HasIdent P] [HasFvar P] [HasIntOrder P] [HasNot P]
+  [HasIdent P] [HasFvar P] [HasFvars P] [HasInt P] [HasIntOps P] [HasBoolOps P]
   (k : String)
   (ss : List (Stmt P CmdT))
   (exitConts : List (Option String × String))
@@ -77,7 +88,7 @@ match ss with
     pure (accumEntry, accumBlocks ++ bbs ++ bsNext)
   else
     let b := (l, { cmds := [], transfer := .goto bl })
-    pure (l, accumBlocks ++ [b] ++ bbs ++ bsNext)
+    pure (accumEntry, accumBlocks ++ [b] ++ bbs ++ bsNext)
 | .ite c tss fss _md :: rest => do
   -- Process rest first
   let (kNext, bsNext) ← stmtsToBlocks k rest exitConts []
@@ -110,13 +121,13 @@ match ss with
       let mLabel ← StringGenState.gen "loop_measure$"
       let mIdent := HasIdent.ident mLabel
       let mOldExpr := HasFvar.mkFvar mIdent
-      let initCmd  := HasInit.init mIdent HasIntOrder.intTy .nondet synthesizedMd
+      let initCmd  := HasInit.init mIdent HasInt.intTy .nondet synthesizedMd
       let assumeCmd := HasPassiveCmds.assume s!"assume_{mLabel}"
-                         (HasIntOrder.eq mOldExpr mExpr) synthesizedMd
+                         (HasIntOps.eq mOldExpr mExpr) synthesizedMd
       let lbCmd    := HasPassiveCmds.assert s!"measure_lb_{mLabel}"
-                         (HasNot.not (HasIntOrder.lt mOldExpr HasIntOrder.zero)) synthesizedMd
+                         (HasBoolOps.not (HasIntOps.lt mOldExpr HasInt.zero)) synthesizedMd
       let decCmd   := HasPassiveCmds.assert s!"measure_decrease_{mLabel}"
-                         (HasIntOrder.lt mExpr mOldExpr) synthesizedMd
+                         (HasIntOps.lt mExpr mOldExpr) synthesizedMd
       let ldec ← StringGenState.gen "measure_decrease$"
       let decBlock := (ldec, { cmds := [decCmd], transfer := .goto lentry })
       pure ([initCmd, assumeCmd, lbCmd], ldec, [decBlock])
@@ -160,7 +171,7 @@ match ss with
 
 def stmtsToCFGM
   [HasBool P] [HasPassiveCmds P CmdT] [HasInit P CmdT]
-  [HasIdent P] [HasFvar P] [HasIntOrder P] [HasNot P]
+  [HasIdent P] [HasFvar P] [HasFvars P] [HasInt P] [HasIntOps P] [HasBoolOps P]
   (ss : List (Stmt P CmdT)) :
   StringGenM (CFG String (DetBlock String CmdT P)) := do
   let lend ← StringGenState.gen "end$"
@@ -170,7 +181,7 @@ def stmtsToCFGM
 
 def stmtsToCFG
   [HasBool P] [HasPassiveCmds P CmdT] [HasInit P CmdT]
-  [HasIdent P] [HasFvar P] [HasIntOrder P] [HasNot P]
+  [HasIdent P] [HasFvar P] [HasFvars P] [HasInt P] [HasIntOps P] [HasBoolOps P]
   (ss : List (Stmt P CmdT)) :
   CFG String (DetBlock String CmdT P) :=
   (stmtsToCFGM ss StringGenState.emp).fst
diff --git a/Strata/Transform/TerminationCheck.lean b/Strata/Transform/TerminationCheck.lean
index 2d315f7b3a..6a478b32d6 100644
--- a/Strata/Transform/TerminationCheck.lean
+++ b/Strata/Transform/TerminationCheck.lean
@@ -292,7 +292,7 @@ private def mkTermCheckProc
                  (func.preconditions.mapIdx fun i p =>
                    (s!"{func.name.name}_requires_{i}", { expr := p.expr, attr := .Free })),
                postconditions := [] }
-    body := stmts
+    body := .structured stmts
   } md, obligations.length)
 
 /-- Add a termination-check procedure as a leaf node in the cached call graph. -/
diff --git a/Strata/Util/FileRange.lean b/Strata/Util/FileRange.lean
index a67cb10f49..cea135549b 100644
--- a/Strata/Util/FileRange.lean
+++ b/Strata/Util/FileRange.lean
@@ -5,6 +5,8 @@
 -/
 module
 public import StrataDDM.Util.SourceRange
+public import Lean.Data.Position
+public import Lean.ToExpr
 
 open Std (Format)
 
@@ -16,7 +18,7 @@ abbrev SourceRange.none := StrataDDM.SourceRange.none
 
 inductive Uri where
   | file (path: String)
-  deriving DecidableEq, Repr, Inhabited
+  deriving DecidableEq, Repr, Inhabited, Hashable
 
 instance : Std.ToFormat Uri where
  format fr := private match fr with | .file path => path
@@ -24,7 +26,7 @@ instance : Std.ToFormat Uri where
 structure FileRange where
   file: Uri
   range: SourceRange
-  deriving DecidableEq, Repr, Inhabited
+  deriving DecidableEq, Repr, Inhabited, Hashable
 
 instance : Std.ToFormat FileRange where
  format fr := private f!"{fr.file}:{fr.range}"
@@ -74,7 +76,7 @@ def FileRange.format (fr : FileRange) (fileMap : Option Lean.FileMap) (includeEn
       f!"{baseName}({fr.range.start}-{fr.range.stop})"
 
 inductive DiagnosticType where | Warning | UserError | NotYetImplemented | StrataBug
-  deriving Repr, BEq, Inhabited
+  deriving Repr, BEq, Inhabited, Lean.ToExpr, Hashable
 
 /-- A diagnostic model that holds a file range and a message.
     This can be converted to a formatted string using a FileMap. -/
@@ -82,7 +84,7 @@ structure DiagnosticModel where
   fileRange : FileRange
   message : String
   type : DiagnosticType
-  deriving Repr, BEq, Inhabited
+  deriving Repr, BEq, Inhabited, Hashable
 
 instance : Inhabited DiagnosticModel where
   default := { fileRange := FileRange.unknown, message := "", type := .UserError }
diff --git a/StrataBoole/StrataBoole/MetaVerifier.lean b/StrataBoole/StrataBoole/MetaVerifier.lean
index 6b05279202..3882536527 100644
--- a/StrataBoole/StrataBoole/MetaVerifier.lean
+++ b/StrataBoole/StrataBoole/MetaVerifier.lean
@@ -42,28 +42,34 @@ open StrataDDM (Program)
 Generate verification conditions for a `StrataDDM.Program`, with Boole support.
 Extends `Strata.genCoreVCs` to handle the Boole dialect.
 -/
-def genCoreVCsBoole (program : Program) : Option Core.coreVCs := do
+def genCoreVCsBoole (program : Program)
+    (options : MetaVerifier.Options := {}) : Option Core.coreVCs := do
   if program.dialect == "Boole" then
     match Boole.getProgram program with
     | .ok booleProgram =>
-      Boole.genVCs booleProgram program.globalContext { (default : Core.VerifyOptions) with verbose := .quiet : Core.VerifyOptions }
+      Boole.genVCs booleProgram program.globalContext options.toVerifyOptions
     | .error _ => none
   else
-    genCoreVCs program
+    genCoreVCs program options
 
 /--
 Generate SMT verification conditions for a `StrataDDM.Program`, with Boole support.
 -/
-def genSMTVCsBoole (program : Program) : Option SMT.SMTVCs := do
-  let coreVCs ← genCoreVCsBoole program
-  toSMTVCs coreVCs
+def genSMTVCsBoole (program : Program)
+    (options : MetaVerifier.Options := {}) : Option SMT.SMTVCs := do
+  let coreVCs ← genCoreVCsBoole program options
+  toSMTVCs coreVCs options
 
 /--
 State semantic correctness of the SMT verification conditions generated for a
-program, with Boole dialect support.
+program under the given metaverifier options, with Boole dialect support. For
+example, `options.useArrayTheory` selects how the SMT encoder treats `Map`
+types: under `true` they become SMT-LIB arrays, under `false` an uninterpreted
+sort with axiomatized `select`/`update` functions.
 -/
-def smtVCsCorrectBoole (program : Program) : Prop :=
-  match genSMTVCsBoole program with
+def smtVCsCorrectBoole (program : Program)
+    (options : MetaVerifier.Options := {}) : Prop :=
+  match genSMTVCsBoole program options with
   | some vcs => (denoteQueries vcs).getD False
   | none     => False
 
@@ -75,10 +81,11 @@ open Lean hiding Options
 
 private unsafe def genSMTVCsBooleUnsafe (mv : MVarId) : MetaM (List MVarId) := do
   let type ← mv.getType
-  let some program := type.app1? ``Strata.smtVCsCorrectBoole | throwError "Expected a Strata.smtVCsCorrectBoole goal"
+  let some (program, options) := type.app2? ``Strata.smtVCsCorrectBoole
+    | throwError "Expected a Strata.smtVCsCorrectBoole goal"
   trace[debug] m!"Generating SMT VCs for {program}"
   let mv ← Meta.unfoldTarget mv ``Strata.smtVCsCorrectBoole
-  let ovcs := .app (.const ``Strata.genSMTVCsBoole []) program
+  let ovcs := mkApp2 (.const ``Strata.genSMTVCsBoole []) program options
   let ovcsType := .app (.const ``Option [0]) (.const ``Strata.SMT.SMTVCs [])
   let some evcs ← Meta.evalExpr (Option Strata.SMT.SMTVCs) ovcsType ovcs
     | throwError "Failed to generate VCs"
diff --git a/StrataBoole/StrataBoole/Verify.lean b/StrataBoole/StrataBoole/Verify.lean
index 0689a0ad25..a9d5add4ed 100644
--- a/StrataBoole/StrataBoole/Verify.lean
+++ b/StrataBoole/StrataBoole/Verify.lean
@@ -950,7 +950,7 @@ private def translateProcedureDecl
   return [.proc {
     header := { name := mkIdent n, typeArgs := tys, inputs := allInputs, outputs := allOutputs }
     spec := spec
-    body := body
+    body := .structured body
   } .empty]
 
 def toCoreDecls (cmd : BooleDDM.Command SourceRange) : TranslateM (List Core.Decl) := do
@@ -972,6 +972,8 @@ def toCoreDecls (cmd : BooleDDM.Command SourceRange) : TranslateM (List Core.Dec
     withTypeBVars tys do
       let inputs ← (bindingsToList ins).mapM toCoreBinding
       translateProcedureDecl m n tys inputs [] specAnn.val bodyAnn.val
+  | .command_cfg_procedure m nameAnn _ _ _ _ =>
+    throwAt m s!"Boole procedure '{nameAnn.val}': CFG-form procedure bodies (`cfg ENTRY \{ ... }`) are not supported in Boole; use a structured body."
   | .command_typedecl _ ⟨_, n⟩ ⟨_, args?⟩ =>
     let params := match args? with
       | none => []
@@ -1025,7 +1027,7 @@ def toCoreDecls (cmd : BooleDDM.Command SourceRange) : TranslateM (List Core.Dec
     return [.proc {
       header := { name := mkIdent topLevelBlockProcedureName, typeArgs := [], inputs := [], outputs := [] }
       spec := { preconditions := [], postconditions := [] }
-      body := ← toCoreBlock b
+      body := .structured (← toCoreBlock b)
     } .empty]
   | .command_datatypes _ ⟨_, decls⟩ =>
     return [.type (.data (← decls.toList.mapM toCoreDatatypeDecl)) .empty]
diff --git a/StrataBoole/StrataBooleTest/FeatureRequests/map_extensionality.lean b/StrataBoole/StrataBooleTest/FeatureRequests/map_extensionality.lean
index 681b458ec8..421d3a26a6 100644
--- a/StrataBoole/StrataBooleTest/FeatureRequests/map_extensionality.lean
+++ b/StrataBoole/StrataBooleTest/FeatureRequests/map_extensionality.lean
@@ -49,11 +49,25 @@ Result: ✅ pass-/
 #guard_msgs in
 #eval Strata.Boole.verify "cvc5" mapExtensionalitySeed (options := .quiet)
 
-example : Strata.smtVCsCorrectBoole mapExtensionalitySeed := by
-  gen_smt_vcs_boole
-  all_goals
-    intro Map inst select a b hPointwise i
-    exact hPointwise i
+/--
+The VCs are provable regardless of `useArrayTheory`: under `true` the `Map` is
+encoded as an SMT array (denoted by `SmtArray`), under `false` as an
+uninterpreted sort with an axiomatized `select` function.
+-/
+example : ∀ useArrayTheory,
+    Strata.smtVCsCorrectBoole mapExtensionalitySeed { useArrayTheory } := by
+  intro useArrayTheory
+  cases useArrayTheory
+  case false =>
+    gen_smt_vcs_boole
+    all_goals
+      intro Map inst select a b hPointwise i
+      exact hPointwise i
+  case true =>
+    gen_smt_vcs_boole
+    all_goals
+      intro a b hPointwise i
+      exact hPointwise i
 
 /-!
 Regression test for extensional equality nested under an outer quantifier.
diff --git a/StrataBoole/StrataBooleTest/FeatureRequests/mutual_recursion.lean b/StrataBoole/StrataBooleTest/FeatureRequests/mutual_recursion.lean
index a54f0d7a20..2cb7a60dab 100644
--- a/StrataBoole/StrataBooleTest/FeatureRequests/mutual_recursion.lean
+++ b/StrataBoole/StrataBooleTest/FeatureRequests/mutual_recursion.lean
@@ -15,18 +15,6 @@ Near-upstream anchors from `differential_status.md`:
 - `vlir-tests:recursion`
 - Verus link:
   `guide/recursion`: https://github.com/verus-lang/verus/blob/main/examples/guide/recursion.rs
-
-Implemented (#599):
-- Mutual recursion for spec functions over datatypes works end-to-end.
-  The `rec function ... function ... ;` block pre-registers all sibling
-  names before elaborating any body, so forward references are resolved.
-  Termination is justified by structural recursion on the `@[cases]` param.
-
-Remaining gap:
-- Mutual recursion over `int` (or other non-datatype types) is not yet
-  supported. Structural recursion does not apply; an explicit `decreases`
-  clause would be needed for each function in the block, and the
-  infrastructure for that is not yet in place.
 -/
 
 -- Working: mutual recursion over a Peano-style datatype.
@@ -64,23 +52,105 @@ spec {
 };
 #end
 
-#guard_msgs (drop info) in
-#eval Strata.Boole.verify "cvc5" mutualRecursionSeed
+/-- info:
+Obligation: even_body_calls_MyNat..pred_0
+Property: assert
+Result: ✅ pass
+
+Obligation: odd_body_calls_MyNat..pred_0
+Property: assert
+Result: ✅ pass
+
+Obligation: even_terminates_0
+Property: assert
+Result: ✅ pass
+
+Obligation: odd_terminates_0
+Property: assert
+Result: ✅ pass
+
+Obligation: assert_4_1094
+Property: assert
+Result: ✅ pass
+
+Obligation: assert_5_1125
+Property: assert
+Result: ✅ pass
+
+Obligation: assert_6_1156
+Property: assert
+Result: ✅ pass
+
+Obligation: assert_7_1194
+Property: assert
+Result: ✅ pass
+
+Obligation: test_parity_ensures_0_950
+Property: assert
+Result: ✅ pass
+
+Obligation: test_parity_ensures_1_982
+Property: assert
+Result: ✅ pass
+
+Obligation: test_parity_ensures_2_1014
+Property: assert
+Result: ✅ pass
+
+Obligation: test_parity_ensures_3_1053
+Property: assert
+Result: ✅ pass-/
+#guard_msgs in
+#eval Strata.Boole.verify "cvc5" mutualRecursionSeed (options := .quiet)
 
 example : Strata.smtVCsCorrectBoole mutualRecursionSeed := by
   gen_smt_vcs_boole
   all_goals (try grind)
 
--- Still open: mutual recursion over int requires a decreases clause.
--- Target shape once function-level decreases is supported:
---
--- rec
--- function even_int(n: int) : bool
--- {
---   if n == 0 then true else odd_int(n - 1)
--- }
--- function odd_int(n: int) : bool
--- {
---   if n == 0 then false else even_int(n - 1)
--- }
--- ;
+/-
+Mutual recursion over int (#1167):
+- `decreases n` on each function in the `rec` block; the termination VCs
+  (`even_terminates_*`, `odd_terminates_*`) are discharged by cvc5.
+
+Open gap — unfolding (Gap #1 / opaque+reveal):
+- `even` and `odd` are emitted as uninterpreted functions (UFs) in the SMT
+  query.  The solver knows their types and that they terminate, but not what
+  they return at any specific argument.  Proving `even(1) == false` requires
+  the defining equations as SMT assertions — blocked by Gap #1 (`opaque`/`reveal`).
+-/
+private def mutualRecursionIntSeed : StrataDDM.Program :=
+#strata
+program Boole;
+
+rec
+function even(n: int) : bool
+  decreases n
+{
+  if n <= 0 then true else odd(n - 1)
+}
+function odd(n: int) : bool
+  decreases n
+{
+  if n <= 0 then false else even(n - 1)
+}
+;
+#end
+
+/-- info:
+Obligation: even_terminates_0
+Property: assert
+Result: ✅ pass
+
+Obligation: even_terminates_1
+Property: assert
+Result: ✅ pass
+
+Obligation: odd_terminates_0
+Property: assert
+Result: ✅ pass
+
+Obligation: odd_terminates_1
+Property: assert
+Result: ✅ pass-/
+#guard_msgs in
+#eval Strata.Boole.verify "cvc5" mutualRecursionIntSeed (options := .quiet)
diff --git a/StrataBoole/StrataBooleTest/FeatureRequests/widening_casts.lean b/StrataBoole/StrataBooleTest/FeatureRequests/widening_casts.lean
index d937a20729..46afbdd1b0 100644
--- a/StrataBoole/StrataBooleTest/FeatureRequests/widening_casts.lean
+++ b/StrataBoole/StrataBooleTest/FeatureRequests/widening_casts.lean
@@ -56,8 +56,22 @@ Result: ✅ pass-/
 #guard_msgs in
 #eval Strata.Boole.verify "cvc5" wideningCastsSeed (options := .quiet)
 
-example : Strata.smtVCsCorrectBoole wideningCastsSeed := by
-  gen_smt_vcs_boole
-  all_goals
-    intro Map inst n bv32_to_int_u select v hNonneg hn i hi
-    exact hNonneg (select v i)
+/--
+The VCs are provable regardless of `useArrayTheory`: under `true` the `Map` is
+encoded as an SMT array (denoted by `SmtArray`), under `false` as an
+uninterpreted sort with an axiomatized `select` function.
+-/
+example : ∀ useArrayTheory,
+    Strata.smtVCsCorrectBoole wideningCastsSeed { useArrayTheory } := by
+  intro useArrayTheory
+  cases useArrayTheory
+  case false =>
+    gen_smt_vcs_boole
+    all_goals
+      intro Map inst n bv32_to_int_u select v hNonneg hn i hi
+      exact hNonneg (select v i)
+  case true =>
+    gen_smt_vcs_boole
+    all_goals
+      intro bv32_to_int_u n v hNonneg hn i hi
+      exact hNonneg (v.select i)
diff --git a/StrataBoole/StrataBooleTest/datatype_tester_freevar.lean b/StrataBoole/StrataBooleTest/datatype_tester_freevar.lean
index 77b587a997..004df8c1b3 100644
--- a/StrataBoole/StrataBooleTest/datatype_tester_freevar.lean
+++ b/StrataBoole/StrataBooleTest/datatype_tester_freevar.lean
@@ -164,8 +164,40 @@ spec {
 };
 #end
 
-#guard_msgs (drop info) in
-#eval Strata.Boole.verify "cvc5" recfndefsMultiSeed
+/-- info:
+Obligation: even_body_calls_MyNat..pred_0
+Property: assert
+Result: ✅ pass
+
+Obligation: odd_body_calls_MyNat..pred_0
+Property: assert
+Result: ✅ pass
+
+Obligation: even_terminates_0
+Property: assert
+Result: ✅ pass
+
+Obligation: odd_terminates_0
+Property: assert
+Result: ✅ pass
+
+Obligation: assert_2_4408
+Property: assert
+Result: ✅ pass
+
+Obligation: assert_3_4439
+Property: assert
+Result: ✅ pass
+
+Obligation: test_parity_ensures_0_4340
+Property: assert
+Result: ✅ pass
+
+Obligation: test_parity_ensures_1_4372
+Property: assert
+Result: ✅ pass-/
+#guard_msgs in
+#eval Strata.Boole.verify "cvc5" recfndefsMultiSeed (options := .quiet)
 
 example : Strata.smtVCsCorrectBoole recfndefsMultiSeed := by
   gen_smt_vcs_boole
diff --git a/StrataBoole/StrataBooleTest/global_readonly_call.lean b/StrataBoole/StrataBooleTest/global_readonly_call.lean
index f1eebfc549..fac4ea2eda 100644
--- a/StrataBoole/StrataBooleTest/global_readonly_call.lean
+++ b/StrataBoole/StrataBooleTest/global_readonly_call.lean
@@ -66,7 +66,9 @@ private def callHelper (p : StrataDDM.Program) : Except String (List String) :=
   return cp.decls.filterMap fun d =>
     match d with
     | .proc p _ =>
-      p.body.findSome? fun
+      -- CFG bodies: call extraction not yet implemented for unstructured programs.
+      let stmts := match p.body with | .structured ss => ss | .cfg _ => []
+      stmts.findSome? fun
         | .block _ stmts _ => stmts.findSome? fun
           | .cmd (.call pname args _) =>
             some s!"call {pname}({", ".intercalate (args.map fmtCallArg)})"
@@ -141,41 +143,41 @@ spec {
 
 
 VCs:
-Label: inc_ensures_1_2429
+Label: inc_ensures_1_2587
 Property: assert
 Assumptions:
-inc_requires_0_2411: z@1 > 0
+inc_requires_0_2569: z@1 > 0
 Obligation:
 true
 
-Label: callElimAssert_inc_requires_0_2411_6
+Label: callElimAssert_inc_requires_0_2569_6
 Property: assert
 Assumptions:
-main_caller_requires_2_2545: z@3 == 10
-main_caller_requires_3_2565: g@3 == 0
+main_caller_requires_2_2703: z@3 == 10
+main_caller_requires_3_2723: g@3 == 0
 Obligation:
 z@3 > 0
 
-Label: main_caller_ensures_4_2584
+Label: main_caller_ensures_4_2742
 Property: assert
 Assumptions:
-main_caller_requires_2_2545: z@3 == 10
-main_caller_requires_3_2565: g@3 == 0
-callElimAssume_inc_ensures_1_2429_7: g@5 == g@3 + 5 + z@5
+main_caller_requires_2_2703: z@3 == 10
+main_caller_requires_3_2723: g@3 == 0
+callElimAssume_inc_ensures_1_2587_7: g@5 == g@3 + 5 + z@5
 Obligation:
 g@5 == 15
 
 ---
 info:
-Obligation: inc_ensures_1_2429
+Obligation: inc_ensures_1_2587
 Property: assert
 Result: ✅ pass
 
-Obligation: callElimAssert_inc_requires_0_2411_6
+Obligation: callElimAssert_inc_requires_0_2569_6
 Property: assert
 Result: ✅ pass
 
-Obligation: main_caller_ensures_4_2584
+Obligation: main_caller_ensures_4_2742
 Property: assert
 Result: ❓ unknown
 Model:
diff --git a/StrataBoole/StrataBooleTest/seq_oob_in_conjunction.lean b/StrataBoole/StrataBooleTest/seq_oob_in_conjunction.lean
new file mode 100644
index 0000000000..465213aea7
--- /dev/null
+++ b/StrataBoole/StrataBooleTest/seq_oob_in_conjunction.lean
@@ -0,0 +1,55 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataBoole.MetaVerifier
+
+open Strata
+
+/-!
+Out-of-bounds checks inside conjunctions are verified using the conjunction
+prefix as a hypothesis.
+
+For `0 <= j && j < Sequence.length(nums) && ret == Sequence.select(nums, j)`,
+the bounds check on `Sequence.select(nums, j)` is discharged using
+`0 <= j && j < Sequence.length(nums)` as an assumption, which is established
+by the earlier conjuncts via short-circuit semantics.
+-/
+
+private def seqOobConjunctionPgm : StrataDDM.Program :=
+#strata
+program Boole;
+
+procedure find_first (nums : Sequence bv32) returns (ret : bv32)
+spec {
+  requires Sequence.length(nums) > 0;
+  ensures ∃ j : int :: 0 <= j && j < Sequence.length(nums) && ret == Sequence.select(nums, j);
+}
+{
+  assume false;
+  ret := Sequence.select(nums, 0);
+  exit find_first;
+};
+
+#end
+
+/-- info:
+Obligation: find_first_post_find_first_ensures_1_708_calls_Sequence.select_0
+Property: out-of-bounds access check
+Result: ✅ pass
+
+Obligation: set_ret_calls_Sequence.select_0
+Property: out-of-bounds access check
+Result: ✅ pass
+
+Obligation: find_first_ensures_1_708
+Property: assert
+Result: ✅ pass-/
+#guard_msgs in
+#eval Strata.Boole.verify "cvc5" seqOobConjunctionPgm (options := .quiet)
+
+example : Strata.smtVCsCorrectBoole seqOobConjunctionPgm := by
+  gen_smt_vcs_boole
+  all_goals (try grind)
diff --git a/StrataDDM/StrataDDM/Integration/Lean/HashCommands.lean b/StrataDDM/StrataDDM/Integration/Lean/HashCommands.lean
index 8c1dec12d0..93cec93ca4 100644
--- a/StrataDDM/StrataDDM/Integration/Lean/HashCommands.lean
+++ b/StrataDDM/StrataDDM/Integration/Lean/HashCommands.lean
@@ -25,14 +25,67 @@ open StrataDDM.Lean (arrayToExpr listToExpr)
 
 namespace StrataDDM
 
-class HasInputContext (m : Type → Type _) [Functor m] where
+public class HasInputContext (m : Type → Type _) [Functor m] where
   getInputContext : m InputContext
   getFileName : m FilePath :=
     (fun ctx => FilePath.mk ctx.fileName) <$> getInputContext
 
+/--
+Bundle returned by the `#strata` term region. Carries:
+
+- `program`: the parsed `Strata.Program` with **file-global** AST byte offsets,
+  so Boole-style consumers (and any code that uses byte offsets in obligation
+  labels or diagnostic ranges) keep their existing behavior.
+- `source`: the raw snippet text between `#strata` and `#end`. Test helpers
+  use this to build a snippet-local `FileMap`.
+- `basePos`: byte offset in the Lean file where the snippet starts, so
+  helpers can convert file-global pipeline diagnostics back to snippet-local
+  positions when matching against inline annotations.
+- `baseLine` / `fileName`: enough info for helpers to render
+  `<lean_file>:<line>:<col>` in error messages so editors / quickfix lists
+  can jump straight to the offending source.
+-/
+public structure SourcedProgram where
+  program  : Program
+  source   : String
+  basePos  : Nat
+  baseLine : Nat
+  fileName : String
+  deriving Inhabited
+
+/-- Forward `ToString` to the underlying `Program` so `#eval` printing keeps
+    working at existing call sites. -/
+public instance : ToString SourcedProgram where
+  toString s := toString s.program
+
+/-- Allow `SourcedProgram` to be used wherever a `Program` is expected; the
+    source/positions are dropped. Removes ~200 explicit `.program` accessors
+    at consumer call sites. -/
+public instance : Coe SourcedProgram Program where
+  coe s := s.program
+
+-- Forwarders so existing call sites can keep using `.commands`, `.dialect`,
+-- etc. on the result of `#strata` as if it were a `Program`.
+namespace SourcedProgram
+
+public abbrev commands (s : SourcedProgram) : Array Operation :=
+  s.program.commands
+public abbrev dialect (s : SourcedProgram) : DialectName :=
+  s.program.dialect
+public abbrev dialects (s : SourcedProgram) : DialectMap :=
+  s.program.dialects
+public abbrev globalContext (s : SourcedProgram) : GlobalContext :=
+  s.program.globalContext
+public abbrev format (s : SourcedProgram) (opts : FormatOptions := {}) : Std.Format :=
+  s.program.format opts
+
+end SourcedProgram
+
 meta section
 
-instance : HasInputContext CommandElabM where
+deriving instance Lean.ToExpr for SourcedProgram
+
+public instance : HasInputContext CommandElabM where
   getInputContext := do
     let ctx ← read
     pure {
@@ -42,7 +95,7 @@ instance : HasInputContext CommandElabM where
     }
   getFileName := return (← read).fileName
 
-instance : HasInputContext CoreM where
+public instance : HasInputContext CoreM where
   getInputContext := do
     let ctx ← read
     pure {
@@ -78,7 +131,7 @@ def offsetMessage
 /--
 Add a definition to environment and compile it.
 -/
-def addDefn (name : Lean.Name)
+public def addDefn (name : Lean.Name)
             (type : Lean.Expr)
             (value : Lean.Expr)
             (levelParams : List Name := [])
@@ -162,6 +215,7 @@ meta def strataProgramImpl : TermElab := fun stx tp => do
   }
   let s := (dialectExt.getState (←Lean.getEnv))
   let leanEnv ← Lean.mkEmptyEnvironment 0
+  let baseLine : Nat := (fullInputCtx.fileMap.toPosition p).line
   match Elab.elabProgram s.loaded leanEnv inputCtx 0 inputCtx.endPos with
   | .ok pgm =>
     let commands := pgm.commands.map (fun cmd => cmd.mapAnn (offsetSourceRange p))
@@ -175,14 +229,21 @@ meta def strataProgramImpl : TermElab := fun stx tp => do
           addDefn n commandType (toExpr cmd)
           pure <| mkConst n
     let commandExprs ← monadLift <| pgm.commands.mapM cmdToExpr
-    return astExpr! Program.create
+    let pgmExpr : Lean.Expr :=
+      astExpr! Program.create
         (mkConst (name |>.str s!"{root}_map"))
         (toExpr pgm.dialect)
         (arrayToExpr .zero commandType commandExprs)
+    return mkApp5 (mkConst ``SourcedProgram.mk)
+      pgmExpr
+      (toExpr snippet)
+      (toExpr (p.byteIdx : Nat))
+      (toExpr baseLine)
+      (toExpr fullInputCtx.fileName)
   | .error errors =>
     for e in errors do
       logMessage (offsetMessage fullInputCtx inputCtx p e)
-    return mkApp2 (mkConst ``sorryAx [1]) (toTypeExpr Program) (toExpr true)
+    return mkApp2 (mkConst ``sorryAx [1]) (toTypeExpr SourcedProgram) (toExpr true)
 
 syntax (name := loadDialectCommand) "#load_dialect" str : command
 
diff --git a/StrataDDM/StrataDDM/Util/SourceRange.lean b/StrataDDM/StrataDDM/Util/SourceRange.lean
index e1107f82f9..78bcd84efb 100644
--- a/StrataDDM/StrataDDM/Util/SourceRange.lean
+++ b/StrataDDM/StrataDDM/Util/SourceRange.lean
@@ -25,7 +25,7 @@ structure SourceRange where
   start : String.Pos.Raw
   /-- One past the end of the range. -/
   stop : String.Pos.Raw
-deriving DecidableEq, Inhabited, Repr
+deriving DecidableEq, Inhabited, Repr, Hashable
 
 namespace SourceRange
 
diff --git a/StrataDDM/StrataDDMTest/Ion.lean b/StrataDDM/StrataDDMTest/Ion.lean
index 24326b2ece..d1b1609e9d 100644
--- a/StrataDDM/StrataDDMTest/Ion.lean
+++ b/StrataDDM/StrataDDMTest/Ion.lean
@@ -153,7 +153,7 @@ eval g : mytype;
 
 -- `eval g` (command 1) references a declared variable via ExprF.fvar
 #guard
-  let cmd := testIonFvarPgm.commands[1]
+  let cmd := testIonFvarPgm.program.commands[1]
   match cmd.args[1]? with
   | some (ArgF.expr (.fvar _ _)) => true
   | _ => false
@@ -168,7 +168,7 @@ checkTypeP Type;
 
 -- `checkTypeP Type` (command 0) passes a category via ArgF.cat
 #guard
-  let cmd := testIonCatPgm.commands[0]
+  let cmd := testIonCatPgm.program.commands[0]
   match cmd.args[0]? with
   | some (ArgF.cat _) => true
   | _ => false
@@ -183,7 +183,7 @@ checkBound (T : Type) T;
 
 -- `checkBound` (command 0) references a scoped type variable via TypeExprF.bvar
 #guard
-  let cmd := testIonBvarPgm.commands[0]
+  let cmd := testIonBvarPgm.program.commands[0]
   match cmd.args[1]? with
   | some (ArgF.type (.bvar _ _)) => true
   | _ => false
diff --git a/StrataPython/StrataPython/CorePrelude.lean b/StrataPython/StrataPython/CorePrelude.lean
index 67ddf6fbfd..08cd2cf930 100644
--- a/StrataPython/StrataPython/CorePrelude.lean
+++ b/StrataPython/StrataPython/CorePrelude.lean
@@ -7,7 +7,7 @@ module
 
 public import Strata.Languages.Core.Program
 import Strata.Languages.Core.Verifier
-import StrataDDM.Integration.Lean.HashCommands -- shake: keep
+public import StrataDDM.Integration.Lean.HashCommands -- shake: keep
 
 open Strata
 
diff --git a/StrataPython/StrataPython/PySpecPipeline.lean b/StrataPython/StrataPython/PySpecPipeline.lean
index 13e376c2ab..02322f079b 100644
--- a/StrataPython/StrataPython/PySpecPipeline.lean
+++ b/StrataPython/StrataPython/PySpecPipeline.lean
@@ -404,9 +404,9 @@ public def translateCombinedLaurelWithLowered (combined : Laurel.Program)
 
 /-- Translate a combined Laurel program to Core and prepend the full
     runtime prelude. -/
-public def translateCombinedLaurel (combined : Laurel.Program)
+public def translateCombinedLaurel (combined : Laurel.Program) (keepAllFilesPrefix : Option String := none)
     : IO (Option Core.Program × List DiagnosticModel) := do
-  let (coreOption, errors, _, _) ← translateCombinedLaurelWithLowered combined
+  let (coreOption, errors, _, _) ← translateCombinedLaurelWithLowered combined keepAllFilesPrefix
   return (coreOption, errors)
 
 /-- Run the pyAnalyzeLaurel pipeline: read a Python Ion program,
diff --git a/StrataPython/StrataPython/PythonDialect.lean b/StrataPython/StrataPython/PythonDialect.lean
index be00dcead9..b619a2a55b 100644
--- a/StrataPython/StrataPython/PythonDialect.lean
+++ b/StrataPython/StrataPython/PythonDialect.lean
@@ -14,7 +14,7 @@ open StrataDDM
 
 public section
 namespace StrataPython
-#load_dialect "../Tools/Python/dialects/Python.dialect.st.ion"
+#load_dialect "Tools/strata-python/dialects/Python.dialect.st.ion"
 
 #strata_gen Python
 
diff --git a/StrataPython/StrataPython/PythonToCore.lean b/StrataPython/StrataPython/PythonToCore.lean
index a9a8e2e58e..13dfe048c5 100644
--- a/StrataPython/StrataPython/PythonToCore.lean
+++ b/StrataPython/StrataPython/PythonToCore.lean
@@ -784,7 +784,7 @@ def translateFunctions (a : Array (stmt SourceRange)) (translation_ctx: Translat
                inputs := [],
                outputs := [("maybe_except", (.tcons "ExceptOrNone" []))]},
         spec := default,
-        body := varDecls ++ [.block "end" ((ArrPyStmtToCore translation_ctx body.val).fst) .empty]
+        body := .structured (varDecls ++ [.block "end" ((ArrPyStmtToCore translation_ctx body.val).fst) .empty])
       }
       some (.proc proc .empty)
     | _ => none)
@@ -815,7 +815,7 @@ def pythonFuncToCore (name : String) (args: List (String × String)) (body: Arra
                inputs,
                outputs},
     spec,
-    body
+    body := .structured body
   }
 
 def unpackPyArguments (args: arguments SourceRange) : List (String × String) :=
diff --git a/StrataPython/StrataPython/PythonToLaurel.lean b/StrataPython/StrataPython/PythonToLaurel.lean
index 09343582aa..c01919b418 100644
--- a/StrataPython/StrataPython/PythonToLaurel.lean
+++ b/StrataPython/StrataPython/PythonToLaurel.lean
@@ -1815,7 +1815,7 @@ partial def translateStmt (ctx : TranslationContext) (s : stmt SourceRange)
     let whileWrapped := mkStmtExprMdWithLoc (StmtExpr.Block [whileStmt] (some breakLabel)) md
     return (loopCtx, preamble ++ [whileWrapped])
 
-  -- Return statement: assign to the LaurelResult output parameter, then exit $body.
+  -- Return statement: assign to the LaurelResult output parameter, then exit the body block.
   | .Return _ value => do
     let stmts ← match value.val with
       | some expr => do
@@ -1824,8 +1824,8 @@ partial def translateStmt (ctx : TranslationContext) (s : stmt SourceRange)
         -- Coerce Composite return values to Any for LaurelResult : Any
         let eRef ← coerceToAny ctx expr eRef
         let assign := mkStmtExprMdWithLoc (StmtExpr.Assign [mkVariableMd (.Local PyLauFuncReturnVar)] eRef) md
-        .ok $ preamble ++ [assign, mkStmtExprMdWithLoc (StmtExpr.Exit "$body") md]
-      | none => .ok [mkStmtExprMdWithLoc (StmtExpr.Exit "$body") md]
+        .ok $ preamble ++ [assign, mkStmtExprMdWithLoc (StmtExpr.Exit bodyLabel) md]
+      | none => .ok [mkStmtExprMdWithLoc (StmtExpr.Exit bodyLabel) md]
     return (ctx, stmts)
 
   -- Assert statement
@@ -2063,7 +2063,7 @@ partial def translateStmt (ctx : TranslationContext) (s : stmt SourceRange)
             let assumeInRange := mkStmtExprMdWithLoc (.Assume inRangeExpr) md
             pure [assumeTypeInt, assumeInRange]
           | _ =>
-            let targetInIter := mkStmtExprMd (.StaticCall "PIn" [targetVar, iterExpr])
+            let targetInIter := mkStmtExprMdWithLoc (.StaticCall "PIn" [targetVar, iterExpr]) md
             let assumeInStmt := mkStmtExprMdWithLoc (.Assume (Any_to_bool targetInIter)) md
             pure [assumeInStmt]
       | _ => pure []
@@ -2731,8 +2731,6 @@ def getHighTypeName : Laurel.HighType → String
   | .TString => "string"
   | .TVoid => "void"
   | .TFloat64 => "real"
-  | .THeap => "Heap"
-  | .TTypedField _ => "Field"
   | .TCore s => s
   | .UserDefined name => name.text
   | .TSet _ => "Map"
diff --git a/StrataPython/StrataPython/ReadPython.lean b/StrataPython/StrataPython/ReadPython.lean
index 591cd1f1da..988f3eaa20 100644
--- a/StrataPython/StrataPython/ReadPython.lean
+++ b/StrataPython/StrataPython/ReadPython.lean
@@ -61,13 +61,13 @@ private def runWithOptions {α} (options : PythonToStrataOptions) (label : Strin
   let _ ← IO.eprintln s!"[perf] {label}: {elapsedMs}ms" |>.toBaseIO
   pure result
 
-/-- Runs `python -m strata.gen py_to_strata` to convert a Python file into a Strata file. -/
+/-- Runs `python -m strata_python.gen py_to_strata` to convert a Python file into a Strata file. -/
 private def runPyToStrata (pythonCmd : String) (extraPythonArgs : Array String)
     (dialectFile pythonFile strataFile : System.FilePath)
     : EIO String Unit := do
   let spawnArgs : IO.Process.SpawnArgs := {
       cmd := pythonCmd
-      args := extraPythonArgs ++ #["-m", "strata.gen", "py_to_strata",
+      args := extraPythonArgs ++ #["-m", "strata_python.gen", "py_to_strata",
           "--dialect", dialectFile.toString,
           pythonFile.toString,
           strataFile.toString
@@ -99,7 +99,7 @@ private def runPyToStrata (pythonCmd : String) (extraPythonArgs : Array String)
     if let some msg := formatParseFailureStderr stderr then
       throw <| s!"{pythonFile} parse error:\n  {msg}"
   if exitCode ≠ 0 then
-    let msg := s!"Internal: Python strata.gen failed (exitCode = {exitCode})\n"
+    let msg := s!"Internal: Python strata_python.gen failed (exitCode = {exitCode})\n"
     let msg := s!"{msg}Standard output:\n"
     let msg := stdout.splitOn.foldl (init := msg) fun msg ln => s!"{msg}  {ln}\n"
     let msg := s!"{msg}Standard error:\n"
@@ -119,7 +119,7 @@ def readPythonStrata (strataPath : String) : EIO String (Array (stmt StrataDDM.S
   | .error msg => throw msg
 
 /--
-This runs `python -m strata.gen py_to_strata` to convert a
+This runs `python -m strata_python.gen py_to_strata` to convert a
 Python file into a Strata file, and then reads it in.
 
 This function fails if the environment isn't configured correctly
diff --git a/StrataPython/StrataPythonTest/CorePreludeTest.lean b/StrataPython/StrataPythonTest/CorePreludeTest.lean
index f051416e7c..832c819980 100644
--- a/StrataPython/StrataPythonTest/CorePreludeTest.lean
+++ b/StrataPython/StrataPythonTest/CorePreludeTest.lean
@@ -18,7 +18,7 @@ Test that the Python CorePrelude can be serialized to Ion format and
 deserialized back without loss of information.
 -/
 private def testCorePreludeRoundTrip : Bool :=
-  let prelude := corePrelude
+  let prelude : Program := corePrelude
   let bytes := prelude.toIon
   match Program.fromIon Strata.Core_map Strata.Core.name bytes with
   | .ok pgm => pgm.commands.size == prelude.commands.size
diff --git a/StrataPython/StrataPythonTest/README.md b/StrataPython/StrataPythonTest/README.md
index 4376b5988d..6f645d5305 100644
--- a/StrataPython/StrataPythonTest/README.md
+++ b/StrataPython/StrataPythonTest/README.md
@@ -12,14 +12,14 @@ Python programs through Laurel to Core for SMT verification.
 
 2. **Install the Python bindings** (requires CPython 3.14):
    ```
-   cd Tools/Python
+   cd StrataPython/Tools/strata-python
    pip install .
    ```
 
 3. **Generate the Python dialect file** (one-time setup):
    ```
-   cd Tools/Python
-   python -m strata.gen dialect dialects
+   cd StrataPython/Tools/strata-python
+   python -m strata_python.gen dialect dialects
    ```
 
 ## Pipeline Overview
@@ -58,11 +58,11 @@ Source program (.py)                  PySpec library stubs (.py)
 Translate a Python source file to a Strata Ion program file:
 
 ```
-cd Tools/Python
-python -m strata.gen py_to_strata \
+cd StrataPython/Tools/strata-python
+python -m strata_python.gen py_to_strata \
    --dialect dialects/Python.dialect.st.ion \
-   ../../StrataPython/StrataPythonTest/test.py \
-   ../../StrataPython/StrataPythonTest/test.python.st.ion
+   ../../StrataPythonTest/test.py \
+   ../../StrataPythonTest/test.python.st.ion
 ```
 
 The output `.python.st.ion` file contains the Python AST in Strata's Ion
diff --git a/StrataPython/StrataPythonTest/TestExamples.lean b/StrataPython/StrataPythonTest/TestExamples.lean
index 3f2c9438ff..1ca20648ad 100644
--- a/StrataPython/StrataPythonTest/TestExamples.lean
+++ b/StrataPython/StrataPythonTest/TestExamples.lean
@@ -31,7 +31,7 @@ def withPythonToLaurel (pythonCmd : System.FilePath) (input : InputContext)
     let ionFile := tmpDir / "test.python.st.ion"
     let child ← IO.Process.spawn {
       cmd := pythonCmd.toString
-      args := #["-m", "strata.gen", "py_to_strata",
+      args := #["-m", "strata_python.gen", "py_to_strata",
                 "--dialect", dialectFile.toString,
                 pyFile.toString, ionFile.toString]
       inheritEnv := true
@@ -62,7 +62,7 @@ public def processPythonToLaurel (pythonCmd : System.FilePath) (input : InputCon
     (Python → Ion → Laurel → Core → verify) and return diagnostics.
 
     The `input` should contain raw Python source code. The `pythonCmd`
-    must point to a Python 3 interpreter with `strata.gen` installed. -/
+    must point to a Python 3 interpreter with `strata_python.gen` installed. -/
 public def processPythonFile (pythonCmd : System.FilePath) (input : InputContext)
     : IO (Array Diagnostic) := do
   withPythonToLaurel pythonCmd input fun laurel pyFile => do
diff --git a/StrataPython/StrataPythonTest/ToLaurelTest.lean b/StrataPython/StrataPythonTest/ToLaurelTest.lean
index cb693b450b..f44e423ba5 100644
--- a/StrataPython/StrataPythonTest/ToLaurelTest.lean
+++ b/StrataPython/StrataPythonTest/ToLaurelTest.lean
@@ -64,8 +64,6 @@ private def fmtHighType : HighType → String
   | .TReal => "TReal"
   | .TFloat64 => "TFloat64"
   | .TString => "TString"
-  | .THeap => "THeap"
-  | .TTypedField _ => "TTypedField"
   | .TSet _ => "TSet"
   | .TMap _ _ => "TMap"
   | .UserDefined name => s!"UserDefined({name})"
diff --git a/StrataPython/StrataPythonTest/Util/Python.lean b/StrataPython/StrataPythonTest/Util/Python.lean
index bf088ddf1f..ae496b461b 100644
--- a/StrataPython/StrataPythonTest/Util/Python.lean
+++ b/StrataPython/StrataPythonTest/Util/Python.lean
@@ -200,11 +200,11 @@ def findPython3 (minVersion : Nat) (maxVersion : Nat) : IO System.FilePath := do
 
   throw <| IO.userError s!"Python 3.{minVersion} or later not found."
 
-/-- Run an action with a Python 3 command that has `strata.gen` installed.
-    Throws if Python is unavailable or `strata.gen` is not installed. -/
+/-- Run an action with a Python 3 command that has `strata_python.gen` installed.
+    Throws if Python is unavailable or `strata_python.gen` is not installed. -/
 def withPython (action : System.FilePath → IO Unit) : IO Unit := do
   let pythonCmd ← findPython3 (minVersion := 11) (maxVersion := 14)
-  if not (← pythonCheckModule pythonCmd "strata.gen") then
+  if not (← pythonCheckModule pythonCmd "strata_python.gen") then
     throw <| .userError
       s!"Python Strata libraries not installed in {pythonCmd}."
   action pythonCmd
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_class_empty.expected b/StrataPython/StrataPythonTest/expected_laurel/test_class_empty.expected
index aab04f3a0d..7f98693936 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_class_empty.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_class_empty.expected
@@ -1,4 +1,4 @@
-test_class_empty.py(5, 4): ✅ pass - callElimAssert_requires_4
+test_class_empty.py(5, 4): ✅ pass - precondition
 test_class_empty.py(6, 4): ✅ pass - empty class instantiated
 DETAIL: 2 passed, 0 failed, 0 inconclusive
 RESULT: Analysis success
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_class_field_init.expected b/StrataPython/StrataPythonTest/expected_laurel/test_class_field_init.expected
index 7cb1e2fc89..4757a64ef8 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_class_field_init.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_class_field_init.expected
@@ -1,2 +1,4 @@
-DETAIL: 0 passed, 0 failed, 0 inconclusive
+test_class_field_init.py(20, 4): ✔️ always true if reached - (CircularBuffer@__init__ requires) Type constraint of size
+test_class_field_init.py(20, 4): ✔️ always true if reached - (CircularBuffer@__init__ requires) Type constraint of name
+DETAIL: 2 passed, 0 failed, 0 inconclusive
 RESULT: Analysis success
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_class_field_use.expected b/StrataPython/StrataPythonTest/expected_laurel/test_class_field_use.expected
index 0caaf75c9f..29a689ea2c 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_class_field_use.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_class_field_use.expected
@@ -1,5 +1,6 @@
+test_class_field_use.py(13, 4): ✔️ always true if reached - (CircularBuffer@__init__ requires) Type constraint of n
 test_class_field_use.py(14, 4): ✔️ always true if reached - Check PMul exception
 test_class_field_use.py(14, 4): ✔️ always true if reached - assert(302)
 test_class_field_use.py(15, 4): ✔️ always true if reached - Doubling of buffer did not work
-DETAIL: 3 passed, 0 failed, 0 inconclusive
+DETAIL: 4 passed, 0 failed, 0 inconclusive
 RESULT: Analysis success
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_class_methods.expected b/StrataPython/StrataPythonTest/expected_laurel/test_class_methods.expected
index 36c53a8361..f0601e776e 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_class_methods.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_class_methods.expected
@@ -1,11 +1,17 @@
-test_class_methods.py(34, 4): ✔️ always true if reached - main_assert(471)_13
+test_class_methods.py(34, 4): ✔️ always true if reached - (Account@__init__ requires) Type constraint of owner
+test_class_methods.py(34, 4): ✔️ always true if reached - (Account@__init__ requires) Type constraint of balance
+test_class_methods.py(34, 4): ✔️ always true if reached - main_assert(471)_32
 test_class_methods.py(34, 4): ✔️ always true if reached - get_owner should return Alice
-test_class_methods.py(34, 4): ✔️ always true if reached - main_assert(564)_15
+test_class_methods.py(34, 4): ✔️ always true if reached - main_assert(564)_35
 test_class_methods.py(34, 4): ✔️ always true if reached - get_balance should return 100
-test_class_methods.py(34, 4): ✔️ always true if reached - main_assert(678)_17
+test_class_methods.py(34, 4): ✔️ always true if reached - (Account@set_balance requires) Type constraint of amount
+test_class_methods.py(34, 4): ✔️ always true if reached - main_assert(678)_40
 test_class_methods.py(34, 4): ✔️ always true if reached - set_balance should update balance
+test_class_methods.py(34, 4): ✔️ always true if reached - (Origin_test_helper_procedure_Requires)req_name_is_foo
+test_class_methods.py(34, 4): ✔️ always true if reached - (Origin_test_helper_procedure_Requires)req_opt_name_none_or_str
+test_class_methods.py(34, 4): ✔️ always true if reached - (Origin_test_helper_procedure_Requires)req_opt_name_none_or_bar
 test_class_methods.py(31, 4): ✔️ always true if reached - assert_name_is_foo
 test_class_methods.py(31, 4): ✔️ always true if reached - assert_opt_name_none_or_str
 test_class_methods.py(31, 4): ✔️ always true if reached - assert_opt_name_none_or_bar
-DETAIL: 9 passed, 0 failed, 0 inconclusive
+DETAIL: 15 passed, 0 failed, 0 inconclusive
 RESULT: Analysis success
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_class_mixed_init.expected b/StrataPython/StrataPythonTest/expected_laurel/test_class_mixed_init.expected
index 766329f9a4..1966e6aa7b 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_class_mixed_init.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_class_mixed_init.expected
@@ -1,4 +1,6 @@
+test_class_mixed_init.py(19, 0): ✔️ always true if reached - (WithInit@__init__ requires) Type constraint of x
 test_class_mixed_init.py(19, 0): ✔️ always true if reached - class with init
-test_class_mixed_init.py(19, 0): ❓ unknown - class with init
-DETAIL: 1 passed, 0 failed, 1 inconclusive
-RESULT: Inconclusive
+test_class_mixed_init.py(19, 0): ✔️ always true if reached - precondition
+test_class_mixed_init.py(19, 0): ✔️ always true if reached - class with init
+DETAIL: 4 passed, 0 failed, 0 inconclusive
+RESULT: Analysis success
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init.expected b/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init.expected
index 7228247375..a55c76cfe4 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init.expected
@@ -1,4 +1,4 @@
-test_class_no_init.py(5, 4): ✅ pass - callElimAssert_requires_4
+test_class_no_init.py(5, 4): ✅ pass - precondition
 test_class_no_init.py(6, 4): ❓ unknown - class without __init__
 DETAIL: 1 passed, 0 failed, 1 inconclusive
 RESULT: Inconclusive
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init_multi_field.expected b/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init_multi_field.expected
index 3dbe40b3b6..13ba7f459b 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init_multi_field.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init_multi_field.expected
@@ -1,4 +1,4 @@
-test_class_no_init_multi_field.py(7, 4): ✅ pass - callElimAssert_requires_4
+test_class_no_init_multi_field.py(7, 4): ✅ pass - precondition
 test_class_no_init_multi_field.py(8, 4): ✅ pass - class with multiple annotated fields no init
 DETAIL: 2 passed, 0 failed, 0 inconclusive
 RESULT: Analysis success
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init_with_method.expected b/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init_with_method.expected
index 29b6682a29..93f5036c2d 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init_with_method.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_class_no_init_with_method.expected
@@ -1,5 +1,5 @@
 test_class_no_init_with_method.py(4, 23): ❓ unknown - (WithMethod@get_x ensures) Return type constraint
-test_class_no_init_with_method.py(8, 4): ✅ pass - callElimAssert_requires_4
+test_class_no_init_with_method.py(8, 4): ✅ pass - precondition
 test_class_no_init_with_method.py(9, 4): ✅ pass - class with method but no __init__
 DETAIL: 2 passed, 0 failed, 1 inconclusive
 RESULT: Inconclusive
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_class_with_methods.expected b/StrataPython/StrataPythonTest/expected_laurel/test_class_with_methods.expected
index 1085e02e58..3f5ddaf665 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_class_with_methods.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_class_with_methods.expected
@@ -1,9 +1,15 @@
-test_class_with_methods.py(32, 4): ✔️ always true if reached - main_assert(484)_12
+test_class_with_methods.py(32, 4): ✔️ always true if reached - (DataStore@__init__ requires) Type constraint of name
+test_class_with_methods.py(32, 4): ✔️ always true if reached - (DataStore@add requires) Type constraint of amount
+test_class_with_methods.py(32, 4): ✔️ always true if reached - (DataStore@add requires) Type constraint of amount
+test_class_with_methods.py(32, 4): ✔️ always true if reached - main_assert(484)_34
 test_class_with_methods.py(32, 4): ✔️ always true if reached - get_count should return 30
-test_class_with_methods.py(32, 4): ✔️ always true if reached - main_assert(569)_14
+test_class_with_methods.py(32, 4): ✔️ always true if reached - main_assert(569)_37
 test_class_with_methods.py(32, 4): ✔️ always true if reached - get_name should return mystore
+test_class_with_methods.py(32, 4): ✔️ always true if reached - (Origin_test_helper_procedure_Requires)req_name_is_foo
+test_class_with_methods.py(32, 4): ✔️ always true if reached - (Origin_test_helper_procedure_Requires)req_opt_name_none_or_str
+test_class_with_methods.py(32, 4): ✔️ always true if reached - (Origin_test_helper_procedure_Requires)req_opt_name_none_or_bar
 test_class_with_methods.py(29, 4): ✔️ always true if reached - assert_name_is_foo
 test_class_with_methods.py(29, 4): ✔️ always true if reached - assert_opt_name_none_or_str
 test_class_with_methods.py(29, 4): ✔️ always true if reached - assert_opt_name_none_or_bar
-DETAIL: 7 passed, 0 failed, 0 inconclusive
+DETAIL: 13 passed, 0 failed, 0 inconclusive
 RESULT: Analysis success
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_deep_inline.expected b/StrataPython/StrataPythonTest/expected_laurel/test_deep_inline.expected
index eac560309d..bc3395d77d 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_deep_inline.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_deep_inline.expected
@@ -1,11 +1,15 @@
+test_deep_inline.py(21, 4): ✔️ always true if reached - (triple_apply requires) Type constraint of x
+test_deep_inline.py(15, 4): ✔️ always true if reached - (double_inc requires) Type constraint of x
+test_deep_inline.py(10, 4): ✔️ always true if reached - (inc requires) Type constraint of x
 test_deep_inline.py(6, 4): ✔️ always true if reached - Check PAdd exception
-test_deep_inline.py(10, 4): ✔️ always true if reached - double_inc_assert(135)_35
+test_deep_inline.py(10, 4): ✔️ always true if reached - double_inc_assert(135)_54
 test_deep_inline.py(10, 4): ✔️ always true if reached - Check PMul exception
-test_deep_inline.py(15, 4): ✔️ always true if reached - triple_apply_assert(206)_17
+test_deep_inline.py(15, 4): ✔️ always true if reached - triple_apply_assert(206)_27
+test_deep_inline.py(15, 4): ✔️ always true if reached - (inc requires) Type constraint of x
 test_deep_inline.py(11, 4): ✔️ always true if reached - Check PAdd exception
-test_deep_inline.py(15, 4): ✔️ always true if reached - triple_apply_assert(233)_18
-test_deep_inline.py(21, 4): ✔️ always true if reached - main_assert(279)_5
+test_deep_inline.py(15, 4): ✔️ always true if reached - triple_apply_assert(233)_30
+test_deep_inline.py(21, 4): ✔️ always true if reached - main_assert(279)_9
 test_deep_inline.py(21, 4): ✔️ always true if reached - triple_apply(3) should be 9
 test_deep_inline.py(21, 4): ✖️ always false if reached - triple_apply(3) should not be 10
-DETAIL: 8 passed, 1 failed, 0 inconclusive
+DETAIL: 12 passed, 1 failed, 0 inconclusive
 RESULT: Failures found
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_havoc_callee_after_hole_call.expected b/StrataPython/StrataPythonTest/expected_laurel/test_havoc_callee_after_hole_call.expected
index 9a320c707c..85efc6288d 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_havoc_callee_after_hole_call.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_havoc_callee_after_hole_call.expected
@@ -2,9 +2,10 @@ test_havoc_callee_after_hole_call.py(8, 0): ❓ unknown - expected unknown becau
 test_havoc_callee_after_hole_call.py(12, 0): ❓ unknown - expected unknown because xs should be havocked
 test_havoc_callee_after_hole_call.py(16, 0): ✔️ always true if reached - chained call: receiver not havocked (chained attribute is not a Name)
 test_havoc_callee_after_hole_call.py(20, 0): ✔️ always true if reached - unrelated variable: nothing should be havocked
+test_havoc_callee_after_hole_call.py(22, 0): ✔️ always true if reached - (MyClass@__init__ requires) Type constraint of n
 test_havoc_callee_after_hole_call.py(25, 0): ✔️ always true if reached - composite arg: heap not havocked (out of scope)
 test_havoc_callee_after_hole_call.py(30, 0): ❓ unknown - expected unknown because argument locals should be havocked
 test_havoc_callee_after_hole_call.py(36, 0): ❓ unknown - assume_assume(1193)_calls_PIn_0
 test_havoc_callee_after_hole_call.py(37, 4): ✔️ always true if reached - for-loop over unmodeled iterator should not crash
-DETAIL: 4 passed, 0 failed, 4 inconclusive
+DETAIL: 5 passed, 0 failed, 4 inconclusive
 RESULT: Inconclusive
diff --git a/StrataPython/StrataPythonTest/expected_laurel/test_with_statement.expected b/StrataPython/StrataPythonTest/expected_laurel/test_with_statement.expected
index c73e76d8cb..8948ea9e4e 100644
--- a/StrataPython/StrataPythonTest/expected_laurel/test_with_statement.expected
+++ b/StrataPython/StrataPythonTest/expected_laurel/test_with_statement.expected
@@ -1,9 +1,13 @@
+test_with_statement.py(16, 4): ✔️ always true if reached - (Resource@__init__ requires) Type constraint of n
 test_with_statement.py(17, 4): ✔️ always true if reached - assert(364)
 test_with_statement.py(20, 4): ✔️ always true if reached - assert(426)
+test_with_statement.py(23, 4): ✔️ always true if reached - (Resource@__init__ requires) Type constraint of n
 test_with_statement.py(25, 8): ✔️ always true if reached - assert(525)
 test_with_statement.py(26, 8): ✔️ always true if reached - assert(558)
+test_with_statement.py(29, 4): ✔️ always true if reached - (Resource@__init__ requires) Type constraint of n
+test_with_statement.py(30, 4): ✔️ always true if reached - (Resource@__init__ requires) Type constraint of n
 test_with_statement.py(32, 21): ✔️ always true if reached - Check PAdd exception
 test_with_statement.py(32, 8): ✔️ always true if reached - assert(697)
 test_with_statement.py(33, 8): ✔️ always true if reached - assert(724)
-DETAIL: 7 passed, 0 failed, 0 inconclusive
+DETAIL: 11 passed, 0 failed, 0 inconclusive
 RESULT: Analysis success
diff --git a/StrataPython/StrataPythonTest/run_py_analyze.sh b/StrataPython/StrataPythonTest/run_py_analyze.sh
index 3925456361..87f5893bd2 100755
--- a/StrataPython/StrataPythonTest/run_py_analyze.sh
+++ b/StrataPython/StrataPythonTest/run_py_analyze.sh
@@ -59,7 +59,7 @@ for test_file in tests/test_*.py; do
         expected_file="${expected_dir}/${base_name}.expected"
 
         if [ -f "$expected_file" ]; then
-            (cd ../../Tools/Python && python3 -m strata.gen py_to_strata --dialect "dialects/Python.dialect.st.ion" "../../StrataPython/StrataPythonTest/$test_file" "../../StrataPython/StrataPythonTest/$ion_file")
+            (cd ../Tools/strata-python && python3 -m strata_python.gen py_to_strata --dialect "dialects/Python.dialect.st.ion" "../../StrataPythonTest/$test_file" "../../StrataPythonTest/$ion_file")
 
             # Check for per-file strata arguments (e.g. # strata-args: --check-mode bugFinding)
             extra_args=$(grep '^# strata-args:' "$test_file" | sed 's/^# strata-args://' | head -1)
@@ -151,7 +151,7 @@ if [ $pending -eq 1 ]; then
         pending_total=$((pending_total + 1))
         ion_file="tests/pending/${base_name}.python.st.ion"
 
-        parse_output=$(cd ../../Tools/Python && python3 -m strata.gen py_to_strata --dialect "dialects/Python.dialect.st.ion" "../../StrataPython/StrataPythonTest/$test_file" "../../StrataPython/StrataPythonTest/$ion_file" 2>&1)
+        parse_output=$(cd ../Tools/strata-python && python3 -m strata_python.gen py_to_strata --dialect "dialects/Python.dialect.st.ion" "../../StrataPythonTest/$test_file" "../../StrataPythonTest/$ion_file" 2>&1)
         parse_exit=$?
 
         if [ $parse_exit -ne 0 ]; then
diff --git a/StrataPython/StrataPythonTest/run_py_analyze_sarif.py b/StrataPython/StrataPythonTest/run_py_analyze_sarif.py
index 0427f10ca0..7d035644b3 100755
--- a/StrataPython/StrataPythonTest/run_py_analyze_sarif.py
+++ b/StrataPython/StrataPythonTest/run_py_analyze_sarif.py
@@ -50,12 +50,12 @@ def run(test_file: str) -> bool:
     # Generate Ion file
     subprocess.run(
         [
-            sys.executable, "-m", "strata.gen", "py_to_strata",
+            sys.executable, "-m", "strata_python.gen", "py_to_strata",
             "--dialect", "dialects/Python.dialect.st.ion",
             str(test_path),
             str(ion_abs),
         ],
-        cwd=REPO_ROOT / "Tools" / "Python",
+        cwd=STRATA_PYTHON_DIR / "Tools" / "strata-python",
         check=True,
     )
 
diff --git a/StrataPython/StrataPythonTest/run_py_cbmc_tests.sh b/StrataPython/StrataPythonTest/run_py_cbmc_tests.sh
index b6ac19d229..d5e3272ad7 100755
--- a/StrataPython/StrataPythonTest/run_py_cbmc_tests.sh
+++ b/StrataPython/StrataPythonTest/run_py_cbmc_tests.sh
@@ -12,7 +12,7 @@ SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)"
 TESTS_DIR="$SCRIPT_DIR/tests"
 EXPECTED="$TESTS_DIR/cbmc_expected.txt"
 STRATA_PYTHON_DIR="$(cd "$SCRIPT_DIR/.." && pwd)"
-DIALECT="$STRATA_PYTHON_DIR/../Tools/Python/dialects/Python.dialect.st.ion"
+DIALECT="$STRATA_PYTHON_DIR/Tools/strata-python/dialects/Python.dialect.st.ion"
 PYTHON=${PYTHON:-python3}
 
 # Generate .py.ion files from .py sources (they are not committed)
@@ -20,8 +20,8 @@ echo "Generating .py.ion files from .py sources..."
 for py_file in "$TESTS_DIR"/*.py; do
   [ -f "$py_file" ] || continue
   ion_file="${py_file}.ion"
-  if ! (cd "$STRATA_PYTHON_DIR/../Tools/Python" && \
-        "$PYTHON" -m strata.gen py_to_strata --dialect "$DIALECT" "$py_file" "$ion_file") 2>/dev/null; then
+  if ! (cd "$STRATA_PYTHON_DIR/Tools/strata-python" && \
+        "$PYTHON" -m strata_python.gen py_to_strata --dialect "$DIALECT" "$py_file" "$ion_file") 2>/dev/null; then
     echo "  WARN: failed to generate $(basename "$ion_file")"
   fi
 done
diff --git a/StrataPython/StrataPythonTest/run_py_interpret.sh b/StrataPython/StrataPythonTest/run_py_interpret.sh
index 7323bebe91..d52023ec9b 100755
--- a/StrataPython/StrataPythonTest/run_py_interpret.sh
+++ b/StrataPython/StrataPythonTest/run_py_interpret.sh
@@ -22,7 +22,6 @@ SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)"
 TESTS_DIR="$SCRIPT_DIR/tests"
 EXPECTED_DIR="$SCRIPT_DIR/expected_interpret"
 STRATA_PYTHON_DIR="$(cd "$SCRIPT_DIR/.." && pwd)"
-PROJECT_ROOT="$(cd "$STRATA_PYTHON_DIR/.." && pwd)"
 
 passed=0
 errors=0
@@ -70,7 +69,7 @@ for test_file in "$TESTS_DIR"/test_*.py; do
     fi
 
     # Compile Python to Ion
-    if ! (cd "$PROJECT_ROOT/Tools/Python" && python3 -m strata.gen py_to_strata \
+    if ! (cd "$STRATA_PYTHON_DIR/Tools/strata-python" && python3 -m strata_python.gen py_to_strata \
         --dialect "dialects/Python.dialect.st.ion" \
         "$test_file" "$ion_file") 2>/dev/null; then
         echo "SKIP (parse): $base_name"
diff --git a/StrataPython/StrataPythonTestExtra/AnalyzeLaurelTest.lean b/StrataPython/StrataPythonTestExtra/AnalyzeLaurelTest.lean
index c24af0dde5..898d069c8d 100644
--- a/StrataPython/StrataPythonTestExtra/AnalyzeLaurelTest.lean
+++ b/StrataPython/StrataPythonTestExtra/AnalyzeLaurelTest.lean
@@ -42,7 +42,7 @@ meta def compilePython
   let ionPath := outDir / s!"{stem}.python.st.ion"
   let spawnArgs : IO.Process.SpawnArgs := {
     cmd := toString pythonCmd
-    args := #["-m", "strata.gen", "py_to_strata",
+    args := #["-m", "strata_python.gen", "py_to_strata",
               "--dialect", dialectFile.toString,
               pyFile.toString, ionPath.toString]
     cwd := none
@@ -370,10 +370,9 @@ Without the attribute, the regex VC would be ❓ unknown. -/
     | .error msg => throw <| IO.userError s!"Pipeline failed: {msg}"
     | .ok vcResults =>
       for r in vcResults do
-        if r.obligation.label.startsWith "servicelib_Storage_" then
-          if !r.isSuccess then
-            throw <| IO.userError
-              s!"Expected all Storage preconditions to pass but got: {r.formatOutcome}"
+        if !r.isSuccess then
+          throw <| IO.userError
+            s!"Expected all Storage preconditions to pass but got: {r.formatOutcome}"
 
 /-! ## Resolution error test after FilterPrelude
 
diff --git a/StrataPython/StrataPythonTestExtra/PropertySummaryTest.lean b/StrataPython/StrataPythonTestExtra/PropertySummaryTest.lean
index 8fbf39fbbc..2e1d33aeed 100644
--- a/StrataPython/StrataPythonTestExtra/PropertySummaryTest.lean
+++ b/StrataPython/StrataPythonTestExtra/PropertySummaryTest.lean
@@ -30,7 +30,7 @@ meta def getPropertySummaries (pythonCmd : System.FilePath) (source : String)
     let ionFile := tmpDir / "test.python.st.ion"
     let child ← IO.Process.spawn {
       cmd := pythonCmd.toString
-      args := #["-m", "strata.gen", "py_to_strata",
+      args := #["-m", "strata_python.gen", "py_to_strata",
                 "--dialect", dialectFile.toString,
                 pyFile.toString, ionFile.toString]
       inheritEnv := true
diff --git a/StrataPython/StrataPythonTestExtra/Specs/IdentifyOverloadsTest.lean b/StrataPython/StrataPythonTestExtra/Specs/IdentifyOverloadsTest.lean
index b958c5acdb..53c3ab801d 100644
--- a/StrataPython/StrataPythonTestExtra/Specs/IdentifyOverloadsTest.lean
+++ b/StrataPython/StrataPythonTestExtra/Specs/IdentifyOverloadsTest.lean
@@ -40,7 +40,7 @@ private meta def compilePython
     let ionPath := outDir / s!"{stem}.python.st.ion"
     let spawnArgs : IO.Process.SpawnArgs := {
       cmd := toString pythonCmd
-      args := #["-m", "strata.gen", "py_to_strata",
+      args := #["-m", "strata_python.gen", "py_to_strata",
                 "--dialect", dialectFile.toString,
                 pyFile.toString, ionPath.toString]
       cwd := none
diff --git a/Tools/Python/.gitignore b/StrataPython/Tools/strata-python/.gitignore
similarity index 100%
rename from Tools/Python/.gitignore
rename to StrataPython/Tools/strata-python/.gitignore
diff --git a/Tools/Python/PythonDialect.md b/StrataPython/Tools/strata-python/PythonDialect.md
similarity index 92%
rename from Tools/Python/PythonDialect.md
rename to StrataPython/Tools/strata-python/PythonDialect.md
index 73c9fb76bb..5c410d94d2 100644
--- a/Tools/Python/PythonDialect.md
+++ b/StrataPython/Tools/strata-python/PythonDialect.md
@@ -49,22 +49,22 @@ A few Python field names conflict with DDM reserved words and are renamed:
 
 ## Installation
 
-Install the `strata` package from the `Tools/Python` directory:
+Install both packages from the repo root:
 
 ```
-pip install .
+pip install ./Tools/Python-base ./StrataPython/Tools/strata-python
 ```
 
 This requires Python 3.11 or later and installs the `amazon.ion` dependency.
 
 ## Command-Line Interface
 
-The `strata.gen` module provides a CLI accessible via `python -m strata.gen`.
+The `strata_python.gen` module provides a CLI accessible via `python -m strata_python.gen`.
 
 ### Generating the dialect
 
 ```
-python -m strata.gen dialect <output_dir>
+python -m strata_python.gen dialect <output_dir>
 ```
 
 Requires Python 3.13 or later.  Writes `<output_dir>/Python.dialect.st.ion`
@@ -77,7 +77,7 @@ strata check "<output_dir>/Python.dialect.st.ion"
 ### Parsing Python to Strata
 
 ```
-python -m strata.gen py_to_strata [--dialect <path>] <input.py> <output.st.ion>
+python -m strata_python.gen py_to_strata [--dialect <path>] <input.py> <output.st.ion>
 ```
 
 Translates a Python source file into a Strata program in Ion format.  The
@@ -87,7 +87,7 @@ Python >= 3.13, the dialect is generated on the fly.
 Example:
 
 ```
-python -m strata.gen py_to_strata --dialect dialects/Python.dialect.st.ion \
+python -m strata_python.gen py_to_strata --dialect dialects/Python.dialect.st.ion \
     my_script.py my_script.py.st.ion
 ```
 
@@ -102,7 +102,7 @@ Exit code 100 indicates a Python parse failure.
 ### Checking the AST parser
 
 ```
-python -m strata.gen check_ast [--dialect <path>] <dir>
+python -m strata_python.gen check_ast [--dialect <path>] <dir>
 ```
 
 Batch-parses all `.py` files under `<dir>` and reports how many were
diff --git a/StrataPython/Tools/strata-python/README.md b/StrataPython/Tools/strata-python/README.md
new file mode 100644
index 0000000000..48b4adafe2
--- /dev/null
+++ b/StrataPython/Tools/strata-python/README.md
@@ -0,0 +1,36 @@
+# strata-python
+
+Python language support for Strata: the `strata_python.gen` CLI and the
+`strata_python.pythonast` parser API. Translates Python source files to
+Strata Ion programs for downstream analysis.
+
+## Installation
+
+This package depends on `strata` (the core DDM datatypes). Install both:
+
+```
+pip install <path-to-strata-base> <path-to-strata-python>
+```
+
+## Quick Start
+
+The Python dialect may only be generated in CPython 3.13 or later. The
+Strata toolchain assumes the dialect is generated in 3.14. Parsing may
+be done in 3.11+ by pre-generating the dialect in 3.14.
+
+Generate the dialect and parse a Python file:
+
+```
+python -m strata_python.gen dialect dialects
+python -m strata_python.gen py_to_strata --dialect dialects/Python.dialect.st.ion \
+   input.py output.py.st.ion
+```
+
+## Documentation
+
+- [PythonDialect.md](PythonDialect.md) — auto-generated Python dialect,
+  CLI commands, the `strata_python.pythonast` parser API, and Python
+  version compatibility.
+- The [DDM Manual](https://strata-org.github.io/Strata/ddm/html-single/)
+  — DDM concepts and the `strata.base` Python API for working with
+  dialects, programs, and AST types.
diff --git a/Tools/Python/dialects/.gitignore b/StrataPython/Tools/strata-python/dialects/.gitignore
similarity index 100%
rename from Tools/Python/dialects/.gitignore
rename to StrataPython/Tools/strata-python/dialects/.gitignore
diff --git a/Tools/Python/dialects/Python.dialect.st.ion b/StrataPython/Tools/strata-python/dialects/Python.dialect.st.ion
similarity index 100%
rename from Tools/Python/dialects/Python.dialect.st.ion
rename to StrataPython/Tools/strata-python/dialects/Python.dialect.st.ion
diff --git a/StrataPython/Tools/strata-python/pyproject.toml b/StrataPython/Tools/strata-python/pyproject.toml
new file mode 100644
index 0000000000..00cb37c124
--- /dev/null
+++ b/StrataPython/Tools/strata-python/pyproject.toml
@@ -0,0 +1,18 @@
+[project]
+name = "strata-python"
+version = "0.0.1"
+description = "Python language support for Strata."
+requires-python = ">= 3.11"
+dependencies = [
+    "strata"
+]
+
+[tool.hatch.build.targets.wheel]
+packages = ["strata_python"]
+
+[build-system]
+requires = ["hatchling"]
+build-backend = "hatchling.build"
+
+[project.scripts]
+strata-python-gen = "strata_python.gen:main"
diff --git a/Tools/Python/scripts/gen_dialect.sh b/StrataPython/Tools/strata-python/scripts/gen_dialect.sh
similarity index 64%
rename from Tools/Python/scripts/gen_dialect.sh
rename to StrataPython/Tools/strata-python/scripts/gen_dialect.sh
index 413c68e55a..78bc0a8e50 100755
--- a/Tools/Python/scripts/gen_dialect.sh
+++ b/StrataPython/Tools/strata-python/scripts/gen_dialect.sh
@@ -4,11 +4,11 @@ set -e
 
 # Get the directory where this script is located
 script_dir="$(cd "$(dirname "$0")" && pwd)"
-# Change to the parent directory (Tools/Python) so dialects and imports match other scripts
-tools_python_dir="$(cd "$script_dir/.." && pwd)"
-cd "$tools_python_dir"
+# Change to the strata-python package root so dialects and imports work
+strata_python_dir="$(cd "$script_dir/.." && pwd)"
+cd "$strata_python_dir"
 
-strata=../../StrataCLI/.lake/build/bin/strata
+strata=../../../StrataCLI/.lake/build/bin/strata
 
 if [ ! -f $strata ]; then
   echo "strata is not built: $strata"
@@ -19,7 +19,7 @@ dialect_dir="dialects"
 
 mkdir -p "$dialect_dir"
 
-python3 -m strata.gen dialect "$dialect_dir"
+python3 -m strata_python.gen dialect "$dialect_dir"
 $strata print "$dialect_dir/Python.dialect.st.ion" > "$dialect_dir/Python.dialect.st"
 
 $strata check "$dialect_dir/Python.dialect.st.ion"
diff --git a/Tools/Python/scripts/run_cpython_tests.sh b/StrataPython/Tools/strata-python/scripts/run_cpython_tests.sh
similarity index 100%
rename from Tools/Python/scripts/run_cpython_tests.sh
rename to StrataPython/Tools/strata-python/scripts/run_cpython_tests.sh
diff --git a/Tools/Python/scripts/run_test.sh b/StrataPython/Tools/strata-python/scripts/run_test.sh
similarity index 79%
rename from Tools/Python/scripts/run_test.sh
rename to StrataPython/Tools/strata-python/scripts/run_test.sh
index efeea1198a..57897f1a35 100755
--- a/Tools/Python/scripts/run_test.sh
+++ b/StrataPython/Tools/strata-python/scripts/run_test.sh
@@ -14,7 +14,7 @@ fi
 
 test_dir="$PWD/test_results"
 
-strata=../../StrataCLI/.lake/build/bin/strata
+strata=../../../StrataCLI/.lake/build/bin/strata
 
 # Dialect files:
 # dialects/Python.dialect.st.ion
@@ -25,7 +25,7 @@ filename=`basename "$input_path"`
 mkdir -p $test_dir/$input_dir
 
 python=${PYTHON:-python3}
-$python -m strata.gen py_to_strata --dialect "dialects/Python.dialect.st.ion" $input_path "$test_dir/$input_dir/$filename.st.ion"
+$python -m strata_python.gen py_to_strata --dialect "dialects/Python.dialect.st.ion" $input_path "$test_dir/$input_dir/$filename.st.ion"
 
 $strata toIon --include "dialects" "$test_dir/$input_dir/$filename.st.ion" "$test_dir/$input_dir/$filename.st.ion2"
 
diff --git a/StrataPython/Tools/strata-python/strata_python/__init__.py b/StrataPython/Tools/strata-python/strata_python/__init__.py
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/Tools/Python/strata/gen.py b/StrataPython/Tools/strata-python/strata_python/gen.py
similarity index 99%
rename from Tools/Python/strata/gen.py
rename to StrataPython/Tools/strata-python/strata_python/gen.py
index 8ff4339f58..9ad180a65d 100755
--- a/Tools/Python/strata/gen.py
+++ b/StrataPython/Tools/strata-python/strata_python/gen.py
@@ -10,7 +10,7 @@
 import argparse
 from pathlib import Path
 from strata.base import Dialect, Program
-import strata.pythonast as pythonast
+import strata_python.pythonast as pythonast
 import sys
 
 sys.setrecursionlimit(2500)
diff --git a/Tools/Python/strata/pythonast.py b/StrataPython/Tools/strata-python/strata_python/pythonast.py
similarity index 99%
rename from Tools/Python/strata/pythonast.py
rename to StrataPython/Tools/strata-python/strata_python/pythonast.py
index 03232bbb70..bb753e6f5e 100644
--- a/Tools/Python/strata/pythonast.py
+++ b/StrataPython/Tools/strata-python/strata_python/pythonast.py
@@ -12,7 +12,7 @@
 from typing import Any
 import types
 import strata.base as strata
-from .base import ArgDecl, FileMapping, Init, SourceRange, SyntaxCat, reserved
+from strata.base import ArgDecl, FileMapping, Init, SourceRange, SyntaxCat, reserved
 
 @dataclass
 class OpArg:
diff --git a/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean b/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean
index 4330ca090b..351ff97336 100644
--- a/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean
+++ b/StrataTest/Backends/CBMC/GOTO/E2E_CoreToGOTO.lean
@@ -350,13 +350,20 @@ private def injectPropertySummary (stmts : List Core.Statement) (msg : String)
       .cmd (.cmd (.assert label b (md.withPropertySummary msg)))
     | other => other
 
+-- This helper is exercised only against structured Core programs because
+-- `injectPropertySummary` pattern-matches on `Core.Statement`. Adding CFG
+-- support would require an analogous injection over `DetCFG` block commands.
+-- The user-facing two-stage path (structured → CFG → GOTO) already exists as
+-- `procedureToGotoCtxViaCFG`; this helper deliberately uses the direct path
+-- to test summary propagation through the structured pipeline.
 private def coreToGotoJsonWithSummary (p : StrataDDM.Program) (summary : String) :
     Except Std.Format (Lean.Json × Lean.Json) := do
   let cprog := translateCore p
   let Env := Lambda.TEnv.default
   let procs := cprog.decls.filterMap fun d => d.getProc?
   let p := procs[0]!
-  let p' : Core.Procedure := { p with body := injectPropertySummary p.body summary }
+  let bodyStmts ← p.body.getStructured.mapError fun s => f!"{s}"
+  let p' : Core.Procedure := { p with body := .structured (injectPropertySummary bodyStmts summary) }
   let pname := Core.CoreIdent.toPretty p'.header.name
   let ctx ← procedureToGotoCtx Env p'
   let json ← (CoreToGOTO.CProverGOTO.Context.toJson pname ctx.1).mapError (fun e => f!"{e}")
diff --git a/StrataTest/Backends/CBMC/GOTO/test_property_summary_e2e.sh b/StrataTest/Backends/CBMC/GOTO/test_property_summary_e2e.sh
index 47b1871cdc..cfd20dceda 100755
--- a/StrataTest/Backends/CBMC/GOTO/test_property_summary_e2e.sh
+++ b/StrataTest/Backends/CBMC/GOTO/test_property_summary_e2e.sh
@@ -8,7 +8,6 @@ set -eo pipefail
 
 SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)"
 PROJECT_ROOT="$(cd "$SCRIPT_DIR/../../../.." && pwd)"
-LAUREL_TO_CBMC="$PROJECT_ROOT/StrataTest/Languages/Laurel/laurel_to_cbmc.sh"
 
 WORK=$(mktemp -d)
 trap 'rm -rf "$WORK"' EXIT
@@ -26,7 +25,7 @@ procedure main()
 LAUREL
 
 # Run the full pipeline (strata → symtab2gb → goto-cc → goto-instrument → cbmc)
-cbmc_out=$("$LAUREL_TO_CBMC" "$WORK/test.lr.st" 2>&1 || true)
+cbmc_out=$(lake -d "$PROJECT_ROOT" env lean --run "$PROJECT_ROOT/Scripts/LaurelToCBMC.lean" "$WORK/test.lr.st" 2>&1 || true)
 
 # Verify CBMC output contains property summaries
 for summary in "addition equals eight" "difference equals two"; do
diff --git a/StrataTest/Backends/CBMC/cbmc-string-support.patch b/StrataTest/Backends/CBMC/cbmc-string-support.patch
new file mode 100644
index 0000000000..225f336438
--- /dev/null
+++ b/StrataTest/Backends/CBMC/cbmc-string-support.patch
@@ -0,0 +1,61 @@
+diff --git a/src/solvers/smt2/smt2_conv.cpp b/src/solvers/smt2/smt2_conv.cpp
+index e00becc56e..43bd7888d3 100644
+--- a/src/solvers/smt2/smt2_conv.cpp
++++ b/src/solvers/smt2/smt2_conv.cpp
+@@ -2707,8 +2707,24 @@ void smt2_convt::convert_expr(const exprt &expr)
+   else if(expr.id() == ID_function_application)
+   {
+     const auto &function_application_expr = to_function_application_expr(expr);
++
++    // Check for string operations by looking at the function symbol name
++    std::string fn_name;
++    if(function_application_expr.function().id() == ID_symbol)
++      fn_name = id2string(
++        to_symbol_expr(function_application_expr.function()).get_identifier());
++
++    if(fn_name == "Str.Concat" &&
++       function_application_expr.arguments().size() == 2)
++    {
++      out << "(str.++ ";
++      convert_expr(function_application_expr.arguments()[0]);
++      out << ' ';
++      convert_expr(function_application_expr.arguments()[1]);
++      out << ')';
++    }
+     // do not use parentheses if there function is a constant
+-    if(function_application_expr.arguments().empty())
++    else if(function_application_expr.arguments().empty())
+     {
+       convert_expr(function_application_expr.function());
+     }
+@@ -3763,6 +3779,21 @@ void smt2_convt::convert_constant(const constant_exprt &expr)
+     out << "(_ bv" << (value_int - range_type.get_from()) << " " << width
+         << ")";
+   }
++  else if(expr_type.id()==ID_string)
++  {
++    const std::string &value = id2string(expr.get_value());
++    out << "\"";
++    for(char c : value)
++    {
++      if(c == '"')
++        out << "\"\"";
++      else if(c == '\\')
++        out << "\\\\";
++      else
++        out << c;
++    }
++    out << "\"";
++  }
+   else
+     UNEXPECTEDCASE("unknown constant: "+expr_type.id_string());
+ }
+@@ -5991,6 +6022,8 @@ void smt2_convt::convert_type(const typet &type)
+       UNEXPECTEDCASE("unsuppored range type");
+     out << "(_ BitVec " << address_bits(size) << ")";
+   }
++  else if(type.id()==ID_string)
++    out << "String";
+   else
+   {
+     UNEXPECTEDCASE("unsupported type: "+type.id_string());
diff --git a/StrataTest/DL/Imperative/CFGToCProverGOTO.lean b/StrataTest/DL/Imperative/CFGToCProverGOTO.lean
index 49d2aeed0c..c2a0069802 100644
--- a/StrataTest/DL/Imperative/CFGToCProverGOTO.lean
+++ b/StrataTest/DL/Imperative/CFGToCProverGOTO.lean
@@ -53,11 +53,18 @@ instance : Imperative.ToGoto LExprTP where
   toGotoType := Lambda.LMonoTy.toGotoType
   toGotoExpr := Lambda.LExprT.toGotoExpr
 
+instance : Imperative.HasVal LExprTP where
+  value _ := True
+
+instance : Imperative.HasFvars LExprTP where
+  getFvars _ := []
+
 instance : Imperative.HasBool LExprTP where
   tt := .const { underlying := (), type := mty[bool] } (.boolConst true)
   ff := .const { underlying := (), type := mty[bool] } (.boolConst false)
   tt_is_not_ff := by simp
   boolTy := .tcons "bool" []
+  boolIsVal := ⟨trivial, trivial⟩
 
 instance : Imperative.HasIdent LExprTP where
   ident s := ⟨s, ()⟩
@@ -70,14 +77,22 @@ instance : Imperative.HasFvar LExprTP where
   | .fvar _ v _ => some v
   | _ => none
 
-instance : Imperative.HasIntOrder LExprTP where
-  eq    e1 e2 := .eq md e1 e2
-  lt    e1 e2 := .app md (.app md (.op md ⟨"Int.Lt", ()⟩ none) e1) e2
+instance : Imperative.HasInt LExprTP where
   zero        := .intConst md 0
   intTy       := .tcons "int" []
+  isNumeral _ := true
+  numeralIsValue := fun _ _ => trivial
+  zeroIsNumeral := by decide
+  numeralHasNoFvars := fun _ _ => rfl
+
+instance : Imperative.HasIntOps LExprTP where
+  eq    e1 e2 := .eq md e1 e2
+  lt    e1 e2 := .app md (.app md (.op md ⟨"Int.Lt", ()⟩ none) e1) e2
 
-instance : Imperative.HasNot LExprTP where
+instance : Imperative.HasBoolOps LExprTP where
   not e := .app md (.op md ⟨"Bool.Not", ()⟩ none) e
+  and e1 e2 := .app md (.app md (.op md ⟨"Bool.And", ()⟩ none) e1) e2
+  imp e1 e2 := .app md (.app md (.op md ⟨"Bool.Imp", ()⟩ none) e1) e2
 
 -------------------------------------------------------------------------------
 
diff --git a/StrataTest/DL/Imperative/StepStmtTest.lean b/StrataTest/DL/Imperative/StepStmtTest.lean
index 4712b61e5e..a4f53a1d6d 100644
--- a/StrataTest/DL/Imperative/StepStmtTest.lean
+++ b/StrataTest/DL/Imperative/StepStmtTest.lean
@@ -6,6 +6,7 @@
 module
 
 meta import Strata.DL.Imperative.StmtSemantics
+meta import Strata.DL.Imperative.StmtSemanticsProps
 import all Strata.DL.Imperative.CmdSemantics
 
 meta section
@@ -26,6 +27,10 @@ inductive Expr where
   | tt
   | ff
   | not (e : Expr)
+  /-- An "operator" reference — opaque to `miniEval` (returns `some (.op n)`),
+      but observable to evaluator extensions: a `funcDecl` whose name matches
+      `n` can give `.op n` a definite boolean value. -/
+  | op (name : String)
   deriving DecidableEq, Repr, Inhabited
 
 /-- Types — only a boolean type is needed for this test. -/
@@ -43,24 +48,47 @@ abbrev MiniPureExpr : PureExpr :=
     TyContext := Unit,
     EvalEnv := Unit }
 
+instance : HasVal MiniPureExpr where
+  value _ := True
+
+instance : HasFvars MiniPureExpr where
+  getFvars _ := []
+
 instance : HasBool MiniPureExpr where
   tt := .tt
   ff := .ff
   tt_is_not_ff := by intro h; cases h
   boolTy := .Bool
+  boolIsVal := ⟨trivial, trivial⟩
 
-instance : HasNot MiniPureExpr where
+instance : HasBoolOps MiniPureExpr where
   not := .not
+  and := fun _ _ => .tt
+  imp := fun _ _ => .tt
+
+instance : HasInt MiniPureExpr where
+  zero := .ff
+  intTy := .Bool
+  isNumeral := fun _ => true
+  numeralIsValue := fun _ _ => trivial
+  zeroIsNumeral := rfl
+  numeralHasNoFvars := fun _ _ => rfl
+
+instance : HasIntOps MiniPureExpr where
+  eq := fun _ _ => .tt
+  lt := fun _ _ => .ff
 
 ---------------------------------------------------------------------
 
 /-! ## Evaluator and well-formedness setup -/
 
 /-- Normalise an `Expr` into a boolean constant by folding `.not`s.
-    Closed `.tt` and `.ff` stay; `.not .tt` collapses to `.ff`, and so on. -/
+    Closed `.tt` and `.ff` stay; `.not .tt` collapses to `.ff`, and so on.
+    `.op` is opaque to the base evaluator and stays as-is. -/
 def Expr.normBool : Expr → Expr
   | .tt => .tt
   | .ff => .ff
+  | .op n => .op n
   | .not e =>
     match Expr.normBool e with
     | .tt => .ff
@@ -134,8 +162,9 @@ theorem progReachesTerminal :
   refine .step _ _ _
     (StepStmt.step_block_body
       (StepStmt.step_seq_inner
-        (StepStmt.step_loop_enter (hasInvFailure := false) htt ?inv_bool ?inv_iff
-          miniEval_wfBool))) ?_
+        (StepStmt.step_loop_enter
+          (hasInvFailure := false)
+          htt ?inv_bool ?inv_iff miniEval_wfBool))) ?_
   · intro _ hmem; nomatch hmem
   · constructor <;> intro h
     · cases h
@@ -204,13 +233,20 @@ theorem progIteThenReachesTerminal :
     (StepStmt.step_block_body
       (StepStmt.step_seq_inner (StepStmt.step_ite_true htt miniEval_wfBool))) ?_
   refine .step _ _ _
-    (StepStmt.step_block_body (StepStmt.step_seq_inner StepStmt.step_stmts_cons)) ?_
+    (StepStmt.step_block_body
+      (StepStmt.step_seq_inner (StepStmt.step_block_body StepStmt.step_stmts_cons))) ?_
   refine .step _ _ _
     (StepStmt.step_block_body
-      (StepStmt.step_seq_inner (StepStmt.step_seq_inner StepStmt.step_exit))) ?_
+      (StepStmt.step_seq_inner
+        (StepStmt.step_block_body (StepStmt.step_seq_inner StepStmt.step_exit)))) ?_
   refine .step _ _ _
     (StepStmt.step_block_body
-      (StepStmt.step_seq_inner StepStmt.step_seq_exit)) ?_
+      (StepStmt.step_seq_inner
+        (StepStmt.step_block_body StepStmt.step_seq_exit))) ?_
+  -- Inner anonymous block (.none) propagates exit "L" via mismatch.
+  refine .step _ _ _
+    (StepStmt.step_block_body
+      (StepStmt.step_seq_inner (StepStmt.step_block_exit_mismatch (by simp)))) ?_
   refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_seq_exit) ?_
   -- Outer block "L" matches the labeled exit; project store (identity here).
   have hproj : projectStore (P := MiniPureExpr) ρ₀.store ρ₀.store = ρ₀.store := by
@@ -241,14 +277,20 @@ theorem progIteElseReachesTerminal :
     (StepStmt.step_block_body
       (StepStmt.step_seq_inner (StepStmt.step_ite_false hff miniEval_wfBool))) ?rest3
   refine .step _ _ _
-    (StepStmt.step_block_body (StepStmt.step_seq_inner StepStmt.step_stmts_cons)) ?rest4
+    (StepStmt.step_block_body
+      (StepStmt.step_seq_inner (StepStmt.step_block_body StepStmt.step_stmts_cons))) ?rest4
   refine .step _ _ _
     (StepStmt.step_block_body
-      (StepStmt.step_seq_inner (StepStmt.step_seq_inner StepStmt.step_exit))) ?rest5
+      (StepStmt.step_seq_inner
+        (StepStmt.step_block_body (StepStmt.step_seq_inner StepStmt.step_exit)))) ?rest5
   refine .step _ _ _
     (StepStmt.step_block_body
-      (StepStmt.step_seq_inner StepStmt.step_seq_exit)) ?rest6
-  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_seq_exit) ?rest7
+      (StepStmt.step_seq_inner
+        (StepStmt.step_block_body StepStmt.step_seq_exit))) ?rest6
+  refine .step _ _ _
+    (StepStmt.step_block_body
+      (StepStmt.step_seq_inner (StepStmt.step_block_exit_mismatch (by simp)))) ?rest7
+  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_seq_exit) ?rest8
   -- Outer block "L" matches the labeled exit; project store (identity here).
   have hproj : projectStore (P := MiniPureExpr) ρ₀.store ρ₀.store = ρ₀.store := by
     funext x; simp [projectStore]; intro _; rfl
@@ -277,14 +319,20 @@ abbrev MiniPureExpr2 : PureExpr :=
     TyContext := Unit,
     EvalEnv := Unit }
 
+instance : HasVal MiniPureExpr2 where
+  value _ := True
+
 instance : HasBool MiniPureExpr2 where
   tt := .tt
   ff := .ff
   tt_is_not_ff := by intro h; cases h
   boolTy := .Bool
+  boolIsVal := ⟨trivial, trivial⟩
 
-instance : HasNot MiniPureExpr2 where
+instance : HasBoolOps MiniPureExpr2 where
   not := .not
+  and := fun _ _ => .tt
+  imp := fun _ _ => .tt
 
 /-- Get free variables from `Expr2`. -/
 def Expr2.getVars : Expr2 → List String
@@ -296,14 +344,17 @@ def Expr2.getVars : Expr2 → List String
 instance : HasVarsPure MiniPureExpr2 Expr2 where
   getVars := Expr2.getVars
 
+instance : HasFvars MiniPureExpr2 where
+  getFvars := Expr2.getVars
+
 instance : HasVarsPure MiniPureExpr2 (Cmd MiniPureExpr2) where
   getVars := Cmd.getVars
 
 /-- Test: `set x := var "y"` has `modifiedOrDefinedVars = ["x"]` (write-set only)
     but `touchedVars = ["x", "y"]` (includes the read variable "y"). -/
 example : (Stmt.cmd (P := MiniPureExpr2)
-    (Cmd.set (P := MiniPureExpr2) "x" (.det (.var "y")) .empty)).modifiedOrDefinedVars
-    = ["x"] := by native_decide
+    (Cmd.set (P := MiniPureExpr2) "x" (.det (.var "y")) .empty)).modifiedOrDefinedVars false
+    =["x"] := by native_decide
 
 example : (Stmt.cmd (P := MiniPureExpr2)
     (Cmd.set (P := MiniPureExpr2) "x" (.det (.var "y")) .empty)).touchedVars
@@ -312,8 +363,8 @@ example : (Stmt.cmd (P := MiniPureExpr2)
 /-- Test: `init z : Bool := var "w"` has `modifiedOrDefinedVars = ["z"]`
     but `touchedVars = ["z", "w"]`. -/
 example : (Stmt.cmd (P := MiniPureExpr2)
-    (Cmd.init (P := MiniPureExpr2) "z" .Bool (.det (.var "w")) .empty)).modifiedOrDefinedVars
-    = ["z"] := by native_decide
+    (Cmd.init (P := MiniPureExpr2) "z" .Bool (.det (.var "w")) .empty)).modifiedOrDefinedVars false
+    =["z"] := by native_decide
 
 example : (Stmt.cmd (P := MiniPureExpr2)
     (Cmd.init (P := MiniPureExpr2) "z" .Bool (.det (.var "w")) .empty)).touchedVars
@@ -323,12 +374,12 @@ example : (Stmt.cmd (P := MiniPureExpr2)
 example : (Block.touchedVars (P := MiniPureExpr2) (C := Cmd MiniPureExpr2)
     [.cmd (Cmd.init (P := MiniPureExpr2) "a" .Bool (.det (.var "b")) .empty),
      .cmd (Cmd.set (P := MiniPureExpr2) "c" (.det (.var "d")) .empty)])
-    = ["a", "c", "b", "d"] := by native_decide
+    = ["c", "a", "b", "d"] := by native_decide
 
 example : (Block.modifiedOrDefinedVars (P := MiniPureExpr2) (C := Cmd MiniPureExpr2)
     [.cmd (Cmd.init (P := MiniPureExpr2) "a" .Bool (.det (.var "b")) .empty),
-     .cmd (Cmd.set (P := MiniPureExpr2) "c" (.det (.var "d")) .empty)])
-    = ["a", "c"] := by native_decide
+     .cmd (Cmd.set (P := MiniPureExpr2) "c" (.det (.var "d")) .empty)] false)
+    = ["c", "a"] := by native_decide
 
 ---------------------------------------------------------------------
 
@@ -541,5 +592,203 @@ theorem reinit_stuck :
 
 ---------------------------------------------------------------------
 
+/-! ## funcDecl scoping tests
+
+Any `.funcDecl` that is declared inside a block must not leak from the
+block: the evaluator `env` of `Env` must be roll backed to the original
+eval after the end of the block scope.
+-/
+
+/-- A temporary HasSubstFvar instance -/
+instance : HasSubstFvar MiniPureExpr where
+  substFvar e _ _ := e
+  substFvars e _  := e
+
+/-- An evaluator extension that *adds* a new declaration for `decl.name`: when
+    the input expression is `.op decl.name`, return `some .tt`; otherwise
+    delegate to the original evaluator `δ`. -/
+def addEval : ExtendEval MiniPureExpr :=
+  fun δ _ decl => fun σ e =>
+    match e with
+    | .op n => if n = decl.name then some .tt else δ σ e
+    | _     => δ σ e
+
+/-- A trivial `PureFunc` named `"f"` to feed into `.funcDecl`.  After the
+    funcDecl steps, the inner eval maps `.op "f"` to `some .tt`. -/
+def fFunc : PureFunc MiniPureExpr :=
+  { name := "f", inputs := ∅, output := .Bool }
+
+/-- The funcDecl statement we will plant inside each scope. -/
+def funcDeclStmt : Stmt MiniPureExpr (Cmd MiniPureExpr) :=
+  .funcDecl fFunc .empty
+
+/-- Quick sanity check: `miniEval` does not know about `"f"` — it leaves
+    `.op "f"` as itself. -/
+example : miniEval emptyStore (.op "f") = some (.op "f") := rfl
+
+/-- After `addEval` is applied for `fFunc`, the resulting evaluator gives
+    `.op "f"` the value `some .tt`. -/
+example : (addEval miniEval emptyStore fFunc) emptyStore (.op "f") = some .tt := rfl
+
+/-- `block "B" { funcDecl f := ... }` — the funcDecl is scoped to the block. -/
+def progBlockFuncDecl : Stmt MiniPureExpr (Cmd MiniPureExpr) :=
+  .block "B" [funcDeclStmt] .empty
+
+/-- Stepping the block to terminal restores `eval` to the original
+    `ρ_x.eval = miniEval`: the `funcDecl` does not leak past block exit. -/
+theorem progBlockFuncDecl_eval_restored :
+    StepStmtStar MiniPureExpr stdEvalCmd addEval
+      (.stmt progBlockFuncDecl ρ_x) (.terminal ρ_x) := by
+  -- Step 1: enter the block (snapshot `ρ_x.store` and `ρ_x.eval := miniEval`).
+  refine .step _ _ _ StepStmt.step_block ?_
+  -- Step 2: dive into the body via stmts_cons.
+  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_cons) ?_
+  -- Step 3: fire the funcDecl — inner eval becomes `addEval miniEval ...`.
+  refine .step _ _ _
+    (StepStmt.step_block_body
+      (StepStmt.step_seq_inner StepStmt.step_funcDecl)) ?_
+  -- Step 4: seq inner reached terminal → drop into stmts [].
+  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_seq_done) ?_
+  -- Step 5: stmts [] becomes terminal.
+  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_nil) ?_
+  -- Step 6: step_block_done — eval is RESTORED to e_parent (= miniEval),
+  -- and the projected store equals `ρ_x.store` (no `init`s ran).
+  conv => rhs; rw [(projectStore_self_env ρ_x).symm]
+  exact .step _ _ _ StepStmt.step_block_done (.refl _)
+
+/-- `if .tt then { funcDecl f := ... } else { }` — funcDecl in the then
+    branch is also scoped: the implicit anonymous `.block .none` wrapper
+    around each branch captures `e_parent := ρ.eval`. -/
+def progIteFuncDecl : Stmt MiniPureExpr (Cmd MiniPureExpr) :=
+  .ite (.det .tt) [funcDeclStmt] [] .empty
+
+theorem progIteFuncDecl_eval_restored :
+    StepStmtStar MiniPureExpr stdEvalCmd addEval
+      (.stmt progIteFuncDecl ρ_x) (.terminal ρ_x) := by
+  have htt : ρ_x.eval ρ_x.store HasBool.tt = some HasBool.tt := rfl
+  -- Step 1: step_ite_true wraps the then-branch in `.block .none ... ρ_x.eval ...`.
+  refine .step _ _ _ (StepStmt.step_ite_true htt miniEval_wfBool) ?_
+  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_cons) ?_
+  refine .step _ _ _
+    (StepStmt.step_block_body
+      (StepStmt.step_seq_inner StepStmt.step_funcDecl)) ?_
+  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_seq_done) ?_
+  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_nil) ?_
+  -- step_block_done restores eval to `e_parent = ρ_x.eval = miniEval` and
+  -- projects the store (identity here).
+  conv => rhs; rw [(projectStore_self_env ρ_x).symm]
+  exact .step _ _ _ StepStmt.step_block_done (.refl _)
+
+/-- `if .ff then { } else { funcDecl f := ... }` — same scoping fix
+    applied to the else branch. -/
+def progIteElseFuncDecl : Stmt MiniPureExpr (Cmd MiniPureExpr) :=
+  .ite (.det .ff) [] [funcDeclStmt] .empty
+
+theorem progIteElseFuncDecl_eval_restored :
+    StepStmtStar MiniPureExpr stdEvalCmd addEval
+      (.stmt progIteElseFuncDecl ρ_x) (.terminal ρ_x) := by
+  have hff : ρ_x.eval ρ_x.store HasBool.ff = some HasBool.ff := rfl
+  refine .step _ _ _ (StepStmt.step_ite_false hff miniEval_wfBool) ?_
+  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_cons) ?_
+  refine .step _ _ _
+    (StepStmt.step_block_body
+      (StepStmt.step_seq_inner StepStmt.step_funcDecl)) ?_
+  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_seq_done) ?_
+  refine .step _ _ _ (StepStmt.step_block_body StepStmt.step_stmts_nil) ?_
+  conv => rhs; rw [(projectStore_self_env ρ_x).symm]
+  exact .step _ _ _ StepStmt.step_block_done (.refl _)
+
+/-- `loop (nondet) { funcDecl f := ... }` — one iteration runs the body
+    inside the per-iteration `.block .none` wrapper.  When that body's
+    block terminates, `eval` is restored to `e_parent = ρ.eval = miniEval`,
+    so subsequent iterations / the final exit see the original eval. -/
+def progLoopFuncDecl : Stmt MiniPureExpr (Cmd MiniPureExpr) :=
+  .loop .nondet none [] [funcDeclStmt] .empty
+
+theorem progLoopFuncDecl_eval_restored :
+    StepStmtStar MiniPureExpr stdEvalCmd addEval
+      (.stmt progLoopFuncDecl ρ_x) (.terminal ρ_x) := by
+  -- Step 1: step_loop_nondet_enter — body wrapped in `.block .none ... ρ_x.eval ...`.
+  refine .step _ _ _
+    (StepStmt.step_loop_nondet_enter (hasInvFailure := false) ?_ ?_) ?_
+  · intro _ hmem; nomatch hmem
+  · constructor <;> intro h
+    · cases h
+    · rcases h with ⟨_, hmem, _⟩; nomatch hmem
+  -- Steps 2-6: descend into the body's block, fire the funcDecl, run out.
+  refine .step _ _ _
+    (StepStmt.step_seq_inner
+      (StepStmt.step_block_body StepStmt.step_stmts_cons)) ?_
+  refine .step _ _ _
+    (StepStmt.step_seq_inner
+      (StepStmt.step_block_body
+        (StepStmt.step_seq_inner StepStmt.step_funcDecl))) ?_
+  refine .step _ _ _
+    (StepStmt.step_seq_inner
+      (StepStmt.step_block_body StepStmt.step_seq_done)) ?_
+  refine .step _ _ _
+    (StepStmt.step_seq_inner
+      (StepStmt.step_block_body StepStmt.step_stmts_nil)) ?_
+  -- Step 7: body's block terminates; `eval` is RESTORED to `miniEval` here.
+  refine .step _ _ _ (StepStmt.step_seq_inner StepStmt.step_block_done) ?_
+  -- Step 8: seq advances to the recursive `[loop ...]` with restored eval.
+  refine .step _ _ _ StepStmt.step_seq_done ?_
+  refine .step _ _ _ StepStmt.step_stmts_cons ?_
+  -- Step 9: step_seq_inner step_loop_nondet_exit — guard chooses to leave.
+  refine .step _ _ _
+    (StepStmt.step_seq_inner
+      (StepStmt.step_loop_nondet_exit (hasInvFailure := false) ?_ ?_)) ?_
+  · intro _ hmem; nomatch hmem
+  · constructor <;> intro h
+    · cases h
+    · rcases h with ⟨_, hmem, _⟩; nomatch hmem
+  refine .step _ _ _ StepStmt.step_seq_done ?_
+  -- The store has been projected once (body's block) but `ρ_x.store`'s shape
+  -- is preserved (no `init` ran).  Adjust the rhs shape to match
+  -- `step_stmts_nil`'s output.
+  conv => rhs; rw [show ρ_x =
+    { store := projectStore ρ_x.store ρ_x.store,
+      eval := ρ_x.eval, hasFailure := ρ_x.hasFailure || false } from by
+    cases ρ_x; simp [projectStore_self]]
+  exact .step _ _ _ StepStmt.step_stmts_nil (.refl _)
+
+/-! ## Negative test: calling a `funcDecl`'d function after its block exits
+
+`progBlockFuncDecl` is the program
+
+  block "B" { funcDecl f := … }
+
+Here we make that scoping discipline observable by contrasting evaluator
+behaviour at three points along that trace, then proving that "calling f"
+after the block (modeled as an `ite` whose guard is the opaque expression
+`.op "f"`) is stuck because `f` has gone out of scope. -/
+
+/-- *Before* entering the block (the initial env): `miniEval` doesn't know
+    about `f`, so `.op "f"` stays opaque (returns itself). -/
+example : ρ_x.eval ρ_x.store (.op "f") = some (.op "f") := rfl
+
+/-- *Inside* the block, after `step_funcDecl` has fired: the env's eval is
+    `addEval miniEval ρ_x.store fFunc`, which gives `.op "f"` the boolean
+    value `tt` — `f` is now in scope and "callable". -/
+example :
+    let inner_eval := addEval miniEval ρ_x.store fFunc
+    inner_eval ρ_x.store (.op "f") = some HasBool.tt := rfl
+
+/-- *After* the block exits: `progBlockFuncDecl_eval_restored` returns us to
+    `ρ_x`, where `.op "f"` is opaque again — the funcDecl extension is gone. -/
+example : ρ_x.eval ρ_x.store (.op "f") = some (.op "f") := rfl
+
+/-- And as a step-level consequence: from `ρ_x` (the env after the block),
+    an `ite` guarded by `.op "f"` cannot step. -/
+theorem funcDecl_out_of_scope_after_block :
+    ¬ ∃ c₂, StepStmt MiniPureExpr stdEvalCmd addEval
+      (.stmt (.ite (.det (.op "f")) [] [] .empty) ρ_x) c₂ := by
+  intro ⟨_, hstep⟩
+  cases hstep with
+  | step_ite_true h _ => simp [ρ_x, miniEval, Expr.normBool] at h
+  | step_ite_false h _ => simp [ρ_x, miniEval, Expr.normBool] at h
+
+---------------------------------------------------------------------
+
 end StepStmtTest
 end
diff --git a/StrataTest/DL/Lambda/FuncAttrTests.lean b/StrataTest/DL/Lambda/FuncAttrTests.lean
index cea51615c7..dcb7d06d17 100644
--- a/StrataTest/DL/Lambda/FuncAttrTests.lean
+++ b/StrataTest/DL/Lambda/FuncAttrTests.lean
@@ -5,7 +5,7 @@
 -/
 module
 
-meta import Strata.DL.Lambda.Lambda
+meta import Strata.DL.Lambda
 meta import Strata.DL.Lambda.TypeFactory
 
 /-!
diff --git a/StrataTest/DL/Lambda/LExprEqTests.lean b/StrataTest/DL/Lambda/LExprEqTests.lean
index 242901ed80..7d8f55693c 100644
--- a/StrataTest/DL/Lambda/LExprEqTests.lean
+++ b/StrataTest/DL/Lambda/LExprEqTests.lean
@@ -8,7 +8,7 @@ module
 meta import Strata.DL.Lambda.LExprEval
 meta import Strata.DL.Lambda.IntBoolFactory
 meta import Strata.DL.Lambda.TypeFactory
-meta import Strata.DL.Lambda.Lambda
+meta import Strata.DL.Lambda
 
 /-!
 ## Tests for `eql`
diff --git a/StrataTest/DL/Lambda/Lambda.lean b/StrataTest/DL/Lambda/Lambda.lean
index 8178930db7..1a9d7c233b 100644
--- a/StrataTest/DL/Lambda/Lambda.lean
+++ b/StrataTest/DL/Lambda/Lambda.lean
@@ -7,7 +7,7 @@ module
 
 
 
-meta import Strata.DL.Lambda.Lambda
+meta import Strata.DL.Lambda
 meta import Strata.DL.Lambda.IntBoolFactory
 
 ---------------------------------------------------------------------
diff --git a/StrataTest/DL/Lambda/RecursiveAxiomsTests.lean b/StrataTest/DL/Lambda/RecursiveAxiomsTests.lean
index 4ee46123d1..ce1c001a81 100644
--- a/StrataTest/DL/Lambda/RecursiveAxiomsTests.lean
+++ b/StrataTest/DL/Lambda/RecursiveAxiomsTests.lean
@@ -6,7 +6,7 @@
 module
 
 meta import Strata.DL.Lambda.RecursiveAxioms
-meta import Strata.DL.Lambda.Lambda
+meta import Strata.DL.Lambda
 meta import Strata.DL.Lambda.IntBoolFactory
 
 /-!
diff --git a/StrataTest/DL/Lambda/TypeFactoryTests.lean b/StrataTest/DL/Lambda/TypeFactoryTests.lean
index 4d5b8d2465..89b18ea057 100644
--- a/StrataTest/DL/Lambda/TypeFactoryTests.lean
+++ b/StrataTest/DL/Lambda/TypeFactoryTests.lean
@@ -5,7 +5,7 @@
 -/
 module
 
-meta import Strata.DL.Lambda.Lambda
+meta import Strata.DL.Lambda
 meta import Strata.DL.Lambda.IntBoolFactory
 meta import Strata.DL.Lambda.TypeFactory
 
diff --git a/StrataTest/Languages/Core/Examples/Exit.lean b/StrataTest/Languages/Core/Examples/Exit.lean
index fe5bc62114..96093e85d8 100644
--- a/StrataTest/Languages/Core/Examples/Exit.lean
+++ b/StrataTest/Languages/Core/Examples/Exit.lean
@@ -3,14 +3,11 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import Strata.Languages.Core
-meta import Strata.Languages.Core
-meta import StrataTest.Languages.Core.Examples.Loops
+import Strata.Languages.Core
+import StrataTest.Languages.Core.Examples.Loops
 import StrataDDM.Integration.Lean.HashCommands
 
-meta section
 open StrataDDM (Program)
 ---------------------------------------------------------------------
 namespace Strata
@@ -117,7 +114,7 @@ Result: ✅ pass
 
 
 /--
-info: Entry: l1
+info: Entry: block$l1$_2
 
 l1:
   condGoto true block$l1$_2 block$l1$_2
@@ -134,16 +131,16 @@ end$_0:
 #eval (Std.format (singleCFG exitPgm 0))
 
 /--
-info: Entry: l5
+info: Entry: ite$_5
 
 l5:
-  condGoto true l4 l4
+  condGoto true ite$_5 ite$_5
 l4:
-  condGoto true l4_before l4_before
+  condGoto true ite$_5 ite$_5
 l4_before:
-  condGoto true l3_before l3_before
+  condGoto true ite$_5 ite$_5
 l3_before:
-  condGoto true l1 l1
+  condGoto true ite$_5 ite$_5
 l1:
   condGoto true ite$_5 ite$_5
 ite$_5:
@@ -165,6 +162,3 @@ end$_0:
 -/
 #guard_msgs in
 #eval (Std.format (singleCFG exitPgm 1))
-
-end Strata
-end
diff --git a/StrataTest/Languages/Core/Examples/Functions.lean b/StrataTest/Languages/Core/Examples/Functions.lean
index 0583925c8d..389ef9e8b8 100644
--- a/StrataTest/Languages/Core/Examples/Functions.lean
+++ b/StrataTest/Languages/Core/Examples/Functions.lean
@@ -3,13 +3,12 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import Strata.Languages.Core
-meta import Strata.Languages.Core.CallGraph
+import Strata.Languages.Core
+import Strata.Languages.Core.CallGraph
 import StrataDDM.Integration.Lean.HashCommands
+import Strata.MetaVerifier
 
-meta section
 open StrataDDM (Program)
 ---------------------------------------------------------------------
 namespace Strata
@@ -76,6 +75,10 @@ Result: ✅ pass
 #guard_msgs in
 #eval Core.verify funcPgm
 
+theorem funcPgm_correct : smtVCsCorrect funcPgm := by
+  gen_smt_vcs
+  all_goals (try grind)
+
 ---------------------------------------------------------------------
 
 /-! ## Multi-argument function test
@@ -155,6 +158,9 @@ Result: ✅ pass
 #guard_msgs in
 #eval Core.verify quantBodyFuncPgm
 
+theorem quantBodyFuncPgm_correct : smtVCsCorrect quantBodyFuncPgm := by
+  gen_smt_vcs
+  all_goals (try grind)
+
 end Strata
-end
 ---------------------------------------------------------------------
diff --git a/StrataTest/Languages/Core/Examples/Loops.lean b/StrataTest/Languages/Core/Examples/Loops.lean
index 57f961d919..9bcba599b8 100644
--- a/StrataTest/Languages/Core/Examples/Loops.lean
+++ b/StrataTest/Languages/Core/Examples/Loops.lean
@@ -3,22 +3,22 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
+
 import Strata.Languages.Core.Verifier
-meta import Strata.Languages.Core
+import Strata.Languages.Core
 import Strata.Transform.StructuredToUnstructured
 import Lean.Parser.Types
-meta import Strata.Languages.Core.DDMTransform.Grammar
-meta import Strata.Languages.Core.DDMTransform.Translate
-meta import Strata.Languages.Core.Options
-public import StrataDDM.AST
-public import Strata.DL.Imperative.BasicBlock
-public import Strata.Languages.Core.Statement
-public import Strata.Languages.Core.Expressions
+import Strata.Languages.Core.DDMTransform.Grammar
+import Strata.Languages.Core.DDMTransform.Translate
+import Strata.Languages.Core.Options
+import StrataDDM.AST
+import Strata.DL.Imperative.BasicBlock
+import Strata.Languages.Core.Statement
+import Strata.Languages.Core.Expressions
 import StrataDDM.Integration.Lean.HashCommands
 import Strata.Languages.Core.StatementSemantics
+import Strata.MetaVerifier
 
-public section
 open StrataDDM (Program)
 namespace Strata
 
@@ -27,7 +27,9 @@ def singleCFG (p : Program) (n : Nat) : Imperative.CFG String
   let corePgm : Core.Program := TransM.run Inhabited.default (translateProgram p) |>.fst
   let proc := match corePgm.decls[n]? with
               | .some (.proc p _) => p | _ => Inhabited.default
-  Imperative.stmtsToCFG proc.body
+  match proc.body with
+  | .structured ss => Imperative.stmtsToCFG ss
+  | .cfg cfg => cfg
 
 ---------------------------------------------------------------------
 
@@ -344,6 +346,10 @@ Result: ✅ pass
 #guard_msgs in
 #eval Core.verify gaussPgm
 
+theorem gaussPgm_correct : smtVCsCorrect gaussPgm := by
+  gen_smt_vcs
+  all_goals (try grind)
+
 ---------------------------------------------------------------------
 
 def nestedPgm :=
@@ -490,6 +496,10 @@ Result: ✅ pass
 #guard_msgs in
 #eval Core.verify nestedPgm (options := .quiet)
 
+theorem nestedPgm_correct : smtVCsCorrect nestedPgm := by
+  gen_smt_vcs
+  all_goals (try grind)
+
 ---------------------------------------------------------------------
 
 -- A loop where the `decreases` clause uses integer division `i / d`.
@@ -556,6 +566,26 @@ Result: ✅ pass
 #guard_msgs in
 #eval Core.verify precondElimInMeasurePgm (options := .quiet)
 
+/--
+This theorem requires a little bit of manual work to handle facts about
+division, though most goals are solved by `grind`.
+-/
+theorem precondElimInMeasurePgm_correct : smtVCsCorrect precondElimInMeasurePgm := by
+  gen_smt_vcs
+  all_goals (try grind)
+  -- measure_lb_0: the loop measure i / d is non-negative
+  case measure_lb_0 =>
+    intro _ d i _ _ dpos _ _ _ inonneg meas_def
+    subst meas_def
+    have p := Int.ediv_nonneg (a := i) (b := d)
+    grind
+  -- measure_decrease_0: the loop measure i / d strictly decreases
+  case measure_decrease_0 =>
+    intro _ d i _ _ dpos _ _ _ _ meas_def
+    subst meas_def
+    have p := Int.add_mul_ediv_left (a := i) (b := d) (c := -1)
+    grind
+
 -- Now, we show the precondition (d > 0) is necessary for the measure-related
 -- checks.
 def precondElimInMeasureBadPgm :=
@@ -683,4 +713,3 @@ Result: ✅ pass
 #eval Core.verify precondElimMeasureBodyMutatesPgm (options := .quiet)
 
 end Strata
-end
diff --git a/StrataTest/Languages/Core/Examples/Min.lean b/StrataTest/Languages/Core/Examples/Min.lean
index 5f7598c54c..97e9f28eec 100644
--- a/StrataTest/Languages/Core/Examples/Min.lean
+++ b/StrataTest/Languages/Core/Examples/Min.lean
@@ -3,12 +3,11 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import Strata.Languages.Core
+import Strata.Languages.Core
 import StrataDDM.Integration.Lean.HashCommands
+import Strata.MetaVerifier
 
-meta section
 open StrataDDM (Program)
 ---------------------------------------------------------------------
 namespace Strata
@@ -47,6 +46,9 @@ Result: ✅ pass
 #guard_msgs in
 #eval Core.verify testPgm
 
+theorem testPgm_correct : smtVCsCorrect testPgm := by
+  gen_smt_vcs
+  grind
+
 end Strata
-end
 ---------------------------------------------------------------------
diff --git a/StrataTest/Languages/Core/Examples/Quantifiers.lean b/StrataTest/Languages/Core/Examples/Quantifiers.lean
index 3aaf7c7dfc..3641766eb3 100644
--- a/StrataTest/Languages/Core/Examples/Quantifiers.lean
+++ b/StrataTest/Languages/Core/Examples/Quantifiers.lean
@@ -3,12 +3,11 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import Strata.Languages.Core
+import Strata.Languages.Core
 import StrataDDM.Integration.Lean.HashCommands
+import Strata.MetaVerifier
 
-meta section
 ---------------------------------------------------------------------
 namespace Strata
 
@@ -152,5 +151,8 @@ Result: ✅ pass
 #guard_msgs in
 #eval Core.verify triggerPgm
 
+theorem triggerPgm_correct : smtVCsCorrect triggerPgm := by
+  gen_smt_vcs
+  all_goals (try grind)
+
 end Strata
-end
diff --git a/StrataTest/Languages/Core/Examples/RecursiveProcIte.lean b/StrataTest/Languages/Core/Examples/RecursiveProcIte.lean
index 4d286baaac..edee2f5c55 100644
--- a/StrataTest/Languages/Core/Examples/RecursiveProcIte.lean
+++ b/StrataTest/Languages/Core/Examples/RecursiveProcIte.lean
@@ -3,12 +3,11 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import Strata.Languages.Core
+import Strata.Languages.Core
 import StrataDDM.Integration.Lean.HashCommands
+import Strata.MetaVerifier
 
-meta section
 open StrataDDM (Program)
 ---------------------------------------------------------------------
 namespace Strata
@@ -77,6 +76,10 @@ Result: ✅ pass
 #guard_msgs in
 #eval Core.verify procIfPgm
 
+theorem procIfPgm_correct : smtVCsCorrect procIfPgm := by
+  gen_smt_vcs
+  all_goals (try grind)
+
 /-
 <PCs>
 if (cond) {
@@ -94,4 +97,3 @@ if (cond) {
 -/
 
 end Strata
-end
diff --git a/StrataTest/Languages/Core/Tests/BvIntCastVerifyTests.lean b/StrataTest/Languages/Core/Tests/BvIntCastVerifyTests.lean
index 06e4d25661..6fa7fc86f0 100644
--- a/StrataTest/Languages/Core/Tests/BvIntCastVerifyTests.lean
+++ b/StrataTest/Languages/Core/Tests/BvIntCastVerifyTests.lean
@@ -48,7 +48,7 @@ private def mkProc (name : String) (postcond : Expression.Expr) : Decl :=
       preconditions  := []
       postconditions := [(s!"{name}_ensures_0", { expr := postcond })]
     }
-    body := [.assume "body" (.true ()) #[]]
+    body := .structured [.assume "body" (.true ()) #[]]
   } #[]
 
 private def castVerifyProg : Core.Program :=
diff --git a/StrataTest/Languages/Core/Tests/ExprEvalTest.lean b/StrataTest/Languages/Core/Tests/ExprEvalTest.lean
index b98556ebc0..f08169f388 100644
--- a/StrataTest/Languages/Core/Tests/ExprEvalTest.lean
+++ b/StrataTest/Languages/Core/Tests/ExprEvalTest.lean
@@ -5,7 +5,7 @@
 -/
 module
 
-meta import Strata.DL.Lambda.Lambda
+meta import Strata.DL.Lambda
 meta import Strata.DL.Lambda.LExpr
 meta import Strata.DL.Lambda.LState
 meta import Strata.DL.Lambda.LTy
diff --git a/StrataTest/Languages/Core/Tests/FunctionTypeTests.lean b/StrataTest/Languages/Core/Tests/FunctionTypeTests.lean
new file mode 100644
index 0000000000..16857d9b10
--- /dev/null
+++ b/StrataTest/Languages/Core/Tests/FunctionTypeTests.lean
@@ -0,0 +1,335 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import Strata.Languages.Core.Verifier
+
+/-! ## Function Type Soundness Tests
+
+Tests for the alpha-equivalence check on function bodies and the closedness
+check on type variables. We verify that body annotations are consistent with
+the function's instantiated typeArgs.
+-/
+
+namespace Core.FunctionTypeTests
+
+open Std (ToFormat Format format)
+open Lambda Imperative
+open LTy.Syntax LExpr.SyntaxMono
+
+private def C : Core.Expression.TyContext := LContext.default
+private def Env : Core.Expression.TyEnv := default
+
+---------------------------------------------------------------------
+-- Should PASS
+---------------------------------------------------------------------
+
+-- Unannotated lambda binder; inference assigns a consistent type.
+-- wrapId<T>(x:T):T { (\y.y)(x) }
+private def inferredBinderFunc : Core.Function :=
+  { name := ⟨"wrapId", ()⟩,
+    typeArgs := ["T"],
+    inputs := [(⟨"x", ()⟩, .ftvar "T")],
+    output := .ftvar "T",
+    body := some (.app () (.abs () "y" none (.bvar () 0)) (.fvar () ⟨"x", ()⟩ none)) }
+
+/--
+info: ok: typeArgs: [T]
+inputs: (x, T)
+output: T
+body: some (fun y : (T) => y)(x)
+-/
+#guard_msgs in
+#eval do
+  let (func', _) ← Function.typeCheck C Env inferredBinderFunc
+  return format f!"typeArgs: {func'.typeArgs}\ninputs: {func'.inputs}\noutput: {func'.output}\nbody: {func'.body}"
+
+-- Multiple type parameters, all used consistently.
+-- fst<a,b>(x:a, y:b):a { x }
+open Strata in
+private def fstPgm :=
+#strata
+program Core;
+
+function fst<a, b>(x : a, y : b) : a {
+  x
+}
+#end
+
+/--
+info: [Strata.Core] Type checking succeeded.
+
+---
+info: ok: program Core;
+
+function fst<a, b> (x : a, y : b) : a {
+  x
+}
+-/
+#guard_msgs in
+open Strata in
+#eval
+  let pgm := (TransM.run Inhabited.default (translateProgram fstPgm)).fst
+  Std.format (Core.typeCheck .default pgm.stripMetaData)
+
+-- Annotated binder renamed to match instantiated typeArgs.
+-- id<T>(x:T):T { (fun y:T => y)(x) }
+open Strata in
+private def annotatedBinderPgm :=
+#strata
+program Core;
+
+function id<T>(x : T) : T {
+  (fun y : T => y)(x)
+}
+#end
+
+/--
+info: [Strata.Core] Type checking succeeded.
+
+---
+info: ok: program Core;
+
+function id<T> (x : T) : T {
+  (fun y : (T) => y)(x)
+}
+-/
+#guard_msgs in
+open Strata in
+#eval
+  let pgm := (TransM.run Inhabited.default (translateProgram annotatedBinderPgm)).fst
+  Std.format (Core.typeCheck .default pgm.stripMetaData)
+
+---------------------------------------------------------------------
+-- Should FAIL
+---------------------------------------------------------------------
+
+-- Two distinct type params identified by the body.
+-- swap<a,b>(x:a, y:b):a { y } forces b = a.
+private def identifyParamsFunc : Core.Function :=
+  { name := ⟨"swap", ()⟩,
+    typeArgs := ["a", "b"],
+    inputs := [(⟨"x", ()⟩, .ftvar "a"), (⟨"y", ()⟩, .ftvar "b")],
+    output := .ftvar "a",
+    body := some (LExpr.fvar () ⟨"y", ()⟩ none) }
+
+/--
+info: error: Function 'swap': body constrains the type to '(arrow b (arrow b b))', incompatible with declared polymorphic signature '(arrow a (arrow b a))'
+-/
+#guard_msgs in
+#eval do
+  let (func', _) ← Function.typeCheck C Env identifyParamsFunc
+  return format f!"typeArgs: {func'.typeArgs}\ninputs: {func'.inputs}\noutput: {func'.output}\nbody: {func'.body}"
+
+-- Binder with incorrect concrete annotation in a polymorphic function.
+-- bad<T>(x:T):T { (fun y:int => y)(x) } forces T = int.
+open Strata in
+private def wrongAnnotPgm :=
+#strata
+program Core;
+
+function bad<T>(x : T) : T {
+  (fun y : int => y)(x)
+}
+#end
+
+/--
+info: error: Function 'bad': body constrains the type to '(arrow int int)', incompatible with declared polymorphic signature '(arrow T T)'
+-/
+#guard_msgs in
+open Strata in
+#eval
+  let pgm := (TransM.run Inhabited.default (translateProgram wrongAnnotPgm)).fst
+  Std.format (Core.typeCheck .default pgm.stripMetaData)
+
+-- Body introduces a type variable not in typeArgs via a lambda annotation.
+-- id<T>(x:T):T { (\(y:U).y)(x) } — U is not in typeArgs.
+private def strayBodyVarFunc : Core.Function :=
+  { name := ⟨"id", ()⟩,
+    typeArgs := ["T"],
+    inputs := [(⟨"x", ()⟩, .ftvar "T")],
+    output := .ftvar "T",
+    body := some (.app () (.abs () "y" (some (.ftvar "U")) (.bvar () 0)) (.fvar () ⟨"x", ()⟩ none)) }
+
+/--
+info: error: Function 'id': body contains undeclared type variables [U] (not in typeArgs [T])
+-/
+#guard_msgs in
+#eval do
+  let (func', _) ← Function.typeCheck C Env strayBodyVarFunc
+  return format f!"typeArgs: {func'.typeArgs}\ninputs: {func'.inputs}\noutput: {func'.output}\nbody: {func'.body}"
+
+---------------------------------------------------------------------
+-- Regression tests
+---------------------------------------------------------------------
+
+-- Issue #1287: Undeclared free type variable in signature.
+-- f<T>(x : T, y : $__ty0) : T { y }
+private def issue1287_func : Core.Function :=
+  { name := ⟨"bad", ()⟩,
+    typeArgs := ["T"],
+    inputs := [(⟨"x", ()⟩, .ftvar "T"), (⟨"y", ()⟩, .ftvar "$__ty0")],
+    output := .ftvar "T",
+    body := some (LExpr.fvar () ⟨"y", ()⟩ none) }
+
+/--
+info: error: Function 'bad': type variables [$__ty0] appear in the signature but are not declared in typeArgs [T]
+-/
+#guard_msgs in
+#eval do
+  let (func', _) ← Function.typeCheck C Env issue1287_func
+  return format f!"typeArgs: {func'.typeArgs}\ninputs: {func'.inputs}\noutput: {func'.output}"
+
+-- Issue #586: Body constrains polymorphic type arg to concrete type.
+-- foo<a>(x:a):a { x + 1 } then called as foo("hello").
+open Lambda.LTy.Syntax Lambda.LExpr.SyntaxMono Core.Syntax in
+def issue586_pgm : Program := { decls := [
+  .func { name := "foo",
+          typeArgs := ["a"],
+          inputs := [("x", .ftvar "a")],
+          output := .ftvar "a",
+          body := some eb[((~Int.Add x) #1)] } .empty,
+  .proc { header := { name := "callFoo",
+                      typeArgs := [],
+                      inputs := [],
+                      outputs := [] },
+          spec := { preconditions := [],
+                    postconditions := [] },
+          body := .structured [
+            Statement.init "s" (.forAll [] .string) (.det eb[#hello]) .empty,
+            Statement.init "r" (.forAll [] .string) (.det eb[(~foo s)]) .empty
+          ]
+  } .empty
+]}
+
+/--
+info: error: Function 'foo': body constrains the type to '(arrow int int)', incompatible with declared polymorphic signature '(arrow a a)'
+-/
+#guard_msgs in
+#eval (typeCheck .default issue586_pgm)
+
+-- Quantifier annotation referencing an undeclared type var.
+-- f<T>(x:T):T { (forall y:U. y)(x) } — U is not in typeArgs.
+private def strayQuantVarFunc : Core.Function :=
+  { name := ⟨"f", ()⟩,
+    typeArgs := ["T"],
+    inputs := [(⟨"x", ()⟩, .ftvar "T")],
+    output := .ftvar "T",
+    body := some (.app ()
+      (.quant () .all "y" (some (.ftvar "U")) (.bvar () 0) (.bvar () 0))
+      (.fvar () ⟨"x", ()⟩ none)) }
+
+/--
+info: error: Function 'f': body contains undeclared type variables [U] (not in typeArgs [T])
+-/
+#guard_msgs in
+#eval do
+  let (func', _) ← Function.typeCheck C Env strayQuantVarFunc
+  return format f!"typeArgs: {func'.typeArgs}\ninputs: {func'.inputs}\noutput: {func'.output}\nbody: {func'.body}"
+
+-- fvar annotation referencing an undeclared type var.
+-- g<T>(x:T):T { x } where x carries annotation (ftvar "V").
+private def strayFvarAnnotFunc : Core.Function :=
+  { name := ⟨"g", ()⟩,
+    typeArgs := ["T"],
+    inputs := [(⟨"x", ()⟩, .ftvar "T")],
+    output := .ftvar "T",
+    body := some (.fvar () ⟨"x", ()⟩ (some (.ftvar "V"))) }
+
+/--
+info: ok: typeArgs: [T]
+inputs: (x, T)
+output: T
+body: some x
+-/
+#guard_msgs in
+#eval do
+  let (func', _) ← Function.typeCheck C Env strayFvarAnnotFunc
+  return format f!"typeArgs: {func'.typeArgs}\ninputs: {func'.inputs}\noutput: {func'.output}\nbody: {func'.body}"
+
+-- Non-trivial bwdMap: unannotated binder creates fresh type variables that
+-- get renamed back via the alpha-equivalence witness map.
+-- wrap<a,b>(f: a->b, x: a): b { (\y.f(y))(x) }
+private def nonTrivialBwdFunc : Core.Function :=
+  { name := ⟨"wrap", ()⟩,
+    typeArgs := ["a", "b"],
+    inputs := [(⟨"f", ()⟩, .arrow (.ftvar "a") (.ftvar "b")), (⟨"x", ()⟩, .ftvar "a")],
+    output := .ftvar "b",
+    body := some (.app ()
+      (.abs () "y" none (.app () (.fvar () ⟨"f", ()⟩ none) (.bvar () 0)))
+      (.fvar () ⟨"x", ()⟩ none)) }
+
+/--
+info: ok: typeArgs: [a, b]
+inputs: (f, (arrow a b)) (x, a)
+output: b
+body: some (fun y : (a) => f(y))(x)
+-/
+#guard_msgs in
+#eval do
+  let (func', _) ← Function.typeCheck C Env nonTrivialBwdFunc
+  return format f!"typeArgs: {func'.typeArgs}\ninputs: {func'.inputs}\noutput: {func'.output}\nbody: {func'.body}"
+
+-- Higher-order function with multiple type args.
+-- apply<a,b>(f: a -> b, x: a): b { f(x) }
+open Strata in
+def higherOrderPgm :=
+#strata
+program Core;
+
+inline function apply<a, b>(f : a -> b, x : a) : b {
+  f(x)
+}
+#end
+
+/--
+info: [Strata.Core] Type checking succeeded.
+
+---
+info: ok: program Core;
+
+inline function apply<a, b> (f : a -> b, x : a) : b {
+  f(x)
+}
+-/
+#guard_msgs in
+open Strata in
+#eval
+  let pgm := (TransM.run Inhabited.default (translateProgram higherOrderPgm)).fst
+  Std.format (Core.typeCheck .default pgm.stripMetaData)
+
+---------------------------------------------------------------------
+-- alphaEquivMap unit tests
+---------------------------------------------------------------------
+
+-- Reflexive: a type is alpha-equivalent to itself.
+#guard (LMonoTy.alphaEquivMap (.ftvar "a") (.ftvar "a")).isSome
+
+-- Consistent renaming: (a → a) ≈ (b → b).
+#guard (LMonoTy.alphaEquivMap
+  (.tcons "arrow" [.ftvar "a", .ftvar "a"])
+  (.tcons "arrow" [.ftvar "b", .ftvar "b"])).isSome
+
+-- Non-injective (capture): (a → b) ≉ (c → c) — two vars mapped to one.
+#guard (LMonoTy.alphaEquivMap
+  (.tcons "arrow" [.ftvar "a", .ftvar "b"])
+  (.tcons "arrow" [.ftvar "c", .ftvar "c"])).isNone
+
+-- Distinct ftvars with crossing: (a → b) ≈ (b → a).
+#guard (LMonoTy.alphaEquivMap
+  (.tcons "arrow" [.ftvar "a", .ftvar "b"])
+  (.tcons "arrow" [.ftvar "b", .ftvar "a"])).isSome
+
+-- Mismatched constructors: arrow ≉ pair.
+#guard (LMonoTy.alphaEquivMap
+  (.tcons "arrow" [.ftvar "a", .ftvar "b"])
+  (.tcons "pair" [.ftvar "a", .ftvar "b"])).isNone
+
+-- Mismatched arity: (a → b) ≉ (a).
+#guard (LMonoTy.alphaEquivMap
+  (.tcons "arrow" [.ftvar "a", .ftvar "b"])
+  (.tcons "arrow" [.ftvar "a"])).isNone
+
+end Core.FunctionTypeTests
diff --git a/StrataTest/Languages/Core/Tests/PolymorphicFunctionTest.lean b/StrataTest/Languages/Core/Tests/PolymorphicFunctionTest.lean
index 8c0a2d54bc..12838ec9c9 100644
--- a/StrataTest/Languages/Core/Tests/PolymorphicFunctionTest.lean
+++ b/StrataTest/Languages/Core/Tests/PolymorphicFunctionTest.lean
@@ -35,7 +35,7 @@ function identity<a>(x : a) : a;
 /--
 info: ok: program Core;
 
-function identity<$__ty0> (x : $__ty0) : $__ty0;
+function identity<a> (x : a) : a;
 -/
 #guard_msgs in
 #eval Core.typeCheck .quiet (TransM.run Inhabited.default (translateProgram singleTypeParamDeclPgm)).fst
@@ -65,7 +65,7 @@ spec {
 /--
 info: ok: program Core;
 
-function identity<$__ty0> (x : $__ty0) : $__ty0;
+function identity<a> (x : a) : a;
 procedure TestIdentityInt ()
 spec {
   ensures [TestIdentityInt_ensures_0]: true;
@@ -102,7 +102,7 @@ spec {
 /--
 info: ok: program Core;
 
-function makePair<$__ty0, $__ty1> (x : $__ty0, y : $__ty1) : Map $__ty0 $__ty1;
+function makePair<a, b> (x : a, y : b) : Map a b;
 procedure TestMakePair ()
 spec {
   ensures [TestMakePair_ensures_0]: true;
@@ -138,7 +138,7 @@ spec {
 /--
 info: ok: program Core;
 
-function apply<$__ty0, $__ty1> (f : $__ty0 -> $__ty1, x : $__ty0) : $__ty1;
+function apply<a, b> (f : a -> b, x : a) : b;
 function intToBool (x : int) : bool;
 procedure TestApply ()
 spec {
@@ -175,8 +175,8 @@ spec {
 /--
 info: ok: program Core;
 
-function identity<$__ty0> (x : $__ty0) : $__ty0;
-function makePair<$__ty1, $__ty2> (x : $__ty1, y : $__ty2) : Map $__ty1 $__ty2;
+function identity<a> (x : a) : a;
+function makePair<a, b> (x : a, y : b) : Map a b;
 procedure TestDifferentInstantiations ()
 spec {
   ensures [TestDifferentInstantiations_ensures_0]: true;
@@ -209,7 +209,7 @@ spec {
 #end
 
 /--
-info: error: (4717-4740) Impossible to unify (arrow int bool) with (arrow bool $__ty5).
+info: error: (4582-4605) Impossible to unify (arrow int bool) with (arrow bool $__ty5).
 First mismatch: int with bool.
 -/
 #guard_msgs in
diff --git a/StrataTest/Languages/Core/Tests/ProcedurePathConditionIsolation.lean b/StrataTest/Languages/Core/Tests/ProcedurePathConditionIsolation.lean
new file mode 100644
index 0000000000..36acb95062
--- /dev/null
+++ b/StrataTest/Languages/Core/Tests/ProcedurePathConditionIsolation.lean
@@ -0,0 +1,57 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+meta import Strata.Languages.Core
+import StrataDDM.Integration.Lean.HashCommands
+
+/-
+Regression test for strata-org/Strata#1390.
+
+A structured `exit` bypasses `Env.merge`, so a procedure's path conditions used
+to leak into later procedures; a contradictory leaked set then proved their
+false obligations vacuously. `first` has an unsatisfiable precondition + a
+structured `exit`; `second`'s `assert false` must fail, not silently pass.
+-/
+
+meta section
+open StrataDDM (Program)
+
+namespace Strata
+
+def leakViaStructuredExit : Program :=
+#strata
+program Core;
+
+procedure first(n : int)
+spec {
+  requires [c1]: (n >= 1);
+  requires [c2]: (n <= 0);
+}
+{
+  body: {
+    if (n > 5) { exit body; }
+  }
+};
+
+procedure second()
+{
+  assert [bad]: false;
+};
+#end
+
+/--
+info:
+Obligation: bad
+Property: assert
+Result: ❌ fail
+-/
+#guard_msgs in
+#eval Core.verify leakViaStructuredExit (options := .quiet)
+
+end Strata
+
+end
diff --git a/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean b/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean
index df69055dae..86a3aefac5 100644
--- a/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean
+++ b/StrataTest/Languages/Core/Tests/ProcedureTypeTests.lean
@@ -40,7 +40,7 @@ info: ok: (procedure P (x : int, out y : int)
                                           outputs := [("y", mty[int])] },
                                spec := { preconditions := [("0_lt_x", ⟨eb[((~Int.Lt #0) x)], .Default, #[]⟩)],
                                          postconditions := [("ret_y_lt_0", ⟨eb[((~Int.Lt y) #0)], .Default, #[]⟩)] },
-                               body := [
+                               body := .structured [
                                  Statement.set "y" eb[((~Int.Sub #0) x)] .empty
                                ]
                              }
diff --git a/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean b/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean
index f43af1af8a..0446dcb4b6 100644
--- a/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean
+++ b/StrataTest/Languages/Core/Tests/ProgramEvalTests.lean
@@ -431,7 +431,7 @@ Proof Obligation:
                 spec := {
                     preconditions := [("0_lt_x", ⟨eb[((~Int.Lt #0) x)], .Default, #[]⟩)],
                     postconditions := [("ret_y_lt_0", ⟨eb[((~Int.Lt y) #0)], .Default, #[]⟩)] },
-                body := [
+                body := .structured [
                   Statement.set "y" eb[(~Int.Neg x)] .empty
                 ]
               }
diff --git a/StrataTest/Languages/Core/Tests/ProgramTypeTests.lean b/StrataTest/Languages/Core/Tests/ProgramTypeTests.lean
index 2fb8b5f5de..9ff897e35e 100644
--- a/StrataTest/Languages/Core/Tests/ProgramTypeTests.lean
+++ b/StrataTest/Languages/Core/Tests/ProgramTypeTests.lean
@@ -33,7 +33,7 @@ def bad_prog : Program := { decls := [
               spec := {
                   preconditions := [],
                   postconditions := [] },
-              body := [
+              body := .structured [
                 Statement.assert "test" eb[(~fooAliasVal == ~fooVal)] .empty
               ]
       } .empty
@@ -63,7 +63,7 @@ def good_prog : Program := { decls := [
               spec := {
                   preconditions := [],
                   postconditions := [] },
-              body := [
+              body := .structured [
                 Statement.assert "test" eb[(~fooAliasVal == ~fooVal)] .empty
               ]
       } .empty
@@ -105,7 +105,7 @@ def outOfScopeVarProg : Program := { decls := [
               spec := {
                   preconditions := [],
                   postconditions := [] },
-              body := [
+              body := .structured [
                 Statement.set "y" eb[((~Bool.Or x) x)] .empty,
                 .ite (.det eb[(x == #true)])
                   [Statement.init "q" t[int] (.det eb[#0]) .empty,
@@ -149,7 +149,7 @@ def polyFuncProg : Program := { decls := [
                       outputs := [] },
           spec := { preconditions := [],
                     postconditions := [] },
-          body := [
+          body := .structured [
             -- var m : Map int bool;
             Statement.init "m" (.forAll [] (.tcons "Map" [.tcons "int" [], .tcons "bool" []])) Imperative.ExprOrNondet.nondet .empty,
             -- m := makePair(identity(42), identity(true));
@@ -164,8 +164,8 @@ info: [Strata.Core] Type checking succeeded.
 ---
 info: ok: program Core;
 
-function identity<$__ty0> (x : $__ty0) : $__ty0;
-function makePair<$__ty1, $__ty2> (x : $__ty1, y : $__ty2) : Map $__ty1 $__ty2;
+function identity<a> (x : a) : a;
+function makePair<a, b> (x : a, y : b) : Map a b;
 procedure Test ()
 {
   var m : (Map int bool);
diff --git a/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean b/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean
index fbb43ad351..1142c5accf 100644
--- a/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean
+++ b/StrataTest/Languages/Core/Tests/SMTEncoderDatatypeTest.lean
@@ -5,7 +5,7 @@
 -/
 module
 
-meta import Strata.DL.Lambda.Lambda
+meta import Strata.DL.Lambda
 meta import Strata.DL.Lambda.LExpr
 meta import Strata.DL.Lambda.LState
 meta import Strata.DL.Lambda.LTy
diff --git a/StrataTest/Languages/Core/Tests/StatementTypeTests.lean b/StrataTest/Languages/Core/Tests/StatementTypeTests.lean
index ba47b08a46..5c81a8d725 100644
--- a/StrataTest/Languages/Core/Tests/StatementTypeTests.lean
+++ b/StrataTest/Languages/Core/Tests/StatementTypeTests.lean
@@ -208,6 +208,32 @@ info: ok: {
 #eval do let ans ← typeCheck LContext.default TEnv.default Program.init none testFuncDeclTypeCheck
          return format ans.fst
 
+-- Regression test for #1289: outer type variable captured in local function body.
+def testOuterTyVarCapture : List Statement :=
+  let localFunc : PureFunc Expression := {
+    name := ⟨"f", ()⟩,
+    typeArgs := ["b"],
+    isConstr := false,
+    inputs := [(⟨"y", ()⟩, .forAll [] (.ftvar "b"))],
+    output := .forAll [] (.ftvar "b"),
+    body := some (.app () (.abs () "z" (some (.ftvar "a")) (.bvar () 0))
+                          (.fvar () ⟨"y", ()⟩ none)),
+    attr := #[],
+    concreteEval := none,
+    axioms := []
+  }
+  [.funcDecl localFunc .empty]
+
+/--
+info: error: Function 'f': body contains undeclared type variables [a] (not in typeArgs [b])
+-/
+#guard_msgs in
+#eval do
+  -- "a" is in the outer context as a type variable (simulating a polymorphic procedure)
+  let Env := TEnv.default.updateContext {types := [[("x", .forAll ["a"] (.ftvar "a"))]]}
+  let ans ← typeCheck LContext.default Env Program.init none testOuterTyVarCapture
+  return format ans.fst
+
 end FuncDeclTests
 
 section NondetCondTests
@@ -256,7 +282,7 @@ private def testProc : Procedure :=
       inputs := [(⟨"x", ()⟩, .int)],
       outputs := [(⟨"x", ()⟩, .int), (⟨"y", ()⟩, .int)] },
     spec := { preconditions := [], postconditions := [] },
-    body := [] }
+    body := .structured [] }
 
 private def testProgram : Program :=
   { decls := [.proc testProc .empty] }
diff --git a/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean b/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean
index fef0458c8d..cfc0740d51 100644
--- a/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean
+++ b/StrataTest/Languages/Laurel/AbstractToConcreteTreeTranslatorTest.lean
@@ -3,20 +3,18 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 Tests that the Laurel AST to DDM concrete syntax tree conversion
 (programToStrata) preserves program structure through roundtripping.
 -/
 
-meta import StrataDDM.Elab
-meta import StrataDDM.BuiltinDialects.Init
-meta import Strata.Languages.Laurel.Grammar.LaurelGrammar
-meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
-meta import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
-
-meta section
+import StrataDDM.Elab
+import StrataDDM.BuiltinDialects.Init
+import StrataDDM.Integration.Lean.HashCommands
+import Strata.Languages.Laurel.Grammar.LaurelGrammar
+import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
+import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
 
 open Strata
 open StrataDDM (initDialect)
@@ -24,12 +22,8 @@ open StrataDDM.Elab (parseStrataProgramFromDialect)
 
 namespace Strata.Laurel
 
-private def parseLaurel (input : String) : IO Program := do
-  let inputCtx := StrataDDM.Parser.stringInputContext "test" input
-  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
-  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name inputCtx
-  let uri := Strata.Uri.file "test"
-  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
+private def parseFromStrata (strataProgram : StrataDDM.Program) : IO Program := do
+  match Laurel.TransM.run (Strata.Uri.file "test") (Laurel.parseProgram strataProgram) with
   | .error e => throw (IO.userError s!"Translation errors: {e}")
   | .ok program => pure program
 
@@ -46,12 +40,16 @@ private def roundtripViaDDM (prog : Program) : IO String := do
   | .error e => throw (IO.userError s!"DDM roundtrip parse errors: {e}")
   | .ok program2 => pure (laurelToText program2)
 
-/-- Parse text, roundtrip through DDM, print, then re-parse the output and verify convergence -/
-private def roundtrip (input : String) : IO String := do
-  let program ← parseLaurel input
+/-- Roundtrip a `StrataDDM.Program` (already parsed by `#strata`) through DDM,
+    pretty-print, re-parse, and verify convergence. -/
+private def roundtrip (strataProgram : StrataDDM.Program) : IO String := do
+  let program ← parseFromStrata strataProgram
   let firstPass ← roundtripViaDDM program
   -- Re-parse the output and verify it produces the same text (convergence)
-  let reparsed ← parseLaurel firstPass
+  let inputCtx := StrataDDM.Parser.stringInputContext "test" firstPass
+  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
+  let reparsedStrata ← parseStrataProgramFromDialect dialects Laurel.name inputCtx
+  let reparsed ← parseFromStrata reparsedStrata
   let secondPass ← roundtripViaDDM reparsed
   if firstPass != secondPass then
     throw (IO.userError s!"Roundtrip does not converge.\nFirst pass:\n{firstPass}\nSecond pass:\n{secondPass}")
@@ -68,9 +66,13 @@ info: procedure foo()
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"procedure foo()
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
+procedure foo()
   opaque
-{ assert true; assert false };")
+{ assert true; assert false };
+#end)
 
 /--
 info: procedure add(x: int, y: int): int
@@ -80,9 +82,13 @@ info: procedure add(x: int, y: int): int
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"procedure add(x: int, y: int): int
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
+procedure add(x: int, y: int): int
   opaque
-{ x + y };")
+{ x + y };
+#end)
 
 /--
 info: function aFunction(x: int): int
@@ -91,31 +97,43 @@ info: function aFunction(x: int): int
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"function aFunction(x: int): int
-{ x };")
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
+function aFunction(x: int): int
+{ x };
+#end)
 
 /--
 info: composite Point { var x: int var y: int }
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
 composite Point {
   var x: int
   var y: int
 }
-")
+#end)
 
 /--
 info: procedure test(x: int): int
   opaque
 {
-  if x > 0 then x else 0 - x
+  if x > 0
+  then x
+  else 0 - x
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"procedure test(x: int): int
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
+procedure test(x: int): int
   opaque
-{ if x > 0 then x else 0 - x };")
+{ if x > 0 then x else 0 - x };
+#end)
 
 /--
 info: procedure divide(x: int, y: int): int
@@ -127,13 +145,15 @@ info: procedure divide(x: int, y: int): int
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
 procedure divide(x: int, y: int): int
   requires y != 0
   opaque
   ensures result >= 0
 { x / y };
-")
+#end)
 
 /--
 info: procedure test()
@@ -144,14 +164,16 @@ info: procedure test()
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
 procedure test()
   opaque
 {
     assert forall(x: int) => x == x;
     assert exists(y: int) => y > 0
 };
-")
+#end)
 
 /--
 info: composite Point { var x: int var y: int }
@@ -165,7 +187,9 @@ procedure test(): int
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
 composite Point {
   var x: int
   var y: int
@@ -177,19 +201,27 @@ procedure test(): int
     p#x := 5;
     p#x
 };
-")
+#end)
 
 /--
 info: datatype Color { Red, Green, Blue }
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"datatype Color { Red, Green, Blue }")
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
+datatype Color { Red, Green, Blue }
+#end)
 
 /--
 info: datatype Pair { MkPair(fst: int, snd: bool) }
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"datatype Pair { MkPair(fst: int, snd: bool) }")
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
+datatype Pair { MkPair(fst: int, snd: bool) }
+#end)
 
 /--
 info: composite Animal { }
@@ -203,13 +235,15 @@ procedure test(a: Animal): bool
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
 composite Animal {}
 composite Dog extends Animal {}
 procedure test(a: Animal): bool
   opaque
 { a is Dog };
-")
+#end)
 
 -- Additional coverage: while loops
 
@@ -225,7 +259,9 @@ info: procedure test()
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
 procedure test()
   opaque
 {
@@ -234,7 +270,7 @@ procedure test()
       invariant x >= 0
     { x := x + 1 }
 };
-")
+#end)
 
 -- Additional coverage: constrained types
 
@@ -242,7 +278,11 @@ procedure test()
 info: constrained Positive = v: int where v > 0 witness 1
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"constrained Positive = v: int where v > 0 witness 1")
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
+constrained Positive = v: int where v > 0 witness 1
+#end)
 
 -- Additional coverage: modifies clauses
 
@@ -259,14 +299,16 @@ procedure modify(c: Container)
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
 composite Container { var value: int }
 procedure modify(c: Container)
   opaque
   ensures true
   modifies c
 { c#value := c#value + 1; true };
-")
+#end)
 
 -- Additional coverage: nondeterministic holes
 
@@ -278,9 +320,62 @@ info: procedure test(): int
 };
 -/
 #guard_msgs in
-#eval do IO.println (← roundtrip r"procedure test(): int
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
+procedure test(): int
+  opaque
+{ <??> };
+#end)
+
+-- Valueless return (issue #1353): a bare `return` round-trips as `.Return none`,
+-- not as the old `return { }` block hack, and re-parses stably.
+/--
+info: procedure earlyExit(b: bool)
+  opaque
+{
+  if b
+  then {
+    return
+  };
+  assert true
+};
+-/
+#guard_msgs in
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
+procedure earlyExit(b: bool)
   opaque
-{ <??> };")
+{ if b then { return }; assert true };
+#end)
+
+-- Do-while (issue #1358): a `do … while` parses to a post-test `While`
+-- (`postTest := true`) and round-trips through the DDM tree via the `doWhile`
+-- serialization arm (whose `#[body, cond, invariants]` arg order this
+-- exercises), re-parsing stably. The desugaring to a pre-test loop happens
+-- later, in the `EliminateDoWhile` pass, not here.
+/--
+info: procedure loop()
+  opaque
+{
+  var x: int := 0;
+  do {
+    x := x + 1
+  } while(x < 3)
+    invariant 0 <= x && x <= 2
+};
+-/
+#guard_msgs in
+#eval do IO.println (← roundtrip
+#strata
+program Laurel;
+procedure loop()
+  opaque
+{
+  var x: int := 0;
+  do { x := x + 1 } while(x < 3) invariant 0 <= x && x <= 2
+};
+#end)
 
 end Strata.Laurel
-end
diff --git a/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean b/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean
index 83330e47b0..9580ece5d6 100644
--- a/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean
+++ b/StrataTest/Languages/Laurel/ConstrainedTypeElimTest.lean
@@ -3,55 +3,34 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 Tests that the constrained type elimination pass correctly transforms
 Laurel programs by comparing the output against expected results.
 -/
 
-meta import StrataDDM.Elab
-meta import StrataDDM.BuiltinDialects.Init
-meta import Strata.Languages.Laurel.Grammar
-meta import Strata.Languages.Laurel.ConstrainedTypeElim
-meta import Strata.Languages.Laurel.Resolution
-
-meta section
+import StrataTest.Util.TestLaurel
+import Strata.Languages.Laurel.ConstrainedTypeElim
+import Strata.Languages.Laurel.Resolution
 
 open Strata
-open StrataDDM (initDialect)
-open StrataDDM.Elab (parseStrataProgramFromDialect)
+open StrataTest.Util
 
 namespace Strata.Laurel
 
-def testProgram : String := r"
-constrained nat = x: int where x >= 0 witness 0
-procedure test(n: nat) returns (r: nat)
-  opaque
-{
-  assert r >= 0;
-  var y: nat := n;
-  return y
-};
-"
+private def parseLaurelAndElim (program : StrataDDM.Program) : IO Program := do
+  let laurelProgram ← translateLaurel program
+  let result := resolve laurelProgram
+  pure (constrainedTypeElim result.model result.program).1
 
-def parseLaurelAndElim (input : String) : IO Program := do
-  let inputCtx := StrataDDM.Parser.stringInputContext "test" input
-  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
-  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name inputCtx
-  let uri := Strata.Uri.file "test"
-  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
-  | .error e => throw (IO.userError s!"Translation errors: {e}")
-  | .ok program =>
-    let result := resolve program
-    let (program, model) := (result.program, result.model)
-    pure (constrainedTypeElim model program).1
+private def printElim (program : StrataDDM.Program) : IO Unit := do
+  let result ← parseLaurelAndElim program
+  for proc in result.staticProcedures do
+    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
 
 /--
 info: function nat$constraint(x: int): bool
-{
-  x >= 0
-};
+x >= 0;
 procedure test(n: int)
   returns (r: int)
   requires nat$constraint(n)
@@ -71,36 +50,26 @@ procedure $witness_nat()
 };
 -/
 #guard_msgs in
-#eval! do
-  let program ← parseLaurelAndElim testProgram
-  for proc in program.staticProcedures do
-    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
-
--- Scope management: constrained variable in if-branch must not leak into sibling block
-def scopeProgram : String := r"
-constrained pos = v: int where v > 0 witness 1
-procedure test(b: bool)
-  opaque
-{
-  if b then {
-    var x: pos := 1
-  };
-  {
-    var x: int := -5;
-    x := -10
-  }
+#eval! printElim
+#strata
+program Laurel;
+constrained nat = x: int where x >= 0 witness 0
+procedure test(n: nat) returns (r: nat) opaque {
+  assert r >= 0;
+  var y: nat := n;
+  return y
 };
-"
+#end
 
+-- Scope management: constrained variable in if-branch must not leak into sibling block
 /--
 info: function pos$constraint(v: int): bool
-{
-  v > 0
-};
+v > 0;
 procedure test(b: bool)
   opaque
 {
-  if b then {
+  if b
+  then {
     var x: int := 1;
     assert pos$constraint(x)
   };
@@ -117,28 +86,26 @@ procedure $witness_pos()
 };
 -/
 #guard_msgs in
-#eval! do
-  let program ← parseLaurelAndElim scopeProgram
-  for proc in program.staticProcedures do
-    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
+#eval! printElim
+#strata
+program Laurel;
+constrained pos = v: int where v > 0 witness 1
+procedure test(b: bool) opaque {
+  if b then {
+    var x: pos := 1
+  };
+  {
+    var x: int := -5;
+    x := -10
+  }
+};
+#end
 
 -- Uninitialized constrained variable: havoc + assume constraint.
 -- The variable has no known value, only the type constraint is assumed.
-def uninitProgram : String := r"
-constrained posint = x: int where x > 0 witness 1
-procedure f()
-  opaque
-{
-  var x: posint;
-  assert x == 1
-};
-"
-
 /--
 info: function posint$constraint(x: int): bool
-{
-  x > 0
-};
+x > 0;
 procedure f()
   opaque
 {
@@ -154,11 +121,14 @@ procedure $witness_posint()
 };
 -/
 #guard_msgs in
-#eval! do
-  let program ← parseLaurelAndElim uninitProgram
-  for proc in program.staticProcedures do
-    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
+#eval! printElim
+#strata
+program Laurel;
+constrained posint = x: int where x > 0 witness 1
+procedure f() opaque {
+  var x: posint;
+  assert x == 1
+};
+#end
 
 end Laurel
-end Strata
-end
diff --git a/StrataTest/Languages/Laurel/DatatypeEqHeapProcTest.lean b/StrataTest/Languages/Laurel/DatatypeEqHeapProcTest.lean
new file mode 100644
index 0000000000..0af4f2514a
--- /dev/null
+++ b/StrataTest/Languages/Laurel/DatatypeEqHeapProcTest.lean
@@ -0,0 +1,69 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-! ## Regression: datatype `==` / `!=` inside a heap-writing procedure
+
+`HeapParameterization` rewrites `==`/`!=` on heap references into a
+`Composite..ref!` reference comparison. The operand-type check used
+`.UserDefined _`, which matches BOTH composites (heap references, where
+`ref!` is correct) AND datatypes (values, where `ref!` is wrong: it would
+unify a datatype value against the `Composite` (= int) type).
+
+The bug only surfaces inside a procedure that writes the heap, because only
+then does the heap-rewriting pass descend into the body and reach the `==`
+arm. Allocating a composite (`new C`) is enough to make the procedure a heap
+writer, so a datatype comparison sitting next to it used to fail Core type
+checking with:
+
+  Impossible to unify (arrow Composite int) with (arrow <Datatype> ...)
+
+The fix guards the `ref!` rewrite on `!isDatatype`, letting datatype
+equality fall through to structural comparison. These programs verify
+cleanly with the fix and fail Core type checking without it.
+
+A datatype compared with `==` inside a heap-writing procedure. The `new C`
+makes `cmp` a heap writer; the datatype values must still compare
+structurally rather than being wrongly reference-compared. -/
+
+#eval testLaurel
+#strata
+program Laurel;
+composite C { var x: int }
+datatype Pair { MkPair(a: int, b: int) }
+
+procedure cmp()
+  opaque
+{
+  var c: C := new C;
+  var p1: Pair := MkPair(1, 2);
+  var p2: Pair := MkPair(1, 2);
+  assert p1 == p2
+};
+#end
+
+/-! Same shape with `!=`: two structurally-distinct datatype values are not
+equal, so the inequality holds. Exercises the `.Neq` arm of the same fix. -/
+
+#eval testLaurel
+#strata
+program Laurel;
+composite C { var x: int }
+datatype Pair { MkPair(a: int, b: int) }
+
+procedure cmp()
+  opaque
+{
+  var c: C := new C;
+  var p1: Pair := MkPair(1, 2);
+  var p2: Pair := MkPair(3, 4);
+  assert p1 != p2
+};
+#end
diff --git a/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean b/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean
index b6d91bdf9c..8f652186e9 100644
--- a/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean
+++ b/StrataTest/Languages/Laurel/DivisionByZeroCheckTest.lean
@@ -3,16 +3,11 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
-
-namespace Strata.Laurel
+open Strata
 
 /-! ## End-to-end test: safe division (no errors) and unsafe division (error)
 
@@ -21,7 +16,11 @@ built-in preconditions (divisor ≠ 0). The PrecondElim transform automatically
 generates verification conditions for these preconditions.
 -/
 
-def e2eProgram := r"
+/-! ### Safe paths verify cleanly -/
+
+#eval testLaurel
+#strata
+program Laurel;
 procedure safeDivision()
   opaque
 {
@@ -31,15 +30,6 @@ procedure safeDivision()
   assert z == 5
 };
 
-// Error ranges are too wide because Core does not use expression locations
-procedure unsafeDivision(x: int)
-  opaque
-{
-  var z: int := 10 / x
-//^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
-// Error ranges are too wide because Core does not use expression locations
-};
-
 function pureDiv(x: int, y: int): int
   requires y != 0
 {
@@ -52,18 +42,37 @@ procedure callPureDivSafe()
   var z: int := pureDiv(10, 2);
   assert z == 5
 };
+#end
+
+/-! ### Unsafe division: divisor not constrained, fails verification -/
+
+-- Error ranges are too wide because Core does not use expression locations.
+#eval testLaurel <|
+#strata
+program Laurel;
+procedure unsafeDivision(x: int)
+  opaque
+{
+  var z: int := 10 / x
+//^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
+};
+#end
+
+/-! ### Unsafe call to function with `requires y != 0` -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+function pureDiv(x: int, y: int): int
+  requires y != 0
+{
+  x / y
+};
 
 procedure callPureDivUnsafe(x: int)
   opaque
 {
   var z: int := pureDiv(10, x)
 //^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
-// Error ranges are too wide because Core does not use expression locations
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "DivByZeroE2E" e2eProgram 20 processLaurelFile
-
-end Strata.Laurel
-end
+#end
diff --git a/StrataTest/Languages/Laurel/DuplicateNameTests.lean b/StrataTest/Languages/Laurel/DuplicateNameTests.lean
index b1c7e5fe27..1ca1640a08 100644
--- a/StrataTest/Languages/Laurel/DuplicateNameTests.lean
+++ b/StrataTest/Languages/Laurel/DuplicateNameTests.lean
@@ -3,189 +3,140 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 Tests that the resolution pass detects duplicate names in the same scope.
-Uses inline error annotations like the other Laurel tests (e.g. T1_AssertFalse).
 -/
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import StrataDDM.Elab
-meta import StrataDDM.BuiltinDialects.Init
-meta import Strata.Languages.Laurel.Grammar.LaurelGrammar
-meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
-meta import Strata.Languages.Laurel.Resolution
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
-open StrataDDM (initDialect)
-open StrataDDM.Elab (parseStrataProgramFromDialect)
-
-namespace Strata.Laurel
-
-/-- Run only parsing + resolution and return diagnostics (no SMT verification). -/
-private def processResolution (input : Lean.Parser.InputContext) : IO (Array Diagnostic) := do
-  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
-  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name input
-  let uri := Strata.Uri.file input.fileName
-  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
-  | .error e => throw (IO.userError s!"Translation errors: {e}")
-  | .ok program =>
-    let result := resolve program
-    let files := Map.insert Map.empty uri input.fileMap
-    return result.errors.toList.map (fun dm => dm.toDiagnostic files) |>.toArray
 
 /-! ## Duplicate static procedure names -/
 
-def dupProcedures := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 procedure foo() opaque { };
 procedure foo() opaque { };
 //        ^^^ error: Duplicate definition 'foo' is already defined in this scope
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "DupProcedures" dupProcedures 35 processResolution
+#end
 
 /-! ## Duplicate type names -/
 
-def dupTypes := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 composite Foo { }
 composite Foo { }
 //        ^^^ error: Duplicate definition 'Foo' is already defined in this scope
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "DupTypes" dupTypes 43 processResolution
+#end
 
 /-! ## Duplicate field names in a composite type -/
 
-def dupFields := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 composite Foo {
   var f: int
   var f: bool
 //    ^ error: Duplicate definition 'Foo.f' is already defined in this scope
 }
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "DupFields" dupFields 51 processResolution
+#end
 
 /-! ## Duplicate parameter names in a procedure -/
 
-def dupParams := r"
-procedure foo(x: int, x: bool)
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure foo(x: int, x: bool) opaque { };
 //                    ^ error: Duplicate definition 'x' is already defined in this scope
-  opaque
-{ };
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "DupParams" dupParams 77 processResolution
+#end
 
 /-! ## Duplicate instance procedure names in a composite type -/
 
-def dupInstanceProcs := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 composite Foo {
-  procedure bar()
-//          ^^^ error: Instance procedure 'bar' on composite type 'Foo' is not yet supported
-    opaque
-  { };
-  procedure bar()
-//          ^^^ error: Instance procedure 'bar' on composite type 'Foo' is not yet supported
-//          ^^^ error: Duplicate definition 'bar' is already defined in this scope
-    opaque
-  { };
+  procedure bar() opaque { };
+  procedure bar() opaque { };
+//          ^^^ error: Duplicate definition 'Foo$bar' is already defined in this scope
 }
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "DupInstanceProcs" dupInstanceProcs 89 processResolution
+#end
 
 /-! ## Duplicate local variable names in the same block -/
 
-def dupLocals := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 procedure foo() opaque {
   var x: int := 1;
   var x: int := 2
 //    ^ error: Duplicate definition 'x' is already defined in this scope
 };
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "DupLocals" dupLocals 81 processResolution
+#end
 
 /-! ## Procedure and type with the same name -/
 
-def dupProcType := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 composite Foo { }
 procedure Foo() opaque { };
 //        ^^^ error: Duplicate definition 'Foo' is already defined in this scope
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "DupProcType" dupProcType 91 processResolution
+#end
 
 /-! ## Shadowing quantifier variables in nested scopes is OK (no error expected) -/
 
-def shadowQuantifierVars := r"
+#eval testLaurelResolution
+#strata
+program Laurel;
 procedure test() opaque {
   assert forall(x: int) => forall(x: int) => x > 0
 };
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "ShadowQuantifierVars" shadowQuantifierVars 99 processResolution
+#end
 
 /-! ## Shadowing in nested blocks is OK (no error expected) -/
 
-def shadowingOk := r"
+#eval testLaurelResolution
+#strata
+program Laurel;
 procedure foo() opaque {
   var x: int := 1;
   {
     var x: int := 2
   }
 };
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "ShadowingOk" shadowingOk 109 processResolution
+#end
 
 /-! ## Duplicate constrained type names -/
 
-def dupConstrainedTypes := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 constrained nat = x: int where x >= 0 witness 0
 constrained nat = x: int where x > 0 witness 1
 //          ^^^ error: Duplicate definition 'nat' is already defined in this scope
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "DupConstrainedTypes" dupConstrainedTypes 119 processResolution
+#end
 
 /-! ## Duplicate datatype names -/
 
-def dupDatatypes := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 datatype Foo { A }
 datatype Foo { B }
 //       ^^^ error: Duplicate definition 'Foo' is already defined in this scope
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "DupDatatypes" dupDatatypes 127 processResolution
+#end
 
 /-! ## Composite type and datatype with the same name -/
 
-def dupCompositeDatatype := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 composite Foo { }
 datatype Foo { A }
 //       ^^^ error: Duplicate definition 'Foo' is already defined in this scope
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "DupCompositeDatatype" dupCompositeDatatype 135 processResolution
-
-end Laurel
-end Strata
-end
+#end
diff --git a/StrataTest/Languages/Laurel/EliminateDoWhileTest.lean b/StrataTest/Languages/Laurel/EliminateDoWhileTest.lean
new file mode 100644
index 0000000000..548073bb0a
--- /dev/null
+++ b/StrataTest/Languages/Laurel/EliminateDoWhileTest.lean
@@ -0,0 +1,131 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+/-
+Tests that the `EliminateDoWhile` pass lowers a post-test `do … while` loop
+to the pre-test form (see EliminateDoWhile.lean for the desugaring).
+-/
+
+meta import StrataDDM.Elab
+meta import StrataDDM.BuiltinDialects.Init
+meta import Strata.Languages.Laurel.Grammar
+meta import Strata.Languages.Laurel.EliminateDoWhile
+
+meta section
+
+open Strata
+open StrataDDM (initDialect)
+open StrataDDM.Elab (parseStrataProgramFromDialect)
+
+namespace Strata.Laurel
+
+/-- Run the parser, then the `EliminateDoWhile` pass, so the printed output is
+    the desugared pre-test form fed to the rest of the pipeline. -/
+def parseEliminateDoWhile (input : String) : IO Program := do
+  let inputCtx := StrataDDM.Parser.stringInputContext "test" input
+  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
+  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name inputCtx
+  let uri := Strata.Uri.file "test"
+  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
+  | .error e => throw (IO.userError s!"Translation errors: {e}")
+  | .ok program => pure (eliminateDoWhile program)
+
+/-- A single do-while; lowered form is in the `#guard_msgs` block below. -/
+def basicProgram : String := r"
+procedure basic()
+  opaque
+{
+  var x: int := 0;
+  do {
+    x := x + 1
+  } while(x < 3)
+    invariant 0 <= x && x <= 2;
+  assert x == 3
+};
+"
+
+/--
+info: procedure basic()
+  opaque
+{
+  var x: int := 0;
+  {
+    while(true)
+      invariant 0 <= x && x <= 2 {
+      {
+        x := x + 1
+      };
+      if !(x < 3)
+      then exit $dowhile_exit_0
+    }
+  }$dowhile_exit_0;
+  assert x == 3
+};
+-/
+#guard_msgs in
+#eval! do
+  let program ← parseEliminateDoWhile basicProgram
+  for proc in program.staticProcedures do
+    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
+
+/-- Nested do-whiles get distinct fresh exit labels (`_0` inner, `_1` outer). -/
+def nestedProgram : String := r"
+procedure nested()
+  opaque
+{
+  var x: int := 0;
+  do {
+    var y: int := 0;
+    do {
+      y := y + 1
+    } while(y < 3)
+      invariant 0 <= y;
+    x := x + 1
+  } while(x < 3)
+    invariant 0 <= x;
+  assert x == 3
+};
+"
+
+/--
+info: procedure nested()
+  opaque
+{
+  var x: int := 0;
+  {
+    while(true)
+      invariant 0 <= x {
+      {
+        var y: int := 0;
+        {
+          while(true)
+            invariant 0 <= y {
+            {
+              y := y + 1
+            };
+            if !(y < 3)
+            then exit $dowhile_exit_0
+          }
+        }$dowhile_exit_0;
+        x := x + 1
+      };
+      if !(x < 3)
+      then exit $dowhile_exit_1
+    }
+  }$dowhile_exit_1;
+  assert x == 3
+};
+-/
+#guard_msgs in
+#eval! do
+  let program ← parseEliminateDoWhile nestedProgram
+  for proc in program.staticProcedures do
+    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
+
+end Laurel
+end Strata
+end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean
index 7d6987cb55..0d15885bc9 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypes.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 constrained nat = x: int where x >= 0 witness 0
 constrained posnat = x: nat where x != 0 witness 1
 
@@ -35,7 +31,7 @@ procedure outputValid(): nat
 
 // Output constraint — invalid return fails
 procedure outputInvalid(): nat
-//                         ^^^ error: assertion does not hold
+//                         ^^^ error: postcondition does not hold
   opaque
 {
   return -1
@@ -142,6 +138,17 @@ procedure uninitNat()
   assert y >= 0
 };
 
+procedure sideEffect()
+  opaque
+{
+  var x : nat;
+  var y : int;
+  y := (x := -1) + 1;
+//      ^^^^^^^ error: assertion does not hold
+  assert x==-1;
+  assert y==0
+};
+
 // Uninitialized nested constrained variable — havoc + assume constraint
 procedure uninitPosnat()
   opaque
@@ -162,9 +169,7 @@ procedure uninitNotWitness()
 
 // Quantifier constraint injection — forall
 // n + 1 > 0 is only provable with n >= 0 injected; false for all int
-procedure forallNat()
-  opaque
-{
+procedure forallNat() opaque {
   var b: bool := forall(n: nat) => n + 1 > 0;
   assert b
 };
@@ -172,9 +177,7 @@ procedure forallNat()
 // Quantifier constraint injection — exists
 // n == -1 is satisfiable for int, but not when n >= 0 is required
 // n == 42 works because 42 >= 0
-procedure existsNat()
-  opaque
-{
+procedure existsNat() opaque {
   var b: bool := exists(n: nat) => n == 42;
   assert b
 };
@@ -197,10 +200,4 @@ procedure captureTest(y: haslarger)
   assert false
 //^^^^^^^^^^^^ error: assertion does not hold
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "ConstrainedTypes" program 14 processLaurelFile
-
-end Laurel
-end Strata
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypesError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypesError.lean
index 4c3d20f45f..7f523c987b 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypesError.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T10_ConstrainedTypesError.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 constrained nat = x: int where x >= 0 witness 0
 
 // Function with valid constrained return — constraint not checked (not yet supported)
@@ -33,10 +29,4 @@ procedure callerGood()
   var x: int := goodFunc();
   assert x >= 0
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "ConstrainedTypes" program 14 processLaurelFile
-
-end Laurel
-end Strata
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T12_Operators.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T12_Operators.lean
index c792a70e09..bdfb797d68 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T12_Operators.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T12_Operators.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def operatorsProgram := r"
+#eval testLaurel
+#strata
+program Laurel;
 procedure testArithmetic()
   opaque
 {
@@ -62,9 +58,4 @@ procedure testTruncatingDiv()
     assert (0 - 7) /t 3 == 0 - 2;
     assert (0 - 7) %t 3 == 0 - 1
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "Operators" operatorsProgram 14 processLaurelFile
-
-end Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoops.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoops.lean
index 8b0cc1934b..0d7b193c9f 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoops.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoops.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def whileLoopsProgram := r"
+#eval testLaurel
+#strata
+program Laurel;
 procedure countDown()
   opaque
 {
@@ -41,9 +37,4 @@ procedure countUp()
     };
     assert i == n
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "WhileLoops" whileLoopsProgram 14 processLaurelFile
-
-end Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoopsError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoopsError.lean
new file mode 100644
index 0000000000..e55297f647
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T13_WhileLoopsError.lean
@@ -0,0 +1,68 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-! ## Loop-invariant failures point at the specific invariant
+
+These negative tests pin each failing loop invariant's diagnostic to that
+invariant's own source range (per-invariant source ranges threaded through
+loop elimination), rather than the whole loop. -/
+
+#eval testLaurel
+#strata
+program Laurel;
+procedure badInitialInvariant()
+  opaque
+{
+    var i: int := -1;
+    while(i < 10)
+      invariant i >= 0
+//              ^^^^^^ error: assertion does not hold
+    {
+        i := i + 1
+    }
+};
+#end
+
+#eval testLaurel
+#strata
+program Laurel;
+procedure secondInvariantFails()
+  opaque
+{
+    var i: int := 0;
+    var j: int := -1;
+    while(i < 10)
+      invariant i >= 0
+      invariant j >= 0
+//              ^^^^^^ error: assertion does not hold
+    {
+        i := i + 1;
+        j := j + 1
+    }
+};
+#end
+
+#eval testLaurel
+#strata
+program Laurel;
+procedure forSecondInvFails()
+  opaque
+{
+    var j: int := -1;
+    for(var i: int := 0; i < 10; i := i + 1)
+      invariant i >= 0
+      invariant j >= 0
+//              ^^^^^^ error: assertion does not hold
+    {
+        j := j + 1
+    }
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean
index 6b748b0444..9b5f93f15d 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T14_Quantifiers.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def quantifiersProgram := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure testForall()
   opaque
 {
@@ -49,10 +45,4 @@ procedure triggers()
 //^^^^^^^^^^^^^^^ error: assertion could not be proved
   assert P(1) == 2
 };
-
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "Quantifiers" quantifiersProgram 14 processLaurelFile
-
-end Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean
index 4eeadef166..eb7562fe68 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T15_ShortCircuit.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def shortCircuitProgram := r"
+#eval testLaurel
+#strata
+program Laurel;
 function mustNotCallFunc(x: int): int
   requires false
 { x };
@@ -28,7 +24,6 @@ procedure mustNotCallProc(): int
 };
 
 // Pure path: function with requires false
-
 procedure testAndThenFunc()
   opaque
 {
@@ -92,10 +87,4 @@ procedure testImpliesProc()
   var b: bool := false ==> mustNotCallProc() > 0;
   assert b
 };
-"
-
-#guard_msgs(drop info) in
-#eval testInputWithOffset "ShortCircuit" shortCircuitProgram 15 processLaurelFile
-
-end Laurel
-end Strata
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean
index aa4c4f796c..9e063f036d 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T16_PropertySummary.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def program := r#"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure divide(x: int, y: int) returns (result: int)
   requires y != 0 summary "divisor is non-zero"
 // Call elimination reports precondition errors at the call site.
@@ -32,9 +28,4 @@ procedure checkPositive(n: int) returns (ok: bool)
   var x: int := divide(3, 0)
 //^^^^^^^^^^^^^^^^^^^^^^^^^^ error: divisor is non-zero does not hold
 };
-"#
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "PropertySummary" program 14 processLaurelFile
-
-end Strata.Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T17_ForLoop.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T17_ForLoop.lean
index b1502b1fd1..bb4358e997 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T17_ForLoop.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T17_ForLoop.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def forLoopProgram := r"
+#eval testLaurel
+#strata
+program Laurel;
 procedure sumToThree()
   opaque
 {
@@ -31,10 +27,4 @@ procedure sumToThree()
   };
   assert sum == 3
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "ForLoop" forLoopProgram 15 processLaurelFile
-
-end Laurel
-end Strata
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveProcedure.lean
similarity index 57%
rename from StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean
rename to StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveProcedure.lean
index b4aac70e17..9a97632738 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveFunction.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T18_RecursiveProcedure.lean
@@ -3,30 +3,28 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
 /-
 A recursive function over a recursive datatype.
 The `isRecursive` flag should be inferred automatically from the self-call.
 -/
-def program := r"
+
+#eval testLaurel
+#strata
+program Laurel;
 datatype IntList {
   Nil(),
   Cons(head: int, tail: IntList)
 }
 
-function listLen(xs: IntList): int {
-  if IntList..isNil(xs) then 0
+procedure listLen(xs: IntList): int
+{
+  return if IntList..isNil(xs) then 0
   else 1 + listLen(IntList..tail!(xs))
 };
 
@@ -38,13 +36,15 @@ procedure testListLen()
 };
 
 // Mutual recursion
-function listLenEven(xs: IntList): bool {
-  if IntList..isNil(xs) then true
+procedure listLenEven(xs: IntList): bool
+{
+  return if IntList..isNil(xs) then true
   else listLenOdd(IntList..tail!(xs))
 };
 
-function listLenOdd(xs: IntList): bool {
-  if IntList..isNil(xs) then false
+procedure listLenOdd(xs: IntList): bool
+{
+  return if IntList..isNil(xs) then false
   else listLenEven(IntList..tail!(xs))
 };
 
@@ -54,9 +54,4 @@ procedure testMutualRecursion()
   var xs: IntList := Cons(1, Cons(2, Nil()));
   assert listLenEven(xs) == true
 };
-"
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "RecursiveFunction" program 14 processLaurelFile
-
-end Strata.Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_BitvectorTypes.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_BitvectorTypes.lean
index 8c0955581e..11b55b9dcf 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_BitvectorTypes.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_BitvectorTypes.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def bvProgram := r"
+#eval testLaurel
+#strata
+program Laurel;
 // Bitvector types in procedure signatures and variable declarations.
 
 // Parameters and return types
@@ -53,10 +49,4 @@ procedure mixedTypes(a: bv 32, b: int) returns (r: int)
 {
   r := b
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "BitvectorTypes" bvProgram 14 processLaurelFile
-
-end Laurel
-end Strata
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean
index 10bfacab74..32efb65c0c 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T19_InvokeOn.lean
@@ -3,19 +3,16 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def program := r#"
+#eval testLaurel
+    (options := { verifyOptions := { Core.VerifyOptions.quiet with solver := "z3" } })
+#strata
+program Laurel;
 function P(x: int): bool;
 function Q(x: int): bool;
 
@@ -72,14 +69,7 @@ procedure badPostcondition(x: int)
   invokeOn R(x)
   opaque
   ensures R(x)
-//        ^^^^ error: assertion could not be proved
+//        ^^^^ error: postcondition could not be proved
 {
 };
-
-"#
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "InvokeOn" program 14
-  (Strata.Laurel.processLaurelFileWithOptions { verifyOptions := { Core.VerifyOptions.default with solver := "z3" } })
-
-end Strata.Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T1_AssertFalse.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T1_AssertFalse.lean
index 08595dd29b..c509426b73 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T1_AssertFalse.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T1_AssertFalse.lean
@@ -3,19 +3,17 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
+/-! ## Failing asserts -/
 
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure foo()
   opaque
 {
@@ -25,14 +23,17 @@ procedure foo()
     assert false
 //  ^^^^^^^^^^^^ error: assertion does not hold
 };
+#end
+
+/-! ## Assume false makes assert false trivially provable -/
 
+#eval testLaurel
+#strata
+program Laurel;
 procedure bar()
   opaque
 {
     assume false;
     assert false
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "AssertFalse" program 14 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_InferTypeError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_InferTypeError.lean
index a69eb2ba09..2f1419c9d3 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_InferTypeError.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_InferTypeError.lean
@@ -3,26 +3,19 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def inferTypeErrorProgram := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure foo()
   opaque
 {
   <?>
 //^^^ error: could not infer type
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "InferTypeError" inferTypeErrorProgram 14 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBody.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBody.lean
index 9f3e6e65a0..1b3ae3aa75 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBody.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBody.lean
@@ -3,36 +3,27 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def transparentBodyProgram := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure transparentBody(): int
 {
   assert true;
-  3
+  return 3
 };
 
 procedure tranparentCaller(): int {
-  transparentBody()
+  return transparentBody()
 };
 
 procedure transparentCallerCaller() opaque {
   var x: int := tranparentCaller();
   assert x == 3
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "TransparentBody" transparentBodyProgram 14 processLaurelFile
-
-end Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean
index e0ee76bb60..806c97af00 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T20_TransparentBodyError.lean
@@ -3,30 +3,28 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def transparentBodyProgram := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure transparentBodyMultipleOuts() returns (q: int, r: int)
 {
   assert true;
   q := 3;
-//^^^^^^ error: destructive assignments are not supported in transparent bodies or contracts
   r := 2
+//^^^^^^ error: ending a transparent body with a Assign statement is not supported
 };
 
 procedure transparentBodyNoOuts()
 {
-  assert true
+  assert true;
+  3
+//^ error: ending a transparent body with a LiteralInt statement is not supported
 };
 
 procedure transparentProcedureCaller() opaque {
@@ -36,9 +34,4 @@ procedure transparentProcedureCaller() opaque {
 
   transparentBodyNoOuts()
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "TransparentBody" transparentBodyProgram 14 processLaurelFile
-
-end Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T21_ExitMultiPathAssert.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T21_ExitMultiPathAssert.lean
index 1b15cfeff7..855f23eb43 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T21_ExitMultiPathAssert.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T21_ExitMultiPathAssert.lean
@@ -3,18 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata.Laurel
-
-def exitMultiPathProgram := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure foo(x: int)
   opaque
 {
@@ -26,9 +23,4 @@ procedure foo(x: int)
   assert false
 //^^^^^^^^^^^^ error: assertion does not hold
 };
-"
-
-#guard_msgs (error, drop all) in
-#eval! testInputWithOffset "ExitMultiPathAssert" exitMultiPathProgram 14 processLaurelFile
-
-end Strata.Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_ArityMismatch.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_ArityMismatch.lean
index fce8013d30..1b4a0ef1a7 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_ArityMismatch.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_ArityMismatch.lean
@@ -3,36 +3,42 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
+
+/-! ## Function called with too many arguments
 
-namespace Strata
-namespace Laurel
+`showLocations := true` makes `testLaurel` echo each diagnostic's file-relative
+`line:col` range (computed from the snippet's base line — no manual offsets),
+while the inline `// ^^^` annotation still asserts the error. The golden below
+thus *shows* the localization without catching a spurious "unexpected
+diagnostic". (Other tests omit the flag and stay silent on success.) -/
 
-def arityMismatchProgram := r"
+/--
+info: 32:16-23  error: call to 'f' expects 1 argument(s) but 2 were provided
+-/
+#guard_msgs in
+#eval testLaurel (showLocations := true) <|
+#strata
+program Laurel;
 function f(x: int): int { x };
 
 procedure caller()
   opaque
 {
   var y: int := f(1, 2)
+//              ^^^^^^^ error: call to 'f' expects 1 argument(s) but 2 were provided
 };
-"
+#end
 
-/--
-error: ArityMismatch(79-100) ❌ Type checking error.
-Impossible to unify int with (arrow int $__ty35).
--/
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "ArityMismatch" arityMismatchProgram 14 processLaurelFile
+/-! ## Multi-return procedure assigned to single target -/
 
-def outputArityMismatchProgram := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure twoReturns() returns (a: int, b: int)
   opaque
   ensures a == 1 && b == 2;
@@ -42,9 +48,6 @@ procedure mismatch()
 {
   var x: int;
   assign x := twoReturns()
-//^^^^^^^^^^^^^^^^^^^^^^^^ error: Assignment target count mismatch
+//            ^^^^^^^^^^^^ error: expected 'int', got '(int, int)'
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "OutputArityMismatch" outputArityMismatchProgram 30 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_MultipleReturns.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_MultipleReturns.lean
index 76b8a7f934..3897cae872 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_MultipleReturns.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T22_MultipleReturns.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def program := r"
+#eval testLaurel
+#strata
+program Laurel;
 procedure multipleReturns() returns (x: int, y: int, z: int)
   opaque
   ensures x == 1 && y == 2 && z == 3;
@@ -47,9 +43,4 @@ procedure repeatedAssignTarget()
   assign x, x, x := multipleReturns();
   assert x == 3
 };
-"
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "MultipleReturns" program 14 processLaurelFile
-
-end Strata.Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T23_ArithTyping.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T23_ArithTyping.lean
new file mode 100644
index 0000000000..639af83913
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T23_ArithTyping.lean
@@ -0,0 +1,79 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-! Documents the current behaviour of the arithmetic typing rules.
+
+    Two rules apply:
+
+    - [⇐] Op-Arith — the *check* path: an expected type from context
+      is pushed into every operand.
+    - [⇒] Op-Arith — the *synth* path: operands are synthesized and
+      folded under `join` to the result type.
+
+    Homogeneous numeric operands type-check via either path;
+    heterogeneous ones (e.g. `int + real`) are rejected by both. The
+    gradual `Unknown` wildcard flows freely. -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure homogeneousInt()
+  opaque
+{
+  var x: int := 1 + 2;
+  assert x == 3
+};
+
+procedure homogeneousReal()
+  opaque
+{
+  var x: real := 1.5 + 2.5;
+  assert x == 4.0
+};
+
+// [⇐] Op-Arith: check path (the `var: real` annotation drives it).
+procedure heterogeneousCheckPath()
+  opaque
+{
+  var x: real := 1 + 2.0
+//               ^ error: expected 'real', got 'int'
+};
+
+// [⇒] Op-Arith: synth path (the `<` forces `1 + 2.0` into synth position).
+procedure heterogeneousSynthPath()
+  opaque
+{
+  assert (1 + 2.0) < 5
+//        ^^^^^^^ error: cannot apply '+' to operands of types 'int', 'real'
+};
+
+procedure unaryNegHomogeneous()
+  opaque
+{
+  var a: int := 5;
+  var b: int := -a;
+  var c: real := 1.5;
+  var d: real := -c;
+  assert b == 0 - 5;
+  assert d == 0.0 - 1.5
+};
+
+// The hole '<?>' synthesizes to 'Unknown', and `join` promotes it to
+// its neighbour: 'Unknown + TInt' folds to TInt. The error against
+// '2.0' (real) is what proves the join returned TInt, not Unknown
+// (Unknown would have compared silently).
+procedure unknownPromotesToNeighbour()
+  opaque
+{
+  assert (<?> + 1) == 2.0
+//       ^^^^^^^^^^^^^^^^ error: cannot compare 'int' with 'real' using '=='
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T23_DoWhile.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T23_DoWhile.lean
new file mode 100644
index 0000000000..82f05e5ffe
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T23_DoWhile.lean
@@ -0,0 +1,110 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-! ## Post-test `do-while`
+
+`do BODY while(COND) invariant I` is a post-test loop: BODY runs once before
+COND is first tested. It parses to a post-test `While` (`postTest := true`),
+desugared by the `EliminateDoWhile` pass to a pre-test `while(true)` whose body
+ends with `if (!COND) exit`. The invariant `I` is checked at the loop head —
+*before* each BODY runs, matching `while`. Gotcha: because the guard is re-tested
+only after BODY, an invariant must hold of the *pre-body* state. For
+`do { x := x+1 } while(x<3)` the loop exits at x==3, but the head invariant sees
+the pre-increment value, so the bound is `x <= 2` (not `x <= 3`). -/
+
+#eval testLaurel
+#strata
+program Laurel;
+procedure basic()
+  opaque
+{
+  var x: int := 0;
+  do {
+    x := x + 1
+  } while(x < 3)
+    invariant 0 <= x && x <= 2;
+  assert x == 3
+};
+
+procedure runsAtLeastOnce()
+  opaque
+{
+  var x: int := 5;
+  do {
+    x := x + 1
+  } while(x < 3)
+    invariant x == 5;
+  assert x == 6
+};
+
+procedure nested()
+  opaque
+{
+  var x: int := 0;
+  do {
+    var y: int := 0;
+    do {
+      y := y + 1
+    } while(y < 3)
+      invariant 0 <= y
+      invariant y <= 2;
+    x := x + 1
+  } while(x < 3)
+    invariant 0 <= x
+    invariant x <= 2;
+  assert x == 3
+};
+
+procedure breakOut()
+  opaque
+{
+  var x: int := 0;
+  {
+    do {
+      x := x + 1;
+      if (x >= 2) then { exit early }
+    } while(x < 5)
+      invariant 0 <= x && x <= 2
+  } early;
+  assert 2 <= x && x <= 3
+};
+
+procedure noInvariant()
+  opaque
+{
+  var x: int := 0;
+  do {
+    x := x + 1
+  } while(x < 3);
+  assert x >= 3
+};
+#end
+
+/-! ## A false postcondition is still rejected
+
+Confirms the `while(true)` desugar isn't vacuous: the body's effect reaches the
+assertion, so an unprovable assert is reported (not discharged vacuously). -/
+
+#eval testLaurel
+#strata
+program Laurel;
+procedure falsePostRejected()
+  opaque
+{
+  var x: int := 0;
+  do {
+    x := x + 1
+  } while(x < 3)
+    invariant 0 <= x && x <= 2;
+  assert x == 99
+//^^^^^^^^^^^^^^ error: assertion could not be proved
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T23_IncrDecr.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T23_IncrDecr.lean
new file mode 100644
index 0000000000..12871b4353
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T23_IncrDecr.lean
@@ -0,0 +1,264 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-!
+End-to-end verification of Java-style `++` and `--` operators.
+
+Covers:
+* Bare statement form (`x++;`, `--x`).
+* Prefix in expression position (yields the new value).
+* Postfix in expression position (yields the old value, like Java).
+* Mixed prefix and postfix in a single expression.
+* Postfix decrement.
+* Use as a `for`-loop step.
+* Increment as an argument to a (pure) function call.
+* Increment in an if-then-else condition.
+* Increment on the right-hand side of a short-circuit `&&` (with both
+  evaluated and skipped paths).
+* Mixing prefix and postfix forms with arithmetic operators.
+* Intentional failing asserts to confirm error reporting still flows.
+
+Increment of a composite-type field is verified separately in
+`T23b_IncrDecrField.lean` (the composite type triggers heap
+parameterization which interacts poorly with counterexample search
+for the failing tests in this file).
+-/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+procedure stmtForm()
+  opaque
+{
+  var x: int := 5;
+  x++;
+  assert x == 6;
+  x--;
+  assert x == 5;
+  ++x;
+  assert x == 6;
+  --x;
+  assert x == 5
+};
+
+procedure preIncrYieldsNew()
+  opaque
+{
+  var x: int := 0;
+  var y: int := ++x;
+  assert x == 1;
+  assert y == 1
+};
+
+procedure postIncrYieldsOld()
+  opaque
+{
+  var x: int := 0;
+  var y: int := x++;
+  assert x == 1;
+  assert y == 0
+};
+
+procedure repeatedPostIncr()
+  opaque
+{
+  var x: int := 0;
+  // Java semantics: (x++)+(x++) reads 0 then 1, x ends at 2, sum = 1.
+  var y: int := x++ + x++;
+  assert x == 2;
+  assert y == 1
+};
+
+procedure repeatedPreIncr()
+  opaque
+{
+  var x: int := 0;
+  // Java semantics: (++x)+(++x) writes 1 then 2, x ends at 2, sum = 3.
+  var y: int := ++x + ++x;
+  assert x == 2;
+  assert y == 3
+};
+
+procedure mixedPrePostIncr()
+  opaque
+{
+  var x: int := 10;
+  // (x++) yields 10 (old), (++x) yields 12 (new), so sum = 22.
+  var y: int := x++ + ++x;
+  assert x == 12;
+  assert y == 22
+};
+
+procedure preDecrYieldsNew()
+  opaque
+{
+  var x: int := 5;
+  var y: int := --x;
+  assert x == 4;
+  assert y == 4
+};
+
+procedure postDecrYieldsOld()
+  opaque
+{
+  var x: int := 5;
+  var y: int := x--;
+  assert x == 4;
+  assert y == 5
+};
+
+procedure forLoopStep()
+  opaque
+{
+  var sum: int := 0;
+  var i: int := 0;
+  for (i := 0; i < 3; i++)
+  invariant 0 <= i
+  invariant i <= 3
+  invariant sum == i
+  {
+    sum := sum + 1
+  };
+  assert sum == 3
+};
+
+// --- More complex scenarios -------------------------------------------------
+
+function double(n: int): int { 2 * n };
+
+procedure incrementAsFunctionArgument()
+  opaque
+{
+  var x: int := 3;
+  // double(x++) reads the OLD x (3), so r = double(3) = 6, and x = 4 after.
+  var r: int := double(x++);
+  assert x == 4;
+  assert r == 6
+};
+
+procedure preIncrementAsFunctionArgument()
+  opaque
+{
+  var x: int := 3;
+  // double(++x) reads the NEW x (4), so r = double(4) = 8, and x = 4 after.
+  var r: int := double(++x);
+  assert x == 4;
+  assert r == 8
+};
+
+procedure postIncrementInIfCondition()
+  opaque
+{
+  var x: int := 0;
+  var hitThen: bool := false;
+  var hitElse: bool := false;
+  // Postfix: x++ yields the OLD value (0), so condition `0 > 0` is false.
+  // The else branch runs, but x has already been incremented to 1.
+  if x++ > 0 then {
+    hitThen := true
+  } else {
+    hitElse := true
+  };
+  assert hitElse;
+  assert !hitThen;
+  assert x == 1
+};
+
+procedure preIncrementInIfCondition()
+  opaque
+{
+  var x: int := 0;
+  var hitThen: bool := false;
+  var hitElse: bool := false;
+  // Prefix: ++x yields the NEW value (1), so condition `1 > 0` is true.
+  if ++x > 0 then {
+    hitThen := true
+  } else {
+    hitElse := true
+  };
+  assert hitThen;
+  assert !hitElse;
+  assert x == 1
+};
+
+procedure incrementInShortCircuitTaken()
+  opaque
+{
+  var y: int := 10;
+  // First operand `y > 0` is true → RHS is evaluated.
+  // y++ yields 10 (old y); 10 > 5 is true; y becomes 11.
+  var b: bool := y > 0 && y++ > 5;
+  assert b;
+  assert y == 11
+};
+
+procedure incrementInShortCircuitSkipped()
+  opaque
+{
+  var x: int := 0;
+  var y: int := 0;
+  // First operand `x > 0` is false → short-circuit → y++ NOT evaluated.
+  var b: bool := x > 0 && y++ > 5;
+  assert !b;
+  // Crucially: y has NOT been incremented because of short-circuit semantics.
+  assert y == 0
+};
+
+procedure mixedIncrInArithmetic()
+  opaque
+{
+  var x: int := 1;
+  // `x++ * 2 + ++x - x--` parses as `((x++ * 2) + ++x) - x--`.
+  // Evaluated left-to-right:
+  //   x    starts at 1
+  //   x++  yields 1, x := 2
+  //   ++x  yields 3 (NEW), x := 3
+  //   x--  yields 3 (old), x := 2
+  // Final x = 2; r = 1*2 + 3 - 3 = 2.
+  var r: int := x++ * 2 + ++x - x--;
+  assert x == 2;
+  assert r == 2
+};
+
+procedure failingAssertOnPostIncr()
+  opaque
+{
+  var x: int := 0;
+  var y: int := x++;
+  assert y == 1
+//^^^^^^^^^^^^^ error: assertion does not hold
+};
+
+procedure failingAssertOnVarAfterPostIncr()
+  opaque
+{
+  // After `x++`, x is 1. Asserting `x == 0` should fail — this guards the
+  // `x` side of postfix semantics: the variable IS updated even though the
+  // expression yields the old value.
+  var x: int := 0;
+  var y: int := x++;
+  assert x == 0
+//^^^^^^^^^^^^^ error: assertion does not hold
+};
+
+procedure failingAssertOnSkippedShortCircuit()
+  opaque
+{
+  // y++ is on the right-hand side of `&&` whose left operand is false, so
+  // short-circuit semantics skip y++ entirely and y stays at 0. Asserting
+  // `y == 1` confirms the skip is real (the assertion fails).
+  var x: int := 0;
+  var y: int := 0;
+  var b: bool := x > 0 && y++ > 5;
+  assert y == 1
+//^^^^^^^^^^^^^ error: assertion does not hold
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T23b_IncrDecrField.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T23b_IncrDecrField.lean
new file mode 100644
index 0000000000..4e76ccd357
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T23b_IncrDecrField.lean
@@ -0,0 +1,144 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-!
+End-to-end verification of `++` and `--` applied to composite-type fields
+(`obj#field`), in both statement and expression positions. The composite
+type triggers Laurel's heap parameterization pass, so this is split out
+from `T23_IncrDecr.lean` to avoid the heap-parameterized program perturbing
+counterexample search for the failing tests there.
+
+Why field-IncrDecr in expression position works: the pipeline runs
+`EliminateIncrDecr` first, which lowers `(c#n)++` to
+`(c#n := c#n + 1) - 1`. `HeapParameterization` then runs and rewrites the
+inner `c#n := c#n + 1` field-assign into a sequence:
+
+  $tmp_i := readField(...) + 1
+  $heap  := updateField($heap, c, Counter.n, BoxInt($tmp_i))
+  $tmp_i        -- yields the new field value
+
+By the time `LiftImperativeExpressions` runs, every assignment target is a
+local (`$tmp_i` or `$heap`), so its snapshot mechanism — which is keyed on
+`Variable.Local` — handles the increment correctly. The Field-target arm of
+`liftAssignExpr` (which falls through `| _ => pure ()`) is defensive but
+never reached in this pipeline order.
+
+`c#n++` now parses paren-free: `fieldAccess` is at `prec(95)`, above the
+postfix incr/decr ops (`prec(90)`), so `#` binds tighter than `++` and
+`c#n++` reads as `(c#n)++`. The parenthesised spelling `(c#n)++` remains
+valid; `parenFreeFieldIncrDecr` below covers the paren-free form.
+-/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite IncrDecrCounter {
+  var n: int
+}
+
+procedure postIncrFieldStatement()
+  opaque
+{
+  var c: IncrDecrCounter := new IncrDecrCounter;
+  c#n := 10;
+  (c#n)++;
+  assert c#n == 11
+};
+
+procedure preIncrFieldStatement()
+  opaque
+{
+  var c: IncrDecrCounter := new IncrDecrCounter;
+  c#n := 10;
+  ++(c#n);
+  assert c#n == 11
+};
+
+procedure postDecrFieldStatement()
+  opaque
+{
+  var c: IncrDecrCounter := new IncrDecrCounter;
+  c#n := 10;
+  (c#n)--;
+  assert c#n == 9
+};
+
+procedure preDecrFieldStatement()
+  opaque
+{
+  var c: IncrDecrCounter := new IncrDecrCounter;
+  c#n := 10;
+  --(c#n);
+  assert c#n == 9
+};
+
+procedure mixedFieldIncrDecrStatements()
+  opaque
+{
+  var c: IncrDecrCounter := new IncrDecrCounter;
+  c#n := 0;
+  (c#n)++;
+  (c#n)++;
+  ++(c#n);
+  (c#n)--;
+  assert c#n == 2
+};
+
+procedure postIncrFieldInExpression()
+  opaque
+{
+  var c: IncrDecrCounter := new IncrDecrCounter;
+  c#n := 5;
+  // Postfix yields the OLD field value (5); c#n is updated to 6.
+  var y: int := (c#n)++;
+  assert c#n == 6;
+  assert y == 5
+};
+
+procedure preIncrFieldInExpression()
+  opaque
+{
+  var c: IncrDecrCounter := new IncrDecrCounter;
+  c#n := 5;
+  // Prefix yields the NEW field value (6).
+  var y: int := ++(c#n);
+  assert c#n == 6;
+  assert y == 6
+};
+
+procedure postDecrFieldInExpression()
+  opaque
+{
+  var c: IncrDecrCounter := new IncrDecrCounter;
+  c#n := 5;
+  // Postfix decrement yields the OLD field value (5); c#n becomes 4.
+  var y: int := (c#n)--;
+  assert c#n == 4;
+  assert y == 5
+};
+
+procedure parenFreeFieldIncrDecr()
+  opaque
+{
+  // Paren-free field incr/decr: `c#n++` parses as `(c#n)++` because `fieldAccess`
+  // (prec 95) binds tighter than postfix `++`/`--` (prec 90).
+  var c: IncrDecrCounter := new IncrDecrCounter;
+  c#n := 10;
+  c#n++;
+  assert c#n == 11;
+  c#n--;
+  assert c#n == 10;
+  // Postfix in expression position yields the OLD value (10); c#n becomes 11.
+  var y: int := c#n++;
+  assert c#n == 11;
+  assert y == 10
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean
index 77639c692f..23885ec665 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressions.lean
@@ -3,19 +3,16 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def program: String := r"
+#guard_msgs (drop info) in
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure nestedImpureStatements()
   opaque
 {
@@ -115,9 +112,9 @@ procedure imperativeCallInConditionalExpression(b: bool)
   }
 };
 
-function add(x: int, y: int): int
+procedure add(x: int, y: int): int
 {
-  x + y
+  return x + y
 };
 
 procedure repeatedBlockExpressions()
@@ -141,15 +138,58 @@ procedure addProcCaller(): int
 {
   var x: int := 0;
   var y: int := addProc({x := 1; x}, {x := x + 10; x});
-  assert y == 11 // TOOD should be 12. Fix in other PR
+  assert y == 12
 
+  // The next statement is not translated correctly.
+  // I think it's a bug in the handling of StaticCall
+  // Where a reference is substituted when it should not be
   // var z: int := addProc({x := 1; x}, {x := x + 10; x}) + (x := 3);
   // assert z == 15
 };
-"
 
-#guard_msgs (error, drop all) in
-#eval! testInputWithOffset "NestedImpureStatements" program 14 processLaurelFile
+procedure assertInsideConditionalExpression(a: int): int
+  return if a > 2
+    then 4
+    else {
+      assert a <= 2;
+      assert a < 2;
+//    ^^^^^^^^^^^^ error: assertion does not hold
+      5
+    };
+
+procedure assertInBlockExpr()
+opaque {
+  var x: int := 0;
+  var y: int := { assert x == 0; x := 1; x };
+  assert y == 1
+};
+
+procedure transparentProc(x: int) returns (r: int)
+{
+  return x + 1
+};
+
+procedure assignmentInExpressionAfterProcCall()
+opaque {
+  var x: int := 0;
+  var y: int := transparentProc(x) + (x := 2);
+  assert y == 3
+};
+
+procedure liftInsideAssignmentInExpression()
+opaque {
+  var x: int := 0;
+  var y: int := ((x := 1) + transparentProc(x));
+  assert y == 3
+};
+
+procedure hasMultipleOutputs() returns (x: int, y: int) opaque {
+  x := 1;
+  y := 2
+};
 
+procedure liftWithMultipleOutputs() opaque {
+  var x: int := { assign var y: int, var z: int := hasMultipleOutputs() ; y + z }
+};
 
-end Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean
index 8768142863..5862e9b93f 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T2_ImpureExpressionsError.lean
@@ -3,19 +3,21 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
+/-! ## Procedures used by the negative tests below -/
+
+-- Resolution-only errors are reported via the resolution pass; we use the full
+-- pipeline helper because the expected diagnostics are not pure resolution
+-- errors.
 
-def program: String := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure hasMutatingAssignment(): int
   opaque
 {
@@ -32,18 +34,17 @@ function functionWithMutatingAssignment(x: int): int
 
 function functionWithWhile(x: int): int
 {
-  while(false) {}
+  while(false) {};
 //^^^^^^^^^^^^^^^ error: loops are not supported in functions or contracts
+  3
 };
 function functionCallingHasMutationAssignment(x: int): int
 {
   hasMutatingAssignment()
-//^^^^^^^^^^^^^^^^^^^^^^^ error: calls to procedures are not supported in functions or contracts
 };
 
-procedure impureContractIsNotLegal1(x: int)
+procedure impureContractIsLegal1(x: int)
   requires x == hasMutatingAssignment()
-//              ^^^^^^^^^^^^^^^^^^^^^^^ error: calls to procedures are not supported in functions or contracts
   opaque
 {
   assert hasMutatingAssignment() == 1
@@ -55,12 +56,5 @@ procedure impureContractIsNotLegal2(x: int)
   opaque
 {
   assert (x := 2) == 2
-//        ^^^^^^ error: destructive assignments are not supported in transparent bodies or contracts
 };
-"
-
-#guard_msgs (error, drop all) in
-#eval! testInputWithOffset "NestedImpureStatements" program 14 processLaurelFile
-
-
-end Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean
index 8f97d3aec6..83f3a702a2 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlow.lean
@@ -3,21 +3,16 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def program := r"
-function returnAtEnd(x: int) returns (r: int)
-{
+#eval testLaurel <|
+#strata
+program Laurel;
+procedure returnAtEnd(x: int) returns (r: int) {
   if x > 0 then {
     if x == 1 then {
       return 1
@@ -29,11 +24,25 @@ function returnAtEnd(x: int) returns (r: int)
   }
 };
 
-function elseWithCall(): int {
+function elseWithCall(): int
+{
   if true then 3 else returnAtEnd(3)
 };
 
-function guardInFunction(x: int) returns (r: int) {
+procedure testFunctions()
+  opaque
+{
+  assert returnAtEnd(1) == 1;
+  assert returnAtEnd(1) == 2;
+//^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved
+
+  assert guardInFunction(1) == 1;
+  assert guardInFunction(1) == 2
+//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved
+};
+
+procedure guardInFunction(x: int) returns (r: int)
+{
   if x > 0 then {
     if x == 1 then {
       return 1
@@ -45,20 +54,7 @@ function guardInFunction(x: int) returns (r: int) {
   return 3
 };
 
-procedure testFunctions()
-  opaque
-{
-  assert returnAtEnd(1) == 1;
-  assert returnAtEnd(1) == 2;
-//^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
-
-  assert guardInFunction(1) == 1;
-  assert guardInFunction(1) == 2
-//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
-};
-
 procedure guards(a: int) returns (r: int)
-  opaque
 {
   var b: int := a + 2;
   if b > 2 then {
@@ -89,7 +85,15 @@ procedure dag(a: int) returns (r: int)
 //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
   return b
 };
-"
 
-#guard_msgs (error, drop all) in
-#eval! testInputWithOffset "ControlFlow" program 14 processLaurelFile
+// Valueless early return (issue #1353): a bare `return` parses to `.Return none`.
+// Must verify cleanly — no value, used as an early exit.
+procedure valuelessEarlyReturn(b: bool)
+  opaque
+{
+  if b then {
+    return
+  };
+  assert true
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean
index 54295179f4..a1d8f03ad7 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 function assertAndAssumeInFunctions(a: int) returns (r: int)
 {
   assert 2 == 3;
@@ -42,13 +38,4 @@ function localVariableWithoutInitializer(): int {
 //^^^^^^^^^^ error: local variables in functions must have initializers
   3
 };
-
-function deadCodeAfterIfElse(x: int) returns (r: int) {
-  if x > 0 then { return 1 } else { return 2 };
-//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: if-then-else only supported as the last statement in a block
-  return 3
-};
-"
-
-#guard_msgs (error, drop all) in
-#eval! testInputWithOffset "ControlFlowError" program 14 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError2.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError2.lean
new file mode 100644
index 0000000000..656009ffca
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T3_ControlFlowError2.lean
@@ -0,0 +1,21 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+#eval testLaurel <|
+#strata
+program Laurel;
+
+procedure deadCodeAfterIfElse(x: int) returns (r: int) {
+  if x > 0 then { return 1 } else { return 2 };
+//^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: in a transparent body, if-then-else is only supported as the last statement in a block
+  return 3
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean
index 58295bbb04..ba8ed4a82c 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T4_LoopJumps.lean
@@ -3,14 +3,9 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
+import Strata.Languages.Laurel
 
-meta section
-
-open StrataTest.Util
 open Strata
 
 namespace Laurel
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T4b_Exit.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T4b_Exit.lean
index 0380886295..50d7e25c96 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T4b_Exit.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T4b_Exit.lean
@@ -3,18 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata.Laurel
-
-def exitProgram := r"
+#eval testLaurel
+#strata
+program Laurel;
 procedure exitSkipsRest()
   opaque
 {
@@ -39,9 +36,4 @@ procedure exitFromNestedBlock()
     } outer;
     assert x == 42
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "Exit" exitProgram 14 processLaurelFile
-
-end Strata.Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean
index 2b2cd03da7..7f68e3caf6 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T5_ProcedureCalls.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def program := r"
+#eval testLaurel
+#strata
+program Laurel;
 procedure fooReassign(): int
   opaque // required because we don't yet support destructive assignment in transparent bodies
 {
@@ -31,7 +27,7 @@ procedure fooSingleAssign(): int
   var x: int := 0;
   var x2: int := x + 1;
   var x3: int := x2 + 1;
-  x3
+  return x3
 };
 
 procedure fooProof()
@@ -55,7 +51,4 @@ procedure aFunctionCaller()
   var x: int := aFunction(3);
   assert x == 3
 };
-"
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "ProcedureCalls" program 14 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean
index 08c9b0ecfb..da9a3d6713 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T6_Preconditions.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure hasRequires(x: int) returns (r: int)
   requires x > 2
 // Call elimination reports precondition errors at the call site,
@@ -81,7 +77,4 @@ procedure funcMultipleRequiresCaller()
   var b: int := funcMultipleRequires(1, -1)
 //^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
 };
-"
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "Preconditions" program 14 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean
index 11d03310b2..61175cc1e2 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T7_Decreases.lean
@@ -3,14 +3,9 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
+import Strata.Languages.Laurel
 
-meta section
-
-open StrataTest.Util
 open Strata
 
 namespace Laurel
@@ -26,23 +21,29 @@ procedure noDecreases(x: int): boolean;
 procedure caller(x: int)
   requires noDecreases(x)
 //                    ^ error: noDecreases can not be called from a pure context, because it is not proven to terminate
+  opaque
 ;
 
 procedure noCyclicCalls()
+  opaque
   decreases []
 {
   leaf();
 };
 
-procedure leaf() decreases [1] { };
+procedure leaf() decreases [1]
+  opaque
+{ };
 
 procedure mutualRecursionA(x: nat)
+  opaque
   decreases [x, 1]
 {
   mutualRecursionB(x);
 };
 
 procedure mutualRecursionB(x: nat)
+  opaque
   decreases [x, 0]
 {
   if x != 0 { mutualRecursionA(x-1); }
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean
index 08b5d11d11..08e32bff17 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_Postconditions.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure opaqueBody(x: int) returns (r: int)
   opaque
   ensures r > 0
@@ -34,12 +30,24 @@ procedure callerOfOpaqueProcedure()
 };
 
 procedure invalidPostcondition(x: int)
+  returns (r: int) // TODO, removing this returns triggers a latent bug
   opaque
   ensures false
-//        ^^^^^ error: assertion does not hold
+//        ^^^^^ error: postcondition does not hold
+{
+};
+
+procedure bar(x: int) returns (r: int)
+  requires x > 0
+  opaque
+  ensures r > 0
 {
+  r := x + 1
 };
-"
 
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "Postconditions" program 14 processLaurelFile
+procedure caller() returns (out: int)
+  opaque
+{
+  out := bar(bar(5))
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean
index 88f8bec609..c344719e35 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8_PostconditionsErrors.lean
@@ -3,19 +3,17 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
+/-! ## Functions with postconditions are not yet supported -/
 
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 
 function opaqueFunction(x: int) returns (r: int)
 //       ^^^^^^^^^^^^^^ error: functions with postconditions are not yet supported
@@ -23,7 +21,6 @@ function opaqueFunction(x: int) returns (r: int)
   requires x > 0
   opaque
   ensures r > 0
-// The above limitation is because functions in Core do not support postconditions
 {
   x
 };
@@ -36,7 +33,4 @@ procedure callerOfOpaqueFunction()
 // The following assertion should fail but does not
   assert x == 3
 };
-"
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "Postconditions" program 14 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean
index 659a1e22a9..66a71def1c 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8b_EarlyReturnPostconditions.lean
@@ -3,19 +3,17 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
+/-! ## Correct early return -/
 
-def program := r"
+#eval testLaurel
+#strata
+program Laurel;
 procedure earlyReturnCorrect(x: int) returns (r: int)
   opaque
   ensures r >= 0
@@ -25,20 +23,21 @@ procedure earlyReturnCorrect(x: int) returns (r: int)
   };
   return x
 };
+#end
+
+/-! ## Buggy early return: postcondition fails -/
 
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure earlyReturnBuggy(x: int) returns (r: int)
   opaque
   ensures r >= 0
-//        ^^^^^^ error: assertion does not hold
+//        ^^^^^^ error: postcondition does not hold
 {
   if x < 0 then {
     return x
   };
   return x
 };
-"
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "EarlyReturn" program 14 processLaurelFile
-
-end Strata.Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean
index d58ecfb4c3..a0875f23b6 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T8c_BodilessInlining.lean
@@ -3,13 +3,11 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all Strata.SimpleAPI
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
+import StrataTest.Util.TestLaurel
 
-meta section
+open StrataTest.Util
+open Strata
 
 /-! # Bodiless Procedure Inlining Test
 
@@ -19,12 +17,9 @@ body, so inlining would make everything after the call trivially provable.
 Now the body assumes the postconditions instead, so `assert false` after
 the inlined call is correctly rejected. -/
 
-namespace Strata.Laurel.BodilessInliningTest
-
-open StrataTest.Util
-open Strata
-
-private def laurelSource := "
+#eval testLaurel (options := { verifyOptions := .quiet, translateOptions := { inlineFunctionsWhenPossible := true } }) <|
+#strata
+program Laurel;
 procedure bodilessProcedure() returns (r: int)
   opaque
   ensures r > 0
@@ -38,11 +33,4 @@ procedure caller()
   assert false
 //^^^^^^^^^^^^ error: assertion could not be proved
 };
-"
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "Postconditions" laurelSource 23
-  (fun p => processLaurelFileWithOptions { translateOptions := { inlineFunctionsWhenPossible := true} } p)
-
-end Strata.Laurel.BodilessInliningTest
-end
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean b/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean
index 68d9ad6e54..1331db2c27 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean
+++ b/StrataTest/Languages/Laurel/Examples/Fundamentals/T9_Nondeterministic.lean
@@ -3,18 +3,14 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
+import Strata.Languages.Laurel
 
-meta section
-
-open StrataTest.Util
 open Strata
 
 namespace Laurel
 
+-- TODO test non-det vs det holes. Make the default of holes non-det.
 def program := r"
 nondet procedure nonDeterministic(x: int): (r: int)
   opaque
@@ -24,6 +20,7 @@ nondet procedure nonDeterministic(x: int): (r: int)
 };
 
 procedure caller()
+  opaque
 {
   var x = nonDeterministic(1)
   assert x > 0;
@@ -33,11 +30,13 @@ procedure caller()
 };
 
 nondet procedure nonDeterminsticTransparant(x: int): (r: int)
+  opaque
 {
   nonDeterministic(x + 1)
 };
 
 procedure nonDeterministicCaller(x: int): int
+  opaque
 {
   nonDeterministic(x)
 };
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T10_CompositeBvField.lean b/StrataTest/Languages/Laurel/Examples/Objects/T10_CompositeBvField.lean
new file mode 100644
index 0000000000..d60053efef
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T10_CompositeBvField.lean
@@ -0,0 +1,52 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+/-
+Test: bitvector types as composite fields. Verifies that the heap
+parameterization pass correctly boxes/unboxes bv-typed fields.
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+#eval testLaurel <|
+#strata
+
+program Laurel;
+
+composite Register {
+  var value: bv 16
+}
+
+procedure writeValue(r: Register, x: bv 16)
+  opaque
+  ensures r#value == x
+  modifies r
+{
+  r#value := x
+};
+
+// Test using bv literal directly
+procedure writeLiteral(r: Register)
+  opaque
+  ensures r#value == 100 bv 16
+  modifies r
+{
+  r#value := 100 bv 16
+};
+
+// Error: postcondition claims field equals wrong literal
+procedure writeWrongLiteral(r: Register)
+  opaque
+  ensures r#value == 100 bv 16
+//        ^^^^^^^^^^^^^^^^^^^^ error: postcondition could not be proved
+  modifies r
+{
+  r#value := 200 bv 16
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T11_ConstrainedField.lean b/StrataTest/Languages/Laurel/Examples/Objects/T11_ConstrainedField.lean
new file mode 100644
index 0000000000..46aa4d9919
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T11_ConstrainedField.lean
@@ -0,0 +1,85 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+/-
+Test: constrained types as composite fields. Verifies that heap
+parameterization resolves constrained types to their base type for boxing,
+and that constraint checks are asserted on field writes.
+
+Also documents a known completeness gap: constraints are NOT recovered when
+*reading* a constrained field (see `readCountCompletenessGap`). To be fixed
+in a follow-up PR by assuming the constraint on field reads and maintaining
+it across havoc/modifies.
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+#eval testLaurel
+#strata
+program Laurel;
+
+constrained nat = x: int where x >= 0 witness 0
+
+composite Counter {
+  var count: nat
+}
+
+procedure setCount(c: Counter)
+  opaque
+  ensures c#count >= 0
+  modifies c
+{
+  c#count := 1
+};
+
+// Error: assigning -1 to a nat field violates the constraint
+procedure setCountInvalid(c: Counter)
+  opaque
+  modifies c
+{
+  c#count := -1
+//^^^^^^^^^^^^^ error: assertion could not be proved
+};
+
+// SOUNDNESS REGRESSION (Fabio Madge, PR #1364):
+// The field-write constraint check must assert on a read-back of the field,
+// not on the RHS `value`. The RHS is already emitted as the field-write
+// statement, so asserting the constraint on `value` re-emits it and runs any
+// side effect in the RHS twice. With the buggy version, `x := x + 1` inside
+// the stored value ran twice (x: 0 -> 2) for the legal write below; the
+// read-back fix evaluates the RHS exactly once (x: 0 -> 1). Verifying that
+// `x == 1` (and not 2) after the write confirms the RHS is evaluated once.
+// This passes non-vacuously: `x` is a plain local int, so its value is tracked
+// precisely (no heap read involved), and were the double-evaluation bug
+// reintroduced this assertion would fail.
+procedure fieldWriteEvaluatesRhsOnce(c: Counter)
+  opaque
+  modifies c
+{
+  var x: int := 0;
+  c#count := (x := x + 1) + 1;
+  assert x == 1
+};
+
+// KNOWN COMPLETENESS GAP (to be fixed in a follow-up PR):
+// Reading a constrained-typed field does NOT recover its constraint. Because
+// HeapParameterization boxes the field as its unconstrained base type (BoxInt),
+// and there is no `assume constraint` inserted on field reads, a legitimately
+// constructed `nat` field cannot be relied upon as `>= 0` after a read through
+// a heap parameter. The assertion below is true in principle but currently
+// unprovable. (Note: the same pattern on a *local* `nat` variable verifies
+// fine, because uninitialized constrained locals get an `assume constraint`.)
+procedure readCountCompletenessGap(c: Counter)
+  opaque
+{
+  var x: int := c#count;
+  assert x >= 0
+//^^^^^^^^^^^^^ error: assertion could not be proved
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean b/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean
index 40e4629058..4bca875744 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T1_MutableFields.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def program := r#"
+#eval testLaurelKeepIntermediates
+#strata
+program Laurel;
 composite Container {
   var intValue: int // var indicates mutable field
   var realValue: real
@@ -70,9 +66,7 @@ procedure updatesAndAliasing()
   assert dAlias#intValue == d#intValue
 };
 
-procedure subsequentHeapMutations()
-  opaque
-{
+procedure subsequentHeapMutations() opaque {
   var c: Container := new Container;
 
   // The additional parenthesis on the next line are needed to let the parser succeed. Joe, any idea why this is needed?
@@ -128,9 +122,7 @@ composite Pixel {
   var color: Color
 }
 
-procedure datatypeField()
-  opaque
-{
+procedure datatypeField() opaque {
   var p: Pixel := new Pixel;
   p#color := Red();
   assert Color..isRed(p#color);
@@ -201,7 +193,4 @@ procedure fieldTargetInMultiAssign()
   assert y == 2;
   assert z == 3
 };
-"#
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "MutableFields" program 14 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean b/StrataTest/Languages/Laurel/Examples/Objects/T1b_HeapMutatingValueReturn.lean
similarity index 52%
rename from StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean
rename to StrataTest/Languages/Laurel/Examples/Objects/T1b_HeapMutatingValueReturn.lean
index f81e63553d..1a18972604 100644
--- a/StrataTest/Languages/Laurel/Examples/Fundamentals/T8d_HeapMutatingValueReturn.lean
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T1b_HeapMutatingValueReturn.lean
@@ -3,19 +3,17 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
+/-! ## Correct heap mutating value return -/
 
-def heapMutatingValueReturnProgram := r"
+#eval testLaurel
+#strata
+program Laurel;
 composite Container {
   var value: int
 }
@@ -28,19 +26,24 @@ procedure setAndReturn(c: Container, x: int) returns (r: int)
   c#value := x;
   return x
 };
+#end
+
+/-! ## Buggy: postcondition r == x + 1 cannot hold when r := x -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Container {
+  var value: int
+}
 
 procedure setAndReturnBuggy(c: Container, x: int) returns (r: int)
   opaque
   ensures r == x + 1
-//        ^^^^^^^^^^ error: assertion does not hold
+//        ^^^^^^^^^^ error: postcondition does not hold
   modifies c
 {
   c#value := x;
   return x
 };
-"
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "HeapMutatingValueReturn" heapMutatingValueReturnProgram 15 processLaurelFile
-
-end Strata.Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T2_ModifiesClauses.lean b/StrataTest/Languages/Laurel/Examples/Objects/T2_ModifiesClauses.lean
index 2ab10c9a31..ed9bfc9301 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/T2_ModifiesClauses.lean
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T2_ModifiesClauses.lean
@@ -3,7 +3,6 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 A modifies clause CAN be placed on any procedure to generate a modifies axiom.
@@ -15,17 +14,14 @@ since otherwise all heap state is lost after calling them.
 
 -/
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 composite Container {
   var value: int
 }
@@ -157,7 +153,4 @@ procedure modifiesWildcardAndSpecificCaller()
   assert x == d#value // fails because modifies * subsumes modifies c
 //^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved
 };
-"
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "ModifiesClauses" program 24 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T3_ReadsClauses.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/T3_ReadsClauses.lr.st
index 5732c7d40c..210a95c155 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/T3_ReadsClauses.lr.st
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T3_ReadsClauses.lr.st
@@ -46,7 +46,8 @@ type Composite;
 type Field;
 val value: Field;
 
-function opaqueProcedure_ensures(heap: Heap, c: Container, r: int): boolean {
+function opaqueProcedure_ensures(heap: Heap, c: Container, r: int): boolean
+{
   true
 }
 
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean b/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean
index 75d59c4e15..3899f9e3a1 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritance.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 composite Base {
   var xValue: int
 }
@@ -99,7 +95,4 @@ procedure diamondInheritance()
 //  assert b is Top;
 //  assert b is Bottom;
 //}
-"
-
-#guard_msgs (drop info) in
-#eval testInputWithOffset "Inheritance" program 14 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritanceErrors.lean b/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritanceErrors.lean
index 91aff3432a..635a6315ec 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritanceErrors.lean
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T5_inheritanceErrors.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 composite Top {
   var xValue: int
 }
@@ -31,7 +27,4 @@ procedure diamondField(b: Bottom)
   b#xValue := 1
 //  ^^^^^^ error: fields that are inherited multiple times can not be accessed.
 };
-"
-
-#guard_msgs (drop info) in
-#eval testInputWithOffset "InheritanceError" program 14 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T6_Datatypes.lean b/StrataTest/Languages/Laurel/Examples/Objects/T6_Datatypes.lean
index 1567885390..896474404b 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/T6_Datatypes.lean
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T6_Datatypes.lean
@@ -3,36 +3,28 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def datatypeProgram := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 datatype IntList {
   Nil(),
   Cons(head: int, tail: IntList)
 }
 
 // Construction and destructor access
-procedure testConstruction()
-  opaque
-{
+procedure testConstruction() opaque {
   var xs: IntList := Cons(42, Nil());
   assert IntList..head(xs) == 42
 };
 
 // Constructor testing
-procedure testConstructorTest()
-  opaque
-{
+procedure testConstructorTest() opaque {
   var xs: IntList := Cons(1, Nil());
   assert IntList..isCons(xs);
   assert !IntList..isNil(xs);
@@ -43,9 +35,7 @@ procedure testConstructorTest()
 };
 
 // Nested construction and deconstruction
-procedure testNested()
-  opaque
-{
+procedure testNested() opaque {
   var xs: IntList := Cons(1, Cons(2, Nil()));
   assert IntList..isCons(xs);
   assert IntList..head(xs) == 1;
@@ -54,9 +44,7 @@ procedure testNested()
   assert IntList..isNil(IntList..tail(IntList..tail(xs)))
 };
 
-procedure unsafeDestructor()
-  opaque
-{
+procedure unsafeDestructor() opaque {
   var nil: IntList := Nil();
   var noError: int := IntList..head!(nil);
   var error: int := IntList..head(nil)
@@ -70,18 +58,14 @@ function listHead(xs: IntList): int
   IntList..head(xs)
 };
 
-procedure testFunction()
-  opaque
-{
+procedure testFunction() opaque {
   var xs: IntList := Cons(10, Nil());
   var h: int := listHead(xs);
   assert h == 10
 };
 
 // Failing assertion
-procedure testFailing()
-  opaque
-{
+procedure testFailing() opaque {
   var xs: IntList := Nil();
   assert IntList..isCons(xs)
 //^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
@@ -97,9 +81,7 @@ datatype OddList {
   OCons(head: int, tail: EvenList)
 }
 
-procedure testMutualConstruction()
-  opaque
-{
+procedure testMutualConstruction() opaque {
   var even: EvenList := ENil();
   assert EvenList..isENil(even);
   var odd: OddList := OCons(1, ENil());
@@ -112,9 +94,4 @@ procedure testMutualConstruction()
 
 datatype RootBeforeLeaf { RootBeforeLeafC(leaf: LeafAfterRoot) }
 datatype LeafAfterRoot { LeafAfterRootC }
-"
-
-#guard_msgs (error, drop all) in
-#eval! testInputWithOffset "Datatypes" datatypeProgram 14 processLaurelFile
-
-end Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean b/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean
index 068bb6fd8b..08638d1c7f 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T7_InstanceProcedures.lean
@@ -3,37 +3,238 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
+/-
+Tests for the `obj#method(args)` syntax for calling instance procedures.
+
+Each instance procedure declared inside a `composite` block is lifted to a
+top-level static procedure named `<CompositeName>$<methodName>` by the
+`LiftInstanceProcedures` pass. Resolution registers the instance proc in
+global scope under the lifted key, so two composites can share a method
+name without colliding. `c#m(args)` parses as `InstanceCall c m args` and
+the lifting pass rewrites it to `StaticCall Counter$m (c :: args)`.
+-/
 
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
+/-! ## 1. Basic instance method call: `c#reset()` -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Counter {
+  var count: int
+  procedure reset(self: Counter)
+    opaque
+    ensures self#count == 0
+    modifies self
+  {
+    self#count := 0
+  };
+}
+
+procedure useCounter()
+  opaque
+{
+  var c: Counter := new Counter;
+  c#reset();
+  assert c#count == 0
+};
+#end
+
+/-! ## 2. Two composites with the same method name resolve independently.
+    Without per-composite scoping, `tick` would collide in the global scope
+    during pre-registration. -/
 
-def instanceProcedureProgram := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 composite Counter {
   var count: int
-  procedure self_increment(self: Counter)
-//          ^^^^^^^^^^^^^^ error: Instance procedure 'self_increment' on composite type 'Counter' is not yet supported
+  procedure tick(self: Counter)
+    opaque
+    ensures self#count == 1
+    modifies self
+  {
+    self#count := 1
+  };
+}
+
+composite Clock {
+  var time: int
+  procedure tick(self: Clock)
+    opaque
+    ensures self#time == 1
+    modifies self
+  {
+    self#time := 1
+  };
+}
+
+procedure runCounter()
+  opaque
+{
+  var c: Counter := new Counter;
+  c#tick();
+  assert c#count == 1
+};
+
+procedure runClock()
+  opaque
+{
+  var k: Clock := new Clock;
+  k#tick();
+  assert k#time == 1
+};
+#end
+
+/-! ## 3. Method with multiple parameters: `c#setTo(v)` -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Cell {
+  var value: int
+  procedure setTo(self: Cell, v: int)
+    opaque
+    ensures self#value == v
+    modifies self
+  {
+    self#value := v
+  };
+}
+
+procedure useCell(x: int)
+  opaque
+{
+  var b: Cell := new Cell;
+  b#setTo(x);
+  assert b#value == x
+};
+#end
+
+/-! ## 4. Boolean-typed field updated through an instance method, and read
+    back via field access in the caller's `assert`. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Widget {
+  var enabled: bool
+  procedure activate(self: Widget)
     opaque
+    ensures self#enabled
+    modifies self
   {
-    self#count := self#count + 1
+    self#enabled := true
   };
+}
+
+procedure useWidget()
+  opaque
+{
+  var w: Widget := new Widget;
+  w#activate();
+  assert w#enabled == true
+};
+#end
+
+/-! ## 5. Calling an instance method from a top-level procedure that takes
+    the receiver as a parameter. The caller's own modifies clause covers
+    only `a`; the unused `b` parameter is included to confirm method
+    dispatch picks the right receiver. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Counter {
+  var count: int
   procedure reset(self: Counter)
-//          ^^^^^ error: Instance procedure 'reset' on composite type 'Counter' is not yet supported
     opaque
+    ensures self#count == 0
+    modifies self
   {
     self#count := 0
   };
 }
-"
 
-#guard_msgs (error, drop all) in
-#eval! testInputWithOffset "InstanceProcedures" instanceProcedureProgram 14 processLaurelFile
+procedure resetTwoCounters(a: Counter, b: Counter)
+  opaque
+  ensures a#count == 0
+  modifies a
+{
+  a#reset()
+};
+#end
+
+/-! ## 6. Instance method whose extra parameter is unused in the body:
+    confirms an extra (unused) method parameter doesn't break call
+    dispatch or framing. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Account {
+  var balance: int
+  procedure deposit(self: Account, amount: int)
+    opaque
+    ensures self#balance == 1
+    modifies self
+  {
+    self#balance := 1
+  };
+}
+
+procedure useAccount()
+  opaque
+{
+  var a: Account := new Account;
+  a#deposit(100);
+  assert a#balance == 1
+};
+#end
+
+/-! ## 7. Instance method called through a field-selected receiver:
+    `obj#field#method()`. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Inner {
+  var x: int
+  procedure isOne(self: Inner) returns (r: bool)
+    opaque
+    ensures r == (self#x == 1)
+  ;
+}
+
+composite Outer {
+  var inner: Inner
+}
+
+procedure useOuter()
+  opaque
+{
+  var o: Outer := new Outer;
+  var b: bool := o#inner#isOne()
+};
+#end
+
+/-! ## 8. Chained field read: `obj#field#x`. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Inner { var x: int }
+composite Outer { var inner: Inner }
 
-end Laurel
+procedure useOuter()
+  opaque
+{
+  var o: Outer := new Outer;
+  var v: int := o#inner#x
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean b/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean
index 18da725e2d..87a6e2424d 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T8_NonCompositeModifies.lean
@@ -3,7 +3,6 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 Regression test for issue #490: a modifies clause referencing a non-composite
@@ -12,17 +11,14 @@ in laurelAnalyze. The fix filters out non-composite modifies entries and emits
 a diagnostic error.
 -/
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def program := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 composite Container {
   var value: int
 }
@@ -43,7 +39,4 @@ procedure modifyContainerAndPrimitive(c: Container, x: int)
 {
   c#value := 1
 };
-"
-
-#guard_msgs (drop info, error) in
-#eval testInputWithOffset "NonCompositeModifies" program 22 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T9_ChainedFieldAccess.lean b/StrataTest/Languages/Laurel/Examples/Objects/T9_ChainedFieldAccess.lean
new file mode 100644
index 0000000000..415f7e937e
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T9_ChainedFieldAccess.lean
@@ -0,0 +1,182 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-!
+Chained field access on nested composites (`o#inner#count`), both read and
+write. Single-level field access (`o#inner`, `i#count`) already worked; this
+exercises the chaining enabled by three changes:
+
+  * Parse — `fieldAccess` is now `leftassoc`, so `a#b#c` left-recurses.
+  * Resolution — `targetTypeName` resolves a `.Var (.Field ..)` target by
+    recursing on the inner target and looking the field up in that type's scope.
+  * Heap — the field-read arm recurses into its target, so a nested
+    `FieldSelect` is eliminated rather than leaking raw into `readField`.
+-/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Inner {
+  var count: int
+}
+
+composite Outer {
+  var inner: Inner
+}
+
+// Three nested composite levels, for the depth-3 chain `a#mid#inner#count`.
+composite Innermost {
+  var count: int
+}
+
+composite Middle {
+  var inner: Innermost
+}
+
+composite Outermost {
+  var mid: Middle
+}
+
+procedure chainedReadWrite()
+  opaque
+{
+  var o: Outer := new Outer;
+  var i: Inner := new Inner;
+  o#inner := i;
+
+  o#inner#count := 7;
+  assert o#inner#count == 7;
+
+  // Write through the chain again and read it back.
+  o#inner#count := o#inner#count + 1;
+  assert o#inner#count == 8;
+
+  // The chained read agrees with the single-level read of the same object.
+  assert i#count == 8
+};
+
+procedure chainedReadAfterInnerAssign()
+  opaque
+{
+  var o: Outer := new Outer;
+  var i: Inner := new Inner;
+  i#count := 3;
+  o#inner := i;
+  // Reading through the chain sees the value written on `i` directly.
+  assert o#inner#count == 3
+};
+
+procedure chainedAliasing()
+  opaque
+{
+  var o: Outer := new Outer;
+  var i: Inner := new Inner;
+  o#inner := i;
+  o#inner#count := 1;
+
+  // `i` and `o#inner` alias the same Inner, so a write through one is seen
+  // through the other.
+  i#count := 42;
+  assert o#inner#count == 42
+};
+
+procedure depth3ReadWrite()
+  opaque
+{
+  var a: Outermost := new Outermost;
+  var b: Middle := new Middle;
+  var c: Innermost := new Innermost;
+  a#mid := b;
+  b#inner := c;
+
+  a#mid#inner#count := 9;
+  assert a#mid#inner#count == 9;
+  // The depth-3 chain agrees with the single-level read of the same object.
+  assert c#count == 9
+};
+
+procedure chainedReadOnBothSides()
+  opaque
+{
+  var o: Outer := new Outer;
+  var p: Outer := new Outer;
+  var i: Inner := new Inner;
+  var j: Inner := new Inner;
+  o#inner := i;
+  p#inner := j;
+  i#count := 4;
+  j#count := 4;
+  // Chained read on both operands of a comparison.
+  assert o#inner#count == p#inner#count
+};
+
+// Paren-free chained incr/decr: `o#inner#count++` parses as `(o#inner#count)++`
+// because `fieldAccess` (prec 95) binds tighter than postfix `++`/`--` (prec 90),
+// and `leftassoc` lets the chain `o#inner#count` left-recurse.
+procedure chainedParenFreeIncrDecr()
+  opaque
+{
+  var o: Outer := new Outer;
+  var i: Inner := new Inner;
+  o#inner := i;
+  o#inner#count := 10;
+  o#inner#count++;
+  assert o#inner#count == 11;
+  o#inner#count--;
+  assert o#inner#count == 10;
+  // Postfix in expression position yields the OLD value (10); the cell becomes 11.
+  var y: int := o#inner#count++;
+  assert o#inner#count == 11;
+  assert y == 10
+};
+
+// Negative: an unconstrained chained field has no known value, so asserting a
+// concrete value must NOT be provable. Pins the chained read as non-vacuous.
+procedure chainedReadUnconstrainedFails()
+  opaque
+{
+  var o: Outer := new Outer;
+  var i: Inner := new Inner;
+  o#inner := i;
+  assert o#inner#count == 7
+//^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved
+};
+
+// Negative (frame soundness): two distinct outers whose inner fields MAY alias.
+// A write through `a#inner` may be observed through `b#inner`, so the post-write
+// value of `b#inner#count` is not provably its pre-write value.
+procedure chainedMayAliasFails()
+  opaque
+{
+  var a: Outer := new Outer;
+  var b: Outer := new Outer;
+  var i: Inner := new Inner;
+  a#inner := i;
+  b#inner := i;
+  a#inner#count := 5;
+  assert b#inner#count == 0
+//^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved
+};
+
+// Negative (write isolation): a write through one chain must not be observable on
+// a genuinely disjoint, freshly-allocated object.
+procedure chainedWriteIsolationFails()
+  opaque
+{
+  var o: Outer := new Outer;
+  var i: Inner := new Inner;
+  var d: Inner := new Inner;
+  o#inner := i;
+  o#inner#count := 7;
+  assert d#count == 7
+//^^^^^^^^^^^^^^^^^^^ error: assertion could not be proved
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T9_IfBranchJoin.lean b/StrataTest/Languages/Laurel/Examples/Objects/T9_IfBranchJoin.lean
new file mode 100644
index 0000000000..3091f90d3e
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T9_IfBranchJoin.lean
@@ -0,0 +1,29 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-
+An `if/else` in check position pushes the expected type into *both* branches
+(rather than synth + subsume at the boundary), so a branch whose value doesn't
+match the expected type errors at that branch.
+-/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+composite Top { }
+composite Left extends Top { }
+composite Right extends Top { }
+procedure test(c: bool) opaque {
+  var x: Top := if c then new Left else new Right;
+  var y: Left := if c then new Left else new Right
+//                                       ^^^^^^^^^ error: expected 'Left', got 'Right'
+};
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T9_OldHeapTwoState.lean b/StrataTest/Languages/Laurel/Examples/Objects/T9_OldHeapTwoState.lean
new file mode 100644
index 0000000000..89681f2234
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T9_OldHeapTwoState.lean
@@ -0,0 +1,235 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+/-
+End-to-end coverage of user-written `old(...)` in Laurel postconditions.
+
+`old(e)` parses to `StmtExpr.Old e`, is pushed inward by `PushOldInward`
+until each `Old` immediately wraps a variable reference, then translated
+to Core's two-state semantics via `LaurelToCoreTranslator`. Combined with
+the inout-`$heap` parameter introduced by `HeapParameterization`, this
+lets postconditions relate the pre- and post-state of the heap.
+
+The procedures below exercise:
+- `old` of a heap field read (basic two-state).
+- `old` of a non-trivial arithmetic sub-expression (PushOldInward
+  distributes through `+` and `*`).
+- `old` of a unary `!` and of a `<` comparison.
+- `old(old(...))` of a sub-expression (collapse + distribution).
+- `old` inside a universal quantifier body.
+- `old` inside an `if-then-else` postcondition.
+- Multiple `modifies` / multiple `old`-using ensures clauses.
+- Modifies-wildcard combined with `old`.
+- Wrong-body and wrong-`old`-relation negative cases.
+- Warning when `old(...)` mentions no inout (no-op `old`).
+- A caller asserting the post-state via the implicit pre-state snapshot.
+
+Each positive postcondition is engineered so that, were `old(...)` to
+be silently dropped, the postcondition would reduce to a post-state
+equation that the body falsifies — the procedure would fail to verify.
+-/
+
+import StrataTest.Util.TestDiagnostics
+import StrataTest.Util.LaurelDebugPipeline
+
+open StrataTest.Util
+
+namespace Strata
+namespace Laurel
+
+def program := r"
+composite Cell {
+  var value: int
+  var flag: bool
+}
+
+// ----- 1. Basic two-state postcondition -----
+
+procedure bumpCell(c: Cell)
+  opaque
+  ensures c#value == old(c#value) + 1
+  modifies c
+{
+  c#value := c#value + 1
+};
+
+procedure bumpCellWrong(c: Cell)
+  opaque
+  ensures c#value == old(c#value) + 1
+//        ^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: postcondition could not be proved
+  modifies c
+{
+  c#value := c#value + 2
+};
+
+procedure bumpCellCaller()
+  opaque
+{
+  var c: Cell := new Cell;
+  var pre: int := c#value;
+  bumpCell(c);
+  assert c#value == pre + 1
+};
+
+// ----- 2. `old` distributing through arithmetic sub-expressions -----
+
+// PushOldInward must push the outer `old` past `+`, leaving
+// `old(c#value) + 1` for the translator to handle.
+procedure addTwoSubexpr(c: Cell)
+  opaque
+  ensures c#value == old(c#value + 1) + 1
+  modifies c
+{
+  c#value := c#value + 2
+};
+
+// Nested arithmetic: `old(2 * c#value + 3)` distributes through both
+// `*` and `+`, leaving `2 * old(c#value) + 3` after lowering.
+procedure linearTransform(c: Cell)
+  opaque
+  ensures c#value == 2 * old(c#value) + 3
+  modifies c
+{
+  c#value := 2 * c#value + 3
+};
+
+// ----- 3. `old` of a boolean: unary `!` and comparison -----
+
+procedure flipFlag(c: Cell)
+  opaque
+  ensures c#flag == !old(c#flag)
+  modifies c
+{
+  c#flag := !c#flag
+};
+
+// `old(c#value < d#value)` distributes through `<`, leaving
+// `old(c#value) < old(d#value)`. The body inverts the ordering, so this
+// postcondition can only hold when `old` actually refers to the
+// pre-state: without two-state semantics the postcondition reduces to
+// the (now false) post-state comparison.
+procedure recallPreOrdering(c: Cell, d: Cell)
+  requires c != d
+  requires c#value < d#value
+  opaque
+  ensures old(c#value < d#value)
+  modifies c
+  modifies d
+{
+  c#value := 100;
+  d#value := -100
+};
+
+// ----- 4. Nested `old(old(e))`: inner `old` is a no-op, warning emitted -----
+
+// PushOldInward warns about the redundant inner `old` and drops it; the
+// outer `old` then distributes past `+`, leaving `2 * old(c#value) + 1`,
+// which the body satisfies.
+procedure nestedOldWarns(c: Cell)
+  opaque
+  ensures c#value == old(old(c#value + c#value)) + 1
+//                       ^^^^^^^^^^^^^^^^^^^^^^ warning: nested `old(...)` has no effect
+  modifies c
+{
+  c#value := 2 * c#value + 1
+};
+
+// ----- 5. `old` inside a universal quantifier body -----
+
+// The postcondition uses `old` inside `forall`: for the modified cell
+// `c`, post > pre strictly. This would be unprovable without `old`
+// (it'd reduce to `c#value > c#value`). The synthetic frame for every
+// other cell does not entail this strict inequality, so the verifier
+// must use the explicit `c#value > old(c#value)` claim.
+procedure strictBumpInForall(c: Cell)
+  opaque
+  ensures forall(other: Cell) => other == c ==> other#value > old(other#value)
+  modifies c
+{
+  c#value := c#value + 1
+};
+
+// ----- 6. `if-then-else` in postcondition with `old` on both branches -----
+
+// The body conditionally bumps `c#value`. The postcondition relates
+// post- to pre-state through an `if` whose condition is itself an
+// `old(...)` field read.
+procedure conditionalUpdate(c: Cell)
+  opaque
+  ensures c#value == if old(c#flag) then old(c#value) + 1 else old(c#value)
+  modifies c
+{
+  if c#flag then { c#value := c#value + 1 }
+};
+
+// ----- 7. Multiple modifies + multiple old-using ensures -----
+
+procedure bumpBoth(c: Cell, d: Cell)
+  requires c != d
+  opaque
+  ensures c#value == old(c#value) + 1
+  ensures d#value == old(d#value) + 2
+  ensures c#flag == old(c#flag)
+  modifies c
+  modifies d
+{
+  c#value := c#value + 1;
+  d#value := d#value + 2
+};
+
+procedure bumpBothCaller()
+  opaque
+{
+  var c: Cell := new Cell;
+  var d: Cell := new Cell;
+  var preC: int := c#value;
+  var preD: int := d#value;
+  // c != d holds because both come from `new Cell`.
+  bumpBoth(c, d);
+  assert c#value == preC + 1;
+  assert d#value == preD + 2
+};
+
+// ----- 8. `modifies *` with an `old`-using ensures -----
+
+// Wildcard modifies takes a different path through ModifiesClauses;
+// `old(c#value)` should still resolve to the pre-state.
+procedure bumpUnderWildcard(c: Cell)
+  opaque
+  ensures c#value == old(c#value) + 1
+  modifies *
+{
+  c#value := c#value + 1
+};
+
+// ----- 9. Negative: ensures asserts the wrong `old` relation -----
+
+procedure wrongOldRelation(c: Cell)
+  opaque
+  ensures c#value == old(c#value) - 1
+//        ^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: postcondition could not be proved
+  modifies c
+{
+  c#value := c#value + 1
+};
+
+// ----- 10. `old(...)` over an expression with no inout: warning, no effect -----
+
+procedure noEffectOld(c: Cell)
+  opaque
+  ensures old(42) == 42
+//        ^^^^^^^ warning: `old(...)` has no effect
+  modifies c
+{
+  c#value := c#value + 1
+};
+"
+
+#guard_msgs (drop info, error) in
+#eval testInputWithOffset "OldHeapTwoState" program 32 processLaurelFile
+
+end Laurel
+end Strata
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/T9_ValueReturningInstanceMethods.lean b/StrataTest/Languages/Laurel/Examples/Objects/T9_ValueReturningInstanceMethods.lean
new file mode 100644
index 0000000000..fb7249ddb7
--- /dev/null
+++ b/StrataTest/Languages/Laurel/Examples/Objects/T9_ValueReturningInstanceMethods.lean
@@ -0,0 +1,310 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+/-
+Comprehensive tests for **value-returning instance procedures** (methods
+declared inside a `composite` block that return a value via a `return expr`
+statement in their body).
+
+These exercise the interaction between the `EliminateValueInReturns` pass and
+the `LiftInstanceProcedures` pass. `EliminateValueInReturns` rewrites
+`return expr` into `outParam := expr; return`, and it must do so for instance
+procedures *while they still live inside their composite* (it runs before
+`LiftInstanceProcedures` lifts them to static scope). If it skipped instance
+procedures, the leftover `return expr` would later trip a `StrataBug` during
+Core translation.
+
+Positive cases below all verify cleanly (no diagnostics). Negative cases pin
+the diagnostics emitted by `EliminateValueInReturns` for unsupported valued
+returns, proving the pass now reaches instance procedures.
+
+See also `T7_InstanceProcedures.lean` for the surface-syntax / call-dispatch
+tests of `obj#method(args)`.
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-! ## 1. Basic: instance method body returns a field via `return expr`. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Num {
+  var v: int
+  procedure get(self: Num) returns (r: int)
+    opaque
+    ensures r == self#v
+  {
+    return self#v
+  };
+}
+
+procedure useGet()
+  opaque
+{
+  var b: Num := new Num;
+  var x: int := b#get();
+  assert x == b#v
+};
+#end
+
+/-! ## 2. Return a computed expression. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Num {
+  var v: int
+  procedure incd(self: Num) returns (r: int)
+    opaque
+    ensures r == self#v + 1
+  {
+    return self#v + 1
+  };
+}
+
+procedure useIncd()
+  opaque
+{
+  var b: Num := new Num;
+  var x: int := b#incd();
+  assert x == b#v + 1
+};
+#end
+
+/-! ## 3. Return an expression that uses a (non-self) parameter. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Num {
+  var v: int
+  procedure addTo(self: Num, d: int) returns (r: int)
+    opaque
+    ensures r == self#v + d
+  {
+    return self#v + d
+  };
+}
+
+procedure useAddTo()
+  opaque
+{
+  var b: Num := new Num;
+  var x: int := b#addTo(5);
+  assert x == b#v + 5
+};
+#end
+
+/-! ## 4. Conditional / early returns: a valued `return` in each branch of an
+    if-then-else inside the method body. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Num {
+  var v: int
+  procedure clampPos(self: Num) returns (r: int)
+    opaque
+    ensures r >= 0
+  {
+    if self#v >= 0 then {
+      return self#v
+    } else {
+      return 0
+    }
+  };
+}
+
+procedure useClampPos()
+  opaque
+{
+  var b: Num := new Num;
+  var x: int := b#clampPos();
+  assert x >= 0
+};
+#end
+
+/-! ## 5. Method that mutates a field (modifies clause) and then returns. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Num {
+  var v: int
+  procedure setAndGet(self: Num, n: int) returns (r: int)
+    opaque
+    ensures self#v == n
+    ensures r == n
+    modifies self
+  {
+    self#v := n;
+    return n
+  };
+}
+
+procedure useSetAndGet()
+  opaque
+{
+  var b: Num := new Num;
+  var x: int := b#setAndGet(7);
+  assert x == 7;
+  assert b#v == 7
+};
+#end
+
+/-! ## 6. Boolean return type. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Num {
+  var v: int
+  procedure isPos(self: Num) returns (r: bool)
+    opaque
+    ensures r == (self#v > 0)
+  {
+    return self#v > 0
+  };
+}
+
+procedure useIsPos()
+  opaque
+{
+  var b: Num := new Num;
+  var p: bool := b#isPos();
+  assert p == (b#v > 0)
+};
+#end
+
+/-! ## 7. Two composites sharing a method name, both with value-returning
+    bodies. Confirms lifting + value-return elimination keep them distinct. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite A {
+  var v: int
+  procedure read(self: A) returns (r: int)
+    opaque
+    ensures r == self#v
+  {
+    return self#v
+  };
+}
+
+composite B {
+  var w: int
+  procedure read(self: B) returns (r: int)
+    opaque
+    ensures r == self#w
+  {
+    return self#w
+  };
+}
+
+procedure useBoth()
+  opaque
+{
+  var a: A := new A;
+  var b: B := new B;
+  var x: int := a#read();
+  var y: int := b#read();
+  assert x == a#v;
+  assert y == b#w
+};
+#end
+
+/-! ## 8. Value-returning method invoked through a field-selected receiver:
+    `o#inner#getX()`. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Inner {
+  var x: int
+  procedure getX(self: Inner) returns (r: int)
+    opaque
+    ensures r == self#x
+  {
+    return self#x
+  };
+}
+
+composite Outer {
+  var inner: Inner
+}
+
+procedure useOuter()
+  opaque
+{
+  var o: Outer := new Outer;
+  var v: int := o#inner#getX();
+  assert v == o#inner#x
+};
+#end
+
+/-! ## 9. Local variable in the body before a valued return. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite Num {
+  var v: int
+  procedure doubleV(self: Num) returns (r: int)
+    opaque
+    ensures r == self#v + self#v
+  {
+    var t: int := self#v;
+    return t + t
+  };
+}
+
+procedure useDoubleV()
+  opaque
+{
+  var b: Num := new Num;
+  var x: int := b#doubleV();
+  assert x == b#v + b#v
+};
+#end
+
+/-! ## 10. Negative: valued return in an instance method with NO output
+    parameter is rejected by `EliminateValueInReturns`. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite C {
+  var v: int
+  procedure noOut(self: C)
+    opaque
+  {
+    return 5
+//  ^^^^^^^^ error: void procedure cannot return a value
+  };
+}
+#end
+
+/-! ## 11. Negative: valued return in an instance method with MULTIPLE output
+    parameters is rejected by `EliminateValueInReturns`. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+composite D {
+  var v: int
+  procedure twoOut(self: D) returns (a: int, b: int)
+    opaque
+  {
+    return 1
+//  ^^^^^^^^  error: multi-output procedure cannot use 'return e'; assign to named outputs instead
+  };
+}
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Allocation.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Allocation.lr.st
index dd02787340..3dc57127ed 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Allocation.lr.st	
+++ b/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Allocation.lr.st	
@@ -13,6 +13,7 @@ composite Immutable {
   invariant x + y >= 5
 
   procedure construct()
+    opaque
     constructor
     requires contructing == {this}
     ensures constructing == {}
@@ -50,6 +51,7 @@ composite ImmutableChainOfTwo {
 
   // only used privately
   procedure allocate()
+    opaque
     constructor
     ensures constructing = {this} {    
     // empty body
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Constructors.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Constructors.lr.st
index 2d9a5afaa4..6d33df854c 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Constructors.lr.st	
+++ b/StrataTest/Languages/Laurel/Examples/Objects/WIP/5. Constructors.lr.st	
@@ -18,6 +18,7 @@ composite Immutable {
   // fields of Immutable are considered mutable inside this procedure
   // and invariants of Immutable are not visible
   // can only call procedures that are also constructing Immutable
+    opaque
     constructs Immutable
     modifies this
   {
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/WIP/7. InstanceCallables.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/WIP/7. InstanceCallables.lr.st
index fe4c5756d6..95cf829196 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/WIP/7. InstanceCallables.lr.st	
+++ b/StrataTest/Languages/Laurel/Examples/Objects/WIP/7. InstanceCallables.lr.st	
@@ -5,12 +5,14 @@
 */
 composite Base {
   procedure foo(): int
+    opaque
     ensures result > 3
     { abstract };
 }
 
 composite Extender1 extends Base {
   procedure foo(): int
+    opaque
     ensures result > 4
 //  ^^^^^^^ error: could not prove ensures clause guarantees that of extended method 'Base.foo'
     { abstract };
@@ -19,6 +21,7 @@ composite Extender1 extends Base {
 composite Extender2 extends Base {
   value: int
   procedure foo(): int
+    opaque
     ensures result > 2
   {
     this.value + 2 // 'this' is an implicit variable inside instance callables
diff --git a/StrataTest/Languages/Laurel/Examples/Objects/WIP/9. Closures.lr.st b/StrataTest/Languages/Laurel/Examples/Objects/WIP/9. Closures.lr.st
index 212df76ab8..3449eb9246 100644
--- a/StrataTest/Languages/Laurel/Examples/Objects/WIP/9. Closures.lr.st	
+++ b/StrataTest/Languages/Laurel/Examples/Objects/WIP/9. Closures.lr.st	
@@ -87,6 +87,7 @@ so in affect there no longer are any variables captured by a closure.
 
 // Option A: first class procedures
 procedure hasClosure() returns (r: int)
+  opaque
   ensures r == 7
 {
   var x = 3;
diff --git a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T1_Decimals.lean b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T1_Decimals.lean
index a87350fda6..0a1280653c 100644
--- a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T1_Decimals.lean
+++ b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T1_Decimals.lean
@@ -3,19 +3,15 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def decimalsProgram := r"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure testDecimalLiterals()
   opaque
 {
@@ -70,9 +66,4 @@ procedure testDecimalAssertFails()
     assert a == b
 //  ^^^^^^^^^^^^^ error: assertion does not hold
 };
-"
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "Decimals" decimalsProgram 14 processLaurelFile
-
-end Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean
index 67a0c1dccf..0528672ee8 100644
--- a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean
+++ b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_String.lean
@@ -3,20 +3,16 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
+open Strata
 
-namespace Strata
-namespace Laurel
-
-def program := r#"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure testStringKO()
   returns (result: string)
   opaque
@@ -41,14 +37,14 @@ returns (result: string)
 procedure testStringLiteralConcatOK()
   opaque
 {
-  var result: string := "a" ++ "b";
+  var result: string := "a" ^ "b";
   assert(result == "ab")
 };
 
 procedure testStringLiteralConcatKO()
   opaque
 {
-  var result: string := "a" ++ "b";
+  var result: string := "a" ^ "b";
   assert(result == "cd")
 //^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
 };
@@ -57,7 +53,7 @@ procedure testStringVarConcatOK()
   opaque
 {
   var x: string := "Hello";
-  var result: string := x ++ " World";
+  var result: string := x ^ " World";
   assert(result == "Hello World")
 };
 
@@ -65,11 +61,8 @@ procedure testStringVarConcatKO()
   opaque
 {
   var x: string := "Hello";
-  var result: string := x ++ " World";
+  var result: string := x ^ " World";
   assert(result == "Goodbye")
 //^^^^^^^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
 };
-"#
-
-#guard_msgs(drop info, error) in
-#eval testInputWithOffset "String" program 14 processLaurelFile
+#end
diff --git a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_StringConcatLifting.lean b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_StringConcatLifting.lean
index c7f5caef5b..cc3756bed8 100644
--- a/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_StringConcatLifting.lean
+++ b/StrataTest/Languages/Laurel/Examples/PrimitiveTypes/T2_StringConcatLifting.lean
@@ -3,24 +3,20 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import all StrataTest.Languages.Laurel.TestExamples
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
 
-namespace Strata.Laurel
-
-def stringConcatLiftingProgram := r#"
+#eval testLaurel <|
+#strata
+program Laurel;
 procedure stringConcatWithAssignment()
   opaque
 {
   var x: string := "Hello";
-  var y: string := x ++ (x := " World");
+  var y: string := x ^ (x := " World");
   assert y == "Hello World";
   assert x == " World"
 };
@@ -30,7 +26,7 @@ procedure stringConcatOK()
 {
   var a: string := "Hello";
   var b: string := " World";
-  var c: string := a ++ b;
+  var c: string := a ^ b;
   assert c == "Hello World"
 };
 
@@ -39,13 +35,8 @@ procedure stringConcatKO()
 {
   var a: string := "Hello";
   var b: string := " World";
-  var c: string := a ++ b;
+  var c: string := a ^ b;
   assert c == "Goodbye"
 //^^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
 };
-"#
-
-#guard_msgs (error, drop all) in
-#eval! testInputWithOffset "StringConcatLifting" stringConcatLiftingProgram 14 processLaurelFile
-
-end Laurel
+#end
diff --git a/StrataTest/Languages/Laurel/IncrDecrLiftTest.lean b/StrataTest/Languages/Laurel/IncrDecrLiftTest.lean
new file mode 100644
index 0000000000..44731ab35d
--- /dev/null
+++ b/StrataTest/Languages/Laurel/IncrDecrLiftTest.lean
@@ -0,0 +1,144 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+module
+
+/-
+Tests that the EliminateIncrDecr + LiftImperativeExpressions pipeline correctly
+lowers Java-style `++`/`--` operators in both prefix and postfix forms, in both
+statement and expression positions, by comparing the lowered Laurel against
+expected output.
+-/
+
+meta import StrataDDM.Elab
+meta import StrataDDM.BuiltinDialects.Init
+meta import Strata.Languages.Laurel.Grammar
+meta import Strata.Languages.Laurel.EliminateIncrDecr
+meta import Strata.Languages.Laurel.LiftImperativeExpressions
+
+meta section
+
+open Strata
+open StrataDDM (initDialect)
+open StrataDDM.Elab (parseStrataProgramFromDialect)
+
+namespace Strata.Laurel
+
+/-- Run the parser, the EliminateIncrDecr pass, then LiftImperativeExpressions,
+    so that test output reflects the Laurel form that is fed to Core. -/
+def parseLowerIncrDecr (input : String) : IO Program := do
+  let inputCtx := StrataDDM.Parser.stringInputContext "test" input
+  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
+  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name inputCtx
+  let uri := Strata.Uri.file "test"
+  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
+  | .error e => throw (IO.userError s!"Translation errors: {e}")
+  | .ok program =>
+    -- Step 1: eliminate IncrDecr
+    let program := eliminateIncrDecr program
+    -- Step 2: resolve so liftExpressionAssignments has a valid SemanticModel
+    let result := resolve program
+    let (program, model) := (result.program, result.model)
+    pure (liftExpressionAssignments program model [])
+
+/-- Statement form: `x++;` and `--x` as statements. Prefix (`--x`) produces
+    a clean assignment. Postfix (`x++`) emits the same assignment-based form as
+    the expression position; the lift pass snapshots the pre-assignment value
+    even though it is unused here. -/
+def stmtFormProgram : String := r"
+procedure stmtForm()
+  opaque
+{
+  var x: int := 0;
+  x++;
+  --x
+};
+"
+
+/--
+info: procedure stmtForm()
+  opaque
+{
+  var x: int := 0;
+  var $x_0: int := x;
+  x := x + 1;
+  x := x - 1
+};
+-/
+#guard_msgs in
+#eval! do
+  let program ← parseLowerIncrDecr stmtFormProgram
+  for proc in program.staticProcedures do
+    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
+
+/-- Prefix form in expression position: yields the new value. -/
+def preIncrExprProgram : String := r"
+procedure preIncrExpr()
+  opaque
+{
+  var x: int := 0;
+  var y: int := ++x + ++x;
+  assert x == 2;
+  assert y == 3
+};
+"
+
+/--
+info: procedure preIncrExpr()
+  opaque
+{
+  var x: int := 0;
+  var $x_1: int := x;
+  x := x + 1;
+  var $x_0: int := x;
+  x := x + 1;
+  var y: int := $x_0 + x;
+  assert x == 2;
+  assert y == 3
+};
+-/
+#guard_msgs in
+#eval! do
+  let program ← parseLowerIncrDecr preIncrExprProgram
+  for proc in program.staticProcedures do
+    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
+
+/-- Postfix form in expression position: yields the OLD value. After the
+    pipeline runs, the snapshot mechanism makes `(x++) + (x++)` evaluate to
+    `0 + 1 = 1` while `x` ends up at 2 — matching Java semantics. -/
+def postIncrExprProgram : String := r"
+procedure postIncrExpr()
+  opaque
+{
+  var x: int := 0;
+  var y: int := x++ + x++;
+  assert x == 2;
+  assert y == 1
+};
+"
+
+/--
+info: procedure postIncrExpr()
+  opaque
+{
+  var x: int := 0;
+  var $x_1: int := x;
+  x := x + 1;
+  var $x_0: int := x;
+  x := x + 1;
+  var y: int := $x_0 - 1 + (x - 1);
+  assert x == 2;
+  assert y == 1
+};
+-/
+#guard_msgs in
+#eval! do
+  let program ← parseLowerIncrDecr postIncrExprProgram
+  for proc in program.staticProcedures do
+    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
+
+end Laurel
+end Strata
+end
diff --git a/StrataTest/Languages/Laurel/IncrDecrTypeRejectionTest.lean b/StrataTest/Languages/Laurel/IncrDecrTypeRejectionTest.lean
new file mode 100644
index 0000000000..33c166b4c9
--- /dev/null
+++ b/StrataTest/Languages/Laurel/IncrDecrTypeRejectionTest.lean
@@ -0,0 +1,55 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+/-
+Increment/decrement (`++`/`--`) is only lowered for `int` and int-based
+constrained types (e.g. `nat`). Applying it to `bv`, `real`, or `float64`
+is rejected during resolution with a clear Laurel diagnostic (and a source
+range), rather than leaking a raw Core unification error from a later pass.
+
+This file also pins the positive case: `++`/`--` on an int-based constrained
+type verifies end-to-end.
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-! ## Rejected: `++`/`--` on unsupported element types -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure incrBv(y: bv 32) opaque {
+  var x: bv 32 := y;
+  x++
+//^^^ error: only supported on 'int' and int-based constrained types
+};
+procedure decrReal() opaque {
+  var r: real := 1.0;
+  r--
+//^^^ error: only supported on 'int' and int-based constrained types
+};
+procedure incrFloat(g: float64) opaque {
+  var f: float64 := g;
+  f++
+//^^^ error: only supported on 'int' and int-based constrained types
+};
+#end
+
+/-! ## Accepted: `++`/`--` on an int-based constrained type (e.g. `nat`) -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+constrained nat = v: int where v >= 0 witness 0
+procedure incrNat() opaque {
+  var n: nat := 0;
+  n++;
+  assert n == 1
+};
+#end
diff --git a/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean b/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean
index e320003aa7..814fabe6cf 100644
--- a/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean
+++ b/StrataTest/Languages/Laurel/LiftExpressionAssignmentsTest.lean
@@ -3,7 +3,6 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 Tests that the expression lifter correctly handles statement constructs
@@ -11,41 +10,24 @@ Tests that the expression lifter correctly handles statement constructs
 by comparing the lifted Laurel against expected output.
 -/
 
-meta import StrataDDM.Elab
-meta import StrataDDM.BuiltinDialects.Init
-meta import Strata.Languages.Laurel.Grammar
-meta import Strata.Languages.Laurel.LaurelToCoreTranslator
-meta import Strata.Languages.Laurel.LiftImperativeExpressions
-
-meta section
+import StrataTest.Util.TestLaurel
+import Strata.Languages.Laurel.LaurelToCoreSchemaPass
+import Strata.Languages.Laurel.Resolution
 
 open Strata
-open StrataDDM (initDialect)
-open StrataDDM.Elab (parseStrataProgramFromDialect)
+open StrataTest.Util
 
 namespace Strata.Laurel
 
-def blockStmtLiftingProgram : String := r"
-procedure assertInBlockExpr()
-  opaque
-{
-  var x: int := 0;
-  var y: int := { assert x == 0; x := 1; x };
-  assert y == 1
-};
-"
+private def parseLaurelAndLift (program : StrataDDM.Program) : IO Program := do
+  let laurelProgram ← translateLaurel program
+  let result := resolve laurelProgram
+  pure (liftExpressionAssignments result.program result.model [])
 
-def parseLaurelAndLift (input : String) : IO Program := do
-  let inputCtx := StrataDDM.Parser.stringInputContext "test" input
-  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
-  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name inputCtx
-  let uri := Strata.Uri.file "test"
-  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
-  | .error e => throw (IO.userError s!"Translation errors: {e}")
-  | .ok program =>
-    let result := resolve program
-    let (program, model) := (result.program, result.model)
-    pure (liftExpressionAssignments model program)
+private def printLifted (program : StrataDDM.Program) : IO Unit := do
+  let lifted ← parseLaurelAndLift program
+  for proc in lifted.staticProcedures do
+    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
 
 /--
 info: procedure assertInBlockExpr()
@@ -62,11 +44,15 @@ info: procedure assertInBlockExpr()
 };
 -/
 #guard_msgs in
-#eval! do
-  let program ← parseLaurelAndLift blockStmtLiftingProgram
-  for proc in program.staticProcedures do
-    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
+#eval! printLifted
+#strata
+program Laurel;
+procedure assertInBlockExpr()
+opaque {
+  var x: int := 0;
+  var y: int := { assert x == 0; x := 1; x };
+  assert y == 1
+};
+#end
 
 end Laurel
-end Strata
-end
diff --git a/StrataTest/Languages/Laurel/LiftHolesTest.lean b/StrataTest/Languages/Laurel/LiftHolesTest.lean
index 1b96b0407a..a7d9879b9d 100644
--- a/StrataTest/Languages/Laurel/LiftHolesTest.lean
+++ b/StrataTest/Languages/Laurel/LiftHolesTest.lean
@@ -3,44 +3,30 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 Tests that the eliminateHoles pass correctly replaces `.Hole` nodes with calls
 to freshly generated uninterpreted functions, with types inferred from context.
 -/
 
-meta import StrataDDM.Elab
-meta import StrataDDM.BuiltinDialects.Init
-meta import Strata.Languages.Laurel.Grammar.LaurelGrammar
-meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
-meta import Strata.Languages.Laurel.InferHoleTypes
-meta import Strata.Languages.Laurel.EliminateHoles
-meta import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
-
-meta section
+import StrataTest.Util.TestLaurel
+import Strata.Languages.Laurel.InferHoleTypes
+import Strata.Languages.Laurel.EliminateDeterministicHoles
 
 open Strata
-open StrataDDM (initDialect)
-open StrataDDM.Elab (parseStrataProgramFromDialect)
+open StrataTest.Util
 
 namespace Strata.Laurel
 
-/-- Parse a Laurel source string, resolve, eliminate holes, and print all procedures. -/
-private def parseElimAndPrint (input : String) : IO Unit := do
-  let inputCtx := StrataDDM.Parser.stringInputContext "test" input
-  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
-  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name inputCtx
-  let uri := Strata.Uri.file "test"
-  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
-  | .error e => throw (IO.userError s!"Translation errors: {e}")
-  | .ok program =>
-    let result := resolve program
-    let (program, model) := (result.program, result.model)
-    let (program, _, _) := inferHoleTypes model program
-    let (program, _) := eliminateHoles program
-    for proc in program.staticProcedures do
-      IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
+/-- Resolve, eliminate holes, and print all procedures. -/
+private def parseElimAndPrint (program : StrataDDM.Program) : IO Unit := do
+  let laurelProgram ← translateLaurel program
+  let result := resolve laurelProgram
+  let (laurelProgram, model) := (result.program, result.model)
+  let (laurelProgram, _, _) := inferHoleTypes model laurelProgram
+  let (laurelProgram, _) := eliminateDeterministicHoles laurelProgram
+  for proc in laurelProgram.staticProcedures do
+    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
 
 /-! ## Basic: single hole in various positions -/
 
@@ -56,11 +42,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { var x: int := 1 + <?> };
-"
+#end
 
 -- Bare Hole as Assign Declare initializer → replaced with call (no longer preserved as havoc).
 /--
@@ -74,11 +62,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { var x: int := <?> };
-"
+#end
 
 -- Hole in comparison arg inside assert → int (inferred from sibling literal).
 /--
@@ -92,11 +82,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { assert <?> > 0 };
-"
+#end
 
 -- Hole directly as assert condition → bool.
 /--
@@ -110,11 +102,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { assert <?> };
-"
+#end
 
 -- Hole directly as assume condition → bool.
 /--
@@ -128,11 +122,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { assume <?> };
-"
+#end
 
 -- Hole as if-then-else condition → bool.
 /--
@@ -142,17 +138,20 @@ info: function $hole_0()
 procedure test()
   opaque
 {
-  if $hole_0() then {
+  if $hole_0()
+  then {
     assert true
   }
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { if <?> then { assert true } };
-"
+#end
 
 -- Hole in then-branch of if-then-else inside typed local variable → int.
 /--
@@ -162,15 +161,19 @@ info: function $hole_0()
 procedure test()
   opaque
 {
-  var x: int := if true then $hole_0() else 0
+  var x: int := if true
+  then $hole_0()
+  else 0
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { var x: int := if true then <?> else 0 };
-"
+#end
 
 -- Hole as while-loop condition → bool.
 /--
@@ -186,11 +189,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { while(<?>) {} };
-"
+#end
 
 -- Hole as while-loop invariant → bool.
 /--
@@ -207,11 +212,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { while(true) invariant <?> {} };
-"
+#end
 
 /-! ## Operators -/
 
@@ -227,11 +234,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { assert true && <?> };
-"
+#end
 
 -- Hole in Neg inside typed local variable → int.
 /--
@@ -245,11 +254,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { var x: int := -<?> };
-"
+#end
 
 -- Hole in StrConcat inside typed local variable → string.
 /--
@@ -258,12 +269,16 @@ info: function $hole_0()
   opaque;
 procedure test()
 {
-  var s: string := "hello" ++ $hole_0()
+  var s: string := "hello" ^ $hole_0()
 };
 -/
 #guard_msgs in
 #eval! parseElimAndPrint
-  "procedure test() { var s: string := \"hello\" ++ <?> };"
+#strata
+program Laurel;
+procedure test()
+{ var s: string := "hello" ^ <?> };
+#end
 
 /-! ## Multiple holes -/
 
@@ -282,11 +297,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { var x: int := <?> + <?> };
-"
+#end
 
 -- Holes across statements: Mul arg (int) then assert condition (bool).
 /--
@@ -304,11 +321,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { var x: int := 2 * <?>; assert <?> };
-"
+#end
 
 /-! ## Combinations: holes in nested contexts -/
 
@@ -320,17 +339,20 @@ info: function $hole_0()
 procedure test()
   opaque
 {
-  if 1 + $hole_0() > 0 then {
+  if 1 + $hole_0() > 0
+  then {
     assert true
   }
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { if 1 + <?> > 0 then { assert true } };
-"
+#end
 
 -- Hole in Implies inside while invariant → bool.
 /--
@@ -348,11 +370,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { var p: bool; while(true) invariant p ==> <?> {} };
-"
+#end
 
 -- Hole in Mul inside typed local variable with real type → real.
 /--
@@ -366,11 +390,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { var r: real := 3.14 * <?> };
-"
+#end
 
 /-! ## Call argument and return type inference -/
 
@@ -386,11 +412,13 @@ procedure test(n: int)
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test(n: int)
   opaque
 { assert n > <?> };
-"
+#end
 
 /-! ## Holes in functions -/
 
@@ -400,17 +428,17 @@ info: function $hole_0(x: int)
   returns ($result: int)
   opaque;
 function test(x: int): int
-  opaque
 {
   $hole_0(x)
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 function test(x: int): int
-  opaque
 { <?> };
-"
+#end
 
 /-! ## Nondeterministic holes (<??>) -/
 
@@ -423,11 +451,13 @@ info: procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { assert <??> };
-"
+#end
 
 -- Mixed: det hole eliminated, nondet hole preserved.
 /--
@@ -442,11 +472,13 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 procedure test()
   opaque
 { var x: int := <?>; assert <??> };
-"
+#end
 
 -- Nondet hole in function → should be rejected (not tested here since
 -- the error occurs at Core translation time, which requires the full pipeline).
@@ -468,10 +500,12 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 datatype IntList { Nil(), Cons(head: int, tail: IntList) }
 procedure test() { var x: int := IntList..head(<?>) };
-"
+#end
 
 -- Hole as argument to an unsafe `!` destructor → same datatype recovery.
 /--
@@ -484,10 +518,12 @@ procedure test()
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 datatype IntList { Nil(), Cons(head: int, tail: IntList) }
 procedure test() { var x: int := IntList..head!(<?>) };
-"
+#end
 
 -- Hole as argument to a tester → typed as the parent datatype.
 /--
@@ -496,15 +532,15 @@ info: function $hole_0()
   opaque;
 procedure test()
 {
-  assert IntList..isCons($hole_0())
+  assert IntList..head($hole_0())
 };
 -/
 #guard_msgs in
-#eval! parseElimAndPrint r"
+#eval! parseElimAndPrint
+#strata
+program Laurel;
 datatype IntList { Nil(), Cons(head: int, tail: IntList) }
-procedure test() { assert IntList..isCons(<?>) };
-"
+procedure test() { assert IntList..head(<?>) };
+#end
 
 end Laurel
-end Strata
-end
diff --git a/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean b/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean
index 3dd6c0290e..dcc3135105 100644
--- a/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean
+++ b/StrataTest/Languages/Laurel/LiftImperativeCallsInAssertTest.lean
@@ -3,7 +3,6 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 Tests that the expression lifter correctly hoists imperative procedure calls
@@ -11,35 +10,23 @@ out of assert and assume conditions, while leaving assignments untouched
 (so they are rejected downstream).
 -/
 
-meta import StrataDDM.Elab
-meta import StrataDDM.BuiltinDialects.Init
-meta import Strata.Languages.Laurel.Grammar
-meta import Strata.Languages.Laurel.LaurelToCoreTranslator
-meta import Strata.Languages.Laurel.LiftImperativeExpressions
-
-meta section
+import StrataTest.Util.TestLaurel
+import Strata.Languages.Laurel.LaurelToCoreSchemaPass
+import Strata.Languages.Laurel.Resolution
 
 open Strata
-open StrataDDM (initDialect)
-open StrataDDM.Elab (parseStrataProgramFromDialect)
+open StrataTest.Util
 
 namespace Strata.Laurel
 
-private def parseLaurelAndLift (input : String) : IO Program := do
-  let inputCtx := StrataDDM.Parser.stringInputContext "test" input
-  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
-  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name inputCtx
-  let uri := Strata.Uri.file "test"
-  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
-  | .error e => throw (IO.userError s!"Translation errors: {e}")
-  | .ok program =>
-    let result := resolve program
-    let (program, model) := (result.program, result.model)
-    pure (liftExpressionAssignments model program)
-
-private def printLifted (input : String) : IO Unit := do
-  let program ← parseLaurelAndLift input
-  for proc in program.staticProcedures do
+private def parseLaurelAndLift (program : StrataDDM.Program) : IO Program := do
+  let laurelProgram ← translateLaurel program
+  let result := resolve laurelProgram
+  pure (liftExpressionAssignments result.program result.model ["impure", "multi_out"])
+
+private def printLifted (program : StrataDDM.Program) : IO Unit := do
+  let lifted ← parseLaurelAndLift program
+  for proc in lifted.staticProcedures do
     IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
 
 /-! ## Imperative calls in assert are lifted -/
@@ -53,13 +40,14 @@ info: procedure impure(): int
 };
 procedure test()
 {
-  var $c_0: int;
-  $c_0 := impure();
-  assert $c_0 == 1
+  var $cndtn_0: int := impure();
+  assert $cndtn_0 == 1
 };
 -/
 #guard_msgs in
-#eval! printLifted r"
+#eval! printLifted
+#strata
+program Laurel;
 procedure impure(): int {
   var x: int := 0;
   x := x + 1;
@@ -68,7 +56,7 @@ procedure impure(): int {
 procedure test() {
   assert impure() == 1
 };
-"
+#end
 
 /-! ## Assignments in assert are NOT lifted (rejected downstream) -/
 
@@ -76,16 +64,20 @@ procedure test() {
 info: procedure test()
 {
   var x: int := 0;
-  assert (x := 2) == 2
+  var $x_0: int := x;
+  x := 2;
+  assert x == 2
 };
 -/
 #guard_msgs in
-#eval! printLifted r"
+#eval! printLifted
+#strata
+program Laurel;
 procedure test() {
   var x: int := 0;
   assert (x := 2) == 2
 };
-"
+#end
 
 /-! ## Imperative calls in assume are lifted -/
 
@@ -98,13 +90,14 @@ info: procedure impure(): int
 };
 procedure test()
 {
-  var $c_0: int;
-  $c_0 := impure();
-  assume $c_0 == 1
+  var $cndtn_0: int := impure();
+  assume $cndtn_0 == 1
 };
 -/
 #guard_msgs in
-#eval! printLifted r"
+#eval! printLifted
+#strata
+program Laurel;
 procedure impure(): int {
   var x: int := 0;
   x := x + 1;
@@ -113,7 +106,7 @@ procedure impure(): int {
 procedure test() {
   assume impure() == 1
 };
-"
+#end
 
 /-! ## Multi-output calls in expression position produce a single (broken) target.
     This is intentional — multi-output calls should not appear in expression position.
@@ -128,13 +121,14 @@ info: procedure multi_out(x: int)
 };
 procedure test()
 {
-  var $c_0: BUG_MultiValuedExpr;
-  $c_0 := multi_out(5);
-  assert $c_0 == 6
+  var $cndtn_0: BUG_MultiValuedExpr := multi_out(5);
+  assert $cndtn_0 == 6
 };
 -/
 #guard_msgs in
-#eval! printLifted r"
+#eval! printLifted
+#strata
+program Laurel;
 procedure multi_out(x: int) returns (r: int, extra: int) {
   r := x + 1;
   extra := x + 2
@@ -142,8 +136,6 @@ procedure multi_out(x: int) returns (r: int, extra: int) {
 procedure test() {
   assert multi_out(5) == 6
 };
-"
+#end
 
 end Laurel
-end Strata
-end
diff --git a/StrataTest/Languages/Laurel/MapStmtExprTest.lean b/StrataTest/Languages/Laurel/MapStmtExprTest.lean
index 25f778c5ea..eee5f05fa0 100644
--- a/StrataTest/Languages/Laurel/MapStmtExprTest.lean
+++ b/StrataTest/Languages/Laurel/MapStmtExprTest.lean
@@ -3,37 +3,24 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 Tests for the generic `mapStmtExprM` traversal. Verifies that `mapStmtExpr id`
 is the identity: applying it to a parsed program produces identical output.
 -/
 
-meta import StrataDDM.Elab
-meta import StrataDDM.BuiltinDialects.Init
-meta import Strata.Languages.Laurel.Grammar.LaurelGrammar
-meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
-meta import Strata.Languages.Laurel.Grammar.AbstractToConcreteTreeTranslator
-meta import Strata.Languages.Laurel.MapStmtExpr
-meta import Strata.Languages.Laurel.Resolution
-
-meta section
+import StrataTest.Util.TestLaurel
+import Strata.Languages.Laurel.MapStmtExpr
+import Strata.Languages.Laurel.Resolution
 
 open Strata
-open StrataDDM (initDialect)
-open StrataDDM.Elab (parseStrataProgramFromDialect)
+open StrataTest.Util
 
 namespace Strata.Laurel
 
-private def parseLaurel (input : String) : IO Program := do
-  let inputCtx := StrataDDM.Parser.stringInputContext "test" input
-  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
-  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name inputCtx
-  let uri := Strata.Uri.file "test"
-  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
-  | .error e => throw (IO.userError s!"Translation errors: {e}")
-  | .ok program => pure (resolve program).program
+private def parseAndResolve (program : StrataDDM.Program) : IO Program := do
+  let laurelProgram ← translateLaurel program
+  pure (resolve laurelProgram).program
 
 private def printProcs (program : Program) : IO String := do
   let mut out := ""
@@ -44,10 +31,10 @@ private def printProcs (program : Program) : IO String := do
 
 /-- Verify `mapStmtExpr id` is the identity by comparing printed output before
     and after the transformation. -/
-private def testMapStmtExprId (input : String) : IO Unit := do
-  let program ← parseLaurel input
-  let mapped := mapProgram (mapStmtExpr id) program
-  let before ← printProcs program
+private def testMapStmtExprId (program : StrataDDM.Program) : IO Unit := do
+  let parsed ← parseAndResolve program
+  let mapped := mapProgram (mapStmtExpr id) parsed
+  let before ← printProcs parsed
   let after ← printProcs mapped
   if before == after then
     IO.println "ok: mapStmtExpr id ≡ id"
@@ -56,7 +43,14 @@ private def testMapStmtExprId (input : String) : IO Unit := do
 
 -- Exercises: IfThenElse, Block, Var Declare, While, Return, Assign,
 -- PrimitiveOp, Assert, Assume, Forall, Exists, LiteralInt, LiteralBool, Identifier.
-def testProgram : String := r"
+
+/--
+info: ok: mapStmtExpr id ≡ id
+-/
+#guard_msgs in
+#eval! testMapStmtExprId
+#strata
+program Laurel;
 procedure test(x: int, b: bool) returns (r: int)
   requires x > 0
   opaque
@@ -79,13 +73,6 @@ procedure test(x: int, b: bool) returns (r: int)
   var p: bool := exists(j: int) => j > 0;
   return y
 };
-"
-
-/--
-info: ok: mapStmtExpr id ≡ id
--/
-#guard_msgs in
-#eval! testMapStmtExprId testProgram
+#end
 
 end Strata.Laurel
-end
diff --git a/StrataTest/Languages/Laurel/ResolutionKindTests.lean b/StrataTest/Languages/Laurel/ResolutionKindTests.lean
index dfe2a1d732..99a8a9aa7f 100644
--- a/StrataTest/Languages/Laurel/ResolutionKindTests.lean
+++ b/StrataTest/Languages/Laurel/ResolutionKindTests.lean
@@ -3,117 +3,83 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 Tests that the resolution pass detects kind mismatches — e.g. using a variable
 where a type is expected, or calling a type as if it were a procedure.
 -/
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import StrataDDM.Elab
-meta import StrataDDM.BuiltinDialects.Init
-meta import Strata.Languages.Laurel.Grammar.LaurelGrammar
-meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
-meta import Strata.Languages.Laurel.Resolution
-
-meta section
+import StrataTest.Util.TestLaurel
 
 open StrataTest.Util
 open Strata
-open StrataDDM (initDialect)
-open StrataDDM.Elab (parseStrataProgramFromDialect)
-
-namespace Strata.Laurel
-
-/-- Run only parsing + resolution and return diagnostics (no SMT verification). -/
-private def processResolution (input : Lean.Parser.InputContext) : IO (Array Diagnostic) := do
-  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
-  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name input
-  let uri := Strata.Uri.file input.fileName
-  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
-  | .error e => throw (IO.userError s!"Translation errors: {e}")
-  | .ok program =>
-    let result := resolve program
-    let files := Map.insert Map.empty uri input.fileMap
-    return result.errors.toList.map (fun dm => dm.toDiagnostic files) |>.toArray
 
 /-! ## Using a variable name where a type is expected -/
 
-def varAsType := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 procedure foo() opaque {
   var x: int := 1;
   var y: x := 2
 //       ^ error: 'x' resolves to variable, but expected composite type, constrained type, datatype definition, type alias
 };
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "VarAsType" varAsType 39 processResolution
+#end
 
 /-! ## Using a procedure name where a type is expected -/
 
-def procAsType := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 procedure bar() opaque { };
 procedure foo() opaque {
   var y: bar := 1
 //       ^^^ error: 'bar' resolves to static procedure, but expected composite type, constrained type, datatype definition, type alias
 };
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "ProcAsType" procAsType 51 processResolution
+#end
 
 /-! ## Calling a composite type as a static call -/
 
-def typeAsStaticCall := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 composite Foo { }
 procedure bar() opaque {
   var x: int := Foo()
 //              ^^^^^ error: 'Foo' resolves to composite type, but expected parameter, static procedure, datatype constructor, datatype destructor, constant
 };
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "TypeAsStaticCall" typeAsStaticCall 61 processResolution
+#end
 
 /-! ## Using a procedure name with `new` -/
 
-def newWithProc := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 procedure bar() opaque { };
 procedure foo() opaque {
   var x: int := new bar
 //              ^^^^^^^ error: 'bar' resolves to static procedure, but expected composite type, datatype definition
 };
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "NewWithProc" newWithProc 77 processResolution
+#end
 
 /-! ## Extending a non-composite type (e.g. a constrained type) -/
 
-def extendConstrained := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 constrained nat = x: int where x >= 0 witness 0
 composite Foo extends nat { }
 //                    ^^^ error: 'nat' resolves to constrained type, but expected composite type
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "ExtendConstrained" extendConstrained 90 processResolution
+#end
 
 /-! ## Multi-output procedure used in expression position -/
 
-def multiOutputInExpr := r"
+#eval testLaurelResolution <|
+#strata
+program Laurel;
 procedure multi(x: int) returns (a: int, b: int) opaque;
 procedure test() opaque {
   assert multi(1) == 1
-//       ^^^^^^^^ error: Multi-output procedure 'multi' used in expression position
+//       ^^^^^^^^ error: multi-output call cannot be used as a value here
 };
-"
-
-#guard_msgs (error, drop all) in
-#eval testInputWithOffset "MultiOutputInExpr" multiOutputInExpr 100 processResolution
-
-end Laurel
-end Strata
-end
+#end
diff --git a/StrataTest/Languages/Laurel/ResolutionTypeCheckTests.lean b/StrataTest/Languages/Laurel/ResolutionTypeCheckTests.lean
new file mode 100644
index 0000000000..e3888db451
--- /dev/null
+++ b/StrataTest/Languages/Laurel/ResolutionTypeCheckTests.lean
@@ -0,0 +1,391 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+/-
+Tests that the resolution pass detects type checking errors — e.g. using an int
+where a bool is expected, or passing the wrong type to a procedure.
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-! ## Non-boolean conditions -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+
+procedure voidReturn(x: int)
+  returns (r: int)
+{
+  r := 1;
+  return
+};
+#end
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function foo(x: int): int {
+  if x then 1 else 0
+//   ^ error: expected 'bool', got 'int'
+};
+#end
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure baz() opaque {
+  var x: int := 42;
+  assert x
+//       ^ error: expected 'bool', got 'int'
+};
+#end
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure qux() opaque {
+  var x: int := 42;
+  assume x
+//       ^ error: expected 'bool', got 'int'
+};
+#end
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure wh() opaque {
+  var x: int := 1;
+  while (x) { }
+//       ^ error: expected 'bool', got 'int'
+};
+#end
+
+/-! ## Logical operator type checks -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function foo(x: int, y: bool): bool {
+  x && y
+//^ error: expected 'bool', got 'int'
+};
+#end
+
+/-! ## Numeric operator type checks -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function cmp(x: string, y: int): bool {
+  x < y
+//^ error: '<' expected a numeric type, got 'string'
+};
+#end
+
+/-! ## Assignment type checks -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure invalidAssignment() opaque {
+  var x: int := true
+//              ^^^^ error: expected 'int', got 'bool'
+};
+#end
+
+/-! ## Procedure return type checks -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure foo(): int {
+  return true
+//       ^^^^ error: expected 'int', got 'bool'
+};
+#end
+
+/-! ## Call argument type checks -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function bar(x: int): int { x };
+function foo(): int {
+  bar(true)
+//    ^^^^ error: expected 'int', got 'bool'
+};
+#end
+
+/-! ## Equality operator type checks -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function cmp(x: int, y: string): bool {
+  x == y
+//^^^^^^ error: cannot compare 'int' with 'string' using '=='
+};
+#end
+
+/-! ## Multi-output procedures -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure multi(x: int) returns (a: int, b: int) opaque;
+procedure test() opaque {
+  assert multi(1) == 1
+//       ^^^^^^^^ error: multi-output call cannot be used as a value here
+};
+#end
+
+/-! A multi-output call in operator-operand (value) position is rejected with a
+position-oriented diagnostic, even when both operands have the *same*
+`MultiValuedExpr` shape (so `isConsistent` would otherwise accept them). Without
+this guard `multi(1) == multi(2)` passes resolution and crashes a later pass as
+a `StrataBug`, since `MultiValuedExpr` has no Core lowering. The guard fires per
+offending operand (here both), short-circuiting the per-family equality check. -/
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure multi(x: int) returns (a: int, b: int) opaque;
+procedure test() opaque {
+  assert multi(1) == multi(2)
+//       ^^^^^^^^ error: multi-output call cannot be used as a value here
+//                   ^^^^^^^^ error: multi-output call cannot be used as a value here
+};
+#end
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure multi() returns (a: int, b: int) opaque;
+procedure test() opaque {
+  var x: int := multi()
+//              ^^^^^^^ error: expected 'int', got '(int, int)'
+};
+#end
+
+/-! ## UserDefined cross-type assignment
+
+Assignments between unrelated composites are rejected: `isSubtype` walks
+`extending` chains, so two composites with no common ancestor are not
+subtypes of each other. -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+composite Dog { }
+composite Cat { }
+procedure test() opaque {
+  var x: Dog := new Cat
+//              ^^^^^^^ error: expected 'Dog', got 'Cat'
+};
+#end
+
+/-! ## Field type is read from the field, not a shadowing local
+
+A field reference (`c#flag`) carries the field's `uniqueId`, but its bare
+name can collide with a same-named local. `getVarType` must read the field's
+declared type (`bool`) — not the shadowing local's type (`int`) — so the
+assignment of an `int` to a `bool` field is still rejected. (Regression guard
+for the scope-first lookup that previously returned the local's type and
+silently dropped the mismatch.) -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+composite C {
+  var flag: bool
+}
+procedure test() opaque {
+  var c: C := new C;
+  var flag: int := 0;
+  c#flag := flag
+//          ^^^^ error: expected 'bool', got 'int'
+};
+#end
+
+/-! ## `if`/`block` in synth-only operand position
+
+An `if`/`then`/`else` (or non-empty block) used where operands are
+synthesized — e.g. as an operand of `==`/`<`/`++` — now has a synth rule
+(`Synth.ifThenElse` / `Synth.block`). Previously it hit the synth wildcard
+and emitted a spurious "type cannot be synthesized" error. With both
+branches consistent, the `if` synthesizes the branch type and resolves
+cleanly (no diagnostics). -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function foo(c: bool): bool {
+  (if c then 1 else 2) == 3
+};
+#end
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function foo(): bool {
+  { 1 } == 1
+};
+#end
+
+/-! ## `if` with incompatible branch types (synth position)
+
+When an `if` is synthesized and its two branches have mutually
+inconsistent types, `Synth.ifThenElse` reports the mismatch at the `if`
+and synthesizes `Unknown` to suppress cascading errors. -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function foo(c: bool): bool {
+  (if c then 1 else true) == 3
+// ^^^^^^^^^^^^^^^^^^^^^ error: 'if' branches have incompatible types 'int' and 'bool'
+};
+#end
+
+/-! ## `if` in operand position synthesizes a *symmetric* branch join
+
+`Synth.ifThenElse` returns the symmetric join of the two consistent branch
+types as the representative type (`(join ctx thenTy elseTy).getD thenTy`),
+not just the then-branch type. So a hole branch (`<?>`, type `Unknown`)
+promotes to the other branch's concrete type regardless of branch order:
+both `(if c then <?> else "x")` and `(if c then "x" else <?>)` synthesize
+`string`. As the operand of a numeric `<`, both orders therefore report the
+*same* "expected a numeric type, got 'string'" diagnostic at the *same*
+span — locking in symmetry. (Before the join, the then-first order returned
+`Unknown` and was silently accepted, while only the else-first order
+errored.) -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function foo(c: bool): bool {
+  (if c then <?> else "x") < 1
+// ^^^^^^^^^^^^^^^^^^^^^^ error: '<' expected a numeric type, got 'string'
+};
+#end
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function foo(c: bool): bool {
+  (if c then "x" else <?>) < 1
+// ^^^^^^^^^^^^^^^^^^^^^^ error: '<' expected a numeric type, got 'string'
+};
+#end
+
+/-! ## `if` branch join recovers precision from a hole
+
+When one branch is a hole (`Unknown`) and the other is a concrete numeric
+type, the join recovers the concrete type (`Unknown ⊔ int = int`) rather
+than collapsing to `Unknown`. So `if c then <?> else 5` synthesizes a usable
+`int` and resolves cleanly where an `int` is expected — no diagnostics. -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function bar(c: bool): int {
+  if c then <?> else 5
+};
+#end
+
+/-! ## Void procedure call in value position
+
+A call to a `void` procedure (no `returns` clause) used where a value is
+expected now synthesizes `TVoid` rather than the internal-only empty
+`MultiValuedExpr []`. The diagnostic therefore reports the type as `'void'`
+instead of the placeholder `'()'` that an empty tuple rendered as. (Regression
+guard for `getCallInfo` mapping an empty output list to `TVoid`.) -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure act() opaque;
+procedure test() opaque {
+  assert act() == 1
+//       ^^^^^^^^^^ error: cannot compare 'void' with 'int' using '=='
+};
+#end
+
+/-! ## Bitvectors are numeric
+
+Bitvector operands (`bv n`) participate in arithmetic and comparison
+operators just like the other numeric primitives. `isNumeric` therefore
+accepts `TBv`, so a comparison of two bitvector parameters resolves
+cleanly with no diagnostics. (Regression guard for `isNumeric` previously
+rejecting `TBv` and emitting a spurious "expected a numeric type" error.) -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function cmp(x: bv 32, y: bv 32): bool {
+  x < y
+};
+#end
+
+/-! ## Over-arity calls are rejected
+
+A call that supplies more arguments than the callee declares is rejected with
+an arity diagnostic. The check fires only when the callee genuinely resolves to
+a procedure with a known parameter count (`procArity`). Under-arity (too few
+arguments) is deliberately not flagged. -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function foo(x: int): int { x };
+function bar(): int {
+  foo(1, 2)
+//^^^^^^^^^ error: call to 'foo' expects 1 argument(s) but 2 were provided
+};
+#end
+
+/-! ## A too-many-args call to an *unresolved* name does not double-report
+
+Calling a name that does not resolve to any definition with surplus arguments
+reports only the name-resolution error — not a spurious arity error on top.
+`procArity` returns `none` for an unresolved name (its empty `paramTypes` is an
+artifact of the name not being found, not a zero-arity procedure), so the
+over-arity check is skipped. (Regression guard for the no-duplicate-diagnostic
+behavior.) -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+function bar(): int {
+  nope(1, 2)
+//^^^^^^^^^^ error: 'nope' is not defined
+};
+#end
+
+/-! ## An unresolved declared type collapses to `Unknown` (no cascade)
+
+A variable declared with an undefined type name reports only the single
+"is not defined" name-resolution error. `resolveHighType` collapses the
+dangling `UserDefined` to `Unknown` once its name fails to resolve, so the
+variable's later uses are not type-checked against a phantom type and no
+cascade of follow-on mismatches (`0` vs the bad type, `x` vs `int`) is emitted.
+(Regression guard: before the collapse-to-`Unknown` fix this program produced
+three diagnostics — the name-resolution error plus the `0`-vs-`UndefinedType`
+initializer mismatch and the `x`-vs-`int` use mismatch; it must now produce
+exactly one.) -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure useUndef() opaque {
+  var x: UndefinedType := 0;
+//       ^^^^^^^^^^^^^ error: 'UndefinedType' is not defined
+  var y: int := x + 2
+};
+#end
diff --git a/StrataTest/Languages/Laurel/StatisticsTest.lean b/StrataTest/Languages/Laurel/StatisticsTest.lean
index 00e17c296c..9de09f3342 100644
--- a/StrataTest/Languages/Laurel/StatisticsTest.lean
+++ b/StrataTest/Languages/Laurel/StatisticsTest.lean
@@ -3,7 +3,6 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
 /-
 Tests that the Laurel compilation pipeline produces the expected statistics
@@ -11,47 +10,34 @@ counters. Uses `translateWithLaurel` which returns `Statistics` as the fourth
 tuple element.
 -/
 
-meta import StrataDDM.Elab
-meta import StrataDDM.BuiltinDialects.Init
-meta import Strata.Languages.Laurel.Grammar.LaurelGrammar
-meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
-meta import Strata.Languages.Laurel.LaurelCompilationPipeline
-meta import Strata.Util.Statistics
-
-meta section
+import StrataTest.Util.TestLaurel
+import Strata.Languages.Laurel.LaurelCompilationPipeline
+import Strata.Util.Statistics
 
 open Strata
-open StrataDDM (initDialect)
-open StrataDDM.Elab (parseStrataProgramFromDialect)
+open StrataTest.Util
 
 namespace Strata.Laurel
 
-/-- Parse a Laurel source string and run it through the full Laurel pipeline,
-    returning the merged statistics from all passes. -/
-private def parseLaurelAndGetStats (input : String) : IO Statistics := do
-  let inputCtx := StrataDDM.Parser.stringInputContext "test" input
-  let dialects := StrataDDM.Elab.LoadedDialects.ofDialects! #[initDialect, Laurel]
-  let strataProgram ← parseStrataProgramFromDialect dialects Laurel.name inputCtx
-  let uri := Strata.Uri.file "test"
-  match Laurel.TransM.run uri (Laurel.parseProgram strataProgram) with
-  | .error e => throw (IO.userError s!"Translation errors: {e}")
-  | .ok program =>
-    let (_, _, _, stats) ← translateWithLaurel {} program
-    return stats
+/-- Translate the program through the full Laurel pipeline and print stats. -/
+private def printStats (program : StrataDDM.Program) : IO Unit := do
+  let laurelProgram ← translateLaurel program
+  let (_, _, _, stats) ← translateWithLaurel {} laurelProgram
+  IO.print stats.format
 
 /-! ## Laurel Statistics: simple procedure -/
 
 #guard_msgs in
-#eval! do
-  let stats ← parseLaurelAndGetStats r"
+#eval! printStats
+#strata
+program Laurel;
 procedure test(x: int) returns (y: int)
   opaque
   ensures y == x
 {
   y := x
 };
-"
-  IO.print stats.format
+#end
 
 /-! ## Laurel Statistics: two procedures with holes -/
 
@@ -60,8 +46,9 @@ info: [statistics] EliminateHoles.holesEliminated: 1
 [statistics] InferHoleTypes.holesAnnotated: 1
 -/
 #guard_msgs in
-#eval! do
-  let stats ← parseLaurelAndGetStats r"
+#eval! printStats
+#strata
+program Laurel;
 procedure p1(a: bool, b: bool) returns (r: bool)
   opaque
   ensures r == (a && b)
@@ -74,9 +61,6 @@ procedure p2(x: int) returns (y: int)
 {
   y := x + <?>
 };
-"
-  IO.print stats.format
+#end
 
 end Laurel
-end Strata
-end
diff --git a/StrataTest/Languages/Laurel/StrataExpectSmokeTest.lean b/StrataTest/Languages/Laurel/StrataExpectSmokeTest.lean
new file mode 100644
index 0000000000..ea6ba94d08
--- /dev/null
+++ b/StrataTest/Languages/Laurel/StrataExpectSmokeTest.lean
@@ -0,0 +1,49 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+/-
+Smoke test for the `#strata` test ergonomics. See `StrataTest.Util.TestLaurel`
+for the helpers.
+-/
+
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+open Strata
+
+/-! ## Positive smoke test -/
+
+#eval testLaurel
+#strata
+program Laurel;
+procedure foo() opaque { assert true };
+#end
+
+/-! ## Negative smoke test: variable used as type. The inline annotation pins
+    the expected diagnostic to the line above it. -/
+
+#eval testLaurelResolution <|
+#strata
+program Laurel;
+procedure foo() opaque {
+  var x: int := 1;
+  var y: x := 2
+//       ^ error: 'x' resolves to variable, but expected
+};
+#end
+
+/-! ## Negative smoke test: a verifier-level diagnostic. -/
+
+#eval testLaurel <|
+#strata
+program Laurel;
+procedure unsafeDivision(x: int)
+  opaque
+{
+  var z: int := 10 / x
+//^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
+};
+#end
diff --git a/StrataTest/Languages/Laurel/run_laurel_cbmc_tests.sh b/StrataTest/Languages/Laurel/run_laurel_cbmc_tests.sh
index fd700d2a43..8ca1b74b17 100755
--- a/StrataTest/Languages/Laurel/run_laurel_cbmc_tests.sh
+++ b/StrataTest/Languages/Laurel/run_laurel_cbmc_tests.sh
@@ -8,12 +8,15 @@
 # appears in CBMC output with the correct status.
 #
 # Environment variables:
-#   CBMC   - path to cbmc binary (default: cbmc)
+#   CBMC              - path to cbmc binary (default: cbmc)
+#   GOTO_CC           - path to goto-cc binary (default: goto-cc)
+#   GOTO_INSTRUMENT   - path to goto-instrument binary (default: goto-instrument)
 
 set -o pipefail
 
 SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)"
 TESTS_DIR="$SCRIPT_DIR/tests"
+PROJECT_ROOT="$(cd "$SCRIPT_DIR/../../.." && pwd)"
 EXPECTED="$TESTS_DIR/cbmc_expected.txt"
 
 passed=0
@@ -40,7 +43,7 @@ for lr_file in "$TESTS_DIR"/*.lr.st; do
   fi
 
   # Run the pipeline
-  output=$("$SCRIPT_DIR/laurel_to_cbmc.sh" "$lr_file" 2>&1)
+  output=$(lake -d "$PROJECT_ROOT" env lean --run "$PROJECT_ROOT/Scripts/LaurelToCBMC.lean" "$lr_file" 2>&1)
   if [ $? -ne 0 ] && ! echo "$output" | grep -q "VERIFICATION"; then
     echo "ERR:  $bn (pipeline error)"
     echo "$output" | tail -3
diff --git a/StrataTest/Languages/Laurel/tests/test_strings.lr.st b/StrataTest/Languages/Laurel/tests/test_strings.lr.st
index f9a84a5b3e..ef32c90803 100644
--- a/StrataTest/Languages/Laurel/tests/test_strings.lr.st
+++ b/StrataTest/Languages/Laurel/tests/test_strings.lr.st
@@ -3,7 +3,7 @@ procedure main()
 {
     var s1: string := "hello";
     var s2: string := " world";
-    var result: string := s1 ++ s2;
+    var result: string := s1 ^ s2;
     assert result == "hello world";
 
     var a: string := "abc";
diff --git a/StrataTest/README.md b/StrataTest/README.md
new file mode 100644
index 0000000000..4272da0fca
--- /dev/null
+++ b/StrataTest/README.md
@@ -0,0 +1,12 @@
+# StrataTest
+
+This directory contains compile-time tests (`#guard_msgs`) for Strata's
+dialects, transforms, and DDM machinery. Tests run as part of `lake build`;
+no output means they passed.
+
+For how to write a new test — including `#strata` blocks and the Laurel
+test helpers — see [`docs/Testing.md`](../docs/Testing.md).
+
+For the runtime test driver (uncached extra tests under `StrataTestExtra/`),
+see the "Running specific test subsets" section of the top-level
+[`README.md`](../README.md).
diff --git a/StrataTest/Transform/CallElim.lean b/StrataTest/Transform/CallElim.lean
index ae3b944d05..31b5cc5ea0 100644
--- a/StrataTest/Transform/CallElim.lean
+++ b/StrataTest/Transform/CallElim.lean
@@ -189,7 +189,7 @@ procedure h(inout j : bool, k : bool) {
 };
 #end
 
-def translate (t : StrataDDM.Program) : Core.Program := (TransM.run Inhabited.default (translateProgram t)).fst
+def translate (t : StrataDDM.SourcedProgram) : Core.Program := (TransM.run Inhabited.default (translateProgram t)).fst
 
 def env : Lambda.LContext CoreLParams := .default (functions := Core.Factory)
 
diff --git a/StrataTest/Transform/DetToKleene.lean b/StrataTest/Transform/DetToKleene.lean
index 895c96ea3c..20fd13ff6d 100644
--- a/StrataTest/Transform/DetToKleene.lean
+++ b/StrataTest/Transform/DetToKleene.lean
@@ -25,8 +25,8 @@ def KleeneTest1 : Stmt Expression (Cmd Expression) :=
 
 def KleeneTest1Ans : Option (KleeneStmt Expression (Cmd Expression)) :=
   .some (.choice
-    (.seq (.cmd (.assume "true_cond" Core.true .empty)) (.seq (.cmd $ .set "x" .nondet .empty) (.assert "$__skip" Imperative.HasBool.tt .empty)))
-    (.seq (.cmd (.assume "false_cond" Core.false .empty)) (.seq (.cmd $ .set "y" .nondet .empty) (.assert "$__skip" Imperative.HasBool.tt .empty))))
+    (.block (.seq (.cmd (.assume "true_cond" Core.true .empty)) (.seq (.cmd $ .set "x" .nondet .empty) (.assert "$__skip" Imperative.HasBool.tt .empty))))
+    (.block (.seq (.cmd (.assume "false_cond" Core.false .empty)) (.seq (.cmd $ .set "y" .nondet .empty) (.assert "$__skip" Imperative.HasBool.tt .empty)))))
 
 -- #eval toString $ Std.format (StmtToKleeneStmt KleeneTest1)
 -- #eval toString $ Std.format KleeneTest1Ans
diff --git a/StrataTest/Transform/ProcedureInlining.lean b/StrataTest/Transform/ProcedureInlining.lean
index bde1031e52..ace24853b7 100644
--- a/StrataTest/Transform/ProcedureInlining.lean
+++ b/StrataTest/Transform/ProcedureInlining.lean
@@ -215,18 +215,19 @@ def alphaEquivStatement (s1 s2: Core.Statement) (map:IdMap)
 end
 
 private def alphaEquiv (p1 p2:Core.Procedure):Except Format Bool := do
-  if p1.body.length ≠ p2.body.length then
-    .error (s!"# statements do not match: in {p1.header.name}, "
-        ++ s!"inlined fn one has {p1.body.length}"
-        ++ s!" whereas the answer has {p2.body.length}")
-  else
-    let newmap:IdMap := IdMap.mk ([], []) []
-    let stmts := (p1.body.zip p2.body)
-    let m ← List.foldlM (fun (map:IdMap) (s1,s2) =>
-        alphaEquivStatement s1 s2 map)
-      newmap stmts
-    -- The corresponding outputs should be pairwise α-equivalent
-    return ((p1.header.outputs.zip p2.header.outputs).map (fun ((x, _), (y, _)) => alphaEquivIdents x y m)).all id
+  match p1.body, p2.body with
+  | .structured ss1, .structured ss2 =>
+    if ss1.length ≠ ss2.length then
+      .error (s!"# statements do not match: in {p1.header.name}, "
+          ++ s!"inlined fn one has {ss1.length}"
+          ++ s!" whereas the answer has {ss2.length}")
+    else
+      let newmap:IdMap := IdMap.mk ([], []) []
+      let m ← List.foldlM (fun (map:IdMap) (s1,s2) =>
+          alphaEquivStatement s1 s2 map)
+        newmap (ss1.zip ss2)
+      return ((p1.header.outputs.zip p2.header.outputs).map (fun ((x, _), (y, _)) => alphaEquivIdents x y m)).all id
+  | _, _ => .error f!"alphaEquiv: CFG procedure bodies are not supported in the inlining test harness"
 
 
 
diff --git a/StrataTest/Languages/Laurel/TestExamples.lean b/StrataTest/Util/LaurelDebugPipeline.lean
similarity index 76%
rename from StrataTest/Languages/Laurel/TestExamples.lean
rename to StrataTest/Util/LaurelDebugPipeline.lean
index 89dc21f539..d49c99cf6a 100644
--- a/StrataTest/Languages/Laurel/TestExamples.lean
+++ b/StrataTest/Util/LaurelDebugPipeline.lean
@@ -3,17 +3,22 @@
 
   SPDX-License-Identifier: Apache-2.0 OR MIT
 -/
-module
 
-meta import all StrataTest.Util.TestDiagnostics
-meta import StrataDDM.Elab
-meta import StrataDDM.BuiltinDialects.Init
-meta import StrataDDM.Util.IO
-meta import Strata.Languages.Laurel.Grammar.LaurelGrammar
-meta import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
-meta import Strata.Languages.Laurel.LaurelCompilationPipeline
+/-
+Debug-only helpers for running the Laurel compilation pipeline manually
+(e.g. via `#eval`) when diagnosing pass-internal issues.
+
+Not used by any test in this repo. The regular test framework lives in
+`StrataTest.Util.TestLaurel`; see `docs/Testing.md`.
+-/
 
-meta section
+import StrataTest.Util.TestDiagnostics
+import StrataDDM.Elab
+import StrataDDM.BuiltinDialects.Init
+import StrataDDM.Util.IO
+import Strata.Languages.Laurel.Grammar.LaurelGrammar
+import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
+import Strata.Languages.Laurel.LaurelCompilationPipeline
 
 open StrataTest.Util
 open Strata
@@ -54,5 +59,3 @@ def processLaurelFileKeepIntermediates (input : InputContext) : IO (Array Diagno
   processLaurelFileWithOptions { translateOptions := { keepAllFilesPrefix := dir}} input
 
 end Laurel
-end Strata
-end
diff --git a/StrataTest/Util/TestDiagnostics.lean b/StrataTest/Util/TestDiagnostics.lean
index 3d672f56ad..5fccdf1500 100644
--- a/StrataTest/Util/TestDiagnostics.lean
+++ b/StrataTest/Util/TestDiagnostics.lean
@@ -82,16 +82,23 @@ public def parseDiagnosticExpectations (content : String) : List DiagnosticExpec
 def stringContains (haystack : String) (needle : String) : Bool :=
   needle.isEmpty || (haystack.splitOn needle).length > 1
 
+/-- Map a `DiagnosticType` to the level keyword used in expectation comments. -/
+private def diagnosticLevel (t : DiagnosticType) : String :=
+  match t with
+  | .Warning => "warning"
+  | _ => "error"
+
 /-- Check if a Diagnostic matches a DiagnosticExpectation -/
 public def matchesDiagnostic (diag : Diagnostic) (exp : DiagnosticExpectation) : Bool :=
   diag.start.line == exp.line &&
   diag.start.column == exp.colStart &&
   diag.ending.line == exp.line &&
   diag.ending.column == exp.colEnd &&
+  diagnosticLevel diag.type == exp.level &&
   stringContains diag.message exp.message
 
 /-- Test input with line offset - adds imaginary newlines to the start of the input -/
-def testInputWithOffset (filename: String) (input : String) (lineOffset : Nat)
+public def testInputWithOffset (filename: String) (input : String) (lineOffset : Nat)
     (process : Lean.Parser.InputContext -> IO (Array Diagnostic)) : IO Unit := do
 
   -- Add imaginary newlines to the start of the input so the reported line numbers match the Lean source file
@@ -100,16 +107,16 @@ def testInputWithOffset (filename: String) (input : String) (lineOffset : Nat)
 
   -- Parse diagnostic expectations from comments
   let expectations := parseDiagnosticExpectations offsetInput
-  let expectedErrors := expectations.filter (fun e => e.level == "error")
+  let expected := expectations.filter (fun e => e.level == "error" || e.level == "warning")
 
   -- Get actual diagnostics from the language-specific processor
   let diagnostics <- process inputContext
 
-  -- Check if all expected errors are matched
+  -- Check if all expected diagnostics are matched
   let mut allMatched := true
   let mut unmatchedExpectations := []
 
-  for exp in expectedErrors do
+  for exp in expected do
     let matched := diagnostics.any (fun diag => matchesDiagnostic diag exp)
     if !matched then
       allMatched := false
@@ -117,29 +124,29 @@ def testInputWithOffset (filename: String) (input : String) (lineOffset : Nat)
 
   let mut unmatchedDiagnostics := []
   for diag in diagnostics do
-    let matched := expectedErrors.any (fun exp => matchesDiagnostic diag exp)
+    let matched := expected.any (fun exp => matchesDiagnostic diag exp)
     if !matched then
       allMatched := false
       unmatchedDiagnostics := unmatchedDiagnostics.append [diag]
 
   -- Report results
-  if allMatched && diagnostics.size == expectedErrors.length then
-    IO.println s!"✓ Test passed: All {expectedErrors.length} error(s) matched"
-    for exp in expectedErrors do
-      IO.println s!"  - Line {exp.line}, Col {exp.colStart}-{exp.colEnd}: {exp.message}"
+  if allMatched && diagnostics.size == expected.length then
+    IO.println s!"✓ Test passed: All {expected.length} diagnostic(s) matched"
+    for exp in expected do
+      IO.println s!"  - Line {exp.line}, Col {exp.colStart}-{exp.colEnd} [{exp.level}]: {exp.message}"
   else
     IO.println s!"✗ Test failed: Mismatched diagnostics"
-    IO.println s!"\nExpected {expectedErrors.length} error(s), got {diagnostics.size} diagnostic(s)"
+    IO.println s!"\nExpected {expected.length} diagnostic(s), got {diagnostics.size} diagnostic(s)"
 
     if unmatchedExpectations.length > 0 then
       IO.println s!"\nUnmatched expected diagnostics:"
       for exp in unmatchedExpectations do
-        IO.println s!"  - Line {exp.line}, Col {exp.colStart}-{exp.colEnd}: {exp.message}"
+        IO.println s!"  - Line {exp.line}, Col {exp.colStart}-{exp.colEnd} [{exp.level}]: {exp.message}"
 
     if unmatchedDiagnostics.length > 0 then
       IO.println s!"\nUnexpected diagnostics:"
       for diag in unmatchedDiagnostics do
-        IO.println s!"  - Line {diag.start.line}, Col {diag.start.column}-{diag.ending.column}: {diag.message}"
+        IO.println s!"  - Line {diag.start.line}, Col {diag.start.column}-{diag.ending.column} [{diagnosticLevel diag.type}]: {diag.message}"
 
     if unmatchedExpectations.length == 0 && unmatchedDiagnostics.length == 0 then
       IO.println s!"Duplicate diagnostics: {repr diagnostics}"
diff --git a/StrataTest/Util/TestLaurel.lean b/StrataTest/Util/TestLaurel.lean
new file mode 100644
index 0000000000..718a38bbaa
--- /dev/null
+++ b/StrataTest/Util/TestLaurel.lean
@@ -0,0 +1,372 @@
+/-
+  Copyright Strata Contributors
+
+  SPDX-License-Identifier: Apache-2.0 OR MIT
+-/
+
+import StrataDDM.Integration.Lean.HashCommands
+import StrataDDM.Elab
+import StrataDDM.BuiltinDialects.Init
+import Strata.Languages.Laurel.Grammar.LaurelGrammar
+import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
+import Strata.Languages.Laurel.Resolution
+import Strata.Languages.Laurel.LaurelCompilationPipeline
+import Strata.Languages.Laurel
+
+open Strata
+open Strata.Laurel
+open StrataDDM (SourcedProgram)
+
+namespace StrataTest.Util
+
+/-- Translate a `StrataDDM.Program` (typically produced by `#strata`) to a Laurel
+    `Program`. Used by tests that need to plug in a custom post-translation
+    pipeline stage; throws if translation fails. -/
+def translateLaurel (program : StrataDDM.Program) : IO Laurel.Program := do
+  match Laurel.TransM.run (Strata.Uri.file "<#strata>") (Laurel.parseProgram program) with
+  | .error e => throw (IO.userError s!"Translation errors: {e}")
+  | .ok laurelProgram => pure laurelProgram
+
+/-- Convert pipeline `DiagnosticModel`s (carrying file-global byte offsets in
+    their `FileRange`) into `Diagnostic`s with snippet-local line/col, by
+    subtracting `basePos` and looking up in a snippet `FileMap`. -/
+private def renderSnippetLocal (basePos : Nat) (snippet : String)
+    (dms : Array Strata.DiagnosticModel) : Array Strata.Diagnostic :=
+  let fileMap := Lean.FileMap.ofString snippet
+  dms.map fun dm =>
+    let startB := dm.fileRange.range.start.byteIdx
+    let stopB  := dm.fileRange.range.stop.byteIdx
+    let startB' : Nat := if startB ≥ basePos then startB - basePos else 0
+    let stopB'  : Nat := if stopB  ≥ basePos then stopB  - basePos else 0
+    let startPos := fileMap.toPosition ⟨startB'⟩
+    let endPos   := fileMap.toPosition ⟨stopB'⟩
+    { start := { line := startPos.line, column := startPos.column }
+      ending := { line := endPos.line, column := endPos.column }
+      message := dm.message
+      type := dm.type }
+
+/-- Default options used by `testLaurel` when the caller doesn't override:
+    quiet verifier, default solver. Override by passing
+    `(options := …)` to `testLaurel`. -/
+def defaultLaurelTestOptions : LaurelVerifyOptions :=
+  { verifyOptions := .quiet }
+
+/-- Run translate + resolve only on a parsed program. Skips SMT verification.
+    Returns diagnostics as `DiagnosticModel`s so the caller can choose how to
+    render them (snippet-local for inline annotations, file-global for editor
+    navigation). -/
+private def runLaurelResolutionRaw (program : StrataDDM.Program) :
+    IO (Array Strata.DiagnosticModel) := do
+  let uri := Strata.Uri.file "<#strata>"
+  match Laurel.TransM.run uri (Laurel.parseProgram program) with
+  | .error e =>
+    return #[Strata.DiagnosticModel.fromMessage s!"Translation error: {e}"]
+  | .ok laurelProgram =>
+    let result := Laurel.resolve laurelProgram
+    return result.errors
+
+/-- Run the full Laurel pipeline (translate + resolve + verify).
+    Returns diagnostics as `DiagnosticModel`s. -/
+private def runLaurelPipelineRaw (program : StrataDDM.Program)
+    (options : LaurelVerifyOptions) : IO (Array Strata.DiagnosticModel) := do
+  let uri := Strata.Uri.file "<#strata>"
+  match Laurel.TransM.run uri (Laurel.parseProgram program) with
+  | .error e =>
+    return #[Strata.DiagnosticModel.fromMessage s!"Translation error: {e}"]
+  | .ok laurelProgram =>
+    -- Use the *capturing* entry point: a verify-phase type/symbolic error comes
+    -- back as a structured `DiagnosticModel` (rather than thrown like the CLI),
+    -- so it flows through the same snippet-local `line:col` rendering as every
+    -- other diagnostic instead of leaking a raw byte offset in its message.
+    Laurel.verifyToDiagnosticModelsCapturing laurelProgram options
+
+/-! ## Inline-annotation matcher
+
+Negative tests embed `// ^^^^^^ <kind>: <message>` annotations directly in the
+source of a `#strata` block. Each annotation pins one expected diagnostic to
+the line above it. Example:
+
+```
+#strata
+program Laurel;
+procedure foo() opaque {
+  var x: int := 1;
+  var y: x := 2
+//       ^ error: 'x' resolves to variable, but expected ...
+};
+#end
+```
+
+The `testLaurel` / `testLaurelResolution` helpers parse these
+annotations from the snippet, run the pipeline, and assert exact match
+between actual diagnostics and annotations: every diagnostic must have an
+annotation, every annotation must fire, positions must match exactly,
+and the actual message must contain the annotation text as a substring.
+-/
+
+/-- One expected diagnostic parsed from a `// ^^^ <kind>: <message>` comment. -/
+private structure DiagnosticAnnotation where
+  /-- 1-indexed line within the snippet that the diagnostic applies to. -/
+  line : Nat
+  /-- 0-indexed column of first caret. -/
+  colStart : Nat
+  /-- 0-indexed column past the last caret. -/
+  colEnd : Nat
+  /-- Diagnostic kind: "error", "warning", "not-yet-implemented", "strata-bug". -/
+  kind : String
+  /-- Substring expected to appear in the diagnostic message. -/
+  message : String
+
+/-- Render the `kind` of a `Diagnostic` to the string used in annotations. -/
+private def diagnosticKindString (t : Strata.DiagnosticType) : String :=
+  match t with
+  | .Warning => "warning"
+  | .UserError => "error"
+  | .NotYetImplemented => "not-yet-implemented"
+  | .StrataBug => "strata-bug"
+
+/-! ## Unified reporting normal form
+
+Actual diagnostics (`Strata.Diagnostic`) and expected annotations
+(`DiagnosticAnnotation`) are two views of the *same* thing — a kinded message
+pinned to a `line:col` range. They are compared against each other and printed
+side-by-side in mismatch reports, so they MUST share one coordinate system and
+one layout. Rather than keep two parallel formatters in sync by discipline
+(they drifted once — actuals went file-relative while expecteds stayed
+snippet-local), both project into a single `LocatedMessage` and flow through
+the *one* `render` / `matches` below. There is no other way to format or
+compare a located message, so the two views cannot diverge again. -/
+
+/-- The common normal form: a kinded, located message in **snippet-local**
+    coordinates (1-indexed line, 0-indexed columns), the system both
+    `Strata.Diagnostic` and `DiagnosticAnnotation` natively use. `message` is
+    the substring to match (when this is an expected annotation) or the full
+    diagnostic text (when this is an actual diagnostic). -/
+private structure LocatedMessage where
+  line : Nat
+  colStart : Nat
+  colEnd : Nat
+  kind : String
+  message : String
+
+/-- View an actual pipeline `Diagnostic` as a `LocatedMessage`. -/
+private def LocatedMessage.ofDiagnostic (d : Strata.Diagnostic) : LocatedMessage :=
+  { line := d.start.line, colStart := d.start.column, colEnd := d.ending.column
+    kind := diagnosticKindString d.type, message := d.message }
+
+/-- View an expected `DiagnosticAnnotation` as a `LocatedMessage`. -/
+private def LocatedMessage.ofAnnotation (a : DiagnosticAnnotation) : LocatedMessage :=
+  { line := a.line, colStart := a.colStart, colEnd := a.colEnd
+    kind := a.kind, message := a.message }
+
+/-- The single renderer for any located message — used for BOTH the
+    "actual diagnostics" and "expected (annotated)" halves of every report, so
+    the two are always in the same coordinate system and layout.
+
+    Prints the **file-relative** `line:col` range (snippet line `L` is file line
+    `block.baseLine + L - 1`; columns coincide). The filename is intentionally
+    omitted: the Lean test runner already reports which file a diagnostic came
+    from, and dropping it keeps `#guard_msgs` goldens stable regardless of how
+    the file was opened. With `showSnippet := true` the snippet-relative range
+    is appended in parens — useful for correlating against inline `// ^^^`
+    annotations, which are snippet-local.
+
+    Format: `<fileLine>:<colStart>-<colEnd>  <kind>: <message>`, or with
+    `showSnippet`:
+    `<fileLine>:<colStart>-<colEnd> (snippet <line>:<colStart>-<colEnd>)  <kind>: <message>` -/
+private def LocatedMessage.render (block : SourcedProgram) (m : LocatedMessage)
+    (showSnippet : Bool := false) : String :=
+  let fileLine := block.baseLine + m.line - 1
+  let snippet := if showSnippet then
+      s!" (snippet {m.line}:{m.colStart}-{m.colEnd})"
+    else ""
+  s!"{fileLine}:{m.colStart}-{m.colEnd}{snippet}  {m.kind}: {m.message}"
+
+/-- Format an actual `Diagnostic` for reporting. Thin wrapper over
+    `LocatedMessage.render` so callers don't project by hand. -/
+def formatDiagnostic (block : SourcedProgram) (d : Strata.Diagnostic)
+    (showSnippet : Bool := false) : String :=
+  (LocatedMessage.ofDiagnostic d).render block showSnippet
+
+/-- Number of leading whitespace characters (`' '` or `'\t'`) in a list. -/
+private def leadingWhitespace (cs : List Char) : Nat :=
+  (cs.takeWhile (fun c => c == ' ' || c == '\t')).length
+
+private def listStartsWith (xs : List Char) (prefix_ : String) : Bool :=
+  let p := prefix_.toList
+  p.length ≤ xs.length && (xs.take p.length) == p
+
+/-- Parse `// ^^^^ <kind>: <message>` annotations out of a snippet. The
+    annotation lives on the line *after* the offending source line. Lines
+    are returned 1-indexed (matching `Lean.Position.line`). -/
+private def parseAnnotations (snippet : String) : Array DiagnosticAnnotation := Id.run do
+  let lineLists : Array (List Char) :=
+    ((snippet.splitOn "\n").map String.toList).toArray
+  let mut annotations : Array DiagnosticAnnotation := #[]
+  for i in [0:lineLists.size] do
+    let chars : List Char := lineLists[i]!
+    let leadWs := leadingWhitespace chars
+    let body : List Char := chars.drop leadWs
+    unless listStartsWith body "//" do continue
+    -- Past the `//`: any non-caret prefix (typically spaces), then carets, then
+    -- optional whitespace, then `<kind>: <message>`.
+    let afterMarker : List Char := body.drop 2
+    let preCarets : List Char := afterMarker.takeWhile (· != '^')
+    let carets : List Char :=
+      (afterMarker.drop preCarets.length).takeWhile (· == '^')
+    if carets.isEmpty then continue
+    let trailing : List Char :=
+      (afterMarker.drop (preCarets.length + carets.length)).dropWhile
+        (fun c => c == ' ' || c == '\t')
+    let some colonIdx := trailing.findIdx? (· == ':')
+      | continue
+    let kind := (String.ofList (trailing.take colonIdx)).trimAscii.toString
+    let message := (String.ofList (trailing.drop (colonIdx + 1))).trimAscii.toString
+    -- Caret columns: leadWs + 2 (for `//`) + offset of first caret.
+    let colStart := leadWs + 2 + preCarets.length
+    let colEnd := colStart + carets.length
+    -- Diagnostic applies to the *previous* non-comment, non-blank line.
+    let mut target := i
+    let mut found := false
+    while target > 0 && !found do
+      target := target - 1
+      let prev : List Char := lineLists[target]!
+      let prevWs := leadingWhitespace prev
+      let prevBody : List Char := prev.drop prevWs
+      if listStartsWith prevBody "//" || prevBody.isEmpty then continue
+      found := true
+    unless found do continue
+    annotations := annotations.push {
+      line := target + 1, colStart, colEnd, kind, message
+    }
+  pure annotations
+
+/-- Substring containment on `String`. Direct rather than the
+    `(d.splitOn a).length > 1` trick. -/
+private def isSubstrOf (needle haystack : String) : Bool :=
+  !needle.isEmpty && (haystack.splitOn needle).length > 1
+
+/-- Does an actual diagnostic satisfy an expected annotation? Both are viewed
+    as `LocatedMessage`s and compared in the shared snippet-local coordinate
+    system: start line and the full column range must agree exactly, kinds must
+    be equal, and the expected `message` must appear as a substring of the
+    actual one (real messages carry volatile detail — unique-id suffixes, full
+    types — so we pin only the stable fragment). The diagnostic's *ending* line
+    is intentionally not constrained, so a future multi-line diagnostic doesn't
+    silently fail to match. -/
+private def LocatedMessage.matches (actual expected : LocatedMessage) : Bool :=
+  actual.line == expected.line
+    && actual.colStart == expected.colStart
+    && actual.colEnd == expected.colEnd
+    && actual.kind == expected.kind
+    && isSubstrOf expected.message actual.message
+
+/-- Format a single annotation for reporting. Thin wrapper over
+    `LocatedMessage.render` — the SAME renderer used for actual diagnostics, so
+    the "expected (annotated)" and "actual diagnostic" halves of a mismatch
+    report are always in the same coordinate system and layout. -/
+private def formatAnnotation (block : SourcedProgram) (a : DiagnosticAnnotation)
+    (showSnippet : Bool := false) : String :=
+  (LocatedMessage.ofAnnotation a).render block showSnippet
+
+/-- Drive a `SourcedProgram` against its inline annotations.
+
+    - If the snippet contains no annotations, succeeds iff the pipeline
+      produces no diagnostics and prints `ok`.
+    - Otherwise asserts an exact match: every diagnostic must be annotated,
+      every annotation must fire. Throws on mismatch. -/
+private def runAndCheck (block : SourcedProgram)
+    (run : StrataDDM.Program → IO (Array Strata.DiagnosticModel))
+    (showLocations : Bool := false) (showSnippet : Bool := false) : IO Unit := do
+  let annotations := parseAnnotations block.source
+  let dms ← run block.program
+  let actual := renderSnippetLocal block.basePos block.source dms
+  -- By default the suite stays silent on success — the inline `// ^^^`
+  -- annotations (matched below) are what assert correctness. `showLocations`
+  -- opts a test into echoing each diagnostic's file-relative `line:col`
+  -- (computed from the snippet's `baseLine`, no manual offsets) so a
+  -- `#guard_msgs` golden can pin it; `showSnippet` further appends the
+  -- snippet-relative range for correlating against the inline markers. Note the
+  -- *failure* reports below always use this same file-relative format, so a
+  -- mismatch points straight at the offending `.lean` line regardless.
+  if showLocations then
+    for d in actual do
+      IO.println (formatDiagnostic block d showSnippet)
+  if annotations.isEmpty then
+    unless actual.isEmpty do
+      let mut report := s!"expected no diagnostics, got {actual.size}:\n"
+      for d in actual do
+        report := report ++ s!"  {formatDiagnostic block d showSnippet}\n"
+      throw <| IO.userError report
+    return
+  -- Pair up: every actual diagnostic must match exactly one annotation.
+  let mut unmatchedDiags : Array Strata.Diagnostic := #[]
+  let mut matchedAnnotationIdxs : Array Nat := #[]
+  for d in actual do
+    let mut matchIdx? : Option Nat := none
+    for h : i in [0:annotations.size] do
+      let a := annotations[i]
+      if !matchedAnnotationIdxs.contains i
+          && (LocatedMessage.ofDiagnostic d).matches (LocatedMessage.ofAnnotation a) then
+        matchIdx? := some i
+        break
+    match matchIdx? with
+    | some i => matchedAnnotationIdxs := matchedAnnotationIdxs.push i
+    | none => unmatchedDiags := unmatchedDiags.push d
+  let mut unmatchedAnnotations : Array DiagnosticAnnotation := #[]
+  for h : i in [0:annotations.size] do
+    if !matchedAnnotationIdxs.contains i then
+      unmatchedAnnotations := unmatchedAnnotations.push annotations[i]
+  if unmatchedDiags.isEmpty && unmatchedAnnotations.isEmpty then return
+  let mut report := s!"diagnostics did not match annotations\n"
+  if !unmatchedAnnotations.isEmpty then
+    report := report ++ s!"\nExpected (annotated) but never fired:\n"
+    for a in unmatchedAnnotations do
+      report := report ++ s!"  {formatAnnotation block a showSnippet}\n"
+  if !unmatchedDiags.isEmpty then
+    report := report ++ s!"\nActual diagnostics with no matching annotation:\n"
+    for d in unmatchedDiags do
+      report := report ++ s!"  {formatDiagnostic block d showSnippet}\n"
+  throw <| IO.userError report
+
+/-- Run the full Laurel pipeline (translate + resolve + verify) on a
+    `#strata`-parsed program. If the snippet has inline `// ^^^ kind: message`
+    annotations, asserts an exact match; otherwise expects no diagnostics.
+
+    `options` defaults to `defaultLaurelTestOptions` (quiet verifier, default
+    solver). Pass an explicit value to override the solver, timeout, etc. — for
+    example, `(options := { verifyOptions := { .quiet with solver := "z3" } })`.
+
+    Succeeds silently by default; the inline `// ^^^` annotations assert
+    correctness. Set `showLocations := true` to echo each diagnostic's
+    file-relative `line:col` range (so a `#guard_msgs` golden can pin the
+    localization), and `showSnippet := true` to also append the snippet-relative
+    range. (Failure reports always use the file-relative format regardless.) -/
+def testLaurel (block : SourcedProgram)
+    (options : LaurelVerifyOptions := defaultLaurelTestOptions)
+    (showLocations : Bool := false) (showSnippet : Bool := false) : IO Unit :=
+  runAndCheck block (runLaurelPipelineRaw · options) showLocations showSnippet
+
+/-- Path to the directory for intermediate files, inside the build directory.
+    Resolved from the current working directory so it works on any machine. -/
+def buildDir : IO String := do
+  let cwd ← IO.currentDir
+  return s!"{cwd}/.lake/build/intermediatePrograms/"
+
+def testLaurelKeepIntermediates (block : SourcedProgram) : IO Unit := do
+  let dir ← buildDir
+  runAndCheck block (runLaurelPipelineRaw · { translateOptions := { keepAllFilesPrefix := dir}})
+
+/-- Like `testLaurel` but skips SMT verification (translate + resolve only).
+    Use when the test only cares about resolution, not the verifier — e.g.
+    "shadowing in nested blocks is OK", or asserting a specific resolution
+    error without the verifier surfacing unrelated noise.
+
+    As with `testLaurel`, succeeds silently by default; `showLocations := true`
+    echoes each diagnostic's file-relative `line:col` range and
+    `showSnippet := true` appends the snippet-relative range. -/
+def testLaurelResolution (block : SourcedProgram)
+    (showLocations : Bool := false) (showSnippet : Bool := false) : IO Unit :=
+  runAndCheck block runLaurelResolutionRaw showLocations showSnippet
+
+end StrataTest.Util
diff --git a/Tools/Python-base/.gitignore b/Tools/Python-base/.gitignore
new file mode 100644
index 0000000000..bee8a64b79
--- /dev/null
+++ b/Tools/Python-base/.gitignore
@@ -0,0 +1 @@
+__pycache__
diff --git a/Tools/Python/pyproject.toml b/Tools/Python-base/pyproject.toml
similarity index 74%
rename from Tools/Python/pyproject.toml
rename to Tools/Python-base/pyproject.toml
index 942b083fee..28501a8376 100644
--- a/Tools/Python/pyproject.toml
+++ b/Tools/Python-base/pyproject.toml
@@ -1,7 +1,7 @@
 [project]
 name = "strata"
 version = "0.0.1"
-description = 'Python support for Strata.'
+description = "Core Strata DDM datatypes and Ion serialization."
 requires-python = ">= 3.11"
 dependencies = [
     "amazon.ion"
@@ -13,6 +13,3 @@ packages = ["strata"]
 [build-system]
 requires = ["hatchling"]
 build-backend = "hatchling.build"
-
-[project.scripts]
-gen = "strata.gen:main"
\ No newline at end of file
diff --git a/Tools/Python-base/strata/__init__.py b/Tools/Python-base/strata/__init__.py
new file mode 100644
index 0000000000..e69de29bb2
diff --git a/Tools/Python/strata/base.py b/Tools/Python-base/strata/base.py
similarity index 100%
rename from Tools/Python/strata/base.py
rename to Tools/Python-base/strata/base.py
diff --git a/Tools/Python/README.md b/Tools/Python/README.md
deleted file mode 100644
index e80c340a20..0000000000
--- a/Tools/Python/README.md
+++ /dev/null
@@ -1,32 +0,0 @@
-# Strata Python Bindings
-
-This directory contains a Python package for strata along with a module
-`strata.gen` for generating Strata dialects and programs from Python.
-
-It can be installed by running `pip install .` from this directory.
-
-For full documentation, see:
-
-- The [DDM Manual](https://strata-org.github.io/Strata/ddm/html-single/)
-  — covers DDM concepts and the `strata.base` Python API for working
-  with dialects, programs, and AST types.
-- [PythonDialect.md](PythonDialect.md) — covers the auto-generated Python
-  dialect, CLI commands, the `strata.pythonast` parser API, and Python
-  version compatibility.
-
-## Quick Start
-
-The Python dialect may only be generated in CPython 3.13 or later.  The
-Strata toolchain assumes the dialect is generated in 3.14.  Parsing may
-be done in 3.12+ by pre-generating the dialect in 3.14.
-
-Generate the dialect and parse a Python file:
-
-```
-python -m strata.gen dialect dialects
-python -m strata.gen py_to_strata --dialect dialects/Python.dialect.st.ion \
-   input.py output.py.st.ion
-```
-
-See [PythonDialect.md](PythonDialect.md) for full CLI reference and API
-documentation.
\ No newline at end of file
diff --git a/docs/Architecture.md b/docs/Architecture.md
index d33681ce8f..e371c65817 100644
--- a/docs/Architecture.md
+++ b/docs/Architecture.md
@@ -12,9 +12,9 @@ In the short term, Strata intends to support deductive verification with largely
 
 ## Dialect Definition Mechanism
 
-The Dialect Definition Mechanism (DDM), in the [`Strata.DDM`](../Strata/DDM/) namespace, provides an embedded DSL within Lean to define syntax and typing rules for a dialect. It then can produce an AST type, parser, pretty printer, and preliminary type checker. The parser can be used for processing either snippets embedded in a Lean source file or text read from external files.
+The Dialect Definition Mechanism (DDM), in the [`StrataDDM`](https://github.com/strata-org/Strata-DDM/) namespace, provides an embedded DSL within Lean to define syntax and typing rules for a dialect. It then can produce an AST type, parser, pretty printer, and preliminary type checker. The parser can be used for processing either snippets embedded in a Lean source file or text read from external files.
 
-The immediate result of processing text written in a specific dialect is a generic and very flexible [AST](../Strata/DDM/AST.lean) that captures all of the constructs possible in Strata. This representation allows flexibility, but is not particularly well-suited to concise traversals and transformations. Therefore, each dialect may have either an auto-generated or a hand-written Lean AST, as well, and a transformation from the generic syntax into dialect-specialized syntax. This transformation can be automated when using the auto-generated AST for the dialect.
+The immediate result of processing text written in a specific dialect is a generic and very flexible [AST](https://github.com/strata-org/Strata-DDM/blob/main/StrataDDM/AST.lean) that captures all of the constructs possible in Strata. This representation allows flexibility, but is not particularly well-suited to concise traversals and transformations. Therefore, each dialect may have either an auto-generated or a hand-written Lean AST, as well, and a transformation from the generic syntax into dialect-specialized syntax. This transformation can be automated when using the auto-generated AST for the dialect.
 
 Not all dialects need to be defined with the DDM, but it is convenient for any dialect that will need to be serialized and exchanged with any other program. In this context, it both lowers development effort and clarifies external interfaces.
 
diff --git a/docs/BooleFeatureRequests.md b/docs/BooleFeatureRequests.md
index e162c367c3..2a2c21c361 100644
--- a/docs/BooleFeatureRequests.md
+++ b/docs/BooleFeatureRequests.md
@@ -1,16 +1,9 @@
 # Boole Feature Request Inventory
 
-This document tracks the selected Boole feature-request seeds kept under
-[`StrataTest/Languages/Boole/FeatureRequests`](../StrataTest/Languages/Boole/FeatureRequests).
-
-## Current priorities
-
-- Prioritize Rust-facing language support over Verus-only proof-visibility features.
-- Treat `opaque`, `reveal`, `hide`, `reveal_with_fuel`, `closed`, and `HasType`
-  as lower-priority compatibility items unless they unblock a broader Rust path.
-- Keep widening casts/coercions active; prefer a centralized type-directed coercion
-  pass. This likely overlaps with `nat`/`int` boundary work given how Verus
-  internalizes fixed-width arithmetic.
+This document tracks the selected Boole feature-request seeds. Fully-implemented
+seeds live in [`StrataBooleTest/`](../StrataBoole/StrataBooleTest/);
+seeds with at least one open gap remain in
+[`StrataBooleTest/FeatureRequests/`](../StrataBoole/StrataBooleTest/FeatureRequests).
 
 ## Implemented feature requests
 
@@ -22,52 +15,52 @@ This document tracks the selected Boole feature-request seeds kept under
   - Remaining Boole-syntax gaps for `[T; N]`: see Gap #15.
 - **Nested `for`-loop lowering** (range-style: `for i in 0..N`)
   - Fresh Core block labels prevent inner loops from shadowing the enclosing `"for"` label; loop elimination havocs only loop-carried variables.
-  - Benchmark: [`square_matrix_multiply.lean`](../StrataTest/Languages/Boole/square_matrix_multiply.lean).
+  - Benchmark: [`square_matrix_multiply.lean`](../StrataBoole/StrataBooleTest/square_matrix_multiply.lean).
   - Note: covers `for i in 0..N` range loops only. Iterator-based `for x in iter.iter()` is a separate gap (#23).
 - **Bitvector loop variables** (`for i : bvN := init to limit`)
   - `for_to_by` and `for_downto_by` dispatch guard/step/increment to `Bv{N}.ULe/Add/Sub` when the loop variable is a bitvector type instead of `int`.
-  - Benchmark: [`sha256_compact_indexed.lean`](../StrataTest/Languages/Boole/FeatureRequests/sha256_compact_indexed.lean).
+  - Benchmark: [`sha256_compact_indexed.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/sha256_compact_indexed.lean).
 - **Early return** (#871)
   - `exit functionName;` exits the labeled Core block wrapping the procedure body, acting as an early return.
-  - Benchmark: [`early_return.lean`](../StrataTest/Languages/Boole/early_return.lean).
+  - Benchmark: [`early_return.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/early_return.lean).
 - **Bitwise operators on `bvN` types** (#970)
   - `&`, `|`, `^`, `>>` (UShr), `>>s` (SShr), `<<`, `~` lower to `Bv{N}.And/Or/Xor/UShr/SShr/Shl/Not` Core ops.
   - `bvWidth` helper extracts the bit-width from the Boole type and dispatches to the right-sized op.
-  - Benchmark: [`bitvector_ops.lean`](../StrataTest/Languages/Boole/bitvector_ops.lean) (X25519 scalar clamping with `bv8` `&` and `|`).
+  - Benchmark: [`bitvector_ops.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/bitvector_ops.lean) (X25519 scalar clamping with `bv8` `&` and `|`).
 - **Bitvector comparisons** (#1075)
   - Unsigned (`<`, `<=`, `>`, `>=`) lower to `Bv{N}.ULt/ULe/UGt/UGe` via `toBvCmpOp` (plain comparisons on bitvector operands default to unsigned).
   - Signed (`<s`, `<=s`, `>s`, `>=s`) lower to `Bv{N}.SLt/SLe/SGt/SGe`.
-  - Benchmark: [`bitvector_ops.lean`](../StrataTest/Languages/Boole/bitvector_ops.lean).
-- **Mutual recursion over datatypes** (#599)
-  - `rec function ... ;` blocks work end-to-end for structural recursion over datatypes.
-  - Remaining gap: mutual recursion over `int` — unblocked by #1167; see #19.
-  - Benchmark: [`mutual_recursion.lean`](../StrataTest/Languages/Boole/FeatureRequests/mutual_recursion.lean) (`even`/`odd` over `MyNat`).
+  - Benchmark: [`bitvector_ops.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/bitvector_ops.lean).
+- **Mutual recursion** (#599, #1167)
+  - `rec function ... ;` blocks work for structural recursion over datatypes and for `int`-typed functions with `decreases`.
+  - Remaining gap: int-recursive functions are opaque UFs — functional properties (e.g. `even(1) == false`) cannot be proved without unfolding axioms. Blocked by Gap #1 (`opaque`/`reveal`).
+  - Benchmark: [`mutual_recursion.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/mutual_recursion.lean).
 - **`choose` syntax**
   - `w := choose z : T :: pred(z)` desugars to `assert ∃ z : T . pred(z); havoc w; assume pred[z/w]`.
   - The existence assertion guards soundness: without it, an unsatisfiable `pred` silently becomes `assume false`, making every downstream obligation a false positive.
-  - Benchmark: [`choose_operator.lean`](../StrataTest/Languages/Boole/choose_operator.lean).
+  - Benchmark: [`choose_operator.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/choose_operator.lean).
 - **`decreases` annotation on functions, procedures, and `for` loops**
   - Parsing/forwarding implemented (#1075): accepted in function preconds, `spec {}` blocks, procedure headers, and `for v := init to/downto limit` loops; the `for`-loop measure is forwarded to the Core while-loop measure field and actively verified.
   - `decreases` on functions (structural): termination verification implemented (#1092).
-  - `decreases <int expr>` on `rec function`: implemented (#1167). Non-negativity and strict-decrease obligations generated at each call site. Int-recursive functions are pure UFs in SMT — no definitional axioms; manual axioms still needed for functional properties.
+  - `decreases <int expr>` on `rec function`: implemented (#1167). Non-negativity and strict-decrease obligations generated at each call site. Int-recursive functions are pure UFs in SMT — functional properties (e.g. `even(1) == false`) cannot be proved without unfolding axioms; blocked by Gap #1.
   - `decreases` on procedures: `decr : Option Measure` parameter on `boole_procedure`, reusing Core's existing `Measure` category; currently parsed and silently dropped.
-  - Benchmark: [`decreases_metadata.lean`](../StrataTest/Languages/Boole/FeatureRequests/decreases_metadata.lean).
+  - Benchmark: [`decreases_metadata.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/decreases_metadata.lean).
 - **`Sequence T` type and slicing ops**
   - All 8 Core inherited ops wired up; wrappers added for `Sequence.skip`, `Sequence.dropFirst`, `Sequence.subrange`.
   - Typed empty-sequence constants: `Sequence.empty_bv8/bv16/bv32/bv64/int`. Each needs a distinct token — 0-ary polymorphic `Sequence.empty` has no arguments to infer the type from.
   - Recursive spec functions over sequences: `decreases Sequence.length(s)` supported (#1167); `reconstruct` seed now active.
-  - Benchmark: [`seq_slicing.lean`](../StrataTest/Languages/Boole/FeatureRequests/seq_slicing.lean).
+  - Benchmark: [`seq_slicing.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/seq_slicing.lean).
 - **Inline `let`-block postconditions**
   - `ensures ({ let x = e; ... })` now lowers correctly; enables dalek-lite's `mul_clamped` postcondition style.
-  - Benchmark: [`embedded_postcondition.lean`](../StrataTest/Languages/Boole/embedded_postcondition.lean).
+  - Benchmark: [`embedded_postcondition.lean`](../StrataBoole/StrataBooleTest/embedded_postcondition.lean).
 - **Lambda abstraction and application**
   - `fun x : T => body` lowers to nested Core `.abs` nodes; `(f)(x)` lowers to `.app () f x`.
   - Remaining gap: first-class function values as procedure parameters / local variables still need abstract-type encoding for the SMT path.
-  - Benchmark: [`lambda_closure.lean`](../StrataTest/Languages/Boole/FeatureRequests/lambda_closure.lean).
+  - Benchmark: [`lambda_closure.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/lambda_closure.lean).
 
 ## Semantic preservation requests
 
-1. **Generic `opaque` / `reveal`**: Lower priority. Preserve reveals for generic spec functions instead of dropping them.
+1. **Generic `opaque` / `reveal`**: Lower priority. Preserve reveals for generic spec functions instead of dropping them. Also blocks functional reasoning about int-recursive functions: without unfolding axioms, `even` and `odd` are opaque UFs and concrete values like `even(1) == false` cannot be proved. The fix is to auto-emit defining equations as SMT assertions (bounded by a trigger) when `decreases` is present — the same mechanism as Dafny's `reveal` and Verus's `reveal_with_fuel`. See [`mutual_recursion.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/mutual_recursion.lean) for a concrete example.
 2. **`hide`**: Lower priority. Emit a real hiding boundary so a revealed body does not stay globally visible.
 3. **`reveal_with_fuel`**: Lower priority. Preserve the requested fuel amount instead of lowering it to an unrestricted reveal.
 4. **`closed` visibility**: Lower priority. Keep closed spec-function bodies hidden across module boundaries.
@@ -77,7 +70,7 @@ This document tracks the selected Boole feature-request seeds kept under
 
 ## Type/model requests
 
-8. **Native `nat` support**: Stop modeling `nat` as a purely abstract type with uninterpreted coercions.
+8. **Native `nat` support**: Approach TBD.
 9. **Missing model types**: Add or standardize support for model types such as `Cell`, `Atomic`, `Thread`, `Rwlock`, `Unit`, and `Arithmetic_overflow`.
 10. **On-demand stdlib/pervasive stubs**: Some pervasive stubs may be droppable after pruning translation output.
 11. **Sequence slicing**: Implemented. Int-based termination for recursive seq functions: implemented (#1167).
@@ -96,7 +89,7 @@ This document tracks the selected Boole feature-request seeds kept under
 
 17. **Higher-order / lambda / closure support**: Implemented. Remaining gap: first-class function values as procedure parameters or local variables.
 18. **`choose`**: Implemented.
-19. **Mutual recursion / forward references**: Implemented for functions over datatypes (structural recursion via `@[cases]`). Remaining gap: mutual recursion over `int` or other non-datatype types — now unblocked by #1167 (same mechanism as Gap #11).
+19. **Mutual recursion / forward references**: Implemented for datatypes (#599) and `int` (#1167). Remaining gap: functional reasoning about int-recursive functions blocked by Gap #1 (unfolding axioms).
 20. **Trait-spec symbol resolution**: Preserve trait-spec symbols across module boundaries.
 21. **Trait / interface with spec and proof methods**: `interface` declarations bundling `spec function` and `lemma` members, with `matches` pattern syntax in `ensures` and `external_body`-style trusted bodies. Confirmed as the backbone of Vest combinators.
 22. **Reusable math spec support**: `pow2`, summation, and modular arithmetic helpers for functional specs; avoids re-axiomatising arithmetic in each seed.
@@ -115,32 +108,32 @@ This document tracks the selected Boole feature-request seeds kept under
 
 ## Boole seed examples
 
-These are the curated one-gap Boole seeds.
+Seeds with all gaps closed have been moved to `StrataBooleTest/`; the table below tracks all seeds regardless of location.
 
 | Definition | Primary request(s) | Source | Current status |
 | --- | --- | --- | --- |
-| [`datatypes_and_selectors.lean`](../StrataTest/Languages/Boole/FeatureRequests/datatypes_and_selectors.lean) | Datatype constructor/selector robustness (#24) | Verus `guide/datatypes`, `adts`; VLIR `rec_adt_structural` | Basic seed passes; richer cases still active |
-| [`abstract_types_and_stubs.lean`](../StrataTest/Languages/Boole/FeatureRequests/abstract_types_and_stubs.lean) | Missing model types (#9), stdlib/pervasive stubs (#10) | Verus `guide/quants`, `broadcast_proof`, `guide/higher_order_fns` | Active; `Sequence` lowering now implemented; primary gaps: Thread, Cell, Rwlock model types and pervasive stubs |
-| [`nat_int_boundary.lean`](../StrataTest/Languages/Boole/FeatureRequests/nat_int_boundary.lean) | Native `nat` (#8), widening coercions (#6) | Verus `quantifiers`, `guide/integers`, `power_of_2`; VLIR `rec_adt_structural` | Active |
-| [`map_extensionality.lean`](../StrataTest/Languages/Boole/FeatureRequests/map_extensionality.lean) | Extensional equality | Verus `guide/ext_equal` | Implemented (#684, #795); named synonyms and non-map types still open |
-| [`overflow_guard.lean`](../StrataTest/Languages/Boole/FeatureRequests/overflow_guard.lean) | Overflow guards (#5) | Verus `guide/overflow`, `overflow` | Lower priority |
-| [`opaque_reveal_hide.lean`](../StrataTest/Languages/Boole/FeatureRequests/opaque_reveal_hide.lean) | `opaque`/`reveal` (#1), `hide` (#2), `closed` (#4) | Verus `generics`, `test_expand_errors`, `debug_expand`, `modules` | Lower priority |
-| [`reveal_with_fuel.lean`](../StrataTest/Languages/Boole/FeatureRequests/reveal_with_fuel.lean) | `reveal_with_fuel` (#3) | Verus `test_expand_errors`, `recursion` | Lower priority |
-| [`early_return.lean`](../StrataTest/Languages/Boole/early_return.lean) | Early return | Verus SST `return` translation gap from `differential_status.md` | Implemented (#871) |
-| [`widening_casts.lean`](../StrataTest/Languages/Boole/FeatureRequests/widening_casts.lean) | Widening casts (#6) | Verus `guide/integers`, `quantifiers`, `statements` | Active |
-| [`choose_operator.lean`](../StrataTest/Languages/Boole/choose_operator.lean) | `choose` (#18) | Verus `trigger_loops` (`choose_example`, `quantifier_example`) | Implemented (#1075) |
-| [`higher_order_encoding.lean`](../StrataTest/Languages/Boole/FeatureRequests/higher_order_encoding.lean) | Higher-order values (#17) | Verus `fun_ext`, `trait_for_fn` | Active |
-| [`lambda_closure.lean`](../StrataTest/Languages/Boole/FeatureRequests/lambda_closure.lean) | Lambda / closure (#17) | Local reduced Rust/Verus-style lambda example | Implemented (#1075); remaining gap: first-class function values as procedure parameters/variables |
-| [`mutual_recursion.lean`](../StrataTest/Languages/Boole/FeatureRequests/mutual_recursion.lean) | Mutual recursion (#19) | Verus `guide/recursion`; VLIR `mutual_recursion`, `recursion` | Implemented for datatypes (#599); mutual recursion over `int` now unblocked by #1167 |
-| [`decreases_metadata.lean`](../StrataTest/Languages/Boole/FeatureRequests/decreases_metadata.lean) | `decreases` preservation (#7) | Verus `proposal-rw2022`, `rw2022_script`, `recursion`; VLIR `LoopSimpleWithSpec` | For-loop `decreases` actively verified; function `decreases` verified by #1092; int-recursive functions: verified (#1167 merged); procedure `decreases` parsed, silently dropped |
-| [`horner_poly_eval.lean`](../StrataTest/Languages/Boole/FeatureRequests/horner_poly_eval.lean) | Reusable math spec (#22) | CLRS Horner’s rule, Exercise 2.3 | Type-checks; full math spec still open |
-| [`embedded_postcondition.lean`](../StrataTest/Languages/Boole/embedded_postcondition.lean) | Inline `let`-binding blocks in `ensures` clauses | dalek-lite `montgomery.rs` `mul_clamped`, `mul_bits_be` | Implemented (#1075) |
-| [`montgomery_loop_invariant.lean`](../StrataTest/Languages/Boole/FeatureRequests/montgomery_loop_invariant.lean) | Relational loop invariants over two co-evolving variables | dalek-lite `montgomery.rs` `mul_bits_be` (Montgomery ladder) | Linear arithmetic case: implemented (#1075); elliptic curve case: open — requires group-law axioms (Costello-Smith 2017, eq. 4); whether cvc5 closes the invariant with those axioms is untested |
-| [`bitvector_ops.lean`](../StrataTest/Languages/Boole/bitvector_ops.lean) | Bitwise operators on `bvN` types | dalek-lite `scalar_specs.rs` | Implemented (#970) |
-| [`bitvector_proof_mode.lean`](../StrataTest/Languages/Boole/FeatureRequests/bitvector_proof_mode.lean) | `by (bit_vector)` proof mode (#27) | VeruSAGE-Bench Vest `leb128` | Active |
-| [`seq_slicing.lean`](../StrataTest/Languages/Boole/FeatureRequests/seq_slicing.lean) | Sequence slicing (#11) | dalek-lite `scalar_specs.rs`, `core_specs.rs`; Vest `leb128`, `repetition` | Implemented (#1075); recursive spec functions implemented (#1167 merged); `reconstruct` seed active |
-| [`scalar_reduce.lean`](../StrataTest/Languages/Boole/FeatureRequests/scalar_reduce.lean) | `reduce()` spec axiom for B2 (`Scalar::from_bytes_mod_order_wide`) | dalek-lite `scalar.rs` | Implemented (#1075); `u8_64_as_group_canonical` can now use recursive form (#1167 merged); manual axioms unchanged |
-| [`struct_field_access.lean`](../StrataTest/Languages/Boole/FeatureRequests/struct_field_access.lean) | Struct/record field access (#13) | dalek-lite `field_specs.rs`, `edwards_specs.rs` | Active |
-| [`trait_spec_methods.lean`](../StrataTest/Languages/Boole/FeatureRequests/trait_spec_methods.lean) | Trait / interface with spec methods (#21) | VeruSAGE-Bench Vest `SecureSpecCombinator` | Active |
-| [`option_matches.lean`](../StrataTest/Languages/Boole/FeatureRequests/option_matches.lean) | `Option<T>` in spec functions (#14) | VeruSAGE-Bench Vest `SecureSpecCombinator`, `leb128` | Active |
-| [`sha256_compact_indexed.lean`](../StrataTest/Languages/Boole/FeatureRequests/sha256_compact_indexed.lean) | Iterator protocol lowering (#23), array syntax (#15), slice types (#16), `bv` rotate primitives (#28) | RustCrypto SHA-256 compact port (indexed `Sequence` encoding) | Active — all 19 VCs pass (#1075); open gaps: iterator protocol (#23), array syntax (#15), slice types (#16) |
+| [`datatypes_and_selectors.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/datatypes_and_selectors.lean) | Datatype constructor/selector robustness (#24) | Verus `guide/datatypes`, `adts`; VLIR `rec_adt_structural` | Basic seed passes; richer cases still active |
+| [`abstract_types_and_stubs.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/abstract_types_and_stubs.lean) | Missing model types (#9), stdlib/pervasive stubs (#10) | Verus `guide/quants`, `broadcast_proof`, `guide/higher_order_fns` | Active; `Sequence` lowering now implemented; primary gaps: Thread, Cell, Rwlock model types and pervasive stubs |
+| [`nat_int_boundary.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/nat_int_boundary.lean) | Native `nat` (#8), widening coercions (#6) | Verus `quantifiers`, `guide/integers`, `power_of_2`; VLIR `rec_adt_structural` | Active |
+| [`map_extensionality.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/map_extensionality.lean) | Extensional equality | Verus `guide/ext_equal` | Implemented (#684, #795); named synonyms and non-map types still open |
+| [`overflow_guard.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/overflow_guard.lean) | Overflow guards (#5) | Verus `guide/overflow`, `overflow` | Lower priority |
+| [`opaque_reveal_hide.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/opaque_reveal_hide.lean) | `opaque`/`reveal` (#1), `hide` (#2), `closed` (#4) | Verus `generics`, `test_expand_errors`, `debug_expand`, `modules` | Lower priority |
+| [`reveal_with_fuel.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/reveal_with_fuel.lean) | `reveal_with_fuel` (#3) | Verus `test_expand_errors`, `recursion` | Lower priority |
+| [`early_return.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/early_return.lean) | Early return | Verus SST `return` translation gap from `differential_status.md` | Implemented (#871) |
+| [`widening_casts.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/widening_casts.lean) | Widening casts (#6) | Verus `guide/integers`, `quantifiers`, `statements` | Active |
+| [`choose_operator.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/choose_operator.lean) | `choose` (#18) | Verus `trigger_loops` (`choose_example`, `quantifier_example`) | Implemented (#1075) |
+| [`higher_order_encoding.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/higher_order_encoding.lean) | Higher-order values (#17) | Verus `fun_ext`, `trait_for_fn` | Active |
+| [`lambda_closure.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/lambda_closure.lean) | Lambda / closure (#17) | Local reduced Rust/Verus-style lambda example | Implemented (#1075); remaining gap: first-class function values as procedure parameters/variables |
+| [`mutual_recursion.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/mutual_recursion.lean) | Mutual recursion (#19) | Verus `guide/recursion`; VLIR `mutual_recursion`, `recursion` | Implemented for datatypes (#599) and `int` (#1167); functional reasoning blocked by Gap #1 (unfolding axioms) |
+| [`decreases_metadata.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/decreases_metadata.lean) | `decreases` preservation (#7) | Verus `proposal-rw2022`, `rw2022_script`, `recursion`; VLIR `LoopSimpleWithSpec` | Implemented (#1092, #1167); procedure `decreases` parsed, silently dropped |
+| [`horner_poly_eval.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/horner_poly_eval.lean) | Reusable math spec (#22) | CLRS Horner’s rule, Exercise 2.3 | Type-checks; full math spec still open |
+| [`embedded_postcondition.lean`](../StrataBoole/StrataBooleTest/embedded_postcondition.lean) | Inline `let`-binding blocks in `ensures` clauses | dalek-lite `montgomery.rs` `mul_clamped`, `mul_bits_be` | Implemented (#1075) |
+| [`montgomery_loop_invariant.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/montgomery_loop_invariant.lean) | Relational loop invariants over two co-evolving variables | dalek-lite `montgomery.rs` `mul_bits_be` (Montgomery ladder) | Linear arithmetic case: implemented (#1075); elliptic curve case: open — requires group-law axioms (Costello-Smith 2017, eq. 4); whether cvc5 closes the invariant with those axioms is untested |
+| [`bitvector_ops.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/bitvector_ops.lean) | Bitwise operators on `bvN` types | dalek-lite `scalar_specs.rs` | Implemented (#970) |
+| [`bitvector_proof_mode.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/bitvector_proof_mode.lean) | `by (bit_vector)` proof mode (#27) | VeruSAGE-Bench Vest `leb128` | Active |
+| [`seq_slicing.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/seq_slicing.lean) | Sequence slicing (#11) | dalek-lite `scalar_specs.rs`, `core_specs.rs`; Vest `leb128`, `repetition` | Implemented (#1075, #1167) |
+| [`scalar_reduce.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/scalar_reduce.lean) | `reduce()` spec axiom for B2 (`Scalar::from_bytes_mod_order_wide`) | dalek-lite `scalar.rs` | Implemented (#1075) |
+| [`struct_field_access.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/struct_field_access.lean) | Struct/record field access (#13) | dalek-lite `field_specs.rs`, `edwards_specs.rs` | Active |
+| [`trait_spec_methods.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/trait_spec_methods.lean) | Trait / interface with spec methods (#21) | VeruSAGE-Bench Vest `SecureSpecCombinator` | Active |
+| [`option_matches.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/option_matches.lean) | `Option<T>` in spec functions (#14) | VeruSAGE-Bench Vest `SecureSpecCombinator`, `leb128` | Active |
+| [`sha256_compact_indexed.lean`](../StrataBoole/StrataBooleTest/FeatureRequests/sha256_compact_indexed.lean) | Iterator protocol lowering (#23), array syntax (#15), slice types (#16), `bv` rotate primitives (#28) | RustCrypto SHA-256 compact port (indexed `Sequence` encoding) | Active — all 17 VCs pass (#1075); open gaps: iterator protocol (#23), array syntax (#15), slice types (#16) |
diff --git a/docs/Testing.md b/docs/Testing.md
new file mode 100644
index 0000000000..59719528f1
--- /dev/null
+++ b/docs/Testing.md
@@ -0,0 +1,276 @@
+# Testing Strata Dialects
+
+This guide shows how to write tests for Strata dialects in the `StrataTest/`
+directory. It focuses on **Laurel** (the path that received the most recent
+ergonomic work) and notes where **Boole** uses the same primitives. For Python
+test wiring, see [`StrataTest/Languages/Python/README.md`](../StrataTest/Languages/Python/README.md).
+
+> **Quick rule of thumb:** put the dialect program inside a `#strata` block
+> and call `testLaurel` (or `testLaurelResolution`) on it. If the program is
+> expected to fail, annotate the expected diagnostics inline with
+> `// ^^^ kind: message`. The helper auto-detects whether to expect a clean
+> run or to match annotations.
+
+## Background
+
+- `#strata <dialect>; … #end` is a **term-elaboration block** that parses the
+  inner Strata program at Lean compile time and elaborates to a
+  `Strata.SourcedProgram` (the parsed `Program` plus the snippet text and the
+  byte/line offset of the snippet inside the surrounding `.lean` file). Parse
+  errors surface as Lean errors, so the LSP highlights them inside the block
+  while you edit.
+- A `Coe SourcedProgram Program` instance lets the result of `#strata` flow
+  into APIs that expect a plain `Program` (e.g. `Strata.Boole.verify`); when
+  consumers need `Program` directly, just write `.program`.
+- `#guard_msgs` is Lean's built-in golden-test command. Used here for
+  **positive tests** — wrap an `#eval` in `#guard_msgs in` and pin the
+  expected output via a `/-- info: … -/` docstring directly above. Negative
+  tests use inline annotations instead (see recipe 2).
+
+Diagnostic positions in inline annotations are snippet-local: lines are
+1-indexed within the `#strata` block, columns are 0-indexed. The helper
+converts file-global pipeline diagnostics back to snippet-local positions
+before matching, so annotations don't drift when the surrounding `.lean` file
+is edited.
+
+## Recipes
+
+### 1. Positive test — program checks cleanly through the full pipeline
+
+Use `testLaurel`. The helper throws if any diagnostics fire, so no
+`#guard_msgs` / docstring is needed:
+
+```lean
+import StrataTest.Util.TestLaurel
+
+open StrataTest.Util
+
+#eval testLaurel
+#strata
+program Laurel;
+procedure foo() opaque { assert true };
+#end
+```
+
+### 2. Negative test — assert that specific errors fire
+
+Same helper, `testLaurel`. Annotate each expected diagnostic *inline*, on the
+line directly below the offending source line, with carets pointing at the
+column range and the kind + (substring of the) message after the carets:
+
+```lean
+#eval testLaurel
+#strata
+program Laurel;
+procedure unsafeDivision(x: int)
+  opaque
+{
+  var z: int := 10 / x
+//^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
+};
+#end
+```
+
+`testLaurel` auto-detects: when annotations are present, it requires an
+**exact match on everything except the message text** — every diagnostic
+annotated, every annotation fires, positions (line + column range) agree,
+kind matches — and the annotation's message must appear as a **substring**
+of the actual diagnostic message. When no annotations are present, it expects
+no diagnostics. A mismatch throws with a precise summary of which annotations
+went unmatched and which actual diagnostics had no annotation, so
+`#guard_msgs` isn't needed for negative tests.
+
+The message is matched as a substring (not a prefix, and not exact) on
+purpose: real diagnostic messages often carry volatile detail — variable
+names with unique-id suffixes, full type descriptions, fix suggestions — that
+you don't want to pin verbatim. Annotate the stable, identifying fragment of
+the message and the test stays robust as messages are reworded.
+
+`kind` is one of `error`, `warning`, `not-yet-implemented`, `strata-bug`.
+
+#### Reported locations
+
+Diagnostic locations are formatted as `<fileLine>:<colStart>-<colEnd>  <kind>:
+<message>`, where `fileLine` is the line in the enclosing `.lean` file (computed
+from the snippet's base line — no manual offsets). The filename is omitted: the
+Lean test runner already reports which file a diagnostic came from.
+
+A test **succeeds silently** by default — the inline `// ^^^` annotations are
+what assert correctness, so there's no per-diagnostic noise in the build log.
+This file-relative format is, however, always used in **failure** reports, so a
+mismatch points straight at the offending `.lean` line. To also *echo* the
+locations on success (e.g. to pin them with `#guard_msgs` and demonstrate the
+localization), pass `showLocations := true`; add `showSnippet := true` to append
+the snippet-relative range — `… (snippet <line>:<colStart>-<colEnd>)` — handy
+when correlating against the inline annotations (those are snippet-local, so
+their `line` differs from the file line).
+
+### 3. Resolution-only tests — skip the verifier
+
+When the test is about resolution (kind mismatches, duplicate names, scope
+errors), running the verifier on a deliberately-broken program adds
+unrelated noise (`dbg_trace` warnings, vacuous VCs). Use
+`testLaurelResolution` — same auto-detect behavior as `testLaurel`, but
+stops after `resolve`.
+
+The gap between the two is not just the SMT call: `testLaurel` runs the full
+compilation pipeline, which after `resolve` applies roughly a dozen
+Laurel-to-Laurel lowering passes (type-alias elimination, heap
+parameterization, type-hierarchy and modifies-clause transforms, hole-type
+inference and elimination, short-circuit desugaring, imperative-expression
+lifting, constrained-type elimination, …) before translating to Core and
+verifying. Several of those passes re-run `resolve` on their output. So a
+diagnostic that only `testLaurel` surfaces may originate from a later pass,
+not the verifier. The major passes are described in the **Translation
+Pipeline** section of the Laurel language manual — published at
+[strata-org.github.io/Strata](https://strata-org.github.io/Strata/laurel/html-single/),
+source in [`docs/verso/LaurelDoc.lean`](verso/LaurelDoc.lean) — and the full
+pass list and exact ordering live in
+[`Strata/Languages/Laurel/LaurelCompilationPipeline.lean`](../Strata/Languages/Laurel/LaurelCompilationPipeline.lean)
+(`laurelPipeline`).
+
+```lean
+#eval testLaurelResolution
+#strata
+program Laurel;
+procedure foo() opaque {
+  var x: int := 1;
+  var y: x := 2
+//       ^ error: 'x' resolves to variable, but expected composite type, ...
+};
+#end
+```
+
+```lean
+/-! Shadowing in nested blocks is OK -/
+#eval testLaurelResolution
+#strata
+program Laurel;
+procedure foo() opaque {
+  var x: int := 1;
+  { var x: int := 2 }
+};
+#end
+```
+
+### 4. Custom pipeline stage — bring your own helper
+
+For tests that exercise a specific transform (e.g. `eliminateHoles`,
+`liftExpressionAssignments`, `constrainedTypeElim`), build a small per-file
+helper that takes a parsed `Strata.Program` and runs the stages you care about.
+`translateLaurel` does the parse → translate step so you don't have to repeat
+it.
+
+```lean
+import StrataTest.Util.TestLaurel
+import Strata.Languages.Laurel.InferHoleTypes
+import Strata.Languages.Laurel.EliminateHoles
+
+open Strata
+open StrataTest.Util
+
+namespace Strata.Laurel
+
+private def parseElimAndPrint (program : Strata.Program) : IO Unit := do
+  let laurelProgram ← translateLaurel program
+  let result := resolve laurelProgram
+  let (laurelProgram, _, _) := inferHoleTypes result.model result.program
+  let (laurelProgram, _) := eliminateHoles laurelProgram
+  for proc in laurelProgram.staticProcedures do
+    IO.println (toString (Std.Format.pretty (Std.ToFormat.format proc)))
+
+/--
+info: function $hole_0()
+  returns ($result: int)
+  opaque;
+procedure test()
+{ var x: int := 1 + $hole_0() };
+-/
+#guard_msgs in
+#eval parseElimAndPrint
+#strata
+program Laurel;
+procedure test() { var x: int := 1 + <?> };
+#end
+
+end Strata.Laurel
+```
+
+The pattern: `translateLaurel : Strata.Program → IO Laurel.Program` is the
+common entry point; everything after is dialect/test-specific.
+
+### 5. One `#strata` block per independent unit; group only on dependency
+
+The rule here is about **independence**, not about positive-vs-negative.
+Every negative test still contains plenty of correct code — the procedure
+that *does* verify so the broken one can be reached, the declarations the
+failing statement refers to, and so on. That mix inside a single block is
+expected and fine.
+
+What matters is the boundary *between* blocks: give each independently
+checkable unit its own `#strata` block, so a regression in one can't mask a
+regression in another and a failure points at the smallest reproducing
+snippet.
+
+```lean
+/-! ### Safe paths verify cleanly -/
+#eval testLaurel #strata
+program Laurel;
+procedure safeDivision() opaque {
+  var z: int := 10 / 2;
+  assert z == 5
+};
+#end
+
+/-! ### Unsafe division: divisor not constrained, fails verification -/
+#eval testLaurel #strata
+program Laurel;
+procedure unsafeDivision(x: int) opaque {
+  var z: int := 10 / x
+//^^^^^^^^^^^^^^^^^^^^ error: assertion does not hold
+};
+#end
+```
+
+**The exception — and the more important point:** when the units genuinely
+depend on each other (one procedure calls another, or they share a type or
+declaration), they *must* live in the same `#strata` block, because
+resolution needs them together. In that case, list the union of expected
+diagnostics across all the contained procedures in one block.
+
+## Practical workflow
+
+1. Write the `#strata` block first, prefaced with `#eval testLaurel`.
+2. For negative tests, sketch placeholder annotations like `// ^ error:`
+   below the offending lines — column positions don't have to be right yet.
+3. Run it: `lake env lean StrataTest/Languages/Laurel/<your_file>.lean`.
+4. On failure: the helper prints exactly which annotations went unmatched
+   and which diagnostics had no annotation, including the line/column range
+   actually produced. Copy those into your annotations, save, re-run.
+
+When `lake env lean` exits silently with no output, every assertion in the
+file held.
+
+> There is no auto-update ("bless") mode yet that rewrites the inline
+> annotations to match the actual diagnostics. For now step 4 is a manual
+> copy from the failure report; adding a bless mode is a natural follow-up.
+
+## Other dialects
+
+- **Boole** uses `#strata program Boole; … #end` directly with hand-written
+  helpers (e.g. `Strata.Boole.verify`); see
+  [`StrataTest/Languages/Boole/find_max.lean`](../StrataTest/Languages/Boole/find_max.lean)
+  for the canonical pattern. `#strata` is dialect-agnostic — Boole could use
+  inline annotations the same way once a Boole-side helper analogous to
+  `testLaurel` is written.
+- **Python** has its own pipeline-driven harness; see
+  [`StrataTest/Languages/Python/README.md`](../StrataTest/Languages/Python/README.md).
+
+## Where things live
+
+| Concept | File |
+| --- | --- |
+| `#strata` elaborator + `SourcedProgram` | `Strata/DDM/Integration/Lean/HashCommands.lean` |
+| `Diagnostic` data type | `Strata/Languages/Core/Verifier.lean` |
+| Laurel test helpers | `StrataTest/Util/TestLaurel.lean` |
+| Examples | `StrataTest/Languages/Laurel/Examples/**/*.lean` |
diff --git a/docs/verso/DDMDoc.lean b/docs/verso/DDMDoc.lean
index e68772e790..c0116b1277 100644
--- a/docs/verso/DDMDoc.lean
+++ b/docs/verso/DDMDoc.lean
@@ -1119,15 +1119,15 @@ and the literal and collection types (`Ident`, `NumLit`, `StrLit`, `Seq`,
 
 For documentation specific to the auto-generated Python dialect and the
 `py_to_strata` command-line tool, see
-[PythonDialect.md](https://github.com/strata-org/Strata/blob/main/Tools/Python/PythonDialect.md)
+[PythonDialect.md](https://github.com/strata-org/Strata/blob/main/StrataPython/Tools/strata-python/PythonDialect.md)
 in the repository.
 
 ## Installation
 
-The `strata` package can be installed from the `Tools/Python` directory:
+Install both Python packages from the repository root:
 
 ```
-pip install .
+pip install ./Tools/Python-base ./StrataPython/Tools/strata-python
 ```
 
 The package requires Python 3.11 or later and depends on the `amazon.ion`
diff --git a/docs/verso/IRTranslationPhilosophyDoc.lean b/docs/verso/IRTranslationPhilosophyDoc.lean
index 250aeeba95..003e70b83b 100644
--- a/docs/verso/IRTranslationPhilosophyDoc.lean
+++ b/docs/verso/IRTranslationPhilosophyDoc.lean
@@ -59,7 +59,7 @@ A few terms recur with specific meanings:
   yet.
 - *Front-end* — the Strata-side component that ingests source
   artifacts and produces a Strata IR (typically a high-level
-  dialect). Examples: `StrataPython`, `StrataBoole`.
+  dialect). Examples: `StrataPython`, [`StrataBoole`](https://github.com/strata-org/Strata-Boole).
 - *Central IR* — an IR many producers and many consumers share.
   In Strata, *Core* is the central IR.
 - *Analysis* — anything that consumes a Strata IR and produces a
@@ -494,9 +494,9 @@ these interfaces _physical_ package boundaries:
 
   Python dialect + `Python → Laurel` translation.
 
-: `StrataBoole`
+: [`StrataBoole`](https://github.com/strata-org/Strata-Boole)
 
-  Boole dialect + translation to Core.
+  Boole dialect + translation to Core (separate repo).
 
 : `StrataBoogie`
 
@@ -516,7 +516,7 @@ rule for the boundaries that _do_ cross packages:
 - `StrataPython` owns `Python.toLaurel` and depends on the main
   `Strata` package; the main package does not depend on
   `StrataPython`.
-- `StrataBoole` owns `Boole.toCore` and depends on the main
+- [`StrataBoole`](https://github.com/strata-org/Strata-Boole) owns `Boole.toCore` and depends on the main
   `Strata` package; the main package does not depend on
   `StrataBoole`.
 - `StrataBoogie` produces `.core.st` / `.laurel.st` artifacts on
diff --git a/docs/verso/LaurelDoc.lean b/docs/verso/LaurelDoc.lean
index 5be9e276d8..4de8a96ba4 100644
--- a/docs/verso/LaurelDoc.lean
+++ b/docs/verso/LaurelDoc.lean
@@ -6,9 +6,9 @@
 
 import VersoManual
 
-import Strata.Languages.Laurel
+import Strata.Languages.Laurel.LaurelAST
 import Strata.Languages.Laurel.LaurelTypes
-import Strata.Languages.Laurel.LaurelToCoreTranslator
+import Strata.Languages.Laurel.LaurelCompilationPipeline
 import Strata.Languages.Laurel.HeapParameterization
 import Strata.Languages.Laurel.LiftImperativeExpressions
 import Strata.Languages.Laurel.ModifiesClauses
@@ -24,6 +24,148 @@ open Verso.Genre.Manual.InlineLean
 
 set_option pp.rawOnError true
 
+/-- Markdown documentation for all Laurel passes, including their
+    `comesBefore`/`comesAfter` ordering rationales. Note: pass
+    `documentation`/`reason` strings are rendered as Markdown, so avoid raw
+    `<angle-bracket>` text (it is treated as inline HTML and crashes Verso's
+    converter); use backticks for inline code instead. -/
+def laurelPipelineDocsMarkdown : String :=
+  let entries := allPasses.map fun pass =>
+    let base := s!"- **{pass.name}**: {pass.documentation}"
+    let beforeDeps := pass.comesBefore.map fun cb =>
+      s!"  - Comes before **{cb.pass.name}** because: {cb.reason}"
+    let afterDeps := pass.comesAfter.map fun ca =>
+      s!"  - Comes after **{ca.pass.name}** because: {ca.reason}"
+    let deps := beforeDeps ++ afterDeps
+    if deps.isEmpty then base
+    else base ++ "\n" ++ "\n".intercalate deps
+  "\n".intercalate entries.toList
+
+/-- Markdown dependency graph for the Laurel passes, derived from the
+    `comesBefore`/`comesAfter` properties. -/
+def laurelPipelineDependencyGraphMarkdown : String := Id.run do
+  -- Collect all edges: (source, target, reason) where source comesBefore target
+  let mut edges : List (String × String × String) := []
+  for pass in allPasses do
+    -- `pass.comesBefore` declares: pass must run before cb.pass, i.e. pass → cb.pass
+    for cb in pass.comesBefore do
+      edges := edges ++ [(pass.name, cb.pass.name, cb.reason)]
+    -- `pass.comesAfter` declares: pass must run after ca.pass, i.e. ca.pass → pass
+    for ca in pass.comesAfter do
+      edges := edges ++ [(ca.pass.name, pass.name, ca.reason)]
+
+  -- Deduplicate edges with the same (source, target), keeping the first reason.
+  edges := edges.foldl (init := []) fun acc e =>
+    if acc.any (fun a => a.1 == e.1 && a.2.1 == e.2.1) then acc else acc ++ [e]
+
+  -- Build the graph as a markdown list showing dependencies
+  let mut md := "**Dependency edges** (A → B means A must run before B):\n\n"
+  if edges.isEmpty then
+    md := md ++ "*No ordering constraints declared.*\n"
+  else
+    for (src, tgt, reason) in edges do
+      md := md ++ s!"- **{src}** → **{tgt}**\n  - *{reason}*\n"
+
+  -- Add a textual rendering of the pipeline order with dependency annotations
+  md := md ++ "\n**Pipeline execution order** (→ X: must run before X; ← X: must run after X):\n\n"
+  md := md ++ "```\n"
+  let mut idx := 1
+  for pass in allPasses do
+    let beforeDeps := pass.comesBefore.map (s!" → {·.pass.name}")
+    let afterDeps := pass.comesAfter.map (s!" ← {·.pass.name}")
+    let deps := beforeDeps ++ afterDeps
+    let depStr := if deps.isEmpty then "" else String.join deps
+    md := md ++ s!"{idx}. {pass.name}{depStr}\n"
+    idx := idx + 1
+  md := md ++ "```\n"
+  return md
+
+/-- Block command that generates documentation for all Laurel pipeline passes.
+    Usage inside a `#doc` block: `{laurelPipelineDocs}` -/
+@[block_command]
+def laurelPipelineDocs : Verso.Doc.Elab.BlockCommandOf Unit := fun () => do
+  let md := laurelPipelineDocsMarkdown
+  let some ast := MD4Lean.parse md
+    | Lean.throwError "Failed to parse laurelPipelineDocumentation as Markdown"
+  let blocks ← ast.blocks.mapM (Markdown.blockFromMarkdown · (handleHeaders := Markdown.strongEmphHeaders))
+  `(Verso.Doc.Block.concat #[$blocks,*])
+
+/-- Block command that generates a dependency graph for the Laurel pipeline passes
+    based on the `comesBefore` and `comesAfter` properties.
+    Usage inside a `#doc` block: `{laurelPipelineDependencyGraph}` -/
+@[block_command]
+def laurelPipelineDependencyGraph : Verso.Doc.Elab.BlockCommandOf Unit := fun () => do
+  let md := laurelPipelineDependencyGraphMarkdown
+  let some ast := MD4Lean.parse md
+    | Lean.throwError "Failed to parse laurelPipelineDependencyGraph as Markdown"
+  let blocks ← ast.blocks.mapM (Markdown.blockFromMarkdown · (handleHeaders := Markdown.strongEmphHeaders))
+  `(Verso.Doc.Block.concat #[$blocks,*])
+
+-- A set-apart *example* box. Renders its contents inside a tinted, bordered
+-- panel with an "Example" header, so concrete examples stand out from the
+-- surrounding explanatory prose. Authored via the `:::example` directive below.
+block_extension Block.«example» (title : Option String) where
+  data := Lean.toJson (title : Option String)
+  traverse _ _ _ := pure none
+  toHtml := some fun _goI goB _id data contents => open Verso.Output.Html in do
+    let title : Option String :=
+      match Lean.fromJson? (α := Option String) data with
+      | .ok t => t
+      | .error _ => none
+    let label := title.getD "Example"
+    pure {{
+      <div class="laurel-example">
+        <div class="laurel-example-header">{{ label }}</div>
+        <div class="laurel-example-body">{{← contents.mapM goB}}</div>
+      </div>
+    }}
+  extraCss := [
+r#"
+.laurel-example {
+  border: 1px solid #98B2C0;
+  border-left: 4px solid #4A90E2;
+  border-radius: 0.4rem;
+  background: #F5F9FF;
+  margin-top: var(--verso--box-vertical-margin);
+  margin-bottom: var(--verso--box-vertical-margin);
+  overflow: hidden;
+}
+.laurel-example-header {
+  font-family: var(--verso-structure-font-family);
+  font-style: italic;
+  font-size: 0.875rem;
+  font-weight: bold;
+  color: #2A5680;
+  background: #E4EEF8;
+  padding: 0.3rem var(--verso--box-padding);
+}
+.laurel-example-body {
+  padding: 0.2rem var(--verso--box-padding);
+}
+"#
+  ]
+  toTeX := some fun _goI goB _id _data contents => open Verso.Output.TeX in open Verso.Doc.TeX in do
+    pure <| .seq <| ← contents.mapM fun b => do
+      pure <| .seq #[← goB b, .raw "\n"]
+
+/-- Configuration for the `:::example` directive: an optional title shown in the
+    box header (defaults to "Example"). -/
+structure LaurelExampleConfig where
+  title : Option String := none
+
+open Verso.ArgParse in
+instance : Verso.ArgParse.FromArgs LaurelExampleConfig Verso.Doc.Elab.DocElabM where
+  fromArgs := LaurelExampleConfig.mk <$>
+    ((positional' `title <&> some) <|> pure none)
+
+/-- Sets its contents apart in a styled *example* box (see `Block.example`).
+    Optionally takes a title: `:::example "Arithmetic join"` … `:::`. -/
+@[directive]
+def «example» : Verso.Doc.Elab.DirectiveExpanderOf LaurelExampleConfig
+  | {title}, stxs => do
+    let args ← stxs.mapM Verso.Doc.Elab.elabBlock
+    ``(Verso.Doc.Block.other (Block.«example» $(Lean.quote title)) #[ $[ $args ],* ])
+
 #doc (Manual) "The Laurel Language" =>
 %%%
 shortTitle := "Laurel"
@@ -33,14 +175,29 @@ shortTitle := "Laurel"
 
 Laurel is an intermediate verification language designed to serve as a target for popular
 garbage-collected languages that include imperative features, such as Java, Python, and
-JavaScript. Laurel tries to include any features that are common to those three languages.
+JavaScript, where those languages have been extended to include verification specific constructs.
+Laurel tries to include any features that are common to those three languages.
+
+This manual follows the language from the ground up: it first describes Laurel's
+types, then its unified expression/statement model, then procedures and whole
+programs. It then turns to type checking, done in a bidirectional way, and finally to the translation
+pipeline that lowers a checked Laurel program to Strata Core.
+
+## Features
+
+In the feature lists below, items marked *(WIP)* are designed or planned but not
+yet fully implemented; everything else is available today.
 
-Laurel enables doing various forms of verification:
-- Deductive verification
-- (WIP) Model checking
-- (WIP) Property based testing
+Laurel enables doing various forms of analyses :
+- Type checking
+- Testing
+- (WIP) Property-based testing
+- (WIP) Bounded symbolic execution
+- Unbounded symbolic execution
 - (WIP) Data-flow analysis
 
+## Shared language features
+
 Here are some Laurel language features that are shared between the source languages:
 - Statements such as loops and return statements
 - Mutation of variables, including in expressions
@@ -48,9 +205,14 @@ Here are some Laurel language features that are shared between the source langua
 - Object oriented concepts such as inheritance, type checking, up and down casting and
   dynamic dispatch
 - (WIP) Error handling via exceptions
-- (WIP) Higher-order procedures and procedure types
+- (WIP) Procedures types and procedures as values
 - (WIP) Parametric polymorphism
 
+Laurel does not distinguish between statements and expressions.
+Expression-like or statement-like constructs can occur in the same positions.
+Each statement-expression has a type, which for statement-like constructs might be void.
+
+## Verification features
 On top of the above features, Laurel adds features that are useful specifically for verification:
 - Assert and assume statements
 - Loop invariants
@@ -65,6 +227,7 @@ On top of the above features, Laurel adds features that are useful specifically
 - Unbounded integer and real types
 - To be designed constructs for supporting proof writing
 
+## Verification design choices
 A peculiar choice of Laurel is that it does not require imperative code to be encapsulated
 using a functional specification. A reason for this is that sometimes the imperative code is
 as readable as the functional specification. For example:
@@ -77,18 +240,20 @@ procedure increment(counter: Counter)
 };
 ```
 
-## Implementation Choices
-
-A design choice that impacts the implementation of Laurel is that statements and expressions
-share a single implementation type, the StmtExpr. This reduces duplication for constructs
-like conditionals and variable declarations. Each StmtExpr has a user facing type, which for
-statement-like constructs could be void.
+## Internal constructors and properties
+Some constructors and properties in the Laurel AST are marked for internal usage and should not be needed by Laurel users.
+Having these internal properties and constructors allows us to define an incremental translation to Core which improves maintainability.
 
 # Types
 
-Laurel's type system includes primitive types, collection types, and user-defined types.
+Laurel's types come in two groups: those a user can write — primitives,
+collections, and user-defined types — and a few internal constructors the
+implementation introduces that have no surface syntax.
 
-## Primitive Types
+The {name Strata.Laurel.HighType}`HighType` type enumerates every type Laurel
+tracks. Alongside the user-writable types it also includes internal constructors
+(such as `Unknown` and `MultiValuedExpr`) that the compiler introduces
+during resolution and later passes; these have no surface syntax.
 
 {docstring Strata.Laurel.HighType}
 
@@ -146,38 +311,711 @@ A Laurel program consists of procedures, global variables, type definitions, and
 
 {docstring Strata.Laurel.Program}
 
-# Translation Pipeline
+# Type checking
+
+Type checking is woven into the resolution pass: every
+{name Strata.Laurel.StmtExpr}`StmtExpr` gets a {name Strata.Laurel.HighType}`HighType`, and
+mismatches against the surrounding context become diagnostics. The implementation is in
+`Resolution.lean`.
+
+## Design
+
+### Bidirectional type checking
+
+There are two operations on expressions, written here in standard
+bidirectional notation:
+
+```
+Γ ⊢ e ⇒ A            -- "e synthesizes A"     (Synth.resolveStmtExpr)
+Γ ⊢ e ⇐ A            -- "e checks against A"  (Check.resolveStmtExpr)
+```
+
+Synthesis returns a type inferred from the expression itself; checking
+verifies that the expression has a given expected type. Each construct
+picks a mode based on whether its type is determined locally (synth) or
+by context (check). The two judgments are connected by a single
+change-of-direction rule, *subsumption*:
+
+$$`\frac{\Gamma \vdash e \Rightarrow A \quad A <: B}{\Gamma \vdash e \Leftarrow B} \quad \text{([⇐] Sub)}`
+
+The two judgments are implemented as
+{name Strata.Laurel.Resolution.Synth.resolveStmtExpr}`Synth.resolveStmtExpr` and
+{name Strata.Laurel.Resolution.Check.resolveStmtExpr}`Check.resolveStmtExpr`:
+
+{docstring Strata.Laurel.Resolution.Synth.resolveStmtExpr}
+
+{docstring Strata.Laurel.Resolution.Check.resolveStmtExpr}
+
+### Gradual typing
+
+The relation `<:` (used in \[⇐\] Sub) is built from three Lean functions —
+{name Strata.Laurel.isSubtype}`isSubtype`, {name Strata.Laurel.isConsistent}`isConsistent`,
+and {name Strata.Laurel.isConsistentSubtype}`isConsistentSubtype`:
+
+{docstring Strata.Laurel.isSubtype}
+
+{docstring Strata.Laurel.isConsistent}
+
+{docstring Strata.Laurel.isConsistentSubtype}
+
+## Typing rules
+
+Each construct is given as a derivation. `Γ` is the current lexical scope (see
+{name Strata.Laurel.ResolveState}`ResolveState`'s `scope`); it threads identically through
+every premise and conclusion unless a rule explicitly extends it (written `Γ, x : T`).
+
+Each rule is tagged with `[⇒]` (synthesis) or `[⇐]` (checking) to make the
+direction explicit. The {ref "rules-procedure"}[*Procedure*] rule is the one
+exception: it is a top-level well-formedness judgment and carries no direction
+tag.
+
+The following notation recurs throughout the rules:
+
+- $`A <: B` — subtyping ({name Strata.Laurel.isSubtype}`isSubtype`); see
+  *Gradual typing* above. In a *checking* premise or side condition (e.g.
+  \[⇐\] Sub, \[⇐\] If-NoElse, \[⇐\] Assign, the check-mode operator rules, and
+  \[⇐\] Hole-Some) the boundary check is the gradual consistent-subtype
+  relation $`<:_\sim` below — the implementation routes every such check
+  through {name Strata.Laurel.isConsistentSubtype}`isConsistentSubtype`, never
+  bare $`<:` — so $`\mathsf{Unknown}` is admitted on either side.
+- $`A \sim B` — the *consistency* relation
+  {name Strata.Laurel.isConsistent}`isConsistent`: symmetric, with
+  $`\mathsf{Unknown}` acting as a wildcard.
+- $`A <:_\sim B` — the *consistent-subtype* relation
+  {name Strata.Laurel.isConsistentSubtype}`isConsistentSubtype`, the gradual
+  combination of the two above.
+- $`\mathsf{Numeric}\;T` — a predicate holding when $`T` is consistent with one
+  of $`\mathsf{TInt}`, $`\mathsf{TReal}`, $`\mathsf{TFloat64}`, or
+  $`\mathsf{TBv}_w` (a bitvector of any width $`w`), with $`\mathsf{Unknown}`
+  admitted as the gradual escape hatch.
+- $`\dashv \Gamma'` — a rule's *output scope*: the judgment threads $`\Gamma` in
+  and produces $`\Gamma'` out. Only \[⇐\] Var-Declare extends the scope; the
+  block rules thread it statement-to-statement (the $`\Gamma_{i-1} \to
+  \Gamma_i` chain in \[⇐\] Block / \[⇒\] Block-Synth).
+- $`\rightsquigarrow \text{error: …}` — the rule emits an error and aborts; no
+  type is produced.
+- $`[\text{emits …}]` — the rule produces its type but also emits a diagnostic.
+- $`\mapsto` — elaboration: the construct is rewritten to the form on the right.
+
+The Index below links to each construct's subsection.
+
+### Index
+
+- {ref "rules-subsumption"}[*Subsumption*] — \[⇐\] Sub
+- {ref "rules-literals"}[*Literals*] — \[⇒\] Lit-Int, \[⇒\] Lit-Bool, \[⇒\] Lit-String, \[⇒\] Lit-Decimal
+- {ref "rules-variables"}[*Variables*] — \[⇒\] Var-Local, \[⇒\] Var-Field, \[⇒\] Var-Declare
+- {ref "rules-control-flow"}[*Control flow*] — \[⇐\] If, \[⇐\] If-NoElse,
+  \[⇒\] If-Synth, \[⇒\] If-Synth-NoElse;
+  \[⇐\] Block, \[⇒\] Block-Synth, \[⋄\] Synth-Discard,
+  \[⇒\] Empty-Block; \[⇒\] Exit;
+  \[⇒\] Return-None-Void, \[⇒\] Return-None-Single, \[⇒\] Return-None-Multi,
+  \[⇒\] Return-Some, \[⇒\] Return-Void-Error,
+  \[⇒\] Return-Multi-Error; \[⇒\] While
+- {ref "rules-verification-statements"}[*Verification statements*] — \[⇒\] Assert, \[⇒\] Assume
+- {ref "rules-assignment"}[*Assignment*] — \[⇒\] Assign, \[⇐\] Assign
+- {ref "rules-calls"}[*Calls*] — \[⇒\] Static-Call, \[⇒\] Static-Call-Multi,
+  \[⇒\] Instance-Call, \[⇒\] Instance-Call-Multi
+- {ref "rules-primitive-operations"}[*Primitive operations*] — \[⇒\] Op-Bool, \[⇒\] Op-Cmp, \[⇒\] Op-Eq,
+  \[⇒\] Op-Arith, \[⇒\] Op-Concat; \[⇐\] Op-Arith, \[⇐\] Op-Bool
+- {ref "rules-object-forms"}[*Object forms*] — \[⇒\] New-Ok, \[⇒\] New-Fallback; \[⇒\] AsType; \[⇒\] IsType;
+  \[⇒\] RefEq; \[⇒\] PureFieldUpdate
+- {ref "rules-verification-expressions"}[*Verification expressions*] — \[⇒\] Quantifier, \[⇒\] Assigned, \[⇐\] Old,
+  \[⇒\] Old-Synth, \[⇒\] Fresh, \[⇐\] ProveBy, \[⇒\] ProveBy-Synth
+- {ref "rules-self-reference"}[*Self reference*] — \[⇒\] This-Inside, \[⇒\] This-Outside
+- {ref "rules-untyped-forms"}[*Untyped forms*] — \[⇒\] Abstract / All
+- {ref "rules-contract-of"}[*ContractOf*] — \[⇒\] ContractOf-Bool, \[⇒\] ContractOf-Set, \[⇒\] ContractOf-Error
+- {ref "rules-holes"}[*Holes*] — \[⇐\] Hole-Some, \[⇐\] Hole-None, \[⇒\] Hole-Synth-None, \[⇒\] Hole-Synth-Some
+- {ref "rules-procedure"}[*Procedure*] — Procedure
+
+### Subsumption
+%%%
+tag := "rules-subsumption"
+%%%
+
+$$`\frac{\Gamma \vdash e \Rightarrow A \quad A <: B}{\Gamma \vdash e \Leftarrow B} \quad \text{([⇐] Sub)}`
+
+Fallback in {name Strata.Laurel.Resolution.Check.resolveStmtExpr}`Check.resolveStmtExpr` whenever no bespoke check
+rule applies.
+
+### Literals
+%%%
+tag := "rules-literals"
+%%%
+
+$$`\frac{}{\Gamma \vdash \mathsf{LiteralInt}\;n \Rightarrow \mathsf{TInt}} \quad \text{([⇒] Lit-Int)}`
+
+{docstring Strata.Laurel.Resolution.Synth.litInt}
+
+$$`\frac{}{\Gamma \vdash \mathsf{LiteralBool}\;b \Rightarrow \mathsf{TBool}} \quad \text{([⇒] Lit-Bool)}`
+
+{docstring Strata.Laurel.Resolution.Synth.litBool}
+
+$$`\frac{}{\Gamma \vdash \mathsf{LiteralString}\;s \Rightarrow \mathsf{TString}} \quad \text{([⇒] Lit-String)}`
+
+{docstring Strata.Laurel.Resolution.Synth.litString}
+
+$$`\frac{}{\Gamma \vdash \mathsf{LiteralDecimal}\;d \Rightarrow \mathsf{TReal}} \quad \text{([⇒] Lit-Decimal)}`
+
+{docstring Strata.Laurel.Resolution.Synth.litDecimal}
+
+### Variables
+%%%
+tag := "rules-variables"
+%%%
+
+$$`\frac{\Gamma(x) = T}{\Gamma \vdash \mathsf{Var}\;(\mathsf{.Local}\;x) \Rightarrow T} \quad \text{([⇒] Var-Local)}`
+
+{docstring Strata.Laurel.Resolution.Synth.varLocal}
+
+$$`\frac{\Gamma \vdash e \Rightarrow \_ \quad \Gamma(f) = T_f}{\Gamma \vdash \mathsf{Var}\;(\mathsf{.Field}\;e\;f) \Rightarrow T_f} \quad \text{([⇒] Var-Field)}`
+
+{docstring Strata.Laurel.Resolution.Synth.varField}
+
+$$`\frac{x \notin \mathrm{dom}(\Gamma)}{\Gamma \vdash \mathsf{Var}\;(\mathsf{.Declare}\;\langle x, T_x\rangle) \Rightarrow \mathsf{TVoid} \quad \dashv \quad \Gamma, x : T_x} \quad \text{([⇒] Var-Declare)}`
+
+$`x \notin \mathrm{dom}(\Gamma)` is a soft side condition rather than a
+hard premise: when $`x` is already bound in the current scope the rule still
+fires, $`[\text{emits “Duplicate definition …”}]`, and extends the scope —
+but with an *unresolved* placeholder instead of $`x : T_x`, so later uses of
+$`x` don't cascade further type errors.
+
+{docstring Strata.Laurel.Resolution.Check.varDeclare}
+
+### Control flow
+%%%
+tag := "rules-control-flow"
+%%%
+
+$$`\frac{\Gamma \vdash \mathit{cond} \Leftarrow \mathsf{TBool} \quad \Gamma \vdash \mathit{thenBr} \Leftarrow T \quad \Gamma \vdash \mathit{elseBr} \Leftarrow T}{\Gamma \vdash \mathsf{IfThenElse}\;\mathit{cond}\;\mathit{thenBr}\;(\mathsf{some}\;\mathit{elseBr}) \Leftarrow T} \quad \text{([⇐] If)}`
+
+$$`\frac{\Gamma \vdash \mathit{cond} \Leftarrow \mathsf{TBool} \quad \Gamma \vdash \mathit{thenBr} \Leftarrow T \quad \mathsf{TVoid} <: T}{\Gamma \vdash \mathsf{IfThenElse}\;\mathit{cond}\;\mathit{thenBr}\;\mathsf{none} \Leftarrow T} \quad \text{([⇐] If-NoElse)}`
+
+{docstring Strata.Laurel.Resolution.Check.ifThenElse}
+
+When an `if` appears in *operand* position — where no expected type is
+available to push down (e.g. as an operand of $`==` / $`<` / $`+\!+`,
+whose operands are synthesized) — the synth counterpart fires instead.
+With an `else`, both branches are synthesized and their types must be
+mutually consistent ($`\sim`, the symmetric gradual relation);
+inconsistent branches $`[\text{emits “'if' branches have incompatible
+types X and Y”}]` and synthesize $`\mathsf{Unknown}`. The result is the
+join $`T_t \sqcup T_e` of the two branch types, so when one branch is a
+hole ($`\mathsf{Unknown}`) the join promotes to the other branch's
+concrete type, and the synthesized type is independent of branch order.
+Without an `else`, the missing branch cannot produce a value, so the `if`
+synthesizes $`\mathsf{TVoid}`.
+
+:::example "`if` in operand position"
+- `(if c then 1 else 2) == y` — both branches $`\mathsf{TInt}`, so the `if` synthesizes $`\mathsf{TInt}`
+- `if c then 1 else <?>` — the hole branch promotes; synthesizes $`\mathsf{TInt}`
+- `if c then 1 else "x"` — incompatible branches: *'if' branches have incompatible types 'int' and 'string'*, synthesizes $`\mathsf{Unknown}`
+- `if c then 1` (no `else`) — synthesizes $`\mathsf{TVoid}`
+:::
+
+$$`\frac{\Gamma \vdash \mathit{cond} \Leftarrow \mathsf{TBool} \quad \Gamma \vdash \mathit{thenBr} \Rightarrow T_t \quad \Gamma \vdash \mathit{elseBr} \Rightarrow T_e \quad T_t \sim T_e}{\Gamma \vdash \mathsf{IfThenElse}\;\mathit{cond}\;\mathit{thenBr}\;(\mathsf{some}\;\mathit{elseBr}) \Rightarrow T_t \sqcup T_e} \quad \text{([⇒] If-Synth)}`
+
+$$`\frac{\Gamma \vdash \mathit{cond} \Leftarrow \mathsf{TBool} \quad \Gamma \vdash \mathit{thenBr} \Rightarrow \_}{\Gamma \vdash \mathsf{IfThenElse}\;\mathit{cond}\;\mathit{thenBr}\;\mathsf{none} \Rightarrow \mathsf{TVoid}} \quad \text{([⇒] If-Synth-NoElse)}`
+
+{docstring Strata.Laurel.Resolution.Synth.ifThenElse}
+
+A non-empty block is typed by splitting its statement list into the
+*last* statement and the statements before it. The last statement
+carries the block's value and inherits the surrounding expected type;
+each earlier statement runs only for its effect — written
+$`\Gamma \vdash s\;\diamond` (*effect position*: the statement's value
+is discarded). The check and synth rules share this shape, differing
+only in how the last statement is treated:
+
+$$`\frac{\Gamma_0 = \Gamma \quad \Gamma_{i-1} \vdash s_i \;\diamond \;\dashv\; \Gamma_i \;\;(1 \le i \le n) \quad \Gamma_n \vdash \mathit{last} \Leftarrow T}{\Gamma \vdash \mathsf{Block}\;[s_1; \ldots; s_n; \mathit{last}]\;\mathit{label} \Leftarrow T} \quad \text{([⇐] Block)}`
+
+$$`\frac{\Gamma_0 = \Gamma \quad \Gamma_{i-1} \vdash s_i \;\diamond \;\dashv\; \Gamma_i \;\;(1 \le i \le n) \quad \Gamma_n \vdash \mathit{last} \Rightarrow T}{\Gamma \vdash \mathsf{Block}\;[s_1; \ldots; s_n; \mathit{last}]\;\mathit{label} \Rightarrow T} \quad \text{([⇒] Block-Synth)}`
+
+\[⇐\] Block fires whenever an expected type $`T` is supplied (procedure
+bodies, branches, loop bodies, assignment RHS, call arguments);
+\[⇒\] Block-Synth fires in operand position, where no expected type is
+available (e.g. $`\{\,x := 1;\; x\,\} == y`), synthesizing the last
+statement's type as the block's value type.
+
+When the block itself sits in statement position ($`T = \mathsf{TVoid}`)
+the last statement is in effect position too: its premise becomes
+$`\mathit{last}\;\diamond` rather than $`\mathit{last} \Leftarrow
+\mathsf{TVoid}`, so a trailing call discards its result and
+$`\{\ldots;\,\mathit{foo}()\}` type-checks as a statement even when
+`foo` returns a non-void type.
+
+The effect-position judgment $`\Gamma \vdash s\;\diamond` synthesizes
+the statement and discards the result:
+
+$$`\frac{\Gamma \vdash s \Rightarrow \_ \;\dashv\; \Gamma'}{\Gamma \vdash s \;\diamond \;\dashv\; \Gamma'} \quad \text{([⋄] Synth-Discard)}`
+
+Every expression in statement position is synthesized and its type
+discarded. Statement-shaped forms (`Var-Declare`, `Assign`, `Assert`,
+`Assume`, `While`, `Exit`, `Return`) synthesize $`\mathsf{TVoid}`;
+value-producing forms (calls, `IncrDecr`, literals, etc.) synthesize
+their natural type, which is then discarded. This means any expression
+is accepted in statement position — the `f(x);` idiom works regardless
+of `f`'s return type, and `x++;` is admitted even though `++`
+synthesizes the target's type.
+
+Only `Var (.Declare …)` actually extends the scope $`\Gamma_i`; every
+other statement leaves it unchanged. The block opens a fresh nested
+scope, so declarations made inside don't leak out — once the block ends,
+the surrounding $`\Gamma` is restored. It also emits a
+`"dead code after '<terminator>'"` diagnostic when an `Exit` or
+`Return` is followed by further statements in the same block.
+
+Pushing $`T` into the last statement (rather than synthesizing the whole
+block and applying \[⇐\] Sub at the boundary) means a type mismatch is
+reported at the offending subexpression's source location, and the
+expectation keeps propagating through nested `Block` / `IfThenElse` /
+`Hole` / `Quantifier` constructs that have their own check rules.
+
+$$`\frac{}{\Gamma \vdash \mathsf{Block}\;[]\;\mathit{label} \Rightarrow \mathsf{TVoid}} \quad \text{([⇒] Empty-Block)}`
+
+The empty block has a fixed type and is the only block-level rule that
+synthesizes unconditionally. \[⇐\] Block and \[⇒\] Block-Synth always
+split off a *last* statement, so they never reach an empty list; the
+empty case is hit only when the block is literally empty at the dispatch
+site. When an empty block appears in check position with
+`expected ≠ TVoid`, the standard \[⇐\] Sub rule fires at the boundary
+(`Check.resolveStmtExpr`'s subsumption-fallback wildcard arm, requiring
+$`\mathsf{TVoid} <: \mathit{expected}`).
+
+{docstring Strata.Laurel.Resolution.Synth.emptyBlock}
+
+{docstring Strata.Laurel.Resolution.Synth.block}
+
+{docstring Strata.Laurel.Resolution.Check.block}
+
+The $`\Gamma \vdash s\;\diamond` judgment — the \[⋄\] Synth-Discard
+rule above — is the single definition of what counts as a statement in
+effect position, factored out into
+{name Strata.Laurel.Resolution.Check.statement}`Check.statement`:
+
+{docstring Strata.Laurel.Resolution.Check.statement}
+
+$$`\frac{l \in \Gamma_{\mathrm{lbl}}}{\Gamma \vdash \mathsf{Exit}\;l \Rightarrow \mathsf{TVoid}} \quad \text{([⇒] Exit)}`
+
+`exit` is an unconditional jump out of the enclosing labeled block.
+It synthesizes $`\mathsf{TVoid}` unconditionally. Labels live in their
+own namespace $`\Gamma_{\mathrm{lbl}}`, populated by the surrounding
+`Block` rule when its $`\mathit{label}` is `some l`. An
+$`\mathsf{Exit}\;l` targeting a label not in $`\Gamma_{\mathrm{lbl}}`
+is rejected.
+
+{docstring Strata.Laurel.Resolution.Check.exit}
+
+In the Return rules below, $`\overline{T_o}` denotes the declared
+output-parameter type list of the enclosing procedure (an implicit
+parameter of the rules — the procedure binds it once on entry).
+
+$$`\frac{\overline{T_o} = []}{\Gamma \vdash \mathsf{Return}\;\mathsf{none} \Rightarrow \mathsf{TVoid}} \quad \text{([⇒] Return-None-Void)}`
+
+$$`\frac{\overline{T_o} = [T]}{\Gamma \vdash \mathsf{Return}\;\mathsf{none} \Rightarrow \mathsf{TVoid}} \quad \text{([⇒] Return-None-Single)}`
+
+$$`\frac{\overline{T_o} = [T_1; \ldots; T_n] \quad (n \ge 2)}{\Gamma \vdash \mathsf{Return}\;\mathsf{none} \Rightarrow \mathsf{TVoid}} \quad \text{([⇒] Return-None-Multi)}`
+
+$$`\frac{\overline{T_o} = [T] \quad \Gamma \vdash e \Leftarrow T}{\Gamma \vdash \mathsf{Return}\;(\mathsf{some}\;e) \Rightarrow \mathsf{TVoid}} \quad \text{([⇒] Return-Some)}`
+
+$$`\frac{\overline{T_o} = []}{\Gamma \vdash \mathsf{Return}\;(\mathsf{some}\;e) \rightsquigarrow \text{error: “void procedure cannot return a value”}} \quad \text{([⇒] Return-Void-Error)}`
+
+$$`\frac{\overline{T_o} = [T_1; \ldots; T_n] \quad (n \ge 2)}{\Gamma \vdash \mathsf{Return}\;(\mathsf{some}\;e) \rightsquigarrow \text{error: “multi-output procedure cannot use 'return e'; assign to named outputs instead”}} \quad \text{([⇒] Return-Multi-Error)}`
+
+`return` is the only rule whose premises depend on the enclosing
+procedure's declared outputs. The rule synthesizes $`\mathsf{TVoid}`
+because `return` is a control-flow terminator: it never falls through
+and produces no value for the surrounding context. The returned value
+(if any) is checked against the procedure's declared output. The error
+arms fire when $`\overline{T_o}`'s arity does not match the syntactic
+shape of `return e`.
+
+Regardless of which arm fires, $`e` is always elaborated — it is
+checked against the declared output in the single-output case,
+otherwise synthesized — so any errors inside $`e` are reported in
+addition to the arity diagnostic.
+
+The three Return-None rules all accept `return;` unconditionally.
+Void-output procedures accept it naturally (Return-None-Void);
+single-output procedures accept it without a subtype check
+(Return-None-Single); multi-output procedures accept it as an
+early-exit shorthand that leaves the named outputs at whatever they
+were last assigned to (Return-None-Multi).
+
+When the surrounding context has no enclosing procedure body (e.g.
+inside a constant initializer), `answerType = none` and all Return
+checks are skipped; well-formed input never produces this case.
+
+{docstring Strata.Laurel.Resolution.Check.return}
+
+$$`\frac{\Gamma \vdash \mathit{cond} \Leftarrow \mathsf{TBool} \quad \Gamma \vdash \mathit{invs}_i \Leftarrow \mathsf{TBool} \quad \Gamma \vdash \mathit{decreases} \Rightarrow U \quad \mathsf{Numeric}\;U \quad \Gamma \vdash \mathit{body} \Leftarrow \mathsf{Unknown}}{\Gamma \vdash \mathsf{While}\;\mathit{cond}\;\mathit{invs}\;\mathit{decreases}\;\mathit{body} \Rightarrow \mathsf{TVoid}} \quad \text{([⇒] While)}`
+
+The body is checked at $`\mathsf{Unknown}`: control either re-enters
+the loop or falls through, so the body's value type is never observed
+by the surrounding context. A loop is a statement and yields no value,
+so the rule synthesizes $`\mathsf{TVoid}`.
+
+The optional $`\mathit{decreases}` clause is synthesized and required
+to have a numeric type via the same $`\mathsf{Numeric}` predicate
+used by the arithmetic primitive operations. $`\mathsf{Numeric}` is
+a predicate (it admits $`\mathsf{TInt}`, $`\mathsf{TReal}`,
+$`\mathsf{TFloat64}`, $`\mathsf{TBv}_w` (a bitvector of any width), and
+$`\mathsf{Unknown}` as the gradual escape hatch), not a single type, so
+the clause runs in synth mode rather than check mode.
+
+{docstring Strata.Laurel.Resolution.Check.while}
+
+### Verification statements
+%%%
+tag := "rules-verification-statements"
+%%%
+
+$$`\frac{\Gamma \vdash \mathit{cond} \Leftarrow \mathsf{TBool}}{\Gamma \vdash \mathsf{Assert}\;\mathit{cond} \Rightarrow \mathsf{TVoid}} \quad \text{([⇒] Assert)}`
+
+{docstring Strata.Laurel.Resolution.Check.assert}
+
+$$`\frac{\Gamma \vdash \mathit{cond} \Leftarrow \mathsf{TBool}}{\Gamma \vdash \mathsf{Assume}\;\mathit{cond} \Rightarrow \mathsf{TVoid}} \quad \text{([⇒] Assume)}`
+
+{docstring Strata.Laurel.Resolution.Check.assume}
+
+### Assignment
+%%%
+tag := "rules-assignment"
+%%%
+
+$$`\frac{\Gamma \vdash \mathit{targets}_i \Rightarrow T_i \quad \Gamma \vdash e \Leftarrow \mathit{ExpectedTy}}{\Gamma \vdash \mathsf{Assign}\;\mathit{targets}\;e \Rightarrow \mathit{ExpectedTy}} \quad \text{([⇒] Assign)}`
+
+where `ExpectedTy = T_1` if `|targets| = 1` and `MultiValuedExpr [T_1; …; T_n]` otherwise.
+The target's declared type `T_i` comes from the variable's scope entry (for
+{name Strata.Laurel.Variable.Local}`Local` and {name Strata.Laurel.Variable.Field}`Field`)
+or from the {name Strata.Laurel.Variable.Declare}`Declare`-bound parameter type. The
+RHS receives `ExpectedTy` via `Check.resolveStmtExpr`, so bidirectional rules in the
+RHS propagate the assignment's type into nested constructs. The
+assignment synthesizes `ExpectedTy` — populating the surrounding
+context with the target's type while the RHS is checked against it.
+
+{docstring Strata.Laurel.Resolution.Synth.assign}
+
+$$`\frac{\Gamma \vdash \mathsf{Assign}\;\mathit{targets}\;e \Rightarrow \mathit{ExpectedTy} \quad T = \mathsf{TVoid} \lor \mathit{ExpectedTy} <: T}{\Gamma \vdash \mathsf{Assign}\;\mathit{targets}\;e \Leftarrow T} \quad \text{([⇐] Assign)}`
+
+The check rule synthesizes the assignment's type via \[⇒\] Assign
+and then runs the standard \[⇐\] Sub boundary check `ExpectedTy <: T`
+— *unless* `T = TVoid`, the marker for statement position. Pushing
+`TVoid` through subsumption would only succeed when the LHS is itself
+void, which would reject every non-void assignment used as a
+statement, so the subsumption is skipped and the synthesized value is
+discarded.
+
+{docstring Strata.Laurel.Resolution.Check.assign}
+
+### Calls
+%%%
+tag := "rules-calls"
+%%%
+
+$$`\frac{\Gamma(\mathit{callee}) = \text{static-procedure with inputs } Ts \text{ and output } [T'] \text{ (single output)} \quad \Gamma \vdash \mathit{args}_i \Leftarrow Ts_i \text{ (pairwise)}}{\Gamma \vdash \mathsf{StaticCall}\;\mathit{callee}\;\mathit{args} \Rightarrow T'} \quad \text{([⇒] Static-Call)}`
+
+$$`\frac{\Gamma(\mathit{callee}) = \text{static-procedure with inputs } Ts \text{ and outputs } [T_1; \ldots; T_n],\; n \ge 2 \quad \Gamma \vdash \mathit{args}_i \Leftarrow Ts_i \text{ (pairwise)}}{\Gamma \vdash \mathsf{StaticCall}\;\mathit{callee}\;\mathit{args} \Rightarrow \mathsf{MultiValuedExpr}\;[T_1; \ldots; T_n]} \quad \text{([⇒] Static-Call-Multi)}`
+
+{docstring Strata.Laurel.Resolution.Synth.staticCall}
+
+$$`\frac{\Gamma \vdash \mathit{target} \Rightarrow \_ \quad \Gamma(\mathit{callee}) = \text{instance- or static-procedure with inputs } [\mathit{self}; Ts] \text{ and output } [T'] \text{ (single output)} \quad \Gamma \vdash \mathit{args}_i \Leftarrow Ts_i \text{ (pairwise; self dropped)}}{\Gamma \vdash \mathsf{InstanceCall}\;\mathit{target}\;\mathit{callee}\;\mathit{args} \Rightarrow T'} \quad \text{([⇒] Instance-Call)}`
+
+$$`\frac{\Gamma \vdash \mathit{target} \Rightarrow \_ \quad \Gamma(\mathit{callee}) = \text{instance- or static-procedure with inputs } [\mathit{self}; Ts] \text{ and outputs } [T_1; \ldots; T_n],\; n \ge 2 \quad \Gamma \vdash \mathit{args}_i \Leftarrow Ts_i \text{ (pairwise; self dropped)}}{\Gamma \vdash \mathsf{InstanceCall}\;\mathit{target}\;\mathit{callee}\;\mathit{args} \Rightarrow \mathsf{MultiValuedExpr}\;[T_1; \ldots; T_n]} \quad \text{([⇒] Instance-Call-Multi)}`
 
-Laurel programs are verified by translating them to Strata Core and then invoking the Core
-verification pipeline. The translation involves several passes, each transforming the Laurel
-program before the final conversion to Core.
+The callee is resolved against either an instance procedure or a
+static procedure (the latter handles uniformly-dispatched call syntax
+where the receiver is forwarded as `self`). Output arity is forwarded
+identically to
+{name Strata.Laurel.Resolution.Synth.staticCall}`Synth.staticCall`'s
+single-vs-multi split. In both call families the single- and multi-output
+rules differ only in the *output* arity; argument checking is the same, and
+surplus arguments (beyond the declared parameters, or when the callee is
+unresolved) are checked against $`\mathsf{Unknown}` rather than flagged as an
+arity error. A zero-output ($`n = 0`) procedure call is the third case in the
+arity split: it synthesizes $`\mathsf{TVoid}` rather than a
+$`\mathsf{MultiValuedExpr}`.
 
-## Heap Parameterization
+{docstring Strata.Laurel.Resolution.Synth.instanceCall}
 
-The heap parameterization pass transforms procedures that interact with the heap by adding
-explicit heap parameters. The heap is modeled as `Map Composite (Map Field Box)`, where
-`Box` is a tagged union with constructors for each primitive type.
+### Primitive operations
+%%%
+tag := "rules-primitive-operations"
+%%%
+
+`Numeric` abbreviates "consistent with one of {name Strata.Laurel.HighType.TInt}`TInt`,
+{name Strata.Laurel.HighType.TReal}`TReal`,
+{name Strata.Laurel.HighType.TFloat64}`TFloat64`, or
+{name Strata.Laurel.HighType.TBv}`TBv` (a bitvector of any width)", with
+`Unknown` admitted as the gradual escape hatch.
+
+$$`\frac{\Gamma \vdash \mathit{args}_i \Rightarrow U_i \quad U_i <: \mathsf{TBool} \quad \mathit{op} \in \{\mathsf{And}, \mathsf{Or}, \mathsf{AndThen}, \mathsf{OrElse}, \mathsf{Not}, \mathsf{Implies}\}}{\Gamma \vdash \mathsf{PrimitiveOp}\;\mathit{op}\;\mathit{args} \Rightarrow \mathsf{TBool}} \quad \text{([⇒] Op-Bool)}`
+
+$$`\frac{\Gamma \vdash \mathit{args}_i \Rightarrow U_i \quad \mathsf{Numeric}\;U_i \quad \mathit{op} \in \{\mathsf{Lt}, \mathsf{Leq}, \mathsf{Gt}, \mathsf{Geq}\}}{\Gamma \vdash \mathsf{PrimitiveOp}\;\mathit{op}\;\mathit{args} \Rightarrow \mathsf{TBool}} \quad \text{([⇒] Op-Cmp)}`
+
+$$`\frac{\Gamma \vdash \mathit{lhs} \Rightarrow T_l \quad \Gamma \vdash \mathit{rhs} \Rightarrow T_r \quad T_l \sim T_r \quad \mathit{op} \in \{\mathsf{Eq}, \mathsf{Neq}\}}{\Gamma \vdash \mathsf{PrimitiveOp}\;\mathit{op}\;[\mathit{lhs}; \mathit{rhs}] \Rightarrow \mathsf{TBool}} \quad \text{([⇒] Op-Eq)}`
+
+$$`\frac{\Gamma \vdash \mathit{args}_i \Rightarrow U_i \quad \mathsf{Numeric}\;U_i \quad T = \bigsqcup_i U_i \text{ (consistency join)} \quad \mathit{op} \in \{\mathsf{Neg}, \mathsf{Add}, \mathsf{Sub}, \mathsf{Mul}, \mathsf{Div}, \mathsf{Mod}, \mathsf{DivT}, \mathsf{ModT}\}}{\Gamma \vdash \mathsf{PrimitiveOp}\;\mathit{op}\;\mathit{args} \Rightarrow T} \quad \text{([⇒] Op-Arith)}`
+
+The arithmetic synth rule mirrors $`[⇒]\,\text{Op-Eq}` but generalised
+to $`n` operands. Each operand is synthesized and required to be
+$`\mathsf{Numeric}` (i.e. $`\mathsf{TInt}`, $`\mathsf{TReal}`,
+$`\mathsf{TFloat64}`, $`\mathsf{TBv}_w` (a bitvector of any width), or
+the gradual $`\mathsf{Unknown}`). The
+result type is the *consistency join* $`\bigsqcup_i U_i` — a fold of
+the operand types under
+{name Strata.Laurel.isConsistent}`isConsistent`'s flat lattice:
+$`\mathsf{Unknown} \sqcup T = T`, $`T \sqcup T = T`, and any other
+combination is rejected. The fold runs via `join`, a pure function, so
+the search has no diagnostic side-effects.
+
+:::example "Arithmetic operand join"
+- `1 + 2` synthesizes $`\mathsf{TInt}`
+- `1.5 + 2.5` synthesizes $`\mathsf{TReal}`
+- `<?> + 1` synthesizes $`\mathsf{TInt}` — the $`\mathsf{Unknown}` operand promotes to its neighbour
+- `<?> + <?>` synthesizes $`\mathsf{Unknown}`
+- `1 + 2.0` is rejected: *cannot apply '+' to operands of types 'int', 'real'*
+:::
+
+$$`\frac{\Gamma \vdash \mathit{args}_i \Rightarrow U_i \quad U_i <: \mathsf{TString} \quad \mathit{op} = \mathsf{StrConcat}}{\Gamma \vdash \mathsf{PrimitiveOp}\;\mathit{op}\;\mathit{args} \Rightarrow \mathsf{TString}} \quad \text{([⇒] Op-Concat)}`
+
+{docstring Strata.Laurel.Resolution.Synth.primitiveOp}
+
+The arithmetic and boolean families also have a check-mode rule, used
+when the surrounding context provides an `expected` type. The rule
+pushes the operand type into each operand via
+`Check.resolveStmtExpr`, replacing the synth-then-`checkSubtype`
+discipline with bidirectional check.
+
+$$`\frac{\mathsf{Numeric}\;T \quad \Gamma \vdash \mathit{args}_i \Leftarrow T \quad \mathit{op} \in \{\mathsf{Neg}, \mathsf{Add}, \mathsf{Sub}, \mathsf{Mul}, \mathsf{Div}, \mathsf{Mod}, \mathsf{DivT}, \mathsf{ModT}\}}{\Gamma \vdash \mathsf{PrimitiveOp}\;\mathit{op}\;\mathit{args} \Leftarrow T} \quad \text{([⇐] Op-Arith)}`
+
+$$`\frac{\mathsf{TBool} <: T \quad \Gamma \vdash \mathit{args}_i \Leftarrow \mathsf{TBool} \quad \mathit{op} \in \{\mathsf{And}, \mathsf{Or}, \mathsf{AndThen}, \mathsf{OrElse}, \mathsf{Not}, \mathsf{Implies}\}}{\Gamma \vdash \mathsf{PrimitiveOp}\;\mathit{op}\;\mathit{args} \Leftarrow T} \quad \text{([⇐] Op-Bool)}`
+
+{docstring Strata.Laurel.Resolution.Check.primitiveOp}
+
+### Object forms
+%%%
+tag := "rules-object-forms"
+%%%
+
+$$`\frac{\mathit{ref} \text{ is a composite or datatype, or is unresolved, or is absent from } \Gamma}{\Gamma \vdash \mathsf{New}\;\mathit{ref} \Rightarrow \mathsf{UserDefined}\;\mathit{ref}} \quad \text{([⇒] New-Ok)}`
+
+$$`\frac{\mathit{ref} \text{ resolves to a non-type kind}}{\Gamma \vdash \mathsf{New}\;\mathit{ref} \Rightarrow \mathsf{Unknown}} \quad \text{([⇒] New-Fallback)}`
+
+The $`\mathsf{Unknown}` fallback fires *only* when $`\mathit{ref}` resolves to
+a present definition whose kind is neither composite nor datatype. An
+unresolved or out-of-scope $`\mathit{ref}` takes the New-Ok branch instead, so
+the kind diagnostic that `resolveRef` already emitted is not duplicated.
+
+{docstring Strata.Laurel.Resolution.Synth.new}
+
+$$`\frac{\Gamma \vdash \mathit{target} \Rightarrow U \quad U \sim T \lor U <: T \lor T <: U}{\Gamma \vdash \mathsf{AsType}\;\mathit{target}\;T \Rightarrow T} \quad \text{([⇒] AsType)}`
+
+{docstring Strata.Laurel.Resolution.Synth.asType}
+
+$$`\frac{\Gamma \vdash \mathit{target} \Rightarrow U \quad U \sim T \lor U <: T \lor T <: U}{\Gamma \vdash \mathsf{IsType}\;\mathit{target}\;T \Rightarrow \mathsf{TBool}} \quad \text{([⇒] IsType)}`
+
+{docstring Strata.Laurel.Resolution.Synth.isType}
+
+$$`\frac{\Gamma \vdash \mathit{lhs} \Rightarrow T_l \quad \Gamma \vdash \mathit{rhs} \Rightarrow T_r \quad \mathsf{isReference}\;T_l \quad \mathsf{isReference}\;T_r \quad T_l \sim T_r}{\Gamma \vdash \mathsf{ReferenceEquals}\;\mathit{lhs}\;\mathit{rhs} \Rightarrow \mathsf{TBool}} \quad \text{([⇒] RefEq)}`
+
+`isReference T` holds when `T` is a {name Strata.Laurel.HighType.UserDefined}`UserDefined`
+or {name Strata.Laurel.HighType.Unknown}`Unknown` type. `~` is the consistency relation
+{name Strata.Laurel.isConsistent}`isConsistent` — symmetric, with the
+{name Strata.Laurel.HighType.Unknown}`Unknown` wildcard.
+
+{docstring Strata.Laurel.Resolution.Synth.refEq}
+
+$$`\frac{\Gamma \vdash \mathit{target} \Rightarrow T_t \quad \Gamma(f) = T_f \quad \Gamma \vdash \mathit{newVal} \Leftarrow T_f}{\Gamma \vdash \mathsf{PureFieldUpdate}\;\mathit{target}\;f\;\mathit{newVal} \Rightarrow T_t} \quad \text{([⇒] PureFieldUpdate)}`
+
+{docstring Strata.Laurel.Resolution.Synth.pureFieldUpdate}
+
+### Verification expressions
+%%%
+tag := "rules-verification-expressions"
+%%%
+
+$$`\frac{\Gamma, x : T \vdash \mathit{body} \Leftarrow \mathsf{TBool}}{\Gamma \vdash \mathsf{Quantifier}\;\mathit{mode}\;\langle x, T\rangle\;\mathit{trig}\;\mathit{body} \Rightarrow \mathsf{TBool}} \quad \text{([⇒] Quantifier)}`
+
+{docstring Strata.Laurel.Resolution.Synth.quantifier}
+
+$$`\frac{\Gamma \vdash \mathit{name} \Rightarrow \_}{\Gamma \vdash \mathsf{Assigned}\;\mathit{name} \Rightarrow \mathsf{TBool}} \quad \text{([⇒] Assigned)}`
+
+{docstring Strata.Laurel.Resolution.Synth.assigned}
+
+$$`\frac{\Gamma \vdash v \Leftarrow T}{\Gamma \vdash \mathsf{Old}\;v \Leftarrow T} \quad \text{([⇐] Old)}`
+
+{docstring Strata.Laurel.Resolution.Check.old}
+
+`old` is type-transparent, so it also synthesizes: in operand position
+(e.g. the postcondition pattern `ensures counter.value == old(counter.value) + 1`,
+where $`==` synthesizes its operands) $`v` is synthesized and its type
+returned unchanged.
+
+$$`\frac{\Gamma \vdash v \Rightarrow T}{\Gamma \vdash \mathsf{Old}\;v \Rightarrow T} \quad \text{([⇒] Old-Synth)}`
+
+{docstring Strata.Laurel.Resolution.Synth.old}
+
+$$`\frac{\Gamma \vdash v \Rightarrow T \quad \mathsf{isReference}\;T}{\Gamma \vdash \mathsf{Fresh}\;v \Rightarrow \mathsf{TBool}} \quad \text{([⇒] Fresh)}`
+
+{docstring Strata.Laurel.Resolution.Synth.fresh}
+
+$$`\frac{\Gamma \vdash v \Leftarrow T \quad \Gamma \vdash \mathit{proof} \Rightarrow \_}{\Gamma \vdash \mathsf{ProveBy}\;v\;\mathit{proof} \Leftarrow T} \quad \text{([⇐] ProveBy)}`
+
+{docstring Strata.Laurel.Resolution.Check.proveBy}
+
+Like `old`, `ProveBy` is type-transparent in `v`, so it also
+synthesizes: in operand position $`v` is synthesized for its type $`T`,
+$`\mathit{proof}` is synthesized only for its name-resolution side
+effects (its type discarded), and $`T` is returned.
+
+$$`\frac{\Gamma \vdash v \Rightarrow T \quad \Gamma \vdash \mathit{proof} \Rightarrow \_}{\Gamma \vdash \mathsf{ProveBy}\;v\;\mathit{proof} \Rightarrow T} \quad \text{([⇒] ProveBy-Synth)}`
+
+{docstring Strata.Laurel.Resolution.Synth.proveBy}
+
+### Self reference
+%%%
+tag := "rules-self-reference"
+%%%
+
+$$`\frac{\Gamma.\mathit{instanceTypeName} = \mathsf{some}\;T}{\Gamma \vdash \mathsf{This} \Rightarrow \mathsf{UserDefined}\;T} \quad \text{([⇒] This-Inside)}`
+
+$$`\frac{\Gamma.\mathit{instanceTypeName} = \mathsf{none}}{\Gamma \vdash \mathsf{This} \Rightarrow \mathsf{Unknown} \quad [\text{emits “‘this’ is not allowed outside instance methods”}]} \quad \text{([⇒] This-Outside)}`
+
+{docstring Strata.Laurel.Resolution.Synth.this}
+
+### Untyped forms
+%%%
+tag := "rules-untyped-forms"
+%%%
+
+$$`\frac{}{\Gamma \vdash \mathsf{Abstract}\,/\,\mathsf{All}\;\ldots \Rightarrow \mathsf{Unknown}} \quad \text{([⇒] Abstract / All)}`
+
+{docstring Strata.Laurel.Resolution.Synth.abstract}
+
+{docstring Strata.Laurel.Resolution.Synth.all}
+
+### ContractOf
+%%%
+tag := "rules-contract-of"
+%%%
+
+$$`\frac{\mathit{fn} = \mathsf{Var}\;(\mathsf{.Local}\;\mathit{id}) \quad \Gamma(\mathit{id}) \in \{\mathit{staticProcedure}, \mathit{instanceProcedure}, \mathit{unresolved}\}}{\Gamma \vdash \mathsf{ContractOf}\;\mathsf{Precondition}\;\mathit{fn} \Rightarrow \mathsf{TBool} \qquad \Gamma \vdash \mathsf{ContractOf}\;\mathsf{PostCondition}\;\mathit{fn} \Rightarrow \mathsf{TBool}} \quad \text{([⇒] ContractOf-Bool)}`
+
+$$`\frac{\mathit{fn} = \mathsf{Var}\;(\mathsf{.Local}\;\mathit{id}) \quad \Gamma(\mathit{id}) \in \{\mathit{staticProcedure}, \mathit{instanceProcedure}, \mathit{unresolved}\}}{\Gamma \vdash \mathsf{ContractOf}\;\mathsf{Reads}\;\mathit{fn} \Rightarrow \mathsf{TSet}\;\mathsf{Unknown} \qquad \Gamma \vdash \mathsf{ContractOf}\;\mathsf{Modifies}\;\mathit{fn} \Rightarrow \mathsf{TSet}\;\mathsf{Unknown}} \quad \text{([⇒] ContractOf-Set)}`
+
+$$`\frac{\mathit{fn} \text{ is not a } \mathsf{Var}\;(\mathsf{.Local}) \text{ resolving to a procedure or unresolved name}}{\Gamma \vdash \mathsf{ContractOf}\;\ldots\;\mathit{fn} \rightsquigarrow \text{error: “‘contractOf’ expected a procedure reference”}} \quad \text{([⇒] ContractOf-Error)}`
+
+The $`\mathit{unresolved}` kind is admitted so an already-reported
+name-resolution error is not duplicated; ContractOf-Error fires only when
+$`\mathit{fn}` resolves to a *present* non-procedure definition (or is not a
+local reference at all).
+
+{docstring Strata.Laurel.Resolution.Synth.contractOf}
+
+### Holes
+%%%
+tag := "rules-holes"
+%%%
+
+$$`\frac{T_h <: T}{\Gamma \vdash \mathsf{Hole}\;d\;(\mathsf{some}\;T_h) \Leftarrow T} \quad \text{([⇐] Hole-Some)}`
+
+{docstring Strata.Laurel.Resolution.Check.holeSome}
+
+$$`\frac{}{\Gamma \vdash \mathsf{Hole}\;d\;\mathsf{none} \Leftarrow T \quad \mapsto \quad \mathsf{Hole}\;d\;(\mathsf{some}\;T)} \quad \text{([⇐] Hole-None)}`
+
+{docstring Strata.Laurel.Resolution.Check.holeNone}
+
+In synth position no expected type is available to push into the hole, so
+an unannotated hole synthesizes the gradual $`\mathsf{Unknown}` while an
+annotated hole synthesizes its annotation $`T_h` (this is what lets
+`<?> + 1` synthesize $`\mathsf{TInt}`).
 
-Procedures that write the heap receive both an input and output heap parameter. Procedures
-that only read the heap receive an input heap parameter. Field reads and writes are rewritten
-to use `readField` and `updateField` functions.
+$$`\frac{}{\Gamma \vdash \mathsf{Hole}\;d\;\mathsf{none} \Rightarrow \mathsf{Unknown}} \quad \text{([⇒] Hole-Synth-None)}`
 
-## Modifies Clauses
+$$`\frac{}{\Gamma \vdash \mathsf{Hole}\;d\;(\mathsf{some}\;T_h) \Rightarrow T_h} \quad \text{([⇒] Hole-Synth-Some)}`
 
-The modifies clause transformation translates modifies clauses into additional ensures
-clauses. The modifies clause of a procedure is translated into a quantified assertion that
-states that objects not mentioned in the modifies clause have their field values preserved
-between the input and output heap.
+### Procedure
+%%%
+tag := "rules-procedure"
+%%%
+
+A procedure body is synthesized (not checked against a computed
+expected type) and is resolved under a scope that includes the
+procedure's input and output parameters. The Return rules above refer
+to the same output list $`\overline{T_o}` that the procedure binds
+here.
+
+$$`\frac{\overline{T_o} = \mathit{proc}.\mathit{outputs}.\mathit{types} \quad \Gamma_\mathit{global},\,\mathit{params}(\mathit{proc}) \vdash \mathit{proc}.\mathit{body} \Rightarrow \_}{\Gamma_\mathit{global} \vdash \mathsf{Procedure}\;\mathit{proc}} \quad \text{(Procedure)}`
+
+The body is synthesized and its type is discarded — there is no
+constraint from the output list pushed into the body. Outputs are
+matched only via `return e` (checked against $`\overline{T_o}` by
+{name Strata.Laurel.Resolution.Check.return}`Check.return`) or via
+named-output assignment.
+
+{docstring Strata.Laurel.resolveProcedure}
+
+{docstring Strata.Laurel.resolveInstanceProcedure}
+
+# Implementation
+
+The static semantics of Laurel are defined by `Resolution.lean`. This is where Laurel references are resolved and where type checking is done. Calling `resolve` will produce diagnostics and a `SemanticModel` that can be used to navigate between definitions and references.
+If new references or definitions are created during compilation, `resolve` must be called again to get a complete model.
+
+## Translation Pipeline
+
+The Laurel to Core translation pipeline uses these IRs:
+- Laurel
+- UnorderedCoreWithLaurelTypes
+- CoreWithLaurelTypes
+- Core
+
+Most of the passes are in the Laurel IR.
+The transparency pass goes from `Laurel` to `UnorderedCoreWithLaurelTypes`.
+The CoreGroupingAndOrdering goes from `UnorderedCoreWithLaurelTypes` to `CoreWithLaurelTypes`
+And the LaurelToCoreSchemaPass goes from `CoreWithLaurelTypes` to `Core`.
+
+## Passes
 
-## Lifting Expression Assignments
+The following passes making up the compilation of Laurel to Core:
 
-The expression assignment lifting pass transforms assignments that appear in expression
-contexts into preceding statements. This is necessary because Strata Core does not support
-assignments within expressions.
+{laurelPipelineDocs}
+
+## Pass Dependency Graph
+
+The following graph shows the ordering constraints between passes.
+
+{laurelPipelineDependencyGraph}
+
+# Differences between Laurel and Core
+
+## Language design
+
+### Parameter lists
+Parameter lists. In Laurel, input and output parameters are defined in a separate list. Inout parameters are defined by repeating the parameter name in both lists. In Core, there is a single parameter list where each parameter defines its kind (in/out/inout).
+
+At the call-site, Laurel requires calls with multiple out parameters to occur inside an assignment, like this:
+`assign x, y := multiOutCall(a, b)`
+Core uses the argument list to assign the output parameters, like this:
+`multiOutCall(a, b, out x, out y)`
+
+In Laurel, an inout parameter only influences the callee's code, since it means there is a single variable that is used as input and output. On the calling side however, there is no concept of inout parameters. This is different from Core, where inout variables affect the calling side. Example of an inout being called in Core, `hasInout(inout x)`.
+
+### Assignments to fresh and existing declarations
+In Laurel, assignments can have multiple targets. Each target can be either an existing variable or a local declaration. Example:
+```
+var x: int;
+var z: int;
+assign x, var y: int, z := hasThreeOutputs()
+```
+In Core, when calling a procedure with multiple outputs, each output parameter must be assigned to an existing local variable. Example:
+```
+var x: int;
+var y: int;
+var z: int;
+hasThreeOutputs(out x, out y, out z);
+```
 
-## Translation to Core
+## Implementation
 
-The final translation converts Laurel types, expressions, statements, and procedures into
-their Strata Core equivalents. Procedures with bodies that only have constructs supported by
-Core expressions are translated to a Core function, while other procedures become Core
-procedures.
+In Laurel, all verification concepts, such as assume statements, pre and postconditions, and transparency of procedures, are part of the language. In Core however, there is the concept of metadata. Concepts that relate to only one or a few analyses might not be considered concepts of the Core language, and will then be represented using metadata instead of being given a typed representation in the AST.
diff --git a/editors/emacs/core-st-mode.el b/editors/emacs/core-st-mode.el
index 4bb318b96a..0401e340ba 100644
--- a/editors/emacs/core-st-mode.el
+++ b/editors/emacs/core-st-mode.el
@@ -8,8 +8,8 @@
   '(    "var" "assume" "assert" "cover" "if" "else" "havoc" "invariant"
     "decreases" "while" "out" "inout" "call" "exit" "free" "ensures"
     "requires" "spec" "procedure" "type" "const" "function" "inline"
-    "rec" "axiom" "distinct" "datatype" "old" "forall" "exists"
-    "program"))
+    "rec" "axiom" "distinct" "datatype" "goto" "cfg" "old" "forall"
+    "exists" "program"))
 
 (defvar core-st-types
   '(    "bool" "int" "string" "regex" "real" "bv1" "bv8" "bv16" "bv32"
diff --git a/editors/vscode/syntaxes/core-st.tmLanguage.json b/editors/vscode/syntaxes/core-st.tmLanguage.json
index 8ab843ae94..a49f10eba1 100644
--- a/editors/vscode/syntaxes/core-st.tmLanguage.json
+++ b/editors/vscode/syntaxes/core-st.tmLanguage.json
@@ -57,7 +57,7 @@
     },
     "keyword": {
       "name": "keyword.core-st",
-      "match": "\\b(var|assume|assert|cover|if|else|havoc|invariant|decreases|while|out|inout|call|exit|free|ensures|requires|spec|procedure|type|const|function|inline|rec|axiom|distinct|datatype|old|forall|exists|program)\\b"
+      "match": "\\b(var|assume|assert|cover|if|else|havoc|invariant|decreases|while|out|inout|call|exit|free|ensures|requires|spec|procedure|type|const|function|inline|rec|axiom|distinct|datatype|goto|cfg|old|forall|exists|program)\\b"
     },
     "type": {
       "name": "support.type.core-st",