diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS
index fefafe3e50..100fecf654 100644
--- a/.github/CODEOWNERS
+++ b/.github/CODEOWNERS
@@ -12,6 +12,9 @@
 ### Area access
 # Each area maintainer has access to parts that pertain them. They get automatically asked for
 # reviewing new PRs that touch those areas.
-/Cslib/Languages/LambdaCalculus/ @chenson2018
+/Cslib/Algorithms/ @fmontesi @sorrachai @chenson2018
+/Cslib/Foundations/Logic/ @arademaker @fmontesi @chenson2018
+/Cslib/Logics/ @arademaker @fmontesi @chenson2018
+/Cslib/Languages/LambdaCalculus/ @chenson2018 @fmontesi
 /.github/workflows @kim-em @fmontesi @chenson2018
 /scripts @kim-em @fmontesi @chenson2018
diff --git a/.github/workflows/lake-update.yml b/.github/workflows/lake-update.yml
index 33271b968a..0bd989b6c9 100644
--- a/.github/workflows/lake-update.yml
+++ b/.github/workflows/lake-update.yml
@@ -25,6 +25,7 @@ on:
 jobs:
   bump:
     runs-on: ubuntu-latest
+    if: github.repository == 'leanprover/cslib'
     steps:
       - name: Generate app token
         id: app-token
@@ -52,6 +53,7 @@ jobs:
 
   open-issue:
     runs-on: ubuntu-latest
+    if: github.repository == 'leanprover/cslib'
     permissions:
       issues: write
     steps:
diff --git a/.github/workflows/lean_action_ci.yml b/.github/workflows/lean_action_ci.yml
index 5b0ce8b541..d5ca8cefab 100644
--- a/.github/workflows/lean_action_ci.yml
+++ b/.github/workflows/lean_action_ci.yml
@@ -22,10 +22,10 @@ jobs:
         with:
           build-args: "--wfail --iofail"
           test-args: "--wfail --iofail"
-      - name: "lake exe mk_all --check --module"
+      - name: "lake exe mk_all --check"
         run: |
           set -e
-          lake exe mk_all --check --module
+          lake exe mk_all --check
       #- name: "lake shake"
       #  run: |
       #    set -e
diff --git a/.github/copilot-instructions.md b/AGENTS.md
similarity index 75%
rename from .github/copilot-instructions.md
rename to AGENTS.md
index 991077d49d..afa7476616 100644
--- a/.github/copilot-instructions.md
+++ b/AGENTS.md
@@ -1,4 +1,4 @@
-# Copilot Instructions for CSLib
+# Project Instructions
 
 ## Repository Overview
 
@@ -18,12 +18,12 @@
 | Command | Purpose | When to Use |
 |---------|---------|-------------|
 | `lake build` | Build the library | After any code change |
-| `lake build --wfail --iofail` | Build with CI strictness (fails on warnings) | **Always use before committing** |
+| `lake build --wfail --iofail` | Build with CI strictness (fails on warnings) | Before committing |
 | `lake test` | Run all tests (builds CslibTests + checks init imports) | After changes to verify correctness |
 | `lake lint` | Run environment linters (Batteries/Mathlib) | Before committing |
 | `lake exe lint-style` | Run text-based style linters | Before committing |
-| `lake exe mk_all --module --check` | Verify Cslib.lean imports all modules | After adding new files |
-| `lake exe mk_all --module` | Auto-update Cslib.lean imports | After adding new files |
+| `lake exe mk_all --check` | Verify Cslib.lean imports all modules | After adding new files |
+| `lake exe mk_all` | Auto-update Cslib.lean imports | After adding new files |
 
 ### Full CI Validation Sequence
 
@@ -31,7 +31,7 @@ Run these commands **in order** to replicate CI checks locally:
 
 ```bash
 lake build --wfail --iofail
-lake exe mk_all --module --check
+lake exe mk_all --check
 lake test
 lake lint
 lake exe lint-style
@@ -64,8 +64,7 @@ lake exe lint-style
 │   └── Logics/          # Logic formalisations (e.g., Linear Logic, Hennessy-Milner Logic)
 ├── CslibTests/          # Test files
 ├── scripts/             # Build and maintenance scripts
-│   ├── noshake.json     # Import exceptions for shake tool
-│   └── nolints.json     # Lint exceptions
+│   └── noshake.json     # Import exceptions for shake tool
 └── .github/workflows/   # CI workflows
 ```
 
@@ -79,9 +78,9 @@ Every file in `Cslib/` must transitively import `Cslib/Init.lean`. This sets up
 - `Cslib.Init` itself
 
 ### 2. New Files Must Be Added to Cslib.lean
-When creating a new `.lean` file in `Cslib/`, add its import to `Cslib.lean`. Run:
+When creating a new `.lean` file in `Cslib/`, add its import to `Cslib.lean` by running:
 ```bash
-lake exe mk_all --module
+lake exe mk_all
 ```
 
 ### 3. PR Title Convention
@@ -103,15 +102,22 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: $LIST_OF_AUTHORS
 -/
 ```
+where $YEAR should be replaced with the current year, $AUTHOR_NAME with the name of the file creator, and $LIST_OF_AUTHORS with the list of authors (this is just the file creator if there are no additional authors).
+
+### 5. Always Read Local README.md Files
+
+Before working on any file or directory, **always read** all `README.md` files in all directories throughout the entire repository.
+
+These files contain essential context that must be understood before making changes.
 
 ## Code Style
 
 - Follow everything written in /CONTRIBUTING.md
-- Follow [Mathlib style guide](https://leanprover-community.github.io/contribute/style.html)
-- Use domain-specific variable names (e.g., `State` for state types, `μ` for transition labels)
-- Keep proofs readable; golfing is welcome if proofs remain clear
-- Use existing typeclasses for common concepts (transitions, reductions)
-- Use `module` keyword at the start of files with `public import` statements
+- Follow the [Mathlib code style](https://leanprover-community.github.io/contribute/style.html)
+- Use domain-specific variable names when dealing with APIs that have a clear intention (e.g., `State` for state types, `μ` for transition labels).
+- Keep proofs readable; golfing is welcome if proofs remain clear.
+- Use existing typeclasses for common concepts (`Congruence`, `Context`, etc.).
+- Use the `module` keyword at the start of files with `public import` statements.
 
 ## Linter Configuration
 
@@ -122,18 +128,11 @@ Linters are configured in `lakefile.toml`.
 ### Creating a New Module
 1. Create file in appropriate `Cslib/` subdirectory
 2. Add `import Cslib.Init` (or import a module that imports it)
-3. Run `lake exe mk_all --module`
+3. Run `lake exe mk_all`
 4. Run `lake build --wfail --iofail`
 5. Run `lake test` to verify init imports
 
 ### Adding Tests
 1. Create or modify a file in `CslibTests/`
-2. Add import to `CslibTests.lean` if new file
+2. Add import to `CslibTests.lean` if it is a new file
 3. Run `lake test`
-
-## Trust These Instructions
-
-Only search for additional information if:
-- A command fails with an unexpected error
-- You need details about a specific module's API
-- The instructions appear incomplete for your specific task
diff --git a/AUTHORS.md b/AUTHORS.md
new file mode 100644
index 0000000000..8517b90603
--- /dev/null
+++ b/AUTHORS.md
@@ -0,0 +1,15 @@
+# CSLib Authors
+
+## Copyright and Authorship
+
+**Copyright in CSLib is held by the individual authors** who contributed to the code.
+
+Each file in CSLib includes a copyright header that lists the authors who contributed significantly to that specific file (in the opener and in the optional `Authors` field, when there are multiple significant authors). Examples of significant contributions are original creation, major refactoring, or important additions.
+
+To see more people who have contributed to CSLib and own copyright to parts of the codebase, please refer to its Git history (on a web browser, this can be accessed at <https://github.com/leanprover/cslib/commits/main>).
+
+**Note**: Git history may not always be fully comprehensive. In cases where code is co-written, commit messages and copyright headers in files may attribute additional authors beyond the single commit author.
+
+## Co-Authorship
+
+To ensure **all contributors are properly credited**, we strongly encourage the use of GitHub's [commit with multiple authors feature](https://docs.github.com/en/pull-requests/committing-changes-to-your-project/creating-and-editing-commits/creating-a-commit-with-multiple-authors) whenever code is co-written. This helps with maintaining accurate attribution in CSLib's Git history.
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index a2f8f88415..2526676ea0 100644
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -101,7 +101,7 @@ instructions on how to run these locally.
 
 ## Pull Request Titles
 
-It is required that pull request titles begun with one of the following categories followed by a
+It is required that pull request titles begin with one of the following categories followed by a
 colon: `feat`, `fix`, `doc`, `style`, `refactor`, `test`, `chore`, `perf`. These may optionally be followed by a
 parenthetical containing what area of the library the PR is working on.
 
@@ -125,8 +125,8 @@ CSLib uses a number of linters, mostly inherited from Batteries and Mathlib. The
 
 ## Imports
 
-There is a also a test that [Cslib.lean](/Cslib.lean) imports all files. You can ensure this by
-running `lake exe mk_all --module` locally, which will make the required changes.
+There is also a test that [Cslib.lean](/Cslib.lean) imports all files. You can ensure this by
+running `lake exe mk_all` locally, which will make the required changes.
 
 CSLib tests for minimized imports using `lake shake --add-public --keep-implied --keep-prefix`, which also comes with a `--fix` option.
 See `lake shake --help` for the special comment syntax used to preserve imports required for tactics or typeclasses.
diff --git a/Cslib.lean b/Cslib.lean
index 657d106c2e..06929151c2 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -1,5 +1,6 @@
 module  -- shake: keep-all --deprecated_module: ignore
 
+public import Cslib.Algorithms.CCS.VendingMachine
 public import Cslib.Algorithms.Lean.MergeSort.MergeSort
 public import Cslib.Algorithms.Lean.TimeM
 public import Cslib.Computability.Automata.Acceptors.Acceptor
@@ -11,19 +12,29 @@ public import Cslib.Computability.Automata.DA.Prod
 public import Cslib.Computability.Automata.DA.ToNA
 public import Cslib.Computability.Automata.EpsilonNA.Basic
 public import Cslib.Computability.Automata.EpsilonNA.ToNA
+public import Cslib.Computability.Automata.EpsilonNA.ToSingleAccept
 public import Cslib.Computability.Automata.NA.Basic
 public import Cslib.Computability.Automata.NA.BuchiEquiv
 public import Cslib.Computability.Automata.NA.BuchiInter
 public import Cslib.Computability.Automata.NA.Concat
+public import Cslib.Computability.Automata.NA.EpsilonTransducer
 public import Cslib.Computability.Automata.NA.Hist
 public import Cslib.Computability.Automata.NA.Loop
 public import Cslib.Computability.Automata.NA.Pair
 public import Cslib.Computability.Automata.NA.Prod
+public import Cslib.Computability.Automata.NA.Reverse
 public import Cslib.Computability.Automata.NA.Sum
 public import Cslib.Computability.Automata.NA.ToDA
 public import Cslib.Computability.Automata.NA.Total
+public import Cslib.Computability.Automata.Transducers.Transducer
 public import Cslib.Computability.Distributed.FLP.Algorithm
+public import Cslib.Computability.Distributed.FLP.CanReachVia
 public import Cslib.Computability.Distributed.FLP.Consensus
+public import Cslib.Computability.Distributed.FLP.FairScheduler
+public import Cslib.Computability.Distributed.FLP.Impossibility
+public import Cslib.Computability.Distributed.FLP.OnePseudoConsensus
+public import Cslib.Computability.Distributed.FLP.PseudoConsensus
+public import Cslib.Computability.Distributed.FLP.ZeroConsensus
 public import Cslib.Computability.Languages.Congruences.BuchiCongruence
 public import Cslib.Computability.Languages.Congruences.RightCongruence
 public import Cslib.Computability.Languages.ExampleEventuallyZero
@@ -32,7 +43,13 @@ public import Cslib.Computability.Languages.MyhillNerode
 public import Cslib.Computability.Languages.OmegaLanguage
 public import Cslib.Computability.Languages.OmegaRegularLanguage
 public import Cslib.Computability.Languages.RegularLanguage
-public import Cslib.Computability.Machines.SingleTapeTuring.Basic
+public import Cslib.Computability.Languages.SafetyLiveness
+public import Cslib.Computability.Machines.Turing.MultiTape.ConstantSpace
+public import Cslib.Computability.Machines.Turing.MultiTape.Deterministic
+public import Cslib.Computability.Machines.Turing.MultiTape.TapeLemmas
+public import Cslib.Computability.Machines.Turing.SingleTape.Defs
+public import Cslib.Computability.Machines.Turing.SingleTape.Deterministic
+public import Cslib.Computability.Machines.Turing.SingleTape.NonDeterministic
 public import Cslib.Computability.URM.Basic
 public import Cslib.Computability.URM.Computable
 public import Cslib.Computability.URM.Defs
@@ -64,13 +81,21 @@ public import Cslib.Foundations.Data.OmegaSequence.Flatten
 public import Cslib.Foundations.Data.OmegaSequence.InfOcc
 public import Cslib.Foundations.Data.OmegaSequence.Init
 public import Cslib.Foundations.Data.OmegaSequence.Temporal
+public import Cslib.Foundations.Data.OmegaSequence.Topology
+public import Cslib.Foundations.Data.PFunctor.Free
 public import Cslib.Foundations.Data.RelatesInSteps
-public import Cslib.Foundations.Data.Relation
 public import Cslib.Foundations.Data.Set.Saturation
 public import Cslib.Foundations.Data.StackTape
 public import Cslib.Foundations.Lint.Basic
 public import Cslib.Foundations.Logic.InferenceSystem
 public import Cslib.Foundations.Logic.LogicalEquivalence
+public import Cslib.Foundations.Logic.Operators
+public import Cslib.Foundations.Relation.Attr
+public import Cslib.Foundations.Relation.Confluence
+public import Cslib.Foundations.Relation.Defs
+public import Cslib.Foundations.Relation.Domain
+public import Cslib.Foundations.Relation.Euclidean
+public import Cslib.Foundations.Relation.Restriction
 public import Cslib.Foundations.Semantics.FLTS.Basic
 public import Cslib.Foundations.Semantics.FLTS.FLTSToLTS
 public import Cslib.Foundations.Semantics.FLTS.LTSToFLTS
@@ -78,12 +103,15 @@ public import Cslib.Foundations.Semantics.FLTS.Prod
 public import Cslib.Foundations.Semantics.LTS.Basic
 public import Cslib.Foundations.Semantics.LTS.Bisimulation
 public import Cslib.Foundations.Semantics.LTS.Divergence
+public import Cslib.Foundations.Semantics.LTS.ExampleTermination
 public import Cslib.Foundations.Semantics.LTS.Execution
 public import Cslib.Foundations.Semantics.LTS.HasTau
 public import Cslib.Foundations.Semantics.LTS.LTSCat.Basic
+public import Cslib.Foundations.Semantics.LTS.MapLabel
 public import Cslib.Foundations.Semantics.LTS.Notation
 public import Cslib.Foundations.Semantics.LTS.OmegaExecution
 public import Cslib.Foundations.Semantics.LTS.Relation
+public import Cslib.Foundations.Semantics.LTS.Reverse
 public import Cslib.Foundations.Semantics.LTS.Simulation
 public import Cslib.Foundations.Semantics.LTS.Termination
 public import Cslib.Foundations.Semantics.LTS.Total
@@ -116,6 +144,8 @@ public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Safety
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.StrongNorm
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.BetaAt
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.CallByName
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Congruence
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence
@@ -124,11 +154,18 @@ public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaEta
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullEta
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullEtaConfluence
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LcAt
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LeftmostReduction
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.MultiApp
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.MultiSubst
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.StandardReduction
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.StrongNorm
 public import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic
+public import Cslib.Languages.LambdaCalculus.Named.Untyped.Properties
+public import Cslib.Languages.Mech.Choreography.Basic
+public import Cslib.Languages.Mech.LocalComputation
+public import Cslib.Languages.StatefulProcesses.Basic
+public import Cslib.Languages.StatefulProcesses.Network
 public import Cslib.Logics.HML.Basic
 public import Cslib.Logics.HML.LogicalEquivalence
 public import Cslib.Logics.LinearLogic.CLL.Basic
@@ -139,9 +176,12 @@ public import Cslib.Logics.LinearLogic.CLL.PhaseSemantics.Basic
 public import Cslib.Logics.Modal.Basic
 public import Cslib.Logics.Modal.Cube
 public import Cslib.Logics.Modal.Denotation
+public import Cslib.Logics.Modal.LogicalEquivalence
 public import Cslib.Logics.Propositional.Defs
 public import Cslib.Logics.Propositional.NaturalDeduction.Basic
+public import Cslib.Logics.Propositional.NaturalDeduction.Theory
 public import Cslib.MachineLearning.PACLearning.Defs
 public import Cslib.MachineLearning.PACLearning.VCDimension
 public import Cslib.MachineLearning.PACLearning.VersionSpace
+public import Cslib.MachineLearning.PACLearning.VersionSpaceLattice
 public import Cslib.Probability.PMF
diff --git a/Cslib/Algorithms/CCS/VendingMachine.lean b/Cslib/Algorithms/CCS/VendingMachine.lean
new file mode 100644
index 0000000000..08bb842513
--- /dev/null
+++ b/Cslib/Algorithms/CCS/VendingMachine.lean
@@ -0,0 +1,96 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Languages.CCS.Semantics
+public import Cslib.Foundations.Semantics.LTS.Bisimulation
+public import Cslib.Foundations.Semantics.LTS.TraceEq
+public import Mathlib.Tactic.FinCases
+
+/-! # Milner's Vending Machine
+
+This file formalises Milner's vending machine example for CCS.
+
+We formalise two versions:
+- A machine with a deterministic LTS: `coin.(tea.VM + coffee.VM)`.
+- A machine with a nondeterministic LTS: `coin.tea.VM + coin.coffee.VM`.
+
+We then prove the classical example that the two are not bisimilar.
+
+Future work on proving that the two vending machines are trace equivalent would be
+welcome.
+-/
+
+@[expose] public section
+
+namespace Cslib.Algorithms.CCS.VendingMachine
+
+open Cslib.CCS Process Act
+open scoped LTS
+
+/-! Action names. -/
+
+/-- Insert a coin. -/
+abbrev Coin := name "coin"
+
+/-- Tea request. -/
+abbrev Tea := name "tea"
+
+/-- Coffee request. -/
+abbrev Coffee := name "coffee"
+
+/-- Constants. -/
+inductive Constant
+  | vm
+
+/-- The vending machine process. -/
+def vm : Process String Constant := const .vm
+
+/-! ## Deterministic vending machine -/
+
+/-- Constant definitions: vm = coin.(tea.VM + coffee.VM) -/
+@[local grind =]
+def vendingDefs : Constant → Option (Process String Constant)
+  | .vm => some <| pre Coin (choice (pre Tea (const .vm)) (pre Coffee (const .vm)))
+
+/-- The LTS of CCS for the deterministic vending machine. -/
+abbrev ltsD := CCS.lts (defs := vendingDefs)
+
+/-- VM can perform a coin action. -/
+example : ltsD.Tr vm Coin (choice (pre Tea (const .vm)) (pre Coffee (const .vm))) :=
+  Tr.const rfl Tr.pre
+
+/-! ## Nondeterministic vending machine -/
+
+/-- vm = coin.tea.VM + coin.coffee.VM -/
+def vendingDefsND : Constant → Option (Process String Constant)
+  | .vm => some <| (choice (pre Coin (pre Tea (const .vm))) (pre Coin (pre Coffee (const .vm))))
+
+/-- The LTS of CCS for the nondeterministic vending machine. -/
+abbrev ltsND := CCS.lts (defs := vendingDefsND)
+
+open LTS LTS.IsBisimulation LTS.Bisimilarity
+
+/-- The deterministic and nondeterministic vending machines are not bisimilar. -/
+theorem vm_ltsD_ltsND_not_bisim : ¬(vm ~[ltsD, ltsND] vm) := by
+  rintro ⟨r, hr, hbisim⟩
+  let p₁ := (choice (pre Tea (const Constant.vm)) (pre Coffee (const Constant.vm)))
+  let q₁ := (pre Tea (const Constant.vm))
+  have ltsD_vm_deterministic : ltsD.DeterministicStateLabel vm Coin := by
+    intro _ _ htr₁ htr₂
+    grind [const_tr htr₁, const_tr htr₂]
+  have h : r p₁ q₁ :=
+    match_deterministic
+      hbisim hr
+      ltsD_vm_deterministic
+      (.const rfl .pre)
+      (.const rfl (.choiceL .pre))
+  have hp₁q₁ : p₁ ~[ltsD, ltsND] q₁ := by grind
+  have hp₁coffee : ltsD.Tr p₁ Coffee (const Constant.vm) := .choiceR .pre
+  grind [hp₁q₁.follow_fst]
+
+end Cslib.Algorithms.CCS.VendingMachine
diff --git a/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean b/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean
index 6de2ca6e6e..bb9f9c8f1f 100644
--- a/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean
+++ b/Cslib/Algorithms/Lean/MergeSort/MergeSort.lean
@@ -8,7 +8,7 @@ module
 
 public import Cslib.Algorithms.Lean.TimeM
 public import Mathlib.Data.Nat.Cast.Order.Ring
-public import Mathlib.Data.Nat.Lattice
+public import Mathlib.Order.Lattice.Nat
 public import Mathlib.Data.Nat.Log
 
 /-!
diff --git a/Cslib/Algorithms/README.md b/Cslib/Algorithms/README.md
new file mode 100644
index 0000000000..9d946c476d
--- /dev/null
+++ b/Cslib/Algorithms/README.md
@@ -0,0 +1,31 @@
+<pre>
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Clark Barrett, Swarat Chaudhuri, Jim Grundy, Fabrizio Montesi, Leonardo de Moura, Alexandre Rademaker, Sorrachai Yingchareonthawornchai
+</pre>
+
+# Algorithms
+
+This directory hosts **algorithms and their properties**. These properties concern functional correctness, complexity, and other relevant results. The directory also includes dedicated facilities for reasoning about algorithms written in Lean.
+
+The broader aim is to develop a library of verified algorithms, both in Lean and in other languages formalised in CSLib. Accordingly, it is in scope to study algorithms implemented as Lean programs as well as algorithms expressed inside one of CSLib's [Languages](../Languages), depending on the purpose of the development.
+All algorithms sit in a language-specific subdirectory depending on the language they are written in, like `Boole`, `Lean`, etc.
+
+## Principles
+
+### Synergies with languages and logics
+
+Important synergies are expected with both [Languages](../Languages) and [Logics](../Logics). Languages provide settings in which algorithms can be written and studied under formal semantics, while logics provide tools for specifying and proving their properties.
+
+One long-term aim is to support principled reasoning pipelines where algorithms are defined in a language, specified through logical notions, and verified inside shared semantic frameworks.
+
+### Dealing with optimisation
+
+Optimising an algorithm can make it harder to reason about it. When this happens, one can prove a relation (e.g., functional or behavioural) to a simpler, less optimised version, and then work by transferring results from it.
+In doing this, we expect contributions to leverage Lean's and CSLib's common infrastructures whenever reasonable.
+
+## Plans and notes
+
+- We aim at developing a comprehensive library of verified algorithms, covering both Lean implementations and algorithms represented in other languages.
+- We plan on expanding the infrastructure for proving properties of Lean algorithms, including correctness, complexity, and other forms of analysis.
+- Reusable mathematical and semantic infrastructure should live elsewhere in CSLib when it is more general-purpose, so developments in this directory should integrate well with [Foundations](../Foundations), [Languages](../Languages), and [Logics](../Logics).
diff --git a/Cslib/Computability/Automata/DA/Prod.lean b/Cslib/Computability/Automata/DA/Prod.lean
index 0d6d123e85..2aa375a07f 100644
--- a/Cslib/Computability/Automata/DA/Prod.lean
+++ b/Cslib/Computability/Automata/DA/Prod.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2025 Fabrizio Montesi. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Ching-Tsun Chou
+Authors: Fabrizio Montesi, Ching-Tsun Chou
 -/
 
 module
diff --git a/Cslib/Computability/Automata/DA/ToNA.lean b/Cslib/Computability/Automata/DA/ToNA.lean
index fe8c58f25c..27efa64c5c 100644
--- a/Cslib/Computability/Automata/DA/ToNA.lean
+++ b/Cslib/Computability/Automata/DA/ToNA.lean
@@ -60,7 +60,7 @@ theorem toNAFinAcc_language_eq {a : DA.FinAcc State Symbol} :
   #adaptation_note
   /-- A grind regression found moving to nightly-2026-03-31 (changes from lean#13166) -/
   constructor
-  · simp_all [mem_language a xs, Accepts, toNAFinAcc, toNA, FLTS.toLTS_mtr]
+  · simp [mem_language a xs, Accepts, toNAFinAcc, toNA, FLTS.toLTS_mtr]
   · intro _
     use a.start
     simp_all [Accepts, toNAFinAcc, toNA, FLTS.toLTS_mtr]
@@ -82,7 +82,7 @@ theorem toNABuchi_language_eq {a : DA.Buchi State Symbol} :
   ext xs; constructor
   #adaptation_note
   /-- A grind regression found moving to nightly-2026-03-31 (changes from lean#13166) -/
-  · simp_all [Accepts, language, toNABuchi]
+  · simp [Accepts, language, toNABuchi]
   · intro h
     use (a.run xs)
     split_ands
diff --git a/Cslib/Computability/Automata/EpsilonNA/Basic.lean b/Cslib/Computability/Automata/EpsilonNA/Basic.lean
index e001d98c24..b68fdd86db 100644
--- a/Cslib/Computability/Automata/EpsilonNA/Basic.lean
+++ b/Cslib/Computability/Automata/EpsilonNA/Basic.lean
@@ -46,9 +46,7 @@ namespace FinAcc
 that trace from the start state. -/
 @[scoped grind =]
 instance : Acceptor (FinAcc State Symbol) Symbol where
-  Accepts (a : FinAcc State Symbol) (xs : List Symbol) :=
-    ∃ s ∈ a.εClosure a.start, ∃ s' ∈ a.accept,
-    a.saturate.MTr s (xs.map (some ·)) s'
+  Accepts a xs := ∃ s ∈ a.start, ∃ s' ∈ a.accept, a.SMTr s (xs.map some) s'
 
 end FinAcc
 
diff --git a/Cslib/Computability/Automata/EpsilonNA/ToNA.lean b/Cslib/Computability/Automata/EpsilonNA/ToNA.lean
index d0299dc920..184c99e963 100644
--- a/Cslib/Computability/Automata/EpsilonNA/ToNA.lean
+++ b/Cslib/Computability/Automata/EpsilonNA/ToNA.lean
@@ -7,32 +7,13 @@ Authors: Fabrizio Montesi
 module
 
 public import Cslib.Computability.Automata.EpsilonNA.Basic
+public import Cslib.Foundations.Semantics.LTS.MapLabel
 
 /-! # Translation of εNA into NA -/
 
 @[expose] public section
 
-namespace Cslib
-
-/-- Converts an `LTS` with Option labels into an `LTS` on the carried label type, by removing all
-ε-transitions. -/
-@[local grind =]
-def LTS.noε (lts : LTS State (Option Label)) : LTS State Label where
-  Tr s μ s' := lts.Tr s (some μ) s'
-
-@[local grind .]
-private lemma LTS.noε_saturate_tr
-  {lts : LTS State (Option Label)} {h : μ = some μ'} :
-  lts.saturate.Tr s μ s' ↔ lts.saturate.noε.Tr s μ' s' := by
-  grind
-
-@[scoped grind =]
-lemma LTS.noε_saturate_mTr {lts : LTS State (Option Label)} :
-  lts.saturate.MTr s (μs.map some) = lts.saturate.noε.MTr s μs := by
-  ext s'
-  induction μs generalizing s <;> grind [<= LTS.MTr.stepL]
-
-namespace Automata.εNA.FinAcc
+namespace Cslib.Automata.εNA.FinAcc
 
 variable {State Symbol : Type*}
 
@@ -41,21 +22,23 @@ variable {State Symbol : Type*}
 def toNAFinAcc (a : εNA.FinAcc State Symbol) : NA.FinAcc State Symbol where
   start := a.εClosure a.start
   accept := a.accept
-  Tr := a.saturate.noε.Tr
+  toLTS := a.saturate.mapLabel Option.some
 
 open Acceptor in
-open scoped NA.FinAcc in
+open scoped NA.FinAcc LTS LTS.MTr LTS.STr LTS.SMTr in
 /-- Correctness of `toNAFinAcc`. -/
-@[scoped grind _=_]
-theorem toNAFinAcc_language_eq {ena : εNA.FinAcc State Symbol} :
-    language ena.toNAFinAcc = language ena := by
+@[scoped grind =]
+theorem toNAFinAcc_language_eq {a : εNA.FinAcc State Symbol} :
+    language a.toNAFinAcc = language a := by
   ext xs
-  have : ∀ s s', ena.saturate.MTr s (xs.map some) s' = ena.saturate.noε.MTr s xs s' := by
-    simp [LTS.noε_saturate_mTr]
-  #adaptation_note
-  /-- A grind regression found moving to nightly-2026-03-31 (changes from lean#13166) -/
-  grind [Accepts]
-
-end Automata.εNA.FinAcc
-
-end Cslib
+  constructor <;> intro ⟨s, hs, s', hs', h⟩
+  · have ⟨sStart, h_sStart, hs⟩ : ∃ i ∈ a.start, s ∈ a.saturate.image i HasTau.τ := by
+      simpa [toNAFinAcc, LTS.τClosure, LTS.setImage] using hs
+    use sStart, h_sStart, s', hs'
+    have h_start := (LTS.sTr_τSTr_iff a.toLTS).mp hs
+    exact LTS.SMTr.comp (LTS.sMTr_τSTr_iff.mp h_start) (by grind)
+  · cases xs with
+    | nil => cases h with | τ tau => exact ⟨s', LTS.tr_setImage hs tau, by grind⟩
+    | cons x xs => exact ⟨s, by grind [Set.mem_of_mem_of_subset]⟩
+
+end Cslib.Automata.εNA.FinAcc
diff --git a/Cslib/Computability/Automata/EpsilonNA/ToSingleAccept.lean b/Cslib/Computability/Automata/EpsilonNA/ToSingleAccept.lean
new file mode 100644
index 0000000000..6b85893fde
--- /dev/null
+++ b/Cslib/Computability/Automata/EpsilonNA/ToSingleAccept.lean
@@ -0,0 +1,277 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Computability.Automata.EpsilonNA.Basic
+
+/-! # Translation of εNA into εNA with a single accept state
+
+Defines the transformation `toSingleAccept` for `εNA.FinAcc` and proves correctness
+results in terms of language equivalence and correspondences between the two transition systems.
+
+Note for future work: we could formulate a stronger transformation, whereby also the set of accept
+states becomes a singleton.
+-/
+
+@[expose] public section
+
+namespace Cslib.Automata.εNA.FinAcc
+
+variable {State Symbol : Type*}
+
+/-- Any `εNA.FinAcc` can be converted into an `εNA.FinAcc` with a single accept state `none`.
+The original states are wrapped in `some`, and all original accept states have ε-transitions to
+`none`. -/
+@[local grind]
+def toSingleAccept (a : εNA.FinAcc State Symbol) : εNA.FinAcc (Option State) Symbol where
+  start := some '' a.start
+  accept := {none}
+  Tr
+    | some s, x, some s' => a.Tr s x s'
+    | some s, none, none => s ∈ a.accept
+    | _, _, _ => False
+
+@[scoped grind =]
+theorem toSingleAccept_accept_def {a : εNA.FinAcc State Symbol} :
+    a.toSingleAccept.accept = {none} := rfl
+
+open Acceptor in
+@[scoped grind .]
+theorem toSingleAccept_accepts_mTr_iff {a : εNA.FinAcc State Symbol} :
+    Accepts a.toSingleAccept xs ↔
+    ∃ s ∈ a.toSingleAccept.start, a.toSingleAccept.SMTr s (xs.map Option.some) none := by
+  grind [Accepts]
+
+open scoped LTS LTS.MTr LTS.STr LTS.SMTr
+
+@[scoped grind →]
+theorem toSingleAccept_tr_antiDerivative_isSome {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.Tr os x os') : os.isSome := by
+  cases os with grind
+
+theorem toSingleAccept_tr_tr {a : εNA.FinAcc State Symbol} :
+    a.toSingleAccept.Tr (some s) x (some s') ↔ a.Tr s x s' := by
+  simp [toSingleAccept]
+
+scoped grind_pattern toSingleAccept_tr_tr => a.toSingleAccept.Tr (some s) x (some s')
+
+@[scoped grind →]
+theorem toSingleAccept_tr_none_accept {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.Tr os x none) : ∃ s, os = some s ∧ s ∈ a.accept := by
+  grind
+
+@[scoped grind ⇒]
+theorem toSingleAccept_not_tr_none {a : εNA.FinAcc State Symbol} :
+    ¬a.toSingleAccept.Tr none x os := by
+  grind
+
+@[scoped grind →]
+theorem toSingleAccept_mTr_antiDerivative_isSome {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.MTr os x (some s')) : os.isSome := by
+  generalize hos' : some s' = os' at h
+  induction h <;> grind
+
+@[scoped grind =]
+theorem toSingleAccept_mTr_mTr {a : εNA.FinAcc State Symbol} :
+    a.toSingleAccept.MTr (some s) xs (some s') ↔ a.MTr s xs s' := by
+  induction xs generalizing s
+  case nil => grind
+  case cons x xs ih =>
+    apply Iff.intro <;> intro h
+    case mp =>
+      cases h with
+      | stepL => grind
+    case mpr =>
+      cases h
+      case stepL sb htr hmtr =>
+        apply LTS.MTr.stepL (s2 := some sb) <;> grind
+
+@[scoped grind →]
+theorem toSingleAccept_τSTr_antiDerivative_none {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.τSTr none os) : os = none := by
+  generalize hnone : none = os' at h
+  induction h using Relation.ReflTransGen.head_induction_on
+  case refl => rfl
+  case head _ _ h₁ h₂ ih => grind [toSingleAccept_tr_antiDerivative_isSome h₁]
+
+@[scoped grind →]
+theorem toSingleAccept_τSTr_antiDerivative_isSome {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.τSTr os (some s')) : os.isSome := by
+  induction h using Relation.ReflTransGen.head_induction_on
+  case refl => exact Option.isSome_some
+  case head _ _ h₁ h₂ ih => exact toSingleAccept_tr_antiDerivative_isSome h₁
+
+@[scoped grind =]
+theorem toSingleAccept_τSTr_τSTr {a : εNA.FinAcc State Symbol}
+    : a.toSingleAccept.τSTr (some s) (some s') ↔ a.τSTr s s' := by
+  apply Iff.intro
+  · generalize hos' : some s' = os'
+    intro h
+    induction h generalizing s' with
+    | refl =>
+      cases hos'
+      exact LTS.τSTr.refl
+    | tail hτstr htr ih =>
+      subst hos'
+      obtain ⟨_, rfl⟩ := Option.isSome_iff_exists.mp <| toSingleAccept_tr_antiDerivative_isSome htr
+      exact .trans (ih rfl) (.single htr)
+  · intro h
+    cases h with
+    | refl => exact LTS.τSTr.refl
+    | tail hτstr htr => exact .trans (.lift some (by rfl) _ _ hτstr) (.single htr)
+
+@[scoped grind →]
+theorem toSingleAccept_τSTr_none_accept {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.τSTr (some s) none) : ∃ s' ∈ a.accept, a.τSTr s s' := by
+  generalize hos' : none = os' at h
+  induction h
+  case refl => simp at hos'
+  case tail osb os' h₁ h₂ ih =>
+    subst hos'
+    have ⟨sb, hosb, hsb⟩ := toSingleAccept_tr_none_accept h₂
+    subst hosb
+    exact ⟨sb, hsb, toSingleAccept_τSTr_τSTr.mp h₁⟩
+
+@[scoped grind →]
+theorem toSingleAccept_sTr_antiDerivative_isSome {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.STr os x (some s')) : os.isSome := by
+  generalize hos' : some s' = os'
+  cases h <;> grind
+
+@[scoped grind =]
+theorem toSingleAccept_sTr_sTr {a : εNA.FinAcc State Symbol}
+    : a.toSingleAccept.STr (some s) x (some s') ↔ a.STr s x s' := by
+  generalize hos' : some s' = os'
+  apply Iff.intro <;> intro h
+  case mp =>
+    induction h
+    case refl => grind only [Option.some_inj, LTS.STr.refl]
+    case tr osb₁ x osb₂ os' h₁ h₂ h₃ =>
+      have ⟨sb₂, hosb₂⟩ : ∃ sb₂, osb₂ = some sb₂ := by grind
+      have ⟨sb₁, hosb₁⟩ : ∃ sb₁, osb₁ = some sb₁ := by grind
+      grind [LTS.STr.tr (s2 := sb₁) (s3 := sb₂)]
+  case mpr =>
+    induction h
+    case refl => grind only [LTS.STr.refl]
+    case tr sb₁ x sb₂ s' h₁ h₂ h₃ =>
+      apply LTS.STr.tr (s2 := some sb₁) (s3 := some sb₂)
+        (toSingleAccept_τSTr_τSTr.mpr h₁)
+        (toSingleAccept_tr_tr.mpr h₂)
+        (hos' ▸ toSingleAccept_τSTr_τSTr.mpr h₃)
+
+@[scoped grind →]
+theorem toSingleAccept_sTr_none_accept {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.STr (some s) x none) : ∃ s' ∈ a.accept, a.STr s x s' := by
+  cases h
+  case tr osb₁ osb₂ h₁ h₂ h₃ =>
+    have ⟨sb₁, hosb₁⟩ : ∃ sb₁, osb₁ = some sb₁ := by grind
+    rw [hosb₁] at h₂
+    cases hosb₂ : osb₂
+    case none =>
+      rw [hosb₂] at h₂
+      have h₂' := toSingleAccept_tr_none_accept h₂
+      rcases h₂' with ⟨s', hs', hs'a⟩
+      exists s'; apply And.intro hs'a
+      rw [hs'] at h₂
+      have hx : x = none := by grind
+      rw [hx]
+      rw [hosb₁, hs'] at h₁
+      cases h₁
+      case refl =>
+        apply LTS.STr.refl
+      case tail osb htrb htr =>
+        have ⟨sb, hosb⟩ : ∃ sb, osb = some sb := by
+          grind only [toSingleAccept_tr_antiDerivative_isSome htr, Option.isSome_iff_exists]
+        rw [hosb] at htr
+        apply toSingleAccept_tr_tr.mp at htr
+        rw [hosb] at htrb
+        apply toSingleAccept_τSTr_τSTr.mp at htrb
+        apply LTS.STr.tr htrb htr LTS.τSTr.refl
+    case some sb₂ =>
+      rw [hosb₁] at h₁
+      rw [hosb₂] at h₂ h₃
+      have ⟨s', hs', hsb₂⟩ := toSingleAccept_τSTr_none_accept h₃
+      exists s'; apply And.intro hs'
+      apply LTS.STr.tr
+        (toSingleAccept_τSTr_τSTr.mp h₁)
+        (toSingleAccept_tr_tr.mp h₂)
+        hsb₂
+
+@[scoped grind →]
+theorem toSingleAccept_sTr_none_none {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.STr none x os) : x = none ∧ os = none := by
+  cases h
+  case refl => trivial
+  case tr osb₁ osb₂ h₁ h₂ h₃ =>
+  have : osb₁ = none := toSingleAccept_τSTr_antiDerivative_none h₁
+  grind
+
+@[scoped grind →]
+theorem toSingleAccept_sMTr_antiDerivative_isSome {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.SMTr os xs (some s')) : os.isSome := by
+  generalize hos' : some s' = os' at h
+  induction h <;> grind [= Option.isSome_iff_exists]
+
+@[scoped grind =]
+theorem toSingleAccept_sMTr_sMTr {a : εNA.FinAcc State Symbol}
+    : a.toSingleAccept.SMTr (some s) x (some s') ↔ a.SMTr s x s' := by
+  generalize hos : some s = os, hos' : some s' = os'
+  apply Iff.intro <;> intro h
+  case mp =>
+    induction h generalizing s
+    case τ => grind [LTS.SMTr.τ]
+    case stepL os x osb xs os' h₁ h₂ ih =>
+      have ⟨sb, hosb⟩ : ∃ sb, osb = some sb := by grind [Option.isSome_iff_exists]
+      grind [LTS.SMTr.stepL (s2 := sb)]
+  case mpr =>
+    induction h generalizing os
+    case τ => grind [LTS.SMTr.τ]
+    case stepL s x sb xs s' h₁ h₂ ih => grind [LTS.SMTr.stepL (s2 := some sb)]
+
+@[scoped grind →]
+theorem toSingleAccept_sMTr_none_accept {a : εNA.FinAcc State Symbol}
+    (h : a.toSingleAccept.SMTr (some s) (List.map some xs) none) :
+    ∃ s' ∈ a.accept, a.SMTr s (List.map some xs) s' := by
+  induction xs generalizing s
+  case nil =>
+    rcases h with ⟨h⟩
+    have ⟨s', hs', h'⟩ := toSingleAccept_sTr_none_accept h
+    exact ⟨s', hs', LTS.SMTr.τ h'⟩
+  case cons x xs ih =>
+    cases h
+    case stepL osb hstr hsmtr =>
+      cases hosb : osb
+      case none =>
+        subst hosb
+        have ⟨s', hs', hstr'⟩ := toSingleAccept_sTr_none_accept hstr
+        refine ⟨s', hs', LTS.SMTr.stepL hstr' ?_⟩
+        have hxs : xs = [] := by cases xs with grind [cases LTS.SMTr]
+        grind
+      case some sb =>
+        subst hosb
+        have ⟨s', hs', ih'⟩ := ih hsmtr
+        exact ⟨s', hs', LTS.SMTr.stepL (toSingleAccept_sTr_sTr.mp hstr) ih'⟩
+
+open Acceptor in
+/-- `toSingleAccept` preserves the language of the input automaton. -/
+@[scoped grind =]
+theorem toSingleAccept_language_eq {a : εNA.FinAcc State Symbol} :
+    language a.toSingleAccept = language a := by
+  ext xs
+  apply Iff.intro <;> intro h
+  case mp =>
+    rcases h with ⟨os, hos, os', hos', hsmtr⟩
+    rcases hos with ⟨s, hs₁, hs₂⟩
+    exists s
+    grind
+  case mpr =>
+    rcases h with ⟨s, hs, s', hs', hsmtr⟩
+    refine ⟨s, by grind, none, by grind, ?_⟩
+    rw [show xs.map some = xs.map some ++ [] by simp]
+    exact LTS.SMTr.comp (toSingleAccept_sMTr_sMTr.mpr hsmtr) <| LTS.SMTr.τ (LTS.STr.single hs')
+
+end Cslib.Automata.εNA.FinAcc
diff --git a/Cslib/Computability/Automata/NA/EpsilonTransducer.lean b/Cslib/Computability/Automata/NA/EpsilonTransducer.lean
new file mode 100644
index 0000000000..4e2e875039
--- /dev/null
+++ b/Cslib/Computability/Automata/NA/EpsilonTransducer.lean
@@ -0,0 +1,68 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Computability.Automata.NA.Basic
+public import Cslib.Computability.Automata.Transducers.Transducer
+public import Cslib.Foundations.Semantics.LTS.HasTau
+
+/-! # Nondeterministic finite ε-transducers
+
+Transducers based on `NA` with an invisible symbol in their input and output alphabets.
+-/
+
+@[expose] public section
+
+namespace Cslib.Automata.NA
+
+/-- A nondeterministic ε-transducer of finite strings where the input and output alphabets include
+an invisible symbol, modelled as `HasTau.τ` (typically called `ε`). -/
+structure εTransducer (State InSymbol OutSymbol : Type*)
+    extends NA State (InSymbol × OutSymbol) where
+  /-- The set of accepting states. -/
+  accept : Set State
+
+/-- Removes all `τ`s from a list. -/
+@[scoped grind =]
+def _root_.List.dropTaus [HasTau α] [DecidableEqTau α] (l : List α) : List α :=
+  l.filter (· ≠ HasTau.τ)
+
+variable [HasTau InSymbol] [HasTau OutSymbol]
+
+namespace εTransducer
+
+/-- An `εTransducer` translates `xs` into `ys` from state `s` to state `s'` if there is a
+multistep transition from `s` to `s'` whose visible projection is `(xs, ys)`.
+`MTransl` is short for Multistep Translation relation.
+-/
+def MTransl [DecidableEqTau InSymbol] [DecidableEqTau OutSymbol]
+    (a : εTransducer State InSymbol OutSymbol) (s : State)
+    (xs : List InSymbol) (ys : List OutSymbol) (s' : State) : Prop :=
+  ∃ μs, a.MTr s μs s' ∧ (μs.map Prod.fst |>.dropTaus) = xs ∧ (μs.map Prod.snd |>.dropTaus) = ys
+
+/-- An `NA.εTransducer` translates a finite string `xs` into a finite string `ys` if it has
+a multistep transition whose visible projection is `(xs, ys)`.
+
+This is the standard string translation performed by nondeterministic transducers, where
+`HasTau.τ` symbols (epsilon transitions) are ignored in the input and output. -/
+instance [DecidableEqTau InSymbol] [DecidableEqTau OutSymbol] :
+    Transducer (εTransducer State InSymbol OutSymbol) InSymbol OutSymbol where
+  Translates a xs ys := ∃ s ∈ a.start, ∃ s' ∈ a.accept, a.MTransl s xs ys s'
+
+/-- Composition of multistep translations. -/
+theorem MTransl.comp [DecidableEqTau InSymbol] [DecidableEqTau OutSymbol]
+    {a : εTransducer State InSymbol OutSymbol}
+    {s₁ s₂ s₃ : State} {xs xs' : List InSymbol} {ys ys' : List OutSymbol} :
+    a.MTransl s₁ xs ys s₂ → a.MTransl s₂ xs' ys' s₃ →
+    a.MTransl s₁ (xs ++ xs') (ys ++ ys') s₃ := by
+  intro ⟨μs₁, h₁, e₁⟩ ⟨μs₂, h₂, e₂⟩
+  refine ⟨μs₁ ++ μs₂, LTS.MTr.comp a.toLTS h₁ h₂, ?_⟩
+  grind
+
+end εTransducer
+
+end Cslib.Automata.NA
diff --git a/Cslib/Computability/Automata/NA/Hist.lean b/Cslib/Computability/Automata/NA/Hist.lean
index ed2137efe6..716b76f9f5 100644
--- a/Cslib/Computability/Automata/NA/Hist.lean
+++ b/Cslib/Computability/Automata/NA/Hist.lean
@@ -57,7 +57,7 @@ theorem hist_run_exists {xs : ωSequence Symbol} {ss : ωSequence State}
   use ⟨fun n ↦ (ss n, makeHist start' tr' xs ss n)⟩
   constructor
   · simp only [addHist]
-    grind only [Run, usr Set.mem_setOf_eq, = get_fun, = LTS.OmegaExecution, makeHist]
+    grind only [Run, usr Set.mem_ofPred_eq, = get_fun, = LTS.OmegaExecution, makeHist]
   · grind
 
 end Cslib.Automata.NA
diff --git a/Cslib/Computability/Automata/NA/Loop.lean b/Cslib/Computability/Automata/NA/Loop.lean
index 2b543787fe..d3cdd4dfc7 100644
--- a/Cslib/Computability/Automata/NA/Loop.lean
+++ b/Cslib/Computability/Automata/NA/Loop.lean
@@ -189,7 +189,7 @@ theorem loop_language_eq [Inhabited Symbol] (h : ¬ language na = 0) :
   ext xl; constructor
   · rintro ⟨s, _, t, h_acc, h_mtr⟩
     by_cases h_xl : xl = []
-    · grind [mem_add, mem_one]
+    · grind [Language.mem_add, Language.mem_one]
     · have : Nonempty na.start := by
         obtain ⟨_, s0, _, _⟩ := nonempty_iff_ne_empty.mpr h
         use s0
@@ -215,10 +215,10 @@ theorem loop_language_eq [Inhabited Symbol] (h : ¬ language na = 0) :
     · obtain ⟨xl1, ⟨h_xl1, _⟩, xl2, h_xl2, rfl⟩ := h
       rw [← totalize_language_eq] at h_xl1
       have := loop_fin_run_mtr h_xl1
-      obtain ⟨s1, _, s2, _, _⟩ := h_xl2
+      obtain ⟨s1, hs, s2, sa, sb⟩ := h_xl2
       obtain ⟨rfl⟩ : s1 = inl () := by grind [finLoop, loop]
       obtain ⟨rfl⟩ : s2 = inl () := by grind [finLoop, loop]
-      refine ⟨inl (), ?_, inl (), ?_, LTS.MTr.comp _ this ?_⟩ <;> assumption
+      exact ⟨inl (), sa, inl (), hs, LTS.MTr.comp _ this sb⟩
     · obtain ⟨rfl⟩ := (Language.mem_one xl).mp h
       refine ⟨inl (), ?_, inl (), ?_, ?_⟩ <;> grind [finLoop, loop]
 
diff --git a/Cslib/Computability/Automata/NA/Pair.lean b/Cslib/Computability/Automata/NA/Pair.lean
index 45beb89d7a..fa233e8068 100644
--- a/Cslib/Computability/Automata/NA/Pair.lean
+++ b/Cslib/Computability/Automata/NA/Pair.lean
@@ -15,7 +15,7 @@ public import Cslib.Computability.Languages.RegularLanguage
 
 namespace Cslib
 
-open Language Automata Acceptor
+open Cslib.Language Automata Acceptor
 
 variable {Symbol : Type*} {State : Type}
 
@@ -50,7 +50,7 @@ theorem LTS.mem_pairViaLang {lts : LTS State Symbol} {via : Set State}
 
 /-- `LTS.pairViaLang via s t` is a regular language if there are only finitely many states. -/
 @[simp]
-theorem LTS.pairViaLang_regular [Inhabited Symbol] [Finite State] {lts : LTS State Symbol}
+theorem LTS.pairViaLang_regular [Finite State] {lts : LTS State Symbol}
     {via : Set State} {s t : State} : (lts.pairViaLang via s t).IsRegular := by
   apply IsRegular.iSup
   grind [Language.IsRegular.mul, LTS.pairLang_regular]
diff --git a/Cslib/Computability/Automata/NA/Reverse.lean b/Cslib/Computability/Automata/NA/Reverse.lean
new file mode 100644
index 0000000000..9ef2b5cafc
--- /dev/null
+++ b/Cslib/Computability/Automata/NA/Reverse.lean
@@ -0,0 +1,79 @@
+/-
+Copyright (c) 2026 Vignesh Karri. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Vignesh Karri
+-/
+
+module
+
+public import Cslib.Computability.Automata.NA.Basic
+public import Cslib.Foundations.Semantics.LTS.Reverse
+
+/-!
+# Reversal of nondeterministic automata
+
+This file defines `Cslib.Automata.NA.FinAcc.reverse`, which reverses every transition of a
+nondeterministic automaton and swaps its start and accept states. Its underlying transition system
+is `Cslib.LTS.reverse`, so the transition results are inherited from
+`Cslib/Foundations/Semantics/LTS/Reverse.lean`.
+
+The main result is `FinAcc.reverse_language_eq`: the language accepted by `na.reverse` is the
+`Language.reverse` of the language accepted by `na`. It follows from `FinAcc.accepts_reverse`,
+the statement that `na.reverse` accepts `xs` iff `na` accepts `xs.reverse`.
+-/
+
+
+@[expose] public section
+
+namespace Cslib.Automata.NA
+
+open Acceptor Language
+
+variable {State Symbol : Type*}
+
+namespace FinAcc
+
+/-- `na.reverse` reverses every transition of `na` and swaps its start and accept states,
+so that it accepts exactly the reversals of the words accepted by `na`. -/
+def reverse (na : FinAcc State Symbol) : FinAcc State Symbol where
+  toLTS := na.toLTS.reverse
+  start := na.accept
+  accept := na.start
+
+/-- Reversing an automaton twice gives back the original automaton. -/
+@[simp]
+theorem reverse_reverse (na : FinAcc State Symbol) : na.reverse.reverse = na := rfl
+
+/-- Reversal of an automaton is an involution. -/
+theorem reverse_involutive : Function.Involutive (reverse (State := State) (Symbol := Symbol)) :=
+  reverse_reverse
+
+/-- The start states of `na.reverse` are the accept states of `na`. -/
+@[simp, grind =]
+theorem reverse_start (na : FinAcc State Symbol) : na.reverse.start = na.accept := rfl
+
+/-- The accept states of `na.reverse` are the start states of `na`. -/
+@[simp, grind =]
+theorem reverse_accept (na : FinAcc State Symbol) : na.reverse.accept = na.start := rfl
+
+/-- The multistep transitions of `na.reverse` are exactly the reversed multistep transitions
+of `na`. -/
+@[simp]
+theorem reverse_mTr (na : FinAcc State Symbol) {xs : List Symbol} {s s' : State} :
+    na.reverse.MTr s' xs s ↔ na.MTr s xs.reverse s' := LTS.reverse_mTr
+
+/-- `na.reverse` accepts a word iff `na` accepts its reversal. -/
+@[simp]
+theorem accepts_reverse {na : FinAcc State Symbol} {xs : List Symbol} :
+    Accepts na.reverse xs ↔ Accepts na xs.reverse := by
+  grind [Accepts, reverse_mTr]
+
+/-- `na.reverse` accepts exactly the reversals of the words accepted by `na`. -/
+@[simp]
+theorem reverse_language_eq (na : FinAcc State Symbol) :
+    language na.reverse = (language na).reverse := by
+  ext; simp
+
+end FinAcc
+
+end Cslib.Automata.NA
diff --git a/Cslib/Computability/Automata/Transducers/Transducer.lean b/Cslib/Computability/Automata/Transducers/Transducer.lean
new file mode 100644
index 0000000000..e17942b640
--- /dev/null
+++ b/Cslib/Computability/Automata/Transducers/Transducer.lean
@@ -0,0 +1,26 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Init
+
+/-! # Transducers -/
+
+@[expose] public section
+
+namespace Cslib.Automata
+
+/-- A `Transducer` is an automaton that translates strings (lists of symbols, from an input to an
+output alphabet). -/
+class Transducer (A : Type u) (InSymbol OutSymbol : outParam (Type v)) where
+  /-- The string `xs` can be translated into `ys` by `a`. -/
+  Translates (a : A) (xs : List InSymbol) (ys : List OutSymbol) : Prop
+
+@[inherit_doc]
+scoped notation xs "[" a "]" ys => Transducer.Translates a xs ys
+
+end Cslib.Automata
diff --git a/Cslib/Computability/Distributed/FLP/Algorithm.lean b/Cslib/Computability/Distributed/FLP/Algorithm.lean
index ccd90dbf65..8a858af0fe 100644
--- a/Cslib/Computability/Distributed/FLP/Algorithm.lean
+++ b/Cslib/Computability/Distributed/FLP/Algorithm.lean
@@ -202,13 +202,16 @@ theorem tr_diamond {ps : Set P} {x1 x2 : Action P M} {s s1 s2 : State P M S}
     (hx1 : DestIn ps x1) (hs1 : a.lts.Tr s x1 s1)
     (hx2 : DestIn psᶜ x2) (hs2 : a.lts.Tr s x2 s2) :
     ∃ s', a.lts.Tr s1 x2 s' ∧ a.lts.Tr s2 x1 s' := by
-  cases x1 <;> cases x2 <;> try grind [Algorithm.lts]
-  case some m1 m2 =>
-    have hd : m1.dest ≠ m2.dest := by grind [DestIn]
-    obtain ⟨h_m1, rfl⟩ := hs1
-    obtain ⟨h_m2, rfl⟩ := hs2
-    simp only [Algorithm.lts, exists_eq_right_right]
-    grind [recvMsg_comm (a := a) hd h_m1 h_m2]
+  cases x1 <;> cases x2
+  · grind [Algorithm.lts]
+  · grind [Algorithm.lts]
+  · grind [Algorithm.lts]
+  · case some m1 m2 =>
+      have hd : m1.dest ≠ m2.dest := by grind [DestIn]
+      obtain ⟨h_m1, rfl⟩ := hs1
+      obtain ⟨h_m2, rfl⟩ := hs2
+      simp only [Algorithm.lts, exists_eq_right_right]
+      grind [recvMsg_comm (a := a) hd h_m1 h_m2]
 
 /-- A message that is in-flight stays in-flight as long as it is not received
 (finite execution version). -/
diff --git a/Cslib/Computability/Distributed/FLP/CanReachVia.lean b/Cslib/Computability/Distributed/FLP/CanReachVia.lean
new file mode 100644
index 0000000000..44a538e7a1
--- /dev/null
+++ b/Cslib/Computability/Distributed/FLP/CanReachVia.lean
@@ -0,0 +1,144 @@
+/-
+Copyright (c) 2026 Ching-Tsun Chou. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ching-Tsun Chou
+-/
+
+module
+
+public import Cslib.Computability.Distributed.FLP.Algorithm
+
+/-! # Reachability via a subset of processes
+
+This file develops a theory of reachability via a subset of processes, that is, what happens
+when only a subset of processes can receive messages and take steps.  It culminates with two
+"diamond properties" of this more refined reachability relation.
+
+## References
+
+* [Volzer2004] H. Völzer, A constructive proof for FLP.
+  Information Processing Letters 92(2), (October 2004) 83–87.
+-/
+
+@[expose] public section
+
+namespace Cslib.FLP
+
+open Function Set Sum Multiset
+
+variable {P M S : Type*} [DecidableEq P] [DecidableEq M]
+
+/-- `a.CanReachVia ps s1 s2` means that state `s2` is reachable from state `s1` via a finite
+execution of algorithm `a` in which all messages received have destinations in `ps`. -/
+def Algorithm.CanReachVia (a : Algorithm P M S) (ps : Set P) (s1 s2 : State P M S) : Prop :=
+  ∃ xs, a.lts.MTr s1 xs s2 ∧ xs.Forall (DestIn ps)
+
+/-- `InpEqOn ps inp1 inp2` means that inputs `inp1` and `inp2` agree on all processes in `ps`. -/
+def InpEqOn (ps : Set P) (inp1 inp2 : P → Bool) : Prop :=
+  ∀ p, p ∈ ps → inp1 p = inp2 p
+
+namespace CanReachVia
+
+variable {a : Algorithm P M S}
+
+/-- `a.CanReachVia ps s s'` implies `a.lts.CanReach s s'` for any `ps`. -/
+theorem canReach {ps : Set P} {s s' : State P M S}
+    (h : a.CanReachVia ps s s') : a.lts.CanReach s s' := by
+  obtain ⟨xs, h_mtr, _⟩ := h
+  use xs
+
+/-- `a.CanReachVia ps s s` is true for any `ps`. -/
+theorem refl (ps : Set P) (s : State P M S) :
+    a.CanReachVia ps s s := by
+  use []
+  simp
+
+/-- Extending `CanReachVia` on the left by one step. -/
+theorem stepL {ps : Set P} {x : Action P M} {s1 s2 s3 : State P M S}
+    (hx : DestIn ps x) (h1 : a.lts.Tr s1 x s2) (h2 : a.CanReachVia ps s2 s3) :
+    a.CanReachVia ps s1 s3 := by
+  obtain ⟨xs, _, _⟩ := h2
+  use (x :: xs)
+  grind [LTS.MTr.stepL, List.forall_cons]
+
+private lemma diamond_helper
+    {ps : Set P} {x : Action P M} {s s1 s2 : State P M S}
+    (hx : DestIn ps x) (h1 : a.lts.Tr s x s1) (h2 : a.CanReachVia psᶜ s s2) :
+    ∃ s', a.CanReachVia psᶜ s1 s' ∧ a.lts.Tr s2 x s' := by
+  obtain ⟨xs2, h_mtr2, h_via2⟩ := h2
+  induction h_mtr2 generalizing s1
+  case refl s =>
+    use s1
+    simp_all [refl]
+  case stepL s y t2 ys s2 h_tr2 h_mtr2 h_ind =>
+    obtain ⟨h_y, h_ys⟩ := (List.forall_cons (DestIn psᶜ) y ys).mp h_via2
+    obtain ⟨t1, h_tr1, h_tr21⟩ := Algorithm.tr_diamond hx h1 h_y h_tr2
+    obtain ⟨s', h_crv1, h_tr2'⟩ := h_ind h_tr21 h_ys
+    use s', ?_, h_tr2'
+    exact stepL h_y h_tr1 h_crv1
+
+/-- A diamond property for `CanReachVia`. This theorem formalizes Proposition 1 of [Volzer2004]. -/
+theorem diamond {ps : Set P} {s s1 s2 : State P M S}
+    (h1 : a.CanReachVia ps s s1) (h2 : a.CanReachVia psᶜ s s2) :
+    ∃ s', a.CanReachVia psᶜ s1 s' ∧ a.CanReachVia ps s2 s' := by
+  obtain ⟨xs1, h_mtr1, h_via1⟩ := h1
+  induction h_mtr1 generalizing s2
+  case refl s =>
+    use s2
+    simp_all [refl]
+  case stepL s x t1 xs s1 h_tr1 h_mtr1 h_ind =>
+    obtain ⟨h_x, h_xs⟩ := (List.forall_cons (DestIn ps) x xs).mp h_via1
+    obtain ⟨t2, h_crv, h_tr2⟩:= diamond_helper h_x h_tr1 h2
+    obtain ⟨s', h_crv1, h_crv2⟩ := h_ind h_crv h_xs
+    use s', h_crv1
+    exact stepL h_x h_tr2 h_crv2
+
+/-- If inputs `inp1` and `inp2` agree on all processes in `ps` and state `s` is reachable from
+the initial state determined by `inp1` by receiving messages with destinations in `ps` only,
+then there exists a state `s2` that agrees with `s` on the states of all processes and is
+reachable from the initial state determined by `inp2` by receiving messages with destinations
+in `ps` only. This theorem is implicitly used in the proof of Lemma 1 of [Volzer2004]. -/
+theorem subset_inp [Fintype P] {ps : Set P} {inp1 inp2 : P → Bool} {s1 : State P M S}
+    (he : InpEqOn ps inp1 inp2) (hr : a.CanReachVia ps (a.start inp1) s1) :
+    ∃ s2, a.CanReachVia ps (a.start inp2) s2 ∧ s2.proc = s1.proc := by
+  obtain ⟨xs, h_mtr, h_xs⟩ := hr
+  obtain ⟨ss, _, h_ss0, _, _⟩ := LTS.Execution.of_mTr h_mtr
+  suffices h_inv : ∀ k, (_ : k ≤ xs.length) →
+    ∃ s2, a.lts.MTr (a.start inp2) (xs.take k) s2 ∧ s2.proc = ss[k].proc ∧
+      ∀ m, m.dest ∈ ps → s2.msgs.count m = ss[k].msgs.count m by
+    obtain ⟨s2, _⟩ := h_inv xs.length (by simp)
+    use s2, ?_, by grind
+    use xs, by grind
+  intro k h_k
+  induction k
+  case zero =>
+    use a.start inp2, by grind [LTS.MTr], by grind [Algorithm.start]
+    intro m h_m
+    simp only [h_ss0, Algorithm.start, count_map, Message.ext_iff]
+    congr
+    grind [InpEqOn]
+  case succ k h_ind =>
+    obtain ⟨s2, h_mtr, h_proc, h_msgs⟩ := h_ind (by grind)
+    obtain (_ | ⟨m, h_m⟩) := Option.eq_none_or_eq_some xs[k]
+    · use s2, ?_, ?_, ?_
+      · have h_tr : a.lts.Tr s2 xs[k] s2 := by grind [Algorithm.lts]
+        grind [List.take_add_one, LTS.MTr.stepR (lts := a.lts) h_mtr h_tr]
+      · grind [Algorithm.tr_none]
+      · grind [Algorithm.tr_none]
+    · obtain ⟨_, h_k1⟩ : m ∈ ss[k].msgs ∧ ss[k + 1] = a.recvMsg m ss[k] := by grind [Algorithm.lts]
+      use a.recvMsg m s2, ?_, ?_, ?_
+      · have := List.forall_mem_iff_forall_getElem.mp <| List.forall_iff_forall_mem.mp h_xs
+        have h_tr : a.lts.Tr s2 xs[k] (a.recvMsg m s2) := by
+          grind [Algorithm.lts, DestIn, one_le_count_iff_mem]
+        grind [List.take_add_one, LTS.MTr.stepR (lts := a.lts) h_mtr h_tr]
+      · grind [Algorithm.recvMsg]
+      · intro m1 h_m1
+        by_cases h1 : m1 = m
+        · simp [h_k1, Algorithm.recvMsg, h_proc, h1, count_erase_self]
+          grind
+        · simp [h_k1, Algorithm.recvMsg, h_proc, count_erase_of_ne h1]
+          grind
+
+end CanReachVia
+
+end Cslib.FLP
diff --git a/Cslib/Computability/Distributed/FLP/Consensus.lean b/Cslib/Computability/Distributed/FLP/Consensus.lean
index b7209ed905..e83ee2aab0 100644
--- a/Cslib/Computability/Distributed/FLP/Consensus.lean
+++ b/Cslib/Computability/Distributed/FLP/Consensus.lean
@@ -100,6 +100,21 @@ def Algorithm.Consensus [Fintype P] (a : Algorithm P M S) (f : ℕ) : Prop :=
 
 variable {a : Algorithm P M S} {inp : P → Bool}
 
+/-- Specialize the definition of `Algorithm.AdmissibleRun` to the case of zero fault. -/
+theorem AdmissibleRun.fault_zero [Fintype P]
+    {xs : ωSequence (Action P M)} {ss : ωSequence (State P M S)} :
+    a.AdmissibleRun inp 0 ss xs ↔
+    ss 0 = a.start inp ∧ a.lts.OmegaExecution ss xs ∧ ∀ p, ProcFair p ss xs := by
+  constructor
+  · rintro ⟨_, _, _, hf⟩
+    suffices ∀ p, ¬ ProcFaulty p ss xs by grind [FairRun, not_procFaulty_and_procFair]
+    simp (disch := toFinite_tac) [numProcFaulty, ncard_eq_zero, Set.ext_iff] at hf
+    assumption
+  · rintro ⟨hi, hr, _⟩
+    use hi, hr, by grind [FairRun]
+    have : ∀ p, ¬ ProcFaulty p ss xs := by grind [not_procFaulty_and_procFair]
+    simpa (disch := toFinite_tac) [numProcFaulty, ncard_eq_zero, Set.ext_iff]
+
 /-- If an infinite execution is admissible with up tp `f` faulty processes,
 then it is also admissible with with up tp `f' ≥ f` faulty processes. -/
 theorem AdmissibleRun.fault_mono [Fintype P] {f f' : ℕ}
diff --git a/Cslib/Computability/Distributed/FLP/FairScheduler.lean b/Cslib/Computability/Distributed/FLP/FairScheduler.lean
new file mode 100644
index 0000000000..9e9d622c58
--- /dev/null
+++ b/Cslib/Computability/Distributed/FLP/FairScheduler.lean
@@ -0,0 +1,250 @@
+/-
+Copyright (c) 2026 Ching-Tsun Chou. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ching-Tsun Chou
+-/
+
+module
+
+public import Cslib.Computability.Distributed.FLP.Consensus
+public import Cslib.Foundations.Data.OmegaSequence.InfOcc
+public import Mathlib.Data.List.ReduceOption
+
+/-! # Machinery for constructing infinite fair executions
+
+The main goal of this file is to define a `fairScheduler` that, given a function `d`
+of type `DeliverMsg`, a state predicate `q`, and a state `s0` of an algorithm `a`,
+constructs an infinite execution of `a` starting from state `s0` in which all processes
+from a set `ps` are fair and `q` is true infinitely often.  With additional assumptions,
+we may also want to require that all actions in the infinite execution satisfy an action
+predicate `r`.
+-/
+
+@[expose] public section
+
+namespace Cslib.FLP
+
+open Function Set Multiset Filter ωSequence
+
+variable {P M S : Type*} [DecidableEq P] [DecidableEq M]
+
+/-- Given a state `s` and a message `m`, a function `d` of type `DeliverMsg` is supposed to
+return `(xs, t)` where `xs` is a finite execution from `s` to `t` in which `m` is delivered. -/
+def DeliverMsg P M S := State P M S → Message P M → List (Action P M) × State P M S
+
+/-- `d.ForallActions r` requires that all actions returned by `d` satisfy `r`. -/
+def DeliverMsg.ForallActions (d : DeliverMsg P M S) (r : Action P M → Prop) : Prop :=
+  ∀ s m, (d s m).fst.Forall r
+
+/-- `d.foldList s ml ms` uses `d` to deliver all messages that are in `ml` but not in `ms` from
+state `s`. Note that if a message `m` in `ml` is delivered during the delivery of an earlier
+message, `m` is added to `ms` so that it is not processed again. -/
+def DeliverMsg.foldList (d : DeliverMsg P M S) (s : State P M S) :
+    List (Message P M) → Finset (Message P M) → List (Action P M) × State P M S
+  | [], _ => ([], s)
+  | m :: ml, ms =>
+    if m ∈ ms then
+      d.foldList s ml ms
+    else
+      let (xl1, s1) := d s m
+      let ms' := ms ∪ xl1.reduceOption.toFinset
+      let (xl2, s2) := d.foldList s1 ml ms'
+      (xl1 ++ xl2, s2)
+
+open scoped Classical in
+/-- `d.scheduleMsgs ps s` schedules and delivers all messages which are in-flight in state `s`
+and have destinations in `ps` in some order (as determined by choice).  If no such message exists,
+then the the stuttering step is taken. -/
+noncomputable def DeliverMsg.scheduleMsgs (d : DeliverMsg P M S) (ps : Set P)
+    (s : State P M S) : List (Action P M) × State P M S :=
+  let ms := s.msgs.filter (fun m ↦ m.dest ∈ ps)
+  if ms = 0 then
+    ([none], s)
+  else
+    d.foldList s ms.toList ∅
+
+namespace DeliverMsg
+
+variable {d : DeliverMsg P M S}
+
+/-- If `d.ForallActions r`, then `d.foldList s ml ms` can only use actions satisfying `r`. -/
+theorem foldList_forallActions {r : Action P M → Prop}
+    (s : State P M S) (ml : List (Message P M)) (ms : Finset (Message P M))
+    (h : d.ForallActions r) : (d.foldList s ml ms).fst.Forall r := by
+  induction ml generalizing s ms <;>
+    grind [DeliverMsg.foldList, DeliverMsg.ForallActions, List.Forall, List.forall_append]
+
+end DeliverMsg
+
+/-- Starting from state `s0`, `a.fairSchedular d ps s0` constructs an infinite sequence of
+finite executions of `a` by repeatedly applying `d.scheduleMsgs ps`. -/
+noncomputable def Algorithm.fairScheduler (a : Algorithm P M S) (d : DeliverMsg P M S) (ps : Set P)
+    (s0 : State P M S) : ℕ → List (Action P M) × State P M S
+  | 0 => ([], s0)
+  | k + 1 => d.scheduleMsgs ps (a.fairScheduler d ps s0 k).snd
+
+/-- The infinite sequence of states forming the end states of the finite executions constructed
+by `Algorithm.fairScheduler`. -/
+noncomputable def Algorithm.fairSegEnds (a : Algorithm P M S) (d : DeliverMsg P M S)
+    (ps : Set P) (s0 : State P M S) : ωSequence (State P M S) :=
+  ωSequence.mk (fun k ↦ (a.fairScheduler d ps s0 k).snd)
+
+/-- The infinite sequence of finite action sequences from the finite executions constructed
+by `Algorithm.fairScheduler`. -/
+noncomputable def Algorithm.fairSegActions (a : Algorithm P M S) (d : DeliverMsg P M S)
+    (ps : Set P) (s0 : State P M S) : ωSequence (List (Action P M)) :=
+  (ωSequence.mk (fun k ↦ (a.fairScheduler d ps s0 k).fst)).tail
+
+/-- `a.FairDeliverMsg d ps q` says that for any state `s` of `a` satisfying `q` and
+any message `m` which is in-flight in `s` and whose destination is in `ps`, `d s m`
+produces a legal finite execution of `a` in which `m` is delivered and which ends in
+a state satisfying `q` again. -/
+def Algorithm.FairDeliverMsg (a : Algorithm P M S) (d : DeliverMsg P M S)
+    (ps : Set P) (q : State P M S → Prop) : Prop :=
+  ∀ s m, m ∈ s.msgs ∧ m.dest ∈ ps ∧ q s →
+    let (xl, t) := d s m
+    a.lts.MTr s xl t ∧ some m ∈ xl ∧ q t
+
+namespace FairScheduler
+
+variable {a : Algorithm P M S}
+
+/-- Re-stating the definition of `Algorithm.fairScheduler` as a mutual recursion of
+`Algorithm.fairSegEnds` and `Algorithm.fairSegActions`. -/
+theorem fairScheduler_init {d : DeliverMsg P M S} (ps : Set P) (s0 : State P M S) :
+    a.fairSegEnds d ps s0 0 = s0 := by
+  grind [Algorithm.fairScheduler, Algorithm.fairSegEnds]
+
+/-- Re-stating the definition of `Algorithm.fairScheduler` as a mutual recursion of
+`Algorithm.fairSegEnds` and `Algorithm.fairSegActions`. -/
+theorem fairScheduler_step {d : DeliverMsg P M S} (ps : Set P) (s0 : State P M S) (k : ℕ) :
+    d.scheduleMsgs ps (a.fairSegEnds d ps s0 k) =
+    (a.fairSegActions d ps s0 k, a.fairSegEnds d ps s0 (k + 1)) := by
+  grind [Algorithm.fairScheduler, Algorithm.fairSegEnds, Algorithm.fairSegActions]
+
+/-- If `d.ForallActions r`, then `a.fairSegActions d ps s0` can only use actions satisfying `r`. -/
+theorem fairSeg_forallActions {d : DeliverMsg P M S} {r : Action P M → Prop}
+    (ps : Set P) (s0 : State P M S) (k : ℕ) (ha : d.ForallActions r) (hn : r none) :
+    (a.fairSegActions d ps s0 k).Forall r := by
+  grind [fairScheduler_step (a := a) (d := d) ps s0 k,
+    DeliverMsg.scheduleMsgs, DeliverMsg.foldList_forallActions, List.Forall]
+
+/-- The correctness of `d.foldList s ml ms` under the assumption `a.FairDeliverMsg d ps q`. -/
+theorem fairDeliverMsg_foldList {d : DeliverMsg P M S} {ps : Set P} {q : State P M S → Prop}
+    (hd : a.FairDeliverMsg d ps q) (s : State P M S)
+    (ml : List (Message P M)) (ms : Finset (Message P M))
+    (hs : q s ∧ ∀ m, m ∈ ml → ¬ m ∈ ms → m ∈ s.msgs ∧ m.dest ∈ ps) :
+    let (xl, t) := d.foldList s ml ms
+    a.lts.MTr s xl t ∧ q t ∧ ∀ m, m ∈ ml → ¬ m ∈ ms → some m ∈ xl := by
+  induction ml generalizing s ms
+  case nil => grind [DeliverMsg.foldList, LTS.MTr]
+  case cons m ml h_ind =>
+    by_cases h_m : m ∈ ms
+    · grind [DeliverMsg.foldList]
+    · let xl1 := (d s m).fst
+      let s1 := (d s m).snd
+      let ms' := ms ∪ xl1.reduceOption.toFinset
+      have (m' : Message P M) : m' ∈ xl1.reduceOption.toFinset ↔ some m' ∈ xl1 := by
+        simp [List.mem_toFinset, List.reduceOption_mem_iff]
+      have (m' : Message P M) : m' ∈ ml → ¬ m' ∈ ms' → m' ∈ s1.msgs := by
+        grind [Algorithm.FairDeliverMsg, Algorithm.mTr_notRcvd_enabled]
+      grind [DeliverMsg.foldList, Algorithm.FairDeliverMsg, LTS.MTr.comp]
+
+/-- The correctness of `d.scheduleMsgs ps s` under the assumption `a.FairDeliverMsg d ps q`. -/
+theorem fairDeliverMsg_scheduleMsgs {d : DeliverMsg P M S} {ps : Set P} {q : State P M S → Prop}
+    (hd : a.FairDeliverMsg d ps q) (s : State P M S) (hs : q s) :
+    let xl := (d.scheduleMsgs ps s).fst
+    let t := (d.scheduleMsgs ps s).snd
+    q t ∧ a.lts.MTr s xl t ∧ xl.length > 0 ∧ ∀ m, m ∈ s.msgs → m.dest ∈ ps → some m ∈ xl := by
+  classical
+  intro xl t
+  let ms := s.msgs.filter (fun m ↦ m.dest ∈ ps)
+  by_cases h_ms : ms = 0
+  · have h1 : xl = [none] ∧ t = s := by grind [DeliverMsg.scheduleMsgs]
+    simp [ms, eq_zero_iff_forall_notMem] at h_ms
+    simp only [h1, hs, List.length_cons, List.length_nil, zero_add, Order.lt_one_iff, true_and]
+    split_ands
+    · apply LTS.MTr.single
+      grind [Algorithm.lts]
+    · grind
+  · have : q t ∧ a.lts.MTr s xl t ∧ ∀ m, m ∈ ms.toList → some m ∈ xl := by
+      grind [DeliverMsg.scheduleMsgs, fairDeliverMsg_foldList hd s ms.toList ∅ (by simp [ms, hs])]
+    obtain ⟨m, _⟩ := exists_mem_of_ne_zero h_ms
+    have : some m ∈ xl := by grind [mem_toList]
+    split_ands <;> grind [mem_toList, mem_filter]
+
+/-- The correctness of `a.fairSegEnds d ps s0` and `a.fairSegActions d ps s0`
+under the assumption `a.FairDeliverMsg d ps q`. -/
+theorem fair_fairSegs {d : DeliverMsg P M S} {ps : Set P} {q : State P M S → Prop}
+    (hd : a.FairDeliverMsg d ps q) (s0 : State P M S) (hs0 : q s0) :
+    let ts := a.fairSegEnds d ps s0
+    let xls := a.fairSegActions d ps s0
+    ∀ k, q (ts k) ∧ a.lts.MTr (ts k) (xls k) (ts (k + 1)) ∧ (xls k).length > 0 ∧
+      ∀ m, m ∈ (ts k).msgs → m.dest ∈ ps → some m ∈ xls k := by
+  classical
+  intro ts xls k
+  induction k <;> grind [fairScheduler_init, fairScheduler_step, fairDeliverMsg_scheduleMsgs]
+
+/-- Given an infinite sequence of non-empty finite executions of algorithm `a`,
+if all messages with destinations in `ps` that are in-flight at the beginning of each
+finite execution are delivered in that finite execution, then those finite executions can
+be concatenated into an infinite execution of `a` in which every process in `ps` is fair. -/
+theorem flatten_fairSegs {ps : Set P}
+    {ts : ωSequence (State P M S)} {xls : ωSequence (List (Action P M))}
+    (hmtr : ∀ k, a.lts.MTr (ts k) (xls k) (ts (k + 1)))
+    (hpos : ∀ k, (xls k).length > 0)
+    (hsch : ∀ k m, m ∈ (ts k).msgs → m.dest ∈ ps → some m ∈ xls k) :
+    ∃ ss, a.lts.OmegaExecution ss xls.flatten ∧ (∀ k, ss (xls.cumLen k) = ts k) ∧
+      ∀ p, p ∈ ps → ProcFair p ss xls.flatten := by
+  obtain ⟨ss, h_omega, h_ts⟩ := LTS.OmegaExecution.flatten_mTr hmtr hpos
+  use ss, h_omega, h_ts
+  rintro p h_m m ⟨rfl⟩
+  by_contra! ⟨k, h_k, h_k'⟩
+  have h_xls : ∃ᶠ n in atTop, n ∈ xls.cumLen '' univ := by
+    apply frequently_iff_strictMono.mpr
+    use xls.cumLen
+    grind [cumLen_strictMono]
+  obtain ⟨j, _, h_j⟩ : ∃ j, k ≤ xls.cumLen j ∧ m ∈ (ts j).msgs := by
+    obtain ⟨n, _, j, _, _⟩ := frequently_atTop.mp h_xls k
+    grind [Algorithm.omega_notRcvd_enabled h_omega h_k h_k']
+  obtain ⟨i, _, _⟩ := List.getElem_of_mem <| hsch j m h_j h_m
+  grind [extract_flatten hpos j]
+
+/-- Under the assumption `a.FairDeliverMsg d ps q`, the infinite sequence of finite executions
+of `a` represented by `a.fairSegEnds d ps s0` and `a.fairSegActions d ps s0` can be concatenated
+into an infinite execution of `a` in which every process in `ps` is fair and `q` is true at
+the ends of all those finite executions. -/
+theorem fair_omegaExecution {d : DeliverMsg P M S} {ps : Set P} {q : State P M S → Prop}
+    (hd : a.FairDeliverMsg d ps q) (s0 : State P M S) (hs0 : q s0) :
+    let ts := a.fairSegEnds d ps s0
+    let xls := a.fairSegActions d ps s0
+    ∃ ss, a.lts.OmegaExecution ss xls.flatten ∧
+      ss 0 = s0 ∧ (∀ k, ss (xls.cumLen k) = ts k) ∧
+      (∀ k, q (ss (xls.cumLen k))) ∧ (∀ k, (xls k).length > 0) ∧
+      ∀ p, p ∈ ps → ProcFair p ss xls.flatten := by
+  intro ts xls
+  obtain ⟨h_q, hmtr, hpos, hsch⟩ :
+      (∀ k, q (ts k)) ∧
+      (∀ k, a.lts.MTr (ts k) (xls k) (ts (k + 1))) ∧
+      (∀ k, (xls k).length > 0) ∧
+      (∀ k m, m ∈ (ts k).msgs → m.dest ∈ ps → some m ∈ xls k) := by
+    grind [fair_fairSegs hd s0 hs0]
+  obtain ⟨ss, _, _, _⟩ := flatten_fairSegs hmtr hpos hsch
+  have : ss 0 = s0 := by grind [fairScheduler_init]
+  use ss
+  grind
+
+/-- If `d.ForallActions r`, then the concatenation of all `a.fairSegActions d ps s0` segments
+can only use actions satisfying `r`. -/
+theorem omega_forall_actions {d : DeliverMsg P M S} {ps : Set P}
+    {q : State P M S → Prop} {r : Action P M → Prop}
+    (hd : a.FairDeliverMsg d ps q) (s0 : State P M S) (hs0 : q s0)
+    (ha : d.ForallActions r) (hn : r none) :
+    ∀ k, r ((a.fairSegActions d ps s0).flatten k) := by
+  have hpos : ∀ k, (a.fairSegActions d ps s0 k).length > 0 := by grind [fair_fairSegs hd s0 hs0]
+  simp only [forall_flatten_iff hpos]
+  grind [fairSeg_forallActions]
+
+end FairScheduler
+
+end Cslib.FLP
diff --git a/Cslib/Computability/Distributed/FLP/Impossibility.lean b/Cslib/Computability/Distributed/FLP/Impossibility.lean
new file mode 100644
index 0000000000..7d2db0c56f
--- /dev/null
+++ b/Cslib/Computability/Distributed/FLP/Impossibility.lean
@@ -0,0 +1,174 @@
+/-
+Copyright (c) 2026 Ching-Tsun Chou. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ching-Tsun Chou
+-/
+
+module
+
+public import Cslib.Computability.Distributed.FLP.OnePseudoConsensus
+public import Cslib.Foundations.Data.OmegaSequence.InfOcc
+
+/-! # Impossibility of asynchronous distributed consensus in the presence of a single fault
+
+This file formalizes the main theorem (Theorem 1) of [Volzer2004] and uses it to prove the
+impossibility of asynchronous distributed consensus in the presence of a single fault.
+-/
+
+@[expose] public section
+
+namespace Cslib.FLP
+
+open Function Set Multiset Fintype Filter ωSequence
+
+variable {P M S : Type*} [DecidableEq P] [DecidableEq M]
+
+variable {a : Algorithm P M S}
+
+/-- `a.ReachableNonUniform inp s` means that `s` is a reachable and non-uniform state of
+algorithm `a` on input `inp`. -/
+abbrev Algorithm.ReachableNonUniform [Fintype P]
+    (a : Algorithm P M S) (inp : P → Bool) (s : State P M S) : Prop :=
+  a.Reachable inp s ∧ a.NonUniform s
+
+/-- Choose an arbitrary non-uniform input. -/
+noncomputable def Algorithm.nonUniformInp [Fintype P] (a : Algorithm P M S)
+    (hpc1 : a.PseudoConsensus 1) (hc : card P ≥ 2) : P → Bool :=
+  Classical.choose (OnePseudoConsensus.nonUniform_inp hpc1 hc)
+
+/-- Assuming `a.PseudoConsensus 1` and there are at least 2 processes, the input chosen by
+`a.nonUniformInp` does indeed give rise to a non-uniform initial state. -/
+theorem OnePseudoConsensus.nonUniform_init [Fintype P]
+    (hpc1 : a.PseudoConsensus 1) (hc : card P ≥ 2) :
+    let inp := a.nonUniformInp hpc1 hc
+    a.ReachableNonUniform inp (a.start inp) := by
+  grind [Algorithm.nonUniformInp, Algorithm.reachable_start]
+
+/-- Assuming `a.PseudoConsensus 1`, starting from any reachable non-uniform state of `a` and
+any message `m` that is in-flight in `s`, there exists a finite execution of `a` in which `m`
+is received and which ends in another non-uniform state. -/
+theorem OnePseudoConsensus.nonUniform_step_exists [Fintype P] {inp : P → Bool}
+    (hpc1 : a.PseudoConsensus 1) {s : State P M S} {m : Message P M}
+    (hs : a.ReachableNonUniform inp s) (hm : m ∈ s.msgs) :
+    ∃ xl t, a.lts.MTr s xl t ∧ some m ∈ xl ∧ a.ReachableNonUniform inp t := by
+  obtain ⟨hr, hn⟩ := hs
+  obtain ⟨s', ⟨xl, h_mtr⟩, _⟩ := nonUniform_step hpc1 hr hn m.dest
+  by_cases h_xl : some m ∈ xl
+  · use xl, s'
+    split_ands
+    · assumption
+    · assumption
+    · grind [Algorithm.reachable_stable, LTS.CanReach]
+    · intro b
+      use m.dest
+      grind
+  · have := Algorithm.mTr_notRcvd_enabled h_mtr hm h_xl
+    have h_tr : a.lts.Tr s' (some m) (a.recvMsg m s') := by grind [Algorithm.lts]
+    have : a.lts.MTr s (xl ++ [some m]) (a.recvMsg m s') := by grind [LTS.MTr.stepR]
+    use xl ++ [some m], a.recvMsg m s'
+    split_ands
+    · assumption
+    · simp
+    · grind [Algorithm.reachable_stable, LTS.CanReach]
+    · intro b
+      use m.dest
+      grind [canDecideWithout_dest]
+
+lemma OnePseudoConsensus.nonUniform_step_aux [Fintype P] (inp : P → Bool)
+    (hpc1 : a.PseudoConsensus 1) (s : State P M S) (m : Message P M) :
+    ∃ xl_t, m ∈ s.msgs ∧ a.ReachableNonUniform inp s →
+      let (xl, t) := xl_t
+      a.lts.MTr s xl t ∧ some m ∈ xl ∧ a.ReachableNonUniform inp t := by
+  by_cases h : m ∈ s.msgs ∧ a.ReachableNonUniform inp s
+  · obtain ⟨hm, hs⟩ := h
+    obtain ⟨xl, t, _⟩ := OnePseudoConsensus.nonUniform_step_exists hpc1 hs hm
+    use (xl, t)
+    grind
+  · use ([], s)
+    grind
+
+/-- Choose an arbitrary finite execution guaranteed to exist by the theorem
+`OnePseudoConsensus.nonUniform_step_exists`. -/
+noncomputable def Algorithm.nonUniformStep [Fintype P] (a : Algorithm P M S) (inp : P → Bool)
+    (hpc1 : a.PseudoConsensus 1) : DeliverMsg P M S :=
+  fun s m ↦ Classical.choose (OnePseudoConsensus.nonUniform_step_aux inp hpc1 s m)
+
+/-- Assuming `a.PseudoConsensus 1`, `a.nonUniformStep` does have the property guaranteed by
+the theorem `OnePseudoConsensus.nonUniform_step_exists`. -/
+theorem OnePseudoConsensus.fair_nonUniform_step [Fintype P] (inp : P → Bool)
+    (hpc1 : a.PseudoConsensus 1) :
+    a.FairDeliverMsg (a.nonUniformStep inp hpc1) univ (a.ReachableNonUniform inp) := by
+  intro s m
+  grind [Algorithm.nonUniformStep]
+
+/-- Assuming `a.PseudoConsensus 1`, starting from any reachable non-uniform state `s0` of `a`,
+use the fair scheduler developed in `FairSchedular.lean` to construct an infinite fair execution
+in which there are infinitely many non-uniform states. -/
+theorem OnePseudoConsensus.fair_nonUniform [Fintype P] (inp : P → Bool)
+    (hpc1 : a.PseudoConsensus 1) (s0 : State P M S) (hs0 : a.ReachableNonUniform inp s0) :
+    ∃ ss xs, a.lts.OmegaExecution ss xs ∧ ss 0 = s0 ∧ (∀ p, ProcFair p ss xs) ∧
+      ∃ᶠ n in atTop, a.ReachableNonUniform inp (ss n) := by
+  obtain ⟨ss', _⟩ := FairScheduler.fair_omegaExecution (fair_nonUniform_step inp hpc1) s0 hs0
+  let xls := a.fairSegActions (a.nonUniformStep inp hpc1) univ s0
+  use ss', xls.flatten
+  split_ands
+  · grind
+  · grind
+  · grind
+  · apply frequently_iff_strictMono.mpr
+    use xls.cumLen
+    grind [cumLen_strictMono]
+
+/-- Assuming `a.PseudoConsensus 1` and there are at least 2 processes, there must exist an
+infinite admissible execution in which no process is faulty but no process terminates, either.
+This theorem formalizes Theorem 1 of [Volzer2004]. -/
+theorem OnePseudoConsensus.not_terminating [Fintype P]
+    (hpc1 : a.PseudoConsensus 1) (hc : card P ≥ 2) :
+    ∃ inp ss xs, a.AdmissibleRun inp 0 ss xs ∧ ∀ p, ¬ ProcTermination p ss xs := by
+  let inp := a.nonUniformInp hpc1 hc
+  let s0 := a.start inp
+  obtain ⟨ss, xs, _, _, _, h_freq⟩ := fair_nonUniform inp hpc1 s0 (nonUniform_init hpc1 hc)
+  use inp, ss, xs
+  split_ands
+  · assumption
+  · assumption
+  · grind [FairRun]
+  · have := numProcFaulty_le_not_procFair (ps := univ) (ss := ss) (xs := xs)
+    grind [ncard_univ, card_eq_nat_card]
+  · rintro p (_ | ⟨k, b, h_k⟩)
+    · grind [not_procFaulty_and_procFair]
+    · have h_r (n : ℕ) : a.Reachable inp (ss n) := by
+        use xs.extract 0 n
+        grind [LTS.OmegaExecution.extract_mTr]
+      have (j : ℕ) (h_j : k ≤ j) : a.Uniform (ss j) b := by
+        apply decided_imp_uniform hpc1 (h_r j)
+        use p
+        apply Algorithm.procDecided_stable (a := a) h_k
+        use xs.extract k j
+        grind [LTS.OmegaExecution.extract_mTr]
+      obtain ⟨n, _⟩ : ∃ n, k ≤ n ∧ a.NonUniform (ss n) := by grind [frequently_atTop.mp h_freq k]
+      grind [not_uniform_and_nonUniform]
+
+/-- As long as there are at least 2 processes, there does not exist a distributed consensus
+algorithm that can tolerate 1 fault. -/
+theorem Consensus.one_not_exists [Fintype P] (hc : card P ≥ 2) :
+    ¬ ∃ a : Algorithm P M S, a.Consensus 1 := by
+  rintro ⟨a, h_cons⟩
+  have hpc1 := PseudoConsensus.of_consensus 1 (show 1 < card P by grind) h_cons
+  obtain ⟨inp, ss, xs, h_run, _⟩ := OnePseudoConsensus.not_terminating hpc1 hc
+  have h_run' := AdmissibleRun.fault_mono (show 0 ≤ 1 by grind) h_run
+  have := Classical.inhabited_of_nonempty <|
+    Fintype.card_pos_iff.mp (show 0 < Fintype.card P by grind)
+  grind [h_cons.right inp ss xs h_run' (default : P)]
+
+/-- As long as there are at least 2 processes, there does not exist a distributed consensus
+algorithm that can tolerate `f` faults for any `f ≥ 1`. -/
+theorem Consensus.ge_one_not_exists [Fintype P] {f : ℕ} (hc : card P ≥ 2) (hf : f ≥ 1) :
+    ¬ ∃ a : Algorithm P M S, a.Consensus f := by
+  rintro ⟨a, h_c⟩
+  suffices h1 : ∃ a : Algorithm P M S, a.Consensus 1 by
+    exact Consensus.one_not_exists hc h1
+  use a
+  grind [Consensus.fault_mono]
+
+end Cslib.FLP
diff --git a/Cslib/Computability/Distributed/FLP/OnePseudoConsensus.lean b/Cslib/Computability/Distributed/FLP/OnePseudoConsensus.lean
new file mode 100644
index 0000000000..7436c16b11
--- /dev/null
+++ b/Cslib/Computability/Distributed/FLP/OnePseudoConsensus.lean
@@ -0,0 +1,287 @@
+/-
+Copyright (c) 2026 Ching-Tsun Chou. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ching-Tsun Chou
+-/
+
+module
+
+public import Cslib.Computability.Distributed.FLP.PseudoConsensus
+
+/-! # 1-tolerant pseudo-consensus
+
+This file develops the theory of pseudo-consensus algorithms that can tolerate up to 1 fault.
+It formalizes section 3 of [Volzer2004] except Theorem 1.
+-/
+
+@[expose] public section
+
+namespace Cslib.FLP
+
+open Function Set Multiset Fintype
+
+variable {P M S : Type*} [DecidableEq P] [DecidableEq M]
+
+/-- `a.CanDecideWithout s p b` means that the boolean value `b` is decided on in a state that
+is reachable from `s` without the participation of `p`. In the notation of [Volzer2004], this
+is equivalent to `b ∈ val(p,s)`. -/
+def Algorithm.CanDecideWithout (a : Algorithm P M S)
+    (s : State P M S) (p : P) (b : Bool) : Prop :=
+  ∃ s', a.CanReachVia {p}ᶜ s s' ∧ s'.Decided b
+
+/-- `a.Uniform s b` means that for every process `p`, `a.CanDecideWithout s p b` but
+not `a.CanDecideWithout s p !b`. -/
+def Algorithm.Uniform (a : Algorithm P M S) (s : State P M S) (b : Bool) : Prop :=
+  ∀ p, a.CanDecideWithout s p b ∧ ¬ a.CanDecideWithout s p !b
+
+/-- `a.NonUniform s` means that for each boolean value `b`, there is a process `p`
+such that `a.CanDecideWithout s p b`. -/
+def Algorithm.NonUniform (a : Algorithm P M S) (s : State P M S) : Prop :=
+  ∀ b, ∃ p, a.CanDecideWithout s p b
+
+namespace OnePseudoConsensus
+
+variable {a : Algorithm P M S} {inp : P → Bool}
+
+/-- Draw a consequence of `a.PseudoConsensus 1`. -/
+theorem pseudoTermination [Fintype P] (hpc1 : a.PseudoConsensus 1)
+    {s : State P M S} (hr : a.Reachable inp s) (p : P) :
+    ∃ s' b, a.CanReachVia {p}ᶜ s s' ∧ s'.Decided b := by
+  apply hpc1.right inp s hr {p}ᶜ
+  simp [Set.ncard_compl {p}]
+
+/-- Assuming `a.PseudoConsensus 1`, for any reachable state of `a` and for any process `p`,
+there is a boolean value `b` such that `a.CanDecideWithout s p b`. This theorem formalizes
+Proposition 2(a) of [Volzer2004]. -/
+theorem canDecideWithout_exists [Fintype P] (hpc1 : a.PseudoConsensus 1)
+    {s : State P M S} (hr : a.Reachable inp s) (p : P) :
+    ∃ b, a.CanDecideWithout s p b := by
+  obtain ⟨s', b, _⟩ := pseudoTermination hpc1 hr p
+  use b
+  grind [Algorithm.CanDecideWithout]
+
+/-- A state cannot be both uniform and non-uniform. -/
+theorem not_uniform_and_nonUniform {s : State P M S} (b : Bool) :
+    ¬ (a.Uniform s b ∧ a.NonUniform s) := by
+  rintro ⟨_, h_n⟩
+  obtain ⟨p, _⟩ := h_n !b
+  grind [Algorithm.Uniform]
+
+/-- Assuming `a.PseudoConsensus 1`, any reachable state of `a` is either uniform or non-uniform. -/
+theorem uniform_or_nonUniform [Fintype P] (hpc1 : a.PseudoConsensus 1)
+    {s : State P M S} (hr : a.Reachable inp s) :
+    a.Uniform s false ∨ a.Uniform s true ∨ a.NonUniform s := by
+  by_cases h : a.Uniform s false ∨ a.Uniform s true
+  · grind
+  · suffices a.NonUniform s by grind
+    simp only [Algorithm.Uniform, not_or, not_forall, not_and, not_not,
+      Bool.not_false, Bool.not_true] at h
+    obtain ⟨⟨p, _⟩, ⟨q, _⟩⟩ := h
+    rintro (_ | _)
+    · use q
+      obtain ⟨b, _⟩ := canDecideWithout_exists hpc1 hr q
+      grind [Bool.dichotomy b]
+    · use p
+      obtain ⟨b, _⟩ := canDecideWithout_exists hpc1 hr p
+      grind [Bool.dichotomy b]
+
+/-- Assuming `a.PseudoConsensus 1`, if a reachable state of `a` has decided on a boolean value `b`
+and `a.CanDecideWithout s p b'` for any process `p`, then `b = b'`. -/
+theorem decided_eq_canDecideWithout [Fintype P] (hpc1 : a.PseudoConsensus 1)
+    {s : State P M S} (hr : a.Reachable inp s) {b b' : Bool} {p : P}
+    (hd : s.Decided b) (hd' : a.CanDecideWithout s p b') : b = b' := by
+  obtain ⟨s', hc, _⟩ := hd'
+  have hc := CanReachVia.canReach hc
+  grind [Algorithm.reachable_stable hr hc, Algorithm.decided_stable hd hc,
+    Algorithm.PseudoConsensus, Algorithm.SafeConsensus, State.Agreed]
+
+/-- Assuming `a.PseudoConsensus 1`, if a reachable state of `a` has decided on a boolean value `b`,
+then `s` is uniform for `b`. This theorem formalizes Proposition 2(b) of [Volzer2004]. -/
+theorem decided_imp_uniform [Fintype P] (hpc1 : a.PseudoConsensus 1)
+    {s : State P M S} (hr : a.Reachable inp s) {b : Bool} (hd : s.Decided b) :
+    a.Uniform s b := by
+  intro p
+  obtain ⟨b', _⟩ := canDecideWithout_exists hpc1 hr p
+  grind [decided_eq_canDecideWithout hpc1 hr hd]
+
+/-- For any message `m`, if state `s'` is reached from state `s` by receiving `m`, then
+`a.CanDecideWithout s m.dest b` implies `a.CanDecideWithout s' m.dest b` for any `b`.
+This theorem formalizes Proposition 3(b) of [Volzer2004]. -/
+theorem canDecideWithout_dest {s s' : State P M S} {m : Message P M} {b : Bool}
+    (ht : a.lts.Tr s (some m) s')
+    (hd : a.CanDecideWithout s m.dest b) : a.CanDecideWithout s' m.dest b := by
+  obtain ⟨t, h_s, h_t⟩ := hd
+  have h_m : a.CanReachVia {m.dest} s s' := by
+    use [some m]
+    grind [DestIn, LTS.MTr, List.Forall]
+  obtain ⟨t', h_s', h_t'⟩ := CanReachVia.diamond h_m h_s
+  use t', h_s'
+  grind [CanReachVia.canReach h_t', Algorithm.decided_stable]
+
+/-- For any message `m`, if state `s'` is reached from state `s` by receiving `m`, then
+`a.CanDecideWithout s' p b` implies `a.CanDecideWithout s p b` for any `b` and any `p ≠ m.dest`.
+This theorem formalizes Proposition 3(a) of [Volzer2004]. -/
+theorem canDecideWithout_nondest {s s' : State P M S} {m : Message P M} {b : Bool}
+    (ht : a.lts.Tr s (some m) s') {p : P} (hn : p ≠ m.dest)
+    (hd' : a.CanDecideWithout s' p b) : a.CanDecideWithout s p b := by
+  obtain ⟨t, h_s', h_t⟩ := hd'
+  refine ⟨t, ?_, h_t⟩
+  have hx : DestIn {p}ᶜ (some m) := by grind [DestIn]
+  exact CanReachVia.stepL hx ht h_s'
+
+/-- Assuming `a.PseudoConsensus 1`, if any reachable state `s` of `a` is uniform for `b` and
+state `s'` is reached from `s` by receiving a message `m`, then `a.CanDecideWithout s' p b`.
+This theorem formalizes Proposition 3(c) of [Volzer2004]. -/
+theorem canDecideWithout_uniform [Fintype P] (hpc1 : a.PseudoConsensus 1)
+    {s s' : State P M S} {m : Message P M} {b : Bool}
+    (hr : a.Reachable inp s) (ht : a.lts.Tr s (some m) s') {p : P}
+    (hd : a.CanDecideWithout s p b) (hdn : ¬ a.CanDecideWithout s p !b) :
+    a.CanDecideWithout s' p b := by
+  by_cases h_card : p = m.dest
+  · obtain ⟨rfl⟩ := h_card
+    exact canDecideWithout_dest ht hd
+  · have h_ss'' : a.Reachable inp s' := by
+      apply Algorithm.reachable_stable hr
+      use [some m]
+      grind [LTS.MTr]
+    obtain ⟨b', h_s'⟩ := canDecideWithout_exists hpc1 h_ss'' p
+    by_cases h_b : b' = b
+    · grind
+    · grind [canDecideWithout_nondest ht h_card h_s', Bool.eq_not_of_ne h_b]
+
+/-- Assuming `a.PseudoConsensus 1`, if any reachable state `s` of `a` that is non-uniform,
+then for any process `p`, there exists a state `s'` reachable from `s` such that
+`a.CanDecideWithout s' p b` for all `b`. This theorem formalizes Lemma 2 of [Volzer2004]. -/
+theorem nonUniform_step [Fintype P] (hpc1 : a.PseudoConsensus 1)
+    {s : State P M S} (hr : a.Reachable inp s) (hn : a.NonUniform s) (p : P) :
+    ∃ s', a.lts.CanReach s s' ∧ ∀ b, a.CanDecideWithout s' p b := by
+  obtain ⟨b, h_s⟩ := canDecideWithout_exists hpc1 hr p
+  obtain ⟨q, s', h_ss', h_s'⟩ := hn !b
+  have hr' := Algorithm.reachable_stable hr (CanReachVia.canReach h_ss')
+  obtain ⟨xs, h_mtr, h_xs'⟩ := h_ss'
+  obtain ⟨ss, h_ss'⟩ := LTS.Execution.of_mTr h_mtr
+  have reach_lemma (k : ℕ) (h : k < ss.length) : a.lts.CanReach s ss[k] := by
+    use xs.take k
+    have := LTS.Execution.split h_ss' k
+    grind [LTS.Execution, LTS.Execution.to_mTr]
+  have : a.CanDecideWithout s' p !b := by
+    obtain ⟨b', h_b'⟩ := canDecideWithout_exists hpc1 hr' p
+    grind [decided_eq_canDecideWithout hpc1 hr' h_s' h_b']
+  have h_nb : ∃ n, ∃ _ : n < ss.length, a.CanDecideWithout ss[n] p !b := by grind [LTS.Execution]
+  classical
+  let n := Nat.find h_nb
+  obtain ⟨_, _⟩ : ∃ _ : n < ss.length, a.CanDecideWithout ss[n] p !b := by grind
+  use ss[n], ?_, ?_
+  · grind [reach_lemma n]
+  · suffices ∀ k, (_ : k ≤ n) → a.CanDecideWithout ss[k] p b by
+      intro b'
+      by_cases h : b' = !b
+      · grind
+      · simp only [Bool.not_eq_not] at h
+        grind
+    intro k
+    induction k
+    case zero => grind [LTS.Execution]
+    case succ k h_ind =>
+      intro h_k
+      obtain ⟨_, _, _, _⟩ := h_ss'
+      have h_tr : a.lts.Tr ss[k] xs[k] ss[k + 1] := by grind
+      obtain (_ | ⟨m, h_m⟩) := Option.eq_none_or_eq_some xs[k]
+      · grind [Algorithm.tr_none]
+      · rw [h_m] at h_tr
+        have hr_k : a.Reachable inp ss[k] := by
+          apply Algorithm.reachable_stable hr
+          grind [reach_lemma k]
+        have hnb_k : ¬a.CanDecideWithout ss[k] p !b := by grind [Nat.find_min h_nb (m := k)]
+        exact canDecideWithout_uniform hpc1 hr_k h_tr (h_ind (by grind)) hnb_k
+
+section NonUniformInit
+
+variable [Fintype P]
+
+/-- Given a numbering `pn` of processes and `n : ℕ`, `inpN pn n` assigns `true` to the processes
+numbered `0, ..., (n - 1)` and `false` to the rest. -/
+def inpN (pn : P ≃ Fin (card P)) (n : ℕ) : P → Bool :=
+  fun p ↦ if pn p < n then true else false
+
+omit [DecidableEq P] in
+/-- Assuming `0 < n ≤ card P`, the inputs `inpN pn (n - 1)` amd `inpN pn n` agree on all processes
+except the one that is numbered `(n - 1)`. -/
+theorem inpN_eqOn_except_singleton (pn : P ≃ Fin (card P))
+    {n : ℕ} (hn0 : 0 < n) (hnc : n ≤ card P) :
+    InpEqOn {pn.symm ⟨n - 1, by grind⟩}ᶜ (inpN pn (n - 1)) (inpN pn n) := by
+  intro p h_p
+  suffices pn p ≠ n - 1 by
+    grind [inpN]
+  intro h
+  simp [← h] at h_p
+
+lemma inpN_zero_no_true (pn : P ≃ Fin (card P)) (hpc1 : a.PseudoConsensus 1) (p : P) :
+    ¬ a.CanDecideWithout (a.start (inpN pn 0)) p true := by
+  rintro ⟨s, h_r, h_b⟩
+  have h_s : a.Reachable (inpN pn 0) s := by
+    have h_i := Algorithm.reachable_start (a := a) (inp := inpN pn 0)
+    exact Algorithm.reachable_stable h_i (CanReachVia.canReach h_r)
+  obtain ⟨q, h_q⟩ := (hpc1.left (inpN pn 0) s h_s).right true h_b
+  simp [inpN] at h_q
+
+/-- Assuming `a.PseudoConsensus 1`, the initial state determined by the all-`false` input
+is uniform for `false`. -/
+theorem inpN_zero_uniform (pn : P ≃ Fin (card P)) (hpc1 : a.PseudoConsensus 1) (hc : card P ≥ 1) :
+    a.Uniform (a.start (inpN pn 0)) false := by
+  have h_i := Algorithm.reachable_start (a := a) (inp := inpN pn 0)
+  obtain (h | h | h) := uniform_or_nonUniform hpc1 h_i
+  · exact h
+  · grind [inpN_zero_no_true, h (pn.symm ⟨0, by grind⟩)]
+  · grind [inpN_zero_no_true, h true]
+
+lemma inpN_card_not_false (pn : P ≃ Fin (card P)) (hpc1 : a.PseudoConsensus 1) (p : P) :
+    ¬ a.CanDecideWithout (a.start (inpN pn (card P))) p false := by
+  rintro ⟨s, h_r, h_b⟩
+  have h_s : a.Reachable (inpN pn (card P)) s := by
+    have h_i := Algorithm.reachable_start (a := a) (inp := inpN pn (card P))
+    exact Algorithm.reachable_stable h_i (CanReachVia.canReach h_r)
+  obtain ⟨q, h_q⟩ := (hpc1.left (inpN pn (card P)) s h_s).right false h_b
+  simp [inpN] at h_q
+
+/-- Assuming `a.PseudoConsensus 1`, the initial state determined by the all-`true` input
+is uniform for `true`. -/
+theorem inpN_card_uniform (pn : P ≃ Fin (card P)) (hpc1 : a.PseudoConsensus 1) (hc : card P ≥ 1) :
+    a.Uniform (a.start (inpN pn (card P))) true := by
+  have h_i := Algorithm.reachable_start (a := a) (inp := inpN pn (card P))
+  obtain (h | h | h) := uniform_or_nonUniform hpc1 h_i
+  · grind [inpN_card_not_false, h (pn.symm ⟨0, by grind⟩)]
+  · exact h
+  · grind [inpN_card_not_false, h false]
+
+/-- Assuming `a.PseudoConsensus 1` and there are at least 2 processes, there must exist an input
+that gives rise to a non-uniform initial state. This theorem formalizes Lemma 1 of [Volzer2004]. -/
+theorem nonUniform_inp (hpc1 : a.PseudoConsensus 1) (hc : card P ≥ 2) :
+    ∃ inp : P → Bool, a.NonUniform (a.start inp) := by
+  let pn := Fintype.equivFin P
+  let uniF (n : ℕ) := ¬ a.Uniform (a.start (inpN pn n)) false
+  have h_card : uniF (card P) := by
+    grind [Algorithm.Uniform, inpN_card_uniform pn hpc1 (by grind) (pn.symm ⟨0, by grind⟩)]
+  have h_uniF : ∃ n, uniF n := ⟨card P, h_card⟩
+  classical
+  let n := Nat.find h_uniF
+  use (inpN pn n)
+  have h_n : ¬ a.Uniform (a.start (inpN pn n)) false := by grind
+  have h_n0 : 0 < n := by grind [inpN_zero_uniform]
+  have h_nc : n ≤ card P := by grind [Nat.find_min' h_uniF]
+  have h_n1 : a.Uniform (a.start (inpN pn (n - 1))) false := by grind [Nat.find_min h_uniF]
+  have : ¬ a.Uniform (a.start (inpN pn n)) true := by
+    obtain ⟨⟨s, h_reach, p, _⟩, _⟩ := h_n1 (pn.symm ⟨n - 1, by grind⟩)
+    obtain ⟨s', h_reach', _⟩ := CanReachVia.subset_inp
+      (inpN_eqOn_except_singleton pn h_n0 h_nc) h_reach
+    have : a.CanDecideWithout (a.start (inpN pn n)) (pn.symm ⟨n - 1, by grind⟩) false := by
+      use s', h_reach', p
+      grind
+    grind [Algorithm.Uniform]
+  grind [uniform_or_nonUniform, Algorithm.reachable_start (a := a) (inp := inpN pn n)]
+
+end NonUniformInit
+
+end OnePseudoConsensus
+
+end Cslib.FLP
diff --git a/Cslib/Computability/Distributed/FLP/PseudoConsensus.lean b/Cslib/Computability/Distributed/FLP/PseudoConsensus.lean
new file mode 100644
index 0000000000..db3a0f4851
--- /dev/null
+++ b/Cslib/Computability/Distributed/FLP/PseudoConsensus.lean
@@ -0,0 +1,122 @@
+/-
+Copyright (c) 2026 Ching-Tsun Chou. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ching-Tsun Chou
+-/
+
+module
+
+public import Cslib.Computability.Distributed.FLP.CanReachVia
+public import Cslib.Computability.Distributed.FLP.FairScheduler
+
+/-! # Fault-tolerant pseudo-consensus
+
+A central idea of [Volzer2004] is the notion of pseudo-consensus, which weakens the notion of
+consensus by replacing the requirement of termination, which is stated in terms of infinite
+executions, by that of pseudo-termination, which is stated in terms of finite executions.
+This makes the notion of pseudo-consensus easier to work with than consensus.  This file
+defines pseudo-consensus and proves that it is implied by consensus.  This result is intuitively
+obvious and is stated without proof in [Volzer2004], but it turns out to require quite a bit
+of formal machinery to prove.
+-/
+
+@[expose] public section
+
+namespace Cslib.FLP
+
+open Function Set Multiset Fintype ωSequence FairScheduler
+
+variable {P M S : Type*} [DecidableEq P] [DecidableEq M]
+
+/-- An algorithm `a` satisfies `f`-tolerant pseudo-termination iff for every reachable state `s`
+of `a` and every `ps` of at least `card P - f` processes, there exists a state `s'` reachable from
+`s` using only messages with destinations in `ps` which has decided on a boolean value.
+In other words, from any reachable state of `a`, a decision can be made without the participation
+of at most `f` processes. -/
+def Algorithm.PseudoTermination [Fintype P] (a : Algorithm P M S) (f : ℕ) : Prop :=
+  ∀ inp s, a.Reachable inp s →
+    ∀ ps : Set P, ps.ncard ≥ card P - f →
+      ∃ s' b, a.CanReachVia ps s s' ∧ s'.Decided b
+
+/-- An algorithm `a` is a pseudo-consensus algorithm tolerating up to `f` faults iff it satisfies
+both the consensus safety property `a.SafeConsensus` and `f`-tolerant pseudo-termination. -/
+def Algorithm.PseudoConsensus [Fintype P] (a : Algorithm P M S) (f : ℕ) : Prop :=
+  a.SafeConsensus ∧ a.PseudoTermination f
+
+open scoped Classical in
+/-- `a.simpleDeliver ps` delivers any message that is in-flight and has its destination in `ps`. -/
+noncomputable def Algorithm.simpleDeliver (a : Algorithm P M S) (ps : Set P) : DeliverMsg P M S :=
+  fun s m ↦ if m ∈ s.msgs ∧ m.dest ∈ ps then
+    ([m], a.recvMsg m s)
+  else
+    ([], s)
+
+namespace PseudoConsensus
+
+variable {a : Algorithm P M S}
+
+lemma simpleDeliver_fair (ps : Set P) :
+    a.FairDeliverMsg (a.simpleDeliver ps) ps (fun _ ↦ True) := by
+  intro s m h
+  simp only [h, Algorithm.simpleDeliver, Algorithm.lts]
+  grind [LTS.MTr.single]
+
+lemma simpleDeliver_forallActions (ps : Set P) :
+    (a.simpleDeliver ps).ForallActions (DestIn ps) := by
+  simp only [DeliverMsg.ForallActions, Algorithm.simpleDeliver]
+  intro s m
+  by_cases h : m ∈ s.msgs ∧ m.dest ∈ ps <;> simp [h, DestIn]
+
+/-- If an algorithm `a` is a consensus algorithm tolerating up to `f` faults, then `a` is also
+a pseudo-consensus algorithm tolerating up to `f` faults.  The main difficulty in the proof of
+this theorem is that we need to construct an infinite admissible execution starting from any
+reachable state of `a` using any subset of non-faulty processes.  This is achieved using the
+fair scheduler developed in `FairSchedular.lean`. -/
+theorem of_consensus [Fintype P] (f : ℕ) (hf : f < card P)
+    (hc : a.Consensus f) : a.PseudoConsensus f := by
+  obtain ⟨h_safe, h_term⟩ := hc
+  use h_safe
+  rintro inp s ⟨xl, h_xl⟩ ps h_ps
+  let xls := a.fairSegActions (a.simpleDeliver ps) ps s
+  obtain ⟨ss, h_omega, h_s, _⟩ := fair_omegaExecution (simpleDeliver_fair ps) s trivial
+  obtain ⟨ss', h_omega', _, _, _⟩ := LTS.OmegaExecution.append h_xl h_omega h_s
+  have h_dest := omega_forall_actions (r := DestIn ps) (d := a.simpleDeliver ps)
+      (simpleDeliver_fair ps) s trivial (simpleDeliver_forallActions ps) (by simp [DestIn])
+  have : ∀ p, p ∈ ps → ProcFair p ss' (xl ++ω xls.flatten) := by
+    intro p h_p
+    rw [← Algorithm.drop_procFair_iff h_omega' p xl.length]
+    grind [drop_append_of_ge_length]
+  have : FairRun ss' (xl ++ω xls.flatten) := by
+    intro p
+    by_cases h_f : ProcFair p ss' (xl ++ω xls.flatten)
+    · grind
+    · obtain ⟨m, _, n, _, _⟩ := Algorithm.not_fair_stay_enabled h_omega' h_f
+      suffices ProcFaulty p ss' (xl ++ω xls.flatten) by grind
+      use n + xl.length, by grind
+      intro k h_k m' h_m'
+      have : xls.flatten (k - xl.length) = some m' := by grind [get_append_right']
+      grind [DestIn]
+  have : numProcFaulty ss' (xl ++ω xls.flatten) ≤ f := by
+    suffices numProcFaulty ss' (xl ++ω xls.flatten) ≤ card P - ps.ncard by grind
+    apply numProcFaulty_le_not_procFair
+    grind
+  have h_adm : a.AdmissibleRun inp f ss' (xl ++ω xls.flatten) := by grind [Algorithm.AdmissibleRun]
+  have hf' : numProcFaulty ss' (xl ++ω xls.flatten) < card P := by grind
+  obtain ⟨p, _⟩ := not_procFaulty_of_numProcFaulty hf'
+  obtain ⟨n, b, _⟩ : ∃ n b, (ss' n).ProcDecided p b := by
+    grind [ProcTermination, h_term inp ss' (xl ++ω xls.flatten) h_adm p]
+  let m := n + xl.length
+  use ss' m, b
+  split_ands
+  · use (xl ++ω xls.flatten).extract xl.length m, by grind [LTS.OmegaExecution.extract_mTr]
+    simp [extract_append_right_right, extract_eq_take,
+      List.forall_iff_forall_mem, List.forall_mem_iff_getElem]
+    grind
+  · have : (ss' n).Decided b := by use p
+    suffices a.lts.CanReach (ss' n) (ss' m) by grind [Algorithm.decided_stable]
+    use (xl ++ω xls.flatten).extract n m
+    grind [LTS.OmegaExecution.extract_mTr]
+
+end PseudoConsensus
+
+end Cslib.FLP
diff --git a/Cslib/Computability/Distributed/FLP/README.md b/Cslib/Computability/Distributed/FLP/README.md
index 7bc8e7bd36..39a60cb07c 100644
--- a/Cslib/Computability/Distributed/FLP/README.md
+++ b/Cslib/Computability/Distributed/FLP/README.md
@@ -1,8 +1,14 @@
-# Impossibility of distributed consensus
+<pre>
+Copyright (c) 2026 Ching-Tsun Chou. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ching-Tsun Chou
+</pre>
+
+# Impossibility of asynchronous distributed consensus
 
 This directory contains a formalization of Völzer's proof [Volzer2004] of the famous result in
-distributed computing, first proved by Fischer, Lynch and Paterson [FLP1985], that distributed
-consensus is impossible in the presence of even a single crash fault.
+distributed computing, first proved by Fischer, Lynch and Paterson [FLP1985], that asynchronous
+distributed consensus is impossible in the presence of even a single crash fault.
 
 ## Lean files
 
@@ -12,8 +18,6 @@ consensus is impossible in the presence of even a single crash fault.
 2. `Consensus.lean` defines what it means for a distributed algorithm to solve the consensus problem
    in a fault-tolerant way and proves some basic properties.
 
-*The following files will appear in future PRs:*
-
 3. `FairScheduler.lean` contains a technical machinery for constructing "fair executions", which is used
     in the proof of `PseudoConsensus.of_consensus` in `PseudoConsensus.lean` and in the proof of
     `OnePseudoConsensus.fair_nonUniform` in `Impossibility.lean`.
@@ -28,15 +32,20 @@ consensus is impossible in the presence of even a single crash fault.
 6. `OnePseudoConsensus.lean` focuses on 1-tolerant pseudo-consensus algorithms, defines the key notion
    of "nonuniformity", and proves a number of their properties.
 
-7. `Impossibility.lean` proves that every 1-tolerant pseudo-consensus algorithms has a fair execution
+7. `Impossibility.lean` proves that every 1-tolerant pseudo-consensus algorithm has a fair execution
    which doesn't contain any fault but never reaches a consensus, which then implies that there cannot
    be a consensus algorithm that can tolerate even a single fault.
 
+8. `ZeroConsensus.lean` presents a simple distributed consensus algorithm and proves that it achieves
+   consensus if there is no fault.  This file is not needed for proving the impossibility result, but is
+   included to show that the notion of an algorithm defined in `Algorithm.lean` is not vacuous, in the
+   sense that it allows a working consensus algorithm when there is no fault.
+
 Files #1 and #2 contains materials common to both [FLP1985] and [Volzer2004].
 File #3 provides proof details that are either completely omitted (in the case of
 `PseudoConsensus.of_consensus`) or only hinted at (in the case of
 `OnePseudoConsensus.fair_nonUniform`) in [Volzer2004].
-The remaining files follow the development in [Volzer2004] fairly closely,
+The remaining files (except #8) follow the development in [Volzer2004] fairly closely,
 as is explained further in each file.
 
 ## References
diff --git a/Cslib/Computability/Distributed/FLP/ZeroConsensus.lean b/Cslib/Computability/Distributed/FLP/ZeroConsensus.lean
new file mode 100644
index 0000000000..0feba19455
--- /dev/null
+++ b/Cslib/Computability/Distributed/FLP/ZeroConsensus.lean
@@ -0,0 +1,171 @@
+/-
+Copyright (c) 2026 Ching-Tsun Chou. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ching-Tsun Chou
+-/
+
+module
+
+public import Cslib.Computability.Distributed.FLP.Consensus
+public import Cslib.Foundations.Data.OmegaSequence.Temporal
+
+/-! # Asynchronous distributed consensus in the absence of faults
+
+This file presents an asynchronous distributed consensus algorithm and proves that it does achieve
+consensus when there is no fault.  Assume that there are `n` processes numbered 0, 1, ..., `n - 1`.
+The algorithm works as follows:
+(1) Process 0 receives its input value and sends that value to all processes (including itself).
+    All other processes ignore their inputs upon receiving them.
+(2) Upon receiving the value sent by process 0 in the previpus step, every process (including
+    process 0) decides on that value.
+Clearly, if there is no fault and all messages are eventually delivered, every process will
+eventually decide on the same value, namely, the input value at process 0.
+
+The contents of this file are not needed for proving the FLP impossibility result, but do show
+that the notion of an `Algorithm` is not vacuous, in the sense that it allows a working
+asynchronous consensus algorithm when there is no fault.
+-/
+
+@[expose] public section
+
+namespace Cslib.FLP.ZeroFaultAlg
+
+open Set Sum Option Multiset ωSequence
+
+/-- The payload of a message is of type `Bool ⊕ Bool`, where `inl b` denotes an input value `b`
+and `inr b` denotes a value `b` sent by process 0 to all processes (including itself). -/
+abbrev M := Bool
+
+/-- The local state of a process is trivial. -/
+abbrev S := Unit
+
+variable {n : ℕ} (npos : 0 < n)
+
+/-- `alg` is the asynchronous distributed consensus algorithm described above. -/
+def alg : Algorithm (Fin n) M S where
+  init _ := ()
+  next _ _ := ()
+  send m _ := match m.msg with
+    | inl b =>
+      if m.dest = ⟨0, npos⟩ then Multiset.map (fun p ↦ ⟨p, inr b⟩) Finset.univ.val else 0
+    | inr _ => 0
+  out m _ := match m.msg with
+    | inl _ => none
+    | inr b => some b
+
+/-- `Inv` is an invariant for `alg`. -/
+def Inv (inp : Fin n → Bool) (s : State (Fin n) M S) : Prop :=
+  (∀ m, m ∈ s.msgs → m.msg = inl (inp m.dest) ∨ m.msg = inr (inp ⟨0, npos⟩)) ∧
+  (∀ p, (s.proc p).out = none ∨ (s.proc p).out = some (inp ⟨0, npos⟩))
+
+/-- `Inv` is true at any initial state. -/
+theorem inv_start (inp : Fin n → Bool) :
+    Inv npos inp ((alg npos).start inp) := by
+  simp [alg, Inv, Algorithm.start]
+
+/-- What happens when an `inl` message is received. -/
+theorem inv_tr_left (inp : Fin n → Bool) {s t : State (Fin n) M S} {m : Message (Fin n) M}
+    (hs : Inv npos inp s) (htr : (alg npos).lts.Tr s (some m) t) (hm : m.msg.isLeft) :
+    t.msgs = s.msgs.erase m +
+      ( if m.dest = ⟨0, npos⟩ then Multiset.map (fun p ↦ ⟨p, inr (inp ⟨0, npos⟩)⟩) Finset.univ.val
+        else 0 ) ∧
+    ∀ p, (t.proc p).out = (s.proc p).out := by
+  simp only [alg] at htr
+  split_ands <;> grind [Inv, Algorithm.lts, Algorithm.recvMsg]
+
+/-- What happens when an `inr` message is received. -/
+theorem inv_tr_right (inp : Fin n → Bool) {s t : State (Fin n) M S} {m : Message (Fin n) M}
+    (hs : Inv npos inp s) (htr : (alg npos).lts.Tr s (some m) t) (hm : m.msg.isRight) :
+    t.msgs = s.msgs.erase m ∧ (t.proc m.dest).out = some (inp ⟨0, npos⟩) ∧
+    ∀ p, p ≠ m.dest → (t.proc p).out = (s.proc p).out := by
+  simp only [alg] at htr
+  grind [Inv, Algorithm.lts, Algorithm.recvMsg]
+
+/-- The truth of `Inv` is preserved by every transition of `alg`. -/
+theorem trInv_inv (inp : Fin n → Bool) : (alg npos).lts.TrInv (Inv npos inp) := by
+  intro s x t htr hs
+  rcases eq_none_or_eq_some x with _ | ⟨m, rfl⟩
+  · grind [Algorithm.lts]
+  · have h1 : m.msg = inl (inp m.dest) ∨ m.msg = inr (inp ⟨0, npos⟩) := by
+      grind [Inv, Algorithm.lts]
+    rcases h1
+    · have := inv_tr_left npos inp hs htr
+      grind [Inv, erase_le, mem_of_le, Multiset.mem_map]
+    · have := inv_tr_right npos inp hs htr
+      grind [Inv, erase_le, mem_of_le]
+
+/-- `Inv` is true in all reachable state of `alg`. -/
+theorem reachable_inv (inp : Fin n → Bool) {s : State (Fin n) M S}
+    (hr : (alg npos).Reachable inp s) : Inv npos inp s := by
+  obtain ⟨xs, _⟩ := hr
+  have := LTS.mtrInv_of_trInv <| trInv_inv npos inp
+  grind [LTS.MTrInv, inv_start npos inp]
+
+/-- `alg` satisfies the `SafeConsensus` property. -/
+theorem safeConsensus : (alg npos).SafeConsensus := by
+  intro inp s hr
+  grind [reachable_inv npos inp hr, Inv, State.Agreed, State.Decided]
+
+/-- `Inv` is true at every state in an admissible run of `alg`. -/
+theorem always_inv (inp : Fin n → Bool)
+    {ss : ωSequence (State (Fin n) M S)} {xs : ωSequence (Action (Fin n) M)}
+    (ha : (alg npos).AdmissibleRun inp 0 ss xs) (k : ℕ) : Inv npos inp (ss k) := by
+  apply reachable_inv
+  apply Algorithm.reachable_stable <| Algorithm.reachable_start
+  use xs.extract 0 k
+  grind [AdmissibleRun.fault_zero, LTS.OmegaExecution.extract_mTr]
+
+/-- The message carrying the input value for process 0 is enabled in the initial state. -/
+theorem init_left (inp : Fin n → Bool)
+    {ss : ωSequence (State (Fin n) M S)} {xs : ωSequence (Action (Fin n) M)}
+    (ha : (alg npos).AdmissibleRun inp 0 ss xs) :
+    ss 0 ∈ {s | ⟨⟨0, npos⟩, inl (inp ⟨0, npos⟩)⟩ ∈ s.msgs} := by
+  obtain ⟨hi, _, _⟩ := AdmissibleRun.fault_zero.mp ha
+  simp [hi, Algorithm.start]
+
+/-- Whenever the message carrying the input value for process 0 is enabled in a state,
+a message carrying that value is eventually sent to every process `p` by process 0. -/
+theorem left_leadsTo_right (inp : Fin n → Bool)
+    {ss : ωSequence (State (Fin n) M S)} {xs : ωSequence (Action (Fin n) M)}
+    (ha : (alg npos).AdmissibleRun inp 0 ss xs) (p : Fin n) :
+    ss.LeadsTo {s | ⟨⟨0, npos⟩, inl (inp ⟨0, npos⟩)⟩ ∈ s.msgs}
+      {s | ⟨p, inr (inp ⟨0, npos⟩)⟩ ∈ s.msgs} := by
+  let m : Message (Fin n) M := ⟨⟨0, npos⟩, inl (inp ⟨0, npos⟩)⟩
+  intro k _
+  have : m ∈ (ss k).msgs := by grind
+  obtain ⟨_, _, hf⟩ := AdmissibleRun.fault_zero.mp ha
+  obtain ⟨j, _, _⟩ : ∃ j, k ≤ j ∧ xs j = some m := by grind [hf ⟨0, npos⟩, ProcFair]
+  use j + 1
+  have hj := always_inv npos inp ha j
+  have htr : (alg npos).lts.Tr (ss j) (some m) (ss (j + 1)) := by grind [LTS.OmegaExecution]
+  have h1 : k ≤ j + 1 := by grind
+  simp [h1, m, inv_tr_left npos inp hj htr rfl]
+
+/-- Whenever a message carrying a value sent by process 0 is enabled at a process `p`,
+`p` eventually decides on that value. -/
+theorem right_leadsTo_out (inp : Fin n → Bool)
+    {ss : ωSequence (State (Fin n) M S)} {xs : ωSequence (Action (Fin n) M)}
+    (ha : (alg npos).AdmissibleRun inp 0 ss xs) (p : Fin n) :
+    ss.LeadsTo {s | ⟨p, inr (inp ⟨0, npos⟩)⟩ ∈ s.msgs}
+      {s | (s.proc p).out = some (inp ⟨0, npos⟩)} := by
+  let m : Message (Fin n) M := ⟨p, inr (inp ⟨0, npos⟩)⟩
+  intro k _
+  have : m ∈ (ss k).msgs := by grind
+  obtain ⟨_, _, hf⟩ := AdmissibleRun.fault_zero.mp ha
+  obtain ⟨j, _, _⟩ : ∃ j, k ≤ j ∧ xs j = some m := by grind [hf p, ProcFair]
+  use j + 1
+  have hj := always_inv npos inp ha j
+  have htr : (alg npos).lts.Tr (ss j) (some m) (ss (j + 1)) := by grind [LTS.OmegaExecution]
+  grind [inv_tr_right npos inp hj htr]
+
+/-- `alg` is a correct asynchronous distributed consensus algorithm when there is no fault. -/
+theorem consensus_zero : (alg npos).Consensus 0 := by
+  use safeConsensus npos
+  intro inp ss xs ha p
+  right
+  have hlt1 := left_leadsTo_right npos inp ha p
+  have hlt2 := right_leadsTo_out npos inp ha p
+  have := leadsTo_trans hlt1 hlt2 0 <| init_left npos inp ha
+  grind
+
+end Cslib.FLP.ZeroFaultAlg
diff --git a/Cslib/Computability/Languages/Language.lean b/Cslib/Computability/Languages/Language.lean
index 0824cb1653..2ff6f64ee3 100644
--- a/Cslib/Computability/Languages/Language.lean
+++ b/Cslib/Computability/Languages/Language.lean
@@ -18,6 +18,17 @@ as defined and developed in `Mathlib.Computability.Language`.
 
 @[expose] public section
 
+namespace List
+
+variable {α : Type*}
+
+/-- `[]` is the only list over an empty type. -/
+theorem eq_nil_ofIsEmpty [IsEmpty α] (xl : List α) : xl = [] := by
+  have hu := List.uniqueOfIsEmpty (α := α)
+  simp [Unique.eq_default]
+
+end List
+
 namespace Language
 
 open Set List
@@ -25,6 +36,17 @@ open scoped Computability
 
 variable {α : Type*} {l m : Language α}
 
+/-- `0` and `1` are the only possible languages over an empty type. -/
+theorem eq_zero_or_one_ofIsEmpty [IsEmpty α] (l : Language α) : l = 0 ∨ l = 1 := by
+  by_cases h : l = 0
+  · simp [h]
+  · right
+    ext xl
+    obtain ⟨yl, _⟩ := nonempty_iff_ne_empty.mpr h
+    obtain ⟨rfl⟩ := eq_nil_ofIsEmpty xl
+    obtain ⟨rfl⟩ := eq_nil_ofIsEmpty yl
+    simpa
+
 @[simp]
 theorem mem_biInf {I : Type*} (s : Set I) (l : I → Language α) (x : List α) :
     (x ∈ ⨅ i ∈ s, l i) ↔ ∀ i ∈ s, x ∈ l i :=
@@ -41,6 +63,10 @@ theorem mem_biSup {I : Type*} (s : Set I) (l : I → Language α) (x : List α)
 theorem le_one_iff_eq : l ≤ 1 ↔ l = 0 ∨ l = 1 :=
   subset_singleton_iff_eq
 
+@[simp, scoped grind =]
+theorem mem_singleton (x y : List α) : x ∈ ({y} : Language α) ↔ x = y :=
+  Iff.rfl
+
 @[simp, scoped grind =]
 theorem mem_sub_one (x : List α) : x ∈ (l - 1) ↔ x ∈ l ∧ x ≠ [] :=
   Iff.rfl
diff --git a/Cslib/Computability/Languages/MyhillNerode.lean b/Cslib/Computability/Languages/MyhillNerode.lean
index 87a3a61a76..e42d3d3254 100644
--- a/Cslib/Computability/Languages/MyhillNerode.lean
+++ b/Cslib/Computability/Languages/MyhillNerode.lean
@@ -23,7 +23,7 @@ The Myhill-Nerode theorem has three parts [WikipediaMyhillNerode2026]:
 
 (3) The minimal DFA is unique up to unique isomorphism. That is, for any
     minimal DFA accepting `l`, there exists exactly an isomorphism from it to the
-    canonical DFA whose states are the equivalence classses of `c_l`, whose
+    canonical DFA whose states are the equivalence classes of `c_l`, whose
     state transitions are of the form `⟦ x ⟧ → ⟦ x ++ [a] ⟧` (where `a : α`
     and `x : List α`), whose initial state is `⟦ [] ⟧`, and whose accepting states
     are `{ ⟦ x ⟧ | x ∈ l }`.
@@ -74,7 +74,7 @@ variable {l : Language α}
 theorem nerodeCongruenceDA_language_eq (l : Language α) :
     language (l.NerodeCongruenceDA) = l := by
   ext x
-  simp only [NerodeCongruenceDA, language, Acceptor.Accepts, congr_mtr_eq, Set.mem_image]
+  simp only [NerodeCongruenceDA, language, Acceptor.Accepts, congr_mtr_eq]
   constructor
   · rintro ⟨y, hy, heq⟩
     have h1 := Quotient.eq.mp heq []
@@ -161,7 +161,7 @@ end Language
 
 namespace Cslib.Automata.DA.FinAcc
 
-open Cslib Language Automata DA FinAcc Acceptor
+open Cslib Cslib.Language Automata DA FinAcc Acceptor
 open scoped RightCongruence
 
 /-- The minimal DFA accepting `l` has the same number of states as the number of equivalence classes
diff --git a/Cslib/Computability/Languages/OmegaLanguage.lean b/Cslib/Computability/Languages/OmegaLanguage.lean
index 8b5fbb45c5..638563537c 100644
--- a/Cslib/Computability/Languages/OmegaLanguage.lean
+++ b/Cslib/Computability/Languages/OmegaLanguage.lean
@@ -8,6 +8,7 @@ module
 
 public import Cslib.Computability.Languages.Language
 public import Cslib.Foundations.Data.OmegaSequence.Flatten
+public import Cslib.Foundations.Data.OmegaSequence.Topology
 public import Mathlib.Computability.Language
 public import Mathlib.Order.CompleteBooleanAlgebra
 public import Mathlib.Order.Filter.AtTopBot.Defs
@@ -28,6 +29,8 @@ denote languages (namely, sets of finite sequences of type `List α`).
   universe sets), and the subset relation are denoted using lattice-theoretic
   notations (`p ∪ q`, `p ∩ q`, `pᶜ`, `⊥`, `⊤`, and `≤`) and terminologies in
   definition and theorem names ("inf", "sup", "compl", "bot", "top", "le").
+* `p.closure`: the topological closure of `p`, where `ωLanguage α` inherits the
+  product topology of `TopologicalSpace (ωSequence α)`
 * `l * p`: ω-language of `x ++ω y` where `x ∈ l` and `y ∈ p`; referred to as
   "hmul" in definition and theorem names.
 * `l^ω`: ω-language of infinite sequences each of which is the concatenation of
@@ -98,6 +101,12 @@ def equiv : ωLanguage α ≃ Set (ωSequence α) where
 instance : CompleteAtomicBooleanAlgebra (ωLanguage α) :=
   equiv.completeAtomicBooleanAlgebra
 
+/-- `⊥` is the only possible ω-language over an empty type. -/
+theorem eq_bot_ofIsEmpty [IsEmpty α] (p : ωLanguage α) : p = ⊥ := by
+  ext xs
+  exfalso
+  exact IsEmpty.false xs
+
 set_option linter.tacticAnalysis.verifyGrindOnly false in
 instance : SetLike (ωLanguage α) (ωSequence α) where
   coe := ωLanguage.toSet
@@ -131,6 +140,10 @@ lemma iInf_def {ι : Sort v} {p : ι → ωLanguage α} : ⨅ i, p i = ⟨⋂ i,
   ext
   simp [iInf, sInf_def]
 
+/-- The topological closure of an ω-language. -/
+def closure (p : ωLanguage α) : ωLanguage α :=
+  _root_.closure p.toSet
+
 /-- The concatenation of a language l and an ω-language `p` is the ω-language made of
 infinite sequences `x ++ω y` where `x ∈ l` and `y ∈ p`. -/
 instance : HMul (Language α) (ωLanguage α) (ωLanguage α) where
@@ -278,7 +291,8 @@ theorem hmul_bot : l * (⊥ : ωLanguage α) = ⊥ := by
 
 @[simp, scoped grind =]
 theorem one_hmul : (1 : Language α) * p = p := by
-  simp [hmul_def, Language.one_def, Language.toSet]
+  simp [hmul_def]
+  simp [Language.one_def, Language.toSet]
 
 theorem hmul_sup : l * (p ⊔ q) = l * p ⊔ l * q := by
   ext : 1
@@ -304,7 +318,7 @@ theorem le_hmul_congr {l1 l2 : Language α} {p1 p2 : ωLanguage α} (hl : l1 ≤
     l1 * p1 ≤ l2 * p2 := by
   simp only [le_def]
   intros _
-  simp_all only [hmul_def, mem_image2]
+  simp only [hmul_def, mem_image2]
   tauto
 
 theorem le_omegaPow_congr [Inhabited α] {l1 l2 : Language α} (h : l1 ≤ l2) : l1^ω ≤ l2^ω := by
@@ -458,8 +472,10 @@ theorem omegaLim_zero : (0 : Language α)↗ω = ⊥ := by
   simp [omegaLim_def, bot_def]
 
 @[simp, scoped grind =]
-theorem map_id (p : ωLanguage α) : map id p = p :=
-  by simp [map]
+theorem map_id (p : ωLanguage α) : map id p = p := by
+  unfold map
+  change { toSet := id '' p.toSet } = p
+  simp
 
 @[scoped grind =]
 theorem map_map (g : β → γ) (f : α → β) (p : ωLanguage α) : map g (map f p) = map (g ∘ f) p := by
diff --git a/Cslib/Computability/Languages/OmegaRegularLanguage.lean b/Cslib/Computability/Languages/OmegaRegularLanguage.lean
index 75e89deff9..644d181d18 100644
--- a/Cslib/Computability/Languages/OmegaRegularLanguage.lean
+++ b/Cslib/Computability/Languages/OmegaRegularLanguage.lean
@@ -190,8 +190,6 @@ theorem IsRegular.omegaPow [Inhabited Symbol] {l : Language Symbol}
   use Unit ⊕ State, inferInstance, ⟨na.loop, {inl ()}⟩
   exact NA.Buchi.loop_language_eq
 
--- TODO: fix proof to work with backward.isDefEq.respectTransparency
-set_option backward.isDefEq.respectTransparency false in
 /-- An ω-language is regular iff it is the finite union of ω-languages of the form `L * M^ω`,
 where all `L`s and `M`s are regular languages. -/
 theorem IsRegular.eq_fin_iSup_hmul_omegaPow [Inhabited Symbol] (p : ωLanguage Symbol) :
@@ -214,8 +212,8 @@ theorem IsRegular.eq_fin_iSup_hmul_omegaPow [Inhabited Symbol] (p : ωLanguage S
     refine ⟨?_, by grind⟩
     rintro ⟨s, h_s, t, h_t, h_mem⟩
     use eq.invFun (⟨s, h_s⟩, ⟨t, h_t⟩)
-    -- The following `simp` is where the `set_option` above is needed.
-    simpa [mem_def]
+    have := Equiv.apply_symm_apply eq
+    simp_all
   · rintro ⟨n, l, m, _, rfl⟩
     rw [← iSup_univ]
     apply IsRegular.iSup
diff --git a/Cslib/Computability/Languages/RegularLanguage.lean b/Cslib/Computability/Languages/RegularLanguage.lean
index 6e1bbcc8e0..8550d40e80 100644
--- a/Cslib/Computability/Languages/RegularLanguage.lean
+++ b/Cslib/Computability/Languages/RegularLanguage.lean
@@ -11,8 +11,10 @@ public import Cslib.Computability.Automata.DA.Prod
 public import Cslib.Computability.Automata.DA.ToNA
 public import Cslib.Computability.Automata.NA.Concat
 public import Cslib.Computability.Automata.NA.Loop
+public import Cslib.Computability.Automata.NA.Reverse
 public import Cslib.Computability.Automata.NA.ToDA
 public import Mathlib.Computability.DFA
+public import Mathlib.Computability.RegularExpressions
 public import Mathlib.Data.Finite.Sum
 public import Mathlib.Data.Set.Card
 
@@ -153,27 +155,32 @@ theorem IsRegular.iSup {I : Type*} [Finite I] {s : Set I} {l : I → Language Sy
 open NA.FinAcc Sum in
 /-- The concatenation of two regular languages is regular. -/
 @[simp]
-theorem IsRegular.mul [Inhabited Symbol] {l1 l2 : Language Symbol}
+theorem IsRegular.mul {l1 l2 : Language Symbol}
     (h1 : l1.IsRegular) (h2 : l2.IsRegular) : (l1 * l2).IsRegular := by
-  rw [IsRegular.iff_nfa] at h1 h2 ⊢
-  obtain ⟨State1, h_fin1, nfa1, rfl⟩ := h1
-  obtain ⟨State2, h_fin1, nfa2, rfl⟩ := h2
-  use Option State1 ⊕ Option State2, inferInstance,
-    ⟨finConcat nfa1 nfa2, inr '' (some '' nfa2.accept)⟩
-  exact finConcat_language_eq
-
--- TODO: fix proof to work with backward.isDefEq.respectTransparency
-set_option backward.isDefEq.respectTransparency false in
+  obtain (he | hne) := isEmpty_or_nonempty Symbol
+  · obtain (rfl | rfl) := Language.eq_zero_or_one_ofIsEmpty l1 <;>
+    obtain (rfl | rfl) := Language.eq_zero_or_one_ofIsEmpty l2 <;> simp
+  · have := Classical.inhabited_of_nonempty hne
+    rw [IsRegular.iff_nfa] at h1 h2 ⊢
+    obtain ⟨State1, h_fin1, nfa1, rfl⟩ := h1
+    obtain ⟨State2, h_fin1, nfa2, rfl⟩ := h2
+    use Option State1 ⊕ Option State2, inferInstance,
+      ⟨finConcat nfa1 nfa2, inr '' (some '' nfa2.accept)⟩
+    exact finConcat_language_eq
+
 open NA.FinAcc Sum in
 /-- The Kleene star of a regular language is regular. -/
 @[simp]
-theorem IsRegular.kstar [Inhabited Symbol] {l : Language Symbol}
+theorem IsRegular.kstar {l : Language Symbol}
     (h : l.IsRegular) : (l∗).IsRegular := by
-  by_cases h_l : l = 0
-  · simp [h_l]
-  · rw [IsRegular.iff_nfa] at h ⊢
-    obtain ⟨State, h_fin, nfa, rfl⟩ := h
-    use Unit ⊕ Option State, inferInstance, ⟨finLoop nfa, {inl ()}⟩, loop_language_eq h_l
+  obtain (he | hne) := isEmpty_or_nonempty Symbol
+  · obtain (rfl | rfl) := Language.eq_zero_or_one_ofIsEmpty l <;> simp
+  · have := Classical.inhabited_of_nonempty hne
+    by_cases h_l : l = 0
+    · simp [h_l]
+    · rw [IsRegular.iff_nfa] at h ⊢
+      obtain ⟨State, h_fin, nfa, rfl⟩ := h
+      use Unit ⊕ Option State, inferInstance, ⟨finLoop nfa, {inl ()}⟩, loop_language_eq h_l
 
 /-- If a right congruence is of finite index, then each of its equivalence classes is regular. -/
 @[simp]
@@ -184,4 +191,46 @@ theorem IsRegular.congr_fin_index {Symbol : Type}
   use Quotient c.eq, inferInstance, ⟨c.toDA, {a}⟩
   exact DA.FinAcc.congr_language_eq
 
+open NA in
+/-- The reversal of a regular language is regular. -/
+theorem IsRegular.reverse {l : Language Symbol} (h : l.IsRegular) : l.reverse.IsRegular := by
+  rw [IsRegular.iff_nfa] at h ⊢
+  obtain ⟨State, h_fin, nfa, rfl⟩ := h
+  use State, inferInstance, nfa.reverse, FinAcc.reverse_language_eq nfa
+
+/-- A language is regular iff its reversal is regular. -/
+@[simp]
+theorem IsRegular.reverse_iff {l : Language Symbol} : l.reverse.IsRegular ↔ l.IsRegular := by
+  constructor
+  · intro h
+    simpa using IsRegular.reverse h
+  · exact IsRegular.reverse
+
+/-- The language containing only the one character string `a` is regular. -/
+@[simp]
+theorem IsRegular.char (a : Symbol) : ({[a]} : Language Symbol).IsRegular := by
+  rw [IsRegular.iff_dfa]
+  classical
+  let flts := FLTS.mk (fun (s : Fin 3) (x : Symbol) ↦ if (s = 0 ∧ x = a) then 1 else 2)
+  use Fin 3, inferInstance, ⟨DA.mk flts 0, {1}⟩
+  ext xs
+  induction xs using List.reverseRec with
+  | nil => grind [Accepts, Language.mem_singleton]
+  | append_singleton xs x ih =>
+    simp only [mem_language, Accepts, Language.mem_singleton, FLTS.mtr_concat_eq] at ih ⊢
+    constructor
+    · induction xs using List.reverseRec <;> grind
+    · simp_all [flts, List.append_eq_cons_iff]
+
+/-- Languages matching regular expressions are regular. -/
+theorem IsRegular.regex {r : RegularExpression Symbol} :
+    r.matches'.IsRegular := by
+  induction r with
+  | zero => simp
+  | epsilon => simp
+  | char a => simp [IsRegular.char a]
+  | plus P Q hP hQ => grind [RegularExpression.matches', IsRegular.add]
+  | comp P Q hP hQ => grind [RegularExpression.matches', IsRegular.mul]
+  | star P hP => grind [RegularExpression.matches', IsRegular.kstar]
+
 end Cslib.Language
diff --git a/Cslib/Computability/Languages/SafetyLiveness.lean b/Cslib/Computability/Languages/SafetyLiveness.lean
new file mode 100644
index 0000000000..fe8b3f3e7c
--- /dev/null
+++ b/Cslib/Computability/Languages/SafetyLiveness.lean
@@ -0,0 +1,75 @@
+/-
+Copyright (c) 2026 Ching-Tsun Chou. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ching-Tsun Chou
+-/
+
+module
+
+public import Cslib.Computability.Languages.OmegaLanguage
+public import Mathlib.Topology.Closure
+
+/-!
+# Safety and Liveness properties of ω-sequences
+
+This file formalizes the main results of [AlpernSchneider1985].  Namely, given
+an appropriate topology on ω-sequences:
+* Safety properties can be identified with closed sets.
+* Liveness properties can be identified with dense sets.
+* Every property is the intersection of a safety property and a liveness property.
+
+## References
+* [Alpern, Bowen; Schneider, Fred B. (1985). "Defining liveness".
+Information Processing Letters. 21 (4): 181–185.][AlpernSchneider1985]
+-/
+
+@[expose] public section
+
+namespace Cslib.ωLanguage
+
+open Set ωSequence TopologicalSpace
+
+variable {α : Type*}
+
+/-- Safety properties are identified with closed sets. -/
+abbrev IsSafety (p : ωLanguage α) : Prop := IsClosed p.toSet
+
+/-- An alternative characterization of `IsSafety` that justifies its definition:
+if an ω-sequence violates a safety property, then it has a finite prefix all of whose
+infinite extensions also violate the property. -/
+theorem isSafety_iff (p : ωLanguage α) :
+    p.IsSafety ↔ ∀ xs, xs ∉ p → ∃ n, ∀ ys, (xs.take n) ++ω ys ∉ p := by
+  simp [← isOpen_compl_iff, isOpen_iff, mem_def]
+
+/-- Liveness properties are identified with dense sets. -/
+abbrev IsLiveness (p : ωLanguage α) : Prop := Dense p.toSet
+
+/-- An alternative characterization of `IsLiveness` that justifies its definition:
+any finite sequence can be extended to an infinite sequence satisfying a liveness property. -/
+theorem isLiveness_iff (p : ωLanguage α) :
+    p.IsLiveness ↔ ∀ (xs : ωSequence α) (n : ℕ), ∃ ys, (xs.take n) ++ω ys ∈ p := by
+  exact dense_iff p.toSet
+
+/-- `p.closure` is always a safety property for any ω-language `p`. -/
+theorem isSafety_closure (p : ωLanguage α) :
+    p.closure.IsSafety := by
+  exact isClosed_closure
+
+/-- `p ⊔ p.closureᶜ` is always a liveness property for any ω-language `p`. -/
+theorem isLiveness_sup_compl_closure (p : ωLanguage α) :
+    (p ⊔ p.closureᶜ).IsLiveness := by
+  simp only [sup_def, closure, compl_def, dense_iff_closure_eq, closure_union,
+    ← compl_subset_iff_union, subset_closure]
+
+/-- Every property `p` is the intersection of a safety property (namely, `p.closure`) and
+a liveness property (namely, `p ⊔ p.closureᶜ`). -/
+theorem exists_safetyLivenessDecomposition (p : ωLanguage α) :
+    ∃ q r : ωLanguage α, q.IsSafety ∧ r.IsLiveness ∧ p = q ⊓ r := by
+  use p.closure, p ⊔ p.closureᶜ
+  split_ands
+  · exact isSafety_closure p
+  · exact isLiveness_sup_compl_closure p
+  · simp [ωLanguage.ext_iff, sup_def, closure, compl_def, inf_def,
+      inter_union_distrib_left, subset_closure]
+
+end Cslib.ωLanguage
diff --git a/Cslib/Computability/Machines/Turing/MultiTape/ConstantSpace.lean b/Cslib/Computability/Machines/Turing/MultiTape/ConstantSpace.lean
new file mode 100644
index 0000000000..ccc6a302b4
--- /dev/null
+++ b/Cslib/Computability/Machines/Turing/MultiTape/ConstantSpace.lean
@@ -0,0 +1,346 @@
+/-
+Copyright (c) 2026 Christian Reitwiessner. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Christian Reitwiessner
+-/
+
+module
+
+public import Cslib.Computability.Machines.Turing.MultiTape.TapeLemmas
+public import Mathlib.Data.Fintype.Option
+public import Mathlib.Data.Fintype.Pi
+public import Mathlib.Data.Fintype.Prod
+
+/-!
+# Constant space is the same as no work tapes
+
+A multi-tape Turing machine that never uses more than a constant number `s` of work-tape cells can
+be replaced by a machine without any work tapes at all (`k = 0`), computing the same outputs in
+exactly the same number of steps.
+
+The converse is trivial: a machine without work tapes uses zero space
+(`MultiTapeTM.spaceUsed_zero_tapes_eq_zero`), which is bounded by any constant.
+
+## Design
+
+The simulating machine `MultiTapeTM.zeroTapeSim tm s` stores the whole (bounded) work-tape
+situation of `tm` in its finite state: for every tape, the contents of the window `[-s, s]` and the
+position of the head inside that window. Since a computation starts with all heads at `0` and moves
+by at most one cell per step, a computation that visits at most `s` cells per tape keeps every head
+inside this window (`MultiTapeTM.natAbs_workTapePos_le`), so no information is lost. Head moves that
+would leave the window are clamped; this never happens along a space-bounded computation.
+
+The simulation is step-by-step: `zeroTapeSim tm s` performs the same input-head move and emits the
+same output symbol as `tm` in every step, so time bounds are preserved exactly, and it halts in
+exactly the same step.
+
+The window argument (positions and non-blank cells stay within `[-s, s]`) is the same one used for
+counting reachable configurations of space-bounded machines; here only the bound on the head
+positions is needed, since the simulating state agrees with the simulated tape only inside the
+window.
+
+## Important Declarations
+
+* `MultiTapeTM.zeroTapeSim`: the simulating machine without work tapes
+* `MultiTapeTM.Sim`: the invariant relating configurations of `tm` and of `zeroTapeSim tm s`
+* `MultiTapeTM.ComputesInTimeAndSpace.zeroTapeSim`: the simulating machine computes the same output
+  in the same time, using zero space
+* `MultiTapeTM.ComputesFunInTimeAndSpace.zeroTapeSim`: a constant-space machine computing a function
+  can be replaced by the machine `zeroTapeSim` without work tapes
+* `MultiTapeTM.exists_zeroTape_computesFun_iff`: "constant space" and "no work tapes" describe the
+  same functions (with the same time bound)
+-/
+
+@[expose] public section
+
+namespace Turing.MultiTapeTM
+
+variable {k : ℕ}
+variable {State Symbol : Type*}
+variable {input : List Symbol}
+variable {tm : MultiTapeTM k Symbol State}
+variable {s : ℕ}
+
+/-! ## The window of tape cells available to a space-bounded computation -/
+
+/-- The window `[-s, s]` of tape positions available to a tape that uses at most `s` cells. -/
+def window (s : ℕ) : Finset ℤ := Finset.Icc (-(s : ℤ)) s
+
+@[scoped grind =]
+lemma mem_window {z : ℤ} : z ∈ window s ↔ z.natAbs ≤ s := by
+  grind [window]
+
+/-- Restrict a tape position to the window, mapping positions outside of it to `0`.
+Along a computation that uses at most `s` cells the clamping never takes effect. -/
+def clampWindow (s : ℕ) (z : ℤ) : ↥(window s) :=
+  if h : z ∈ window s then ⟨z, h⟩ else ⟨0, mem_window.mpr (Nat.zero_le _)⟩
+
+@[simp]
+lemma clampWindow_val {z : ℤ} (h : z ∈ window s) : (clampWindow s z : ℤ) = z := by
+  simp [clampWindow, h]
+
+/-! ## The simulating machine without work tapes -/
+
+/-- The state of a machine that simulates the `k` work tapes of a space-`s`-bounded machine in its
+state: the simulated state together with the contents of the window `[-s, s]` of every work tape
+and the position of every work-tape head inside that window. -/
+structure ConstSpaceState (Symbol State : Type*) (k s : ℕ) where
+  /-- the state of the simulated machine (cf. `Cfg.state`) -/
+  state : State
+  /-- the contents of the window of work tape `i` (cf. `Cfg.workTapes`) -/
+  workTapes (i : Fin k) : ↥(window s) → Option Symbol
+  /-- the position of the head of work tape `i` (cf. `Cfg.workTapePos`) -/
+  workTapePos (i : Fin k) : ↥(window s)
+
+/-- A `ConstSpaceState` is just a product of its fields; this equivalence provides its `Fintype`
+instance. -/
+def ConstSpaceState.equivProd (Symbol State : Type*) (k s : ℕ) :
+    ConstSpaceState Symbol State k s ≃
+      State × ((i : Fin k) → ↥(window s) → Option Symbol) × (Fin k → ↥(window s)) where
+  toFun x := (x.state, x.workTapes, x.workTapePos)
+  invFun := fun ⟨state, workTapes, workTapePos⟩ => ⟨state, workTapes, workTapePos⟩
+
+instance (Symbol State : Type*) [Fintype Symbol] [Fintype State] (k s : ℕ) :
+    Fintype (ConstSpaceState Symbol State k s) :=
+  Fintype.ofEquiv _ (ConstSpaceState.equivProd Symbol State k s).symm
+
+/-- The machine without work tapes that simulates `tm` under the assumption that `tm` uses at most
+`s` cells of work-tape space: it keeps the work tapes of `tm` in its state and performs the same
+input-head moves and outputs as `tm`. -/
+def zeroTapeSim (tm : MultiTapeTM k Symbol State) (s : ℕ) :
+    MultiTapeTM 0 Symbol (ConstSpaceState Symbol State k s) where
+  q₀ := ⟨tm.q₀, fun _ _ => none, fun _ => clampWindow s 0⟩
+  tr q inputSymbol _ :=
+    let out := tm.tr q.state inputSymbol fun i => q.workTapes i (q.workTapePos i)
+    { inputMove := out.inputMove
+      workActions := fun i => i.elim0
+      outS := out.outS
+      q' := out.q'.map fun q'' =>
+        { state := q''
+          workTapes := fun i =>
+            match (out.workActions i).1 with
+            | none => q.workTapes i
+            | some sym => Function.update (q.workTapes i) (q.workTapePos i) sym
+          workTapePos := fun i =>
+            clampWindow s ((q.workTapePos i : ℤ) + ((out.workActions i).2 : ℤ)) } }
+
+/-! ## The simulation invariant -/
+
+/-- The invariant relating a configuration `c` of `tm` with a configuration `c'` of
+`zeroTapeSim tm s`: both are at the same input position, in the same state, and (if not halted) the
+state of `c'` records the work tapes of `c` inside the window and the work-tape head positions. -/
+structure Sim (s : ℕ) (c : Cfg k Symbol State input)
+    (c' : Cfg 0 Symbol (ConstSpaceState Symbol State k s) input) : Prop where
+  /-- both machines are at the same input position -/
+  inputPos : c'.inputPos = c.inputPos
+  /-- both machines are in the same state (in particular, one has halted iff the other has) -/
+  state : c.state = c'.state.map ConstSpaceState.state
+  /-- the simulating state records the work tapes inside the window -/
+  workTapes : ∀ q' ∈ c'.state, ∀ (i : Fin k) (z : ↥(window s)),
+    q'.workTapes i z = c.workTapes i (z : ℤ)
+  /-- the simulating state records the work-tape head positions -/
+  workTapePos : ∀ q' ∈ c'.state, ∀ i : Fin k, (q'.workTapePos i : ℤ) = c.workTapePos i
+
+/-- Simulated and simulating machine read the same work-tape symbols. -/
+private lemma sim_read {c : Cfg k Symbol State input}
+    {c' : Cfg 0 Symbol (ConstSpaceState Symbol State k s) input}
+    {q' : ConstSpaceState Symbol State k s}
+    (hsim : Sim s c c') (hq' : c'.state = some q') :
+    (fun i => q'.workTapes i (q'.workTapePos i)) = c.workTapeSymbols := by
+  funext i
+  rw [hsim.workTapes q' hq' i (q'.workTapePos i), hsim.workTapePos q' hq' i]
+  rfl
+
+/-- One step of the simulating machine mirrors one step of the simulated machine, provided the
+work-tape heads stay inside the window. -/
+lemma sim_step {c : Cfg k Symbol State input}
+    {c' : Cfg 0 Symbol (ConstSpaceState Symbol State k s) input}
+    (hsim : Sim s c c')
+    (hpos : ∀ i, ((tm.step c).workTapePos i).natAbs ≤ s) :
+    Sim s (tm.step c) ((tm.zeroTapeSim s).step c') := by
+  rcases hq' : c'.state with _ | q'
+  · -- Both machines have halted, so both configurations are unchanged.
+    have hc : c.state = none := by rw [hsim.state, hq']; rfl
+    rw [step_of_halt hc, step_of_halt hq']
+    exact hsim
+  · have hc : c.state = some q'.state := by rw [hsim.state, hq']; rfl
+    -- Both machines evaluate the transition function on the same arguments.
+    set out := tm.tr q'.state c.inputSymbol c.workTapeSymbols with hout
+    have hinputSymbol : c'.inputSymbol = c.inputSymbol := by
+      simp [Cfg.inputSymbol, hsim.inputPos]
+    have hstep' : (tm.zeroTapeSim s).step c' =
+        { state := out.q'.map fun q'' =>
+            { state := q''
+              workTapes := fun i =>
+                match (out.workActions i).1 with
+                | none => q'.workTapes i
+                | some sym => Function.update (q'.workTapes i) (q'.workTapePos i) sym
+              workTapePos := fun i =>
+                clampWindow s ((q'.workTapePos i : ℤ) + ((out.workActions i).2 : ℤ)) },
+          inputPos := moveInputPos c'.inputPos out.inputMove,
+          workTapes := fun i => i.elim0,
+          workTapePos := fun i => i.elim0 } := by
+      unfold step zeroTapeSim
+      rw [hq']
+      simp only [hinputSymbol, sim_read hsim hq', ← hout]
+      exact Cfg.ext rfl rfl (funext fun i => i.elim0) (funext fun i => i.elim0)
+    have hstep : tm.step c =
+        { state := out.q',
+          inputPos := moveInputPos c.inputPos out.inputMove,
+          workTapes := fun i =>
+            match (out.workActions i).1 with
+            | none => c.workTapes i
+            | some sym => Function.update (c.workTapes i) (c.workTapePos i) sym,
+          workTapePos := fun i => c.workTapePos i + ((out.workActions i).2 : ℤ) } := by
+      unfold step
+      rw [hc]
+      rfl
+    rw [hstep, hstep']
+    refine ⟨by rw [hsim.inputPos], by rcases out.q' with _ | q₂ <;> simp, ?_, ?_⟩
+    · rintro q'' hq'' i z
+      simp only [Option.mem_def, Option.map_eq_some_iff] at hq''
+      obtain ⟨q₂, _, rfl⟩ := hq''
+      -- The written cell is the one under the head, which lies inside the window.
+      rcases hw : (out.workActions i).1 with _ | sym
+      · simpa [hw] using hsim.workTapes q' hq' i z
+      · have hz : (z = q'.workTapePos i) ↔ ((z : ℤ) = c.workTapePos i) := by
+          rw [← hsim.workTapePos q' hq' i, Subtype.ext_iff]
+        simp only [hw]
+        by_cases h : z = q'.workTapePos i
+        · rw [hz.mp h, h, Function.update_self, Function.update_self]
+        · rw [Function.update_of_ne h, Function.update_of_ne (fun hc => h (hz.mpr hc))]
+          exact hsim.workTapes q' hq' i z
+    · rintro q'' hq'' i
+      simp only [Option.mem_def, Option.map_eq_some_iff] at hq''
+      obtain ⟨q₂, _, rfl⟩ := hq''
+      have hin : (q'.workTapePos i : ℤ) + ((out.workActions i).2 : ℤ) ∈ window s := by
+        have := hpos i
+        rw [hstep] at this
+        rw [mem_window, hsim.workTapePos q' hq' i]
+        simpa using this
+      rw [clampWindow_val hin, hsim.workTapePos q' hq' i]
+
+/-- The simulating machine emits the same symbols as the simulated machine. -/
+lemma sim_outputSymbol {c : Cfg k Symbol State input}
+    {c' : Cfg 0 Symbol (ConstSpaceState Symbol State k s) input}
+    (hsim : Sim s c c') :
+    (tm.zeroTapeSim s).outputSymbol c' = tm.outputSymbol c := by
+  rcases hq' : c'.state with _ | q'
+  · have hc : c.state = none := by rw [hsim.state, hq']; rfl
+    simp [outputSymbol, hq', hc]
+  · have hc : c.state = some q'.state := by rw [hsim.state, hq']; rfl
+    have hinputSymbol : c'.inputSymbol = c.inputSymbol := by
+      simp [Cfg.inputSymbol, hsim.inputPos]
+    simp only [outputSymbol, hq', hc, zeroTapeSim, hinputSymbol, sim_read hsim hq']
+
+/-! ## Simulation of space-bounded computations -/
+
+/-- A work-tape head of a computation that uses at most `s` cells of space up to step `t` stays
+within the window `[-s, s]` up to step `t`. -/
+lemma natAbs_workTapePos_le {t : ℕ} (hs : tm.spaceUsed (tm.initCfg input) t ≤ s) (i : Fin k) :
+    ((tm.configs (tm.initCfg input) t).workTapePos i).natAbs ≤ s := by
+  -- The heads start at `0`, so the displacement bound is a bound on the position itself.
+  have h := tm.natAbs_le_spaceUsedByTape_of_mem_visited
+    (tm.mem_visitedByTapeHead_self (tm.initCfg input) t i)
+  simp only [initCfg, sub_zero] at h
+  exact h.trans ((tm.spaceUsedByTape_le_spaceUsed _ t i).trans hs)
+
+/-- Along a computation that uses at most `s` cells of work-tape space, the machine without work
+tapes simulates the original machine step by step. -/
+theorem sim_configs (tm : MultiTapeTM k Symbol State) (input : List Symbol)
+    (hs : ∀ t, tm.spaceUsed (tm.initCfg input) t ≤ s) (t : ℕ) :
+    Sim s (tm.configs (tm.initCfg input) t)
+      ((tm.zeroTapeSim s).configs ((tm.zeroTapeSim s).initCfg input) t) := by
+  induction t with
+  | zero =>
+    refine ⟨rfl, rfl, ?_, ?_⟩ <;>
+    · rintro q' hq' i
+      simp only [configs_zero, initCfg, Option.mem_def, Option.some.injEq] at hq'
+      subst hq'
+      simp [zeroTapeSim, clampWindow, mem_window]
+  | succ t ih =>
+    have hpos : ∀ i, ((tm.step (tm.configs (tm.initCfg input) t)).workTapePos i).natAbs ≤ s := by
+      intro i
+      rw [← configs_succ_eq_step']
+      exact natAbs_workTapePos_le (hs (t + 1)) i
+    rw [configs_succ_eq_step', configs_succ_eq_step']
+    exact sim_step ih hpos
+
+/-- The machine without work tapes produces the same output as the simulated machine. -/
+theorem sim_outputString (tm : MultiTapeTM k Symbol State) (input : List Symbol)
+    (hs : ∀ t, tm.spaceUsed (tm.initCfg input) t ≤ s) (t : ℕ) :
+    (tm.zeroTapeSim s).outputString ((tm.zeroTapeSim s).initCfg input) t
+      = tm.outputString (tm.initCfg input) t := by
+  induction t with
+  | zero => simp [outputString]
+  | succ t ih =>
+    rw [outputString_succ, outputString_succ, ih, sim_outputSymbol (sim_configs tm input hs t)]
+
+/-- The machine without work tapes halts in exactly the same step as the simulated machine. -/
+theorem sim_state_isNone (tm : MultiTapeTM k Symbol State) (input : List Symbol)
+    (hs : ∀ t, tm.spaceUsed (tm.initCfg input) t ≤ s) (t : ℕ) :
+    ((tm.zeroTapeSim s).configs ((tm.zeroTapeSim s).initCfg input) t).state = none
+      ↔ (tm.configs (tm.initCfg input) t).state = none := by
+  rw [(sim_configs tm input hs t).state]
+  simp
+
+/-- The space used by a computation does not grow any more once the machine has halted. -/
+lemma spaceUsed_le_of_halted {cfg : Cfg k Symbol State input} {T : ℕ}
+    (h : (tm.configs cfg T).state = none) (t : ℕ) :
+    tm.spaceUsed cfg t ≤ tm.spaceUsed cfg T := by
+  rcases Nat.le_total t T with hle | hle
+  · exact tm.spaceUsed_mono cfg hle
+  -- After step `T` the configuration never changes, so no new cells are visited.
+  refine Finset.sum_le_sum fun i _ => Finset.card_le_card fun z hz => ?_
+  obtain ⟨t', ht', rfl⟩ := tm.mem_visitedByTapeHead.mp hz
+  rcases Nat.le_total t' T with ht | ht
+  · exact tm.mem_visitedByTapeHead.mpr ⟨t', by omega, rfl⟩
+  · obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le ht
+    rw [tm.configs_add, tm.configs_of_halts _ h]
+    exact tm.mem_visitedByTapeHead_self cfg T i
+
+/-- **Constant space needs no work tapes**: if `tm` computes `output` from `input` in `t` steps and
+never uses more than `s` cells of work-tape space, then the machine `tm.zeroTapeSim s` without work
+tapes computes the same output in the same number of steps, using zero space. -/
+theorem ComputesInTimeAndSpace.zeroTapeSim {output : List Symbol} {t s' : ℕ}
+    (h : tm.ComputesInTimeAndSpace input output t s')
+    (hs : ∀ t', tm.spaceUsed (tm.initCfg input) t' ≤ s) :
+    (tm.zeroTapeSim s).ComputesInTimeAndSpace input output t 0 := by
+  obtain ⟨hhalt, houtput, -⟩ := h
+  exact ⟨(sim_state_isNone tm input hs t).mpr hhalt,
+    (sim_outputString tm input hs t).trans houtput,
+    spaceUsed_zero_tapes_eq_zero _ t rfl⟩
+
+/-- If a machine computes a function within a constant space bound `c`, then the machine
+`tm.zeroTapeSim c` without work tapes computes the same function within the same time bound, using
+zero space. -/
+theorem ComputesFunInTimeAndSpace.zeroTapeSim {IOSymbol : Type*}
+    {f : List IOSymbol → List IOSymbol} {toMachineSymbol : IOSymbol ↪ Symbol} {t sf : ℕ → ℕ}
+    {c : ℕ} (h : tm.ComputesFunInTimeAndSpace f toMachineSymbol t sf) (hc : ∀ n, sf n ≤ c) :
+    (tm.zeroTapeSim c).ComputesFunInTimeAndSpace f toMachineSymbol t (fun _ => 0) := by
+  intro input
+  obtain ⟨t', ht', s', hs', hcomputes⟩ := h input
+  -- The space bound at the halting step bounds the space usage at every step.
+  have hbound : ∀ τ, tm.spaceUsed (tm.initCfg (input.map toMachineSymbol)) τ ≤ c := fun τ =>
+    (spaceUsed_le_of_halted hcomputes.1 τ).trans
+      (hcomputes.2.2 ▸ hs'.trans (hc input.length))
+  exact ⟨t', ht', 0, Nat.zero_le _, hcomputes.zeroTapeSim hbound⟩
+
+/-- **Constant space is the same as no work tapes**: a function is computed within a constant space
+bound by some multi-tape machine if and only if it is computed by a machine without work tapes
+(which necessarily uses zero space), with the same time bound. -/
+theorem exists_zeroTape_computesFun_iff {Symbol IOSymbol : Type} [Finite Symbol]
+    {f : List IOSymbol → List IOSymbol} {toMachineSymbol : IOSymbol ↪ Symbol} {t : ℕ → ℕ} :
+    (∃ (State' : Type) (_ : Finite State') (tm' : MultiTapeTM 0 Symbol State'),
+        tm'.ComputesFunInTimeAndSpace f toMachineSymbol t (fun _ => 0)) ↔
+      (∃ (c k : ℕ) (State : Type) (_ : Finite State) (tm : MultiTapeTM k Symbol State)
+        (sf : ℕ → ℕ), (∀ n, sf n ≤ c) ∧ tm.ComputesFunInTimeAndSpace f toMachineSymbol t sf) := by
+  constructor
+  · rintro ⟨State', _, tm', h⟩
+    exact ⟨0, 0, State', inferInstance, tm', fun _ => 0, fun _ => le_rfl, h⟩
+  · rintro ⟨c, k, State, _, tm, sf, hc, h⟩
+    have : Fintype Symbol := Fintype.ofFinite Symbol
+    have : Fintype State := Fintype.ofFinite State
+    exact ⟨ConstSpaceState Symbol State k c, inferInstance, tm.zeroTapeSim c, h.zeroTapeSim hc⟩
+
+end Turing.MultiTapeTM
diff --git a/Cslib/Computability/Machines/Turing/MultiTape/Deterministic.lean b/Cslib/Computability/Machines/Turing/MultiTape/Deterministic.lean
new file mode 100644
index 0000000000..625b932b2b
--- /dev/null
+++ b/Cslib/Computability/Machines/Turing/MultiTape/Deterministic.lean
@@ -0,0 +1,531 @@
+/-
+Copyright (c) 2026 Christian Reitwiessner. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Christian Reitwiessner
+-/
+
+module
+
+public import Mathlib.Data.Finset.Max
+public import Mathlib.Data.Int.Interval
+public import Mathlib.Algebra.Order.Group.Abs
+public import Mathlib.Algebra.Order.Group.Int
+public import Mathlib.Algebra.Order.BigOperators.Group.Finset
+public import Mathlib.Computability.Language
+public import Mathlib.Data.Sign.Defs
+public import Cslib.Foundations.Data.RelatesInSteps
+
+/-!
+# Deterministic Multi-Tape Turing Machines
+
+Defines deterministic Turing machines with a read-only input tape, `k` work tapes and one write-only
+output tape.
+The tapes contain symbols from `Option Symbol` for a finite alphabet `Symbol` (where `none` is the
+blank symbol).
+
+## Design
+
+The multi-tape Turing machine uses a read-only input tape, `k` work tapes and a write-only output
+tape.
+The input head can move freely on the input, but any move attempt beyond one cell outside the input
+results in no movement.
+The transition function can optionally output one symbol, which models the write-only output tape.
+Because of these restrictions, we ignore the input and output tapes for space usage of the machine.
+The space usage is defined as the total number of cells the work tape heads visited during
+execution.
+
+Restricting the movement of the input head is not essential, but useful because it allows
+us to easily bound the number of possible configurations of a space-bounded machine. Most textbooks
+have this restriction.
+
+Instead of considering the cells _visited_ by the work tape heads, some textbooks
+(including [AroraBarak09]) only consider the number of cells that contain
+a non-blank symbol at some point in the execution or the number of cells written to. This allows
+work tape heads to freely move at no cost as long as they do not write. It is
+important to note that this causes `DSPACE(1)` to include `DSPACE(log log n)`, a class that
+contains e.g. the non-regular language `{0^n 1^n | n ∈ ℕ}` (it is accepted by a TM that writes a
+single marker on the work tape and then counts the number of symbols by work tape head movement
+without writing).
+Defining space usage via "cells visited" thus yields the more fine-grained "complexity world" in
+which `DSPACE(1)` is exactly the class of regular languages.
+
+This definition is adapted from the one in [Papadimitriou94], chapter 2.3 including
+the sub-linear space modifications from chapter 2.5 with the following changes:
+- We allow Turing machines to choose to not write on a tape. This is equivalent to
+  writing the read symbol again but makes it easier to reason about the semantics.
+- Our tapes are infinite in both directions instead of just to the right. This definition is
+  equivalent (see [AroraBarak09], Claim 1.4). It saves us from having to add a "start marker" to
+  the alphabet.
+- We only have a single halting state. The different ways to halt (accepting, rejecting, etc) can
+  be distinguished based on the output.
+- The way to prevent the input head to move outside the input is enforced by the interpretation
+  and not by a restriction on the transition function. The two definitions are equivalent, but
+  not restricting the transition function makes it easier to define a universal machine.
+
+## Important Declarations
+
+We define a number of structures and concepts related to multi-tape Turing machine computation:
+
+* `MultiTapeTM`: the TM itself
+* `Cfg`: the configuration of a TM: the internal state, the work tape contents and head positions
+* `spaceUsed`: the number of work tape cells touched by the heads until a certain step
+* `TransitionRelation`: the transition relation from one configuration to the next
+* `spaceUsed`: the number of tape cells touched by work tape heads, our main space measure
+* `ComputesInTimeAndSpace`: a proof that a specific TM computes an output from an input in a certain
+    number of steps and using a certain number of tape cells
+* `ComputableInTimeAndSpace`: a proof that there is a multi-tape TM that computes a function
+    (on strings) respecting a time and space bound in the input length.
+* `DecidableInTimeAndSpace`: a proof that a TM decides a language within a certain time
+    and space bound.
+
+There are two ways to talk about the behaviour of a multi-tape Turing machine, and they are
+proven to be equivalent.
+
+* `MultiTapeTM.configs`: a sequence of configurations by execution step
+* `RelatesInSteps tm.TransitionRelation cfg cfg' t`: a proof that `tm` transforms the configuration
+    `cfg` into `cfg'` in exactly `t` steps
+
+## References
+
+* [C. Papadimitriou, *Computational Complexity*][Papadimitriou94]
+* [S. Arora, B. Barak, *Computational Complexity: A Modern Approach*][AroraBarak09]
+* [M. Sipser, *Introduction to the Theory of Computation*][Sipser2013]
+
+-/
+
+@[expose] public section
+
+open Cslib Relation
+
+namespace Turing
+
+variable {k : ℕ} {State Symbol : Type*}
+
+/-- The output of the transition function. -/
+structure TransitionOut (k : ℕ) (Symbol State : Type*) where
+  /-- The movement (attempt) of the input head. -/
+  inputMove : SignType
+  /-- Actions on the work tapes: optionally a symbol to write and the head movement. -/
+  workActions : Fin k → (Option (Option Symbol)) × SignType
+  /-- An optional symbol to output. -/
+  outS : Option Symbol
+  /-- The successor state or none to halt. -/
+  q' : Option State
+
+/--
+A multi-tape Turing machine with `k` work tapes over the alphabet of `Option Symbol` (where `none`
+is the blank `BiTape` symbol). Note that it is not required that `Symbol` or `State` are finite
+to keep the definition more general. The restriction will be introduced once we start talking about
+computability by Turing machines in general.
+-/
+structure MultiTapeTM (k : ℕ) (Symbol State : Type*) where
+  /-- initial state -/
+  q₀ : State
+  /-- transition function, mapping a state, the current input symbol and a tuple of work head
+  symbols to a movement for the input head, actions on the work tape, optionally a symbol to output
+  and the successor state -/
+  tr (q : State) (input : Option Symbol) (work : Fin k → Option Symbol) :
+    TransitionOut k Symbol State
+
+namespace MultiTapeTM
+
+variable {tm : MultiTapeTM k Symbol State}
+
+section Cfg
+
+/-!
+## Configurations of a Turing Machine
+
+This section defines the configurations of a Turing machine,
+the step function that lets the machine transition from one configuration to the next,
+the resulting sequence of configurations and the initial configuration.
+-/
+
+/--
+The configurations of a Turing machine is relative to the input of the machine and consist of:
+- an `Option`al state (or none for the halting state),
+- the position of the input head (shifted by one),
+- the contents of the work tape,
+- the positions of the work tape heads.
+-/
+@[ext]
+structure Cfg (k : ℕ) (Symbol State : Type*) (input : List Symbol) where
+  /-- the state of the TM (or none for the halting state) -/
+  state : Option State
+  /-- the position of the input head, shifted by one -/
+  inputPos : Fin (input.length + 2)
+  /-- the work tapes -/
+  workTapes : Fin k → ℤ → Option Symbol
+  /-- the positions of the heads on the work tapes -/
+  workTapePos : Fin k → ℤ
+deriving Inhabited
+
+/-- Attempt to move the input tape head.
+The machine can only read one empty cell outside of the input,
+any attempted movement beyond that results in no movement.
+
+The addition is performed in `ℤ` before clamping. Performing it in `Fin (n + 2)` would wrap an
+outward boundary move to the opposite end of the input. -/
+@[scoped grind =]
+def moveInputPos {n : ℕ} (pos : Fin (n + 2)) (m : SignType) : Fin (n + 2) :=
+  let p := ((pos.val : ℤ) + (m.cast : ℤ)).toNat
+  if h : p < n + 2 then ⟨p, h⟩ else ⟨n + 1, by omega⟩
+
+@[simp]
+lemma moveInputPos_zero {n : ℕ} (pos : Fin (n + 2)) :
+    moveInputPos pos 0 = pos := by
+  apply Fin.ext
+  simp [moveInputPos, pos.isLt]
+
+@[simp]
+lemma moveInputPos_leftBoundary {n : ℕ} :
+    moveInputPos (0 : Fin (n + 2)) (-1) = 0 := by
+  apply Fin.ext
+  simp [moveInputPos]
+
+@[simp]
+lemma moveInputPos_rightBoundary {n : ℕ} :
+    moveInputPos (⟨n + 1, by omega⟩ : Fin (n + 2)) 1 = ⟨n + 1, by omega⟩ := by
+  unfold moveInputPos
+  rw [dite_eq_right (by simp; omega)]
+
+/-- A left move away from the left input boundary decrements the native input position. -/
+lemma moveInputPos_neg_of_ne_left {n : ℕ} (p : Fin (n + 2)) (h : p ≠ 0) :
+    moveInputPos p .neg = ⟨p.val - 1, by have := p.isLt; omega⟩ := by
+  have hp : 0 < p.val := Nat.pos_of_ne_zero (fun hz => h (Fin.ext hz))
+  unfold moveInputPos
+  apply Fin.ext
+  rw [dite_eq_left] <;> simp <;> omega
+
+/-- A right move away from the right input boundary increments the native input position. -/
+lemma moveInputPos_pos_of_ne_right {n : ℕ} (p : Fin (n + 2)) (h : p.val ≠ n + 1) :
+    moveInputPos p .pos = ⟨p.val + 1, by have := p.isLt; omega⟩ := by
+  unfold moveInputPos
+  rw [dite_eq_left]
+  · apply Fin.ext
+    simp
+  · simp
+    omega
+
+/-- The symbol currently under the input tape head. -/
+def Cfg.inputSymbol (cfg : Cfg k Symbol State input) : Option Symbol :=
+  if h₁ : cfg.inputPos = 0 then none
+  else if h₂ : cfg.inputPos = input.length + 1 then none
+  else input[cfg.inputPos.val - 1]'(by grind)
+
+@[simp]
+lemma inputSymbolInner {cfg : Cfg k Symbol State input} (p : ℕ)
+    (h₁ : cfg.inputPos.val = 1 + p)
+    (h₂ : p < input.length) :
+    cfg.inputSymbol = some input[p] := by
+  grind [Cfg.inputSymbol]
+
+/-- The symbol read by work tape `i`. -/
+def Cfg.workTapeSymbols (cfg : Cfg k Symbol State input) (i : Fin k) : Option Symbol :=
+  cfg.workTapes i (cfg.workTapePos i)
+
+/-- The step function corresponding to a `MultiTapeTM`. -/
+def step (cfg : Cfg k Symbol State input) : Cfg k Symbol State input :=
+  match cfg.state with
+  -- in the halting state, we stay at the configuration
+  | none => cfg
+  | some q =>
+    let {inputMove, workActions, q', ..} := tm.tr q cfg.inputSymbol cfg.workTapeSymbols
+    {
+      state := q',
+      inputPos := moveInputPos cfg.inputPos inputMove,
+      workTapes i := match (workActions i).1 with
+        | none => cfg.workTapes i
+        | some s => Function.update (cfg.workTapes i) (cfg.workTapePos i) s
+      workTapePos i := (cfg.workTapePos i) + (workActions i).2
+    }
+
+/-- The symbol (optionally) output when executing one step starting from configuration `cfg`. -/
+def outputSymbol (cfg : Cfg k Symbol State input) : Option Symbol :=
+  match cfg.state with
+  | none => none
+  | some q => (tm.tr q cfg.inputSymbol cfg.workTapeSymbols).outS
+
+/-- The initial configuration corresponding to an input string. -/
+@[simp]
+def initCfg (input : List Symbol) : Cfg k Symbol State input :=
+  ⟨some tm.q₀, 1, fun _ _ => none, fun _ => 0⟩
+
+@[simp]
+lemma step_of_halt {cfg : Cfg k Symbol State input} (h : cfg.state = none) :
+    tm.step cfg = cfg := by
+  unfold step
+  rw [h]
+
+/-- The sequence of configurations of the Turing machine starting from `cfg`.
+If the Turing machine halts, it will stay at the halting configuration. -/
+def configs (cfg : Cfg k Symbol State input) (t : ℕ) : Cfg k Symbol State input := tm.step^[t] cfg
+
+@[simp]
+lemma configs_zero {cfg : Cfg k Symbol State input} :
+    tm.configs cfg 0 = cfg := by
+  simp [configs]
+
+lemma configs_succ_eq_step {cfg : Cfg k Symbol State input} {t : ℕ} :
+    tm.configs cfg (t + 1) = tm.configs (tm.step cfg) t := by
+  simp [configs, Function.iterate_succ_apply]
+
+lemma configs_succ_eq_step' {cfg : Cfg k Symbol State input} {t : ℕ} :
+    tm.configs cfg (t + 1) = tm.step (tm.configs cfg t) := by
+  simp [configs, Function.iterate_succ_apply']
+
+/-- Running `a + d` steps equals running `a` steps from the configuration reached after `d`. -/
+lemma configs_add (cfg : Cfg k Symbol State input) (a b : ℕ) :
+    tm.configs cfg (a + b) = tm.configs (tm.configs cfg a) b := by
+  unfold configs
+  rw [Nat.add_comm, Function.iterate_add_apply]
+
+/-- The sequence of configurations from a halting state is constant. -/
+@[simp]
+lemma configs_of_halts (cfg : Cfg k Symbol State input) (h : cfg.state = none) {n : ℕ} :
+    tm.configs cfg n = cfg := by
+  induction n with
+  | zero => rfl
+  | succ d ih =>
+    rw [configs_succ_eq_step', ih, step_of_halt h]
+
+@[simp]
+lemma outputSymbol_of_halt {cfg : Cfg k Symbol State input} (h_halt : cfg.state = none) :
+    tm.outputSymbol cfg = none := by
+  simp [outputSymbol, h_halt]
+
+/-- The work-tape head moves by at most one cell in a single step. -/
+lemma workTapePos_step_le (c : Cfg k Symbol State input) (i : Fin k) :
+    |(tm.step c).workTapePos i - c.workTapePos i| ≤ 1 := by
+  unfold step
+  cases hstate : c.state with
+  | none => simp
+  | some q =>
+    simp only [add_sub_cancel_left, abs_le, SignType.cast]
+    grind
+
+end Cfg
+
+section Space
+/-! Now we define space usage and add some helper lemmas. -/
+
+/-- The set of positions visited by the head of work tape `i` in the computation starting from
+configuration `cfg` up to step `t`. -/
+def visitedByTapeHead (cfg : Cfg k Symbol State input) (t : ℕ) (i : Fin k) : Finset ℤ :=
+  (Finset.range (t + 1)).image fun t' => (tm.configs cfg t').workTapePos i
+
+/--
+The number of work tape cells touched by the head of tape `i` in the computation starting from
+configuration `cfg` up to step `t`.
+-/
+def spaceUsedByTape (cfg : Cfg k Symbol State input) (t : ℕ) (i : Fin k) : ℕ :=
+  (tm.visitedByTapeHead cfg t i).card
+
+/--
+The number of work tape cells touched by a computation starting from configuration
+`cfg` up to step `t`.
+-/
+def spaceUsed (cfg : Cfg k Symbol State input) (t : ℕ) : ℕ := ∑ i, tm.spaceUsedByTape cfg t i
+
+/-- A zero-tape Turing machine uses zero space. -/
+@[simp]
+lemma spaceUsed_zero_tapes_eq_zero (cfg : Cfg k Symbol State input) (t : ℕ) (h_zero : k = 0) :
+    tm.spaceUsed cfg t = 0 := by
+  unfold spaceUsed
+  subst h_zero
+  simp
+
+/-- Each tape's space usage is bounded by the total space used. -/
+lemma spaceUsedByTape_le_spaceUsed (cfg : Cfg k Symbol State input) (t : ℕ) (i : Fin k) :
+    tm.spaceUsedByTape cfg t i ≤ tm.spaceUsed cfg t :=
+  Finset.single_le_sum (fun _ _ => Nat.zero_le _) (Finset.mem_univ i)
+
+end Space
+
+open Cfg
+
+/--
+The `TransitionRelation` corresponding to a `MultiTapeTM k Symbol`
+is defined by the `step` function,
+which maps a configuration to its next configuration.
+-/
+@[scoped grind =]
+def TransitionRelation (c₁ c₂ : Cfg k Symbol State input) : Prop := tm.step c₁ = c₂
+
+/-- The string output by the Turing machine `tm` starting in configuration `cfg₀`, executing for
+`t` steps. It is the concatenation of the symbols (optionally) emitted at each of the first `t`
+steps. -/
+def outputString
+    (tm : MultiTapeTM k Symbol State)
+    (cfg₀ : Cfg k Symbol State input) (t : ℕ) : List Symbol :=
+  (List.range t).flatMap fun t' => (tm.outputSymbol (tm.configs cfg₀ t')).toList
+
+/-- The output produced in `t + 1` steps is the output produced in `t` steps followed by the symbol
+(optionally) emitted at step `t`. -/
+lemma outputString_succ
+    (tm : MultiTapeTM k Symbol State)
+    (cfg : Cfg k Symbol State input) (t : ℕ) :
+    tm.outputString cfg (t + 1) =
+      tm.outputString cfg t ++ (tm.outputSymbol (tm.configs cfg t)).toList := by
+  simp [outputString, List.range_succ, List.flatMap_append]
+
+/-- From a halting configuration, a TM does not output anything. -/
+lemma outputString_halt
+    (tm : MultiTapeTM k Symbol State)
+    (cfg : Cfg k Symbol State input)
+    (h_halt : cfg.state = none)
+    (t : ℕ) :
+    tm.outputString cfg t = [] := by
+  induction t with
+  | zero => simp [outputString]
+  | succ t ih => simp [outputString_succ, ih, h_halt]
+
+lemma outputString_add_eq_append
+    (tm : MultiTapeTM k Symbol State)
+    (cfg : Cfg k Symbol State input) (t₁ t₂ : ℕ) :
+    tm.outputString cfg (t₁ + t₂) =
+      tm.outputString cfg t₁ ++ tm.outputString (tm.configs cfg t₁) t₂ := by
+  induction t₂ with
+  | zero => simp [outputString]
+  | succ t ih =>
+    rw [show (t₁ + (t + 1)) = (t₁ + t) + 1 by omega]
+    simp [outputString_succ, ih, configs, ← Function.iterate_add_apply, Nat.add_comm]
+
+/-- The output does not change after the machine has halted. -/
+lemma outputString_eq_of_halt
+    (tm : MultiTapeTM k Symbol State)
+    (cfg : Cfg k Symbol State input) {τ t : ℕ} (hle : τ ≤ t)
+    (hhalt : (tm.configs cfg τ).state = none) :
+    tm.outputString cfg t = tm.outputString cfg τ := by
+  conv_lhs => rw [← Nat.sub_add_cancel hle, Nat.add_comm]
+  rw [outputString_add_eq_append, outputString_halt _ _ hhalt]
+  simp
+
+/-- A proof that the Turing machine `tm` on input `input` outputs `output` in at most `t` steps
+and uses exactly `s` space.
+Note that this does not require the alphabet or state set to be finite. -/
+def ComputesInTimeAndSpace
+    (tm : MultiTapeTM k Symbol State)
+    (input output : List Symbol)
+    (t s : ℕ) : Prop :=
+  (tm.configs (tm.initCfg input) t).state = none ∧
+  tm.outputString (tm.initCfg input) t = output ∧
+  tm.spaceUsed (tm.initCfg input) t = s
+
+/-- A proof that the Turing machine `tm` computes the function `f` such that on all inputs of
+length `n` it uses at most `t n` steps and `s n` space. It assumes an embedding function
+from the input/output alphabet into the machine alphabet.
+Note that this does not require the alphabet or state set to be finite. -/
+def ComputesFunInTimeAndSpace
+    (tm : MultiTapeTM k Symbol State)
+    {IOSymbol : Type*}
+    (f : List IOSymbol → List IOSymbol)
+    (toMachineSymbol : IOSymbol ↪ Symbol)
+    (t s : ℕ → ℕ) : Prop :=
+  ∀ input, ∃ t' ≤ t input.length, ∃ s' ≤ s input.length,
+  ComputesInTimeAndSpace tm (input.map toMachineSymbol) ((f input).map toMachineSymbol) t' s'
+
+/-- The main definition of complexity of multi-tape Turing machines:
+A proof that the function `f` is computable by some multi-tape Turing machine `tm` (with finite
+work alphabet and finite state set) via an alphabet embedding function `toMachineSymbol`,
+such that on all inputs of length `n`, `tm` uses at most `t n` steps and at most `s n` space. -/
+def ComputableInTimeAndSpace
+    {IOSymbol : Type*}
+    (f : List IOSymbol → List IOSymbol)
+    (t s : ℕ → ℕ) : Prop :=
+  ∃ (k sym state : ℕ) (toMachineSymbol : _) (tm : MultiTapeTM k (Fin sym) (Fin state)),
+  ComputesFunInTimeAndSpace tm f toMachineSymbol t s
+
+open Classical in
+/-- The indicator function of a language. -/
+noncomputable def indicator {Symbol : Type*} [Inhabited Symbol] (L : Language Symbol) :
+    List Symbol → List Symbol
+  | x => if x ∈ L then [default] else []
+
+/-- A language is decidable in time `t` and space `s` if and only if its indicator function
+is computable in time `t` and space `s`. -/
+def DecidableInTimeAndSpace
+    {IOSymbol : Type} [Inhabited IOSymbol]
+    (L : Language IOSymbol)
+    (t s : ℕ → ℕ) : Prop :=
+  ComputableInTimeAndSpace (indicator L) t s
+
+/-- This lemma translates between the relational notion and the iterated step notion. The latter
+can be more convenient especially for deterministic machines as we have here. -/
+@[scoped grind =]
+lemma relatesInSteps_iff_configs_eq
+    (tm : MultiTapeTM k Symbol State)
+    (cfg₁ cfg₂ : Cfg k Symbol State input)
+    (t : ℕ) :
+    RelatesInSteps tm.TransitionRelation cfg₁ cfg₂ t ↔ tm.configs cfg₁ t = cfg₂ := by
+  unfold configs
+  induction t generalizing cfg₁ cfg₂ with
+  | zero => simp
+  | succ t ih =>
+    rw [RelatesInSteps.succ_iff, Function.iterate_succ_apply']
+    constructor
+    · grind
+    · intro h_configs
+      use tm.step^[t] cfg₁
+      grind
+
+/-- The Turing machine `tm` halts after exactly `t` steps on input `input`
+if its state is `none` at step `t` and non-none at step `t - 1`.
+Note that every Turing machine hast to perform at least one step to halt. -/
+def haltsAtStep (tm : MultiTapeTM k Symbol State) (input : List Symbol) (t : ℕ) : Bool :=
+  (tm.configs (tm.initCfg input) t).state.isNone &&
+  !(tm.configs (tm.initCfg input) (t - 1)).state.isNone
+
+/-- If a Turing machine halts, the time step is uniquely determined. -/
+lemma halting_step_unique
+    {tm : MultiTapeTM k Symbol State}
+    {input : List Symbol}
+    {t₁ t₂ : ℕ}
+    (h_halts₁ : tm.haltsAtStep input t₁)
+    (h_halts₂ : tm.haltsAtStep input t₂) :
+    t₁ = t₂ := by
+  wlog h : t₁ ≤ t₂
+  · exact (this h_halts₂ h_halts₁ (Nat.le_of_not_le h)).symm
+  obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le h
+  cases d with
+  | zero => rfl
+  | succ d =>
+    have halts₁ : (tm.configs (tm.initCfg input) t₁).state = none := by
+      simp [haltsAtStep] at h_halts₁
+      exact h_halts₁.left
+    have halts₂ : (tm.configs (tm.initCfg input) (d + t₁)).state ≠ none := by
+      grind [haltsAtStep, configs]
+    refine absurd ?_ halts₂
+    rw [Nat.add_comm, configs_add, tm.configs_of_halts _ halts₁]
+    exact halts₁
+
+/-- If a deterministic machine repeats a non-halting configuration, it never halts,
+because the sequence between the two configurations will loop forever.
+Note that this can be applied to two arbitrary and different time steps `t` and `t + Δ`
+using `tm.configs_add`. -/
+lemma not_halts_of_repeat_nonhalt
+    (cfg : Cfg k Symbol State input)
+    (h_not_halt : cfg.state ≠ none)
+    (t : ℕ)
+    (heq : tm.configs cfg (t + 1) = cfg) :
+    ∀ t', (tm.configs cfg t').state ≠ none := by
+  intro t'
+  -- The configuration will repeat every `t + 1` steps.
+  have hloop : ∀ n, tm.configs cfg (n * (t + 1)) = cfg := by
+    intro n
+    induction n with
+    | zero => simp
+    | succ n ih =>
+      rw [show (n + 1) * (t + 1) = n * (t + 1) + (t + 1) by grind, tm.configs_add, ih, heq]
+  by_contra hnh
+  -- Assuming the machine halts at step `t'`, it is also halted at step `t' * (t + 1)`
+  have h₁ : (tm.configs cfg (t' * (t + 1))).state = none := by
+    have hle : t' ≤ t' * (t + 1) := by grind
+    obtain ⟨tΔ , htΔ⟩ := Nat.exists_eq_add_of_le hle
+    rw [htΔ, tm.configs_add]
+    simp [hnh]
+  simp [hloop t', h_not_halt] at h₁
+
+end MultiTapeTM
+
+end Turing
diff --git a/Cslib/Computability/Machines/Turing/MultiTape/TapeLemmas.lean b/Cslib/Computability/Machines/Turing/MultiTape/TapeLemmas.lean
new file mode 100644
index 0000000000..39ec30f56d
--- /dev/null
+++ b/Cslib/Computability/Machines/Turing/MultiTape/TapeLemmas.lean
@@ -0,0 +1,150 @@
+/-
+Copyright (c) 2026 Christian Reitwiessner. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Christian Reitwiessner
+-/
+
+module
+
+public import Cslib.Computability.Machines.Turing.MultiTape.Deterministic
+
+/-!
+# Tape head visitation and space-usage lemmas
+
+This file collects lemmas about the set of positions visited by a work-tape head
+(`MultiTapeTM.visitedByTapeHead`) and the resulting space-usage measures
+(`MultiTapeTM.spaceUsedByTape`, `MultiTapeTM.spaceUsed`) and how the tape head positions
+influence the cells that are modified on a tape.
+
+-/
+
+@[expose] public section
+
+namespace Turing.MultiTapeTM
+
+variable {k : ℕ}
+variable {State Symbol : Type*}
+variable {input : List Symbol}
+variable {tm : MultiTapeTM k Symbol State}
+variable {cfg : Cfg k Symbol State input}
+
+/-- If the work tape head is not at position `z`, then the tape does not change there. -/
+lemma step_workTapes_eq_of_ne
+    (cfg : Cfg k Symbol State input)
+    (j : Fin k)
+    (z : ℤ)
+    (hz : z ≠ cfg.workTapePos j) :
+    (tm.step cfg).workTapes j z = cfg.workTapes j z := by
+  unfold step
+  cases hst : cfg.state with
+  | none => simp_all
+  | some q =>
+    rcases hw : ((tm.tr q cfg.inputSymbol cfg.workTapeSymbols).workActions j).1 <;> simp_all
+
+lemma mem_visitedByTapeHead {t : ℕ} {i : Fin k} {z : ℤ} :
+    z ∈ tm.visitedByTapeHead cfg t i ↔ ∃ t' < t + 1, (tm.configs cfg t').workTapePos i = z := by
+  simp [visitedByTapeHead]
+
+lemma mem_visitedByTapeHead_self (cfg : Cfg k Symbol State input) (t : ℕ) (i : Fin k) :
+    (tm.configs cfg t).workTapePos i ∈ tm.visitedByTapeHead cfg t i :=
+  tm.mem_visitedByTapeHead.mpr ⟨t, by omega, rfl⟩
+
+/-- The set of positions visited by a tape head is monotone in the number of steps. -/
+lemma visitedByTapeHead_mono (cfg : Cfg k Symbol State input) (i : Fin k) {t t' : ℕ} (h : t ≤ t') :
+    tm.visitedByTapeHead cfg t i ⊆ tm.visitedByTapeHead cfg t' i := by
+  apply Finset.image_subset_image
+  grind
+
+/-- Starting from configuration `cfg`, every position between the initial head position of tape
+`i` and the one after `t` steps is part of the "visited set" at step `t`. -/
+lemma uIcc_workTapePos_subset_visitedByTapeHead
+    (cfg : Cfg k Symbol State input) (i : Fin k) (t : ℕ) :
+    Finset.uIcc (cfg.workTapePos i) ((tm.configs cfg t).workTapePos i)
+      ⊆ tm.visitedByTapeHead cfg t i := by
+  induction t with
+  | zero => simpa [configs] using tm.mem_visitedByTapeHead_self cfg 0 i
+  | succ t ih =>
+    intro z hz
+    have hstep : |(tm.configs cfg (t + 1)).workTapePos i - (tm.configs cfg t).workTapePos i| ≤ 1 :=
+      configs_succ_eq_step' (tm := tm) ▸ tm.workTapePos_step_le _ i
+    have hmono := tm.visitedByTapeHead_mono cfg i (Nat.le_succ t)
+    have hself := tm.mem_visitedByTapeHead_self cfg (t + 1) i
+    grind [Finset.mem_uIcc]
+
+/-- If a work tape cell is changed after `t` steps, it must have been visited by the tape head. -/
+lemma mem_visitedByTapeHead_of_workTapes_ne
+    (j : Fin k)
+    (t : ℕ)
+    (z : ℤ)
+    (h : (tm.configs cfg t).workTapes j z ≠ cfg.workTapes j z) :
+    z ∈ tm.visitedByTapeHead cfg t j := by
+  induction t with
+  | zero => exact absurd (by simp [configs]) h
+  | succ t ih =>
+    rw [configs_succ_eq_step'] at h
+    by_cases hz : z = (tm.configs cfg t).workTapePos j
+    · exact hz ▸ tm.visitedByTapeHead_mono cfg j (Nat.le_succ t)
+        (tm.mem_visitedByTapeHead_self cfg t j)
+    · rw [tm.step_workTapes_eq_of_ne _ j z hz] at h
+      exact tm.visitedByTapeHead_mono cfg j (Nat.le_succ t) (ih h)
+
+/-- Every position visited by the head of tape `i` lies within `spaceUsedByTape … i` of the
+head's starting position. -/
+lemma natAbs_le_spaceUsedByTape_of_mem_visited
+    {i : Fin k}
+    {z : ℤ}
+    {t : ℕ}
+    (hz : z ∈ tm.visitedByTapeHead cfg t i) :
+    (z - cfg.workTapePos i).natAbs ≤ tm.spaceUsedByTape cfg t i := by
+  obtain ⟨t', ht', rfl⟩ := tm.mem_visitedByTapeHead.mp hz
+  have h1 := Finset.card_le_card
+    ((tm.uIcc_workTapePos_subset_visitedByTapeHead cfg i t').trans
+      (tm.visitedByTapeHead_mono cfg i (show t' ≤ t by omega)))
+  rw [Int.card_uIcc] at h1
+  unfold spaceUsedByTape
+  omega
+
+/-- Every non-blank cell on work tape `i` lies within `spaceUsedByTape … i t` of the origin. -/
+lemma content_natAbs_le_spaceUsedByTape
+    {i : Fin k}
+    (t : ℕ)
+    (z : ℤ)
+    (h : (tm.configs (tm.initCfg input) t).workTapes i z ≠ none) :
+    z.natAbs ≤ tm.spaceUsedByTape (tm.initCfg input) t i := by
+  -- The work tapes start out blank, so any non-blank cell has been visited by the head; the
+  -- initial head position is `0`, so the displacement bound is a bound on the position itself.
+  simpa using tm.natAbs_le_spaceUsedByTape_of_mem_visited
+    (tm.mem_visitedByTapeHead_of_workTapes_ne i t z h)
+
+/-- The number of cells touched by a single work tape grows by at most one each step. -/
+lemma spaceUsedByTape_le (cfg : Cfg k Symbol State input) (t : ℕ) (i : Fin k) :
+    tm.spaceUsedByTape cfg t i ≤ t + 1 := by
+  calc
+    tm.spaceUsedByTape cfg t i
+    _ ≤ (Finset.range (t + 1)).card := Finset.card_image_le
+    _ = t + 1 := Finset.card_range _
+
+/-- The space used by a computation is bounded linearly by the number of steps. -/
+lemma spaceUsed_linear (cfg : Cfg k Symbol State input) (t : ℕ) :
+    tm.spaceUsed cfg t ≤ k * t + k := by
+  calc tm.spaceUsed cfg t
+      = ∑ i, (tm.spaceUsedByTape cfg t i) := by rfl
+    _ ≤ ∑ i, (t + 1) := Finset.sum_le_sum (fun i _ => tm.spaceUsedByTape_le cfg t i)
+    _ = k * t + k := by simp [Nat.mul_succ]
+
+/-- The space used by a single tape is monotone in the number of steps. -/
+lemma spaceUsedByTape_mono
+    (tm : MultiTapeTM k Symbol State)
+    (cfg : Cfg k Symbol State input)
+    (i : Fin k) :
+    Monotone (tm.spaceUsedByTape cfg · i) := by
+  intro t t' h
+  exact Finset.card_le_card (tm.visitedByTapeHead_mono cfg i h)
+
+/-- The total space used is monotone in the number of steps. -/
+lemma spaceUsed_mono (tm : MultiTapeTM k Symbol State) (cfg : Cfg k Symbol State input) :
+    Monotone (tm.spaceUsed cfg ·) := by
+  intro t t' h
+  exact Finset.sum_le_sum (fun i _ => spaceUsedByTape_mono tm cfg i h)
+
+end Turing.MultiTapeTM
diff --git a/Cslib/Computability/Machines/Turing/SingleTape/Defs.lean b/Cslib/Computability/Machines/Turing/SingleTape/Defs.lean
new file mode 100644
index 0000000000..5cac8d41b0
--- /dev/null
+++ b/Cslib/Computability/Machines/Turing/SingleTape/Defs.lean
@@ -0,0 +1,68 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi, Bolton Bailey
+-/
+
+module
+
+public import Cslib.Foundations.Data.BiTape
+
+/-! # Basic definitions for Turing Machines (TMs) -/
+
+@[expose] public section
+
+namespace Cslib.Computability.Turing.SingleTape
+
+/-- The transition labels used by a single-tape Turing Machine. -/
+inductive TrLabel (Symbol : Type*)
+  /-- Read `x` from the tape. -/
+  | read (x : Symbol)
+  /-- Write `x` on the tape. -/
+  | write (x : Symbol)
+  /-- Move the head of the tape. -/
+  | move (d : Turing.Dir)
+  /-- Do nothing. -/
+  | skip
+
+/-- Applies a transition label to a tape, returning `none` if it is not possible.
+The input is taken as an `Option` to make the function composable. -/
+def TrLabel.applyToTape [DecidableEq Symbol]
+    (otape : Option (Turing.BiTape Symbol)) (μ : TrLabel Symbol) :
+    Option (Turing.BiTape Symbol) :=
+  match μ, otape with
+  | read x, some tape => if x = tape.head then some tape else none
+  | write x, some tape => some (tape.write x)
+  | move d, some tape => some (tape.move d)
+  | skip, some tape => some tape
+  | _, _ => none
+
+@[scoped grind →]
+theorem TrLabel.applyToTape_isSome [DecidableEq Symbol] {μ : TrLabel Symbol}
+    {ot : Option (Turing.BiTape Symbol)} (h : (μ.applyToTape ot).isSome) : ot.isSome := by
+  have ⟨t', ht'⟩ := Option.isSome_iff_exists.mp h
+  simp only [applyToTape] at ht'
+  grind [applyToTape]
+
+@[scoped grind →]
+theorem TrLabel.applyToTape_foldl_isSome [DecidableEq Symbol] {μs : List (TrLabel Symbol)}
+    {ot : Option (Turing.BiTape Symbol)} (h : (μs.foldl applyToTape ot).isSome) : ot.isSome := by
+  induction μs generalizing ot <;> grind
+
+/-- Configuration of a single-tape Turing machine. -/
+@[ext]
+structure Cfg (State Symbol : Type*) where
+  /-- The state that the machine is in. -/
+  state : State
+  /-- Tape of the machine (memory). -/
+  tape : Turing.BiTape Symbol
+
+/-- Helper builder for a configuration with a given tape content. -/
+def Cfg.mk₁ (s : State) (xs : List Symbol) : Cfg State Symbol where
+  state := s
+  tape := Turing.BiTape.mk₁ xs
+
+/-- The space used by a configuration is the space used by its tape. -/
+def Cfg.spaceUsed (cfg : Cfg State Symbol) : ℕ := cfg.tape.spaceUsed
+
+end Cslib.Computability.Turing.SingleTape
diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/Turing/SingleTape/Deterministic.lean
similarity index 99%
rename from Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
rename to Cslib/Computability/Machines/Turing/SingleTape/Deterministic.lean
index debad7d43f..29f379d5ac 100644
--- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/Turing/SingleTape/Deterministic.lean
@@ -62,11 +62,12 @@ We also provide ways of constructing polynomial-runtime TMs
 
 @[expose] public section
 
-open Cslib Relation
+open Relation
 
-namespace Turing
+namespace Cslib.Turing
 
 open BiTape StackTape
+open _root_.Turing
 
 variable {Symbol : Type}
 
@@ -317,8 +318,7 @@ private theorem map_toCompCfg_right_step :
   cases cfg2 with
   | mk state BiTape =>
     cases state with
-    | none =>
-      simp only [step, toCompCfg_right, Option.map_none, compComputer]
+    | none => rfl
     | some q =>
       generalize hM : tm2.tr q BiTape.head = result
       obtain ⟨⟨wr, dir⟩, nextState⟩ := result
@@ -503,4 +503,4 @@ end PolyTimeComputable
 
 end SingleTapeTM
 
-end Turing
+end Cslib.Turing
diff --git a/Cslib/Computability/Machines/Turing/SingleTape/NonDeterministic.lean b/Cslib/Computability/Machines/Turing/SingleTape/NonDeterministic.lean
new file mode 100644
index 0000000000..ffd15a5909
--- /dev/null
+++ b/Cslib/Computability/Machines/Turing/SingleTape/NonDeterministic.lean
@@ -0,0 +1,123 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Foundations.Relation.Defs
+public import Cslib.Foundations.Data.RelatesInSteps
+public import Cslib.Computability.Automata.NA.Basic
+public import Cslib.Computability.Automata.Transducers.Transducer
+public import Cslib.Foundations.Data.BiTape
+public import Cslib.Computability.Machines.Turing.SingleTape.Defs
+
+/-! # Single-Tape Nondeterministic Turing Machines (NTMs)
+
+Nondeterministic Turing Machines (NTMs), defined as nondeterministic automata (`NA`) that act on a
+bidirectional tape (`BiTape`).
+
+## References
+
+* [M. Sipser, *Introduction to Theory of Computation*][Sipser2013]
+-/
+
+@[expose] public section
+
+namespace Cslib.Computability.Turing.SingleTape
+
+open Automata
+
+/-- A (single-tape) Nondeterministic Turing Machine (NTM) is a nondeterministic automaton equipped
+with a set of accepting halting states. -/
+structure SingleTapeNTM (State Symbol : Type*)
+    extends NA State (TrLabel Symbol) where
+  /-- The set of accepting states. -/
+  accept : Set State
+  /-- Proof that all accepting states are halting states. -/
+  accept_halting (hmem : s ∈ accept) : ¬∃ μ s', Tr s μ s'
+
+variable {State Symbol : Type*}
+
+namespace SingleTapeNTM
+
+variable [DecidableEq Symbol]
+
+/-- An NTM yields a small-step operational semantics on configurations, which codifies an execution
+step. This formalises the 'yields' relation from [Sipser2013]. -/
+def Yields (m : SingleTapeNTM State Symbol)
+    (c c' : Cfg State Symbol) : Prop :=
+  ∃ μ, m.Tr c.state μ c'.state ∧ μ.applyToTape c.tape = c'.tape
+
+@[scoped grind =]
+theorem yields_tr {m : SingleTapeNTM State Symbol} :
+    m.Yields c c' ↔ ∃ μ, m.Tr c.state μ c'.state ∧ μ.applyToTape c.tape = c'.tape := by rfl
+
+/-- Multistep execution of an NTM, defined as the reflexive and transitive closure of one-step
+execution.
+-/
+def MYields (m : SingleTapeNTM State Symbol) := Relation.ReflTransGen m.Yields
+
+open scoped LTS LTS.MTr TrLabel
+
+/-- Characterisation of executions in terms of multistep transitions. -/
+@[scoped grind =]
+theorem mYields_mTr {m : SingleTapeNTM State Symbol} :
+    m.MYields c c' ↔ ∃ μs, m.MTr c.state μs c'.state ∧
+    μs.foldl TrLabel.applyToTape (some c.tape) = c'.tape := by
+  apply Iff.intro <;> intro h
+  case mp =>
+    induction h using Relation.ReflTransGen.head_induction_on
+    case refl =>
+      exists []
+      grind
+    case head _ c cb hred hmred ih =>
+      rcases ih with ⟨μs, hmtr, ih⟩
+      have ⟨μ, _⟩ := yields_tr.mp hred
+      exists μ :: μs
+      grind
+  case mpr =>
+    rcases h with ⟨μs, hmtr, h⟩
+    induction μs generalizing c
+    case nil =>
+      rw [show c = c' by grind [Cfg.ext]]
+      apply Relation.ReflTransGen.refl
+    case cons μ μs ih =>
+      cases hmtr
+      case stepL sb htr hmtr =>
+        have hat : ∀ (μ : TrLabel Symbol) t, (μ.applyToTape t).isSome → t.isSome := by grind
+        have ⟨tb, htb⟩ : ∃ tb, μ.applyToTape c.tape = some tb := by grind [Option.isSome_iff_exists]
+        let cb := {state := sb, tape := tb : Cfg State Symbol}
+        have hmyields : m.MYields cb c' := by grind
+        apply Relation.ReflTransGen.head (b := cb) (by grind)
+        simp only [MYields] at hmyields
+        grind
+
+/-- An NTM is an acceptor of finite lists of symbols. -/
+instance : Acceptor (SingleTapeNTM State Symbol) Symbol where
+    Accepts (m : SingleTapeNTM State Symbol) (xs : List Symbol) :=
+  ∃ s ∈ m.start, ∃ c', c'.state ∈ m.accept ∧ m.MYields (Cfg.mk₁ s xs) c'
+
+/-- The NTM `m` accepts `xs` in `n` execution steps. -/
+def AcceptsInSteps (m : SingleTapeNTM State Symbol) (xs : List Symbol) (n : ℕ) : Prop :=
+  ∃ s ∈ m.start, ∃ c', c'.state ∈ m.accept ∧ Relation.RelatesInSteps m.Yields (Cfg.mk₁ s xs) c' n
+
+/-- The NTM `m` accepts `xs` in at most `n` execution steps. -/
+def AcceptsInAtMostSteps (m : SingleTapeNTM State Symbol) (xs : List Symbol) (n : ℕ) : Prop :=
+  ∃ k ≤ n, m.AcceptsInSteps xs k
+
+/-- An NTM is a transducer of finite lists of symbols. -/
+instance : Transducer (SingleTapeNTM State Symbol) Symbol Symbol where
+    Translates (m : SingleTapeNTM State Symbol) (xs ys : List Symbol) :=
+  ∃ s ∈ m.start, ∃ c',
+    c'.state ∈ m.accept ∧
+    m.MYields (Cfg.mk₁ s xs) c' ∧
+    /- The following condition on output deviates from textbooks, in order to have the same
+    criterion as for deterministic TMs. We might want to revisit this in the future.
+    -/
+    c'.tape = Turing.BiTape.mk₁ ys
+
+end SingleTapeNTM
+
+end Cslib.Computability.Turing.SingleTape
diff --git a/Cslib/Computability/README.md b/Cslib/Computability/README.md
new file mode 100644
index 0000000000..f2ab58842f
--- /dev/null
+++ b/Cslib/Computability/README.md
@@ -0,0 +1,35 @@
+<pre>
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+</pre>
+
+# Computability
+
+This directory hosts **formal developments in computability and neighbouring areas**. Its scope includes automata, complexity classes, formal languages over finite and infinite words, and other machine models.
+
+## Principles
+
+### Multiple computational models
+
+There is a plethora of computational models in the literature, some of which are very near to each other (e.g., Turing machines and Wang B-machines). Depending on the aim, one can be more convenient than the other.
+In general, computability can be studied through different kinds of objects.
+
+These representations can coexist when they serve different purposes. A central goal is to make their tradeoffs explicit and to connect them where possible.
+
+### Reuse of common infrastructure
+
+The [Foundations](../Foundations) directory offers abstractions that are directly useful for computability-theoretic developments and should be reused as much as possible. Examples already present in this directory include the use of labelled transition systems for automata and distributed algorithms, tape structures for Turing machines, and general relation-theoretic tools for machine semantics.
+
+This approach enables:
+1. Reusing and transferring constructions and results across different models.
+2. Applying CSLib's [logics](../Logics) to reason about computational models.
+3. Developing connections between computability models and other areas (like the constructions of automata based on transition systems).
+
+### Separation from languages
+
+Some of the developments here are close to [Languages](../Languages), but are placed here instead because the emphasis is on formal languages over words and models typically linked to computability studies.
+
+## Plans and notes
+
+- We plan on expanding this directory with more machine models and associated results, including equivalence results, closure properties, and other metatheory.
+- We plan on clarifying and formalising connections between language-theoretic, automata-theoretic, machine-based, and distributed perspectives on computation.
diff --git a/Cslib/Computability/URM/Execution.lean b/Cslib/Computability/URM/Execution.lean
index 00526d3893..83e5c853e4 100644
--- a/Cslib/Computability/URM/Execution.lean
+++ b/Cslib/Computability/URM/Execution.lean
@@ -6,7 +6,7 @@ Authors: Jesse Alama
 module
 
 public import Cslib.Computability.URM.Defs
-public import Cslib.Foundations.Data.Relation
+public import Cslib.Foundations.Relation.Confluence
 public import Mathlib.Data.Part
 
 /-! # URM Execution Semantics
diff --git a/Cslib/Computability/URM/StandardForm.lean b/Cslib/Computability/URM/StandardForm.lean
index f1abcf344b..51a288b6bc 100644
--- a/Cslib/Computability/URM/StandardForm.lean
+++ b/Cslib/Computability/URM/StandardForm.lean
@@ -217,8 +217,9 @@ theorem eval_toStandardForm {p : Program} {inputs : List ℕ} :
   · simp only [Part.map_Dom]
     exact Halts.toStandardForm_iff
   · intro hp hq
-    simp only [Part.map_get, Function.comp_apply, Regs.output,
-               evalState_toStandardForm_regs hp hq]
+    have := Part.map_get (fun x : State => x.regs.output) (evalState p inputs) hp
+    have := Part.map_get (fun x : State => x.regs.output) (evalState p.toStandardForm inputs) hq
+    simp_all [Function.comp_def, evalState_toStandardForm_regs hp hq]
 
 /-- A program is equivalent to its standard form. -/
 theorem toStandardForm_equiv (p : Program) : p.toStandardForm ≈ p :=
diff --git a/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean b/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean
index bd0de00d3b..0c227bdd84 100644
--- a/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean
+++ b/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean
@@ -174,7 +174,7 @@ private theorem privacyCorrectionPolynomial_degree_lt
       (r := fun i : s => (secret₀ - secret₁) / params.point i)
       (points_injOn_subtype (F := F) params s))
     ?_
-  simpa using hcard
+  simp [hcard]
 
 private noncomputable def privacyCorrection
     (params : Params F Party) (s : Finset Party)
@@ -270,11 +270,10 @@ noncomputable def schemeWith (params : Params F Party) (sampler : TailSampler pa
           (Polynomial.sharingPolynomial secretValue
               (Polynomial.tailPolynomial params.threshold coeffs)).degree <
             Fintype.card s := by
-        simpa using
-          (lt_of_lt_of_le hdeg₀ (by exact_mod_cast hs) :
-            (Polynomial.sharingPolynomial secretValue
-                (Polynomial.tailPolynomial params.threshold coeffs)).degree <
-              s.card)
+        simp [(lt_of_lt_of_le hdeg₀ (by exact_mod_cast hs) :
+          (Polynomial.sharingPolynomial secretValue
+            (Polynomial.tailPolynomial params.threshold coeffs)).degree <
+              s.card)]
       have hx : Function.Injective (fun i : s => params.point i) := by
         intro i j hij
         exact Subtype.ext (params.point_injective hij)
diff --git a/Cslib/Crypto/Protocols/SecretSharing/Shamir/Polynomial.lean b/Cslib/Crypto/Protocols/SecretSharing/Shamir/Polynomial.lean
index 4cb4ced4f8..3ee93ac1ed 100644
--- a/Cslib/Crypto/Protocols/SecretSharing/Shamir/Polynomial.lean
+++ b/Cslib/Crypto/Protocols/SecretSharing/Shamir/Polynomial.lean
@@ -126,7 +126,7 @@ theorem reconstruct_eq_constantCoeff_of_eval_eq
       (s := Finset.univ)
       (v := x)
       hx.injOn
-      (by simpa using hdeg)
+      (by simp [hdeg])
   simpa [reconstruct] using congrArg _root_.Polynomial.constantCoeff hp.symm
 
 /-- Reconstruction succeeds on the values of a Shamir sharing polynomial once
diff --git a/Cslib/Crypto/README.md b/Cslib/Crypto/README.md
new file mode 100644
index 0000000000..75ffac5366
--- /dev/null
+++ b/Cslib/Crypto/README.md
@@ -0,0 +1,26 @@
+<pre>
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+</pre>
+
+# Crypto
+
+This directory hosts **cryptographic definitions, primitives, protocol models, and related security metatheory**. Its scope includes both basic cryptographic notions and larger developments such as security protocols.
+
+We aim at supporting both abstract security reasoning and concrete protocol developments, while making explicit the relations between them. To this end, this part of CSLib has very important relationships with [Languages](../Languages) and [Logics](../Logics), explained in the remainder.
+
+## Principles
+
+### Integration with languages
+
+Whenever appropriate, cryptographic primitives should be developed so that they compose well with CSLib's [languages](../Languages) that offer a way to integrate a computational substrate. This is common, for example, in choreographic programming languages and many process calculi.
+
+The aim is to build end-to-end models where cryptographic operations appear inside larger communicating or computational systems.
+
+To this end, we expect to leverage the combination of `Crypto` and [Languages](../Languages) to define and formally reason about security protocols. CSLib's common semantics APIs connecting [Languages](../Languages) and [Logics](../Logics) should enable such reasoning.
+
+## Plans and notes
+
+- We plan on developing applied calculi and logics for modelling and reasoning about security protocols.
+- We plan on developing a comprehensive library of primitives and foundational protocols, together with their proofs of correctness.
+- We plan on supporting downstream efforts on the development of secure digital infrastructures (including implementation of complex secure applications and systems).
diff --git a/Cslib/Foundations/Combinatorics/InfiniteGraphRamsey.lean b/Cslib/Foundations/Combinatorics/InfiniteGraphRamsey.lean
index 41cb0180dc..6d0712db97 100644
--- a/Cslib/Foundations/Combinatorics/InfiniteGraphRamsey.lean
+++ b/Cslib/Foundations/Combinatorics/InfiniteGraphRamsey.lean
@@ -29,12 +29,10 @@ open Function Set
 theorem infinite_pigeonhole_principle {X Y : Type*} [Finite Y] (f : X → Y) {s : Set X}
     (h_inf : s.Infinite) : ∃ y, ∃ t, t.Infinite ∧ t ⊆ s ∧ ∀ x ∈ t, f x = y := by
   have := h_inf.to_subtype
-  obtain ⟨y, h_inf'⟩ := Finite.exists_infinite_fiber (s.restrict f)
+  obtain ⟨y, h_inf'⟩ := Finite.exists_infinite_fiber (s.domRestrict f)
   have h_inf_iff := Equiv.infinite_iff <|
     Equiv.subtypeSubtypeEquivSubtypeInter (· ∈ s) (fun x ↦ f x = y)
-  simp only [coe_eq_subtype, mem_preimage, restrict_apply, mem_singleton_iff, h_inf_iff] at h_inf'
-  have h_inf'' := (infinite_coe_iff (s := { x | x ∈ s ∧ f x = y })).mp h_inf'
-  use y, {x | x ∈ s ∧ f x = y}
+  use y, {x | x ∈ s ∧ f x = y}, infinite_coe_iff.mp <| h_inf_iff.mp h_inf'
   grind
 
 /-- An `InfVSet` consists of a set of vertices and a proof that the set is infinite. -/
@@ -69,8 +67,8 @@ private lemma goodSelection_exists (ivs : InfVSet Vertex) :
   obtain ⟨v, h_v⟩ := Set.Infinite.nonempty ivs.inf
   let f u := color {v, u}
   obtain ⟨c, vs, h_inf, h_vs, h_col⟩ := infinite_pigeonhole_principle f <|
-    Set.Infinite.diff ivs.inf (finite_singleton v)
-  simp only [subset_diff] at h_vs
+    Set.Infinite.sdiff ivs.inf (finite_singleton v)
+  simp only [subset_sdiff] at h_vs
   let ivs' := InfVSet.mk vs h_inf
   use {vs := ivs', v := v, c := c}
   grind [GoodSelection]
diff --git a/Cslib/Foundations/Control/Monad/Free.lean b/Cslib/Foundations/Control/Monad/Free.lean
index 90b2fea4c0..09d550b8bc 100644
--- a/Cslib/Foundations/Control/Monad/Free.lean
+++ b/Cslib/Foundations/Control/Monad/Free.lean
@@ -39,6 +39,8 @@ This unique interpreter is `FreeM.liftM f`
 - `FreeM.liftM_unique`: Proof of the universal property
 
 For elimination and interpretation theory, see `Free/Fold.lean`.
+For polynomial effect signatures with explicit operation shapes and positions, see
+`Cslib.Foundations.Data.PFunctor.Free`.
 
 See the Haskell [freer-simple](https://hackage.haskell.org/package/freer-simple) library for the
 Haskell implementation that inspired this approach.
@@ -184,11 +186,11 @@ theorem map_bind (f : β → γ) (x : FreeM F α) (c : α → FreeM F β) :
 @[simp]
 theorem id_map : ∀ x : FreeM F α, map id x = x
   | .pure a => rfl
-  | .liftBind op cont => by simp_all [map, id_map]
+  | .liftBind op cont => by simp [map, id_map]
 
 theorem comp_map (h : β → γ) (g : α → β) : ∀ x : FreeM F α, map (h ∘ g) x = map h (map g x)
   | .pure a => rfl
-  | .liftBind op cont => by simp_all [map, comp_map]
+  | .liftBind op cont => by simp [map, comp_map]
 
 instance : LawfulFunctor (FreeM F) where
   map_const := rfl
diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean
index e61272d57d..8c57a4c114 100644
--- a/Cslib/Foundations/Data/BiTape.lean
+++ b/Cslib/Foundations/Data/BiTape.lean
@@ -38,13 +38,13 @@ will not collide.
 
 @[expose] public section
 
-namespace Turing
+namespace Cslib.Turing
 
 /--
 A structure for bidirectionally-infinite Turing machine tapes
 that eventually take on blank `none` values
 -/
-structure BiTape (Symbol : Type) where
+structure BiTape (Symbol : Type*) where
   /-- The symbol currently under the tape head -/
   head : Option Symbol
   /-- The contents to the left of the head -/
@@ -54,7 +54,7 @@ structure BiTape (Symbol : Type) where
 
 namespace BiTape
 
-variable {Symbol : Type}
+variable {Symbol : Type*}
 
 /-- The empty `BiTape` -/
 def nil : BiTape Symbol := ⟨none, ∅, ∅⟩
@@ -92,6 +92,8 @@ Move the head right by shifting the right StackTape under the head.
 def moveRight (t : BiTape Symbol) : BiTape Symbol :=
   ⟨t.right.head, StackTape.cons t.head t.left, t.right.tail⟩
 
+open _root_.Turing
+
 /--
 Move the head to the left or right, shifting the tape underneath it.
 -/
@@ -102,7 +104,7 @@ def move (t : BiTape Symbol) : Dir → BiTape Symbol
 /--
 Optionally perform a `move`, or do nothing if `none`.
 -/
-def optionMove : BiTape Symbol → Option Dir → BiTape Symbol
+def optionMove : BiTape Symbol → Option Turing.Dir → BiTape Symbol
   | t, none => t
   | t, some d => t.move d
 
@@ -125,10 +127,9 @@ def write (t : BiTape Symbol) (a : Option Symbol) : BiTape Symbol := { t with he
 The space used by a `BiTape` is the number of symbols
 between and including the head, and leftmost and rightmost non-blank symbols on the `BiTape`.
 -/
-@[scoped grind]
 def spaceUsed (t : BiTape Symbol) : ℕ := 1 + t.left.length + t.right.length
 
-@[simp, grind =]
+@[simp]
 lemma spaceUsed_write (t : BiTape Symbol) (a : Option Symbol) :
     (t.write a).spaceUsed = t.spaceUsed := by rfl
 
@@ -138,11 +139,11 @@ lemma spaceUsed_mk₁ (l : List Symbol) :
   | nil => simp [mk₁, spaceUsed, nil, StackTape.length_nil]
   | cons h t => simp [mk₁, spaceUsed, StackTape.length_nil, StackTape.length_mapSome]; omega
 
-lemma spaceUsed_move (t : BiTape Symbol) (d : Dir) :
+lemma spaceUsed_move (t : BiTape Symbol) (d : Turing.Dir) :
     (t.move d).spaceUsed ≤ t.spaceUsed + 1 := by
   cases d <;> grind [moveLeft, moveRight, move,
     spaceUsed, StackTape.length_tail_le, StackTape.length_cons_le]
 
 end BiTape
 
-end Turing
+end Cslib.Turing
diff --git a/Cslib/Foundations/Data/HasFresh.lean b/Cslib/Foundations/Data/HasFresh.lean
index 01ae7bc7fd..993493547c 100644
--- a/Cslib/Foundations/Data/HasFresh.lean
+++ b/Cslib/Foundations/Data/HasFresh.lean
@@ -62,7 +62,7 @@ def HasFresh.ofSucc {α : Type u} [Inhabited α] [SemilatticeSup α] (f : α →
     HasFresh α where
   fresh s := if hs : s.Nonempty then f (s.sup' hs id) else default
   fresh_notMem s h := if hs : s.Nonempty
-    then not_le_of_gt (hf (s.sup' hs id)) <| by rw [dif_pos hs] at h; exact s.le_sup' id h
+    then not_le_of_gt (hf (s.sup' hs id)) <| by rw [dite_eq_left hs] at h; exact s.le_sup' id h
     else hs ⟨_, h⟩
 
 /-- `ℕ` has a computable fresh function. -/
@@ -126,13 +126,13 @@ declare_term_config_elab elabFreeUnionConfig FreeUnionConfig
   #check free_union [f, g] ℕ
 
   info: ∅ ∪ xs : Finset ℕ
-  #check free_union (singleton := false) ℕ
+  #check free_union -singleton ℕ
 
   -- info: ∅ ∪ {x} : Finset ℕ
-  #check free_union (finset := false) ℕ
+  #check free_union -finset ℕ
 
   -- info: ∅ : Finset ℕ
-  #check free_union (singleton := false) (finset := false) ℕ
+  #check free_union -singleton -finset ℕ
   ```
 -/
 syntax (name := freeUnion) "free_union" optConfig (" [" (term,*) "]")? term : term
diff --git a/Cslib/Foundations/Data/Nat/Segment.lean b/Cslib/Foundations/Data/Nat/Segment.lean
index 01ec8fae8b..ebb139383d 100644
--- a/Cslib/Foundations/Data/Nat/Segment.lean
+++ b/Cslib/Foundations/Data/Nat/Segment.lean
@@ -45,7 +45,7 @@ theorem infinite_strictMono {ns : Set ℕ} (h : ns.Infinite) :
 
 /-- There is a gap between two successive occurrences of a predicate `p : ℕ → Prop`,
 assuming `p` (as a set) is infinite. -/
-theorem nth_succ_gap {p : ℕ → Prop} (hf : (setOf p).Infinite) (n : ℕ) :
+theorem nth_succ_gap {p : ℕ → Prop} (hf : (ofPred p).Infinite) (n : ℕ) :
     ∀ k < nth p (n + 1) - nth p n, k > 0 → ¬ p (k + nth p n) := by
   classical
   intro k h_k1 h_k0 h_p_k
@@ -222,12 +222,12 @@ theorem segment'_eq_segment (hm : StrictMono f) :
       ({x ∈ Finset.range (k + 1) | x ∈ range f}) by
     grind [BijOn.finsetCard_eq, Finset.coe_filter]
   refine ⟨fun n ↦ n + f 0, ?_, ?_, ?_⟩
-  · intro n; simp only [mem_range, Finset.mem_range, mem_setOf_eq]
+  · intro n; simp only [mem_range, Finset.mem_range]
     rintro ⟨h_n, i, rfl⟩
     have := StrictMono.monotone hm <| zero_le i
     refine ⟨?_, i, ?_⟩ <;> omega
   · grind [injOn_of_injective, Injective]
-  · intro n; simp only [mem_range, Finset.mem_range, mem_setOf_eq, mem_image]
+  · intro n; simp only [mem_range, Finset.mem_range, mem_ofPred_eq, mem_image]
     rintro ⟨h_n, i, rfl⟩
     have := StrictMono.monotone hm <| zero_le i
     grind
diff --git a/Cslib/Foundations/Data/OmegaSequence/Flatten.lean b/Cslib/Foundations/Data/OmegaSequence/Flatten.lean
index 4d7a6f76c1..32cc620122 100644
--- a/Cslib/Foundations/Data/OmegaSequence/Flatten.lean
+++ b/Cslib/Foundations/Data/OmegaSequence/Flatten.lean
@@ -88,7 +88,7 @@ theorem cumLen_segment_one_add {ls : ωSequence (List α)} (h_ls : ∀ k, (ls k)
   symm
   apply Set.BijOn.finsetCard_eq (fun n ↦ n + (ls 0).length)
   refine ⟨?_, by grind [injOn_of_injective, Injective], ?_⟩ <;>
-  ( intro k; simp only [Set.mem_range, Finset.coe_filter, Finset.mem_range, Set.mem_setOf_eq,
+  ( intro k; simp only [Set.mem_range, Finset.coe_filter, Finset.mem_range, Set.mem_ofPred_eq,
       le_add_iff_nonneg_left, _root_.zero_le, and_true] )
   · rintro ⟨h_k, i, rfl⟩
     refine ⟨?_, 1 + i, ?_⟩ <;> grind [cumLen_one_add_drop]
@@ -123,10 +123,10 @@ theorem append_flatten [Inhabited α] {ls : ωSequence (List α)} (h_ls : ∀ k,
     (n : ℕ) : (ls.take n).flatten ++ω (ls.drop n).flatten = ls.flatten := by
   induction n generalizing ls <;> grind [tail_eq_drop, take_succ]
 
-/-- The length of `(ls.take n).flatten` is `ls.cumLen n`. -/
-@[simp, nolint simpNF, scoped grind =]
-theorem length_flatten_take {ls : ωSequence (List α)} (n : ℕ) :
-    (ls.take n).flatten.length = ls.cumLen n := by
+/-- The sum of `List.map List.length (take n ls)` is `ls.cumLen n`. -/
+@[simp, scoped grind =]
+theorem map_length_take_sum {ls : ωSequence (List α)} (n : ℕ) :
+    (List.map List.length (take n ls)).sum = ls.cumLen n := by
   induction n <;> grind [take_succ']
 
 /-- `In fact, (ls.take n).flatten` is `ls.flatten.take (ls.cumLen n)`
@@ -137,7 +137,7 @@ theorem flatten_take_drop [Inhabited α]
     (ls.drop n).flatten = ls.flatten.drop (ls.cumLen n) := by
   apply append_left_right_injective
   · rw [append_flatten h_ls n, append_take_drop (ls.cumLen n) ls.flatten]
-  · rw [length_flatten_take, length_take]
+  · simp
 
 theorem flatten_take [Inhabited α]
     {ls : ωSequence (List α)} (h_ls : ∀ k, (ls k).length > 0) (n : ℕ) :
diff --git a/Cslib/Foundations/Data/OmegaSequence/Init.lean b/Cslib/Foundations/Data/OmegaSequence/Init.lean
index 3c54d06ecf..0013a221ae 100644
--- a/Cslib/Foundations/Data/OmegaSequence/Init.lean
+++ b/Cslib/Foundations/Data/OmegaSequence/Init.lean
@@ -9,7 +9,7 @@ module
 public import Cslib.Foundations.Data.OmegaSequence.Defs
 public import Mathlib.Algebra.Order.Group.Nat
 public import Mathlib.Algebra.Order.Sub.Basic
-public import Mathlib.Data.Nat.Lattice
+public import Mathlib.Order.Lattice.Nat
 
 /-!
 # ω-sequences a.k.a. infinite sequences
@@ -32,6 +32,9 @@ variable (m n : ℕ) (x y : List α) (a b : ωSequence α)
 instance [Inhabited α] : Inhabited (ωSequence α) :=
   ⟨ωSequence.const default⟩
 
+instance [h : IsEmpty α] : IsEmpty (ωSequence α) where
+  false xs := IsEmpty.false (xs 0)
+
 @[simp, scoped grind =]
 protected theorem eta (s : ωSequence α) : head s ::ω tail s = s := by
   apply DFunLike.ext
diff --git a/Cslib/Foundations/Data/OmegaSequence/Topology.lean b/Cslib/Foundations/Data/OmegaSequence/Topology.lean
new file mode 100644
index 0000000000..3a336faf94
--- /dev/null
+++ b/Cslib/Foundations/Data/OmegaSequence/Topology.lean
@@ -0,0 +1,125 @@
+/-
+Copyright (c) 2026 Ching-Tsun Chou. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ching-Tsun Chou
+-/
+
+module
+
+public import Cslib.Foundations.Data.OmegaSequence.Init
+public import Mathlib.Topology.Homeomorph.TransferInstance
+public import Mathlib.Topology.MetricSpace.PiNat
+
+/-!
+# Topology on ω-sequences
+
+The topology on ω-sequences is essentially the product topology when `ωSequence α` is
+viewed as the product space `Π (n : ℕ), α`, where `α` is equipped with the discrete
+topology.  The notion of "cylinders" are also ported from `Π (n : ℕ), α` and they form
+a topological basis.
+-/
+
+@[expose] public section
+
+namespace Cslib.ωSequence
+
+open Set Homeomorph TopologicalSpace ωSequence
+
+variable {α : Type*}
+
+/-- Define the topology on `ωSequence α` using an equivalence from it to the product topology
+`ℕ → WithDiscreteTopology α`. -/
+instance : TopologicalSpace (ωSequence α) :=
+  haveI eqv : ωSequence α ≃ (ℕ → WithDiscreteTopology α) := {
+    toFun xs i := .toTopology ⊥ (xs.get i)
+    invFun f := ωSequence.mk fun i => (f i).ofTopology
+    left_inv _ := rfl
+    right_inv _ := rfl
+  }
+  eqv.topologicalSpace
+
+/-- The homeomorphisim from `ωSequence α` to `ℕ → WithDiscreteTopology α`. -/
+def homeomorph : ωSequence α ≃ₜ (ℕ → WithDiscreteTopology α) := Equiv.homeomorph _
+
+@[simp]
+lemma homeomorph_apply (xs : ωSequence α) (i : Nat) :
+    homeomorph xs i = .toTopology ⊥ (xs i) :=
+  rfl
+
+@[simp]
+lemma homeomorph_symm_apply (f : ℕ → WithDiscreteTopology α) :
+    homeomorph.symm f = ωSequence.mk fun i => (f i).ofTopology :=
+  rfl
+
+/-- Port the notion of "cylinders" from `ℕ → WithDiscreteTopology α` to `ωSequence α`. -/
+def cylinder (xs : ωSequence α) (n : ℕ) : Set (ωSequence α) :=
+  homeomorph ⁻¹' (PiNat.cylinder (homeomorph xs) n)
+
+/-- An alternative characterization of cylinders in terms of `ωSequence α` alone. -/
+theorem cylinder_def (xs : ωSequence α) (n : ℕ) :
+    xs.cylinder n = { ys | ∀ k, k < n → ys k = xs k } := by
+  simp [cylinder, PiNat.cylinder]
+
+/-- Yet another alternative characterization of cylinders in terms of `ωSequence α` alone. -/
+theorem cylinder_eq_prepend_range (xs : ωSequence α) (n : ℕ) :
+    xs.cylinder n = range (xs.take n ++ω ·) := by
+  ext ys
+  simp only [cylinder_def, mem_ofPred_eq, mem_range]
+  constructor
+  · intro h
+    use ys.drop n
+    suffices xs.take n = ys.take n by grind
+    apply List.ext_get <;> grind
+  · grind [get_append_left]
+
+/-- The cylinders form a topological basis. -/
+theorem isTopologicalBasis_cylinders :
+    IsTopologicalBasis { s | ∃ (xs : ωSequence α) (n : ℕ), s = xs.cylinder n } := by
+  convert (PiNat.isTopologicalBasis_cylinders _).isInducing homeomorph.isInducing
+  ext
+  constructor
+  · grind [cylinder]
+  · rintro ⟨_, ⟨xs, n, rfl⟩, rfl⟩
+    use (discharger := rfl) homeomorph.symm xs, n
+
+/-- All cylinders are open sets. -/
+theorem isOpen_cylinder (xs : ωSequence α) (n : ℕ) :
+    IsOpen (xs.cylinder n) := homeomorph.continuous.isOpen_preimage _ (PiNat.isOpen_cylinder ..)
+
+/-- Every ω-sequence in an open set belongs to a cylinder which is contained in the set. -/
+theorem nhds_cylinders {xs : ωSequence α} {s : Set (ωSequence α)} (hx : xs ∈ s) (hs : IsOpen s) :
+    ∃ (ys : ωSequence α) (n : ℕ), xs ∈ ys.cylinder n ∧ ys.cylinder n ⊆ s := by
+  obtain ⟨_, ⟨ys, n, rfl⟩, hx', hy⟩:= isTopologicalBasis_cylinders.exists_subset_of_mem_open hx hs
+  use ys, n
+
+/-- A set is open iff any ω-sequence in the set has a finite prefix all of whose infinite
+extensions are also in the set. -/
+theorem isOpen_iff (s : Set (ωSequence α)) :
+    IsOpen s ↔ ∀ xs, xs ∈ s → ∃ n, ∀ ys, (xs.take n) ++ω ys ∈ s := by
+  simp only [IsTopologicalBasis.isOpen_iff isTopologicalBasis_cylinders,
+    cylinder_eq_prepend_range, mem_ofPred_eq, ↓existsAndEq, mem_range, true_and]
+  constructor <;> intro h xs hxs
+  · obtain ⟨_, n, ⟨_, rfl⟩, _⟩ := h xs hxs
+    use n
+    grind [take_append_of_le_length]
+  · obtain ⟨n, _⟩ := h xs hxs
+    use xs, n, ⟨xs.drop n, ?_⟩ <;> grind
+
+/-- A set is dense iff any finite sequence can be extended to an infinite sequence in the set. -/
+theorem dense_iff (s : Set (ωSequence α)) :
+    Dense s ↔ ∀ (xs : ωSequence α) (n : ℕ), ∃ ys, (xs.take n) ++ω ys ∈ s := by
+  simp only [IsTopologicalBasis.dense_iff isTopologicalBasis_cylinders, cylinder_eq_prepend_range,
+    mem_ofPred_eq, forall_exists_index]
+  constructor
+  · intro h xs n
+    obtain ⟨ys, h1, _⟩ := h (xs.cylinder n) xs n
+      (by simp [cylinder_eq_prepend_range]) (by use xs; simp [cylinder_def])
+    use ys.drop n
+    suffices xs.take n = ys.take n by grind
+    grind [cylinder_eq_prepend_range, take_append_of_le_length]
+  · rintro h c xs n rfl ⟨_, _, rfl⟩
+    obtain ⟨ys, _⟩ := h xs n
+    use xs.take n ++ω ys
+    grind
+
+end Cslib.ωSequence
diff --git a/Cslib/Foundations/Data/PFunctor/Free.lean b/Cslib/Foundations/Data/PFunctor/Free.lean
new file mode 100644
index 0000000000..a29e974704
--- /dev/null
+++ b/Cslib/Foundations/Data/PFunctor/Free.lean
@@ -0,0 +1,377 @@
+/-
+Copyright (c) 2026 Quang Dao. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Quang Dao
+-/
+
+module
+
+public import Cslib.Init
+public import Mathlib.Data.PFunctor.Univariate.Basic
+
+/-!
+# Free Monad of a Polynomial Functor
+
+We define the free monad on a **polynomial functor** (`PFunctor`), and prove some basic properties.
+
+The free monad `PFunctor.FreeM P` extends the W-type construction with an extra `pure`
+constructor, yielding a monad that is free over the polynomial functor `P`.
+
+## Comparison with `Cslib.FreeM`
+
+`Cslib.FreeM F` (in `Cslib/Foundations/Control/Monad/Free.lean`) builds a free monad over an
+arbitrary type constructor `F : Type u → Type v`, which need not be functorial.
+Its `liftBind` constructor abstracts over the intermediate type `ι`:
+```
+| liftBind {ι : Type u} (op : F ι) (cont : ι → FreeM F α) : FreeM F α
+```
+
+`PFunctor.FreeM P` instead takes a polynomial functor `P : PFunctor`, where the shapes
+`P.A` and positions `P.B a` are given explicitly.
+Its `liftBind` constructor uses the shape and continuation directly:
+```
+| liftBind (a : P.A) (cont : P.B a → P.FreeM α) : P.FreeM α
+```
+
+When the effect signature is naturally polynomial (a fixed set of operations, each with a
+known return type), `PFunctor.FreeM` avoids the universe bump that the abstract `ι` in
+`Cslib.FreeM` introduces.
+Concretely, `PFunctor.FreeM P` is a genuine endofunctor on a single universe: for a ground
+`P`, `P.FreeM α : Type` whenever `α : Type`, whereas `Cslib.FreeM F α : Type 1` for
+`F : Type → Type`, since `liftBind` stores the intermediate type `ι : Type`.
+
+This matters when a program must itself be a first-class value of the same kind, i.e. for
+higher-order effects whose operations consume or return computations of the same monad
+(schedulers, exception handlers, staged interpreters, higher-order oracles).
+Such an effect's response type can be another `P.FreeM` computation, staying in one universe:
+```
+def coin : PFunctor.{0,0} := ⟨Bool, fun b => if b then Bool else Nat⟩
+-- a `coin`-program is itself `Type 0`, so it can be another effect's response type:
+def scheduler : PFunctor.{0,0} := ⟨Unit, fun _ => coin.FreeM Bool⟩  -- `Type 0`
+```
+With the abstract `ι`, the analogous program lives in `Type 1`, so an effect `Type → Type`
+cannot return it; bumping the effect to `Type 1 → Type 1` pushes its programs to `Type 2`,
+and so on without bound.
+
+This construction is ported from the [VCV-io](https://github.com/dtumad/VCV-io) library.
+
+## Main Definitions
+
+- `PFunctor.FreeM`: The free monad on a polynomial functor.
+- `PFunctor.FreeM.lift`: Lift a shape of the base polynomial functor into the free monad.
+- `PFunctor.FreeM.liftObj`: Lift an object of the base polynomial functor into the free monad.
+- `PFunctor.FreeM.liftM`: Interpret `FreeM P` into any other monad.
+-/
+
+@[expose] public section
+
+universe u v uA uB
+
+namespace PFunctor
+
+-- Disable generation of unneeded lemmas which the simpNF linter would complain about.
+set_option genInjectivity false in
+set_option genSizeOfSpec false in
+/-- The free monad on a polynomial functor.
+This extends `WType` with an extra `pure` constructor. -/
+inductive FreeM (P : PFunctor.{uA, uB}) : Type v → Type (max uA uB v)
+  /-- A leaf node wrapping a pure value. -/
+  | protected pure {α} (a : α) : P.FreeM α
+  /-- Invoke the operation `a : P.A` with continuation `cont : P.B a → P.FreeM α`. -/
+  | liftBind {α} (a : P.A) (cont : P.B a → P.FreeM α) : P.FreeM α
+deriving Inhabited
+
+namespace FreeM
+
+variable {P : PFunctor.{uA, uB}} {α β γ : Type*}
+
+instance : Pure (P.FreeM) where pure := .pure
+
+@[simp]
+theorem pure_eq_pure : (FreeM.pure : α → P.FreeM α) = pure := rfl
+
+/-- Lift a shape of the base polynomial functor into the free monad. -/
+def lift (a : P.A) : P.FreeM (P.B a) := FreeM.liftBind a pure
+
+@[simp] lemma lift_ne_pure (a : P.A) (y : P.B a) :
+    (lift a : P.FreeM (P.B a)) ≠ pure y := by simp [lift]
+
+@[simp] lemma pure_ne_lift (a : P.A) (y : P.B a) :
+    pure y ≠ (lift a : P.FreeM (P.B a)) := by simp [lift]
+
+/-- Bind operation for the `FreeM` monad.
+
+The builtin `>>=` notation should be preferred when `α` and `β` are in the same universe. -/
+protected def bind : P.FreeM α → (α → P.FreeM β) → P.FreeM β
+  | FreeM.pure a, f => f a
+  | FreeM.liftBind a cont, f => FreeM.liftBind a (fun u ↦ FreeM.bind (cont u) f)
+
+instance : Bind (P.FreeM) where bind := .bind
+
+/-- Note that this lemma does not always apply, as it is universe-constrained by `Bind.bind`. -/
+@[simp]
+theorem bind_eq_bind {α β : Type v} :
+    (FreeM.bind : P.FreeM α → _ → P.FreeM β) = Bind.bind := rfl
+
+/-- Map a function over a `FreeM` computation.
+
+The builtin `<$>` notation should be preferred when `α` and `β` are in the same universe. -/
+def map (f : α → β) : P.FreeM α → P.FreeM β
+  | .pure a => .pure (f a)
+  | .liftBind a cont => .liftBind a fun u => FreeM.map f (cont u)
+
+instance : Functor (P.FreeM) where
+  map := .map
+
+/-- Note that this lemma does not always apply, as it is universe-constrained by `Functor.map`. -/
+@[simp]
+theorem map_eq_map {α β : Type v} :
+    FreeM.map (P := P) (α := α) (β := β) = Functor.map := rfl
+
+@[simp]
+lemma liftBind_eq (a : P.A) (cont : P.B a → P.FreeM α) :
+    FreeM.liftBind a cont = (FreeM.lift a).bind cont := rfl
+
+/-- Lift an object of the base polynomial functor into the free monad.
+
+This lifts the shape `x.1` with `lift` and relabels the responses with `x.2`. We use the
+universe-polymorphic `FreeM.map` rather than `<$>`, since the response type `P.B x.1` and the
+target `α` need not lie in the same universe. -/
+abbrev liftObj (x : P.Obj α) : P.FreeM α := (lift x.1).map x.2
+
+instance : MonadLift P (P.FreeM) where
+  monadLift x := FreeM.liftObj x
+
+@[simp] lemma liftObj_ne_pure (x : P.Obj α) (y : α) :
+    (liftObj x : P.FreeM α) ≠ pure y := by simp [liftObj, lift, map, -liftBind_eq]
+
+@[simp] lemma pure_ne_liftObj (x : P.Obj α) (y : α) :
+    pure y ≠ (liftObj x : P.FreeM α) := by simp [liftObj, lift, map, -liftBind_eq]
+
+lemma monadLift_eq_liftObj (x : P.Obj α) : (x : P.FreeM α) = FreeM.liftObj x := rfl
+
+set_option linter.unusedVariables false in
+/-- An override for the default induction principle that is in simp-normal form.
+
+Note that when `α` and `P.B a` are in the same universe, this simplifies slightly further. -/
+@[induction_eliminator]
+protected theorem induction {motive : P.FreeM α → Prop}
+    (pure : ∀ a, motive (pure a))
+    (lift_bind : ∀ (a : P.A) (cont : P.B a → P.FreeM α) (ih : ∀ i, motive (cont i)),
+      motive ((FreeM.lift a).bind cont)) : ∀ x, motive x
+  | .pure a => pure a
+  | liftBind a cont => lift_bind a cont fun u => FreeM.induction pure lift_bind (cont u)
+
+protected theorem bind_assoc (x : P.FreeM α) (f : α → P.FreeM β) (g : β → P.FreeM γ) :
+    (x.bind f).bind g = x.bind (fun a => (f a).bind g) := by
+  induction x with
+  | pure a => rfl
+  | lift_bind a cont ih => simp [← liftBind_eq, FreeM.bind, ih] at *
+
+/-- `.pure a` followed by `bind` collapses immediately. -/
+@[simp]
+lemma pure_bind (a : α) (f : α → P.FreeM β) :
+    (pure a : P.FreeM α).bind f = f a := rfl
+
+@[simp]
+lemma bind_pure : ∀ x : P.FreeM α, x.bind pure = x
+  | .pure a => rfl
+  | .liftBind a cont => by
+    simp only [FreeM.bind]; congr 1; funext u; exact bind_pure (cont u)
+
+@[simp]
+lemma bind_pure_comp (f : α → β) : ∀ x : P.FreeM α, x.bind (pure ∘ f) = map f x
+  | .pure a => rfl
+  | .liftBind a cont => by simp only [FreeM.bind, map, bind_pure_comp]
+
+@[simp]
+lemma liftBind_bind (a : P.A) (cont : P.B a → P.FreeM β) (f : β → P.FreeM γ) :
+    ((FreeM.lift a).bind cont).bind f = (FreeM.lift a).bind (fun u ↦ (cont u).bind f) := by
+  simp only [lift]
+  exact FreeM.bind_assoc (FreeM.liftBind a pure) cont f
+
+@[simp]
+lemma liftObj_bind (x : P.Obj α) (f : α → P.FreeM β) :
+    (FreeM.liftObj x).bind f = FreeM.liftBind x.1 (fun a ↦ f (x.2 a)) := rfl
+
+@[simp] lemma bind_eq_pure_iff (x : P.FreeM α) (f : α → P.FreeM β) (b : β) :
+    x.bind f = pure b ↔ ∃ a, x = pure a ∧ f a = pure b := by
+  cases x with
+  | pure a => exact ⟨fun h => ⟨a, rfl, h⟩, fun ⟨_, h, hf⟩ => by cases h; exact hf⟩
+  | liftBind a cont =>
+    constructor
+    · intro h
+      cases h
+    · rintro ⟨_, h, _⟩
+      cases h
+
+@[simp] lemma pure_eq_bind_iff (x : P.FreeM α) (f : α → P.FreeM β) (b : β) :
+    pure b = x.bind f ↔ ∃ a, x = pure a ∧ pure b = f a := by
+  cases x with
+  | pure a => exact ⟨fun h => ⟨a, rfl, h⟩, fun ⟨_, h, hf⟩ => by cases h; exact hf⟩
+  | liftBind a cont =>
+    constructor
+    · intro h
+      cases h
+    · rintro ⟨_, h, _⟩
+      cases h
+
+instance : Monad (P.FreeM) where
+
+@[simp]
+theorem id_map : ∀ x : P.FreeM α, map id x = x
+  | .pure a => rfl
+  | .liftBind a cont => by
+    simp only [map]
+    congr 1
+    funext u
+    exact id_map (cont u)
+
+theorem comp_map (h : β → γ) (g : α → β) :
+    ∀ x : P.FreeM α, map (h ∘ g) x = map h (map g x)
+  | .pure a => rfl
+  | .liftBind a cont => by
+    simp only [map]
+    congr 1
+    funext u
+    exact comp_map h g (cont u)
+
+instance : LawfulMonad (P.FreeM) := LawfulMonad.mk'
+  (bind_pure_comp := bind_pure_comp)
+  (id_map := id_map)
+  (pure_bind := pure_bind)
+  (bind_assoc := FreeM.bind_assoc)
+
+@[simp]
+lemma pure_inj (a b : α) : (pure a : P.FreeM α) = pure b ↔ a = b := by
+  constructor
+  · intro h
+    cases h
+    rfl
+  · rintro rfl; rfl
+
+lemma liftBind_inj (a a' : P.A)
+    (cont : P.B a → P.FreeM α) (cont' : P.B a' → P.FreeM α) :
+    FreeM.liftBind a cont = FreeM.liftBind a' cont' ↔ ∃ h : a = a', h ▸ cont = cont' := by
+  constructor
+  · intro h
+    cases h
+    exact ⟨rfl, rfl⟩
+  · rintro ⟨rfl, rfl⟩
+    rfl
+
+section liftM
+
+variable {m : Type uB → Type v} {α : Type uB}
+
+/-- Interpret a `FreeM P` computation into any monad `m` by providing an interpretation
+`interp : (a : P.A) → m (P.B a)` for each operation. -/
+protected def liftM [Pure m] [Bind m] (interp : (a : P.A) → m (P.B a)) : P.FreeM α → m α
+  | .pure a => pure a
+  | .liftBind a cont => interp a >>= fun u ↦ (cont u).liftM interp
+
+variable [Monad m] (interp : (a : P.A) → m (P.B a))
+
+@[simp]
+lemma liftM_pure (a : α) : (Pure.pure a : P.FreeM α).liftM interp = Pure.pure a := rfl
+
+@[simp]
+lemma liftM_lift_bind (a : P.A) (cont : P.B a → P.FreeM α) :
+    FreeM.liftM interp (FreeM.lift a >>= cont) =
+      (do let u ← interp a; (cont u).liftM interp) := by
+  dsimp only [FreeM.liftM, FreeM.bind, FreeM.lift]
+  rfl
+
+/--
+A predicate stating that `eval : P.FreeM α → m α` is an interpreter for the polynomial
+effect handler `handler : (a : P.A) → m (P.B a)`.
+
+This means that `eval` is a monad morphism from the free monad `P.FreeM` to the
+monad `m`, and that it extends the interpretation of individual operations given by
+`handler`.
+-/
+structure Interprets (handler : (a : P.A) → m (P.B a)) (eval : P.FreeM α → m α) : Prop where
+  apply_pure (a : α) : eval (.pure a) = pure a
+  apply_lift_bind (a : P.A) (cont : P.B a → P.FreeM α) :
+    eval ((FreeM.lift a).bind cont) = handler a >>= fun x => eval (cont x)
+
+theorem Interprets.eq {handler : (a : P.A) → m (P.B a)} {eval : P.FreeM α → m α}
+    (h : Interprets handler eval) :
+    eval = (·.liftM handler) := by
+  ext x
+  induction x with
+  | pure a => exact h.apply_pure a
+  | lift_bind a cont ih =>
+    rw [h.apply_lift_bind]
+    conv_rhs => simp only [bind_eq_bind, liftM_lift_bind]
+    simp only [ih]
+
+theorem Interprets.liftM (handler : (a : P.A) → m (P.B a)) :
+    Interprets handler (·.liftM handler : P.FreeM α → _) where
+  apply_pure _ := rfl
+  apply_lift_bind _ _ := rfl
+
+/--
+The universal property of the free monad `P.FreeM`.
+
+That is, `liftM handler` is the unique interpreter that extends the effect handler `handler` to
+interpret `P.FreeM` computations in a monad `m`.
+-/
+theorem Interprets.iff (handler : (a : P.A) → m (P.B a)) (eval : P.FreeM α → m α) :
+    Interprets handler eval ↔ eval = (·.liftM handler) :=
+  ⟨(·.eq), fun h => h ▸ Interprets.liftM _⟩
+
+variable [LawfulMonad m]
+
+@[simp]
+lemma liftM_bind {α β : Type uB} (x : P.FreeM α) (f : α → P.FreeM β) :
+    (x >>= f).liftM interp = (do let u ← x.liftM interp; (f u).liftM interp) := by
+  induction x with
+  | pure _ => simp only [liftM_pure, LawfulMonad.pure_bind]
+  | lift_bind a cont h =>
+    simp_rw [bind_eq_bind]
+    rw [LawfulMonad.bind_assoc, liftM_lift_bind]
+    simp_rw [liftM_lift_bind, LawfulMonad.bind_assoc]
+    congr 1
+    funext u
+    exact h u
+
+@[simp]
+lemma liftM_map {α β : Type uB} (f : α → β) (x : P.FreeM α) :
+    (f <$> x).liftM interp = f <$> x.liftM interp := by
+  simp_rw [← LawfulMonad.bind_pure_comp, liftM_bind, liftM_pure]
+
+@[simp]
+lemma liftM_seq {α β : Type uB}
+    (interp : (a : P.A) → m (P.B a)) (x : P.FreeM (α → β)) (y : P.FreeM α) :
+    (x <*> y).liftM interp = x.liftM interp <*> y.liftM interp := by
+  simp [seq_eq_bind_map]
+
+@[simp]
+lemma liftM_seqLeft {α β : Type uB}
+    (interp : (a : P.A) → m (P.B a)) (x : P.FreeM α) (y : P.FreeM β) :
+    (x <* y).liftM interp = x.liftM interp <* y.liftM interp := by
+  simp [seqLeft_eq_bind]
+
+@[simp]
+lemma liftM_seqRight {α β : Type uB}
+    (interp : (a : P.A) → m (P.B a)) (x : P.FreeM α) (y : P.FreeM β) :
+    (x *> y).liftM interp = x.liftM interp *> y.liftM interp := by
+  simp [seqRight_eq_bind]
+
+@[simp]
+lemma liftM_lift (interp : (a : P.A) → m (P.B a)) (a : P.A) :
+    (FreeM.lift a).liftM interp = interp a := by
+  simpa [bind_pure] using
+    (liftM_lift_bind (interp := interp) (a := a) (cont := pure))
+
+@[simp]
+lemma liftM_liftObj (interp : (a : P.A) → m (P.B a)) (x : P.Obj α) :
+    (FreeM.liftObj x).liftM interp = x.2 <$> interp x.1 := by
+  simp [liftObj]
+
+end liftM
+
+end FreeM
+
+end PFunctor
diff --git a/Cslib/Foundations/Data/Relation.lean b/Cslib/Foundations/Data/Relation.lean
deleted file mode 100644
index 262ccbbd8c..0000000000
--- a/Cslib/Foundations/Data/Relation.lean
+++ /dev/null
@@ -1,872 +0,0 @@
-/-
-Copyright (c) 2025 Fabrizio Montesi and Thomas Waring. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Fabrizio Montesi, Thomas Waring, Chris Henson
--/
-
-module
-
-public import Cslib.Init
-public import Mathlib.Data.List.TFAE
-public import Mathlib.Tactic.TFAE
-public import Mathlib.Order.Comparable
-public import Mathlib.Order.WellFounded
-public import Mathlib.Order.BooleanAlgebra.Basic
-public import Mathlib.Data.Fintype.EquivFin
-
-/-! # Relations
-
-## References
-
-* [*Term Rewriting and All That*][Baader1998]
-* [*Simple Laws about Nonprominent Properties of Binary Relations*][Burghardt2018]
-
--/
-
-@[expose] public section
-
-open Relator
-
-variable {α : Type*} {r r₁ r₂ : α → α → Prop}
-
-theorem WellFounded.ofTransGen (trans_wf : WellFounded (Relation.TransGen r)) : WellFounded r := by
-  grind [WellFounded.wellFounded_iff_has_min, Relation.TransGen]
-
-@[simp, grind =]
-theorem WellFounded.iff_transGen : WellFounded (Relation.TransGen r) ↔ WellFounded r :=
-  ⟨ofTransGen, transGen⟩
-
-namespace Relation
-
-/-- The empty (heterogeneous) relation, which always returns `False`. -/
-@[nolint unusedArguments]
-def emptyHRelation {α : Sort u} {β : Sort v} (_ : α) (_ : β) := False
-
-@[simp, grind =]
-theorem emptyHRelation_emptyRelation : (emptyHRelation : α → α → Prop) = emptyRelation := rfl
-
-@[simp, grind =]
-theorem emptyHrelation_apply (a : α) (b : β) : emptyHRelation a b ↔ False := .rfl
-
-section dom_cod
-
-variable {β : Type*} {r : α → β → Prop}
-
-/-- Domain of a relation. -/
-def dom (r : α → β → Prop) : Set α := {a | ∃ b, r a b}
-
-/-- Codomain of a relation, aka range. -/
-def cod (r : α → β → Prop) : Set β := {b | ∃ a, r a b}
-
-@[simp, grind =] lemma mem_dom : a ∈ dom r ↔ ∃ b, r a b := .rfl
-@[simp, grind =] lemma mem_cod : b ∈ cod r ↔ ∃ a, r a b := .rfl
-
-@[gcongr] lemma dom_mono (h : r₁ ≤ r₂) : dom r₁ ⊆ dom r₂ := fun a ⟨b, hab⟩ => ⟨b, h a b hab⟩
-@[gcongr] lemma cod_mono (h : r₁ ≤ r₂) : cod r₁ ⊆ cod r₂ := fun b ⟨a, hab⟩ => ⟨a, h a b hab⟩
-
-@[simp, grind =]
-lemma dom_empty : dom (emptyHRelation : α → β → Prop) = ∅ := by grind
-
-@[simp, grind =]
-lemma cod_empty : cod (emptyHRelation : α → β → Prop) = ∅ := by grind
-
-@[simp, grind =]
-lemma dom_eq_empty_iff : dom r = ∅ ↔ r = emptyHRelation where
-  mp h := by
-    ext a b
-    simp
-    grind => have : a ∈ dom r; finish
-  mpr := by grind
-
-@[simp, grind =]
-lemma cod_eq_empty_iff : cod r = ∅ ↔ r = emptyHRelation where
-  mp h := by
-    ext a b
-    simp
-    grind => have : b ∈ cod r; finish
-  mpr h := by grind
-
-@[simp]
-lemma cod_inv : cod (fun a b => r b a) = dom r := rfl
-
-@[simp]
-lemma dom_inv : dom (fun a b => r b a) = cod r := rfl
-
-end dom_cod
-
-instance : CoeDep (α → α → Prop) r (dom r → dom r → Prop) where
-  coe a b := r a b
-
-instance : CoeDep (α → α → Prop) r (cod r → cod r → Prop) where
-  coe a b := r a b
-
-theorem _root_.Std.Trichotomous.subsingleton_cod [Std.Trichotomous r] :
-    Subsingleton ((cod r)ᶜ : Set α) := by
-  constructor
-  rintro ⟨b₁, _⟩ ⟨b₂, _⟩
-  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ b₁ b₂
-  grind
-
-theorem _root_.Std.Trichotomous.subsingleton_dom [Std.Trichotomous r] :
-    Subsingleton ((dom r)ᶜ : Set α) := by
-  constructor
-  rintro ⟨a₁, _⟩ ⟨a₂, _⟩
-  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ a₁ a₂
-  grind
-
-attribute [scoped grind] ReflGen TransGen ReflTransGen EqvGen CompRel
-
-theorem ReflGen.to_eqvGen (h : ReflGen r a b) : EqvGen r a b := by
-  induction h <;> grind
-
-theorem TransGen.to_eqvGen (h : TransGen r a b) : EqvGen r a b := by
-  induction h <;> grind
-
-theorem ReflTransGen.to_eqvGen (h : ReflTransGen r a b) : EqvGen r a b := by
-  induction h <;> grind
-
-theorem SymmGen.to_eqvGen (h : SymmGen r a b) : EqvGen r a b := by
-  induction h <;> grind
-
-attribute [scoped grind →] ReflGen.to_eqvGen TransGen.to_eqvGen ReflTransGen.to_eqvGen
-  SymmGen.to_eqvGen
-
-/-- The join of the reflexive transitive closure. This is not named in Mathlib, but see
-  `#loogle Relation.Join (Relation.ReflTransGen ?r)` -/
-abbrev MJoin (r : α → α → Prop) := Join (ReflTransGen r)
-
-theorem MJoin.refl (a : α) : MJoin r a a := by
-  use a
-
-theorem MJoin.symm : Symmetric (MJoin r) := Relation.symmetric_join
-
-theorem MJoin.single (h : ReflTransGen r a b) : MJoin r a b := by
-  use b
-
-/-- The relation `r` 'up to' the relation `s`. -/
-def UpTo (r s : α → α → Prop) : α → α → Prop := Comp s (Comp r s)
-
-/-- A relation `r` is (right) Euclidean if `r a b` and `r a c` guarantee `r b c`. -/
-class RightEuclidean (r : α → α → Prop) where
-  rightEuclidean : r a b → r a c → r b c
-
-/-- A relation `r` is (left) Euclidean if `r a c` and `r b c` guarantee `r a b`. -/
-class LeftEuclidean (r : α → α → Prop) where
-  leftEuclidean {a b c} : r a c → r b c → r a b
-
-namespace RightEuclidean
-
-variable [RightEuclidean r]
-
-/-- A `RightEuclidean` relation is reflexive on its range -/
-theorem refl_cod (ab : r a b) : r b b := rightEuclidean ab ab
-
-theorem refl_cod' : b ∈ cod r → r b b := fun ⟨_, ab⟩ ↦ refl_cod ab
-
-/-- The converse of a `RightEuclidean` relation is `LeftEuclidean` -/
-theorem leftEuclidean_swap : LeftEuclidean (fun a b => r b a) where
-  leftEuclidean ca cb := rightEuclidean cb ca
-
-instance [Std.Refl r] : Std.Symm r where
-  symm a _ ab := rightEuclidean ab (refl a)
-
-theorem trichotomous_trans [Std.Trichotomous r] : IsTrans α r where
-  trans a b c ab bc := by
-    have := Std.Trichotomous.trichotomous (r := r) a c
-    have cc := refl_cod bc
-    have (ca : r c a) := rightEuclidean ca cc
-    grind
-
-theorem antisymm_rightUnique [Std.Antisymm r] : Relator.RightUnique r := by
-  intros a b c ab ac
-  exact antisymm (rightEuclidean ab ac) (rightEuclidean ac ab)
-
-theorem rightUnique_antisymm (h : Relator.RightUnique r) : Std.Antisymm r where
-  antisymm _ _ ab ba := h ba (refl_cod ab)
-
-theorem rightUnique_trans (h : Relator.RightUnique r) : IsTrans α r where
-  trans a b c ab bc := by
-    have eq : c = b := h bc (refl_cod ab)
-    simpa [eq]
-
-theorem rightTotal_equiv (h : Relator.RightTotal r) : IsEquiv α r := by
-  have : Std.Refl r := ⟨fun a => refl_cod (h a).choose_spec⟩
-  exact {toIsTrans := ⟨fun _ _ _ ab bc => rightEuclidean (symm ab) bc⟩}
-
-omit [RightEuclidean r] in
-theorem leftTotal_rightUnique_trans (h₁ : LeftTotal r) (h₂ : RightUnique r) [IsTrans α r] :
-    RightEuclidean r where
-  rightEuclidean {a b c} ab ac := by
-    obtain ⟨d, dc⟩ := h₁ c
-    have : b = c := h₂ ab ac
-    have : d = c := h₂ (_root_.trans ac dc) ac
-    grind
-
-private theorem three_contra [Std.Trichotomous r] [Std.Antisymm r] :
-    ¬ ∃ (a b c : α), a ≠ b ∧ a ≠ c ∧ b ≠ c := by
-  rintro ⟨a, b, c, _⟩
-  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ a b
-  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ a c
-  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ b c
-  have := antisymm_rightUnique (r := r)
-  have := @refl_cod (r := r)
-  grind [Relator.RightUnique]
-
-theorem trichotomous_antisymm_finite [Std.Trichotomous r] [Std.Antisymm r] : Finite α := by
-  classical
-  by_contra! h
-  apply three_contra (r := r)
-  have ⟨_, hcard⟩ := Infinite.exists_subset_card_eq α 3
-  have ⟨a, b, c, _, _, _, _⟩ := Finset.card_eq_three.mp hcard
-  use a, b, c
-
-theorem trichotomous_antisymm_card [Std.Trichotomous r] [Std.Antisymm r] [Fintype α] :
-    Fintype.card α ≤ 2 := by
-  by_contra! h
-  apply three_contra (r := r)
-  have ⟨a, b, c, _⟩ := Fintype.two_lt_card_iff.mp h
-  use a, b, c
-
-theorem cod_subset_dom : cod r ⊆ dom r := fun b ⟨_, ab⟩ ↦ ⟨b, refl_cod ab⟩
-
-instance : RightEuclidean (α := cod r) r where
-  rightEuclidean := rightEuclidean
-
-instance : RightEuclidean (α := dom r) r where
-  rightEuclidean := rightEuclidean
-
-theorem rightTotal_cod : Relator.RightTotal (α := cod r) (β := cod r) r :=
-  fun ⟨_, _, h⟩ => ⟨_, refl_cod h⟩
-
-theorem equiv_cod : IsEquiv (cod r) r := rightTotal_equiv rightTotal_cod
-
-end RightEuclidean
-
-namespace LeftEuclidean
-
-variable [LeftEuclidean r]
-
-/-- A `LeftEuclidean` relation is reflexive on its domain -/
-theorem refl_dom (ab : r a b) : r a a := leftEuclidean ab ab
-
-theorem refl_dom' : a ∈ dom r → r a a := fun ⟨_, ab⟩ ↦ refl_dom ab
-
-/-- The converse of a `LeftEuclidean` relation is `RightEuclidean` -/
-theorem rightEuclidean_swap : RightEuclidean (fun a b => r b a) where
-  rightEuclidean ab ac := leftEuclidean ac ab
-
-instance [Std.Refl r] : Std.Symm r where
-  symm _ b ab := leftEuclidean (refl b) ab
-
-theorem trichotomous_trans [Std.Trichotomous r] : IsTrans α r where
-  trans a b c ab bc := by
-    have := Std.Trichotomous.trichotomous (r := r) a c
-    have aa := refl_dom ab
-    have (ca : r c a) := leftEuclidean aa ca
-    grind
-
-theorem antisymm_leftUnique [Std.Antisymm r] : Relator.LeftUnique r := by
-  intros a b c ac bc
-  exact antisymm (leftEuclidean ac bc) (leftEuclidean bc ac)
-
-theorem leftUnique_antisymm (h : Relator.LeftUnique r) : Std.Antisymm r where
-  antisymm _ _ ab ba := h ab (refl_dom ba)
-
-theorem leftUnique_trans (h : Relator.LeftUnique r) : IsTrans α r where
-  trans a b c ab bc := by
-    have eq : a = b := h ab (refl_dom bc)
-    simpa [eq]
-
-theorem leftTotal_equiv (h : Relator.LeftTotal r) : IsEquiv α r := by
-  have : Std.Refl r := ⟨fun a => refl_dom (h a).choose_spec⟩
-  exact {toIsTrans := ⟨fun _ _ _ ab bc => leftEuclidean ab (symm bc)⟩}
-
-omit [LeftEuclidean r] in
-theorem rightTotal_leftUnique_trans (h₁ : RightTotal r) (h₂ : LeftUnique r) [IsTrans α r] :
-    LeftEuclidean r where
-  leftEuclidean {a b c} ac bc := by
-    obtain ⟨d, da⟩ := h₁ a
-    have : a = b := h₂ ac bc
-    have : a = d := h₂ ac (_root_.trans da ac)
-    grind
-
-private theorem three_contra [Std.Trichotomous r] [Std.Antisymm r] :
-    ¬ ∃ (a b c : α), a ≠ b ∧ a ≠ c ∧ b ≠ c := by
-  rintro ⟨a, b, c, _⟩
-  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ a b
-  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ a c
-  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ b c
-  have := antisymm_leftUnique (r := r)
-  have := @refl_dom (r := r)
-  grind [Relator.LeftUnique]
-
-theorem trichotomous_antisymm_finite [Std.Trichotomous r] [Std.Antisymm r] : Finite α := by
-  classical
-  by_contra! h
-  apply three_contra (r := r)
-  have ⟨_, hcard⟩ := Infinite.exists_subset_card_eq α 3
-  have ⟨a, b, c, _, _, _, _⟩ := Finset.card_eq_three.mp hcard
-  use a, b, c
-
-theorem trichotomous_antisymm_card [Std.Trichotomous r] [Std.Antisymm r] [Fintype α] :
-    Fintype.card α ≤ 2 := by
-  by_contra! h
-  apply three_contra (r := r)
-  have ⟨a, b, c, _⟩ := Fintype.two_lt_card_iff.mp h
-  use a, b, c
-
-theorem dom_subset_cod : dom r ⊆ cod r := fun a ⟨_, ab⟩ ↦ ⟨a, refl_dom ab⟩
-
-instance : LeftEuclidean (α := cod r) r where
-  leftEuclidean := leftEuclidean
-
-instance : LeftEuclidean (α := dom r) r where
-  leftEuclidean := leftEuclidean
-
-theorem leftTotal_dom : Relator.LeftTotal (α := dom r) (β := dom r) r :=
-  fun ⟨_, _, h⟩ => ⟨_, refl_dom h⟩
-
-theorem equiv_dom : IsEquiv (dom r) r := leftTotal_equiv leftTotal_dom
-
-end LeftEuclidean
-
-section euclidean_symm
-
-variable [Std.Symm r]
-
-open RightEuclidean LeftEuclidean in
-private theorem symm_equivalents : [RightEuclidean r, LeftEuclidean r, IsTrans α r].TFAE := by
-  tfae_have 1 → 2 := fun _ => ⟨fun ac bc => rightEuclidean (symm ac) (symm bc)⟩
-  tfae_have 2 → 3 := fun _ => ⟨fun _ _ _ ab bc => leftEuclidean ab (symm bc)⟩
-  tfae_have 3 → 1 := fun _ => ⟨fun ab ac => _root_.trans (symm ab) ac⟩
-  tfae_finish
-
-/-- For a symmetric relation, `LeftEuclidean` and `RightEuclidean` are equivalent. -/
-theorem symm_leftEuclidean_iff_rightEuclidean : LeftEuclidean r ↔ RightEuclidean r :=
-  List.TFAE.out symm_equivalents 1 0
-
-/-- For a symmetric relation, `LeftEuclidean` and transitivity are equivalent. -/
-theorem symm_leftEuclidean_iff_trans : LeftEuclidean r ↔  IsTrans α r :=
-  List.TFAE.out symm_equivalents 1 2
-
-/-- For a symmetric relation, `RightEuclidean` and transitivity are equivalent. -/
-theorem symm_rightEuclidean_iff_trans : RightEuclidean r ↔ IsTrans α r :=
-  List.TFAE.out symm_equivalents 0 2
-
-end euclidean_symm
-
-theorem leftEuclidean_rightEuclidean_dom_cod_eq [LeftEuclidean r] [RightEuclidean r] :
-    dom r = cod r := by
-  have : dom r ⊆ cod r := LeftEuclidean.dom_subset_cod
-  have : cod r ⊆ dom r := RightEuclidean.cod_subset_dom
-  grind
-
-theorem dom_cod_leftEuclidean (eq : dom r = cod r) [equiv_dom : IsEquiv (dom r) r] :
-    LeftEuclidean r where
-  leftEuclidean {a b c} ac bc := by
-    have cb : r c b := equiv_dom.symm ⟨_, _, bc⟩ ⟨c, by grind⟩ bc
-    exact equiv_dom.trans ⟨_, _, ac⟩ ⟨_, _, cb⟩ ⟨_, by grind⟩ ac cb
-
-lemma dom_cod_rightEuclidean (eq : dom r = cod r) [equiv_dom : IsEquiv (dom r) r] :
-    RightEuclidean r where
-  rightEuclidean {a b c} ab ac := by
-    have ba : r b a := equiv_dom.symm ⟨a, _, ab⟩ ⟨b, by grind⟩ ab
-    exact equiv_dom.trans ⟨_, _, ba⟩ ⟨_, _, ac⟩ ⟨c, by grind⟩ ba ac
-
-/-- A relation is both left and right Euclidean if and only if the relation is an equivalence on
-  coinciding domain and codomain. -/
-theorem leftEuclidean_rightEuclidean_iff_dom_cod :
-    LeftEuclidean r ∧ RightEuclidean r ↔ dom r = cod r ∧ IsEquiv (dom r) r where
-  mp := fun ⟨_, _⟩ ↦ ⟨leftEuclidean_rightEuclidean_dom_cod_eq, LeftEuclidean.equiv_dom⟩
-  mpr := fun ⟨eq, _⟩ ↦ ⟨dom_cod_leftEuclidean eq, dom_cod_rightEuclidean eq⟩
-
-/-- A relation has the diamond property when all reductions with a common origin are joinable -/
-abbrev Diamond (r : α → α → Prop) := ∀ {a b c : α}, r a b → r a c → Join r b c
-
-/-- A relation is confluent when its reflexive transitive closure has the diamond property. -/
-abbrev Confluent (r : α → α → Prop) := Diamond (ReflTransGen r)
-
-/-- A relation is semi-confluent when single and multiple steps with common origin
-  are multi-joinable. -/
-abbrev SemiConfluent (r : α → α → Prop) :=
-  ∀ {x y₁ y₂}, ReflTransGen r x y₂ → r x y₁ → Join (ReflTransGen r) y₁ y₂
-
-/-- A relation has the Church Rosser property when equivalence implies multi-joinability. -/
-abbrev ChurchRosser (r : α → α → Prop) := ∀ {x y}, EqvGen r x y → Join (ReflTransGen r) x y
-
-/-- Extending a multistep reduction by a single step preserves multi-joinability. -/
-lemma Diamond.extend (h : Diamond r) :
-    ReflTransGen r a b → r a c → Join (ReflTransGen r) b c := by
-  intros ab ac
-  induction ab using ReflTransGen.head_induction_on generalizing c
-  case refl => exists c, .single ac
-  case head a'_c' _ ih =>
-    obtain ⟨d, cd, c'_d⟩ := h ac a'_c'
-    obtain ⟨d', b_d', d_d'⟩ := ih c'_d
-    exact ⟨d', b_d', .head cd d_d'⟩
-
-/-- The diamond property implies confluence. -/
-theorem Diamond.toConfluent (h : Diamond r) : Confluent r := by
-  intros a b c ab bc
-  induction ab using ReflTransGen.head_induction_on generalizing c
-  case refl => exists c
-  case head _ _ a'_c' _ ih =>
-    obtain ⟨d, cd, c'_d⟩ := h.extend bc a'_c'
-    obtain ⟨d', b_d', d_d'⟩ := ih c'_d
-    exact ⟨d', b_d', .trans cd d_d'⟩
-
-theorem Confluent.toChurchRosser (h : Confluent r) : ChurchRosser r := by
-  intro x y h_eqv
-  induction h_eqv with
-  | rel _ b => exists b; grind [ReflTransGen.single]
-  | refl a => exists a
-  | symm a b _ ih => exact symmetric_join ih
-  | trans _ _ _ _ _ ih1 ih2 =>
-      obtain ⟨u, _, hbu⟩ := ih1
-      obtain ⟨v, hbv, _⟩ := ih2
-      obtain ⟨w, _, _⟩ := h hbu hbv
-      exists w
-      grind [ReflTransGen.trans]
-
-theorem SemiConfluent.toConfluent (h : SemiConfluent r) : Confluent r := by
-  intro x y1 y2 h_xy1 h_xy2
-  induction h_xy1 with
-  | refl => use y2
-  | tail h_xz h_zy1 ih =>
-      obtain ⟨u, h_zu, _⟩ := ih
-      obtain ⟨v, _, _⟩ := h h_zu h_zy1
-      exists v
-      grind [ReflTransGen.trans]
-
-attribute [scoped grind →] Confluent.toChurchRosser SemiConfluent.toConfluent
-
-private theorem confluent_equivalents : [ChurchRosser r, SemiConfluent r, Confluent r].TFAE := by
-  grind [List.tfae_cons_cons, List.tfae_singleton]
-
-theorem SemiConfluent_iff_ChurchRosser : SemiConfluent r ↔ ChurchRosser r :=
-  List.TFAE.out confluent_equivalents 1 0
-
-theorem Confluent_iff_ChurchRosser : Confluent r ↔ ChurchRosser r :=
-  List.TFAE.out confluent_equivalents 2 0
-
-theorem Confluent_iff_SemiConfluent : Confluent r ↔ SemiConfluent r :=
-  List.TFAE.out confluent_equivalents 2 1
-
-theorem Confluent_of_unique_end {x : α} (h : ∀ y : α, ReflTransGen r y x) : Confluent r := by
-  intro a b c hab hac
-  exact ⟨x, h b, h c⟩
-
-/-- An element is reducible with respect to a relation if there is a value it is related to. -/
-abbrev Reducible (r : α → α → Prop) (x : α) : Prop := ∃ y, r x y
-
-/-- A relation `r` is serial if every element is `Reducible`, i.e. `Relator.LeftTotal`. -/
-class Serial (r : α → α → Prop) where
-  serial : Relator.LeftTotal r
-
-@[scoped grind →]
-lemma refl_serial (r : α → α → Prop) (h : Std.Refl r) : Relation.Serial r where
-  serial a := ⟨a, h.refl a⟩
-
-instance [instRefl : Std.Refl r] : Relation.Serial r := refl_serial r instRefl
-
-/-- An element is normal if it is not reducible. -/
-abbrev Normal (r : α → α → Prop) (x : α) : Prop := ¬ Reducible r x
-
-theorem Normal_iff (r : α → α → Prop) (x : α) : Normal r x ↔ ∀ y, ¬ r x y := by
-  rw [Normal, not_exists]
-
-/-- An element is normalizable if it is related to a normal element. -/
-abbrev Normalizable (r : α → α → Prop) (x : α) : Prop :=
-  ∃ n, ReflTransGen r x n ∧ Normal r n
-
-/-- A relation is normalizing when every element is normalizable. -/
-abbrev Normalizing (r : α → α → Prop) : Prop :=
-  ∀ x, Normalizable r x
-
-/-- A multi-step from a normal form must be reflexive. -/
-@[grind =>]
-theorem Normal.reflTransGen_eq (h : Normal r x) (xy : ReflTransGen r x y) : x = y := by
-  induction xy <;> grind
-
-/-- For a Church-Rosser relation, elements in an equivalence class must be multi-step related. -/
-theorem ChurchRosser.normal_eqvGen_reflTransGen (cr : ChurchRosser r) (norm : Normal r x)
-    (xy : EqvGen r y x) : ReflTransGen r y x := by
-  have ⟨_, _, _⟩ := cr xy
-  grind
-
-/-- For a Church-Rosser relation there is one normal form in each equivalence class. -/
-theorem ChurchRosser.normal_eq (cr : ChurchRosser r) (nx : Normal r x) (ny : Normal r y)
-    (xy : EqvGen r x y) : x = y := by
-  have ⟨z, _, _⟩ := cr xy
-  grind
-
-/-- A pair of subrelations lifts to transitivity on the relation. -/
-@[implicit_reducible]
-def transLeftRight (s s' r : α → α → Prop) [IsTrans α r] (h : s ≤ r) (h' : s' ≤ r) :
-    Trans s s' r where
-  trans hab hbc := _root_.trans (h _ _ hab) (h' _ _ hbc)
-
-/-- A subrelation lifts to transitivity on the left of the relation. -/
-@[implicit_reducible]
-def transLeft (s r : α → α → Prop) [IsTrans α r] (h : s ≤ r) : Trans s r r where
-  trans hab hbc := _root_.trans (h _ _ hab) hbc
-
-/-- A subrelation lifts to transitivity on the right of the relation. -/
-@[implicit_reducible]
-def transRight (s r : α → α → Prop) [IsTrans α r] (h : s ≤ r) : Trans r s r where
-  trans hab hbc := _root_.trans hab (h _ _ hbc)
-
-/-- Confluence implies that multi-step joinability is an equivalence. -/
-theorem Confluent.equivalence_join_reflTransGen (h : Confluent r) :
-    Equivalence (Join (ReflTransGen r)) := by
-  apply equivalence_join
-  grind
-
-/-- An element `x` is `SN` (for strongly-normalising) for a relation `r` if it is accesible under
-the inverse of `r`. -/
-abbrev SN (r : α → α → Prop) := Acc (fun a b => r b a)
-
-set_option linter.tacticAnalysis.verifyGrindOnly false in
-lemma SN_iff_SN_of_rel (x : α) : SN r x ↔ ∀ y, r x y → SN r y := by grind only [Acc]
-
-lemma SN.intro : (h : ∀ y, r x y → SN r y) → SN r x := (SN_iff_SN_of_rel x).mpr
-
-lemma SN.of_rel (hx : SN r x) (h : r x y) : SN r y := Acc.inv hx h
-
-@[grind →]
-lemma SN.of_rel_reflTransGen (hx : SN r x) (h : ReflTransGen r x y) : SN r y := by
-  induction h with
-  | refl => exact hx
-  | tail _ h ih => exact ih.of_rel h
-
-lemma SN.transGen (hx : SN r x) : SN (TransGen r) x := by
-  have eq : TransGen (Function.swap r) = (fun a b => TransGen r b a) := by
-    ext
-    exact transGen_swap
-  simpa [eq] using Acc.transGen hx
-
-lemma SN.of_le {r' : α → α → Prop} (hx : SN r x) (h : r' ≤ r) : SN r' x := by
-  refine Subrelation.accessible ?_ hx
-  exact subrelation_iff_le.mpr fun {x y} => h y x
-
-@[simp]
-lemma SN.iff_transGen (x : α) : SN (TransGen r) x ↔ SN r x :=
-  ⟨fun hx => hx.of_le <| fun _ _ => TransGen.single, transGen⟩
-
-/-- `SN r x` is equivalent to the more elementary definition, that there is no infinite sequence
-of reductions starting with `x`. -/
-theorem SN.iff_isEmpty_chain :
-    SN r x ↔ IsEmpty {f : ℕ → α | f 0 = x ∧ ∀ n, r (f n) (f (n + 1))} :=
-  acc_iff_isEmpty_descending_chain
-
-lemma SN.onFun_of_image {r : β → β → Prop} {f : α → β} (hx : SN r (f x)) :
-    SN (Function.onFun r f) x := InvImage.accessible f hx
-
-lemma SN.of_normal (hx : Normal r x) : SN r x := SN.intro fun y hy => (hx ⟨y, hy⟩).elim
-
-/-- A relation is terminating when the inverse of its transitive closure is well-founded.
-  Note that this is also called Noetherian or strongly normalizing in the literature. -/
-abbrev Terminating (r : α → α → Prop) := WellFounded (fun a b => r b a)
-
-lemma Terminating.apply (hr : Terminating r) (x : α) : SN r x := WellFounded.apply hr x
-
-lemma Terminating.iff_forall_sn : Terminating r ↔ ∀ x, SN r x :=
-  ⟨WellFounded.apply, WellFounded.intro⟩
-
-theorem Terminating.toTransGen (ht : Terminating r) : Terminating (TransGen r) := by
-  simp_rw [iff_forall_sn, SN.iff_transGen] at ht ⊢
-  exact ht
-
-theorem Terminating.ofTransGen : Terminating (TransGen r) → Terminating r := by
-  simp_rw [iff_forall_sn, SN.iff_transGen]
-  exact id
-
-theorem Terminating.iff_transGen : Terminating (TransGen r) ↔ Terminating r := by
-  simp_rw [iff_forall_sn, SN.iff_transGen]
-
-theorem Terminating.iff_isEmpty_chain :
-    Terminating r ↔ IsEmpty {f : ℕ → α // ∀ n, r (f n) (f (n + 1))} :=
-  wellFounded_iff_isEmpty_descending_chain
-
-theorem Terminating.of_le {r' : α → α → Prop} (hr : Terminating r) (h : r' ≤ r) :
-    Terminating r' := by
-  rw [iff_forall_sn] at hr ⊢
-  exact fun x => (hr x).of_le h
-
-lemma Terminating.subtype_sn (r : α → α → Prop) :
-    Terminating (α := {x // SN r x}) (fun a b => r a b) :=
-  iff_forall_sn.mpr fun x => x.property.onFun_of_image
-
-theorem SN.isNormalizable (hx : SN r x) : Normalizable r x := by
-  -- restrict to the subtype where all elements are `SN`, so `flip r` is well-founded
-  obtain ⟨⟨y, hsn⟩, hred : ReflTransGen r x y, hnorm⟩ :=
-    (Terminating.subtype_sn r).has_min
-    (s := Subtype.val ⁻¹' ({y | ReflTransGen r x y})) ⟨⟨x, hx⟩, ReflTransGen.refl⟩
-  use y, hred
-  intro ⟨z, hyz⟩
-  exact hnorm ⟨z, hsn.of_rel hyz⟩ (.tail hred hyz) hyz
-
-theorem Terminating.isNormalizing (hr : Terminating r) : Normalizing r :=
-  fun x => (hr.apply x).isNormalizable
-
-theorem Terminating.isConfluent_iff_all_unique_Normal (ht : Terminating r) :
-    Confluent r ↔ ∀ a : α, ∃! n : α, ReflTransGen r a n ∧ Normal r n := by
-  have hn : Normalizing r := ht.isNormalizing
-  constructor
-  · intro hc a
-    apply existsUnique_of_exists_of_unique (hn a)
-    rintro n₁ n₂ ⟨hr₁, hn₁⟩ ⟨hr₂, hn₂⟩
-    have hj : Join (ReflTransGen r) n₁ n₂ := hc hr₁ hr₂
-    obtain ⟨m, h₁, h₂⟩ := hj
-    rw [Normal.reflTransGen_eq hn₁ h₁, Normal.reflTransGen_eq hn₂ h₂]
-  · intro h a b c hab hac
-    obtain ⟨na, ⟨han, hnnor⟩, H⟩ := h a
-    use na
-    obtain ⟨nb, hbnb, hnb⟩ := hn b
-    obtain ⟨nc, hcnc, hnc⟩ := hn c
-    have hanb : (ReflTransGen r) a nb := ReflTransGen.trans hab hbnb
-    have hanc : (ReflTransGen r) a nc := ReflTransGen.trans hac hcnc
-    have hnanb : nb = na := H nb ⟨hanb, hnb⟩
-    have hnanc : nc = na := H nc ⟨hanc, hnc⟩
-    rw [hnanb] at hbnb
-    rw [hnanc] at hcnc
-    exact ⟨hbnb, hcnc⟩
-
-/-- A relation is convergent when it is both confluent and terminating. -/
-abbrev Convergent (r : α → α → Prop) := Confluent r ∧ Terminating r
-
-theorem Convergent.isTerminating (h : Convergent r) : Terminating r := h.right
-
-theorem Convergent.isConfluent (h : Convergent r) : Confluent r := h.left
-
-theorem Convergent.isNormalizing (h : Convergent r) : Normalizing r := h.isTerminating.isNormalizing
-
-theorem Convergent.unique_Normal (h : Convergent r) :
-    ∀ a : α, ∃! n : α, ReflTransGen r a n ∧ Normal r n :=
-  h.isTerminating.isConfluent_iff_all_unique_Normal.mp h.isConfluent
-
-/-- A relation is locally confluent when all reductions with a common origin are multi-joinable -/
-abbrev LocallyConfluent (r : α → α → Prop) :=
-  ∀ {a b c : α}, r a b → r a c → Join (ReflTransGen r) b c
-
-theorem Confluent.toLocallyConfluent (h : Confluent r) : LocallyConfluent r := by
-  intro _ _ _ ab ac
-  exact h (.single ab) (.single ac)
-
-/-- Newman's lemma: a terminating, locally confluent relation is confluent. -/
-theorem LocallyConfluent.Terminating_toConfluent (hlc : LocallyConfluent r) (ht : Terminating r) :
-    Confluent r := by
-  intro x
-  induction x using ht.induction with
-  | h x ih =>
-    intro y z xy xz
-    cases xy.cases_head with
-    | inl => exists z; grind
-    | inr h =>
-      obtain ⟨y₁, x_y₁, y₁_y⟩ := h
-      cases xz.cases_head with
-      | inl => exists y; grind
-      | inr h =>
-        obtain ⟨z₁, x_z₁, z₁_z⟩ := h
-        have ⟨u, z₁_u, y₁_u⟩ := hlc x_z₁ x_y₁
-        have ⟨v, uv, yv⟩ : Join (ReflTransGen r) u y := by grind
-        have ⟨w, vw, zw⟩ : Join (ReflTransGen r) v z := by grind [ReflTransGen.trans]
-        exact ⟨w, .trans yv vw, zw⟩
-
-/-- A relation is strongly confluent when single steps are reflexive- and multi-joinable. -/
-abbrev StronglyConfluent (r : α → α → Prop) :=
-  ∀ {x y₁ y₂}, r x y₁ → r x y₂ → ∃ z, ReflGen r y₁ z ∧ ReflTransGen r y₂ z
-
-/-- Generalization of `Confluent` to two relations. -/
-def Commute (r₁ r₂ : α → α → Prop) := ∀ {x y₁ y₂},
-  ReflTransGen r₁ x y₁ → ReflTransGen r₂ x y₂ → ∃ z, ReflTransGen r₂ y₁ z ∧ ReflTransGen r₁ y₂ z
-
-theorem Commute.symmetric : Symmetric (@Commute α) := by
-  intro r₁ r₂ h x y₁ y₂ x_y₁ x_y₂
-  obtain ⟨_, _, _⟩ := h x_y₂ x_y₁
-  grind
-
-theorem Commute.toConfluent : Commute r r = Confluent r := rfl
-
-/-- Generalization of `StronglyConfluent` to two relations. -/
-def StronglyCommute (r₁ r₂ : α → α → Prop) :=
-  ∀ {x y₁ y₂}, r₁ x y₁ → r₂ x y₂ → ∃ z, ReflGen r₂ y₁ z ∧ ReflTransGen r₁ y₂ z
-
-theorem StronglyCommute.toStronglyConfluent : StronglyCommute r r = StronglyConfluent r := rfl
-
-/-- Generalization of `Diamond` to two relations. -/
-def DiamondCommute (r₁ r₂ : α → α → Prop) :=
-  ∀ {x y₁ y₂}, r₁ x y₁ → r₂ x y₂ → ∃ z, r₂ y₁ z ∧ r₁ y₂ z
-
-theorem DiamondCommute.toDiamond : DiamondCommute r r = Diamond r := by rfl
-
-theorem StronglyCommute.extend (h : StronglyCommute r₁ r₂) (xy : ReflTransGen r₁ x y)
-    (xz : r₂ x z) : ∃ w, ReflGen r₂ y w ∧ ReflTransGen r₁ z w := by
-  induction xy with
-  | refl => exact ⟨z, .single xz, .refl⟩
-  | @tail b c _ bc ih =>
-    obtain ⟨w, bw, zw⟩ := ih
-    cases bw with
-    | refl => exact ⟨c, .refl, zw.trans (.single bc)⟩
-    | single bw => cases h bc bw; grind [ReflTransGen.trans]
-
-theorem StronglyCommute.toCommute (h : StronglyCommute r₁ r₂) : Commute r₁ r₂ := by
-  intro x y₁ y₂ x_y₁ x_y₂
-  induction x_y₂ with
-  | refl => exists y₁
-  | @tail a b xa ab ih =>
-    obtain ⟨z, y₁_z, y₂_z⟩ := ih
-    obtain ⟨w, zw, bw⟩ := h.extend y₂_z ab
-    exact ⟨w, y₁_z.trans zw.to_reflTransGen, bw⟩
-
-theorem StronglyConfluent.toConfluent (h : StronglyConfluent r) : Confluent r :=
-  StronglyCommute.toCommute h
-
-variable {r₁ r₂ : α → α → Prop}
-
-@[scoped grind <=]
-theorem join_inl (r₁_ab : r₁ a b) : (r₁ ⊔ r₂) a b :=
-  Or.inl r₁_ab
-
-@[scoped grind <=]
-theorem join_inr (r₂_ab : r₂ a b) : (r₁ ⊔ r₂) a b :=
-  Or.inr r₂_ab
-
-@[scoped grind <=]
-theorem join_inl_reflTransGen (r₁_ab : ReflTransGen r₁ a b) : ReflTransGen (r₁ ⊔ r₂) a b := by
-  induction r₁_ab <;> grind
-
-@[scoped grind <=]
-theorem join_inr_reflTransGen (r₂_ab : ReflTransGen r₂ a b) : ReflTransGen (r₁ ⊔ r₂) a b := by
-  induction r₂_ab <;> grind
-
-lemma Commute.join_left (c₁ : Commute r₁ r₃) (c₂ : Commute r₂ r₃) : Commute (r₁ ⊔ r₂) r₃ := by
-  intro x y z xy xz
-  induction xy with
-  | refl => grind
-  | @tail b c _ bc ih =>
-    have ⟨w, bw, _⟩ := ih
-    cases bc with
-    | inl bc =>
-      obtain ⟨_, _, _⟩ := c₁ (.single bc) bw
-      grind [ReflTransGen.trans]
-    | inr bc =>
-      obtain ⟨_, _, _⟩ := c₂ (.single bc) bw
-      grind [ReflTransGen.trans]
-
-theorem Commute.join_confluent (c₁ : Confluent r₁) (c₂ : Confluent r₂) (comm : Commute r₁ r₂) :
-    Confluent (r₁ ⊔ r₂) := by
-  intro a b c ab ac
-  induction ab generalizing c with
-  | refl => exists c
-  | @tail x y ax xy ih =>
-    have h_comm : Commute (r₁ ⊔ r₂) (r₁ ⊔ r₂) := by apply_rules [join_left, symmetric]
-    obtain ⟨z, xz, cz⟩ := ih ac
-    obtain ⟨w, yw, zw⟩ := h_comm (.single xy) xz
-    exact ⟨w, yw, cz.trans zw⟩
-
-/-- If a relation is squeezed by a relation and its multi-step closure, they are multi-step equal -/
-theorem reflTransGen_mono_closed (h₁ : r₁ ≤ r₂) (h₂ : r₂ ≤ ReflTransGen r₁) :
-    ReflTransGen r₁ = ReflTransGen r₂ := by
-  ext
-  exact ⟨ReflTransGen.mono @h₁, reflTransGen_closed @h₂⟩
-
-lemma ReflGen.compRel_symm : ReflGen (SymmGen r) a b → ReflGen (SymmGen r) b a
-| .refl => .refl
-| .single (.inl h) => .single (.inr h)
-| .single (.inr h) => .single (.inl h)
-
-@[simp, grind =]
-theorem reflTransGen_compRel : ReflTransGen (SymmGen r) = EqvGen r := by
-  ext a b
-  constructor
-  · intro h
-    induction h with
-    | refl => exact .refl _
-    | tail hab hbc ih =>
-      cases hbc with
-      | inl h => exact ih.trans _ _ _ (.rel _ _ h)
-      | inr h => exact ih.trans _ _ _ (.symm _ _ (.rel _ _ h))
-  · intro h
-    induction h with
-    | rel _ _ ih => exact .single (.inl ih)
-    | refl x => exact .refl
-    | symm x y eq ih =>
-      rw [symmGen_swap]
-      exact reflTransGen_swap.mp ih
-    | trans _ _ _ _ _ ih₁ ih₂ => exact ih₁.trans ih₂
-
-/-- `Relator.RightUnique` corresponds to deterministic reductions, which are confluent, as all
-multi-reductions with a common origin start the same (this fact is
-`Relation.ReflTransGen.total_of_right_unique`.) -/
-theorem RightUnique.toConfluent (hr : Relator.RightUnique r) : Confluent r := by
-  intro a b c ab ac
-  obtain (h | h) := ReflTransGen.total_of_right_unique hr ab ac
-  · use c
-  · use b
-
-public meta section
-
-open Lean Elab Meta Command Term
-
-/--
-  This command adds notations for relations. This should not usually be called directly, but from
-  the `reduction_sys` attribute.
-
-  As an example `reduction_notation foo "β"` will add the notations "⭢β" and "↠β".
-
-  Note that the string used will afterwards be registered as a notation. This means that if you have
-  also used this as a constructor name, you will need quotes to access corresponding cases, e.g. «β»
-  in the above example.
--/
-syntax attrKind "reduction_notation" ident (str)? : command
-macro_rules
-  | `($kind:attrKind reduction_notation $rel $sym) =>
-    `(
-      @[nolint docBlame]
-      $kind:attrKind notation3 t:39 " ⭢" $sym:str t':39 => $rel t t'
-      @[nolint docBlame]
-      $kind:attrKind notation3 t:39 " ↠" $sym:str t':39 => Relation.ReflTransGen $rel t t'
-     )
-  | `($kind:attrKind reduction_notation $rel) =>
-    `(
-      @[nolint docBlame]
-      $kind:attrKind notation3 t:39 " ⭢ " t':39 => $rel t t'
-      @[nolint docBlame]
-      $kind:attrKind notation3 t:39 " ↠ " t':39 => Relation.ReflTransGen $rel t t'
-     )
-
-
-/--
-  This attribute calls the `reduction_notation` command for the annotated declaration, such as in:
-
-  ```
-  @[reduction_sys "ₙ", simp]
-  def PredReduction (a b : ℕ) : Prop := a = b + 1
-  ```
--/
-syntax (name := reductionSys) "reduction_sys" (ppSpace str)? : attr
-
-initialize Lean.registerBuiltinAttribute {
-  name := `reductionSys
-  descr := "Register notation for a relation and its closures."
-  add := fun decl stx _ => MetaM.run' do
-    let currNamespace ← getCurrNamespace
-    match stx with
-    | `(attr | reduction_sys $sym) =>
-        let mut sym := sym
-        unless sym.getString.endsWith " " do
-          sym := Syntax.mkStrLit (sym.getString ++ " ")
-        liftCommandElabM <| do
-          modifyScope ({ · with currNamespace })
-          elabCommand (← `(scoped reduction_notation $(mkIdent decl) $sym))
-    | `(attr | reduction_sys) =>
-        liftCommandElabM <| do
-          modifyScope ({ · with currNamespace })
-          elabCommand (← `(scoped reduction_notation $(mkIdent decl)))
-    | _ => throwError "invalid syntax for 'reduction_sys' attribute"
-}
-
-end
-
-end Relation
diff --git a/Cslib/Foundations/Data/Set/Saturation.lean b/Cslib/Foundations/Data/Set/Saturation.lean
index 32e9806dbf..c502ef193b 100644
--- a/Cslib/Foundations/Data/Set/Saturation.lean
+++ b/Cslib/Foundations/Data/Set/Saturation.lean
@@ -38,7 +38,7 @@ theorem saturates_compl (hs : Saturates f s) : Saturates f sᶜ := by
 theorem saturates_eq_biUnion (hs : Saturates f s) (hc : ⋃ i, f i = univ) :
     s = ⋃ i ∈ {i | (f i ∩ s).Nonempty}, f i := by
   ext x
-  simp only [mem_setOf_eq, mem_iUnion, exists_prop]
+  simp only [mem_iUnion]
   constructor
   · intro h_x
     obtain ⟨i, _⟩ := mem_iUnion.mp <| univ_subset_iff.mpr hc <| mem_univ x
diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean
index a252582b02..2cd556ecf7 100644
--- a/Cslib/Foundations/Data/StackTape.lean
+++ b/Cslib/Foundations/Data/StackTape.lean
@@ -38,7 +38,7 @@ advantages and disadvantages.
 
 @[expose] public section
 
-namespace Turing
+namespace Cslib.Turing
 
 /--
 An infinite tape representation using a list of `Option` values,
@@ -46,7 +46,7 @@ where the list is eventually `none`.
 
 Represented as a `List (Option Symbol)` that does not end with `none`.
 -/
-structure StackTape (Symbol : Type) where
+structure StackTape (Symbol : Type*) where
   /-- The underlying list representation -/
   toList : List (Option Symbol)
   /--
@@ -59,10 +59,9 @@ attribute [scoped grind! .] StackTape.toList_getLast?_ne_some_none
 
 namespace StackTape
 
-variable {Symbol : Type}
+variable {Symbol : Type*}
 
 /-- The empty `StackTape` -/
-@[scoped grind]
 def nil : StackTape Symbol := ⟨[], by grind⟩
 
 instance : Inhabited (StackTape Symbol) where
@@ -78,7 +77,6 @@ lemma empty_eq_nil : (∅ : StackTape Symbol) = nil := rfl
 lemma nil_toList : (nil : StackTape Symbol).toList = [] := rfl
 
 /-- Prepend an `Option` to the `StackTape` -/
-@[scoped grind]
 def cons (x : Option Symbol) (xs : StackTape Symbol) : StackTape Symbol :=
   match x, xs with
   | none, ⟨[], _⟩ => ⟨[], by grind⟩
@@ -86,9 +84,10 @@ def cons (x : Option Symbol) (xs : StackTape Symbol) : StackTape Symbol :=
   | some a, ⟨l, hl⟩ => ⟨some a :: l, by grind⟩
 
 @[simp, scoped grind =]
-lemma cons_none_nil_toList : (cons none (nil : StackTape Symbol)).toList = [] := by grind
+lemma cons_none_nil_toList : (cons none (nil : StackTape Symbol)).toList = [] := by
+  grind only [nil, cons]
 
-@[simp, scoped grind =]
+@[simp]
 lemma cons_some_toList (a : Symbol) (l : StackTape Symbol) :
     (cons (some a) l).toList = some a :: l.toList := by simp only [cons]
 
@@ -113,22 +112,22 @@ lemma eq_iff (l1 l2 : StackTape Symbol) :
   · intro ⟨hhead, htail⟩
     cases l1 with | mk as1 h1 =>
     cases l2 with | mk as2 h2 =>
-    cases as1 <;> cases as2 <;> grind
+    cases as1 <;> cases as2 <;> grind [nil]
 
 @[simp]
 lemma head_cons (o : Option Symbol) (l : StackTape Symbol) : (cons o l).head = o := by
   cases o with
   | none =>
     cases l with | mk toList hl =>
-    cases toList <;> grind
-  | some a => grind
+    cases toList <;> grind [cons]
+  | some a => grind [cons_some_toList]
 
 @[simp]
 lemma tail_cons (o : Option Symbol) (l : StackTape Symbol) : (cons o l).tail = l := by
   cases o with
   | none =>
     cases l with | mk toList h =>
-    cases toList <;> grind
+    cases toList <;> grind [nil, cons]
   | some a =>
     simp only [cons, tail]
 
@@ -157,16 +156,15 @@ grind_pattern length_tail_le => l.tail.length
 lemma length_cons_none (l : StackTape Symbol) :
     (cons none l).length = l.length + if l.length = 0 then 0 else 1 := by
   cases l with | mk toList h =>
-  cases toList <;> grind
+  cases toList <;> grind [cons]
 
-@[scoped grind =]
 lemma length_cons_some (a : Symbol) (l : StackTape Symbol) :
     (cons (some a) l).length = l.length + 1 := by
-  grind
+  grind [cons_some_toList]
 
 lemma length_cons_le (o : Option Symbol) (l : StackTape Symbol) :
     (cons o l).length ≤ l.length + 1 := by
-  cases o <;> grind
+  cases o <;> grind [cons_some_toList]
 
 @[simp, scoped grind =]
 lemma length_mapSome (l : List Symbol) : (mapSome l).length = l.length := by grind
@@ -178,4 +176,4 @@ end Length
 
 end StackTape
 
-end Turing
+end Cslib.Turing
diff --git a/Cslib/Foundations/Lint/Basic.lean b/Cslib/Foundations/Lint/Basic.lean
index 5eb31ac5e6..abbcc82b76 100644
--- a/Cslib/Foundations/Lint/Basic.lean
+++ b/Cslib/Foundations/Lint/Basic.lean
@@ -13,8 +13,9 @@ namespace Cslib.Lint
 
 open Lean Meta Std Batteries.Tactic.Lint
 
+-- TODO: adapt `topNamespace` to the module system
+
 /-- A linter for checking that new declarations fall under some preexisting namespace. -/
-@[env_linter]
 public meta def topNamespace : Batteries.Tactic.Lint.Linter where
   noErrorsFound := "No declarations are outside a namespace."
   errorsFound := "TOP LEVEL DECLARATIONS:"
diff --git a/Cslib/Foundations/Logic/InferenceSystem.lean b/Cslib/Foundations/Logic/InferenceSystem.lean
index 854b8deb1c..3067d3f6cd 100644
--- a/Cslib/Foundations/Logic/InferenceSystem.lean
+++ b/Cslib/Foundations/Logic/InferenceSystem.lean
@@ -8,7 +8,15 @@ module
 
 public import Cslib.Init
 
-/-! -/
+/-! # Inference systems
+
+This module defines the basic classes and notation for *inference systems* -- systems for deriving
+conclusions from premises.
+
+We intend inference systems broadly, as in theory of programming languages. In applications to
+logic, for example, we use inference systems to capture both the concepts of satisfiability and
+proof systems.
+-/
 
 @[expose] public section
 
@@ -63,6 +71,17 @@ noncomputable instance [InferenceSystem S α] {a : α} : Coe (DerivableIn S a) (
 
 @[inherit_doc] scoped notation "⇓" a:90 => InferenceSystem.derivation Default a
 
+open Lean Elab PrettyPrinter Delaborator SubExpr in
+/-- Delaborator that hides `InferenceSystem.Default` in uses of the `⇓a` notation. -/
+@[app_delab InferenceSystem.derivation]
+meta def delabInferenceSystem : Delab := do
+  let expr ← getExpr
+  if expr.getAppArgs[0]?.any (·.isConstOf `Cslib.Logic.InferenceSystem.Default) then
+    let a ← withAppArg delab
+    `(⇓ $a)
+  else
+    delabApp
+
 end InferenceSystem
 
 end Cslib.Logic
diff --git a/Cslib/Foundations/Logic/LogicalEquivalence.lean b/Cslib/Foundations/Logic/LogicalEquivalence.lean
index 7f6c0d332c..9885b50669 100644
--- a/Cslib/Foundations/Logic/LogicalEquivalence.lean
+++ b/Cslib/Foundations/Logic/LogicalEquivalence.lean
@@ -8,6 +8,7 @@ module
 
 public import Cslib.Foundations.Syntax.Context
 public import Cslib.Foundations.Syntax.Congruence
+public import Cslib.Foundations.Logic.InferenceSystem
 
 /-! Typeclass and notation for logical equivalence. -/
 
@@ -15,21 +16,15 @@ public import Cslib.Foundations.Syntax.Congruence
 
 namespace Cslib.Logic
 
-/-- A logical equivalence for a given type of `Judgement`s is a congruence on propositions that
-preserves validity of judgements under any judgemental context. -/
-class LogicalEquivalence
-    (Proposition : Type u) [HasContext Proposition]
-    (Judgement : Type v) [HasHContext Judgement Proposition]
-    (Valid : Judgement → Sort w) where
-  /-- The logical equivalence relation. -/
-  eqv (a b : Proposition) : Prop
-  /-- Proof that `eqv` is a congruence. -/
-  [congruence : Congruence Proposition eqv]
-  /-- Validity is preserved for any judgemental context. -/
-  eqvFillValid (heqv : eqv a b) (c : HasHContext.Context Judgement Proposition)
-    (h : Valid (c<[a])) : Valid (c<[b])
+open scoped InferenceSystem
 
-@[inherit_doc]
-scoped infix:29 " ≡ " => LogicalEquivalence.eqv
+/-- A logical equivalence `eqv` for an inference system `S` is a congruence on propositions (of type
+`α`) that preserves validity of judgements under any judgemental context. -/
+class LogicalEquivalence S (eqv : α → α → Prop)
+    [HasContext α] [Congruence eqv] [HasHContext Judgement α] [InferenceSystem S Judgement]
+    extends LawfulCongruence eqv where
+  /-- Validity is preserved for any judgemental context. -/
+  eqvFillValid (heqv : a ≡[eqv] b) (c : HasHContext.Context Judgement α)
+    (h : S⇓(c<[a])) : S⇓(c<[b])
 
 end Cslib.Logic
diff --git a/Cslib/Foundations/Logic/Operators.lean b/Cslib/Foundations/Logic/Operators.lean
new file mode 100644
index 0000000000..fc9f3bb2a9
--- /dev/null
+++ b/Cslib/Foundations/Logic/Operators.lean
@@ -0,0 +1,120 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi, Thomas Waring
+-/
+
+module
+
+public import Cslib.Init
+
+/-! # Logical operators
+
+This module contains typeclasses and associated notation for common logical operators: propositional
+connectives (like `∧` and `→`), modalities (like `◇`, plain and indexed), linear connectives (like
+`⊗`), etc.
+-/
+
+@[expose] public section
+
+namespace Cslib.Logic
+
+section Propositional
+
+/-! ## Propositional connectives -/
+
+/-- The type `α` has an and connective (`∧`). -/
+class HasAnd (α : Type*) where
+  /-- `a ∧ b` is the conjunction of `a` and `b`. -/
+  and (a b : α) : α
+
+@[inherit_doc] scoped infixr:36 " ∧ " => HasAnd.and
+
+/-- The type `α` has an or connective (`∨`). -/
+class HasOr (α : Type*) where
+  /-- `a ∨ b` is the disjunction of `a` and `b`. -/
+  or (a b : α) : α
+
+@[inherit_doc] scoped infixr:30 " ∨ " => HasOr.or
+
+/-- The type `α` has an implication connective (`→`). -/
+class HasImp (α : Type*) where
+  /-- `a → b` denotes `a` implies `b`. -/
+  imp (a b : α) : α
+
+@[inherit_doc] scoped infixr:25 " → " => HasImp.imp
+
+/-- The type `α` has a bi-implication connective (`↔`). -/
+class HasIff (α : Type*) where
+  /-- `a ↔ b` denotes `a` implies `b` and vice-versa. -/
+  iff (a b : α) : α
+
+@[inherit_doc] scoped infixr:20 " ↔ " => HasIff.iff
+
+/-- The type `α` has a negation connective (`¬`). -/
+class HasNot (α : Type*) where
+  /-- `¬a` is the negation of `a`. -/
+  not (a : α) : α
+
+@[inherit_doc] scoped notation:max "¬" p:40 => HasNot.not p
+
+end Propositional
+
+section Modal
+
+/-! ## Basic modalities -/
+
+/-- The type `α` has a box modality (`□`). -/
+class HasBox (α : Type*) where
+  /-- `a` is valid in all immediately reachable states. -/
+  box (a : α) : α
+
+@[inherit_doc] scoped prefix:40 "□" => HasBox.box
+
+/-- The type `α` has a diamond modality (`◇`). -/
+class HasDiamond (α : Type*) where
+  /-- `a` is valid in a reachable state. -/
+  diamond (a : α) : α
+
+@[inherit_doc] scoped prefix:40 "◇" => HasDiamond.diamond
+
+end Modal
+
+section Dynamic
+
+/-! ## Dynamic modalities
+
+Here we need to use the prefix `d` to distinguish our notation from the normal `[·]` and `⟨·⟩`.
+A refactoring that makes this unnecessary would be welcome.
+-/
+
+/-- The type `α` has a dynamic box modality with action type `β` (`d[a]φ`). -/
+class HasDynamicBox (α β : Type*) where
+  /-- `b` is necessarily valid after `a`. -/
+  dynBox (a : β) (b : α) : α
+
+@[inherit_doc] scoped notation "d[" a "]" φ => HasDynamicBox.dynBox a φ
+
+/-- The type `α` has a dynamic diamond modality with action type `β` (`d⟨a⟩φ`). -/
+class HasDynamicDiamond (α β : Type*) where
+  /-- `b` is possibly valid after `a`. -/
+  dynDiamond (a : β) (b : α) : α
+
+@[inherit_doc] scoped notation "d⟨" a "⟩" φ => HasDynamicDiamond.dynDiamond a φ
+
+end Dynamic
+
+section Linear
+
+/-! ## Linear connectives -/
+
+/-- The type `α` has a tensor connective (⊗). -/
+class HasTensor (α : Type*) where
+  /-- `a ⊗ b` is the multiplicative conjunction of `a` and `b`. -/
+  tensor (a b : α) : α
+
+@[inherit_doc] scoped infixr:35 " ⊗ " => HasTensor.tensor
+
+end Linear
+
+end Cslib.Logic
diff --git a/Cslib/Foundations/README.md b/Cslib/Foundations/README.md
new file mode 100644
index 0000000000..c99a262fd0
--- /dev/null
+++ b/Cslib/Foundations/README.md
@@ -0,0 +1,32 @@
+<pre>
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+</pre>
+
+# Foundations
+
+This directory covers **common foundations** for the rest of CSLib and downstream developments. As such, it acts as its fulcrum of integration through common concepts and APIs. This directory includes also additional results about foundational data objects defined in Mathlib, such as `Nat` and `Set`.
+
+Please browse the subdirectories for details.
+
+The foundational approach to semantics spans multiple directories and has a large role; it is explained below.
+
+## Semantics
+
+A recurring aspect that cuts across different areas is semantics. Examples of such areas include concurrency theory, computational models, logics, modelling languages, programming languages, and security protocols.
+
+Most of the APIs for semantics provided in `Foundations` are in the [Semantics](Semantics) directory. An example of an exception is the [Relation](Relation) directory, which sits at the top level.
+
+The vision is to provide common abstractions that can be reused throughout CSLib. Beyond providing reusable definitions, having common APIs for semantics is important for multiple reasons. The next list covers some illustrative examples.
+
+- The modular use of modal and dynamic logics to reason about programs.
+- The sharing of semantic metatheory, such as behavioural equivalences for labelled transition systems (bisimulation, trace equivalence, etc.) and common definitions like confluence.
+- The development of provably-correct compilers between languages based on these abstractions, supporting for example proofs of bisimilarity or full abstraction.
+- The elicitation of connections between different domains, including computability, crypto, logic, programming languages, etc.
+
+### Plans
+
+- Many modules are still missing, for example facilities for probabilistic operational semantics, derivatives and antiderivatives for transition systems, logical relations, etc. We plan to develop develop a comprehensive library.
+- We plan on building general frameworks that give important metatheoretical properties about the semantics of objects that respect certain properties (e.g., rule formats, GSOS) for free (or at least in principled ways rather than doing it from scratch).
+- We plan both on developing constructions that embed different semantic models into each other and to prove separation results between them.
+- We plan on pushing towards building formal connections between different domains based on a semantic approach.
diff --git a/Cslib/Foundations/Relation/Attr.lean b/Cslib/Foundations/Relation/Attr.lean
new file mode 100644
index 0000000000..0b2d037784
--- /dev/null
+++ b/Cslib/Foundations/Relation/Attr.lean
@@ -0,0 +1,86 @@
+/-
+Copyright (c) 2025 Fabrizio Montesi and Thomas Waring. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi, Thomas Waring, Chris Henson
+-/
+
+module
+
+public import Cslib.Init
+public import Lean.Elab.Command
+public import Mathlib.Util.Notation3
+public import Mathlib.Logic.Relation
+
+/-! # Relations: Attributes
+
+This module defines the `reduction_sys` attribute used for creating relation notations.
+
+-/
+
+public meta section
+
+namespace Relation
+
+open Lean Elab Meta Command Term
+
+/--
+  This command adds notations for relations. This should not usually be called directly, but from
+  the `reduction_sys` attribute.
+
+  As an example `reduction_notation foo "β"` will add the notations "⭢β" and "↠β".
+
+  Note that the string used will afterwards be registered as a notation. This means that if you have
+  also used this as a constructor name, you will need quotes to access corresponding cases, e.g. «β»
+  in the above example.
+-/
+syntax attrKind "reduction_notation" ident (str)? : command
+macro_rules
+  | `($kind:attrKind reduction_notation $rel $sym) =>
+    `(
+      @[nolint docBlame]
+      $kind:attrKind notation3 t:39 " ⭢" $sym:str t':39 => $rel t t'
+      @[nolint docBlame]
+      $kind:attrKind notation3 t:39 " ↠" $sym:str t':39 => Relation.ReflTransGen $rel t t'
+     )
+  | `($kind:attrKind reduction_notation $rel) =>
+    `(
+      @[nolint docBlame]
+      $kind:attrKind notation3 t:39 " ⭢ " t':39 => $rel t t'
+      @[nolint docBlame]
+      $kind:attrKind notation3 t:39 " ↠ " t':39 => Relation.ReflTransGen $rel t t'
+     )
+
+
+/--
+  This attribute calls the `reduction_notation` command for the annotated declaration, such as in:
+
+  ```
+  @[reduction_sys "ₙ", simp]
+  def PredReduction (a b : ℕ) : Prop := a = b + 1
+  ```
+-/
+syntax (name := reductionSys) "reduction_sys" (ppSpace str)? : attr
+
+initialize Lean.registerBuiltinAttribute {
+  name := `reductionSys
+  descr := "Register notation for a relation and its closures."
+  add := fun decl stx _ => MetaM.run' do
+    let currNamespace ← getCurrNamespace
+    match stx with
+    | `(attr | reduction_sys $sym) =>
+        let mut sym := sym
+        unless sym.getString.endsWith " " do
+          sym := Syntax.mkStrLit (sym.getString ++ " ")
+        liftCommandElabM <| do
+          modifyScope ({ · with currNamespace })
+          elabCommand (← `(scoped reduction_notation $(mkIdent decl) $sym))
+    | `(attr | reduction_sys) =>
+        liftCommandElabM <| do
+          modifyScope ({ · with currNamespace })
+          elabCommand (← `(scoped reduction_notation $(mkIdent decl)))
+    | _ => throwError "invalid syntax for 'reduction_sys' attribute"
+}
+
+end Relation
+
+end
diff --git a/Cslib/Foundations/Relation/Confluence.lean b/Cslib/Foundations/Relation/Confluence.lean
new file mode 100644
index 0000000000..5e9557982a
--- /dev/null
+++ b/Cslib/Foundations/Relation/Confluence.lean
@@ -0,0 +1,405 @@
+/-
+Copyright (c) 2025 Fabrizio Montesi and Thomas Waring. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi, Thomas Waring, Chris Henson
+-/
+
+module
+
+public import Cslib.Foundations.Relation.Defs
+public import Mathlib.Data.List.Pairwise
+public import Mathlib.Order.Comparable
+public import Mathlib.Order.WellFounded
+
+/-! # Relations: Confluence and Termination
+
+This module proves some properties regarding confluence and termination that are used for both
+lambda calculi and combinatory logic. Some notable theorems:
+
+* `Diamond.toConfluent`: the diamond property implies confluence
+* `LocallyConfluent.Terminating_toConfluent`: Newman's lemma
+
+## References
+
+* [*Term Rewriting and All That*][Baader1998]
+
+-/
+
+@[expose] public section
+
+variable {α : Type*} {r r₁ r₂ : α → α → Prop}
+
+theorem WellFounded.ofTransGen (trans_wf : WellFounded (Relation.TransGen r)) : WellFounded r := by
+  grind [WellFounded.wellFounded_iff_has_min, Relation.TransGen]
+
+@[simp, grind =]
+theorem WellFounded.iff_transGen : WellFounded (Relation.TransGen r) ↔ WellFounded r :=
+  ⟨ofTransGen, transGen⟩
+
+namespace Relation
+
+attribute [scoped grind] ReflGen TransGen ReflTransGen EqvGen
+
+theorem ReflGen.to_eqvGen (h : ReflGen r a b) : EqvGen r a b := by
+  induction h <;> grind
+
+theorem TransGen.to_eqvGen (h : TransGen r a b) : EqvGen r a b := by
+  induction h <;> grind
+
+theorem ReflTransGen.to_eqvGen (h : ReflTransGen r a b) : EqvGen r a b := by
+  induction h <;> grind
+
+theorem SymmGen.to_eqvGen (h : SymmGen r a b) : EqvGen r a b := by
+  induction h <;> grind
+
+attribute [scoped grind →] ReflGen.to_eqvGen TransGen.to_eqvGen ReflTransGen.to_eqvGen
+  SymmGen.to_eqvGen
+
+theorem MJoin.refl (a : α) : MJoin r a a := by
+  use a
+
+theorem MJoin.single (h : ReflTransGen r a b) : MJoin r a b := by
+  use b
+
+/-- Extending a multistep reduction by a single step preserves multi-joinability. -/
+lemma Diamond.extend (h : Diamond r) :
+    ReflTransGen r a b → r a c → Join (ReflTransGen r) b c := by
+  intros ab ac
+  induction ab using ReflTransGen.head_induction_on generalizing c
+  case refl => exists c, .single ac
+  case head a'_c' _ ih =>
+    obtain ⟨d, cd, c'_d⟩ := h ac a'_c'
+    obtain ⟨d', b_d', d_d'⟩ := ih c'_d
+    exact ⟨d', b_d', .head cd d_d'⟩
+
+/-- The diamond property implies confluence. -/
+theorem Diamond.toConfluent (h : Diamond r) : Confluent r := by
+  intros a b c ab bc
+  induction ab using ReflTransGen.head_induction_on generalizing c
+  case refl => exists c
+  case head _ _ a'_c' _ ih =>
+    obtain ⟨d, cd, c'_d⟩ := h.extend bc a'_c'
+    obtain ⟨d', b_d', d_d'⟩ := ih c'_d
+    exact ⟨d', b_d', .trans cd d_d'⟩
+
+theorem Confluent.toChurchRosser (h : Confluent r) : ChurchRosser r := by
+  intro x y h_eqv
+  induction h_eqv with
+  | rel _ b => exists b; grind [ReflTransGen.single]
+  | refl a => exists a
+  | symm a b _ ih => exact symm ih
+  | trans _ _ _ _ _ ih1 ih2 =>
+      obtain ⟨u, _, hbu⟩ := ih1
+      obtain ⟨v, hbv, _⟩ := ih2
+      obtain ⟨w, _, _⟩ := h hbu hbv
+      exists w
+      grind [ReflTransGen.trans]
+
+theorem SemiConfluent.toConfluent (h : SemiConfluent r) : Confluent r := by
+  intro x y1 y2 h_xy1 h_xy2
+  induction h_xy1 with
+  | refl => use y2
+  | tail h_xz h_zy1 ih =>
+      obtain ⟨u, h_zu, _⟩ := ih
+      obtain ⟨v, _, _⟩ := h h_zu h_zy1
+      exists v
+      grind [ReflTransGen.trans]
+
+attribute [scoped grind →] Confluent.toChurchRosser SemiConfluent.toConfluent
+
+private theorem confluent_equivalents : [ChurchRosser r, SemiConfluent r, Confluent r].TFAE := by
+  grind [List.tfae_cons_cons, List.tfae_singleton]
+
+theorem SemiConfluent_iff_ChurchRosser : SemiConfluent r ↔ ChurchRosser r :=
+  List.TFAE.out confluent_equivalents 2 1
+
+theorem Confluent_iff_ChurchRosser : Confluent r ↔ ChurchRosser r :=
+  List.TFAE.out confluent_equivalents 3 1
+
+theorem Confluent_iff_SemiConfluent : Confluent r ↔ SemiConfluent r :=
+  List.TFAE.out confluent_equivalents 3 2
+
+theorem Confluent_of_unique_end {x : α} (h : ∀ y : α, ReflTransGen r y x) : Confluent r := by
+  intro a b c hab hac
+  exact ⟨x, h b, h c⟩
+
+theorem Normal_iff (r : α → α → Prop) (x : α) : Normal r x ↔ ∀ y, ¬ r x y := by
+  rw [Normal, not_exists]
+
+/-- A multi-step from a normal form must be reflexive. -/
+@[grind =>]
+theorem Normal.reflTransGen_eq (h : Normal r x) (xy : ReflTransGen r x y) : x = y := by
+  induction xy <;> grind
+
+/-- For a Church-Rosser relation, elements in an equivalence class must be multi-step related. -/
+theorem ChurchRosser.normal_eqvGen_reflTransGen (cr : ChurchRosser r) (norm : Normal r x)
+    (xy : EqvGen r y x) : ReflTransGen r y x := by
+  have ⟨_, _, _⟩ := cr xy
+  grind
+
+/-- For a Church-Rosser relation there is one normal form in each equivalence class. -/
+theorem ChurchRosser.normal_eq (cr : ChurchRosser r) (nx : Normal r x) (ny : Normal r y)
+    (xy : EqvGen r x y) : x = y := by
+  have ⟨z, _, _⟩ := cr xy
+  grind
+
+/-- Confluence implies that multi-step joinability is an equivalence. -/
+theorem Confluent.equivalence_join_reflTransGen (h : Confluent r) :
+    Equivalence (Join (ReflTransGen r)) := by
+  apply equivalence_join
+  grind
+
+set_option linter.tacticAnalysis.verifyGrindOnly false in
+lemma SN_iff_SN_of_rel (x : α) : SN r x ↔ ∀ y, r x y → SN r y := by grind only [Acc]
+
+lemma SN.intro : (h : ∀ y, r x y → SN r y) → SN r x := (SN_iff_SN_of_rel x).mpr
+
+lemma SN.of_rel (hx : SN r x) (h : r x y) : SN r y := Acc.inv hx h
+
+@[grind →]
+lemma SN.of_rel_reflTransGen (hx : SN r x) (h : ReflTransGen r x y) : SN r y := by
+  induction h with
+  | refl => exact hx
+  | tail _ h ih => exact ih.of_rel h
+
+lemma SN.transGen (hx : SN r x) : SN (TransGen r) x := by
+  have eq : TransGen (Function.swap r) = (fun a b => TransGen r b a) := by
+    ext
+    exact transGen_swap
+  simpa [eq] using Acc.transGen hx
+
+lemma SN.of_le {r' : α → α → Prop} (hx : SN r x) (h : r' ≤ r) : SN r' x := by
+  refine Subrelation.accessible ?_ hx
+  exact subrelation_iff_le.mpr fun {x y} => h y x
+
+@[simp]
+lemma SN.iff_transGen (x : α) : SN (TransGen r) x ↔ SN r x :=
+  ⟨fun hx => hx.of_le <| fun _ _ => TransGen.single, transGen⟩
+
+/-- `SN r x` is equivalent to the more elementary definition, that there is no infinite sequence
+of reductions starting with `x`. -/
+theorem SN.iff_isEmpty_chain :
+    SN r x ↔ IsEmpty {f : ℕ → α | f 0 = x ∧ ∀ n, r (f n) (f (n + 1))} :=
+  acc_iff_isEmpty_descending_chain
+
+lemma SN.onFun_of_image {r : β → β → Prop} {f : α → β} (hx : SN r (f x)) :
+    SN (Function.onFun r f) x := InvImage.accessible f hx
+
+lemma SN.of_normal (hx : Normal r x) : SN r x := SN.intro fun y hy => (hx ⟨y, hy⟩).elim
+
+theorem SN.normalizable (hx : SN r x) : Normalizable r x := by
+  induction hx with | intro x h ih =>
+  by_cases hy: (∃ y, r x y)
+  · obtain ⟨y, hy⟩ := hy
+    obtain ⟨z, hz, hnormal⟩ := ih y hy
+    exact ⟨z, .trans (.single hy) hz, hnormal⟩
+  · exists x
+
+lemma Terminating.apply (hr : Terminating r) (x : α) : SN r x := WellFounded.apply hr x
+
+lemma Terminating.iff_forall_sn : Terminating r ↔ ∀ x, SN r x :=
+  ⟨WellFounded.apply, WellFounded.intro⟩
+
+theorem Terminating.toTransGen (ht : Terminating r) : Terminating (TransGen r) := by
+  simp_rw [iff_forall_sn, SN.iff_transGen] at ht ⊢
+  exact ht
+
+/-- A terminating relation is acyclic. -/
+theorem Terminating.toAcyclic (ht : Terminating r) : Acyclic r :=
+  ⟨fun x hx => ht.toTransGen.irrefl.irrefl x hx⟩
+
+theorem Terminating.ofTransGen : Terminating (TransGen r) → Terminating r := by
+  simp_rw [iff_forall_sn, SN.iff_transGen]
+  exact id
+
+theorem Terminating.iff_transGen : Terminating (TransGen r) ↔ Terminating r := by
+  simp_rw [iff_forall_sn, SN.iff_transGen]
+
+theorem Terminating.iff_isEmpty_chain :
+    Terminating r ↔ IsEmpty {f : ℕ → α // ∀ n, r (f n) (f (n + 1))} :=
+  wellFounded_iff_isEmpty_descending_chain
+
+theorem Terminating.of_le {r' : α → α → Prop} (hr : Terminating r) (h : r' ≤ r) :
+    Terminating r' := by
+  rw [iff_forall_sn] at hr ⊢
+  exact fun x => (hr x).of_le h
+
+lemma Terminating.subtype_sn (r : α → α → Prop) :
+    Terminating (α := {x // SN r x}) (fun a b => r a b) :=
+  iff_forall_sn.mpr fun x => x.property.onFun_of_image
+
+theorem Terminating.isNormalizing (hr : Terminating r) : Normalizing r :=
+  fun x => (hr.apply x).normalizable
+
+theorem Terminating.isConfluent_iff_all_unique_Normal (ht : Terminating r) :
+    Confluent r ↔ ∀ a : α, ∃! n : α, ReflTransGen r a n ∧ Normal r n := by
+  have hn : Normalizing r := ht.isNormalizing
+  constructor
+  · intro hc a
+    apply existsUnique_of_exists_of_unique (hn a)
+    rintro n₁ n₂ ⟨hr₁, hn₁⟩ ⟨hr₂, hn₂⟩
+    have hj : Join (ReflTransGen r) n₁ n₂ := hc hr₁ hr₂
+    obtain ⟨m, h₁, h₂⟩ := hj
+    rw [Normal.reflTransGen_eq hn₁ h₁, Normal.reflTransGen_eq hn₂ h₂]
+  · intro h a b c hab hac
+    obtain ⟨na, ⟨han, hnnor⟩, H⟩ := h a
+    use na
+    obtain ⟨nb, hbnb, hnb⟩ := hn b
+    obtain ⟨nc, hcnc, hnc⟩ := hn c
+    have hanb : (ReflTransGen r) a nb := ReflTransGen.trans hab hbnb
+    have hanc : (ReflTransGen r) a nc := ReflTransGen.trans hac hcnc
+    have hnanb : nb = na := H nb ⟨hanb, hnb⟩
+    have hnanc : nc = na := H nc ⟨hanc, hnc⟩
+    rw [hnanb] at hbnb
+    rw [hnanc] at hcnc
+    exact ⟨hbnb, hcnc⟩
+
+theorem Convergent.isTerminating (h : Convergent r) : Terminating r := h.right
+
+theorem Convergent.isConfluent (h : Convergent r) : Confluent r := h.left
+
+theorem Convergent.isNormalizing (h : Convergent r) : Normalizing r := h.isTerminating.isNormalizing
+
+theorem Convergent.unique_Normal (h : Convergent r) :
+    ∀ a : α, ∃! n : α, ReflTransGen r a n ∧ Normal r n :=
+  h.isTerminating.isConfluent_iff_all_unique_Normal.mp h.isConfluent
+
+theorem Confluent.toLocallyConfluent (h : Confluent r) : LocallyConfluent r := by
+  intro _ _ _ ab ac
+  exact h (.single ab) (.single ac)
+
+/-- Newman's lemma: a terminating, locally confluent relation is confluent. -/
+theorem LocallyConfluent.Terminating_toConfluent (hlc : LocallyConfluent r) (ht : Terminating r) :
+    Confluent r := by
+  intro x
+  induction x using ht.induction with
+  | h x ih =>
+    intro y z xy xz
+    cases xy.cases_head with
+    | inl => exists z; grind
+    | inr h =>
+      obtain ⟨y₁, x_y₁, y₁_y⟩ := h
+      cases xz.cases_head with
+      | inl => exists y; grind
+      | inr h =>
+        obtain ⟨z₁, x_z₁, z₁_z⟩ := h
+        have ⟨u, z₁_u, y₁_u⟩ := hlc x_z₁ x_y₁
+        have ⟨v, uv, yv⟩ : Join (ReflTransGen r) u y := by grind
+        have ⟨w, vw, zw⟩ : Join (ReflTransGen r) v z := by grind [ReflTransGen.trans]
+        exact ⟨w, .trans yv vw, zw⟩
+
+instance : Std.Symm (@Commute α) where
+  symm r₁ r₂ h x y₁ y₂ x_y₁ x_y₂ := by grind [h x_y₂ x_y₁]
+
+theorem Commute.toConfluent : Commute r r = Confluent r := rfl
+
+theorem StronglyCommute.toStronglyConfluent : StronglyCommute r r = StronglyConfluent r := rfl
+
+theorem DiamondCommute.toDiamond : DiamondCommute r r = Diamond r := by rfl
+
+theorem StronglyCommute.extend (h : StronglyCommute r₁ r₂) (xy : ReflTransGen r₁ x y)
+    (xz : r₂ x z) : ∃ w, ReflGen r₂ y w ∧ ReflTransGen r₁ z w := by
+  induction xy with
+  | refl => exact ⟨z, .single xz, .refl⟩
+  | @tail b c _ bc ih =>
+    obtain ⟨w, bw, zw⟩ := ih
+    cases bw with
+    | refl => exact ⟨c, .refl, zw.trans (.single bc)⟩
+    | single bw => cases h bc bw; grind [ReflTransGen.trans]
+
+theorem StronglyCommute.toCommute (h : StronglyCommute r₁ r₂) : Commute r₁ r₂ := by
+  intro x y₁ y₂ x_y₁ x_y₂
+  induction x_y₂ with
+  | refl => exists y₁
+  | @tail a b xa ab ih =>
+    obtain ⟨z, y₁_z, y₂_z⟩ := ih
+    obtain ⟨w, zw, bw⟩ := h.extend y₂_z ab
+    exact ⟨w, y₁_z.trans zw.to_reflTransGen, bw⟩
+
+theorem StronglyConfluent.toConfluent (h : StronglyConfluent r) : Confluent r :=
+  StronglyCommute.toCommute h
+
+variable {r₁ r₂ : α → α → Prop}
+
+@[scoped grind <=]
+theorem join_inl (r₁_ab : r₁ a b) : (r₁ ⊔ r₂) a b :=
+  Or.inl r₁_ab
+
+@[scoped grind <=]
+theorem join_inr (r₂_ab : r₂ a b) : (r₁ ⊔ r₂) a b :=
+  Or.inr r₂_ab
+
+@[scoped grind <=]
+theorem join_inl_reflTransGen (r₁_ab : ReflTransGen r₁ a b) : ReflTransGen (r₁ ⊔ r₂) a b := by
+  induction r₁_ab <;> grind
+
+@[scoped grind <=]
+theorem join_inr_reflTransGen (r₂_ab : ReflTransGen r₂ a b) : ReflTransGen (r₁ ⊔ r₂) a b := by
+  induction r₂_ab <;> grind
+
+lemma Commute.join_left (c₁ : Commute r₁ r₃) (c₂ : Commute r₂ r₃) : Commute (r₁ ⊔ r₂) r₃ := by
+  intro x y z xy xz
+  induction xy with
+  | refl => grind
+  | @tail b c _ bc ih =>
+    have ⟨w, bw, _⟩ := ih
+    cases bc with
+    | inl bc =>
+      obtain ⟨_, _, _⟩ := c₁ (.single bc) bw
+      grind [ReflTransGen.trans]
+    | inr bc =>
+      obtain ⟨_, _, _⟩ := c₂ (.single bc) bw
+      grind [ReflTransGen.trans]
+
+theorem Commute.join_confluent (c₁ : Confluent r₁) (c₂ : Confluent r₂) (comm : Commute r₁ r₂) :
+    Confluent (r₁ ⊔ r₂) := by
+  intro a b c ab ac
+  induction ab generalizing c with
+  | refl => exists c
+  | @tail x y ax xy ih =>
+    have h_comm : Commute (r₁ ⊔ r₂) (r₁ ⊔ r₂) := by apply_rules [join_left, symm]
+    obtain ⟨z, xz, cz⟩ := ih ac
+    obtain ⟨w, yw, zw⟩ := h_comm (.single xy) xz
+    exact ⟨w, yw, cz.trans zw⟩
+
+/-- If a relation is squeezed by a relation and its multi-step closure, they are multi-step equal -/
+theorem reflTransGen_mono_closed (h₁ : r₁ ≤ r₂) (h₂ : r₂ ≤ ReflTransGen r₁) :
+    ReflTransGen r₁ = ReflTransGen r₂ := by
+  ext a b
+  exact ⟨ReflTransGen.mono h₁ a b, reflTransGen_closed h₂ a b⟩
+
+lemma ReflGen.symmGen_symm : ReflGen (SymmGen r) a b → ReflGen (SymmGen r) b a
+| .refl => .refl
+| .single (.inl h) => .single (.inr h)
+| .single (.inr h) => .single (.inl h)
+
+@[simp, grind =]
+theorem reflTransGen_symmGen : ReflTransGen (SymmGen r) = EqvGen r := by
+  ext a b
+  constructor
+  · intro h
+    induction h with
+    | refl => exact .refl _
+    | tail hab hbc ih =>
+      cases hbc with
+      | inl h => exact ih.trans _ _ _ (.rel _ _ h)
+      | inr h => exact ih.trans _ _ _ (.symm _ _ (.rel _ _ h))
+  · intro h
+    induction h with
+    | rel _ _ ih => exact .single (.inl ih)
+    | refl x => exact .refl
+    | symm x y eq ih =>
+      rw [symmGen_swap]
+      exact reflTransGen_swap.mp ih
+    | trans _ _ _ _ _ ih₁ ih₂ => exact ih₁.trans ih₂
+
+/-- `Relator.RightUnique` corresponds to deterministic reductions, which are confluent, as all
+multi-reductions with a common origin start the same (this fact is
+`Relation.ReflTransGen.total_of_right_unique`.) -/
+theorem RightUnique.toConfluent (hr : Relator.RightUnique r) : Confluent r := by
+  intro a b c ab ac
+  obtain (h | h) := ReflTransGen.total_of_right_unique hr ab ac
+  · use c
+  · use b
+
+end Relation
diff --git a/Cslib/Foundations/Relation/Defs.lean b/Cslib/Foundations/Relation/Defs.lean
new file mode 100644
index 0000000000..4901f785dd
--- /dev/null
+++ b/Cslib/Foundations/Relation/Defs.lean
@@ -0,0 +1,161 @@
+/-
+Copyright (c) 2025 Fabrizio Montesi and Thomas Waring. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi, Thomas Waring, Chris Henson
+-/
+
+module
+
+public import Cslib.Init
+public import Mathlib.Data.Set.CoeSort
+public import Mathlib.Logic.Relation
+public import Mathlib.Order.Basic
+
+/-! # Relations: Definitions
+
+## References
+
+* [*Term Rewriting and All That*][Baader1998]
+* [*Simple Laws about Nonprominent Properties of Binary Relations*][Burghardt2018]
+
+-/
+
+@[expose] public section
+
+namespace Relation
+
+@[nolint defsWithUnderscore]
+instance (r : α → α → Prop) (s : Set α) : CoeDep (α → α → Prop) r (s → s → Prop) where
+  coe a b := r a b
+
+/-- The empty (heterogeneous) relation, which always returns `False`. -/
+@[nolint unusedArguments]
+def emptyHRelation {α : Sort u} {β : Sort v} (_ : α) (_ : β) := False
+
+/-- Domain of a relation. -/
+def dom (r : α → β → Prop) : Set α := {a | ∃ b, r a b}
+
+/-- Codomain of a relation, aka range. -/
+def cod (r : α → β → Prop) : Set β := {b | ∃ a, r a b}
+
+/-- The join of the reflexive transitive closure. This is not named in Mathlib, but see
+  `#loogle Relation.Join (Relation.ReflTransGen ?r)` -/
+abbrev MJoin (r : α → α → Prop) := Join (ReflTransGen r)
+
+/-- The relation `r` 'up to' the relation `s`. -/
+def UpTo (r s : α → α → Prop) : α → α → Prop := Comp s (Comp r s)
+
+/-- A relation `r` is (right) Euclidean if `r a b` and `r a c` guarantee `r b c`. -/
+class RightEuclidean (r : α → α → Prop) where
+  rightEuclidean : r a b → r a c → r b c
+
+/-- A relation `r` is (left) Euclidean if `r a c` and `r b c` guarantee `r a b`. -/
+class LeftEuclidean (r : α → α → Prop) where
+  leftEuclidean {a b c} : r a c → r b c → r a b
+
+/-- A relation has the diamond property when all reductions with a common origin are joinable -/
+abbrev Diamond (r : α → α → Prop) := ∀ {a b c : α}, r a b → r a c → Join r b c
+
+/-- A relation is confluent when its reflexive transitive closure has the diamond property. -/
+abbrev Confluent (r : α → α → Prop) := Diamond (ReflTransGen r)
+
+/-- A relation is semi-confluent when single and multiple steps with common origin
+  are multi-joinable. -/
+abbrev SemiConfluent (r : α → α → Prop) :=
+  ∀ {x y₁ y₂}, ReflTransGen r x y₂ → r x y₁ → Join (ReflTransGen r) y₁ y₂
+
+/-- A relation has the Church Rosser property when equivalence implies multi-joinability. -/
+abbrev ChurchRosser (r : α → α → Prop) := ∀ {x y}, EqvGen r x y → Join (ReflTransGen r) x y
+
+/-- An element is reducible with respect to a relation if there is a value it is related to. -/
+abbrev Reducible (r : α → α → Prop) (x : α) : Prop := ∃ y, r x y
+
+/-- A relation `r` is serial if every element is `Reducible`, i.e. `Relator.LeftTotal`. -/
+class Serial (r : α → α → Prop) where
+  serial : Relator.LeftTotal r
+
+/-- An element is normal if it is not reducible. -/
+abbrev Normal (r : α → α → Prop) (x : α) : Prop := ¬ Reducible r x
+
+/-- An element is normalizable if it is related to a normal element. -/
+abbrev Normalizable (r : α → α → Prop) (x : α) : Prop :=
+  ∃ n, ReflTransGen r x n ∧ Normal r n
+
+/-- A relation is normalizing when every element is normalizable. -/
+abbrev Normalizing (r : α → α → Prop) : Prop :=
+  ∀ x, Normalizable r x
+
+/-- An element `x` is `SN` (for strongly-normalising) for a relation `r` if it is accessible under
+the inverse of `r`. -/
+abbrev SN (r : α → α → Prop) := Acc (fun a b => r b a)
+
+/-- A relation is acyclic if its transitive closure is irreflexive, equivalently if it admits no
+nonempty cycle. -/
+abbrev Acyclic (r : α → α → Prop) := Std.Irrefl (TransGen r)
+
+/-- A relation is terminating when the inverse of its transitive closure is well-founded.
+  Note that this is also called Noetherian or strongly normalizing in the literature. -/
+abbrev Terminating (r : α → α → Prop) := WellFounded (fun a b => r b a)
+
+/-- A relation is convergent when it is both confluent and terminating. -/
+abbrev Convergent (r : α → α → Prop) := Confluent r ∧ Terminating r
+
+/-- A relation is locally confluent when all reductions with a common origin are multi-joinable -/
+abbrev LocallyConfluent (r : α → α → Prop) :=
+  ∀ {a b c : α}, r a b → r a c → Join (ReflTransGen r) b c
+
+/-- A relation is strongly confluent when single steps are reflexive- and multi-joinable. -/
+abbrev StronglyConfluent (r : α → α → Prop) :=
+  ∀ {x y₁ y₂}, r x y₁ → r x y₂ → ∃ z, ReflGen r y₁ z ∧ ReflTransGen r y₂ z
+
+/-- Generalization of `Confluent` to two relations. -/
+def Commute (r₁ r₂ : α → α → Prop) := ∀ {x y₁ y₂},
+  ReflTransGen r₁ x y₁ → ReflTransGen r₂ x y₂ → ∃ z, ReflTransGen r₂ y₁ z ∧ ReflTransGen r₁ y₂ z
+
+/-- Generalization of `StronglyConfluent` to two relations. -/
+def StronglyCommute (r₁ r₂ : α → α → Prop) :=
+  ∀ {x y₁ y₂}, r₁ x y₁ → r₂ x y₂ → ∃ z, ReflGen r₂ y₁ z ∧ ReflTransGen r₁ y₂ z
+
+/-- Generalization of `Diamond` to two relations. -/
+def DiamondCommute (r₁ r₂ : α → α → Prop) :=
+  ∀ {x y₁ y₂}, r₁ x y₁ → r₂ x y₂ → ∃ z, r₂ y₁ z ∧ r₁ y₂ z
+
+/-- A pair of subrelations lifts to transitivity on the relation. -/
+@[implicit_reducible]
+def transLeftRight (s s' r : α → α → Prop) [IsTrans α r] (h : s ≤ r) (h' : s' ≤ r) :
+    Trans s s' r where
+  trans hab hbc := _root_.trans (h _ _ hab) (h' _ _ hbc)
+
+/-- A subrelation lifts to transitivity on the left of the relation. -/
+@[implicit_reducible]
+def transLeft (s r : α → α → Prop) [IsTrans α r] (h : s ≤ r) : Trans s r r where
+  trans hab hbc := _root_.trans (h _ _ hab) hbc
+
+/-- A subrelation lifts to transitivity on the right of the relation. -/
+@[implicit_reducible]
+def transRight (s r : α → α → Prop) [IsTrans α r] (h : s ≤ r) : Trans r s r where
+  trans hab hbc := _root_.trans hab (h _ _ hbc)
+
+end Relation
+
+namespace Set
+
+open Relation
+
+/-- `ReflOn s r` is true when a relation `r` is reflexive on its restriction to a set `s`. -/
+def ReflOn (s : Set α) (r : α → α → Prop) : Prop :=
+  ∀ a ∈ s, r a a
+
+-- these names are used in the literature, so we provide them as `abbrev`
+
+/-- `LeftQuasiRefl r` is true when a relation `r` is reflexive on its domain. -/
+abbrev LeftQuasiRefl (r : α → α → Prop) := (dom r).ReflOn r
+
+/-- `RightQuasiRefl r` is true when a relation `r` is reflexive on its codomain. -/
+abbrev RightQuasiRefl (r : α → α → Prop) := (cod r).ReflOn r
+
+/-- `SymmOn s r` is true when a relation `r` is symmetric on its restriction to a set `s`. -/
+def SymmOn (s : Set α) (r : α → α → Prop) : Prop :=
+  ∀ a ∈ s, ∀ b ∈ s, r a b → r b a
+
+end Set
diff --git a/Cslib/Foundations/Relation/Domain.lean b/Cslib/Foundations/Relation/Domain.lean
new file mode 100644
index 0000000000..c4976f1a6f
--- /dev/null
+++ b/Cslib/Foundations/Relation/Domain.lean
@@ -0,0 +1,85 @@
+/-
+Copyright (c) 2025 Fabrizio Montesi and Thomas Waring. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi, Thomas Waring, Chris Henson
+-/
+
+module
+
+public import Cslib.Foundations.Relation.Defs
+public import Mathlib.Data.Set.Basic
+
+/-! # Relations: Domain and Codomain
+
+This module proves basic properties of the domain and codomain of relations.
+
+## References
+
+* [*Simple Laws about Nonprominent Properties of Binary Relations*][Burghardt2018]
+
+-/
+
+@[expose] public section
+
+namespace Relation
+
+@[simp, grind =]
+theorem emptyHRelation_emptyRelation : (emptyHRelation : α → α → Prop) = emptyRelation := rfl
+
+@[simp, grind =]
+theorem emptyHrelation_apply (a : α) (b : β) : emptyHRelation a b ↔ False := .rfl
+
+variable {β : Type*} {r : α → β → Prop}
+
+@[simp, grind =] lemma mem_dom : a ∈ dom r ↔ ∃ b, r a b := .rfl
+@[simp, grind =] lemma mem_cod : b ∈ cod r ↔ ∃ a, r a b := .rfl
+
+theorem of_dom (hab : r a b) : a ∈ dom r := by grind
+theorem of_cod (hab : r a b) : b ∈ cod r := by grind
+
+@[gcongr] lemma dom_mono (h : r₁ ≤ r₂) : dom r₁ ⊆ dom r₂ := fun a ⟨b, hab⟩ => ⟨b, h a b hab⟩
+@[gcongr] lemma cod_mono (h : r₁ ≤ r₂) : cod r₁ ⊆ cod r₂ := fun b ⟨a, hab⟩ => ⟨a, h a b hab⟩
+
+@[simp, grind =]
+lemma dom_empty : dom (emptyHRelation : α → β → Prop) = ∅ := by grind
+
+@[simp, grind =]
+lemma cod_empty : cod (emptyHRelation : α → β → Prop) = ∅ := by grind
+
+@[simp, grind =]
+lemma dom_eq_empty_iff : dom r = ∅ ↔ r = emptyHRelation where
+  mp h := by
+    ext a b
+    simp
+    grind => have : a ∈ dom r; finish
+  mpr := by grind
+
+@[simp, grind =]
+lemma cod_eq_empty_iff : cod r = ∅ ↔ r = emptyHRelation where
+  mp h := by
+    ext a b
+    simp
+    grind => have : b ∈ cod r; finish
+  mpr h := by grind
+
+@[simp]
+lemma cod_inv : cod (fun a b => r b a) = dom r := rfl
+
+@[simp]
+lemma dom_inv : dom (fun a b => r b a) = cod r := rfl
+
+theorem _root_.Std.Trichotomous.subsingleton_cod (r : α → α → Prop) [Std.Trichotomous r] :
+    Subsingleton ((cod r)ᶜ : Set α) := by
+  constructor
+  rintro ⟨b₁, _⟩ ⟨b₂, _⟩
+  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ b₁ b₂
+  grind
+
+theorem _root_.Std.Trichotomous.subsingleton_dom (r : α → α → Prop) [Std.Trichotomous r] :
+    Subsingleton ((dom r)ᶜ : Set α) := by
+  constructor
+  rintro ⟨a₁, _⟩ ⟨a₂, _⟩
+  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ a₁ a₂
+  grind
+
+end Relation
diff --git a/Cslib/Foundations/Relation/Euclidean.lean b/Cslib/Foundations/Relation/Euclidean.lean
new file mode 100644
index 0000000000..10b6f46377
--- /dev/null
+++ b/Cslib/Foundations/Relation/Euclidean.lean
@@ -0,0 +1,258 @@
+/-
+Copyright (c) 2025 Fabrizio Montesi and Thomas Waring. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi, Thomas Waring, Chris Henson
+-/
+
+module
+
+public import Cslib.Foundations.Relation.Restriction
+public import Mathlib.Data.Fintype.EquivFin
+public import Mathlib.Tactic.TFAE
+
+/-! # Relations: Euclidean Relations
+
+This module proves basic properties about left and right Euclidean relations, which are use
+in modal logic.
+
+TODO: develop an attribute to dualize theorems to the converse of a relation
+
+## References
+
+* [*Simple Laws about Nonprominent Properties of Binary Relations*][Burghardt2018]
+
+-/
+
+@[expose] public section
+
+open Relator
+
+namespace Relation
+
+variable {α : Type*} {r : α → α → Prop}
+
+instance [RightEuclidean r] (s : Set α) : RightEuclidean (α := s) r :=
+  ⟨RightEuclidean.rightEuclidean⟩
+
+instance [LeftEuclidean r] (s : Set α) : LeftEuclidean (α := s) r :=
+  ⟨LeftEuclidean.leftEuclidean⟩
+
+@[scoped grind →]
+lemma refl_serial (r : α → α → Prop) (h : Std.Refl r) : Serial r where
+  serial a := ⟨a, h.refl a⟩
+
+instance [instRefl : Std.Refl r] : Serial r := refl_serial r instRefl
+
+namespace RightEuclidean
+
+variable [RightEuclidean r]
+
+/-- A `RightEuclidean` relation is reflexive on its codomain -/
+theorem reflOn_cod : (cod r).ReflOn r := fun _ ⟨_, ab⟩ ↦ rightEuclidean ab ab
+
+/-- The converse of a `RightEuclidean` relation is `LeftEuclidean` -/
+theorem leftEuclidean_swap : LeftEuclidean (fun a b => r b a) where
+  leftEuclidean ca cb := rightEuclidean cb ca
+
+instance [Std.Refl r] : Std.Symm r where
+  symm a _ ab := rightEuclidean ab (refl a)
+
+theorem trichotomous_trans [Std.Trichotomous r] : IsTrans α r where
+  trans a b c ab bc := by
+    have := Std.Trichotomous.trichotomous (r := r) a c
+    have cc := reflOn_cod.of_cod bc
+    have (ca : r c a) := rightEuclidean ca cc
+    grind
+
+theorem antisymm_rightUnique [Std.Antisymm r] : Relator.RightUnique r := by
+  intros a b c ab ac
+  exact antisymm (rightEuclidean ab ac) (rightEuclidean ac ab)
+
+theorem rightUnique_antisymm (h : Relator.RightUnique r) : Std.Antisymm r where
+  antisymm _ _ ab ba := h ba (reflOn_cod.of_cod ab)
+
+theorem rightUnique_trans (h : Relator.RightUnique r) : IsTrans α r where
+  trans a b c ab bc := by
+    have eq : c = b := h bc (reflOn_cod.of_cod ab)
+    simpa [eq]
+
+theorem rightTotal_equiv (h : Relator.RightTotal r) : IsEquiv α r := by
+  have : Std.Refl r := ⟨fun a => reflOn_cod.of_cod (h a).choose_spec⟩
+  exact {toIsTrans := ⟨fun _ _ _ ab bc => rightEuclidean (symm ab) bc⟩}
+
+omit [RightEuclidean r] in
+theorem leftTotal_rightUnique_trans (h₁ : LeftTotal r) (h₂ : RightUnique r) [IsTrans α r] :
+    RightEuclidean r where
+  rightEuclidean {a b c} ab ac := by
+    obtain ⟨d, dc⟩ := h₁ c
+    have : b = c := h₂ ab ac
+    have : d = c := h₂ (_root_.trans ac dc) ac
+    grind
+
+private theorem three_contra [Std.Trichotomous r] [Std.Antisymm r] :
+    ¬ ∃ (a b c : α), a ≠ b ∧ a ≠ c ∧ b ≠ c := by
+  rintro ⟨a, b, c, _⟩
+  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ a b
+  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ a c
+  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ b c
+  have := antisymm_rightUnique (r := r)
+  have := @reflOn_cod (r := r)
+  simp [Set.ReflOn] at this
+  grind [Relator.RightUnique]
+
+theorem trichotomous_antisymm_finite [Std.Trichotomous r] [Std.Antisymm r] : Finite α := by
+  classical
+  by_contra! h
+  apply three_contra (r := r)
+  have ⟨_, hcard⟩ := Infinite.exists_subset_card_eq α 3
+  have ⟨a, b, c, _, _, _, _⟩ := Finset.card_eq_three.mp hcard
+  use a, b, c
+
+theorem trichotomous_antisymm_card [Std.Trichotomous r] [Std.Antisymm r] [Fintype α] :
+    Fintype.card α ≤ 2 := by
+  by_contra! h
+  apply three_contra (r := r)
+  have ⟨a, b, c, _⟩ := Fintype.two_lt_card_iff.mp h
+  use a, b, c
+
+theorem cod_subset_dom : cod r ⊆ dom r := fun _ ⟨_, ab⟩ ↦ of_cod (reflOn_cod.of_cod ab)
+
+theorem rightTotal_cod : Relator.RightTotal (α := cod r) (β := cod r) r :=
+  fun ⟨_, _, h⟩ => of_cod (reflOn_cod.of_cod h)
+
+theorem equiv_cod : IsEquiv (cod r) r := rightTotal_equiv rightTotal_cod
+
+end RightEuclidean
+
+namespace LeftEuclidean
+
+variable [LeftEuclidean r]
+
+/-- A `LeftEuclidean` relation is reflexive on its domain -/
+theorem reflOn_dom : (dom r).ReflOn r := fun _ ⟨_, ab⟩ ↦ leftEuclidean ab ab
+
+/-- The converse of a `LeftEuclidean` relation is `RightEuclidean` -/
+theorem rightEuclidean_swap : RightEuclidean (fun a b => r b a) where
+  rightEuclidean ab ac := leftEuclidean ac ab
+
+instance [Std.Refl r] : Std.Symm r where
+  symm _ b ab := leftEuclidean (refl b) ab
+
+theorem trichotomous_trans [Std.Trichotomous r] : IsTrans α r where
+  trans a b c ab bc := by
+    have := Std.Trichotomous.trichotomous (r := r) a c
+    have aa := reflOn_dom.of_dom ab
+    have (ca : r c a) := leftEuclidean aa ca
+    grind
+
+theorem antisymm_leftUnique [Std.Antisymm r] : Relator.LeftUnique r := by
+  intros a b c ac bc
+  exact antisymm (leftEuclidean ac bc) (leftEuclidean bc ac)
+
+theorem leftUnique_antisymm (h : Relator.LeftUnique r) : Std.Antisymm r where
+  antisymm _ _ ab ba := h ab (reflOn_dom.of_dom ba)
+
+theorem leftUnique_trans (h : Relator.LeftUnique r) : IsTrans α r where
+  trans a b c ab bc := by
+    have eq : a = b := h ab (reflOn_dom.of_dom bc)
+    simpa [eq]
+
+theorem leftTotal_equiv (h : Relator.LeftTotal r) : IsEquiv α r := by
+  have : Std.Refl r := ⟨fun a => reflOn_dom.of_dom (h a).choose_spec⟩
+  exact {toIsTrans := ⟨fun _ _ _ ab bc => leftEuclidean ab (symm bc)⟩}
+
+omit [LeftEuclidean r] in
+theorem rightTotal_leftUnique_trans (h₁ : RightTotal r) (h₂ : LeftUnique r) [IsTrans α r] :
+    LeftEuclidean r where
+  leftEuclidean {a b c} ac bc := by
+    obtain ⟨d, da⟩ := h₁ a
+    have : a = b := h₂ ac bc
+    have : a = d := h₂ ac (_root_.trans da ac)
+    grind
+
+private theorem three_contra [Std.Trichotomous r] [Std.Antisymm r] :
+    ¬ ∃ (a b c : α), a ≠ b ∧ a ≠ c ∧ b ≠ c := by
+  rintro ⟨a, b, c, _⟩
+  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ a b
+  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ a c
+  have := @Std.Trichotomous.rel_or_eq_or_rel_swap _ r _ b c
+  have := antisymm_leftUnique (r := r)
+  have := @reflOn_dom (r := r)
+  simp [Set.ReflOn] at this
+  grind [Relator.LeftUnique]
+
+theorem trichotomous_antisymm_finite [Std.Trichotomous r] [Std.Antisymm r] : Finite α := by
+  classical
+  by_contra! h
+  apply three_contra (r := r)
+  have ⟨_, hcard⟩ := Infinite.exists_subset_card_eq α 3
+  have ⟨a, b, c, _, _, _, _⟩ := Finset.card_eq_three.mp hcard
+  use a, b, c
+
+theorem trichotomous_antisymm_card [Std.Trichotomous r] [Std.Antisymm r] [Fintype α] :
+    Fintype.card α ≤ 2 := by
+  by_contra! h
+  apply three_contra (r := r)
+  have ⟨a, b, c, _⟩ := Fintype.two_lt_card_iff.mp h
+  use a, b, c
+
+theorem dom_subset_cod : dom r ⊆ cod r := fun _ ⟨_, ab⟩ ↦ of_dom (reflOn_dom.of_dom ab)
+
+theorem leftTotal_dom : Relator.LeftTotal (α := dom r) (β := dom r) r :=
+  fun ⟨a, _, h⟩ => ⟨⟨a, of_dom h⟩, reflOn_dom.of_dom h⟩
+
+theorem equiv_dom : IsEquiv (dom r) r := leftTotal_equiv leftTotal_dom
+
+end LeftEuclidean
+
+section euclidean_symm
+
+variable [Std.Symm r]
+
+open RightEuclidean LeftEuclidean in
+private theorem symm_equivalents : [RightEuclidean r, LeftEuclidean r, IsTrans α r].TFAE := by
+  tfae_have 1 → 2 := fun _ => ⟨fun ac bc => rightEuclidean (symm ac) (symm bc)⟩
+  tfae_have 2 → 3 := fun _ => ⟨fun _ _ _ ab bc => leftEuclidean ab (symm bc)⟩
+  tfae_have 3 → 1 := fun _ => ⟨fun ab ac => _root_.trans (symm ab) ac⟩
+  tfae_finish
+
+/-- For a symmetric relation, `LeftEuclidean` and `RightEuclidean` are equivalent. -/
+theorem symm_leftEuclidean_iff_rightEuclidean : LeftEuclidean r ↔ RightEuclidean r :=
+  List.TFAE.out symm_equivalents 2 1
+
+/-- For a symmetric relation, `LeftEuclidean` and transitivity are equivalent. -/
+theorem symm_leftEuclidean_iff_trans : LeftEuclidean r ↔  IsTrans α r :=
+  List.TFAE.out symm_equivalents 2 3
+
+/-- For a symmetric relation, `RightEuclidean` and transitivity are equivalent. -/
+theorem symm_rightEuclidean_iff_trans : RightEuclidean r ↔ IsTrans α r :=
+  List.TFAE.out symm_equivalents 1 3
+
+end euclidean_symm
+
+theorem leftEuclidean_rightEuclidean_dom_cod_eq [LeftEuclidean r] [RightEuclidean r] :
+    dom r = cod r := by
+  have : dom r ⊆ cod r := LeftEuclidean.dom_subset_cod
+  have : cod r ⊆ dom r := RightEuclidean.cod_subset_dom
+  grind
+
+theorem dom_cod_leftEuclidean (eq : dom r = cod r) [equiv_dom : IsEquiv (dom r) r] :
+    LeftEuclidean r where
+  leftEuclidean {a b c} ac bc := by
+    have cb : r c b := equiv_dom.symm ⟨_, _, bc⟩ ⟨c, by grind⟩ bc
+    exact equiv_dom.trans ⟨_, _, ac⟩ ⟨_, _, cb⟩ ⟨_, by grind⟩ ac cb
+
+lemma dom_cod_rightEuclidean (eq : dom r = cod r) [equiv_dom : IsEquiv (dom r) r] :
+    RightEuclidean r where
+  rightEuclidean {a b c} ab ac := by
+    have ba : r b a := equiv_dom.symm ⟨a, _, ab⟩ ⟨b, by grind⟩ ab
+    exact equiv_dom.trans ⟨_, _, ba⟩ ⟨_, _, ac⟩ ⟨c, by grind⟩ ba ac
+
+/-- A relation is both left and right Euclidean if and only if the relation is an equivalence on
+  coinciding domain and codomain. -/
+theorem leftEuclidean_rightEuclidean_iff_dom_cod :
+    LeftEuclidean r ∧ RightEuclidean r ↔ dom r = cod r ∧ IsEquiv (dom r) r where
+  mp := fun ⟨_, _⟩ ↦ ⟨leftEuclidean_rightEuclidean_dom_cod_eq, LeftEuclidean.equiv_dom⟩
+  mpr := fun ⟨eq, _⟩ ↦ ⟨dom_cod_leftEuclidean eq, dom_cod_rightEuclidean eq⟩
+
+end Relation
diff --git a/Cslib/Foundations/Relation/Restriction.lean b/Cslib/Foundations/Relation/Restriction.lean
new file mode 100644
index 0000000000..9de7da6d56
--- /dev/null
+++ b/Cslib/Foundations/Relation/Restriction.lean
@@ -0,0 +1,54 @@
+/-
+Copyright (c) 2026 Chris Henson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Henson
+-/
+
+module
+
+public import Cslib.Foundations.Relation.Defs
+public import Cslib.Foundations.Relation.Domain
+
+/-! # Relations: Properties on set restrictions
+
+## References
+
+* [*Simple Laws about Nonprominent Properties of Binary Relations*][Burghardt2018]
+
+-/
+
+@[expose] public section
+
+open Relation
+
+namespace Set
+
+variable (r : α → α → Prop) (s : Set α)
+
+@[simp, grind .]
+theorem refl_iff_reflOn : Std.Refl (α := s) r ↔ s.ReflOn r := by
+  constructor
+  · exact fun ⟨h⟩ a ha ↦ h ⟨a, ha⟩
+  · exact fun h ↦ ⟨fun ⟨a, ha⟩ ↦ h a ha⟩
+
+@[simp, grind .]
+theorem symm_iff_symmOn : Std.Symm (α := s) r ↔ s.SymmOn r := by
+  constructor
+  · exact fun ⟨h⟩ a ha b hb ab ↦ h ⟨a, ha⟩ ⟨b, hb⟩ ab
+  · exact fun h ↦ ⟨fun ⟨a, ha⟩ ⟨b, hb⟩ ab ↦ h a ha b hb ab⟩
+
+-- for special cases of (co)domain, we provide constructive shortcut lemmas
+
+theorem ReflOn.of_dom {r} : (dom r).ReflOn r → r a b → r a a
+| h, hab => h a (Relation.of_dom hab)
+
+theorem ReflOn.of_cod {r} : (cod r).ReflOn r → r a b → r b b
+| h, hab => h b (Relation.of_cod hab)
+
+theorem SymmOn.of_dom {r} : (dom r).SymmOn r → r a b → r b c → r b a
+| h, hab, hbc => h a (Relation.of_dom hab) b (Relation.of_dom hbc) hab
+
+theorem SymmOn.of_cod {r} : (cod r).SymmOn r → r a b → r c a → r b a
+| h, hab, hca => h a (Relation.of_cod hca) b (Relation.of_cod hab) hab
+
+end Set
diff --git a/Cslib/Foundations/Semantics/LTS/Basic.lean b/Cslib/Foundations/Semantics/LTS/Basic.lean
index 0f56865026..2c29aebd7e 100644
--- a/Cslib/Foundations/Semantics/LTS/Basic.lean
+++ b/Cslib/Foundations/Semantics/LTS/Basic.lean
@@ -6,7 +6,7 @@ Authors: Fabrizio Montesi
 
 module
 
-public import Cslib.Init
+public import Cslib.Foundations.Relation.Defs
 public import Mathlib.Data.Set.Finite.Basic
 public import Mathlib.Order.SetNotation
 
@@ -25,8 +25,12 @@ relation `Tr` between states. We follow the style and conventions in [Sangiorgi2
 - `LTS.MTr` extends the transition relation of any LTS to a multistep transition relation,
 formalising the inference system and admissible rules for such relations in [Montesi2023].
 
+- `LTS.BoundedUpTo` records an explicit global execution-length bound. `LTS.Bounded`,
+`LTS.Terminating`, and `LTS.Acyclic` distinguish globally bounded execution length, absence of
+infinite executions, and absence of nonempty cycles.
+
 - Definitions for all the common classes of LTSs: image-finite, finitely branching, finite-state,
-finite, and deterministic.
+and deterministic.
 
 ## Main statements
 
@@ -56,12 +60,17 @@ universe u v
 A Labelled Transition System (LTS) for a type of states (`State`) and a type of transition
 labels (`Label`) consists of a labelled transition relation (`Tr`).
 -/
+@[ext]
 structure LTS (State : Type u) (Label : Type v) where
   /-- The transition relation. -/
   Tr : State → Label → State → Prop
 
 namespace LTS
 
+/-- The unlabelled transition relation underlying an LTS. -/
+def UnlabelledTr (lts : LTS State Label) : State → State → Prop :=
+  fun s1 s2 => ∃ μ, lts.Tr s1 μ s2
+
 section MultiStep
 
 /-! ## Multistep transitions and executions with finite traces
@@ -78,13 +87,22 @@ Definition of a multistep transition.
 rule. This makes working with lists of labels more convenient, because we follow the same
 construction. It is also similar to what is done in the `SimpleGraph` library in mathlib.)
 -/
-@[scoped grind]
+@[scoped grind, mk_iff]
 inductive MTr (lts : LTS State Label) : State → List Label → State → Prop where
   | refl {s : State} : lts.MTr s [] s
   | stepL {s1 : State} {μ : Label} {s2 : State} {μs : List Label} {s3 : State} :
     lts.Tr s1 μ s2 → lts.MTr s2 μs s3 →
     lts.MTr s1 (μ :: μs) s3
 
+/-- In any zero-steps multistep transition, the origin and the derivative are the same. -/
+@[scoped grind .]
+theorem MTr.nil_eq (h : lts.MTr s1 [] s2) : s1 = s2 := by
+  cases h
+  rfl
+
+@[simp] theorem MTr.nil_iff (s1 s2 : State) : lts.MTr s1 [] s2 ↔ s1 = s2 :=
+  ⟨nil_eq lts, fun h => h ▸ MTr.refl⟩
+
 /-- Any transition is also a multistep transition. -/
 @[scoped grind →]
 theorem MTr.single {s1 : State} {μ : Label} {s2 : State} :
@@ -94,6 +112,16 @@ theorem MTr.single {s1 : State} {μ : Label} {s2 : State} :
   · exact h
   · apply MTr.refl
 
+/-- A multistep transition along `μ :: μs` is a transition labelled by `μ` plus a multistep
+transition labelled by `μs`. -/
+theorem MTr.cons_iff {lts : LTS State Label} :
+    lts.MTr s1 (μ :: μs) s2 ↔ ∃ s, lts.Tr s1 μ s ∧ lts.MTr s μs s2 := by
+  constructor
+  · rintro (_ | ⟨htr, hmtr⟩)
+    exact ⟨_, htr, hmtr⟩
+  · intro ⟨s, htr, hmtr⟩
+    exact .stepL htr hmtr
+
 /-- Any multistep transition can be extended by adding a transition. -/
 theorem MTr.stepR {s1 : State} {μs : List Label} {s2 : State} {μ : Label} {s3 : State} :
   lts.MTr s1 μs s2 → lts.Tr s2 μ s3 → lts.MTr s1 (μs ++ [μ]) s3 := by
@@ -128,11 +156,44 @@ theorem MTr.single_invert (s1 : State) (μ : Label) (s2 : State) :
     cases hmtr
     exact htr
 
-/-- In any zero-steps multistep transition, the origin and the derivative are the same. -/
-@[scoped grind .]
-theorem MTr.nil_eq (h : lts.MTr s1 [] s2) : s1 = s2 := by
-  cases h
-  rfl
+/-- A 1-sized multistep transition is exactly a single transition with the given label. -/
+@[simp] theorem MTr.singleton_iff (s1 : State) (μ : Label) (s2 : State) :
+  lts.MTr s1 [μ] s2 ↔ lts.Tr s1 μ s2 := ⟨MTr.single_invert lts s1 μ s2, MTr.single lts⟩
+
+/-- A multistep transition over a concatenation can be split into two multistep transitions. -/
+theorem MTr.split {lts : LTS State Label} (h : lts.MTr s1 (μs ++ μs') s2) :
+    ∃ s, lts.MTr s1 μs s ∧ lts.MTr s μs' s2 := by
+  induction μs generalizing s1 s2 with
+  | nil => use s1, .refl, h
+  | cons μ μs ih =>
+    rw [List.cons_append] at h
+    cases h
+    case stepL s htr hmtr =>
+      obtain ⟨s', hmtr', hmtr''⟩ := ih hmtr
+      use s', .stepL htr hmtr', hmtr''
+
+/-- Multistep-transitions over `μs ++ μs'` are exactly multistep transitions over `μs` and `μs'`
+with a common end & start state (respectively). -/
+theorem MTr.append_iff : lts.MTr s1 (μs ++ μs') s2 ↔ ∃ s, lts.MTr s1 μs s ∧ lts.MTr s μs' s2 := by
+  refine ⟨MTr.split, ?_⟩
+  intro ⟨_, h, h'⟩
+  exact h.comp lts h'
+
+/-- Single-step invariant. -/
+@[scoped grind =]
+def TrInv (p : State → Prop) : Prop :=
+  ∀ s1 μ s2, lts.Tr s1 μ s2 → p s1 → p s2
+
+/-- Multistep invariant. -/
+@[scoped grind =]
+def MTrInv (p : State → Prop) : Prop :=
+  ∀ s1 μs s2, lts.MTr s1 μs s2 → p s1 → p s2
+
+/-- Any single-step invariant is also a multistep invariant. -/
+theorem mtrInv_of_trInv {lts : LTS State Label} {p : State → Prop}
+    (htr : lts.TrInv p) : lts.MTrInv p := by
+  intro s1 μs s2 h
+  induction h <;> grind
 
 /-- A state `s1` can reach a state `s2` if there exists a multistep transition from
 `s1` to `s2`. -/
@@ -160,12 +221,36 @@ section Classes
 
 variable {State : Type u} {Label : Type v} (lts : LTS State Label)
 
-/-- An lts is deterministic if a state cannot reach different states with the same transition
-label. -/
+/-- A state `s` is deterministic for a label `μ` if `s` has at most one `μ`-derivative. -/
+@[scoped grind =]
+def DeterministicStateLabel (s : State) (μ : Label) : Prop :=
+  ∀ s₁ s₂, lts.Tr s μ s₁ → lts.Tr s μ s₂ → s₁ = s₂
+
+/-- A state `s` is deterministic if it is deterministic for all labels. -/
+@[scoped grind =]
+def DeterministicState (s : State) : Prop := ∀ μ, lts.DeterministicStateLabel s μ
+
+/-- An lts is deterministic if it is deterministic at every state. -/
 @[scoped grind]
 class Deterministic (lts : LTS State Label) where
-  deterministic (s1 : State) (μ : Label) (s2 s3 : State) :
-    lts.Tr s1 μ s2 → lts.Tr s1 μ s3 → s2 = s3
+  /-- For all states and labels, there is at most one state reachable from a given state
+  with a given label. -/
+  deterministic : ∀ s, lts.DeterministicState s
+
+theorem Deterministic.eq_of_tr {lts : LTS State Label} [h : lts.Deterministic]
+    (htr : lts.Tr s1 μ s2) (htr' : lts.Tr s1 μ s2') : s2 = s2' :=
+  h.deterministic s1 μ s2 s2' htr htr'
+
+/-- In a deterministic lts, multistep transitions with a given start state and trace reach a unique
+end state. -/
+theorem Deterministic.eq_of_mTr {lts : LTS State Label} [lts.Deterministic]
+    (hmtr : lts.MTr s1 μs s2) (hmtr' : lts.MTr s1 μs s2') : s2 = s2' := by
+  induction μs generalizing s1 s2 s2' with
+  | nil => grind
+  | cons μ μs ih =>
+    rcases hmtr with (_ | ⟨htr, hmtr⟩); rcases hmtr' with (_ | ⟨htr', hmtr'⟩)
+    rw [eq_of_tr htr htr'] at hmtr
+    exact ih hmtr hmtr'
 
 /-- The `μ`-image of a state `s` is the set of all `μ`-derivatives of `s`. -/
 @[scoped grind =]
@@ -236,24 +321,29 @@ abbrev ImageFinite := ∀ s μ, Finite (lts.image s μ)
 
 /-- In a deterministic LTS, if a state has a `μ`-derivative, then it can have no other
 `μ`-derivative. -/
-@[scoped grind .]
-theorem deterministic_not_lto [h : lts.Deterministic] :
-  ∀ s μ s' s'', s' ≠ s'' → lts.Tr s μ s' → ¬lts.Tr s μ s'' := by grind
+@[scoped grind ⇒]
+theorem DeterministicStateLabel.not_tr_of_ne (hdet : lts.DeterministicStateLabel s μ)
+    (hne : s₁ ≠ s₂) (htr₁ : lts.Tr s μ s₁) : ¬lts.Tr s μ s₂ := by
+  grind
 
-@[scoped grind _=_]
-theorem deterministic_tr_image_singleton [lts.Deterministic] :
+@[scoped grind ⇒]
+theorem DeterministicStateLabel.image_singleton_iff_tr (h : lts.DeterministicStateLabel s μ) :
     lts.image s μ = {s'} ↔ lts.Tr s μ s' := by
   have := (lts.image s μ).eq_singleton_iff_unique_mem (a := s')
   grind
 
-/-- In a deterministic LTS, any image is either a singleton or the empty set. -/
-@[scoped grind .]
-theorem deterministic_image_char [lts.Deterministic] (s : State) (μ : Label) :
-    (∃ s', lts.image s μ = { s' }) ∨ (lts.image s μ = ∅) := by grind
+/-- If `s` is deterministic for `μ`, then the `μ`-image of `s` is either a singleton or the empty
+set. -/
+@[scoped grind →]
+theorem DeterministicStateLabel.image_char (h : lts.DeterministicStateLabel s μ) :
+    (∃ s', lts.image s μ = { s' }) ∨ (lts.image s μ = ∅) := by
+  grind [=_ image_singleton_iff_tr]
 
-/-- In a deterministic LTS, the image of any state-label combination is finite. -/
-instance [lts.Deterministic] (s : State) (μ : Label) : Finite (lts.image s μ) := by
-  have hDet := deterministic_image_char lts s μ
+/-- If `s` is deterministic at `μ`, then the `μ`-image of `s` is finite. -/
+@[scoped grind →]
+theorem DeterministicStateLabel.finite_image (h : lts.DeterministicStateLabel s μ) :
+    Finite (lts.image s μ) := by
+  have hDet := image_char lts h
   cases hDet
   case inl hDet =>
     obtain ⟨s', hDet'⟩ := hDet
@@ -263,6 +353,9 @@ instance [lts.Deterministic] (s : State) (μ : Label) : Finite (lts.image s μ)
     simp only [hDet]
     apply Set.finite_empty
 
+instance [h : lts.Deterministic] (s : State) (μ : Label) : Finite (lts.image s μ) :=
+  DeterministicStateLabel.finite_image lts (h.deterministic s μ)
+
 /-- Every deterministic LTS is also image-finite. -/
 instance deterministic_imageFinite [lts.Deterministic] : lts.ImageFinite := inferInstance
 
@@ -288,15 +381,25 @@ attribute [instance] FinitelyBranching.image_finite FinitelyBranching.finite_sta
 /-- Every LTS with finite types for states and labels is also finitely branching. -/
 instance FinitelyBranching.of_finite [Finite State] [Finite Label] : lts.FinitelyBranching where
 
-/-- An LTS is acyclic if there are no infinite multistep transitions. -/
-class Acyclic (lts : LTS State Label) where
-  acyclic : ∃ n, ∀ s1 μs s2, lts.MTr s1 μs s2 → μs.length < n
+/-- An LTS is bounded up to `n` if every finite execution has length strictly less than `n`. -/
+def BoundedUpTo (lts : LTS State Label) (n : ℕ) : Prop :=
+  ∀ s1 μs s2, lts.MTr s1 μs s2 → μs.length < n
+
+/-- An LTS is bounded if there is a global bound on the length of all of its finite executions. -/
+class Bounded (lts : LTS State Label) where
+  bounded : ∃ n, lts.BoundedUpTo n
 
-/-- An LTS is finite if it is finite-state and acyclic.
+/-- An LTS is terminating if its underlying unlabelled transition relation is terminating,
+equivalently if it admits no infinite execution. -/
+class Terminating (lts : LTS State Label) where
+  terminating : Relation.Terminating lts.UnlabelledTr
+
+/-- An LTS is acyclic if its underlying unlabelled transition relation contains no nonempty
+cycle. -/
+class Acyclic (lts : LTS State Label) where
+  [acyclic : Relation.Acyclic lts.UnlabelledTr]
 
-We call this `FiniteLTS` instead of just `Finite` to avoid confusion with the standard `Finite`
-class. -/
-class FiniteLTS [Finite State] (lts : LTS State Label) extends lts.Acyclic
+attribute [instance] Acyclic.acyclic
 
 end Classes
 
diff --git a/Cslib/Foundations/Semantics/LTS/Bisimulation.lean b/Cslib/Foundations/Semantics/LTS/Bisimulation.lean
index 21ffd67eb5..01cc9724de 100644
--- a/Cslib/Foundations/Semantics/LTS/Bisimulation.lean
+++ b/Cslib/Foundations/Semantics/LTS/Bisimulation.lean
@@ -1,15 +1,15 @@
 /-
 Copyright (c) 2025 Fabrizio Montesi. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Fabrizio Montesi
+Authors: Fabrizio Montesi, Thomas Waring
 -/
 
 module
 
-public import Cslib.Foundations.Data.Relation
-public import Cslib.Foundations.Semantics.LTS.HasTau
+public import Cslib.Foundations.Relation.Domain
 public import Cslib.Foundations.Semantics.LTS.Simulation
 public import Cslib.Foundations.Semantics.LTS.TraceEq
+public import Mathlib.Tactic.TFAE
 
 /-! # Bisimulation and Bisimilarity
 
@@ -51,7 +51,7 @@ we prove to be sound and complete.
 - `LTS.IsBisimulation.inv`: the inverse of a bisimulation is a bisimulation.
 - `Bisimilarity.eqv`: bisimilarity is an equivalence relation (see `Equivalence`).
 - `Bisimilarity.isBisimulation`: bisimilarity is itself a bisimulation.
-- `Bisimilarity.largest_bisimulation`: bisimilarity is the largest bisimulation.
+- `IsBisimulation.le_bisimilarity`: bisimilarity is the largest bisimulation.
 - `Bisimilarity.gfp`: the union of bisimilarity and any bisimulation is equal to bisimilarity.
 - `LTS.IsBisimulationUpTo.isBisimulation`: any bisimulation up to bisimilarity is a bisimulation.
 - `LTS.IsBisimulation.traceEq`: any bisimulation that relates two states implies that they are
@@ -68,12 +68,13 @@ equivalence coincide.
 
 namespace Cslib.LTS
 
+variable {State₁ State₂ Label : Type*} {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
+
 section Bisimulation
 
 /-- A relation is a bisimulation if, whenever it relates two states,
 the transitions originating from these states mimic each other and the reached
 derivatives are themselves related. -/
-@[scoped grind =]
 def IsBisimulation (lts₁ : LTS State₁ Label) (lts₂ : LTS State₂ Label)
     (r : State₁ → State₂ → Prop) : Prop :=
   ∀ ⦃s₁ s₂⦄, r s₁ s₂ → ∀ μ, (
@@ -82,20 +83,74 @@ def IsBisimulation (lts₁ : LTS State₁ Label) (lts₂ : LTS State₂ Label)
     (∀ s₂', lts₂.Tr s₂ μ s₂' → ∃ s₁', lts₁.Tr s₁ μ s₁' ∧ r s₁' s₂')
   )
 
-/-- A homogeneous bisimulation is a bisimulation where the underlying LTSs are the same. -/
-abbrev IsHomBisimulation (lts : LTS State Label) := IsBisimulation lts lts
+/-! ## Relation to simulation -/
+
+/-- Any bisimulation is also a simulation. -/
+theorem IsBisimulation.isSimulation : IsBisimulation lts₁ lts₂ r → IsSimulation lts₁ lts₂ r := by
+  grind [IsBisimulation, IsSimulation]
+
+/-- The inverse of a bisimulation is a simulation. -/
+theorem IsBisimulation.flip_isSimulation :
+    IsBisimulation lts₁ lts₂ r → IsSimulation lts₂ lts₁ (flip r) := by
+  grind [IsBisimulation, IsSimulation, flip]
+
+/-- A relation is a bisimulation iff both it and its inverse are simulations. -/
+theorem IsBisimulation.isSimulation_iff :
+    IsBisimulation lts₁ lts₂ r ↔ (IsSimulation lts₁ lts₂ r ∧ IsSimulation lts₂ lts₁ (flip r)) := by
+  have _ (s₁ s₂) : r s₁ s₂ → flip r s₂ s₁ := id
+  grind [IsBisimulation, IsSimulation, flip]
 
 /-- Helper for following a transition by the first state in a pair of a `Bisimulation`. -/
 theorem IsBisimulation.follow_fst
     (hb : IsBisimulation lts₁ lts₂ r) (hr : r s₁ s₂) (htr : lts₁.Tr s₁ μ s₁') :
     ∃ s₂', lts₂.Tr s₂ μ s₂' ∧ r s₁' s₂' :=
-  (hb hr μ).1 _ htr
+  IsSimulation.follow hb.isSimulation hr htr
 
 /-- Helper for following a transition by the second state in a pair of a `Bisimulation`. -/
 theorem IsBisimulation.follow_snd
     (hb : IsBisimulation lts₁ lts₂ r) (hr : r s₁ s₂) (htr : lts₂.Tr s₂ μ s₂') :
     ∃ s₁', lts₁.Tr s₁ μ s₁' ∧ r s₁' s₂' :=
-  (hb hr μ).2 _ htr
+  IsSimulation.follow hb.flip_isSimulation hr htr
+
+/-- If the unique transition of a state is matched by a related state in a bisimulation,
+then the derivatives are still in the bisimulation. -/
+theorem IsBisimulation.match_deterministic
+    (hb : IsBisimulation lts₁ lts₂ r)
+    (hr : r s₁ s₂)
+    (hdet : lts₁.DeterministicStateLabel s₁ μ)
+    (htr₁ : lts₁.Tr s₁ μ s₁')
+    (htr₂ : lts₂.Tr s₂ μ s₂') : r s₁' s₂' := by
+  have hr' : (flip r) s₂ s₁ := by grind [flip]
+  apply IsSimulation.match_deterministic hb.flip_isSimulation hr' hdet htr₂ htr₁
+
+/-- If the unique transition of a state is matched by a related state in the inverse of a
+bisimulation, then the derivatives are still in the bisimulation. -/
+theorem IsBisimulation.match_deterministic₂
+    (hb : IsBisimulation lts₁ lts₂ r)
+    (hr : r s₁ s₂)
+    (hdet : lts₂.DeterministicStateLabel s₂ μ)
+    (htr₁ : lts₁.Tr s₁ μ s₁')
+    (htr₂ : lts₂.Tr s₂ μ s₂') : r s₁' s₂' := by
+  apply IsSimulation.match_deterministic hb.isSimulation hr hdet htr₁ htr₂
+
+/-- If a state is deterministic for `μ`, then any transition made by a related state in a
+bisimulation is matched by a unique transition (left variant). -/
+theorem IsBisimulation.follow_fst_deterministic (hb : IsBisimulation lts₁ lts₂ r) (hr : r s₁ s₂)
+    (hdet : lts₂.DeterministicStateLabel s₂ μ) (htr : lts₁.Tr s₁ μ s₁') :
+    ∃! s₂', lts₂.Tr s₂ μ s₂' ∧ r s₁' s₂' :=
+  IsSimulation.follow_deterministic hb.isSimulation hr hdet htr
+
+/-- If a state is deterministic for `μ`, then any transition made by a related state in a
+bisimulation is matched by a unique transition (right variant). -/
+theorem IsBisimulation.follow_snd_deterministic
+    (hb : IsBisimulation lts₁ lts₂ r)
+    (hr : r s₁ s₂)
+    (hdet : lts₁.DeterministicStateLabel s₁ μ)
+    (htr : lts₂.Tr s₂ μ s₂') : ∃! s₁', lts₁.Tr s₁ μ s₁' ∧ r s₁' s₂' :=
+  IsSimulation.follow_deterministic hb.flip_isSimulation hr hdet htr
+
+/-- A homogeneous bisimulation is a bisimulation where the underlying LTSs are the same. -/
+abbrev IsHomBisimulation (lts : LTS State Label) := IsBisimulation lts lts
 
 /-- Two states are bisimilar if they are related by some bisimulation. -/
 @[scoped grind =]
@@ -116,28 +171,37 @@ abbrev HomBisimilarity (lts : LTS State Label) := Bisimilarity lts lts
 /-- Notation for homogeneous bisimilarity. -/
 scoped notation s:max " ~[" lts "] " s':max => HomBisimilarity lts s s'
 
+/-- Helper for following a transition by the first state in a pair of a `Bisimilarity`. -/
+theorem Bisimilarity.follow_fst (hr : s₁ ~[lts₁,lts₂] s₂) (htr : lts₁.Tr s₁ μ s₁') :
+    ∃ s₂', lts₂.Tr s₂ μ s₂' ∧ s₁' ~[lts₁,lts₂ ] s₂' := by grind [IsBisimulation]
+
+/-- Helper for following a transition by the first state in a pair of a `Bisimilarity`. -/
+theorem Bisimilarity.follow_snd (hr : s₁ ~[lts₁,lts₂] s₂) (htr : lts₂.Tr s₂ μ s₂') :
+    ∃ s₁', lts₁.Tr s₁ μ s₁' ∧ s₁' ~[lts₁,lts₂] s₂' := by grind [IsBisimulation]
+
 /-- Homogeneous bisimilarity is reflexive. -/
 @[scoped grind ., refl]
 theorem HomBisimilarity.refl (s : State) : s ~[lts] s := by
   exists Eq
-  grind
+  grind [IsBisimulation]
 
 /-- The inverse of a bisimulation is a bisimulation. -/
 @[scoped grind →]
 theorem IsBisimulation.inv (h : IsBisimulation lts₁ lts₂ r) :
-  IsBisimulation lts₂ lts₁ (flip r) := by grind [flip]
+  IsBisimulation lts₂ lts₁ (flip r) := by grind [IsBisimulation, flip]
 
 open scoped IsBisimulation in
 /-- Bisimilarity is symmetric. -/
 @[scoped grind →, symm]
-theorem Bisimilarity.symm {s₁ s₂ : State} (h : s₁ ~[lts₁,lts₂] s₂) : s₂ ~[lts₂,lts₁] s₁ := by
+theorem Bisimilarity.symm {lts₁ lts₂ : LTS State Label} {s₁ s₂ : State}
+    (h : s₁ ~[lts₁,lts₂] s₂) : s₂ ~[lts₂,lts₁] s₁ := by
   grind [flip]
 
 /-- The composition of two bisimulations is a bisimulation. -/
 @[scoped grind .]
 theorem IsBisimulation.comp
     (h1 : IsBisimulation lts₁ lts₂ r1) (h2 : IsBisimulation lts₂ lts₃ r2) :
-  IsBisimulation lts₁ lts₃ (Relation.Comp r1 r2) := by grind [Relation.Comp]
+  IsBisimulation lts₁ lts₃ (Relation.Comp r1 r2) := by grind [IsBisimulation, Relation.Comp]
 
 /-- Bisimilarity is transitive. -/
 @[scoped grind →]
@@ -147,7 +211,7 @@ theorem Bisimilarity.trans
   obtain ⟨r1, _, _⟩ := h1
   obtain ⟨r2, _, _⟩ := h2
   exists Relation.Comp r1 r2
-  grind [Relation.Comp]
+  grind [IsBisimulation, Relation.Comp]
 
 /-- Homogeneous bisimilarity is an equivalence relation. -/
 theorem HomBisimilarity.eqv :
@@ -162,67 +226,34 @@ instance : IsEquiv State (HomBisimilarity lts) where
   symm _ _ := Bisimilarity.symm
   trans _ _ _ := Bisimilarity.trans
 
+/-- Bisimulation implies simulation equivalence. -/
+theorem IsBisimulation.simulationEquiv (h : IsBisimulation lts₁ lts₂ r) (hrel : r s₁ s₂) :
+    s₁ ≤≥[lts₁,lts₂] s₂ := ⟨⟨r, hrel, h.isSimulation⟩, flip r, hrel, h.inv.isSimulation⟩
+
 /-- The union of two bisimulations is a bisimulation. -/
 @[scoped grind .]
 theorem IsBisimulation.sup (hrb : IsBisimulation lts₁ lts₂ r) (hsb : IsBisimulation lts₁ lts₂ s) :
-  IsBisimulation lts₁ lts₂ (r ⊔ s) := by
-  intro s₁ s₂ hrs μ
-  cases hrs
-  case inl h =>
-    constructor
-    · intro s₁' htr
-      obtain ⟨s₂', htr', hr'⟩ := hrb.follow_fst h htr
-      exists s₂'
-      constructor
-      · assumption
-      · simp only [max, SemilatticeSup.sup]
-        left
-        exact hr'
-    · intro s₂' htr
-      obtain ⟨s₁', htr', hr'⟩ := hrb.follow_snd h htr
-      exists s₁'
-      constructor
-      · assumption
-      · simp only [max, SemilatticeSup.sup]
-        left
-        exact hr'
-  case inr h =>
-    constructor
-    · intro s₁' htr
-      obtain ⟨s₂', htr', hs'⟩ := hsb.follow_fst h htr
-      exists s₂'
-      constructor
-      · assumption
-      · simp only [max, SemilatticeSup.sup]
-        right
-        exact hs'
-    · intro s₂' htr
-      obtain ⟨s₁', htr', hs'⟩ := hsb.follow_snd h htr
-      exists s₁'
-      constructor
-      · assumption
-      · simp only [max, SemilatticeSup.sup]
-        right
-        exact hs'
+    IsBisimulation lts₁ lts₂ (r ⊔ s) := by
+  rw [IsBisimulation.isSimulation_iff] at hrb hsb ⊢
+  rw [show flip (r ⊔ s) = flip r ⊔ flip s by ext; rfl]
+  exact ⟨hrb.1.sup hsb.1, hrb.2.sup hsb.2⟩
 
 /-- Bisimilarity is a bisimulation. -/
 @[scoped grind .]
-theorem Bisimilarity.is_bisimulation : IsBisimulation lts₁ lts₂ (Bisimilarity lts₁ lts₂) := by grind
+theorem Bisimilarity.isBisimulation (lts₁ : LTS State₁ Label) (lts₂ : LTS State₂ Label) :
+  IsBisimulation lts₁ lts₂ (Bisimilarity lts₁ lts₂) := by grind [IsBisimulation]
 
 /-- Bisimilarity is the largest bisimulation. -/
 @[scoped grind →]
-theorem Bisimilarity.largest_bisimulation (h : IsBisimulation lts₁ lts₂ r) :
-  Subrelation r (Bisimilarity lts₁ lts₂) := by
+theorem IsBisimulation.le_bisimilarity (h : IsBisimulation lts₁ lts₂ r) :
+    r ≤ (Bisimilarity lts₁ lts₂) := by
   intro s₁ s₂ hr
   exists r
 
 /-- The union of bisimilarity with any bisimulation is bisimilarity. -/
 @[scoped grind =, simp]
 theorem Bisimilarity.gfp (r : State₁ → State₂ → Prop) (h : IsBisimulation lts₁ lts₂ r) :
-    (Bisimilarity lts₁ lts₂) ⊔ r = Bisimilarity lts₁ lts₂ := by
-  funext s₁ s₂
-  simp only [max, SemilatticeSup.sup]
-  grind
+    (Bisimilarity lts₁ lts₂) ⊔ r = Bisimilarity lts₁ lts₂ := sup_eq_left.mpr h.le_bisimilarity
 
 /-- `calc` support for bisimilarity. -/
 instance : Trans (Bisimilarity lts₁ lts₂) (Bisimilarity lts₂ lts₃) (Bisimilarity lts₁ lts₃) where
@@ -235,30 +266,15 @@ section Order
 instance : Max {r // IsBisimulation lts₁ lts₂ r} where
   max r s := ⟨r.1 ⊔ s.1, IsBisimulation.sup r.2 s.2⟩
 
+@[simp] lemma coe_sup (r s : {r // IsBisimulation lts₁ lts₂ r}) :
+    (↑(r ⊔ s) : State₁ → State₂ → Prop) = (r : State₁ → State₂ → Prop) ⊔ s := rfl
+
 /-- Bisimulations equipped with union form a join-semilattice. -/
 instance : SemilatticeSup {r // IsBisimulation lts₁ lts₂ r} where
   sup r s := r ⊔ s
-  le_sup_left r s := by
-    simp only [LE.le]
-    intro s₁ s₂ hr
-    simp only [max, SemilatticeSup.sup]
-    left
-    exact hr
-  le_sup_right r s := by
-    simp only [LE.le]
-    intro s₁ s₂ hs
-    simp only [max, SemilatticeSup.sup]
-    right
-    exact hs
-  sup_le r s t := by
-    intro h1 h2
-    simp only [LE.le, max, SemilatticeSup.sup]
-    intro s₁ s₂ h
-    cases h
-    case inl h =>
-      apply h1 _ _ h
-    case inr h =>
-      apply h2 _ _ h
+  le_sup_left r s := by simp [←Subtype.coe_le_coe]
+  le_sup_right r s := by simp [←Subtype.coe_le_coe]
+  sup_le r s t := by simp [←Subtype.coe_le_coe]; tauto
 
 /-- The empty (heterogeneous) relation is a bisimulation. -/
 @[scoped grind .]
@@ -270,7 +286,7 @@ instance : Bot {r // IsBisimulation lts₁ lts₂ r} :=
   ⟨Relation.emptyHRelation, IsBisimulation.bot⟩
 
 instance : Top {r // IsBisimulation lts₁ lts₂ r} :=
-  ⟨Bisimilarity lts₁ lts₂, Bisimilarity.is_bisimulation⟩
+  ⟨Bisimilarity lts₁ lts₂, Bisimilarity.isBisimulation ..⟩
 
 /-- In the inclusion order on bisimulations:
 
@@ -280,15 +296,8 @@ instance : Top {r // IsBisimulation lts₁ lts₂ r} :=
 instance : BoundedOrder {r // IsBisimulation lts₁ lts₂ r} where
   top := ⊤
   bot := ⊥
-  le_top r := by
-    intro s₁ s₂
-    simp only [LE.le, Top.top]
-    grind
-  bot_le r := by
-    intro s₁ s₂
-    simp only [LE.le]
-    intro hr
-    cases hr
+  le_top r := r.property.le_bisimilarity
+  bot_le r := by simp [Bot.bot, LE.le]
 
 end Order
 
@@ -302,7 +311,6 @@ def UpToHomBisimilarity (lts₁ : LTS State₁ Label) (lts₂ : LTS State₂ Lab
 /-- A relation `r` is a bisimulation up to homogeneous bisimilarity if, whenever it relates two
 states in an lts, the transitions originating from these states mimic each other and the reached
 derivatives are themselves related by `r` up to bisimilarity. -/
-@[scoped grind]
 def IsBisimulationUpTo (lts₁ : LTS State₁ Label) (lts₂ : LTS State₂ Label)
     (r : State₁ → State₂ → Prop) : Prop :=
   ∀ ⦃s₁ s₂⦄, r s₁ s₂ → ∀ μ, (
@@ -315,109 +323,42 @@ def IsBisimulationUpTo (lts₁ : LTS State₁ Label) (lts₂ : LTS State₂ Labe
 
 /-- Any bisimulation up to bisimilarity is a bisimulation. -/
 @[scoped grind →]
-theorem IsBisimulationUpTo.is_bisimulation (h : IsBisimulationUpTo lts₁ lts₂ r) :
-  IsBisimulation lts₁ lts₂ (UpToHomBisimilarity lts₁ lts₂ r) := by
+theorem IsBisimulationUpTo.isBisimulation (h : IsBisimulationUpTo lts₁ lts₂ r) :
+    IsBisimulation lts₁ lts₂ (UpToHomBisimilarity lts₁ lts₂ r) := by
   intro s₁ s₂ hr μ
   rcases hr with ⟨s₁b, hr1b, s₂b, hrb, hr2b⟩
-  obtain ⟨r1, hr1, hr1b⟩ := hr1b
-  obtain ⟨r2, hr2, hr2b⟩ := hr2b
   constructor
   case left =>
     intro s₁' htr1
-    obtain ⟨s₁b', hs₁b'tr, hs₁b'r⟩ := (hr1b hr1 μ).1 s₁' htr1
+    obtain ⟨s₁b', hs₁b'tr, hs₁b'r⟩ := hr1b.follow_fst htr1
     obtain ⟨s₂b', hs₂b'tr, hs₂b'r⟩ := (h hrb μ).1 s₁b' hs₁b'tr
-    obtain ⟨s₂', hs₂btr, hs₂br⟩ := (hr2b hr2 μ).1 _ hs₂b'tr
-    exists s₂'
-    constructor
-    case left =>
-      exact hs₂btr
-    case right =>
-      obtain ⟨smid1, hsmidb, smid2, hsmidr, hsmidrb⟩ := hs₂b'r
-      constructor
-      constructor
-      · apply Bisimilarity.trans (Bisimilarity.largest_bisimulation hr1b hs₁b'r)
-          hsmidb
-      · exists smid2
-        constructor
-        · exact hsmidr
-        · apply Bisimilarity.trans hsmidrb
-          apply Bisimilarity.largest_bisimulation hr2b hs₂br
+    obtain ⟨s₂', hs₂btr, hs₂br⟩ := hr2b.follow_fst hs₂b'tr
+    use s₂', hs₂btr
+    obtain ⟨smid1, hsmidb, smid2, hsmidr, hsmidrb⟩ := hs₂b'r
+    use smid1, hs₁b'r.trans hsmidb, smid2, hsmidr
+    exact hsmidrb.trans hs₂br
   case right =>
     intro s₂' htr2
-    obtain ⟨s₂b', hs₂b'tr, hs₂b'r⟩ := (hr2b hr2 μ).2 s₂' htr2
+    obtain ⟨s₂b', hs₂b'tr, hs₂b'r⟩ := hr2b.follow_snd htr2
     obtain ⟨s₁b', hs₁b'tr, hs₁b'r⟩ := (h hrb μ).2 s₂b' hs₂b'tr
-    obtain ⟨s₁', hs₁btr, hs₁br⟩ := (hr1b hr1 μ).2 _ hs₁b'tr
-    exists s₁'
-    constructor
-    case left =>
-      exact hs₁btr
-    case right =>
-      obtain ⟨smid1, hsmidb, smid2, hsmidr, hsmidrb⟩ := hs₁b'r
-      constructor
-      constructor
-      · apply Bisimilarity.trans (Bisimilarity.largest_bisimulation hr1b _) hsmidb
-        · exact hs₁br
-      · exists smid2
-        constructor
-        · exact hsmidr
-        · apply Bisimilarity.trans hsmidrb
-          apply Bisimilarity.largest_bisimulation hr2b _
-          exact hs₂b'r
+    obtain ⟨s₁', hs₁btr, hs₁br⟩ := hr1b.follow_snd hs₁b'tr
+    use s₁', hs₁btr
+    obtain ⟨smid1, hsmidb, smid2, hsmidr, hsmidrb⟩ := hs₁b'r
+    use smid1, hs₁br.trans hsmidb, smid2, hsmidr
+    exact hsmidrb.trans hs₂b'r
 
 /-- If two states are related by a bisimulation, they can mimic each other's multi-step
 transitions. -/
-theorem IsBisimulation.bisim_trace
-    (hb : IsBisimulation lts₁ lts₂ r) (hr : r s₁ s₂) :
-    ∀ μs s₁', lts₁.MTr s₁ μs s₁' → ∃ s₂', lts₂.MTr s₂ μs s₂' ∧ r s₁' s₂' := by
-  intro μs
-  induction μs generalizing s₁ s₂
-  case nil =>
-    intro s₁' hmtr1
-    exists s₂
-    cases hmtr1
-    constructor
-    constructor
-    exact hr
-  case cons μ μs' ih =>
-    intro s₁' hmtr1
-    cases hmtr1
-    case stepL s₁'' htr hmtr =>
-      specialize hb hr μ
-      have hf := hb.1 s₁'' htr
-      obtain ⟨s₂'', htr2, hb2⟩ := hf
-      specialize ih hb2 s₁' hmtr
-      obtain ⟨s₂', hmtr2, hr'⟩ := ih
-      exists s₂'
-      constructor
-      case left =>
-        constructor
-        · exact htr2
-        · exact hmtr2
-      case right =>
-        exact hr'
+theorem IsBisimulation.bisim_trace (hb : IsBisimulation lts₁ lts₂ r) (hr : r s₁ s₂) :
+    ∀ μs s₁', lts₁.MTr s₁ μs s₁' → ∃ s₂', lts₂.MTr s₂ μs s₂' ∧ r s₁' s₂' :=
+  hb.isSimulation.sim_trace hr
 
 /-! ## Relation to trace equivalence -/
 
 /-- Any bisimulation implies trace equivalence. -/
 @[scoped grind =>]
-theorem IsBisimulation.traceEq
-    (hb : IsBisimulation lts₁ lts₂ r) (hr : r s₁ s₂) :
-    s₁ ~tr[lts₁,lts₂] s₂ := by
-  funext μs
-  simp only [eq_iff_iff]
-  constructor
-  case mp =>
-    intro h
-    obtain ⟨s₁', h⟩ := h
-    obtain ⟨s₂', hmtr⟩ := IsBisimulation.bisim_trace hb hr μs s₁' h
-    exists s₂'
-    exact hmtr.1
-  case mpr =>
-    intro h
-    obtain ⟨s₂', h⟩ := h
-    obtain ⟨s₁', hmtr⟩ := IsBisimulation.bisim_trace hb.inv hr μs s₂' h
-    exists s₁'
-    exact hmtr.1
+theorem IsBisimulation.traceEq (hb : IsBisimulation lts₁ lts₂ r) (hr : r s₁ s₂) :
+    s₁ ~tr[lts₁,lts₂] s₂ := (hb.simulationEquiv hr).traceEq
 
 /-- Bisimilarity is included in trace equivalence. -/
 @[scoped grind .]
@@ -444,356 +385,104 @@ example `Bisimulation.deterministic_trace_eq_is_bisim`). -/
 theorem IsBisimulation.traceEq_not_bisim :
     ∃ (State : Type) (Label : Type) (lts : LTS State Label),
       ¬(IsHomBisimulation lts (HomTraceEq lts)) := by
-  exists ℕ
-  exists Char
   let lts := LTS.mk BisimMotTr
-  exists lts
+  exists ℕ, Char, lts
   intro h
-  -- specialize h 1 5
   have htreq : (1 ~tr[lts] 5) := by
-    simp [TraceEq]
     have htraces₁ : lts.traces 1 = {[], ['a'], ['a', 'b'], ['a', 'c']} := by
-      apply Set.ext_iff.2
-      intro μs
-      apply Iff.intro
+      ext μs
+      constructor
       case mp =>
-        intro h1
-        obtain ⟨s', htr⟩ := h1
-        cases htr
-        case refl =>
-          simp
-        case stepL μ sb μs' htr hmtr =>
-          cases htr
-          cases hmtr
-          case one2two.stepL μ sb μs' htr hmtr =>
-            cases htr <;> cases hmtr <;>
-            simp only [↓Char.isValue, Set.mem_insert_iff, reduceCtorEq, List.cons.injEq,
-              List.cons_ne_self, and_false, Set.mem_singleton_iff, Char.reduceEq, and_true,
-              or_false, or_true] <;>
-            contradiction
-          simp
+        rintro ⟨_, (_ | ⟨⟨_⟩, (_ | ⟨(_ | _), (_ | ⟨⟨_⟩, _⟩)⟩)⟩)⟩
+        all_goals simp
       case mpr =>
-        intro h1
-        cases h1
-        case inl h1 =>
-          simp only [h1]
-          exists 1
-          constructor
-        case inr h1 =>
-          cases h1
-          case inl h1 =>
-            simp only [h1]
-            exists 2
-            apply MTr.single; constructor
-          case inr h1 =>
-            cases h1
-            case inl h1 =>
-              simp only [h1]
-              exists 3
-              constructor
-              · apply BisimMotTr.one2two
-              · apply MTr.single
-                apply BisimMotTr.two2three
-            case inr h1 =>
-              cases h1
-              exists 4
-              constructor
-              · apply BisimMotTr.one2two
-              · apply MTr.single
-                apply BisimMotTr.two2four
-    have htraces₂ : lts.traces 5 = {[], ['a'], ['a', 'b'], ['a', 'c']} := by
-      apply Set.ext_iff.2
-      intro μs
-      apply Iff.intro
+        rintro (rfl | rfl | rfl | rfl)
+        · exact ⟨1, .refl⟩
+        · exact ⟨2, MTr.single lts .one2two⟩
+        · exact ⟨3, MTr.stepL .one2two <| MTr.single lts .two2three⟩
+        · exact ⟨4, MTr.stepL .one2two <| MTr.single lts .two2four⟩
+    have htraces₅ : lts.traces 5 = {[], ['a'], ['a', 'b'], ['a', 'c']} := by
+      ext μs
+      constructor
       case mp =>
-        intro h1
-        obtain ⟨s', htr⟩ := h1
-        cases htr
-        case refl =>
-          simp
-        case stepL μ sb μs' htr hmtr =>
-          cases htr
-          case five2six =>
-            cases hmtr
-            case refl =>
-              simp
-            case stepL μ sb μs' htr hmtr =>
-              cases htr
-              cases hmtr
-              case refl => simp
-              case stepL μ sb μs' htr hmtr =>
-                cases htr
-          case five2eight =>
-            cases hmtr
-            case refl =>
-              simp
-            case stepL μ sb μs' htr hmtr =>
-              cases htr
-              cases hmtr
-              case refl => right; right; simp
-              case stepL μ sb μs' htr hmtr =>
-                cases htr
+        rintro ⟨_, (_ | ⟨(_ | _), (_ | ⟨⟨_⟩, (_ | ⟨⟨_⟩, _⟩)⟩)⟩)⟩
+        all_goals simp
       case mpr =>
-        intro h1
-        cases h1
-        case inl h1 =>
-          simp only [h1]
-          exists 5
-          constructor
-        case inr h1 =>
-          cases h1
-          case inl h1 =>
-            simp only [h1]
-            exists 6
-            apply MTr.single; constructor
-          case inr h1 =>
-            cases h1
-            case inl h1 =>
-              simp only [h1]
-              exists 7
-              constructor
-              · apply BisimMotTr.five2six
-              · apply MTr.single
-                apply BisimMotTr.six2seven
-            case inr h1 =>
-              cases h1
-              exists 9
-              constructor
-              · apply BisimMotTr.five2eight
-              · apply MTr.single;
-                apply BisimMotTr.eight2nine
-    simp [htraces₁, htraces₂]
-  specialize h htreq
-  specialize h 'a'
-  obtain ⟨h1, h2⟩ := h
-  specialize h1 2 (by constructor)
-  obtain ⟨s₂', htr5, cih⟩ := h1
+        rintro (rfl | rfl | rfl | rfl)
+        · exact ⟨5, .refl⟩
+        · exact ⟨6, MTr.single lts .five2six⟩
+        · exact ⟨7, MTr.stepL .five2six <| MTr.single lts .six2seven⟩
+        · exact ⟨9, MTr.stepL .five2eight <| MTr.single lts .eight2nine⟩
+    exact htraces₁.trans htraces₅.symm
+  obtain ⟨h1, h2⟩ := h htreq 'a'
+  obtain ⟨s₂', htr5, cih⟩ := h1 2 (by constructor)
+  have htraces₂ : {['b'], ['c']} ⊆ lts.traces 2 := by
+    intro μs h
+    rcases h with (rfl | rfl)
+    · refine ⟨3, MTr.single lts .two2three⟩
+    · refine ⟨4, MTr.single lts .two2four⟩
   cases htr5
   case five2six =>
-    simp [TraceEq] at cih
-    have htraces₂ : lts.traces 2 = {[], ['b'], ['c']} := by
-      apply Set.ext_iff.2
-      intro μs
-      apply Iff.intro
-      case mp =>
-        intro h
-        obtain ⟨s', htr⟩ := h
-        cases htr
-        case refl => simp
-        case stepL μ sb μs' htr hmtr =>
-          cases htr
-          case two2three =>
-            cases hmtr
-            case stepL μ sb μs' htr hmtr => cases htr
-            simp
-          case two2four =>
-            cases hmtr
-            case refl => simp
-            case stepL μ sb μs' htr hmtr =>
-              cases htr
-      case mpr =>
-        intro h
-        cases h
-        case inl h =>
-          exists 2
-          simp [h]
-          constructor
-        case inr h =>
-          cases h
-          case inl h =>
-            exists 3; simp [h]; constructor; constructor; constructor
-          case inr h =>
-            exists 4
-            simp at h
-            simp [h]
-            constructor; constructor; constructor
-    have htraces6 : lts.traces 6 = {[], ['b']} := by
-      apply Set.ext_iff.2
-      intro μs
-      apply Iff.intro
-      case mp =>
-        intro h
-        obtain ⟨s', htr⟩ := h
-        cases htr
-        case refl => simp
-        case stepL μ sb μs' htr hmtr =>
-          cases htr
-          cases hmtr
-          case stepL μ sb μs' htr hmtr => cases htr
-          simp
-      case mpr =>
-        intro h
-        cases h
-        case inl h =>
-          exists 6
-          simp [h]
-          constructor
-        case inr h =>
-          exists 7
-          simp at h
-          simp [h]
-          constructor; constructor; constructor
-    grind
+    suffices ['c'] ∉ lts.traces 6 by grind [TraceEq]
+    rintro ⟨_, (_ | h)⟩
+    cases h
   case five2eight =>
-    simp only [TraceEq] at cih
-    have htraces₂ : lts.traces 2 = {[], ['b'], ['c']} := by
-      apply Set.ext_iff.2
-      intro μs
-      apply Iff.intro
-      case mp =>
-        intro h
-        obtain ⟨s', htr⟩ := h
-        cases htr
-        case refl => simp
-        case stepL μ sb μs' htr hmtr =>
-          cases htr
-          case two2three =>
-            cases hmtr
-            case stepL μ sb μs' htr hmtr => cases htr
-            simp
-          case two2four =>
-            cases hmtr
-            case refl => simp
-            case stepL μ sb μs' htr hmtr =>
-              cases htr
-      case mpr =>
-        intro h
-        cases h
-        case inl h =>
-          exists 2
-          simp [h]
-          constructor
-        case inr h =>
-          cases h
-          case inl h =>
-            exists 3; simp [h]; constructor; constructor; constructor
-          case inr h =>
-            exists 4
-            simp at h
-            simp [h]
-            constructor; constructor; constructor
-    have htraces8 : lts.traces 8 = {[], ['c']} := by
-      apply Set.ext_iff.2
-      intro μs
-      apply Iff.intro
-      case mp =>
-        intro h
-        obtain ⟨s', htr⟩ := h
-        cases htr
-        case refl => simp
-        case stepL μ sb μs' htr hmtr =>
-          cases htr
-          cases hmtr
-          case stepL μ sb μs' htr hmtr => cases htr
-          simp
-      case mpr =>
-        intro h
-        cases h
-        case inl h =>
-          exists 8
-          simp [h]
-          constructor
-        case inr h =>
-          exists 9
-          simp at h
-          simp [h]
-          repeat constructor
-    rw [htraces₂, htraces8] at cih
-    apply Set.ext_iff.1 at cih
-    specialize cih ['b']
-    obtain ⟨cih1, cih2⟩ := cih
-    have cih1h : ['b'] ∈ @insert
-      (List Char) (Set (List Char)) Set.instInsert [] {['b'], ['c']} := by
-      simp
-    specialize cih1 cih1h
-    simp at cih1
+    suffices ['b'] ∉ lts.traces 8 by grind [TraceEq]
+    rintro ⟨_, (_ | h)⟩
+    cases h
 
 /-- In general, bisimilarity and trace equivalence are distinct. -/
 theorem Bisimilarity.bisimilarity_neq_traceEq :
     ∃ (State : Type) (Label : Type) (lts : LTS State Label),
       HomBisimilarity lts ≠ HomTraceEq lts := by
   obtain ⟨State, Label, lts, h⟩ := IsBisimulation.traceEq_not_bisim
-  exists State; exists Label; exists lts
-  intro heq
-  have hb := Bisimilarity.is_bisimulation (lts₁ := lts) (lts₂ := lts)
-  simp only [HomBisimilarity] at heq
-  rw [heq] at hb
-  contradiction
+  use State, Label, lts
+  grind [Bisimilarity.isBisimulation lts lts]
 
 /-- In any deterministic LTS, trace equivalence is a bisimulation. -/
 theorem IsBisimulation.deterministic_traceEq_isBisimulation
     {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
     [lts₁.Deterministic] [lts₂.Deterministic] :
     (IsBisimulation lts₁ lts₂ (TraceEq lts₁ lts₂)) := by
-  simp only [IsBisimulation]
-  intro s₁ s₂ hteq μ
-  constructor
-  case left =>
-    apply TraceEq.deterministic_isSimulation s₁ s₂ hteq
-  case right =>
-    intro s₂' htr
-    apply TraceEq.symm at hteq
-    have h := TraceEq.deterministic_isSimulation s₂ s₁ hteq μ s₂' htr
-    obtain ⟨s₁', h⟩ := h
-    exists s₁'
-    constructor
-    case left =>
-      exact h.1
-    case right =>
-      apply h.2.symm
+  rw [IsBisimulation.isSimulation_iff, TraceEq.flip_eq]
+  exact ⟨Deterministic.isSimulation_traceEq, Deterministic.isSimulation_traceEq⟩
 
 /-- In deterministic LTSs, trace equivalence implies bisimilarity. -/
 theorem Bisimilarity.deterministic_traceEq_bisim {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
     [lts₁.Deterministic] [lts₂.Deterministic] (h : s₁ ~tr[lts₁,lts₂] s₂) :
     (s₁ ~[lts₁,lts₂] s₂) := by
-  exists TraceEq lts₁ lts₂
-  constructor
-  case left =>
-    exact h
-  case right =>
-    apply IsBisimulation.deterministic_traceEq_isBisimulation
+  use TraceEq lts₁ lts₂, h, IsBisimulation.deterministic_traceEq_isBisimulation
+
+/-- In a deterministic lts, bisimilarity, trace equivalence, and simulation equivalence are
+equivalent to one-another. -/
+theorem Deterministic.bisim_tfae {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
+    [lts₁.Deterministic] [lts₂.Deterministic] (s₁ : State₁) (s₂ : State₂) :
+    [s₁ ~[lts₁,lts₂] s₂, s₁ ~tr[lts₁,lts₂] s₂, s₁ ≤≥[lts₁,lts₂] s₂].TFAE := by
+  tfae_have 2 ↔ 3 := Deterministic.traceEq_iff_simulationEquiv s₁ s₂
+  tfae_have 1 → 2 := Bisimilarity.le_traceEq s₁ s₂
+  tfae_have 2 → 1 := Bisimilarity.deterministic_traceEq_bisim
+  tfae_finish
 
 /-- In deterministic LTSs, bisimilarity and trace equivalence coincide. -/
 theorem Bisimilarity.deterministic_bisim_eq_traceEq
     {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
     [lts₁.Deterministic] [lts₂.Deterministic] : Bisimilarity lts₁ lts₂ = TraceEq lts₁ lts₂ := by
-  funext s₁ s₂
-  simp only [eq_iff_iff]
-  constructor
-  case mp =>
-    apply Bisimilarity.le_traceEq
-  case mpr =>
-    apply Bisimilarity.deterministic_traceEq_bisim
-
-/-! ## Relation to simulation -/
-
-/-- Any bisimulation is also a simulation. -/
-theorem IsBisimulation.isSimulation : IsBisimulation lts₁ lts₂ r → IsSimulation lts₁ lts₂ r := by
-  grind [IsSimulation]
+  ext s₁ s₂
+  exact (Deterministic.bisim_tfae s₁ s₂).out 1 2
 
-/-- A relation is a bisimulation iff both it and its inverse are simulations. -/
-theorem IsBisimulation.isSimulation_iff :
-    IsBisimulation lts₁ lts₂ r ↔ (IsSimulation lts₁ lts₂ r ∧ IsSimulation lts₂ lts₁ (flip r)) := by
-  have _ (s₁ s₂) : r s₁ s₂ → flip r s₂ s₁ := id
-  grind [IsSimulation, flip]
-
-set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Homogeneous bisimilarity can also be characterized through symmetric simulations. -/
 theorem HomBisimilarity.symm_simulation :
   HomBisimilarity lts =
     fun s₁ s₂ => ∃ r, r s₁ s₂ ∧ Std.Symm r ∧ IsHomSimulation lts r := by
-  funext s₁ s₂
-  apply Iff.eq
-  apply Iff.intro
+  ext s₁ s₂
+  constructor
   · intro h
-    have bisim : HomBisimilarity lts s₁ s₂ ∧ Std.Symm (HomBisimilarity lts)
-        ∧ IsHomSimulation lts (HomBisimilarity lts) := by
-      grind [Std.Symm, Bisimilarity.symm, IsBisimulation.isSimulation]
-    grind
-  · intro ⟨r, hr, hsymm, hsim⟩
-    have : r = (flip r) := by grind only [flip, Std.Symm]
-    have : IsHomBisimulation lts r := by grind [IsBisimulation.isSimulation_iff]
-    grind
+    use lts.HomBisimilarity, h
+    exact ⟨⟨fun _ _ => Bisimilarity.symm⟩, (Bisimilarity.isBisimulation lts lts).isSimulation⟩
+  · intro ⟨r, hrel, ⟨hsymm⟩, hsim⟩
+    use r, hrel
+    have : r = flip r := by grind [flip]
+    simpa [IsBisimulation.isSimulation_iff, ←this]
 
 end Bisimulation
 
@@ -836,47 +525,22 @@ def IsSWBisimulation [HasTau Label] (lts₁ : LTS State₁ Label) (lts₂ : LTS
     (∀ s₂', lts₂.Tr s₂ μ s₂' → ∃ s₁', lts₁.STr s₁ μ s₁' ∧ r s₁' s₂')
   )
 
-/-- Utility theorem for 'following' internal transitions using an `SWBisimulation`
-(first component). -/
-theorem IsSWBisimulation.follow_internal_fst
-    [HasTau Label] {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
-    (hswb : IsSWBisimulation lts₁ lts₂ r) (hr : r s₁ s₂) (hstr : lts₁.τSTr s₁ s₁') :
-    ∃ s₂', lts₂.τSTr s₂ s₂' ∧ r s₁' s₂' := by
-  induction hstr
-  case refl =>
-    exists s₂
-    constructor; constructor
-    exact hr
-  case tail sb hrsb htrsb ih1 ih2 =>
-    obtain ⟨sb2, htrsb2, hrb⟩ := ih2
-    have h := (hswb hrb HasTau.τ).left _ ih1
-    obtain ⟨sb2', htrsb2', hrb'⟩ := h
-    exists sb2'
-    constructor
-    · simp only [sTr_τSTr] at htrsb htrsb2'
-      exact Relation.ReflTransGen.trans htrsb2 htrsb2'
-    · exact hrb'
-
-/-- Utility theorem for 'following' internal transitions using an `SWBisimulation`
-(second component). -/
-theorem IsSWBisimulation.follow_internal_snd
-    [HasTau Label] {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
-    (hswb : IsSWBisimulation lts₁ lts₂ r) (hr : r s₁ s₂) (hstr : lts₂.τSTr s₂ s₂') :
-    ∃ s₁', lts₁.τSTr s₁ s₁' ∧ r s₁' s₂' := by
-  induction hstr
-  case refl =>
-    exists s₁
-    constructor; constructor
-    exact hr
-  case tail sb hrsb htrsb ih1 ih2 =>
-    obtain ⟨sb2, htrsb2, hrb⟩ := ih2
-    have h := (hswb hrb HasTau.τ).right _ ih1
-    obtain ⟨sb2', htrsb2', hrb'⟩ := h
-    exists sb2'
-    constructor
-    · simp only [sTr_τSTr] at htrsb htrsb2'
-      exact Relation.ReflTransGen.trans htrsb2 htrsb2'
-    · exact hrb'
+lemma IsSWBisimulation.isSimulation [HasTau Label] (h : IsSWBisimulation lts₁ lts₂ r) :
+    IsSimulation lts₁ lts₂.saturate r := by
+  intro s₁ s₂ hr μ
+  exact (h hr μ).1
+
+lemma IsSWBisimulation.isSimulation_flip [HasTau Label] (h : IsSWBisimulation lts₁ lts₂ r) :
+    IsSimulation lts₂ lts₁.saturate (flip r) := by
+  intro s₂ s₁ hr μ
+  exact (h hr μ).2
+
+theorem IsSWBisimulation.iff_isSimulation [HasTau Label] :
+    IsSWBisimulation lts₁ lts₂ r ↔
+      IsSimulation lts₁ lts₂.saturate r ∧ IsSimulation lts₂ lts₁.saturate (flip r) := by
+  refine ⟨fun h => ⟨h.isSimulation, h.isSimulation_flip⟩, ?_⟩
+  intro ⟨h, hflip⟩ s₁ s₂ hr μ
+  exact ⟨h hr μ, hflip hr μ⟩
 
 /-- We can now prove that any relation is a `WeakBisimulation` iff it is an `SWBisimulation`.
 This formalises lemma 4.2.10 in [Sangiorgi2011]. -/
@@ -885,59 +549,15 @@ theorem isWeakBisimulation_iff_isSWBisimulation
     IsWeakBisimulation lts₁ lts₂ r ↔ IsSWBisimulation lts₁ lts₂ r := by
   apply Iff.intro
   case mp =>
-    intro h s₁ s₂ hr μ
-    apply And.intro
-    case left =>
-      intro s₁' htr
-      specialize h hr μ
-      have h' := h.1 s₁' (STr.single lts₁ htr)
-      obtain ⟨s₂', htr2, hr2⟩ := h'
-      exists s₂'
-    case right =>
-      intro s₂' htr
-      specialize h hr μ
-      have h' := h.2 s₂' (STr.single lts₂ htr)
-      obtain ⟨s₁', htr1, hr1⟩ := h'
-      exists s₁'
+    intro h
+    rw [IsSWBisimulation.iff_isSimulation]
+    exact ⟨h.isSimulation.mono lts₁.tr_le_tr_saturate le_rfl,
+      h.inv.isSimulation.mono lts₂.tr_le_tr_saturate le_rfl⟩
   case mpr =>
-    intro h s₁ s₂ hr μ
-    apply And.intro
-    case left =>
-      intro s₁' hstr
-      cases hstr
-      case refl =>
-        exists s₂
-        constructor; constructor
-        exact hr
-      case tr sb sb' hstr1 htr hstr2 =>
-        rw [←sTr_τSTr] at hstr1 hstr2
-        simp only [sTr_τSTr] at hstr1 hstr2
-        obtain ⟨sb1, hstr1b, hrb⟩ := IsSWBisimulation.follow_internal_fst h hr hstr1
-        obtain ⟨sb2', hstr1b', hrb'⟩ := (h hrb μ).left _ htr
-        obtain ⟨s₁', hstr1', hrb2⟩ := IsSWBisimulation.follow_internal_fst h hrb' hstr2
-        rw [←sTr_τSTr] at hstr1' hstr1b
-        exists s₁'
-        constructor
-        · exact STr.comp lts₂ hstr1b hstr1b' hstr1'
-        · exact hrb2
-    case right =>
-      intro s₂' hstr
-      cases hstr
-      case refl =>
-        exists s₁
-        constructor; constructor
-        exact hr
-      case tr sb sb' hstr1 htr hstr2 =>
-        rw [←sTr_τSTr] at hstr1 hstr2
-        simp only [sTr_τSTr] at hstr1 hstr2
-        obtain ⟨sb1, hstr1b, hrb⟩ := IsSWBisimulation.follow_internal_snd h hr hstr1
-        obtain ⟨sb2', hstr1b', hrb'⟩ := (h hrb μ).right _ htr
-        obtain ⟨s₁', hstr1', hrb2⟩ := IsSWBisimulation.follow_internal_snd h hrb' hstr2
-        rw [←sTr_τSTr] at hstr1' hstr1b
-        exists s₁'
-        constructor
-        · exact STr.comp lts₁ hstr1b hstr1b' hstr1'
-        · exact hrb2
+    intro h
+    rw [IsWeakBisimulation, IsBisimulation.isSimulation_iff]
+    exact ⟨h.isSimulation.isSimulation_saturate_left,
+      h.isSimulation_flip.isSimulation_saturate_left⟩
 
 theorem IsWeakBisimulation.isSwBisimulation
     [HasTau Label] {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label} {r : State₁ → State₂ → Prop}
diff --git a/Cslib/Foundations/Semantics/LTS/ExampleTermination.lean b/Cslib/Foundations/Semantics/LTS/ExampleTermination.lean
new file mode 100644
index 0000000000..a8010801a7
--- /dev/null
+++ b/Cslib/Foundations/Semantics/LTS/ExampleTermination.lean
@@ -0,0 +1,78 @@
+/-
+Copyright (c) 2026 Samuel Schlesinger. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Samuel Schlesinger
+-/
+
+module
+
+public import Cslib.Foundations.Semantics.LTS.Termination
+public import Mathlib.Order.WellFounded
+
+/-!
+# Examples separating boundedness, termination, and acyclicity
+
+On infinite state spaces, boundedness, termination, and acyclicity are distinct properties.
+This file gives concrete LTSs witnessing that the converses in
+`Bounded → Terminating → Acyclic` do not hold in general.
+-/
+
+@[expose] public section
+
+namespace Cslib.LTS.Example
+
+/-- The countdown LTS takes a natural number to its predecessor. -/
+def countdownLTS : LTS ℕ Unit where
+  Tr n _ m := n = m + 1
+
+instance countdownLTS_terminating : countdownLTS.Terminating where
+  terminating := by
+    apply Subrelation.wf _ Nat.lt_wfRel.wf
+    rintro s2 s1 ⟨_, rfl⟩
+    exact Nat.lt_succ_self s2
+
+example : countdownLTS.Acyclic := inferInstance
+example : Relation.Acyclic countdownLTS.UnlabelledTr := inferInstance
+
+private theorem countdownLTS_mTr (n : ℕ) :
+    countdownLTS.MTr n (List.replicate n ()) 0 := by
+  induction n with
+  | zero => exact .refl
+  | succ n ih =>
+      simpa [List.replicate_succ] using MTr.stepL (by simp [countdownLTS]) ih
+
+/-- The countdown LTS is not bounded. -/
+theorem countdownLTS_not_bounded : ¬ countdownLTS.Bounded := by
+  rintro ⟨bound, hbound⟩
+  simpa using hbound bound (List.replicate bound ()) 0 (countdownLTS_mTr bound)
+
+/-- The successor LTS takes each natural number to its successor. -/
+def successorLTS : LTS ℕ Unit where
+  Tr n _ m := m = n + 1
+
+private theorem successorLTS_transGen_lt {n m : ℕ}
+    (h : Relation.TransGen successorLTS.UnlabelledTr n m) : n < m := by
+  apply Relation.transGen_minimal (r' := (· < ·)) at h
+  · exact h
+  · rintro n m ⟨μ, htr⟩
+    simp only [successorLTS] at htr
+    omega
+
+instance successorLTS_acyclic : successorLTS.Acyclic where
+  acyclic := ⟨fun n h => (Nat.lt_irrefl n) (successorLTS_transGen_lt h)⟩
+
+/-- The successor LTS is not terminating. -/
+theorem successorLTS_not_terminating : ¬ successorLTS.Terminating := by
+  intro h
+  exact (Relation.Terminating.iff_isEmpty_chain.mp h.terminating).false
+    ⟨fun n => n, fun n => ⟨(), by simp [successorLTS]⟩⟩
+
+/-- The self-loop LTS has a transition from its unique state to itself. -/
+def selfLoopLTS : LTS Unit Unit where
+  Tr _ _ _ := True
+
+/-- The self-loop LTS is not acyclic. -/
+theorem selfLoopLTS_not_acyclic : ¬ selfLoopLTS.Acyclic :=
+  fun h => h.acyclic.irrefl () (.single ⟨(), trivial⟩)
+
+end Cslib.LTS.Example
diff --git a/Cslib/Foundations/Semantics/LTS/Execution.lean b/Cslib/Foundations/Semantics/LTS/Execution.lean
index ac51c2a1c8..37dc1089bf 100644
--- a/Cslib/Foundations/Semantics/LTS/Execution.lean
+++ b/Cslib/Foundations/Semantics/LTS/Execution.lean
@@ -84,6 +84,11 @@ theorem Execution.to_mTr (hexec : lts.Execution s1 μs s2 ss) :
         apply this
       · grind
 
+/-- The states visited by an execution form a chain in the underlying unlabelled relation. -/
+theorem Execution.isChain (hexec : lts.Execution s1 μs s2 ss) :
+    ss.IsChain lts.UnlabelledTr := by
+  grind [Execution, List.isChain_iff_getElem, UnlabelledTr]
+
 open scoped Execution
 /-- Correspondence of multistep transitions and executions. -/
 @[scoped grind =]
@@ -131,11 +136,4 @@ theorem Execution.split
   simp [Execution]
   grind
 
-/-- A multistep transition over a concatenation can be split into two multistep transitions. -/
-theorem MTr.split {lts : LTS State Label} {s0 : State} {μs1 μs2 : List Label} {s2 : State}
-    (h : lts.MTr s0 (μs1 ++ μs2) s2) : ∃ s1, lts.MTr s0 μs1 s1 ∧ lts.MTr s1 μs2 s2 := by
-  obtain ⟨ss, h_ss⟩ := Execution.of_mTr h
-  have := Execution.split h_ss μs1.length
-  grind
-
 end Cslib.LTS
diff --git a/Cslib/Foundations/Semantics/LTS/HasTau.lean b/Cslib/Foundations/Semantics/LTS/HasTau.lean
index 9deb34d449..89643fdff6 100644
--- a/Cslib/Foundations/Semantics/LTS/HasTau.lean
+++ b/Cslib/Foundations/Semantics/LTS/HasTau.lean
@@ -23,16 +23,23 @@ class HasTau (Label : Type v) where
   /-- The internal transition label, also known as τ. -/
   τ : Label
 
+/-- Checking whether an element is `τ` is decidable. -/
+abbrev DecidableEqTau (α : Type*) [HasTau α] := ∀ a : α, Decidable (a = HasTau.τ)
+
 namespace LTS
 
 /-- Saturated τ-transition relation. -/
 def τSTr [HasTau Label] (lts : LTS State Label) : State → State → Prop :=
   Relation.ReflTransGen (Tr.toRelation lts HasTau.τ)
 
+@[scoped grind .]
+theorem τSTr.refl [HasTau Label] {lts : LTS State Label} : lts.τSTr s s :=
+  Relation.ReflTransGen.refl
+
 /-- Saturated transition relation. -/
 inductive STr [HasTau Label] (lts : LTS State Label) : State → Label → State → Prop where
-| refl : lts.STr s HasTau.τ s
-| tr : lts.τSTr s1 s2 → lts.Tr s2 μ s3 → lts.τSTr s3 s4 → lts.STr s1 μ s4
+  | refl : lts.STr s HasTau.τ s
+  | tr : lts.τSTr s1 s2 → lts.Tr s2 μ s3 → lts.τSTr s3 s4 → lts.STr s1 μ s4
 
 /-- The `LTS` obtained by saturating the transition relation in `lts`. -/
 @[scoped grind =]
@@ -44,14 +51,17 @@ theorem saturate_tr_sTr [HasTau Label] {lts : LTS State Label} :
   lts.saturate.Tr = lts.STr := by rfl
 
 /-- Any transition is also a saturated transition. -/
-theorem STr.single [HasTau Label] (lts : LTS State Label) :
+theorem STr.single [HasTau Label] {lts : LTS State Label} :
     lts.Tr s μ s' → lts.STr s μ s' := by
   intro h
   apply STr.tr .refl h .refl
 
+lemma tr_le_tr_saturate [HasTau Label] (lts : LTS State Label) : lts.Tr ≤ lts.saturate.Tr :=
+  fun _ _ _ => STr.single
+
 /-- STr transitions labeled by HasTau.τ are exactly the τSTr transitions. -/
-theorem sTr_τSTr [HasTau Label] (lts : LTS State Label) :
-  lts.STr s HasTau.τ s' ↔ lts.τSTr s s' := by
+theorem sTr_τSTr_iff [HasTau Label] (lts : LTS State Label) :
+    lts.STr s HasTau.τ s' ↔ lts.τSTr s s' := by
   apply Iff.intro <;> intro h
   case mp =>
     cases h
@@ -64,14 +74,14 @@ theorem sTr_τSTr [HasTau Label] (lts : LTS State Label) :
     case tail _ h1 h2 => exact STr.tr h1 h2 .refl
 
 /-- In a saturated LTS, the transition and saturated transition relations are the same. -/
-theorem saturate_τSTr_τSTr [hHasTau : HasTau Label] (lts : LTS State Label)
-  : lts.saturate.τSTr s = lts.τSTr s := by
-  ext s''
+theorem saturate_τsTr_τSTr_iff [hHasTau : HasTau Label] (lts : LTS State Label) :
+    lts.saturate.τSTr = lts.τSTr := by
+  ext s s'
   apply Iff.intro <;> intro h
   case mp =>
     induction h
     case refl => constructor
-    case tail _ _ _ h2 h3 => exact Relation.ReflTransGen.trans h3 ((sTr_τSTr _).mp h2)
+    case tail _ _ _ h2 h3 => exact Relation.ReflTransGen.trans h3 ((sTr_τSTr_iff _).mp h2)
   case mpr =>
     cases h
     case refl => constructor
@@ -82,31 +92,31 @@ theorem saturate_τSTr_τSTr [hHasTau : HasTau Label] (lts : LTS State Label)
 /-- Saturated transitions labelled by τ can be composed. -/
 @[scoped grind .]
 theorem STr.trans_τ
-  [HasTau Label] (lts : LTS State Label)
-  (h1 : lts.STr s1 HasTau.τ s2) (h2 : lts.STr s2 HasTau.τ s3) :
-  lts.STr s1 HasTau.τ s3 := by
-  rw [sTr_τSTr _] at h1 h2
-  rw [sTr_τSTr _]
+    [HasTau Label] {lts : LTS State Label}
+    (h1 : lts.STr s1 HasTau.τ s2) (h2 : lts.STr s2 HasTau.τ s3) :
+    lts.STr s1 HasTau.τ s3 := by
+  rw [sTr_τSTr_iff _] at h1 h2
+  rw [sTr_τSTr_iff _]
   apply Relation.ReflTransGen.trans h1 h2
 
 /-- Saturated transitions can be composed. -/
 theorem STr.comp
-  [HasTau Label] (lts : LTS State Label)
-  (h1 : lts.STr s1 HasTau.τ s2)
-  (h2 : lts.STr s2 μ s3)
-  (h3 : lts.STr s3 HasTau.τ s4) :
+    [HasTau Label] {lts : LTS State Label}
+    (h1 : lts.STr s1 HasTau.τ s2)
+    (h2 : lts.STr s2 μ s3)
+    (h3 : lts.STr s3 HasTau.τ s4) :
   lts.STr s1 μ s4 := by
-  rw [sTr_τSTr _] at h1 h3
+  rw [sTr_τSTr_iff _] at h1 h3
   cases h2
   case refl =>
-    rw [sTr_τSTr _]
+    rw [sTr_τSTr_iff _]
     apply Relation.ReflTransGen.trans h1 h3
   case tr _ _ hτ1 htr hτ2 =>
     exact STr.tr (Relation.ReflTransGen.trans h1 hτ1) htr (Relation.ReflTransGen.trans hτ2 h3)
 
 /-- In a saturated LTS, the transition and saturated transition relations are the same. -/
 theorem saturate_tr_saturate_sTr [hHasTau : HasTau Label] (lts : LTS State Label)
-  (hμ : μ = hHasTau.τ) : lts.saturate.Tr s μ = lts.saturate.STr s μ := by
+    (hμ : μ = hHasTau.τ) : lts.saturate.Tr s μ = lts.saturate.STr s μ := by
   ext s'
   apply Iff.intro <;> intro h
   case mp =>
@@ -119,20 +129,104 @@ theorem saturate_tr_saturate_sTr [hHasTau : HasTau Label] (lts : LTS State Label
     cases h
     case refl => constructor
     case tr hstr1 htr hstr2 =>
-      rw [saturate_τSTr_τSTr lts] at hstr1 hstr2
-      rw [←sTr_τSTr lts] at hstr1 hstr2
-      exact STr.comp lts hstr1 htr hstr2
+      rw [saturate_τsTr_τSTr_iff lts] at hstr1 hstr2
+      rw [←sTr_τSTr_iff lts] at hstr1 hstr2
+      exact STr.comp hstr1 htr hstr2
 
 /-- In a saturated LTS, every state is in its τ-image. -/
 @[scoped grind .]
-theorem mem_saturate_image_τ [HasTau Label] (lts : LTS State Label) :
+lemma mem_saturate_image_τ [HasTau Label] (lts : LTS State Label) :
   s ∈ lts.saturate.image s HasTau.τ := STr.refl
 
+/-- Monotonicity of `setImage` on `HasTau.τ`. -/
+@[scoped grind .]
+lemma subset_saturate_setImage_τ [HasTau Label] (lts : LTS State Label) :
+    S ⊆ lts.saturate.setImage S HasTau.τ := by
+  grind [setImage, Set.mem_iUnion]
+
+/-- `setImage` preserves (non-)emptyness. -/
+@[scoped grind =]
+lemma empty_saturate_setImage_τ [HasTau Label] (lts : LTS State Label) :
+    lts.saturate.setImage S HasTau.τ = ∅ ↔ S = ∅:= by grind [Set.mem_of_mem_of_subset]
+
 /-- The `τ`-closure of a set of states `S` is the set of states reachable by any state in `S`
 by performing only `τ`-transitions. -/
 def τClosure [HasTau Label] (lts : LTS State Label) (S : Set State) : Set State :=
   lts.saturate.setImage S HasTau.τ
 
+/-- Monotonicity of `setImage` on `HasTau.τ`. -/
+@[scoped grind .]
+lemma τClosure_subset [HasTau Label] (lts : LTS State Label) :
+    S ⊆ lts.τClosure S := by grind [Set.mem_of_mem_of_subset, = τClosure]
+
+/-- Saturated multistep transition relation. -/
+inductive SMTr [HasTau Label] (lts : LTS State Label) : State → List Label → State → Prop where
+  | τ : lts.STr s HasTau.τ s' → lts.SMTr s [] s'
+  | stepL : lts.STr s1 μ s2 → lts.SMTr s2 μs s3 → lts.SMTr s1 (μ :: μs) s3
+
+/-- The saturated multistep transition relation is reflexive. -/
+@[scoped grind .]
+theorem SMTr.refl [HasTau Label] (lts : LTS State Label) (s : State) :
+    lts.SMTr s [] s := by grind [LTS.STr, LTS.SMTr]
+
+open scoped LTS.STr
+
+/-- The saturated multistep transition relation is transitive. -/
+@[scoped grind .]
+theorem SMTr.comp [HasTau Label] {lts : LTS State Label}
+    (h₁ : lts.SMTr s₁ μs₁ s₂) (h₂ : lts.SMTr s₂ μs₂ s₃) : lts.SMTr s₁ (μs₁ ++ μs₂) s₃ := by
+  induction h₁
+  case τ s₁ s₂ htr =>
+    cases h₂
+    case τ htr' => grind [SMTr]
+    case stepL _ _ _ μ s₂' μs hstr hmstr => exact stepL (htr.comp hstr STr.refl) hmstr
+  case stepL s₁ μ s₁' μs s₂ hstr hmstr ih =>
+    apply stepL hstr (ih h₂)
+
+/-- A multistep transition implies a saturated multistep transition. -/
+@[scoped grind .]
+theorem SMTr.fromMTr [HasTau Label] {lts : LTS State Label}
+    (h : lts.MTr s μs s') : lts.SMTr s μs s' := by
+  induction μs generalizing s s'
+  case nil => grind [LTS.STr, LTS.SMTr]
+  case cons x xs ih =>
+    cases h
+    case stepL sb htr hmtr => exact SMTr.stepL (STr.single htr) (ih hmtr)
+
+@[scoped grind =]
+theorem sMTr_τSTr_iff [HasTau Label] {lts : LTS State Label} :
+    lts.τSTr s s' ↔ lts.SMTr s [] s' := by grind only [=_ sTr_τSTr_iff, SMTr]
+
+/-- A saturated multistep transition with a nonempty label list implies a multistep transition. -/
+@[scoped grind =]
+theorem saturate_mTr_sMTr_not_nil_iff [HasTau Label] {lts : LTS State Label}
+    (hμs : μs ≠ []) : lts.saturate.MTr s μs s' ↔ lts.SMTr s μs s' := by
+  induction μs generalizing s
+  case nil => contradiction
+  case cons x xs ih =>
+    apply Iff.intro <;> intro h
+    case mp =>
+      cases h
+      case stepL sb htr hmtr =>
+        cases xs with
+        | nil =>
+          cases hmtr
+          apply LTS.SMTr.stepL htr (by grind only [SMTr.fromMTr, MTr.refl])
+        | cons x' xs' =>
+          exact LTS.SMTr.stepL htr ((ih (by simp)).mp hmtr)
+    case mpr =>
+      cases h
+      case stepL sb htr hmtr =>
+        cases xs with
+        | nil =>
+          cases hmtr
+          case τ h_τ =>
+            exact LTS.MTr.stepL
+              (LTS.STr.comp LTS.STr.refl htr h_τ)
+              LTS.MTr.refl
+        | cons x' xs' =>
+          exact LTS.MTr.stepL htr ((ih (by simp)).mpr hmtr)
+
 end LTS
 
 end Cslib
diff --git a/Cslib/Foundations/Semantics/LTS/LTSCat/Basic.lean b/Cslib/Foundations/Semantics/LTS/LTSCat/Basic.lean
index 9c40c3dcd5..d1e578db87 100644
--- a/Cslib/Foundations/Semantics/LTS/LTSCat/Basic.lean
+++ b/Cslib/Foundations/Semantics/LTS/LTSCat/Basic.lean
@@ -35,11 +35,11 @@ def LTS.withIdle (lts : LTS State Label) : LTS State (Option Label) :=
 
 /-! ## LTSs and LTS morphisms form a category -/
 
+set_option linter.checkUnivs false in
 /--
 The definition of labelled transition system (with the type of states and the
 type of labels as part of the structure).
 -/
-@[nolint checkUnivs]
 structure LTSCat : Type (max u v + 1) where
   /-- Type of states of an LTS -/
   State : Type u
diff --git a/Cslib/Foundations/Semantics/LTS/MapLabel.lean b/Cslib/Foundations/Semantics/LTS/MapLabel.lean
new file mode 100644
index 0000000000..aa13af30ba
--- /dev/null
+++ b/Cslib/Foundations/Semantics/LTS/MapLabel.lean
@@ -0,0 +1,41 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Foundations.Semantics.LTS.Basic
+
+
+/-!
+# Label map operation for LTS.
+-/
+
+@[expose] public section
+
+namespace Cslib.LTS
+
+section MapLabel
+
+/-- Constructs an LTS by mapping its labels into those of an existing LTS. -/
+def mapLabel (lts : LTS State Label₁) (f : Label₂ → Label₁) : LTS State Label₂ where
+  Tr s μ s' := lts.Tr s (f μ) s'
+
+@[simp]
+theorem mapLabel_tr {lts : LTS State Label₁} :
+    (lts.mapLabel f).Tr s μ s' ↔ lts.Tr s (f μ) s' := by rfl
+
+scoped grind_pattern mapLabel_tr => (lts.mapLabel f).Tr s μ s'
+
+@[simp, scoped grind =]
+theorem mapLabel_mTr {lts : LTS State Label₁} {f : Label₂ → Label₁} :
+    (lts.mapLabel f).MTr s μs s' ↔ lts.MTr s (μs.map f) s' := by
+  induction μs generalizing s with
+  | nil => grind
+  | cons μ μs ih => grind [=_ mapLabel_tr (f := f)]
+
+end MapLabel
+
+end Cslib.LTS
diff --git a/Cslib/Foundations/Semantics/LTS/Relation.lean b/Cslib/Foundations/Semantics/LTS/Relation.lean
index c087357b44..3253fa3ebb 100644
--- a/Cslib/Foundations/Semantics/LTS/Relation.lean
+++ b/Cslib/Foundations/Semantics/LTS/Relation.lean
@@ -32,6 +32,61 @@ labels `μs`. -/
 def MTr.toRelation (lts : LTS State Label) (μs : List Label) : State → State → Prop :=
   fun s1 s2 => lts.MTr s1 μs s2
 
+section UnlabelledPaths
+
+variable (lts : LTS State Label)
+
+/-- A multistep transition induces a reflexive-transitive path in the underlying unlabelled
+transition relation. -/
+theorem MTr.toReflTransGen (h : lts.MTr s1 μs s2) :
+    Relation.ReflTransGen lts.UnlabelledTr s1 s2 := by
+  induction h with
+  | refl => exact .refl
+  | stepL htr _ ih => exact ih.head ⟨_, htr⟩
+
+/-- A nonempty multistep transition induces a nonempty path in the underlying unlabelled
+transition relation. -/
+theorem MTr.toTransGen (h : lts.MTr s1 μs s2) (hne : μs ≠ []) :
+    Relation.TransGen lts.UnlabelledTr s1 s2 := by
+  cases h with
+  | refl => contradiction
+  | stepL htr hmtr => exact Relation.TransGen.head' ⟨_, htr⟩ (hmtr.toReflTransGen lts)
+
+/-- The reflexive-transitive closure of the underlying unlabelled transition relation is exactly
+reachability in the LTS. -/
+theorem reflTransGen_unlabelledTr_iff :
+    Relation.ReflTransGen lts.UnlabelledTr s1 s2 ↔ lts.CanReach s1 s2 := by
+  constructor
+  · intro h
+    induction h with
+    | refl => exact ⟨[], .refl⟩
+    | tail _ htr ih =>
+        obtain ⟨μs, hmtr⟩ := ih
+        obtain ⟨μ, htr⟩ := htr
+        exact ⟨μs ++ [μ], hmtr.stepR lts htr⟩
+  · rintro ⟨μs, hmtr⟩
+    exact hmtr.toReflTransGen lts
+
+/-- The transitive closure of the underlying unlabelled transition relation is exactly the
+nonempty multistep transitions of the LTS. -/
+theorem transGen_unlabelledTr_iff :
+    Relation.TransGen lts.UnlabelledTr s1 s2 ↔
+      ∃ μs, μs ≠ [] ∧ lts.MTr s1 μs s2 := by
+  constructor
+  · intro h
+    induction h with
+    | single htr =>
+        obtain ⟨μ, htr⟩ := htr
+        exact ⟨[μ], by simp, MTr.single lts htr⟩
+    | tail _ htr ih =>
+        obtain ⟨μs, hne, hmtr⟩ := ih
+        obtain ⟨μ, htr⟩ := htr
+        exact ⟨μs ++ [μ], by simp, hmtr.stepR lts htr⟩
+  · rintro ⟨μs, hne, hmtr⟩
+    exact hmtr.toTransGen lts hne
+
+end UnlabelledPaths
+
 /-! ### Calc tactic support for MTr -/
 
 /-- Transitions can be chained. -/
diff --git a/Cslib/Foundations/Semantics/LTS/Reverse.lean b/Cslib/Foundations/Semantics/LTS/Reverse.lean
new file mode 100644
index 0000000000..83c003acd7
--- /dev/null
+++ b/Cslib/Foundations/Semantics/LTS/Reverse.lean
@@ -0,0 +1,121 @@
+/-
+Copyright (c) 2026 Vignesh Karri. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Vignesh Karri
+-/
+
+module
+
+public import Cslib.Foundations.Semantics.LTS.Execution
+
+/-!
+# Reverse operation for LTS
+
+This file defines `Cslib.LTS.reverse`, which reverses every transition of an LTS.
+`reverse_canReach`, `reverse_unlabelledTr`, `reverse_image`, `reverse_imageMultistep`,
+`reverse_hasOutLabel` and `reverse_boundedUpTo` each state a property about `lts.reverse` in
+terms of `lts`.
+
+`reverse_mTr` states that the multistep transitions of `lts.reverse` are the reversed
+multistep transitions of `lts`. `reverse_execution` is the same statement for
+executions, and is derived from `Execution.reverse`.
+-/
+
+@[expose] public section
+
+namespace Cslib.LTS
+
+variable {State Label : Type*}
+
+section Reverse
+
+/-- Constructs an LTS by reversing the transitions of an existing LTS. -/
+def reverse (lts : LTS State Label) : LTS State Label where
+  Tr s μ s' := lts.Tr s' μ s
+
+/-- The transitions of `lts.reverse` are exactly the reversed transitions of `lts`. -/
+@[simp]
+theorem reverse_tr {lts : LTS State Label} :
+    (lts.reverse).Tr s μ s' ↔ lts.Tr s' μ s := by rfl
+
+/-- Reversing an LTS twice gives back the original LTS. -/
+@[simp]
+theorem reverse_reverse (lts : LTS State Label) : lts.reverse.reverse = lts := rfl
+
+/-- Reversal of an LTS is an involution. -/
+theorem reverse_involutive : Function.Involutive (reverse (Label := Label) (State := State)) :=
+  reverse_reverse
+
+/-- The multistep transitions of `lts.reverse` are exactly the reversed multistep transitions of
+`lts`. -/
+@[simp]
+theorem reverse_mTr {lts : LTS State Label} :
+    lts.reverse.MTr s' μs s ↔ lts.MTr s μs.reverse s' := by
+  induction μs generalizing s s' with
+  | nil =>
+    simp [eq_comm]
+  | cons x xs ih =>
+    simp_rw [List.reverse_cons, MTr.append_iff, MTr.singleton_iff, MTr.cons_iff, and_comm, ih,
+      reverse_tr]
+
+/-- `lts.reverse` can reach `s'` from `s` iff `lts` can reach `s` from `s'`. -/
+@[simp]
+theorem reverse_canReach {lts : LTS State Label} :
+    lts.reverse.CanReach s s' ↔ lts.CanReach s' s := by
+  simp only [CanReach, reverse_mTr]
+  conv_rhs => rw [List.reverse_involutive.surjective.exists]
+
+/-- The unlabelled transitions of `lts.reverse` are those of `lts` with the endpoints swapped. -/
+@[simp]
+theorem reverse_unlabelledTr {lts : LTS State Label} :
+    lts.reverse.UnlabelledTr s s' ↔ lts.UnlabelledTr s' s := Iff.rfl
+
+/-- The `μ`-image of a state in `lts.reverse` is its `μ`-preimage in `lts`. -/
+@[simp]
+theorem reverse_image {lts : LTS State Label} :
+    lts.reverse.image s μ = {s' | lts.Tr s' μ s} := rfl
+
+/-- Membership form of `reverse_image`. -/
+theorem mem_reverse_image {lts : LTS State Label} :
+    s' ∈ lts.reverse.image s μ ↔ s ∈ lts.image s' μ := Iff.rfl
+
+/-- The `μs`-image of a state in `lts.reverse` is its `μs.reverse`-preimage in `lts`. -/
+@[simp]
+theorem reverse_imageMultistep {lts : LTS State Label} :
+    lts.reverse.imageMultistep s μs = {s' | lts.MTr s' μs.reverse s} :=
+  Set.ext fun _ => reverse_mTr
+
+/-- Membership version of `reverse_imageMultistep`. -/
+theorem mem_reverse_imageMultistep {lts : LTS State Label} :
+    s' ∈ lts.reverse.imageMultistep s μs ↔ s ∈ lts.imageMultistep s' μs.reverse := reverse_mTr
+
+/-- A state has `μ` as an outgoing label in `lts.reverse` iff it has `μ` as an incoming
+label in `lts`. -/
+@[simp]
+theorem reverse_hasOutLabel {lts : LTS State Label} :
+    lts.reverse.HasOutLabel s μ ↔ ∃ s', lts.Tr s' μ s := Iff.rfl
+
+/-- `lts.reverse` is bounded up to `n` iff `lts` is. -/
+@[simp]
+theorem reverse_boundedUpTo {lts : LTS State Label} {n : ℕ} :
+    lts.reverse.BoundedUpTo n ↔ lts.BoundedUpTo n := by
+  constructor <;> intro h s₁ μs s₂ hmtr <;> simpa using h s₂ μs.reverse s₁ (by simpa using hmtr)
+
+/-- Reversing an execution of `lts` gives an execution of `lts.reverse`, with the labels, states
+and endpoints reversed. -/
+theorem Execution.reverse {lts : LTS State Label} (h : lts.Execution s μs s' ss) :
+    lts.reverse.Execution s' μs.reverse s ss.reverse := by
+  obtain ⟨_, _, _, _⟩ := h
+  use by simpa
+  grind only [reverse_tr, = List.getElem_reverse, = List.length_reverse]
+
+/-- An execution of `lts.reverse` is an execution of `lts` with the labels, states
+and endpoints reversed. -/
+@[simp]
+theorem reverse_execution {lts : LTS State Label} :
+    lts.reverse.Execution s μs s' ss ↔ lts.Execution s' μs.reverse s ss.reverse :=
+  ⟨fun h => h.reverse, fun h => by simpa using h.reverse⟩
+
+end Reverse
+
+end Cslib.LTS
diff --git a/Cslib/Foundations/Semantics/LTS/Simulation.lean b/Cslib/Foundations/Semantics/LTS/Simulation.lean
index cf401de048..72d70a6268 100644
--- a/Cslib/Foundations/Semantics/LTS/Simulation.lean
+++ b/Cslib/Foundations/Semantics/LTS/Simulation.lean
@@ -6,7 +6,7 @@ Authors: Fabrizio Montesi
 
 module
 
-public import Cslib.Foundations.Semantics.LTS.Basic
+public import Cslib.Foundations.Semantics.LTS.HasTau
 
 /-! # IsSimulation and Similarity
 
@@ -54,7 +54,7 @@ any transition originating from the first state is mimicked by a transition from
 and the reached derivatives are themselves related. -/
 def IsSimulation (lts₁ : LTS State₁ Label) (lts₂ : LTS State₂ Label) (r : State₁ → State₂ → Prop) :
     Prop :=
-  ∀ s₁ s2, r s₁ s2 → ∀ μ s₁', lts₁.Tr s₁ μ s₁' → ∃ s2', lts₂.Tr s2 μ s2' ∧ r s₁' s2'
+  ∀ ⦃s₁ s₂⦄, r s₁ s₂ → ∀ μ s₁', lts₁.Tr s₁ μ s₁' → ∃ s₂', lts₂.Tr s₂ μ s₂' ∧ r s₁' s₂'
 
 /-- A homogeneous simulation is a simulation where the underlying LTSs are the same. -/
 abbrev IsHomSimulation (lts : LTS State Label) := IsSimulation lts lts
@@ -89,31 +89,40 @@ theorem IsSimulation.comp
     (r2 : State₂ → State₃ → Prop)
     (h1 : IsSimulation lts₁ lts₂ r1) (h2 : IsSimulation lts₂ lts₃ r2) :
     IsSimulation lts₁ lts₃ (Relation.Comp r1 r2) := by
-  simp_all only [IsSimulation]
   intro s₁ s2 hrc μ s₁' htr
   rcases hrc with ⟨sb, hr1, hr2⟩
-  specialize h1 s₁ sb hr1 μ
-  specialize h2 sb s2 hr2 μ
-  have h1' := h1 s₁' htr
-  obtain ⟨s₁'', h1'tr, h1'⟩ := h1'
-  have h2' := h2 s₁'' h1'tr
-  obtain ⟨s2'', h2'tr, h2'⟩ := h2'
-  exists s2''
-  constructor
-  · exact h2'tr
-  · exists s₁''
+  obtain ⟨s₁'', h1'tr, h1'⟩ := h1 hr1 μ s₁' htr
+  obtain ⟨s2'', h2'tr, h2'⟩ := h2 hr2 μ s₁'' h1'tr
+  use s2'', h2'tr, s₁'', h1', h2'
 
 /-- Similarity is transitive. -/
 theorem Similarity.trans (h1 : s₁ ≤[lts₁,lts₂] s2) (h2 : s2 ≤[lts₂,lts₃] s₃) :
     s₁ ≤[lts₁,lts₃] s₃ := by
   obtain ⟨r1, hr1, hr1s⟩ := h1
   obtain ⟨r2, hr2, hr2s⟩ := h2
-  exists Relation.Comp r1 r2
-  constructor
-  case left =>
-    exists s2
-  case right =>
-    apply IsSimulation.comp r1 r2 hr1s hr2s
+  use! Relation.Comp r1 r2, s2, hr1, hr2, IsSimulation.comp r1 r2 hr1s hr2s
+
+theorem IsSimulation.sup (hr : IsSimulation lts₁ lts₂ r)
+    (hs : IsSimulation lts₁ lts₂ s) : IsSimulation lts₁ lts₂ (r ⊔ s) := by
+  rintro s₁ s₂ (hrel | hrel) μ s₁' htr
+  · obtain ⟨s₂', htr', hrel'⟩ := hr hrel μ s₁' htr
+    use s₂', htr', Or.inl hrel'
+  · obtain ⟨s₂', htr', hrel'⟩ := hs hrel μ s₁' htr
+    use s₂', htr', Or.inr hrel'
+
+theorem IsSimulation.sim_trace (hr : IsSimulation lts₁ lts₂ r) (hrel : r s₁ s₂) :
+    ∀ μs s₁', lts₁.MTr s₁ μs s₁' → ∃ s₂', lts₂.MTr s₂ μs s₂' ∧ r s₁' s₂' := by
+  intro μs s₁' hmtr
+  induction μs generalizing s₁ s₂ with
+  | nil =>
+    obtain rfl := hmtr.nil_eq
+    exact ⟨s₂, MTr.refl, hrel⟩
+  | cons μ μs ih =>
+    cases hmtr
+    case stepL s₁'' htr hmtr =>
+      obtain ⟨s₂'', htr₂, hrel'⟩: ∃ s2', lts₂.Tr s₂ μ s2' ∧ r s₁'' s2' := hr hrel μ s₁'' htr
+      obtain ⟨s₂', hmtr₂, hrel'⟩ := ih hrel' hmtr
+      use s₂', hmtr₂.stepL htr₂, hrel'
 
 /-- Simulation equivalence relates all states `s₁` and `s2` such that `s₁ ≤[lts₁ lts₂] s2` and
 `s2 ≤[lts₂ lts₁] s₁`. -/
@@ -160,6 +169,62 @@ instance :
     (SimulationEquiv lts₁ lts₃) where
   trans := SimulationEquiv.trans
 
+/-- Helper for following a transition by the first state in a pair of a simulation. -/
+theorem IsSimulation.follow
+    (hb : IsSimulation lts₁ lts₂ r) (hr : r s₁ s₂) (htr : lts₁.Tr s₁ μ s₁') :
+    ∃ s₂', lts₂.Tr s₂ μ s₂' ∧ r s₁' s₂' := hb hr μ _ htr
+
+/-- Utility theorem for following internal transitions along a saturated lts. -/
+lemma IsSimulation.follow_internal [HasTau Label] {lts₁ : LTS State₁ Label}
+    {lts₂ : LTS State₂ Label} (h : IsSimulation lts₁ lts₂.saturate r) (hr : r s₁ s₂)
+    (hstr : lts₁.τSTr s₁ s₁') : ∃ s₂', lts₂.τSTr s₂ s₂' ∧ r s₁' s₂' := by
+  induction hstr
+  case refl =>
+    use s₂, .refl
+  case tail sb hrsb htrsb ih1 ih2 =>
+    obtain ⟨sb2, htrsb2, hrb⟩ := ih2
+    have ⟨sb2', htrsb2', hrb'⟩ := h hrb HasTau.τ _ ih1
+    use sb2', htrsb2.trans (lts₂.sTr_τSTr_iff.mp htrsb2')
+
+/-- If the right-hand lts is saturated, a simulation lifts along saturating the left-hand lts. -/
+theorem IsSimulation.isSimulation_saturate_left [HasTau Label] {lts₁ : LTS State₁ Label}
+    {lts₂ : LTS State₂ Label} (h : IsSimulation lts₁ lts₂.saturate r) :
+    IsSimulation lts₁.saturate lts₂.saturate r := by
+  intro s₁ s₂ hr μ s₁' h
+  cases h
+  case refl =>
+    use s₂, .refl, hr
+  case tr sb sb' hstr1 htr hstr2 =>
+    obtain ⟨sb1, hstr1b, hrb⟩ := IsSimulation.follow_internal h hr hstr1
+    obtain ⟨sb2', hstr1b', hrb'⟩ := h hrb μ _ htr
+    obtain ⟨s₁', hstr1', hrb2⟩ := IsSimulation.follow_internal h hrb' hstr2
+    rw [←sTr_τSTr_iff] at hstr1' hstr1b
+    use s₁', STr.comp hstr1b hstr1b' hstr1', hrb2
+
+/-- Simulation is preserved by removing transitions on the left, and adding transitions on the
+right. -/
+theorem IsSimulation.mono (h₁ : lts₁'.Tr ≤ lts₁.Tr) (h₂ : lts₂.Tr ≤ lts₂'.Tr)
+    (h : IsSimulation lts₁ lts₂ r) : IsSimulation lts₁' lts₂' r := by
+  intro s₁ s₂ hr μ s₁' htr
+  obtain ⟨s₂', htr', hr'⟩ := h hr μ s₁' (h₁ _ _ _ htr)
+  use s₂', h₂ _ _ _ htr', hr'
+
+/-- When a deterministic state matches a transition in a simulation, then the derivatives are still
+in the simulation. -/
+theorem IsSimulation.match_deterministic (hb : IsSimulation lts₁ lts₂ r) (hr : r s₁ s₂)
+    (hdet : lts₂.DeterministicStateLabel s₂ μ) (htr₁ : lts₁.Tr s₁ μ s₁') (htr₂ : lts₂.Tr s₂ μ s₂') :
+    r s₁' s₂' := by
+  grind [follow hb hr]
+
+/-- If a state is deterministic for `μ`, then any transition made by a related state in a
+simulation is matched by a unique transition. -/
+theorem IsSimulation.follow_deterministic (hb : IsSimulation lts₁ lts₂ r) (hr : r s₁ s₂)
+    (hdet : lts₂.DeterministicStateLabel s₂ μ) (htr : lts₁.Tr s₁ μ s₁') :
+    ∃! s₂', lts₂.Tr s₂ μ s₂' ∧ r s₁' s₂' := by
+  obtain ⟨s₂', htr₂, hr₂⟩ := follow hb hr htr
+  exists s₂'
+  grind
+
 end Simulation
 
 end Cslib.LTS
diff --git a/Cslib/Foundations/Semantics/LTS/Termination.lean b/Cslib/Foundations/Semantics/LTS/Termination.lean
index 2203737fb2..6d72fe5cee 100644
--- a/Cslib/Foundations/Semantics/LTS/Termination.lean
+++ b/Cslib/Foundations/Semantics/LTS/Termination.lean
@@ -6,10 +6,16 @@ Authors: Fabrizio Montesi
 
 module
 
-public import Cslib.Foundations.Semantics.LTS.Basic
+public import Cslib.Foundations.Relation.Confluence
+public import Cslib.Foundations.Semantics.LTS.Execution
+public import Mathlib.Data.Fintype.Card
+public import Mathlib.Data.List.Chain
+public import Mathlib.SetTheory.Cardinal.Finite
 
 /-!
 # Termination of LTS
+
+This module relates global execution bounds, well-founded termination, and acyclicity.
 -/
 
 @[expose] public section
@@ -20,6 +26,61 @@ universe u v
 
 variable {State : Type u} {Label : Type v} (lts : LTS State Label) (Terminated : State → Prop)
 
+/-- Bounded LTSs are terminating. -/
+theorem Bounded.toTerminating (h : lts.Bounded) : lts.Terminating := by
+  constructor
+  rw [Relation.Terminating.iff_isEmpty_chain]
+  constructor
+  rintro ⟨f, hf⟩
+  change ∀ n, lts.UnlabelledTr (f n) (f (n + 1)) at hf
+  obtain ⟨bound, hbound⟩ := h.bounded
+  have hpaths : ∀ n, ∃ μs, μs.length = n ∧ lts.MTr (f 0) μs (f n) := by
+    intro n
+    induction n with
+    | zero => exact ⟨[], rfl, .refl⟩
+    | succ n ih =>
+        obtain ⟨μs, hlength, hmtr⟩ := ih
+        obtain ⟨μ, htr⟩ := hf n
+        exact ⟨μs ++ [μ], by simp [hlength], hmtr.stepR lts htr⟩
+  obtain ⟨μs, hlength, hmtr⟩ := hpaths bound
+  have := hbound (f 0) μs (f bound) hmtr
+  omega
+
+/-- A bounded LTS is available as a terminating LTS through typeclass inference. -/
+instance bounded_terminating [lts.Bounded] : lts.Terminating :=
+  (inferInstance : lts.Bounded).toTerminating
+
+/-- Terminating LTSs are acyclic. -/
+theorem Terminating.toAcyclic (h : lts.Terminating) : lts.Acyclic where
+  acyclic := h.terminating.toAcyclic
+
+/-- A terminating LTS is available as an acyclic LTS through typeclass inference. -/
+instance terminating_acyclic [lts.Terminating] : lts.Acyclic :=
+  (inferInstance : lts.Terminating).toAcyclic
+
+/-- On a finite state space, an acyclic LTS has execution length strictly less than the number of
+states. -/
+theorem Acyclic.toBoundedUpTo [Finite State] (h : lts.Acyclic) :
+    lts.BoundedUpTo (Nat.card State) := by
+  classical
+  let := Fintype.ofFinite State
+  rw [Nat.card_eq_fintype_card]
+  intro s1 μs s2 hmtr
+  obtain ⟨states, hexec⟩ := Execution.of_mTr hmtr
+  have hchain : states.IsChain (Relation.TransGen lts.UnlabelledTr) :=
+    hexec.isChain.imp_of_mem_imp fun _ _ _ _ htr => .single htr
+  let : Std.Irrefl (Relation.TransGen lts.UnlabelledTr) := h.acyclic
+  have hcard := hchain.pairwise.nodup.length_le_card
+  grind [Execution]
+
+/-- On a finite state space, acyclic LTSs are bounded. -/
+theorem Acyclic.toBounded [Finite State] (h : lts.Acyclic) : lts.Bounded :=
+  ⟨Nat.card State, h.toBoundedUpTo⟩
+
+/-- On a finite state space, acyclic LTSs are terminating. -/
+theorem Acyclic.toTerminating [Finite State] (h : lts.Acyclic) : lts.Terminating :=
+  h.toBounded.toTerminating
+
 /-- A state 'may terminate' if it can reach a terminated state. The definition of `Terminated`
 is a parameter. -/
 def MayTerminate (s : State) : Prop := ∃ s', Terminated s' ∧ lts.CanReach s s'
diff --git a/Cslib/Foundations/Semantics/LTS/TraceEq.lean b/Cslib/Foundations/Semantics/LTS/TraceEq.lean
index 3e4dbebb48..700ddf0c3b 100644
--- a/Cslib/Foundations/Semantics/LTS/TraceEq.lean
+++ b/Cslib/Foundations/Semantics/LTS/TraceEq.lean
@@ -26,7 +26,8 @@ Definitions and results on trace equivalence for `LTS`s.
 ## Main statements
 
 - `TraceEq.eqv`: trace equivalence is an equivalence relation (see `Equivalence`).
-- `TraceEq.deterministic_sim`: in any deterministic `LTS`, trace equivalence is a simulation.
+- `Deterministic.isSimulation_traceEq`: in any deterministic `LTS`, trace equivalence is a
+  simulation.
 
 -/
 
@@ -34,14 +35,63 @@ Definitions and results on trace equivalence for `LTS`s.
 
 namespace Cslib.LTS
 
+open Deterministic
+
 /-- The traces of a state `s` is the set of all lists of labels `μs` such that there is a multi-step
 transition labelled by `μs` originating from `s`. -/
 def traces (lts : LTS State Label) (s : State) := { μs : List Label | ∃ s', lts.MTr s μs s' }
 
+/-- Definition of `LTS.traces` for general label sequences, ... -/
+theorem mem_traces_iff {lts : LTS State Label} (μs : List Label) :
+  μs ∈ lts.traces s ↔ ∃ s', lts.MTr s μs s' := Iff.rfl
+
+/-- ... singleton sequences, ... -/
+theorem mem_traces_singleton_iff {lts : LTS State Label} (μ : Label) :
+    [μ] ∈ lts.traces s ↔ ∃ s', lts.Tr s μ s' := by
+  simp_rw [mem_traces_iff, MTr.singleton_iff lts s μ]
+
+/-- ... and sequences extended with a single transition. -/
+theorem mem_traces_cons_iff {lts : LTS State Label} (μ : Label) (μs : List Label) :
+    (μ :: μs) ∈ lts.traces s ↔ ∃ s', lts.Tr s μ s' ∧ μs ∈ lts.traces s' := by
+  simp_rw [mem_traces_iff, MTr.cons_iff]
+  grind
+
 /-- If there is a multi-step transition from `s` labelled by `μs`, then `μs` is in the traces of
 `s`. -/
 theorem traces_in {lts : LTS State Label} (h : lts.MTr s μs s') : μs ∈ lts.traces s := by exists s'
 
+/-- In a deterministic lts, a state's traces are determined by any of its predecessors. -/
+theorem Deterministic.traces_of_tr {lts : LTS State Label} [lts.Deterministic]
+    (h : lts.Tr s μ s') : lts.traces s' = {μs | μ :: μs ∈ lts.traces s} := by
+  ext μs
+  constructor
+  · intro ⟨s'', hmtr⟩
+    use s'', MTr.stepL h hmtr
+  · intro ⟨s'', hmtr⟩
+    rcases hmtr with (_ | ⟨htr, hmtr⟩)
+    rw [←deterministic _ _ _ _ h htr] at hmtr
+    exact ⟨s'', hmtr⟩
+
+/-- In a deterministic lts, a state's traces are determined by any of its multi-step predecessors.
+-/
+theorem Deterministic.traces_of_mTr {lts : LTS State Label} [lts.Deterministic]
+    (h : lts.MTr s μs s') : lts.traces s' = {μs' | μs ++ μs' ∈ lts.traces s} := by
+  ext μs'
+  constructor
+  · intro ⟨s'', hmtr⟩
+    use s'', h.comp _ hmtr
+  · intro ⟨s'', hmtr⟩
+    obtain ⟨smid, hmid, hmid'⟩ := hmtr.split
+    rw [Deterministic.eq_of_mTr h hmid]
+    use s'', hmid'
+
+/-- If `s₁` is simulated by `s₂` all of `s₁`'s traces are also traces of `s₂`. -/
+theorem IsSimulation.traces_subset (hr : IsSimulation lts₁ lts₂ r) (hrel : r s₁ s₂) :
+    lts₁.traces s₁ ⊆ lts₂.traces s₂ := by
+  intro μs ⟨s₁', h₁⟩
+  obtain ⟨s₂', h₂, _⟩ := hr.sim_trace hrel μs s₁' h₁
+  exact ⟨s₂', h₂⟩
+
 /-- Two states are trace equivalent if they have the same set of traces. -/
 def TraceEq (lts₁ : LTS State₁ Label) (lts₂ : LTS State₂ Label)
     (s₁ : State₁) (s₂ : State₂) :=
@@ -62,20 +112,19 @@ abbrev HomTraceEq (lts : LTS State Label) := TraceEq lts lts
 scoped notation s:max " ~tr[" lts "] " s':max => HomTraceEq lts s s'
 
 /-- Homogeneous trace equivalence is reflexive. -/
-theorem HomTraceEq.refl (s : State) : s ~tr[lts] s := by
-  simp only [TraceEq]
+@[refl] theorem HomTraceEq.refl (s : State) : s ~tr[lts] s := rfl
+
+@[simp] theorem TraceEq.flip_eq : flip (TraceEq lts₁ lts₂) = TraceEq lts₂ lts₁ := by
+  ext s₁ s₂
+  grind [flip, TraceEq]
 
 /-- Trace equivalence is symmetric. -/
 theorem TraceEq.symm (h : s₁ ~tr[lts₁,lts₂] s₂) : s₂ ~tr[lts₂,lts₁] s₁ := by
-  simp only [TraceEq] at h
-  simp only [TraceEq]
-  rw [h]
+  rwa [←flip_eq]
 
 /-- Trace equivalence is transitive. -/
 theorem TraceEq.trans (h1 : s₁ ~tr[lts₁,lts₂] s₂) (h2 : s₂ ~tr[lts₂,lts₃] s₃) :
-    s₁ ~tr[lts₁,lts₃] s₃ := by
-  simp only [TraceEq] at *
-  rw [h1, h2]
+    s₁ ~tr[lts₁,lts₃] s₃ := Eq.trans h1 h2
 
 /-- Homogeneous trace equivalence is an equivalence relation. -/
 theorem HomTraceEq.eqv : Equivalence (· ~tr[lts] ·) where
@@ -87,50 +136,45 @@ theorem HomTraceEq.eqv : Equivalence (· ~tr[lts] ·) where
 instance : Trans (TraceEq lts₁ lts₂) (TraceEq lts₂ lts₃) (TraceEq lts₁ lts₃) where
   trans := TraceEq.trans
 
+/-- For trace-equivalent states, any multistep transition of one can be mimicked by the other. -/
+theorem TraceEq.exists_mTr_of_mTr {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
+    (h : s₁ ~tr[lts₁,lts₂] s₂) (htr : lts₁.MTr s₁ μs s₁') : ∃ s₂', lts₂.MTr s₂ μs s₂' := by
+  rw [←mem_traces_iff, ←h]
+  exact ⟨s₁', htr⟩
+
+/-- For trace-equivalent states, any single-step transition of one can be mimicked by the other. -/
+theorem TraceEq.exists_tr_of_tr {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
+    (h : s₁ ~tr[lts₁,lts₂] s₂) (htr : lts₁.Tr s₁ μ s₁') : ∃ s₂', lts₂.Tr s₂ μ s₂' := by
+  rw [←mem_traces_singleton_iff, ←h, mem_traces_singleton_iff]
+  exact ⟨s₁', htr⟩
+
+/-- For deterministic lts's, trace equivalence is preserved by respective transitions with the same
+label. -/
+theorem TraceEq.traceEq_of_tr_of_tr {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
+    [hdet₁ : lts₁.Deterministic] [hdet₂ : lts₂.Deterministic] (h : s₁ ~tr[lts₁,lts₂] s₂)
+    (htr₁ : lts₁.Tr s₁ μ s₁') (htr₂ : lts₂.Tr s₂ μ s₂') : s₁' ~tr[lts₁,lts₂] s₂' := by
+  rw [TraceEq] at h
+  simp_rw [TraceEq, Deterministic.traces_of_tr htr₁, Deterministic.traces_of_tr htr₂, h]
+
 /-- In deterministic LTSs, trace equivalence is a simulation. -/
-theorem TraceEq.deterministic_isSimulation {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
+theorem Deterministic.isSimulation_traceEq {lts₁ : LTS State₁ Label} {lts₂ : LTS State₂ Label}
     [hdet₁ : lts₁.Deterministic] [hdet₂ : lts₂.Deterministic] :
     IsSimulation lts₁ lts₂ (TraceEq lts₁ lts₂) := by
   intro s₁ s₂ h μ s₁' htr1
-  have hmtr1 := MTr.single lts₁ htr1
-  have hin := traces_in hmtr1
-  rw [h] at hin
-  obtain ⟨s₂', hmtr2⟩ := hin
-  exists s₂'
-  constructor
-  · apply MTr.single_invert lts₂ _ _ _ hmtr2
-  · simp only [TraceEq, traces]
-    funext μs'
-    simp only [eq_iff_iff]
-    simp only [setOf]
-    constructor
-    case mp =>
-      intro hmtr1'
-      obtain ⟨s₁'', hmtr1'⟩ := hmtr1'
-      have hmtr1comp := MTr.comp lts₁ hmtr1 hmtr1'
-      have hin := traces_in hmtr1comp
-      rw [h] at hin
-      obtain ⟨s', hmtr2'⟩ := hin
-      cases hmtr2'
-      case stepL s₂'' htr2 hmtr2' =>
-        exists s'
-        have htr2' := MTr.single_invert lts₂ _ _ _ hmtr2
-        have hdets₂ := hdet₂.deterministic s₂ μ s₂' s₂'' htr2' htr2
-        rw [hdets₂]
-        exact hmtr2'
-    case mpr =>
-      intro hmtr2'
-      obtain ⟨s₂'', hmtr2'⟩ := hmtr2'
-      have hmtr2comp := MTr.comp lts₂ hmtr2 hmtr2'
-      have hin := traces_in hmtr2comp
-      rw [← h] at hin
-      obtain ⟨s', hmtr1'⟩ := hin
-      cases hmtr1'
-      case stepL s₁'' htr1 hmtr1' =>
-        exists s'
-        have htr1' := MTr.single_invert lts₁ _ _ _ hmtr1
-        have hdets₁ := hdet₁.deterministic s₁ μ s₁' s₁'' htr1' htr1
-        rw [hdets₁]
-        exact hmtr1'
+  obtain ⟨s₂', htr2⟩ := h.exists_tr_of_tr htr1
+  use s₂', htr2, h.traceEq_of_tr_of_tr htr1 htr2
+
+/-- Simulation equivalence implies trace equivalence. -/
+theorem SimulationEquiv.traceEq (h : s₁ ≤≥[lts₁,lts₂] s₂) : s₁ ~tr[lts₁,lts₂] s₂ := by
+  obtain ⟨⟨_, h, hr⟩, _, h', hr'⟩ := h
+  exact (hr.traces_subset h).antisymm (hr'.traces_subset h')
+
+/-- Simulation equivalence and trace equivalence are equivalence for detemrinistic lts's. -/
+theorem Deterministic.traceEq_iff_simulationEquiv {lts₁ : LTS State₁ Label}
+    {lts₂ : LTS State₂ Label} [hdet₁ : lts₁.Deterministic] [hdet₂ : lts₂.Deterministic]
+    (s₁ : State₁) (s₂ : State₂) : (s₁ ~tr[lts₁,lts₂] s₂) ↔ s₁ ≤≥[lts₁,lts₂] s₂ :=
+  ⟨fun h =>
+    ⟨⟨_, h, Deterministic.isSimulation_traceEq⟩, _, h.symm, Deterministic.isSimulation_traceEq⟩,
+    SimulationEquiv.traceEq⟩
 
 end Cslib.LTS
diff --git a/Cslib/Foundations/Syntax/Congruence.lean b/Cslib/Foundations/Syntax/Congruence.lean
index 0a787a642c..25c954c2db 100644
--- a/Cslib/Foundations/Syntax/Congruence.lean
+++ b/Cslib/Foundations/Syntax/Congruence.lean
@@ -15,8 +15,36 @@ public import Mathlib.Algebra.Order.Monoid.Unbundled.Defs
 
 namespace Cslib
 
-/-- An equivalence relation on `α` preserved by all contexts `Ctx`. -/
-class Congruence (α : Type*) [HasContext α] (r : α → α → Prop) extends
-  IsEquiv α r, covariant : CovariantClass (HasContext.Context α) α (·<[·]) r
+/-- The relation `r` is a congruence on `α`. This class gives access to the `≡[r]` notation.
+To instantiate a canonical congruence for `α`, see `HasCongruence`.
+
+Congruence relations should also instantiate `LawfulCongruence` to prove that the relation respects
+the expected congruence laws. -/
+class Congruence (r : α → α → Prop)
+
+/-- `a ≡[r] b` means that the `a` and `b` are related by the congruence `r`. -/
+@[nolint unusedArguments]
+def Congruence.r (r : α → α → Prop) [Congruence r] := r
+
+@[inherit_doc]
+scoped notation:29 a " ≡[" r "] " b => Congruence.r r a b
+
+/-- The type `α` has a canonical congruence relation. This gives access to the `≡` notation. -/
+class DefaultCongruence (α : Type*) (r : outParam (α → α → Prop))
+
+/-- `a ≡ b` means that `a` and `b` are related by the canonical congruence relation for their
+type. -/
+@[nolint unusedArguments]
+def DefaultCongruence.r {α : Type*} {r : α → α → Prop} [DefaultCongruence α r] (a b : α) := r a b
+
+@[inherit_doc]
+scoped infix:29 " ≡ " => DefaultCongruence.r
+
+@[nolint unusedArguments]
+instance (α : Type*) (r : α → α → Prop) [DefaultCongruence α r] : Congruence r := ⟨⟩
+
+/-- An equivalence relation on `α` preserved by all contexts. -/
+class LawfulCongruence (r : α → α → Prop) [Congruence r] [HasContext α] extends
+  IsEquiv α r, covariant : CovariantClass (HasContext.Context α) α (·<[·]) (· ≡[r] ·)
 
 end Cslib
diff --git a/Cslib/Foundations/Syntax/Context.lean b/Cslib/Foundations/Syntax/Context.lean
index 6f9c7c83c2..1967029920 100644
--- a/Cslib/Foundations/Syntax/Context.lean
+++ b/Cslib/Foundations/Syntax/Context.lean
@@ -17,7 +17,7 @@ namespace Cslib
 /-- Class for types with a canonical notion of heterogeneous single-hole contexts. -/
 class HasHContext (α β : Type*) where
   /-- The type of contexts. -/
-  Context : Type*
+  {Context : Type*}
   /-- Replaces the hole in the context with a value, resulting in a new value. -/
   fill (c : Context) (b : β) : α
 
diff --git a/Cslib/Foundations/Syntax/HasSubstitution.lean b/Cslib/Foundations/Syntax/HasSubstitution.lean
index 15a5e8d091..ae69bf6cd5 100644
--- a/Cslib/Foundations/Syntax/HasSubstitution.lean
+++ b/Cslib/Foundations/Syntax/HasSubstitution.lean
@@ -19,7 +19,30 @@ class HasSubstitution (α : Type u) (β : Type v) (γ : Type w) where
   /-- Substitution function. Replaces `x` in `t` with `t'`. -/
   subst (t : α) (x : β) (t' : γ) : α
 
-/-- Notation for substitution. -/
-notation t:max "[" x ":=" t' "]" => HasSubstitution.subst t x t'
+/--
+Notation for substitution.
+
+The `noWs` guard is intentional: substitution must be written as `t[x := s]`,
+not `t [x := s]`. Without the guard, the term parser can attach a bracket from
+following syntax, such as an instance-binder field in a structure declaration,
+to the preceding term.
+-/
+syntax:max term noWs "[" term " := " term "]" : term
+
+macro_rules
+  | `($t[$x := $s]) => `(HasSubstitution.subst $t $x $s)
+
+/-- Pretty-printer support for `HasSubstitution.subst`. -/
+@[app_unexpander HasSubstitution.subst]
+meta def unexpandHasSubstitutionSubst : Lean.PrettyPrinter.Unexpander
+  | `($_ $t $x $s) => `($t[$x := $s])
+  | _ => throw ()
+
+namespace HasSubstitution
+
+instance [DecidableEq α] : HasSubstitution (α → β) α β where
+  subst := Function.update
+
+end HasSubstitution
 
 end Cslib
diff --git a/Cslib/Foundations/Syntax/HasWellFormed.lean b/Cslib/Foundations/Syntax/HasWellFormed.lean
index 94ca81629c..1dd2a6330f 100644
--- a/Cslib/Foundations/Syntax/HasWellFormed.lean
+++ b/Cslib/Foundations/Syntax/HasWellFormed.lean
@@ -20,6 +20,6 @@ class HasWellFormed (α : Type u) where
   wf (x : α) : Prop
 
 /-- Notation for well-formedness. -/
-notation x:max "✓" => HasWellFormed.wf x
+macro x:term:max noWs "✓" : term => `(HasWellFormed.wf $x)
 
 end Cslib
diff --git a/Cslib/Languages/CCS/Basic.lean b/Cslib/Languages/CCS/Basic.lean
index c30c1849d4..ec581611c2 100644
--- a/Cslib/Languages/CCS/Basic.lean
+++ b/Cslib/Languages/CCS/Basic.lean
@@ -119,7 +119,7 @@ def Context.fill (c : Context Name Constant) (p : Process Name Constant) : Proce
   | choiceR r c => Process.choice r (c.fill p)
   | res a c => Process.res a (c.fill p)
 
-instance : HasContext (Process Name Constant) := ⟨Context Name Constant, Context.fill⟩
+instance : HasContext (Process Name Constant) := ⟨Context.fill⟩
 
 /-- Definition of context filling. -/
 @[scoped grind =]
diff --git a/Cslib/Languages/CCS/BehaviouralTheory.lean b/Cslib/Languages/CCS/BehaviouralTheory.lean
index 6e24dac126..3490b12fc0 100644
--- a/Cslib/Languages/CCS/BehaviouralTheory.lean
+++ b/Cslib/Languages/CCS/BehaviouralTheory.lean
@@ -30,7 +30,7 @@ section CCS.BehaviouralTheory
 
 open LTS
 
-variable {Name : Type u} {Constant : Type v} {defs : Constant → CCS.Process Name Constant → Prop}
+variable {Name : Type u} {Constant : Type v} {defs : Constant → Option (CCS.Process Name Constant)}
 
 namespace CCS
 
@@ -213,7 +213,7 @@ theorem bisimilarity_choice_comm : (choice p q) ~[lts (defs := defs)] (choice q
         cases htr with grind
       · grind [HomBisimilarity.refl, ChoiceComm]
   case bisim h =>
-    grind [ChoiceComm]
+    grind [IsBisimulation, ChoiceComm]
 
 private inductive ChoiceAssoc : Process Name Constant → Process Name Constant → Prop where
   | assoc : ChoiceAssoc (choice p (choice q r)) (choice (choice p q) r)
@@ -262,7 +262,7 @@ theorem bisimilarity_congr_pre :
   case pre p' q' μ hbis =>
     unfold lts
     constructor <;> intro _ _ <;> [exists q'; exists p'] <;> grind
-  case bisim => grind [Bisimilarity.largest_bisimulation]
+  case bisim => grind [IsBisimulation, IsBisimulation.le_bisimilarity]
 
 @[local grind]
 private inductive ResBisim : Process Name Constant → Process Name Constant → Prop where
@@ -283,7 +283,7 @@ theorem bisimilarity_congr_res :
   case left =>
     intro s1' htr
     cases htr with | res _ _ htr =>
-    obtain ⟨q', _, bisim⟩ := Bisimilarity.is_bisimulation.follow_fst h htr
+    obtain ⟨q', _, bisim⟩ := h.follow_fst htr
     exists res a q'
     unfold lts at *
     #adaptation_note
@@ -294,7 +294,7 @@ theorem bisimilarity_congr_res :
   case right =>
     intro s2' htr
     cases htr with | res _ _ htr =>
-    obtain ⟨p', _, bisim⟩ := Bisimilarity.is_bisimulation.follow_snd h htr
+    obtain ⟨p', _, bisim⟩ := h.follow_snd htr
     exists res a p'
     unfold lts at *
     #adaptation_note
@@ -328,7 +328,7 @@ theorem bisimilarity_congr_choice :
         constructor
         · apply Tr.choiceL htr2
         · constructor
-          apply Bisimilarity.largest_bisimulation hb hr2
+          apply hb.le_bisimilarity _ _ hr2
       case choiceR a b c htr =>
         exists s1'
         constructor
@@ -342,7 +342,7 @@ theorem bisimilarity_congr_choice :
       constructor
       · assumption
       constructor
-      apply Bisimilarity.largest_bisimulation hb hr2
+      apply hb.le_bisimilarity _ _ hr2
   case right =>
     intro s2' htr
     cases r
@@ -355,7 +355,7 @@ theorem bisimilarity_congr_choice :
         constructor
         · apply Tr.choiceL htr1
         · constructor
-          apply Bisimilarity.largest_bisimulation hb hr1
+          apply hb.le_bisimilarity _ _ hr1
       case choiceR a b c htr =>
         exists s2'
         constructor
@@ -369,7 +369,7 @@ theorem bisimilarity_congr_choice :
       constructor
       · assumption
       · constructor
-        apply Bisimilarity.largest_bisimulation hb hr1
+        apply hb.le_bisimilarity _ _ hr1
 
 @[local grind]
 private inductive ParBisim : Process Name Constant → Process Name Constant → Prop where
@@ -441,10 +441,14 @@ theorem bisimilarity_is_congruence
   | _ => grind [bisimilarity_congr_pre, bisimilarity_congr_par,
                 bisimilarity_congr_choice, bisimilarity_congr_res]
 
+instance : Congruence (HomBisimilarity (lts (defs := defs))) := ⟨⟩
+
 /-- Bisimilarity is a congruence in CCS. -/
 instance bisimilarityCongruence :
-    Congruence (Process Name Constant) (HomBisimilarity (lts (defs := defs))) where
-  covariant := ⟨by grind [Covariant, bisimilarity_is_congruence]⟩
+    LawfulCongruence (HomBisimilarity (lts (defs := defs))) where
+  elim := by
+    dsimp [Congruence.r]
+    grind [Covariant, bisimilarity_is_congruence]
 
 end CCS
 
diff --git a/Cslib/Languages/CCS/Semantics.lean b/Cslib/Languages/CCS/Semantics.lean
index 7a5670fdec..93be9f5e87 100644
--- a/Cslib/Languages/CCS/Semantics.lean
+++ b/Cslib/Languages/CCS/Semantics.lean
@@ -20,14 +20,12 @@ public import Cslib.Languages.CCS.Basic
 
 @[expose] public section
 
-namespace Cslib
+namespace Cslib.CCS
 
 variable
   {Name : Type u}
   {Constant : Type v}
-  {defs : Constant → (CCS.Process Name Constant) → Prop}
-
-namespace CCS
+  {defs : Constant → Option (Process Name Constant)}
 
 open Process
 
@@ -43,7 +41,7 @@ inductive Tr : Process Name Constant → Act Name → Process Name Constant →
   | choiceL : Tr p μ p' → Tr (choice p q) μ p'
   | choiceR : Tr q μ q' → Tr (choice p q) μ q'
   | res : μ ≠ Act.name a → μ ≠ Act.coname a → Tr p μ p' → Tr (res a p) μ (res a p')
-  | const : defs k p → Tr p μ p' → Tr (const k) μ p'
+  | const : defs k = some p → Tr p μ p' → Tr (const k) μ p'
 
 instance : HasTau (Act Name) where
   τ := Act.τ
@@ -55,6 +53,59 @@ inductive Terminated : Process Name Constant → Prop where
   | choice : Terminated p → Terminated q → Terminated (choice p q)
   | res : Terminated p → Terminated (res a p)
 
-end CCS
+open LTS
+
+/-- A terminated process has no outgoing transitions. -/
+@[scoped grind ⇒]
+theorem not_tr_of_terminated (h : Terminated p) : ¬(lts (defs := defs)).Tr p μ p' := by
+  intro htr
+  induction htr <;> grind [Terminated]
+
+/-- Inversion lemma for prefix transitions. -/
+@[scoped grind →]
+theorem pre_tr (h : (lts (defs := defs)).Tr (pre μ p) μ' p') : μ = μ' ∧ p = p' := by
+  cases h
+  simp
+
+/-- Inversion lemma for constant transitions. -/
+@[scoped grind →]
+theorem const_tr (h : (lts (defs := defs)).Tr (const k) μ p') :
+    ∃ p, defs k = some p ∧ (lts (defs := defs)).Tr p μ p' := by
+  cases h
+  case const p hdef htr =>
+    exists p
+
+/-- Prefixes are deterministic. -/
+@[scoped grind .]
+theorem pre_deterministicState : DeterministicState (lts (defs := defs)) (pre μ p) := by
+  grind
+
+/-- Constants are deterministic if their definition is deterministic. -/
+@[scoped grind .]
+theorem const_deterministicStateLabel (hdef : defs k = some p)
+    (h : DeterministicStateLabel (lts (defs := defs)) p μ) :
+    DeterministicStateLabel (lts (defs := defs)) (const k) μ := by
+  intro p₁ p₂ h₁ h₂
+  cases h₁
+  cases h₂
+  case const.const q₁ hdef₁ htr₁ q₂ hdef₂ htr₂ =>
+    have hq₁ : q₁ = p := by grind only
+    have hq₂ : q₂ = p := by grind only
+    rw [hq₁] at htr₁
+    rw [hq₂] at htr₂
+    apply h p₁ p₂ htr₁ htr₂
+
+/-- Restriction is deterministic if its subterm is deterministic. -/
+@[scoped grind .]
+theorem res_deterministicStateLabel
+    (h : DeterministicStateLabel (lts (defs := defs)) p μ) :
+    DeterministicStateLabel (lts (defs := defs)) (res μ' p) μ := by
+  intro p₁ p₂ h₁ h₂
+  cases h₁
+  cases h₂
+  case res.res q₁ h₁ h₂ htr₁ q₂ h₃ h₄ htr₂ =>
+    have hq₁q₂ : q₁ = q₂ := by
+      apply h _ _ htr₁ htr₂
+    rw [hq₁q₂]
 
-end Cslib
+end Cslib.CCS
diff --git a/Cslib/Languages/CombinatoryLogic/Confluence.lean b/Cslib/Languages/CombinatoryLogic/Confluence.lean
index 6a0d20022a..86a22cec2a 100644
--- a/Cslib/Languages/CombinatoryLogic/Confluence.lean
+++ b/Cslib/Languages/CombinatoryLogic/Confluence.lean
@@ -7,6 +7,7 @@ Authors: Thomas Waring
 module
 
 public import Cslib.Languages.CombinatoryLogic.Defs
+public import Cslib.Foundations.Relation.Confluence
 
 /-!
 # SKI reduction is confluent
@@ -58,44 +59,43 @@ inductive ParallelReduction : SKI → SKI → Prop
   | par ⦃a a' b b' : SKI⦄ :
       ParallelReduction a a' → ParallelReduction b b' → ParallelReduction (a ⬝ b) (a' ⬝ b')
 
-/-- The inclusion `⭢ₚ ⊆ ↠` -/
-theorem mRed_of_parallelReduction {a a' : SKI} (h : a ⭢ₚ a') : a ↠ a' := by
+/-- The inclusion `(· ⭢ₚ ·) ≤ (· ↠ ·)`. -/
+theorem ParallelReduction.le_reflTransGen_red :
+    (· ⭢ₚ ·) ≤ (· ↠ ·) := by
+  intro a a' h
   cases h
   case refl => exact Relation.ReflTransGen.refl
   case par a a' b b' ha hb =>
     apply parallel_mRed
-    · exact mRed_of_parallelReduction ha
-    · exact mRed_of_parallelReduction hb
-  case red_I => exact Relation.ReflTransGen.single (red_I a')
-  case red_K b => exact Relation.ReflTransGen.single (red_K a' b)
-  case red_S a b c => exact Relation.ReflTransGen.single (red_S a b c)
-
-/-- The inclusion `⭢ ⊆ ⭢ₚ` -/
-theorem parallelReduction_of_red {a a' : SKI} (h : a ⭢ a') : a ⭢ₚ a' := by
+    · exact ha.le_reflTransGen_red
+    · exact hb.le_reflTransGen_red
+  case red_I => exact Relation.ReflTransGen.single (Red.red_I a')
+  case red_K b => exact Relation.ReflTransGen.single (Red.red_K a' b)
+  case red_S a b c => exact Relation.ReflTransGen.single (Red.red_S a b c)
+
+/-- The inclusion `(· ⭢ ·) ≤ (· ⭢ₚ ·)`. -/
+theorem Red.le_parallelReduction :
+    (· ⭢ ·) ≤ (· ⭢ₚ ·) := by
+  intro a a' h
   cases h
   case red_S => apply ParallelReduction.red_S
   case red_K => apply ParallelReduction.red_K
   case red_I => apply ParallelReduction.red_I
   case red_head a a' b h =>
     apply ParallelReduction.par
-    · exact parallelReduction_of_red h
+    · exact h.le_parallelReduction
     · exact ParallelReduction.refl b
   case red_tail a b b' h =>
     apply ParallelReduction.par
     · exact ParallelReduction.refl a
-    · exact parallelReduction_of_red h
+    · exact h.le_parallelReduction
 
-/-- The inclusions of `mRed_of_parallelReduction` and
-`parallelReduction_of_red` imply that `⭢` and `⭢ₚ` have the same reflexive-transitive
-closure. -/
+/-- The relations `⭢` and `⭢ₚ` have the same reflexive-transitive closure. -/
 theorem reflTransGen_parallelReduction_mRed :
     ReflTransGen ParallelReduction = ReflTransGen Red := by
-  ext a b
-  constructor
-  · apply Relation.reflTransGen_of_isTrans_reflexive
-    exact @mRed_of_parallelReduction
-  · apply Relation.reflTransGen_of_isTrans_reflexive
-    exact fun a a' h => Relation.ReflTransGen.single (parallelReduction_of_red h)
+  apply le_antisymm
+  · exact reflTransGen_le_of_le ParallelReduction.le_reflTransGen_red
+  · exact ReflTransGen.mono Red.le_parallelReduction
 
 /-!
 Irreducibility for the (partially applied) primitive combinators.
diff --git a/Cslib/Languages/CombinatoryLogic/Defs.lean b/Cslib/Languages/CombinatoryLogic/Defs.lean
index a82459aadf..7d028d2834 100644
--- a/Cslib/Languages/CombinatoryLogic/Defs.lean
+++ b/Cslib/Languages/CombinatoryLogic/Defs.lean
@@ -6,7 +6,8 @@ Authors: Thomas Waring
 
 module
 
-public import Cslib.Foundations.Data.Relation
+public import Cslib.Foundations.Relation.Attr
+public import Cslib.Foundations.Relation.Defs
 public meta import Mathlib.Tactic.ToDual
 
 /-!
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Opening.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Opening.lean
index 1d7060916e..3c6bc29580 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Opening.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Opening.lean
@@ -235,9 +235,9 @@ lemma openRecTy_lc {t : Term Var} (lc : t.LC) : t = t⟦X ↝ σ⟧ᵗᵞ := by
 def substTy (X : Var) (δ : Ty Var) : Term Var → Term Var
 | bvar x => bvar x
 | fvar x => fvar x
-| abs σ t₁ => abs (σ [X := δ]) (substTy X δ t₁)
+| abs σ t₁ => abs (σ[X := δ]) (substTy X δ t₁)
 | app t₁ t₂ => app (substTy X δ t₁) (substTy X δ t₂)
-| tabs σ t₁ => tabs (σ [X := δ]) (substTy X δ t₁)
+| tabs σ t₁ => tabs (σ[X := δ]) (substTy X δ t₁)
 | tapp t₁ σ => tapp (substTy X δ t₁) (σ[X := δ])
 | let' t₁ t₂ => let' (substTy X δ t₁) (substTy X δ t₂)
 | inl t₁ => inl (substTy X δ t₁)
@@ -253,7 +253,7 @@ lemma substTy_def : substTy (X : Var) (δ : Ty Var) (t : Term Var) = t[X := δ]
 
 omit [HasFresh Var] in
 /-- Substitution of a free type variable not present in a term leaves it unchanged. -/
-lemma substTy_fresh (nmem : X ∉ t.fvTy) (δ : Ty Var) : t = t [X := δ] :=
+lemma substTy_fresh (nmem : X ∉ t.fvTy) (δ : Ty Var) : t = t[X := δ] :=
   by induction t <;> grind [Ty.subst_fresh]
 
 /-- Substitution of a locally closed type distributes with term opening to a type . -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Reduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Reduction.lean
index b9969aa49a..d38bc67c3a 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Reduction.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Reduction.lean
@@ -6,7 +6,7 @@ Authors: Chris Henson
 
 module
 
-public import Cslib.Foundations.Data.Relation
+public import Cslib.Foundations.Relation.Attr
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Opening
 
 /-! # λ-calculus
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
index e777ed0ea7..f2e4d4b6c5 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
@@ -50,7 +50,7 @@ lemma Typing.preservation (der : Typing Γ t τ) (step : t ⭢βᵛ t') : Typing
       have ⟨_, _, ⟨_, _⟩⟩ := der.tabs_inv sub
       have ⟨X, mem⟩ := fresh_exists <| free_union [Ty.fv, fvTy] Var
       simp at mem
-      have : Γ = (Context.mapVal (·[X:=σ']) []) ++ Γ := by grind
+      have : Γ = (Context.mapVal (·[X := σ']) []) ++ Γ := by grind
       rw [openTy_substTy_intro (X := X), open_subst_intro (X := X)] <;> grind [subst_ty]
     case tapp => grind
   case let' Γ _ _ _ _ L der _ ih₁ _ =>
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Subtype.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Subtype.lean
index 7cdb72133c..66217c566a 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Subtype.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Subtype.lean
@@ -144,7 +144,7 @@ lemma narrow (sub_δ : Sub Δ δ δ') (sub_narrow : Sub (Γ ++ ⟨X, Binding.sub
 variable [HasFresh Var] in
 /-- Subtyping of substitutions. -/
 lemma map_subst (sub₁ : Sub (Γ ++ ⟨X, Binding.sub δ'⟩ :: Δ) σ τ) (sub₂ : Sub Δ δ δ') :
-    Sub (Γ.mapVal (·[X:=δ]) ++ Δ) (σ[X:=δ]) (τ[X:=δ]) := by
+    Sub (Γ.mapVal (·[X := δ]) ++ Δ) (σ[X := δ]) (τ[X := δ]) := by
   generalize eq : Γ ++ ⟨X, Binding.sub δ'⟩ :: Δ = Θ at sub₁
   induction sub₁ generalizing Γ
   case all => apply Sub.all (free_union Var) <;> grind [open_subst_var]
@@ -152,7 +152,7 @@ lemma map_subst (sub₁ : Sub (Γ ++ ⟨X, Binding.sub δ'⟩ :: Δ) σ τ) (sub
     have := map_subst_nmem Δ X δ
     have : Γ ++ ⟨X, .sub δ'⟩ :: Δ ~ ⟨X, .sub δ'⟩ :: (Γ ++ Δ) := perm_middle
     have : .sub σ ∈ dlookup X' (⟨X, .sub δ'⟩ :: (Γ ++ Δ)) := by grind [perm_dlookup]
-    have := @mapVal_mem Var (f := ((·[X:=δ]) : Binding Var → Binding Var))
+    have := @mapVal_mem Var (f := ((·[X := δ]) : Binding Var → Binding Var))
     by_cases X = X'
     · trans δ' <;> grind [→ mem_dlookup, Ty.subst_fresh, Ty.Wf.nmem_fv, weaken_head]
     · grind
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Typing.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Typing.lean
index c4aa13facd..1e0be09d13 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Typing.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Typing.lean
@@ -30,7 +30,7 @@ variable {Var : Type*} [DecidableEq Var] [HasFresh Var]
 
 namespace LambdaCalculus.LocallyNameless.Fsub
 
-open Term Ty Ty.Wf Env.Wf Sub Context List Binding
+open Term Ty Ty.Wf Env.Wf Fsub.Sub Context List Binding
 
 /-- The typing relation. -/
 inductive Typing : Env Var → Term Var → Ty Var → Prop
@@ -144,7 +144,7 @@ lemma subst_ty (der : Typing (Γ ++ ⟨X, Binding.sub δ'⟩ :: Δ) t τ) (sub :
   induction der generalizing Γ X
   case var σ _ X' _ mem =>
     have := map_subst_nmem Δ X δ
-    have := @mapVal_mem Var (f := ((·[X:=δ]) : Binding Var → Binding Var))
+    have := @mapVal_mem Var (f := ((·[X := δ]) : Binding Var → Binding Var))
     grind [Env.Wf.map_subst, → notMem_keys_of_nodupKeys_cons]
   case abs => grind [abs (free_union [Ty.fv] Var), Ty.subst_fresh, openTm_substTy_var]
   case tabs => grind [tabs (free_union Var), openTy_substTy_var, open_subst_var]
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean
index c24a0ab669..ea45b5d7f4 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean
@@ -121,7 +121,7 @@ lemma strengthen (wf : σ.Wf (Γ ++ ⟨X, Binding.ty τ⟩ :: Δ)) : σ.Wf (Γ +
 variable [HasFresh Var] in
 /-- A type remains well-formed under context substitution (of a well-formed type). -/
 lemma map_subst (wf_σ : σ.Wf (Γ ++ ⟨X, Binding.sub τ⟩ :: Δ)) (wf_τ' : τ'.Wf Δ)
-    (ok : (Γ.mapVal (·[X:=τ']) ++ Δ)✓) : σ[X:=τ'].Wf <| Γ.mapVal (·[X:=τ']) ++ Δ := by
+    (ok : (Γ.mapVal (·[X := τ']) ++ Δ)✓) : σ[X := τ'].Wf <| Γ.mapVal (·[X := τ']) ++ Δ := by
   have := @mapVal_mem Var (Binding Var)
   generalize eq : Γ ++ ⟨X, Binding.sub τ⟩ :: Δ = Θ at wf_σ
   induction wf_σ generalizing Γ τ' with
@@ -133,7 +133,7 @@ variable [HasFresh Var] in
 lemma open_lc (ok_Γ : Γ✓) (wf_all : (Ty.all σ τ).Wf Γ) (wf_δ : δ.Wf Γ) : (τ ^ᵞ δ).Wf Γ := by
   cases wf_all with | all =>
     let ⟨X, _⟩ := fresh_exists <| free_union [fv, Context.dom] Var
-    have : Γ = Context.mapVal (·[X:=δ]) [] ++ Γ := by grind
+    have : Γ = Context.mapVal (·[X := δ]) [] ++ Γ := by grind
     grind [open_subst_intro, map_subst]
 
 /-- A type bound in a context is well formed. -/
@@ -177,7 +177,7 @@ lemma strengthen (wf : Env.Wf <| Γ ++ ⟨X, Binding.ty τ⟩ :: Δ) : Env.Wf <|
 variable [HasFresh Var] in
 /-- A context remains well-formed under substitution (of a well-formed type). -/
 lemma map_subst (wf_env : Env.Wf (Γ ++ ⟨X, Binding.sub τ⟩ :: Δ)) (wf_τ' : τ'.Wf Δ) :
-    Env.Wf <| Γ.mapVal (·[X:=τ']) ++ Δ := by
+    Env.Wf <| Γ.mapVal (·[X := τ']) ++ Δ := by
   induction Γ generalizing wf_τ' Δ τ' <;> cases wf_env
   case nil => grind
   case cons.sub | cons.ty => constructor <;> grind [Ty.Wf.map_subst]
@@ -186,7 +186,7 @@ variable [HasFresh Var]
 
 /-- A well-formed context is unchanged by substituting for a free key. -/
 lemma map_subst_nmem (Γ : Env Var) (X : Var) (σ : Ty Var) (wf : Γ.Wf) (nmem : X ∉ Γ.dom) :
-    Γ = Γ.mapVal (·[X:=σ]) := by
+    Γ = Γ.mapVal (·[X := σ]) := by
   induction wf <;> grind [Ty.Wf.nmem_fv, Binding.subst_fresh]
 
 end Env.Wf
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean
index 405554ffb4..fd95b1eae6 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean
@@ -117,7 +117,7 @@ lemma subst_aux (h : Δ ++ ⟨x, σ⟩ :: Γ ⊢ t ∶ τ) (der : Γ ⊢ s ∶ 
 
 /-- Substitution for a context weakened by a single type. -/
 lemma typing_subst_head (weak : ⟨x, σ⟩ :: Γ ⊢ t ∶ τ) (der : Γ ⊢ s ∶ σ) :
-    Γ ⊢ (t [x := s]) ∶ τ := by
+    Γ ⊢ (t[x := s]) ∶ τ := by
   grind [subst_aux]
 
 /-- Typing preservation for opening. -/
@@ -125,7 +125,7 @@ theorem preservation_open {xs : Finset Var}
     (cofin : ∀ x ∉ xs, ⟨x, σ⟩ :: Γ ⊢ m ^ fvar x ∶ τ) (der : Γ ⊢ n ∶ σ) :
     Γ ⊢ m ^ n ∶ τ := by
   have ⟨fresh, _⟩ := fresh_exists <| free_union [Term.fv] Var
-  grind [subst_intro fresh _ _ ?_ der.lc, typing_subst_head]
+  grind [subst_intro fresh _ _ ?_, typing_subst_head]
 
 end LambdaCalculus.LocallyNameless.Stlc.Typing
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Safety.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Safety.lean
index 972a2ed112..609e129a6e 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Safety.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Safety.lean
@@ -8,6 +8,7 @@ module
 
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta
+public import Cslib.Foundations.Relation.Confluence
 
 /-! # λ-calculus
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
index 8496ba8b9e..b55058f31a 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
@@ -7,7 +7,6 @@ Authors: David Wegmann
 module
 
 public import Cslib.Foundations.Data.HasFresh
-public import Cslib.Foundations.Data.Relation
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.StrongNorm
@@ -59,7 +58,6 @@ def semanticMap : Ty Base → Set (Term Var)
   | .base _ => { t | SN FullBeta t ∧ LC t }
   | .arrow τ₁ τ₂ => { t | ∀ s, s ∈ semanticMap τ₁ → app t s ∈ semanticMap τ₂ }
 
-set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- The sets constructed by semanticMap are saturated -/
 lemma semanticMap_saturated (τ : Ty Base) : @Saturated Var (semanticMap τ) := by
   induction τ with
@@ -68,11 +66,11 @@ lemma semanticMap_saturated (τ : Ty Base) : @Saturated Var (semanticMap τ) :=
     constructor
     · let x : Var := fresh {}
       have := ih₁.neutal_lc (fvar x) (.fvar x) (.fvar x)
-      grind only [semanticMap, usr Set.mem_setOf_eq, cases LC]
+      grind [cases LC]
     · grind [sn_app_left (Var := Var) (N := fvar <| fresh {})]
     · grind
     · intro M N P _ _ _ s _
-      grind [ih₂.multiApp M N (s :: P)]
+      grind [ih₂.multiApp M N (P ++ [s]), multiApp_tail]
 
 /-- The `entailsContext` predicate ensures that each variable in the context
     is mapped to a term in the corresponding semantic map. -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/BetaAt.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/BetaAt.lean
new file mode 100644
index 0000000000..4e1abca44f
--- /dev/null
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/BetaAt.lean
@@ -0,0 +1,223 @@
+/-
+Copyright (c) 2026 Maximiliano Onofre Martínez. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Maximiliano Onofre Martínez
+-/
+
+module
+
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.CallByName
+
+/-! # Redex Positions
+
+This module defines β-reduction at a given redex position and proves its basic properties.
+
+## Reference
+
+* [M. Copes, *A machine-checked proof of the Standardization Theorem in λ-calculus*][Copes2018]
+
+-/
+
+@[expose] public section
+
+set_option linter.unusedDecidableInType false
+
+namespace Cslib
+
+universe u
+
+variable {Var : Type u}
+
+namespace LambdaCalculus.LocallyNameless.Untyped.Term
+
+/-- The number of β-redexes occurring in a term. -/
+@[grind]
+def countRedexes : Term Var → Nat
+| fvar _        => 0
+| bvar _        => 0
+| abs m         => countRedexes m
+| app (abs m) n => countRedexes m + countRedexes n + 1
+| app m n       => countRedexes m + countRedexes n
+
+/-- `BetaAt i M N` reduces the redex at position `i` of `M` to obtain `N`;
+    positions are counted from left to right. -/
+inductive BetaAt : Nat → Term Var → Term Var → Prop
+/-- The outermost redex sits at position `0`. -/
+| outer : LC (abs M) → LC N → BetaAt 0 (app (abs M) N) (M ^ N)
+/-- Reducing the operator advances the position by one when the operator is an abstraction. -/
+| appL : BetaAt i M M' → BetaAt (i + if IsAbs M then 1 else 0) (app M N) (app M' N)
+/-- Reducing the operand adds the operator's redex count, plus one when it is an abstraction. -/
+| appR : BetaAt i M M' →
+    BetaAt (i + countRedexes N + if IsAbs N then 1 else 0) (app N M) (app N M')
+/-- Reducing under a binder keeps the position. -/
+| abs (xs : Finset Var) :
+    (∀ x ∉ xs, BetaAt i (M ^ fvar x) (M' ^ fvar x)) → BetaAt i (abs M) (abs M')
+
+variable {L L' M M' N N' P : Term Var} {a b i m n : Nat}
+
+/-- Reducing a non-abstraction operator keeps the position. -/
+lemma BetaAt.appNoAbsL (h : BetaAt i M M') (hna : ¬IsAbs M) :
+    BetaAt i (app M N) (app M' N) := by
+  simpa [ite_eq_right hna] using h.appL
+
+/-- Reducing an abstraction operator advances the position by one. -/
+lemma BetaAt.appAbsL (h : BetaAt i M M') (ha : IsAbs M) :
+    BetaAt (i + 1) (app M N) (app M' N) := by
+  simpa [ite_eq_left ha] using h.appL
+
+/-- Reducing the operand adds the redex count of a non-abstraction operator. -/
+lemma BetaAt.appNoAbsR (h : BetaAt i M M') (hna : ¬IsAbs N) :
+    BetaAt (i + countRedexes N) (app N M) (app N M') := by
+  simpa [ite_eq_right hna] using h.appR (N := N)
+
+/-- Reducing the operand adds the redex count of an abstraction operator, plus one. -/
+lemma BetaAt.appAbsR (h : BetaAt i M M') (ha : IsAbs N) :
+    BetaAt (i + countRedexes N + 1) (app N M) (app N M') := by
+  simpa [ite_eq_left ha] using h.appR (N := N)
+
+/-- Opening with a free variable preserves the number of redexes. -/
+lemma countRedexes_openRec_fvar (M : Term Var) (k : Nat) (x : Var) :
+    countRedexes (M⟦k ↝ fvar x⟧) = countRedexes M := by
+  induction M generalizing k with
+  | bvar j => simp only [openRec_bvar]; split <;> rfl
+  | fvar => rfl
+  | abs M ih => grind [openRec_abs]
+  | app L R ihL ihR => cases L <;> grind [openRec_bvar, openRec_app, openRec_abs]
+
+/-- Opening the outermost binder with a free variable preserves the number of redexes. -/
+lemma countRedexes_open_fvar (M : Term Var) (x : Var) :
+    countRedexes (M ^ fvar x) = countRedexes M :=
+  countRedexes_openRec_fvar M 0 x
+
+/-- An application has at least as many redexes as its operator and operand combined. -/
+lemma countRedexes_app_le (M N : Term Var) :
+    countRedexes M + countRedexes N ≤ countRedexes (app M N) := by
+  cases M <;> grind
+
+/-- An application with an abstraction operator has one more redex than its parts. -/
+lemma countRedexes_app_abs {M : Term Var} (ha : IsAbs M) (N : Term Var) :
+    countRedexes (app M N) = countRedexes M + countRedexes N + 1 := by
+  cases ha
+  grind
+
+/-- Contracting a redex of an abstraction yields an abstraction. -/
+lemma BetaAt.isAbs_r (h : BetaAt i M N) (ha : IsAbs M) : IsAbs N := by
+  cases ha
+  cases h
+  exact .abs _
+
+/-- The source of a Call-by-Name step is never an abstraction. -/
+lemma cbn_not_isAbs (h : M ⭢ₙ N) : ¬IsAbs M := by
+  intro ha
+  cases ha
+  trivial
+
+/-- A single Call-by-Name step contracts the redex at position `0`. -/
+lemma BetaAt.of_cbn_step (h : M ⭢ₙ N) : BetaAt 0 M N := by
+  induction h with
+  | base h_beta =>
+    cases h_beta with
+    | beta lc_M lc_N => exact .outer lc_M lc_N
+  | app _ step_M ih => exact .appNoAbsL ih (cbn_not_isAbs step_M)
+
+/-- Renaming a free variable preserves the number of redexes. -/
+lemma countRedexes_subst_fvar [DecidableEq Var] (M : Term Var) (x y : Var) :
+    countRedexes (M[x := fvar y]) = countRedexes M := by
+  induction M with
+  | fvar z => simp only [subst_fvar]; split <;> rfl
+  | bvar => rfl
+  | abs M ih => grind
+  | app L R ihL ihR => cases L <;> grind
+
+/-- Renaming a free variable preserves being an abstraction. -/
+lemma isAbs_subst_fvar [DecidableEq Var] {x y : Var} : IsAbs (M[x := fvar y]) ↔ IsAbs M := by
+  cases M <;> grind
+
+/-- A `BetaAt` step is a full β-step. -/
+lemma BetaAt.to_step [DecidableEq Var] (h : BetaAt i M N) (lc : LC M) : M ⭢βᶠ N := by
+  induction h with
+  | outer lc_M lc_N => exact .base (.beta lc_M lc_N)
+  | appL _ ih =>
+    cases lc with
+    | app lc_L lc_R => exact .appR lc_R (ih lc_L)
+  | appR _ ih =>
+    cases lc with
+    | app lc_L lc_R => exact .appL lc_L (ih lc_R)
+  | abs xs _ ih =>
+    cases lc with
+    | abs ys _ h_body =>
+      apply Xi.abs (xs ∪ ys)
+      intro z hz
+      exact ih z (by grind) (h_body z (by grind))
+
+variable [HasFresh Var]
+
+/-- The position of a contracted redex is at most the redex count of the result. -/
+lemma BetaAt.le_countRedexes (h : BetaAt i M N) : i ≤ countRedexes N := by
+  induction h with
+  | outer => exact Nat.zero_le _
+  | appL step =>
+    split
+    · rw [countRedexes_app_abs (step.isAbs_r (by assumption))]
+      omega
+    · exact le_trans (by omega) (countRedexes_app_le _ _)
+  | appR =>
+    split
+    · rw [countRedexes_app_abs (by assumption)]
+      omega
+    · exact le_trans (by omega) (countRedexes_app_le _ _)
+  | abs xs =>
+    have := fresh_exists xs
+    grind [countRedexes_open_fvar]
+
+variable [DecidableEq Var]
+
+/-- Renaming a free variable preserves the position of the contracted redex. -/
+lemma BetaAt.rename (h : BetaAt i M M') (x y : Var) :
+    BetaAt i (M[x := fvar y]) (M'[x := fvar y]) := by
+  induction h with
+  | outer lc_M lc_N =>
+    rw [subst_open x (fvar y) _ _ (.fvar y)]
+    exact .outer (subst_lc lc_M (.fvar y)) (subst_lc lc_N (.fvar y))
+  | appL _ ih =>
+    split
+    · exact ih.appAbsL (isAbs_subst_fvar.mpr (by assumption))
+    · exact ih.appNoAbsL (mt isAbs_subst_fvar.mp (by assumption))
+  | appR _ ih =>
+    rw [← countRedexes_subst_fvar _ x y]
+    split
+    · exact ih.appAbsR (isAbs_subst_fvar.mpr (by assumption))
+    · exact ih.appNoAbsR (mt isAbs_subst_fvar.mp (by assumption))
+  | abs =>
+    apply BetaAt.abs <| free_union [fv] Var
+    grind
+
+/-- Contracting a redex preserves local closure. -/
+lemma BetaAt.lc_r (h : BetaAt i M M') (lc : LC M) : LC M' := by
+  induction h with
+  | outer lc_M lc_N => exact beta_lc lc_M lc_N
+  | appL _ ih =>
+    cases lc with
+    | app lc_L lc_R => exact .app (ih lc_L) lc_R
+  | appR _ ih =>
+    cases lc with
+    | app lc_L lc_R => exact .app lc_L (ih lc_R)
+  | abs xs _ ih =>
+    cases lc with
+    | abs ys _ h_body =>
+      apply LC.abs (xs ∪ ys)
+      intro z hz
+      exact ih z (by grind) (h_body z (by grind))
+
+/-- Closing a variable and abstracting preserves the position of the contracted redex. -/
+lemma BetaAt.abs_close {x : Var} (h : BetaAt i M M') (lc : LC M) :
+    BetaAt i (M⟦0 ↜ x⟧.abs) (M'⟦0 ↜ x⟧.abs) := by
+  apply BetaAt.abs ∅
+  intro z _
+  have lc' := h.lc_r lc
+  have hr : BetaAt i (M[x := fvar z]) (M'[x := fvar z]) := h.rename x z
+  grind
+
+end LambdaCalculus.LocallyNameless.Untyped.Term
+
+end Cslib
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/CallByName.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/CallByName.lean
new file mode 100644
index 0000000000..a2be62e5a8
--- /dev/null
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/CallByName.lean
@@ -0,0 +1,86 @@
+/-
+Copyright (c) 2026 Maximiliano Onofre Martínez. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Maximiliano Onofre Martínez
+-/
+
+module
+
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties
+
+/-! # Call-by-Name Evaluation -/
+
+@[expose] public section
+
+set_option linter.unusedDecidableInType false
+
+namespace Cslib
+
+universe u
+
+variable {Var : Type u}
+
+namespace LambdaCalculus.LocallyNameless.Untyped.Term
+
+/-- A single step of Call-by-Name evaluation. -/
+@[reduction_sys "ₙ"]
+inductive CBN : Term Var → Term Var → Prop
+/-- Top-level β-reduction. -/
+| base : Beta M N → CBN M N
+/-- Evaluates the leftmost term. -/
+| app : LC Z → CBN M N → CBN (app M Z) (app N Z)
+
+variable {M M' N N' : Term Var}
+
+/-- The left side of a Call-by-Name step is locally closed. -/
+lemma CBN.lc_l (step : M ⭢ₙ N) : LC M := by
+  induction step with grind
+
+/-- A single Call-by-Name step is a full β-reduction. -/
+lemma CBN.step_to_redex (step : M ⭢ₙ N) : M ↠βᶠ N := by
+  induction step with
+  | base h => exact .single (.base h)
+  | app lc_Z _ ih => exact FullBeta.redex_app_l_cong ih lc_Z
+
+/-- Call-by-Name reduction is contained in full β-reduction. -/
+lemma CBN.to_redex (step : M ↠ₙ N) : M ↠βᶠ N := by
+  induction step
+  · rfl
+  · grind [CBN.step_to_redex, Relation.ReflTransGen.trans]
+
+/-- Left congruence rule for application in Call-by-Name reduction. -/
+lemma CBN.steps_app_l_cong (step : M ↠ₙ M') (lc_N : LC N) : Term.app M N ↠ₙ Term.app M' N := by
+  induction step
+  · rfl
+  · grind [CBN.app]
+
+variable [HasFresh Var] [DecidableEq Var]
+
+/-- The right side of a Call-by-Name step is locally closed. -/
+lemma CBN.lc_r (step : M ⭢ₙ N) : LC N := by
+  induction step with grind
+
+/-- The right side of a Call-by-Name reduction is locally closed. -/
+lemma CBN.steps_lc_r (lc_M : LC M) (step : M ↠ₙ N) : LC N := by
+  induction step
+  · exact lc_M
+  · grind [CBN.lc_r]
+
+/-- Substitution preserves a single Call-by-Name step. -/
+lemma CBN.step_subst (x : Var) (h : M ⭢ₙ M') (lc_N : LC N) :
+    M[x := N] ⭢ₙ M'[x := N] := by
+  induction h
+  · grind [Term.subst_open, CBN.base]
+  · grind [CBN.app]
+
+/-- Substitution preserves Call-by-Name reduction. -/
+lemma CBN.steps_subst (x : Var) (step : M ↠ₙ M') (lc_N : LC N) :
+    M[x := N] ↠ₙ M'[x := N] := by
+  induction step
+  · rfl
+  · grind [CBN.step_subst]
+
+end LambdaCalculus.LocallyNameless.Untyped.Term
+
+end Cslib
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
index f23f6c5083..399eeee23c 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
@@ -6,7 +6,7 @@ Authors: Chris Henson
 
 module
 
-public import Cslib.Foundations.Data.Relation
+public import Cslib.Foundations.Relation.Attr
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Congruence
 
@@ -77,17 +77,14 @@ variable [HasFresh Var] [DecidableEq Var]
 
 /-- The right side of a reduction is locally closed. -/
 @[scoped grind →]
-lemma step_lc_r (step : M ⭢βᶠ M') : LC M' := by
-  induction step
-  case abs => constructor; assumption
-  all_goals grind
+lemma step_lc_r (step : M ⭢βᶠ M') : LC M' := Xi.step_lc_r (by grind) step
 
 lemma steps_lc_or_rfl {M M' : Term Var} (redex : M ↠βᶠ M') : (LC M ∧ LC M') ∨ M = M' := by
   grind
 
 /-- Substitution of a locally closed term respects a single reduction step. -/
 lemma redex_subst_cong_lc (s s' t : Term Var) (x : Var) (step : s ⭢βᶠ s') (h_lc : LC t) :
-    s [ x := t ] ⭢βᶠ s' [ x := t ] := by
+    s[x := t] ⭢βᶠ s'[x := t] := by
   induction step with
   | base beta => cases beta; grind [subst_open]
   | abs  => grind [Xi.abs <| free_union Var]
@@ -95,7 +92,7 @@ lemma redex_subst_cong_lc (s s' t : Term Var) (x : Var) (step : s ⭢βᶠ s') (
 
 /-- Substitution respects a single reduction step of a free variable. -/
 lemma redex_subst_cong (s s' : Term Var) (x y : Var) (step : s ⭢βᶠ s') :
-    s [ x := fvar y ] ⭢βᶠ s' [ x := fvar y ] :=
+    s[x := fvar y] ⭢βᶠ s'[x := fvar y] :=
   redex_subst_cong_lc _ _ _ _ step (.fvar y)
 
 /-- An β-reduction step does not introduce new free variables. -/
@@ -149,7 +146,7 @@ lemma invert_steps_abs {s t : Term Var} (step : s.abs ↠βᶠ t) :
 
 /- `λ s ↠βᶠ λ s'` implies `s ^ t ↠βᶠ s' ^ t'` -/
 lemma steps_open_cong_l_abs
-  (s s' t : Term Var) (steps : s.abs ↠βᶠ s'.abs) (lc_s : LC s.abs) (lc_t : LC t) :
+  (s s' t : Term Var) (steps : s.abs ↠βᶠ s'.abs) (lc_t : LC t) :
     (s ^ t) ↠βᶠ (s' ^ t) := by
   generalize eq : s.abs = s_abs at steps
   generalize eq' : s'.abs = s'_abs at steps
@@ -159,25 +156,25 @@ lemma steps_open_cong_l_abs
     specialize ih s
     cases step with grind [invert_steps_abs, step_open_cong_l (L := free_union Var)]
 
-/- `t ↠βᶠ t'` implies `s [ x := t ] ↠βᶠ s [ x := t' ]`.
+/- `t ↠βᶠ t'` implies `s[x := t] ↠βᶠ s[x := t']`.
    There is no single step lemma in this case because x
    may be substituted for n times, so a single step t ↠βᶠ t
-   in general requires n steps in `s [ x := t ] ↠βᶠ (s [ x := t' ])` -/
+   in general requires n steps in `s[x := t] ↠βᶠ (s[x := t'])` -/
 lemma step_subst_cong_r {x : Var} (s t t' : Term Var) (step : t ⭢βᶠ t') (h_lc : LC s) :
-    (s [ x := t ]) ↠βᶠ (s [ x := t' ]) := by
+    (s[x := t]) ↠βᶠ (s[x := t']) := by
   induction h_lc with
   | fvar y => grind
   | abs => grind [redex_abs_cong (free_union Var)]
   | @app l r =>
      calc
-       (l.app r)[x:=t] ↠βᶠ l[x := t].app (r[x:=t']) := by grind
-       _               ↠βᶠ (l.app r)[x:=t'] := by grind
+       (l.app r)[x := t] ↠βᶠ l[x := t].app (r[x := t']) := by grind
+       _                 ↠βᶠ (l.app r)[x := t'] := by grind
 
 /- `step_subst_cong_r` can be generalized to multiple reductions `t ↠βᶠ t'`.
    This requires s to be locally closed, locally closedness of t and t'
    can be inferred by the fact t reduces to t' -/
 lemma steps_subst_cong_r {x : Var} (s t t' : Term Var) (step : t ↠βᶠ t') (h_lc : LC s) :
-    (s [ x := t ]) ↠βᶠ (s [ x := t' ]) := by
+    (s[x := t]) ↠βᶠ (s[x := t']) := by
   induction step with
   | refl => rfl
   | tail steps step ih => grind [Relation.ReflTransGen.trans, step_subst_cong_r]
@@ -190,7 +187,7 @@ lemma steps_open_cong_abs (s s' t t' : Term Var)
   | abs L =>
     have ⟨x, _⟩ := fresh_exists <| free_union [fv] Var
     rw [subst_intro x t s, subst_intro x t' s']
-    · trans (s ^ fvar x)[x:=t']
+    · trans (s ^ fvar x)[x := t']
       · grind [steps_subst_cong_r]
       · grind [=_ subst_intro, steps_open_cong_l_abs]
     all_goals grind
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean
index 84d5865c95..21d6826046 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean
@@ -7,6 +7,7 @@ Authors: Chris Henson
 module
 
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta
+public import Cslib.Foundations.Relation.Confluence
 
 /-! # β-confluence for the λ-calculus -/
 
@@ -72,8 +73,10 @@ lemma para_lc_r (step : M ⭢ₚ N) : LC N := by
   all_goals grind
 
 omit [HasFresh Var] [DecidableEq Var] in
-/-- A single β-reduction implies a single parallel reduction. -/
-lemma step_to_para (step : M ⭢βᶠ N) : M ⭢ₚ N := by
+/-- The inclusion `(· ⭢βᶠ ·) ≤ (· ⭢ₚ ·)`. -/
+lemma FullBeta.le_parallel :
+    ((· ⭢βᶠ ·) : Term Var → Term Var → Prop) ≤ (· ⭢ₚ ·) := by
+  intro M N step
   induction step with
   | base h =>
     cases h with | beta abs_lc _ =>
@@ -83,8 +86,10 @@ lemma step_to_para (step : M ⭢βᶠ N) : M ⭢ₚ N := by
   | _ => grind
 
 open FullBeta in
-/-- A single parallel reduction implies a multiple β-reduction. -/
-lemma para_to_redex (para : M ⭢ₚ N) : M ↠βᶠ N := by
+/-- The inclusion `(· ⭢ₚ ·) ≤ (· ↠βᶠ ·)`. -/
+lemma Parallel.le_reflTransGen_fullBeta :
+    ((· ⭢ₚ ·) : Term Var → Term Var → Prop) ≤ (· ↠βᶠ ·) := by
+  intro M N para
   induction para
   case fvar => constructor
   case app L L' R R' l_para m_para redex_l redex_m =>
@@ -104,11 +109,12 @@ lemma para_to_redex (para : M ⭢ₚ N) : M ↠βᶠ N := by
       _           ↠βᶠ m'.abs.app n' := by grind
       _           ⭢βᶠ m' ^ n'       := by grind
 
-/-- Multiple parallel reduction is equivalent to multiple β-reduction. -/
-theorem parachain_iff_redex : M ↠ₚ N ↔ M ↠βᶠ N := by
-  refine Iff.intro ?chain_redex ?redex_chain <;> intros h <;> induction h <;> try rfl
-  case redex_chain redex chain => exact ReflTransGen.tail chain (step_to_para redex)
-  case chain_redex para  redex => exact ReflTransGen.trans redex (para_to_redex para)
+/-- Multiple parallel reduction is equal to multiple β-reduction. -/
+theorem reflTransGen_parallel_fullBeta :
+    ((· ↠ₚ ·) : Term Var → Term Var → Prop) = (· ↠βᶠ ·) := by
+  apply le_antisymm
+  · exact reflTransGen_le_of_le Parallel.le_reflTransGen_fullBeta
+  · exact ReflTransGen.mono FullBeta.le_parallel
 
 /-- Parallel reduction respects substitution. -/
 @[scoped grind .]
@@ -135,7 +141,7 @@ lemma para_open_out (L : Finset Var) (mem : ∀ x, x ∉ L → (M ^ fvar x) ⭢
 
 -- adapted from https://github.com/ElifUskuplu/Stlc_deBruijn/blob/main/Stlc/confluence.lean
 /-- Parallel reduction has the diamond property. -/
-theorem para_diamond : Diamond (@Parallel Var) := by
+theorem parallel_diamond : Diamond ((· ⭢ₚ ·) : Term Var → Term Var → Prop) := by
   intros t t1 t2 tpt1
   revert t2
   induction tpt1 <;> intros t2 tpt2
@@ -174,7 +180,7 @@ theorem para_diamond : Diamond (@Parallel Var) := by
       have ⟨q1, q2, _⟩ := qx
       have ⟨t', _⟩ := ih2 s2pu2'
       have ⟨t'', _⟩ := @ih1 x q1 _ (mem' _ q2)
-      refine ⟨t'' [x := t'], ?_⟩
+      refine ⟨t''[x := t'], ?_⟩
       grind
   case app s1 s1' s2 s2' s1ps1' _ ih1 ih2  =>
     cases tpt2
@@ -198,16 +204,15 @@ theorem para_diamond : Diamond (@Parallel Var) := by
           apply Parallel.beta (free_union Var) <;> grind
 
 /-- Parallel reduction is confluent. -/
-theorem para_confluence : Confluent (@Parallel Var) :=
-  para_diamond.toConfluent
+theorem confluent_parallel : Confluent ((· ⭢ₚ ·) : Term Var → Term Var → Prop) :=
+  parallel_diamond.toConfluent
 
 /-- β-reduction is confluent. -/
-theorem confluence_beta : Confluent (@FullBeta Var) := by
-  have eq : ReflTransGen (@Parallel Var) = ReflTransGen (@FullBeta Var) := by
-    ext
-    exact parachain_iff_redex
-  rw [Confluent, ←eq]
-  exact para_confluence
+@[wikidata Q1308502]
+theorem confluent_fullBeta : Confluent ((· ⭢βᶠ ·) : Term Var → Term Var → Prop) := by
+  change Diamond ((· ↠βᶠ ·) : Term Var → Term Var → Prop)
+  rw [← reflTransGen_parallel_fullBeta]
+  exact confluent_parallel
 
 end LambdaCalculus.LocallyNameless.Untyped.Term
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean
index 989142ac67..c3452374ac 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean
@@ -88,15 +88,17 @@ lemma stronglyCommute_eta_beta : StronglyCommute (@FullEta Var) FullBeta := by
         | refl => grind [open_close]
         | single => exact .single (Xi.abs {w} (by grind [FullBeta.redex_subst_cong]))
       · rw [open_close w N 0 (by grind)]
-        exact FullEta.redex_abs_close h_eta (FullBeta.step_lc_r (st_body_beta w (by grind)))
+        exact FullEta.redex_abs_close h_eta
 
 open Commute in
 /-- βη-reduction is confluent. -/
+@[wikidata Q1308502]
 theorem confluent_beta_eta : Confluent (@FullBetaEta Var) := by
   apply join_confluent
-  · exact confluence_beta
+  · exact confluent_fullBeta
   · exact stronglyConfluent_eta.toConfluent
-  exact symmetric stronglyCommute_eta_beta.toCommute
+  apply symm
+  exact stronglyCommute_eta_beta.toCommute
 
 end LambdaCalculus.LocallyNameless.Untyped.Term
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
index ee2ee01d1c..a830d898f1 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
@@ -6,7 +6,7 @@ Authors: Maximiliano Onofre Martínez
 
 module
 
-public import Cslib.Foundations.Data.Relation
+public import Cslib.Foundations.Relation.Attr
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Congruence
 
@@ -45,6 +45,7 @@ lemma step_lc_r (step : M ⭢ηᶠ M') : LC M' := by
   grind
 
 /-- The left side of an η-reduction is locally closed. -/
+@[scoped grind →]
 lemma step_lc_l [HasFresh Var] (step : M ⭢ηᶠ M') : LC M := by
   induction step with
   | base h_e => cases h_e with | eta => apply LC.abs ∅; grind
@@ -81,72 +82,77 @@ lemma step_not_fv (step : M ⭢ηᶠ M') : M.fv = M'.fv := by
     grind [open_preserve_not_fvar]
   | _ => grind
 
-/-- Substitution of a fresh variable preserves an η-reduction step. -/
-@[scoped grind ←]
-lemma eta_subst_fvar {x y : Var} (step : M ⭢ηᶠ M') : M [ x := fvar y ] ⭢ηᶠ M' [ x := fvar y ] := by
-  induction step with
-  | abs => apply Xi.abs <| free_union Var; grind
-  | @base M N => grind
-  | _ => grind
+/- `s ⭢ηᶠ s'` implies `s[x := N] ⭢ηᶠ s'[x := N]`. -/
+lemma step_subst_cong_l {x : Var} (s s' N : Term Var) (step : s ⭢ηᶠ s') (lc_N : LC N) :
+    s[x := N] ⭢ηᶠ s'[x := N] := by
+  induction step
+  case base h => cases h with | eta lc => exact Xi.base (.eta (subst_lc lc lc_N))
+  case abs => apply Xi.abs <| free_union Var; grind
+  all_goals grind
+
+/- `steps_subst_cong_l` can be generalized to multiple reductions `s ↠ηᶠ s'`. -/
+lemma steps_subst_cong_l {x : Var} (s s' N : Term Var) (steps : s ↠ηᶠ s') (lc_N : LC N) :
+    s[x := N] ↠ηᶠ s'[x := N] := by
+  induction steps with
+  | refl => rfl
+  | tail _ step ih => grind [step_subst_cong_l]
 
 /-- Abstracting then closing preserves a single η-reduction step. -/
-lemma step_abs_close {x} (step : M ⭢ηᶠ M') (lc_M : LC M) : (M ^* x).abs ⭢ηᶠ (M' ^* x).abs := by
-  grind [Xi.abs ∅]
+lemma step_abs_close {x} (step : M ⭢ηᶠ M') : (M ^* x).abs ⭢ηᶠ (M' ^* x).abs := by
+  apply Xi.abs ∅
+  grind [step_subst_cong_l]
 
 /-- Abstracting then closing preserves multiple reductions. -/
-lemma redex_abs_close {x} (steps : M ↠ηᶠ M') (lc_M : LC M) : (M ^* x).abs ↠ηᶠ (M' ^* x).abs := by
+lemma redex_abs_close {x} (steps : M ↠ηᶠ M') : (M ^* x).abs ↠ηᶠ (M' ^* x).abs := by
   induction steps using Relation.ReflTransGen.head_induction_on
   case refl => exact .refl
-  case head b c st_bc _ ih => exact .head (step_abs_close st_bc lc_M) (ih (step_lc_r st_bc))
+  case head b c st_bc _ ih => exact .head (step_abs_close st_bc) ih
 
 /-- Multiple reduction of opening implies multiple reduction of abstraction. -/
 theorem redex_abs_cong {M M' : Term Var} (xs : Finset Var)
-    (cofin : ∀ x ∉ xs, (M ^ fvar x) ↠ηᶠ M' ^ fvar x) (lc_M : LC M.abs) :
+    (cofin : ∀ x ∉ xs, (M ^ fvar x) ↠ηᶠ M' ^ fvar x) :
     M.abs ↠ηᶠ M'.abs := by
-  cases lc_M
-  case abs L hL =>
     have ⟨x, _⟩ := fresh_exists <| free_union [fv] Var
     rw [open_close x M 0, open_close x M' 0]
-    all_goals grind [redex_abs_close (x := x) (cofin x ?_) (hL x ?_)]
+    all_goals grind [redex_abs_close (x := x) (cofin x ?_)]
 
-/- `t ⭢ηᶠ t'` implies `s [ x := t ] ↠ηᶠ s [ x := t' ]`. -/
-lemma step_subst_cong_r {x : Var} (s t t' : Term Var) (st : t ⭢ηᶠ t') (lc_s : LC s) (lc_t : LC t) :
-    s [ x := t ] ↠ηᶠ s [ x := t' ] := by
+/- `t ⭢ηᶠ t'` implies `s[x := t] ↠ηᶠ s[x := t']`. -/
+lemma step_subst_cong_r {x : Var} (s t t' : Term Var) (st : t ⭢ηᶠ t') (lc_s : LC s) :
+    s[x := t] ↠ηᶠ s[x := t'] := by
   induction lc_s generalizing t t' with
   | fvar => grind
   | app hl hr ih_l ih_r =>
     trans
-    · exact redex_app_l_cong (ih_l t t' st lc_t) (subst_lc hr lc_t)
-    · exact redex_app_r_cong (ih_r t t' st lc_t) (subst_lc hl (step_lc_r st))
+    · exact redex_app_l_cong (ih_l t t' st) (subst_lc hr (by grind))
+    · exact redex_app_r_cong (ih_r t t' st) (subst_lc hl (step_lc_r st))
   | abs L body h_lc_body ih =>
     apply redex_abs_cong (L ∪ {x})
     · intro z
       grind =>
         have : (body ^ fvar z)[x := t] ↠ηᶠ (body ^ fvar z)[x := t']
         finish
-    · exact subst_lc (LC.abs L body h_lc_body) lc_t
 
 /- `steps_subst_cong_r` can be generalized to multiple reductions `t ↠ηᶠ t'`. -/
-lemma steps_subst_cong_r {x : Var} (s t t' : Term Var) (st : t ↠ηᶠ t') (lc_s : LC s) (lc_t : LC t) :
-    s [ x := t ] ↠ηᶠ s [ x := t' ] := by
+lemma steps_subst_cong_r {x : Var} (s t t' : Term Var) (st : t ↠ηᶠ t') (lc_s : LC s) :
+    s[x := t] ↠ηᶠ s[x := t'] := by
   induction st using Relation.ReflTransGen.head_induction_on
   case refl => rfl
-  case head _ _ st _ ih => exact .trans (step_subst_cong_r s _ _ st lc_s lc_t) (ih (step_lc_r st))
+  case head _ _ st _ ih => exact .trans (step_subst_cong_r s _ _ st lc_s) ih
 
 /- `t ⭢ηᶠ t'` implies `s ^ t ↠ηᶠ s ^ t'`. -/
-lemma step_open_cong_r {s t t' : Term Var} (lc_s : LC s.abs) (lc_t : LC t) (step : t ⭢ηᶠ t') :
+lemma step_open_cong_r {s t t' : Term Var} (lc_s : LC s.abs) (step : t ⭢ηᶠ t') :
     (s ^ t) ↠ηᶠ s ^ t' := by
   cases lc_s
   case abs L hL =>
     have ⟨x, _⟩ := fresh_exists <| free_union [fv] Var
-    grind [step_subst_cong_r (x := x) (s ^ fvar x) t t' step (hL x ?_) lc_t]
+    grind [step_subst_cong_r (x := x) (s ^ fvar x) t t' step (hL x ?_)]
 
 /- `steps_open_cong_r` can be generalized to multiple reductions `t ↠ηᶠ t'`. -/
-lemma steps_open_cong_r {s t t' : Term Var} (lc_s : LC s.abs) (lc_t : LC t) (steps : t ↠ηᶠ t') :
+lemma steps_open_cong_r {s t t' : Term Var} (lc_s : LC s.abs) (steps : t ↠ηᶠ t') :
     (s ^ t) ↠ηᶠ s ^ t' := by
   induction steps using Relation.ReflTransGen.head_induction_on
   case refl => rfl
-  case head _ _ st _ ih => exact .trans (step_open_cong_r lc_s lc_t st) (ih (step_lc_r st))
+  case head _ _ st _ ih => exact .trans (step_open_cong_r lc_s st) ih
 
 /- Closing a sequence of η-reduction steps over a fresh variable preserves the steps. -/
 open Relation in
@@ -155,22 +161,7 @@ lemma close_eta_steps (hx_M : x ∉ M.fv) (st_M : ReflGen FullEta (M ^ fvar x) N
   cases st_M with
   | refl => rw [←open_close_var x M hx_M]
   | single st =>
-    exact .single (Xi.abs {x} (by grind))
-
-/- `s ⭢ηᶠ s'` implies `s [ x := N ] ⭢ηᶠ s' [ x := N ]`. -/
-lemma step_subst_cong_l {x : Var} (s s' N : Term Var) (step : s ⭢ηᶠ s') (lc_N : LC N) :
-    s [ x := N ] ⭢ηᶠ s' [ x := N ] := by
-  induction step
-  case base h => cases h with | eta lc => exact Xi.base (.eta (subst_lc lc lc_N))
-  case abs => grind [Xi.abs <| free_union Var, subst_open_var]
-  all_goals grind
-
-/- `steps_subst_cong_l` can be generalized to multiple reductions `s ↠ηᶠ s'`. -/
-lemma steps_subst_cong_l {x : Var} (s s' N : Term Var) (steps : s ↠ηᶠ s') (lc_N : LC N) :
-    s [ x := N ] ↠ηᶠ s' [ x := N ] := by
-  induction steps with
-  | refl => rfl
-  | tail _ step ih => grind [step_subst_cong_l]
+    exact .single (Xi.abs {x} (by grind [step_subst_cong_l]))
 
 end LambdaCalculus.LocallyNameless.Untyped.Term.FullEta
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEtaConfluence.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEtaConfluence.lean
index 500febbb76..4defb563e1 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEtaConfluence.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEtaConfluence.lean
@@ -7,6 +7,7 @@ Authors: Maximiliano Onofre Martínez
 module
 
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullEta
+public import Cslib.Foundations.Relation.Confluence
 
 /-! # η-confluence for the λ-calculus
 
@@ -33,6 +34,7 @@ open Relation
 variable [HasFresh Var] [DecidableEq Var]
 
 open FullEta in
+@[wikidata Q1308502]
 lemma stronglyConfluent_eta : StronglyConfluent (@FullEta Var) := by
   intro _ y z h₁ h₂
   suffices ∃ w, ReflGen FullEta y w ∧ ReflGen FullEta z w by grind
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
index 72fce48957..4a74cf41d1 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
@@ -86,6 +86,16 @@ attribute [scoped grind .] LC.fvar LC.app
 inductive Value : Term Var → Prop
 | abs (e : Term Var) : e.abs.LC → e.abs.Value
 
+/-- `IsAbs m` holds when `m` is an abstraction. -/
+@[scoped grind]
+inductive IsAbs : Term Var → Prop
+| abs (m : Term Var) : IsAbs (abs m)
+
+instance (m : Term Var) : Decidable (IsAbs m) := by
+  cases m
+  case abs => exact isTrue (.abs _)
+  all_goals exact isFalse (by intro _; contradiction)
+
 set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- `M` is `LcAt 0` if and only if `M` is locally closed. -/
 theorem lcAt_iff_LC (M : Term Var) [HasFresh Var] : LcAt 0 M ↔ M.LC := by
@@ -125,4 +135,7 @@ lemma lcAt_openRec_above_lcAt (M N : Term Var) (i j : ℕ) (h : i ≤ j) (lc : L
     M⟦j ↝ N⟧ = M := by
   induction M generalizing i j <;> grind
 
+lemma lcAt_le (M : Term Var) (i j : ℕ) (h : i ≤ j) (lc : LcAt i M) : LcAt j M := by
+  induction M generalizing i j <;> grind
+
 end Cslib.LambdaCalculus.LocallyNameless.Untyped.Term
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean
new file mode 100644
index 0000000000..e690a33755
--- /dev/null
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean
@@ -0,0 +1,142 @@
+/-
+Copyright (c) 2026 Maximiliano Onofre Martínez. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Maximiliano Onofre Martínez
+-/
+
+module
+
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.StandardReduction
+
+/-! # The Leftmost Reduction Theorem
+
+## Reference
+
+* [M. Copes, *A machine-checked proof of the Standardization Theorem in λ-calculus*][Copes2018]
+
+-/
+
+@[expose] public section
+
+set_option linter.unusedDecidableInType false
+
+namespace Cslib
+
+universe u
+
+variable {Var : Type u}
+
+namespace LambdaCalculus.LocallyNameless.Untyped.Term
+
+/-- A term is in normal form when it contains no β-redexes. -/
+@[grind]
+def BetaNormal (m : Term Var) : Prop := countRedexes m = 0
+
+/-- Leftmost reduction: a β-reduction contracting the redex at position 0. -/
+@[reduction_sys "ℓ"]
+abbrev Leftmost : Term Var → Term Var → Prop := BetaAt 0
+
+variable {L L' M M' N : Term Var} {i : Nat}
+
+/-- In a normal-form application, both sides are normal and the operator is not an
+    abstraction. -/
+lemma BetaNormal.app_inv (h : BetaNormal (app L M)) :
+    ¬IsAbs L ∧ BetaNormal L ∧ BetaNormal M := by
+  cases L <;> grind [countRedexes]
+
+/-- The body of a normal-form abstraction opens to a normal form. -/
+lemma BetaNormal.abs_open {x : Var} (h : BetaNormal (abs M)) : BetaNormal (M ^ fvar x) := by
+  rw [BetaNormal, countRedexes_open_fvar]
+  exact h
+
+/-- Leftmost reduction preserves being an abstraction. -/
+lemma Leftmost.steps_isAbs_r (h : M ↠ℓ N) (ha : IsAbs M) : IsAbs N := by
+  induction h with
+  | refl => exact ha
+  | tail _ step ih => exact step.isAbs_r ih
+
+/-- Left congruence for leftmost reduction, provided the target is not an abstraction. -/
+lemma Leftmost.steps_app_l_cong (h : L ↠ℓ L') (hna : ¬IsAbs L') :
+    app L M ↠ℓ app L' M := by
+  induction h
+  case refl => rfl
+  case tail P _ _ step ih =>
+    have hnb : ¬IsAbs P := mt step.isAbs_r hna
+    exact (ih hnb).tail (step.appNoAbsL hnb)
+
+/-- Reducing the operand across a non-abstraction normal form keeps the position. -/
+lemma BetaAt.app_r_cong (h : BetaAt i M M') (hL : BetaNormal L) (hna : ¬IsAbs L) :
+    BetaAt i (app L M) (app L M') := by
+  have := h.appNoAbsR hna
+  rwa [hL] at this
+
+/-- Right congruence for leftmost reduction, provided the operator is a non-abstraction
+    normal form. -/
+lemma Leftmost.steps_app_r_cong (h : M ↠ℓ M') (hL : BetaNormal L) (hna : ¬IsAbs L) :
+    app L M ↠ℓ app L M' := by
+  induction h with
+  | refl => rfl
+  | tail _ step ih => exact ih.tail (step.app_r_cong hL hna)
+
+/-- Congruence for leftmost reduction on applications whose reduced operator is a
+    non-abstraction normal form. -/
+lemma Leftmost.steps_app_cong (hL : L ↠ℓ L') (hM : M ↠ℓ M')
+    (hnf : BetaNormal L') (hna : ¬IsAbs L') : app L M ↠ℓ app L' M' :=
+  (steps_app_l_cong hL hna).trans (steps_app_r_cong hM hnf hna)
+
+/-- Call-by-Name reduction is contained in leftmost reduction. -/
+lemma Leftmost.of_cbn (h : M ↠ₙ N) : M ↠ℓ N := by
+  induction h with
+  | refl => rfl
+  | tail _ step ih => exact ih.tail (BetaAt.of_cbn_step step)
+
+variable [DecidableEq Var] [HasFresh Var]
+
+/-- Leftmost reduction preserves local closure. -/
+lemma Leftmost.steps_lc_r (h : M ↠ℓ M') (lc : LC M) : LC M' := by
+  induction h with
+  | refl => exact lc
+  | tail _ step ih => exact step.lc_r ih
+
+/-- Leftmost reduction is preserved by closing a variable and abstracting. -/
+lemma Leftmost.steps_abs_close {x : Var} (h : M ↠ℓ M') (lc : LC M) :
+    (M⟦0 ↜ x⟧.abs) ↠ℓ (M'⟦0 ↜ x⟧.abs) := by
+  induction h with
+  | refl => rfl
+  | tail hs step ih => exact ih.tail (step.abs_close (steps_lc_r hs lc))
+
+/-- Cofinite congruence rule for leftmost reduction under an abstraction. -/
+lemma Leftmost.steps_abs_cong (xs : Finset Var)
+    (cofin : ∀ x ∉ xs, (M ^ fvar x) ↠ℓ (M' ^ fvar x)) (lc : LC (abs M)) :
+    abs M ↠ℓ abs M' := by
+  have ⟨w, _⟩ := fresh_exists <| free_union [fv] Var
+  rw [open_close w M 0 (by grind), open_close w M' 0 (by grind)]
+  have hstep := cofin w (by grind)
+  have hlc := beta_lc lc (.fvar w)
+  exact steps_abs_close hstep hlc
+
+/-- A standard reduction to a normal form is a leftmost reduction. -/
+theorem Leftmost.of_standard (h : M ⭢ₛ N) (hn : BetaNormal N) : M ↠ℓ N := by
+  induction h
+  case fvar x => rfl
+  case app _ _ ihL ihM =>
+    have ⟨hna, hL', hM'⟩ := hn.app_inv
+    exact steps_app_cong (ihL hL') (ihM hM') hL' hna
+  case abs xs h_body ih =>
+    have lc := (Standard.abs xs h_body).lc_l
+    apply steps_abs_cong xs _ lc
+    intro x hx
+    exact ih x hx hn.abs_open
+  case rdx M N M' _ lc_M lc_N cbn std_P ih =>
+    have s1 : M.app N ↠ℓ M'.abs.app N := of_cbn (CBN.steps_app_l_cong cbn lc_N)
+    have s2 : M'.abs.app N ⭢ℓ M' ^ N := .outer (CBN.steps_lc_r lc_M cbn) lc_N
+    exact (s1.tail s2).trans (ih hn)
+
+/-- The leftmost reduction theorem: if a term β-reduces to a normal form, then leftmost
+    reduction reaches it. -/
+theorem Leftmost.normalization (lc : LC M) (h : M ↠βᶠ N) (hn : BetaNormal N) : M ↠ℓ N :=
+  of_standard (.standardization lc h) hn
+
+end LambdaCalculus.LocallyNameless.Untyped.Term
+
+end Cslib
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiApp.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiApp.lean
index d7016d7dc4..8773906467 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiApp.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiApp.lean
@@ -28,7 +28,7 @@ namespace LambdaCalculus.LocallyNameless.Untyped.Term
 @[simp, scoped grind =]
 def multiApp (f : Term Var) : List (Term Var) → Term Var
 | []      => f
-| a :: as => Term.app (multiApp f as) a
+| a :: as => multiApp (app f a) as
 
 /-- A list of arguments performs a single reduction step
 
@@ -45,18 +45,23 @@ inductive ListFullBeta : List (Term Var) → List (Term Var) → Prop where
 
 variable {M M' : Term Var} {Ns Ns' : List (Term Var)}
 
+lemma multiApp_tail {N} : (M.multiApp (Ns ++ [N])) = (M.multiApp Ns).app  N:= by
+  induction Ns generalizing M with
+  | nil => grind
+  | cons head tail ih => rw [List.cons_append]; apply ih
+
 /-- A term resulting from a multi-application is locally closed if
     and only if the leftmost term and all arguments applied to it are locally closed -/
 @[scoped grind ←]
 lemma multiApp_lc : LC (M.multiApp Ns) ↔ LC M ∧ (∀ N ∈ Ns, LC N) := by
-  induction Ns with grind [cases LC]
+  induction Ns generalizing M with grind [cases LC]
 
 /-- Just like ordinary beta reduction, the left-hand side
     of a multi-application step is locally closed -/
 @[scoped grind ←]
 lemma step_multiApp_l (steps : M ⭢βᶠ M') (lc_Ns : ∀ N ∈ Ns, LC N) :
     M.multiApp Ns ⭢βᶠ M'.multiApp Ns := by
-  induction Ns <;> grind
+  induction Ns generalizing M M' with grind
 
 /-- Congruence lemma for multi reduction of the left most term of a multi-application -/
 lemma steps_multiApp_l (steps : M ↠βᶠ M') (lc_Ns : ∀ N ∈ Ns, LC N) :
@@ -66,12 +71,18 @@ lemma steps_multiApp_l (steps : M ↠βᶠ M') (lc_Ns : ∀ N ∈ Ns, LC N) :
 /-- Congruence lemma for single reduction of one of the arguments of a multi-application -/
 @[scoped grind ←]
 lemma step_multiApp_r (steps : Ns ⭢lβᶠ Ns') (lc_M : LC M) : M.multiApp Ns ⭢βᶠ M.multiApp Ns' := by
-  induction steps <;> grind
+  induction steps generalizing M <;> grind
 
 /-- Congruence lemma for multiple reduction of one of the arguments of a multi-application -/
 lemma steps_multiApp_r (steps : Ns ↠lβᶠ Ns') (lc_M : LC M) : M.multiApp Ns ↠βᶠ M.multiApp Ns' := by
   induction steps <;> grind
 
+lemma listFullBeta_cons_r (h : Ns ⭢lβᶠ Ns') (h_lc : ∀ M ∈ l, LC M) : (l ++ Ns) ⭢lβᶠ (l ++ Ns') := by
+  induction l using List.reverseRecOn generalizing Ns Ns' with grind
+
+lemma listFullBeta_cons_l (h : Ns ⭢lβᶠ Ns') (h_lc : ∀ M ∈ l, LC M) : (Ns ++ l) ⭢lβᶠ (Ns' ++ l) := by
+  induction h with grind
+
 set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- If a term (λ M) N P_1 ... P_n reduces in a single step to Q, then
     Q must be one of the following forms:
@@ -86,16 +97,19 @@ lemma invert_abs_multiApp_st {Ps} {M N Q : Term Var}
     (∃ N', N ⭢βᶠ N' ∧ Q = multiApp (M.abs.app N') Ps) ∨
     (∃ Ps', Ps ⭢lβᶠ Ps' ∧ Q = multiApp (M.abs.app N) Ps') ∨
     (Q = multiApp (M ^ N) Ps) := by
-  induction Ps generalizing M N Q with
+  induction Ps using List.reverseRecOn generalizing M N Q with
   | nil => grind only [cases Xi, multiApp]
-  | cons P Ps ih =>
-    generalize Heq : (M.abs.app N).multiApp Ps = Q'
-    have : ∀ P', Q'.app P' = (M.abs.app N).multiApp (P' :: Ps) := by grind
-    rw [multiApp, Heq] at h_red
+  | append_singleton Ps P ih =>
+    rw [multiApp_tail] at h_red
     cases h_red with
-    | base => cases Ps <;> grind
-    | appR => grind [→ ListFullBeta.cons]
-    | appL => grind
+    | @appL _ _ P' _ P_P' =>
+      have : (Ps ++ [P]) ⭢lβᶠ Ps ++ [P'] := by apply listFullBeta_cons_r (.step P_P' ?_) <;> grind
+      grind [multiApp_tail]
+    | appR _ h =>
+      have {Ps'} (h : Ps ⭢lβᶠ Ps') : (Ps ++ [P]) ⭢lβᶠ Ps' ++ [P] := listFullBeta_cons_l h (by grind)
+      grind [multiApp_tail]
+    | base => induction Ps using List.reverseRecOn with grind [multiApp_tail]
+
 
 /-- If a term (λ M) N P₁ ... Pₙ reduces in multiple steps to Q, then either Q if of the form
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean
index 4cf0657415..91deb0e118 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean
@@ -7,7 +7,6 @@ Authors: David Wegmann
 
 module
 
-public import Cslib.Foundations.Data.Relation
 public import Cslib.Foundations.Data.HasFresh
 public import Cslib.Foundations.Syntax.HasSubstitution
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic
@@ -38,7 +37,7 @@ abbrev Env (Var : Type u) := Context Var (Term Var)
 def multiSubst (E : Env Var) (M : Term Var) : Term Var :=
   match E with
   | [] => M
-  | ⟨i, sub⟩ :: E' => (multiSubst E' M) [ i := sub ]
+  | ⟨i, sub⟩ :: E' => (multiSubst E' M)[i := sub]
 
 /-- The free variables of an environment are the union of
     the free variables of all terms in the environment.
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
index 54b3b6c9ab..4af9462d16 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
@@ -25,7 +25,7 @@ attribute [grind =] Finset.union_singleton
 variable [DecidableEq Var]
 
 /-- Substitution of a free variable not present in a term leaves it unchanged. -/
-theorem subst_fresh (x : Var) (t sub : Term Var) (nmem : x ∉ t.fv) : t [x := sub] = t := by
+theorem subst_fresh (x : Var) (t sub : Term Var) (nmem : x ∉ t.fv) : t[x := sub] = t := by
   induction t <;> grind
 
 /- Opening and closing are inverses. -/
@@ -66,7 +66,7 @@ theorem open_preserve_not_fvar (k) (m n : Term Var) :
 set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Substitution preserves free variables. -/
 lemma subst_preserve_not_fvar {y : Var} (m n : Term Var) :
-    m [y := n].fv = m.fv.erase y ∨ m [y := n].fv = m.fv.erase y ∪ n.fv:= by
+    m[y := n].fv = m.fv.erase y ∨ m[y := n].fv = m.fv.erase y ∪ n.fv:= by
   induction m with
   | app => grind only [fv, = subst_app, = Finset.mem_union, = Finset.mem_erase]
   | _ => grind
@@ -74,6 +74,16 @@ lemma subst_preserve_not_fvar {y : Var} (m n : Term Var) :
 lemma subst_refl (m : Term Var) (x : Var) : m[x := fvar x] = m := by
   induction m <;> grind
 
+lemma subst_intro_openRec {x} {t e : Term Var} (mem : x ∉ e.fv) {k : ℕ} :
+    e ⟦k ↝ t⟧ = (e ⟦ k ↝ fvar x⟧)[ x := t ] := by
+  induction e generalizing k with grind
+
+/-- Opening to a term `t` is equivalent to opening to a free variable and substituting for `t`. -/
+lemma subst_intro (x : Var) (t e : Term Var) (mem : x ∉ e.fv) :
+    e ^ t = (e ^ fvar x)[x := t] := subst_intro_openRec mem
+
+scoped grind_pattern subst_intro => open' e t, open' e (fvar x)
+
 variable [HasFresh Var]
 
 omit [DecidableEq Var] in
@@ -97,12 +107,12 @@ lemma open_eq_app {x : Var} {m n : Term Var} (hw_n : x ∉ n.fv) (hw_m : x ∉ m
 /-- Substitution of a locally closed term distributes with opening. -/
 @[scoped grind =]
 lemma subst_openRec (x : Var) (t : Term Var) (k : ℕ) (u e : Term Var) (lc : LC t) :
-    (e⟦ k ↝ u ⟧)[x := t] = e[x := t]⟦k ↝ u [ x := t ]⟧ := by
+    (e⟦ k ↝ u ⟧)[x := t] = e[x := t]⟦k ↝ u[x := t]⟧ := by
   induction e generalizing k with grind
 
 /-- Specialize `subst_openRec` to the first opening. -/
 lemma subst_open (x : Var) (t : Term Var) (u e : Term Var) (lc : LC t) :
-    (e ^ u)[x := t] = e[x := t] ^ u [ x := t ] := by grind
+    (e ^ u)[x := t] = e[x := t] ^ u[x := t] := by grind
 
 /-- Specialize `subst_open` to the free variables. -/
 theorem subst_open_var (x y : Var) (u e : Term Var) (neq : y ≠ x) (u_lc : LC u) :
@@ -110,17 +120,11 @@ theorem subst_open_var (x y : Var) (u e : Term Var) (neq : y ≠ x) (u_lc : LC u
 
 /-- Substitution of locally closed terms is locally closed. -/
 @[scoped grind ←]
-theorem subst_lc {x : Var} {e u : Term Var} (e_lc : LC e) (u_lc : LC u) : LC (e [x := u]) := by
+theorem subst_lc {x : Var} {e u : Term Var} (e_lc : LC e) (u_lc : LC u) : LC (e[x := u]) := by
   induction e_lc
   case' abs => apply LC.abs (free_union Var)
   all_goals grind
 
-/-- Opening to a term `t` is equivalent to opening to a free variable and substituting for `t`. -/
-lemma subst_intro (x : Var) (t e : Term Var) (mem : x ∉ e.fv) (t_lc : LC t) :
-    e ^ t = (e ^ fvar x) [ x := t ] := by grind [subst_fresh]
-
-scoped grind_pattern subst_intro => open' e t, open' e (fvar x)
-
 set_option linter.unusedDecidableInType false in
 /-- Opening of locally closed terms is locally closed. -/
 @[scoped grind ←]
@@ -130,8 +134,8 @@ theorem beta_lc {M N : Term Var} (m_lc : M.abs.LC) (n_lc : LC N) : LC (M ^ N) :=
 
 /-- Closing then opening is equivalent to substitution. -/
 @[scoped grind =]
-lemma close_open_to_subst (m n : Term Var) (x : Var) (k : ℕ) (m_lc : LC m) (n_lc : LC n) :
-    m ⟦k ↜ x⟧⟦k ↝ n⟧ = m [x := n] := by
+lemma close_openRec_to_subst (m n : Term Var) (x : Var) (k : ℕ) (m_lc : LC m) (n_lc : LC n) :
+    m ⟦k ↜ x⟧⟦k ↝ n⟧ = m[x := n] := by
   induction m_lc generalizing k with
   | abs xs t =>
     have ⟨x', _⟩ := fresh_exists <| free_union [fv] Var
@@ -142,6 +146,10 @@ lemma close_open_to_subst (m n : Term Var) (x : Var) (k : ℕ) (m_lc : LC m) (n_
     · grind [open_preserve_not_fvar]
   | _ => grind
 
+@[scoped grind =]
+lemma close_open_to_subst (m n : Term Var) (x : Var) (m_lc : LC m) (n_lc : LC n) :
+    (m ^* x) ^ n = m[x := n] := close_openRec_to_subst m n x 0 m_lc n_lc
+
 /-- Closing and opening are inverses. -/
 lemma close_open (x : Var) (t : Term Var) (k : ℕ) (t_lc : LC t) : t⟦k ↜ x⟧⟦k ↝ fvar x⟧ = t := by
   grind [subst_refl]
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StandardReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StandardReduction.lean
new file mode 100644
index 0000000000..96324ac570
--- /dev/null
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StandardReduction.lean
@@ -0,0 +1,419 @@
+/-
+Copyright (c) 2026 Maximiliano Onofre Martínez. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Maximiliano Onofre Martínez
+-/
+
+module
+
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.BetaAt
+
+/-! # Standard Reduction and the Standardization Theorem
+
+## References
+
+* [B. Calisto, *Formalization in Coq of the Standardization Theorem for λ-calculus*][Calisto2022]
+* [M. Copes, *A machine-checked proof of the Standardization Theorem in λ-calculus*][Copes2018]
+
+-/
+
+@[expose] public section
+
+set_option linter.unusedDecidableInType false
+
+namespace Cslib
+
+universe u
+
+variable {Var : Type u}
+
+namespace LambdaCalculus.LocallyNameless.Untyped.Term
+
+/-! ## Main definitions -/
+
+/-- A standard β-reduction sequence contracts redexes at non-decreasing positions. The index
+    `n` is the last position contracted. -/
+inductive StandardSeq : Nat → Term Var → Term Var → Prop
+/-- The empty sequence. -/
+| refl : StandardSeq n M M
+/-- Append a β-step whose position is no earlier than the previous one. -/
+| tail : StandardSeq n M P → BetaAt m P N → n ≤ m → StandardSeq m M N
+
+/-- The Standard reduction relation. -/
+@[reduction_sys "ₛ"]
+inductive Standard : Term Var → Term Var → Prop
+/-- Free variables standardly reduce to themselves. -/
+| fvar (x : Var) : Standard (fvar x) (fvar x)
+/-- Congruence rule for application. -/
+| app  : Standard L L' → Standard M M' → Standard (app L M) (app L' M')
+/-- Congruence rule for lambda terms. -/
+| abs (xs : Finset Var) :
+    (∀ x ∉ xs, Standard (m ^ fvar x) (m' ^ fvar x)) → Standard (abs m) (abs m')
+/-- Standard reduction of a head redex. -/
+| rdx : LC m → LC n → m ↠ₙ (abs m') → Standard (m' ^ n) p → Standard (app m n) p
+
+variable {L L' M M' N N' P : Term Var} {a b i m n : Nat}
+
+/-! ## Basic properties -/
+
+/-- The left side of a standard reduction is locally closed. -/
+lemma Standard.lc_l (step : M ⭢ₛ N) : LC M := by
+  induction step
+  case abs xs _ ih => exact LC.abs xs _ ih
+  all_goals grind
+
+/-- Standard reduction is reflexive for locally closed terms. -/
+lemma Standard.lc_refl (M : Term Var) (lc : LC M) : M ⭢ₛ M := by
+  induction lc
+  all_goals constructor <;> assumption
+
+/-- The right side of a standard reduction is locally closed. -/
+lemma Standard.lc_r (step : M ⭢ₛ N) : LC N := by
+  induction step
+  case abs xs _ ih => exact LC.abs xs _ ih
+  all_goals grind
+
+/-- A single Call-by-Name step is a standard reduction. -/
+lemma Standard.of_cbn_step (step : M ⭢ₙ N) (lc_N : LC N) : M ⭢ₛ N := by
+  induction step
+  case base h_beta =>
+    cases h_beta
+    exact rdx (by assumption) (by assumption) .refl (lc_refl _ lc_N)
+  case app L _ _ lc_L _ ih =>
+    cases lc_N
+    exact app (ih (by assumption)) (lc_refl L lc_L)
+
+/-- A Call-by-Name step followed by a standard reduction is a standard reduction. -/
+lemma Standard.cbn_step_trans (step : M ⭢ₙ P) (std : P ⭢ₛ N) : M ⭢ₛ N := by
+  induction step generalizing N
+  case base h_beta =>
+    cases h_beta
+    exact rdx (by assumption) (by assumption) .refl std
+  case app step_M ih =>
+    cases std with
+    | app std_L' std_M => exact app (ih std_L') std_M
+    | rdx _ lc_Z cbn_m std_body => exact rdx step_M.lc_l lc_Z (.head step_M cbn_m) std_body
+
+/-- A Call-by-Name reduction followed by a standard reduction is a standard reduction. -/
+lemma Standard.cbn_trans (h1 : M ↠ₙ P) (h2 : P ⭢ₛ N) : M ⭢ₛ N := by
+  induction h1 with
+  | refl => exact h2
+  | tail _ h_step ih => exact ih (cbn_step_trans h_step h2)
+
+/-- Call-by-Name reduction is contained in standard reduction. -/
+lemma Standard.of_cbn (step : M ↠ₙ N) (lc_N : LC N) : M ⭢ₛ N :=
+  cbn_trans step (lc_refl N lc_N)
+
+/-! ## Standard sequences -/
+
+/-- Standard sequences preserve being an abstraction. -/
+lemma StandardSeq.isAbs_r (h : StandardSeq n M N) (ha : IsAbs M) : IsAbs N := by
+  induction h with
+  | refl => exact ha
+  | tail _ step _ ih => exact step.isAbs_r (ih ha)
+
+/-- A standard sequence preceded by a step at position `0` remains standard. -/
+lemma StandardSeq.head_leftmost (seq : StandardSeq n P N) :
+    ∀ {M}, BetaAt 0 M P → ∃ k, k ≤ n ∧ StandardSeq k M N := by
+  induction seq with
+  | refl => intro M step; exact ⟨0, Nat.zero_le _, StandardSeq.refl.tail step (le_refl 0)⟩
+  | tail _ step' hni ih =>
+    intro M step
+    obtain ⟨k, hkn, hk⟩ := ih step
+    exact ⟨_, le_refl _, hk.tail step' (by omega)⟩
+
+/-- A standard sequence stays standard when preceded by a Call-by-Name reduction. -/
+lemma StandardSeq.cbn_head (h : M ↠ₙ P) (hseq : StandardSeq n P N) :
+    ∃ k, StandardSeq k M N := by
+  induction h generalizing n with
+  | refl => exact ⟨n, hseq⟩
+  | tail _ step ih =>
+    obtain ⟨j, _, hj⟩ := hseq.head_leftmost (BetaAt.of_cbn_step step)
+    exact ih hj
+
+/-- Right congruence for standard sequences when the operator is an abstraction. -/
+lemma StandardSeq.app_r_abs (h : StandardSeq n M M') (ha : IsAbs L) :
+    StandardSeq (n + countRedexes L + 1) (app L M) (app L M') := by
+  induction h with
+  | refl => exact .refl
+  | tail _ step hni ih => exact ih.tail (step.appAbsR ha) (by omega)
+
+/-- Right congruence for standard sequences when the operator is a non-abstraction. -/
+lemma StandardSeq.app_r_noAbs (h : StandardSeq n M M') (hna : ¬IsAbs L) :
+    StandardSeq (n + countRedexes L) (app L M) (app L M') := by
+  induction h with
+  | refl => exact .refl
+  | tail _ step hni ih => exact ih.tail (step.appNoAbsR hna) (by omega)
+
+/-- Right application congruence for standard sequences. -/
+lemma StandardSeq.app_r_cong (h : StandardSeq n M M') :
+    ∃ k, StandardSeq k (app L M) (app L M') ∧
+      k ≤ n + countRedexes L + (if IsAbs L then 1 else 0) := by
+  induction h with
+  | refl => exact ⟨0, .refl, Nat.zero_le _⟩
+  | tail _ step hni ih =>
+    have ⟨k, hseq, hk⟩ := ih
+    have happ := step.appR (N := L)
+    exact ⟨_, hseq.tail happ (by omega), by omega⟩
+
+variable [HasFresh Var]
+
+/-- The final position of a nonempty standard sequence is at most its target's redex count. -/
+lemma StandardSeq.le_countRedexes_of_ne (h : StandardSeq n M N) (hne : M ≠ N) :
+    n ≤ countRedexes N := by
+  cases h with
+  | refl => contradiction
+  | tail _ step _ => exact step.le_countRedexes
+
+omit [HasFresh Var] in
+/-- Reducing the operator of an application yields a standard sequence, with the final position
+    bounded. -/
+lemma StandardSeq.app_l_cong (h : StandardSeq n L L') :
+    ∃ k, StandardSeq k (app L M) (app L' M) ∧
+      k ≤ n + (if IsAbs L' then 1 else 0) := by
+  induction h
+  case refl => exact ⟨0, .refl, Nat.zero_le _⟩
+  case tail Q _ _ seq step hni ih =>
+    have ⟨c, hc, hc_le⟩ := ih
+    by_cases hQ : IsAbs Q
+    · have hL' := step.isAbs_r hQ
+      have hseq := hc.tail (step.appAbsL hQ) (by simp only [ite_eq_left hQ] at hc_le; omega)
+      exact ⟨_, hseq, by rw [ite_eq_left hL']⟩
+    · have hseq := hc.tail (step.appNoAbsL hQ) (by simp only [ite_eq_right hQ] at hc_le; omega)
+      exact ⟨_, hseq, by split <;> omega⟩
+
+/-- A nonempty operator reduction lifts to the application, bounded by the operator's redex
+    count. -/
+lemma StandardSeq.app_l_cong_of_ne (h : StandardSeq n L L') (hne : L ≠ L') :
+    ∃ k, StandardSeq k (app L M) (app L' M) ∧
+      k ≤ countRedexes L' + (if IsAbs L' then 1 else 0) := by
+  have hn := h.le_countRedexes_of_ne hne
+  have ⟨k, hseq, hk⟩ := h.app_l_cong (M := M)
+  exact ⟨k, hseq, by omega⟩
+
+omit [HasFresh Var] in
+/-- Append an operand step to a standard sequence of applications. -/
+lemma StandardSeq.app_r_tail (h : StandardSeq n (app L M) (app L' N))
+    (step : BetaAt i N N')
+    (hle : n ≤ i + countRedexes L' + (if IsAbs L' then 1 else 0)) :
+    StandardSeq (i + countRedexes L' + (if IsAbs L' then 1 else 0))
+      (app L M) (app L' N') :=
+  h.tail step.appR hle
+
+omit [HasFresh Var] in
+/-- Compose an application sequence with a standard reduction of its operand. -/
+lemma StandardSeq.app_r_trans (h : StandardSeq n M M')
+    (happ : StandardSeq i (app L M) (app L' M))
+    (hc : i ≤ countRedexes L' + (if IsAbs L' then 1 else 0)) :
+    ∃ d, StandardSeq d (app L M) (app L' M') ∧
+      d ≤ n + countRedexes L' + (if IsAbs L' then 1 else 0) := by
+  induction h with
+  | refl => exact ⟨i, happ, by omega⟩
+  | tail _ step hni ih =>
+    have ⟨d, hd, hd_le⟩ := ih happ
+    have hseq := hd.app_r_tail step (by omega)
+    exact ⟨_, hseq, by omega⟩
+
+/-- If operator and operand each reduce by a standard sequence, so does the application. -/
+lemma StandardSeq.app_cong (hL : StandardSeq n L L') (hM : StandardSeq b M M') :
+    ∃ k, StandardSeq k (app L M) (app L' M') := by
+  by_cases hLL : L = L'
+  · subst hLL
+    have ⟨k, hseq, _⟩ := hM.app_r_cong (L := L)
+    exact ⟨k, hseq⟩
+  · have ⟨_, happ, hbound⟩ := hL.app_l_cong_of_ne (M := M) hLL
+    have ⟨k, hseq, _⟩ := hM.app_r_trans happ hbound
+    exact ⟨k, hseq⟩
+
+variable [DecidableEq Var]
+
+/-! ## Standardization -/
+
+/-- Standard reduction is preserved by substitution. -/
+lemma Standard.subst (hM : M ⭢ₛ M') (hN : N ⭢ₛ N') (x : Var) (lc_N : LC N) (lc_N' : LC N') :
+    (M[x := N]) ⭢ₛ (M'[x := N']) := by
+  induction hM generalizing N N'
+  case fvar =>
+    simp only [Term.subst_fvar]
+    split
+    · exact hN
+    · exact fvar _
+  case app ihL ihM => exact app (ihL hN lc_N lc_N') (ihM hN lc_N lc_N')
+  case abs m m' _ _ ih =>
+    apply abs <| free_union [fv] Var
+    grind
+  case rdx n m' _ lc_m lc_n cbn_m std_p ih =>
+    rw [Term.subst_app]
+    have std_p_subst := ih hN lc_N lc_N'
+    rw [Term.subst_open x N n m' lc_N] at std_p_subst
+    exact rdx (subst_lc lc_m lc_N) (subst_lc lc_n lc_N) (CBN.steps_subst x cbn_m lc_N) std_p_subst
+
+/-- A single full β-step is a standard reduction. -/
+lemma Standard.of_beta_step (step : M ⭢βᶠ N) (lc_M : LC M) : M ⭢ₛ N := by
+  induction step
+  case base h_beta => grind [rdx, lc_refl]
+  case appL Z A B lc_Z _ ih =>
+    cases lc_M
+    exact app (lc_refl Z lc_Z) (ih (by assumption))
+  case appR Z A B lc_Z _ ih =>
+    cases lc_M
+    exact app (ih (by assumption)) (lc_refl Z lc_Z)
+  case abs ih =>
+    apply abs <| free_union [fv] Var
+    intro x hx
+    exact ih x (by grind) (Term.beta_lc lc_M (by constructor))
+
+open FullBeta in
+/-- Standard reduction is contained in full β-reduction. -/
+lemma Standard.to_redex (step : M ⭢ₛ N) : M ↠βᶠ N := by
+  induction step
+  case fvar => rfl
+  case app step_L step_M ih_L ih_M =>
+    exact .trans (redex_app_l_cong ih_L step_M.lc_l) (redex_app_r_cong ih_M step_L.lc_r)
+  case abs xs _ ih => exact FullBeta.redex_abs_cong xs ih
+  case rdx n m' _ lc_m lc_n cbn_m std_p ih =>
+    have step1 := redex_app_l_cong (CBN.to_redex cbn_m) lc_n
+    have step2 : m'.abs.app n ↠βᶠ m' ^ n := .single (.base (.beta (CBN.steps_lc_r lc_m cbn_m) lc_n))
+    exact .trans step1 (.trans step2 ih)
+
+/-- If a standard reduction reaches an abstraction, then its leading Call-by-Name
+    reduction reaches an abstraction that standardly reduces to the same target. -/
+lemma Standard.abs_inv (h : M ⭢ₛ N) (M' : Term Var) (eq : N = Term.abs M') :
+    ∃ M'', M ↠ₙ Term.abs M'' ∧ Term.abs M'' ⭢ₛ Term.abs M' := by
+  induction h generalizing M'
+  case fvar => trivial
+  case app => trivial
+  case abs m_body m_target xs h_body ih =>
+    cases eq
+    exact ⟨m_body, .refl, .abs xs h_body⟩
+  case rdx m1 n1 m1' p1 lc_m1 lc_n1 cbn_m1 _ ih =>
+    have ⟨p'', cbn_body, std_p''⟩ := ih M' eq
+    have step1 : m1.app n1 ↠ₙ m1'.abs.app n1 := CBN.steps_app_l_cong cbn_m1 lc_n1
+    have step2 : m1'.abs.app n1 ⭢ₙ m1' ^ n1 := .base (.beta (CBN.steps_lc_r lc_m1 cbn_m1) lc_n1)
+    exact ⟨p'', .trans step1 (.head step2 cbn_body), std_p''⟩
+
+/-- Standard reduction of abstractions is preserved by opening. -/
+lemma Standard.abs_subst
+    (h_abs : Term.abs M ⭢ₛ Term.abs M') (hN : N ⭢ₛ N') (lc_N : LC N) (lc_N' : LC N') :
+    (M ^ N) ⭢ₛ (M' ^ N') := by
+  cases h_abs
+  case abs h_body =>
+    have ⟨y, _⟩ := fresh_exists <| free_union [fv] Var
+    have := subst (h_body y (by grind)) hN y lc_N lc_N'
+    grind
+
+/-- A standard reduction followed by a full β-step is a standard reduction. -/
+lemma Standard.trans_step (h1 : M ⭢ₛ P) (h2 : P ⭢βᶠ N) : M ⭢ₛ N := by
+  induction h1 generalizing N
+  case fvar => contradiction
+  case rdx lc_L lc_M cbn _ ih => exact .rdx lc_L lc_M cbn (ih h2)
+  case abs p_body ih =>
+    cases h2
+    · grind
+    · apply abs <| free_union [fv] Var
+      grind
+  case app L' _ M _ std_L std_M ih_L ih_M =>
+    cases h2
+    case appL step_M => exact .app std_L (ih_M step_M)
+    case appR step_L _ => exact .app (ih_L step_L) std_M
+    case base h_beta =>
+      cases h_beta
+      have ⟨L, cbn_L1, std_abs⟩ := abs_inv std_L _ rfl
+      have std_subst := std_abs.abs_subst std_M std_M.lc_l std_M.lc_r
+      have s1 : L'.app M ↠ₙ L.abs.app M := CBN.steps_app_l_cong cbn_L1 std_M.lc_l
+      have s2 : L.abs.app M ⭢ₙ L ^ M := .base (.beta (CBN.steps_lc_r std_L.lc_l cbn_L1) std_M.lc_l)
+      exact Standard.cbn_trans (.trans s1 (.single s2)) std_subst
+
+/-- A standard reduction followed by a full β-reduction is a standard reduction. -/
+lemma Standard.trans_redex (h1 : M ⭢ₛ P) (h2 : P ↠βᶠ N) : M ⭢ₛ N := by
+  induction h2 with
+  | refl => exact h1
+  | tail _ step ih => exact trans_step ih step
+
+/-- Standard reduction is transitive. -/
+lemma Standard.trans (h1 : M ⭢ₛ P) (h2 : P ⭢ₛ N) : M ⭢ₛ N :=
+  trans_redex h1 (to_redex h2)
+
+instance : Trans (· ⭢ₛ · : Term Var → Term Var → Prop) (· ⭢βᶠ ·) (· ⭢ₛ ·) where
+  trans := Standard.trans_step
+
+instance : Trans (· ⭢ₛ · : Term Var → Term Var → Prop) (· ↠βᶠ ·) (· ⭢ₛ ·) where
+  trans := Standard.trans_redex
+
+instance : Trans (· ⭢ₛ · : Term Var → Term Var → Prop) (· ⭢ₛ ·) (· ⭢ₛ ·) where
+  trans := Standard.trans
+
+/-- The standardization theorem: every full β-reduction is a standard reduction. -/
+theorem Standard.standardization (lc_M : LC M) (step : M ↠βᶠ N) : M ⭢ₛ N := by
+  induction step with
+  | refl => exact lc_refl M lc_M
+  | tail _ h_step ih => exact ih.trans (of_beta_step h_step h_step.step_lc_l)
+
+/-- Standard reduction coincides with full β-reduction on locally closed terms. -/
+theorem Standard.iff_redex (lc_M : LC M) : M ⭢ₛ N ↔ M ↠βᶠ N :=
+  ⟨to_redex, standardization lc_M⟩
+
+/-! ## Equivalence with standard sequences -/
+
+/-- Standard sequences preserve local closure. -/
+lemma StandardSeq.lc_r (h : StandardSeq n M N) (lc : LC M) : LC N := by
+  induction h with
+  | refl => exact lc
+  | tail _ step _ ih => exact step.lc_r (ih lc)
+
+/-- Closing a variable and abstracting preserves a standard sequence. -/
+lemma StandardSeq.abs_close {x : Var} (h : StandardSeq n M M') (lc : LC M) :
+    StandardSeq n (M⟦0 ↜ x⟧.abs) (M'⟦0 ↜ x⟧.abs) := by
+  induction h with
+  | refl => exact .refl
+  | tail seq step hni ih => exact (ih lc).tail (step.abs_close (seq.lc_r lc)) hni
+
+/-- Abstraction congruence for standard sequences. -/
+lemma StandardSeq.abs_cong (xs : Finset Var)
+    (cofin : ∀ x ∉ xs, ∃ n, StandardSeq n (M ^ fvar x) (M' ^ fvar x))
+    (lc : LC (abs M)) : ∃ n, StandardSeq n (abs M) (abs M') := by
+  have ⟨w, _⟩ := fresh_exists <| free_union [fv] Var
+  have ⟨n, hseq⟩ := cofin w (by grind)
+  have hlc := beta_lc lc (.fvar w)
+  have habs : StandardSeq n (abs M) (abs M') := by
+    rw [open_close w M 0 (by grind), open_close w M' 0 (by grind)]
+    exact hseq.abs_close hlc
+  exact ⟨n, habs⟩
+
+/-- A standard sequence is a full β-reduction. -/
+lemma StandardSeq.to_redex (h : StandardSeq n M N) (lc_M : LC M) : M ↠βᶠ N := by
+  induction h with
+  | refl => rfl
+  | tail seq step _ ih => exact (ih lc_M).tail (step.to_step (seq.lc_r lc_M))
+
+/-- A standard reduction gives a standard β-reduction sequence. -/
+theorem Standard.to_seq (h : M ⭢ₛ N) : ∃ n, StandardSeq n M N := by
+  induction h
+  case fvar x => exact ⟨0, .refl⟩
+  case app _ _ ihL ihM =>
+    have ⟨_, hL⟩ := ihL
+    have ⟨_, hM⟩ := ihM
+    exact hL.app_cong hM
+  case abs xs h_body ih => exact StandardSeq.abs_cong xs ih ((Standard.abs xs h_body).lc_l)
+  case rdx K P K' _ lc_K lc_P cbn _ ih =>
+    have ⟨_, hk⟩ := ih
+    have cbn_full : K.app P ↠ₙ K' ^ P :=
+      (CBN.steps_app_l_cong cbn lc_P).tail (.base (.beta (CBN.steps_lc_r lc_K cbn) lc_P))
+    exact StandardSeq.cbn_head cbn_full hk
+
+/-- A standard β-reduction sequence gives a standard reduction. -/
+theorem StandardSeq.to_standard (h : StandardSeq n M N) (lc_M : LC M) : M ⭢ₛ N := by
+  induction h with
+  | refl => exact Standard.lc_refl _ lc_M
+  | tail seq step _ ih => exact (ih lc_M).trans_step (step.to_step (seq.lc_r lc_M))
+
+/-- Standard reduction coincides with the existence of a standard β-reduction sequence. -/
+theorem Standard.iff_seq (lc_M : LC M) : M ⭢ₛ N ↔ ∃ n, StandardSeq n M N := by
+  constructor
+  · exact Standard.to_seq
+  · intro ⟨_, h⟩
+    exact h.to_standard lc_M
+
+end LambdaCalculus.LocallyNameless.Untyped.Term
+
+end Cslib
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean
index 6a0163c97a..ea45ee0e86 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean
@@ -9,6 +9,7 @@ module
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.MultiApp
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LcAt
+public import Cslib.Foundations.Relation.Confluence
 
 /-! Strong normalization (termination) for full beta-reduction of untyped lambda calculus. -/
 
@@ -123,20 +124,21 @@ lemma sn_abs_app_multiApp [DecidableEq Var] [HasFresh Var] {Ps} {M N : Term Var}
     (sn_N : SN FullBeta N) (sn_MNPs : SN FullBeta (multiApp (M ^ N) Ps))
     (lc_N : LC N) (lc_MNPs : LC (multiApp (M ^ N) Ps)) :
     SN FullBeta (multiApp (M.abs.app N) Ps) := by
-  induction Ps with
+  induction Ps using List.reverseRecOn with
   | nil =>
     apply sn_app
     · grind [sn_abs]
     · exact sn_N
     · grind [→ steps_open_cong_abs, open_abs_lc, sn_steps]
-  | cons P Ps ih =>
+  | append_singleton Ps P ih =>
+    rw [multiApp_tail]
     apply sn_app
-    · cases lc_MNPs with grind [sn_app_left]
-    · grind [sn_app_right]
+    · grind [cases LC, multiApp_tail, sn_app_left]
+    · grind [multiApp_tail, sn_app_right]
     · intro Q' P' hstep1 hstep2
       have ⟨M', N', Ps', h_M_red, h_N_red, h_Ps_red, h_cases⟩ := invert_abs_multiApp_mst hstep1
       rcases h_cases with h_P | ⟨h_st1, h_st2⟩
-      · cases Ps' with grind
+      · induction Ps' using List.reverseRecOn with grind [multiApp_tail]
       · have innerSteps : (M ^ N).multiApp Ps ↠βᶠ (M' ^ N').multiApp Ps' := by
           trans
           · exact steps_multiApp_r h_Ps_red (by grind)
@@ -144,15 +146,15 @@ lemma sn_abs_app_multiApp [DecidableEq Var] [HasFresh Var] {Ps} {M N : Term Var}
             · apply steps_open_cong_abs M M' N N' <;> grind [open_abs_lc]
             · grind [multiApp_steps_lc]
         refine sn_steps ?_ sn_MNPs
+        rw [multiApp_tail]
         · calc ((M ^ N).multiApp Ps).app P
             _ ↠βᶠ ((M ^ N).multiApp Ps).app P' := by grind
             _ ↠βᶠ Q'.abs.app P' := redex_app_l_cong (.trans innerSteps h_st2) (by grind)
             _ ↠βᶠ Q' ^ P' := by
               rw [Relation.reflTransGen_iff_eq_or_transGen] at ⊢ innerSteps h_st2
               right
-              cases lc_MNPs
               refine Relation.TransGen.single (Xi.base (Beta.beta ?_ ?_))
-              all_goals grind only [→ step_lc_r]
+              all_goals grind
 
 end LambdaCalculus.LocallyNameless.Untyped.Term
 
diff --git a/Cslib/Languages/LambdaCalculus/Named/Untyped/Basic.lean b/Cslib/Languages/LambdaCalculus/Named/Untyped/Basic.lean
index 364b7cf8f9..5cdab218ca 100644
--- a/Cslib/Languages/LambdaCalculus/Named/Untyped/Basic.lean
+++ b/Cslib/Languages/LambdaCalculus/Named/Untyped/Basic.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2025 Fabrizio Montesi. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Fabrizio Montesi
+Authors: Fabrizio Montesi, Haoxuan Yin
 -/
 
 module
@@ -12,11 +12,14 @@ public import Cslib.Foundations.Syntax.HasSubstitution
 
 /-! # λ-calculus
 
-The untyped λ-calculus.
+The untyped λ-calculus, with a named representation of variables. This file contains the definitions
+of α-equivalence and capture-avoiding substitution.
 
 ## References
 
 * [H. Barendregt, *Introduction to Lambda Calculus*][Barendregt1984]
+* Definition of α-equivalence [M. Gabbay and A. Pitts, *A New Approach to Abstract Syntax with
+Variable Binding*][Gabbay2002]
 
 -/
 
@@ -26,9 +29,9 @@ namespace Cslib
 
 universe u
 
-variable {Var : Type u}
+variable {Var : Type u} [DecidableEq Var] [HasFresh Var]
 
-namespace LambdaCalculus.Named
+namespace LambdaCalculus.Named.Untyped
 
 /-- Syntax of terms. -/
 inductive Term (Var : Type u) : Type u where
@@ -37,52 +40,75 @@ inductive Term (Var : Type u) : Type u where
   | app (m n : Term Var)
 deriving DecidableEq
 
+namespace Term
+
 /-- Free variables. -/
-def Term.fv [DecidableEq Var] : Term Var → Finset Var
+@[simp, scoped grind =]
+def fv : Term Var → Finset Var
   | var x => {x}
-  | abs x m => m.fv.erase x
+  | abs x m => m.fv \ {x}
   | app m n => m.fv ∪ n.fv
 
 /-- Bound variables. -/
-def Term.bv [DecidableEq Var] : Term Var → Finset Var
+@[simp, scoped grind =]
+def bv : Term Var → Finset Var
   | var _ => ∅
-  | abs x m => m.bv ∪ {x} -- Could also be `insert x m.bv`
+  | abs x m => m.bv ∪ {x}
   | app m n => m.bv ∪ n.bv
 
 /-- Variable names (free and bound) in a term. -/
-def Term.vars [DecidableEq Var] (m : Term Var) : Finset Var :=
-  m.fv ∪ m.bv
+@[simp, scoped grind =]
+def vars : Term Var → Finset Var
+  | var x => {x}
+  | abs x m => m.vars ∪ {x}
+  | app m n => m.vars ∪ n.vars
 
-/-- Capture-avoiding substitution, as an inference system. -/
-inductive Term.Subst [DecidableEq Var] : Term Var → Var → Term Var → Term Var → Prop where
-  | varHit : (var x).Subst x r r
-  | varMiss : x ≠ y → (var y).Subst x r (var y)
-  | absShadow : (abs x m).Subst x r (abs x m)
-  | absIn : x ≠ y → y ∉ r.fv → m.Subst x r m' → (abs y m).Subst x r (abs y m')
-  | app : m.Subst x r m' → n.Subst x r n' → (app m n).Subst x r (app m' n')
-
-/-- Renaming, or variable substitution. `m.rename x y` renames `x` into `y` in `m`. -/
-def Term.rename [DecidableEq Var] (m : Term Var) (x y : Var) : Term Var :=
+/-- Variable renaming, applying to both free and bound variables.
+    `m.rename x y` changes all occurrences of `x` into `y` in `m`. -/
+@[simp, scoped grind =]
+def rename (m : Term Var) (x y : Var) : Term Var :=
   match m with
-  | var z => if z = x then (var y) else (var z)
-  | abs z m' =>
-    if z = x then
-      -- Shadowing
-      abs z m'
-    else
-      abs z (m'.rename x y)
+  | var z => var (if z = x then y else z)
+  | abs z m' => abs (if z = x then y else z) (m'.rename x y)
   | app n1 n2 => app (n1.rename x y) (n2.rename x y)
 
+omit [HasFresh Var] in
 /-- Renaming preserves size. -/
-@[simp]
-theorem Term.rename.eq_sizeOf {m : Term Var} {x y : Var} [DecidableEq Var] :
-  sizeOf (m.rename x y) = sizeOf m := by
+@[simp, scoped grind =]
+theorem rename_eq_sizeOf {m : Term Var} {x y : Var} : sizeOf (m.rename x y) = sizeOf m := by
   induction m <;> aesop (add simp [Term.rename])
 
+/-- α-equivalence. -/
+inductive AlphaEquiv : Term Var → Term Var → Prop where
+  | var {x} : AlphaEquiv (var x) (var x)
+  | abs {y x1 x2 m1 m2} : y ∉ m1.vars ∪ m2.vars ∪ {x1, x2} →
+    AlphaEquiv (m1.rename x1 y) (m2.rename x2 y) → AlphaEquiv (abs x1 m1) (abs x2 m2)
+  | app {m1 n1 m2 n2} : AlphaEquiv m1 n1 → AlphaEquiv m2 n2 → AlphaEquiv (app m1 m2) (app n1 n2)
+
+/-- Instance for the notation `m =α n`. -/
+instance instHasAlphaEquivTerm : HasAlphaEquiv (Term Var) where
+  AlphaEquiv := AlphaEquiv
+
+omit [HasFresh Var] in
+/-- Allow grind to recognise the notation of α-equivalence. -/
+@[simp, scoped grind _=_]
+theorem AlphaEquiv_def (m n : Term Var) : m =α n ↔ AlphaEquiv m n := by
+  rfl
+
+/-- Capture-avoiding substitution, as an inference system. -/
+inductive Subst : Term Var → Var → Term Var → Term Var → Prop where
+  | varHit {x r} : (var x).Subst x r r
+  | varMiss {x y r} : y ≠ x → (var y).Subst x r (var y)
+  | absShadow {x m r} : (abs x m).Subst x r (abs x m)
+  | absIn {x y m r m'} : y ∉ r.fv ∪ {x} → m.Subst x r m' → (abs y m).Subst x r (abs y m')
+  | app {m n x r m' n'} : m.Subst x r m' → n.Subst x r n' → (app m n).Subst x r (app m' n')
+  | alpha {m m' r r' n n' x} : m =α m' → r =α r' → n =α n' → Subst m x r n → m'.Subst x r' n'
+
 /-- Capture-avoiding substitution. `m.subst x r` replaces the free occurrences of variable `x`
 in `m` with `r`. -/
-def Term.subst [DecidableEq Var] [HasFresh Var] (m : Term Var) (x : Var) (r : Term Var) :
-  Term Var :=
+@[simp, scoped grind =]
+def subst (m : Term Var) (x : Var) (r : Term Var) :
+    Term Var :=
   match m with
   | var y => if y = x then r else var y
   | abs y m' =>
@@ -91,25 +117,21 @@ def Term.subst [DecidableEq Var] [HasFresh Var] (m : Term Var) (x : Var) (r : Te
     else if y ∉ r.fv then
       abs y (m'.subst x r)
     else
-      let z := HasFresh.fresh (m'.vars ∪ r.vars ∪ {x})
+      let z := HasFresh.fresh (m'.vars ∪ r.vars ∪ {x, y})
       abs z ((m'.rename y z).subst x r)
   | app m1 m2 => app (m1.subst x r) (m2.subst x r)
 termination_by m
-decreasing_by all_goals grind [rename.eq_sizeOf, abs.sizeOf_spec, app.sizeOf_spec]
+decreasing_by all_goals grind
 
 /-- `Term.subst` is a substitution for λ-terms. Gives access to the notation `m[x := n]`. -/
-instance instHasSubstitutionTerm [DecidableEq Var] [HasFresh Var] :
+instance instHasSubstitutionTerm :
     HasSubstitution (Term Var) Var (Term Var) where
-  subst := Term.subst
+  subst := subst
 
--- TODO
--- theorem Term.subst_comm
---   [DecidableEq Var] [HasFresh Var]
---   {m : Term Var} {x : Var} {n1 : Term Var} {y : Var} {n2 : Term Var} :
---   (m[x := n1])[y := n2] = (m[y := n2])[x := n1] := by
---   induction m
---   -- case var z =>
---   sorry
+/-- Allow grind to recognise the notation of substitution. -/
+@[simp, scoped grind _=_]
+theorem subst_def (m r : Term Var) (x : Var) : m[x := r] = m.subst x r := by
+  rfl
 
 /-- Contexts. -/
 inductive Context (Var : Type u) : Type u where
@@ -127,39 +149,13 @@ def Context.fill (c : Context Var) (m : Term Var) : Term Var :=
   | appL c n => Term.app (c.fill m) n
   | appR n c => Term.app n (c.fill m)
 
-/-- Any `Term` can be obtained by filling a `Context` with a variable. This proves that `Context`
-completely captures the syntax of terms. -/
-theorem Context.complete (m : Term Var) :
-    ∃ (c : Context Var) (x : Var), m = (c.fill (Term.var x)) := by
-  induction m with
-  | var x => exists hole, x
-  | abs x n ih =>
-    obtain ⟨c', y, ih⟩ := ih
-    exists Context.abs x c', y
-    rw [ih, fill]
-  | app n₁ n₂ ih₁ ih₂ =>
-    obtain ⟨c₁, x₁, ih₁⟩ := ih₁
-    exists Context.appL c₁ n₂, x₁
-    rw [ih₁, fill]
-
-open Term
-
-/-- α-equivalence. -/
-inductive Term.AlphaEquiv [DecidableEq Var] : Term Var → Term Var → Prop where
--- The α-axiom
-| ax {m : Term Var} {x y : Var} :
-  y ∉ m.fv → AlphaEquiv (abs x m) (abs y (m.rename x y))
--- Equivalence relation rules
-| refl : AlphaEquiv m m
-| symm : AlphaEquiv m n → AlphaEquiv n m
-| trans : AlphaEquiv m1 m2 → AlphaEquiv m2 m3 → AlphaEquiv m1 m3
--- Context closure
-| ctx {c : Context Var} {m n : Term Var} : AlphaEquiv m n → AlphaEquiv (c.fill m) (c.fill n)
-
-/-- Instance for the notation `m =α n`. -/
-instance instHasAlphaEquivTerm [DecidableEq Var] : HasAlphaEquiv (Term Var) where
-  AlphaEquiv := Term.AlphaEquiv
+/-- Variables (both free and bound) in a context. -/
+def Context.vars : Context Var → Finset Var
+  | hole => ∅
+  | abs x c => c.vars ∪ {x}
+  | appL c m => c.vars ∪ m.vars
+  | appR m c => m.vars ∪ c.vars
 
-end LambdaCalculus.Named
+end LambdaCalculus.Named.Untyped.Term
 
 end Cslib
diff --git a/Cslib/Languages/LambdaCalculus/Named/Untyped/Properties.lean b/Cslib/Languages/LambdaCalculus/Named/Untyped/Properties.lean
new file mode 100644
index 0000000000..dd98742b7b
--- /dev/null
+++ b/Cslib/Languages/LambdaCalculus/Named/Untyped/Properties.lean
@@ -0,0 +1,514 @@
+/-
+Copyright (c) 2026 Haoxuan Yin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Haoxuan Yin, Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic
+
+
+/-! # λ-calculus
+
+The untyped λ-calculus, with a named representation of variables. This file contains properties of
+α-equivalence and capture-avoiding substitution.
+
+## Main results
+
+- `AlphaEquiv.refl`: reflexivity of α-equivalence
+- `AlphaEquiv.symm`: symmetry of α-equivalence
+- `AlphaEquiv.trans`: transitivity of α-equivalence
+- `Subst.relation_iff_function`: the relational and functional definition of capture-avoiding
+  substitution are equivalent, modulo alpha-equivalence
+- `subst.commutativity`: commutativity of substitution, more commonly known as the
+  "substitution lemma" (e.g. in [Barendregt1984])
+-/
+
+public section
+
+namespace Cslib
+
+universe u
+
+variable {Var : Type u} [DecidableEq Var]
+
+namespace LambdaCalculus.Named.Untyped.Term
+
+/-- A variable in a term is either free or bound. -/
+theorem vars_either_fv_or_bv {m : Term Var} : m.vars = m.fv ∪ m.bv := by
+  induction m <;> grind
+
+/-- Renaming an unused variable has no effect. -/
+@[simp, scoped grind =]
+theorem rename_unused {m : Term Var} {x y : Var} : x ∉ m.vars → m.rename x y = m := by
+  induction m <;> grind
+
+/-- Renaming a variable to itself has no effect. -/
+@[simp, scoped grind =]
+theorem rename_same {m : Term Var} {x : Var} : m.rename x x = m := by
+  induction m <;> grind
+
+/-- Renaming a used variable changes the set of variables. -/
+theorem rename_vars_used {m : Term Var} {x y : Var} : x ∈ m.vars →
+    (m.rename x y).vars = m.vars.erase x ∪ {y} := by
+  induction m with
+  | var z => grind
+  | abs z m ih =>
+    intro hx
+    by_cases hxm : x ∈ m.vars <;> grind
+  | app m n ihm ihn =>
+    intro hx
+    by_cases hxm : x ∈ m.vars
+    · by_cases hxn : x ∈ n.vars <;> grind
+    · grind
+
+/-- Renaming removes the variable. -/
+theorem rename_remove {m : Term Var} {x y : Var} : x ≠ y → x ∉ (m.rename x y).vars := by
+  intro hxy
+  by_cases hx : x ∈ m.vars <;> grind [rename_vars_used]
+
+/-- The set of variables after renaming. -/
+@[simp, scoped grind =]
+theorem rename_vars {m : Term Var} {x y : Var} :
+    (m.rename x y).vars = m.vars \ {x} ∪ (if x ∈ m.vars then {y} else ∅) := by
+  grind [rename_vars_used]
+
+/-- The set of free variables after renaming. -/
+theorem rename_fv {m : Term Var} {x y : Var} :
+    y ∉ m.vars → (m.rename x y).fv = m.fv \ {x} ∪ (if x ∈ m.fv then {y} else ∅) := by
+  induction m with
+  | var z => grind
+  | abs z m ih => grind [vars_either_fv_or_bv]
+  | app m n ihm ihn => grind
+
+/-- Concatenation of renaming. -/
+@[simp, scoped grind =]
+theorem rename_concat {m : Term Var} {x y z : Var} : y ∉ m.vars →
+    (m.rename x y).rename y z = m.rename x z := by
+  induction m <;> grind
+
+/-- Commutativity of renaming distinct variables. -/
+theorem rename_comm_fresh {m : Term Var} {x y z w : Var} :
+    x ≠ z → y ∉ m.vars ∪ {x, z} → w ∉ m.vars ∪ {x, z} →
+    (m.rename x y).rename z w = (m.rename z w).rename x y := by
+  induction m <;> grind
+
+/-- Commutativity of renaming. -/
+theorem rename_comm {m : Term Var} {x y z w : Var} :
+    y ∉ m.vars ∪ {x, z} → w ∉ m.vars ∪ {x, y, z} →
+    (m.rename x y).rename (if z = x then y else z) w = (m.rename z w).rename x y := by
+  grind [rename_comm_fresh]
+
+omit [DecidableEq Var] in
+theorem induction_by_sizeOf {C : Term Var → Prop}
+    (step : ∀ m : Term Var, (∀ m1 : Term Var, sizeOf m1 < sizeOf m → C m1) → C m ) :
+    ∀ m : Term Var, C m :=
+  WellFounded.fix (r := sizeOfWFRel.rel) sizeOfWFRel.wf step
+
+/-- α-equivalent terms have the same size. -/
+theorem AlphaEquiv.eq_sizeOf {m n : Term Var} : m =α n → sizeOf m = sizeOf n := by
+  intro h
+  induction h with
+  | @var x => rfl
+  | @abs y x1 x2 m1 m2 hy h ih =>
+    simp
+    grind
+  | @app m1 n1 m2 n2 _ hm hn =>
+    grind
+
+/-- α-equivalent terms have the same free variables. -/
+theorem AlphaEquiv.same_fv {m n : Term Var} : m =α n → m.fv = n.fv := by
+  intro h
+  induction h with
+  | var => rfl
+  | app => grind
+  | @abs y x1 x2 m1 m2 hy h ih =>
+    grind =>
+      instantiate [rename_fv, vars_either_fv_or_bv]
+      have : m1.fv \ {x1} = (m1.rename x1 y).fv \ {y}
+      have : (m2.rename x2 y).fv \ {y} = m2.fv \ {x2}
+
+variable [HasFresh Var]
+
+/-- Reflexivity of α-equivalence. -/
+theorem AlphaEquiv.refl (m : Term Var) : m =α m := by
+  induction m using induction_by_sizeOf with
+  | step m ih =>
+    cases m with
+    | var x => grind [AlphaEquiv.var]
+    | abs x m =>
+      obtain ⟨z, hz⟩ := fresh_exists <| free_union [vars] Var
+      apply AlphaEquiv.abs (y := z) <;> grind
+    | app m n => grind [AlphaEquiv.app]
+
+omit [HasFresh Var] in
+/-- Symmetry of α-equivalence. -/
+theorem AlphaEquiv.symm {m n : Term Var} : m =α n → n =α m := by
+  intro h
+  induction h with
+  | @var x => grind [AlphaEquiv.var]
+  | @abs y x1 x2 m1 m2 hy h ih =>
+    apply AlphaEquiv.abs (y := y) <;> grind
+  | @app m1 n1 m2 n2 hwm1 hwn1 hwm2 hwn2 => grind [AlphaEquiv.app]
+
+/-- Renaming α-equivalent terms produces α-equivalent terms. -/
+theorem AlphaEquiv.rename_preserve (m n : Term Var) (x y : Var) :
+    y ∉ m.vars ∪ n.vars → m =α n → (m.rename x y) =α (n.rename x y) := by
+  induction m using induction_by_sizeOf generalizing n x y with
+  | step m ih =>
+    intro hy h
+    by_cases hyx : y = x
+    · grind
+    cases h with
+    | @var z => grind [AlphaEquiv.refl]
+    | @app m1 n1 m2 n2 hm hn => grind [AlphaEquiv.app]
+    | @abs z x1 x2 m1 m2 hz hbody =>
+      obtain ⟨w, hw⟩ := fresh_exists <| free_union [vars] Var
+      simp at hw hy
+      apply AlphaEquiv.abs (y := w)
+      · grind
+      rw [rename_comm, rename_comm]
+      case neg.abs.a =>
+        apply ih
+        · grind
+        · grind
+        · have hxzw : ((m1.rename x1 z).rename z w) =α ((m2.rename x2 z).rename z w) := by grind
+          grind
+      all_goals grind
+
+/-- Elimination rule for α-equivalence of abstractions.
+    It states that if two abstractions are α-equivalent,
+    then their bodies can be renamed to ``any'' fresh variable y and remain α-equivalent.
+    This is sometimes easier to use than using by_cases on the equivalence,
+    which can only produce the claim for ``some'' fresh y. -/
+theorem AlphaEquiv.abs_elim {m1 m2 : Term Var} {x1 x2 y : Var} :
+    y ∉ m1.vars ∪ m2.vars ∪ {x1, x2} → (Term.abs x1 m1) =α (Term.abs x2 m2) →
+    (m1.rename x1 y) =α (m2.rename x2 y) := by
+  intro hy h
+  cases h with
+  | @abs z _ _ _ _ hz h1 =>
+    by_cases hzy : z = y
+    · grind
+    · have hxzy : ((m1.rename x1 z).rename z y) =α ((m2.rename x2 z).rename z y) := by
+        grind [AlphaEquiv.rename_preserve]
+      grind
+
+/-- Transitivity of α-equivalence. -/
+theorem AlphaEquiv.trans {m n p : Term Var} : m =α n → n =α p → m =α p := by
+  induction m using induction_by_sizeOf generalizing n p with
+  | step m ih =>
+    intro hmn hnp
+    cases m with
+    | var x =>
+      cases hmn with
+      | @var x => assumption
+    | abs x1 m1 =>
+      obtain ⟨w, hw⟩ := fresh_exists <| free_union [vars] Var
+      have hmn' := hmn
+      cases hmn' with
+      | @abs y x1 x2 m1 m2 hy h1 =>
+        have hnp' := hnp
+        cases hnp' with
+        | @abs z x2 x3 m2 m3 hz h2 =>
+          apply AlphaEquiv.abs (y := w)
+          · grind
+          apply ih (n := m2.rename x2 w) <;> grind [AlphaEquiv.abs_elim]
+    | app m1 m2 =>
+      cases hmn with
+      | @app m1 n1 m2 n2 hmn1 hmn2 =>
+        cases hnp with
+        | @app n1 p1 n2 p2 hnp1 hnp2 =>
+          apply AlphaEquiv.app
+          · apply ih (n := n1) <;> grind
+          · apply ih (n := n2) <;> grind
+
+/-- Renaming a non-free variable results in an α-equivalent term -/
+theorem AlphaEquiv.rename_non_fv {m : Term Var} {x y : Var} : x ∉ m.fv → y ∉ m.vars →
+    m =α (m.rename x y) := by
+  intro hx hy
+  induction m with
+  | var z => grind [AlphaEquiv.var]
+  | app m1 m2 ih1 ih2 => grind [AlphaEquiv.app]
+  | abs z m ih =>
+    obtain ⟨w, hw⟩ := fresh_exists <| free_union [vars] Var
+    apply AlphaEquiv.abs (y := w) <;> grind [AlphaEquiv.refl, AlphaEquiv.rename_preserve]
+
+/-- Abstracting over an arbitrary non-free variable results in the same term,
+    modulo α-equivalence. -/
+theorem AlphaEquiv.abs_non_fv {m1 m2 : Term Var} {x1 x2 : Var} :
+    m1 =α m2 → x1 ∉ m1.fv → x2 ∉ m2.fv → (Term.abs x1 m1) =α (Term.abs x2 m2) := by
+  intro hm hx1 hx2
+  obtain ⟨y, hy⟩ := fresh_exists <| free_union [vars] Var
+  apply AlphaEquiv.abs (y := y)
+  · grind
+  grind [AlphaEquiv.abs, AlphaEquiv.trans, rename_non_fv, AlphaEquiv.symm]
+
+/-- Renaming an abstraction leads to an α-equivalent term. -/
+theorem AlphaEquiv.abs_rename {m : Term Var} {x y : Var} :
+    y ∉ m.vars ∪ {x} → (Term.abs x m) =α (Term.abs y (m.rename x y)) := by
+  intro hy
+  obtain ⟨z, hz⟩ := fresh_exists <| free_union [vars] Var
+  apply AlphaEquiv.abs (y := z) <;> grind [AlphaEquiv.refl]
+
+omit [DecidableEq Var] [HasFresh Var] in
+/-- Any `Term` can be obtained by filling a `Context` with a variable. This proves that `Context`
+completely captures the syntax of terms. -/
+theorem Context.complete (m : Term Var) : ∃ (c : Context Var) (x : Var), m = (c.fill (var x)) := by
+  induction m with
+  | var x => exists hole, x
+  | abs x n ih =>
+    obtain ⟨c', y, ih⟩ := ih
+    exists Context.abs x c', y
+    rw [ih, fill]
+  | app n₁ n₂ ih₁ ih₂ =>
+    obtain ⟨c₁, x₁, ih₁⟩ := ih₁
+    exists Context.appL c₁ n₂, x₁
+    rw [ih₁, fill]
+
+omit [HasFresh Var] in
+/-- The set of variables after filling a context. -/
+theorem Context.fill_vars {c : Context Var} {m : Term Var} : (c.fill m).vars = c.vars ∪ m.vars := by
+  induction c <;> grind [Context.fill, Context.vars]
+
+/-- α-equivalence is preserved under context filling. -/
+theorem AlphaEquiv.context {m n : Term Var} {c : Context Var} :
+    m =α n → (c.fill m) =α (c.fill n) := by
+  intro h
+  induction c with
+  | hole => assumption
+  | abs x c ih =>
+    obtain ⟨y, hy⟩ := fresh_exists (m.vars ∪ n.vars ∪ c.vars ∪ {x})
+    apply AlphaEquiv.abs (y := y) <;> grind [Context.fill_vars, rename_preserve]
+  | appL c m ih =>
+    apply AlphaEquiv.app <;> grind [AlphaEquiv.app, AlphaEquiv.refl]
+  | appR m c ih =>
+    apply AlphaEquiv.app <;> grind [AlphaEquiv.app, AlphaEquiv.refl]
+
+/-- The functional definition of substitution satisfies the relational definition of substitution.
+-/
+theorem Subst.function_to_relation {m r : Term Var} {x : Var} : m.Subst x r (m[x := r]) := by
+  induction m using induction_by_sizeOf with
+  | step m ih =>
+    cases m with
+    | var y => grind [Subst.varHit, Subst.varMiss]
+    | app m1 m2 => grind [Subst.app]
+    | abs y m =>
+      by_cases hyx : y = x
+      · grind [Subst.absShadow]
+      · by_cases hyr : y ∈ r.fv
+        · let s := {x, y} ∪ m.vars ∪ r.vars
+          have hz := fresh_notMem s
+          set z := fresh s
+          apply Subst.alpha (m := abs z (m.rename y z)) (r := r)
+            (n := abs z ((m.rename y z)[x := r]))
+          · have h1 : abs z (m.rename y z) = (abs y m).rename y z := by
+              simp
+            grind [AlphaEquiv.symm, AlphaEquiv.rename_non_fv]
+          · grind [AlphaEquiv.refl]
+          · grind [AlphaEquiv.refl]
+          · grind [Subst.absIn, vars_either_fv_or_bv]
+        · grind [Subst.absIn]
+
+/-- Substituting a non-free variable has no effect. -/
+theorem subst.non_free {m r : Term Var} {x : Var} : x ∉ m.fv → (m[x := r]) =α m := by
+  induction m using induction_by_sizeOf with
+  | step m ih =>
+    intro hx
+    cases m with
+    | var y => grind [AlphaEquiv.var]
+    | app m1 m2 => grind [AlphaEquiv.app]
+    | abs y m =>
+      by_cases hyx : y = x
+      · grind [AlphaEquiv.refl]
+      · by_cases hyr : y ∈ r.fv
+        · simp only [subst_def, eq_2, hyx, ↓reduceIte, hyr, not_true_eq_false, Finset.union_insert,
+            Finset.union_singleton, AlphaEquiv_def]
+          let s := (insert x (insert y (m.vars ∪ r.vars)))
+          have hz := fresh_notMem s
+          set z := fresh s
+          obtain ⟨w, hw⟩ := fresh_exists (m.vars ∪ r.vars ∪ ((m.rename y z).subst x r).vars
+            ∪ {x, y, z})
+          apply AlphaEquiv.abs (y := w)
+          · grind
+          apply AlphaEquiv.trans (n := ((m.rename y z).rename z w))
+          · grind [AlphaEquiv.rename_preserve, rename_fv]
+          · grind [AlphaEquiv.refl]
+        · simp only [subst_def, eq_2, hyx, ↓reduceIte, hyr, not_false_eq_true, AlphaEquiv_def]
+          apply AlphaEquiv.context (c := Context.abs y Context.hole)
+          grind
+
+private lemma subst.abs_fresh_helper {m r : Term Var} {x y z : Var} :
+    z ∉ m.vars ∪ r.vars ∪ {x, y} → ((Term.abs y m)[x := r]) =α (Term.abs z ((m.rename y z)[x := r]))
+    ∧ (y ∉ r.fv ∪ {x} → (Term.abs y (m[x := r])) =α (Term.abs z ((m.rename y z)[x := r]))) := by
+  induction m using induction_by_sizeOf generalizing r x y z with
+  | step m ih =>
+    intro hz
+    have hright : ∀ (m' : Term Var) (y' : Var), sizeOf m' = sizeOf m →
+        z ∉ m'.vars ∪ r.vars ∪ {x, y'} → y' ∉ r.fv ∪ {x} →
+        (Term.abs y' (m'[x:=r])) =α (Term.abs z ((m'.rename y' z)[x:=r])) := by
+      intro m' y' hm' hz hy'
+      cases m' with
+      | var w =>
+        by_cases hwx : w = x
+        · grind [vars_either_fv_or_bv, AlphaEquiv.refl, AlphaEquiv.abs_non_fv]
+        · by_cases hwy' : w = y'
+          · obtain ⟨v, hv⟩ := fresh_exists <| free_union [vars] Var
+            apply AlphaEquiv.abs (y := v) <;> grind [AlphaEquiv.var]
+          · grind [vars_either_fv_or_bv, AlphaEquiv.refl, AlphaEquiv.abs_non_fv]
+      | app m1 m2 =>
+        obtain ⟨w, hw⟩ := fresh_exists
+          ((m1.app m2)[x := r].vars ∪ (((m1.app m2).rename y' z)[x := r]).vars
+          ∪ m1[x := r].vars ∪ m2[x := r].vars ∪ (m1.rename y' z)[x := r].vars
+          ∪ (m2.rename y' z)[x := r].vars ∪ {y', z})
+        apply AlphaEquiv.abs (y := w) <;> grind [AlphaEquiv.app, AlphaEquiv.abs_elim]
+      | abs w m1 =>
+        by_cases hwy' : w = y'
+        · grind [vars_either_fv_or_bv, AlphaEquiv.abs_non_fv]
+        · rw [rename]
+          simp only [hwy', ↓reduceIte]
+          by_cases hwx : w = x
+          · grind [AlphaEquiv.trans, AlphaEquiv.abs_rename, AlphaEquiv.refl]
+          · by_cases hwr : w ∈ r.fv
+            · obtain ⟨v, hv⟩ := fresh_exists <| free_union [vars] Var
+              simp at hv
+              have hl : (Term.abs y' (((Term.abs w m1)[x := r]))) =α
+                  (Term.abs y' (Term.abs v ((m1.rename w v)[x := r]))) := by
+                apply AlphaEquiv.context (c := Context.abs y' Context.hole)
+                grind
+              have hr : (Term.abs z (Term.abs v (((m1.rename y' z).rename w v)[x := r])))
+                =α (Term.abs z ((Term.abs w (m1.rename y' z))[x := r])) := by
+                apply AlphaEquiv.context (c := Context.abs z Context.hole)
+                grind [AlphaEquiv.symm]
+              have hmid : (Term.abs y' (Term.abs v ((m1.rename w v)[x := r]))) =α
+                  (Term.abs z (Term.abs v (((m1.rename y' z).rename w v)[x := r]))) := by
+                obtain ⟨u, hu⟩ := fresh_exists
+                  ((Term.abs v ((m1.rename w v)[x := r])).vars ∪
+                  (Term.abs v (((m1.rename y' z).rename w v)[x := r])).vars ∪
+                  ((m1.rename w v).rename y' z)[x:=r].vars ∪ {y', z})
+                apply AlphaEquiv.abs (y := u)
+                · grind
+                · have hvy' : v ≠ y' := by grind
+                  have hvz : v ≠ z := by grind
+                  simp only [rename, hvy', hvz, ↓reduceIte]
+                  apply AlphaEquiv.context (c := Context.abs v Context.hole)
+                  grind [AlphaEquiv.trans, AlphaEquiv.abs_elim, AlphaEquiv.rename_preserve,
+                    rename_comm_fresh, AlphaEquiv.refl]
+              grind [AlphaEquiv.trans]
+            · obtain ⟨v, hv⟩ := fresh_exists
+                (m1[x:=r].vars ∪ (m1.rename y' z)[x:=r].vars ∪ ((Term.abs w m1)[x := r]).vars ∪
+                ((Term.abs w (m1.rename y' z))[x := r]).vars ∪ {y', z})
+              apply AlphaEquiv.abs (y := v)
+              · grind
+              · have hwz : w ≠ z := by grind
+                simp only [subst_def, eq_2, hwx, ↓reduceIte, hwr, not_false_eq_true, rename, hwy',
+                  hwz]
+                apply AlphaEquiv.context (c := Context.abs w Context.hole)
+                grind [AlphaEquiv.abs_elim]
+    have hleft : ((Term.abs y m)[x:=r]) =α (Term.abs z ((m.rename y z)[x:=r])) := by
+      by_cases hyx : y = x
+      · subst y
+        simp only [subst_def, eq_2, ↓reduceIte, AlphaEquiv_def]
+        obtain ⟨w, hw⟩ := fresh_exists (m.vars ∪ r.vars ∪ ((m.rename x z).subst x r).vars ∪
+          {x, z})
+        apply AlphaEquiv.abs (y := w)
+        · grind
+        · apply AlphaEquiv.trans (n := ((m.rename x z).rename z w))
+          · grind [AlphaEquiv.refl]
+          · grind [AlphaEquiv.rename_preserve, AlphaEquiv.symm, subst.non_free, rename_fv]
+      · by_cases hyr : y ∈ r.fv
+        · simp only [subst_def, eq_2, hyx, ↓reduceIte, hyr, not_true_eq_false, Finset.union_insert,
+              Finset.union_singleton, AlphaEquiv_def]
+          let s := (insert x (insert y (m.vars ∪ r.vars)))
+          have hw := fresh_notMem s
+          set w := fresh s
+          grind [AlphaEquiv.refl, AlphaEquiv.trans, vars_either_fv_or_bv]
+        · grind
+    grind
+
+/-- Modulo α-equivalence, substituting an abstraction falls back to the fresh variable case only.
+    With this lemma, the three cases in the definition of subst can be reduced to one.
+-/
+theorem subst.abs_fresh {m r : Term Var} {x y z : Var} : z ∉ m.vars ∪ r.vars ∪ {x, y} →
+    ((Term.abs y m)[x := r]) =α (Term.abs z ((m.rename y z)[x := r])) := by
+  grind [subst.abs_fresh_helper]
+
+/-- Substituting α-equivalent terms produces α-equivalent terms. -/
+theorem subst.preserve_AlphaEquiv {m m' r r' : Term Var} {x : Var} :
+    m =α m' → r =α r' → (m[x := r]) =α (m'[x := r']) := by
+  induction m using induction_by_sizeOf generalizing m' r r' x with
+  | step m ih =>
+    intro hmm' hrr'
+    have hmm'' := hmm'
+    cases hmm'' with
+    | @var y => grind [AlphaEquiv.refl]
+    | @app m m' n n' hm hn => grind [AlphaEquiv.app]
+    | @abs z y y' m m' hz h1 =>
+      obtain ⟨w, hw⟩ := fresh_exists <| free_union [vars] Var
+      have h2 : ((Term.abs y m)[x := r]) =α (Term.abs w ((m.rename y w)[x := r])) := by
+        grind [subst.abs_fresh]
+      have h2' : ((Term.abs y' m')[x := r']) =α
+          (Term.abs w ((m'.rename y' w)[x := r'])) := by
+        grind [subst.abs_fresh]
+      have hbody : (m.rename y w) =α (m'.rename y' w) := by
+        apply AlphaEquiv.abs_elim <;> grind
+      have h3 :
+          (Term.abs w ((m.rename y w)[x := r])) =α (Term.abs w ((m'.rename y' w)[x := r'])) := by
+        apply AlphaEquiv.context (c := Context.abs w Context.hole)
+        apply ih <;> grind [rename_eq_sizeOf]
+      grind [AlphaEquiv.trans, AlphaEquiv.symm]
+
+/-- The relational definition of substitution coincides with the functional definition of
+    substitution, modulo α-equivalence. -/
+theorem Subst.relation_iff_function {m n r : Term Var} {x : Var} :
+    m.Subst x r n ↔ n =α (m[x := r]) := by
+  constructor
+  · intro h
+    induction h with
+    | varHit => grind [AlphaEquiv.refl]
+    | varMiss => grind [AlphaEquiv.refl]
+    | absShadow => grind [AlphaEquiv.refl]
+    | app => grind [AlphaEquiv.app]
+    | @absIn x y m r m' hy h ih =>
+      have hyx : y ≠ x := by grind
+      have hyr : y ∉ r.fv := by grind
+      simp only [subst_def, subst.eq_2, hyx, ↓reduceIte, hyr, not_false_eq_true, AlphaEquiv_def]
+      apply AlphaEquiv.context (c := Context.abs y Context.hole)
+      assumption
+    | @alpha m m' r r' n n' x hm hr hn h ih =>
+      grind [AlphaEquiv.symm, AlphaEquiv.trans, subst.preserve_AlphaEquiv]
+  · intro h
+    apply Subst.alpha (m := m) (r := r) (n := m[x := r]) <;> grind [AlphaEquiv.symm,
+      AlphaEquiv.refl, Subst.function_to_relation]
+
+/-- Commutativity of substitution (a.k.a. the substitution lemma) -/
+theorem subst.commutativity {m r1 r2 : Term Var} {x y : Var} :
+    x ∉ r2.fv ∪ {y} → ((m[x := r1])[y := r2]) =α ((m[y := r2])[x := (r1[y := r2])]) := by
+  induction m using induction_by_sizeOf generalizing r1 r2 x y with
+  | step m ih =>
+    intro hx
+    cases m with
+    | var z => grind [AlphaEquiv.refl, AlphaEquiv.symm, subst.non_free]
+    | app m1 m2 => grind [AlphaEquiv.app]
+    | abs z m =>
+      obtain ⟨w, hw⟩ := fresh_exists (m.vars ∪ r1.vars ∪ r2.vars ∪ (r1[y := r2]).vars ∪ {x, y, z})
+      have hl : (((Term.abs z m)[x := r1])[y := r2]) =α
+        (Term.abs w (((m.rename z w)[x := r1])[y := r2])) := by
+        apply AlphaEquiv.trans (n := (((Term.abs w ((m.rename z w)[x := r1]))[y := r2])))
+        · grind [subst.preserve_AlphaEquiv, subst.abs_fresh, AlphaEquiv.refl]
+        · grind [vars_either_fv_or_bv, AlphaEquiv.refl]
+      have hr : (Term.abs w (((m.rename z w)[y := r2])[x := (r1[y := r2])]))
+        =α (((Term.abs z m)[y := r2])[x := (r1[y := r2])]) := by
+        apply AlphaEquiv.symm
+        apply AlphaEquiv.trans (n := ((Term.abs w ((m.rename z w)[y := r2]))[x := (r1[y := r2])]))
+        · grind [subst.preserve_AlphaEquiv, subst.abs_fresh, AlphaEquiv.refl]
+        · grind [vars_either_fv_or_bv, AlphaEquiv.refl]
+      have hmid : (Term.abs w (((m.rename z w)[x := r1])[y := r2])) =α
+        (Term.abs w (((m.rename z w)[y := r2])[x := (r1[y := r2])])) := by
+        apply AlphaEquiv.context (c := Context.abs w Context.hole)
+        grind
+      grind [AlphaEquiv.trans]
+
+end LambdaCalculus.Named.Untyped.Term
+
+end Cslib
diff --git a/Cslib/Languages/Mech/Choreography/Basic.lean b/Cslib/Languages/Mech/Choreography/Basic.lean
new file mode 100644
index 0000000000..c69073f8e9
--- /dev/null
+++ b/Cslib/Languages/Mech/Choreography/Basic.lean
@@ -0,0 +1,137 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Init
+public import Mathlib.Data.Finset.Basic
+
+/-!
+# Choreography
+
+A choreography defines the collective behaviour of a system of communicating participants
+(processes) [Montesi2023].
+
+## Limitations
+
+Some notable features not yet included:
+- Recursion (only the syntax is implemented, but no semantics).
+- General recursion (the current syntax supports only tail recursion).
+- Choreographic choice (for barriers, first-come/first-served patterns, etc.).
+- Asynchronous communication.
+
+## References
+
+* [F. Montesi, *Introduction to Choreographies*][Montesi2023]
+-/
+
+@[expose] public section
+
+namespace Cslib.Languages.Mech
+
+section Syntax
+
+/-! ## Syntax of choreographies -/
+
+/-- Expressions for local computation. -/
+inductive Expr (Var Val FunId : Type*) where
+  /-- Read variable `x`. -/
+  | var (x : Var)
+  /-- Value `v`. -/
+  | val (v : Val)
+  /-- Call function `f` with arguments `args`. -/
+  | call (f : FunId) (args : List (Expr Var Val FunId))
+
+/-- Utility instance to write variables directly as expressions. -/
+instance : Coe Var (Expr Var Val FunId) where
+  coe x := .var x
+
+/-- Utility instance to write values directly as expressions. -/
+instance : Coe Val (Expr Var Val FunId) where
+  coe v := .val v
+
+/-- Choreographic prefix. -/
+inductive Prefix (Pid Var Val FunId SelLabel : Type*) where
+  /-- `p` assigns `x` the value computed from `e`. -/
+  | assign (p : Pid) (x : Var) (e : Expr Var Val FunId)
+  /-- `p` communicates the evaluation of `e` to `q`, which stores it in its variable `x`. -/
+  | com (p : Pid) (e : Expr Var Val FunId) (q : Pid) (x : Var)
+  /-- `p` communicates the selection label (a static tag used to denote a choice) to `q`. -/
+  | sel (p : Pid) (q : Pid) (l : SelLabel)
+
+/-- Choreographies. -/
+inductive Choreography (Pid Var Val FunId SelLabel ProcName : Type*) where
+  /-- The terminated choreography. -/
+  | nil
+  /-- Do `prf` and continue as `c`. -/
+  | pre (prf : Prefix Pid Var Val FunId SelLabel)
+    (c : Choreography Pid Var Val FunId SelLabel ProcName)
+  /-- Conditional: `p` evaluates `e` to choose between `c₁` and `c₂`. -/
+  | cond (p : Pid) (e : Expr Var Val FunId)
+    (c₁ c₂ : Choreography Pid Var Val FunId SelLabel ProcName)
+  /-- Call the procedure `proc`. -/
+  | call (proc : ProcName) (ps : List Pid)
+
+instance : Zero (Choreography Pid Var Val FunId SelLabel ProcName) := ⟨.nil⟩
+
+/-- Syntactic category for prefixes. -/
+declare_syntax_cat mechPre
+
+@[inherit_doc Prefix.assign]
+scoped syntax term:max "." term "≔" term : mechPre
+
+@[inherit_doc Prefix.com]
+scoped syntax term:max "." term "⮕" term:max "." term : mechPre
+
+@[inherit_doc Prefix.sel]
+scoped syntax term:max "⮕" term:max "[" term "]" : mechPre
+
+@[inherit_doc Prefix]
+scoped syntax "`(MechPre|" mechPre ")" : term
+
+scoped macro_rules
+  | `(`(MechPre| $p:term . $x:term ≔ $e:term)) => `(Prefix.assign $p $x $e)
+  | `(`(MechPre| $p:term . $e:term ⮕ $q:term . $x:term)) => `(Prefix.com $p $e $q $x)
+  | `(`(MechPre| $p:term ⮕ $q:term [ $l:term ])) => `(Prefix.sel $p $q $l)
+
+/-- Syntactic category for choreographies. -/
+declare_syntax_cat mechChor
+
+@[inherit_doc Choreography.nil]
+scoped syntax num : mechChor
+
+@[inherit_doc Choreography.pre]
+scoped syntax mechPre "; " mechChor : mechChor
+
+@[inherit_doc Choreography.cond]
+scoped syntax "if" term:max "." term "then" mechChor "else" mechChor : mechChor
+
+@[inherit_doc Choreography]
+scoped syntax "`(Mech| " mechChor ")" : term
+
+scoped macro_rules
+  | `(`(Mech| 0)) => `(0)
+  | `(`(Mech| $prf:mechPre; $pr:mechChor)) => `(Choreography.pre `(MechPre| $prf) `(Mech| $pr))
+  | `(`(Mech| if $p:term . $e:term then $c₁:mechChor else $c₂:mechChor)) =>
+    `(Choreography.cond $p $e `(Mech| $c₁) `(Mech| $c₂))
+
+variable [DecidableEq Pid]
+
+/-- Process names in a prefix. -/
+def Prefix.pn : Prefix Pid Var Val FunId SelLabel → Finset Pid
+  | assign p _ _ => {p}
+  | com p _ q _ | sel p q _ => {p, q}
+
+/-- Process names in a choreography. -/
+def Choreography.pn : Choreography Pid Var Val FunId SelLabel ProcName → Finset Pid
+  | 0 => ∅
+  | pre prf c => prf.pn ∪ c.pn
+  | cond p _ c₁ c₂ => {p} ∪ c₁.pn ∪ c₂.pn
+  | call _ args => args.toFinset
+
+end Syntax
+
+end Cslib.Languages.Mech
diff --git a/Cslib/Languages/Mech/LocalComputation.lean b/Cslib/Languages/Mech/LocalComputation.lean
new file mode 100644
index 0000000000..19851e056a
--- /dev/null
+++ b/Cslib/Languages/Mech/LocalComputation.lean
@@ -0,0 +1,88 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Foundations.Syntax.HasSubstitution
+
+/-!
+# Local expressions, stores, and evaluation
+
+Choreographic programming and associated languages (like process calculi for modelling distributed
+protocol implementations) are typically defined abstracting from how processes locally compute and
+store values [Montesi2023]. This module defines this interface, as well as the derived concept of
+global store.
+
+## Implementation notes
+
+The module is currently developed with minimality in mind. In the future, we plan on adding
+facilities for typing expressions and easy integration with Lean and other IRs/FFIs.
+
+## References
+
+* [F. Montesi, *Introduction to Choreographies*][Montesi2023]
+-/
+
+@[expose] public section
+
+namespace Cslib.Mech
+
+/-- Expressions for local computation. -/
+inductive Expr (Var Val FunId : Type*) where
+  /-- Read variable `x`. -/
+  | var (x : Var)
+  /-- Value `v`. -/
+  | val (v : Val)
+  /-- Call function `f` with arguments `args`. -/
+  | call (f : FunId) (args : List (Expr Var Val FunId))
+
+/-- Utility instance to write variables directly as expressions. -/
+instance : Coe Var (Expr Var Val FunId) where
+  coe x := .var x
+
+/-- Utility instance to write values directly as expressions. -/
+instance : Coe Val (Expr Var Val FunId) where
+  coe v := .val v
+
+/-- A local store represents the memory state of a process, mapping variables to values. -/
+abbrev LocalStore Var Val := (x : Var) → Val
+
+/-- Type of (potentially nondeterministic) evaluation relations for local function calls at
+processes. -/
+abbrev FunCallEval FunId Val := (f : FunId) → (args : List Val) → Val → Prop
+
+/-- Evaluation relation for expressions. -/
+inductive FunCallEval.EvalExpr (eval : FunCallEval FunId Val) :
+    (σ : LocalStore Var Val) → (e : Expr Var Val FunId) → (v : Val) → Prop where
+  /-- A value evaluates to itself. -/
+  | val : eval.EvalExpr σ (.val v) v
+  /-- A variable evaluates to its mapped value in the store. -/
+  | var : eval.EvalExpr σ (.var x) (σ x)
+  /-- A function call first recursively evaluates its expression arguments, and then
+  invokes the parameter for function evaluation. -/
+  | call
+    (hArgs : List.Forall₂ (eval.EvalExpr σ) args vals)
+    (hFun : eval f vals v) :
+    eval.EvalExpr σ (.call f args) v
+
+/-- A global store represents the memory state of an entire system, mapping each process to its
+local store. -/
+abbrev GlobalStore Pid Var Val := (p : Pid) → LocalStore Var Val
+
+/-- Type of an element of type `α` located at a process. -/
+abbrev AtPid Pid α := Pid × α
+
+/-- The process name of a located element. -/
+abbrev AtPid.pid (a : AtPid Pid α) := a.fst
+
+/-- The element of a located element. -/
+abbrev AtPid.elem (a : AtPid Pid α) := a.snd
+
+instance [DecidableEq Pid] [DecidableEq Var] :
+    HasSubstitution (GlobalStore Pid Var Val) (AtPid Pid Var) Val where
+  subst gs px v := gs[px.fst := ((gs px.pid)[px.elem := v])]
+
+end Cslib.Mech
diff --git a/Cslib/Languages/Mech/README.md b/Cslib/Languages/Mech/README.md
new file mode 100644
index 0000000000..056db87d17
--- /dev/null
+++ b/Cslib/Languages/Mech/README.md
@@ -0,0 +1,40 @@
+<pre>
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+</pre>
+
+# Mech: Mechanised Choreographic Programming
+
+This directory is a placeholder for the upstreaming of Mech, a language for choreographic programming developed at FORM.
+
+Mech is a verified choreographic programming framework. It can be used to:
+1. Codify distributed protocols and systems in a choreographic language, benefitting from the simple global view of the 'Alice and Bob' protocol notation.
+2. Reason about choreographic programs with CSLib's foundations and tools
+3. Compile choreographies into provably-correct models of distributed programs in a process calculus.
+
+
+## Principles and plans
+
+### Protocol library development
+
+We plan on using Mech to develop a library of verified protocol for concurrent and distributed systems.
+
+### Support CSLib's compilation infrastructure
+
+Mech is sufficiently complex to test CSLib's infrastructure for compiler verification. We will establish a strong bisimilarity for the choreography compiler, enabling the transference of results from choreographies to their compiled versions.
+
+### Iterative approach
+
+A downstream version of Mech already exists at FORM -- CSLib originally started as a spin-off of some general components developed to make Mech possible, like `LTS`. This version is fairly complete, as it formalises most of the textbook theory of choreographic programming ('Introduction to Choreographies'), but some parts require adaptation or generalisation to be included in CSLib.
+
+We follow an iterative approach, whereby we introduce core components and then gradually augment them with more advanced features (like recursion, nondeterminism, etc.).
+
+### Placement
+
+Components that might be of interest beyond Mech (like [StatefulProcesses](../StatefulProcesses), a calculus used in some variation over different research papers) are placed outside of this directory.
+
+### Ergonomics
+
+- The current development has many unbundled parameters (for types, local computation, etc.). We plan on exploring convenient bundled interfaces for easier use. See also the [tests for StatefulProcesses](/CslibTests/StatefulProcesses.lean).
+- We could use a lot more convenience in escaping to Lean for expression evaluation. This is nontrivial because we need to resolve variables from the local store of the appropriate process.
\ No newline at end of file
diff --git a/Cslib/Languages/README.md b/Cslib/Languages/README.md
new file mode 100644
index 0000000000..17fbd53e10
--- /dev/null
+++ b/Cslib/Languages/README.md
@@ -0,0 +1,30 @@
+<pre>
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+</pre>
+
+# Languages
+
+This directory hosts **modelling and programming languages** formalised in CSLib and their properties. Their components can include syntax, semantics, typing and other reasoning disciplines, execution facilities (compilers, interpreters, etc.), behavioural theories, supporting metatheory, etc.
+We are interested in many kinds of languages, from foundational calculi to applied programming frameworks.
+
+The focus is not only on individual languages in isolation, but also on exposing them through reusable abstractions from [Foundations](../Foundations), such as contexts, substitution, congruence, reduction systems, and labelled transition systems.
+
+## Principles
+
+### Reuse of common infrastructure
+
+The [Foundations](../Foundations) directory offers useful modules for language development, which should be used as much as possible.
+These modules include support for syntax (like contexts and congruence relations), semantics (like transition systems),  compiler correctness (like behavioural relations), and more.
+
+### Multiple representations are welcome
+
+Different representations can coexist when they serve different purposes. For example `LambdaCalculus` currently contains both named and locally nameless developments. The goal is to make tradeoffs explicit and to connect them where possible.
+
+## Plans and notes
+
+- We expect this directory to grow with many more languages, as well as connections between languages, logics, and other reasoning techniques.
+- A recurring issue is how to handle binders. We still need to develop general facilities for this. Leveraging multiple representations of languages, we also plan on formally exploring the connection between standard pen & paper definitions and convenient formal representations, for example the relation between α-equivalence and techniques based on de Brujin indices.
+- We aim at providing reusable infrastructure for defining languages and provably-correct compilers.
+- Some topics that are often associated with languages also appear elsewhere in CSLib when a more general placement is preferrable. For example, automata and formal languages over words are in [Computability](../Computability), while reusable semantic infrastructure lives in [Foundations](../Foundations).
diff --git a/Cslib/Languages/StatefulProcesses/Basic.lean b/Cslib/Languages/StatefulProcesses/Basic.lean
new file mode 100644
index 0000000000..8250049296
--- /dev/null
+++ b/Cslib/Languages/StatefulProcesses/Basic.lean
@@ -0,0 +1,183 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Languages.Mech.LocalComputation
+public import Cslib.Foundations.Semantics.LTS.Basic
+
+set_option linter.style.header false in
+set_option linter.style.longLine false in
+/-!
+# Stateful Processes
+
+The language of Stateful Processes (SP for short), a process calculus
+where processes communicate via message passing [Montesi2023]. Stateful processes or similar
+languages are typically used to model implementations of choreographic programs (concurrent and/or
+distributed protocols), but they are also designed to be used as abstract representations that can
+be later compiled to executable mainstream languages.
+
+## Limitations
+
+The current formalisation does not cover process polymorphism (procedures do not take process
+parameters) nor general recursion (this is the tail-recursive fragment of Stateful Processes).
+For recursion, only the syntax is currently implemented. Its semantics will follow a similar
+approach to that for `CCS`.
+
+## Implementation notes
+
+This development follows the presentation in [Montesi2023], with one difference: we adopt a modular
+approach to the definition of operational semantics, by first defining a symbolic semantics from
+which a concrete semantics is then derived by adding stores (process memory). This approach is
+described in [Acclavio2026].
+
+## References
+
+* [M. Acclavio, G. Manara, F. Montesi, X. Qin, *Choreographic Programming: a Semantic Approach*][Acclavio2026]
+* [F. Montesi, *Introduction to Choreographies*][Montesi2023]
+-/
+
+@[expose] public section
+
+namespace Cslib.StatefulProcesses
+
+open Cslib.Mech
+
+section Syntax
+
+/-! ## Syntax of process terms -/
+
+/-- Prefixes. -/
+inductive Prefix (Pid Var Val FunId SelLabel : Type*) where
+  /-- Assign to `x` the result of evaluating `e`. -/
+  | assign (x : Var) (e : Expr Var Val FunId)
+  /-- Send to `p` the result of evaluating `e`. -/
+  | sendValue (p : Pid) (e : Expr Var Val FunId)
+  /-- Receive a value from `p` and store it in `x`. -/
+  | recvValue (p : Pid) (x : Var)
+  /-- Send to `p` the label `l`. -/
+  | sendLabel (p : Pid) (l : SelLabel)
+
+/-- Processes. -/
+inductive Process (Pid Var Val FunId SelLabel ProcName : Type*) where
+  /-- The terminated process. -/
+  | nil
+  /-- Execute the prefix `prf` and proceed as the continuation `pr`. -/
+  | pre (prf : Prefix Pid Var Val FunId SelLabel) (pr : Process Pid Var Val FunId SelLabel ProcName)
+  /-- Branching process: receives a selection label and continues accordingly. -/
+  | recvLabel (p : Pid) (branches : List (SelLabel × Process Pid Var Val FunId SelLabel ProcName))
+  /-- Conditional: evaluate `e` to choose between `pr₁` and `pr₂`. -/
+  | cond (e : Expr Var Val FunId) (pr₁ pr₂ : Process Pid Var Val FunId SelLabel ProcName)
+  /-- Call the procedure `proc`. -/
+  | call (proc : ProcName) (ps : List Pid)
+
+instance : Zero (Process Pid Var Val FunId SelLabel ProcName) := ⟨.nil⟩
+
+/-- Syntactic category for prefixes. -/
+declare_syntax_cat spPre
+
+@[inherit_doc Prefix.assign]
+scoped syntax term:max "≔" term : spPre
+
+@[inherit_doc Prefix.sendValue]
+scoped syntax term:max "!" term : spPre
+
+@[inherit_doc Prefix.recvValue]
+scoped syntax term:max "?" term : spPre
+
+@[inherit_doc Prefix.sendLabel]
+scoped syntax term:max "⊕" term : spPre
+
+@[inherit_doc Prefix]
+scoped syntax "`(SPpre|" spPre ")" : term
+
+scoped macro_rules
+  | `(`(SPpre| $x:term ≔ $e:term )) => `(Prefix.assign $x $e)
+  | `(`(SPpre| $p:term ! $e:term )) => `(Prefix.sendValue $p $e)
+  | `(`(SPpre| $p:term ? $x:term )) => `(Prefix.recvValue $p $x)
+  | `(`(SPpre| $p:term ⊕ $l:term )) => `(Prefix.sendLabel $p $l)
+
+/-- Syntactic category for processes. -/
+declare_syntax_cat spProc
+
+@[inherit_doc Process.nil]
+scoped syntax num : spProc
+
+@[inherit_doc Process.pre]
+scoped syntax spPre "; " spProc : spProc
+
+@[inherit_doc Process.recvLabel]
+scoped syntax term:max "&" term : spProc
+
+@[inherit_doc Process.cond]
+scoped syntax "if" term "then" spProc "else" spProc : spProc
+
+-- The next syntax would be nice to have to avoid having trailing 0s in examples.
+-- scoped syntax:min "`(SP| " spPre ")" : term
+
+@[inherit_doc Process]
+scoped syntax "`(SP| " spProc ")" : term
+
+scoped macro_rules
+  | `(`(SP| 0)) => `(0)
+  | `(`(SP| $prf:spPre; $pr:spProc)) => `(Process.pre `(SPpre| $prf) `(SP| $pr))
+  | `(`(SP| $p:term & $l:term)) => `(Process.recvLabel $p $l)
+  | `(`(SP| if $e:term then $p₁:spProc else $p₂:spProc)) =>
+    `(Process.cond $e `(SP| $p₁) `(SP| $p₂))
+
+end Syntax
+
+section Semantics
+
+/-! ## Semantics -/
+
+/-- Actions. -/
+inductive Act (Pid Var Val FunId SelLabel : Type*) where
+  /-- Assign to `x` the result of evaluating `e`. -/
+  | assign (x : Var) (e : Expr Var Val FunId)
+  /-- Send to `p` the result of evaluating `e`. -/
+  | sendValue (p : Pid) (e : Expr Var Val FunId)
+  /-- Receive a value from `p` and store it in variable `x`. -/
+  | recvValue (p : Pid) (x : Var)
+  /-- Send to `p` the selection label `l`. -/
+  | sendLabel (p : Pid) (l : SelLabel)
+  /-- Receive from `p` the selection label `l`. -/
+  | recvLabel (p : Pid) (l : SelLabel)
+  /-- Choose the then-branch of a conditional guarded by `e`. -/
+  | condThen (e : Expr Var Val FunId)
+  /-- Choose the else-branch of a conditional guarded by `e`. -/
+  | condElse (e : Expr Var Val FunId)
+
+/-- An action is internal if it is not meant to interact with another process. -/
+def Act.isInternal : Act Pid Var Val FunId SelLabel → Bool
+  | assign _ _ | condThen _ | condElse _ => true
+  | _ => false
+
+/-- Transforms a `Prefix` into an `Act`. -/
+abbrev Prefix.toAct : Prefix Pid Var Val FunId SelLabel → Act Pid Var Val FunId SelLabel
+  | assign x e => .assign x e
+  | sendValue p e => .sendValue p e
+  | recvValue p x => .recvValue p x
+  | sendLabel p l => .sendLabel p l
+
+/-- Symbolic transition relation for processes.
+Do not use this directly, use `Process.lts` instead. -/
+inductive Process.Tr :
+    Process Pid Var Val FunId SelLabel ProcName → Act Pid Var Val FunId SelLabel →
+    Process Pid Var Val FunId SelLabel ProcName → Prop
+  | pre : Tr (pre prf pr) prf.toAct (pr)
+  | condThen : Tr (cond e pr₁ pr₂) (.condThen e) pr₁
+  | condElse : Tr (cond e pr₁ pr₂) (.condElse e) pr₂
+  | recvLabel (h : (l, pr) ∈ branches): Tr (recvLabel p branches) (.recvLabel p l) pr
+
+/-- Symbolic LTS of processes. -/
+def Process.lts :
+    LTS (Process Pid Var Val FunId SelLabel ProcName) (Act Pid Var Val FunId SelLabel) :=
+  ⟨Process.Tr⟩
+
+end Semantics
+
+end Cslib.StatefulProcesses
diff --git a/Cslib/Languages/StatefulProcesses/Network.lean b/Cslib/Languages/StatefulProcesses/Network.lean
new file mode 100644
index 0000000000..22bb7a9d55
--- /dev/null
+++ b/Cslib/Languages/StatefulProcesses/Network.lean
@@ -0,0 +1,131 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Languages.StatefulProcesses.Basic
+public import Cslib.Foundations.Syntax.HasSubstitution
+
+/-! # Networks of stateful processes and their semantics
+
+This module defines networks (maps from process names to process terms), as well as their symbolic
+and concrete operational semantics.
+
+## Implementation notes
+
+We leverage the fact that networks are functions to formulate the semantics without requiring a
+definition of parallel composition.
+
+## References
+
+* [F. Montesi, *Introduction to Choreographies*][Montesi2023]
+-/
+
+@[expose] public section
+
+namespace Cslib.StatefulProcesses
+
+open Cslib.Mech
+
+/-! ## Networks and their symbolic semantics -/
+
+/-- A network maps process names to process terms. -/
+abbrev Network (Pid Var Val FunId SelLabel ProcName : Type*) :=
+  Pid → Process Pid Var Val FunId SelLabel ProcName
+
+/-- The 0 ('zero') network, mapping all processes to the process term 0. -/
+instance : Zero (Network Pid Var Val FunId SelLabel ProcName) := ⟨fun _ => 0⟩
+
+/-- Symbolic transition labels for networks. -/
+inductive Network.TrLabel Pid Var Val FunId SelLabel
+  | local (p : Pid) (μ : Act Pid Var Val FunId SelLabel)
+  | com (p : Pid) (e : Expr Var Val FunId) (q : Pid) (x : Var)
+  | sel (p : Pid) (q : Pid) (l : SelLabel)
+
+variable [DecidableEq Pid]
+
+/-- Symbolic transition relation for networks. -/
+inductive Network.Tr :
+    Network Pid Var Val FunId SelLabel ProcName → TrLabel Pid Var Val FunId SelLabel →
+    Network Pid Var Val FunId SelLabel ProcName → Prop
+  | local
+    (hμ : μ.isInternal) (htr : Process.lts.Tr (n p) μ prP)
+    (hn' : n' = n[p := prP]) :
+    Tr n (TrLabel.local p μ) n'
+  | com
+    (hsend : Process.lts.Tr (n p) (.sendValue q e) prP)
+    (hrecv : Process.lts.Tr (n q) (.recvValue p x) prQ)
+    (hn' : n' = n[p := prP][q := prQ]) :
+    Tr n (TrLabel.com p e q x) n'
+  | sel
+    (hsend : Process.lts.Tr (n p) (.sendLabel q l) prP)
+    (hrecv : Process.lts.Tr (n q) (.recvLabel p l) prQ)
+    (hn' : n' = n[p := prP][q := prQ]) :
+    Tr n (TrLabel.sel p q l) n'
+
+/-- Symbolic LTS of networks. -/
+def Network.lts :
+    LTS (Network Pid Var Val FunId SelLabel ProcName) (TrLabel Pid Var Val FunId SelLabel) :=
+  ⟨Network.Tr⟩
+
+/-! ## Stores, evaluation, and concrete semantics of networks -/
+
+/-- Configurations, consisting of a network and a global store. -/
+structure Cfg (Pid Var Val FunId SelLabel ProcName : Type*) where
+  /-- The network of the configuration. -/
+  net : Network Pid Var Val FunId SelLabel ProcName
+  /-- The global store of the configuration. -/
+  store : GlobalStore Pid Var Val
+
+/-- Transition labels for network configurations.
+
+These labels model what can be observed from execution, and thus hide internal computational
+details.
+-/
+inductive Cfg.TrLabel Pid Val SelLabel
+  | local (p : Pid)
+  | com (p : Pid) (q : Pid) (v : Val)
+  | sel (p : Pid) (q : Pid) (l : SelLabel)
+
+/-- Transition relation for network configurations. -/
+inductive Cfg.Tr [DecidableEq Var] (isTrue : Val → Bool) (Eval : FunCallEval FunId Val) :
+    Cfg Pid Var Val FunId SelLabel ProcName → Cfg.TrLabel Pid Val SelLabel →
+    Cfg Pid Var Val FunId SelLabel ProcName → Prop where
+  -- Internal actions
+  | assign
+    (htr : Network.lts.Tr cfg.net (.local p (.assign x e)) cfg'.net)
+    (heval : Eval.EvalExpr (cfg.store p) e v)
+    (hstore : cfg'.store = cfg.store[(p, x) := v]) :
+    Tr isTrue Eval cfg (Cfg.TrLabel.local p) cfg'
+  | condThen
+    (htr : Network.lts.Tr cfg.net (.local p (.condThen e)) cfg'.net)
+    (heval : Eval.EvalExpr (cfg.store p) e v)
+    (hguard : isTrue v)
+    (hstore : cfg'.store = cfg.store) :
+    Tr isTrue Eval cfg (Cfg.TrLabel.local p) cfg'
+  | condElse
+    (htr : Network.lts.Tr cfg.net (.local p (.condElse e)) cfg'.net)
+    (heval : Eval.EvalExpr (cfg.store p) e v)
+    (hguard : ¬isTrue v)
+    (hstore : cfg'.store = cfg.store) :
+    Tr isTrue Eval cfg (Cfg.TrLabel.local p) cfg'
+  -- Interactions
+  | com
+    (htr : Network.lts.Tr cfg.net (.com p e q x) cfg'.net)
+    (heval : Eval.EvalExpr (cfg.store p) e v)
+    (hstore : cfg'.store = cfg.store[(q, x) := v]) :
+    Tr isTrue Eval cfg (Cfg.TrLabel.com p q v) cfg'
+  | sel
+    (htr : Network.lts.Tr cfg.net (.sel p q l) cfg'.net)
+    (hstore : cfg'.store = cfg.store) :
+    Tr isTrue Eval cfg (Cfg.TrLabel.sel p q l) cfg'
+
+/-- LTS of network configurations. -/
+def Cfg.lts [DecidableEq Var] (isTrue : Val → Bool) (Eval : FunCallEval FunId Val) :
+    LTS (Cfg Pid Var Val FunId SelLabel ProcName) (Cfg.TrLabel Pid Val SelLabel) :=
+  ⟨Cfg.Tr isTrue Eval⟩
+
+end Cslib.StatefulProcesses
diff --git a/Cslib/Logics/HML/Basic.lean b/Cslib/Logics/HML/Basic.lean
index f83709a780..1bba83dd37 100644
--- a/Cslib/Logics/HML/Basic.lean
+++ b/Cslib/Logics/HML/Basic.lean
@@ -7,6 +7,8 @@ Authors: Fabrizio Montesi, Marco Peressotti, Alexandre Rademaker
 module
 
 public import Cslib.Foundations.Semantics.LTS.Bisimulation
+public import Cslib.Foundations.Logic.Operators
+public import Cslib.Foundations.Logic.InferenceSystem
 
 /-! # Hennessy-Milner Logic (HML)
 
@@ -16,9 +18,8 @@ concurrent systems.
 ## Implementation notes
 There are two main versions of HML. The original [Hennessy1985], which includes a negation
 connective, and a variation without negation, for example as in [Aceto1999].
-We follow the latter, which is used in many recent papers. Negation is recovered as usual, by having
-a `false` atomic proposition and a function that, given any proposition, returns its negated form
-(see `Proposition.neg`).
+We follow the former and focus on a minimal set of connectives, recovering the others as derived
+constructs.
 
 ## Main definitions
 
@@ -50,67 +51,197 @@ namespace Cslib.Logic.HML
 
 /-- Propositions. -/
 inductive Proposition (Label : Type u) : Type u where
+  /-- Truth. -/
   | true
-  | false
+  /-- Conjunction. -/
   | and (φ₁ φ₂ : Proposition Label)
-  | or (φ₁ φ₂ : Proposition Label)
+  /-- Negation. -/
+  | not (φ : Proposition Label)
+  /-- Possibility (dynamic diamond modality). -/
   | diamond (μ : Label) (φ : Proposition Label)
-  | box (μ : Label) (φ : Proposition Label)
 
-/-- Negation of a proposition. -/
-@[simp, scoped grind =]
-def Proposition.neg (a : Proposition Label) : Proposition Label :=
-  match a with
-  | .true => .false
-  | .false => .true
-  | and a b => or a.neg b.neg
-  | or a b => and a.neg b.neg
-  | diamond μ a => box μ a.neg
-  | box μ a => diamond μ a.neg
+instance : Top (Proposition Label) := ⟨.true⟩
+instance : HasAnd (Proposition Label) := ⟨.and⟩
+instance : HasNot (Proposition Label) := ⟨.not⟩
+instance : HasDynamicDiamond (Proposition Label) Label := ⟨.diamond⟩
+
+/-- Falsity, derived from negation and truth. -/
+@[match_pattern]
+def Proposition.false : Proposition Label := ¬⊤
+
+instance : Bot (Proposition Label) := ⟨.false⟩
+
+/-- Disjunction, derived from negation and conjunction. -/
+@[match_pattern]
+def Proposition.or (φ₁ φ₂ : Proposition Label) : Proposition Label := ¬(¬φ₁ ∧ ¬φ₂)
+
+instance : HasOr (Proposition Label) := ⟨Proposition.or⟩
+
+/-- Implication. -/
+@[match_pattern]
+def Proposition.imp (φ₁ φ₂ : Proposition Label) : Proposition Label := ¬φ₁ ∨ φ₂
+
+instance : HasImp (Proposition Label) := ⟨.imp⟩
+
+/-- Bi-implication. -/
+@[match_pattern]
+def Proposition.iff (φ₁ φ₂ : Proposition Label) : Proposition Label := (φ₁ → φ₂) ∧ (φ₂ → φ₁)
+
+instance : HasIff (Proposition Label) := ⟨.iff⟩
+
+/-- Necessity (dynamic box modality), derived from dynamic diamond and negation. -/
+@[match_pattern]
+def Proposition.box (μ : Label) (φ : Proposition Label) : Proposition Label := ¬d⟨μ⟩¬φ
+
+instance : HasDynamicBox (Proposition Label) Label := ⟨.box⟩
+
+@[scoped grind =]
+lemma Proposition.top_def : .true = ((⊤ : Proposition Label)) := rfl
+
+@[scoped grind =]
+lemma Proposition.bot_def : .false = ((⊥ : Proposition Label)) := rfl
+
+@[scoped grind =]
+lemma Proposition.and_def (φ₁ φ₂ : Proposition Label) : φ₁.and φ₂ = (φ₁ ∧ φ₂) := rfl
+
+@[scoped grind =]
+lemma Proposition.not_def (φ : Proposition Label) : φ.not = ¬φ := rfl
+
+@[scoped grind =]
+lemma Proposition.diamond_def (μ : Label) (φ : Proposition Label) :
+  Proposition.diamond μ φ = d⟨μ⟩φ := rfl
+
+@[scoped grind =]
+lemma Proposition.or_def (φ₁ φ₂ : Proposition Label) : φ₁.or φ₂ = (φ₁ ∨ φ₂) := rfl
+
+@[scoped grind =]
+lemma Proposition.imp_def (φ₁ φ₂ : Proposition Label) : φ₁.imp φ₂ = (φ₁ → φ₂) := rfl
+
+@[scoped grind =]
+lemma Proposition.iff_def (φ₁ φ₂ : Proposition Label) :
+    φ₁.iff φ₂ = (φ₁ ↔ φ₂) := rfl
+
+@[scoped grind =]
+lemma Proposition.box_def (μ : Label) (φ : Proposition Label) : Proposition.box μ φ = d[μ]φ := rfl
 
 /-- Finite conjunction of propositions. -/
 @[simp, scoped grind =]
-def Proposition.finiteAnd (as : List (Proposition Label)) : Proposition Label :=
-  List.foldr .and .true as
+def Proposition.finiteAnd (φs : List (Proposition Label)) : Proposition Label :=
+  List.foldr (· ∧ ·) ⊤ φs
 
 /-- Finite disjunction of propositions. -/
 @[simp, scoped grind =]
-def Proposition.finiteOr (as : List (Proposition Label)) : Proposition Label :=
-  List.foldr .or .false as
+def Proposition.finiteOr (φs : List (Proposition Label)) : Proposition Label :=
+  List.foldr (· ∨ ·) ⊥ φs
 
-/-- Satisfaction relation. `Satisfies lts s a` means that, in the LTS `lts`, the state `s` satisfies
-the proposition `a`. -/
+/-- Satisfaction relation. `Satisfies lts s φ` means that, in the LTS `lts`, the state `s` satisfies
+the proposition `φ`. -/
 @[scoped grind]
-inductive Satisfies (lts : LTS State Label) : State → Proposition Label → Prop where
-  | true {s : State} : Satisfies lts s .true
-  | and {s : State} {a b : Proposition Label} :
-    Satisfies lts s a → Satisfies lts s b →
-    Satisfies lts s (.and a b)
-  | or₁ {s : State} {a b : Proposition Label} :
-    Satisfies lts s a → Satisfies lts s (.or a b)
-  | or₂ {s : State} {a b : Proposition Label} :
-    Satisfies lts s b → Satisfies lts s (.or a b)
-  | diamond {s s' : State} {μ : Label} {a : Proposition Label}
-    (htr : lts.Tr s μ s') (hs : Satisfies lts s' a) : Satisfies lts s (.diamond μ a)
-  | box {s : State} {μ : Label} {a : Proposition Label}
-    (h : ∀ s', lts.Tr s μ s' → Satisfies lts s' a) :
-    Satisfies lts s (.box μ a)
+def Satisfies (lts : LTS State Label) (s : State) : Proposition Label → Prop
+  | .true => True
+  | .and φ₁ φ₂ => Satisfies lts s φ₁ ∧ Satisfies lts s φ₂
+  | .not φ => ¬Satisfies lts s φ
+  | .diamond μ φ => ∃ s', lts.Tr s μ s' ∧ Satisfies lts s' φ
+
+/-- Judgement, representing the conclusions one reaches in HML. -/
+structure Judgement State Label where
+  /-- Constructs a judgement. -/
+  mk ::
+  /-- LTS. -/
+  lts : LTS State Label
+  /-- The state satisfying the proposition `φ`. -/
+  state : State
+  /-- The proposition satisfied by the state `s`. -/
+  φ : Proposition Label
+
+@[inherit_doc] scoped notation "HML[" lts "," s " ⊨ " φ "]" => Judgement.mk lts s φ
+
+/-- Satisfaction for judgements. This just refers to the unbundled `Satisfies`. -/
+@[simp, scoped grind =]
+def Satisfies.Bundled (j : Judgement State Label) : Prop := Satisfies j.lts j.state j.φ
+
+instance : HasInferenceSystem (Judgement State Label) := ⟨Satisfies.Bundled⟩
+
+open scoped InferenceSystem Proposition
+
+@[scoped grind =]
+theorem derivation_def : Satisfies lts s φ = ⇓HML[lts,s ⊨ φ] := rfl
+
+@[scoped grind =]
+theorem Satisfies.not_iff_not : ⇓HML[lts,s ⊨ ¬φ] ↔ ¬⇓HML[lts,s ⊨ φ] := by rfl
+
+@[scoped grind .]
+theorem Satisfies.top : ⇓HML[lts,s ⊨ ⊤] := by
+  dsimp [Top.top]
+  grind [=_ derivation_def]
+
+@[scoped grind .]
+theorem Satisfies.bot : ¬⇓HML[lts,s ⊨ ⊥] := by
+  simp only [Bot.bot]
+  grind [= Proposition.false]
+
+@[scoped grind =]
+theorem Satisfies.and_iff_and :
+    ⇓HML[lts,s ⊨ φ₁ ∧ φ₂] ↔ ⇓HML[lts,s ⊨ φ₁] ∧ ⇓HML[lts,s ⊨ φ₂] := by rfl
+
+@[scoped grind =]
+theorem Satisfies.or_iff_or :
+    ⇓HML[lts,s ⊨ φ₁ ∨ φ₂] ↔ ⇓HML[lts,s ⊨ φ₁] ∨ ⇓HML[lts,s ⊨ φ₂] := by
+  grind [=_ Proposition.or_def, Proposition.or]
+
+@[scoped grind =]
+theorem Satisfies.diamond_iff_exists :
+    ⇓HML[lts,s ⊨ d⟨μ⟩φ] ↔ ∃ s', lts.Tr s μ s' ∧ ⇓HML[lts,s' ⊨ φ] := by rfl
+
+/-- Characterisation of the `→` connective.
+
+Implication is defined in terms of the more primitive connectives given in `Proposition`.
+This result proves that the definition is correct.
+-/
+@[scoped grind =]
+theorem Satisfies.imp_iff_imp :
+    ⇓HML[lts,s ⊨ φ₁ → φ₂] ↔ (⇓HML[lts,s ⊨ φ₁] → ⇓HML[lts,s ⊨ φ₂]) := by
+  grind [=_ Proposition.imp_def, Proposition.imp]
+
+/-- Characterisation of the `↔` connective.
+
+Bi-implication is defined in terms of the more primitive connectives given in `Proposition`.
+This result proves that the definition is correct. -/
+@[scoped grind =]
+theorem Satisfies.iff_iff_iff :
+    ⇓HML[lts,s ⊨ φ₁ ↔ φ₂] ↔ (⇓HML[lts,s ⊨ φ₁] ↔ ⇓HML[lts,s ⊨ φ₂]) := by
+  simp only [HasIff.iff, Proposition.iff]
+  grind
+
+@[scoped grind =]
+theorem Satisfies.box_iff_forall :
+    ⇓HML[lts,s ⊨ d[μ]φ] ↔ ∀ s', lts.Tr s μ s' → ⇓HML[lts,s' ⊨ φ] := by
+  grind [=_ Proposition.box_def, Proposition.box]
+
+/-- A state satisfies a finite conjunction iff it satisfies all conjuncts. -/
+@[scoped grind =]
+theorem Satisfies.finiteAnd_iff_forall :
+    ⇓HML[lts,s ⊨ Proposition.finiteAnd φs] ↔ ∀ φ ∈ φs, ⇓HML[lts,s ⊨ φ] := by
+  induction φs <;> grind
+
+/-- A state satisfies a finite disjunction iff it satisfies some disjunct. -/
+@[scoped grind =]
+theorem Satisfies.finiteOr_iff_exists :
+    ⇓HML[lts,s ⊨ Proposition.finiteOr φs] ↔ ∃ φ ∈ φs, ⇓HML[lts,s ⊨ φ] := by
+  induction φs <;> grind
 
 /-- Denotation of a proposition. -/
 @[simp, scoped grind =]
-def Proposition.denotation (a : Proposition Label) (lts : LTS State Label)
-    : Set State :=
-  match a with
+def Proposition.denotation (lts : LTS State Label)
+    : Proposition Label → Set State
   | .true => Set.univ
-  | .false => ∅
-  | .and a b => a.denotation lts ∩ b.denotation lts
-  | .or a b => a.denotation lts ∪ b.denotation lts
-  | .diamond μ a => {s | ∃ s', lts.Tr s μ s' ∧ s' ∈ a.denotation lts}
-  | .box μ a => {s | ∀ s', lts.Tr s μ s' → s' ∈ a.denotation lts}
+  | .and φ₁ φ₂ => φ₁.denotation lts ∩ φ₂.denotation lts
+  | .not φ => (φ.denotation lts)ᶜ
+  | .diamond μ φ => {s | ∃ s', lts.Tr s μ s' ∧ s' ∈ φ.denotation lts}
 
 /-- The theory of a state is the set of all propositions that it satisfies. -/
 abbrev theory (lts : LTS State Label) (s : State) : Set (Proposition Label) :=
-  {a | Satisfies lts s a}
+  {φ | ⇓HML[lts,s ⊨ φ]}
 
 /-- Two states are theory-equivalent (for a specific LTS) if they have the same theory. -/
 abbrev TheoryEq (lts : LTS State Label) (s1 s2 : State) :=
@@ -120,59 +251,46 @@ open Proposition LTS
 
 /-- Characterisation theorem for the denotational semantics. -/
 @[scoped grind =]
-theorem satisfies_mem_denotation {lts : LTS State Label} :
-    Satisfies lts s a ↔ s ∈ a.denotation lts := by
-  induction a generalizing s <;> grind
+theorem mem_denotation_iff_satisfies {φ : Proposition Label} :
+    s ∈ φ.denotation lts ↔ ⇓HML[lts,s ⊨ φ] := by
+  induction φ generalizing s <;> grind [=_ derivation_def]
 
-/-- A state satisfies a proposition iff it does not satisfy the negation of the proposition. -/
-@[simp, scoped grind =]
-theorem neg_satisfies {lts : LTS State Label} :
-    ¬Satisfies lts s a.neg ↔ Satisfies lts s a := by
-  induction a generalizing s <;> grind
+@[scoped grind .]
+theorem mem_theory_iff_satisfies : φ ∈ theory lts s ↔ ⇓HML[lts,s ⊨ φ] := by
+  grind
 
-/-- A state is in the denotation of a proposition iff it is not in the denotation of the negation
-of the proposition. -/
-@[scoped grind =]
-theorem neg_denotation {lts : LTS State Label} (a : Proposition Label) :
-    s ∉ a.neg.denotation lts ↔ s ∈ a.denotation lts := by
-  grind [_=_ satisfies_mem_denotation]
+/- A state satisfies a proposition iff it does not satisfy the negation of the proposition. -/
+-- @[simp, scoped grind =]
+-- theorem Satisfies.not_not_iff {lts : LTS State Label} :
+--   ¬⇓HML[lts,s ⊨ ¬φ] ↔ ⇓HML[lts,s ⊨ φ] := by
+--   grind
 
-/-- A state satisfies a finite conjunction iff it satisfies all conjuncts. -/
-@[scoped grind =]
-theorem satisfies_finiteAnd {lts : LTS State Label} {s : State}
-    {as : List (Proposition Label)} :
-    Satisfies lts s (Proposition.finiteAnd as) ↔ ∀ a ∈ as, Satisfies lts s a := by
-  induction as <;> grind
+open scoped Satisfies
 
-/-- A state satisfies a finite disjunction iff it satisfies some disjunct. -/
+/-- A state is in the denotation of a proposition iff it is not in the denotation of the negation
+of the proposition. -/
 @[scoped grind =]
-theorem satisfies_finiteOr {lts : LTS State Label} {s : State}
-    {as : List (Proposition Label)} :
-    Satisfies lts s (Proposition.finiteOr as) ↔ ∃ a ∈ as, Satisfies lts s a := by
-  induction as <;> grind
-
-@[scoped grind →]
-theorem satisfies_theory (h : Satisfies lts s a) : a ∈ theory lts s := by
-  grind
+theorem not_denotation {lts : LTS State Label} (φ : Proposition Label) :
+    s ∉ (¬φ).denotation lts ↔ s ∈ φ.denotation lts := by grind
 
 /-- Two states are theory-equivalent iff they are denotationally equivalent. -/
 theorem theoryEq_denotation_eq {lts : LTS State Label} :
     TheoryEq lts s1 s2 ↔
-    (∀ a : Proposition Label, s1 ∈ a.denotation lts ↔ s2 ∈ a.denotation lts) := by
-  grind [_=_ satisfies_mem_denotation]
+    (∀ φ : Proposition Label, s1 ∈ φ.denotation lts ↔ s2 ∈ φ.denotation lts) := by
+  grind [=_ mem_theory_iff_satisfies, =_ mem_denotation_iff_satisfies]
 
 /-- If two states are not theory equivalent, there exists a distinguishing proposition. -/
-lemma not_theoryEq_satisfies (h : ¬ TheoryEq lts s1 s2) :
-    ∃ a, (Satisfies lts s1 a ∧ ¬Satisfies lts s2 a) := by
-  grind [=_ neg_satisfies]
+lemma not_theoryEq_satisfies (h : ¬TheoryEq lts s1 s2) :
+    ∃ φ, (⇓HML[lts,s1 ⊨ φ] ∧ ¬⇓HML[lts,s2 ⊨ φ]) := by
+  grind [=_ Satisfies.not_iff_not]
 
 /-- If two states are theory equivalent and the former satisfies a proposition, the latter does as
 well. -/
-theorem theoryEq_satisfies {lts : LTS State Label} (h : TheoryEq lts s1 s2)
-    (hs : Satisfies lts s1 a) : Satisfies lts s2 a := by
+theorem theoryEq_satisfies (h : TheoryEq lts s1 s2)
+    (hs : ⇓HML[lts,s1 ⊨ φ]) : ⇓HML[lts,s2 ⊨ φ] := by
   unfold TheoryEq theory at h
   rw [Set.ext_iff] at h
-  exact (h a).mp hs
+  exact (h φ).mp hs
 
 section ImageToPropositions
 
@@ -188,12 +306,13 @@ theorem propositions_complete (s' : lts.image s μ) : stateMap s' ∈ propositio
   use s', Finset.mem_toList.mpr (Fintype.complete s')
 
 theorem propositions_satisfies_conjunction (htr : lts.Tr s1 μ s1')
-    (hdist_spec : ∀ s2', Satisfies lts s1' (stateMap s2')) :
-    Satisfies lts s1 (.diamond μ <| Proposition.finiteAnd (propositions stateMap)) := by
-  apply Satisfies.diamond htr
-  rw [satisfies_finiteAnd]
-  intro a ha_mem
-  grind [List.mem_map.mp ha_mem]
+    (hdist_spec : ∀ s2', ⇓HML[lts,s1' ⊨ (stateMap s2')]) :
+    ⇓HML[lts,s1 ⊨ d⟨μ⟩finiteAnd (propositions stateMap)] := by
+  rw [Satisfies.diamond_iff_exists]
+  use s1', htr
+  rw [Satisfies.finiteAnd_iff_forall]
+  intro φ hφ_mem
+  grind [List.mem_map.mp hφ_mem]
 
 end ImageToPropositions
 
@@ -208,15 +327,15 @@ theorem theoryEq_isBisimulation (lts : LTS State Label)
   case left =>
     intro s1' htr
     by_contra
-    have hdist : ∀ s2' : lts.image s2 μ, ∃ a, Satisfies lts s1' a ∧ ¬Satisfies lts s2'.val a := by
+    have hdist : ∀ s2' : lts.image s2 μ, ∃ φ, ⇓HML[lts,s1' ⊨ φ] ∧ ¬⇓HML[lts,s2'.val ⊨ φ] := by
       intro ⟨s2', hs2'⟩
       apply not_theoryEq_satisfies
       grind
     choose dist_formula hdist_spec using hdist
     let conjunction := Proposition.finiteAnd (propositions dist_formula)
-    have hs1_diamond : Satisfies lts s1 (.diamond μ conjunction) := by
+    have hs1_diamond : ⇓HML[lts,s1 ⊨ d⟨μ⟩conjunction] := by
       grind [propositions_satisfies_conjunction]
-    cases (theoryEq_satisfies h hs1_diamond) with | @diamond _ s2'' _ _ htr2 hsat =>
+    obtain ⟨s2'', htr2, hsat⟩ := Satisfies.diamond_iff_exists.mp (theoryEq_satisfies h hs1_diamond)
     grind [propositions_complete dist_formula ⟨s2'', htr2⟩]
   case right =>
     -- Symmetric to left case
@@ -228,39 +347,29 @@ theorem theoryEq_isBisimulation (lts : LTS State Label)
       grind
     choose dist_formula hdist_spec using hdist
     let conjunction := Proposition.finiteAnd (propositions dist_formula)
-    have hs2_diamond : Satisfies lts s2 (.diamond μ conjunction) := by
+    have hs2_diamond : ⇓HML[lts,s2 ⊨ d⟨μ⟩conjunction] := by
       grind [propositions_satisfies_conjunction]
-    cases (theoryEq_satisfies h.symm hs2_diamond) with | @diamond _ s1'' _ _ htr1 hsat =>
+    obtain ⟨s1'', htr1, hsat⟩ :=
+      Satisfies.diamond_iff_exists.mp (theoryEq_satisfies h.symm hs2_diamond)
     grind [propositions_complete dist_formula ⟨s1'', htr1⟩]
 
-/-- If two states are in a bisimulation and the former satisfies a proposition, the latter does as
-well. -/
+/-- If two states are in a bisimulation, one satisfies a proposition iff the other does. -/
 @[scoped grind ⇒]
-lemma bisimulation_satisfies {lts : LTS State Label}
-    {hrb : lts.IsHomBisimulation r}
-    (hr : r s1 s2) (a : Proposition Label) (hs : Satisfies lts s1 a) :
-    Satisfies lts s2 a := by
-  induction a generalizing s1 s2 with
-  | diamond => cases hs with | diamond htr _ => grind [hrb.follow_fst hr htr]
-  | _ => grind
-
-lemma bisimulation_TheoryEq {lts : LTS State Label}
-    {hrb : lts.IsHomBisimulation r}
-    (hr : r s1 s2) :
-    TheoryEq lts s1 s2 := by
-  have : s2 ~[lts] s1 := by grind [Bisimilarity.symm]
-  grind
+lemma bisimulation_satisfies {hrb : lts.IsHomBisimulation r}
+    (hr : r s1 s2) (φ : Proposition Label) : ⇓HML[lts,s1 ⊨ φ] ↔ ⇓HML[lts,s2 ⊨ φ] := by
+  induction φ generalizing s1 s2 <;> grind [IsBisimulation]
+
+lemma bisimulation_theoryEq {hrb : lts.IsHomBisimulation r} (hr : r s1 s2) :
+    TheoryEq lts s1 s2 := by grind
 
 /-- Theory equivalence and bisimilarity coincide for image-finite LTSs. -/
-theorem theoryEq_eq_bisimilarity (lts : LTS State Label)
+theorem theoryEq_eq_bisimilarity {lts : LTS State Label}
     [image_finite : ∀ s μ, Finite (lts.image s μ)] :
     TheoryEq lts = HomBisimilarity lts := by
   ext s1 s2
   apply Iff.intro <;> intro h
   · exists TheoryEq lts
     grind
-  · obtain ⟨r, hr, hrb⟩ := h
-    apply bisimulation_TheoryEq hr
-    exact hrb
+  · grind
 
 end Cslib.Logic.HML
diff --git a/Cslib/Logics/HML/LogicalEquivalence.lean b/Cslib/Logics/HML/LogicalEquivalence.lean
index 5bad96e468..5debc60b46 100644
--- a/Cslib/Logics/HML/LogicalEquivalence.lean
+++ b/Cslib/Logics/HML/LogicalEquivalence.lean
@@ -18,24 +18,49 @@ This module defines logical equivalence for HML propositions and instantiates `L
 
 namespace Cslib.Logic.HML
 
-/-- Logical equivalence for HML propositions. -/
-def Proposition.Equiv {State : Type u} {Label : Type v} (a b : Proposition Label) : Prop :=
-  ∀ lts : LTS State Label, a.denotation lts = b.denotation lts
+open scoped InferenceSystem Satisfies
+
+section Theory
+
+/-! ## Theory of logical equivalence -/
+
+/-- The HML propositions `φ₁` and `φ₂` are logically equivalent under the LTS `lts`. -/
+def Proposition.Equiv (lts : LTS State Label) (φ₁ φ₂ : Proposition Label) : Prop :=
+  ∀ (s : State), ⇓HML[lts,s ⊨ φ₁ ↔ φ₂]
+
+instance : Congruence (Proposition.Equiv lts) := ⟨⟩
 
 @[scoped grind =]
-theorem Proposition.equiv_def {State : Type u} {Label : Type v} (a b : Proposition Label) :
-    Equiv (State := State) a b ↔
-    (∀ lts : LTS State Label, a.denotation lts = b.denotation lts) := by rfl
+theorem Proposition.equiv_def (lts : LTS State Label) (φ₁ φ₂ : Proposition Label) :
+    (φ₁.Equiv lts φ₂) ↔ φ₁ ≡[Equiv lts] φ₂ := by rfl
+
+@[scoped grind ⇒]
+theorem Proposition.equiv_forall_der (lts : LTS State Label) (φ₁ φ₂ : Proposition Label)
+    (h : φ₁ ≡[Equiv lts] φ₂) : ∀ (s : State), ⇓HML[lts,s ⊨ φ₁ ↔ φ₂] := by
+  intro s
+  specialize h s
+  assumption
+
+theorem Proposition.forall_der_equiv (lts : LTS State Label) (φ₁ φ₂ : Proposition Label)
+    (h : ∀ (s : State), ⇓HML[lts,s ⊨ φ₁ ↔ φ₂]) :
+    φ₁ ≡[Equiv lts] φ₂ := by
+  intro s
+  specialize h s
+  assumption
+
+@[scoped grind ⇒]
+theorem Proposition.equiv_iff {lts : LTS State Label} {φ₁ φ₂ : Proposition Label}
+    (h : φ₁ ≡[Equiv lts] φ₂) (s : State) :
+    ⇓HML[lts,s ⊨ φ₁] ↔ ⇓HML[lts,s ⊨ φ₂] := by
+  grind [=_ Satisfies.iff_iff_iff]
 
 /-- Propositional contexts. -/
 inductive Proposition.Context (Label : Type u) : Type u where
   | hole
   | andL (c : Context Label) (φ : Proposition Label)
   | andR (φ : Proposition Label) (c : Context Label)
-  | orL (c : Context Label) (φ : Proposition Label)
-  | orR (φ : Proposition Label) (c : Context Label)
+  | not (c : Context Label)
   | diamond (μ : Label) (c : Context Label)
-  | box (μ : Label) (c : Context Label)
 
 /-- Replaces a hole in a propositional context with a proposition. -/
 @[scoped grind =]
@@ -44,72 +69,125 @@ def Proposition.Context.fill (c : Context Label) (φ : Proposition Label) :=
   | hole => φ
   | andL c φ' => (c.fill φ).and φ'
   | andR φ' c => φ'.and (c.fill φ)
-  | orL c φ' => (c.fill φ).or φ'
-  | orR φ' c => φ'.or (c.fill φ)
+  | not c => .not (c.fill φ)
   | diamond μ c => .diamond μ (c.fill φ)
-  | box μ c => .box μ (c.fill φ)
 
-instance : HasContext (Proposition Label) := ⟨Proposition.Context Label, Proposition.Context.fill⟩
+instance : HasContext (Proposition Label) := ⟨Proposition.Context.fill⟩
+
+@[scoped grind =]
+lemma Proposition.Context.fill_def {c : HasContext.Context (Proposition Atom)} :
+    c.fill φ = c<[φ] := rfl
 
 open scoped Proposition Proposition.Context
 
-instance : IsEquiv (Proposition Label) (Proposition.Equiv (State := State) (Label := Label)) where
-  refl := by grind
-  symm := by grind
-  trans := by grind
+/-- Logical equivalence is an equivalence relation. -/
+instance : IsEquiv (Proposition Label) (Proposition.Equiv lts) := by
+  rw [← equivalence_iff_isEquiv]
+  grind [Equivalence, Proposition.Equiv]
 
-instance {State : Type u} {Label : Type v} :
-    Congruence (Proposition Label) (Proposition.Equiv (State := State) (Label := Label)) where
-  elim :
-      Covariant (Proposition.Context Label) (Proposition Label) (Proposition.Context.fill)
-      Proposition.Equiv := by
-    intro ctx a b hab lts
-    specialize hab lts
+/-- Logical equivalence is a lawful congruence. -/
+instance (lts : LTS State Label) :
+    LawfulCongruence (Proposition.Equiv lts) where
+  elim ctx φ₁ φ₂ heqv := by
     induction ctx
-      <;> simp only [Proposition.Context.fill, Proposition.denotation]
-      <;> grind
-
-/-- Bundled version of a judgement for `Satisfy`. -/
-structure Satisfies.Judgement (State : Type u) (Label : Type v) where
-  /-- The state transition system to consider. -/
-  lts : LTS State Label
-  /-- The state to check the proposition against. -/
-  state : State
-  /-- The proposition to check. -/
-  φ : Proposition Label
-
-/-- `Satisfies` variant using bundled judgements. -/
-def Satisfies.Bundled (j : Satisfies.Judgement State Label) := Satisfies j.lts j.state j.φ
-
-@[scoped grind =]
-theorem Satisfies.bundled_char : Satisfies.Bundled j ↔ Satisfies j.lts j.state j.φ := by rfl
+    case hole =>
+      grind [=_ Proposition.Context.fill_def]
+    case not c ih | andL c ih | andR c ih =>
+      intro s
+      specialize ih s
+      grind [=_ Proposition.Context.fill_def]
+    case diamond c ih =>
+      intro s
+      rw [Satisfies.iff_iff_iff]
+      apply Iff.intro
+      all_goals
+        rintro ⟨w', h⟩
+        specialize ih w'
+        grind [=_ Proposition.Context.fill_def]
 
 /-- Judgemental contexts. -/
-structure Satisfies.Context (State : Type u) (Label : Type v) where
-  /-- The state transition system to consider. -/
+structure Judgement.Context State Label where
+  /-- The labelled transition system to consider. -/
   lts : LTS State Label
   /-- The state to check propositions against. -/
   state : State
 
 /-- Fills a judgemental context with a proposition. -/
-def Satisfies.Context.fill (c : Satisfies.Context State Label) (φ : Proposition Label) :
-    Satisfies.Judgement State Label where
+def Judgement.Context.fill (c : Judgement.Context State Label) (φ : Proposition Label) :
+    Judgement State Label where
   lts := c.lts
   state := c.state
   φ := φ
 
-instance judgementalContext :
-    HasHContext (Satisfies.Judgement State Label) (Proposition Label) :=
-  ⟨Satisfies.Context State Label, Satisfies.Context.fill⟩
-
-instance : LogicalEquivalence
-    (Proposition Label) (Satisfies.Judgement State Label) (Satisfies.Bundled) where
-  eqv := Proposition.Equiv
-  eqvFillValid {a b : Proposition Label} (heqv : a.Equiv (State := State) b)
-      (c : HasHContext.Context (Satisfies.Judgement State Label) (Proposition Label))
-      (h : Satisfies.Bundled c<[a]) : Satisfies.Bundled c<[b] := by
-    simp only [Satisfies.bundled_char, HasHContext.fill, Satisfies.Context.fill]
-    simp only [Satisfies.bundled_char, HasHContext.fill, Satisfies.Context.fill] at h
+instance : HasHContext (Judgement State Label) (Proposition Label) :=
+  ⟨Judgement.Context.fill⟩
+
+@[scoped grind =]
+lemma Judgement.Context.fill_def {c : Judgement.Context World Atom} {φ : Proposition Atom} :
+    HML[c.lts,c.state ⊨ φ] = c<[φ] := rfl
+
+/-- Universal logical equivalence: logical equivalence under all LTSs. -/
+def Proposition.UEquiv.{u, v} {Label : Type v} (φ₁ φ₂ : Proposition Label) : Prop :=
+  ∀ ⦃State : Type u⦄ (lts : LTS State Label), φ₁ ≡[Equiv lts] φ₂
+
+instance : DefaultCongruence (Proposition Label) (Proposition.UEquiv (Label := Label)) := ⟨⟩
+
+@[scoped grind =]
+theorem Proposition.uEquiv_def.{u, v} : UEquiv.{u, v} φ₁ φ₂ ↔ φ₁ ≡[UEquiv.{u, v}] φ₂ := by
+  simp [Congruence.r]
+
+@[scoped grind =]
+theorem Proposition.uEquiv_iff_forall_equiv.{u, v} {Label : Type v} (φ₁ φ₂ : Proposition Label) :
+    (φ₁ ≡[UEquiv.{u, v}] φ₂) ↔ ∀ {State : Type u} (lts : LTS State Label), φ₁ ≡[Equiv lts] φ₂ := by
+  rfl
+
+/-- Universal logical equivalence is an equivalence relation. -/
+instance : IsEquiv (Proposition Label) Proposition.UEquiv := by
+  rw [← equivalence_iff_isEquiv]
+  constructor
+  · intro φ State lts s
     grind
+  · intro φ₁ φ₂ h State lts s
+    grind [h lts]
+  · intro φ₁ φ₂ φ₃ h₁ h₂ State lts
+    grind [h₁ lts, h₂ lts, Proposition.forall_der_equiv lts]
+
+/-- Universal logical equivalence is a lawful congruence. -/
+instance {Label} : LawfulCongruence (Proposition.UEquiv (Label := Label)) where
+  elim :
+      Covariant (Proposition.Context Label) (Proposition Label) Proposition.Context.fill
+      Proposition.UEquiv := by
+    intro ctx φ₁ φ₂ h State lts
+    induction ctx <;> grind [h lts, Proposition.forall_der_equiv lts]
+
+instance : LogicalEquivalence (Judgement := Judgement State Label) InferenceSystem.Default
+    (Proposition.UEquiv (Label := Label)) where
+  eqvFillValid heqv c h := by
+    specialize heqv c.lts c.state
+    grind [=_ Judgement.Context.fill_def, HasHContext.fill, Judgement.Context.fill]
+
+end Theory
+
+section Equivalences
+
+/-! ## Database of logical equivalences -/
+
+namespace Proposition
+
+theorem false_and_false_eqv_false :
+    (⊥ ∧ ⊥ : Proposition Label) ≡ (⊥ : Proposition Label) := by
+  intro State lts
+  have := forall_der_equiv lts
+  grind
+
+/-- The dual axiom (reformulated for HML from modal logic). -/
+theorem dual (μ : Label) (φ : Proposition Label) :
+    (d⟨μ⟩φ) ≡ (¬d[μ]¬φ) := by
+  intro State lts s
+  grind
+
+end Proposition
+
+end Equivalences
 
 end Cslib.Logic.HML
diff --git a/Cslib/Logics/LinearLogic/CLL/Basic.lean b/Cslib/Logics/LinearLogic/CLL/Basic.lean
index c331ae2ae8..7a0aaeba3c 100644
--- a/Cslib/Logics/LinearLogic/CLL/Basic.lean
+++ b/Cslib/Logics/LinearLogic/CLL/Basic.lean
@@ -96,7 +96,7 @@ def Proposition.Context.fill (c : Context Atom) (a : Proposition Atom) : Proposi
   | bang c => .bang (c.fill a)
   | quest c => .quest (c.fill a)
 
-instance : HasContext (Proposition Atom) := ⟨Proposition.Context Atom, Proposition.Context.fill⟩
+instance : HasContext (Proposition Atom) := ⟨Proposition.Context.fill⟩
 
 /-- Definition of context filling. -/
 @[scoped grind =]
@@ -183,8 +183,7 @@ def Sequent.Context Atom := Sequent Atom
 /-- Filling a judgemental context returns a sequent. -/
 def Sequent.Context.fill (Γc : Sequent.Context Atom) (a : Proposition Atom) := a ::ₘ Γc
 
-instance : HasHContext (Sequent Atom) (Proposition Atom) :=
-  ⟨Sequent.Context Atom, Sequent.Context.fill⟩
+instance : HasHContext (Sequent Atom) (Proposition Atom) := ⟨Sequent.Context.fill⟩
 
 open Proposition in
 /-- A proof in the sequent calculus for classical linear logic. -/
@@ -259,8 +258,11 @@ open Sequent in
 def Proposition.Equiv (a b : Proposition Atom) :=
   Derivable ({a⫠, b} : Sequent Atom) ∧ Derivable ({b⫠, a} : Sequent Atom)
 
-@[inherit_doc]
-scoped infix:29 " ≡ " => Proposition.Equiv
+instance : DefaultCongruence (Proposition Atom) (Proposition.Equiv (Atom := Atom)) := ⟨⟩
+
+@[scoped grind =]
+theorem Proposition.prop_equiv_def {a b : Proposition Atom} : Proposition.Equiv a b ↔ a ≡ b := by
+  rfl
 
 /-- Conversion from proof-relevant to proof-irrelevant versions of propositional
 equivalence. -/
@@ -643,19 +645,16 @@ private lemma Proposition.equiv_quest {a a' : Proposition Atom} (h : a ≡ a') :
       apply Proof.quest
       apply h₂.rwConclusion (by grind)
 
-instance : Congruence (Proposition Atom) Proposition.Equiv where
+instance : LawfulCongruence (Proposition.Equiv (Atom := Atom)) where
   elim :
       Covariant (Proposition.Context Atom) (Proposition Atom) (Proposition.Context.fill)
       Proposition.Equiv := by
     intro ctx a b hab
     induction ctx <;> grind [= Context.fill]
 
-noncomputable instance : LogicalEquivalence (Proposition Atom) (Sequent Atom) Proof where
-  eqv := Proposition.Equiv
-  eqvFillValid {a b : Proposition Atom} (heqv : a.Equiv b)
-      (c : HasHContext.Context (Sequent Atom) (Proposition Atom))
-      (h : ⇓c<[a]) : ⇓c<[b] := by
-    apply substEqvHead (chooseEquiv heqv) h
+noncomputable instance : LogicalEquivalence
+    (Judgement := Sequent Atom) InferenceSystem.Default (Proposition.Equiv (Atom := Atom)) where
+  eqvFillValid heqv _ h := substEqvHead (chooseEquiv heqv) h
 
 /-- Tensor is commutative. -/
 @[scoped grind ←]
diff --git a/Cslib/Logics/LinearLogic/CLL/EtaExpansion.lean b/Cslib/Logics/LinearLogic/CLL/EtaExpansion.lean
index 9aa98ab04a..1148ef3ef9 100644
--- a/Cslib/Logics/LinearLogic/CLL/EtaExpansion.lean
+++ b/Cslib/Logics/LinearLogic/CLL/EtaExpansion.lean
@@ -109,11 +109,8 @@ private lemma Proof.expand_onlyAtomicAxioms_dual {a : Proposition Atom} :
   induction a with
   | one => simp +contextual [dual, expand, onlyAtomicAxioms]
   | bot =>
-    intro h
-    rw [←h]
-    congr 1
-    · grind
-    · simp [dual, expand, rwConclusion, Logic.InferenceSystem.rwConclusion]
+    #adaptation_note /-- see https://github.com/leanprover/lean4/pull/13484/ -/
+    grind [expand, dual.eq_def]
   | _ => grind [Proposition.expand, Proposition.dual_inj]
 
 open Proposition Proof in
diff --git a/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean b/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
index 25cd8138e7..c5233c24c5 100644
--- a/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
+++ b/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
@@ -196,14 +196,8 @@ lemma coe_mk {X : Set P} {h : isFact X} : ((⟨X, h⟩ : Fact P) : Set P) = X :=
 @[simp] lemma closed (F : Fact P) : isFact (F : Set P) := F.property
 
 /-- In any phase space, `{1}⫠ = ⊥`. -/
-lemma orth_one_eq_bot :
-    ({(1 : P)} : Set P)⫠ = (PhaseSpace.bot : Set P) := by
-  ext m; constructor
-  · intro hm
-    simpa [orthogonal, mem_setOf, mul_one] using hm 1 (by simp)
-  · intro hm x hx
-    rcases hx with rfl
-    simpa [orthogonal, mem_setOf, mul_one] using hm
+lemma orth_one_eq_bot : ({(1 : P)} : Set P)⫠ = (PhaseSpace.bot : Set P) := by
+  simp_all
 
 /-- The fact given by the dual of G. -/
 @[simps!] def dualFact (G : Set P) : Fact P := Fact.mkDual (G⫠) G rfl
@@ -638,14 +632,9 @@ lemma par_semi_distrib_plus : ((G ⅋ H) ⊕ (G ⅋ K) : Fact P) ≤ G ⅋ (H 
 
 @[simp] lemma top_par : (⊤ ⅋ G : Fact P) = ⊤ := by
   refine SetLike.coe_injective ?_
-  rw [coe_top]
-  rw [Set.eq_univ_iff_forall]
-  intro x
-  simp only [parr, dualFact, mkDual, mkSubset, coe_mk, coe_top]
-  rw [PhaseSpace.orthogonal_def, Set.mem_setOf_eq]
-  intro w hw
+  rw [coe_top, Set.eq_univ_iff_forall]
+  intro x w hw
   rcases Set.mem_mul.mp hw with ⟨y, hy, z, hz, rfl⟩
-  rw [PhaseSpace.orthogonal_def, Set.mem_setOf_eq] at hy
   rw [mul_left_comm]
   exact hy (x * z) (Set.mem_univ _)
 
@@ -679,7 +668,7 @@ lemma valid_with {G H : Fact P} : (G & H).IsValid ↔ G.IsValid ∧ H.IsValid :=
 
 end Fact
 
-open Fact
+open PhaseSpace.Fact
 
 /-! ## Interpretation of propositions -/
 
diff --git a/Cslib/Logics/Modal/Basic.lean b/Cslib/Logics/Modal/Basic.lean
index a627923676..b00710b460 100644
--- a/Cslib/Logics/Modal/Basic.lean
+++ b/Cslib/Logics/Modal/Basic.lean
@@ -6,11 +6,11 @@ Authors: Fabrizio Montesi, Marianna Girlando
 
 module
 
-public import Cslib.Init
+public import Cslib.Foundations.Logic.Operators
 public import Cslib.Foundations.Logic.InferenceSystem
 public import Mathlib.Data.Set.Basic
 public import Mathlib.Order.Defs.Unbundled
-public import Cslib.Foundations.Data.Relation
+public import Cslib.Foundations.Relation.Euclidean
 public import Mathlib.Logic.Nonempty
 
 /-! # Modal Logic
@@ -41,42 +41,64 @@ inductive Proposition (Atom : Type u) : Type u where
   /-- Atomic proposition. -/
   | atom (p : Atom)
   /-- Negation. -/
-  | neg (φ : Proposition Atom)
+  | not (φ : Proposition Atom)
   /-- Conjunction. -/
   | and (φ₁ φ₂ : Proposition Atom)
   /-- Possibility. -/
   | diamond (φ : Proposition Atom)
 
-@[inherit_doc] scoped prefix:40 "¬" => Proposition.neg
-@[inherit_doc] scoped infix:36 " ∧ " => Proposition.and
-@[inherit_doc] scoped prefix:40 "◇" => Proposition.diamond
+instance : HasNot (Proposition Atom) := ⟨.not⟩
+instance : HasAnd (Proposition Atom) := ⟨.and⟩
+instance : HasDiamond (Proposition Atom) := ⟨.diamond⟩
+
+@[scoped grind =]
+lemma Proposition.not_def (φ : Proposition Atom) : φ.not = ¬φ := rfl
+
+@[scoped grind =]
+lemma Proposition.and_def (φ₁ φ₂ : Proposition Atom) : φ₁.and φ₂ = (φ₁ ∧ φ₂) := rfl
+
+@[scoped grind =]
+lemma Proposition.diamond_def (φ : Proposition Atom) : φ.diamond = (◇φ) := rfl
 
 /-- Disjunction. -/
 def Proposition.or (φ₁ φ₂ : Proposition Atom) : Proposition Atom := ¬(¬φ₁ ∧ ¬φ₂)
 
-@[inherit_doc] scoped infix:35 " ∨ " => Proposition.or
+instance : HasOr (Proposition Atom) := ⟨Proposition.or⟩
+
+@[scoped grind =]
+lemma Proposition.or_def (φ₁ φ₂ : Proposition Atom) : φ₁.or φ₂ = (φ₁ ∨ φ₂) := rfl
 
 /-- Implication. -/
-def Proposition.impl (φ₁ φ₂ : Proposition Atom) : Proposition Atom := ¬φ₁ ∨ φ₂
+def Proposition.imp (φ₁ φ₂ : Proposition Atom) : Proposition Atom := ¬φ₁ ∨ φ₂
+
+instance : HasImp (Proposition Atom) := ⟨.imp⟩
 
-@[inherit_doc] scoped infix:30 " → " => Proposition.impl
+@[scoped grind =]
+lemma Proposition.imp_def (φ₁ φ₂ : Proposition Atom) : φ₁.imp φ₂ = (φ₁ → φ₂) := rfl
 
 /-- Bi-implication. -/
 def Proposition.iff (φ₁ φ₂ : Proposition Atom) : Proposition Atom := (φ₁ → φ₂) ∧ (φ₂ → φ₁)
 
-@[inherit_doc] scoped infix:30 " ↔ " => Proposition.iff
+instance : HasIff (Proposition Atom) := ⟨.iff⟩
+
+@[scoped grind =]
+lemma Proposition.iff_def (φ₁ φ₂ : Proposition Atom) :
+    φ₁.iff φ₂ = (φ₁ ↔ φ₂) := rfl
 
 /-- Necessity. -/
 def Proposition.box (φ : Proposition Atom) : Proposition Atom := ¬◇¬φ
 
-@[inherit_doc] scoped prefix:40 "□" => Proposition.box
+instance : HasBox (Proposition Atom) := ⟨.box⟩
+
+@[scoped grind =]
+lemma Proposition.box_def (φ : Proposition Atom) : φ.box = (□φ) := rfl
 
 /-- Satisfaction relation. `Satisfies m w φ` means that, in the model `m`, the world `w` satisfies
 the proposition `φ`. -/
 @[scoped grind]
 def Satisfies (m : Model World Atom) (w : World) : Proposition Atom → Prop
   | .atom p => m.v w p
-  | .neg φ => ¬Satisfies m w φ
+  | .not φ => ¬Satisfies m w φ
   | .and φ₁ φ₂ => Satisfies m w φ₁ ∧ Satisfies m w φ₂
   | .diamond φ => ∃ w', m.r w w' ∧ Satisfies m w' φ
 
@@ -101,14 +123,21 @@ instance : HasInferenceSystem (Judgement World Atom) := ⟨Satisfies.Bundled⟩
 
 open scoped InferenceSystem Proposition
 
-@[scoped grind =]
+@[scoped grind =_]
 theorem derivation_def {m : Model World Atom} {w : World} {φ : Proposition Atom} :
-  ⇓Modal[m,w ⊨ φ] = Satisfies m w φ := rfl
+  Satisfies m w φ = ⇓Modal[m,w ⊨ φ] := rfl
 
 /-- A world satisfies a proposition iff it does not satisfy the negation of the proposition. -/
 @[scoped grind =]
-theorem neg_satisfies : ⇓Modal[m,w ⊨ ¬φ] ↔ ¬⇓Modal[m,w ⊨ φ] := by
-  induction φ generalizing w <;> grind
+theorem Satisfies.not_iff_not : ⇓Modal[m,w ⊨ ¬φ] ↔ ¬⇓Modal[m,w ⊨ φ] := by rfl
+
+@[scoped grind =]
+theorem Satisfies.and_iff_and {m : Model World Atom} :
+    ⇓Modal[m,w ⊨ φ₁ ∧ φ₂] ↔ ⇓Modal[m,w ⊨ φ₁] ∧ ⇓Modal[m,w ⊨ φ₂] := by rfl
+
+@[scoped grind =]
+theorem Satisfies.diamond_iff_exists {m : Model World Atom} :
+    ⇓Modal[m,w ⊨ ◇φ] ↔ ∃ w', m.r w w' ∧ ⇓Modal[m,w' ⊨ φ] := by rfl
 
 /-- Characterisation of the `∨` connective.
 
@@ -116,7 +145,8 @@ Disjunction is defined in terms of the more primitive connectives given in `Prop
 This result proves that the definition is correct. -/
 @[scoped grind =]
 theorem Satisfies.or_iff_or {m : Model World Atom} :
-    ⇓Modal[m,w ⊨ φ₁ ∨ φ₂] ↔ ⇓Modal[m,w ⊨ φ₁] ∨ ⇓Modal[m,w ⊨ φ₂] := by grind [Proposition.or]
+    ⇓Modal[m,w ⊨ φ₁ ∨ φ₂] ↔ ⇓Modal[m,w ⊨ φ₁] ∨ ⇓Modal[m,w ⊨ φ₂] := by
+  grind [=_ Proposition.or_def, Proposition.or]
 
 /-- Characterisation of the `→` connective.
 
@@ -124,8 +154,19 @@ Implication is defined in terms of the more primitive connectives given in `Prop
 This result proves that the definition is correct.
 -/
 @[scoped grind =]
-theorem Satisfies.impl_iff_impl {m : Model World Atom} :
-    ⇓Modal[m,w ⊨ φ₁ → φ₂] ↔ (⇓Modal[m,w ⊨ φ₁] → ⇓Modal[m,w ⊨ φ₂]) := by grind [Proposition.impl]
+theorem Satisfies.imp_iff_imp {m : Model World Atom} :
+    ⇓Modal[m,w ⊨ φ₁ → φ₂] ↔ (⇓Modal[m,w ⊨ φ₁] → ⇓Modal[m,w ⊨ φ₂]) := by
+  grind [=_ Proposition.imp_def, Proposition.imp]
+
+/-- Characterisation of the `↔` connective.
+
+Bi-implication is defined in terms of the more primitive connectives given in `Proposition`.
+This result proves that the definition is correct. -/
+@[scoped grind =]
+theorem Satisfies.iff_iff_iff {m : Model World Atom} :
+    ⇓Modal[m,w ⊨ φ₁ ↔ φ₂] ↔ (⇓Modal[m,w ⊨ φ₁] ↔ ⇓Modal[m,w ⊨ φ₂]) := by
+  simp only [HasIff.iff, Proposition.iff]
+  grind [= derivation_def]
 
 /-- Characterisation of the `□` modality.
 
@@ -133,9 +174,10 @@ Necessity is defined in terms of the more primitive connectives given in `Propos
 This result proves that the definition is correct. -/
 @[scoped grind =]
 theorem Satisfies.box_iff_forall {m : Model World Atom} :
-    ⇓Modal[m,w ⊨ □φ] ↔ ∀ w', m.r w w' → ⇓Modal[m,w' ⊨ φ] := by grind [Proposition.box]
+    ⇓Modal[m,w ⊨ □φ] ↔ ∀ w', m.r w w' → ⇓Modal[m,w' ⊨ φ] := by
+  grind [=_ Proposition.box_def, Proposition.box]
 
-/-- The theory of a world in a model is the set of all propositions that it satifies. -/
+/-- The theory of a world in a model is the set of all propositions that it satisfies. -/
 abbrev theory (m : Model World Atom) (w : World) : Set (Proposition Atom) :=
   {φ | ⇓Modal[m,w ⊨ φ]}
 
@@ -152,7 +194,7 @@ theorem satisfies_theory (h : Satisfies m w φ) : φ ∈ theory m w := by grind
 
 /-- If two worlds are not theory equivalent, there exists a distinguishing proposition. -/
 lemma not_theoryEq_satisfies (h : ¬TheoryEq m w₁ w₂) :
-    ∃ φ, (⇓Modal[m,w₁ ⊨ φ] ∧ ¬⇓Modal[m,w₂ ⊨ φ]) := by grind [=_ neg_satisfies]
+    ∃ φ, (⇓Modal[m,w₁ ⊨ φ] ∧ ¬⇓Modal[m,w₂ ⊨ φ]) := by grind [=_ Satisfies.not_iff_not]
 
 /-- If two worlds are theory equivalent and the former satisfies a proposition, the latter does as
 well. -/
@@ -164,13 +206,12 @@ theorem theoryEq_satisfies {m : Model World Atom} (h : TheoryEq m w₁ w₂)
 /-- The K axiom, valid for all models. -/
 theorem Satisfies.k : ⇓Modal[m,w ⊨ □(φ₁ → φ₂) → (□φ₁ → □φ₂)] := by grind
 
-set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- The dual axiom, valid for all models. -/
 theorem Satisfies.dual : ⇓Modal[m,w ⊨ ◇φ ↔ ¬□¬φ] := by
+  simp only [Satisfies.iff_iff_iff]
   constructor
   · grind
-  · grind only [→ satisfies_theory, usr Set.mem_setOf_eq, = impl_iff_impl, = derivation_def,
-    = neg_satisfies, Satisfies, = box_iff_forall, = Set.setOf_true]
+  · grind only [= not_iff_not, = diamond_iff_exists, = box_iff_forall]
 
 /-- The T axiom, valid for all reflexive models. -/
 theorem Satisfies.t {m : Model World Atom} [instRefl : Std.Refl m.r] {w : World}
@@ -203,13 +244,13 @@ theorem Satisfies.b_symm {World Atom} {r : World → World → Prop} [Nonempty A
     have a := Classical.arbitrary Atom
     let v₁ := fun (w' : World) (a : Atom) => w' = w₁
     let h₁ := h (v := v₁) (w := w₁) (φ := .atom a)
-    simp [impl_iff_impl] at h₁
+    simp [imp_iff_imp] at h₁
     grind
 
 /-- The 4 axiom, valid for all transitive models. -/
 theorem Satisfies.four {m : Model World Atom} [IsTrans World m.r] {w : World}
     (φ : Proposition Atom) : ⇓Modal[m,w ⊨ ◇◇φ → ◇φ] := by
-  simp only [impl_iff_impl]
+  simp only [imp_iff_imp]
   intro h
   rcases h with ⟨w', h₁, w'', h₂, hs⟩
   exact ⟨w'', IsTrans.trans _ _ _ h₁ h₂, hs⟩
diff --git a/Cslib/Logics/Modal/Cube.lean b/Cslib/Logics/Modal/Cube.lean
index 98e825014c..765193ac0d 100644
--- a/Cslib/Logics/Modal/Cube.lean
+++ b/Cslib/Logics/Modal/Cube.lean
@@ -45,7 +45,8 @@ def Five World Atom := logic {m : Model World Atom | Relation.RightEuclidean m.r
 
 /-- The modal logic K45. -/
 @[scoped grind =]
-def K45 World Atom := (K World Atom) ∪ (Four World Atom) ∪ (Five World Atom)
+def K45 World Atom :=
+  logic {m : Model World Atom | IsTrans World m.r ∧ Relation.RightEuclidean m.r}
 
 /-- The modal logic D. -/
 @[scoped grind =]
@@ -53,60 +54,68 @@ def D World Atom := logic {m : Model World Atom | Relation.Serial m.r}
 
 /-- The modal logic D4. -/
 @[scoped grind =]
-def D4 World Atom := (K World Atom) ∪ (D World Atom) ∪ (Four World Atom)
+def D4 World Atom :=
+  logic {m : Model World Atom | Relation.Serial m.r ∧ IsTrans World m.r}
 
 /-- The modal logic D5. -/
 @[scoped grind =]
-def D5 World Atom := (K World Atom) ∪ (D World Atom) ∪ (Five World Atom)
+def D5 World Atom :=
+  logic {m : Model World Atom | Relation.Serial m.r ∧ Relation.RightEuclidean m.r}
 
 /-- The modal logic D45. -/
 @[scoped grind =]
-def D45 World Atom := (K World Atom) ∪ (D World Atom) ∪ (Four World Atom) ∪ (Five World Atom)
+def D45 World Atom :=
+  logic {m : Model World Atom |
+    Relation.Serial m.r ∧ IsTrans World m.r ∧ Relation.RightEuclidean m.r}
 
 /-- The modal logic DB. -/
 @[scoped grind =]
-def DB World Atom := (K World Atom) ∪ (D World Atom) ∪ (B World Atom)
+def DB World Atom :=
+  logic {m : Model World Atom | Relation.Serial m.r ∧ Std.Symm m.r}
 
 /-- The modal logic TB. -/
 @[scoped grind =]
-def TB World Atom := (K World Atom) ∪ (T World Atom) ∪ (B World Atom)
+def TB World Atom :=
+  logic {m : Model World Atom | Std.Refl m.r ∧ Std.Symm m.r}
 
 /-- The modal logic KB5. -/
 @[scoped grind =]
-def KB5 World Atom := (K World Atom) ∪ (B World Atom) ∪ (Five World Atom)
+def KB5 World Atom :=
+  logic {m : Model World Atom | Std.Symm m.r ∧ Relation.RightEuclidean m.r}
 
 /-- The modal logic S4. -/
 @[scoped grind =]
-def S4 World Atom := (K World Atom) ∪ (T World Atom) ∪ (Four World Atom)
+def S4 World Atom :=
+  logic {m : Model World Atom | Std.Refl m.r ∧ IsTrans World m.r}
 
 /-- The modal logic S5. -/
 @[scoped grind =]
-def S5 World Atom := (K World Atom) ∪ (T World Atom) ∪ (Four World Atom) ∪ (Five World Atom)
+def S5 World Atom :=
+  logic {m : Model World Atom |
+    Std.Refl m.r ∧ IsTrans World m.r ∧ Relation.RightEuclidean m.r}
 
 section Order
 
 /-! ## Ordering of Modal Logics
 
-This section proves the essential inclusions of modal logics.
-
-The other inclusions in the Modal Cube can be derived from the properties of `⊆` and `∪`, as shown
-in `k_subset_t`.
+This section proves the essential inclusions of modal logics. Inclusions among compound logics
+follow by forgetting frame conditions in their defining model classes.
 -/
 
 open scoped Proposition
 open Set
 
 theorem k_subset_d : K World Atom ⊆ D World Atom := by
-  grind only [subset_def, D, K, = setOf_true, = logic, mem_setOf_eq, = Proposition.valid]
+  grind only [subset_def, D, K, = ofPred_true, = logic, mem_ofPred_eq, = Proposition.valid]
 
 theorem k_subset_b : K World Atom ⊆ B World Atom := by
-  grind only [subset_def, B, K, = setOf_true, = logic, mem_setOf_eq, = Proposition.valid]
+  grind only [subset_def, B, K, = ofPred_true, = logic, mem_ofPred_eq, = Proposition.valid]
 
 theorem k_subset_four : K World Atom ⊆ Four World Atom := by
-  grind only [subset_def, Four, K, = setOf_true, = logic, mem_setOf_eq, = Proposition.valid]
+  grind only [subset_def, Four, K, = ofPred_true, = logic, mem_ofPred_eq, = Proposition.valid]
 
 theorem k_subset_five : K World Atom ⊆ Five World Atom := by
-  grind only [subset_def, Five, K, = setOf_true, = logic, mem_setOf_eq, = Proposition.valid]
+  grind only [subset_def, Five, K, = ofPred_true, = logic, mem_ofPred_eq, = Proposition.valid]
 
 open scoped Relation in
 theorem d_subset_t : D World Atom ⊆ T World Atom := by
diff --git a/Cslib/Logics/Modal/Denotation.lean b/Cslib/Logics/Modal/Denotation.lean
index 63e88000e0..4b3415b334 100644
--- a/Cslib/Logics/Modal/Denotation.lean
+++ b/Cslib/Logics/Modal/Denotation.lean
@@ -18,14 +18,14 @@ A denotational semantics for modal logic, inspired by the one for Hennessy-Milne
 
 namespace Cslib.Logic.Modal
 
-open scoped Proposition InferenceSystem
+open scoped Proposition InferenceSystem Satisfies
 
 /-- Denotation of a proposition. -/
 @[simp, scoped grind =]
 def Proposition.denotation (m : Model World Atom) :
     Proposition Atom → Set World
   | .atom p => {w | m.v w p}
-  | .neg φ => (φ.denotation m)ᶜ
+  | .not φ => (φ.denotation m)ᶜ
   | .and φ₁ φ₂ => φ₁.denotation m ∩ φ₂.denotation m
   | .diamond φ => {w | ∃ w', m.r w w' ∧ w' ∈ φ.denotation m}
 
@@ -38,7 +38,7 @@ theorem satisfies_mem_denotation {m : Model World Atom} {φ : Proposition Atom}
 /-- A world is in the denotation of a proposition iff it is not in the denotation of the negation
 of the proposition. -/
 @[scoped grind =]
-theorem neg_denotation {m : Model World Atom} (φ : Proposition Atom) :
+theorem not_denotation {m : Model World Atom} (φ : Proposition Atom) :
     w ∉ (¬φ).denotation m ↔ w ∈ φ.denotation m := by
   grind [_=_ satisfies_mem_denotation]
 
diff --git a/Cslib/Logics/Modal/LogicalEquivalence.lean b/Cslib/Logics/Modal/LogicalEquivalence.lean
new file mode 100644
index 0000000000..092ff00e6b
--- /dev/null
+++ b/Cslib/Logics/Modal/LogicalEquivalence.lean
@@ -0,0 +1,143 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+module
+
+public import Cslib.Logics.Modal.Basic
+public import Cslib.Foundations.Logic.LogicalEquivalence
+
+/-! # Logical Equivalence in Modal Logic
+
+This module defines logical equivalence for modal propositions.
+The definitions are parametric on the class of models under consideration.
+
+We also instantiate `LogicalEquivalence` for Modal Logic K, i.e., equivalence
+for the class of all models.
+-/
+
+@[expose] public section
+
+namespace Cslib.Logic.Modal
+
+open scoped InferenceSystem Proposition Satisfies
+
+/-- The modal propositions `φ₁` and `φ₂` are equivalent in the class of models `S`. -/
+def Proposition.Equiv (S : Set (Model World Atom)) (φ₁ φ₂ : Proposition Atom)
+    : Prop :=
+  ∀ m ∈ S, ∀ w : World, ⇓Modal[m,w ⊨ φ₁ ↔ φ₂]
+
+instance : Congruence (Proposition.Equiv S) := ⟨⟩
+
+@[scoped grind =]
+theorem Proposition.equiv_def (S : Set (Model World Atom)) (φ₁ φ₂ : Proposition Atom) :
+    φ₁.Equiv S φ₂ ↔ (φ₁ ≡[Equiv S] φ₂) := by rfl
+
+@[scoped grind ⇒]
+theorem Proposition.equiv_forall_der (S : Set (Model World Atom)) (φ₁ φ₂ : Proposition Atom)
+    (h : φ₁ ≡[Equiv S] φ₂) : ∀ m ∈ S, ∀ (w : World), ⇓Modal[m,w ⊨ φ₁ ↔ φ₂] := by
+  intro s
+  specialize h s
+  assumption
+
+theorem Proposition.forall_der_equiv (S : Set (Model World Atom)) (φ₁ φ₂ : Proposition Atom)
+    (h : ∀ m ∈ S, ∀ (w : World), ⇓Modal[m,w ⊨ φ₁ ↔ φ₂]) : φ₁ ≡[Equiv S] φ₂ := by
+  intro s
+  specialize h s
+  assumption
+
+@[scoped grind ⇒]
+theorem Proposition.equiv_iff (S : Set (Model World Atom)) (φ₁ φ₂ : Proposition Atom)
+    (h : φ₁ ≡[Equiv S] φ₂) (m : Model World Atom) (hm : m ∈ S) (w : World) :
+    ⇓Modal[m,w ⊨ φ₁] ↔ ⇓Modal[m,w ⊨ φ₂] := by
+  grind [=_ Satisfies.iff_iff_iff]
+
+/-- Logical equivalence preserves validity. -/
+theorem Proposition.equiv_valid (S : Set (Model World Atom))
+    (φ₁ φ₂ : Proposition Atom) (h : φ₁ ≡[Equiv S] φ₂) :
+    (φ₁.valid S ↔ φ₂.valid S) := by
+  apply Proposition.equiv_forall_der at h
+  simp only [Satisfies.iff_iff_iff] at h
+  grind
+
+/-- Propositional contexts. -/
+inductive Proposition.Context (Atom : Type u) : Type u where
+  | hole
+  | not (c : Context Atom)
+  | andL (c : Context Atom) (φ : Proposition Atom)
+  | andR (φ : Proposition Atom) (c : Context Atom)
+  | diamond (c : Context Atom)
+
+/-- Replaces a hole in a propositional context with a proposition. -/
+@[scoped grind =]
+def Proposition.Context.fill (c : Context Atom) (φ : Proposition Atom) :=
+  match c with
+  | hole => φ
+  | not c => .not (c.fill φ)
+  | andL c φ' => (c.fill φ).and φ'
+  | andR φ' c => φ'.and (c.fill φ)
+  | diamond c => .diamond (c.fill φ)
+
+instance : HasContext (Proposition Atom) := ⟨Proposition.Context.fill⟩
+
+@[scoped grind =]
+lemma Proposition.Context.fill_def {c : HasContext.Context (Proposition Atom)} :
+    c.fill φ = c<[φ] := rfl
+
+open scoped Proposition Proposition.Context
+
+/-- Logical equivalence is an equivalence relation. -/
+instance {World Atom} (S : Set (Model World Atom)) :
+    IsEquiv (Proposition Atom) (Proposition.Equiv S) := by
+  rw [← equivalence_iff_isEquiv]
+  grind [Equivalence, Proposition.Equiv]
+
+/-- Logical equivalence is a congruence. -/
+instance {World Atom} (S : Set (Model World Atom)) :
+    LawfulCongruence (Proposition.Equiv S) where
+  elim ctx φ₁ φ₂ heqv m hₘ w := by
+    induction ctx generalizing w
+    case hole => grind [=_ Proposition.Context.fill_def]
+    case not c ih | andL c ih | andR c ih =>
+      specialize ih w
+      grind [=_ Proposition.Context.fill_def]
+    case diamond c ih =>
+      rw [Satisfies.iff_iff_iff]
+      apply Iff.intro
+      all_goals
+        rintro ⟨w', h⟩
+        specialize ih w'
+        grind [=_ Proposition.Context.fill_def]
+
+/-- Judgemental contexts. -/
+structure Satisfies.Context (World Atom : Type*) where
+  /-- The model to consider. -/
+  m : Model World Atom
+  /-- The world to check propositions against. -/
+  w : World
+
+/-- Fills a judgemental context with a proposition. -/
+def Satisfies.Context.fill (c : Satisfies.Context World Atom) (φ : Proposition Atom) :
+    Judgement World Atom := Modal[c.m, c.w ⊨ φ]
+
+instance : HasHContext (Judgement World Atom) (Proposition Atom) :=
+  ⟨Satisfies.Context.fill⟩
+
+@[scoped grind =]
+lemma Satisfies.Context.fill_def {c : Satisfies.Context World Atom} :
+    Modal[c.m,c.w ⊨ φ] = c<[φ] := rfl
+
+open scoped Satisfies.Context
+
+/-- Logical equivalence for Modal Logic K. That is, no assumptions on models are made. -/
+instance : LogicalEquivalence
+    (α := Proposition Atom)
+    (Judgement := Judgement World Atom) InferenceSystem.Default
+    (Proposition.Equiv (Set.univ (α := Model World Atom))) where
+  eqvFillValid heqv c h := by
+    specialize heqv c.m
+    grind [=_ Satisfies.Context.fill_def]
+
+end Cslib.Logic.Modal
diff --git a/Cslib/Logics/Propositional/Defs.lean b/Cslib/Logics/Propositional/Defs.lean
index fa3caf53e2..a68d4c53a7 100644
--- a/Cslib/Logics/Propositional/Defs.lean
+++ b/Cslib/Logics/Propositional/Defs.lean
@@ -6,7 +6,8 @@ Authors: Thomas Waring
 
 module
 
-public import Cslib.Init
+public import Cslib.Foundations.Logic.Operators
+public import Cslib.Foundations.Logic.InferenceSystem
 public import Mathlib.Data.FunLike.Basic
 public import Mathlib.Data.Set.Image
 public import Mathlib.Order.TypeTags
@@ -30,8 +31,10 @@ theory.
 
 ## Notation
 
-We introduce notation for the logical connectives: `⊥ ⊤ ∧ ∨ → ¬` for, respectively, falsum, verum,
-conjunction, disjunction, implication and negation.
+We instantiate the notation classes `HasAnd`, `HasOr`, `HasImpl` and `HasNot` for `Proposition Atom`
+to give access to, respectively, the notations `∧, ∨, →` and `¬` for propositional connectives.
+In the case that `Atom` has a bottom element (respectively, is inhabited) we give instances
+`HasBot (Proposition Atom)` and (respectively, `HasTop (Proposition Atom)`).
 -/
 
 @[expose] public section
@@ -51,26 +54,30 @@ inductive Proposition (Atom : Type u) : Type u where
   /-- Disjunction -/
   | or (a b : Proposition Atom)
   /-- Implication -/
-  | impl (a b : Proposition Atom)
+  | imp (a b : Proposition Atom)
 deriving DecidableEq, BEq
 
 instance instBotProposition [Bot Atom] : Bot (Proposition Atom) := ⟨.atom ⊥⟩
 instance instInhabitedOfBot [Bot Atom] : Inhabited Atom := ⟨⊥⟩
 
 /-- We view negation as a defined connective ~A := A → ⊥ -/
-abbrev Proposition.neg [Bot Atom] : Proposition Atom → Proposition Atom := (Proposition.impl · ⊥)
+abbrev Proposition.neg [Bot Atom] : Proposition Atom → Proposition Atom := (Proposition.imp · ⊥)
 
 /-- A fixed choice of a derivable proposition (of course any two are equivalent). -/
-abbrev Proposition.top [Inhabited Atom] : Proposition Atom := impl (.atom default) (.atom default)
+abbrev Proposition.top [Inhabited Atom] : Proposition Atom := imp (.atom default) (.atom default)
 
 instance instTopProposition [Inhabited Atom] : Top (Proposition Atom) := ⟨.top⟩
 
-example [Bot Atom] : (⊤ : Proposition Atom) = Proposition.impl ⊥ ⊥ := rfl
+example [Bot Atom] : (⊤ : Proposition Atom) = Proposition.imp ⊥ ⊥ := rfl
 
-@[inherit_doc] scoped infix:36 " ∧ " => Proposition.and
-@[inherit_doc] scoped infix:35 " ∨ " => Proposition.or
-@[inherit_doc] scoped infix:30 " → " => Proposition.impl
-@[inherit_doc] scoped prefix:40 " ¬ " => Proposition.neg
+instance : HasAnd (Proposition Atom) := ⟨.and⟩
+instance : HasOr (Proposition Atom) := ⟨.or⟩
+instance : HasImp (Proposition Atom) := ⟨.imp⟩
+instance [Bot Atom] : HasNot (Proposition Atom) := ⟨.neg⟩
+
+omit [DecidableEq Atom] in
+@[grind =]
+lemma not_eq [Bot Atom] (A : Proposition Atom) : (A → ⊥) = ¬ A := rfl
 
 /-- Substitute each atom in a proposition for a proposition, possibly changing the atomic
 language. -/
@@ -79,7 +86,7 @@ def Proposition.subst {Atom Atom' : Type u} (f : Atom → Proposition Atom') :
   | atom x => f x
   | and A B => (A.subst f) ∧ (B.subst f)
   | or A B => (A.subst f) ∨ (B.subst f)
-  | impl A B => (A.subst f) → (B.subst f)
+  | imp A B => (A.subst f) → (B.subst f)
 
 -- This is probably a lawful monad, but that doesn't seem to be important.
 instance : Monad Proposition where
@@ -99,56 +106,43 @@ instance : Functor Theory where
   map f := Set.image (f <$> ·)
 
 /-- The empty theory corresponds to minimal propositional logic. -/
-abbrev MPL : Theory (Atom) := ∅
+abbrev MPL (Atom : Type u) : Theory (Atom) := ∅
 
 /-- Intuitionistic propositional logic adds the principle of explosion (ex falso quodlibet). -/
-abbrev IPL [Bot Atom] : Theory Atom :=
-  Set.range (⊥ → ·)
-
-/-- Classical logic further adds double negation elimination. -/
-abbrev CPL [Bot Atom] : Theory Atom :=
-  Set.range (fun (A : Proposition Atom) ↦ ¬¬A → A)
-
-/-- A theory is intuitionistic if it validates ex falso quodlibet. -/
-@[scoped grind]
-class IsIntuitionistic [Bot Atom] (T : Theory Atom) where
-  efq (A : Proposition Atom) : (⊥ → A) ∈ T
+abbrev IPL (Atom : Type u) [Bot Atom] : Theory Atom := {⊥ → A | A : Proposition Atom}
 
 omit [DecidableEq Atom] in
-@[scoped grind =]
-theorem isIntuitionisticIff [Bot Atom] (T : Theory Atom) : IsIntuitionistic T ↔ IPL ⊆ T := by grind
-
-/-- A theory is classical if it validates double-negation elimination. -/
-@[scoped grind]
-class IsClassical [Bot Atom] (T : Theory Atom) where
-  dne (A : Proposition Atom) : (¬¬A → A) ∈ T
-
-omit [DecidableEq Atom] in
-@[scoped grind =]
-theorem isClassicalIff [Bot Atom] (T : Theory Atom) : IsClassical T ↔ CPL ⊆ T := by grind
-
-instance instIsIntuitionisticIPL [Bot Atom] : IsIntuitionistic (Atom := Atom) IPL where
-  efq A := Set.mem_range.mpr ⟨A, rfl⟩
+lemma efq_mem_ipl [Bot Atom] (A : Proposition Atom) : (⊥ → A) ∈ IPL Atom := ⟨A, rfl⟩
 
-instance instIsClassicalCPL [Bot Atom] : IsClassical (Atom := Atom) CPL where
-  dne A := Set.mem_range.mpr ⟨A, rfl⟩
+/-- Attach a bottom element to a theory `T`, and the principle of explosion for that bottom. -/
+@[reducible]
+def intuitionisticCompletion (T : Theory Atom) : Theory (WithBot Atom) :=
+  (WithBot.some <$> T) ∪ IPL (WithBot Atom)
 
-omit [DecidableEq Atom] in
-@[scoped grind →]
-theorem instIsIntuitionisticExtention [Bot Atom] {T T' : Theory Atom} [IsIntuitionistic T]
-    (h : T ⊆ T') : IsIntuitionistic T' := by grind
+/-- Classical logic further adds double negation elimination. -/
+abbrev CPL (Atom : Type u) [Bot Atom] : Theory Atom := {¬¬A → A | A : Proposition Atom}
 
 omit [DecidableEq Atom] in
-@[scoped grind →]
-theorem instIsClassicalExtention [Bot Atom] {T T' : Theory Atom} [IsClassical T] (h : T ⊆ T') :
-    IsClassical T' := by grind
+lemma dne_mem_cpl [Bot Atom] (A : Proposition Atom) : (¬¬A → A) ∈ CPL Atom := ⟨A, rfl⟩
 
-/-- Attach a bottom element to a theory `T`, and the principle of explosion for that bottom. -/
-@[reducible]
-def intuitionisticCompletion (T : Theory Atom) : Theory (WithBot Atom) :=
-  (WithBot.some <$> T) ∪ IPL
+open InferenceSystem
 
-instance instIsIntuitionisticIntuitionisticCompletion (T : Theory Atom) :
-    IsIntuitionistic T.intuitionisticCompletion := by grind
+/-- An inference system is intuitionistic if it derives ex falso quodlibet. TODO: this should be
+generalised outside the `PL` scope, once we have typeclasses to express that a type possesses an
+implication connective. -/
+@[scoped grind]
+class IsIntuitionistic (Atom : Type u) [Bot Atom] (S : Type*)
+    [InferenceSystem S (Proposition Atom)] where
+  /-- The principle of explosion (ex falso quolibet). -/
+  efq (A : Proposition Atom) : S⇓(⊥ → A)
+
+/-- An inference system is classical if it validates double-negation elimination. TODO: this should
+be generalised outside the `PL` scope, once we have typeclasses to express that a type possesses an
+implication connective. -/
+@[scoped grind]
+class IsClassical (Atom : Type u) [Bot Atom] (S : Type*)
+    [InferenceSystem S (Proposition Atom)] where
+  /-- Double-negation elimination. -/
+  dne (A : Proposition Atom) : S⇓(¬¬A → A)
 
 end Cslib.Logic.PL.Theory
diff --git a/Cslib/Logics/Propositional/NaturalDeduction/Basic.lean b/Cslib/Logics/Propositional/NaturalDeduction/Basic.lean
index b1a8947e20..560ecb69e2 100644
--- a/Cslib/Logics/Propositional/NaturalDeduction/Basic.lean
+++ b/Cslib/Logics/Propositional/NaturalDeduction/Basic.lean
@@ -156,7 +156,7 @@ theorem Theory.equiv_iff {A B : Proposition Atom} :
     exact ⟨D, E⟩
 
 /-- Minimally equivalent propositions. -/
-abbrev Equiv : Proposition Atom → Proposition Atom → Prop := MPL.Equiv
+abbrev Equiv : Proposition Atom → Proposition Atom → Prop := (MPL Atom).Equiv
 
 @[inherit_doc]
 scoped infix:29 " ≡ " => Equiv
diff --git a/Cslib/Logics/Propositional/NaturalDeduction/Theory.lean b/Cslib/Logics/Propositional/NaturalDeduction/Theory.lean
new file mode 100644
index 0000000000..8cdaa806df
--- /dev/null
+++ b/Cslib/Logics/Propositional/NaturalDeduction/Theory.lean
@@ -0,0 +1,101 @@
+/-
+Copyright (c) 2025 Thomas Waring. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Thomas Waring
+-/
+module
+
+public import Cslib.Logics.Propositional.NaturalDeduction.Basic
+
+/-! # Results on propositional theories
+
+In this file we prove the expected results that `IPL Atom` is an intuitionistic theory, and
+`CPL Atom` is a classical theory. We provide derived rules for common intuitionistic and classical
+proof patterns.
+-/
+
+@[expose] public section
+
+universe u
+
+namespace Cslib.Logic.PL
+
+open Proposition Theory InferenceSystem DerivableIn Derivation IsIntuitionistic IsClassical
+
+variable {Atom : Type u} [DecidableEq Atom] [Bot Atom] {T : Theory Atom}
+
+namespace Theory
+
+instance instIsIntuitionisticIPL : IsIntuitionistic Atom (IPL Atom) where
+  efq A := ax (efq_mem_ipl A)
+
+/-- Derivation of efq in an arbitrary context. -/
+def IsIntuitionistic.efqCtx [IsIntuitionistic Atom T] (Γ : Ctx Atom) (A : Proposition Atom)
+    : T⇓(Γ ⊢ ⊥ → A) := (efq A : T⇓(⊥ → A)).weakCtx (Finset.empty_subset Γ)
+
+/-- Efq as a derived rule. -/
+def IsIntuitionistic.efqRule [IsIntuitionistic Atom T] (Γ : Ctx Atom) (A : Proposition Atom)
+    (D : T⇓(Γ ⊢ ⊥)) : T⇓(Γ ⊢ A) :=
+  implE (A := ⊥) (efqCtx Γ A) D
+
+/-- Prove any proposition from contradictory hypotheses. -/
+def IsIntuitionistic.contra [IsIntuitionistic Atom T] {Γ : Ctx Atom} (A B : Proposition Atom)
+    (hΓ : A ∈ Γ) (hΓ' : (¬A) ∈ Γ) : T⇓(Γ ⊢ B) :=
+  efqRule Γ B <| implE (ass hΓ') (ass hΓ)
+
+instance instIsClassicalCPL : IsClassical Atom (CPL Atom) where
+  dne A := ax (dne_mem_cpl A)
+
+/-- Proof by contradiction as a derived rule. -/
+def IsClassical.byContra [IsClassical Atom T] {Γ : Ctx Atom} {A : Proposition Atom}
+    (D : T⇓(insert (¬ A) Γ ⊢ ⊥)) : T⇓(Γ ⊢ A) :=
+  implE (A := ¬¬A) ((dne A : T⇓(¬¬A → A)) |>.weakCtx <| Finset.empty_subset ..) D.implI
+
+instance instIsIntuitionisticOfIsClassical [IsClassical Atom T] : IsIntuitionistic Atom T where
+  efq A := implI _ <| byContra <| ass (by grind)
+
+/-- Law of excluded middle in a classical theory. -/
+def IsClassical.lem [IsClassical Atom T] (A : Proposition Atom) : T⇓(A ∨ ¬ A) := by
+  apply byContra
+  apply implE (ass <| Finset.mem_insert_self ..)
+  apply orI₂; apply implI
+  apply implE (A := A ∨ ¬ A) (ass <| by grind)
+  exact orI₁ <| ass <| Finset.mem_insert_self ..
+
+/-- Pierce's law in a classical theory. -/
+def IsClassical.pierce [IsClassical Atom T] (A B : Proposition Atom) : T⇓(((A → B) → A) → A) := by
+  apply implI; apply byContra
+  apply implE (ass <| Finset.mem_insert_self ..)
+  apply implE (A := A → B) (ass <| by grind); apply implI
+  apply contra A B <;> grind
+
+/-- The axiom system consisting of instances of LEM. -/
+def LEM (Atom : Type u) [Bot Atom] : Theory Atom := {A ∨ ¬ A | A : Proposition Atom}
+
+omit [DecidableEq Atom] in
+lemma lem_mem_lem (A : Proposition Atom) : (A ∨ ¬ A) ∈ LEM Atom := ⟨A, rfl⟩
+
+/-- The axiom system consisting of instances of Pierce's law. -/
+def Pierce (Atom : Type u) : Theory Atom :=
+  {((A → B) → A) → A | (A : Proposition Atom) (B : Proposition Atom)}
+
+omit [DecidableEq Atom] [Bot Atom] in
+lemma pierce_mem_pierce (A B : Proposition Atom) : (((A → B) → A) → A) ∈ Pierce Atom := ⟨A, B, rfl⟩
+
+instance instIsClassicalLEM : IsClassical Atom (LEM Atom ∪ IPL Atom : Theory Atom) where
+  dne A := by
+    apply implI
+    apply orE (ax <| Set.mem_union_left _ <| lem_mem_lem A)
+    · exact ass (Finset.mem_insert_self A _)
+    · apply implE (A := ⊥) (ax <| Set.mem_union_right _ (efq_mem_ipl A))
+      apply implE (A := ¬ A) <;> exact ass (by grind)
+
+instance instIsClassicalPierce : IsClassical Atom (Pierce Atom ∪ IPL Atom : Theory Atom) where
+  dne A := by
+    apply implI
+    apply implE (A := (A → ⊥) → A) (ax <| Set.mem_union_left _ <| pierce_mem_pierce A ⊥)
+    apply implI
+    apply implE (A := ⊥) (ax <| Set.mem_union_right _ (efq_mem_ipl A))
+    apply implE (A := ¬ A) <;> exact ass (by grind)
+
+end Cslib.Logic.PL.Theory
diff --git a/Cslib/Logics/README.md b/Cslib/Logics/README.md
new file mode 100644
index 0000000000..5837889a01
--- /dev/null
+++ b/Cslib/Logics/README.md
@@ -0,0 +1,46 @@
+<pre>
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+</pre>
+
+# Logic
+
+CSLib offers **formal logics** for defining specifications and reasoning about programs and systems. Each subdirectory focuses on a specific logic or framework.
+
+Shared foundations can be found in [Foundations/Logic](../Foundations/Logic).
+
+## Principles
+
+### Operators
+
+Please instantiate and use the typeclasses for logical operators (connectives, modalities, etc.) found in [Foundations/Logic](../Foundations/Logic).
+
+### Inference system and logical equivalence
+
+We adopt a unified approach to proof systems and semantics, whereby they instantiate `InferenceSystem`. See [linear logic](LinearLogic) and [modal logic](Modal) for examples.
+
+When defining logical equivalence for a given inference system, instantiate `LogicalEquivalence`. This class also acts as a check that you use the correct APIs.
+
+### Proof relevance in proof systems
+
+A recurring choice when defining a proof system (like a sequent calculus) is whether they should go into `Prop` (proof irrelevance) or a `Type` (proof relevance).
+The default choice is to use a `Type` -- at the appropriate universe level, polymorphic if it has type parameters. This makes it easy to define computations on derivations, e.g., to compute their height, display them, or make tools that show how they can be transformed.
+
+### Fragments
+
+To define a fragment of a proof system, you can use a predicate. See [MLL](LinearLogic/CLL/MLL.lean) for an example.
+
+### Notation for judgements
+
+To avoid notation clashes in the notation for judgements, use a wrapper tag that clearly describes the logic. For example, in modal logic this is `Modal[m,w ⊨ φ]`.
+
+## Plans and notes
+
+### Logical equivalence
+
+We plan on leveraging the common infrastructure of `InferenceSystem`, `LogicalEquivalence`, and similar to build common interfaces for manipulating proofs.
+If any of these APIs do not suit your needs, we are interested in expanding them or creating new ones that can cover your use cases.
+
+### Notation
+
+We will explore alternative approaches to dealing with notation clashes. An example of a current shortcoming is the necessity of prefixing dynamic logic modalities with a `d`, because they use common notation such as `[...]`. One way of doing this could be to establish typeclasses/syntax also for judgemental notation, such as `m,w ⊨ φ`, and make it accessible within a tag like `Logic`, giving for example `Logic[m,w ⊨ φ]`. This would then scope the notation for propositions only to `φ`.
diff --git a/Cslib/MachineLearning/PACLearning/Defs.lean b/Cslib/MachineLearning/PACLearning/Defs.lean
index e51ceff1fd..2bbb32303e 100644
--- a/Cslib/MachineLearning/PACLearning/Defs.lean
+++ b/Cslib/MachineLearning/PACLearning/Defs.lean
@@ -516,9 +516,7 @@ theorem error_map_eq_hypothesisError (P : Measure α) (h c : Set α)
       (measurable_to_bool (by convert hc using 1; ext x; simp [decide_eq_true_eq]))
   rw [Measure.map_apply_of_aemeasurable hf.aemeasurable]
   · congr 1; ext x
-    simp only [Set.mem_preimage, Set.mem_setOf_eq, symmDiff_def, sup_eq_union,
-      Set.mem_union, Set.mem_diff]
-    by_cases hx : x ∈ h <;> by_cases hcx : x ∈ c <;> simp_all
+    by_cases hx : x ∈ h <;> simp_all [symmDiff_def]
   · convert (hh.prod (measurableSet_singleton false)).union
       (hh.compl.prod (measurableSet_singleton true)) using 1
     ext ⟨x, b⟩; cases b <;> simp
diff --git a/Cslib/MachineLearning/PACLearning/VCDimension.lean b/Cslib/MachineLearning/PACLearning/VCDimension.lean
index 3084b95629..8328f75447 100644
--- a/Cslib/MachineLearning/PACLearning/VCDimension.lean
+++ b/Cslib/MachineLearning/PACLearning/VCDimension.lean
@@ -59,12 +59,12 @@ theorem SetShatters.subset {C : ConceptClass α Bool} {W V : Set α}
     (hW : SetShatters C W) (hVW : V ⊆ W) : SetShatters C V := by
   intro V' hV'V
   obtain ⟨c, hc, hc_eq⟩ := hW (V' ∪ (W \ V))
-    (union_subset (hV'V.trans hVW) diff_subset)
+    (union_subset (hV'V.trans hVW) sdiff_subset)
   refine ⟨c, hc, ?_⟩
   rw [show V = W ∩ V from (inter_eq_self_of_subset_right hVW).symm,
     ← inter_assoc, hc_eq]
   ext x
-  simp only [mem_inter_iff, mem_union, mem_diff]
+  simp only [mem_inter_iff, mem_union, mem_sdiff]
   refine ⟨?_, fun h => ⟨Or.inl h, hV'V h⟩⟩
   rintro ⟨h1 | ⟨_, h2⟩, h3⟩
   · exact h1
diff --git a/Cslib/MachineLearning/PACLearning/VersionSpace.lean b/Cslib/MachineLearning/PACLearning/VersionSpace.lean
index 37f8072cf0..0b0665d97b 100644
--- a/Cslib/MachineLearning/PACLearning/VersionSpace.lean
+++ b/Cslib/MachineLearning/PACLearning/VersionSpace.lean
@@ -82,7 +82,7 @@ theorem versionSpace_empty_sample (C : ConceptClass α β)
     (S : LabeledSample α β 0) :
     VersionSpace C S = C := by
   ext h
-  refine ⟨fun hh => hh.1, fun hh => ⟨hh, fun i => i.elim0⟩⟩
+  exact ⟨fun hh => hh.1, fun hh => ⟨hh, fun i => i.elim0⟩⟩
 
 /-- *Version space reindexing.* For any reindexing `f : Fin m → Fin n`, the
 version space on `S` is contained in the version space on the reindexed sample
@@ -153,31 +153,8 @@ theorem mem_versionSpace_iff_empiricalError_zero
   unfold empiricalError empiricalMeasure error
   rcases Nat.eq_zero_or_pos m with hm | hm
   · subst hm
-    rw [dif_pos rfl]
-    simp only [Measure.coe_zero, Pi.zero_apply]
-    exact iff_of_true (fun i => i.elim0) trivial
-  · have hm_ne : m ≠ 0 := Nat.pos_iff_ne_zero.mp hm
-    have hm_inv_ne : (m : ℝ≥0∞)⁻¹ ≠ 0 :=
-      ENNReal.inv_ne_zero.mpr (ENNReal.natCast_ne_top m)
-    rw [dif_neg hm_ne, Measure.smul_apply, Measure.finsetSum_apply]
-    simp only [Measure.dirac_apply, Set.indicator, Set.mem_setOf_eq, Pi.one_apply,
-               smul_eq_mul]
-    rw [mul_eq_zero]
-    constructor
-    · intro hh
-      right
-      apply Finset.sum_eq_zero
-      intro i _
-      rw [if_neg]
-      intro hne
-      exact hne (hh i)
-    · rintro (h1 | h2)
-      · exact absurd h1 hm_inv_ne
-      · intro i
-        have hi := (Finset.sum_eq_zero_iff.mp h2) i (Finset.mem_univ i)
-        by_contra hne
-        rw [if_pos hne] at hi
-        exact one_ne_zero hi
+    simp
+  · simp_all [Nat.pos_iff_ne_zero]
 
 /-- The empirical 0-1 error equals the empirical miscount divided by the
 sample size. -/
@@ -188,9 +165,8 @@ theorem empiricalError_eq_div [DecidableEq β]
     empiricalError h S = (empiricalMiscount h S : ℝ≥0∞) / m := by
   have hm_ne : m ≠ 0 := hm.ne'
   unfold empiricalError empiricalMeasure error empiricalMiscount
-  rw [dif_neg hm_ne, Measure.smul_apply, Measure.finsetSum_apply]
-  simp only [Measure.dirac_apply, Set.indicator, Set.mem_setOf_eq, Pi.one_apply,
-             smul_eq_mul]
+  rw [dite_eq_right hm_ne, Measure.smul_apply, Measure.finsetSum_apply]
+  simp only [Measure.dirac_apply, Set.indicator, Set.mem_ofPred_eq, Pi.one_apply, smul_eq_mul]
   rw [Finset.sum_boole, ← ENNReal.div_eq_inv_mul]
 
 /-! ### Consistent Learners -/
@@ -276,7 +252,7 @@ private lemma pi_map_graph_eq_one
     (Measure.pi (fun _ : Fin m => P.map (fun x => (x, c x))))
       (Set.univ.pi (fun _ : Fin m => {p : α × β | p.2 = c p.1})) = 1 := by
   have hφ : Measurable (fun x : α => (x, c x)) := by fun_prop
-  haveI : IsProbabilityMeasure (P.map (fun x : α => (x, c x))) :=
+  have : IsProbabilityMeasure (P.map (fun x : α => (x, c x))) :=
     Measure.isProbabilityMeasure_map hφ.aemeasurable
   rw [Measure.pi_pi]
   simp [map_graph_eq_one hcm P hG]
@@ -293,14 +269,13 @@ theorem ae_mem_versionSpace_of_realizable
       ∂(Measure.pi (fun _ : Fin m => P.map (fun x => (x, c x)))),
       c ∈ VersionSpace C S := by
   have hφ : Measurable (fun x : α => (x, c x)) := by fun_prop
-  haveI : IsProbabilityMeasure (P.map (fun x : α => (x, c x))) :=
+  have : IsProbabilityMeasure (P.map (fun x : α => (x, c x))) :=
     Measure.isProbabilityMeasure_map hφ.aemeasurable
   rw [ae_iff]
   have hsub : {S : Fin m → α × β | ¬ c ∈ VersionSpace C S} ⊆
       (Set.univ.pi (fun _ : Fin m => {p : α × β | p.2 = c p.1}))ᶜ := by
     intro S hS hcontra
-    simp only [Set.mem_pi, Set.mem_univ, true_implies, Set.mem_setOf_eq] at hcontra
-    exact hS ⟨hc, fun i => (hcontra i).symm⟩
+    exact hS ⟨hc, by simp_all⟩
   have hcompl : (Measure.pi (fun _ : Fin m => P.map (fun x : α => (x, c x))))
       ((Set.univ.pi (fun _ : Fin m => {p : α × β | p.2 = c p.1}))ᶜ) = 0 := by
     rw [prob_compl_eq_one_sub (MeasurableSet.univ_pi fun _ => hG),
diff --git a/Cslib/MachineLearning/PACLearning/VersionSpaceLattice.lean b/Cslib/MachineLearning/PACLearning/VersionSpaceLattice.lean
new file mode 100644
index 0000000000..80ce34a2b4
--- /dev/null
+++ b/Cslib/MachineLearning/PACLearning/VersionSpaceLattice.lean
@@ -0,0 +1,112 @@
+/-
+Copyright (c) 2026 Dhruv Gupta. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Dhruv Gupta
+-/
+
+module
+
+public import Cslib.MachineLearning.PACLearning.VersionSpace
+public import Mathlib.Data.Fin.Tuple.Basic
+public import Mathlib.Data.Set.Card
+public import Mathlib.Data.Set.Finite.Powerset
+
+/-! # Version Space Lattice
+
+The collection of all version spaces of a concept
+class is a ∩-closed family with top `C`, the *version space lattice* of Mitchell (1982).
+
+## Main definitions
+
+- `VersionSpaces C`: the family of all version spaces of `C`, over samples of every size.
+
+## Main results
+
+- `versionSpace_append`: the version space of an appended sample is the intersection of
+  the version spaces.
+- `self_mem_versionSpaces`, `inter_mem_versionSpaces`: the family contains `C` (top) and
+  is closed under intersection.
+- `versionSpaces_subset_powerset`, `versionSpaces_finite`, `versionSpaces_ncard_le`: every
+  member is a subset of `C` and for a finite class the family is finite of size at most
+  `2 ^ C.ncard`.
+
+## References
+
+* [Mitchell1977]
+* [Mitchell1982]
+* [Mitchell1997]
+-/
+
+@[expose] public section
+
+open Set
+
+namespace Cslib.MachineLearning.PACLearning
+
+variable {α : Type*} {β : Type*}
+
+/-- *The version-space meet law.* The version space of an appended sample is the
+intersection of the version spaces of the two parts: constraints accumulate by
+intersection. -/
+theorem versionSpace_append {m n : ℕ} (C : ConceptClass α β)
+    (S : LabeledSample α β m) (T : LabeledSample α β n) :
+    VersionSpace C (Fin.append S T) = VersionSpace C S ∩ VersionSpace C T := by
+  ext h
+  constructor
+  · intro hh
+    refine ⟨⟨hh.1, fun i => ?_⟩, hh.1, fun i => ?_⟩
+    · have hi := hh.2 (Fin.castAdd n i)
+      rwa [Fin.append_left] at hi
+    · have hi := hh.2 (Fin.natAdd m i)
+      rwa [Fin.append_right] at hi
+  · rintro ⟨⟨hC, hS⟩, ⟨-, hT⟩⟩
+    refine ⟨hC, fun i => ?_⟩
+    refine Fin.addCases (fun j => ?_) (fun j => ?_) i
+    · rw [Fin.append_left]
+      exact hS j
+    · rw [Fin.append_right]
+      exact hT j
+
+/-- The family of all version spaces of a concept class, over labeled samples of every
+size. -/
+def VersionSpaces (C : ConceptClass α β) : Set (ConceptClass α β) :=
+  {V | ∃ (m : ℕ) (S : LabeledSample α β m), V = VersionSpace C S}
+
+/-- Membership in the version-space family unfolds to a witnessing sample. -/
+theorem mem_versionSpaces_iff {C V : ConceptClass α β} :
+    V ∈ VersionSpaces C ↔ ∃ (m : ℕ) (S : LabeledSample α β m), V = VersionSpace C S :=
+  Iff.rfl
+
+/-- The whole class is a version space (of the empty sample) which means the family has top `C`. -/
+theorem self_mem_versionSpaces (C : ConceptClass α β) : C ∈ VersionSpaces C :=
+  ⟨0, Fin.elim0, (versionSpace_empty_sample C Fin.elim0).symm⟩
+
+/-- The version-space family is closed under intersection (append the witnessing
+samples). -/
+theorem inter_mem_versionSpaces {C U V : ConceptClass α β}
+    (hU : U ∈ VersionSpaces C) (hV : V ∈ VersionSpaces C) :
+    U ∩ V ∈ VersionSpaces C := by
+  obtain ⟨m, S, rfl⟩ := hU
+  obtain ⟨n, T, rfl⟩ := hV
+  exact ⟨m + n, Fin.append S T, (versionSpace_append C S T).symm⟩
+
+/-- Every version space is a subset of the class: the family lives in the powerset
+of `C`. -/
+theorem versionSpaces_subset_powerset (C : ConceptClass α β) :
+    VersionSpaces C ⊆ 𝒫 C := by
+  rintro V ⟨m, S, rfl⟩
+  exact versionSpace_subset C S
+
+/-- A finite concept class has finitely many version spaces. -/
+theorem versionSpaces_finite {C : ConceptClass α β} (hC : C.Finite) :
+    (VersionSpaces C).Finite :=
+  hC.finite_subsets.subset (versionSpaces_subset_powerset C)
+
+/-- A finite concept class has at most `2 ^ C.ncard` version spaces: the lattice embeds
+in the powerset. -/
+theorem versionSpaces_ncard_le {C : ConceptClass α β} (hC : C.Finite) :
+    (VersionSpaces C).ncard ≤ 2 ^ C.ncard :=
+  (ncard_le_ncard (versionSpaces_subset_powerset C) hC.finite_subsets).trans_eq
+    (ncard_powerset C hC)
+
+end Cslib.MachineLearning.PACLearning
diff --git a/Cslib/Probability/PMF.lean b/Cslib/Probability/PMF.lean
index d20be22be2..8393eb2291 100644
--- a/Cslib/Probability/PMF.lean
+++ b/Cslib/Probability/PMF.lean
@@ -39,7 +39,7 @@ the Mathlib module instead.
 
 namespace Cslib.Probability.PMF
 
-open PMF ENNReal
+open ENNReal
 
 universe u v
 variable {α : Type u} {β : Type v}
diff --git a/CslibTests.lean b/CslibTests.lean
index 12bc0e4611..b62965a9c6 100644
--- a/CslibTests.lean
+++ b/CslibTests.lean
@@ -1,15 +1,20 @@
-module  -- shake: keep-all --deprecated_module: ignore
-
-public import CslibTests.Bisimulation
-public import CslibTests.CCS
-public import CslibTests.CLL
-public import CslibTests.DFA
-public import CslibTests.FreeMonad
-public import CslibTests.GrindLint
-public import CslibTests.HML
-public import CslibTests.HasFresh
-public import CslibTests.ImportWithMathlib
-public import CslibTests.LTS
-public import CslibTests.LambdaCalculus
-public import CslibTests.MLL
-public import CslibTests.Reduction
+import CslibTests.Bisimulation
+import CslibTests.CCS
+import CslibTests.CCS.VendingMachine
+import CslibTests.CLL
+import CslibTests.Congruence
+import CslibTests.DFA
+import CslibTests.FreeMonad
+import CslibTests.GrindLint
+import CslibTests.HML
+import CslibTests.HasFresh
+import CslibTests.HasSubstitution
+import CslibTests.HasWellFormed
+import CslibTests.ImportWithMathlib
+import CslibTests.InferenceSystem
+import CslibTests.LTS
+import CslibTests.LambdaCalculus
+import CslibTests.MLL
+import CslibTests.Modal
+import CslibTests.Reduction
+import CslibTests.StatefulProcesses
diff --git a/CslibTests/CCS.lean b/CslibTests/CCS.lean
index af98377051..6478b842b4 100644
--- a/CslibTests/CCS.lean
+++ b/CslibTests/CCS.lean
@@ -13,7 +13,7 @@ open Cslib
 open CCS Process
 
 @[lts ltsNat "ₙ"]
-def TrNat := @CCS.Tr ℕ ℕ (fun _ _ => False)
+def TrNat := @CCS.Tr ℕ ℕ (fun _ => none)
 
 def p : Process ℕ ℕ := (pre Act.τ (pre (Act.name 1) nil))
 
diff --git a/CslibTests/CCS/VendingMachine.lean b/CslibTests/CCS/VendingMachine.lean
new file mode 100644
index 0000000000..7771ec301a
--- /dev/null
+++ b/CslibTests/CCS/VendingMachine.lean
@@ -0,0 +1,17 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+import Cslib.Algorithms.CCS.VendingMachine
+
+namespace CslibTests
+
+open Cslib CCS Process Algorithms.CCS.VendingMachine
+
+/-- The deterministic vending machine can perform a coin action. -/
+example : ltsD.Tr vm Coin (choice (pre Tea (const .vm)) (pre Coffee (const .vm))) :=
+  Tr.const rfl Tr.pre
+
+end CslibTests
diff --git a/CslibTests/CLL.lean b/CslibTests/CLL.lean
index 55f15b98fc..3355b0ab15 100644
--- a/CslibTests/CLL.lean
+++ b/CslibTests/CLL.lean
@@ -13,6 +13,7 @@ namespace CslibTests
 I use `Proposition Nat` as the concrete instantiation for atoms.
 -/
 
+open Cslib
 open Cslib.Logic.CLL
 
 /-! ## Proposition construction tests -/
diff --git a/CslibTests/Congruence.lean b/CslibTests/Congruence.lean
new file mode 100644
index 0000000000..f28de54d32
--- /dev/null
+++ b/CslibTests/Congruence.lean
@@ -0,0 +1,20 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+import Cslib.Foundations.Syntax.Congruence
+
+namespace CslibTests
+
+open Cslib
+
+def myRel (n m : ℕ) := n = m
+
+instance : DefaultCongruence ℕ myRel := ⟨⟩
+
+example : (2 : ℕ) ≡ (2 : ℕ) := by rfl
+example : (2 : ℕ) ≡[myRel] (2 : ℕ) := by rfl
+
+end CslibTests
diff --git a/CslibTests/DFA.lean b/CslibTests/DFA.lean
index 09ccd69d70..c48ee1c1bb 100644
--- a/CslibTests/DFA.lean
+++ b/CslibTests/DFA.lean
@@ -15,12 +15,12 @@ open Cslib.Automata
 inductive Floor where
 | one
 | two
-deriving DecidableEq, Fintype
+deriving DecidableEq
 
 inductive Direction where
 | up
 | down
-deriving DecidableEq, Fintype
+deriving DecidableEq
 
 def elevator : DA Floor Direction where
   tr
diff --git a/CslibTests/GrindLint.lean b/CslibTests/GrindLint.lean
index 370e58db3a..70cce89a01 100644
--- a/CslibTests/GrindLint.lean
+++ b/CslibTests/GrindLint.lean
@@ -33,20 +33,23 @@ open_scoped_all Cslib
 #grind_lint skip Cslib.FinFun.fromFun_eq
 #grind_lint skip Cslib.FinFun.fromFun_idem
 #grind_lint skip Cslib.FinFun.fromFun_inter
-#grind_lint skip Cslib.LTS.deterministic_not_lto
-#grind_lint skip Cslib.LTS.deterministic_tr_image_singleton
+#grind_lint skip Cslib.LTS.DeterministicStateLabel.not_tr_of_ne
+#grind_lint skip Cslib.LTS.DeterministicStateLabel.image_singleton_iff_tr
 #grind_lint skip Cslib.LTS.Execution.refl
 #grind_lint skip Cslib.LTS.mem_saturate_image_τ
 #grind_lint skip Cslib.ωSequence.drop_const
 #grind_lint skip Cslib.ωSequence.get_cons_append_zero
 #grind_lint skip Cslib.ωSequence.map_id
 #grind_lint skip Cslib.Automata.DA.buchi_eq_finAcc_omegaLim
+#grind_lint skip Cslib.LTS.mapLabel_tr
 #grind_lint skip Cslib.LTS.MTr.stepL
 #grind_lint skip Cslib.LTS.STr.trans_τ
 #grind_lint skip Cslib.Automata.DA.FinAcc.toNAFinAcc_language_eq
 #grind_lint skip Cslib.Automata.NA.Buchi.reindex_language_eq
 #grind_lint skip Cslib.Automata.NA.FinAcc.toDAFinAcc_language_eq
 #grind_lint skip Cslib.Automata.εNA.FinAcc.toNAFinAcc_language_eq
+#grind_lint skip Cslib.Automata.εNA.FinAcc.toSingleAccept_tr_tr
+#grind_lint skip Cslib.Automata.εNA.FinAcc.toSingleAccept_not_tr_none
 #grind_lint skip Cslib.LambdaCalculus.LocallyNameless.Fsub.Sub.arrow
 #grind_lint skip Cslib.LambdaCalculus.LocallyNameless.Fsub.Sub.sum
 #grind_lint skip Cslib.LambdaCalculus.LocallyNameless.Fsub.Sub.trans_tvar
@@ -67,20 +70,19 @@ open_scoped_all Cslib
 #grind_lint skip Cslib.LambdaCalculus.LocallyNameless.Fsub.Env.Wf.sub
 #grind_lint skip Cslib.LambdaCalculus.LocallyNameless.Fsub.Env.Wf.ty
 #grind_lint skip Cslib.Logic.HML.bisimulation_satisfies
-#grind_lint skip Cslib.Logic.HML.Satisfies.diamond
 #grind_lint skip Cslib.LambdaCalculus.LocallyNameless.Untyped.Term.step_multiApp_l
 #adaptation_note
 /-- (changes from lean#13166) -/
 #grind_lint skip Cslib.ωLanguage.map_id
 #grind_lint skip Cslib.LTS.Bisimilarity.gfp
-#grind_lint skip Cslib.LTS.Bisimilarity.is_bisimulation
-#grind_lint skip Cslib.LTS.Bisimilarity.largest_bisimulation
+#grind_lint skip Cslib.LTS.Bisimilarity.isBisimulation
+#grind_lint skip Cslib.LTS.IsBisimulation.le_bisimilarity
 #grind_lint skip Cslib.LTS.IsBisimulation.bot
 #grind_lint skip Cslib.LTS.IsBisimulation.comp
 #grind_lint skip Cslib.LTS.IsBisimulation.inv
 #grind_lint skip Cslib.LTS.IsBisimulation.sup
 #grind_lint skip Cslib.LTS.IsBisimulation.traceEq
-#grind_lint skip Cslib.LTS.IsBisimulationUpTo.is_bisimulation
+#grind_lint skip Cslib.LTS.IsBisimulationUpTo.isBisimulation
 #grind_lint skip Cslib.Logic.HML.theoryEq_isBisimulation
 
 #guard_msgs in
diff --git a/CslibTests/HML.lean b/CslibTests/HML.lean
index 3e9346f2b8..b1a4fae2fa 100644
--- a/CslibTests/HML.lean
+++ b/CslibTests/HML.lean
@@ -5,15 +5,43 @@ Authors: Fabrizio Montesi
 -/
 
 import Cslib.Logics.HML.Basic
+import Cslib.Logics.HML.LogicalEquivalence
 import Cslib.Languages.CCS.Semantics
 
 namespace CslibTests
 
-open Cslib
-open CCS Logic.HML LTS
+open Cslib Logic HML LTS
 
 example [∀ p μ, Finite ((CCS.lts (defs := defs)).image p μ)] :
     TheoryEq (CCS.lts (defs := defs)) = HomBisimilarity (CCS.lts (defs := defs)) :=
   theoryEq_eq_bisimilarity ..
 
+section LogicalEquivalence
+
+/-
+The next example tests that logical equivalence can lift equivalences.
+
+We prove it twice. Once using our infrastructure for up-to context reasoning directly, and then
+with grind. Note that the grind proof works because Satisfies.and_iff_and gives a congruence
+principle on the satisfaction relation for the and-connective.
+-/
+
+open scoped InferenceSystem
+open Proposition
+
+example {State : Type u} {lts : LTS State Label} {s : State} {μ : Label} {φ₁ φ₂ : Proposition Label}
+    (h : ⇓HML[lts,s ⊨ (d⟨μ⟩φ₁) ∧ φ₂])
+    : ⇓HML[lts,s ⊨ (¬d[μ]¬φ₁) ∧ φ₂] := by
+  let pc : HasContext.Context (Proposition Label) := Context.andL .hole φ₂
+  have eqv := LawfulCongruence.covariant.elim pc (dual μ φ₁)
+  let jc : HasHContext.Context (Judgement State Label) (Proposition Label) :=
+    Judgement.Context.mk lts s
+  apply LogicalEquivalence.eqvFillValid eqv jc h
+
+example {State : Type u} {lts : LTS State Label} {s : State} {μ : Label} {φ₁ φ₂ : Proposition Label}
+    (h : ⇓HML[lts,s ⊨ (d⟨μ⟩φ₁) ∧ φ₂]) : ⇓HML[lts,s ⊨ (¬d[μ]¬φ₁) ∧ φ₂] := by
+  grind only [= Satisfies.and_iff_and, => equiv_iff, dual μ φ₁ lts]
+
+end LogicalEquivalence
+
 end CslibTests
diff --git a/CslibTests/HasFresh.lean b/CslibTests/HasFresh.lean
index 95ba08a128..aa1ccffadc 100644
--- a/CslibTests/HasFresh.lean
+++ b/CslibTests/HasFresh.lean
@@ -40,17 +40,21 @@ def g (_ : String) : Finset ℕ := {4, 5, 6}
 #guard_msgs in
 #check free_union [f, g] ℕ
 
+/-- info: ∅ ∪ {x} ∪ xs ∪ f var ∪ g var : Finset ℕ -/
+#guard_msgs in
+#check free_union +singleton +finset [f, g] ℕ
+
 /-- info: ∅ ∪ xs : Finset ℕ -/
 #guard_msgs in
-#check free_union (singleton := false) ℕ
+#check free_union -singleton ℕ
 
 /-- info: ∅ ∪ {x} : Finset ℕ -/
 #guard_msgs in
-#check free_union (finset := false) ℕ
+#check free_union -finset ℕ
 
 /-- info: ∅ : Finset ℕ -/
 #guard_msgs in
-#check free_union (singleton := false) (finset := false) ℕ
+#check free_union -singleton -finset ℕ
 
 end
 
diff --git a/CslibTests/HasSubstitution.lean b/CslibTests/HasSubstitution.lean
new file mode 100644
index 0000000000..d2b39682a6
--- /dev/null
+++ b/CslibTests/HasSubstitution.lean
@@ -0,0 +1,21 @@
+import Cslib.Foundations.Syntax.HasSubstitution
+
+namespace CslibTests
+namespace HasSubstitution
+
+/-- Regression test for leanprover/cslib#631.
+
+Before the notation was guarded by `noWs`, the parser tried to read the instance
+binder below as part of a substitution expression attached to `Type`.
+-/
+structure InstanceBinderAfterField where
+  A : Type
+  [inst : Inhabited A]
+
+instance : Cslib.HasSubstitution Nat Nat Nat where
+  subst t _ _ := t
+
+example : (1[2 := 3]) = 1 := rfl
+
+end HasSubstitution
+end CslibTests
diff --git a/CslibTests/HasWellFormed.lean b/CslibTests/HasWellFormed.lean
new file mode 100644
index 0000000000..e408cb3d2b
--- /dev/null
+++ b/CslibTests/HasWellFormed.lean
@@ -0,0 +1,26 @@
+/-
+Copyright (c) 2026 Sean D. Stoneburner. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sean D. Stoneburner
+-/
+import Cslib.Algorithms.Lean.TimeM
+import Cslib.Foundations.Syntax.HasWellFormed
+
+open Cslib.Algorithms.Lean
+
+/-!
+# Syntax Collision Test
+This file tests that the `✓` prefix macro from `TimeM` does not collide with
+the `✓` postfix notation from `HasWellFormed` across line breaks.
+-/
+
+def testParserCollision (n : Nat) : TimeM Nat Nat := do
+  let m := n
+  ✓ return m
+
+-- Ensure the postfix notation still functions correctly when attached without whitespace
+variable {α : Type*} [Cslib.HasWellFormed α] (x : α)
+
+/-- info: Cslib.HasWellFormed.wf x : Prop -/
+#guard_msgs in
+#check x✓
diff --git a/CslibTests/InferenceSystem.lean b/CslibTests/InferenceSystem.lean
new file mode 100644
index 0000000000..43bd6a9527
--- /dev/null
+++ b/CslibTests/InferenceSystem.lean
@@ -0,0 +1,25 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+import Cslib.Foundations.Logic.InferenceSystem
+
+namespace CslibTests
+
+open Cslib.Logic
+
+instance : HasInferenceSystem ℕ := ⟨fun _ => True⟩
+
+open scoped InferenceSystem
+
+-- Tests that the delaboration of `InferenceSystem.Default` in the `⇓` notation works.
+
+/-- info: ⇓5 : Prop -/
+#guard_msgs in
+#check ⇓5
+
+example : ⇓5 := by dsimp [InferenceSystem.derivation]
+
+end CslibTests
diff --git a/CslibTests/LambdaCalculus.lean b/CslibTests/LambdaCalculus.lean
index 1a331ea582..3315166941 100644
--- a/CslibTests/LambdaCalculus.lean
+++ b/CslibTests/LambdaCalculus.lean
@@ -1,42 +1,55 @@
 /-
 Copyright (c) 2025 Fabrizio Montesi. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Fabrizio Montesi
+Authors: Fabrizio Montesi, Haoxuan Yin
 -/
 
 import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic
+import Cslib.Languages.LambdaCalculus.Named.Untyped.Properties
 
+/-! # λ-calculus
 
+Tests for the named untyped λ-calculus.
 
-namespace CslibTests
-
-open Cslib LambdaCalculus.Named LambdaCalculus.Named.Term
-
-abbrev NatTerm := Term ℕ
-
-def lambdaId := abs 0 (var 0)
+-/
 
-example : (abs 0 (var 0)) =α (abs 1 (var 1)) := by
-  constructor
-  simp [Term.fv]
+namespace CslibTests
 
-example : (abs 1 (var 0)).subst 0 (app (var 1) (var 2)) = (abs 3 (app (var 1) (var 2))) := by
-  simp +instances [subst, fv, bv, vars, rename, instHasFreshNat, HasFresh.ofSucc]
+open Cslib Cslib.LambdaCalculus.Named.Untyped.Term
 
 def x := 0
 def y := 1
 def z := 2
 def w := 3
 
-attribute [simp] x y z w
+def lambdaId := abs x (var x)
 
-local instance coeNatTerm : Coe ℕ (Term ℕ) := ⟨Term.var⟩
+example : (abs x (var x)) =α (abs y (var y)) := by
+  have h : (abs y (var y)) = (abs y ((var x).rename x y)) := by grind [rename]
+  rw [h]
+  apply AlphaEquiv.abs_rename
+  simp only [vars]
+  decide
 
--- section 5.3.4 of TAPL
-example : (abs y (app x y))[x := (app y z : Term ℕ)] = (abs w (app (app y z) w)) := by
-  simp +instances [subst, fv, bv, vars, rename, instHasFreshNat, HasFresh.ofSucc,
-    instHasSubstitutionTerm]
+example : (abs y (var x)).subst x (app (var y) (var z)) = (abs w (app (var y) (var z))) := by
+  simp only [rename, subst, fv, vars]
+  decide
 
--- example : (abs 0 (abs 1 (app (var 0) (var 1)))) =α (abs 1 (abs 0 (app (var 1) (var 0)))) := by
+-- section 5.3.4 of TAPL
+example : (abs y (app (var x) (var y))).subst x (app (var y) (var z)) =
+    (abs w (app (app (var y) (var z)) (var w))) := by
+  simp only [subst, vars, rename]
+  decide
+
+example : (abs x (abs y (app (var x) (var y)))) =α (abs y (abs x (app (var y) (var x)))) := by
+  apply AlphaEquiv.abs (y := z)
+  · simp only [vars]
+    decide
+  simp only [rename]
+  apply AlphaEquiv.abs (y := w)
+  · simp only [vars]
+    decide
+  simp only [rename]
+  apply AlphaEquiv.refl
 
 end CslibTests
diff --git a/CslibTests/Modal.lean b/CslibTests/Modal.lean
new file mode 100644
index 0000000000..be9f5b8801
--- /dev/null
+++ b/CslibTests/Modal.lean
@@ -0,0 +1,78 @@
+/-
+Copyright (c) 2026 Samuel Schlesinger. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Samuel Schlesinger
+-/
+
+import Cslib.Logics.Modal.Cube
+
+namespace Cslib.Logic.Modal
+
+open scoped Proposition
+
+variable {World Atom : Type*} {φ : Proposition Atom}
+
+-- Compound modal logics contain conjunctions of the axioms validated by their combined frame
+-- conditions. Defining them as unions of the individual logics loses these conjunctions.
+
+example : ((◇◇φ → ◇φ) ∧ (◇φ → □◇φ) : Proposition Atom) ∈ K45 World Atom := by
+  intro m h w
+  let : IsTrans World m.r := h.1
+  let : Relation.RightEuclidean m.r := h.2
+  exact ⟨Satisfies.four φ, Satisfies.five φ⟩
+
+example : ((□φ → ◇φ) ∧ (◇◇φ → ◇φ) : Proposition Atom) ∈ D4 World Atom := by
+  intro m h w
+  let : Relation.Serial m.r := h.1
+  let : IsTrans World m.r := h.2
+  exact ⟨Satisfies.d φ, Satisfies.four φ⟩
+
+example : ((□φ → ◇φ) ∧ (◇φ → □◇φ) : Proposition Atom) ∈ D5 World Atom := by
+  intro m h w
+  let : Relation.Serial m.r := h.1
+  let : Relation.RightEuclidean m.r := h.2
+  exact ⟨Satisfies.d φ, Satisfies.five φ⟩
+
+example :
+    Proposition.and (□φ → ◇φ) (Proposition.and (◇◇φ → ◇φ) (◇φ → □◇φ)) ∈
+      D45 World Atom := by
+  intro m h w
+  let : Relation.Serial m.r := h.1
+  let : IsTrans World m.r := h.2.1
+  let : Relation.RightEuclidean m.r := h.2.2
+  exact ⟨Satisfies.d φ, Satisfies.four φ, Satisfies.five φ⟩
+
+example : ((□φ → ◇φ) ∧ (φ → □◇φ) : Proposition Atom) ∈ DB World Atom := by
+  intro m h w
+  let : Relation.Serial m.r := h.1
+  let : Std.Symm m.r := h.2
+  exact ⟨Satisfies.d φ, Satisfies.b φ⟩
+
+example : ((φ → ◇φ) ∧ (φ → □◇φ) : Proposition Atom) ∈ TB World Atom := by
+  intro m h w
+  let : Std.Refl m.r := h.1
+  let : Std.Symm m.r := h.2
+  exact ⟨Satisfies.t φ, Satisfies.b φ⟩
+
+example : ((φ → □◇φ) ∧ (◇φ → □◇φ) : Proposition Atom) ∈ KB5 World Atom := by
+  intro m h w
+  let : Std.Symm m.r := h.1
+  let : Relation.RightEuclidean m.r := h.2
+  exact ⟨Satisfies.b φ, Satisfies.five φ⟩
+
+example : ((φ → ◇φ) ∧ (◇◇φ → ◇φ) : Proposition Atom) ∈ S4 World Atom := by
+  intro m h w
+  let : Std.Refl m.r := h.1
+  let : IsTrans World m.r := h.2
+  exact ⟨Satisfies.t φ, Satisfies.four φ⟩
+
+example :
+    Proposition.and (φ → ◇φ) (Proposition.and (◇◇φ → ◇φ) (◇φ → □◇φ)) ∈
+      S5 World Atom := by
+  intro m h w
+  let : Std.Refl m.r := h.1
+  let : IsTrans World m.r := h.2.1
+  let : Relation.RightEuclidean m.r := h.2.2
+  exact ⟨Satisfies.t φ, Satisfies.four φ, Satisfies.five φ⟩
+
+end Cslib.Logic.Modal
diff --git a/CslibTests/Reduction.lean b/CslibTests/Reduction.lean
index 297830d36d..fdd55a97a1 100644
--- a/CslibTests/Reduction.lean
+++ b/CslibTests/Reduction.lean
@@ -1,4 +1,4 @@
-import Cslib.Foundations.Data.Relation
+import Cslib.Foundations.Relation.Attr
 
 namespace CslibTests
 
diff --git a/CslibTests/StatefulProcesses.lean b/CslibTests/StatefulProcesses.lean
new file mode 100644
index 0000000000..292a4cf794
--- /dev/null
+++ b/CslibTests/StatefulProcesses.lean
@@ -0,0 +1,74 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi
+-/
+
+import Cslib.Languages.StatefulProcesses.Basic
+import Cslib.Languages.StatefulProcesses.Network
+
+namespace CslibTests
+
+open Cslib.StatefulProcesses Cslib.Mech
+
+-- Notation
+
+example (x : Var) (e : Expr Var Val FunId) :
+    (`(SPpre|x ≔ e) : Prefix Pid Var Val FunId SelLabel) =
+    (Prefix.assign x e) := by
+  rfl
+
+example (x : Var) (e : Expr Var Val FunId) :
+    (`(SP|x ≔ e; 0) : Process Pid Var Val FunId SelLabel ProcName) =
+    Process.pre (Prefix.assign x e) 0 := by
+  rfl
+
+-- Semantics
+
+open Cslib
+open Cslib.StatefulProcesses.Network
+
+section Hello
+
+/-!
+A simple example where "p" sends the string `"Hello"` to "q".
+-/
+
+/-- A simple stringified process type. -/
+abbrev HelloProcess := Process String String String String String String
+
+/-- A simple stringified network type. -/
+abbrev HelloNetwork := Network String String String String String String
+
+def helloNet : HelloNetwork := fun p =>
+  if p = "p" then `(SP|"q"!"Hello"; 0)
+  else if p = "q" then `(SP|"p"?"x"; 0)
+  else 0
+
+/-- A simple stringified configuration type. -/
+abbrev HelloCfg := Cfg String String String String String String
+
+def helloCfg : HelloCfg where
+  net := helloNet
+  store := fun _ => fun _ => ""
+
+def stringIsTrue (s : String) := s == "true"
+
+/-- All functions evaluate to "⊥". -/
+def HelloEval : FunCallEval String String := fun _ _ v => v = "⊥"
+
+def helloLts : LTS HelloCfg (Cfg.TrLabel String String String) := Cfg.lts stringIsTrue HelloEval
+
+-- Example transition.
+-- This is begging for more automation.
+example : helloLts.Tr helloCfg (.com "p" "q" "Hello")
+    (Cfg.mk 0 (helloCfg.store[("q", "x") := "Hello"])) := by
+  apply Cfg.Tr.com (heval := by constructor) (hstore := rfl)
+  apply Network.Tr.com (by constructor) (by constructor)
+  ext p
+  simp only [Pi.zero_apply, helloCfg, HasSubstitution.subst]
+  grind [helloNet]
+
+end Hello
+
+end CslibTests
diff --git a/GOVERNANCE.md b/GOVERNANCE.md
index 200340c6e7..8ffbf3d3ca 100644
--- a/GOVERNANCE.md
+++ b/GOVERNANCE.md
@@ -23,7 +23,7 @@ The maintainer team is responsible for the quality of the codebase, establishing
 
 ### Lead maintainer
 
-The lead maintainer coordinates the overall work of the maintainer team and oversees the project's repositories.
+The lead maintainer coordinates the maintainer team's overall work and oversees the project's repositories.
 
 - Fabrizio Montesi (@fmontesi), FORM, University of Southern Denmark and Danish Institute for Advanced Study.
 
@@ -31,7 +31,7 @@ The lead maintainer coordinates the overall work of the maintainer team and over
 
 Technical leads guide long-term developments that may span multiple areas of the codebase, offering specialised expertise.
 
-- Alexandre Rademaker (@arademaker), Atlas Computing and Getulio Vargas Foundation.
+- Alexandre Rademaker (@arademaker), Renaissance Philanthropy and Getulio Vargas Foundation.
 - Sorrachai Yingchareonthawornchai (@sorrachai), ETH Zurich.
 
 ### Area maintainers
@@ -40,6 +40,8 @@ Area maintainers are trusted contributors who take ownership of specific areas o
 
 - Chris Henson (@chenson2018), Drexel University. Areas: Lambda calculus, metaprogramming.
 - Kim Morrison (@kim-em), Lean FRO. Areas: Continuous Integration and Deployment (CI/CD) with upstream (Lean, mathlib).
+- Alexandre Rademaker (@arademaker), Atlas Computing and Getulio Vargas Foundation. Areas: logic.
+- Sorrachai Yingchareonthawornchai (@sorrachai), ETH Zurich. Areas: algorithms and data structures.
 
 ### Reviewers
 
diff --git a/ORGANISATION.md b/ORGANISATION.md
index a2c4edfca6..33e522ef9d 100644
--- a/ORGANISATION.md
+++ b/ORGANISATION.md
@@ -1,6 +1,8 @@
 # Code organisation
 
-This document gives an overview of how the codebase is structured, in terms of directories.
+This document gives an overview of how the codebase is structured, in terms of directories. 
+
+For more details about the high-level principles that govern these directories, please refer to their internal `README.md` files when present.
 
 **Note** that this organisation is still under active discussion and is subject to change.
 
diff --git a/lake-manifest.json b/lake-manifest.json
index 99fff5ea9d..9729be4580 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -5,17 +5,17 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "d90090f647cae4f4ad4da99c0ac8bab2ca8c34ab",
+   "rev": "29e01041a56962fc26f2a81f09da3243c79afc4e",
    "name": "mathlib",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "d90090f647cae4f4ad4da99c0ac8bab2ca8c34ab",
+   "inputRev": "29e01041a56962fc26f2a81f09da3243c79afc4e",
    "inherited": false,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/plausible",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "744117af710b1c0400cd297c9ce91f8d0ad3a347",
+   "rev": "38e9c3ce15cbb63c92e90bb9a92e4eb82131f669",
    "name": "plausible",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -25,7 +25,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843",
+   "rev": "2bc7cf064315b26bc38dac2e9612fb581be9b75f",
    "name": "LeanSearchClient",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -35,7 +35,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "99c763c8a96d3d44fb4994e96eaa51ca4568449d",
+   "rev": "978b7ec9fbbf9a535114f1de8fe5b3778b358870",
    "name": "importGraph",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -45,50 +45,50 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "1537e3fc7e680d64e06fe5fb95c4c9edee7941c2",
+   "rev": "99e8adeea3c3cd86b6b79ba01a1383bf2d31d055",
    "name": "proofwidgets",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v0.0.101",
+   "inputRev": "main",
    "inherited": true,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/aesop",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "7897ea6e5cfc6522d355083bdfa798377ab35e11",
+   "rev": "c1c4362a130f12e632d252180a6c2a31d8fd4726",
    "name": "aesop",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.31.0-rc2",
+   "inputRev": "master",
    "inherited": true,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover-community/quote4",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "94346b7b49c36ae871639d1434232f057c193d60",
+   "rev": "3b55e9d00c6b0018e5d984eb011b6f93c09bd163",
    "name": "Qq",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.31.0-rc2",
+   "inputRev": "master",
    "inherited": true,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover-community/batteries",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "460b61adc7d183e43db2b99ac6c1dede9f7a76df",
+   "rev": "36cc05ca2d0e469bfbeea9437f460e19238e885e",
    "name": "batteries",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.31.0-rc2",
+   "inputRev": "main",
    "inherited": true,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover/lean4-cli",
    "type": "git",
    "subDir": null,
    "scope": "leanprover",
-   "rev": "baf3e62fbb3502305076ca077e004aea78157c63",
+   "rev": "af8bc067a4cc6c6df472a68909a3f40b1c76c43e",
    "name": "Cli",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.31.0-rc2",
+   "inputRev": "v4.34.0-rc1",
    "inherited": true,
    "configFile": "lakefile.toml"}],
  "name": "cslib",
diff --git a/lakefile.toml b/lakefile.toml
index 79a2ff1a8b..768d8abb45 100644
--- a/lakefile.toml
+++ b/lakefile.toml
@@ -18,16 +18,14 @@ weak.linter.unicodeLinter = false
 [[require]]
 name = "mathlib"
 scope = "leanprover-community"
-rev = "d90090f647cae4f4ad4da99c0ac8bab2ca8c34ab"
+rev = "29e01041a56962fc26f2a81f09da3243c79afc4e"
 
 [[lean_lib]]
 name = "Cslib"
-globs = ["Cslib.*"]
 
 [[lean_lib]]
 name = "CslibTests"
-globs = ["CslibTests.+"]
-moreLeanArgs = ["-Dweak.linter.style.header=false"]
+leanOptions = {weak.linter.style.header = false}
 
 [[lean_exe]]
 name = "checkInitImports"
diff --git a/lean-toolchain b/lean-toolchain
index e6a8c3c1fa..75def60936 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.31.0-rc2
+leanprover/lean4:v4.34.0-rc1
diff --git a/references.bib b/references.bib
index 973371b652..d2a7dfb130 100644
--- a/references.bib
+++ b/references.bib
@@ -1,3 +1,13 @@
+@misc{Acclavio2026,
+      title={Choreographic Programming: a Semantic Approach}, 
+      author={Matteo Acclavio and Giulia Manara and Fabrizio Montesi and Xueying Qin},
+      year={2026},
+      eprint={2607.23793},
+      archivePrefix={arXiv},
+      primaryClass={cs.PL},
+      url={https://arxiv.org/abs/2607.23793}, 
+}
+
 @inproceedings{Aceto1999,
   author       = {Luca Aceto and
                   Anna Ing{\'{o}}lfsd{\'{o}}ttir},
@@ -19,6 +29,19 @@ @inproceedings{Aceto1999
   bibsource    = {dblp computer science bibliography, https://dblp.org}
 }
 
+@article{AlpernSchneider1985,
+  author    = {Alpern, Bowen and Schneider, Fred B.},
+  title     = {Defining liveness},
+  journal   = {Information Processing Letters},
+  volume    = {21},
+  number    = {4},
+  pages     = {181--185},
+  year      = {1985},
+  issn      = {0020-0190},
+  doi       = {10.1016/0020-0190(85)90056-0},
+  url       = {https://www.sciencedirect.com/science/article/pii/0020019085900560}
+}
+
 @article{AngluinLaird1988,
   author       = {Angluin, Dana and Laird, Philip},
   title        = {Learning from Noisy Examples},
@@ -149,6 +172,26 @@ @article{ FLP1985
   numpages  = {9}
 }
 
+@article{Gabbay2002,
+author = {Gabbay, Murdoch J. and Pitts, Andrew M.},
+title = {A New Approach to Abstract Syntax with Variable Binding},
+year = {2002},
+issue_date = {Jul 2002},
+publisher = {Springer-Verlag},
+address = {Berlin, Heidelberg},
+volume = {13},
+number = {3–5},
+issn = {0934-5043},
+url = {https://doi.org/10.1007/s001650200016},
+doi = {10.1007/s001650200016},
+abstract = {The permutation model of set theory with atoms (FM-sets), devised by Fraenkel and Mostowski in the 1930s, supports notions of ‘name-abstraction’ and ‘fresh name’ that provide a new way to represent, compute with, and reason about the syntax of formal systems involving variable-binding operations. Inductively defined FM-sets involving the name-abstraction set former (together with Cartesian product and disjoint union) can correctly encode syntax modulo renaming of bound variables. In this way, the standard theory of algebraic data types can be extended to encompass signatures involving binding operators. In particular, there is an associated notion of structural recursion for defining syntax-manipulating functions (such as capture avoiding substitution, set of free variables, etc.) and a notion of proof by structural induction, both of which remain pleasingly close to informal practice in computer science.},
+journal = {Form. Asp. Comput.},
+month = jul,
+pages = {341–363},
+numpages = {23},
+keywords = {Keywords: Abstract syntax; Alpha-conversion; Permutation actions; Set theory; Structural induction}
+}
+
 @article{        Girard1987,
   title={Linear logic},
   author={Girard, Jean-Yves},
@@ -470,3 +513,41 @@ @book{Mitchell1997
   publisher    = {McGraw-Hill},
   isbn         = {0070428077}
 }
+@mastersthesis{Calisto2022,
+  author       = {Calisto, Bruna},
+  title        = {Formalization in {Coq} of the {Standardization Theorem} for {$\lambda$}-calculus},
+  school       = {Universidade do Minho},
+  year         = {2022}
+}
+
+@book{Sipser2013,
+  author    = {Sipser, Michael},
+  title     = {Introduction to the Theory of Computation},
+  edition   = {3rd},
+  publisher = {Cengage Learning},
+  year      = {2013}
+}
+
+@mastersthesis{Copes2018,
+  author       = {Copes, Martín},
+  title        = {A machine-checked proof of the Standardization Theorem 
+                  in Lambda Calculus using multiple substitution},
+  school       = {Universidad ORT Uruguay},
+  year         = {2018}
+}
+
+@book{AroraBarak09,
+  author       = {Sanjeev Arora and
+                  Boaz Barak},
+  title        = {Computational Complexity - {A} Modern Approach},
+  publisher    = {Cambridge University Press},
+  year         = {2009},
+}
+
+@book{Papadimitriou94,
+  title={Computational Complexity},
+  author={Papadimitriou, Christos H.},
+  year={1994},
+  publisher={Addison-Wesley},
+  address={Reading, Massachusetts}
+}
diff --git a/scripts/bench/README.md b/scripts/bench/README.md
index 2eca796a48..12285bbd05 100644
--- a/scripts/bench/README.md
+++ b/scripts/bench/README.md
@@ -5,13 +5,13 @@ It is built around [radar](github.com/leanprover/radar)
 and benchmark results can be viewed
 on the [Lean FRO radar instance](https://radar.lean-lang.org/repos/cslib).
 
-To execute the entire suite, run `scripts/bench/run` in the repo root.
-To execute an individual benchmark, run `scripts/bench/<benchmark>/run` in the repo root.
-All scripts output their measurements into the file `measurements.jsonl`.
+To execute the benchmark suite, run `scripts/bench/run` from the repo root.
+All measurements will be placed into `measurements.jsonl` in the repo root.
 
 Radar sums any duplicated measurements with matching metrics.
-To post-process the `measurements.jsonl` file this way in-place,
-run `scripts/bench/combine.py` in the repo root after executing the benchmark suite.
+To post-process the `measurements.jsonl` file this way,
+run `scripts/bench/combine.py measurements.jsonl -o measurements_combined.jsonl`
+in the repo root after executing the benchmark suite.
 
 The `*.py` symlinks exist only so the python files are a bit nicer to edit
 in text editors that rely on the file ending.
@@ -23,3 +23,10 @@ To add a benchmark to the suite, follow these steps:
 1. Create a new folder containing a `run` script and a `README.md` file describing the benchmark,
    as well as any other files required for the benchmark.
 2. Edit `scripts/bench/run` to call the `run` script of your new benchmark.
+
+The following environment variables are available to an individual benchmark's `run` script:
+
+- `ROOT_DIR`: absolute path to the root of the repo
+- `BENCH_DIR`: absolute path to this directory (`scripts/bench`).
+- `OUTPUT_FILE`: absolute path to the `measurements.jsonl` file
+  that benchmarks should append their measurements to
diff --git a/scripts/bench/build/README.md b/scripts/bench/build/README.md
index 5292e925d2..7a37466b5d 100644
--- a/scripts/bench/build/README.md
+++ b/scripts/bench/build/README.md
@@ -1,6 +1,6 @@
 # The `build` benchmark
 
-This benchmark executes a complete build of cslib and collects global and per-module metrics.
+This benchmark executes a complete build and collects global and per-module metrics.
 
 The following metrics are collected by a wrapper around the entire build process:
 
@@ -9,7 +9,7 @@ The following metrics are collected by a wrapper around the entire build process
 - `build//task-clock`
 - `build//wall-clock`
 
-The following metrics are collected from `leanc --profile` and summed across all modules:
+The following metrics are collected from `lean --profile` and summed across all modules:
 
 - `build/profile/<name>//wall-clock`
 
@@ -18,10 +18,15 @@ The following metrics are collected from `lakeprof report`:
 - `build/lakeprof/longest build path//wall-clock`
 - `build/lakeprof/longest rebuild path//wall-clock`
 
+The following metrics are collected from a combination of `lakeprof report` and the per-module instructions:
+
+- `build/lakeprof/longest build path//instructions`
+- `build/lakeprof/longest rebuild path//instructions`
+
 The following metrics are collected individually for each module:
 
 - `build/module/<name>//lines`
 - `build/module/<name>//instructions`
 
-If the file `build_upload_lakeprof_report` is present in the repo root,
-the lakeprof report will be uploaded once the benchmark run concludes.
+If the `LAKEPROF_UPLOAD_URL` environment variable is set,
+the lakeprof report will be uploaded to that URL prefix once the benchmark run concludes.
diff --git a/scripts/bench/build/fake-root/bin/lean b/scripts/bench/build/fake-root/bin/lean
index 8d2b778e65..2ce14c08b2 100755
--- a/scripts/bench/build/fake-root/bin/lean
+++ b/scripts/bench/build/fake-root/bin/lean
@@ -2,22 +2,29 @@
 
 import argparse
 import json
+import os
 import re
 import subprocess
 import sys
 from pathlib import Path
 
-NAME = "build"
-REPO = Path()
-BENCH = REPO / "scripts" / "bench"
-OUTFILE = REPO / "measurements.jsonl"
+# Global paths
+BENCH_DIR = Path(os.environ["BENCH_DIR"])
+WRAPPER_OUT = Path(os.environ["WRAPPER_OUT"])
+WRAPPER_PREFIX = Path(os.environ["WRAPPER_PREFIX"])
 
+# Other config
+BENCHMARK = "build"
 
-def save_result(metric: str, value: float, unit: str | None = None) -> None:
+sys.path.append(str(BENCH_DIR))
+import measure  # noqa: E402
+
+
+def save_measurement(metric: str, value: float, unit: str | None = None) -> None:
     data = {"metric": metric, "value": value}
     if unit is not None:
         data["unit"] = unit
-    with open(OUTFILE, "a+") as f:
+    with open(WRAPPER_OUT, "a") as f:
         f.write(f"{json.dumps(data)}\n")
 
 
@@ -27,15 +34,6 @@ def run(*command: str) -> None:
         sys.exit(result.returncode)
 
 
-def run_stderr(*command: str) -> str:
-    result = subprocess.run(command, capture_output=True, encoding="utf-8")
-    if result.returncode != 0:
-        print(result.stdout, end="", file=sys.stdout)
-        print(result.stderr, end="", file=sys.stderr)
-        sys.exit(result.returncode)
-    return result.stderr
-
-
 def get_module(setup: Path) -> str:
     with open(setup) as f:
         return json.load(f)["name"]
@@ -44,33 +42,33 @@ def get_module(setup: Path) -> str:
 def count_lines(module: str, path: Path) -> None:
     with open(path) as f:
         lines = sum(1 for _ in f)
-    save_result(f"{NAME}/module/{module}//lines", lines)
+    save_measurement(f"{BENCHMARK}/module/{module}//lines", lines)
 
 
 def run_lean(module: str) -> None:
-    stderr = run_stderr(
-        f"{BENCH}/measure.py",
-        *("-t", f"{NAME}/module/{module}"),
-        *("-m", "instructions"),
-        "--",
-        *("lean", "--profile", "-Dprofiler.threshold=9999999"),
-        *sys.argv[1:],
+    _, stderr = measure.main(
+        cmd=["lean", "--profile", "-Dprofiler.threshold=9999999", *sys.argv[1:]],
+        output=WRAPPER_OUT,
+        topics=[f"{BENCHMARK}/module/{module}"],
+        metrics={"instructions"},
+        append=True,
+        capture=True,
     )
 
+    # Output of `lean --profile`
+    # See timeit.cpp for the time format
     for line in stderr.splitlines():
-        # Output of `lean --profile`
-        # See timeit.cpp for the time format
         if match := re.fullmatch(r"\t(.*) ([\d.]+)(m?s)", line):
             name = match.group(1)
             seconds = float(match.group(2))
             if match.group(3) == "ms":
                 seconds = seconds / 1000
-            save_result(f"{NAME}/profile/{name}//wall-clock", seconds, "s")
+            save_measurement(f"{BENCHMARK}/profile/{name}//wall-clock", seconds, "s")
 
 
 def main() -> None:
     if sys.argv[1:] == ["--print-prefix"]:
-        print(Path(__file__).resolve().parent.parent)
+        print(WRAPPER_PREFIX)
         return
 
     if sys.argv[1:] == ["--githash"]:
diff --git a/scripts/bench/build/lakeprof_measurements.py b/scripts/bench/build/lakeprof_measurements.py
new file mode 100755
index 0000000000..db97dcb3bd
--- /dev/null
+++ b/scripts/bench/build/lakeprof_measurements.py
@@ -0,0 +1,84 @@
+#!/usr/bin/env python3
+
+# Derives the `build/lakeprof/*` measurements from `lakeprof report` and the
+# existing contents of the measurements file. The results are appended back onto
+# the measurements file.
+#
+# Must be run from the src dir so that lakeprof can collect the metadata it
+# needs.
+
+import argparse
+import json
+import re
+import subprocess
+import sys
+from dataclasses import dataclass
+from pathlib import Path
+
+
+def save_measurement(
+    output: Path, metric: str, value: float, unit: str | None = None
+) -> None:
+    data = {"metric": metric, "value": value}
+    if unit is not None:
+        data["unit"] = unit
+    with open(output, "a") as f:
+        f.write(f"{json.dumps(data)}\n")
+
+
+def load_instructions_per_module(output: Path) -> dict[str, float]:
+    pattern = re.compile(r"build/module/(.*)//instructions")
+    instructions: dict[str, float] = {}
+    with open(output) as f:
+        for line in f:
+            data = json.loads(line)
+            if match := pattern.fullmatch(data["metric"]):
+                instructions[match.group(1)] = data["value"]
+    return instructions
+
+
+@dataclass
+class Row:
+    time: float
+    time_frac: float
+    cum_time: float
+    cum_time_frac: float
+    module: str
+
+
+def lakeprof_report(*args: str) -> list[Row]:
+    result = subprocess.run(
+        ["lakeprof", "report", *args, "-j"], capture_output=True, encoding="utf-8"
+    )
+    if result.returncode != 0:
+        print(result.stdout, end="", file=sys.stdout)
+        print(result.stderr, end="", file=sys.stderr)
+        sys.exit(result.returncode)
+    return [Row(*row) for row in json.loads(result.stdout)]
+
+
+def main() -> None:
+    parser = argparse.ArgumentParser()
+    parser.add_argument("out", type=Path)
+    args = parser.parse_args()
+    out: Path = args.out
+
+    instructions = load_instructions_per_module(out)
+
+    for flag, name in [("-p", "longest build path"), ("-r", "longest rebuild path")]:
+        rows = lakeprof_report(flag)
+
+        # Total wall-clock time, as reported by lakeprof
+        save_measurement(
+            out, f"build/lakeprof/{name}//wall-clock", rows[-1].cum_time, "s"
+        )
+
+        # Total instructions, computed from lakeprof's modules and our own measurements
+        total_instructions = sum(instructions.get(row.module, 0) for row in rows)
+        save_measurement(
+            out, f"build/lakeprof/{name}//instructions", total_instructions
+        )
+
+
+if __name__ == "__main__":
+    main()
diff --git a/scripts/bench/build/lakeprof_report_upload.py b/scripts/bench/build/lakeprof_report_upload.py
index e49627b628..450887df8d 100644
--- a/scripts/bench/build/lakeprof_report_upload.py
+++ b/scripts/bench/build/lakeprof_report_upload.py
@@ -1,16 +1,23 @@
 #!/usr/bin/env python3
 
 import json
+import os
 import subprocess
 import sys
 from pathlib import Path
 
+upload_url = os.environ.get("LAKEPROF_UPLOAD_URL")
+if not upload_url:
+    sys.exit(0)
+if upload_url.endswith("/"):
+    upload_url = upload_url[:-1]
 
-def run(*args: str) -> None:
-    subprocess.run(args, check=True)
+# Determine paths
+template_file = Path(__file__).with_name("lakeprof_report_template.html")
+root_dir = Path(os.environ["ROOT_DIR"])
 
 
-def run_stdout(*command: str, cwd: str | None = None) -> str:
+def run_stdout(*command: str, cwd: Path | None = None) -> str:
     result = subprocess.run(command, capture_output=True, encoding="utf-8", cwd=cwd)
     if result.returncode != 0:
         print(result.stdout, end="", file=sys.stdout)
@@ -19,26 +26,20 @@ def run_stdout(*command: str, cwd: str | None = None) -> str:
     return result.stdout
 
 
-def main() -> None:
-    script_file = Path(__file__)
-    template_file = script_file.parent / "lakeprof_report_template.html"
+sha = run_stdout("git", "rev-parse", "@", cwd=root_dir).strip()
+base_url = f"{upload_url}/{sha}"
+report = run_stdout("lakeprof", "report", "-prc", cwd=root_dir)
 
-    sha = run_stdout("git", "rev-parse", "@").strip()
-    base_url = f"https://speed.lean-lang.org/cslib-out/{sha}"
-    report = run_stdout("lakeprof", "report", "-prc")
-    with open(template_file) as f:
-        template = f.read()
+template = template_file.read_text()
+template = template.replace("__BASE_URL__", json.dumps(base_url))
+template = template.replace("__LAKEPROF_REPORT__", report)
+(root_dir / "index.html").write_text(template)
 
-    template = template.replace("__BASE_URL__", json.dumps(base_url))
-    template = template.replace("__LAKEPROF_REPORT__", report)
 
-    with open("index.html", "w") as f:
-        f.write(template)
+def upload(file: Path) -> None:
+    subprocess.run(["curl", "-fT", file, f"{base_url}/{file.name}"], check=True)
 
-    run("curl", "-T", "index.html", f"{base_url}/index.html")
-    run("curl", "-T", "lakeprof.log", f"{base_url}/lakeprof.log")
-    run("curl", "-T", "lakeprof.trace_event", f"{base_url}/lakeprof.trace_event")
 
-
-if __name__ == "__main__":
-    main()
+upload(root_dir / "index.html")
+upload(root_dir / "lakeprof.log")
+upload(root_dir / "lakeprof.trace_event")
diff --git a/scripts/bench/build/run b/scripts/bench/build/run
index 39d34b2478..d20a8f7002 100755
--- a/scripts/bench/build/run
+++ b/scripts/bench/build/run
@@ -1,23 +1,17 @@
 #!/usr/bin/env bash
 set -euxo pipefail
 
-BENCH="scripts/bench"
-
 # Prepare build
 lake exe cache get
 
 # Run build
-LAKE_OVERRIDE_LEAN=true LEAN=$(realpath "$BENCH/build/fake-root/bin/lean") \
-  "$BENCH/measure.py" -t build \
-  -m instructions -m maxrss -m task-clock -m wall-clock -- \
+LAKE_OVERRIDE_LEAN=true \
+  LEAN="$BENCH_DIR/build/fake-root/bin/lean" \
+  WRAPPER_OUT="$OUTPUT_FILE" \
+  WRAPPER_PREFIX="$BENCH_DIR/build/fake-root" \
+  "$BENCH_DIR/measure.py" -t build -d -a -o "$OUTPUT_FILE" -- \
   lakeprof record lake build --no-cache
 
 # Analyze lakeprof data
-lakeprof report -pj | jq -c '{metric: "build/lakeprof/longest build path//wall-clock", value: .[-1][2], unit: "s"}' >> measurements.jsonl
-lakeprof report -rj | jq -c '{metric: "build/lakeprof/longest rebuild path//wall-clock", value: .[-1][2], unit: "s"}' >> measurements.jsonl
-
-# Upload lakeprof report
-# Guarded to prevent accidental uploads (which wouldn't work anyways) during local runs.
-if [ -f build_upload_lakeprof_report ]; then
-  python3 "$BENCH/build/lakeprof_report_upload.py"
-fi
+"$BENCH_DIR/build/lakeprof_measurements.py" "$OUTPUT_FILE"
+python3 "$BENCH_DIR/build/lakeprof_report_upload.py"
diff --git a/scripts/bench/combine.py b/scripts/bench/combine.py
index 2a71f31b96..bf5e3b6dce 100755
--- a/scripts/bench/combine.py
+++ b/scripts/bench/combine.py
@@ -2,30 +2,79 @@
 
 import argparse
 import json
+import sys
 from pathlib import Path
+from typing import Any
 
-OUTFILE = Path() / "measurements.jsonl"
 
-if __name__ == "__main__":
+def add_measurement(
+    values: dict[str, float],
+    units: dict[str, str | None],
+    data: dict[str, Any],
+) -> None:
+    metric = data["metric"]
+    values[metric] = values.get(metric, 0) + data["value"]
+    units[metric] = data.get("unit")
+
+
+def format_measurement(
+    values: dict[str, float],
+    units: dict[str, str | None],
+    name: str,
+) -> dict[str, Any]:
+    value = values[name]
+    unit = units.get(name)
+
+    data: dict[str, Any] = {"metric": name, "value": value}
+    if unit is not None:
+        data["unit"] = unit
+
+    return data
+
+
+def main() -> None:
     parser = argparse.ArgumentParser(
-        description=f"Combine duplicated measurements in {OUTFILE.name} the way radar does, by summing their values."
+        description="Combine measurement files in the JSON Lines format, summing duplicated measurements like radar does.",
+    )
+    parser.add_argument(
+        "input",
+        nargs="*",
+        default=[],
+        help="input files to read measurements from. If none are specified, measurements are read from stdin.",
+    )
+    parser.add_argument(
+        "-o",
+        "--output",
+        type=Path,
+        help="output file to write measurements to. If not specified, the result is printed to stdout.",
     )
     args = parser.parse_args()
 
+    inputs: list[Path] = args.input
+    output: Path | None = args.output
+
     values: dict[str, float] = {}
     units: dict[str, str | None] = {}
 
-    with open(OUTFILE, "r") as f:
-        for line in f:
-            data = json.loads(line)
-            metric = data["metric"]
-            values[metric] = values.get(metric, 0) + data["value"]
-            units[metric] = data.get("unit")
-
-    with open(OUTFILE, "w") as f:
-        for metric, value in values.items():
-            unit = units.get(metric)
-            data = {"metric": metric, "value": value}
-            if unit is not None:
-                data["unit"] = unit
-            f.write(f"{json.dumps(data)}\n")
+    # Read measurements
+    if inputs:
+        for input in inputs:
+            with open(input, "r") as f:
+                for line in f:
+                    add_measurement(values, units, json.loads(line))
+    else:
+        for line in sys.stdin:
+            add_measurement(values, units, json.loads(line))
+
+    # Write measurements
+    if output:
+        with open(output, "w") as f:
+            for metric in sorted(values):
+                f.write(f"{json.dumps(format_measurement(values, units, metric))}\n")
+    else:
+        for metric in sorted(values):
+            print(json.dumps(format_measurement(values, units, metric)))
+
+
+if __name__ == "__main__":
+    main()
diff --git a/scripts/bench/measure.py b/scripts/bench/measure.py
index 072f4cdde6..c52b6e9028 100755
--- a/scripts/bench/measure.py
+++ b/scripts/bench/measure.py
@@ -9,8 +9,7 @@
 import tempfile
 from dataclasses import dataclass
 from pathlib import Path
-
-OUTFILE = Path() / "measurements.jsonl"
+from typing import Tuple
 
 
 @dataclass
@@ -27,10 +26,24 @@ class RusageMetric:
     unit: str | None = None
 
 
+@dataclass
+class Result:
+    category: str
+    value: float
+    unit: str | None
+
+    def fmt(self, topic: str) -> str:
+        data = {"metric": f"{topic}//{self.category}", "value": self.value}
+        if self.unit is not None:
+            data["unit"] = self.unit
+        return json.dumps(data)
+
+
 PERF_METRICS = {
     "task-clock": PerfMetric("task-clock", factor=1e-9, unit="s"),
     "wall-clock": PerfMetric("duration_time", factor=1e-9, unit="s"),
     "instructions": PerfMetric("instructions"),
+    "cycles": PerfMetric("cycles"),
 }
 
 PERF_UNITS = {
@@ -43,118 +56,201 @@ class RusageMetric:
 }
 
 ALL_METRICS = {**PERF_METRICS, **RUSAGE_METRICS}
+DEFAULT_METRICS = {"instructions", "maxrss", "task-clock", "wall-clock"}
 
 
-def measure_perf(cmd: list[str], events: list[str]) -> dict[str, tuple[float, str]]:
-    with tempfile.NamedTemporaryFile() as tmp:
-        cmd = [
-            *["perf", "stat", "-j", "-o", tmp.name],
-            *[arg for event in events for arg in ["-e", event]],
-            *["--", *cmd],
-        ]
+def resolve_metrics(metrics: set[str]) -> Tuple[set[str], set[str]]:
+    perf = set()
+    rusage = set()
+    unknown = set()
 
-        # Execute command
-        env = os.environ.copy()
-        env["LC_ALL"] = "C"  # or else perf may output syntactically invalid json
-        result = subprocess.run(cmd, env=env)
-        if result.returncode != 0:
-            sys.exit(result.returncode)
+    for metric in metrics:
+        if metric in PERF_METRICS:
+            perf.add(metric)
+        elif metric in RUSAGE_METRICS:
+            rusage.add(metric)
+        else:
+            unknown.add(metric)
 
-        # Collect results
-        perf = {}
-        for line in tmp:
-            data = json.loads(line)
-            if "event" in data and "counter-value" in data:
-                perf[data["event"]] = float(data["counter-value"]), data["unit"]
+    if unknown:
+        raise SystemExit(f"unknown metrics: {', '.join(unknown)}")
 
-        return perf
+    return perf, rusage
 
 
 @dataclass
-class Result:
-    category: str
+class PerfResult:
     value: float
-    unit: str | None
+    unit: str
 
-    def fmt(self, topic: str) -> str:
-        metric = f"{topic}//{self.category}"
-        if self.unit is None:
-            return json.dumps({"metric": metric, "value": self.value})
-        return json.dumps({"metric": metric, "value": self.value, "unit": self.unit})
 
+type PerfResults = dict[str, PerfResult]
 
-def measure(cmd: list[str], metrics: list[str]) -> list[Result]:
-    # Check args
-    unknown_metrics = []
-    for metric in metrics:
-        if metric not in RUSAGE_METRICS and metric not in PERF_METRICS:
-            unknown_metrics.append(metric)
-    if unknown_metrics:
-        raise Exception(f"unknown metrics: {', '.join(unknown_metrics)}")
 
-    # Prepare perf events
-    events: list[str] = []
-    for metric in metrics:
-        if info := PERF_METRICS.get(metric):
-            events.append(info.event)
+@dataclass
+class MeasureResult:
+    perf: PerfResults
+    stdout: str
+    stderr: str
+
+
+def measure_perf(cmd: list[str], events: set[str], capture: bool) -> MeasureResult:
+    with tempfile.NamedTemporaryFile() as tmp:
+        env = os.environ.copy()
+        env["LC_ALL"] = "C"  # or perf may output syntactically invalid JSON
+
+        # On NixOS, perf effectively prepends /usr/bin to the PATH, but in this
+        # test suite, we often use the PATH to specify the binaries under test.
+        # Hence, we reset the PATH inside of perf using env.
+        cmd = [
+            *("perf", "stat", "-j", "-o", tmp.name),
+            *(arg for event in sorted(events) for arg in ["-e", event]),
+            "--",
+            *("env", f"PATH={env['PATH']}"),
+            *cmd,
+        ]
 
-    # Measure
-    perf = measure_perf(cmd, events)
+        # Execute command
+        result = subprocess.run(cmd, env=env, capture_output=capture, encoding="utf-8")
+        if result.returncode != 0:
+            if capture:
+                print(result.stdout, end="", file=sys.stdout)
+                print(result.stderr, end="", file=sys.stderr)
+            raise SystemExit(result.returncode)
+
+        # Collect results
+        perf: PerfResults = {}
+        for line in tmp:
+            data = json.loads(line)
+            if "event" in data and "counter-value" in data:
+                perf[data["event"]] = PerfResult(
+                    value=float(data["counter-value"]),
+                    unit=data["unit"],
+                )
+
+        return MeasureResult(
+            perf=perf,
+            stdout=result.stdout or "",
+            stderr=result.stderr or "",
+        )
+
+
+def get_perf_result(perf: PerfResults, metric: str) -> Result:
+    info = PERF_METRICS[metric]
+    if info.event in perf:
+        result = perf[info.event]
+    else:
+        # Without the corresponding permissions,
+        # we only get access to the userspace versions of the counters.
+        result = perf[f"{info.event}:u"]
+
+    value = result.value * PERF_UNITS.get(result.unit, info.factor)
+    return Result(category=metric, value=value, unit=info.unit)
+
+
+def get_rusage_result(rusage: resource.struct_rusage, metric: str) -> Result:
+    info = RUSAGE_METRICS[metric]
+    value = getattr(rusage, info.name) * info.factor
+    return Result(category=metric, value=value, unit=info.unit)
+
+
+def main(
+    cmd: list[str],
+    output: Path,
+    topics: list[str],
+    metrics: set[str],
+    append: bool = True,
+    capture: bool = False,
+) -> tuple[str, str]:
+    perf_metrics, rusage_metrics = resolve_metrics(metrics)
+    perf_events = {PERF_METRICS[metric].event for metric in perf_metrics}
+
+    measured = measure_perf(cmd, perf_events, capture=capture)
+    perf = measured.perf
     rusage = resource.getrusage(resource.RUSAGE_CHILDREN)
 
-    # Extract results
     results = []
-    for metric in metrics:
-        if info := PERF_METRICS.get(metric):
-            if info.event in perf:
-                value, unit = perf[info.event]
-            else:
-                # Without the corresponding permissions,
-                # we only get access to the userspace versions of the counters.
-                value, unit = perf[f"{info.event}:u"]
+    for metric in perf_metrics:
+        results.append(get_perf_result(perf, metric))
+    for metric in rusage_metrics:
+        results.append(get_rusage_result(rusage, metric))
 
-            value *= PERF_UNITS.get(unit, info.factor)
-            results.append(Result(metric, value, info.unit))
+    with open(output, "a" if append else "w") as f:
+        for result in results:
+            for topic in topics:
+                f.write(f"{result.fmt(topic)}\n")
 
-        if info := RUSAGE_METRICS.get(metric):
-            value = getattr(rusage, info.name) * info.factor
-            results.append(Result(metric, value, info.unit))
+    return measured.stdout, measured.stderr
 
-    return results
+
+class Args:
+    topic: list[str]
+    metric: list[str]
+    default_metrics: bool
+    output: Path
+    append: bool
+    cmd: str
+    args: list[str]
 
 
 if __name__ == "__main__":
     parser = argparse.ArgumentParser(
-        description=f"Measure resource usage of a command using perf and rusage. The results are appended to {OUTFILE.name}.",
+        description="Measure resource usage of a command using perf and rusage.",
+        formatter_class=argparse.ArgumentDefaultsHelpFormatter,
     )
     parser.add_argument(
-        "-t",
         "--topic",
+        "-t",
         action="append",
         default=[],
         help="topic prefix for the metrics",
     )
     parser.add_argument(
-        "-m",
         "--metric",
+        "-m",
         action="append",
         default=[],
         help=f"metrics to measure. Can be specified multiple times. Available metrics: {', '.join(sorted(ALL_METRICS))}",
     )
+    parser.add_argument(
+        "--default-metrics",
+        "-d",
+        action="store_true",
+        help=f"measure a default set of metrics: {', '.join(sorted(DEFAULT_METRICS))}",
+    )
+    parser.add_argument(
+        "--output",
+        "-o",
+        type=Path,
+        default=Path() / "measurements.jsonl",
+        help="output file to write measurements to, in the JSON Lines format",
+    )
+    parser.add_argument(
+        "--append",
+        "-a",
+        action="store_true",
+        help="append to the output file instead of overwriting it",
+    )
     parser.add_argument(
         "cmd",
-        nargs="*",
         help="command to measure the resource usage of",
     )
-    args = parser.parse_args()
-
-    topics: list[str] = args.topic
-    metrics: list[str] = args.metric
-    cmd: list[str] = args.cmd
-
-    results = measure(cmd, metrics)
-
-    with open(OUTFILE, "a+") as f:
-        for result in results:
-            for topic in topics:
-                f.write(f"{result.fmt(topic)}\n")
+    parser.add_argument(
+        "args",
+        nargs="*",
+        default=[],
+        help="arguments to pass to the command",
+    )
+    args = parser.parse_args(namespace=Args())
+
+    metrics = set(args.metric)
+    if args.default_metrics:
+        metrics |= DEFAULT_METRICS
+
+    main(
+        cmd=[args.cmd] + args.args,
+        output=args.output,
+        topics=args.topic,
+        metrics=metrics,
+        append=args.append,
+    )
diff --git a/scripts/bench/repeatedly.py b/scripts/bench/repeatedly.py
new file mode 100755
index 0000000000..fae258cf02
--- /dev/null
+++ b/scripts/bench/repeatedly.py
@@ -0,0 +1,172 @@
+#!/usr/bin/env python3
+
+import argparse
+import json
+import subprocess
+import sys
+from contextlib import contextmanager
+from dataclasses import dataclass
+from pathlib import Path
+
+
+@dataclass
+class Measurement:
+    metric: str
+    value: float
+    unit: str | None
+
+    @classmethod
+    def from_json_str(cls, s: str) -> "Measurement":
+        data = json.loads(s.strip())
+        return cls(data["metric"], data["value"], data.get("unit"))
+
+    def to_json_str(self) -> str:
+        if self.unit is None:
+            return json.dumps({"metric": self.metric, "value": self.value})
+        return json.dumps(
+            {"metric": self.metric, "value": self.value, "unit": self.unit}
+        )
+
+
+@contextmanager
+def temporarily_move_outfile(outfile: Path):
+    outfile_tmp = outfile.with_name(outfile.name + ".repeatedly_tmp")
+    if outfile_tmp.exists():
+        raise Exception(f"{outfile_tmp} already exists")
+
+    outfile.touch()
+    outfile.rename(outfile_tmp)
+    try:
+        yield
+    finally:
+        outfile_tmp.rename(outfile)
+
+
+def read_measurements_from_outfile(outfile: Path) -> list[Measurement]:
+    measurements = []
+    with open(outfile, "r") as f:
+        for line in f:
+            measurements.append(Measurement.from_json_str(line))
+    return measurements
+
+
+def write_measurements_to_outfile(
+    outfile: Path, measurements: list[Measurement]
+) -> None:
+    with open(outfile, "a") as f:
+        for measurement in measurements:
+            f.write(f"{measurement.to_json_str()}\n")
+
+
+def run_once(cmd: list[str], outfile: Path) -> list[Measurement]:
+    with temporarily_move_outfile(outfile):
+        proc = subprocess.run(cmd)
+        if proc.returncode != 0:
+            sys.exit(proc.returncode)
+
+        return read_measurements_from_outfile(outfile)
+
+
+def sum_by_metric(measurements: list[Measurement]) -> dict[str, Measurement]:
+    totals: dict[str, Measurement] = {}
+    for measurement in measurements:
+        if existing := totals.get(measurement.metric):
+            measurement.value += existing.value
+        totals[measurement.metric] = measurement
+    return totals
+
+
+def repeatedly(
+    cmd: list[str],
+    iterations: int,
+    outfile: Path,
+    drop_highest: int = 0,
+    drop_lowest: int = 0,
+) -> list[Measurement]:
+    by_metric: dict[str, list[Measurement]] = {}
+
+    for i in range(iterations):
+        for metric, measurement in sum_by_metric(run_once(cmd, outfile)).items():
+            by_metric.setdefault(metric, []).append(measurement)
+
+    if drop_highest + drop_lowest >= iterations:
+        raise ValueError(
+            f"drop_highest ({drop_highest}) + drop_lowest ({drop_lowest}) must be "
+            f"less than the number of iterations ({iterations})"
+        )
+
+    results = []
+    for metric, measurements in by_metric.items():
+        if drop_highest or drop_lowest:
+            measurements.sort(key=lambda m: m.value)
+            measurements = measurements[drop_lowest : len(measurements) - drop_highest]
+        if not measurements:
+            continue
+        unit = measurements[0].unit
+        value = sum(m.value for m in measurements) / len(measurements)
+        results.append(Measurement(metric, value, unit))
+
+    return results
+
+
+class Args:
+    iterations: int
+    drop_highest: int
+    drop_lowest: int
+    outfile: Path
+    cmd: str
+    args: list[str]
+
+
+if __name__ == "__main__":
+    parser = argparse.ArgumentParser(
+        description="Repeatedly run a command, averaging the measurements it writes.",
+    )
+    parser.add_argument(
+        "-n",
+        "--iterations",
+        type=int,
+        default=5,
+        help="number of iterations",
+    )
+    parser.add_argument(
+        "-H",
+        "--drop-highest",
+        type=int,
+        default=0,
+        help="drop the n highest values of each metric before averaging",
+    )
+    parser.add_argument(
+        "-L",
+        "--drop-lowest",
+        type=int,
+        default=0,
+        help="drop the n lowest values of each metric before averaging",
+    )
+    parser.add_argument(
+        "-o",
+        "--outfile",
+        type=Path,
+        default=Path("measurements.jsonl"),
+        help="measurements file the command under test writes to",
+    )
+    parser.add_argument(
+        "cmd",
+        help="command to repeatedly run",
+    )
+    parser.add_argument(
+        "args",
+        nargs="*",
+        default=[],
+        help="arguments to pass to the command",
+    )
+    args = parser.parse_args(namespace=Args())
+
+    measurements = repeatedly(
+        [args.cmd] + args.args,
+        args.iterations,
+        args.outfile,
+        args.drop_highest,
+        args.drop_lowest,
+    )
+    write_measurements_to_outfile(args.outfile, measurements)
diff --git a/scripts/bench/run b/scripts/bench/run
index 71af3550ca..5e7eb4c324 100755
--- a/scripts/bench/run
+++ b/scripts/bench/run
@@ -1,10 +1,12 @@
 #!/usr/bin/env bash
 set -euo pipefail
 
-BENCH="scripts/bench"
+export ROOT_DIR="$(realpath .)"
+export BENCH_DIR="$ROOT_DIR/scripts/bench"
+export OUTPUT_FILE="$ROOT_DIR/measurements.jsonl"
 
 echo "Running benchmark: build"
-"$BENCH/build/run"
+"$BENCH_DIR/build/run"
 
 echo "Running benchmark: size"
-"$BENCH/size/run"
+"$BENCH_DIR/size/run"
diff --git a/scripts/bench/size/run b/scripts/bench/size/run
index 437671149f..38bea95813 100755
--- a/scripts/bench/size/run
+++ b/scripts/bench/size/run
@@ -1,40 +1,54 @@
 #!/usr/bin/env python3
 
 import json
+import os
 from pathlib import Path
+from typing import Generator
 
-OUTFILE = Path() / "measurements.jsonl"
+OUTFILE = Path(os.environ["OUTPUT_FILE"])
 
 
-def output_result(metric: str, value: float, unit: str | None = None) -> None:
-    data = {"metric": metric, "value": value}
+def output_result(
+    topic: str,
+    category: str,
+    value: float,
+    unit: str | None = None,
+) -> None:
+    data = {"metric": f"{topic}//{category}", "value": value}
     if unit is not None:
         data["unit"] = unit
     with open(OUTFILE, "a") as f:
         f.write(f"{json.dumps(data)}\n")
 
 
-def measure_leans() -> None:
-    lean_files = 0
-    lean_lines = 0
-    for path in Path().glob("Cslib/**/*.lean"):
-        lean_files += 1
-        with open(path) as f:
-            lean_lines += sum(1 for _ in f)
-    output_result("size/.lean//files", lean_files)
-    output_result("size/.lean//lines", lean_lines)
+def find_lean_files() -> Generator[Path, None, None]:
+    for p in Path().iterdir():
+        if p.name.startswith("."):
+            continue
+        elif p.is_dir():
+            yield from p.glob("**/*.lean")
+        elif p.name.endswith(".lean"):
+            yield p
 
 
-def measure_oleans() -> None:
-    olean_files = 0
-    olean_bytes = 0
-    for path in Path().glob(".lake/build/**/*.olean"):
-        olean_files += 1
-        olean_bytes += path.stat().st_size
-    output_result("size/.olean//files", olean_files)
-    output_result("size/.olean//bytes", olean_bytes, "B")
+def measure_lines(topic: str, *paths: Path) -> None:
+    for path in paths:
+        if path.is_file():
+            lines = len(path.read_text().splitlines())
+            output_result(topic, "lines", lines)
+            output_result(topic, "files", 1)
+
+
+def measure_bytes(topic: str, *paths: Path) -> None:
+    for path in paths:
+        if path.is_file():
+            bytes = path.stat().st_size
+            output_result(topic, "bytes", bytes, "B")
+            output_result(topic, "files", 1)
 
 
 if __name__ == "__main__":
-    measure_leans()
-    measure_oleans()
+    measure_lines("size/.lean", *find_lean_files())
+    measure_bytes("size/.olean", *Path().glob(".lake/build/**/*.olean"))
+    measure_bytes("size/.olean.server", *Path().glob(".lake/build/**/*.olean.server"))
+    measure_bytes("size/.olean.private", *Path().glob(".lake/build/**/*.olean.private"))