From cb9e7a3d965258ffa1508102aaf0d825a92358b1 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Tue, 10 Mar 2026 17:54:17 +0100
Subject: [PATCH 01/53] Update
 Cslib/Computability/Machines/MultiTapeTuring/Basic.lean

Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com>
---
 .../Machines/MultiTapeTuring/Basic.lean       | 19 +++++--------------
 1 file changed, 5 insertions(+), 14 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index 6bf325db8b..b3c45032ac 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -343,21 +343,12 @@ public lemma eval_eq_some_iff_transformsTapes
   constructor
   · intro ⟨h_dom, h_get⟩
     use Nat.find h_dom
-    rw [TransformsTapesInExactTime, relatesInSteps_iff_step_iter_eq_some]
-    rw [← configs, Option.eq_some_iff_get_eq]
-    use configs_isSome_of_haltsAtStep (Nat.find_spec h_dom)
-    ext1
-    · simp
-      grind [haltsAtStep, Nat.find_spec h_dom]
-    · exact h_get
+    grind [TransformsTapesInExactTime, configs, haltCfgTapes, haltsAtStep]
   · intro ⟨t, h_iter⟩
-    rw [TransformsTapesInExactTime, relatesInSteps_iff_step_iter_eq_some] at h_iter
-    rw [← configs] at h_iter
-    have h_halts_at_t : tm.haltsAtStep tapes t := by simp [haltsAtStep, h_iter]
-    let h_halts : ∃ t, tm.haltsAtStep tapes t := ⟨t, h_halts_at_t⟩
-    use h_halts
-    have h_eq : Nat.find h_halts = t := halting_step_unique (Nat.find_spec h_halts) h_halts_at_t
-    simp [h_eq, h_iter]
+    rw [TransformsTapesInExactTime, relatesInSteps_iff_step_iter_eq_some, ← configs] at h_iter
+    have h_halts_at_t : tm.haltsAtStep tapes t := by grind [haltsAtStep]
+    have : ∃ t, tm.haltsAtStep tapes t := ⟨t, h_halts_at_t⟩
+    grind [haltCfgTapes, halting_step_unique]
 
 end MultiTapeTM
 

From cc78278fa4262b7df7a3fe8ea316b4ade1680983 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Tue, 10 Mar 2026 17:37:56 +0100
Subject: [PATCH 02/53] Extract common parts.

---
 Cslib.lean                                    |  1 +
 .../Machines/MultiTapeTuring/Basic.lean       | 14 ++++++-------
 .../Machines/SingleTapeTuring/Basic.lean      | 21 ++-----------------
 3 files changed, 10 insertions(+), 26 deletions(-)

diff --git a/Cslib.lean b/Cslib.lean
index d64e025eff..48a755f506 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -30,6 +30,7 @@ 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.Machines.TuringCommon
 public import Cslib.Computability.Machines.MultiTapeTuring.Basic
 public import Cslib.Computability.URM.Basic
 public import Cslib.Computability.URM.Computable
diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index b3c45032ac..2ca7e81cd4 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -6,12 +6,12 @@ Authors: Christian Reitwiessner
 
 module
 
--- TODO create a "common file"?
-public import Cslib.Computability.Machines.SingleTapeTuring.Basic
-
 public import Mathlib.Data.Part
-
-import Mathlib.Algebra.Order.BigOperators.Group.Finset
+public import Mathlib.Data.Fintype.Defs
+public import Cslib.Foundations.Data.BiTape
+public import Cslib.Foundations.Data.RelatesInSteps
+public import Cslib.Computability.Machines.TuringCommon
+public import Mathlib.Algebra.Order.BigOperators.Group.Finset
 
 /-!
 # Multi-Tape Turing Machines
@@ -84,7 +84,7 @@ public structure MultiTapeTM k Symbol [Inhabited Symbol] [Fintype Symbol] where
   (q₀ : State)
   /-- transition function, mapping a state and a tuple of head symbols to a `Stmt` to invoke
   for each tape and optionally the new state to transition to afterwards (`none` for halt) -/
-  (tr : State → (Fin k → Option Symbol) → ((Fin k → (SingleTapeTM.Stmt Symbol)) × Option State))
+  (tr : State → (Fin k → Option Symbol) → ((Fin k → (Stmt Symbol)) × Option State))
 
 namespace MultiTapeTM
 
@@ -104,7 +104,7 @@ instance : Inhabited tm.State := ⟨tm.q₀⟩
 
 instance : Fintype tm.State := tm.stateFintype
 
-instance inhabitedStmt : Inhabited (SingleTapeTM.Stmt Symbol) := inferInstance
+instance inhabitedStmt : Inhabited (Stmt Symbol) := inferInstance
 
 
 /--
diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
index 4f31c1530f..adec507055 100644
--- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
@@ -9,6 +9,7 @@ module
 public import Cslib.Foundations.Data.BiTape
 public import Cslib.Foundations.Data.RelatesInSteps
 public import Mathlib.Algebra.Polynomial.Eval.Defs
+public import Cslib.Computability.Machines.TuringCommon
 
 @[expose] public section
 
@@ -44,7 +45,6 @@ for convenience in composition of machines.
 
 We define a number of structures related to Turing machine computation:
 
-* `Stmt`: the write and movement operations a TM can do in a single step.
 * `SingleTapeTM`: the TM itself.
 * `Cfg`: the configuration of a TM, including internal and tape state.
 * `TimeComputable f`: a TM for computing `f`, packaged with a bound on runtime.
@@ -70,21 +70,6 @@ open BiTape StackTape
 
 variable {Symbol : Type}
 
-namespace SingleTapeTM
-
-/--
-A Turing machine "statement" is just a `Option`al command to move left or right,
-and write a symbol (i.e. an `Option Symbol`, where `none` is the blank symbol) on the `BiTape`
--/
-structure Stmt (Symbol : Type) where
-  /-- The symbol to write at the current head position -/
-  symbol : Option Symbol
-  /-- The direction to move the tape head -/
-  movement : Option Dir
-deriving Inhabited
-
-end SingleTapeTM
-
 /--
 A single-tape Turing machine
 over the alphabet of `Option Symbol` (where `none` is the blank `BiTape` symbol).
@@ -98,7 +83,7 @@ structure SingleTapeTM Symbol [Inhabited Symbol] [Fintype Symbol] where
   (q₀ : State)
   /-- Transition function, mapping a state and a head symbol to a `Stmt` to invoke,
   and optionally the new state to transition to afterwards (`none` for halt) -/
-  (tr : State → Option Symbol → SingleTapeTM.Stmt Symbol × Option State)
+  (tr : State → Option Symbol → Stmt Symbol × Option State)
 
 namespace SingleTapeTM
 
@@ -118,8 +103,6 @@ instance : Inhabited tm.State := ⟨tm.q₀⟩
 
 instance : Fintype tm.State := tm.stateFintype
 
-instance inhabitedStmt : Inhabited (Stmt Symbol) := inferInstance
-
 /--
 The configurations of a Turing machine consist of:
 an `Option`al state (or none for the halting state),

From 07d7bcd3ac11e72f0823d6492bd369091594ec05 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Tue, 10 Mar 2026 17:54:30 +0100
Subject: [PATCH 03/53] Simplify definitions and proofs.

---
 .../Machines/MultiTapeTuring/Basic.lean            | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index 2ca7e81cd4..900c4556c4 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -77,14 +77,14 @@ over the alphabet of `Option Symbol` (where `none` is the blank `BiTape` symbol)
 -/
 public structure MultiTapeTM k Symbol [Inhabited Symbol] [Fintype Symbol] where
   /-- type of state labels -/
-  (State : Type)
+  State : Type
   /-- finiteness of the state type -/
   [stateFintype : Fintype State]
   /-- initial state -/
-  (q₀ : State)
+  q₀ : State
   /-- transition function, mapping a state and a tuple of head symbols to a `Stmt` to invoke
   for each tape and optionally the new state to transition to afterwards (`none` for halt) -/
-  (tr : State → (Fin k → Option Symbol) → ((Fin k → (Stmt Symbol)) × Option State))
+  tr : State → (Fin k → Option Symbol) → ((Fin k → (Stmt Symbol)) × Option State)
 
 namespace MultiTapeTM
 
@@ -139,10 +139,8 @@ public lemma step_iter_none_eq_none (tapes : Fin k → BiTape Symbol) (n : ℕ)
     (Option.bind · tm.step)^[n + 1] (some ⟨none, tapes⟩) = none := by
   rw [Function.iterate_succ_apply]
   induction n with
-  | zero => simp [step]
-  | succ n ih =>
-    simp only [Function.iterate_succ_apply', ih]
-    simp [step]
+  | zero => rfl
+  | succ n ih => grind [Function.iterate_succ_apply']
 
 /-- A collection of tapes where the first tape contains `s` -/
 public def firstTape (s : List Symbol) : Fin k → BiTape Symbol
@@ -280,7 +278,7 @@ public lemma relatesInSteps_iff_step_iter_eq_some
   | succ t ih =>
     rw [RelatesInSteps.succ_iff, Function.iterate_succ_apply']
     constructor
-    · grind only [TransitionRelation, = Option.bind_some]
+    · grind
     · intro h_configs
       cases h : (Option.bind · tm.step)^[t] cfg₁ with
       | none => grind

From 841be7f40ff647e163459e2394b9f5b3889e75f0 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Tue, 10 Mar 2026 18:26:03 +0100
Subject: [PATCH 04/53] Use "@[expose] public section"

---
 .../Machines/MultiTapeTuring/Basic.lean       | 57 +++++++++----------
 1 file changed, 26 insertions(+), 31 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index 900c4556c4..e08ab23992 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -13,6 +13,8 @@ public import Cslib.Foundations.Data.RelatesInSteps
 public import Cslib.Computability.Machines.TuringCommon
 public import Mathlib.Algebra.Order.BigOperators.Group.Finset
 
+@[expose] public section
+
 /-!
 # Multi-Tape Turing Machines
 
@@ -75,7 +77,7 @@ variable {k : ℕ}
 A `k`-tape Turing machine
 over the alphabet of `Option Symbol` (where `none` is the blank `BiTape` symbol).
 -/
-public structure MultiTapeTM k Symbol [Inhabited Symbol] [Fintype Symbol] where
+structure MultiTapeTM k Symbol [Inhabited Symbol] [Fintype Symbol] where
   /-- type of state labels -/
   State : Type
   /-- finiteness of the state type -/
@@ -113,7 +115,7 @@ an `Option`al state (or none for the halting state),
 and a `BiTape` representing the tape contents.
 -/
 @[ext]
-public structure Cfg : Type where
+structure Cfg : Type where
   /-- the state of the TM (or none for the halting state) -/
   state : Option tm.State
   /-- the BiTape contents -/
@@ -121,7 +123,7 @@ public structure Cfg : Type where
 deriving Inhabited
 
 /-- The step function corresponding to a `MultiTapeTM`. -/
-public def step : tm.Cfg → Option tm.Cfg
+def step : tm.Cfg → Option tm.Cfg
   | ⟨none, _⟩ =>
     -- If in the halting state, there is no next configuration
     none
@@ -135,7 +137,7 @@ public def step : tm.Cfg → Option tm.Cfg
 
 /-- Any number of positive steps run from a halting configuration lead to `none`. -/
 @[simp, scoped grind =]
-public lemma step_iter_none_eq_none (tapes : Fin k → BiTape Symbol) (n : ℕ) :
+lemma step_iter_none_eq_none (tapes : Fin k → BiTape Symbol) (n : ℕ) :
     (Option.bind · tm.step)^[n + 1] (some ⟨none, tapes⟩) = none := by
   rw [Function.iterate_succ_apply]
   induction n with
@@ -143,7 +145,7 @@ public lemma step_iter_none_eq_none (tapes : Fin k → BiTape Symbol) (n : ℕ)
   | succ n ih => grind [Function.iterate_succ_apply']
 
 /-- A collection of tapes where the first tape contains `s` -/
-public def firstTape (s : List Symbol) : Fin k → BiTape Symbol
+def firstTape (s : List Symbol) : Fin k → BiTape Symbol
   | ⟨0, _⟩ => BiTape.mk₁ s
   | ⟨_, _⟩ => default
 
@@ -153,46 +155,42 @@ Note that the entries of the tape constructed by `BiTape.mk₁` are all `some` v
 This is to ensure that distinct lists map to distinct initial configurations.
 -/
 @[simp]
-public def initCfg (s : List Symbol) : tm.Cfg :=
+def initCfg (s : List Symbol) : tm.Cfg :=
   ⟨some tm.q₀, firstTape s⟩
 
 /-- Create an initial configuration given a tuple of tapes. -/
 @[simp]
-public def initCfgTapes (tapes : Fin k → BiTape Symbol) : tm.Cfg :=
+def initCfgTapes (tapes : Fin k → BiTape Symbol) : tm.Cfg :=
   ⟨some tm.q₀, tapes⟩
 
 /-- The final configuration corresponding to a list in the output alphabet.
 (We demand that the head halts at the leftmost position of the output.)
 -/
 @[simp]
-public def haltCfg (s : List Symbol) : tm.Cfg :=
+def haltCfg (s : List Symbol) : tm.Cfg :=
   ⟨none, firstTape s⟩
 
 /-- The final configuration of a Turing machine given a tuple of tapes. -/
 @[simp]
-public def haltCfgTapes (tapes : Fin k → BiTape Symbol) : tm.Cfg :=
+def haltCfgTapes (tapes : Fin k → BiTape Symbol) : tm.Cfg :=
   ⟨none, tapes⟩
 
 /-- The sequence of configurations of the Turing machine starting with initial state and
 given tapes at step `t`.
 If the Turing machine halts, it will eventually get and stay `none` after reaching the halting
 configuration. -/
-public def configs (tapes : Fin k → BiTape Symbol) (t : ℕ) : Option tm.Cfg :=
+def configs (tapes : Fin k → BiTape Symbol) (t : ℕ) : Option tm.Cfg :=
   (Option.bind · tm.step)^[t] (tm.initCfgTapes tapes)
 
-
-
--- TODO shouldn't this be spaceUsed? (If yes, also change it in SingleTapeTM)
-
 /--
 The space used by a configuration is the sum of the space used by its tapes.
 -/
-public def Cfg.space_used (cfg : tm.Cfg) : ℕ := ∑ i, (cfg.tapes i).space_used
+def Cfg.space_used (cfg : tm.Cfg) : ℕ := ∑ i, (cfg.tapes i).space_used
 
 /--
 The space used by a configuration grows by at most `k` each step.
 -/
-public lemma Cfg.space_used_step (cfg cfg' : tm.Cfg)
+lemma Cfg.space_used_step (cfg cfg' : tm.Cfg)
     (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + k := by
   obtain ⟨_ | q, tapes⟩ := cfg
   · simp [step] at hstep
@@ -220,12 +218,12 @@ is defined by the `step` function,
 which maps a configuration to its next configuration, if it exists.
 -/
 @[scoped grind =]
-public def TransitionRelation (tm : MultiTapeTM k Symbol) (c₁ c₂ : tm.Cfg) : Prop :=
+def TransitionRelation (tm : MultiTapeTM k Symbol) (c₁ c₂ : tm.Cfg) : Prop :=
   tm.step c₁ = some c₂
 
 /-- A proof that the Turing machine `tm` transforms tapes `tapes` to `tapes'` in exactly
 `t` steps. -/
-public def TransformsTapesInExactTime
+def TransformsTapesInExactTime
     (tm : MultiTapeTM k Symbol)
     (tapes tapes' : Fin k → BiTape Symbol)
     (t : ℕ) : Prop :=
@@ -233,21 +231,19 @@ public def TransformsTapesInExactTime
 
 /-- A proof that the Turing machine `tm` transforms tapes `tapes` to `tapes'` in up to
 `t` steps. -/
-public def TransformsTapesInTime
+def TransformsTapesInTime
     (tm : MultiTapeTM k Symbol)
     (tapes tapes' : Fin k → BiTape Symbol)
     (t : ℕ) : Prop :=
   RelatesWithinSteps tm.TransitionRelation (tm.initCfgTapes tapes) (tm.haltCfgTapes tapes') t
 
 /-- The Turing machine `tm` transforms tapes `tapes` to `tapes'`. -/
-public def TransformsTapes
-    (tm : MultiTapeTM k Symbol)
-    (tapes tapes' : Fin k → BiTape Symbol) : Prop :=
+def TransformsTapes (tm : MultiTapeTM k Symbol) (tapes tapes' : Fin k → BiTape Symbol) : Prop :=
   ∃ t, tm.TransformsTapesInExactTime tapes tapes' t
 
 /-- A proof that the Turing machine `tm` uses at most space `s` when run for up to `t` steps
 on initial tapes `tapes`. -/
-public def UsesSpaceUntilStep
+def UsesSpaceUntilStep
     (tm : MultiTapeTM k Symbol)
     (tapes : Fin k → BiTape Symbol)
     (s t : ℕ) : Prop :=
@@ -257,7 +253,7 @@ public def UsesSpaceUntilStep
 
 /-- A proof that the Turing machine `tm` transforms tapes `tapes` to `tapes'` in exactly `t` steps
 and uses at most `s` space. -/
-public def TransformsTapesInTimeAndSpace
+def TransformsTapesInTimeAndSpace
     (tm : MultiTapeTM k Symbol)
     (tapes tapes' : Fin k → BiTape Symbol)
     (t s : ℕ) : Prop :=
@@ -267,7 +263,7 @@ public def TransformsTapesInTimeAndSpace
 /-- 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 =]
-public lemma relatesInSteps_iff_step_iter_eq_some
+lemma relatesInSteps_iff_step_iter_eq_some
     (tm : MultiTapeTM k Symbol)
     (cfg₁ cfg₂ : tm.Cfg)
     (t : ℕ) :
@@ -287,14 +283,13 @@ public lemma relatesInSteps_iff_step_iter_eq_some
         grind
 
 /-- The Turing machine `tm` halts after exactly `t` steps on initial tapes `tapes`. -/
-public def haltsAtStep
-    (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) (t : ℕ) : Bool :=
+def haltsAtStep (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) (t : ℕ) : Bool :=
   match (tm.configs tapes t) with
   | some ⟨none, _⟩ => true
   | _ => false
 
 /-- If a Turing machine halts, the time step is uniquely determined. -/
-public lemma halting_step_unique
+lemma halting_step_unique
     {tm : MultiTapeTM k Symbol}
     {tapes : Fin k → BiTape Symbol}
     {t₁ t₂ : ℕ}
@@ -316,7 +311,7 @@ public lemma halting_step_unique
       simp at h_halts₂
 
 /-- At the halting step, the configuration sequence of a Turing machine is still `some`. -/
-public lemma configs_isSome_of_haltsAtStep
+lemma configs_isSome_of_haltsAtStep
     {tm : MultiTapeTM k Symbol} {tapes : Fin k → BiTape Symbol} {t : ℕ}
     (h_halts : tm.haltsAtStep tapes t) :
     (tm.configs tapes t).isSome := by
@@ -324,7 +319,7 @@ public lemma configs_isSome_of_haltsAtStep
 
 /-- Execute the Turing machine `tm` on initial tapes `tapes` and return the resulting tapes
 if it eventually halts. -/
-public def eval (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) :
+def eval (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) :
     Part (Fin k → BiTape Symbol) :=
   ⟨∃ t, tm.haltsAtStep tapes t,
     fun h => ((tm.configs tapes (Nat.find h)).get
@@ -333,7 +328,7 @@ public def eval (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) :
 /-- Evaluating a Turing machine on a tuple of tapes `tapes` has a value `tapes'` if and only if
 it transforms `tapes` into `tapes'`. -/
 @[scoped grind =]
-public lemma eval_eq_some_iff_transformsTapes
+lemma eval_eq_some_iff_transformsTapes
     {tm : MultiTapeTM k Symbol}
     {tapes tapes' : Fin k → BiTape Symbol} :
     tm.eval tapes = .some tapes' ↔ tm.TransformsTapes tapes tapes' := by

From abac0f11ddf6579691556eb705599353f16a5cca Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Tue, 10 Mar 2026 18:26:49 +0100
Subject: [PATCH 05/53] Update Cslib.lean

---
 Cslib.lean | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Cslib.lean b/Cslib.lean
index 48a755f506..4e8f8d568b 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -29,9 +29,9 @@ public import Cslib.Computability.Languages.Language
 public import Cslib.Computability.Languages.OmegaLanguage
 public import Cslib.Computability.Languages.OmegaRegularLanguage
 public import Cslib.Computability.Languages.RegularLanguage
+public import Cslib.Computability.Machines.MultiTapeTuring.Basic
 public import Cslib.Computability.Machines.SingleTapeTuring.Basic
 public import Cslib.Computability.Machines.TuringCommon
-public import Cslib.Computability.Machines.MultiTapeTuring.Basic
 public import Cslib.Computability.URM.Basic
 public import Cslib.Computability.URM.Computable
 public import Cslib.Computability.URM.Defs

From ae6c498526fed9a2002d0396a60068782c8e3cd7 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Tue, 10 Mar 2026 23:52:23 +0100
Subject: [PATCH 06/53] Add missed file.

---
 .../Computability/Machines/TuringCommon.lean  | 28 +++++++++++++++++++
 1 file changed, 28 insertions(+)
 create mode 100644 Cslib/Computability/Machines/TuringCommon.lean

diff --git a/Cslib/Computability/Machines/TuringCommon.lean b/Cslib/Computability/Machines/TuringCommon.lean
new file mode 100644
index 0000000000..e9e19184f0
--- /dev/null
+++ b/Cslib/Computability/Machines/TuringCommon.lean
@@ -0,0 +1,28 @@
+/-
+Copyright (c) 2026 Bolton Bailey. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Bolton Bailey, Pim Spelier, Daan van Gent
+-/
+
+module
+
+public import Mathlib.Computability.Tape
+
+@[expose] public section
+
+namespace Turing
+
+/--
+A Turing machine "statement" is just a `Option`al command to move left or right,
+and write a symbol (i.e. an `Option Symbol`, where `none` is the blank symbol) on the `BiTape`
+-/
+structure Stmt (Symbol : Type) where
+  /-- The symbol to write at the current head position -/
+  symbol : Option Symbol
+  /-- The direction to move the tape head -/
+  movement : Option Dir
+deriving Inhabited
+
+instance inhabitedStmt : Inhabited (Stmt Symbol) := inferInstance
+
+end Turing

From 7401a21ab47ac4cf53cd964f1f7d7e9896867a64 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Thu, 19 Mar 2026 12:15:06 +0100
Subject: [PATCH 07/53] fix import.

---
 Cslib/Computability/Machines/TuringCommon.lean | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Cslib/Computability/Machines/TuringCommon.lean b/Cslib/Computability/Machines/TuringCommon.lean
index e9e19184f0..60d0636639 100644
--- a/Cslib/Computability/Machines/TuringCommon.lean
+++ b/Cslib/Computability/Machines/TuringCommon.lean
@@ -6,7 +6,7 @@ Authors: Bolton Bailey, Pim Spelier, Daan van Gent
 
 module
 
-public import Mathlib.Computability.Tape
+public import Mathlib.Computability.TuringMachine.Tape
 
 @[expose] public section
 

From f57bb82a750c5d3dac3d4f7ed0c5e164a3f4f6c0 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Sat, 18 Apr 2026 18:08:59 +0200
Subject: [PATCH 08/53] Function view for tapes.

---
 Cslib/Foundations/Data/BiTape.lean    | 95 +++++++++++++++++++++++++++
 Cslib/Foundations/Data/StackTape.lean | 36 ++++++++++
 2 files changed, 131 insertions(+)

diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean
index de7a9c8fa2..91730dccbb 100644
--- a/Cslib/Foundations/Data/BiTape.lean
+++ b/Cslib/Foundations/Data/BiTape.lean
@@ -78,6 +78,31 @@ def mk₁ (l : List Symbol) : BiTape Symbol :=
   | [] => ∅
   | h :: t => { head := some h, left := ∅, right := StackTape.map_some t }
 
+/-- Returns the tape symbol at positon `p` relative to the head, where
+positive numbers are right of the head and negative are left of the head. -/
+def get (t : BiTape Symbol) : ℤ → Option Symbol
+  | Int.ofNat 0 => t.head
+  | Int.ofNat (Nat.succ p') => t.right.toList[p']?.getD none
+  | Int.negSucc p' => t.left.toList[p']?.getD none
+
+/-- Two tapes are equal if and only if their `get` functions are equal. This allows to view
+tapes as functions `ℤ → Option Symbol`. -/
+lemma ext_get (t₁ t₂ : BiTape Symbol) (h_get_eq : ∀ p, t₁.get p = t₂.get p) :
+  t₁ = t₂ := by
+  obtain ⟨head₁, left₁, right₁⟩ := t₁
+  obtain ⟨head₂, left₂, right₂⟩ := t₂
+  have h_head : head₁ = head₂ := by simpa [get] using h_get_eq 0
+  have h_right : right₁ = right₂ := by
+    apply StackTape.ext_get
+    intro p
+    simpa [get] using h_get_eq p.succ
+  have h_left : left₁ = left₂ := by
+    apply StackTape.ext_get
+    intro p
+    simpa [get] using h_get_eq (Int.negSucc p)
+  simp only [h_head, h_left, h_right]
+
+
 section Move
 
 /--
@@ -114,6 +139,66 @@ lemma move_left_move_right (t : BiTape Symbol) : t.move_left.move_right = t := b
 lemma move_right_move_left (t : BiTape Symbol) : t.move_right.move_left = t := by
   simp [move_left, move_right]
 
+/-- Translate an optional direction into a head movement offset, where the positive
+direction is to the right. -/
+def optionDirToInt (d : Option Dir) : ℤ :=
+  match d with
+  | none => 0
+  | some .left => -1
+  | some .right => 1
+
+@[simp]
+lemma get_move_left (t : BiTape Symbol) (p : ℤ) :
+    (t.move_left).get p = t.get (p - 1) := by
+  unfold move_left get
+  match p with
+  | Int.ofNat 0 =>
+    rw [show Int.ofNat 0 - 1 = Int.negSucc 0 from rfl]
+    simp [StackTape.head_eq_getD]
+  | Int.ofNat 1 => simp
+  | Int.ofNat (n + 2) =>
+    rw [show Int.ofNat (n + 2) - 1 = Int.ofNat (n + 1) from by grind]
+    simp
+  | Int.negSucc n => simp
+
+@[simp]
+lemma get_move_right (t : BiTape Symbol) (p : ℤ) :
+    (t.move_right).get p = t.get (p + 1) := by
+  unfold move_right get
+  match p with
+  | Int.ofNat n =>
+    rw [show Int.ofNat n + 1 = Int.ofNat (n + 1) from by grind]
+    cases n <;> simp [StackTape.head_eq_getD]
+  | Int.negSucc 0 => simp
+  | Int.negSucc (n + 1) =>
+    rw [show Int.negSucc (n + 1) + 1 = Int.negSucc n from rfl]
+    simp
+
+@[simp]
+lemma get_optionMove (t : BiTape Symbol) (d : Option Dir) (p : ℤ) :
+    (t.optionMove d).get p = t.get (p + optionDirToInt d) := by
+  unfold optionMove optionDirToInt
+  cases d with
+  | none => simp
+  | some d =>
+    cases d <;> simp [move, show p + (-1 : ℤ) = p - 1 from by omega]
+
+@[simp]
+lemma get_move_right_iterate (t : BiTape Symbol) (n : ℕ) (p : ℤ) :
+    (move_right^[n] t).get p = t.get (p + n):= by
+  induction n generalizing t p with
+  | zero => simp
+  | succ n ih => simp [Function.iterate_succ_apply, ih, Int.add_assoc]
+
+@[simp]
+lemma get_move_left_iterate (t : BiTape Symbol) (n : ℕ) (p : ℤ) :
+    (move_left^[n] t).get p = t.get (p - n):= by
+  induction n generalizing t p with
+  | zero => simp
+  | succ n ih =>
+    have : p - n - 1 = p - (n + 1) := by grind
+    simp [Function.iterate_succ_apply, ih, this]
+
 end Move
 
 /--
@@ -121,6 +206,16 @@ Write a value under the head of the `BiTape`.
 -/
 def write (t : BiTape Symbol) (a : Option Symbol) : BiTape Symbol := { t with head := a }
 
+@[simp]
+lemma get_write (t : BiTape Symbol) (a : Option Symbol) :
+    (t.write a).get = Function.update t.get 0 a := by
+  unfold write get Function.update
+  funext p
+  match p with
+  | Int.ofNat 0 => simp
+  | Int.ofNat (n + 1) => simp; grind
+  | Int.negSucc n => simp
+
 /--
 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`.
diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean
index 049d52a195..e64758dba8 100644
--- a/Cslib/Foundations/Data/StackTape.lean
+++ b/Cslib/Foundations/Data/StackTape.lean
@@ -106,6 +106,25 @@ def head (l : StackTape Symbol) : Option Symbol :=
   | [] => none
   | h :: _ => h
 
+lemma head_eq_getD (s : StackTape Symbol) :
+    s.head = s.toList[0]?.getD none := by
+  unfold head; cases s.toList <;> simp
+
+@[simp]
+lemma tail_getD (s : StackTape Symbol) (n : ℕ) :
+    s.tail.toList[n]?.getD none = s.toList[n + 1]?.getD none := by
+  cases s with | mk l h => cases l <;> simp [tail, nil]
+
+@[simp]
+lemma cons_getD_zero (x : Option Symbol) (s : StackTape Symbol) :
+    (cons x s).toList[0]?.getD none = x := by
+  cases x <;> (cases s with | mk l h => cases l <;> simp [cons])
+
+@[simp]
+lemma cons_getD_succ (x : Option Symbol) (s : StackTape Symbol) (n : ℕ) :
+    (cons x s).toList[n + 1]?.getD none = s.toList[n]?.getD none := by
+  cases x <;> (cases s with | mk l h => cases l <;> simp [cons])
+
 lemma eq_iff (l1 l2 : StackTape Symbol) :
     l1 = l2 ↔ l1.head = l2.head ∧ l1.tail = l2.tail := by
   constructor
@@ -115,6 +134,23 @@ lemma eq_iff (l1 l2 : StackTape Symbol) :
     cases l2 with | mk as2 h2 =>
     cases as1 <;> cases as2 <;> grind
 
+lemma ext (t₁ t₂ : StackTape Symbol) (h_toList_eq : t₁.toList = t₂.toList) :
+  t₁ = t₂ := by
+  obtain ⟨t₁, h₁⟩ := t₁
+  obtain ⟨t₂, h₂⟩ := t₂
+  simpa using h_toList_eq
+
+lemma ext_get (t₁ t₂ : StackTape Symbol)
+    (h_get_eq : ∀ p, t₁.toList.getD p none = t₂.toList.getD p none) :
+  t₁ = t₂ := by
+  apply ext
+  obtain ⟨l₁, h₁⟩ := t₁
+  obtain ⟨l₂, h₂⟩ := t₂
+  simp only [List.getD_eq_getElem?_getD] at h_get_eq
+  have hlen : l₁.length = l₂.length := by grind
+  apply List.ext_getElem hlen
+  grind
+
 @[simp]
 lemma head_cons (o : Option Symbol) (l : StackTape Symbol) : (cons o l).head = o := by
   cases o with

From 642162c56369302365a23c8e2507fe9d164355e8 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Mon, 20 Apr 2026 11:38:51 +0200
Subject: [PATCH 09/53] Apply suggestions from code review

Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com>
---
 Cslib/Foundations/Data/BiTape.lean | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean
index 91730dccbb..c2621771de 100644
--- a/Cslib/Foundations/Data/BiTape.lean
+++ b/Cslib/Foundations/Data/BiTape.lean
@@ -78,12 +78,13 @@ def mk₁ (l : List Symbol) : BiTape Symbol :=
   | [] => ∅
   | h :: t => { head := some h, left := ∅, right := StackTape.map_some t }
 
+open scoped Int in
 /-- Returns the tape symbol at positon `p` relative to the head, where
 positive numbers are right of the head and negative are left of the head. -/
 def get (t : BiTape Symbol) : ℤ → Option Symbol
-  | Int.ofNat 0 => t.head
-  | Int.ofNat (Nat.succ p') => t.right.toList[p']?.getD none
-  | Int.negSucc p' => t.left.toList[p']?.getD none
+  | 0 => t.head
+  | (p' + 1 : Nat) => t.right.toList[p']?.getD none
+  | -[p'+1] => t.left.toList[p']?.getD none
 
 /-- Two tapes are equal if and only if their `get` functions are equal. This allows to view
 tapes as functions `ℤ → Option Symbol`. -/
@@ -95,7 +96,7 @@ lemma ext_get (t₁ t₂ : BiTape Symbol) (h_get_eq : ∀ p, t₁.get p = t₂.g
   have h_right : right₁ = right₂ := by
     apply StackTape.ext_get
     intro p
-    simpa [get] using h_get_eq p.succ
+    simpa [get] using h_get_eq (p + 1)
   have h_left : left₁ = left₂ := by
     apply StackTape.ext_get
     intro p
@@ -157,7 +158,7 @@ lemma get_move_left (t : BiTape Symbol) (p : ℤ) :
     simp [StackTape.head_eq_getD]
   | Int.ofNat 1 => simp
   | Int.ofNat (n + 2) =>
-    rw [show Int.ofNat (n + 2) - 1 = Int.ofNat (n + 1) from by grind]
+    rw [show Int.ofNat (n + 2) - 1 = Int.ofNat (n + 1) by lia]
     simp
   | Int.negSucc n => simp
 
@@ -167,7 +168,7 @@ lemma get_move_right (t : BiTape Symbol) (p : ℤ) :
   unfold move_right get
   match p with
   | Int.ofNat n =>
-    rw [show Int.ofNat n + 1 = Int.ofNat (n + 1) from by grind]
+    rw [show Int.ofNat n + 1 = Int.ofNat (n + 1) by lia]
     cases n <;> simp [StackTape.head_eq_getD]
   | Int.negSucc 0 => simp
   | Int.negSucc (n + 1) =>
@@ -196,7 +197,7 @@ lemma get_move_left_iterate (t : BiTape Symbol) (n : ℕ) (p : ℤ) :
   induction n generalizing t p with
   | zero => simp
   | succ n ih =>
-    have : p - n - 1 = p - (n + 1) := by grind
+    have : p - n - 1 = p - (n + 1) := by lia
     simp [Function.iterate_succ_apply, ih, this]
 
 end Move
@@ -213,7 +214,7 @@ lemma get_write (t : BiTape Symbol) (a : Option Symbol) :
   funext p
   match p with
   | Int.ofNat 0 => simp
-  | Int.ofNat (n + 1) => simp; grind
+  | Int.ofNat (n + 1) => grind
   | Int.negSucc n => simp
 
 /--

From be6855a82b58c4690c37837976eb4c44dc22469b Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Mon, 20 Apr 2026 13:07:33 +0200
Subject: [PATCH 10/53] Simplify some proofs and add annotations.

---
 Cslib/Foundations/Data/BiTape.lean    | 25 +++++++++----------
 Cslib/Foundations/Data/StackTape.lean | 35 +++++++++++----------------
 2 files changed, 26 insertions(+), 34 deletions(-)

diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean
index c2621771de..74c6a8190b 100644
--- a/Cslib/Foundations/Data/BiTape.lean
+++ b/Cslib/Foundations/Data/BiTape.lean
@@ -81,6 +81,7 @@ def mk₁ (l : List Symbol) : BiTape Symbol :=
 open scoped Int in
 /-- Returns the tape symbol at positon `p` relative to the head, where
 positive numbers are right of the head and negative are left of the head. -/
+@[scoped grind]
 def get (t : BiTape Symbol) : ℤ → Option Symbol
   | 0 => t.head
   | (p' + 1 : Nat) => t.right.toList[p']?.getD none
@@ -88,8 +89,8 @@ def get (t : BiTape Symbol) : ℤ → Option Symbol
 
 /-- Two tapes are equal if and only if their `get` functions are equal. This allows to view
 tapes as functions `ℤ → Option Symbol`. -/
-lemma ext_get (t₁ t₂ : BiTape Symbol) (h_get_eq : ∀ p, t₁.get p = t₂.get p) :
-  t₁ = t₂ := by
+@[ext]
+lemma ext_get (t₁ t₂ : BiTape Symbol) (h_get_eq : ∀ p, t₁.get p = t₂.get p) : t₁ = t₂ := by
   obtain ⟨head₁, left₁, right₁⟩ := t₁
   obtain ⟨head₂, left₂, right₂⟩ := t₂
   have h_head : head₁ = head₂ := by simpa [get] using h_get_eq 0
@@ -101,7 +102,7 @@ lemma ext_get (t₁ t₂ : BiTape Symbol) (h_get_eq : ∀ p, t₁.get p = t₂.g
     apply StackTape.ext_get
     intro p
     simpa [get] using h_get_eq (Int.negSucc p)
-  simp only [h_head, h_left, h_right]
+  grind
 
 
 section Move
@@ -142,13 +143,14 @@ lemma move_right_move_left (t : BiTape Symbol) : t.move_right.move_left = t := b
 
 /-- Translate an optional direction into a head movement offset, where the positive
 direction is to the right. -/
+@[scoped grind]
 def optionDirToInt (d : Option Dir) : ℤ :=
   match d with
   | none => 0
   | some .left => -1
   | some .right => 1
 
-@[simp]
+@[simp, scoped grind =]
 lemma get_move_left (t : BiTape Symbol) (p : ℤ) :
     (t.move_left).get p = t.get (p - 1) := by
   unfold move_left get
@@ -162,7 +164,7 @@ lemma get_move_left (t : BiTape Symbol) (p : ℤ) :
     simp
   | Int.negSucc n => simp
 
-@[simp]
+@[simp, scoped grind =]
 lemma get_move_right (t : BiTape Symbol) (p : ℤ) :
     (t.move_right).get p = t.get (p + 1) := by
   unfold move_right get
@@ -175,23 +177,20 @@ lemma get_move_right (t : BiTape Symbol) (p : ℤ) :
     rw [show Int.negSucc (n + 1) + 1 = Int.negSucc n from rfl]
     simp
 
-@[simp]
+@[simp, scoped grind =]
 lemma get_optionMove (t : BiTape Symbol) (d : Option Dir) (p : ℤ) :
     (t.optionMove d).get p = t.get (p + optionDirToInt d) := by
   unfold optionMove optionDirToInt
-  cases d with
-  | none => simp
-  | some d =>
-    cases d <;> simp [move, show p + (-1 : ℤ) = p - 1 from by omega]
+  grind [move]
 
-@[simp]
+@[simp, scoped grind =]
 lemma get_move_right_iterate (t : BiTape Symbol) (n : ℕ) (p : ℤ) :
     (move_right^[n] t).get p = t.get (p + n):= by
   induction n generalizing t p with
   | zero => simp
   | succ n ih => simp [Function.iterate_succ_apply, ih, Int.add_assoc]
 
-@[simp]
+@[simp, scoped grind =]
 lemma get_move_left_iterate (t : BiTape Symbol) (n : ℕ) (p : ℤ) :
     (move_left^[n] t).get p = t.get (p - n):= by
   induction n generalizing t p with
@@ -207,7 +206,7 @@ Write a value under the head of the `BiTape`.
 -/
 def write (t : BiTape Symbol) (a : Option Symbol) : BiTape Symbol := { t with head := a }
 
-@[simp]
+@[simp, scoped grind =]
 lemma get_write (t : BiTape Symbol) (a : Option Symbol) :
     (t.write a).get = Function.update t.get 0 a := by
   unfold write get Function.update
diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean
index e64758dba8..add0b18edf 100644
--- a/Cslib/Foundations/Data/StackTape.lean
+++ b/Cslib/Foundations/Data/StackTape.lean
@@ -106,21 +106,21 @@ def head (l : StackTape Symbol) : Option Symbol :=
   | [] => none
   | h :: _ => h
 
-lemma head_eq_getD (s : StackTape Symbol) :
-    s.head = s.toList[0]?.getD none := by
+@[scoped grind =]
+lemma head_eq_getD (s : StackTape Symbol) : s.head = s.toList[0]?.getD none := by
   unfold head; cases s.toList <;> simp
 
-@[simp]
-lemma tail_getD (s : StackTape Symbol) (n : ℕ) :
-    s.tail.toList[n]?.getD none = s.toList[n + 1]?.getD none := by
+@[simp, scoped grind =]
+lemma tail_getElem? (s : StackTape Symbol) (n : ℕ) :
+    s.tail.toList[n]? = s.toList[n + 1]? := by
   cases s with | mk l h => cases l <;> simp [tail, nil]
 
-@[simp]
+@[simp, scoped grind =]
 lemma cons_getD_zero (x : Option Symbol) (s : StackTape Symbol) :
     (cons x s).toList[0]?.getD none = x := by
   cases x <;> (cases s with | mk l h => cases l <;> simp [cons])
 
-@[simp]
+@[simp, scoped grind =]
 lemma cons_getD_succ (x : Option Symbol) (s : StackTape Symbol) (n : ℕ) :
     (cons x s).toList[n + 1]?.getD none = s.toList[n]?.getD none := by
   cases x <;> (cases s with | mk l h => cases l <;> simp [cons])
@@ -134,30 +134,23 @@ lemma eq_iff (l1 l2 : StackTape Symbol) :
     cases l2 with | mk as2 h2 =>
     cases as1 <;> cases as2 <;> grind
 
-lemma ext (t₁ t₂ : StackTape Symbol) (h_toList_eq : t₁.toList = t₂.toList) :
-  t₁ = t₂ := by
+@[ext]
+lemma ext (t₁ t₂ : StackTape Symbol) (h_toList_eq : t₁.toList = t₂.toList) : t₁ = t₂ := by
   obtain ⟨t₁, h₁⟩ := t₁
   obtain ⟨t₂, h₂⟩ := t₂
   simpa using h_toList_eq
 
+@[ext]
 lemma ext_get (t₁ t₂ : StackTape Symbol)
-    (h_get_eq : ∀ p, t₁.toList.getD p none = t₂.toList.getD p none) :
-  t₁ = t₂ := by
-  apply ext
+    (h_get_eq : ∀ p : ℕ, t₁.toList[p]?.getD none = t₂.toList[p]?.getD none) :
+    t₁ = t₂ := by
   obtain ⟨l₁, h₁⟩ := t₁
   obtain ⟨l₂, h₂⟩ := t₂
-  simp only [List.getD_eq_getElem?_getD] at h_get_eq
-  have hlen : l₁.length = l₂.length := by grind
-  apply List.ext_getElem hlen
-  grind
+  grind [List.ext_getElem]
 
 @[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
+  grind
 
 @[simp]
 lemma tail_cons (o : Option Symbol) (l : StackTape Symbol) : (cons o l).tail = l := by

From 3110f77821d3c3798e724c68a470e605cea22927 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Thu, 30 Apr 2026 10:25:46 +0200
Subject: [PATCH 11/53] Move "expose" command below module-level documentation.

---
 Cslib/Computability/Machines/MultiTapeTuring/Basic.lean | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index e08ab23992..91ee0c781d 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -13,8 +13,6 @@ public import Cslib.Foundations.Data.RelatesInSteps
 public import Cslib.Computability.Machines.TuringCommon
 public import Mathlib.Algebra.Order.BigOperators.Group.Finset
 
-@[expose] public section
-
 /-!
 # Multi-Tape Turing Machines
 
@@ -63,6 +61,8 @@ There are multiple ways to talk about the behaviour of a multi-tape Turing machi
 
 -/
 
+@[expose] public section
+
 open Cslib Relation
 
 namespace Turing

From aa623433a9b32b44631aba1d5f30e1533ba9dc21 Mon Sep 17 00:00:00 2001
From: Kim Morrison <477956+kim-em@users.noreply.github.com>
Date: Tue, 5 May 2026 15:23:52 +1000
Subject: [PATCH 12/53] chore: route Zulip notifications to
 nightly-testing-cslib (#548)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This PR retargets the nightly-testing failure-detection workflow and the
adaptation-PR helper script from the shared `nightly-testing` channel to
the new `#nightly-testing-cslib` channel, in line with the [proposal to
split
`#nightly-testing`](https://leanprover.zulipchat.com/#narrow/channel/428973-nightly-testing/topic/proposal.20to.20split.20the.20channel/near/592721807)
into per-project channels for Mathlib, Batteries, and Cslib.

Topic names are unchanged so existing bookmarks and topic links continue
to resolve to the same conversations (which were also moved over).

The `#nightly-testing-cslib` channel mirrors the original (web-public,
history visible to subscribers, anyone can post).

Companion PRs:
https://github.com/leanprover-community/mathlib4/pull/38946,
https://github.com/leanprover-community/mathlib-ci/pull/33,
https://github.com/leanprover-community/batteries/pull/1794.

🤖 Prepared with Claude Code
---
 .../workflows/report_failures_nightly-testing.yml    | 12 ++++++------
 scripts/create-adaptation-pr.sh                      |  4 ++--
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/.github/workflows/report_failures_nightly-testing.yml b/.github/workflows/report_failures_nightly-testing.yml
index bdbd878814..edeeb91682 100644
--- a/.github/workflows/report_failures_nightly-testing.yml
+++ b/.github/workflows/report_failures_nightly-testing.yml
@@ -21,7 +21,7 @@ jobs:
         api-key: ${{ secrets.ZULIP_API_KEY }}
         email: 'github-mathlib4-bot@leanprover.zulipchat.com'
         organization-url: 'https://leanprover.zulipchat.com'
-        to: 'nightly-testing'
+        to: 'nightly-testing-cslib'
         type: 'stream'
         topic: 'Cslib status updates'
         content: |
@@ -101,7 +101,7 @@ jobs:
           'num_before': 1,
           'num_after': 0,
           'narrow': [
-            {'operator': 'stream', 'operand': 'nightly-testing'},
+            {'operator': 'stream', 'operand': 'nightly-testing-cslib'},
             {'operator': 'topic', 'operand': 'Cslib status updates'},
             {'operator': 'sender', 'operand': bot_email}
           ],
@@ -113,7 +113,7 @@ jobs:
             # Post the success message
             request = {
                 'type': 'stream',
-                'to': 'nightly-testing',
+                'to': 'nightly-testing-cslib',
                 'topic': 'Cslib status updates',
                 'content': f"✅ The latest CI for Cslib's [nightly-testing branch](https://github.com/leanprover/cslib/tree/nightly-testing) has succeeded! ([{os.getenv('SHA')}](https://github.com/${{ github.repository }}/commit/{os.getenv('SHA')}))"
             }
@@ -250,7 +250,7 @@ jobs:
         api-key: ${{ secrets.ZULIP_API_KEY }}
         email: 'github-mathlib4-bot@leanprover.zulipchat.com'
         organization-url: 'https://leanprover.zulipchat.com'
-        to: 'nightly-testing'
+        to: 'nightly-testing-cslib'
         type: 'stream'
         topic: 'Cslib status updates'
         content: |
@@ -350,7 +350,7 @@ jobs:
               'num_before': 1,
               'num_after': 0,
               'narrow': [
-                {'operator': 'stream', 'operand': 'nightly-testing'},
+                {'operator': 'stream', 'operand': 'nightly-testing-cslib'},
                 {'operator': 'topic', 'operand': 'Cslib bump branch reminders'},
                 {'operator': 'sender', 'operand': bot_email}
               ],
@@ -388,7 +388,7 @@ jobs:
                 # Post the reminder message
                 request = {
                     'type': 'stream',
-                    'to': 'nightly-testing',
+                    'to': 'nightly-testing-cslib',
                     'topic': 'Cslib bump branch reminders',
                     'content': payload
                 }
diff --git a/scripts/create-adaptation-pr.sh b/scripts/create-adaptation-pr.sh
index 01587009c9..47b1ee2a10 100755
--- a/scripts/create-adaptation-pr.sh
+++ b/scripts/create-adaptation-pr.sh
@@ -203,13 +203,13 @@ if git diff --name-only bump/"$BUMPVERSION" bump/nightly-"$NIGHTLYDATE" | grep -
   zulip_title="cslib#$pr_number adaptations for nightly-$NIGHTLYDATE"
   zulip_body=$(printf "> %s\n\nPlease review this PR. At the end of the month this diff will land in 'main'." "$pr_title cslib#$pr_number")
 
-  echo "Posting the link to the PR in a new thread on the #nightly-testing channel on Zulip"
+  echo "Posting the link to the PR in a new thread on the #nightly-testing-cslib channel on Zulip"
   echo "Here is the message:"
   echo "Title: $zulip_title"
   echo " Body: $zulip_body"
 
   if command -v zulip-send >/dev/null 2>&1; then
-    zulip_command="zulip-send --stream nightly-testing --subject \"$zulip_title\" --message \"$zulip_body\""
+    zulip_command="zulip-send --stream nightly-testing-cslib --subject \"$zulip_title\" --message \"$zulip_body\""
     echo "Running the following 'zulip-send' command to do this:"
     echo "> $zulip_command"
     eval "$zulip_command"

From 02052d4c7d64fe18ea3519b4cc481e159cca2516 Mon Sep 17 00:00:00 2001
From: "mathlib-nightly-testing[bot]"
 <258991302+mathlib-nightly-testing[bot]@users.noreply.github.com>
Date: Tue, 5 May 2026 17:51:15 -0400
Subject: [PATCH 13/53] chore: bump mathlib to 6cf3ab1, fix breaking changes
 (#547)

Bump `mathlib` dependency to
[6cf3ab1](https://github.com/leanprover-community/mathlib4/commit/6cf3ab1c11e19e328c2e535bdd32d66dc7842fb5):
chore: make argument in `zero_le`/`one_le` implicit (#38148)
(2026-04-29)
Previously at:
[6727686](https://github.com/leanprover-community/mathlib4/commit/672768680fb7e4eff7dac7ceca12bc3889fd60fd):
ci(olean_report): use `lake env` instead of `lake exec` to invoke cache
binary (#38712) (2026-04-29)

Tracking issue: https://github.com/leanprover/cslib/issues/546

---

This PR bumps `mathlib` to an identified incompatible (first-known-bad)
commit (`6cf3ab1`) so you can reproduce and fix the incompatibility
locally by checking out this branch.

_Opened automatically by
[downstream-reports/track-incompatibility](https://github.com/leanprover-community/downstream-reports)
via [this workflow
run](https://github.com/leanprover/cslib/actions/runs/25351406099)._

---------

Co-authored-by: mathlib-nightly-testing[bot] <mathlib-nightly-testing[bot]@users.noreply.github.com>
Co-authored-by: Chris Henson <chrishenson.net@gmail.com>
---
 Cslib/Computability/Automata/NA/Concat.lean | 2 +-
 lake-manifest.json                          | 4 ++--
 lakefile.toml                               | 2 +-
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/Cslib/Computability/Automata/NA/Concat.lean b/Cslib/Computability/Automata/NA/Concat.lean
index 0b2c10d3e7..7cc7c1c18f 100644
--- a/Cslib/Computability/Automata/NA/Concat.lean
+++ b/Cslib/Computability/Automata/NA/Concat.lean
@@ -177,7 +177,7 @@ theorem finConcat_language_eq [Inhabited Symbol] :
     obtain ⟨ss, ⟨_, h_ωtr⟩, _⟩ := concat_run_exists h_xl1 h_run2
     #adaptation_note
     /-- A grind regression found moving to nightly-2026-03-31 (changes from lean#13166) -/
-    have h_mtr := LTS.OmegaExecution.extract_mTr h_ωtr (zero_le (xl1.length + xl2.length))
+    have h_mtr := LTS.OmegaExecution.extract_mTr h_ωtr (zero_le (a := xl1.length + xl2.length))
     simp [← append_append_ωSequence, extract_eq_drop_take,
       take_append_of_le_length, ← List.length_append] at h_mtr
     have : ss (xl1.length + xl2.length) = (ss.drop xl1.length) xl2.length := by grind
diff --git a/lake-manifest.json b/lake-manifest.json
index b16de692da..ca8591cf36 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -5,10 +5,10 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "672768680fb7e4eff7dac7ceca12bc3889fd60fd",
+   "rev": "6cf3ab1c11e19e328c2e535bdd32d66dc7842fb5",
    "name": "mathlib",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "672768680fb7e4eff7dac7ceca12bc3889fd60fd",
+   "inputRev": "6cf3ab1c11e19e328c2e535bdd32d66dc7842fb5",
    "inherited": false,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/plausible",
diff --git a/lakefile.toml b/lakefile.toml
index 6f836bf81b..4169d4b8e6 100644
--- a/lakefile.toml
+++ b/lakefile.toml
@@ -18,7 +18,7 @@ weak.linter.unicodeLinter = false
 [[require]]
 name = "mathlib"
 scope = "leanprover-community"
-rev = "672768680fb7e4eff7dac7ceca12bc3889fd60fd"
+rev = "6cf3ab1c11e19e328c2e535bdd32d66dc7842fb5"
 
 [[lean_lib]]
 name = "Cslib"

From cdfe65513343e5eebb6e43fd6329851d1aefa7e8 Mon Sep 17 00:00:00 2001
From: thomaskwaring <51426330+thomaskwaring@users.noreply.github.com>
Date: Wed, 6 May 2026 22:26:29 +0200
Subject: [PATCH 14/53] feat(Foundations/Data/Relation): strongly normalising
 elements of a type equipped with a relation (#549)

This PR defines a predicate `SN r x` (better naming suggestions welcome)
expressing that there is no infinite chain of `r`-related elements
starting with `x`. This extends the definition of `Terminating` using
`WellFounded` to individual elements, using `Acc`.

---

I'm very open to being told this is not a useful generalisation /
abstraction, but the existing API for `Acc` does seem to make certain
proofs easier. For instance, `sn_app_left` in
`LambdaCalculus/LocallyNameless/Untyped/StrongNorm` falls out as
reduction on `M` is a subrelation of reduction on `M.app N`.

---------

Co-authored-by: twwar <tom.waring@unimelb.edu.au>
Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com>
---
 Cslib/Foundations/Data/Relation.lean          | 97 ++++++++++++++-----
 .../LocallyNameless/Stlc/StrongNorm.lean      | 10 +-
 .../LocallyNameless/Untyped/StrongNorm.lean   | 70 +++++++------
 3 files changed, 113 insertions(+), 64 deletions(-)

diff --git a/Cslib/Foundations/Data/Relation.lean b/Cslib/Foundations/Data/Relation.lean
index 743e2f22df..b8060d3389 100644
--- a/Cslib/Foundations/Data/Relation.lean
+++ b/Cslib/Foundations/Data/Relation.lean
@@ -203,38 +203,91 @@ theorem Confluent.equivalence_join_reflTransGen (h : Confluent r) :
   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)
+
+lemma SN_iff_SN_of_rel (x : α) : SN r x ↔ ∀ y, r x y → SN r y := by grind [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
-  suffices _ : (fun a b => TransGen r b a) = TransGen (Function.swap r) by grind
-  grind [transGen_swap]
+  simp_rw [iff_forall_sn, SN.iff_transGen] at ht ⊢
+  exact ht
 
 theorem Terminating.ofTransGen : Terminating (TransGen r) → Terminating r := by
-  suffices _ : (fun a b => TransGen r b a) = TransGen (Function.swap r) by grind
-  grind [transGen_swap]
+  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_transGen : Terminating (TransGen r) ↔ Terminating r :=
-  ⟨ofTransGen, toTransGen⟩
+theorem Terminating.iff_isEmpty_chain :
+    Terminating r ↔ IsEmpty {f : ℕ → α // ∀ n, r (f n) (f (n + 1))} :=
+  wellFounded_iff_isEmpty_descending_chain
 
-theorem Terminating.subrelation {r' : α → α → Prop} (hr : Terminating r) (h : Subrelation r' r) :
+theorem Terminating.of_le {r' : α → α → Prop} (hr : Terminating r) (h : r' ≤ r) :
     Terminating r' := by
-  rw [Terminating, wellFounded_iff_isEmpty_descending_chain] at hr ⊢
-  rw [isEmpty_subtype]
-  intro f hf
-  exact hr.elim ⟨f, fun n ↦ by exact h (hf n)⟩
-
-theorem Terminating.isNormalizing (h : Terminating r) : Normalizing r := by
-  unfold Terminating at h
-  intro t
-  apply WellFounded.induction h t
-  intro a ih
-  by_cases ha : Reducible r a
-  · obtain ⟨b, hab⟩ := ha
-    obtain ⟨n, hbn, hn⟩ := ih b hab
-    exact ⟨n, ReflTransGen.head hab hbn, hn⟩
-  · use a
+  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
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
index e9fd87fee6..9c98b17dac 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
@@ -26,7 +26,7 @@ universe u v
 
 namespace LambdaCalculus.LocallyNameless.Stlc
 
-open Untyped Typing LambdaCalculus.LocallyNameless.Untyped.Term
+open Untyped Typing LambdaCalculus.LocallyNameless.Untyped.Term Relation
 
 variable {Var : Type u} {Base : Type v} [DecidableEq Var] [HasFresh Var]
 
@@ -43,9 +43,9 @@ open scoped Term
 @[scoped grind]
 structure Saturated (S : Set (Term Var)) : Prop where
   lc : ∀ M ∈ S, LC M
-  sn : ∀ M ∈ S, SN M
+  sn : ∀ M ∈ S, SN FullBeta M
   neutal_lc : ∀ M, Neutral M → LC M → M ∈ S
-  multiApp : ∀ M N P, LC N → SN N → multiApp (M ^ N) P ∈ S → multiApp (M.abs.app N) P ∈ S
+  multiApp : ∀ M N P, LC N → SN FullBeta N → multiApp (M ^ N) P ∈ S → multiApp (M.abs.app N) P ∈ S
 
 /-- The semantic map maps each type to a corresponding saturated set of terms.
     For the strong normalization proof to work, we must ensure that
@@ -56,7 +56,7 @@ structure Saturated (S : Set (Term Var)) : Prop where
 -/
 @[simp, scoped grind =]
 def semanticMap : Ty Base → Set (Term Var)
-  | .base _ => { t | SN t ∧ LC t }
+  | .base _ => { t | SN FullBeta t ∧ LC t }
   | .arrow τ₁ τ₂ => { t | ∀ s, s ∈ semanticMap τ₁ → app t s ∈ semanticMap τ₂ }
 
 /-- The sets constructed by semanticMap are saturated -/
@@ -117,7 +117,7 @@ lemma soundness {Γ : Context Var (Ty Base)} (derivation_t : Γ ⊢ t ∶ τ) :
 /-- Using soundness and the fact that the empty context
     is entailed by any environment, we can conclude that
     a well-typed term is strongly normalizing. -/
-theorem strong_norm {t : Term Var} {τ : Ty Base} (der : Γ ⊢ t ∶ τ) : SN t := by
+theorem strong_norm {t : Term Var} {τ : Ty Base} (der : Γ ⊢ t ∶ τ) : SN FullBeta t := by
   apply (semanticMap_saturated τ).sn
   apply (soundness der [] (by grind) entails_context_empty)
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean
index 2c5f2e7dc6..793061cfee 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean
@@ -24,59 +24,52 @@ namespace LambdaCalculus.LocallyNameless.Untyped.Term
 
 variable {Var : Type u} {t t' : Term Var}
 
-open FullBeta
+open FullBeta Relation
 
 attribute [grind =] Finset.union_singleton
 
-/-- A term is strongly normalizing if every reduction sequence terminates at some point.
-    This is ensured by the following type as inductive data must always be finite. -/
-inductive SN {α} : Term α → Prop
-| sn t : (∀ t', t ⭢βᶠ t' → SN t') → SN t
-
-attribute [scoped grind .] SN.sn
-
 /-- A single β-reduction step preserves strong normalization. -/
-lemma sn_step (t_st_t' : t ⭢βᶠ t') (sn_t : SN t) : SN t' := by
-  grind [cases SN]
+lemma sn_step (t_st_t' : t ⭢βᶠ t') (sn_t : SN FullBeta t) : SN FullBeta t' :=
+  sn_t.of_rel t_st_t'
 
 /-- Multiple β-reduction steps also preserve strong normalization. -/
-lemma sn_steps (t_st_t' : t ↠βᶠ t') (sn_t : SN t) : SN t' := by
-  induction t_st_t' with grind [sn_step]
+lemma sn_steps (t_st_t' : t ↠βᶠ t') (sn_t : SN FullBeta t) : SN FullBeta t' :=
+  sn_t.of_rel_reflTransGen t_st_t'
 
 /-- Free variables are strongly normalizing. -/
-lemma sn_fvar {x : Var} : SN (fvar x) := by
-  grind only [cases Xi, cases Beta, SN]
+lemma sn_fvar {x : Var} : SN FullBeta (fvar x) := by
+  rw [SN_iff_SN_of_rel]
+  grind only [cases Xi, cases Beta]
 
 /-- An application is strongly normalizing if the left and right terms are strongly normalizing,
     as well as all possible future top level abstraction application beta reductions -/
-lemma sn_app (t s : Term Var) (sn_t : SN t) (sn_s : SN s)
-    (hβ : ∀ {t' s' : Term Var}, t ↠βᶠ t'.abs → s ↠βᶠ s' → SN (t' ^ s')) : SN (t.app s) := by
+lemma sn_app (t s : Term Var) (sn_t : SN FullBeta t) (sn_s : SN FullBeta s)
+    (hβ : ∀ {t' s' : Term Var}, t ↠βᶠ t'.abs → s ↠βᶠ s' → SN FullBeta (t' ^ s')) :
+    SN FullBeta (t.app s) := by
   induction sn_t generalizing s with
-  | sn t ht ih_t =>
+  | intro t ht ih_t =>
     induction sn_s with
-    | sn s hs ih_s =>
+    | intro s hs ih_s =>
       constructor
       intro u hstep
       cases hstep with
       | base h => cases h; grind
       | appL _ h_s_red => apply ih_s _ h_s_red
                           grind [Relation.ReflTransGen.head]
-      | appR _ h_t_red => apply ih_t _ h_t_red _ (SN.sn s hs)
+      | appR _ h_t_red => apply ih_t _ h_t_red _ (SN.intro hs)
                           grind [Relation.ReflTransGen.head]
 
 /-- The left side of a strongly normalizing application is strongly normalizing. -/
-lemma sn_app_left (M N : Term Var) (lc_N : Term.LC N) (sn_MN : SN (M.app N)) :
-    SN M := by
-  generalize Heq : M.app N = P
-  rw [Heq] at sn_MN
-  induction sn_MN generalizing M N with grind
+lemma sn_app_left (M N : Term Var) (lc_N : Term.LC N) (sn_MN : SN FullBeta (M.app N)) :
+    SN FullBeta M := by
+  refine sn_MN.onFun_of_image (f := (·.app N)) |>.of_le fun _ _ => ?_
+  exact Xi.appR lc_N
 
 /-- The right side of a strongly normalizing application is strongly normalizing. -/
-lemma sn_app_right (M N : Term Var) (lc_N : Term.LC M) (sn_MN : SN (M.app N)) :
-    SN N := by
-  generalize Heq : M.app N = P
-  rw [Heq] at sn_MN
-  induction sn_MN generalizing M N with grind
+lemma sn_app_right (M N : Term Var) (lc_M : Term.LC M) (sn_MN : SN FullBeta (M.app N)) :
+    SN FullBeta N := by
+  refine sn_MN.onFun_of_image (f := M.app) |>.of_le fun _ _ => ?_
+  exact Xi.appL lc_M
 
 /-- A neutral term is a term of the form v t₁ … t_n where
     v is a variable and t₁ … t_n are strongly normalizing terms. -/
@@ -87,7 +80,7 @@ inductive Neutral : Term Var → Prop
 /-- Just a free variable is neutral. -/
 | fvar : ∀ x, Neutral (fvar x)
 /-- Applying a strongly normalizing term to a neutral term yields a neutral term. -/
-| app : ∀ t1 t2, Neutral t1 → SN t2 → Neutral (app t1 t2)
+| app : ∀ t1 t2, Neutral t1 → SN FullBeta t2 → Neutral (app t1 t2)
 
 --attribute [scoped grind .] Neutral.bvar Neutral.fvar Neutral.app
 
@@ -100,17 +93,19 @@ lemma neutral_steps (Hneut : Neutral t) (Hsteps : t ↠βᶠ t') : Neutral t' :=
   induction Hsteps <;> grind [neutral_step]
 
 /-- Neutral terms are strongly normalizing. -/
-lemma sn_neutral (Hneut : Neutral t) : SN t := by
+lemma sn_neutral (Hneut : Neutral t) : SN FullBeta t := by
   induction Hneut with
   | app => grind [→ neutral_steps, sn_app]
-  | _ => grind only [SN, cases Xi]
+  | _ =>
+    rw [SN_iff_SN_of_rel]
+    grind only [cases Xi]
 
 /-- A lambda abstraction is strongly normalizing if its body is strongly normalizing. -/
-lemma sn_abs [DecidableEq Var] [HasFresh Var] {M N : Term Var} (sn_MN : SN (M ^ N)) (lc_N : LC N) :
-    SN (abs M) := by
+lemma sn_abs [DecidableEq Var] [HasFresh Var] {M N : Term Var} (sn_MN : SN FullBeta (M ^ N))
+    (lc_N : LC N) : SN FullBeta (abs M) := by
   generalize h : (M ^ N) = M_open at sn_MN
   induction sn_MN generalizing M N with
-  | sn =>
+  | intro =>
     constructor
     intro _ h_step
     cases h_step with
@@ -123,8 +118,9 @@ lemma sn_abs [DecidableEq Var] [HasFresh Var] {M N : Term Var} (sn_MN : SN (M ^
       1. N is locally closed,
       1. M ^ N P₁ … Pₙ is locally closed -/
 lemma sn_abs_app_multiApp [DecidableEq Var] [HasFresh Var] {Ps} {M N : Term Var}
-    (sn_N : SN N) (sn_MNPs : SN (multiApp (M ^ N) Ps))
-    (lc_N : LC N) (lc_MNPs : LC (multiApp (M ^ N) Ps)) : SN (multiApp (M.abs.app N) Ps) := by
+    (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
   | nil =>
     apply sn_app

From ab16df6f9145bbee4e0c461402689c99be78c3bf Mon Sep 17 00:00:00 2001
From: Fabrizio Montesi <famontesi@gmail.com>
Date: Thu, 7 May 2026 17:29:59 +0200
Subject: [PATCH 15/53] feat: Modal Logic (#528)

Adds Modal Logic and the Modal Cube, including all the 15 well-known
modal logics (K, D, T, S5, etc.) and their relationships.

The notation that overlaps with propositional logic is consistent with
the existing module.

Note for future work (or here, if somebody can see an easy fix that
doesn't compromise readability for modal logicians): I'm not very
satisfied by the notation for judgements, which includes a ',' so it can
lead to some parsing trouble.

---------

Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com>
Co-authored-by: Chris Henson <chrishenson.net@gmail.com>
---
 Cslib.lean                           |   3 +
 Cslib/Foundations/Data/Relation.lean |  14 ++
 Cslib/Logics/Modal/Basic.lean        | 269 +++++++++++++++++++++++++++
 Cslib/Logics/Modal/Cube.lean         | 139 ++++++++++++++
 Cslib/Logics/Modal/Denotation.lean   |  51 +++++
 references.bib                       |  10 +
 6 files changed, 486 insertions(+)
 create mode 100644 Cslib/Logics/Modal/Basic.lean
 create mode 100644 Cslib/Logics/Modal/Cube.lean
 create mode 100644 Cslib/Logics/Modal/Denotation.lean

diff --git a/Cslib.lean b/Cslib.lean
index 37a038ee41..92a251cdfd 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -129,5 +129,8 @@ public import Cslib.Logics.LinearLogic.CLL.CutElimination
 public import Cslib.Logics.LinearLogic.CLL.EtaExpansion
 public import Cslib.Logics.LinearLogic.CLL.MLL
 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.Propositional.Defs
 public import Cslib.Logics.Propositional.NaturalDeduction.Basic
diff --git a/Cslib/Foundations/Data/Relation.lean b/Cslib/Foundations/Data/Relation.lean
index b8060d3389..784e11b1e3 100644
--- a/Cslib/Foundations/Data/Relation.lean
+++ b/Cslib/Foundations/Data/Relation.lean
@@ -69,6 +69,10 @@ theorem MJoin.single (h : ReflTransGen r a b) : MJoin r a b := by
 /-- 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 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
 
@@ -148,6 +152,16 @@ theorem Confluent_of_unique_end {x : α} (h : ∀ y : α, ReflTransGen r y x) :
 /-- 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`. -/
+class Serial (r : α → α → Prop) where
+  serial a : Reducible r a
+
+@[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
 
diff --git a/Cslib/Logics/Modal/Basic.lean b/Cslib/Logics/Modal/Basic.lean
new file mode 100644
index 0000000000..a627923676
--- /dev/null
+++ b/Cslib/Logics/Modal/Basic.lean
@@ -0,0 +1,269 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi, Marianna Girlando
+-/
+
+module
+
+public import Cslib.Init
+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 Mathlib.Logic.Nonempty
+
+/-! # Modal Logic
+
+Modal logic is a logic for reasoning about relational structures, studying statements about
+necessity (`□φ`) and possibility `◇φ`.
+
+## References
+
+* [P. Blackburn, M. de Rijke, Y. Venema, *Modal Logic*][Blackburn2001]
+* The definitions of theory equivalence and the denotational semantics of worlds are inspired by
+  the development of `Cslib.Logic.HML`.
+-/
+
+@[expose] public section
+
+namespace Cslib.Logic.Modal
+
+/-- A model consists of a relation between worlds `r` and a valuation `v`. -/
+structure Model (World : Type*) (Atom : Type*) where
+  /-- World accessibility relation. -/
+  r : World → World → Prop
+  /-- Valuation of atoms at a world. -/
+  v : World → Atom → Prop
+
+/-- Propositions. -/
+inductive Proposition (Atom : Type u) : Type u where
+  /-- Atomic proposition. -/
+  | atom (p : Atom)
+  /-- Negation. -/
+  | neg (φ : 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
+
+/-- Disjunction. -/
+def Proposition.or (φ₁ φ₂ : Proposition Atom) : Proposition Atom := ¬(¬φ₁ ∧ ¬φ₂)
+
+@[inherit_doc] scoped infix:35 " ∨ " => Proposition.or
+
+/-- Implication. -/
+def Proposition.impl (φ₁ φ₂ : Proposition Atom) : Proposition Atom := ¬φ₁ ∨ φ₂
+
+@[inherit_doc] scoped infix:30 " → " => Proposition.impl
+
+/-- Bi-implication. -/
+def Proposition.iff (φ₁ φ₂ : Proposition Atom) : Proposition Atom := (φ₁ → φ₂) ∧ (φ₂ → φ₁)
+
+@[inherit_doc] scoped infix:30 " ↔ " => Proposition.iff
+
+/-- Necessity. -/
+def Proposition.box (φ : Proposition Atom) : Proposition Atom := ¬◇¬φ
+
+@[inherit_doc] scoped prefix:40 "□" => Proposition.box
+
+/-- 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 φ
+  | .and φ₁ φ₂ => Satisfies m w φ₁ ∧ Satisfies m w φ₂
+  | .diamond φ => ∃ w', m.r w w' ∧ Satisfies m w' φ
+
+/-- Judgement, representing the conclusions one reaches in modal logic. -/
+structure Judgement World Atom where
+  /-- Constructs a judgement. -/
+  mk ::
+  /-- Model. -/
+  m : Model World Atom
+  /-- The world satisfying the proposition `φ`. -/
+  w : World
+  /-- The proposition satisfied by the world `w`. -/
+  φ : Proposition Atom
+
+@[inherit_doc] scoped notation "Modal[" m "," w " ⊨ " φ "]" => Judgement.mk m w φ
+
+/-- Satisfaction for judgements. This just refers to the unbundled `Satisfies`. -/
+@[simp, scoped grind =]
+def Satisfies.Bundled (j : Judgement World Atom) : Prop := Satisfies j.m j.w j.φ
+
+instance : HasInferenceSystem (Judgement World Atom) := ⟨Satisfies.Bundled⟩
+
+open scoped InferenceSystem Proposition
+
+@[scoped grind =]
+theorem derivation_def {m : Model World Atom} {w : World} {φ : Proposition Atom} :
+  ⇓Modal[m,w ⊨ φ] = Satisfies 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
+
+/-- Characterisation of the `∨` connective.
+
+Disjunction is defined in terms of the more primitive connectives given in `Proposition`.
+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]
+
+/-- 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.impl_iff_impl {m : Model World Atom} :
+    ⇓Modal[m,w ⊨ φ₁ → φ₂] ↔ (⇓Modal[m,w ⊨ φ₁] → ⇓Modal[m,w ⊨ φ₂]) := by grind [Proposition.impl]
+
+/-- Characterisation of the `□` modality.
+
+Necessity is defined in terms of the more primitive connectives given in `Proposition`.
+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]
+
+/-- The theory of a world in a model is the set of all propositions that it satifies. -/
+abbrev theory (m : Model World Atom) (w : World) : Set (Proposition Atom) :=
+  {φ | ⇓Modal[m,w ⊨ φ]}
+
+/-- Two worlds are theory-equivalent under a model if they have the same theory. -/
+abbrev TheoryEq (m : Model World Atom) (w₁ w₂ : World) :=
+  theory m w₁ = theory m w₂
+
+theorem TheoryEq.ext_iff : TheoryEq m w₁ w₂ ↔ (∀ φ, φ ∈ theory m w₁ ↔ φ ∈ theory m w₂) := by
+  grind
+
+/-- Any proposition satisfied by a world is in the theory of that world. -/
+@[scoped grind →]
+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]
+
+/-- If two worlds are theory equivalent and the former satisfies a proposition, the latter does as
+well. -/
+theorem theoryEq_satisfies {m : Model World Atom} (h : TheoryEq m w₁ w₂)
+    (hs : Satisfies m w₁ φ) : ⇓Modal[m,w₂ ⊨ φ] := by
+  apply TheoryEq.ext_iff.1 at h
+  exact (h φ).mp hs
+
+/-- 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
+  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]
+
+/-- The T axiom, valid for all reflexive models. -/
+theorem Satisfies.t {m : Model World Atom} [instRefl : Std.Refl m.r] {w : World}
+    (φ : Proposition Atom) : ⇓Modal[m,w ⊨ φ → ◇φ] := by grind [instRefl.refl w]
+
+/-- Any model that admits the axiom T is reflexive. -/
+theorem Satisfies.t_refl {r : World → World → Prop} [Nonempty Atom]
+    (h : ∀ {v} {w} {φ : Proposition Atom}, ⇓Modal[⟨r, v⟩,w ⊨ φ → ◇φ]) : Std.Refl r where
+  refl w := by
+    have a := Classical.arbitrary Atom
+    let v := fun (w' : World) (a : Atom) => w' = w
+    let h' := h (v := v) (w := w) (φ := .atom a)
+    grind
+
+/-- In any reflexive model, `□φ → φ` is equivalent to `φ → ◇φ`. -/
+theorem Satisfies.t_box_diamond [Std.Refl m.r] : ⇓Modal[m,w ⊨ □φ → φ] ↔ ⇓Modal[m,w ⊨ φ → ◇φ] := by
+  have := Std.Refl.refl (r := m.r) w
+  grind
+
+/-- The B axiom, valid for all symmetric models. -/
+theorem Satisfies.b {m : Model World Atom} [Std.Symm m.r] {w : World} (φ : Proposition Atom) :
+    ⇓Modal[m,w ⊨ φ → □◇φ] := by
+  have := Std.Symm.symm (r := m.r) w
+  grind
+
+/-- Any model that admits the axiom B is symmetric. -/
+theorem Satisfies.b_symm {World Atom} {r : World → World → Prop} [Nonempty Atom]
+    (h : ∀ {v} {w} {φ : Proposition Atom}, ⇓Modal[⟨r, v⟩,w ⊨ φ → □◇φ]) : Std.Symm r where
+  symm w₁ := by
+    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₁
+    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]
+  intro h
+  rcases h with ⟨w', h₁, w'', h₂, hs⟩
+  exact ⟨w'', IsTrans.trans _ _ _ h₁ h₂, hs⟩
+
+/-- Any model that admits 4 is transitive. -/
+theorem Satisfies.four_trans {r : World → World → Prop} [Nonempty Atom]
+    (h : ∀ {v} {w} {φ : Proposition Atom}, ⇓Modal[⟨r, v⟩,w ⊨ ◇◇φ → ◇φ]) : IsTrans World r where
+  trans w₁ w₂ w₃ h₁ h₂ := by
+    have a := Classical.arbitrary Atom
+    let v := fun (w' : World) (a : Atom) => w' = w₃
+    let h' := h (v := v) (w := w₁) (φ := .atom a)
+    grind
+
+/-- The 5 axiom, valid for all Euclidean models. -/
+theorem Satisfies.five {m : Model World Atom} [Relation.RightEuclidean m.r]
+    {w : World}
+    (φ : Proposition Atom) : ⇓Modal[m,w ⊨ ◇φ → □◇φ] := by
+  have := @Relation.RightEuclidean.rightEuclidean (r := m.r)
+  grind
+
+/-- Any model that admits 5 is Euclidean. -/
+theorem Satisfies.five_rightEuclidean {r : World → World → Prop} [Nonempty Atom]
+    (h : ∀ {v} {w : World} {φ : Proposition Atom}, ⇓Modal[⟨r, v⟩,w ⊨ ◇φ → □◇φ]) :
+    Relation.RightEuclidean r where
+  rightEuclidean {w₁ w₂ w₃} h₁ h₂ := by
+    have a := Classical.arbitrary Atom
+    let v := fun (w' : World) (a : Atom) => w' = w₃
+    let h' := h (v := v) (w := w₁) (φ := .atom a)
+    grind
+
+/-- The D axiom, valid for all serial models. -/
+theorem Satisfies.d {m : Model World Atom} [Relation.Serial m.r] {w} (φ : Proposition Atom) :
+    ⇓Modal[m,w ⊨ □φ → ◇φ] := by
+  have : ∃ w', m.r w w' := Relation.Serial.serial w
+  grind
+
+/-- Any model that admits D is serial. -/
+theorem Satisfies.d_serial {r : World → World → Prop} [Nonempty Atom]
+    (h : ∀ {v} {w} {φ : Proposition Atom}, ⇓Modal[⟨r, v⟩,w ⊨ □φ → ◇φ]) : Relation.Serial r where
+  serial w₁ := by
+    have a := Classical.arbitrary Atom
+    let v := fun (w' : World) (a : Atom) => w' = w₁
+    let h' := h (v := v) (w := w₁) (φ := .atom a)
+    grind
+
+/-- A proposition is valid in a class of models `S` (modelled as a set) if it is satisfied under
+all models in `S` for all worlds. -/
+@[simp, scoped grind =]
+def Proposition.valid (S : Set (Model World Atom)) (φ : Proposition Atom) : Prop :=
+  ∀ (m : Model World Atom), ∀ (_ : m ∈ S), ∀ (w : World), ⇓Modal[m,w ⊨ φ]
+
+/-- The modal logic of a class of models `S` is the set of all propositions valid in `S`. -/
+@[simp, scoped grind =]
+def logic (S : Set (Model World Atom)) : Set (Proposition Atom) :=
+  {φ | φ.valid S}
+
+end Cslib.Logic.Modal
diff --git a/Cslib/Logics/Modal/Cube.lean b/Cslib/Logics/Modal/Cube.lean
new file mode 100644
index 0000000000..38b28295af
--- /dev/null
+++ b/Cslib/Logics/Modal/Cube.lean
@@ -0,0 +1,139 @@
+/-
+Copyright (c) 2026 Fabrizio Montesi. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Fabrizio Montesi, Marianna Girlando
+-/
+
+module
+
+public import Cslib.Logics.Modal.Basic
+
+/-! # Modal Logic Cube
+
+This module formalises the Modal Cube, including all the 15 foundational modal logics and their
+relationships.
+
+## References
+
+* [P. Blackburn, M. de Rijke, Y. Venema, *Modal Logic*][Blackburn2001]
+
+-/
+
+@[expose] public section
+
+namespace Cslib.Logic.Modal
+
+/-- The modal logic K. -/
+@[simp, scoped grind =]
+def K World Atom := logic (Set.univ (α := Model World Atom))
+
+/-- The modal logic T. -/
+@[simp, scoped grind =]
+def T World Atom := logic {m : Model World Atom | Std.Refl m.r}
+
+/-- The modal logic B. -/
+@[simp, scoped grind =]
+def B World Atom := logic {m : Model World Atom | Std.Symm m.r}
+
+/-- The modal logic 4. -/
+@[simp, scoped grind =]
+def Four World Atom := logic {m : Model World Atom | IsTrans World m.r}
+
+/-- The modal logic 5. -/
+@[simp, scoped grind =]
+def Five World Atom := logic {m : Model World Atom | Relation.RightEuclidean m.r}
+
+/-- The modal logic K45. -/
+@[simp, scoped grind =]
+def K45 World Atom := (K World Atom) ∪ (Four World Atom) ∪ (Five World Atom)
+
+/-- The modal logic D. -/
+@[simp, scoped grind =]
+def D World Atom := logic {m : Model World Atom | Relation.Serial m.r}
+
+/-- The modal logic D4. -/
+@[simp, scoped grind =]
+def D4 World Atom := (K World Atom) ∪ (D World Atom) ∪ (Four World Atom)
+
+/-- The modal logic D5. -/
+@[simp, scoped grind =]
+def D5 World Atom := (K World Atom) ∪ (D World Atom) ∪ (Five World Atom)
+
+/-- The modal logic D45. -/
+@[simp, scoped grind =]
+def D45 World Atom := (K World Atom) ∪ (D World Atom) ∪ (Four World Atom) ∪ (Five World Atom)
+
+/-- The modal logic DB. -/
+@[simp, scoped grind =]
+def DB World Atom := (K World Atom) ∪ (D World Atom) ∪ (B World Atom)
+
+/-- The modal logic TB. -/
+@[simp, scoped grind =]
+def TB World Atom := (K World Atom) ∪ (T World Atom) ∪ (B World Atom)
+
+/-- The modal logic KB5. -/
+@[simp, scoped grind =]
+def KB5 World Atom := (K World Atom) ∪ (B World Atom) ∪ (Five World Atom)
+
+/-- The modal logic S4. -/
+@[simp, scoped grind =]
+def S4 World Atom := (K World Atom) ∪ (T World Atom) ∪ (Four World Atom)
+
+/-- The modal logic S5. -/
+@[simp, scoped grind =]
+def S5 World Atom := (K World Atom) ∪ (T World Atom) ∪ (Four World Atom) ∪ (Five World Atom)
+
+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`.
+-/
+
+open scoped Proposition
+
+theorem k_subset_d : (K World Atom ⊆ D World Atom) := by
+  intro φ; grind
+
+theorem k_subset_b : (K World Atom ⊆ B World Atom) := by
+  intro φ; grind
+
+theorem k_subset_four : (K World Atom ⊆ Four World Atom) := by
+  intro φ; grind
+
+theorem k_subset_five : (K World Atom ⊆ Five World Atom) := by
+  intro φ; grind
+
+open scoped Relation in
+theorem d_subset_t : (D World Atom ⊆ T World Atom) := by
+  intro φ; grind
+
+theorem k_subset_t : (K World Atom ⊆ T World Atom) := by
+  calc
+    K World Atom ⊆ D World Atom := k_subset_d
+    D World Atom ⊆ T World Atom := d_subset_t
+
+end Order
+
+section Validity
+
+/-! ## Validity
+
+This section showcases how to prove the expected validities in the different modal logics.
+-/
+
+/-- The axiom K is valid in the logic K. -/
+theorem K.k_valid : (□(φ₁ → φ₂) → (□φ₁ → □φ₂) : Proposition Atom) ∈ K World Atom := by
+  open scoped Proposition in grind [Satisfies.k]
+
+/-- The axiom T is valid in the logic T. -/
+theorem T.t_valid : (φ → ◇φ : Proposition Atom) ∈ T World Atom := by
+  intro _ h
+  grind [Satisfies.t (instRefl := (by assumption))]
+
+end Validity
+
+end Cslib.Logic.Modal
diff --git a/Cslib/Logics/Modal/Denotation.lean b/Cslib/Logics/Modal/Denotation.lean
new file mode 100644
index 0000000000..63e88000e0
--- /dev/null
+++ b/Cslib/Logics/Modal/Denotation.lean
@@ -0,0 +1,51 @@
+/-
+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
+
+/-! # Denotational semantics for Modal Logic
+
+A denotational semantics for modal logic, inspired by the one for Hennessy-Milner Logic
+(`Cslib.Logic.HML`).
+-/
+
+@[expose] public section
+
+namespace Cslib.Logic.Modal
+
+open scoped Proposition InferenceSystem
+
+/-- 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)ᶜ
+  | .and φ₁ φ₂ => φ₁.denotation m ∩ φ₂.denotation m
+  | .diamond φ => {w | ∃ w', m.r w w' ∧ w' ∈ φ.denotation m}
+
+/-- Characterisation theorem for the denotational semantics. -/
+@[scoped grind =]
+theorem satisfies_mem_denotation {m : Model World Atom} {φ : Proposition Atom} :
+    w ∈ φ.denotation m ↔ ⇓Modal[m,w ⊨ φ] := by
+  induction φ generalizing w <;> grind
+
+/-- 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) :
+    w ∉ (¬φ).denotation m ↔ w ∈ φ.denotation m := by
+  grind [_=_ satisfies_mem_denotation]
+
+/-- Two worlds are theory-equivalent iff they are denotationally equivalent. -/
+theorem theoryEq_denotation_eq {m : Model World Atom} {w₁ w₂ : World} :
+    (TheoryEq m w₁ w₂) ↔
+    (∀ (φ : Proposition Atom), w₁ ∈ (φ.denotation m) ↔ w₂ ∈ (φ.denotation m)) := by
+  apply Iff.intro <;> grind [_=_ satisfies_mem_denotation]
+
+end Cslib.Logic.Modal
diff --git a/references.bib b/references.bib
index 1f8c0dc518..afa0213e93 100644
--- a/references.bib
+++ b/references.bib
@@ -28,6 +28,16 @@ @book{Baader1998
 address = {USA}
 }
 
+@book{Blackburn2001,
+  place={Cambridge},
+  series={Cambridge Tracts in Theoretical Computer Science},
+  title={Modal Logic},
+  publisher={Cambridge University Press},
+  author={Blackburn, Patrick and Rijke, Maarten de and Venema, Yde},
+  year={2001},
+  collection={Cambridge Tracts in Theoretical Computer Science}
+}
+
 @inproceedings{Danielsson2008,
 author = {Danielsson, Nils Anders},
 title = {Lightweight semiformal time complexity analysis for purely functional data structures},

From b37c36e4eff045ec347f83ad21328bd397e01eb0 Mon Sep 17 00:00:00 2001
From: Chris Henson <46805207+chenson2018@users.noreply.github.com>
Date: Mon, 11 May 2026 02:40:22 -0400
Subject: [PATCH 16/53] feat: some lemmas about Euclidean relations (#557)

Some lemmas on Euclidean relations, including defining `LeftEuclidean`
to accompany the existing `RightEuclidean`. I erred on the side of
leaving most of these as theorems, as these are a bit problematic if all
made instances.

I will note again that these existed in FFL, but this adds a bit more
than is proven there.
---
 Cslib/Foundations/Data/Relation.lean | 99 ++++++++++++++++++++++++++++
 1 file changed, 99 insertions(+)

diff --git a/Cslib/Foundations/Data/Relation.lean b/Cslib/Foundations/Data/Relation.lean
index 784e11b1e3..29635bee64 100644
--- a/Cslib/Foundations/Data/Relation.lean
+++ b/Cslib/Foundations/Data/Relation.lean
@@ -73,6 +73,105 @@ def UpTo (r s : α → α → Prop) : α → α → Prop := Comp s (Comp r s)
 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_range (ab : r a b) : r b b := 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 := refl_range 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_range ab)
+
+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
+
+/-- 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)
+
+end LeftEuclidean
+
+section euclidean_symm
+
+variable [Std.Symm r]
+
+private theorem RightEuclidean.symm_leftEuclidean [RightEuclidean r] : LeftEuclidean r where
+  leftEuclidean ac bc := rightEuclidean (symm ac) (symm bc)
+
+private theorem LeftEuclidean.symm_trans [LeftEuclidean r] : IsTrans α r where
+  trans _ _ _ ab bc := leftEuclidean ab (symm bc)
+
+private theorem RightEuclidean.trans_symm [IsTrans α r] : RightEuclidean r where
+  rightEuclidean ab ac := _root_.trans (symm ab) ac
+
+private theorem symm_equivalents : [RightEuclidean r, LeftEuclidean r, IsTrans α r].TFAE := by
+  apply List.tfae_of_cycle
+  · simp only [List.isChain_cons_cons, List.IsChain.singleton, and_true]
+    split_ands
+    · exact @RightEuclidean.symm_leftEuclidean _ _ _
+    · exact @LeftEuclidean.symm_trans _ _ _
+  · exact @RightEuclidean.trans_symm _ _ _
+
+/-- 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
+
 /-- 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
 

From ca0e27c11f3e34ef053c4e1df73563679c3dce60 Mon Sep 17 00:00:00 2001
From: Samuel Schlesinger <SamuelSchlesinger@users.noreply.github.com>
Date: Mon, 11 May 2026 04:02:38 -0400
Subject: [PATCH 17/53] feat(MachineLearning/PACLearning): definitions (#492)

Define the PAC learning model generalized to an arbitrary label type and
parameterized by a distribution family over labeled examples.

The unified definition `IsPACLearnerFor` captures the realizable,
agnostic, and noise-tolerant settings. Online PAC learning is not
treated here and left for future work. Given that the theorems we will
prove on this definition will require statements that look a whole lot
like `IsPACLearnerFor` anyways, this work will be compatible with future
online definitions.

---------

Co-authored-by: Fabrizio Montesi <famontesi@gmail.com>
---
 Cslib.lean                                  |   1 +
 Cslib/MachineLearning/PACLearning/Defs.lean | 528 ++++++++++++++++++++
 references.bib                              |  60 +++
 3 files changed, 589 insertions(+)
 create mode 100644 Cslib/MachineLearning/PACLearning/Defs.lean

diff --git a/Cslib.lean b/Cslib.lean
index 92a251cdfd..8bb4d86a50 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -134,3 +134,4 @@ public import Cslib.Logics.Modal.Cube
 public import Cslib.Logics.Modal.Denotation
 public import Cslib.Logics.Propositional.Defs
 public import Cslib.Logics.Propositional.NaturalDeduction.Basic
+public import Cslib.MachineLearning.PACLearning.Defs
diff --git a/Cslib/MachineLearning/PACLearning/Defs.lean b/Cslib/MachineLearning/PACLearning/Defs.lean
new file mode 100644
index 0000000000..e51ceff1fd
--- /dev/null
+++ b/Cslib/MachineLearning/PACLearning/Defs.lean
@@ -0,0 +1,528 @@
+/-
+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.Init
+public import Mathlib.MeasureTheory.Measure.MeasureSpace
+public import Mathlib.MeasureTheory.Constructions.Pi
+public import Mathlib.Order.SymmDiff
+
+/-! # PAC Learning
+
+This file defines the Probably Approximately Correct (PAC) learning model
+introduced by Valiant [Valiant1984], generalized to an arbitrary label type `β`
+and parameterized by a family of distributions `𝒟` on `α × β`.
+
+A concept class `C` over domain `α` with labels in `β` is a collection of
+functions `α → β`. A learning algorithm receives a labeled sample drawn i.i.d.
+from an unknown joint distribution `D` on `α × β` and must produce a hypothesis
+whose 0-1 error is within `ε` of the best concept in `C`, with probability at
+least `1 - δ`.
+
+The single definition `IsPACLearnerFor` captures the realizable, agnostic, and
+noise-tolerant settings by varying the distribution family `𝒟`:
+
+- **Agnostic** [Haussler1992]: `𝒟 = Set.univ` — the learner must work for all distributions.
+- **Realizable**: `𝒟` consists of pushforwards of arbitrary probability measures
+  `P` on `α` along the graph `x ↦ (x, c x)` of some concept `c ∈ C`, so that
+  `optimalError D C = 0`.
+- **Noise-tolerant** [AngluinLaird1988]: `𝒟` consists of noisy versions of realizable
+  distributions, where each label is corrupted independently with some probability `η`.
+
+The accuracy and confidence parameters `ε` and `δ` are elements of the subtype
+`Set.Ioo (0 : ℝ≥0) 1`, which bundles the value together with the proof that it
+lies in the open interval `(0, 1)`, ensuring the learning condition is non-vacuous.
+
+All declarations live under the `Cslib.MachineLearning.PACLearning` namespace so that
+generic names like `error` and `optimalError` do not pollute the parent namespace.
+
+## Main definitions
+
+- `ConceptClass`: a set of functions `α → β` (classifiers).
+- `LabeledSample`: a finite sequence of `(point, label)` pairs.
+- `Learner`: a function from labeled samples to hypotheses.
+- `error`: the 0-1 error of a hypothesis under a joint distribution.
+- `optimalError`: the infimum of `error` over a concept class.
+- `IsPACLearnerFor`: deterministic `(ε, δ)`-PAC learner over a distribution family.
+- `IsRPACLearnerFor`: randomized variant of `IsPACLearnerFor`. Universe-polymorphic in the
+  randomness space `Ω : Type*`.
+- `IsPACLearnable`: a concept class is PAC learnable if `IsPACLearnerFor` holds for
+  all `ε, δ : Set.Ioo (0 : ℝ≥0) 1` with some sample size `m`.
+- `IsRPACLearnable`: randomized variant of `IsPACLearnable`. Pins the randomness space to
+  `Type 0`; `IsRPACLearnerFor` itself remains universe-polymorphic for users who need it.
+- `LearnerModel`: the common predicate shape `ℕ → ε → δ → C → 𝒟 → Prop` abstracting both
+  the deterministic and randomized learners so sample-complexity lemmas can be shared.
+- `sampleComplexity`: sample complexity of a generic learner model.
+- `rsampleComplexity`: randomized sample complexity, i.e. `sampleComplexity IsRPACLearnerFor`.
+
+## Binary classification
+
+When `β = Bool`, concepts correspond to subsets of `α`. The section
+*Binary Classification* provides:
+
+- `hypothesisError`: the symmetric-difference error `P(h ∆ c)`.
+- `falsePositiveError`, `falseNegativeError`: its decomposition.
+- `hypothesisError_eq_add`: the decomposition theorem.
+- `error_map_eq_hypothesisError`: bridge between the general `error` and
+  the binary `hypothesisError` under a realizable distribution.
+
+## Main statements
+
+- `IsPACLearnerFor.toIsRPACLearnerFor`: every deterministic PAC learner is a
+  randomized one (via the trivial randomness space `PUnit`).
+- `IsPACLearnerFor.antitone_family`, `.antitone_C`: the deterministic PAC learner
+  predicate is antitone in the distribution family and concept class.
+- `IsPACLearnerFor.mono_δ`, `.mono_ε`: the predicate is monotone in the confidence and
+  accuracy parameters (a weaker bound still holds).
+- `IsRPACLearnerFor.antitone_family`, `.mono_δ`: analogues for the randomized predicate.
+  (`mono_ε` and `antitone_C` are not provided because they change the integrand and
+  would require an extra measurability assumption.)
+- `IsPACLearnable.toIsRPACLearnable`: deterministic learnability implies randomized.
+- `IsPACLearnable.antitone_family`, `.antitone_C`, `IsRPACLearnable.antitone_family`:
+  PAC learnability is antitone in the distribution family and concept class.
+- `sampleComplexity_antitone_δ`, `_antitone_ε`, `_mono_family`, `_mono_C`: variation of
+  deterministic sample complexity in confidence, accuracy, distribution family, and concept
+  class (antitone in the numeric parameters, monotone under `⊆` in the set parameters). The
+  randomized analogues `rsampleComplexity_antitone_δ` and `_mono_family` are provided.
+- `IsPACLearnable.sampleComplexity_*`, `IsRPACLearnable.rsampleComplexity_*`: the same
+  monotonicity facts phrased with a learnability hypothesis in place of the ad-hoc
+  `∃ m, IsPACLearnerFor m …` existence witness, so callers who already know the class is
+  learnable need not thread it through.
+- `hypothesisError_eq_add`: total error = false positive + false negative.
+
+## References
+
+* [L. G. Valiant, *A Theory of the Learnable*][Valiant1984]
+* [A. Ehrenfeucht, D. Haussler, M. Kearns, L. Valiant,
+  *A General Lower Bound on the Number of Examples Needed for Learning*][EHKV1989]
+* [M. J. Kearns, U. V. Vazirani,
+  *An Introduction to Computational Learning Theory*][KearnsVazirani1994]
+* [D. Haussler, *Decision Theoretic Generalizations of the PAC Model for Neural Net
+  and Other Learning Applications*][Haussler1992]
+* [D. Angluin, P. Laird, *Learning from Noisy Examples*][AngluinLaird1988]
+-/
+
+@[expose] public section
+
+open MeasureTheory Set
+open scoped ENNReal NNReal
+
+namespace Cslib.MachineLearning.PACLearning
+
+/-! ### Core Definitions -/
+
+/-- A *concept class* over domain `α` with label type `β` is a set of functions `α → β`.
+For binary classification (`β = Bool`), this is equivalent to a collection of subsets of `α`
+via the characteristic function. -/
+abbrev ConceptClass (α β : Type*) := Set (α → β)
+
+/-- A *labeled sample* of size `m` over domain `α` with label type `β` is a finite sequence
+of `(point, label)` pairs. -/
+abbrev LabeledSample (α β : Type*) (m : ℕ) := Fin m → (α × β)
+
+/-- A *learner* using `m` samples is a function that takes a labeled sample and produces
+a hypothesis (a function from the domain to the label type). -/
+abbrev Learner (α β : Type*) (m : ℕ) := LabeledSample α β m → (α → β)
+
+section
+variable {α : Type*} {β : Type*} [MeasurableSpace α] [MeasurableSpace β]
+
+/-- The *prediction error* (0-1 loss) of a hypothesis `h` under a joint distribution `D`
+on `α × β`, defined as the probability that the prediction disagrees with the label:
+`D({(x, y) | h(x) ≠ y})`. -/
+noncomputable def error (D : Measure (α × β)) (h : α → β) : ℝ≥0∞ :=
+  D {p : α × β | h p.1 ≠ p.2}
+
+/-- The *optimal error* of a concept class `C` under a joint distribution `D`, defined as the
+infimum of `error D c` over all concepts `c ∈ C`. When `C` is empty this is `⊤`, making the
+PAC learning condition vacuously true. -/
+noncomputable def optimalError (D : Measure (α × β)) (C : ConceptClass α β) : ℝ≥0∞ :=
+  ⨅ c ∈ C, error D c
+
+/-! ### PAC Learners -/
+
+/-- `IsPACLearnerFor m ε δ C 𝒟` asserts that there exists a learner using `m` samples
+that is `(ε, δ)`-correct for the concept class `C` over the distribution family `𝒟`: for every
+probability measure `D ∈ 𝒟` on `α × β`, the probability (over i.i.d. samples from `D`) that
+the learner's hypothesis has error exceeding `opt_C(D) + ε` is at most `δ`.
+
+The parameters `ε` and `δ` are elements of `Set.Ioo (0 : ℝ≥0) 1`, bundling the value with
+the proof that it lies in `(0, 1)`. This ensures the condition is non-vacuous:
+`ε < 1` prevents the error threshold from exceeding the maximum possible error under a
+probability measure, and `δ < 1` prevents the confidence bound from being trivially
+satisfied. -/
+def IsPACLearnerFor (m : ℕ) (ε δ : Set.Ioo (0 : ℝ≥0) 1)
+    (C : ConceptClass α β) (𝒟 : Set (Measure (α × β))) : Prop :=
+  ∃ A : Learner α β m,
+    ∀ (D : Measure (α × β)) [IsProbabilityMeasure D], D ∈ 𝒟 →
+      (Measure.pi (fun _ : Fin m => D))
+        {S : LabeledSample α β m |
+          error D (A S) > optimalError D C + ↑ε.val} ≤ ↑δ.val
+
+/-- `IsRPACLearnerFor m ε δ C 𝒟` asserts that there exists a *randomized* learner using
+`m` samples that is `(ε, δ)`-correct for the concept class `C` over the distribution family
+`𝒟`. A randomized learner draws internal randomness `ω` from a probability space `(Ω, Q)` and
+acts as the deterministic learner `A(ω)`.
+
+For every probability measure `D ∈ 𝒟`, the failure probability function
+`ω ↦ D^m{S | error(A(ω)(S)) > opt_C(D) + ε}` must be `Q`-a.e. measurable, and its
+expectation over `ω` must be at most `δ`.
+
+The randomness space `Ω : Type*` is universe-polymorphic; the universe is an implicit
+parameter of `IsRPACLearnerFor`, and downstream statements reference it via the pattern
+`IsRPACLearnerFor.{_, _, u}`. Fix `u := 0` for the usual case of a standard randomness space.
+
+A deterministic learner (`IsPACLearnerFor`) is the special case `Ω = PUnit`;
+see `IsPACLearnerFor.toIsRPACLearnerFor`. -/
+def IsRPACLearnerFor (m : ℕ) (ε δ : Set.Ioo (0 : ℝ≥0) 1)
+    (C : ConceptClass α β) (𝒟 : Set (Measure (α × β))) : Prop :=
+  ∃ (Ω : Type*) (_ : MeasurableSpace Ω) (Q : Measure Ω) (_ : IsProbabilityMeasure Q)
+    (A : Ω → Learner α β m),
+    ∀ (D : Measure (α × β)) [IsProbabilityMeasure D], D ∈ 𝒟 →
+      AEMeasurable (fun ω => (Measure.pi (fun _ : Fin m => D))
+        {S : LabeledSample α β m |
+          error D ((A ω) S) > optimalError D C + ↑ε.val}) Q ∧
+      ∫⁻ ω, (Measure.pi (fun _ : Fin m => D))
+        {S : LabeledSample α β m |
+          error D ((A ω) S) > optimalError D C + ↑ε.val} ∂Q ≤ ↑δ.val
+
+/-- Every deterministic PAC learner is in particular a randomized PAC learner
+(with the trivial one-point randomness space `PUnit`). -/
+theorem IsPACLearnerFor.toIsRPACLearnerFor {m : ℕ} {ε δ : Set.Ioo (0 : ℝ≥0) 1}
+    {C : ConceptClass α β} {𝒟 : Set (Measure (α × β))}
+    (h : IsPACLearnerFor m ε δ C 𝒟) :
+    IsRPACLearnerFor m ε δ C 𝒟 := by
+  obtain ⟨A, hA⟩ := h
+  refine ⟨PUnit, inferInstance, Measure.dirac PUnit.unit, inferInstance, fun _ => A, ?_⟩
+  intro D _ hD
+  refine ⟨measurable_const.aemeasurable, ?_⟩
+  simp only [gt_iff_lt, lintegral_const, measure_univ, mul_one]
+  exact hA D hD
+
+/-- The deterministic PAC learner predicate is antitone in the distribution family: a
+learner for a larger family `𝒟'` is also a learner for any subfamily `𝒟 ⊆ 𝒟'`. -/
+theorem IsPACLearnerFor.antitone_family {m : ℕ} {ε δ : Set.Ioo (0 : ℝ≥0) 1}
+    {C : ConceptClass α β} {𝒟 𝒟' : Set (Measure (α × β))}
+    (h𝒟 : 𝒟 ⊆ 𝒟') (h : IsPACLearnerFor m ε δ C 𝒟') :
+    IsPACLearnerFor m ε δ C 𝒟 := by
+  obtain ⟨A, hA⟩ := h
+  exact ⟨A, fun D inst hD => @hA D inst (h𝒟 hD)⟩
+
+/-- A PAC learner with confidence `δ₁` is also a PAC learner with any weaker confidence
+`δ₂ ≥ δ₁`: the failure-probability bound only gets looser. -/
+theorem IsPACLearnerFor.mono_δ {m : ℕ} {ε : Set.Ioo (0 : ℝ≥0) 1}
+    {δ₁ δ₂ : Set.Ioo (0 : ℝ≥0) 1} (hδ : δ₁.val ≤ δ₂.val)
+    {C : ConceptClass α β} {𝒟 : Set (Measure (α × β))}
+    (h : IsPACLearnerFor m ε δ₁ C 𝒟) :
+    IsPACLearnerFor m ε δ₂ C 𝒟 := by
+  obtain ⟨A, hA⟩ := h
+  refine ⟨A, fun D inst hD => le_trans (@hA D inst hD) ?_⟩
+  exact_mod_cast hδ
+
+/-- A PAC learner with accuracy `ε₁` is also a PAC learner with any weaker accuracy
+`ε₂ ≥ ε₁`: the bad event `{error > opt + ε}` only shrinks. -/
+theorem IsPACLearnerFor.mono_ε {m : ℕ} {δ : Set.Ioo (0 : ℝ≥0) 1}
+    {ε₁ ε₂ : Set.Ioo (0 : ℝ≥0) 1} (hε : ε₁.val ≤ ε₂.val)
+    {C : ConceptClass α β} {𝒟 : Set (Measure (α × β))}
+    (h : IsPACLearnerFor m ε₁ δ C 𝒟) :
+    IsPACLearnerFor m ε₂ δ C 𝒟 := by
+  obtain ⟨A, hA⟩ := h
+  refine ⟨A, fun D inst hD => le_trans (measure_mono ?_) (@hA D inst hD)⟩
+  intro S hS
+  have hε' : (↑ε₁.val : ℝ≥0∞) ≤ ↑ε₂.val := by exact_mod_cast hε
+  calc optimalError D C + (↑ε₁.val : ℝ≥0∞)
+      ≤ optimalError D C + ↑ε₂.val := by gcongr
+    _ < error D (A S) := hS
+
+/-- The deterministic PAC learner predicate is antitone in the concept class: a learner
+for a larger class `C'` is also a learner for any subclass `C ⊆ C'`, since the agnostic
+benchmark `optimalError _ C ≥ optimalError _ C'` makes the error requirement easier. -/
+theorem IsPACLearnerFor.antitone_C {m : ℕ} {ε δ : Set.Ioo (0 : ℝ≥0) 1}
+    {C C' : ConceptClass α β} (hC : C ⊆ C')
+    {𝒟 : Set (Measure (α × β))} (h : IsPACLearnerFor m ε δ C' 𝒟) :
+    IsPACLearnerFor m ε δ C 𝒟 := by
+  obtain ⟨A, hA⟩ := h
+  refine ⟨A, fun D inst hD => le_trans (measure_mono ?_) (@hA D inst hD)⟩
+  intro S hS
+  have h_opt : optimalError D C' ≤ optimalError D C := iInf_le_iInf_of_subset hC
+  calc optimalError D C' + (↑ε.val : ℝ≥0∞)
+      ≤ optimalError D C + ↑ε.val := by gcongr
+    _ < error D (A S) := hS
+
+/-- The randomized PAC learner predicate is antitone in the distribution family. The
+universe of the randomness space `Ω` is pinned so the hypothesis and conclusion share it. -/
+theorem IsRPACLearnerFor.antitone_family.{u} {m : ℕ} {ε δ : Set.Ioo (0 : ℝ≥0) 1}
+    {C : ConceptClass α β} {𝒟 𝒟' : Set (Measure (α × β))}
+    (h𝒟 : 𝒟 ⊆ 𝒟') (h : IsRPACLearnerFor.{_, _, u} m ε δ C 𝒟') :
+    IsRPACLearnerFor.{_, _, u} m ε δ C 𝒟 := by
+  obtain ⟨Ω, mΩ, Q, hQ, A, hA⟩ := h
+  exact ⟨Ω, mΩ, Q, hQ, A, fun D inst hD => @hA D inst (h𝒟 hD)⟩
+
+/-- A randomized PAC learner with confidence `δ₁` is also a randomized PAC learner with
+any weaker confidence `δ₂ ≥ δ₁`. Unlike `mono_ε` or `antitone_C`, this does not touch the
+integrand, so it carries the `AEMeasurable` part through unchanged. -/
+theorem IsRPACLearnerFor.mono_δ.{u} {m : ℕ} {ε : Set.Ioo (0 : ℝ≥0) 1}
+    {δ₁ δ₂ : Set.Ioo (0 : ℝ≥0) 1} (hδ : δ₁.val ≤ δ₂.val)
+    {C : ConceptClass α β} {𝒟 : Set (Measure (α × β))}
+    (h : IsRPACLearnerFor.{_, _, u} m ε δ₁ C 𝒟) :
+    IsRPACLearnerFor.{_, _, u} m ε δ₂ C 𝒟 := by
+  obtain ⟨Ω, mΩ, Q, hQ, A, hA⟩ := h
+  refine ⟨Ω, mΩ, Q, hQ, A, fun D inst hD => ?_⟩
+  obtain ⟨hmeas, hint⟩ := @hA D inst hD
+  refine ⟨hmeas, le_trans hint ?_⟩
+  exact_mod_cast hδ
+
+/-! ### PAC Learnability -/
+
+/-- A concept class `C` is *PAC learnable* over the distribution family `𝒟` if for every
+accuracy `ε ∈ (0, 1)` and confidence `δ ∈ (0, 1)`, there exists a sample size `m` admitting
+a deterministic `(ε, δ)`-PAC learner for `C`. Here `ε` and `δ` are elements of the subtype
+`Set.Ioo (0 : ℝ≥0) 1`. -/
+def IsPACLearnable (C : ConceptClass α β) (𝒟 : Set (Measure (α × β))) : Prop :=
+  ∀ (ε δ : Set.Ioo (0 : ℝ≥0) 1),
+    ∃ m, IsPACLearnerFor m ε δ C 𝒟
+
+/-- A concept class `C` is *randomized PAC learnable* over the distribution family `𝒟` if for
+every accuracy `ε ∈ (0, 1)` and confidence `δ ∈ (0, 1)`, there exists a sample size `m`
+admitting a randomized `(ε, δ)`-PAC learner for `C`. The randomness space is pinned to
+`Type 0` at the learnability level; `IsRPACLearnerFor` itself remains universe-polymorphic. -/
+def IsRPACLearnable (C : ConceptClass α β) (𝒟 : Set (Measure (α × β))) : Prop :=
+  ∀ (ε δ : Set.Ioo (0 : ℝ≥0) 1),
+    ∃ m, IsRPACLearnerFor.{_, _, 0} m ε δ C 𝒟
+
+/-- Deterministic PAC learnability implies randomized PAC learnability. -/
+theorem IsPACLearnable.toIsRPACLearnable {C : ConceptClass α β}
+    {𝒟 : Set (Measure (α × β))} (h : IsPACLearnable C 𝒟) :
+    IsRPACLearnable C 𝒟 := by
+  intro ε δ
+  obtain ⟨m, hm⟩ := h ε δ
+  exact ⟨m, hm.toIsRPACLearnerFor⟩
+
+/-- PAC learnability is antitone in the distribution family: a subfamily of a learnable
+family is learnable. -/
+theorem IsPACLearnable.antitone_family {C : ConceptClass α β} {𝒟 𝒟' : Set (Measure (α × β))}
+    (h𝒟 : 𝒟 ⊆ 𝒟') (h : IsPACLearnable C 𝒟') : IsPACLearnable C 𝒟 :=
+  fun ε δ => (h ε δ).imp fun _ hm => hm.antitone_family h𝒟
+
+/-- PAC learnability is antitone in the concept class: a subclass of a learnable class is
+learnable. -/
+theorem IsPACLearnable.antitone_C {C C' : ConceptClass α β} (hC : C ⊆ C')
+    {𝒟 : Set (Measure (α × β))} (h : IsPACLearnable C' 𝒟) : IsPACLearnable C 𝒟 :=
+  fun ε δ => (h ε δ).imp fun _ hm => hm.antitone_C hC
+
+/-- Randomized PAC learnability is antitone in the distribution family. -/
+theorem IsRPACLearnable.antitone_family {C : ConceptClass α β}
+    {𝒟 𝒟' : Set (Measure (α × β))} (h𝒟 : 𝒟 ⊆ 𝒟')
+    (h : IsRPACLearnable C 𝒟') : IsRPACLearnable C 𝒟 :=
+  fun ε δ => (h ε δ).imp fun _ hm => hm.antitone_family h𝒟
+
+/-! ### Sample Complexity -/
+
+/-- A *learner model* is a predicate on (sample size, accuracy, confidence, concept class,
+distribution family) that classifies which sample sizes admit a learner of the given kind.
+Instantiating with `IsPACLearnerFor` gives the deterministic model; with `IsRPACLearnerFor`
+gives the randomized one. -/
+abbrev LearnerModel (α β : Type*) [MeasurableSpace α] [MeasurableSpace β] :=
+  ℕ → Set.Ioo (0 : ℝ≥0) 1 → Set.Ioo (0 : ℝ≥0) 1 →
+    ConceptClass α β → Set (Measure (α × β)) → Prop
+
+/-- The *sample complexity* of a concept class `C` under a learner model `L`, at accuracy
+`ε ∈ (0, 1)` and confidence `δ ∈ (0, 1)` over distribution family `𝒟`, is the smallest sample
+size `m` with `L m ε δ C 𝒟`. Specialize with `L := IsPACLearnerFor` for the deterministic model
+and `L := IsRPACLearnerFor` for the randomized one.
+
+**Caveat**: because `sInf` on `ℕ` returns `0` for the empty set, this definition returns `0`
+when no learner exists (e.g., a concept class of infinite VC dimension). It is only meaningful
+when the defining set `{m | L m ε δ C 𝒟}` is nonempty. The `IsPACLearnable.sampleComplexity_*`
+variants below discharge this nonemptiness from a learnability hypothesis. -/
+noncomputable def sampleComplexity (L : LearnerModel α β) (C : ConceptClass α β)
+    (ε δ : Set.Ioo (0 : ℝ≥0) 1) (𝒟 : Set (Measure (α × β))) : ℕ :=
+  sInf {m : ℕ | L m ε δ C 𝒟}
+
+/-- The *randomized sample complexity* of `C`, i.e. `sampleComplexity` instantiated at the
+randomized learner model `IsRPACLearnerFor`. The randomness space is pinned to `Type 0`. -/
+noncomputable def rsampleComplexity (C : ConceptClass α β) (ε δ : Set.Ioo (0 : ℝ≥0) 1)
+    (𝒟 : Set (Measure (α × β))) : ℕ :=
+  sampleComplexity IsRPACLearnerFor.{_, _, 0} C ε δ 𝒟
+
+/-! ### Monotonicity of Sample Complexity
+
+These lemmas are all special cases of the following observation: if `{m | L₁ m ε₁ δ₁ C₁ 𝒟₁} ⊆
+{m | L₂ m ε₂ δ₂ C₂ 𝒟₂}` and the first set is nonempty, then the sample complexity under
+`(L₂, ε₂, δ₂, C₂, 𝒟₂)` is at most the sample complexity under `(L₁, ε₁, δ₁, C₁, 𝒟₁)`. The
+nonemptiness hypothesis is essential: `sInf` on `ℕ` returns `0` for an empty set, so without
+it the inequality can fail at the degenerate boundary. The `IsPACLearnable`-flavoured variants
+at the end of this section discharge that witness from a learnability hypothesis. -/
+
+/-- General pointwise monotonicity of `sampleComplexity`: if every witness sample size for
+`(L₁, ε₁, δ₁, C₁, 𝒟₁)` is also a witness for `(L₂, ε₂, δ₂, C₂, 𝒟₂)`, then the latter's
+sample complexity is at most the former's (provided the former is attained). -/
+theorem sampleComplexity_le_of_forall {L₁ L₂ : LearnerModel α β}
+    {ε₁ δ₁ ε₂ δ₂ : Set.Ioo (0 : ℝ≥0) 1} {C₁ C₂ : ConceptClass α β}
+    {𝒟₁ 𝒟₂ : Set (Measure (α × β))}
+    (hL : ∀ {m : ℕ}, L₁ m ε₁ δ₁ C₁ 𝒟₁ → L₂ m ε₂ δ₂ C₂ 𝒟₂)
+    (h : ∃ m, L₁ m ε₁ δ₁ C₁ 𝒟₁) :
+    sampleComplexity L₂ C₂ ε₂ δ₂ 𝒟₂ ≤ sampleComplexity L₁ C₁ ε₁ δ₁ 𝒟₁ :=
+  Nat.sInf_le (hL (Nat.sInf_mem h))
+
+/-- Deterministic sample complexity is antitone in the confidence parameter `δ`: weaker
+confidence requires no more samples. -/
+theorem sampleComplexity_antitone_δ {ε δ₁ δ₂ : Set.Ioo (0 : ℝ≥0) 1} (hδ : δ₁.val ≤ δ₂.val)
+    {C : ConceptClass α β} {𝒟 : Set (Measure (α × β))}
+    (h : ∃ m, IsPACLearnerFor m ε δ₁ C 𝒟) :
+    sampleComplexity IsPACLearnerFor C ε δ₂ 𝒟 ≤ sampleComplexity IsPACLearnerFor C ε δ₁ 𝒟 :=
+  sampleComplexity_le_of_forall (fun h' => h'.mono_δ hδ) h
+
+/-- Deterministic sample complexity is antitone in the accuracy parameter `ε`: weaker
+accuracy requires no more samples. -/
+theorem sampleComplexity_antitone_ε {ε₁ ε₂ δ : Set.Ioo (0 : ℝ≥0) 1} (hε : ε₁.val ≤ ε₂.val)
+    {C : ConceptClass α β} {𝒟 : Set (Measure (α × β))}
+    (h : ∃ m, IsPACLearnerFor m ε₁ δ C 𝒟) :
+    sampleComplexity IsPACLearnerFor C ε₂ δ 𝒟 ≤ sampleComplexity IsPACLearnerFor C ε₁ δ 𝒟 :=
+  sampleComplexity_le_of_forall (fun h' => h'.mono_ε hε) h
+
+/-- Deterministic sample complexity is monotone in the distribution family under `⊆`: a
+smaller family (fewer distributions to cover) requires no more samples. -/
+theorem sampleComplexity_mono_family {ε δ : Set.Ioo (0 : ℝ≥0) 1}
+    {C : ConceptClass α β} {𝒟 𝒟' : Set (Measure (α × β))} (h𝒟 : 𝒟 ⊆ 𝒟')
+    (h : ∃ m, IsPACLearnerFor m ε δ C 𝒟') :
+    sampleComplexity IsPACLearnerFor C ε δ 𝒟 ≤ sampleComplexity IsPACLearnerFor C ε δ 𝒟' :=
+  sampleComplexity_le_of_forall (fun h' => h'.antitone_family h𝒟) h
+
+/-- Deterministic sample complexity is monotone in the concept class under `⊆`: a smaller
+class (weaker agnostic benchmark) requires no more samples. -/
+theorem sampleComplexity_mono_C {ε δ : Set.Ioo (0 : ℝ≥0) 1}
+    {C C' : ConceptClass α β} (hC : C ⊆ C') {𝒟 : Set (Measure (α × β))}
+    (h : ∃ m, IsPACLearnerFor m ε δ C' 𝒟) :
+    sampleComplexity IsPACLearnerFor C ε δ 𝒟 ≤ sampleComplexity IsPACLearnerFor C' ε δ 𝒟 :=
+  sampleComplexity_le_of_forall (fun h' => h'.antitone_C hC) h
+
+/-- Randomized sample complexity is antitone in the confidence parameter `δ`. -/
+theorem rsampleComplexity_antitone_δ {ε δ₁ δ₂ : Set.Ioo (0 : ℝ≥0) 1}
+    (hδ : δ₁.val ≤ δ₂.val) {C : ConceptClass α β} {𝒟 : Set (Measure (α × β))}
+    (h : ∃ m, IsRPACLearnerFor.{_, _, 0} m ε δ₁ C 𝒟) :
+    rsampleComplexity C ε δ₂ 𝒟 ≤ rsampleComplexity C ε δ₁ 𝒟 :=
+  sampleComplexity_le_of_forall (fun h' => h'.mono_δ hδ) h
+
+/-- Randomized sample complexity is monotone in the distribution family under `⊆`. -/
+theorem rsampleComplexity_mono_family {ε δ : Set.Ioo (0 : ℝ≥0) 1}
+    {C : ConceptClass α β} {𝒟 𝒟' : Set (Measure (α × β))} (h𝒟 : 𝒟 ⊆ 𝒟')
+    (h : ∃ m, IsRPACLearnerFor.{_, _, 0} m ε δ C 𝒟') :
+    rsampleComplexity C ε δ 𝒟 ≤ rsampleComplexity C ε δ 𝒟' :=
+  sampleComplexity_le_of_forall (fun h' => h'.antitone_family h𝒟) h
+
+/-! Convenience variants conditional on learnability, which discharge the nonemptiness
+hypothesis `(∃ m, IsPACLearnerFor m …)` from an `IsPACLearnable` / `IsRPACLearnable` witness.
+Bodies go through `sampleComplexity_le_of_forall` directly rather than the top-level
+`sampleComplexity_*` lemmas, whose unqualified names would resolve as self-recursion inside
+these theorems' `IsPACLearnable.*` / `IsRPACLearnable.*` namespaces. -/
+
+/-- `sampleComplexity_antitone_δ` for a learnable class: the nonemptiness hypothesis comes
+for free from `IsPACLearnable`. -/
+theorem IsPACLearnable.sampleComplexity_antitone_δ
+    {C : ConceptClass α β} {𝒟 : Set (Measure (α × β))} (hL : IsPACLearnable C 𝒟)
+    {ε δ₁ δ₂ : Set.Ioo (0 : ℝ≥0) 1} (hδ : δ₁.val ≤ δ₂.val) :
+    sampleComplexity IsPACLearnerFor C ε δ₂ 𝒟 ≤ sampleComplexity IsPACLearnerFor C ε δ₁ 𝒟 :=
+  sampleComplexity_le_of_forall (fun h' => h'.mono_δ hδ) (hL ε δ₁)
+
+/-- `sampleComplexity_antitone_ε` for a learnable class. -/
+theorem IsPACLearnable.sampleComplexity_antitone_ε
+    {C : ConceptClass α β} {𝒟 : Set (Measure (α × β))} (hL : IsPACLearnable C 𝒟)
+    {ε₁ ε₂ δ : Set.Ioo (0 : ℝ≥0) 1} (hε : ε₁.val ≤ ε₂.val) :
+    sampleComplexity IsPACLearnerFor C ε₂ δ 𝒟 ≤ sampleComplexity IsPACLearnerFor C ε₁ δ 𝒟 :=
+  sampleComplexity_le_of_forall (fun h' => h'.mono_ε hε) (hL ε₁ δ)
+
+/-- `sampleComplexity_mono_family` for a learnable class (learnability at the *larger*
+family `𝒟'` is the hypothesis). -/
+theorem IsPACLearnable.sampleComplexity_mono_family
+    {C : ConceptClass α β} {𝒟 𝒟' : Set (Measure (α × β))}
+    (hL : IsPACLearnable C 𝒟') (h𝒟 : 𝒟 ⊆ 𝒟') {ε δ : Set.Ioo (0 : ℝ≥0) 1} :
+    sampleComplexity IsPACLearnerFor C ε δ 𝒟 ≤ sampleComplexity IsPACLearnerFor C ε δ 𝒟' :=
+  sampleComplexity_le_of_forall (fun h' => h'.antitone_family h𝒟) (hL ε δ)
+
+/-- `sampleComplexity_mono_C` for a learnable class (learnability at the *larger* class
+`C'` is the hypothesis). -/
+theorem IsPACLearnable.sampleComplexity_mono_C
+    {C C' : ConceptClass α β} {𝒟 : Set (Measure (α × β))}
+    (hL : IsPACLearnable C' 𝒟) (hC : C ⊆ C') {ε δ : Set.Ioo (0 : ℝ≥0) 1} :
+    sampleComplexity IsPACLearnerFor C ε δ 𝒟 ≤ sampleComplexity IsPACLearnerFor C' ε δ 𝒟 :=
+  sampleComplexity_le_of_forall (fun h' => h'.antitone_C hC) (hL ε δ)
+
+/-- `rsampleComplexity_antitone_δ` for a randomized-learnable class. -/
+theorem IsRPACLearnable.rsampleComplexity_antitone_δ
+    {C : ConceptClass α β} {𝒟 : Set (Measure (α × β))} (hL : IsRPACLearnable C 𝒟)
+    {ε δ₁ δ₂ : Set.Ioo (0 : ℝ≥0) 1} (hδ : δ₁.val ≤ δ₂.val) :
+    rsampleComplexity C ε δ₂ 𝒟 ≤ rsampleComplexity C ε δ₁ 𝒟 :=
+  sampleComplexity_le_of_forall (fun h' => h'.mono_δ hδ) (hL ε δ₁)
+
+/-- `rsampleComplexity_mono_family` for a randomized-learnable class. -/
+theorem IsRPACLearnable.rsampleComplexity_mono_family
+    {C : ConceptClass α β} {𝒟 𝒟' : Set (Measure (α × β))}
+    (hL : IsRPACLearnable C 𝒟') (h𝒟 : 𝒟 ⊆ 𝒟') {ε δ : Set.Ioo (0 : ℝ≥0) 1} :
+    rsampleComplexity C ε δ 𝒟 ≤ rsampleComplexity C ε δ 𝒟' :=
+  sampleComplexity_le_of_forall (fun h' => h'.antitone_family h𝒟) (hL ε δ)
+
+end
+
+/-! ### Binary Classification
+
+When `β = Bool`, concepts correspond to subsets of `α` via the characteristic function.
+The symmetric-difference error `P(h ∆ c)` is the natural error metric, and it decomposes
+into false positive and false negative components.
+
+The bridge lemma `error_map_eq_hypothesisError` connects the general `error` on `α × Bool`
+to the binary `hypothesisError` on `α`, showing they coincide for realizable distributions. -/
+
+section Binary
+variable {α : Type*} [MeasurableSpace α]
+
+/-- The *symmetric-difference error* of a hypothesis `h` with respect to a target concept `c`
+(both viewed as subsets of `α`) under distribution `P`, defined as `P(h ∆ c)`. -/
+noncomputable def hypothesisError (P : Measure α) (h c : Set α) : ℝ≥0∞ :=
+  P (symmDiff h c)
+
+/-- The *false positive error* `P(h \ c)` — points classified positive but not in the
+concept. -/
+noncomputable def falsePositiveError (P : Measure α) (h c : Set α) : ℝ≥0∞ :=
+  P (h \ c)
+
+/-- The *false negative error* `P(c \ h)` — points in the concept but classified negative. -/
+noncomputable def falseNegativeError (P : Measure α) (h c : Set α) : ℝ≥0∞ :=
+  P (c \ h)
+
+/-- The total hypothesis error decomposes as the sum of false positive and false negative
+errors, since `h ∆ c = (h \ c) ∪ (c \ h)` is a disjoint union. -/
+theorem hypothesisError_eq_add {P : Measure α} {h c : Set α}
+    (hh : MeasurableSet h) (hc : MeasurableSet c) :
+    hypothesisError P h c = falsePositiveError P h c + falseNegativeError P h c := by
+  simp only [hypothesisError, falsePositiveError, falseNegativeError, symmDiff_def, sup_eq_union]
+  exact measure_union disjoint_sdiff_sdiff (hc.diff hh)
+
+open Classical in
+/-- Under a realizable distribution `P.map (x ↦ (x, c(x)))`, the general 0-1 `error`
+coincides with the binary `hypothesisError P h c`, where `h` and `c` are viewed as subsets
+of `α` via the characteristic function `decide (· ∈ ·)`. -/
+theorem error_map_eq_hypothesisError (P : Measure α) (h c : Set α)
+    (hh : MeasurableSet h) (hc : MeasurableSet c) :
+    error (P.map (fun x => (x, decide (x ∈ c)))) (fun x => decide (x ∈ h)) =
+    hypothesisError P h c := by
+  simp only [error, hypothesisError]
+  have hf : Measurable (fun x => (x, decide (x ∈ c))) :=
+    Measurable.prodMk measurable_id
+      (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
+  · convert (hh.prod (measurableSet_singleton false)).union
+      (hh.compl.prod (measurableSet_singleton true)) using 1
+    ext ⟨x, b⟩; cases b <;> simp
+
+end Binary
+
+end Cslib.MachineLearning.PACLearning
diff --git a/references.bib b/references.bib
index afa0213e93..f0db1a781e 100644
--- a/references.bib
+++ b/references.bib
@@ -19,6 +19,17 @@ @inproceedings{Aceto1999
   bibsource    = {dblp computer science bibliography, https://dblp.org}
 }
 
+@article{AngluinLaird1988,
+  author       = {Angluin, Dana and Laird, Philip},
+  title        = {Learning from Noisy Examples},
+  journal      = {Machine Learning},
+  volume       = {2},
+  number       = {4},
+  pages        = {343--370},
+  year         = {1988},
+  doi          = {10.1007/BF00116829}
+}
+
 @book{Baader1998,
 author = {Baader, Franz and Nipkow, Tobias},
 title = {Term rewriting and all that},
@@ -117,6 +128,18 @@ @inbook{          Girard1995
   collection={London Mathematical Society Lecture Note Series}
 }
 
+@article{Haussler1992,
+  author       = {Haussler, David},
+  title        = {Decision Theoretic Generalizations of the {PAC} Model for Neural Net and Other Learning Applications},
+  journal      = {Information and Computation},
+  volume       = {100},
+  number       = {1},
+  pages        = {78--150},
+  year         = {1992},
+  issn         = {0890-5401},
+  doi          = {10.1016/0890-5401(92)90010-D}
+}
+
 @article{         Hennessy1985,
   author       = {Matthew Hennessy and
                   Robin Milner},
@@ -285,6 +308,43 @@ @article{         ShepherdsonSturgis1963
   address      = {New York, NY, USA}
 }
 
+@inproceedings{Valiant1984,
+  author       = {Valiant, L. G.},
+  title        = {A Theory of the Learnable},
+  year         = {1984},
+  isbn         = {0-89791-133-4},
+  publisher    = {Association for Computing Machinery},
+  address      = {New York, NY, USA},
+  url          = {https://doi.org/10.1145/800057.808710},
+  doi          = {10.1145/800057.808710},
+  booktitle    = {Proceedings of the Sixteenth Annual ACM Symposium on Theory of Computing},
+  pages        = {436--445},
+  series       = {STOC '84}
+}
+
+@article{EHKV1989,
+  author       = {Ehrenfeucht, Andrzej and Haussler, David and Kearns, Michael and Valiant, Leslie},
+  title        = {A General Lower Bound on the Number of Examples Needed for Learning},
+  journal      = {Information and Computation},
+  volume       = {82},
+  number       = {3},
+  pages        = {247--261},
+  year         = {1989},
+  issn         = {0890-5401},
+  url          = {https://doi.org/10.1016/0890-5401(89)90002-3},
+  doi          = {10.1016/0890-5401(89)90002-3},
+  publisher    = {Academic Press}
+}
+
+@book{KearnsVazirani1994,
+  author       = {Kearns, Michael J. and Vazirani, Umesh V.},
+  title        = {An Introduction to Computational Learning Theory},
+  year         = {1994},
+  isbn         = {978-0-262-11193-5},
+  publisher    = {MIT Press},
+  address      = {Cambridge, MA, USA}
+}
+
 @incollection{WinskelNielsen1995,
   author       = {Winskel, Glynn and Nielsen, Mogens},
   isbn         = {9780198537809},

From 57e5054134b4d049d85e7c4404115c69b6de043a Mon Sep 17 00:00:00 2001
From: Samuel Schlesinger <SamuelSchlesinger@users.noreply.github.com>
Date: Mon, 11 May 2026 06:11:06 -0400
Subject: [PATCH 18/53] feat(Cryptography/SecretSharing): Shamir's secret
 sharing (#495)

Added a general definition of a secret sharing protocol along with
privacy definitions: view indistinguishability and perfect privacy.
Implemented Shamir's secret sharing as an instance, then proved view
indistinguishability and perfect privacy of translation invariant tail
polynomial distributions. Specialized to the uniform tail polynomial
distribution as that is the typical setting.

A few more PMF utilities were needed, I am planning to upstream those to
Mathlib along with the existing ones from perfectly secret encryption
schemes.

---------

Co-authored-by: Fabrizio Montesi <famontesi@gmail.com>
---
 Cslib.lean                                    |   6 +-
 .../Crypto/Protocols/PerfectSecrecy/Defs.lean |   4 +-
 .../Internal/PerfectSecrecy.lean              |   4 +-
 .../Crypto/Protocols/SecretSharing/Defs.lean  | 104 ++++++
 .../Protocols/SecretSharing/Scheme.lean       | 107 ++++++
 .../Protocols/SecretSharing/Shamir.lean       | 327 ++++++++++++++++++
 .../SecretSharing/Shamir/Polynomial.lean      | 144 ++++++++
 .../PMF.lean}                                 |  59 +++-
 references.bib                                |  13 +
 9 files changed, 755 insertions(+), 13 deletions(-)
 create mode 100644 Cslib/Crypto/Protocols/SecretSharing/Defs.lean
 create mode 100644 Cslib/Crypto/Protocols/SecretSharing/Scheme.lean
 create mode 100644 Cslib/Crypto/Protocols/SecretSharing/Shamir.lean
 create mode 100644 Cslib/Crypto/Protocols/SecretSharing/Shamir/Polynomial.lean
 rename Cslib/{Crypto/Protocols/PerfectSecrecy/PMFUtilities.lean => Probability/PMF.lean} (56%)

diff --git a/Cslib.lean b/Cslib.lean
index 8bb4d86a50..1b7b4c4b13 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -42,7 +42,10 @@ public import Cslib.Crypto.Protocols.PerfectSecrecy.Encryption
 public import Cslib.Crypto.Protocols.PerfectSecrecy.Internal.OneTimePad
 public import Cslib.Crypto.Protocols.PerfectSecrecy.Internal.PerfectSecrecy
 public import Cslib.Crypto.Protocols.PerfectSecrecy.OneTimePad
-public import Cslib.Crypto.Protocols.PerfectSecrecy.PMFUtilities
+public import Cslib.Crypto.Protocols.SecretSharing.Defs
+public import Cslib.Crypto.Protocols.SecretSharing.Scheme
+public import Cslib.Crypto.Protocols.SecretSharing.Shamir
+public import Cslib.Crypto.Protocols.SecretSharing.Shamir.Polynomial
 public import Cslib.Foundations.Combinatorics.InfiniteGraphRamsey
 public import Cslib.Foundations.Control.Monad.Free
 public import Cslib.Foundations.Control.Monad.Free.Effects
@@ -135,3 +138,4 @@ public import Cslib.Logics.Modal.Denotation
 public import Cslib.Logics.Propositional.Defs
 public import Cslib.Logics.Propositional.NaturalDeduction.Basic
 public import Cslib.MachineLearning.PACLearning.Defs
+public import Cslib.Probability.PMF
diff --git a/Cslib/Crypto/Protocols/PerfectSecrecy/Defs.lean b/Cslib/Crypto/Protocols/PerfectSecrecy/Defs.lean
index 03760e22dd..e7d824dd69 100644
--- a/Cslib/Crypto/Protocols/PerfectSecrecy/Defs.lean
+++ b/Cslib/Crypto/Protocols/PerfectSecrecy/Defs.lean
@@ -7,7 +7,7 @@ Authors: Samuel Schlesinger
 module
 
 public import Cslib.Crypto.Protocols.PerfectSecrecy.Encryption
-public import Cslib.Crypto.Protocols.PerfectSecrecy.PMFUtilities
+public import Cslib.Probability.PMF
 public import Mathlib.Probability.ProbabilityMassFunction.Constructions
 
 /-!
@@ -58,7 +58,7 @@ the marginal distribution. -/
 noncomputable def posteriorMsgDist (scheme : EncScheme M K C)
     (msgDist : PMF M) (c : C)
     (hc : c ∈ (scheme.marginalCiphertextDist msgDist).support) : PMF M :=
-  PMFUtilities.posteriorDist msgDist scheme.ciphertextDist c hc
+  Cslib.Probability.PMF.posteriorDist msgDist scheme.ciphertextDist c hc
 
 @[simp]
 theorem posteriorMsgDist_apply (scheme : EncScheme M K C)
diff --git a/Cslib/Crypto/Protocols/PerfectSecrecy/Internal/PerfectSecrecy.lean b/Cslib/Crypto/Protocols/PerfectSecrecy/Internal/PerfectSecrecy.lean
index 9f01fc4791..66656e8bad 100644
--- a/Cslib/Crypto/Protocols/PerfectSecrecy/Internal/PerfectSecrecy.lean
+++ b/Cslib/Crypto/Protocols/PerfectSecrecy/Internal/PerfectSecrecy.lean
@@ -32,12 +32,12 @@ variable {M K C : Type u}
 theorem jointDist_eq (scheme : EncScheme M K C) (msgDist : PMF M)
     (m : M) (c : C) :
     scheme.jointDist msgDist (m, c) = msgDist m * scheme.ciphertextDist m c :=
-  PMFUtilities.bind_pair_apply msgDist scheme.ciphertextDist m c
+  Cslib.Probability.PMF.bind_pair_apply msgDist scheme.ciphertextDist m c
 
 /-- Summing the joint distribution over messages gives the marginal ciphertext distribution. -/
 theorem jointDist_tsum_fst (scheme : EncScheme M K C) (msgDist : PMF M) (c : C) :
     ∑' m, scheme.jointDist msgDist (m, c) = scheme.marginalCiphertextDist msgDist c :=
-  PMFUtilities.bind_pair_tsum_fst msgDist scheme.ciphertextDist c
+  Cslib.Probability.PMF.bind_pair_tsum_fst msgDist scheme.ciphertextDist c
 
 /-- Perfect secrecy is equivalent to message-ciphertext independence.
 The two formulations are related by multiplying/dividing by `marginal(c)`. -/
diff --git a/Cslib/Crypto/Protocols/SecretSharing/Defs.lean b/Cslib/Crypto/Protocols/SecretSharing/Defs.lean
new file mode 100644
index 0000000000..e8788f08d0
--- /dev/null
+++ b/Cslib/Crypto/Protocols/SecretSharing/Defs.lean
@@ -0,0 +1,104 @@
+/-
+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.Probability.PMF
+public import Cslib.Crypto.Protocols.SecretSharing.Scheme
+
+/-!
+# Secret Sharing: Definitions
+
+Privacy for secret sharing is part of the `Scheme` interface. This file exposes
+the corresponding view and posterior distributions, plus theorem-friendly
+consequences of the built-in privacy field.
+
+## Main definitions
+
+- `Cslib.Crypto.Protocols.SecretSharing.Scheme.shareDist`:
+  the full share distribution for one secret
+- `Cslib.Crypto.Protocols.SecretSharing.Scheme.viewDist`:
+  the distribution of the restricted view for one coalition
+- `Cslib.Crypto.Protocols.SecretSharing.Scheme.posteriorSecretDist`:
+  the posterior distribution on secrets after observing one view
+- `Cslib.Crypto.Protocols.SecretSharing.Scheme.PerfectlyPrivate`:
+  posterior equals prior for unauthorized coalitions
+- `Cslib.Crypto.Protocols.SecretSharing.Scheme.perfectlyPrivate`:
+  every scheme has posterior privacy
+
+## References
+
+* [Adi Shamir, *How to Share a Secret*][Shamir1979]
+* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2020]
+-/
+
+@[expose] public section
+
+namespace Cslib.Crypto.Protocols.SecretSharing
+
+namespace Scheme
+
+variable {Secret Randomness Party Share : Type*}
+
+/-- The distribution of the full share assignment for one secret. -/
+noncomputable def shareDist (scheme : Scheme Secret Randomness Party Share)
+    (secret : Secret) : PMF (Party → Share) :=
+  scheme.gen.map (fun r => scheme.share r secret)
+
+/-- The view distribution induced on the coalition `s`. -/
+noncomputable def viewDist (scheme : Scheme Secret Randomness Party Share)
+    (s : Finset Party) (secret : Secret) : PMF (s → Share) :=
+  viewDistOf scheme.gen scheme.share s secret
+
+/-- Unauthorized coalitions receive secret-independent view distributions. -/
+theorem viewDist_eq_of_not_authorized
+    (scheme : Scheme Secret Randomness Party Share)
+    {s : Finset Party} (hs : ¬ scheme.authorized s)
+    (secret₀ secret₁ : Secret) :
+    scheme.viewDist s secret₀ = scheme.viewDist s secret₁ := by
+  unfold viewDist
+  exact scheme.view_indist s hs secret₀ secret₁
+
+/-- The posterior distribution on secrets after observing the coalition view
+`v`. -/
+noncomputable def posteriorSecretDist
+    (scheme : Scheme Secret Randomness Party Share)
+    (s : Finset Party) (secretDist : PMF Secret) (v : s → Share)
+    (hv : v ∈ (secretDist.bind (scheme.viewDist s)).support) : PMF Secret :=
+  Cslib.Probability.PMF.posteriorDist
+    (p := secretDist) (f := scheme.viewDist s) v hv
+
+@[simp]
+theorem posteriorSecretDist_apply
+    (scheme : Scheme Secret Randomness Party Share)
+    (s : Finset Party) (secretDist : PMF Secret) (v : s → Share)
+    (hv : v ∈ (secretDist.bind (scheme.viewDist s)).support) (secret : Secret) :
+    scheme.posteriorSecretDist s secretDist v hv secret =
+      (secretDist.bind fun secret' =>
+        (scheme.viewDist s secret').bind fun v' => PMF.pure (secret', v')) (secret, v) /
+        (secretDist.bind (scheme.viewDist s)) v :=
+  rfl
+
+/-- Perfect privacy for unauthorized coalitions: conditioning on a view does not
+change the prior on secrets. -/
+def PerfectlyPrivate (scheme : Scheme Secret Randomness Party Share) : Prop :=
+  ∀ (s : Finset Party) (_hs : ¬ scheme.authorized s)
+    (secretDist : PMF Secret) (v : s → Share)
+    (hv : v ∈ (secretDist.bind (scheme.viewDist s)).support),
+      scheme.posteriorSecretDist s secretDist v hv = secretDist
+
+/-- Every scheme has posterior privacy by definition of `Scheme`. -/
+theorem perfectlyPrivate
+    (scheme : Scheme Secret Randomness Party Share) :
+    scheme.PerfectlyPrivate := by
+  intro s hs secretDist v hv
+  exact Cslib.Probability.PMF.posteriorDist_eq_prior_of_outputIndist
+    (p := secretDist) (f := scheme.viewDist s)
+    (fun secret₀ secret₁ => scheme.viewDist_eq_of_not_authorized hs secret₀ secret₁) v hv
+
+end Scheme
+
+end Cslib.Crypto.Protocols.SecretSharing
diff --git a/Cslib/Crypto/Protocols/SecretSharing/Scheme.lean b/Cslib/Crypto/Protocols/SecretSharing/Scheme.lean
new file mode 100644
index 0000000000..09e07ae2a3
--- /dev/null
+++ b/Cslib/Crypto/Protocols/SecretSharing/Scheme.lean
@@ -0,0 +1,107 @@
+/-
+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.Init
+public import Mathlib.Data.Finset.Basic
+public import Mathlib.Probability.ProbabilityMassFunction.Constructions
+
+/-!
+# Secret Sharing Schemes
+
+A secret-sharing scheme bundles the deterministic sharing/reconstruction
+interface, the distribution on randomness, and privacy for unauthorized
+coalitions.
+
+## Main definitions
+
+- `Cslib.Crypto.Protocols.SecretSharing.Scheme`:
+  a secret-sharing scheme with correctness and privacy
+- `Cslib.Crypto.Protocols.SecretSharing.Scheme.view`:
+  the restricted shares seen by one coalition
+
+## References
+
+* [Adi Shamir, *How to Share a Secret*][Shamir1979]
+* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2020]
+-/
+
+@[expose] public section
+
+namespace Cslib.Crypto.Protocols.SecretSharing
+
+/-- The view distribution induced by raw sharing data. -/
+noncomputable def viewDistOf {Secret Randomness Party Share : Type*}
+    (gen : PMF Randomness) (share : Randomness → Secret → Party → Share)
+    (s : Finset Party) (secret : Secret) : PMF (s → Share) :=
+  PMF.map (fun r : Randomness => (fun i : s => share r secret i : s → Share)) gen
+
+/--
+A secret-sharing scheme over secret space `Secret`, randomness space
+`Randomness`, party set `Party`, and share space `Share`.
+
+Correctness is deterministic: every authorized coalition reconstructs the
+secret from the shares generated using any randomness seed. Privacy is
+distributional: unauthorized coalitions have the same view distribution for all
+secrets.
+-/
+structure Scheme (Secret Randomness Party Share : Type*) where
+  /-- The distribution used to sample the protocol's randomness. -/
+  gen : PMF Randomness
+  /-- Sharing algorithm: one randomness seed determines one share per party. -/
+  share : Randomness → Secret → Party → Share
+  /-- Reconstruction from a coalition's observed shares. -/
+  reconstruct (s : Finset Party) : (s → Share) → Secret
+  /-- Authorized coalitions. -/
+  authorized : Finset Party → Prop
+  /-- Authorization is monotone in the coalition. -/
+  authorized_mono :
+    ∀ {s t : Finset Party}, s ⊆ t → authorized s → authorized t
+  /-- Authorized coalitions reconstruct the secret from the restricted view. -/
+  correct :
+    ∀ (r : Randomness) (secret : Secret) (s : Finset Party),
+      authorized s → reconstruct s (fun i => share r secret i) = secret
+  /-- Unauthorized coalitions receive secret-independent view distributions. -/
+  view_indist :
+    ∀ (s : Finset Party), ¬ authorized s → ∀ secret₀ secret₁ : Secret,
+      viewDistOf gen share s secret₀ = viewDistOf gen share s secret₁
+
+namespace Scheme
+
+variable {Secret Randomness Party Share : Type*}
+
+/-- The restricted shares observed by the coalition `s`. -/
+def view (scheme : Scheme Secret Randomness Party Share) (s : Finset Party)
+    (r : Randomness) (secret : Secret) : s → Share :=
+  fun i => scheme.share r secret i
+
+@[simp]
+theorem view_apply (scheme : Scheme Secret Randomness Party Share) (s : Finset Party)
+    (r : Randomness) (secret : Secret) (i : s) :
+    scheme.view s r secret i = scheme.share r secret i :=
+  rfl
+
+/-- Authorized coalitions reconstruct the secret from the restricted view. -/
+theorem reconstruct_view_eq_secret
+    (scheme : Scheme Secret Randomness Party Share)
+    (r : Randomness) (secret : Secret) {s : Finset Party}
+    (hs : scheme.authorized s) :
+    scheme.reconstruct s (scheme.view s r secret) = secret :=
+  scheme.correct r secret s hs
+
+/-- Any sub-coalition of an unauthorized coalition is unauthorized as well. -/
+theorem not_authorized_of_subset
+    (scheme : Scheme Secret Randomness Party Share)
+    {s t : Finset Party} (hst : s ⊆ t)
+    (ht : ¬ scheme.authorized t) :
+    ¬ scheme.authorized s := by
+  intro hs
+  exact ht (scheme.authorized_mono hst hs)
+
+end Scheme
+
+end Cslib.Crypto.Protocols.SecretSharing
diff --git a/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean b/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean
new file mode 100644
index 0000000000..5e5d7f2930
--- /dev/null
+++ b/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean
@@ -0,0 +1,327 @@
+/-
+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.Crypto.Protocols.SecretSharing.Scheme
+public import Mathlib.Probability.Distributions.Uniform
+public import Cslib.Crypto.Protocols.SecretSharing.Shamir.Polynomial
+import Cslib.Probability.PMF
+
+/-!
+# Shamir Secret Sharing
+
+This module presents a secure-by-construction API for finite-party Shamir secret
+sharing through the abstract `SecretSharing.Scheme` interface.
+
+The public constructors require two pieces of data:
+
+- public parameters consisting of a threshold together with distinct, nonzero
+  evaluation points for a finite party set
+- a translation-invariant sampler on the tail coefficients
+
+Translation invariance is exactly the symmetry used in the privacy proof. The
+canonical finite-field instance is obtained by taking the sampler to be uniform.
+
+## Main definitions
+
+- `Cslib.Crypto.Protocols.SecretSharing.Shamir.Params`:
+  the threshold and public evaluation points
+- `Cslib.Crypto.Protocols.SecretSharing.Shamir.Randomness`:
+  the vector of tail coefficients
+- `Cslib.Crypto.Protocols.SecretSharing.Shamir.TailSampler`:
+  a translation-invariant distribution on tail coefficients
+- `Cslib.Crypto.Protocols.SecretSharing.Shamir.schemeWith`:
+  Shamir's scheme with a privacy-preserving tail sampler
+- `Cslib.Crypto.Protocols.SecretSharing.Shamir.scheme`:
+  the corresponding finite-field scheme with uniform randomness
+
+## Main results
+
+- `Cslib.Crypto.Protocols.SecretSharing.Shamir.reconstruct_view_eq_secret`:
+  any authorized coalition reconstructs the secret
+- `Cslib.Crypto.Protocols.SecretSharing.Shamir.authorized_univ`:
+  the full party set is always authorized
+
+## Notes
+
+The public share type is just the field `F`: the evaluation points are fixed in
+`Params`, so one share consists only of the corresponding field value.
+
+## References
+
+* [Adi Shamir, *How to Share a Secret*][Shamir1979]
+* [J. Katz, Y. Lindell, *Introduction to Modern Cryptography*][KatzLindell2020]
+-/
+
+@[expose] public section
+
+noncomputable section
+
+namespace Cslib.Crypto.Protocols.SecretSharing.Shamir
+
+variable {F Party : Type*} [Field F] [Fintype Party]
+
+/-- Public parameters for a finite Shamir secret-sharing instance. The threshold
+is bundled with the evaluation points so the API can enforce the standard
+non-vacuous `threshold < number of parties` side condition. -/
+structure Params (F : Type*) [Zero F] (Party : Type*) [Fintype Party] where
+  /-- A coalition of size `threshold + 1` is the first authorized size. -/
+  threshold : ℕ
+  /-- Standard Shamir sharing requires `threshold < number of parties`. -/
+  threshold_lt_card : threshold < Fintype.card Party
+  /-- The public evaluation point assigned to each party. -/
+  point : Party → F
+  /-- Distinct parties receive distinct evaluation points. -/
+  point_injective : Function.Injective point
+  /-- Standard Shamir sharing forbids the point `0`, which would reveal the
+  secret directly. -/
+  point_nonzero : ∀ i : Party, point i ≠ 0
+
+/-- The random coefficients of the degree-`threshold - 1` tail polynomial. -/
+abbrev Randomness (params : Params F Party) := Fin params.threshold → F
+
+/-- A coalition is authorized exactly when it contains at least
+`params.threshold + 1` parties. -/
+def authorized (params : Params F Party) (s : Finset Party) : Prop :=
+  params.threshold + 1 ≤ s.card
+
+/-- Because `params.threshold < |Party|`, the full party set can always
+reconstruct the secret. -/
+theorem authorized_univ {F Party : Type*} [Field F] [Fintype Party]
+    (params : Params F Party) :
+    authorized params (Finset.univ : Finset Party) := by
+  simpa [authorized] using Nat.succ_le_of_lt params.threshold_lt_card
+
+/-- The Shamir share value sent to one party. -/
+noncomputable def share (params : Params F Party)
+    (coeffs : Randomness params) (secretValue : F) (i : Party) : F :=
+  (Polynomial.sharingPolynomial secretValue
+    (Polynomial.tailPolynomial params.threshold coeffs)).eval (params.point i)
+
+/-- Reconstruct the secret from one coalition's Shamir shares. -/
+noncomputable def reconstruct (params : Params F Party)
+    (s : Finset Party) (σ : s → F) : F :=
+  Polynomial.reconstruct (fun i : s => params.point i) σ
+
+/-- A sampler on Shamir tail coefficients is privacy-compatible when its
+distribution is invariant under translation by any coefficient vector. This is
+the exact symmetry needed in the privacy proof. -/
+structure TailSampler (params : Params F Party) where
+  /-- The underlying coefficient distribution. -/
+  gen : PMF (Randomness params)
+  /-- Translating the coefficients does not change the distribution. -/
+  map_add_eq_self : ∀ δ : Randomness params, gen.map (fun coeffs => coeffs + δ) = gen
+
+private def coeffTranslate {params : Params F Party} (δ : Randomness params) :
+    Randomness params ≃ Randomness params where
+  toFun coeffs := coeffs + δ
+  invFun coeffs := coeffs - δ
+  left_inv coeffs := by simp
+  right_inv coeffs := by simp
+
+/-- Uniform tail coefficients form the canonical privacy-compatible sampler. -/
+noncomputable def uniformTailSampler (params : Params F Party)
+    [Fintype F] [Nonempty F] : TailSampler params where
+  gen := PMF.uniformOfFintype (Randomness params)
+  map_add_eq_self δ := by
+    simpa [coeffTranslate] using
+      (Cslib.Probability.PMF.uniformOfFintype_map_equiv
+        (coeffTranslate (params := params) δ))
+
+private noncomputable def privacyCorrectionPolynomial
+    (params : Params F Party) (s : Finset Party)
+    (secret₀ secret₁ : F) : _root_.Polynomial F :=
+  by
+    classical
+    exact _root_.Lagrange.interpolate s.attach (fun i : s => params.point i)
+      (fun i : s => (secret₀ - secret₁) / params.point i)
+
+private theorem points_injOn_subtype {F Party : Type*} [Field F] [Fintype Party]
+    (params : Params F Party) (s : Finset Party) :
+    Set.InjOn (fun i : s => params.point i) (s.attach : Finset s) := by
+  intro i _ j _ hij
+  apply Subtype.ext
+  exact params.point_injective hij
+
+private theorem privacyCorrectionPolynomial_eval
+    (params : Params F Party) (s : Finset Party)
+    (secret₀ secret₁ : F) (i : s) :
+    (privacyCorrectionPolynomial (F := F) params s secret₀ secret₁).eval (params.point i) =
+      (secret₀ - secret₁) / params.point i := by
+  classical
+  simpa using
+    (_root_.Lagrange.eval_interpolate_at_node
+      (s := s.attach)
+      (v := fun j : s => params.point j)
+      (r := fun j : s => (secret₀ - secret₁) / params.point j)
+      (points_injOn_subtype (F := F) params s)
+      (by simp))
+
+private theorem privacyCorrectionPolynomial_degree_lt
+    (params : Params F Party) (s : Finset Party)
+    (secret₀ secret₁ : F) (hcard : s.card ≤ params.threshold) :
+    (privacyCorrectionPolynomial (F := F) params s secret₀ secret₁).degree <
+      params.threshold := by
+  classical
+  refine lt_of_lt_of_le
+    (_root_.Lagrange.degree_interpolate_lt
+      (s := s.attach)
+      (v := fun i : s => params.point i)
+      (r := fun i : s => (secret₀ - secret₁) / params.point i)
+      (points_injOn_subtype (F := F) params s))
+    ?_
+  simpa using hcard
+
+private noncomputable def privacyCorrection
+    (params : Params F Party) (s : Finset Party)
+    (hcard : s.card ≤ params.threshold)
+    (secret₀ secret₁ : F) : Randomness params :=
+  _root_.Polynomial.degreeLTEquiv F params.threshold
+    ⟨privacyCorrectionPolynomial (F := F) params s secret₀ secret₁,
+      _root_.Polynomial.mem_degreeLT.2
+        (privacyCorrectionPolynomial_degree_lt (F := F) params s secret₀ secret₁ hcard)⟩
+
+private theorem tailPolynomial_privacyCorrection
+    (params : Params F Party) (s : Finset Party)
+    (hcard : s.card ≤ params.threshold)
+    (secret₀ secret₁ : F) :
+    Polynomial.tailPolynomial (F := F) params.threshold
+        (privacyCorrection (F := F) params s hcard secret₀ secret₁) =
+      privacyCorrectionPolynomial (F := F) params s secret₀ secret₁ := by
+  simp [privacyCorrection, Polynomial.tailPolynomial]
+
+private theorem view_eq_view_add_privacyCorrection
+    (params : Params F Party) (s : Finset Party)
+    (hcard : s.card ≤ params.threshold)
+    (secret₀ secret₁ : F) (coeffs : Randomness params) :
+    (fun i : s => share params coeffs secret₀ i) =
+      (fun i : s =>
+        share params
+          (coeffs + privacyCorrection (F := F) params s hcard secret₀ secret₁)
+          secret₁ i) := by
+  ext i
+  unfold share
+  rw [Polynomial.sharingPolynomial_eval, Polynomial.sharingPolynomial_eval]
+  rw [Polynomial.tailPolynomial_add, _root_.Polynomial.eval_add, tailPolynomial_privacyCorrection]
+  rw [privacyCorrectionPolynomial_eval (F := F) params s secret₀ secret₁ i]
+  field_simp [params.point_nonzero i]
+  ring
+
+/-- Translation-invariant Shamir tail samplers induce secret-independent views
+for unauthorized coalitions. -/
+theorem view_indist_of_tailSampler (params : Params F Party)
+    (sampler : TailSampler params) :
+    ∀ (s : Finset Party), ¬ authorized params s → ∀ secret₀ secret₁ : F,
+      viewDistOf sampler.gen (share params) s secret₀ =
+        viewDistOf sampler.gen (share params) s secret₁ := by
+  intro s hs secret₀ secret₁
+  have hcard : s.card ≤ params.threshold := by
+    have hs' : ¬ params.threshold + 1 ≤ s.card := by
+      simpa [authorized] using hs
+    exact Nat.lt_succ_iff.mp (Nat.not_le.mp hs')
+  unfold viewDistOf
+  calc
+    PMF.map (fun coeffs : Randomness params =>
+        (fun i : s => share params coeffs secret₀ i : s → F)) sampler.gen =
+      PMF.map
+        (fun coeffs : Randomness params => (fun i : s =>
+          share params
+            (coeffs + privacyCorrection (F := F) params s hcard secret₀ secret₁)
+            secret₁ i : s → F)) sampler.gen := by
+        congr 1
+        funext coeffs
+        exact view_eq_view_add_privacyCorrection
+          (F := F) params s hcard secret₀ secret₁ coeffs
+    _ = PMF.map (fun coeffs : Randomness params =>
+          (fun i : s => share params coeffs secret₁ i : s → F))
+        (PMF.map
+          (fun coeffs => coeffs + privacyCorrection (F := F) params s hcard secret₀ secret₁)
+          sampler.gen) := by
+          rw [PMF.map_comp]
+          rfl
+    _ = PMF.map (fun coeffs : Randomness params =>
+          (fun i : s => share params coeffs secret₁ i : s → F)) sampler.gen := by
+          rw [sampler.map_add_eq_self]
+
+/-- Shamir's scheme built from a privacy-compatible tail sampler. -/
+noncomputable def schemeWith (params : Params F Party) (sampler : TailSampler params)
+    :
+    SecretSharing.Scheme F (Randomness params) Party F :=
+  { gen := sampler.gen
+    share := share params
+    reconstruct := reconstruct params
+    authorized := authorized params
+    authorized_mono := by
+      intro s u hsu hs
+      exact le_trans hs (Finset.card_le_card hsu)
+    correct := by
+      intro coeffs secretValue s hs
+      have hdeg₀ :
+          (Polynomial.sharingPolynomial secretValue
+              (Polynomial.tailPolynomial params.threshold coeffs)).degree <
+            (params.threshold + 1 : WithBot ℕ) :=
+        Polynomial.degree_sharingPolynomial_tailPolynomial_lt_succ
+          secretValue params.threshold coeffs
+      have hdeg :
+          (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)
+      have hx : Function.Injective (fun i : s => params.point i) := by
+        intro i j hij
+        exact Subtype.ext (params.point_injective hij)
+      simpa [share, reconstruct] using
+        Polynomial.reconstruct_sharingPolynomial_eq_secret
+          (x := fun i : s => params.point i)
+          (secretValue := secretValue)
+          (tail := Polynomial.tailPolynomial params.threshold coeffs)
+          hx
+          hdeg
+    view_indist := view_indist_of_tailSampler params sampler }
+
+/-- The canonical finite-field Shamir scheme with uniformly sampled tail
+coefficients. -/
+noncomputable def scheme (params : Params F Party)
+    [Fintype F] [Nonempty F] :
+    SecretSharing.Scheme F (Randomness params) Party F :=
+  schemeWith params (uniformTailSampler params)
+
+@[simp]
+theorem schemeWith_authorized_iff (params : Params F Party)
+    (sampler : TailSampler params) (s : Finset Party) :
+    (schemeWith params sampler).authorized s ↔ params.threshold + 1 ≤ s.card :=
+  Iff.rfl
+
+@[simp]
+theorem scheme_authorized_iff (params : Params F Party)
+    [Fintype F] [Nonempty F] (s : Finset Party) :
+    (scheme params).authorized s ↔ params.threshold + 1 ≤ s.card :=
+  Iff.rfl
+
+@[simp]
+theorem schemeWith_share_eq (params : Params F Party)
+    (sampler : TailSampler params) (coeffs : Randomness params)
+    (secretValue : F) (i : Party) :
+    (schemeWith params sampler).share coeffs secretValue i =
+      share params coeffs secretValue i :=
+  rfl
+
+/-- Any authorized coalition reconstructs the secret from the shares it sees. -/
+theorem reconstruct_view_eq_secret
+    (params : Params F Party) (sampler : TailSampler params)
+    (coeffs : Randomness params) (secretValue : F) {s : Finset Party}
+    (hs : (schemeWith params sampler).authorized s) :
+    (schemeWith params sampler).reconstruct s
+      ((schemeWith params sampler).view s coeffs secretValue) = secretValue :=
+  SecretSharing.Scheme.reconstruct_view_eq_secret
+    (schemeWith params sampler) coeffs secretValue hs
+
+end Cslib.Crypto.Protocols.SecretSharing.Shamir
diff --git a/Cslib/Crypto/Protocols/SecretSharing/Shamir/Polynomial.lean b/Cslib/Crypto/Protocols/SecretSharing/Shamir/Polynomial.lean
new file mode 100644
index 0000000000..4cb4ced4f8
--- /dev/null
+++ b/Cslib/Crypto/Protocols/SecretSharing/Shamir/Polynomial.lean
@@ -0,0 +1,144 @@
+/-
+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.Init
+public import Mathlib.LinearAlgebra.Lagrange
+
+/-!
+# Shamir Secret Sharing: Polynomial Utilities
+
+This file contains the Shamir-specific polynomial and interpolation utilities
+used to prove correctness and privacy of the public scheme construction.
+-/
+
+@[expose] public section
+
+noncomputable section
+
+namespace Cslib.Crypto.Protocols.SecretSharing.Shamir.Polynomial
+
+variable {F : Type*} [Field F]
+
+/-- The tail polynomial determined by the first `n` coefficients. -/
+def tailPolynomial (n : ℕ) (coeffs : Fin n → F) : _root_.Polynomial F :=
+  ↑((_root_.Polynomial.degreeLTEquiv F n).symm coeffs)
+
+@[simp]
+theorem tailPolynomial_coeff (n : ℕ) (coeffs : Fin n → F) (i : Fin n) :
+    (tailPolynomial (F := F) n coeffs).coeff i = coeffs i := by
+  have h := congrFun
+    (LinearEquiv.apply_symm_apply (_root_.Polynomial.degreeLTEquiv F n) coeffs) i
+  simpa [tailPolynomial, _root_.Polynomial.degreeLTEquiv] using h
+
+/-- `tailPolynomial n coeffs` has degree `< n` by construction. -/
+theorem tailPolynomial_degree_lt (n : ℕ) (coeffs : Fin n → F) :
+    (tailPolynomial (F := F) n coeffs).degree < n :=
+  _root_.Polynomial.mem_degreeLT.1
+    (((_root_.Polynomial.degreeLTEquiv F n).symm coeffs :
+      _root_.Polynomial.degreeLT F n)).2
+
+/-- `tailPolynomial` is additive in its coefficient vector. -/
+theorem tailPolynomial_add (n : ℕ) (a b : Fin n → F) :
+    tailPolynomial (F := F) n (a + b) = tailPolynomial n a + tailPolynomial n b := by
+  simp [tailPolynomial]
+
+/-- The standard Shamir sharing polynomial `s + X * q(X)`. -/
+def sharingPolynomial (secretValue : F) (tail : _root_.Polynomial F) : _root_.Polynomial F :=
+  _root_.Polynomial.C secretValue + _root_.Polynomial.X * tail
+
+@[simp]
+theorem sharingPolynomial_eval (secretValue x : F) (tail : _root_.Polynomial F) :
+    (sharingPolynomial secretValue tail).eval x = secretValue + x * tail.eval x := by
+  simp [sharingPolynomial, mul_comm]
+
+theorem coeff_zero_sharingPolynomial (secretValue : F) (tail : _root_.Polynomial F) :
+    (sharingPolynomial secretValue tail).coeff 0 = secretValue := by
+  simp [sharingPolynomial]
+
+theorem constantCoeff_sharingPolynomial (secretValue : F) (tail : _root_.Polynomial F) :
+    (sharingPolynomial secretValue tail).constantCoeff = secretValue := by
+  simpa [_root_.Polynomial.constantCoeff_apply] using
+    coeff_zero_sharingPolynomial secretValue tail
+
+/-- If the tail polynomial has degree `< n`, then the sharing polynomial has
+natural degree at most `n`. -/
+theorem natDegree_sharingPolynomial_le (secretValue : F) (tail : _root_.Polynomial F) {n : ℕ}
+    (hdeg : tail.degree < n) :
+    (sharingPolynomial secretValue tail).natDegree ≤ n := by
+  rw [sharingPolynomial]
+  refine (_root_.Polynomial.natDegree_add_le _ _).trans ?_
+  rw [max_le_iff]
+  constructor
+  · rw [_root_.Polynomial.natDegree_C]
+    exact Nat.zero_le n
+  · by_cases htail : tail = 0
+    · simp [htail]
+    · rw [_root_.Polynomial.natDegree_X_mul htail]
+      have htailDegree : tail.natDegree < n := by
+        have := hdeg
+        rw [_root_.Polynomial.degree_eq_natDegree htail] at this
+        exact_mod_cast this
+      exact Nat.succ_le_of_lt htailDegree
+
+/-- If the tail polynomial has degree `< n`, then the sharing polynomial has
+degree `< n + 1`. -/
+theorem degree_sharingPolynomial_lt_succ (secretValue : F) (tail : _root_.Polynomial F) {n : ℕ}
+    (hdeg : tail.degree < n) :
+    (sharingPolynomial secretValue tail).degree < (n + 1 : WithBot ℕ) := by
+  by_cases hsharing : sharingPolynomial secretValue tail = 0
+  · simp [hsharing]
+  · rw [_root_.Polynomial.degree_eq_natDegree hsharing]
+    exact_mod_cast Nat.lt_succ_of_le (natDegree_sharingPolynomial_le secretValue tail hdeg)
+
+/-- The coefficient-vector version of `degree_sharingPolynomial_lt_succ`. -/
+theorem degree_sharingPolynomial_tailPolynomial_lt_succ
+    (secretValue : F) (n : ℕ) (coeffs : Fin n → F) :
+    (sharingPolynomial secretValue (tailPolynomial n coeffs)).degree <
+      (n + 1 : WithBot ℕ) :=
+  degree_sharingPolynomial_lt_succ secretValue (tailPolynomial n coeffs)
+    (tailPolynomial_degree_lt n coeffs)
+
+variable {ι : Type*} [Fintype ι]
+
+/-- Reconstruct the secret from finitely indexed share values by interpolating
+the unique low-degree polynomial that matches them. -/
+def reconstruct (x σ : ι → F) : F :=
+  by
+    classical
+    exact (_root_.Lagrange.interpolate Finset.univ x σ).constantCoeff
+
+/-- Reconstruction recovers the constant coefficient of any low-degree
+polynomial from its values at distinct points. -/
+theorem reconstruct_eq_constantCoeff_of_eval_eq
+    {x : ι → F} {p : _root_.Polynomial F}
+    (hx : Function.Injective x)
+    (hdeg : p.degree < Fintype.card ι) :
+    reconstruct x (fun i => p.eval (x i)) = p.constantCoeff := by
+  classical
+  have hp :
+      p = _root_.Lagrange.interpolate Finset.univ x (fun i => p.eval (x i)) :=
+    _root_.Lagrange.eq_interpolate
+      (s := Finset.univ)
+      (v := x)
+      hx.injOn
+      (by simpa using hdeg)
+  simpa [reconstruct] using congrArg _root_.Polynomial.constantCoeff hp.symm
+
+/-- Reconstruction succeeds on the values of a Shamir sharing polynomial once
+the finite index type is large enough. -/
+theorem reconstruct_sharingPolynomial_eq_secret
+    {x : ι → F} {secretValue : F} {tail : _root_.Polynomial F}
+    (hx : Function.Injective x)
+    (hdeg : (sharingPolynomial secretValue tail).degree < Fintype.card ι) :
+    reconstruct x
+      (fun i => (sharingPolynomial secretValue tail).eval (x i)) = secretValue := by
+  rw [reconstruct_eq_constantCoeff_of_eval_eq
+    (p := sharingPolynomial secretValue tail) hx hdeg]
+  exact constantCoeff_sharingPolynomial secretValue tail
+
+end Cslib.Crypto.Protocols.SecretSharing.Shamir.Polynomial
diff --git a/Cslib/Crypto/Protocols/PerfectSecrecy/PMFUtilities.lean b/Cslib/Probability/PMF.lean
similarity index 56%
rename from Cslib/Crypto/Protocols/PerfectSecrecy/PMFUtilities.lean
rename to Cslib/Probability/PMF.lean
index b1ab748de0..d20be22be2 100644
--- a/Cslib/Crypto/Protocols/PerfectSecrecy/PMFUtilities.lean
+++ b/Cslib/Probability/PMF.lean
@@ -8,6 +8,7 @@ module
 
 public import Cslib.Init
 public import Mathlib.Probability.ProbabilityMassFunction.Monad
+public import Mathlib.Probability.Distributions.Uniform
 
 /-!
 # PMF Utilities
@@ -23,20 +24,25 @@ the Mathlib module instead.
 
 ## Main results
 
-- `PMFUtilities.bind_pair_apply`: the "pairing" bind at `(a, b)` equals `p a * f a b`
-- `PMFUtilities.bind_pair_tsum_fst`: marginalizing over the first component
-- `PMFUtilities.posterior_hasSum`: posterior probabilities sum to 1
-- `PMFUtilities.posteriorDist`: the posterior as a `PMF`
+- `Cslib.Probability.PMF.bind_pair_apply`: the "pairing" bind at `(a, b)` equals `p a * f a b`
+- `Cslib.Probability.PMF.bind_pair_tsum_fst`: marginalizing over the first component
+- `Cslib.Probability.PMF.uniformOfFintype_map_equiv`:
+  a uniform distribution is invariant under equivalence
+- `Cslib.Probability.PMF.posterior_hasSum`: posterior probabilities sum to 1
+- `Cslib.Probability.PMF.posteriorDist`: the posterior as a `PMF`
+- `Cslib.Probability.PMF.posteriorDist_eq_prior_of_outputIndist`:
+  if the output distribution does not depend on the input, conditioning does
+  not change the prior
 -/
 
 @[expose] public section
 
-namespace Cslib.Crypto.Protocols.PerfectSecrecy.PMFUtilities
+namespace Cslib.Probability.PMF
 
 open PMF ENNReal
 
-universe u
-variable {α β : Type u}
+universe u v
+variable {α : Type u} {β : Type v}
 
 /-- Evaluating the "pairing" bind `(do let a ← p; return (a, ← f a))` at `(a, b)`
 gives the product `p a * f a b`. -/
@@ -54,6 +60,24 @@ theorem bind_pair_tsum_fst (p : PMF α) (f : α → PMF β) (b : β) :
       (p.bind f) b := by
   simp_rw [bind_pair_apply, PMF.bind_apply]
 
+/-- A uniform distribution on a finite type is invariant under any equivalence. -/
+theorem uniformOfFintype_map_equiv {γ : Type v} [Fintype α] [Fintype γ] [Nonempty α] [Nonempty γ]
+    (e : α ≃ γ) :
+    (PMF.uniformOfFintype α).map e = PMF.uniformOfFintype γ := by
+  classical
+  have hcard : Fintype.card α = Fintype.card γ := Fintype.card_congr e
+  ext c
+  rw [PMF.map_apply, PMF.uniformOfFintype_apply, tsum_eq_single (e.symm c)]
+  · simp_rw [PMF.uniformOfFintype_apply]
+    simp [hcard]
+  · intro a ha
+    simp_rw [PMF.uniformOfFintype_apply]
+    split_ifs with h
+    · exfalso
+      apply ha
+      simpa using congrArg e.symm h.symm
+    · simp
+
 /-- Posterior probabilities `joint(a, b) / marginal(b)` sum to 1
 when `b` is in the support of the marginal. -/
 theorem posterior_hasSum (p : PMF α) (f : α → PMF β) (b : β)
@@ -87,4 +111,23 @@ theorem posteriorDist_apply (p : PMF α) (f : α → PMF β) (b : β)
         (p.bind f) b :=
   rfl
 
-end Cslib.Crypto.Protocols.PerfectSecrecy.PMFUtilities
+/-- If the output distribution of a channel does not depend on the input, then
+conditioning on any output with positive probability leaves the prior unchanged. -/
+theorem posteriorDist_eq_prior_of_outputIndist (p : PMF α) (f : α → PMF β)
+    (h : ∀ a₀ a₁ : α, f a₀ = f a₁)
+    (b : β) (hb : b ∈ (p.bind f).support) :
+    posteriorDist p f b hb = p := by
+  ext a
+  rw [posteriorDist_apply, bind_pair_apply, PMF.bind_apply]
+  have hf : ∀ a', f a' b = f a b := fun a' => by rw [h a' a]
+  simp_rw [hf]
+  rw [ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul]
+  have hb' : (p.bind f) b ≠ 0 := (PMF.mem_support_iff _ _).mp hb
+  have hmarg : (p.bind f) b = f a b := by
+    rw [PMF.bind_apply]
+    simp_rw [hf]
+    rw [ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul]
+  exact ENNReal.mul_div_cancel_right (hmarg ▸ hb')
+    (ne_top_of_le_ne_top ENNReal.one_ne_top (PMF.coe_le_one _ _))
+
+end Cslib.Probability.PMF
diff --git a/references.bib b/references.bib
index f0db1a781e..f0d122d179 100644
--- a/references.bib
+++ b/references.bib
@@ -166,6 +166,19 @@ @book{             KatzLindell2020
   isbn         = {9780815354369}
 }
 
+@article{         Shamir1979,
+  author       = {Adi Shamir},
+  title        = {How to Share a Secret},
+  journal      = {Communications of the ACM},
+  volume       = {22},
+  number       = {11},
+  pages        = {612--613},
+  year         = {1979},
+  month        = nov,
+  url          = {https://doi.org/10.1145/359168.359176},
+  doi          = {10.1145/359168.359176}
+}
+
 @inproceedings{   Kiselyov2015,
   author    = {Kiselyov, Oleg and Ishii, Hiromi},
   title     = {Freer Monads, More Extensible Effects},

From 2e5e64d28ae562ac3820750f0ad61e1430e55f89 Mon Sep 17 00:00:00 2001
From: Chris Henson <46805207+chenson2018@users.noreply.github.com>
Date: Mon, 11 May 2026 08:08:51 -0400
Subject: [PATCH 19/53] ci: use `INFO=true` for weekly linting (#526)

This adds back `info` messages for the weekly linting report, see
https://github.com/leanprover-community/mathlib-ci/pull/23 for more
context.
---
 .github/workflows/weekly-lints.yml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.github/workflows/weekly-lints.yml b/.github/workflows/weekly-lints.yml
index 42462e34ef..949213f269 100644
--- a/.github/workflows/weekly-lints.yml
+++ b/.github/workflows/weekly-lints.yml
@@ -58,6 +58,7 @@ jobs:
         SHA=${{ github.sha }} \
         REPO=${{ github.repository }} \
         RUN_ID=${{ github.run_id }} \
+        INFO=true \
           "${CI_SCRIPTS_DIR}/reporting/zulip_build_report.sh" "${lean_outfile}" > "${GITHUB_OUTPUT}"
 
     - name: Post output to Zulip

From 283bc0bb625030786f88f9005384cfd505d137c2 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Mon, 11 May 2026 21:31:59 +0200
Subject: [PATCH 20/53] Apply suggestions from code review

Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com>
---
 Cslib/Foundations/Data/BiTape.lean | 25 ++++++++++---------------
 1 file changed, 10 insertions(+), 15 deletions(-)

diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean
index 74c6a8190b..dc760e2045 100644
--- a/Cslib/Foundations/Data/BiTape.lean
+++ b/Cslib/Foundations/Data/BiTape.lean
@@ -91,18 +91,15 @@ def get (t : BiTape Symbol) : ℤ → Option Symbol
 tapes as functions `ℤ → Option Symbol`. -/
 @[ext]
 lemma ext_get (t₁ t₂ : BiTape Symbol) (h_get_eq : ∀ p, t₁.get p = t₂.get p) : t₁ = t₂ := by
-  obtain ⟨head₁, left₁, right₁⟩ := t₁
-  obtain ⟨head₂, left₂, right₂⟩ := t₂
-  have h_head : head₁ = head₂ := by simpa [get] using h_get_eq 0
-  have h_right : right₁ = right₂ := by
-    apply StackTape.ext_get
-    intro p
-    simpa [get] using h_get_eq (p + 1)
-  have h_left : left₁ = left₂ := by
-    apply StackTape.ext_get
+  cases t₁
+  congr
+  · simpa [get] using h_get_eq 0
+  · apply StackTape.ext_get
     intro p
     simpa [get] using h_get_eq (Int.negSucc p)
-  grind
+  · apply StackTape.ext_get
+    intro p
+    simpa [get] using h_get_eq (p + 1)
 
 
 section Move
@@ -151,13 +148,12 @@ def optionDirToInt (d : Option Dir) : ℤ :=
   | some .right => 1
 
 @[simp, scoped grind =]
-lemma get_move_left (t : BiTape Symbol) (p : ℤ) :
-    (t.move_left).get p = t.get (p - 1) := by
+lemma get_move_left (t : BiTape Symbol) (p : ℤ) : t.move_left.get p = t.get (p - 1) := by
   unfold move_left get
   match p with
   | Int.ofNat 0 =>
-    rw [show Int.ofNat 0 - 1 = Int.negSucc 0 from rfl]
     simp [StackTape.head_eq_getD]
+    rfl
   | Int.ofNat 1 => simp
   | Int.ofNat (n + 2) =>
     rw [show Int.ofNat (n + 2) - 1 = Int.ofNat (n + 1) by lia]
@@ -165,8 +161,7 @@ lemma get_move_left (t : BiTape Symbol) (p : ℤ) :
   | Int.negSucc n => simp
 
 @[simp, scoped grind =]
-lemma get_move_right (t : BiTape Symbol) (p : ℤ) :
-    (t.move_right).get p = t.get (p + 1) := by
+lemma get_move_right (t : BiTape Symbol) (p : ℤ) : t.move_right.get p = t.get (p + 1) := by
   unfold move_right get
   match p with
   | Int.ofNat n =>

From 28a8f5e47008c4552b371ae027a804a060de7a6b Mon Sep 17 00:00:00 2001
From: Kim Morrison <477956+kim-em@users.noreply.github.com>
Date: Tue, 12 May 2026 11:46:17 +1000
Subject: [PATCH 21/53] chore(ci): pin lint-style-action to a SHA instead of
 @main (#561)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This PR pins `leanprover-community/lint-style-action` to commit
`91923b04` (2026-05-12) instead of tracking `@main`. SHA-pinning
third-party GitHub Actions is the standard hardening practice — it
prevents a compromised or accidentally-broken upstream commit from
silently affecting CI here, and makes the action version reproducible.

The chosen pin matches what mathlib4 uses (after the companion bump in
https://github.com/leanprover-community/mathlib4/pull/39228) and
includes
https://github.com/leanprover-community/lint-style-action/pull/5 -
feat(install-bibtool): use --no-install-recommends with apt-get, which
trims ~167 MB of unused texlive packages off every run of the Lint style
step.

Going forward, bumping the pin can be a periodic, reviewed step rather
than an implicit dependency on whatever HEAD happens to be.

🤖 Prepared with Claude Code

Co-authored-by: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
---
 .github/workflows/lean_action_ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/lean_action_ci.yml b/.github/workflows/lean_action_ci.yml
index 1053d8a537..0554798c1b 100644
--- a/.github/workflows/lean_action_ci.yml
+++ b/.github/workflows/lean_action_ci.yml
@@ -34,6 +34,6 @@ jobs:
         run: |
           set -e
           lake exe checkInitImports
-      - uses: leanprover-community/lint-style-action@main
+      - uses: leanprover-community/lint-style-action@91923b046cc6a468e9ae340f32f8defe586bd08f # 2026-05-12
         with:
           mode: check

From b3c5575d118fdf36bd507fdce57c5267beee61a2 Mon Sep 17 00:00:00 2001
From: Kim Morrison <477956+kim-em@users.noreply.github.com>
Date: Tue, 12 May 2026 21:56:11 +1000
Subject: [PATCH 22/53] chore(ci): bump lint-style-action pin off reverted
 commit (#562)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Follow-up to https://github.com/leanprover/cslib/pull/561.

This PR moves `leanprover-community/lint-style-action` from `91923b04`
(the merge of the now-reverted
https://github.com/leanprover-community/lint-style-action/pull/5) to
`e6128ab2` (the merge of the revert PR
https://github.com/leanprover-community/lint-style-action/pull/6).

cslib does not set `lint-bib-file: true`, so the broken `Install
bibtool` step shipped in `91923b04` was gated off and never actually ran
here — the previous pin was functionally harmless. This is purely a
cosmetic move off a known-bad SHA onto the current clean tip, restoring
parity with mathlib4's pin (which is still `a7e7428`, functionally
identical to `e6128ab2` at the `action.yml` level after the revert).

🤖 Prepared with Claude Code

Co-authored-by: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
---
 .github/workflows/lean_action_ci.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/lean_action_ci.yml b/.github/workflows/lean_action_ci.yml
index 0554798c1b..5b0ce8b541 100644
--- a/.github/workflows/lean_action_ci.yml
+++ b/.github/workflows/lean_action_ci.yml
@@ -34,6 +34,6 @@ jobs:
         run: |
           set -e
           lake exe checkInitImports
-      - uses: leanprover-community/lint-style-action@91923b046cc6a468e9ae340f32f8defe586bd08f # 2026-05-12
+      - uses: leanprover-community/lint-style-action@e6128ab22cb03b509075ae46c33727e3952ffab7 # 2026-05-12
         with:
           mode: check

From 608cbe1b629a276abd3f2081f9b42dc766d8fd78 Mon Sep 17 00:00:00 2001
From: lyj <sjtu5140809011@gmail.com>
Date: Wed, 13 May 2026 02:01:58 +0800
Subject: [PATCH 23/53] doc: fix missing '$' (#564)

doc: fix missing '$'
---
 Cslib/Languages/CombinatoryLogic/Defs.lean | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Cslib/Languages/CombinatoryLogic/Defs.lean b/Cslib/Languages/CombinatoryLogic/Defs.lean
index 9186ade5b7..a82459aadf 100644
--- a/Cslib/Languages/CombinatoryLogic/Defs.lean
+++ b/Cslib/Languages/CombinatoryLogic/Defs.lean
@@ -40,7 +40,7 @@ namespace Cslib
 
 /-- An SKI expression is built from the primitive combinators `S`, `K` and `I`, and application. -/
 inductive SKI where
-  /-- `S`-combinator, with semantics $λxyz.xz(yz) -/
+  /-- `S`-combinator, with semantics $λxyz.xz(yz)$ -/
   | S
   /-- `K`-combinator, with semantics $λxy.x$ -/
   | K

From 5220c7bee67ce72a4ba58521ce73dfd18c9fbe6f Mon Sep 17 00:00:00 2001
From: lyj <sjtu5140809011@gmail.com>
Date: Wed, 20 May 2026 09:31:14 +0800
Subject: [PATCH 24/53] feat: remove open_fresh_preserve_not_fvar (#573)

This PR remove `open_fresh_preserve_not_fvar`: because
`open_preserve_not_fvar` is the stronger version of
`open_fresh_preserve_not_fvar`
---
 .../LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean   | 2 +-
 .../LambdaCalculus/LocallyNameless/Untyped/FullEta.lean    | 2 +-
 .../LambdaCalculus/LocallyNameless/Untyped/Properties.lean | 7 +------
 3 files changed, 3 insertions(+), 8 deletions(-)

diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
index 1b90ff1e6d..f9a5f00c86 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
@@ -104,7 +104,7 @@ lemma step_not_fv (step : M ⭢βᶠ N) (hw : w ∉ M.fv) : w ∉ N.fv := by
   | abs =>
     have ⟨x, _⟩ := fresh_exists <| free_union [fv] Var
     have := open_close x
-    grind [close_preserve_not_fvar, open_fresh_preserve_not_fvar]
+    grind [close_preserve_not_fvar, open_preserve_not_fvar]
   | _ => grind
 
 /-- Abstracting then closing preserves a single reduction. -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
index 9907b11a2f..10d29d35e5 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
@@ -69,7 +69,7 @@ lemma step_not_fv (step : M ⭢ηᶠ M') (hw : w ∉ M.fv) : w ∉ M'.fv := by
   | abs =>
     have ⟨x, _⟩ := fresh_exists <| free_union [fv] Var
     have := open_close x
-    grind [close_preserve_not_fvar, open_fresh_preserve_not_fvar]
+    grind [close_preserve_not_fvar, open_preserve_not_fvar]
   | _ => grind
 
 /-- Substitution of a fresh variable preserves an η-reduction step. -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
index aedd0be0b3..5bb9979a94 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
@@ -55,11 +55,6 @@ lemma swap_open_fvar_close (k n : ℕ) (x y : Var) (m : Term Var) (neq₁ : k 
 lemma close_preserve_not_fvar {k x y} (m : Term Var) (nmem : x ∉ m.fv) : x ∉ (m⟦k ↜ y⟧).fv := by
   induction m generalizing k <;> grind
 
-/-- Opening to a fresh free variable preserves free variables. -/
-lemma open_fresh_preserve_not_fvar {k x y} (m : Term Var) (nmem : x ∉ m.fv) (neq : x ≠ y) :
-    x ∉ (m⟦k ↝ fvar y⟧).fv := by
-  induction m generalizing k <;> grind
-
 /-- Opening preserves free variables. -/
 lemma open_preserve_not_fvar {k x} (m n : Term Var) (nmem_m : x ∉ m.fv) (nmem_n : x ∉ n.fv) :
     x ∉ (m⟦k ↝ n⟧).fv := by
@@ -144,7 +139,7 @@ lemma open_close_to_subst (m : Term Var) (x y : Var) (k : ℕ) (m_lc : LC m) :
     grind [
       swap_open, =_ swap_open_fvar_close,
       open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ fvar y⟧) 0, open_close x' (t[x := fvar y]) 0,
-      open_fresh_preserve_not_fvar, close_preserve_not_fvar, subst_preserve_not_fvar]
+       open_preserve_not_fvar, close_preserve_not_fvar, subst_preserve_not_fvar]
   | _ => grind
 
 /-- Closing and opening are inverses. -/

From a188b7623d58522b4c1e7408c6c132de4300e046 Mon Sep 17 00:00:00 2001
From: lyj <sjtu5140809011@gmail.com>
Date: Wed, 20 May 2026 10:10:42 +0800
Subject: [PATCH 25/53] feat: decidable `LcAt` and `LC` (#572)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This PR makes `LcAt` and `LC` decidable.

Before:

```lean
def Term_LA0L1 : Term String := .abs (.app (.bvar 0) (.abs (.bvar 1)))

theorem LA0L1_lc : Term_LA0L1.LC := by
unfold Term_LA0L1
apply LC.abs
intros
simp [open', openRec]
apply LC.app
grind
apply LC.abs
intros
simp [open', openRec]
grind
exact ∅
exact ∅
```

After:

```lean
theorem LA0L1_lc : LcAt 0 Term_LA0L1 := by decide
```
---
 .../LambdaCalculus/LocallyNameless/Untyped/LcAt.lean   | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
index 5a6529c1e7..7222d84bb6 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
@@ -27,10 +27,10 @@ variable {Var : Type u}
 
 /-- `LcAt k M` is satisfied when all bound indices of M are smaller than `k`. -/
 @[simp, scoped grind =]
-def LcAt (k : ℕ) : Term Var → Prop
+def LcAt (k : ℕ) : Term Var → Bool
 | bvar i => i < k
-| fvar _ => True
-| app t₁ t₂ => LcAt k t₁ ∧ LcAt k t₂
+| fvar _ => true
+| app t₁ t₂ => LcAt k t₁ && LcAt k t₂
 | abs t => LcAt (k + 1) t
 
 /-- `depth` counts the maximum number of the lambdas that are enclosing variables. -/
@@ -83,6 +83,10 @@ theorem lcAt_iff_LC (M : Term Var) [HasFresh Var] : LcAt 0 M ↔ M.LC := by
         grind [fresh_exists L]
     | _ => grind [cases LC]
 
+instance [HasFresh Var] (t : Term Var) : Decidable t.LC := by
+  rw [← lcAt_iff_LC]
+  infer_instance
+
 /- Opening for some term at i-th bound variable increments `LcAt` by one -/
 lemma lcAt_openRec_lcAt (M N : Term Var) (i : ℕ) :
     LcAt i (M⟦i ↝ N⟧) → LcAt (i + 1) M := by

From cb6469f7387581969a6310a68689a0db570c6c16 Mon Sep 17 00:00:00 2001
From: lyj <sjtu5140809011@gmail.com>
Date: Wed, 20 May 2026 14:35:56 +0800
Subject: [PATCH 26/53] feat(FullBetaEta): redex_app_l_cong, redex_app_r_cong
 (#571)

This PR introduces `FullBetaEta.redex_app_l_cong` and
`FullBetaEta.redex_app_r_cong`

Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com>
---
 Cslib.lean                                    |  1 +
 .../LocallyNameless/Untyped/FullBetaEta.lean  | 62 +++++++++++++++++++
 .../Untyped/FullBetaEtaConfluence.lean        |  5 +-
 3 files changed, 64 insertions(+), 4 deletions(-)
 create mode 100644 Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEta.lean

diff --git a/Cslib.lean b/Cslib.lean
index 1b7b4c4b13..b504973c3e 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -116,6 +116,7 @@ public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Congruence
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaEta
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaEtaConfluence
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullEta
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullEtaConfluence
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEta.lean
new file mode 100644
index 0000000000..a78ade35f9
--- /dev/null
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEta.lean
@@ -0,0 +1,62 @@
+/-
+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, Yijun Leng
+-/
+
+module
+
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullEtaConfluence
+
+/-! # βη-Confluence for the λ-calculus
+
+## Reference
+
+* [T. Nipkow, *More Church-Rosser Proofs (in Isabelle/HOL)*][Nipkow2001]
+
+-/
+
+@[expose] public section
+
+set_option linter.unusedDecidableInType false
+
+namespace Cslib
+
+universe u
+
+variable {Var : Type u}
+
+namespace LambdaCalculus.LocallyNameless.Untyped.Term
+
+open Relation
+
+/-- Full βη-reduction. -/
+@[reduction_sys "βηᶠ"]
+abbrev FullBetaEta : Term Var → Term Var → Prop := FullBeta ⊔ FullEta
+
+namespace FullBetaEta
+
+theorem redex_app_l_cong (redex : M ↠βηᶠ M') (lc_N : LC N) : app M N ↠βηᶠ app M' N := by
+  induction redex with
+  | refl => grind
+  | tail _ h ih =>
+    refine .trans ih (.single ?_)
+    rcases h with h | h
+    · exact join_inl (h.appR lc_N)
+    · exact join_inr (h.appR lc_N)
+
+theorem redex_app_r_cong (redex : M ↠βηᶠ M') (lc_N : LC N) : app N M ↠βηᶠ app N M' := by
+  induction redex with
+  | refl => grind
+  | tail _ h ih =>
+    refine .trans ih (.single ?_)
+    rcases h with h | h
+    · exact join_inl (h.appL lc_N)
+    · exact join_inr (h.appL lc_N)
+
+end FullBetaEta
+
+end LambdaCalculus.LocallyNameless.Untyped.Term
+
+end Cslib
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean
index 24ae1c9438..d56359e8ad 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean
@@ -8,6 +8,7 @@ module
 
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence
 public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullEtaConfluence
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaEta
 
 /-! # βη-Confluence for the λ-calculus
 
@@ -32,10 +33,6 @@ namespace LambdaCalculus.LocallyNameless.Untyped.Term
 
 open Relation
 
-/-- Full βη-reduction. -/
-@[reduction_sys "βηᶠ"]
-abbrev FullBetaEta : Term Var → Term Var → Prop := FullBeta ⊔ FullEta
-
 open FullEta FullBeta in
 /-- η-reduction and β-reduction strongly commute. -/
 lemma stronglyCommute_eta_beta : StronglyCommute (@FullEta Var) FullBeta := by

From caa9a9c1fad8d6ae627941ae921557731da055d7 Mon Sep 17 00:00:00 2001
From: lyj <sjtu5140809011@gmail.com>
Date: Wed, 20 May 2026 19:33:03 +0800
Subject: [PATCH 27/53] feat: precise `close_preserve_not_fvar` (#580)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

`(m⟦k ↜ y⟧).fv` can be precisely represented: `(m⟦k ↜ y⟧).fv =
m.fv.erase y`
---
 .../LambdaCalculus/LocallyNameless/Untyped/Properties.lean      | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
index 5bb9979a94..e79c4bb960 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
@@ -52,7 +52,7 @@ lemma swap_open_fvar_close (k n : ℕ) (x y : Var) (m : Term Var) (neq₁ : k 
   induction m generalizing k n <;> grind
 
 /-- Closing preserves free variables. -/
-lemma close_preserve_not_fvar {k x y} (m : Term Var) (nmem : x ∉ m.fv) : x ∉ (m⟦k ↜ y⟧).fv := by
+lemma close_preserve_not_fvar {k y} (m : Term Var) : (m⟦k ↜ y⟧).fv = m.fv.erase y := by
   induction m generalizing k <;> grind
 
 /-- Opening preserves free variables. -/

From f3c2894ea49e092c29d48175e0e0ff7ebecf3792 Mon Sep 17 00:00:00 2001
From: Ching-Tsun Chou <chingtsun.chou@gmail.com>
Date: Thu, 21 May 2026 07:04:29 -0700
Subject: [PATCH 28/53] refactor: use `Option State` rather than `Sum State
 Unit` in `LTS.totalize` construction (#584)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The `LTS.totalize` construction adds a "sink state" and transitions to
the sink state in order to make the LTS total. Originally the sink state
is represented by the `()` in the RHS of a direct sum `State ⊕ Unit`.
This PR changes the state space of `LTS.totalize` to `Option State`
instead, where the sink state is represented by `none`. This equivalent
representation is easier to read and, more importantly, avoids the
confusing "sum of sums" types in NA/Concat.lean and NA.Loop.lean, where
another level of constructions also use the direct sum types.
---
 Cslib/Computability/Automata/NA/Concat.lean   | 12 +++----
 Cslib/Computability/Automata/NA/Loop.lean     |  8 ++---
 Cslib/Computability/Automata/NA/Total.lean    | 18 +++++------
 .../Languages/RegularLanguage.lean            |  6 ++--
 Cslib/Foundations/Semantics/LTS/Total.lean    | 32 ++++++++++---------
 5 files changed, 39 insertions(+), 37 deletions(-)

diff --git a/Cslib/Computability/Automata/NA/Concat.lean b/Cslib/Computability/Automata/NA/Concat.lean
index 7cc7c1c18f..298e607fd1 100644
--- a/Cslib/Computability/Automata/NA/Concat.lean
+++ b/Cslib/Computability/Automata/NA/Concat.lean
@@ -138,20 +138,20 @@ namespace FinAcc
 
 /-- `finConcat na1 na2` is the concatenation of the "totalized" versions of `na1` and `na2`. -/
 def finConcat (na1 : FinAcc State1 Symbol) (na2 : FinAcc State2 Symbol)
-  : NA ((State1 ⊕ Unit) ⊕ (State2 ⊕ Unit)) Symbol :=
-  concat ⟨na1.totalize, inl '' na1.accept⟩ na2.totalize
+  : NA (Option State1 ⊕ Option State2) Symbol :=
+  concat ⟨na1.totalize, some '' na1.accept⟩ na2.totalize
 
 variable {na1 : FinAcc State1 Symbol} {na2 : FinAcc State2 Symbol}
 
 /-- `finConcat na1 na2` is total. -/
 instance : (finConcat na1 na2).Total where
   total s x := match s with
-    | inl _ => ⟨inl (inr ()), by grind [finConcat, concat, NA.totalize, LTS.totalize]⟩
-    | inr _ => ⟨inr (inr ()), by grind [finConcat, concat, NA.totalize, LTS.totalize]⟩
+    | inl _ => ⟨inl none, by grind [finConcat, concat, NA.totalize, LTS.totalize]⟩
+    | inr _ => ⟨inr none, by grind [finConcat, concat, NA.totalize, LTS.totalize]⟩
 
 /-- `finConcat na1 na2` accepts the concatenation of the languages of `na1` and `na2`. -/
 theorem finConcat_language_eq [Inhabited Symbol] :
-    language (FinAcc.mk (finConcat na1 na2) (inr '' (inl '' na2.accept))) =
+    language (FinAcc.mk (finConcat na1 na2) (inr '' (some '' na2.accept))) =
     language na1 * language na2 := by
   ext xl
   constructor
@@ -166,7 +166,7 @@ theorem finConcat_language_eq [Inhabited Symbol] :
       #adaptation_note
       /-- A grind regression found moving to nightly-2026-03-31 (changes from lean#13166) -/
       have : ss xl.length = inr (ss2 (xl.length - n)) := by grind
-      have hl : (ss2 (xl.length - n)).isLeft := by grind
+      have hl : (ss2 (xl.length - n)).isSome := by grind
       obtain ⟨s2, t2, h_mtr2, _, _, _⟩ := totalize_run_mtr h_run2 hl
       refine ⟨s2, ?_, t2, ?_, ?_⟩ <;> grind [drop_append_of_le_length, take_append_of_le_length]
     · exact xl.take_append_drop n
diff --git a/Cslib/Computability/Automata/NA/Loop.lean b/Cslib/Computability/Automata/NA/Loop.lean
index 9aa7432c4c..a114cb384b 100644
--- a/Cslib/Computability/Automata/NA/Loop.lean
+++ b/Cslib/Computability/Automata/NA/Loop.lean
@@ -167,14 +167,14 @@ namespace FinAcc
 open scoped Computability
 
 /-- `finLoop na` is the loop construction applied to the "totalized" version of `na`. -/
-def finLoop (na : FinAcc State Symbol) : NA (Unit ⊕ (State ⊕ Unit)) Symbol :=
-  FinAcc.loop ⟨na.totalize, inl '' na.accept⟩
+def finLoop (na : FinAcc State Symbol) : NA (Unit ⊕ Option State) Symbol :=
+  FinAcc.loop ⟨na.totalize, some '' na.accept⟩
 
 /-- `finLoop na` is total, assuming that `na` has at least one start state. -/
 instance [h : Nonempty na.start] : na.finLoop.Total where
   total s x := match s with
-    | inl _ => ⟨inr (inr ()), by simpa [finLoop, loop, NA.totalize, LTS.totalize] using h⟩
-    | inr _ => ⟨inr (inr ()), by grind [finLoop, loop, NA.totalize, LTS.totalize]⟩
+    | inl _ => ⟨inr none, by simpa [finLoop, loop, NA.totalize, LTS.totalize] using h⟩
+    | inr _ => ⟨inr none, by grind [finLoop, loop, NA.totalize, LTS.totalize]⟩
 
 /-- `finLoop na` accepts the Kleene star of the language of `na`, assuming that
 the latter is nonempty. -/
diff --git a/Cslib/Computability/Automata/NA/Total.lean b/Cslib/Computability/Automata/NA/Total.lean
index 28e4df850d..9ba731b1c7 100644
--- a/Cslib/Computability/Automata/NA/Total.lean
+++ b/Cslib/Computability/Automata/NA/Total.lean
@@ -16,25 +16,25 @@ public import Cslib.Foundations.Semantics.LTS.Total
 
 namespace Cslib.Automata.NA
 
-open Sum ωSequence Acceptor
+open Option ωSequence Acceptor
 
 variable {Symbol State : Type*}
 
 /-- `NA.totalize` makes the original NA total by replacing its LTS with `LTS.totalize`
 and its starting states with their lifted non-sink versions. -/
-def totalize (na : NA State Symbol) : NA (State ⊕ Unit) Symbol where
+def totalize (na : NA State Symbol) : NA (Option State) Symbol where
   toLTS := na.toLTS.totalize
-  start := inl '' na.start
+  start := some '' na.start
 
 variable {na : NA State Symbol}
 
 /-- In an infinite execution of `NA.totalize`, as long as the NA stays in a non-sink state,
 the execution so far corresponds to a finite execution of the original NA. -/
-theorem totalize_run_mtr {xs : ωSequence Symbol} {ss : ωSequence (State ⊕ Unit)} {n : ℕ}
-    (h : na.totalize.Run xs ss) (hl : (ss n).isLeft) :
-    ∃ s t, na.MTr s (xs.take n) t ∧ s ∈ na.start ∧ ss 0 = inl s ∧ ss n = inl t := by
+theorem totalize_run_mtr {xs : ωSequence Symbol} {ss : ωSequence (Option State)} {n : ℕ}
+    (h : na.totalize.Run xs ss) (hl : (ss n).isSome) :
+    ∃ s t, na.MTr s (xs.take n) t ∧ s ∈ na.start ∧ ss 0 = some s ∧ ss n = some t := by
   obtain ⟨s, _, eq₁⟩ := h.start
-  obtain ⟨t, eq₂⟩ := isLeft_iff.mp hl
+  obtain ⟨t, eq₂⟩ := isSome_iff_exists.mp hl
   use s, t
   refine ⟨?_, by grind⟩
   -- TODO: `grind` does not use congruence relations with `na.totalize.MTr`
@@ -45,7 +45,7 @@ theorem totalize_run_mtr {xs : ωSequence Symbol} {ss : ωSequence (State ⊕ Un
 `NA.totalize`, provided that the alphabet is inbabited. -/
 theorem totalize_mtr_run [Inhabited Symbol] {xl : List Symbol} {s t : State}
     (hs : s ∈ na.start) (hm : na.MTr s xl t) :
-    ∃ xs ss, na.totalize.Run (xl ++ω xs) ss ∧ ss 0 = inl s ∧ ss xl.length = inl t := by
+    ∃ xs ss, na.totalize.Run (xl ++ω xs) ss ∧ ss 0 = some s ∧ ss xl.length = some t := by
   grind [totalize, Run, LTS.Total.extend_omegaExecution <| LTS.totalize.nonsink_mtr_iff.mpr hm]
 
 namespace FinAcc
@@ -53,7 +53,7 @@ namespace FinAcc
 /-- `NA.totalize` and the original NA accept the same language of finite words,
 as long as the accepting states are also lifted in the obvious way. -/
 theorem totalize_language_eq {na : FinAcc State Symbol} :
-    language (FinAcc.mk na.totalize (inl '' na.accept)) = language na := by
+    language (FinAcc.mk na.totalize (some '' na.accept)) = language na := by
   ext xl
   simp +instances [totalize]
 
diff --git a/Cslib/Computability/Languages/RegularLanguage.lean b/Cslib/Computability/Languages/RegularLanguage.lean
index 562d555b31..6e1bbcc8e0 100644
--- a/Cslib/Computability/Languages/RegularLanguage.lean
+++ b/Cslib/Computability/Languages/RegularLanguage.lean
@@ -158,8 +158,8 @@ theorem IsRegular.mul [Inhabited Symbol] {l1 l2 : Language Symbol}
   rw [IsRegular.iff_nfa] at h1 h2 ⊢
   obtain ⟨State1, h_fin1, nfa1, rfl⟩ := h1
   obtain ⟨State2, h_fin1, nfa2, rfl⟩ := h2
-  use (State1 ⊕ Unit) ⊕ (State2 ⊕ Unit), inferInstance,
-    ⟨finConcat nfa1 nfa2, inr '' (inl '' nfa2.accept)⟩
+  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
@@ -173,7 +173,7 @@ theorem IsRegular.kstar [Inhabited Symbol] {l : Language Symbol}
   · simp [h_l]
   · rw [IsRegular.iff_nfa] at h ⊢
     obtain ⟨State, h_fin, nfa, rfl⟩ := h
-    use Unit ⊕ (State ⊕ Unit), inferInstance, ⟨finLoop nfa, {inl ()}⟩, loop_language_eq h_l
+    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]
diff --git a/Cslib/Foundations/Semantics/LTS/Total.lean b/Cslib/Foundations/Semantics/LTS/Total.lean
index 5907d35b9f..37073920f3 100644
--- a/Cslib/Foundations/Semantics/LTS/Total.lean
+++ b/Cslib/Foundations/Semantics/LTS/Total.lean
@@ -20,7 +20,7 @@ and a "totalize" construction that converts any LTS into a total LTS.
 
 namespace Cslib.LTS
 
-open ωSequence Sum
+open ωSequence
 
 variable {State Label : Type*} {lts : LTS State Label}
 
@@ -62,22 +62,24 @@ theorem Total.extend_omegaExecution [Inhabited Label] [ht : lts.Total]
   grind [OmegaExecution.append hm ho h0]
 
 /-- `totalize` constructs a total LTS from any given LTS by adding a sink state. -/
-def totalize (lts : LTS State Label) : LTS (State ⊕ Unit) Label where
+def totalize (lts : LTS State Label) : LTS (Option State) Label where
   Tr s' μ t' := match s', t' with
-    | Sum.inl s, Sum.inl t => lts.Tr s μ t
-    | _, Sum.inr () => True
-    | Sum.inr (), Sum.inl _ => False
+    | some s, some t => lts.Tr s μ t
+    | _, none => True
+    | none, some _ => False
 
 /-- The LTS constructed by `totalize` is indeed total. -/
 instance (lts : LTS State Label) : lts.totalize.Total where
-  total _ _ := by simp [totalize]
+  total _ _ := by
+    use none
+    simp [totalize]
 
 /-- In `totalize`, there is no finite execution from the sink state to any non-sink state. -/
 theorem totalize.no_sink_to_nonsink {μs : List Label} {t : State} :
-    ¬ lts.totalize.MTr (Sum.inr ()) μs (Sum.inl t) := by
+    ¬ lts.totalize.MTr (none) μs (some t) := by
   intro h
-  generalize h_s : (Sum.inr () : State ⊕ Unit) = s'
-  generalize h_t : (Sum.inl t : State ⊕ Unit) = t'
+  generalize h_s : (none : Option State) = s'
+  generalize h_t : (some t : Option State) = t'
   rw [h_s, h_t] at h
   induction h <;> grind [totalize]
 
@@ -85,25 +87,25 @@ theorem totalize.no_sink_to_nonsink {μs : List Label} {t : State} :
 the transitions in the original LTS. -/
 @[simp]
 theorem totalize.nonsink_tr_iff {μ : Label} {s t : State} :
-    lts.totalize.Tr (Sum.inl s) μ (Sum.inl t) ↔ lts.Tr s μ t := by
+    lts.totalize.Tr (some s) μ (some t) ↔ lts.Tr s μ t := by
   simp [totalize]
 
 /-- In `totalize`, the multistep transitions between non-sink states correspond exactly to
 the multistep transitions in the original LTS. -/
 @[simp]
 theorem totalize.nonsink_mtr_iff {μs : List Label} {s t : State} :
-    lts.totalize.MTr (Sum.inl s) μs (Sum.inl t) ↔ lts.MTr s μs t := by
+    lts.totalize.MTr (some s) μs (some t) ↔ lts.MTr s μs t := by
   constructor <;> intro h
-  · generalize h_s : (Sum.inl s : State ⊕ Unit) = s'
-    generalize h_t : (Sum.inl t : State ⊕ Unit) = t'
+  · generalize h_s : (some s : Option State) = s'
+    generalize h_t : (some t : Option State) = t'
     rw [h_s, h_t] at h
     induction h generalizing s
     case refl _ => grind [MTr]
     case stepL t1' μ t2' μs t3' h_tr h_mtr h_ind =>
       obtain ⟨rfl⟩ := h_s
       cases t2'
-      case inl t2 => grind [MTr, totalize.nonsink_tr_iff.mp h_tr]
-      case inr t2 => grind [totalize.no_sink_to_nonsink]
+      case some t2 => grind [MTr, totalize.nonsink_tr_iff.mp h_tr]
+      case none => grind [totalize.no_sink_to_nonsink]
   · induction h
     case refl _ => grind [MTr]
     case stepL t1 μ t2 μs t3 h_tr h_mtr h_ind =>

From 6cc5327b2a45ea7a317f1a4951f31c345a267c75 Mon Sep 17 00:00:00 2001
From: lyj <sjtu5140809011@gmail.com>
Date: Sat, 23 May 2026 09:49:04 +0800
Subject: [PATCH 29/53] feat: FullEta.step_lc_l (#589)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This PR adds a missing lemma to the `FullEta` development in the locally
nameless untyped λ‑calculus:
a proof that **the source term of a single‑step η‑reduction is locally
closed**. It also moves the definition of `LcAt` earlier to avoid some
duplication of proofs about `LC`.

#### New Lemmas

`FullEta.step_lc_l` : Proves that the left side of an η-reduction `step
(M ⭢ηᶠ M')` is locally closed.
Uses induction on the reduction step and the grind tactic.

`lcAt_openRec_above_lcAt` : Shows that opening a term at a higher index
than its locally closed level leaves it unchanged.

#### Refactored Lemmas

open_lc : Simplified proof using `lcAt_openRec_above_lcAt` and
`lcAt_iff_LC`.

PR description is generated by AI

---------

Co-authored-by: Chris Henson <chrishenson.net@gmail.com>
Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com>
---
 .../LocallyNameless/Untyped/Basic.lean           | 12 ------------
 .../LocallyNameless/Untyped/FullEta.lean         |  8 ++++++++
 .../LocallyNameless/Untyped/LcAt.lean            | 16 ++++++++++++++++
 .../LocallyNameless/Untyped/Properties.lean      | 15 ++++-----------
 4 files changed, 28 insertions(+), 23 deletions(-)

diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Basic.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Basic.lean
index 6ac6c5d6c4..d1e4543a4d 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Basic.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Basic.lean
@@ -111,18 +111,6 @@ def fv : Term Var → Finset Var
 | abs e1 => e1.fv
 | app l r => l.fv ∪ r.fv
 
-/-- Locally closed terms. -/
-inductive LC : Term Var → Prop
-| fvar (x : Var)  : LC (fvar x)
-| abs (L : Finset Var) (e : Term Var) : (∀ x ∉ L, LC (e ^ fvar x)) → LC (abs e)
-| app {l r} : l.LC → r.LC → LC (app l r)
-
-attribute [scoped grind .] LC.fvar LC.app
-
-/-- Values are irreducible terms. -/
-inductive Value : Term Var → Prop
-| abs (e : Term Var) : e.abs.LC → e.abs.Value
-
 section
 
 omit [HasFresh Var]
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
index 10d29d35e5..517ce78683 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
@@ -44,6 +44,14 @@ lemma step_lc_r (step : M ⭢ηᶠ M') : LC M' := by
   refine Xi.step_lc_r ?_ step
   grind
 
+/-- The left side of an η-reduction is locally closed. -/
+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
+  | appL lc_Z _ ih => exact LC.app lc_Z ih
+  | appR lc_Z _ ih => exact LC.app ih lc_Z
+  | @abs M' _ xs _ ih => exact LC.abs xs M' ih
+
 /-- Left congruence rule for application in multiple reduction. -/
 theorem redex_app_l_cong (redex : M ↠ηᶠ M') (lc_N : LC N) : app M N ↠ηᶠ app M' N := by
   induction redex <;> grind
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
index 7222d84bb6..691939af75 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
@@ -72,6 +72,18 @@ theorem lcAt_openRec_fvar_iff_lcAt (M : Term Var) (x : Var) (i : ℕ) :
 theorem lcAt_open_fvar_iff_lcAt (M : Term Var) (x : Var) : LcAt 0 (M ^ fvar x) ↔ LcAt 1 M :=
   lcAt_openRec_fvar_iff_lcAt M x 0
 
+/-- Locally closed terms. -/
+inductive LC : Term Var → Prop
+| fvar (x : Var)  : LC (fvar x)
+| abs (L : Finset Var) (e : Term Var) : (∀ x ∉ L, LC (e ^ fvar x)) → LC (abs e)
+| app {l r} : l.LC → r.LC → LC (app l r)
+
+attribute [scoped grind .] LC.fvar LC.app
+
+/-- Values are irreducible terms. -/
+inductive Value : Term Var → Prop
+| abs (e : Term Var) : e.abs.LC → e.abs.Value
+
 /-- `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
   induction M using LambdaCalculus.LocallyNameless.Untyped.Term.ind_on_depth with
@@ -98,4 +110,8 @@ lemma open_abs_lc [HasFresh Var] {M N : Term Var} (hlc : LC (M ^ N)) : LC (M.abs
   rw [← lcAt_iff_LC] at *
   exact lcAt_openRec_lcAt _ _ _ hlc
 
+lemma lcAt_openRec_above_lcAt (M N : Term Var) (i j : ℕ) (h : i ≤ j) (lc : LcAt i M) :
+    M⟦j ↝ N⟧ = M := by
+  induction M generalizing i j <;> grind
+
 end Cslib.LambdaCalculus.LocallyNameless.Untyped.Term
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
index e79c4bb960..06634fccd6 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
@@ -6,7 +6,7 @@ Authors: Chris Henson
 
 module
 
-public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic
+public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LcAt
 
 /-! General properties of opening and substitution in untyped lambda calculus terms. -/
 
@@ -22,11 +22,6 @@ namespace LambdaCalculus.LocallyNameless.Untyped.Term
 
 attribute [grind =] Finset.union_singleton
 
-/-- An opening appearing in both sides of an equality of terms can be removed. -/
-lemma open_lc_aux (e : Term Var) (j v i u) (neq : i ≠ j) (eq : e⟦j ↝ v⟧ = e⟦j ↝ v⟧⟦i ↝ u⟧) :
-    e = e ⟦i ↝ u⟧ := by
-  induction e generalizing j i <;> grind
-
 variable [DecidableEq Var]
 
 /-- Substitution of a free variable not present in a term leaves it unchanged. -/
@@ -77,11 +72,9 @@ variable [HasFresh Var]
 
 omit [DecidableEq Var] in
 /-- A locally closed term is unchanged by opening. -/
-@[scoped grind =_]
-lemma open_lc (k t) (e : Term Var) (e_lc : e.LC) : e = e⟦k ↝ t⟧ := by
-  induction e_lc generalizing k with
-  | abs xs e _ _ => grind [open_lc_aux e 0 (fvar (fresh xs)) (k+1) t]
-  | _ => grind
+@[scoped grind =]
+lemma open_lc (k t) (e : Term Var) (e_lc : e.LC) : e⟦k ↝ t⟧ = e :=
+  lcAt_openRec_above_lcAt e t 0 k k.zero_le ((lcAt_iff_LC e).mpr e_lc)
 
 omit [DecidableEq Var] in
 /-- Opening is associative for nonclashing locally closed terms. -/

From 85518e63634bbec88ae0a4800d1595869153e300 Mon Sep 17 00:00:00 2001
From: Chris Henson <46805207+chenson2018@users.noreply.github.com>
Date: Sat, 23 May 2026 06:49:28 -0400
Subject: [PATCH 30/53] doc: link to Mathlib AI policy in CONTRIBUTING.md
 (#593)

For some time we have followed the Mathlib guideline of disclosing AI
usage in PR descriptions, but this was not documented in
`CONTRIBUTING.md`. This PR adds a mention of this and links to the new
Mathlib AI policy.

---------

Co-authored-by: Fabrizio Montesi <famontesi@gmail.com>
---
 CONTRIBUTING.md | 17 ++++++-----------
 1 file changed, 6 insertions(+), 11 deletions(-)

diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index b9b6b80687..a2f8f88415 100644
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -2,6 +2,7 @@
 
 - [Contributing to CSLib](#contributing-to-cslib)
 - [Contribution model](#contribution-model)
+- [The role of AI](#the-role-of-ai)
 - [Style and documentation](#style-and-documentation)
   - [Variable names](#variable-names)
   - [Proof style and golfing :golf:](#proof-style-and-golfing-golf)
@@ -38,8 +39,6 @@
       - [Back ends for Boole](#back-ends-for-boole)
       - [Implementing verification paradigms](#implementing-verification-paradigms)
       - [Lean automation](#lean-automation)
-      - [The role of AI](#the-role-of-ai)
-
 
 # Contributing to CSLib
 
@@ -57,6 +56,11 @@ If you are adding something new to CSLib and are in doubt about it, you are very
 
 If you are unfamiliar with CSLib as a whole and want to understand how to get started, please see [Getting started](#getting-started).
 
+# The role of AI
+
+CSLib in general follows the Mathlib policy on [use of AI](https://leanprover-community.github.io/contribute/index.html#use-of-ai). In particular, take note of:
+> If you use artificial intelligence [...] please explain this in the PR description. Explain which tool(s) you used and how you used it. This provides useful context for reviewers: tools make different mistakes than humans, so knowing this makes it easier to spot common errors.
+
 # Style and documentation
 
 We generally follow the [mathlib style for coding and documentation](https://leanprover-community.github.io/contribute/style.html), so please read that as well. Some things worth mentioning and conventions specific to CSLib are explained next.
@@ -322,12 +326,3 @@ The formal methods community has a wide range of verification techniques that co
 Since Boole back ends reduce correctness questions to Lean conjectures, automation is central.
 
 We already rely on key techniques such as `grind` and `lean-smt`. Additional work on automation for conjectures generated from Boole is welcome, including domain-specific automation that remains performant and readable.
-
-#### The role of AI
-
-There are two primary areas where generative AI can help:
-
-- generating/refining specifications (at the front-end or Boole level)
-- helping to prove Lean conjectures
-
-Other creative uses of AI are welcome, but contributions should remain reviewable and maintainable.

From 107a51dd89f29c62c99d16b4c38d23d3b38bdc28 Mon Sep 17 00:00:00 2001
From: "mathlib-nightly-testing[bot]"
 <258991302+mathlib-nightly-testing[bot]@users.noreply.github.com>
Date: Sun, 24 May 2026 02:35:36 -0400
Subject: [PATCH 31/53] chore: Bump `mathlib` dependency to d8de6b6 (#552)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Bump `mathlib` dependency to
[d8de6b6](https://github.com/leanprover-community/mathlib4/commit/d8de6b61f073daf518577b643724875545b98e89):
feat(Combinatorics/SimpleGraph/Coloring/VertexColoring):
`chromaticNumber ⊤` and other small lemmas (#38424) (2026-05-23)
Previously at:
[6cf3ab1](https://github.com/leanprover-community/mathlib4/commit/6cf3ab1c11e19e328c2e535bdd32d66dc7842fb5):
chore: make argument in `zero_le`/`one_le` implicit (#38148)
(2026-04-29)

_This PR was last updated on 2026-05-23 by [this workflow
run](https://github.com/leanprover/cslib/actions/runs/26342584154). It
is an automated bump using
[downstream-reports/open-bump-pr](https://github.com/leanprover-community/downstream-reports)_

---------

Co-authored-by: mathlib-nightly-testing[bot] <mathlib-nightly-testing[bot]@users.noreply.github.com>
Co-authored-by: Chris Henson <chrishenson.net@gmail.com>
---
 .../Languages/ExampleEventuallyZero.lean      |  30 +--
 .../Languages/OmegaRegularLanguage.lean       |   8 +-
 .../Machines/SingleTapeTuring/Basic.lean      |  54 ++---
 Cslib/Computability/URM/StraightLine.lean     |  24 +--
 Cslib/Foundations/Data/BiTape.lean            |  42 ++--
 Cslib/Foundations/Data/HasFresh.lean          |   2 +-
 Cslib/Foundations/Data/Relation.lean          |  22 +-
 Cslib/Foundations/Data/StackTape.lean         |   4 +-
 .../Foundations/Logic/LogicalEquivalence.lean |   2 +-
 Cslib/Foundations/Semantics/LTS/Notation.lean |   4 +-
 .../LocallyNameless/Context.lean              |   6 +-
 .../LocallyNameless/Fsub/Basic.lean           |  18 +-
 .../LocallyNameless/Fsub/Opening.lean         | 196 +++++++++---------
 .../LocallyNameless/Fsub/Reduction.lean       |   6 +-
 .../LocallyNameless/Fsub/Safety.lean          |  14 +-
 .../LocallyNameless/Fsub/Subtype.lean         |   4 +-
 .../LocallyNameless/Fsub/Typing.lean          |  20 +-
 .../LocallyNameless/Fsub/WellFormed.lean      |  10 +-
 .../LocallyNameless/Stlc/StrongNorm.lean      |  18 +-
 .../LocallyNameless/Untyped/MultiSubst.lean   |   6 +-
 Cslib/Logics/HML/LogicalEquivalence.lean      |   2 +-
 Cslib/Logics/LinearLogic/CLL/Basic.lean       |  42 ++--
 .../LinearLogic/CLL/PhaseSemantics/Basic.lean |  32 +--
 .../Propositional/NaturalDeduction/Basic.lean |  30 +--
 CslibTests/CLL.lean                           |  42 ++--
 lake-manifest.json                            |  10 +-
 lakefile.toml                                 |   2 +-
 27 files changed, 324 insertions(+), 326 deletions(-)

diff --git a/Cslib/Computability/Languages/ExampleEventuallyZero.lean b/Cslib/Computability/Languages/ExampleEventuallyZero.lean
index 7e03b8cfd5..dc777d9a8b 100644
--- a/Cslib/Computability/Languages/ExampleEventuallyZero.lean
+++ b/Cslib/Computability/Languages/ExampleEventuallyZero.lean
@@ -26,22 +26,22 @@ namespace Cslib.ωLanguage.Example
 
 open scoped LTS NA
 
-/-- A sequence `xs` is in `eventually_zero` iff `xs k = 0` for all large `k`. -/
+/-- A sequence `xs` is in `eventuallyZero` iff `xs k = 0` for all large `k`. -/
 @[scoped grind =]
-def eventually_zero : ωLanguage (Fin 2) :=
+def eventuallyZero : ωLanguage (Fin 2) :=
   { xs : ωSequence (Fin 2) | ∀ᶠ k in atTop, xs k = 0 }
 
-/-- `eventually_zero` is accepted by a 2-state nondeterministic Buchi automaton. -/
+/-- `eventuallyZero` is accepted by a 2-state nondeterministic Buchi automaton. -/
 @[scoped grind =]
-def eventually_zero_na : NA.Buchi (Fin 2) (Fin 2) where
+def eventuallyZeroNa : NA.Buchi (Fin 2) (Fin 2) where
   -- Once state 1 is reached, only symbol 0 is accepted and the next state is still 1
   Tr s x s' := s = 1 → x = 0 ∧ s' = 1
   start := {0}
   accept := {1}
 
-theorem eventually_zero_accepted_by_na_buchi :
-    language eventually_zero_na = eventually_zero := by
-  ext xs; unfold eventually_zero_na; constructor
+theorem eventuallyZero_accepted_by_na_buchi :
+    language eventuallyZeroNa = eventuallyZero := by
+  ext xs; unfold eventuallyZeroNa; constructor
   · rintro ⟨ss, h_run, h_acc⟩
     obtain ⟨m, h_m⟩ := Frequently.exists h_acc
     apply eventually_atTop.mpr
@@ -61,27 +61,27 @@ theorem eventually_zero_accepted_by_na_buchi :
       grind
 
 private lemma extend_by_zero (u : List (Fin 2)) :
-    u ++ω const 0 ∈ eventually_zero := by
+    u ++ω const 0 ∈ eventuallyZero := by
   apply eventually_atTop.mpr
   use u.length
   grind [get_append_right']
 
 private lemma extend_by_one (u : List (Fin 2)) :
-    ∃ v, 1 ∈ v ∧ u ++ v ++ω const 0 ∈ eventually_zero := by
+    ∃ v, 1 ∈ v ∧ u ++ v ++ω const 0 ∈ eventuallyZero := by
   use [1]
   grind [extend_by_zero]
 
-private lemma extend_by_hyp {l : Language (Fin 2)} (h : l↗ω = eventually_zero)
+private lemma extend_by_hyp {l : Language (Fin 2)} (h : l↗ω = eventuallyZero)
     (u : List (Fin 2)) : ∃ v, 1 ∈ v ∧ u ++ v ∈ l := by
   obtain ⟨v, _, h_pfx⟩ := extend_by_one u
   rw [← h] at h_pfx
   have := frequently_atTop.mp h_pfx (u ++ v).length
   grind [extract_append_zero_right]
 
-private noncomputable def oneSegs {l : Language (Fin 2)} (h : l↗ω = eventually_zero) (n : ℕ) :=
+private noncomputable def oneSegs {l : Language (Fin 2)} (h : l↗ω = eventuallyZero) (n : ℕ) :=
   Classical.choose <| extend_by_hyp h (List.ofFn (fun k : Fin n ↦ oneSegs h k)).flatten
 
-private lemma oneSegs_lemma {l : Language (Fin 2)} (h : l↗ω = eventually_zero) (n : ℕ) :
+private lemma oneSegs_lemma {l : Language (Fin 2)} (h : l↗ω = eventuallyZero) (n : ℕ) :
     1 ∈ oneSegs h n ∧ (List.ofFn (fun k : Fin (n + 1) ↦ oneSegs h k)).flatten ∈ l := by
   let P u v := 1 ∈ v ∧ u ++ v ∈ l
   have : P ((List.ofFn (fun k : Fin n ↦ oneSegs h k)).flatten) (oneSegs h n) := by
@@ -92,13 +92,13 @@ private lemma oneSegs_lemma {l : Language (Fin 2)} (h : l↗ω = eventually_zero
   rw [List.ofFn_succ_last]
   simpa
 
-theorem eventually_zero_not_omegaLim :
-    ¬ ∃ l : Language (Fin 2), l↗ω = eventually_zero := by
+theorem eventuallyZero_not_omegaLim :
+    ¬ ∃ l : Language (Fin 2), l↗ω = eventuallyZero := by
   rintro ⟨l, h⟩
   let ls := ωSequence.mk (oneSegs h)
   have h_segs := oneSegs_lemma h
   have h_pos : ∀ k, (ls k).length > 0 := by grind
-  have h_ev : ls.flatten ∈ eventually_zero := by
+  have h_ev : ls.flatten ∈ eventuallyZero := by
     rw [← h, mem_omegaLim, frequently_iff_strictMono]
     use (fun k ↦ ls.cumLen (k + 1))
     constructor
diff --git a/Cslib/Computability/Languages/OmegaRegularLanguage.lean b/Cslib/Computability/Languages/OmegaRegularLanguage.lean
index 1657c89e21..f3e799c63f 100644
--- a/Cslib/Computability/Languages/OmegaRegularLanguage.lean
+++ b/Cslib/Computability/Languages/OmegaRegularLanguage.lean
@@ -61,11 +61,11 @@ where the automaton is not even required to be finite-state. -/
 theorem IsRegular.not_da_buchi :
   ∃ (Symbol : Type) (p : ωLanguage Symbol), p.IsRegular ∧
     ¬ ∃ (State : Type) (da : DA.Buchi State Symbol), language da = p := by
-  refine ⟨Fin 2, Example.eventually_zero, ?_, ?_⟩
-  · use Fin 2, inferInstance, Example.eventually_zero_na,
-      Example.eventually_zero_accepted_by_na_buchi
+  refine ⟨Fin 2, Example.eventuallyZero, ?_, ?_⟩
+  · use Fin 2, inferInstance, Example.eventuallyZeroNa,
+      Example.eventuallyZero_accepted_by_na_buchi
   · rintro ⟨State, ⟨da, acc⟩, _⟩
-    have := Example.eventually_zero_not_omegaLim
+    have := Example.eventuallyZero_not_omegaLim
     grind [DA.buchi_eq_finAcc_omegaLim]
 
 /-- The ω-limit of a regular language is ω-regular. -/
diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
index 477ab60b14..b956b62869 100644
--- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
@@ -160,27 +160,27 @@ def haltCfg (tm : SingleTapeTM Symbol) (s : List Symbol) : tm.Cfg := ⟨none, Bi
 /--
 The space used by a configuration is the space used by its tape.
 -/
-def Cfg.space_used (tm : SingleTapeTM Symbol) (cfg : tm.Cfg) : ℕ := cfg.BiTape.space_used
+def Cfg.spaceUsed (tm : SingleTapeTM Symbol) (cfg : tm.Cfg) : ℕ := cfg.BiTape.spaceUsed
 
 @[scoped grind =]
-lemma Cfg.space_used_initCfg (tm : SingleTapeTM Symbol) (s : List Symbol) :
-    (tm.initCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s
+lemma Cfg.spaceUsed_initCfg (tm : SingleTapeTM Symbol) (s : List Symbol) :
+    (tm.initCfg s).spaceUsed = max 1 s.length := BiTape.spaceUsed_mk₁ s
 
 @[scoped grind =]
-lemma Cfg.space_used_haltCfg (tm : SingleTapeTM Symbol) (s : List Symbol) :
-    (tm.haltCfg s).space_used = max 1 s.length := BiTape.space_used_mk₁ s
+lemma Cfg.spaceUsed_haltCfg (tm : SingleTapeTM Symbol) (s : List Symbol) :
+    (tm.haltCfg s).spaceUsed = max 1 s.length := BiTape.spaceUsed_mk₁ s
 
-lemma Cfg.space_used_step {tm : SingleTapeTM Symbol} (cfg cfg' : tm.Cfg)
-    (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + 1 := by
+lemma Cfg.spaceUsed_step {tm : SingleTapeTM Symbol} (cfg cfg' : tm.Cfg)
+    (hstep : tm.step cfg = some cfg') : cfg'.spaceUsed ≤ cfg.spaceUsed + 1 := by
   obtain ⟨_ | q, tape⟩ := cfg
   · simp [step] at hstep
   · simp only [step] at hstep
     generalize hM : tm.tr q tape.head = result at hstep
     obtain ⟨⟨wr, dir⟩, q''⟩ := result
     cases hstep; cases dir with
-    | none => simp [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write, hM]
-    | some d => simpa [Cfg.space_used, BiTape.optionMove, BiTape.space_used_write, hM] using
-        BiTape.space_used_move (tape.write wr) d
+    | none => simp [Cfg.spaceUsed, BiTape.optionMove, BiTape.spaceUsed_write, hM]
+    | some d => simpa [Cfg.spaceUsed, BiTape.optionMove, BiTape.spaceUsed_write, hM] using
+        BiTape.spaceUsed_move (tape.write wr) d
 
 end Cfg
 
@@ -215,8 +215,8 @@ lemma output_length_le_input_length_add_time (tm : SingleTapeTM Symbol) (l l' :
     (h : tm.OutputsWithinTime l l' t) :
     l'.length ≤ max 1 l.length + t := by
   obtain ⟨steps, hsteps_le, hevals⟩ := h
-  grind [hevals.apply_le_apply_add (Cfg.space_used tm)
-      fun a b hstep ↦ Cfg.space_used_step a b (Option.mem_def.mp hstep)]
+  grind [hevals.apply_le_apply_add (Cfg.spaceUsed tm)
+      fun a b hstep ↦ Cfg.spaceUsed_step a b (Option.mem_def.mp hstep)]
 
 section Computers
 
@@ -392,15 +392,15 @@ structure TimeComputable (f : List Symbol → List Symbol) where
   /-- the underlying bundled SingleTapeTM -/
   tm : SingleTapeTM Symbol
   /-- a bound on runtime -/
-  time_bound : ℕ → ℕ
-  /-- proof this machine outputs `f` in at most `time_bound(input.length)` steps -/
-  outputsFunInTime (a) : tm.OutputsWithinTime a (f a) (time_bound a.length)
+  timeBound : ℕ → ℕ
+  /-- proof this machine outputs `f` in at most `timeBound(input.length)` steps -/
+  outputsFunInTime (a) : tm.OutputsWithinTime a (f a) (timeBound a.length)
 
 
 /-- The identity map on Symbol is computable in constant time. -/
 def TimeComputable.id : TimeComputable (Symbol := Symbol) id where
   tm := idComputer
-  time_bound _ := 1
+  timeBound _ := 1
   outputsFunInTime _ := ⟨1, le_rfl, RelatesInSteps.single rfl⟩
 
 /--
@@ -419,36 +419,36 @@ then the time bound for the second machine still holds for that shorter input to
 -/
 def TimeComputable.comp {f g : List Symbol → List Symbol}
     (hf : TimeComputable f) (hg : TimeComputable g)
-    (h_mono : Monotone hg.time_bound) :
+    (h_mono : Monotone hg.timeBound) :
     (TimeComputable (g ∘ f)) where
   tm := compComputer hf.tm hg.tm
   -- perhaps it would be good to track the blow up separately?
-  time_bound l := (hf.time_bound l) + hg.time_bound (max 1 l + hf.time_bound l)
+  timeBound l := (hf.timeBound l) + hg.timeBound (max 1 l + hf.timeBound l)
   outputsFunInTime a := by
     have hf_outputsFun := hf.outputsFunInTime a
     have hg_outputsFun := hg.outputsFunInTime (f a)
     simp only [OutputsWithinTime, initCfg, compComputer_q₀_eq, Function.comp_apply,
       haltCfg] at hg_outputsFun hf_outputsFun ⊢
-    -- The computer reduces a to f a in time hf.time_bound a.length
+    -- The computer reduces a to f a in time hf.timeBound a.length
     have h_a_reducesTo_f_a :
         RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation
           (initialCfg hf.tm hg.tm a)
           (intermediateCfg hf.tm hg.tm (f a))
-          (hf.time_bound a.length) :=
+          (hf.timeBound a.length) :=
       comp_left_relatesWithinSteps hf.tm hg.tm a (f a)
-        (hf.time_bound a.length) hf_outputsFun
-    -- The computer reduces f a to g (f a) in time hg.time_bound (f a).length
+        (hf.timeBound a.length) hf_outputsFun
+    -- The computer reduces f a to g (f a) in time hg.timeBound (f a).length
     have h_f_a_reducesTo_g_f_a :
         RelatesWithinSteps (compComputer hf.tm hg.tm).TransitionRelation
           (intermediateCfg hf.tm hg.tm (f a))
           (finalCfg hf.tm hg.tm (g (f a)))
-          (hg.time_bound (f a).length) :=
+          (hg.timeBound (f a).length) :=
       comp_right_relatesWithinSteps hf.tm hg.tm (f a) (g (f a))
-        (hg.time_bound (f a).length) hg_outputsFun
+        (hg.timeBound (f a).length) hg_outputsFun
     -- Therefore, the computer reduces a to g (f a) in the sum of those times.
     have h_a_reducesTo_g_f_a := RelatesWithinSteps.trans h_a_reducesTo_f_a h_f_a_reducesTo_g_f_a
     apply RelatesWithinSteps.of_le h_a_reducesTo_g_f_a
-    refine Nat.add_le_add_left ?_ (hf.time_bound a.length)
+    refine Nat.add_le_add_left ?_ (hf.timeBound a.length)
     · apply h_mono
       -- Use the lemma about output length being bounded by input length + time
       exact output_length_le_input_length_add_time hf.tm _ _ _ (hf.outputsFunInTime a)
@@ -478,7 +478,7 @@ structure PolyTimeComputable (f : List Symbol → List Symbol) extends TimeCompu
   /-- a polynomial time bound -/
   poly : Polynomial ℕ
   /-- proof that this machine outputs `f` in at most `time(input.length)` steps -/
-  bounds : ∀ n, time_bound n ≤ poly.eval n
+  bounds : ∀ n, timeBound n ≤ poly.eval n
 
 /-- A proof that the identity map on Symbol is computable in polytime. -/
 noncomputable def PolyTimeComputable.id : PolyTimeComputable (Symbol := Symbol) id where
@@ -493,7 +493,7 @@ A proof that the composition of two polytime computable functions is polytime co
 -/
 noncomputable def PolyTimeComputable.comp {f g : List Symbol → List Symbol}
     (hf : PolyTimeComputable f) (hg : PolyTimeComputable g)
-    (h_mono : Monotone hg.time_bound) :
+    (h_mono : Monotone hg.timeBound) :
     PolyTimeComputable (g ∘ f) where
   toTimeComputable := TimeComputable.comp hf.toTimeComputable hg.toTimeComputable h_mono
   poly := hf.poly + hg.poly.comp (1 + X + hf.poly)
diff --git a/Cslib/Computability/URM/StraightLine.lean b/Cslib/Computability/URM/StraightLine.lean
index bde52823e9..750a8c51da 100644
--- a/Cslib/Computability/URM/StraightLine.lean
+++ b/Cslib/Computability/URM/StraightLine.lean
@@ -20,7 +20,7 @@ they always halt exactly at their length.
 ## Main results
 
 - `straight_line_halts`: straight-line programs always halt
-- `straightLine_finalState`: final state after running a straight-line program
+- `straightLinefinalState`: final state after running a straight-line program
 -/
 
 @[expose] public section
@@ -100,27 +100,27 @@ theorem straight_line_halts {p : Program} (hsl : p.IsStraightLine) (inputs : Lis
 
 /-- The halting state for a straight-line program starting from registers r.
 Wraps Classical.choose to hide it from the API. -/
-noncomputable def straightLine_finalState {p : Program}
+noncomputable def straightLinefinalState {p : Program}
     (hsl : p.IsStraightLine) (r : Regs) : State :=
   Classical.choose (straight_line_halts_from_regs hsl r)
 
-/-- Specification: the state from straightLine_finalState satisfies Steps, isHalted,
+/-- Specification: the state from straightLinefinalState satisfies Steps, isHalted,
 and has pc = p.length. -/
-theorem straightLine_finalState_spec {p : Program} (hsl : p.IsStraightLine) (r : Regs) :
-    let s := straightLine_finalState hsl r
+theorem straightLinefinalState_spec {p : Program} (hsl : p.IsStraightLine) (r : Regs) :
+    let s := straightLinefinalState hsl r
     Steps p ⟨0, r⟩ s ∧ s.isHalted p ∧ s.pc = p.length :=
   Classical.choose_spec (straight_line_halts_from_regs hsl r)
 
 /-- The final registers after running a straight-line program from given starting registers. -/
-noncomputable def straightLine_finalRegs {p : Program} (hsl : p.IsStraightLine) (r : Regs) : Regs :=
-  (straightLine_finalState hsl r).regs
+noncomputable def straightLineFinalRegs {p : Program} (hsl : p.IsStraightLine) (r : Regs) : Regs :=
+  (straightLinefinalState hsl r).regs
 
-/-- For a straight-line program, s.regs equals straightLine_finalRegs if halted from r. -/
-theorem straightLine_finalRegs_eq_of_halted {p : Program} (hsl : p.IsStraightLine)
+/-- For a straight-line program, s.regs equals straightLineFinalRegs if halted from r. -/
+theorem straightLineFinalRegs_eq_of_halted {p : Program} (hsl : p.IsStraightLine)
     (r : Regs) (s : State) (hsteps : Steps p ⟨0, r⟩ s) (hhalted : s.isHalted p) :
-    s.regs = straightLine_finalRegs hsl r :=
-  Steps.eq_of_halts hsteps hhalted (straightLine_finalState_spec hsl r).1
-    (straightLine_finalState_spec hsl r).2.1 ▸ rfl
+    s.regs = straightLineFinalRegs hsl r :=
+  Steps.eq_of_halts hsteps hhalted (straightLinefinalState_spec hsl r).1
+    (straightLinefinalState_spec hsl r).2.1 ▸ rfl
 
 /-- In a straight-line program, we can characterize the state at any intermediate pc.
 This gives us the state after executing instructions 0..pc-1. -/
diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean
index ba71605564..e61272d57d 100644
--- a/Cslib/Foundations/Data/BiTape.lean
+++ b/Cslib/Foundations/Data/BiTape.lean
@@ -33,7 +33,7 @@ will not collide.
 * `BiTape`: A tape with a head symbol and left/right contents stored as `StackTape`
 * `BiTape.move`: Move the tape head left or right
 * `BiTape.write`: Write a symbol at the current head position
-* `BiTape.space_used`: The space used by the tape
+* `BiTape.spaceUsed`: The space used by the tape
 -/
 
 @[expose] public section
@@ -76,28 +76,28 @@ with the head under the first element of the list if it exists.
 def mk₁ (l : List Symbol) : BiTape Symbol :=
   match l with
   | [] => ∅
-  | h :: t => { head := some h, left := ∅, right := StackTape.map_some t }
+  | h :: t => { head := some h, left := ∅, right := StackTape.mapSome t }
 
 section Move
 
 /--
 Move the head left by shifting the left StackTape under the head.
 -/
-def move_left (t : BiTape Symbol) : BiTape Symbol :=
+def moveLeft (t : BiTape Symbol) : BiTape Symbol :=
   ⟨t.left.head, t.left.tail, StackTape.cons t.head t.right⟩
 
 /--
 Move the head right by shifting the right StackTape under the head.
 -/
-def move_right (t : BiTape Symbol) : BiTape Symbol :=
+def moveRight (t : BiTape Symbol) : BiTape Symbol :=
   ⟨t.right.head, StackTape.cons t.head t.left, t.right.tail⟩
 
 /--
 Move the head to the left or right, shifting the tape underneath it.
 -/
 def move (t : BiTape Symbol) : Dir → BiTape Symbol
-  | .left => t.move_left
-  | .right => t.move_right
+  | .left => t.moveLeft
+  | .right => t.moveRight
 
 /--
 Optionally perform a `move`, or do nothing if `none`.
@@ -107,12 +107,12 @@ def optionMove : BiTape Symbol → Option Dir → BiTape Symbol
   | t, some d => t.move d
 
 @[simp]
-lemma move_left_move_right (t : BiTape Symbol) : t.move_left.move_right = t := by
-  simp [move_right, move_left]
+lemma moveLeft_moveRight (t : BiTape Symbol) : t.moveLeft.moveRight = t := by
+  simp [moveRight, moveLeft]
 
 @[simp]
-lemma move_right_move_left (t : BiTape Symbol) : t.move_right.move_left = t := by
-  simp [move_left, move_right]
+lemma moveRight_moveLeft (t : BiTape Symbol) : t.moveRight.moveLeft = t := by
+  simp [moveLeft, moveRight]
 
 end Move
 
@@ -126,22 +126,22 @@ 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 space_used (t : BiTape Symbol) : ℕ := 1 + t.left.length + t.right.length
+def spaceUsed (t : BiTape Symbol) : ℕ := 1 + t.left.length + t.right.length
 
 @[simp, grind =]
-lemma space_used_write (t : BiTape Symbol) (a : Option Symbol) :
-    (t.write a).space_used = t.space_used := by rfl
+lemma spaceUsed_write (t : BiTape Symbol) (a : Option Symbol) :
+    (t.write a).spaceUsed = t.spaceUsed := by rfl
 
-lemma space_used_mk₁ (l : List Symbol) :
-    (mk₁ l).space_used = max 1 l.length := by
+lemma spaceUsed_mk₁ (l : List Symbol) :
+    (mk₁ l).spaceUsed = max 1 l.length := by
   cases l with
-  | nil => simp [mk₁, space_used, nil, StackTape.length_nil]
-  | cons h t => simp [mk₁, space_used, StackTape.length_nil, StackTape.length_map_some]; omega
+  | nil => simp [mk₁, spaceUsed, nil, StackTape.length_nil]
+  | cons h t => simp [mk₁, spaceUsed, StackTape.length_nil, StackTape.length_mapSome]; omega
 
-lemma space_used_move (t : BiTape Symbol) (d : Dir) :
-    (t.move d).space_used ≤ t.space_used + 1 := by
-  cases d <;> grind [move_left, move_right, move,
-    space_used, StackTape.length_tail_le, StackTape.length_cons_le]
+lemma spaceUsed_move (t : BiTape Symbol) (d : 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
 
diff --git a/Cslib/Foundations/Data/HasFresh.lean b/Cslib/Foundations/Data/HasFresh.lean
index 689fe0a267..6c095a334d 100644
--- a/Cslib/Foundations/Data/HasFresh.lean
+++ b/Cslib/Foundations/Data/HasFresh.lean
@@ -134,7 +134,7 @@ instance HasFresh.to_infinite (α : Type u) [HasFresh α] : Infinite α := by
 
 /-- All infinite types have an associated (at least noncomputable) fresh function.
 This, in conjunction with `HasFresh.to_infinite`, characterizes `HasFresh`. -/
-noncomputable instance HasFresh.of_infinite (α : Type u) [Infinite α] : HasFresh α where
+noncomputable instance (α : Type u) [Infinite α] : HasFresh α where
   fresh s := Infinite.exists_notMem_finset s |>.choose
   fresh_notMem s := by grind
 
diff --git a/Cslib/Foundations/Data/Relation.lean b/Cslib/Foundations/Data/Relation.lean
index 29635bee64..4ff14dfb03 100644
--- a/Cslib/Foundations/Data/Relation.lean
+++ b/Cslib/Foundations/Data/Relation.lean
@@ -294,21 +294,19 @@ theorem ChurchRosser.normal_eq (cr : ChurchRosser r) (nx : Normal r x) (ny : Nor
 
 /-- A pair of subrelations lifts to transitivity on the relation. -/
 @[implicit_reducible]
-def trans_of_subrelation (s s' r : α → α → Prop) (hr : IsTrans α r)
-    (h : Subrelation s r) (h' : Subrelation s' r) : Trans s s' r where
-  trans hab hbc := hr.trans _ _ _ (h hab) (h' hbc)
+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 trans_of_subrelation_left (s r : α → α → Prop) (hr : IsTrans α r)
-    (h : Subrelation s r) : Trans s r r where
-  trans hab hbc := hr.trans _ _ _ (h hab) hbc
+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 trans_of_subrelation_right (s r : α → α → Prop) (hr : IsTrans α r)
-    (h : Subrelation s r) : Trans r s r where
-  trans hab hbc := hr.trans _ _ _ hab (h hbc)
+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) :
@@ -559,7 +557,7 @@ theorem Commute.join_confluent (c₁ : Confluent r₁) (c₂ : Confluent r₂) (
     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₁ : Subrelation r₁ r₂) (h₂ : Subrelation r₂ (ReflTransGen r₁)) :
+theorem reflTransGen_mono_closed (h₁ : r₁ ≤ r₂) (h₂ : r₂ ≤ ReflTransGen r₁) :
     ReflTransGen r₁ = ReflTransGen r₂ := by
   ext
   exact ⟨ReflTransGen.mono @h₁, reflTransGen_closed @h₂⟩
@@ -638,10 +636,10 @@ macro_rules
   def PredReduction (a b : ℕ) : Prop := a = b + 1
   ```
 -/
-syntax (name := reduction_sys) "reduction_sys" (ppSpace str)? : attr
+syntax (name := reductionSys) "reduction_sys" (ppSpace str)? : attr
 
 initialize Lean.registerBuiltinAttribute {
-  name := `reduction_sys
+  name := `reductionSys
   descr := "Register notation for a relation and its closures."
   add := fun decl stx _ => MetaM.run' do
     let currNamespace ← getCurrNamespace
diff --git a/Cslib/Foundations/Data/StackTape.lean b/Cslib/Foundations/Data/StackTape.lean
index f495d897a2..a252582b02 100644
--- a/Cslib/Foundations/Data/StackTape.lean
+++ b/Cslib/Foundations/Data/StackTape.lean
@@ -140,7 +140,7 @@ lemma cons_head_tail (l : StackTape Symbol) :
 
 /-- Create a `StackTape` from a list by mapping all elements to `some` -/
 @[scoped grind]
-def map_some (l : List Symbol) : StackTape Symbol := ⟨l.map some, by simp⟩
+def mapSome (l : List Symbol) : StackTape Symbol := ⟨l.map some, by simp⟩
 
 section Length
 
@@ -169,7 +169,7 @@ lemma length_cons_le (o : Option Symbol) (l : StackTape Symbol) :
   cases o <;> grind
 
 @[simp, scoped grind =]
-lemma length_map_some (l : List Symbol) : (map_some l).length = l.length := by grind
+lemma length_mapSome (l : List Symbol) : (mapSome l).length = l.length := by grind
 
 @[simp, scoped grind =]
 lemma length_nil : (nil : StackTape Symbol).length = 0 := by grind
diff --git a/Cslib/Foundations/Logic/LogicalEquivalence.lean b/Cslib/Foundations/Logic/LogicalEquivalence.lean
index e08755f014..7f6c0d332c 100644
--- a/Cslib/Foundations/Logic/LogicalEquivalence.lean
+++ b/Cslib/Foundations/Logic/LogicalEquivalence.lean
@@ -26,7 +26,7 @@ class LogicalEquivalence
   /-- Proof that `eqv` is a congruence. -/
   [congruence : Congruence Proposition eqv]
   /-- Validity is preserved for any judgemental context. -/
-  eqv_fill_valid (heqv : eqv a b) (c : HasHContext.Context Judgement Proposition)
+  eqvFillValid (heqv : eqv a b) (c : HasHContext.Context Judgement Proposition)
     (h : Valid (c<[a])) : Valid (c<[b])
 
 @[inherit_doc]
diff --git a/Cslib/Foundations/Semantics/LTS/Notation.lean b/Cslib/Foundations/Semantics/LTS/Notation.lean
index ea71ec88ea..59198c133b 100644
--- a/Cslib/Foundations/Semantics/LTS/Notation.lean
+++ b/Cslib/Foundations/Semantics/LTS/Notation.lean
@@ -77,10 +77,10 @@ macro_rules
      )
 
 /-- This attribute calls the `lts_transition_notation` command for the annotated declaration. -/
-syntax (name := lts_attr) "lts" ident (ppSpace str)? : attr
+syntax (name := ltsAttr) "lts" ident (ppSpace str)? : attr
 
 initialize Lean.registerBuiltinAttribute {
-  name := `lts_attr
+  name := `ltsAttr
   descr := "Register notation for an LTS"
   add := fun decl stx _ => MetaM.run' do
     let currNamespace ← getCurrNamespace
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Context.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Context.lean
index d8df3b2271..d78dd6eb3d 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Context.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Context.lean
@@ -68,17 +68,17 @@ variable {Γ Δ : Context α β}
 
 /-- A mapping of values within a context. -/
 @[simp, scoped grind]
-def map_val (f : β → β) (Γ : Context α β) : Context α β :=
+def mapVal (f : β → β) (Γ : Context α β) : Context α β :=
   Γ.map (fun ⟨var,ty⟩ => ⟨var,f ty⟩)
 
 omit [DecidableEq α] in
 /-- A mapping of values preserves keys. -/
 @[scoped grind .]
-lemma map_val_keys (f) : Γ.keys = (Γ.map_val f).keys := by
+lemma mapVal_keys (f) : Γ.keys = (Γ.mapVal f).keys := by
   induction Γ <;> grind
 
 /-- A mapping of values maps lookups. -/
-lemma map_val_mem (mem : σ ∈ Γ.dlookup x) (f) : f σ ∈ (Γ.map_val f).dlookup x := by
+lemma mapVal_mem (mem : σ ∈ Γ.dlookup x) (f) : f σ ∈ (Γ.mapVal f).dlookup x := by
   induction Γ <;> grind
 
 end LambdaCalculus.LocallyNameless.Context
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Basic.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Basic.lean
index 2b7483d3dc..51098b693f 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Basic.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Basic.lean
@@ -90,21 +90,21 @@ def Binding.fv : Binding Var → Finset Var
 
 /-- Free type variables of a term. -/
 @[scoped grind =]
-def Term.fv_ty : Term Var → Finset Var
+def Term.fvTy : Term Var → Finset Var
 | bvar _ | fvar _ => {}
-| abs σ t₁ | tabs σ t₁ | tapp t₁ σ => σ.fv ∪ t₁.fv_ty
-| inl t₁ | inr t₁ => t₁.fv_ty
-| app t₁ t₂ | let' t₁ t₂ => t₁.fv_ty ∪ t₂.fv_ty
-| case t₁ t₂ t₃ => t₁.fv_ty ∪ t₂.fv_ty ∪ t₃.fv_ty
+| abs σ t₁ | tabs σ t₁ | tapp t₁ σ => σ.fv ∪ t₁.fvTy
+| inl t₁ | inr t₁ => t₁.fvTy
+| app t₁ t₂ | let' t₁ t₂ => t₁.fvTy ∪ t₂.fvTy
+| case t₁ t₂ t₃ => t₁.fvTy ∪ t₂.fvTy ∪ t₃.fvTy
 
 /-- Free term variables of a term. -/
 @[scoped grind =]
-def Term.fv_tm : Term Var → Finset Var
+def Term.fvTm : Term Var → Finset Var
 | bvar _ => {}
 | fvar x => {x}
-| abs _ t₁ | tabs _ t₁ | tapp t₁ _ | inl t₁ | inr t₁ => t₁.fv_tm
-| app t₁ t₂ | let' t₁ t₂ => t₁.fv_tm ∪ t₂.fv_tm
-| case t₁ t₂ t₃ => t₁.fv_tm ∪ t₂.fv_tm ∪ t₃.fv_tm
+| abs _ t₁ | tabs _ t₁ | tapp t₁ _ | inl t₁ | inr t₁ => t₁.fvTm
+| app t₁ t₂ | let' t₁ t₂ => t₁.fvTm ∪ t₂.fvTm
+| case t₁ t₂ t₃ => t₁.fvTm ∪ t₂.fvTm ∪ t₃.fvTm
 
 /-- A context of bindings. -/
 abbrev Env (Var : Type*) := Context Var (Binding Var)
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Opening.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Opening.lean
index 489791ddc7..1d7060916e 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Opening.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Opening.lean
@@ -144,51 +144,51 @@ open scoped Ty
 
 /-- Variable opening (term opening to type) of the ith bound variable. -/
 @[scoped grind =]
-def openRec_ty (X : ℕ) (δ : Ty Var) : Term Var → Term Var
+def openRecTy (X : ℕ) (δ : Ty Var) : Term Var → Term Var
 | bvar x => bvar x
 | fvar x => fvar x
-| abs σ t₁ => abs (σ⟦X ↝ δ⟧ᵞ) (openRec_ty X δ t₁)
-| app t₁ t₂ => app (openRec_ty X δ t₁) (openRec_ty X δ t₂)
-| tabs σ t₁ => tabs (σ⟦X ↝ δ⟧ᵞ) (openRec_ty (X + 1) δ t₁)
-| tapp t₁ σ => tapp (openRec_ty X δ t₁) (σ⟦X ↝ δ⟧ᵞ)
-| let' t₁ t₂ => let' (openRec_ty X δ t₁) (openRec_ty X δ t₂)
-| inl t₁ => inl (openRec_ty X δ t₁)
-| inr t₂ => inr (openRec_ty X δ t₂)
-| case t₁ t₂ t₃ => case (openRec_ty X δ t₁) (openRec_ty X δ t₂) (openRec_ty X δ t₃)
+| abs σ t₁ => abs (σ⟦X ↝ δ⟧ᵞ) (openRecTy X δ t₁)
+| app t₁ t₂ => app (openRecTy X δ t₁) (openRecTy X δ t₂)
+| tabs σ t₁ => tabs (σ⟦X ↝ δ⟧ᵞ) (openRecTy (X + 1) δ t₁)
+| tapp t₁ σ => tapp (openRecTy X δ t₁) (σ⟦X ↝ δ⟧ᵞ)
+| let' t₁ t₂ => let' (openRecTy X δ t₁) (openRecTy X δ t₂)
+| inl t₁ => inl (openRecTy X δ t₁)
+| inr t₂ => inr (openRecTy X δ t₂)
+| case t₁ t₂ t₃ => case (openRecTy X δ t₁) (openRecTy X δ t₂) (openRecTy X δ t₃)
 
 @[inherit_doc]
-scoped notation:68 t "⟦" X " ↝ " δ "⟧ᵗᵞ"=> openRec_ty X δ t
+scoped notation:68 t "⟦" X " ↝ " δ "⟧ᵗᵞ"=> openRecTy X δ t
 
 /-- Variable opening (term opening to type) of the closest binding. -/
 @[scoped grind =]
-def open_ty (t : Term Var) (δ : Ty Var) := openRec_ty 0 δ t
+def openTy (t : Term Var) (δ : Ty Var) := openRecTy 0 δ t
 
 @[inherit_doc]
-scoped infixr:80 " ^ᵗᵞ " => open_ty
+scoped infixr:80 " ^ᵗᵞ " => openTy
 
 /-- Variable opening (term opening to term) of the ith bound variable. -/
 @[scoped grind =]
-def openRec_tm (x : ℕ) (s : Term Var) : Term Var → Term Var
+def openRecTm (x : ℕ) (s : Term Var) : Term Var → Term Var
 | bvar y => if x = y then s else (bvar y)
 | fvar x => fvar x
-| abs σ t₁ => abs σ (openRec_tm (x + 1) s t₁)
-| app t₁ t₂ => app (openRec_tm x s t₁) (openRec_tm x s t₂)
-| tabs σ t₁ => tabs σ (openRec_tm x s t₁)
-| tapp t₁ σ => tapp (openRec_tm x s t₁) σ
-| let' t₁ t₂ => let' (openRec_tm x s t₁) (openRec_tm (x + 1) s t₂)
-| inl t₁ => inl (openRec_tm x s t₁)
-| inr t₂ => inr (openRec_tm x s t₂)
-| case t₁ t₂ t₃ => case (openRec_tm x s t₁) (openRec_tm (x + 1) s t₂) (openRec_tm (x + 1) s t₃)
+| abs σ t₁ => abs σ (openRecTm (x + 1) s t₁)
+| app t₁ t₂ => app (openRecTm x s t₁) (openRecTm x s t₂)
+| tabs σ t₁ => tabs σ (openRecTm x s t₁)
+| tapp t₁ σ => tapp (openRecTm x s t₁) σ
+| let' t₁ t₂ => let' (openRecTm x s t₁) (openRecTm (x + 1) s t₂)
+| inl t₁ => inl (openRecTm x s t₁)
+| inr t₂ => inr (openRecTm x s t₂)
+| case t₁ t₂ t₃ => case (openRecTm x s t₁) (openRecTm (x + 1) s t₂) (openRecTm (x + 1) s t₃)
 
 @[inherit_doc]
-scoped notation:68 t "⟦" x " ↝ " s "⟧ᵗᵗ"=> openRec_tm x s t
+scoped notation:68 t "⟦" x " ↝ " s "⟧ᵗᵗ"=> openRecTm x s t
 
 /-- Variable opening (term opening to term) of the closest binding. -/
 @[scoped grind =]
-def open_tm (t₁ t₂ : Term Var) := openRec_tm 0 t₂ t₁
+def openTm (t₁ t₂ : Term Var) := openRecTm 0 t₂ t₁
 
 @[inherit_doc]
-scoped infixr:80 " ^ᵗᵗ " => open_tm
+scoped infixr:80 " ^ᵗᵗ " => openTm
 
 /-- Locally closed terms. -/
 inductive LC : Term Var → Prop
@@ -212,189 +212,189 @@ variable {t : Term Var} {δ : Ty Var}
 
 omit [HasFresh Var] [DecidableEq Var] in
 /-- An opening (term to type) appearing in both sides of an equality of terms can be removed. -/
-lemma openRec_ty_neq_eq (neq : X ≠ Y) (eq : t⟦Y ↝ σ⟧ᵗᵞ = t⟦Y ↝ σ⟧ᵗᵞ⟦X ↝ τ⟧ᵗᵞ) :
+lemma openRecTy_neq_eq (neq : X ≠ Y) (eq : t⟦Y ↝ σ⟧ᵗᵞ = t⟦Y ↝ σ⟧ᵗᵞ⟦X ↝ τ⟧ᵗᵞ) :
     t = t⟦X ↝ τ⟧ᵗᵞ := by
   induction t generalizing X Y <;> grind [Ty.openRec_neq_eq]
 
 omit [HasFresh Var] [DecidableEq Var] in
 /-- Elimination of mixed term and type opening. -/
 @[scoped grind .]
-lemma openRec_tm_ty_eq (eq : t⟦x ↝ s⟧ᵗᵗ = t⟦x ↝ s⟧ᵗᵗ⟦y ↝ δ⟧ᵗᵞ) : t = t⟦y ↝ δ⟧ᵗᵞ
+lemma openRecTm_ty_eq (eq : t⟦x ↝ s⟧ᵗᵗ = t⟦x ↝ s⟧ᵗᵗ⟦y ↝ δ⟧ᵗᵞ) : t = t⟦y ↝ δ⟧ᵗᵞ
   := by induction t generalizing x y <;> grind
 
 /-- A locally closed term is unchanged by type opening. -/
 @[scoped grind =_]
-lemma openRec_ty_lc {t : Term Var} (lc : t.LC) : t = t⟦X ↝ σ⟧ᵗᵞ := by
+lemma openRecTy_lc {t : Term Var} (lc : t.LC) : t = t⟦X ↝ σ⟧ᵗᵞ := by
   induction lc generalizing X with
   | let' | case | tabs | abs =>
-    grind [fresh_exists <| free_union Var, Ty.openRec_lc, openRec_ty_neq_eq]
+    grind [fresh_exists <| free_union Var, Ty.openRec_lc, openRecTy_neq_eq]
   | _ => grind [Ty.openRec_lc]
 
 /-- Substitution of a type within a term. -/
 @[scoped grind =]
-def subst_ty (X : Var) (δ : Ty Var) : Term Var → Term Var
+def substTy (X : Var) (δ : Ty Var) : Term Var → Term Var
 | bvar x => bvar x
 | fvar x => fvar x
-| abs σ t₁ => abs (σ [X := δ]) (subst_ty X δ t₁)
-| app t₁ t₂ => app (subst_ty X δ t₁) (subst_ty X δ t₂)
-| tabs σ t₁ => tabs (σ [X := δ]) (subst_ty X δ t₁)
-| tapp t₁ σ => tapp (subst_ty X δ t₁) (σ[X := δ])
-| let' t₁ t₂ => let' (subst_ty X δ t₁) (subst_ty X δ t₂)
-| inl t₁ => inl (subst_ty X δ t₁)
-| inr t₁ => inr (subst_ty X δ t₁)
-| case t₁ t₂ t₃ => case (subst_ty X δ t₁) (subst_ty X δ t₂) (subst_ty 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₁)
+| tapp t₁ σ => tapp (substTy X δ t₁) (σ[X := δ])
+| let' t₁ t₂ => let' (substTy X δ t₁) (substTy X δ t₂)
+| inl t₁ => inl (substTy X δ t₁)
+| inr t₁ => inr (substTy X δ t₁)
+| case t₁ t₂ t₃ => case (substTy X δ t₁) (substTy X δ t₂) (substTy X δ t₃)
 
 instance : HasSubstitution (Term Var) Var (Ty Var) where
-  subst t X δ := Term.subst_ty X δ t
+  subst t X δ := Term.substTy X δ t
 
 omit [HasFresh Var] in
 @[scoped grind _=_]
-lemma subst_ty_def : subst_ty (X : Var) (δ : Ty Var) (t : Term Var) = t[X := δ] := by rfl
+lemma substTy_def : substTy (X : Var) (δ : Ty Var) (t : Term Var) = t[X := δ] := by rfl
 
 omit [HasFresh Var] in
 /-- Substitution of a free type variable not present in a term leaves it unchanged. -/
-lemma subst_ty_fresh (nmem : X ∉ t.fv_ty) (δ : 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 . -/
-lemma openRec_ty_subst_ty (Y : ℕ) (t : Term Var) (σ : Ty Var) (lc : δ.LC) (X : Var) :
+lemma openRecTy_substTy (Y : ℕ) (t : Term Var) (σ : Ty Var) (lc : δ.LC) (X : Var) :
     (t⟦Y ↝ σ⟧ᵗᵞ)[X := δ] = (t[X := δ])⟦Y ↝  σ[X := δ]⟧ᵗᵞ := by
   induction t generalizing Y <;> grind [Ty.openRec_subst]
 
-/-- Specialize `Term.openRec_ty_subst` to the first opening. -/
-lemma open_ty_subst_ty (t : Term Var) (σ : Ty Var) (lc : δ.LC) (X : Var) :
-     (t ^ᵗᵞ σ)[X := δ] = t[X := δ] ^ᵗᵞ σ[X := δ] := openRec_ty_subst_ty 0 t σ lc X
+/-- Specialize `Term.openRecTy_subst` to the first opening. -/
+lemma openTy_substTy (t : Term Var) (σ : Ty Var) (lc : δ.LC) (X : Var) :
+     (t ^ᵗᵞ σ)[X := δ] = t[X := δ] ^ᵗᵞ σ[X := δ] := openRecTy_substTy 0 t σ lc X
 
-/-- Specialize `Term.open_ty_subst` to free type variables. -/
-lemma open_ty_subst_ty_var (t : Term Var) (neq : Y ≠ X) (lc : δ.LC) :
-    (t ^ᵗᵞ .fvar Y)[X := δ] = t[X := δ] ^ᵗᵞ .fvar Y := by grind [open_ty_subst_ty]
+/-- Specialize `Term.openTy_subst` to free type variables. -/
+lemma openTy_substTy_var (t : Term Var) (neq : Y ≠ X) (lc : δ.LC) :
+    (t ^ᵗᵞ .fvar Y)[X := δ] = t[X := δ] ^ᵗᵞ .fvar Y := by grind [openTy_substTy]
 
 omit [HasFresh Var]
 
 /-- Opening a term to a type is equivalent to opening to a free variable and substituting. -/
-lemma openRec_ty_subst_ty_intro (Y : ℕ) (t : Term Var) (nmem : X ∉ t.fv_ty) :
+lemma openRecTy_substTy_intro (Y : ℕ) (t : Term Var) (nmem : X ∉ t.fvTy) :
   t⟦Y ↝ δ⟧ᵗᵞ = (t⟦Y ↝ Ty.fvar X⟧ᵗᵞ)[X := δ] := by
   induction t generalizing X δ Y <;> grind [Ty.openRec_subst_intro]
 
-/-- Specialize `Term.openRec_ty_subst_ty_intro` to the first opening. -/
-lemma open_ty_subst_ty_intro (t : Term Var) (δ : Ty Var) (nmem : X ∉ t.fv_ty) :
-    t ^ᵗᵞ δ = (t ^ᵗᵞ Ty.fvar X)[X := δ] := openRec_ty_subst_ty_intro _ _ nmem
+/-- Specialize `Term.openRecTy_substTy_intro` to the first opening. -/
+lemma openTy_substTy_intro (t : Term Var) (δ : Ty Var) (nmem : X ∉ t.fvTy) :
+    t ^ᵗᵞ δ = (t ^ᵗᵞ Ty.fvar X)[X := δ] := openRecTy_substTy_intro _ _ nmem
 
 /-- Substitution of a term within a term. -/
 @[scoped grind =]
-def subst_tm (x : Var) (s : Term Var) : Term Var → Term Var
+def substTm (x : Var) (s : Term Var) : Term Var → Term Var
 | bvar x => bvar x
 | fvar y => if y = x then s else fvar y
-| abs σ t₁ => abs σ (subst_tm x s t₁)
-| app t₁ t₂ => app (subst_tm x s t₁) (subst_tm x s t₂)
-| tabs σ t₁ => tabs σ (subst_tm x s t₁)
-| tapp t₁ σ => tapp (subst_tm x s t₁) σ
-| let' t₁ t₂ => let' (subst_tm x s t₁) (subst_tm x s t₂)
-| inl t₁ => inl (subst_tm x s t₁)
-| inr t₁ => inr (subst_tm x s t₁)
-| case t₁ t₂ t₃ => case (subst_tm x s t₁) (subst_tm x s t₂) (subst_tm x s t₃)
+| abs σ t₁ => abs σ (substTm x s t₁)
+| app t₁ t₂ => app (substTm x s t₁) (substTm x s t₂)
+| tabs σ t₁ => tabs σ (substTm x s t₁)
+| tapp t₁ σ => tapp (substTm x s t₁) σ
+| let' t₁ t₂ => let' (substTm x s t₁) (substTm x s t₂)
+| inl t₁ => inl (substTm x s t₁)
+| inr t₁ => inr (substTm x s t₁)
+| case t₁ t₂ t₃ => case (substTm x s t₁) (substTm x s t₂) (substTm x s t₃)
 
 instance : HasSubstitution (Term Var) Var (Term Var) where
-  subst t x s := Term.subst_tm x s t
+  subst t x s := Term.substTm x s t
 
 @[scoped grind _=_]
-lemma subst_tm_def : subst_tm (x : Var) (s : Term Var) (t : Term Var) = t[x := s] := by rfl
+lemma substTm_def : substTm (x : Var) (s : Term Var) (t : Term Var) = t[x := s] := by rfl
 
 omit [DecidableEq Var] in
 /-- An opening (term to term) appearing in both sides of an equality of terms can be removed. -/
-lemma openRec_tm_neq_eq (neq : x ≠ y) (eq : t⟦y ↝ s₁⟧ᵗᵗ = t⟦y ↝ s₁⟧ᵗᵗ⟦x ↝ s₂⟧ᵗᵗ) :
+lemma openRecTm_neq_eq (neq : x ≠ y) (eq : t⟦y ↝ s₁⟧ᵗᵗ = t⟦y ↝ s₁⟧ᵗᵗ⟦x ↝ s₂⟧ᵗᵗ) :
     t = t⟦x ↝ s₂⟧ᵗᵗ := by
   induction t generalizing x y <;> grind
 
 omit [DecidableEq Var] in
 /-- Elimination of mixed term and type opening. -/
-lemma openRec_ty_tm_eq (eq : t⟦Y ↝ σ⟧ᵗᵞ = t⟦Y ↝ σ⟧ᵗᵞ⟦x ↝ s⟧ᵗᵗ) : t = t⟦x ↝ s⟧ᵗᵗ := by
+lemma openRecTy_tm_eq (eq : t⟦Y ↝ σ⟧ᵗᵞ = t⟦Y ↝ σ⟧ᵗᵞ⟦x ↝ s⟧ᵗᵗ) : t = t⟦x ↝ s⟧ᵗᵗ := by
   induction t generalizing x Y <;> grind
 
 variable [HasFresh Var]
 
 /-- A locally closed term is unchanged by term opening. -/
 @[scoped grind =_]
-lemma openRec_tm_lc (lc : t.LC) : t = t⟦x ↝ s⟧ᵗᵗ := by
+lemma openRecTm_lc (lc : t.LC) : t = t⟦x ↝ s⟧ᵗᵗ := by
   induction lc generalizing x with
   | let' | case | tabs | abs =>
-    grind [fresh_exists <| free_union Var, openRec_tm_neq_eq, openRec_ty_tm_eq]
+    grind [fresh_exists <| free_union Var, openRecTm_neq_eq, openRecTy_tm_eq]
   | _ => grind
 
 variable {t s : Term Var} {δ : Ty Var} {x : Var}
 
 omit [HasFresh Var] in
 /-- Substitution of a free term variable not present in a term leaves it unchanged. -/
-lemma subst_tm_fresh (nmem : x ∉ t.fv_tm) (s : Term Var) : t = t[x := s] := by
+lemma substTm_fresh (nmem : x ∉ t.fvTm) (s : Term Var) : t = t[x := s] := by
   induction t <;> grind
 
 /-- Substitution of a locally closed term distributes with term opening to a term. -/
-lemma openRec_tm_subst_tm (y : ℕ) (t₁ t₂ : Term Var) (lc : s.LC) (x : Var) :
+lemma openRecTm_substTm (y : ℕ) (t₁ t₂ : Term Var) (lc : s.LC) (x : Var) :
     (t₁⟦y ↝ t₂⟧ᵗᵗ)[x := s] = (t₁[x := s])⟦y ↝  t₂[x := s]⟧ᵗᵗ := by
   induction t₁ generalizing y <;> grind
 
-/-- Specialize `Term.openRec_tm_subst_tm` to the first opening. -/
-lemma open_tm_subst_tm (t₁ t₂ : Term Var) (lc : s.LC) (x : Var) :
-    (t₁ ^ᵗᵗ t₂)[x := s] = (t₁[x := s]) ^ᵗᵗ t₂[x := s] := openRec_tm_subst_tm 0 t₁ t₂ lc x
+/-- Specialize `Term.openRecTm_substTm` to the first opening. -/
+lemma openTm_substTm (t₁ t₂ : Term Var) (lc : s.LC) (x : Var) :
+    (t₁ ^ᵗᵗ t₂)[x := s] = (t₁[x := s]) ^ᵗᵗ t₂[x := s] := openRecTm_substTm 0 t₁ t₂ lc x
 
-/-- Specialize `Term.openRec_tm_subst_tm` to free term variables. -/
-lemma open_tm_subst_tm_var (t : Term Var) (neq : y ≠ x) (lc : s.LC) :
-     (t ^ᵗᵗ fvar y)[x := s] = (t[x := s]) ^ᵗᵗ fvar y := by grind [open_tm_subst_tm]
+/-- Specialize `Term.openRecTm_substTm` to free term variables. -/
+lemma openTm_substTm_var (t : Term Var) (neq : y ≠ x) (lc : s.LC) :
+     (t ^ᵗᵗ fvar y)[x := s] = (t[x := s]) ^ᵗᵗ fvar y := by grind [openTm_substTm]
 
 /-- Substitution of a locally closed type distributes with term opening to a term. -/
-lemma openRec_tm_subst_ty (y : ℕ) (t₁ t₂ : Term Var) (δ : Ty Var) (X : Var) :
+lemma openRecTm_substTy (y : ℕ) (t₁ t₂ : Term Var) (δ : Ty Var) (X : Var) :
     (t₁⟦y ↝ t₂⟧ᵗᵗ)[X := δ] = (t₁[X := δ])⟦y ↝  t₂[X := δ]⟧ᵗᵗ := by
   induction t₁ generalizing y <;> grind
 
-/-- Specialize `Term.openRec_tm_subst_ty` to the first opening -/
-lemma open_tm_subst_ty (t₁ t₂ : Term Var) (δ : Ty Var) (X : Var) :
-    (t₁ ^ᵗᵗ t₂)[X := δ] = (t₁[X := δ]) ^ᵗᵗ t₂[X := δ] := openRec_tm_subst_ty 0 t₁ t₂ δ X
+/-- Specialize `Term.openRecTm_substTy` to the first opening -/
+lemma openTm_substTy (t₁ t₂ : Term Var) (δ : Ty Var) (X : Var) :
+    (t₁ ^ᵗᵗ t₂)[X := δ] = (t₁[X := δ]) ^ᵗᵗ t₂[X := δ] := openRecTm_substTy 0 t₁ t₂ δ X
 
-/-- Specialize `Term.open_tm_subst_ty` to free term variables -/
-lemma open_tm_subst_ty_var (t₁ : Term Var) (δ : Ty Var) (X y : Var) :
-    (t₁ ^ᵗᵗ fvar y)[X := δ] = (t₁[X := δ]) ^ᵗᵗ fvar y := by grind [open_tm_subst_ty]
+/-- Specialize `Term.openTm_substTy` to free term variables -/
+lemma openTm_substTy_var (t₁ : Term Var) (δ : Ty Var) (X y : Var) :
+    (t₁ ^ᵗᵗ fvar y)[X := δ] = (t₁[X := δ]) ^ᵗᵗ fvar y := by grind [openTm_substTy]
 
 /-- Substitution of a locally closed term distributes with term opening to a type. -/
-lemma openRec_ty_subst_tm (Y : ℕ) (t : Term Var) (δ : Ty Var) (lc : s.LC) (x : Var) :
+lemma openRecTy_substTm (Y : ℕ) (t : Term Var) (δ : Ty Var) (lc : s.LC) (x : Var) :
     (t⟦Y ↝ δ⟧ᵗᵞ)[x := s] = t[x := s]⟦Y ↝ δ⟧ᵗᵞ := by
   induction t generalizing Y <;> grind
 
-/-- Specialize `Term.openRec_ty_subst_tm` to the first opening. -/
-lemma open_ty_subst_tm (t : Term Var) (δ : Ty Var) (lc : s.LC) (x : Var) :
-    (t ^ᵗᵞ δ)[x := s] = t[x := s] ^ᵗᵞ δ := openRec_ty_subst_tm 0 t δ lc x
+/-- Specialize `Term.openRecTy_substTm` to the first opening. -/
+lemma openTy_substTm (t : Term Var) (δ : Ty Var) (lc : s.LC) (x : Var) :
+    (t ^ᵗᵞ δ)[x := s] = t[x := s] ^ᵗᵞ δ := openRecTy_substTm 0 t δ lc x
 
-/-- Specialize `Term.open_ty_subst_tm` to free type variables. -/
-lemma open_ty_subst_tm_var (t : Term Var) (lc : s.LC) (x Y : Var) :
-    (t ^ᵗᵞ .fvar Y)[x := s] = t[x := s] ^ᵗᵞ .fvar Y := open_ty_subst_tm _ _ lc _
+/-- Specialize `Term.openTy_substTm` to free type variables. -/
+lemma openTy_substTm_var (t : Term Var) (lc : s.LC) (x Y : Var) :
+    (t ^ᵗᵞ .fvar Y)[x := s] = t[x := s] ^ᵗᵞ .fvar Y := openTy_substTm _ _ lc _
 
 omit [HasFresh Var]
 
 /-- Opening a term to a term is equivalent to opening to a free variable and substituting. -/
-lemma openRec_tm_subst_tm_intro (y : ℕ) (t s : Term Var) (nmem : x ∉ t.fv_tm) :
+lemma openRecTm_substTm_intro (y : ℕ) (t s : Term Var) (nmem : x ∉ t.fvTm) :
     t⟦y ↝ s⟧ᵗᵗ = (t⟦y ↝ fvar x⟧ᵗᵗ)[x := s] := by
   induction t generalizing y <;> grind
 
-/-- Specialize `Term.openRec_tm_subst_tm_intro` to the first opening. -/
-lemma open_tm_subst_tm_intro (t s : Term Var) (nmem : x ∉ t.fv_tm) :
-    t ^ᵗᵗs = (t ^ᵗᵗ fvar x)[x := s] := openRec_tm_subst_tm_intro _ _ _ nmem
+/-- Specialize `Term.openRecTm_substTm_intro` to the first opening. -/
+lemma openTm_substTm_intro (t s : Term Var) (nmem : x ∉ t.fvTm) :
+    t ^ᵗᵗs = (t ^ᵗᵗ fvar x)[x := s] := openRecTm_substTm_intro _ _ _ nmem
 
 variable [HasFresh Var]
 
-lemma subst_ty_lc (t_lc : t.LC) (δ_lc : δ.LC) (X : Var) : t[X := δ].LC := by
+lemma substTy_lc (t_lc : t.LC) (δ_lc : δ.LC) (X : Var) : t[X := δ].LC := by
   induction t_lc
   case' abs  => apply LC.abs (free_union Var)
   case' tabs => apply LC.tabs (free_union Var)
   case' let' => apply LC.let' (free_union Var)
   case' case => apply LC.case (free_union Var)
-  all_goals grind [Ty.subst_lc, open_tm_subst_ty_var, openRec_ty_subst_ty]
+  all_goals grind [Ty.subst_lc, openTm_substTy_var, openRecTy_substTy]
 
-lemma subst_tm_lc (t_lc : t.LC) (s_lc : s.LC) (x : Var) : t[x := s].LC := by
+lemma substTm_lc (t_lc : t.LC) (s_lc : s.LC) (x : Var) : t[x := s].LC := by
   induction t_lc
   case' abs  => apply LC.abs (free_union Var)
   case' let' => apply LC.let' (free_union Var)
   case' case => apply LC.case (free_union Var)
   case' tabs => apply LC.tabs (free_union Var)
-  all_goals grind [open_tm_subst_tm_var, open_ty_subst_tm_var]
+  all_goals grind [openTm_substTm_var, openTy_substTm_var]
 
 end Term
 
@@ -414,10 +414,10 @@ instance : HasSubstitution (Binding Var) Var (Ty Var) where
 variable {δ γ : Ty Var} {X : Var}
 
 @[scoped grind _=_]
-lemma subst_sub : (sub γ)[X := δ] = sub (γ[X := δ]) := by rfl
+lemma substSub : (sub γ)[X := δ] = sub (γ[X := δ]) := by rfl
 
 @[scoped grind _=_]
-lemma subst_ty : (ty γ)[X := δ] = ty (γ[X := δ]) := by rfl
+lemma substTy : (ty γ)[X := δ] = ty (γ[X := δ]) := by rfl
 
 open scoped Ty in
 /-- Substitution of a free variable not present in a binding leaves it unchanged. -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Reduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Reduction.lean
index 8263fe2957..b9969aa49a 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Reduction.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Reduction.lean
@@ -68,7 +68,7 @@ variable [HasFresh Var]
 @[scoped grind <=]
 lemma open_tm_body (body : t₁.body) (lc : t₂.LC) : (t₁ ^ᵗᵗ t₂).LC := by
   cases body
-  grind [fresh_exists <| free_union [fv_tm] Var, subst_tm_lc, open_tm_subst_tm_intro]
+  grind [fresh_exists <| free_union [fvTm] Var, substTm_lc, openTm_substTm_intro]
 
 end
 
@@ -109,8 +109,8 @@ lemma Red.lc {t t' : Term Var} (red : t ⭢βᵛ t') : t.LC ∧ t'.LC := by
     · grind
     · cases lc
       grind [
-        fresh_exists <| free_union [fv_tm, fv_ty] Var, subst_tm_lc,
-        subst_ty_lc, open_tm_subst_tm_intro, open_ty_subst_ty_intro]
+        fresh_exists <| free_union [fvTm, fvTy] Var, substTm_lc,
+        substTy_lc, openTm_substTm_intro, openTy_substTy_intro]
   all_goals grind
 
 end Term
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
index c5e0116db4..cf294d3b1c 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
@@ -42,22 +42,22 @@ lemma Typing.preservation (der : Typing Γ t τ) (step : t ⭢βᵛ t') : Typing
     case abs der _ _ =>
       have sub : Sub Γ (σ.arrow τ) (σ.arrow τ) := by grind [Sub.refl]
       have ⟨_, _, ⟨_, _⟩⟩ := der.abs_inv sub
-      grind [fresh_exists <| free_union [fv_tm] Var, open_tm_subst_tm_intro, subst_tm, Sub.weaken]
+      grind [fresh_exists <| free_union [fvTm] Var, openTm_substTm_intro, subst_tm, Sub.weaken]
   case tapp Γ _ σ τ σ' _ _ _ =>
     cases step
     case tabs der _ _ =>
       have sub : Sub Γ (σ.all τ) (σ.all τ) := by grind [Sub.refl]
       have ⟨_, _, ⟨_, _⟩⟩ := der.tabs_inv sub
-      have ⟨X, mem⟩ := fresh_exists <| free_union [Ty.fv, fv_ty] Var
+      have ⟨X, mem⟩ := fresh_exists <| free_union [Ty.fv, fvTy] Var
       simp at mem
-      have : Γ = (Context.map_val (·[X:=σ']) []) ++ Γ := by grind
-      rw [open_ty_subst_ty_intro (X := X), open_subst_intro (X := X)] <;> grind [subst_ty]
+      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₁ _ =>
     cases step
     case let_bind red₁ _ => apply Typing.let' L (ih₁ red₁); grind
     case let_body =>
-      grind [fresh_exists <| free_union [fv_tm] Var, open_tm_subst_tm_intro, subst_tm]
+      grind [fresh_exists <| free_union [fvTm] Var, openTm_substTm_intro, subst_tm]
   case case Γ _ σ τ _ _ _ L _ _ _ ih₁ _ _ =>
     have sub : Sub Γ (σ.sum τ) (σ.sum τ) := by grind [Sub.refl]
     have : Γ = [] ++ Γ := by rfl
@@ -65,10 +65,10 @@ lemma Typing.preservation (der : Typing Γ t τ) (step : t ⭢βᵛ t') : Typing
     case «case» red₁ _ _ => apply Typing.case L (ih₁ red₁) <;> grind
     case case_inl der _ _ =>
       have ⟨_, ⟨_, _⟩⟩ := der.inl_inv sub
-      grind [fresh_exists <| free_union [fv_tm] Var, open_tm_subst_tm_intro, subst_tm]
+      grind [fresh_exists <| free_union [fvTm] Var, openTm_substTm_intro, subst_tm]
     case case_inr der _ _ =>
       have ⟨_, ⟨_, _⟩⟩ := der.inr_inv sub
-      grind [fresh_exists <| free_union [fv_tm] Var, open_tm_subst_tm_intro, subst_tm]
+      grind [fresh_exists <| free_union [fvTm] Var, openTm_substTm_intro, subst_tm]
   all_goals grind [cases Red]
 
 /-- Any typable term either has a reduction step or is a value. -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Subtype.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Subtype.lean
index 4f0635f5e8..1a8abe649d 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 (Γ.map_val (·[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 := @map_val_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 d0edd7896c..7a9e8efe0e 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Typing.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Typing.lean
@@ -124,29 +124,29 @@ lemma subst_tm (der : Typing (Γ ++ ⟨X, .ty σ⟩ :: Δ) t τ) (der_sub : Typi
       -/
       grind [→ List.mem_dlookup, weaken_head, Env.Wf.strengthen, -append_assoc]
     · grind [Env.Wf.strengthen, => List.perm_dlookup]
-  case abs => grind [abs (free_union Var), open_tm_subst_tm_var]
-  case tabs => grind [tabs (free_union Var), open_ty_subst_tm_var]
-  case let' der _ => grind [let' (free_union Var) (der eq), open_tm_subst_tm_var]
+  case abs => grind [abs (free_union Var), openTm_substTm_var]
+  case tabs => grind [tabs (free_union Var), openTy_substTm_var]
+  case let' der _ => grind [let' (free_union Var) (der eq), openTm_substTm_var]
   case case der _ _ =>
-    apply case (free_union Var) (der eq) <;> grind [open_tm_subst_tm_var]
+    apply case (free_union Var) (der eq) <;> grind [openTm_substTm_var]
   all_goals grind [Env.Wf.strengthen, Ty.Wf.strengthen, Sub.strengthen]
 
 /-- Type substitution within a typing. -/
 lemma subst_ty (der : Typing (Γ ++ ⟨X, Binding.sub δ'⟩ :: Δ) t τ) (sub : Sub Δ δ δ') :
-    Typing (Γ.map_val (·[X := δ]) ++ Δ) (t[X := δ]) (τ[X := δ]) := by
+    Typing (Γ.mapVal (·[X := δ]) ++ Δ) (t[X := δ]) (τ[X := δ]) := by
   generalize eq : Γ ++ ⟨X, Binding.sub δ'⟩ :: Δ = Θ at der
   induction der generalizing Γ X
   case var σ _ X' _ mem =>
     have := map_subst_nmem Δ X δ
-    have := @map_val_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, open_tm_subst_ty_var]
-  case tabs => grind [tabs (free_union Var), open_ty_subst_ty_var, open_subst_var]
+  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]
   case let' der _ =>
     apply let' (free_union Var) (der eq)
-    grind [open_tm_subst_ty_var]
+    grind [openTm_substTy_var]
   case case der _ _ =>
-    apply case (free_union Var) (der eq) <;> grind [open_tm_subst_ty_var]
+    apply case (free_union Var) (der eq) <;> grind [openTm_substTy_var]
   case tapp => grind [Ty.open_subst, Env.Wf.map_subst, Ty.Wf.map_subst, Sub.map_subst]
   all_goals grind [Env.Wf.map_subst, Ty.Wf.map_subst, Sub.map_subst]
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean
index 423312304e..ffb6f30237 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean
@@ -121,8 +121,8 @@ 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 : (Γ.map_val (·[X:=τ']) ++ Δ)✓) : σ[X:=τ'].Wf <| Γ.map_val (·[X:=τ']) ++ Δ := by
-  have := @map_val_mem Var (Binding Var)
+    (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
   | all => apply all (free_union [dom] Var) <;> grind [open_subst_var]
@@ -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.map_val (·[X:=δ]) [] ++ Γ := by grind
+    have : Γ = Context.mapVal (·[X:=δ]) [] ++ Γ := by grind
     grind [open_subst_intro, map_subst]
 
 /-- A type bound in a context is well formed. -/
@@ -176,7 +176,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 <| Γ.map_val (·[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]
@@ -185,7 +185,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) :
-    Γ = Γ.map_val (·[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/StrongNorm.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
index 9c98b17dac..d9ab413bdc 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
@@ -71,32 +71,32 @@ lemma semanticMap_saturated (τ : Ty Base) : @Saturated Var (semanticMap τ) :=
     · intro M N P _ _ _ s _
       grind [ih₂.multiApp M N (s :: P)]
 
-/-- The `entails_context` predicate ensures that each variable in the context
+/-- The `entailsContext` predicate ensures that each variable in the context
     is mapped to a term in the corresponding semantic map. -/
-abbrev entails_context (E : Term.Env Var) (Γ : Context Var (Ty Base)) :=
+abbrev entailsContext (E : Term.Env Var) (Γ : Context Var (Ty Base)) :=
   ∀ {x τ}, ⟨x, τ⟩ ∈ Γ → (multiSubst E (fvar x)) ∈ semanticMap τ
 
 /-- The empty context is entailed by any environment. -/
-lemma entails_context_empty {Γ : Context Var (Ty Base)} : entails_context [] Γ := by
+lemma entailsContext_empty {Γ : Context Var (Ty Base)} : entailsContext [] Γ := by
   have := semanticMap_saturated (Var := Var) (Base := Base)
   grind
 
 open scoped Context in
 omit [HasFresh Var] in
-/-- The `entails_context` predicate is preserved when extending the context
+/-- The `entailsContext` predicate is preserved when extending the context
     with a new variable, provided the new variable is fresh and its
     substitution is in the corresponding semantic map. -/
-lemma entails_context_cons (E : Term.Env Var) (Γ : Context Var (Ty Base))
+lemma entailsContext_cons (E : Term.Env Var) (Γ : Context Var (Ty Base))
     (x : Var) (τ : Ty Base) (sub : Term Var)
     (h_fresh : x ∉ E.dom ∪ E.fv ∪ Γ.dom)
     (h_mem : sub ∈ semanticMap τ) :
-    entails_context E Γ → entails_context (⟨ x, sub ⟩ :: E) (⟨ x, τ ⟩ :: Γ) := by
+    entailsContext E Γ → entailsContext (⟨ x, sub ⟩ :: E) (⟨ x, τ ⟩ :: Γ) := by
   grind [multiSubst_fvar_fresh, subst_fresh, multiSubst_preserves_not_fvar]
 
 /-- The `entails` predicate states that a term `t` is
     semantically valid with respect to a context `Γ` and a type `τ` -/
 abbrev entails (Γ : Context Var (Ty Base)) (t : Term Var) (τ : Ty Base) :=
-    ∀ E, env_LC E → (entails_context E Γ) → (multiSubst E t) ∈ semanticMap τ
+    ∀ E, envLC E → entailsContext E Γ → multiSubst E t ∈ semanticMap τ
 
 /-- The `soundness` lemma states that if a term `t` has type `τ` in context `Γ`,
     then `t` is semantically valid with respect to `Γ` and `τ` -/
@@ -111,7 +111,7 @@ lemma soundness {Γ : Context Var (Ty Base)} (derivation_t : Γ ⊢ t ∶ τ) :
     let := multiSubst E t
     have ⟨x, _⟩ := fresh_exists <| E.dom ∪ free_union [fv, Context.dom, Env.fv] Var
     have := IH (x := x) (E := ⟨x,s⟩ :: E)
-    grind [multiSubst_abs, entails_context_cons, multiSubst_open_var]
+    grind [multiSubst_abs, entailsContext_cons, multiSubst_open_var]
   | app => grind [multiSubst_app]
 
 /-- Using soundness and the fact that the empty context
@@ -119,7 +119,7 @@ lemma soundness {Γ : Context Var (Ty Base)} (derivation_t : Γ ⊢ t ∶ τ) :
     a well-typed term is strongly normalizing. -/
 theorem strong_norm {t : Term Var} {τ : Ty Base} (der : Γ ⊢ t ∶ τ) : SN FullBeta t := by
   apply (semanticMap_saturated τ).sn
-  apply (soundness der [] (by grind) entails_context_empty)
+  apply (soundness der [] (by grind) entailsContext_empty)
 
 end LambdaCalculus.LocallyNameless.Stlc
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean
index 05db5bab3d..548b3d2c0c 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean
@@ -51,10 +51,10 @@ def Env.fv (E : Env Var) : Finset Var :=
 attribute [scoped grind =] Env.fv
 
 /-- An environment is locally closed if all terms in the environment are locally closed -/
-abbrev env_LC (E : Env Var) : Prop := ∀ {x M}, ⟨x, M⟩ ∈ E → LC M
+abbrev envLC (E : Env Var) : Prop := ∀ {x M}, ⟨x, M⟩ ∈ E → LC M
 
 /-- Adding a locally closed term to an environment preserves local closure -/
-lemma env_LC_cons (lc_sub : LC sub) (lc_E : env_LC E) : env_LC (⟨ x, sub ⟩ :: E) := by
+lemma envLC_cons (lc_sub : LC sub) (lc_E : envLC E) : envLC (⟨ x, sub ⟩ :: E) := by
   grind
 
 /-- Multi-substitution of a fresh variable does nothing -/
@@ -81,7 +81,7 @@ lemma multiSubst_abs (M : Term Var) (E : Env Var) :
     provided that the variable is not in the domain of the environment
     and the environment is locally closed -/
 lemma multiSubst_open_var [HasFresh Var] (M : Term Var) (E : Env Var) (x : Var)
-  (h_ndom : x ∉ E.dom) (h_lc : env_LC E) :
+  (h_ndom : x ∉ E.dom) (h_lc : envLC E) :
     multiSubst E (M ^ fvar x) = multiSubst E M ^ fvar x := by
   induction E with grind
 
diff --git a/Cslib/Logics/HML/LogicalEquivalence.lean b/Cslib/Logics/HML/LogicalEquivalence.lean
index 3bd8c11bfd..5bad96e468 100644
--- a/Cslib/Logics/HML/LogicalEquivalence.lean
+++ b/Cslib/Logics/HML/LogicalEquivalence.lean
@@ -105,7 +105,7 @@ instance judgementalContext :
 instance : LogicalEquivalence
     (Proposition Label) (Satisfies.Judgement State Label) (Satisfies.Bundled) where
   eqv := Proposition.Equiv
-  eqv_fill_valid {a b : Proposition Label} (heqv : a.Equiv (State := State) b)
+  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]
diff --git a/Cslib/Logics/LinearLogic/CLL/Basic.lean b/Cslib/Logics/LinearLogic/CLL/Basic.lean
index bb9b145de7..c331ae2ae8 100644
--- a/Cslib/Logics/LinearLogic/CLL/Basic.lean
+++ b/Cslib/Logics/LinearLogic/CLL/Basic.lean
@@ -114,11 +114,11 @@ def Proposition.negative : Proposition Atom → Bool
   | _ => false
 
 /-- Whether a `Proposition` is positive is decidable. -/
-instance Proposition.positive_decidable (a : Proposition Atom) : Decidable a.positive :=
+instance Proposition.positiveDecidable (a : Proposition Atom) : Decidable a.positive :=
   a.positive.decEq true
 
 /-- Whether a `Proposition` is negative is decidable. -/
-instance Proposition.negative_decidable (a : Proposition Atom) : Decidable a.negative :=
+instance Proposition.negativeDecidable (a : Proposition Atom) : Decidable a.negative :=
   a.negative.decEq true
 
 /-- Propositional duality. -/
@@ -225,21 +225,21 @@ def Proof.cut' (p : ⇓(a⫠ ::ₘ Γ)) (q : ⇓(a ::ₘ Δ)) : ⇓(Γ + Δ) :=
   p.cut r
 
 /-- Inversion of the ⅋ rule. -/
-def Proof.parr_inversion {Γ : Sequent Atom} (h : ⇓((a ⅋ b) ::ₘ Γ)) : ⇓(a ::ₘ b ::ₘ Γ) :=
+def Proof.parrInversion {Γ : Sequent Atom} (h : ⇓((a ⅋ b) ::ₘ Γ)) : ⇓(a ::ₘ b ::ₘ Γ) :=
   show a ::ₘ b ::ₘ Γ = {a, b} + Γ by simp ▸
     cut' (show ({a, b} : Sequent Atom) = {a} + {b} by simp ▸ tensor ax' ax') h
 
 /-- Inversion of the ⊥ rule. -/
-def Proof.bot_inversion {Γ : Sequent Atom} (h : ⇓(⊥ ::ₘ Γ)) : ⇓Γ := by
+def Proof.botInversion {Γ : Sequent Atom} (h : ⇓(⊥ ::ₘ Γ)) : ⇓Γ := by
   convert Proof.cut' (a := ⊥) (Γ := {}) (Δ := Γ) Proof.one h
   simp
 
 /-- Inversion of the & rule, first component. -/
-def Proof.with_inversion₁ {Γ : Sequent Atom} (h : ⇓((a & b) ::ₘ Γ)) : ⇓(a ::ₘ Γ) :=
+def Proof.withInversion₁ {Γ : Sequent Atom} (h : ⇓((a & b) ::ₘ Γ)) : ⇓(a ::ₘ Γ) :=
   cut' (a := a & b) (oplus₁ ax') h
 
 /-- Inversion of the & rule, second component. -/
-def Proof.with_inversion₂ {Γ : Sequent Atom} (h : ⇓((a & b) ::ₘ Γ)) : ⇓(b ::ₘ Γ) :=
+def Proof.withInversion₂ {Γ : Sequent Atom} (h : ⇓((a & b) ::ₘ Γ)) : ⇓(b ::ₘ Γ) :=
   cut' (a := a & b) (oplus₂ ax') h
 
 section LogicalEquiv
@@ -314,23 +314,23 @@ instance : IsEquiv (Proposition Atom) Proposition.Equiv where
 
 /-- !⊤ ≡⇓ 1 -/
 @[scoped grind =]
-def bang_top_eqv_one : (!⊤ : Proposition Atom) ≡⇓ 1 :=
+def bangTopEqvOne : (!⊤ : Proposition Atom) ≡⇓ 1 :=
   ⟨.weaken .one, .bot (.bang rfl .top)⟩
 
 /-- ʔ0 ≡⇓ ⊥ -/
 @[scoped grind =]
-def quest_zero_eqv_bot : (ʔ0 : Proposition Atom) ≡⇓ ⊥ :=
+def questZeroEqvBot : (ʔ0 : Proposition Atom) ≡⇓ ⊥ :=
   ⟨rwConclusion (Multiset.pair_comm ..) <| .bot (.bang rfl .top),
    rwConclusion (Multiset.pair_comm ..) <| .weaken .one⟩
 
 /-- a ⊗ 0 ≡⇓ 0 -/
 @[scoped grind =]
-def tensor_zero_eqv_zero (a : Proposition Atom) : a ⊗ 0 ≡⇓ 0 :=
+def tensorZeroEqvZero (a : Proposition Atom) : a ⊗ 0 ≡⇓ 0 :=
   ⟨.parr <| .rwConclusion (Multiset.cons_swap ..) .top, .top⟩
 
 /-- a ⅋ ⊤ ≡⇓ ⊤ -/
 @[scoped grind =]
-def parr_top_eqv_top (a : Proposition Atom) : a ⅋ ⊤ ≡⇓ ⊤ :=
+def parrTopEqvTop (a : Proposition Atom) : a ⅋ ⊤ ≡⇓ ⊤ :=
   ⟨.rwConclusion (Multiset.cons_swap ..) .top,
    .rwConclusion (Multiset.cons_swap ..) <| .parr <| .rwConclusion (Multiset.cons_swap ..) .top⟩
 
@@ -343,7 +343,7 @@ attribute [local grind =] Multiset.insert_eq_cons
 
 open scoped Multiset in
 /-- ⊗ distributes over ⊕. -/
-def tensor_distrib_oplus (a b c : Proposition Atom) : a ⊗ (b ⊕ c) ≡⇓ (a ⊗ b) ⊕ (a ⊗ c) :=
+def tensorDistribOplus (a b c : Proposition Atom) : a ⊗ (b ⊕ c) ≡⇓ (a ⊗ b) ⊕ (a ⊗ c) :=
   ⟨.parr <|
     .rwConclusion (Multiset.cons_swap ..) <|
     .with
@@ -362,7 +362,7 @@ def tensor_distrib_oplus (a b c : Proposition Atom) : a ⊗ (b ⊕ c) ≡⇓ (a
 /-- The proposition at the head of a proof can be substituted by an equivalent
   proposition. -/
 @[scoped grind =]
-def subst_eqv_head {Γ : Sequent Atom} (heqv : a ≡⇓ b) (p : ⇓(a ::ₘ Γ)) : ⇓(b ::ₘ Γ) :=
+def substEqvHead {Γ : Sequent Atom} (heqv : a ≡⇓ b) (p : ⇓(a ::ₘ Γ)) : ⇓(b ::ₘ Γ) :=
   show b ::ₘ Γ = Γ + {b} by grind ▸ p.cut heqv.1
 
 theorem add_middle_eq_cons {a : Proposition Atom} : Γ + {a} + Δ = a ::ₘ (Γ + Δ) := by
@@ -372,8 +372,8 @@ open scoped Multiset in
 /-- Any proposition in a proof (regardless of its position) can be substituted by
   an equivalent proposition. -/
 @[scoped grind =]
-def subst_eqv {Γ Δ : Sequent Atom} (heqv : a ≡⇓ b) (p : ⇓(Γ + {a} + Δ)) : ⇓(Γ + {b} + Δ) :=
-  add_middle_eq_cons ▸ subst_eqv_head heqv (add_middle_eq_cons ▸ p)
+def substEqv {Γ Δ : Sequent Atom} (heqv : a ≡⇓ b) (p : ⇓(Γ + {a} + Δ)) : ⇓(Γ + {b} + Δ) :=
+  add_middle_eq_cons ▸ substEqvHead heqv (add_middle_eq_cons ▸ p)
 
 open scoped Context
 
@@ -652,14 +652,14 @@ instance : Congruence (Proposition Atom) Proposition.Equiv where
 
 noncomputable instance : LogicalEquivalence (Proposition Atom) (Sequent Atom) Proof where
   eqv := Proposition.Equiv
-  eqv_fill_valid {a b : Proposition Atom} (heqv : a.Equiv b)
+  eqvFillValid {a b : Proposition Atom} (heqv : a.Equiv b)
       (c : HasHContext.Context (Sequent Atom) (Proposition Atom))
       (h : ⇓c<[a]) : ⇓c<[b] := by
-    apply subst_eqv_head (chooseEquiv heqv) h
+    apply substEqvHead (chooseEquiv heqv) h
 
 /-- Tensor is commutative. -/
 @[scoped grind ←]
-def tensor_symm {a b : Proposition Atom} : a ⊗ b ≡⇓ b ⊗ a :=
+def tensorSymm {a b : Proposition Atom} : a ⊗ b ≡⇓ b ⊗ a :=
   ⟨.parr <| show a⫠ ::ₘ b⫠ ::ₘ {b ⊗ a} = (b ⊗ a) ::ₘ {b⫠} + {a⫠} by grind ▸ .tensor .ax .ax,
    .parr <| show b⫠ ::ₘ a⫠ ::ₘ {a ⊗ b} = (a ⊗ b) ::ₘ {a⫠} + {b⫠} by grind ▸ .tensor .ax .ax⟩
 
@@ -667,7 +667,7 @@ def tensor_symm {a b : Proposition Atom} : a ⊗ b ≡⇓ b ⊗ a :=
 open scoped Multiset in
 /-- ⊗ is associative. -/
 @[scoped grind ←]
-def tensor_assoc {a b c : Proposition Atom} : a ⊗ (b ⊗ c) ≡⇓ (a ⊗ b) ⊗ c :=
+def tensorAssoc {a b c : Proposition Atom} : a ⊗ (b ⊗ c) ≡⇓ (a ⊗ b) ⊗ c :=
   ⟨.parr <|
      Multiset.cons_swap .. ▸
      (.parr <|
@@ -679,17 +679,17 @@ def tensor_assoc {a b c : Proposition Atom} : a ⊗ (b ⊗ c) ≡⇓ (a ⊗ b) 
      (.tensor .ax <| .tensor .ax .ax)⟩
 
 instance {Γ : Sequent Atom} : Std.Symm (fun a b => Derivable ((a ⊗ b) ::ₘ Γ)) where
-  symm _ _ h := DerivableIn.fromDerivation (subst_eqv_head tensor_symm (DerivableIn.toDerivation h))
+  symm _ _ h := DerivableIn.fromDerivation (substEqvHead tensorSymm (DerivableIn.toDerivation h))
 
 /-- ⊕ is idempotent. -/
 @[scoped grind ←]
-def oplus_idem {a : Proposition Atom} : a ⊕ a ≡⇓ a :=
+def oplusIdem {a : Proposition Atom} : a ⊕ a ≡⇓ a :=
   ⟨.with .ax' .ax',
    show ({a⫠, a ⊕ a} : Sequent Atom) = {a ⊕ a, a⫠} by grind ▸ .oplus₁ .ax⟩
 
 /-- & is idempotent. -/
 @[scoped grind ←]
-def with_idem {a : Proposition Atom} : a & a ≡⇓ a :=
+def withIdem {a : Proposition Atom} : a & a ≡⇓ a :=
   ⟨.oplus₁ .ax',
    show ({a⫠, a & a} : Sequent Atom) = {a & a, a⫠} by grind ▸ .with .ax .ax⟩
 
diff --git a/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean b/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
index 7f7a237131..df33df215b 100644
--- a/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
+++ b/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
@@ -179,7 +179,7 @@ lemma of_Fact {G : Fact P} {p : P}
 @[scoped grind =, simp] lemma mem_carrier (G : Fact P) : G.carrier = (G : Set P) := rfl
 
 /-- Construct a fact from a set G and a proof that its biorthogonal closure is contained in G. -/
-@[simps] def Fact.mk_subset (G : Set P) (h : G⫠⫠ ⊆ G) : Fact P where
+@[simps] def Fact.mkSubset (G : Set P) (h : G⫠⫠ ⊆ G) : Fact P where
   carrier := G
   property := by grind [isFact, orth_extensive]
 
@@ -187,8 +187,8 @@ lemma dual_subset_dual {G H : Set P} (h : G ⊆ H) :
     H⫠ ⊆ G⫠ := fun _ hp _ hq => hp _ (h hq)
 
 /-- Construct a fact from a set G and a proof that G equals the orthogonal of some set H. -/
-@[simps!] def Fact.mk_dual (G H : Set P) (h : G = H⫠) : Fact P :=
-  Fact.mk_subset G <| by rw [h, triple_orth]
+@[simps!] def Fact.mkDual (G H : Set P) (h : G = H⫠) : Fact P :=
+  Fact.mkSubset G <| by rw [h, triple_orth]
 
 lemma coe_mk {X : Set P} {h : isFact X} : ((⟨X, h⟩ : Fact P) : Set P) = X := rfl
 
@@ -205,7 +205,7 @@ lemma orth_one_eq_bot :
     simpa [orthogonal, mem_setOf, mul_one] using hm
 
 /-- The fact given by the dual of G. -/
-@[simps!] def dualFact (G : Set P) : Fact P := Fact.mk_dual (G⫠) G rfl
+@[simps!] def dualFact (G : Set P) : Fact P := Fact.mkDual (G⫠) G rfl
 
 lemma dual_dual_subset_Fact_iff {G : Set P} {H : Fact P} : G⫠⫠ ⊆ H ↔ G ⊆ H := by
   constructor <;> rw [H.eq] <;> grind
@@ -227,7 +227,7 @@ lemma mul_mem_one (hp : p ∈ (1 : Fact P)) (hq : q ∈ (1 : Fact P)) : p * q 
   grind
 
 instance : Top (Fact P) where
-  top := Fact.mk_subset Set.univ <| fun _ _ => Set.mem_univ _
+  top := Fact.mkSubset Set.univ <| fun _ _ => Set.mem_univ _
 
 @[scoped grind =, simp] lemma coe_top : ((⊤ : Fact P) : Set P) = Set.univ := rfl
 
@@ -246,7 +246,7 @@ lemma mem_zero : p ∈ (0 : Fact P) ↔ ∀ q, p * q ∈ PhaseSpace.bot := by
   simp [← SetLike.mem_coe]
 
 instance : Bot (Fact P) where
-  bot := Fact.mk_dual (PhaseSpace.bot : Set P) {1} (orth_one_eq_bot).symm
+  bot := Fact.mkDual (PhaseSpace.bot : Set P) {1} (orth_one_eq_bot).symm
 
 /-- In a phase space, `G⫠⫠` is the smallest fact containing `G`. -/
 lemma biorth_least_fact (G : Set P) :
@@ -326,7 +326,7 @@ lemma inter_eq_orth_union_orth (G H : Fact P) :
     grind [Fact.eq]
 
 instance : Min (Fact P) where
-  min G H := Fact.mk_dual (G ∩ H) (G⫠ ∪ H⫠) <| by simp
+  min G H := Fact.mkDual (G ∩ H) (G⫠ ∪ H⫠) <| by simp
 
 @[simp] lemma coe_min {G H : Fact P} : ((G ⊓ H : Fact P) : Set P) = (G : Set P) ∩ H := rfl
 
@@ -394,7 +394,7 @@ def parr (X Y : Fact P) : Fact P := dualFact ((X⫠) * (Y⫠))
   refine SetLike.coe_injective ?_
   rw [tensor]
   refine Set.Subset.antisymm ?_ ?_
-  · simp only [dualFact, mk_dual, mk_subset, coe_mk]
+  · simp only [dualFact, mkDual, mkSubset, coe_mk]
     rw [dual_dual_subset_Fact_iff]
     grind [SetLike.mem_coe, Set.mem_mul]
   · exact Set.Subset.trans (orth_extensive _) <| orth_antitone <| orth_antitone <|
@@ -417,7 +417,7 @@ lemma coe_tensor_assoc {G H K : Fact P} :
     ((G ⊗ H) ⊗ K : Set P) = ((G : Set P) * ((H : Set P) * (K : Set P)))⫠⫠ := by
   simp only [tensor]
   refine Set.Subset.antisymm ?_ ?_
-  · simp only [dualFact, mk_dual, mk_subset, coe_mk, dual_dual_subset_dual_iff]
+  · simp only [dualFact, mkDual, mkSubset, coe_mk, dual_dual_subset_dual_iff]
     rw [K.eq]
     refine tensor_assoc_aux.trans ?_
     rw [← K.eq]
@@ -442,7 +442,7 @@ lemma tensor_le_tensor {G K H} {L : Fact P} (hGK : G ≤ K) (hHL : H ≤ L) : (G
 
 lemma tensor_of_par {G H : Fact P} : (G ⊗ H) = (Gᗮ ⅋ Hᗮ)ᗮ :=
   SetLike.coe_injective <| by
-    simp only [tensor, parr, dualFact, mk_dual, mk_subset, coe_mk]
+    simp only [tensor, parr, dualFact, mkDual, mkSubset, coe_mk]
     rw [G.eq, H.eq]
     #adaptation_note
     /-- A grind regression found moving to nightly-2026-03-31 (changes from lean#13166) -/
@@ -471,7 +471,7 @@ def linImpl (X Y : Fact P) : Fact P := dualFact ((X : Set P) * (Y : Set P)⫠)
 
 lemma linImpl_of_tensor {G H : Fact P} : (G ⊸ H) = (G ⊗ Hᗮ)ᗮ :=
   SetLike.coe_injective <| by
-    simp only [linImpl, tensor, coe_neg, dualFact, mk_dual, mk_subset, coe_mk]
+    simp only [linImpl, tensor, coe_neg, dualFact, mkDual, mkSubset, coe_mk]
     apply Set.Subset.antisymm <;> grind
 
 lemma par_of_linImpl {G H : Fact P} : (G ⅋ H) = (Gᗮ ⊸ H) :=
@@ -589,14 +589,14 @@ lemma le_plus_right {G H : Fact P} : H ≤ G ⊕ H := fun _ hx ↦
 
 lemma tensor_distrib_plus : (G ⊗ (H ⊕ K) : Fact P) = (G ⊗ H) ⊕ (G ⊗ K) := by
   refine SetLike.coe_injective <| Set.Subset.antisymm ?_ ?_
-  · rw [tensor, dualFact, mk_dual_coe, oplus, dualFact, mk_dual_coe]
+  · rw [tensor, dualFact, mkDual_coe, oplus, dualFact, mkDual_coe]
     rw [dual_dual_subset_Fact_iff, G.eq]
     refine tensor_assoc_aux.trans ?_
-    rw [Set.mul_union, oplus, dualFact, mk_dual_coe, tensor, dualFact, mk_dual_coe]
+    rw [Set.mul_union, oplus, dualFact, mkDual_coe, tensor, dualFact, mkDual_coe]
     exact dual_subset_dual <| dual_subset_dual <|
       Set.union_subset_union subset_dual_dual subset_dual_dual
-  · rw [oplus, dualFact, mk_dual_coe, dual_dual_subset_Fact_iff, tensor, dualFact, mk_dual_coe,
-      tensor, dualFact, mk_dual_coe, Set.union_subset_iff]
+  · rw [oplus, dualFact, mkDual_coe, dual_dual_subset_Fact_iff, tensor, dualFact, mkDual_coe,
+      tensor, dualFact, mkDual_coe, Set.union_subset_iff]
     simp only [dual_dual_subset_Fact_iff]
     exact ⟨(Set.mul_subset_mul_left le_plus_left).trans mul_subset_tensor,
            (Set.mul_subset_mul_left le_plus_right).trans mul_subset_tensor⟩
@@ -640,7 +640,7 @@ lemma par_semi_distrib_plus : ((G ⅋ H) ⊕ (G ⅋ K) : Fact P) ≤ G ⅋ (H 
   rw [coe_top]
   rw [Set.eq_univ_iff_forall]
   intro x
-  simp only [parr, dualFact, mk_dual, mk_subset, coe_mk, coe_top]
+  simp only [parr, dualFact, mkDual, mkSubset, coe_mk, coe_top]
   rw [PhaseSpace.orthogonal_def, Set.mem_setOf_eq]
   intro w hw
   rcases Set.mem_mul.mp hw with ⟨y, hy, z, hz, rfl⟩
diff --git a/Cslib/Logics/Propositional/NaturalDeduction/Basic.lean b/Cslib/Logics/Propositional/NaturalDeduction/Basic.lean
index fd3853c563..b1a8947e20 100644
--- a/Cslib/Logics/Propositional/NaturalDeduction/Basic.lean
+++ b/Cslib/Logics/Propositional/NaturalDeduction/Basic.lean
@@ -183,12 +183,12 @@ def Theory.Derivation.weak {T T' : Theory Atom} {Γ Δ : Ctx Atom} {A : Proposit
   | implE D D' => implE (D.weak hTheory hCtx) (D'.weak hTheory hCtx)
 
 /-- Weakening the theory only. -/
-def Theory.Derivation.weak_theory {T T' : Theory Atom} {Γ : Ctx Atom} {A : Proposition Atom}
+def Theory.Derivation.weakTheory {T T' : Theory Atom} {Γ : Ctx Atom} {A : Proposition Atom}
     (hTheory : T ⊆ T') : T⇓(Γ ⊢ A) → T'⇓(Γ ⊢ A):=
   Derivation.weak hTheory Finset.Subset.rfl
 
 /-- Weakening the context only. -/
-def Theory.Derivation.weak_ctx {T : Theory Atom} {Γ Δ : Ctx Atom} {A : Proposition Atom}
+def Theory.Derivation.weakCtx {T : Theory Atom} {Γ Δ : Ctx Atom} {A : Proposition Atom}
     (hCtx : Γ ⊆ Δ) : T⇓(Γ ⊢ A) → T⇓(Δ ⊢ A) :=
   Derivation.weak Set.Subset.rfl hCtx
 
@@ -198,14 +198,14 @@ theorem DerivableIn.weak {T T' : Theory Atom} {Γ Δ : Ctx Atom} {A : Propositio
   | ⟨D⟩ => ⟨D.weak hTheory hCtx⟩
 
 /-- Proof irrelevant weakening of the theory. -/
-theorem DerivableIn.weak_theory {T T' : Theory Atom} {Γ : Ctx Atom} {A : Proposition Atom}
+theorem DerivableIn.weakTheory {T T' : Theory Atom} {Γ : Ctx Atom} {A : Proposition Atom}
     (hTheory : T ⊆ T') : DerivableIn T (Γ ⊢ A) → DerivableIn T' (Γ ⊢ A)
-  | ⟨D⟩ => ⟨D.weak_theory hTheory⟩
+  | ⟨D⟩ => ⟨D.weakTheory hTheory⟩
 
 /-- Proof irrelevant weakening of the context. -/
-theorem DerivableIn.weak_ctx {T : Theory Atom} {Γ Δ : Ctx Atom} {A : Proposition Atom}
+theorem DerivableIn.weakCtx {T : Theory Atom} {Γ Δ : Ctx Atom} {A : Proposition Atom}
     (hCtx : Γ ⊆ Δ) : DerivableIn T (Γ ⊢ A) → DerivableIn T (Δ ⊢ A)
-  | ⟨D⟩ => ⟨D.weak_ctx hCtx⟩
+  | ⟨D⟩ => ⟨D.weakCtx hCtx⟩
 
 /--
 Implement the cut rule, removing a hypothesis `A` from `E` using a derivation `D`. This is *not*
@@ -213,9 +213,9 @@ substitution, which would replace appeals to `A` in `E` by the whole derivation
 -/
 def Theory.Derivation.cut {Γ Δ : Ctx Atom} {A B : Proposition Atom}
     (D : T⇓(Γ ⊢ A)) (E : T⇓(insert A Δ ⊢ B)) : T⇓((Γ ∪ Δ) ⊢ B) := by
-  refine implE (A := A) ?_ (D.weak_ctx Finset.subset_union_left)
+  refine implE (A := A) ?_ (D.weakCtx Finset.subset_union_left)
   have : insert A Δ ⊆ insert A (Γ ∪ Δ) := by grind
-  exact implI (Γ ∪ Δ) <| E.weak_ctx this
+  exact implI (Γ ∪ Δ) <| E.weakCtx this
 
 /-- Proof irrelevant cut rule. -/
 theorem DerivableIn.cut {Γ Δ : Ctx Atom} {A B : Proposition Atom} :
@@ -228,7 +228,7 @@ theorem DerivableIn.cut_away {Γ Γ' : Ctx Atom} {B : Proposition Atom}
     (hΔ : ∀ A ∈ Γ', DerivableIn T (Γ ⊢ A)) (hDer : DerivableIn T ((Γ ∪ Γ') ⊢ B)) :
     DerivableIn T (Γ ⊢ B) := by
   induction Γ' using Finset.induction with
-  | empty => exact DerivableIn.weak_ctx (by grind) hDer
+  | empty => exact DerivableIn.weakCtx (by grind) hDer
   | insert A Δ hA ih =>
     apply ih
     · intro A' hA'
@@ -246,7 +246,7 @@ def Theory.Derivation.subs {Γ Γ' Δ : Ctx Atom} {B : Proposition Atom}
   | @ass _ _ _ _ B hB => by
     by_cases B ∈ Γ'
     case pos h =>
-      exact (Ds B h).weak_ctx <| by grind
+      exact (Ds B h).weakCtx <| by grind
     case neg h =>
       exact ass <| by grind
   | andI E E' => andI (E.subs Ds) (E'.subs Ds)
@@ -257,13 +257,13 @@ def Theory.Derivation.subs {Γ Γ' Δ : Ctx Atom} {B : Proposition Atom}
   | @orE _ _ _ _ C C' _ E E' E'' .. => by
     apply orE (E.subs Ds)
     · rw [show insert C (Γ \ Γ' ∪ Δ) = (insert C Γ \ Γ') ∪ insert C Δ by grind]
-      exact E'.subs Ds |>.weak_ctx (by grind)
+      exact E'.subs Ds |>.weakCtx (by grind)
     · rw [show insert C' (Γ \ Γ' ∪ Δ) = (insert C' Γ \ Γ') ∪ insert C' Δ by grind]
-      exact E''.subs Ds |>.weak_ctx (by grind)
+      exact E''.subs Ds |>.weakCtx (by grind)
   | @implI _ _ _ A' _ _ E .. => by
     apply implI
     rw [show insert A' (Γ \ Γ' ∪ Δ) = (insert A' Γ \ Γ') ∪ insert A' Δ by grind]
-    exact E.subs Ds |>.weak_ctx (by grind)
+    exact E.subs Ds |>.weakCtx (by grind)
   | implE E E' => implE (E.subs Ds) (E'.subs Ds)
 
 /-- Transport a derivation along a substitution of atoms. -/
@@ -300,9 +300,9 @@ theorem derivableIn_top [Inhabited Atom] : DerivableIn T (⊤ : Proposition Atom
 theorem derivable_iff_equiv_top [Inhabited Atom] (A : Proposition Atom) :
     DerivableIn T A ↔ A ≡[T] ⊤ := by
   constructor <;> intro h
-  · refine ⟨derivationTop.weak_ctx <| by grind, ?_⟩
+  · refine ⟨derivationTop.weakCtx <| by grind, ?_⟩
     let D := Classical.choice h
-    exact D.weak_ctx <| by grind
+    exact D.weakCtx <| by grind
   · have := DerivableIn.cut (derivableIn_top (T := T)) (B := A) (Δ := ∅)
     rw [←show (∅ : Ctx Atom) = ∅ ∪ ∅ by rfl] at this
     exact this h.mpr
diff --git a/CslibTests/CLL.lean b/CslibTests/CLL.lean
index 47c6bda616..55f15b98fc 100644
--- a/CslibTests/CLL.lean
+++ b/CslibTests/CLL.lean
@@ -119,15 +119,15 @@ example (h : (a : P) ≡ b) : b ≡ a := Proposition.Equiv.symm h
 example (hab : (a : P) ≡ b) (hbc : b ≡ c) : a ≡ c := Proposition.Equiv.trans hab hbc
 
 -- Coercion from proof-relevant to proof-irrelevant (via .toProp)
-example : (!⊤ : P) ≡ 1 := Proposition.bang_top_eqv_one.toProp
-example : (ʔ0 : P) ≡ ⊥ := Proposition.quest_zero_eqv_bot.toProp
-example : (a ⊗ 0 : P) ≡ 0 := (Proposition.tensor_zero_eqv_zero a).toProp
-example : (a ⅋ ⊤ : P) ≡ ⊤ := (Proposition.parr_top_eqv_top a).toProp
-example : (a ⊗ b : P) ≡ b ⊗ a := Proposition.tensor_symm.toProp
-example : (a ⊗ (b ⊗ c) : P) ≡ (a ⊗ b) ⊗ c := Proposition.tensor_assoc.toProp
-example : (a ⊗ (b ⊕ c) : P) ≡ (a ⊗ b) ⊕ (a ⊗ c) := (Proposition.tensor_distrib_oplus a b c).toProp
-example : (a ⊕ a : P) ≡ a := Proposition.oplus_idem.toProp
-example : (a & a : P) ≡ a := Proposition.with_idem.toProp
+example : (!⊤ : P) ≡ 1 := Proposition.bangTopEqvOne.toProp
+example : (ʔ0 : P) ≡ ⊥ := Proposition.questZeroEqvBot.toProp
+example : (a ⊗ 0 : P) ≡ 0 := (Proposition.tensorZeroEqvZero a).toProp
+example : (a ⅋ ⊤ : P) ≡ ⊤ := (Proposition.parrTopEqvTop a).toProp
+example : (a ⊗ b : P) ≡ b ⊗ a := Proposition.tensorSymm.toProp
+example : (a ⊗ (b ⊗ c) : P) ≡ (a ⊗ b) ⊗ c := Proposition.tensorAssoc.toProp
+example : (a ⊗ (b ⊕ c) : P) ≡ (a ⊗ b) ⊕ (a ⊗ c) := (Proposition.tensorDistribOplus a b c).toProp
+example : (a ⊕ a : P) ≡ a := Proposition.oplusIdem.toProp
+example : (a & a : P) ≡ a := Proposition.withIdem.toProp
 
 
 /-! ## Proof-relevant equivalence tests -/
@@ -142,25 +142,25 @@ example (h : (a : P) ≡⇓ b) : b ≡⇓ a := Proposition.equiv.symm a h
 example (hab : (a : P) ≡⇓ b) (hbc : (b : P) ≡⇓ c) : a ≡⇓ c := Proposition.equiv.trans hab hbc
 
 -- Proof-relevant versions of logical equivalences
-example : (!⊤ : P) ≡⇓ 1 := Proposition.bang_top_eqv_one
-example : (ʔ0 : P) ≡⇓ ⊥ := Proposition.quest_zero_eqv_bot
-example : (a ⊗ b : P) ≡⇓ b ⊗ a := Proposition.tensor_symm
-example : (a ⊗ (b ⊗ c) : P) ≡⇓ (a ⊗ b) ⊗ c := Proposition.tensor_assoc
-example : (a ⊕ a : P) ≡⇓ a := Proposition.oplus_idem
-example : (a & a : P) ≡⇓ a := Proposition.with_idem
+example : (!⊤ : P) ≡⇓ 1 := Proposition.bangTopEqvOne
+example : (ʔ0 : P) ≡⇓ ⊥ := Proposition.questZeroEqvBot
+example : (a ⊗ b : P) ≡⇓ b ⊗ a := Proposition.tensorSymm
+example : (a ⊗ (b ⊗ c) : P) ≡⇓ (a ⊗ b) ⊗ c := Proposition.tensorAssoc
+example : (a ⊕ a : P) ≡⇓ a := Proposition.oplusIdem
+example : (a & a : P) ≡⇓ a := Proposition.withIdem
 
 
 /-! ## Inversion tests -/
 
--- parr_inversion
-example (h : ⇓({a ⅋ b} : Sequent Nat)) : ⇓({a, b} : Sequent Nat) := Proof.parr_inversion h
+-- parrInversion
+example (h : ⇓({a ⅋ b} : Sequent Nat)) : ⇓({a, b} : Sequent Nat) := Proof.parrInversion h
 
--- bot_inversion
-example (h : ⇓({⊥, 1} : Sequent Nat)) : ⇓({1} : Sequent Nat) := Proof.bot_inversion h
+-- botInversion
+example (h : ⇓({⊥, 1} : Sequent Nat)) : ⇓({1} : Sequent Nat) := Proof.botInversion h
 
 -- with_inversion
-example (h : ⇓({a & b} : Sequent Nat)) : ⇓({a} : Sequent Nat) := Proof.with_inversion₁ h
-example (h : ⇓({a & b} : Sequent Nat)) : ⇓({b} : Sequent Nat) := Proof.with_inversion₂ h
+example (h : ⇓({a & b} : Sequent Nat)) : ⇓({a} : Sequent Nat) := Proof.withInversion₁ h
+example (h : ⇓({a & b} : Sequent Nat)) : ⇓({b} : Sequent Nat) := Proof.withInversion₂ h
 
 
 /-! ## Positive/Negative classification tests -/
diff --git a/lake-manifest.json b/lake-manifest.json
index ca8591cf36..1b6933333f 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -5,10 +5,10 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "6cf3ab1c11e19e328c2e535bdd32d66dc7842fb5",
+   "rev": "d8de6b61f073daf518577b643724875545b98e89",
    "name": "mathlib",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "6cf3ab1c11e19e328c2e535bdd32d66dc7842fb5",
+   "inputRev": "d8de6b61f073daf518577b643724875545b98e89",
    "inherited": false,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/plausible",
@@ -35,7 +35,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "cdab3938ccabbdb044be6896e251b5814bec932e",
+   "rev": "fd70b40073aeca8fa60fe0fb492f189d3b12c0ef",
    "name": "importGraph",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -75,10 +75,10 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "5c57f3857ba81924a88b2cdf4f062e34ec04ff11",
+   "rev": "4ee56e687ce2b9b51b097bfa65947a499da0c453",
    "name": "batteries",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.30.0-rc2",
+   "inputRev": "main",
    "inherited": true,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover/lean4-cli",
diff --git a/lakefile.toml b/lakefile.toml
index 4169d4b8e6..92c711279e 100644
--- a/lakefile.toml
+++ b/lakefile.toml
@@ -18,7 +18,7 @@ weak.linter.unicodeLinter = false
 [[require]]
 name = "mathlib"
 scope = "leanprover-community"
-rev = "6cf3ab1c11e19e328c2e535bdd32d66dc7842fb5"
+rev = "d8de6b61f073daf518577b643724875545b98e89"
 
 [[lean_lib]]
 name = "Cslib"

From c6bb800929dde8c1ab62f2f9ff74bba198644ec6 Mon Sep 17 00:00:00 2001
From: lyj <sjtu5140809011@gmail.com>
Date: Tue, 26 May 2026 12:34:18 +0800
Subject: [PATCH 32/53] feat(locallynameless): signature of fv theorems  (#588)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This PR refactors several free‑variable (`fv`) lemmas in the Locally
Nameless Lambda Calculus library to make the API more uniform,
algebraic, and easier to use. The changes focus on replacing
negative‑membership lemmas with equalities of `fv` sets, consolidating
redundant lemmas, and updating downstream proofs accordingly.

---

## What’s changed

### 1. Rename and consolidate closing lemmas
- `close_preserve_not_fvar` is replaced with the more general and
consistently named
**`close_rec_fv`**, which states the same property using a cleaner proof
structure
- The old `close_var_not_fvar_rec` and its specialization are removed.
A simpler lemma **`close_var_not_fvar`** now derives directly from
`close_rec_fv`


### 2. Strengthen theorem signatures for opening and substitution
Several lemmas now express **equalities of free‑variable sets** instead
of
“`x ∉ …`”‑style statements:

- **`open_preserve_not_fvar`** now states that opening yields either
  ```
  m⟦k ↝ n⟧.fv = m.fv ∪ n.fv
  ```
  or
  ```
  m⟦k ↝ n⟧.fv = m.fv
  ```
  replacing the previous negative‑membership lemma


- **`subst_preserve_not_fvar`** now characterizes substitution via:
  ```
  (m[y := n]).fv = m.fv.erase y ∪ n.fv
  ```
again replacing a negated membership lemma with a structural equality


These equalities are more compositional and better suited for downstream
reasoning.

### 3. Update dependent proofs
Proofs that relied on the old lemma names or signatures—particularly in
`open_close_to_subst`—are updated to use:

- `close_rec_fv` instead of the removed lemma
- the new `open_preserve_not_fvar` signature
- the updated `subst_preserve_not_fvar` behavior

### 4. Rename `open_close_to_subst` to `close_open_to_subst` and
generalize

### 5. Minor cleanup
- Adds `@[scoped grind]` annotations for consistency.
- Slightly reorganizes lemma order for readability.





Aggregation of #579, #585 and #586

PR description is generated by Copilot

---------

Co-authored-by: Chris Henson <chrishenson.net@gmail.com>
Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com>
---
 .../LocallyNameless/Untyped/FullBeta.lean     |  6 ++--
 .../Untyped/FullBetaEtaConfluence.lean        |  4 +--
 .../LocallyNameless/Untyped/FullEta.lean      |  4 +--
 .../LocallyNameless/Untyped/MultiSubst.lean   |  4 +--
 .../LocallyNameless/Untyped/Properties.lean   | 33 +++++++++----------
 5 files changed, 24 insertions(+), 27 deletions(-)

diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
index f9a5f00c86..698f52b6ca 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
@@ -98,13 +98,13 @@ lemma redex_subst_cong (s s' : Term Var) (x y : Var) (step : s ⭢βᶠ s') :
   redex_subst_cong_lc _ _ _ _ step (.fvar y)
 
 /-- An β-reduction step does not introduce new free variables. -/
-lemma step_not_fv (step : M ⭢βᶠ N) (hw : w ∉ M.fv) : w ∉ N.fv := by
+lemma step_not_fv (step : M ⭢βᶠ N) : N.fv ⊆ M.fv := by
   induction step with
   | base h => cases h with | beta => grind [open_preserve_not_fvar]
-  | abs =>
+  | @abs M N =>
     have ⟨x, _⟩ := fresh_exists <| free_union [fv] Var
     have := open_close x
-    grind [close_preserve_not_fvar, open_preserve_not_fvar]
+    grind [open_preserve_not_fvar 0 M N]
   | _ => grind
 
 /-- Abstracting then closing preserves a single reduction. -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean
index d56359e8ad..989142ac67 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaEtaConfluence.lean
@@ -74,9 +74,9 @@ lemma stronglyCommute_eta_beta : StronglyCommute (@FullEta Var) FullBeta := by
       cases h_eta with | eta =>
         have ⟨w, _⟩ := fresh_exists <| free_union [fv] Var
         have st_beta_w : app y₁ (fvar w) ⭢βᶠ N ^ fvar w := by grind [st_body_beta w]
-        rcases invert_step_app_fvar st_beta_w with ⟨u', _, st_u⟩ | ⟨u1, _, _⟩
+        rcases invert_step_app_fvar st_beta_w with ⟨u', h, st_u⟩ | ⟨u1, _, _⟩
         · use u'
-          grind [open_eq_app ?_ (step_not_fv st_u ?_)]
+          apply open_eq_app at h <;> grind [FullBeta.step_not_fv st_u]
         · use abs u1
           grind [open_injective w N u1]
     case abs S ys st_body_eta =>
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
index 517ce78683..856541e6e3 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
@@ -71,13 +71,13 @@ lemma invert_step_app_fvar (step : (app M (fvar x)) ⭢ηᶠ N) :
 variable [HasFresh Var] [DecidableEq Var]
 
 /-- An η-reduction step does not introduce new free variables. -/
-lemma step_not_fv (step : M ⭢ηᶠ M') (hw : w ∉ M.fv) : w ∉ M'.fv := by
+lemma step_not_fv (step : M ⭢ηᶠ M') : M.fv = M'.fv := by
   induction step with
   | base => grind
   | abs =>
     have ⟨x, _⟩ := fresh_exists <| free_union [fv] Var
     have := open_close x
-    grind [close_preserve_not_fvar, open_preserve_not_fvar]
+    grind [open_preserve_not_fvar]
   | _ => grind
 
 /-- Substitution of a fresh variable preserves an η-reduction step. -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean
index 548b3d2c0c..4cf0657415 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiSubst.lean
@@ -63,8 +63,8 @@ lemma multiSubst_fvar_fresh (E : Env Var) : ∀ x ∉ E.dom, multiSubst E (fvar
 
 /-- If x is neither a free variable of an environment Ns or a term M, then
     x is also not a free variable of the multi-substitution of Ns into M -/
-lemma multiSubst_preserves_not_fvar (M : Term Var) (E : Env Var) (nmem : x ∉ M.fv ∪ E.fv) :
-    x ∉ (multiSubst E M).fv := by
+lemma multiSubst_preserves_not_fvar (M : Term Var) (E : Env Var) :
+    (multiSubst E M).fv ⊆ M.fv ∪ E.fv := by
   induction E with grind [subst_preserve_not_fvar]
 
 /-- Multi-substitution propagates recursively through an application -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
index 06634fccd6..76fd322972 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
@@ -47,27 +47,24 @@ lemma swap_open_fvar_close (k n : ℕ) (x y : Var) (m : Term Var) (neq₁ : k 
   induction m generalizing k n <;> grind
 
 /-- Closing preserves free variables. -/
-lemma close_preserve_not_fvar {k y} (m : Term Var) : (m⟦k ↜ y⟧).fv = m.fv.erase y := by
+@[scoped grind =]
+lemma close_rec_fv {k y} (m : Term Var) : (m⟦k ↜ y⟧).fv = m.fv.erase y := by
   induction m generalizing k <;> grind
 
+/-- Specializes `close_var_not_fvar_rec` to first closing. -/
+@[scoped grind =]
+lemma close_var_not_fvar (x) (t : Term Var) : (t ^* x).fv = t.fv.erase x := close_rec_fv t
+
 /-- Opening preserves free variables. -/
-lemma open_preserve_not_fvar {k x} (m n : Term Var) (nmem_m : x ∉ m.fv) (nmem_n : x ∉ n.fv) :
-    x ∉ (m⟦k ↝ n⟧).fv := by
+theorem open_preserve_not_fvar (k) (m n : Term Var) :
+    m⟦k ↝ n⟧.fv = m.fv ∪ n.fv ∨ m⟦k ↝ n⟧.fv = m.fv := by
   induction m generalizing k <;> grind
 
 /-- Substitution preserves free variables. -/
-lemma subst_preserve_not_fvar {x y : Var} (m n : Term Var) (nmem : x ∉ m.fv ∪ n.fv) :
-    x ∉ (m [y := n]).fv := by
+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
   induction m <;> grind
 
-/-- Closing removes a free variable. -/
-@[scoped grind ←]
-lemma close_var_not_fvar_rec (x) (k) (t : Term Var) : x ∉ (t⟦k ↜ x⟧).fv := by
-  induction t generalizing k <;> grind
-
-/-- Specializes `close_var_not_fvar_rec` to first closing. -/
-lemma close_var_not_fvar (x) (t : Term Var) : x ∉ (t ^* x).fv := close_var_not_fvar_rec x 0 t
-
 variable [HasFresh Var]
 
 omit [DecidableEq Var] in
@@ -122,17 +119,17 @@ theorem beta_lc {M N : Term Var} (m_lc : M.abs.LC) (n_lc : LC N) : LC (M ^ N) :=
   cases m_lc with
   | abs => grind [fresh_exists <| free_union [fv] Var]
 
-/-- Opening then closing is equivalent to substitution. -/
+/-- Closing then opening is equivalent to substitution. -/
 @[scoped grind =]
-lemma open_close_to_subst (m : Term Var) (x y : Var) (k : ℕ) (m_lc : LC m) :
-    m ⟦k ↜ x⟧⟦k ↝ fvar y⟧ = m [x := fvar y] := by
+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
   induction m_lc generalizing k with
   | abs xs t =>
     have ⟨x', _⟩ := fresh_exists <| free_union [fv] Var
     grind [
       swap_open, =_ swap_open_fvar_close,
-      open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ fvar y⟧) 0, open_close x' (t[x := fvar y]) 0,
-       open_preserve_not_fvar, close_preserve_not_fvar, subst_preserve_not_fvar]
+      open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ n⟧) 0, open_close x' (t[x := n]) 0,
+       open_preserve_not_fvar, close_rec_fv, subst_preserve_not_fvar]
   | _ => grind
 
 /-- Closing and opening are inverses. -/

From 28e0b17ac0e01d7284e559e5bf149ad474bdf158 Mon Sep 17 00:00:00 2001
From: lyj <sjtu5140809011@gmail.com>
Date: Tue, 26 May 2026 13:13:18 +0800
Subject: [PATCH 33/53] feat: subst_refl (#599)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This pr

1. adds a new lemma: `subst_refl`

```
lemma subst_refl (m : Term Var) (x : Var) :
  m[x := fvar x] = m
```

This states that substituting a variable with its own free-variable form
leaves the term unchanged.
The proof is implemented using structural induction and `grind` tactics.

---

2. Refactors the `close_open` lemma

The lemma:

```
lemma close_open (x : Var) (t : Term Var) (k : ℕ) (t_lc : LC t) :
  t⟦k ↜ x⟧⟦k ↝ fvar x⟧ = t
```

is rewritten with ` grind [subst_refl]`


PR summary generated by copilot
---
 .../LocallyNameless/Untyped/Properties.lean            | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
index 76fd322972..f7810940df 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
@@ -65,6 +65,9 @@ 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
   induction m <;> grind
 
+lemma subst_refl (m : Term Var) (x : Var) : m[x := fvar x] = m := by
+  induction m <;> grind
+
 variable [HasFresh Var]
 
 omit [DecidableEq Var] in
@@ -134,12 +137,7 @@ lemma close_open_to_subst (m n : Term Var) (x : Var) (k : ℕ) (m_lc : LC m) (n_
 
 /-- 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
-  induction t_lc generalizing k with
-  | abs _ t _ ih =>
-    let z := t⟦k + 1 ↜ x⟧⟦k + 1 ↝ fvar x⟧
-    have ⟨y, _⟩ := fresh_exists <| free_union [fv] Var
-    grind [ih y ?_ (k+1), open_injective, swap_open_fvar_close, swap_open]
-  | _ => grind
+  grind [subst_refl]
 
 end LambdaCalculus.LocallyNameless.Untyped.Term
 

From c7944a9fb44c3298f1a960a5e574ab23a6ab8ed5 Mon Sep 17 00:00:00 2001
From: Garmelon <joscha@plugh.de>
Date: Tue, 26 May 2026 22:48:17 +0100
Subject: [PATCH 34/53] chore: bump toolchain to v4.30.0 (#601)

---
 lake-manifest.json | 26 +++++++++++++-------------
 lakefile.toml      |  2 +-
 lean-toolchain     |  2 +-
 3 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/lake-manifest.json b/lake-manifest.json
index 1b6933333f..7b2d3b8f19 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -5,17 +5,17 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "d8de6b61f073daf518577b643724875545b98e89",
+   "rev": "c5ea00351c28e24afc9f0f84379aa41082b1188f",
    "name": "mathlib",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "d8de6b61f073daf518577b643724875545b98e89",
+   "inputRev": "c5ea00351c28e24afc9f0f84379aa41082b1188f",
    "inherited": false,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/plausible",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "293af9b2a383eed4d04d66b898d608d0a44b750f",
+   "rev": "a456461b368b71d2accd95234832cd9c174b5437",
    "name": "plausible",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -35,7 +35,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "fd70b40073aeca8fa60fe0fb492f189d3b12c0ef",
+   "rev": "515cf9d0c00ece5e661f6de4326a53dedc1e8ea1",
    "name": "importGraph",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -45,37 +45,37 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "2db6054a44326f8c0230ee0570e2ddb894816511",
+   "rev": "a84b3e2475d5c5ab979567b1ad8aea21b764bcf8",
    "name": "proofwidgets",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v0.0.98",
+   "inputRev": "v0.0.99",
    "inherited": true,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/aesop",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "f0c6e183ea26531e82773feb4b73ab6595ca17a5",
+   "rev": "558915ae105bfd8074e22d597613d1961822adc2",
    "name": "aesop",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.30.0-rc2",
+   "inputRev": "v4.30.0",
    "inherited": true,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover-community/quote4",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "1cc7e819b9b9bc1e87c9edcccb62e0269e00a809",
+   "rev": "a6e6c34c4ef182f83b219a3a5a385f51f44bdc4c",
    "name": "Qq",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.30.0-rc2",
+   "inputRev": "v4.30.0",
    "inherited": true,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover-community/batteries",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "4ee56e687ce2b9b51b097bfa65947a499da0c453",
+   "rev": "32dc18cde3684679f3c003de608743b57498c56f",
    "name": "batteries",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -85,10 +85,10 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover",
-   "rev": "13567aed1ac4f12aea9484178e07e51f8c9f7658",
+   "rev": "6b907cf12b2e445ccb7c24bc208ef04a1f39e84c",
    "name": "Cli",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.30.0-rc2",
+   "inputRev": "v4.30.0",
    "inherited": true,
    "configFile": "lakefile.toml"}],
  "name": "cslib",
diff --git a/lakefile.toml b/lakefile.toml
index 92c711279e..38c08dd947 100644
--- a/lakefile.toml
+++ b/lakefile.toml
@@ -18,7 +18,7 @@ weak.linter.unicodeLinter = false
 [[require]]
 name = "mathlib"
 scope = "leanprover-community"
-rev = "d8de6b61f073daf518577b643724875545b98e89"
+rev = "c5ea00351c28e24afc9f0f84379aa41082b1188f"
 
 [[lean_lib]]
 name = "Cslib"
diff --git a/lean-toolchain b/lean-toolchain
index 6c7e31fffe..af9e5d339a 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.30.0-rc2
+leanprover/lean4:v4.30.0

From d780a2ad97124ab8f23e3c02fad896b3742745c6 Mon Sep 17 00:00:00 2001
From: Eric Wieser <efw@google.com>
Date: Wed, 27 May 2026 15:09:49 -0700
Subject: [PATCH 35/53] refactor: change the simpNF for FreeM (#417)

This declares `liftBind` an implementation detail, encouraging users to
work with `lift` and `bind` separately instead.

In particular:
* `>>=` is now the simp-normal form of `FreeM.bind`
* `<$>` is now the simp-normal form of `FreeM.map`
* `Pure.pure` is now the simp-normal form of `FreeM.pure`

Note that due to a failing in the design of monads in Lean around
universes, it is not always possible to use the notation.
The advantage of using it when it _is_ available is that standard lemmas
about lawful monads can apply.

---

Depends on:
* #439
* #490
* #525
---
 Cslib/Foundations/Control/Monad/Free.lean     | 130 +++++++++-------
 .../Control/Monad/Free/Effects.lean           | 140 ++++++++----------
 .../Foundations/Control/Monad/Free/Fold.lean  |  34 +++--
 CslibTests/FreeMonad.lean                     |  30 ++--
 4 files changed, 177 insertions(+), 157 deletions(-)

diff --git a/Cslib/Foundations/Control/Monad/Free.lean b/Cslib/Foundations/Control/Monad/Free.lean
index 0fe0805218..dd8b2e66ad 100644
--- a/Cslib/Foundations/Control/Monad/Free.lean
+++ b/Cslib/Foundations/Control/Monad/Free.lean
@@ -49,8 +49,6 @@ The `FreeM` monad is defined using an inductive type with constructors `.pure` a
 We implement `Functor` and `Monad` instances, and prove the corresponding `LawfulFunctor`
 and `LawfulMonad` instances.
 
-For now we choose to make the constructors the simp-normal form, as opposed to the standard
-monad notation.
 
 The file `Free/Effects.lean` demonstrates practical applications by implementing State, Writer, and
 Continuations monads using `FreeM` with appropriate effect signatures.
@@ -71,6 +69,9 @@ Free monad, state monad
 
 namespace Cslib
 
+-- 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 over a type constructor `F`.
 
 A `FreeM F a` is a tree of operations from the type constructor `F`, with leaves of type `a`.
@@ -94,83 +95,100 @@ universe u v w w' w''
 namespace FreeM
 variable {F : Type u → Type v} {ι : Type u} {α : Type w} {β : Type w'} {γ : Type w''}
 
+section notations
+
 instance : Pure (FreeM F) where pure := .pure
 
 @[simp]
-theorem pure_eq_pure : (pure : α → FreeM F α) = FreeM.pure := rfl
+theorem pure_eq_pure : FreeM.pure = (pure : α → FreeM F α) := rfl
+
+/-- Bind operation for the `FreeM` monad.
 
-/-- Bind operation for the `FreeM` monad. -/
+The builtin `>>=` notation should be preferred when `α` and `β` are in the same universe. -/
 protected def bind (x : FreeM F α) (f : α → FreeM F β) : FreeM F β :=
   match x with
   | .pure a => f a
   | .liftBind op cont => .liftBind op fun z => FreeM.bind (cont z) f
 
-protected theorem bind_assoc (x : FreeM F α) (f : α → FreeM F β) (g : β → FreeM F γ) :
-    (x.bind f).bind g = x.bind (fun x => (f x).bind g) := by
-  induction x with
-  | pure a => rfl
-  | liftBind op cont ih =>
-    simp [FreeM.bind] at *
-    simp [ih]
-
 instance : Bind (FreeM F) 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 w} : Bind.bind = (FreeM.bind : FreeM F α → _ → FreeM F β) := rfl
+theorem bind_eq_bind {α β : Type w} : (FreeM.bind : FreeM F α → _ → FreeM F β) = Bind.bind := rfl
 
-/-- Map a function over a `FreeM` monad. -/
-@[simp]
+/-- Map a function over a `FreeM` monad.
+
+The builtin `<$>` notation should be preferred when `α` and `β` are in the same universe. -/
 def map (f : α → β) : FreeM F α → FreeM F β
   | .pure a => .pure (f a)
   | .liftBind op cont => .liftBind op fun z => FreeM.map f (cont z)
 
-@[simp]
-theorem id_map : ∀ x : FreeM F α, map id x = x
-  | .pure a => rfl
-  | .liftBind op cont => by simp_all [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]
-
 instance : Functor (FreeM F) 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 w} : Functor.map = FreeM.map (F := F) (α := α) (β := β) := rfl
+theorem map_eq_map {α β : Type w} : FreeM.map (F := F) (α := α) (β := β) = Functor.map := rfl
 
 /-- Lift an operation from the effect signature `F` into the `FreeM F` monad. -/
 def lift (op : F ι) : FreeM F ι :=
-  .liftBind op .pure
+  .liftBind op pure
 
-/-- Rewrite `lift` to the constructor form so that simplification stays in constructor normal
-form. -/
 @[simp]
-lemma lift_def (op : F ι) :
-    (lift op : FreeM F ι) = liftBind op .pure := rfl
+lemma liftBind_eq (op : F ι) :
+    liftBind op cont = (lift op : FreeM F ι).bind cont :=
+  rfl
 
-@[simp]
-lemma map_lift (f : ι → α) (op : F ι) :
-    map f (lift op : FreeM F ι) = liftBind op (fun z => (.pure (f z) : FreeM F α)) := rfl
+set_option linter.unusedVariables false in
+/-- An override for the default induction principle that is in simp-normal form.
+
+Note that when `α` and `ι` are in the same universe, this simplifies slightly further. -/
+@[induction_eliminator]
+protected theorem induction {motive : FreeM F α → Prop}
+    (pure : ∀ a, motive (pure a))
+    (lift_bind : ∀ {ι} (op : F ι) (cont : ι → FreeM F α) (ih : ∀ i, motive (cont i)),
+      motive ((lift op).bind cont)) : ∀ x, motive x
+  | .pure a => pure a
+  | liftBind _ _ => lift_bind _ _ fun _ => FreeM.induction pure lift_bind _
+
+end notations
+
+protected theorem bind_assoc (x : FreeM F α) (f : α → FreeM F β) (g : β → FreeM F γ) :
+    (x.bind f).bind g = x.bind (fun x => (f x).bind g) := by
+  induction x with
+  | pure a => rfl
+  | lift_bind op cont ih => simp [← liftBind_eq, FreeM.bind, ih] at *
 
 /-- `.pure a` followed by `bind` collapses immediately. -/
 @[simp]
-lemma pure_bind (a : α) (f : α → FreeM F β) : (.pure a : FreeM F α).bind f = f a := rfl
+lemma pure_bind (a : α) (f : α → FreeM F β) : (pure a : FreeM F α).bind f = f a := rfl
 
 @[simp]
-lemma bind_pure : ∀ x : FreeM F α, x.bind (.pure) = x
+lemma bind_pure : ∀ x : FreeM F α, x.bind pure = x
   | .pure a => rfl
-  | liftBind op k => by simp [FreeM.bind, bind_pure]
+  | liftBind op k => by simp [FreeM.bind, bind_pure, -bind_eq_bind]
 
 @[simp]
-lemma bind_pure_comp (f : α → β) : ∀ x : FreeM F α, x.bind (.pure ∘ f) = map f x
+lemma bind_pure_comp (f : α → β) : ∀ x : FreeM F α, x.bind (pure ∘ f) = map f x
   | .pure a => rfl
   | liftBind op k => by simp only [FreeM.bind, map, bind_pure_comp]
 
-/-- Collapse a `.bind` that follows a `liftBind` into a single `liftBind` -/
 @[simp]
-lemma liftBind_bind (op : F ι) (cont : ι → FreeM F α) (f : α → FreeM F β) :
-    (liftBind op cont).bind f = liftBind op fun x => (cont x).bind f := rfl
+theorem map_pure (f : α → β) (x : α) : map f (pure x : FreeM F α) = pure (f x) := rfl
+
+@[simp]
+theorem map_bind (f : β → γ) (x : FreeM F α) (c : α → FreeM F β) :
+    map f (x.bind c) = x.bind fun a => (c a).map f := by
+  simp_rw [← bind_pure_comp, FreeM.bind_assoc]
+
+@[simp]
+theorem id_map : ∀ x : FreeM F α, map id x = x
+  | .pure a => rfl
+  | .liftBind op cont => by simp_all [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]
 
 instance : LawfulFunctor (FreeM F) where
   map_const := rfl
@@ -202,32 +220,31 @@ protected def liftM (interp : {ι : Type u} → F ι → m ι) : FreeM F α →
 
 @[simp]
 lemma liftM_pure (interp : {ι : Type u} → F ι → m ι) (a : α) :
-    (.pure a : FreeM F α).liftM interp = pure a := rfl
+    (pure a : FreeM F α).liftM interp = pure a := rfl
 
 @[simp]
-lemma liftM_liftBind (interp : {ι : Type u} → F ι → m ι) (op : F β) (cont : β → FreeM F α) :
-    (liftBind op cont).liftM interp = (do let b ← interp op; (cont b).liftM interp) := by
+lemma liftM_lift_bind (interp : {ι : Type u} → F ι → m ι) (op : F β) (cont : β → FreeM F α) :
+    ((lift op) >>= cont).liftM interp = (do let b ← interp op; (cont b).liftM interp) := by
   rfl
 
+@[simp]
 lemma liftM_lift [LawfulMonad m] (interp : {ι : Type u} → F ι → m ι) (op : F β) :
     (lift op).liftM interp = interp op := by
-  simp_rw [lift_def, liftM_liftBind, liftM_pure, _root_.bind_pure]
+  simp_rw [lift, FreeM.liftM, _root_.bind_pure]
 
 @[simp]
 lemma liftM_bind [LawfulMonad m]
     (interp : {ι : Type u} → F ι → m ι) (x : FreeM F α) (f : α → FreeM F β) :
-    (x.bind f).liftM interp = (do let a ← x.liftM interp; (f a).liftM interp) := by
+    (x >>= f).liftM interp = (do let a ← x.liftM interp; (f a).liftM interp) := by
   induction x generalizing f with
-  | pure a => simp only [pure_bind, liftM_pure, LawfulMonad.pure_bind]
-  | liftBind op cont ih =>
-    rw [FreeM.bind, liftM_liftBind, liftM_liftBind, bind_assoc]
-    simp_rw [ih]
+  | pure a => simp only [liftM_pure, LawfulMonad.pure_bind]
+  | lift_bind op cont ih => simp [← ih]
 
 @[simp]
 lemma liftM_map [LawfulMonad m]
     (interp : {ι : Type u} → F ι → m ι) (f : α → β) (x : FreeM F α) :
-    (x.map f).liftM interp = f <$> x.liftM interp := by
-  simp_rw [← bind_pure_comp, ← LawfulMonad.bind_pure_comp, liftM_bind, Function.comp, liftM_pure]
+    (f <$> x).liftM interp = f <$> x.liftM interp := by
+  simp_rw [← LawfulMonad.bind_pure_comp, liftM_bind, liftM_pure]
 
 @[simp]
 lemma liftM_seq [LawfulMonad m]
@@ -261,8 +278,8 @@ Formally, `interp` satisfies the two equations:
 -/
 structure Interprets (handler : {ι : Type u} → F ι → m ι) (interp : FreeM F α → m α) : Prop where
   apply_pure (a : α) : interp (.pure a) = pure a
-  apply_liftBind {ι : Type u} (op : F ι) (cont : ι → FreeM F α) :
-    interp (liftBind op cont) = handler op >>= fun x => interp (cont x)
+  apply_lift_bind {ι : Type u} (op : F ι) (cont : ι → FreeM F α) :
+    interp (lift op >>= cont) = handler op >>= fun x => interp (cont x)
 
 theorem Interprets.eq {handler : {ι : Type u} → F ι → m ι} {interp : FreeM F α → m α}
     (h : Interprets handler interp) :
@@ -270,14 +287,13 @@ theorem Interprets.eq {handler : {ι : Type u} → F ι → m ι} {interp : Free
   ext x
   induction x with
   | pure a => exact h.apply_pure a
-  | liftBind op cont ih =>
-    rw [liftM_liftBind, h.apply_liftBind]
-    simp [ih]
+  | lift_bind op cont ih =>
+    simp [h.apply_lift_bind, ih]
 
 theorem Interprets.liftM (handler : {ι : Type u} → F ι → m ι) :
     Interprets handler (·.liftM handler : FreeM F α → _) where
   apply_pure _ := rfl
-  apply_liftBind _ _ := rfl
+  apply_lift_bind _ _ := rfl
 
 /--
 The universal property of the free monad `FreeM`.
diff --git a/Cslib/Foundations/Control/Monad/Free/Effects.lean b/Cslib/Foundations/Control/Monad/Free/Effects.lean
index 98d0f11241..7c58bca5a9 100644
--- a/Cslib/Foundations/Control/Monad/Free/Effects.lean
+++ b/Cslib/Foundations/Control/Monad/Free/Effects.lean
@@ -110,24 +110,24 @@ theorem run_toStateM {α : Type u} (comp : FreeState σ α) (s₀ : σ) :
 
 @[simp]
 lemma run_pure (a : α) (s₀ : σ) :
-    run (.pure a : FreeState σ α) s₀ = (a, s₀) := rfl
+    run (pure a : FreeState σ α) s₀ = (a, s₀) := rfl
 
 @[simp]
-lemma run_get (k : σ → FreeState σ α) (s₀ : σ) :
-    run (liftBind .get k) s₀ = run (k s₀) s₀ := rfl
+lemma run_get (s₀ : σ) :
+    run (lift .get) s₀ = (s₀, s₀) := rfl
 
 @[simp]
-lemma run_set (s' : σ) (k : PUnit → FreeState σ α) (s₀ : σ) :
-    run (liftBind (.set s') k) s₀ = run (k .unit) s' := rfl
+lemma run_set (s' : σ) (s₀ : σ) :
+    run (lift (.set s')) s₀ = (.unit, s') := rfl
 
 @[simp]
 lemma run_bind (x : FreeState σ α) (f : α → FreeState σ β) (s₀ : σ) :
     run (x.bind f) s₀ = let p := x.run s₀; (f p.1).run p.2 := by
-  induction x generalizing f s₀ with
+  induction x using FreeM.induction generalizing f s₀ with
   | pure => simp
-  | liftBind op cont ih =>
-    rw [FreeM.liftBind_bind]
-    cases op <;> simp [run, ih]
+  | lift_bind op cont ih =>
+    simp_rw [FreeM.bind_assoc]
+    cases op <;> simp [← liftBind_eq, run, ih]
 
 /-- Run a state computation, returning only the result. -/
 def run' (c : FreeState σ α) (s₀ : σ) : α := (run c s₀).1
@@ -140,15 +140,15 @@ theorem run'_toStateM {α : Type u} (comp : FreeState σ α) (s₀ : σ) :
 
 @[simp]
 lemma run'_pure (a : α) (s₀ : σ) :
-    run' (.pure a : FreeState σ α) s₀ = a := rfl
+    run' (pure a : FreeState σ α) s₀ = a := rfl
 
 @[simp]
-lemma run'_get (k : σ → FreeState σ α) (s₀ : σ) :
-    run' (liftBind .get k) s₀ = run' (k s₀) s₀ := rfl
+lemma run'_get (s₀ : σ) :
+    run' (lift .get) s₀ = s₀ := rfl
 
 @[simp]
-lemma run'_set (s' : σ) (k : PUnit → FreeState σ α) (s₀ : σ) :
-    run' (liftBind (.set s') k) s₀ = run' (k .unit) s' := rfl
+lemma run'_set (s' : σ) (s₀ : σ) :
+    run' (lift (.set s')) s₀ = .unit := rfl
 
 @[simp]
 lemma run'_bind (x : FreeState σ α) (f : α → FreeState σ β) (s₀ : σ) :
@@ -174,7 +174,7 @@ abbrev FreeWriter (ω : Type u) := FreeM (WriterF ω)
 namespace FreeWriter
 
 open WriterF
-variable {ω : Type u} {α : Type u}
+variable {ω : Type u} {α β : Type*}
 
 /-- Interpret `WriterF` operations into `WriterT`. -/
 @[simp]
@@ -212,21 +212,21 @@ def run [Monoid ω] : FreeWriter ω α → α × ω
 
 @[simp]
 lemma run_pure [Monoid ω] (a : α) :
-    run (.pure a : FreeWriter ω α) = (a, 1) := rfl
+    run (pure a : FreeWriter ω α) = (a, 1) := rfl
+
+@[simp]
+lemma run_lift_tell [Monoid ω] (w : ω) :
+    run (lift (.tell w)) = (.unit, w) := Prod.ext rfl <| mul_one _
 
 @[simp]
 lemma run_bind [Monoid ω] (x : FreeWriter ω α) (f : α → FreeWriter ω β) :
     run (x.bind f) = let p := run x; ((f p.1).run.1, p.2 * (f p.1).run.2) := by
-  induction x generalizing f with
+  induction x using FreeM.induction generalizing f with
   | pure => simp
-  | liftBind op cont ih =>
-    rw [FreeM.liftBind_bind]
+  | lift_bind op cont ih =>
+    simp_rw [FreeM.bind_assoc]
     cases op
-    simp [run, ih, mul_assoc]
-
-@[simp]
-lemma run_liftBind_tell [Monoid ω] (w : ω) (k : PUnit → FreeWriter ω α) :
-    run (liftBind (.tell w) k) = (let (a, w') := run (k .unit); (a, w * w')) := rfl
+    simp [← liftBind_eq, run, ih, mul_assoc]
 
 /--
 The canonical interpreter `toWriterT` derived from `liftM` agrees with the hand-written
@@ -235,14 +235,13 @@ recursive interpreter `run` for `FreeWriter`.
 @[simp]
 theorem run_toWriterT {α : Type u} [Monoid ω] (comp : FreeWriter ω α) :
     (toWriterT comp).run = pure (run comp) := by
-  ext : 1
-  induction comp with
-  | pure _ => simp only [liftM_pure, run_pure, pure, WriterT.run]
-  | liftBind op cont ih =>
+  induction comp using FreeM.induction with
+  | pure _ => simp [toWriterT]
+  | lift_bind op cont ih =>
+    simp only [toWriterT, run_bind] at *
+    ext : 1
     cases op
-    simp only [liftM_liftBind, run_liftBind_tell, Id.run_pure] at *
-    rw [ ← ih]
-    simp [WriterT.run_bind]
+    simp [ih]
 
 /--
 `listen` captures the log produced by a subcomputation incrementally. It traverses the computation,
@@ -257,13 +256,13 @@ def listen [Monoid ω] : FreeWriter ω α → FreeWriter ω (α × ω)
 
 @[simp]
 lemma listen_pure [Monoid ω] (a : α) :
-    listen (.pure a : FreeWriter ω α) = .pure (a, 1) := rfl
+    listen (pure a : FreeWriter ω α) = .pure (a, 1) := rfl
 
 @[simp]
-lemma listen_liftBind_tell [Monoid ω] (w : ω)
+lemma listen_lift_tell_bind [Monoid ω] (w : ω)
     (k : PUnit → FreeWriter ω α) :
-    listen (liftBind (.tell w) k) =
-      liftBind (.tell w) (fun _ =>
+    listen (lift (.tell w) >>= k) =
+      lift (.tell w) >>= (fun _ =>
         listen (k .unit) >>= fun (a, w') =>
           pure (a, w * w')) := by
   rfl
@@ -324,51 +323,43 @@ def run : FreeCont r α → (α → r) → r
   | .pure a, k => k a
   | .liftBind (.callCC g) cont, k => g (fun a => run (cont a) k)
 
-/--
-The canonical interpreter `toContT` derived from `liftM` agrees with the hand-written
-recursive interpreter `run` for `FreeCont`.
--/
 @[simp]
-theorem run_toContT {α : Type u} (comp : FreeCont r α) (k : α → r) :
-    (toContT comp).run k = pure (run comp k) := by
-  induction comp with
-  | pure a => rfl
-  | liftBind op cont ih =>
-    simp only [FreeM.liftM]
-    cases op
-    simp only [ContT.run_bind]
-    congr with x
-    apply ih
+lemma run_pure (a : α) (k : α → r) :
+    run (pure a : FreeCont r α) k = k a := rfl
 
 @[simp]
-lemma run_pure (a : α) (k : α → r) :
-    run (.pure a : FreeCont r α) k = k a := rfl
+lemma run_lift_callCC (g : (α → r) → r) (k : α → r) :
+    run (lift (.callCC g)) k = g k := rfl
 
 @[simp]
 lemma run_bind (x : FreeCont r α) (f : α → FreeCont r β) (k : β → r) :
     run (x.bind f) k = run x (fun i => run (f i) k) := by
-  induction x generalizing k with
+  induction x using FreeM.induction generalizing k with
   | pure a => rfl
-  | liftBind op cont ih =>
-    rw [FreeM.liftBind_bind]
+  | lift_bind op cont ih =>
+    rw [FreeM.bind_assoc]
     cases op
-    simp [run, ih]
+    simp [← liftBind_eq, run, ih]
 
+/--
+The canonical interpreter `toContT` derived from `liftM` agrees with the hand-written
+recursive interpreter `run` for `FreeCont`.
+-/
 @[simp]
-lemma run_liftBind_callCC (g : (α → r) → r)
-    (cont : α → FreeCont r β) (k : β → r) :
-    run (liftBind (.callCC g) cont) k = g (fun a => run (cont a) k) := rfl
+theorem run_toContT {α : Type u} (comp : FreeCont r α) (k : α → r) :
+    (toContT comp).run k = pure (run comp k) := by
+  simp only [toContT]
+  induction comp using FreeM.induction with
+  | pure a => rfl
+  | lift_bind op cont ih =>
+    cases op
+    simp_rw [run_bind]
+    simp [ih]
 
 /-- Call with current continuation for the Free continuation monad. -/
 def callCC (f : MonadCont.Label α (FreeCont r) β → FreeCont r α) :
     FreeCont r α :=
-  liftBind (.callCC fun k => run (f ⟨fun x => liftBind (.callCC fun _ => k x) pure⟩) k) pure
-
-@[simp]
-lemma callCC_def (f : MonadCont.Label α (FreeCont r) β → FreeCont r α) :
-    callCC f =
-      liftBind (.callCC fun k => run (f ⟨fun x => liftBind (.callCC fun _ => k x) pure⟩) k) pure :=
-  rfl
+  lift (.callCC fun k => run (f ⟨fun x => lift (.callCC fun _ => k x)⟩) k)
 
 instance : MonadCont (FreeCont r) where
   callCC := .callCC
@@ -376,8 +367,8 @@ instance : MonadCont (FreeCont r) where
 /-- `run` of a `callCC` node simplifies to running the handler with the current continuation. -/
 @[simp]
 lemma run_callCC (f : MonadCont.Label α (FreeCont r) β → FreeCont r α) (k : α → r) :
-    run (callCC f) k = run (f ⟨fun x => liftBind (.callCC fun _ => k x) pure⟩) k := by
-  simp [callCC, run_liftBind_callCC]
+    run (callCC f) k = run (f ⟨fun x => lift (.callCC fun _ => k x)⟩) k := by
+  simp [callCC]
 
 end FreeCont
 
@@ -395,7 +386,6 @@ variable {σ : Type u} {α : Type u}
 instance : MonadReaderOf σ (FreeReader σ) where
   read := .lift .read
 
-@[simp]
 lemma read_def : (read : FreeReader σ σ) = .lift .read := rfl
 
 instance : MonadReader σ (FreeReader σ) := inferInstance
@@ -433,19 +423,17 @@ theorem run_toReaderM {α : Type u} (comp : FreeReader σ α) (s : σ) :
 
 @[simp]
 lemma run_pure (a : α) (s₀ : σ) :
-    run (.pure a : FreeReader σ α) s₀ = a := rfl
+    run (pure a : FreeReader σ α) s₀ = a := rfl
 
 @[simp]
-lemma run_read (k : σ → FreeReader σ α) (s₀ : σ) :
-    run (liftBind .read k) s₀ = run (k s₀) s₀ := rfl
+lemma run_read (s₀ : σ) :
+    run read s₀ = s₀ := rfl
 
 @[simp]
 lemma run_bind (x : FreeReader σ α) (f : α → FreeReader σ β) (s₀ : σ) :
-    run (x.bind f) s₀ = run (f <| run x s₀) s₀ := by
-  induction x generalizing s₀ with
-  | pure a => rfl
-  | liftBind op cont ih =>
-    cases op; apply ih
+    run (x >>= f) s₀ = run (f <| run x s₀) s₀ := by
+  rw [← Id.run_pure (run _ _), ← run_toReaderM, toReaderM, liftM_bind, ReaderT.run_bind,
+    Id.run_bind, run_toReaderM, run_toReaderM, Id.run_pure, Id.run_pure]
 
 instance instMonadWithReaderOf : MonadWithReaderOf σ (FreeReader σ) where
   withReader {α} f m :=
diff --git a/Cslib/Foundations/Control/Monad/Free/Fold.lean b/Cslib/Foundations/Control/Monad/Free/Fold.lean
index 6b1f979094..7b07faed33 100644
--- a/Cslib/Foundations/Control/Monad/Free/Fold.lean
+++ b/Cslib/Foundations/Control/Monad/Free/Fold.lean
@@ -59,20 +59,36 @@ def foldFreeM
 theorem foldFreeM_pure
     (onValue : α → β)
     (onEffect : {ι : Type u} → F ι → (ι → β) → β)
-    (a : α) : foldFreeM onValue onEffect (.pure a) = onValue a := rfl
+    (a : α) : foldFreeM onValue onEffect (pure a) = onValue a := rfl
 
 @[simp]
-theorem foldFreeM_liftBind
+theorem foldFreeM_lift_bind
     (onValue : α → β)
     (onEffect : {ι : Type u} → F ι → (ι → β) → β)
     (op : F ι) (k : ι → FreeM F α) :
-    foldFreeM onValue onEffect (.liftBind op k)
+      foldFreeM onValue onEffect ((lift op).bind k)
       = onEffect op (fun x => foldFreeM onValue onEffect (k x)) := rfl
 
+@[simp]
+theorem foldFreeM_lift_bind' {F : Type w → Type v} {ι : Type w}
+    (onValue : α → β)
+    (onEffect : {ι : Type w} → F ι → (ι → β) → β)
+    (op : F ι) (k : ι → FreeM F α) :
+      foldFreeM onValue onEffect (lift op >>= k)
+      = onEffect op (fun x => foldFreeM onValue onEffect (k x)) := rfl
+
+@[simp]
+theorem foldFreeM_lift
+    (onValue : ι → β)
+    (onEffect : {ι : Type u} → F ι → (ι → β) → β)
+    (op : F ι) :
+    foldFreeM onValue onEffect (lift op) = onEffect op onValue :=
+  rfl
+
 /--
 **Universal Property**: If `h : FreeM F α → β` satisfies:
-* `h (.pure a) = onValue a`
-* `h (.liftBind op k) = onEffect op (fun x => h (k x))`
+* `h (pure a) = onValue a`
+* `h ((lift op).bind k) = onEffect op (fun x => h (k x))`
 
 then `h` is equal to `foldFreeM onValue onEffect`.
 -/
@@ -80,16 +96,16 @@ theorem foldFreeM_unique
     (onValue : α → β)
     (onEffect : {ι : Type u} → F ι → (ι → β) → β)
     (h : FreeM F α → β)
-    (h_pure : ∀ a, h (.pure a) = onValue a)
+    (h_pure : ∀ a, h (pure a) = onValue a)
     (h_liftBind : ∀ {ι} (op : F ι) (k : ι → FreeM F α),
-      h (.liftBind op k) = onEffect op (fun x => h (k x))) :
+      h ((lift op).bind k) = onEffect op (fun x => h (k x))) :
     h = foldFreeM onValue onEffect := by
   funext x
   induction x with
   | pure a =>
     rw [foldFreeM_pure, h_pure]
-  | liftBind op k ih =>
-    rw [foldFreeM_liftBind, h_liftBind]
+  | lift_bind op k ih =>
+    rw [foldFreeM_lift_bind, h_liftBind]
     grind
 
 end FreeM
diff --git a/CslibTests/FreeMonad.lean b/CslibTests/FreeMonad.lean
index 947fa9ff5f..9928038563 100644
--- a/CslibTests/FreeMonad.lean
+++ b/CslibTests/FreeMonad.lean
@@ -266,7 +266,7 @@ theorem runEff_bind_ok {α β}
   revert h
   induction p generalizing env env' tr tr' v <;> simp only [runEff, bind, foldFreeM] <;> intro h
   · case pure => cases h; rfl
-  · case liftBind _ op _ ih =>
+  · case lift_bind _ op _ ih =>
     cases op
     · case inl s => cases s <;> exact ih _ h
     · case inr s =>
@@ -287,7 +287,7 @@ theorem runEff_bind_err {α β}
     runEff (p >>= k) env tr = .error msg := by
   induction p generalizing env tr msg <;> simp only [runEff, bind, foldFreeM] <;> intro h
   · case pure => simp [effPure] at h
-  · case liftBind _ op _ ih =>
+  · case lift_bind _ op _ ih =>
     cases op
     · case inl s => cases s <;> exact ih _ h
     · case inr s =>
@@ -309,39 +309,39 @@ theorem runEff_eval_correct (e : Expr) (env : Env) (trace : Trace)
     runEff (eval e) env trace = res := by
   induction h
   · case val z env trace =>
-    simp [eval, pure_eq_pure, runEff, effPure]
+    simp [eval, runEff, effPure]
   · case var_found x env trace v h =>
-    simp [runEff, eval, getEnv, lift_def, effStep, h, effPure]
+    simp [runEff, eval, getEnv, effStep, h, effPure]
   · case var_missing x env trace h =>
-    simp [runEff, eval, bind, getEnv, fail, lift_def, effStep, h]
+    simp [runEff, eval, getEnv, fail, effStep, h, - LawfulMonad.bind_pure_comp]
   · case add e₁ e₂ env trace₁ trace₂ trace₃ v1 v2 env₂ env₃ h₁ h₂ ih₁ ih₂ =>
-    simp [eval, bind]
+    simp [eval]
     have step₁ := runEff_bind_ok (p := eval e₁ ) (k := fun v1 => do
       let v2 ← eval e₂
       pure (v1 + v2)) ih₁
-    simp [bind] at step₁; simp [step₁]
+    simp at step₁; simp [step₁]
     have step₂ := runEff_bind_ok (p := eval e₂) (k := fun v2 => pure (v1 + v2)) ih₂
-    simp [bind] at step₂; simp [step₂]; rfl
+    simp at step₂; simp [step₂]; rfl
   · case div_ok e₁ e₂ env trace₁ trace₂ trace₃ v₁ v₂ env₂ env₃ v₂_ne_0 h₁ h₂ ih₁ ih₂  =>
-    simp [eval, bind]
+    simp [eval]
     have step₁ := runEff_bind_ok (p := eval e₁) (k := fun v1 => do
       let v2 ← eval e₂
       if v2 = 0 then do fail "divide by zero"; pure 0 else pure (v1 / v2)) ih₁
-    simp [bind] at step₁; simp [step₁]
+    simp at step₁; simp [step₁]
     have step₂ := runEff_bind_ok (p := eval e₂) (k := fun v₂ =>
       if v₂ = 0 then do fail "divide by zero"; pure 0 else pure (v₁ / v₂)) ih₂
-    simp [bind] at step₂; simp [step₂, v₂_ne_0]
+    simp at step₂; simp [step₂, v₂_ne_0]
     rfl
   · case div_zero e₁ e₂ env' trace₁ trace₂ trace₃ v₁ v₂ env₂ env₃ v₂_eq_0 h₁ h₂ ih₁ ih₂ =>
-    simp [eval, bind]
+    simp [eval]
     have step₁ := runEff_bind_ok (p := eval e₁) (k := fun v₁ => do
       let v₂ ← eval e₂
       if v₂ = 0 then fail "divide by zero"; pure 0 else pure (v₁ / v₂)) ih₁
-    simp [bind] at step₁; simp [step₁]
+    simp at step₁; simp [step₁]
     have step₂ := runEff_bind_ok (p := eval e₂) (k := fun v₂ =>
       if v₂ = 0 then (do fail "divide by zero"; pure 0) else pure (v₁ / v₂)) ih₂
-    simp [bind] at step₂; simp [step₂, v₂_eq_0]
-    simp [fail, lift, runEff]
+    simp at step₂; simp [step₂, v₂_eq_0]
+    simp [fail, runEff]
     rfl
 
 end CslibTests

From 024db9e781e518602763841e57b73d4eadc00183 Mon Sep 17 00:00:00 2001
From: Chris Henson <46805207+chenson2018@users.noreply.github.com>
Date: Thu, 28 May 2026 12:46:13 -0400
Subject: [PATCH 36/53] chore: use `tfae_*` tactics (#600)

I wasn't aware previously that `TFAE` came with these tactics. This is a
bit nicer since all these theorems are `private`.
---
 Cslib/Foundations/Data/Relation.lean | 21 ++++++---------------
 1 file changed, 6 insertions(+), 15 deletions(-)

diff --git a/Cslib/Foundations/Data/Relation.lean b/Cslib/Foundations/Data/Relation.lean
index 4ff14dfb03..bc3f0ec2bf 100644
--- a/Cslib/Foundations/Data/Relation.lean
+++ b/Cslib/Foundations/Data/Relation.lean
@@ -8,6 +8,7 @@ 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
@@ -141,22 +142,12 @@ section euclidean_symm
 
 variable [Std.Symm r]
 
-private theorem RightEuclidean.symm_leftEuclidean [RightEuclidean r] : LeftEuclidean r where
-  leftEuclidean ac bc := rightEuclidean (symm ac) (symm bc)
-
-private theorem LeftEuclidean.symm_trans [LeftEuclidean r] : IsTrans α r where
-  trans _ _ _ ab bc := leftEuclidean ab (symm bc)
-
-private theorem RightEuclidean.trans_symm [IsTrans α r] : RightEuclidean r where
-  rightEuclidean ab ac := _root_.trans (symm ab) ac
-
+open RightEuclidean LeftEuclidean in
 private theorem symm_equivalents : [RightEuclidean r, LeftEuclidean r, IsTrans α r].TFAE := by
-  apply List.tfae_of_cycle
-  · simp only [List.isChain_cons_cons, List.IsChain.singleton, and_true]
-    split_ands
-    · exact @RightEuclidean.symm_leftEuclidean _ _ _
-    · exact @LeftEuclidean.symm_trans _ _ _
-  · exact @RightEuclidean.trans_symm _ _ _
+  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 :=

From a264a6002ac2d10c658d840c5c24479e0a0cc220 Mon Sep 17 00:00:00 2001
From: Samuel Schlesinger <SamuelSchlesinger@users.noreply.github.com>
Date: Thu, 28 May 2026 12:47:28 -0400
Subject: [PATCH 37/53] feat(MachineLearning/PACLearning): VC dimension (#563)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Adds the Vapnik-Chervonenkis dimension for binary concept classes `C :
ConceptClass α Bool`, with:

- `SetShatters C W`: `C` shatters a set `W` if every `W' ⊆ W` arises as
the intersection of some `c ⁻¹' {true}` with `W` for `c ∈ C`.
- `SetShatters.subset` / `SetShatters.superset`: anti/monotonicity in
the shattered set and the concept class.
- `Finset.Shatters.toSetShatters`: bridge from Mathlib's
`Finset.Shatters` to `SetShatters` via characteristic functions.
- `vcDim C`: VC dimension as `sSup` of shattered finite-set
cardinalities.
- `HasFiniteVCDim C` and `hasFiniteVCDim_iff`: the predicate making
`vcDim` mathematically meaningful (uniform bound on shattered
cardinalities), required as a hypothesis by downstream `vcDim`-stated
lower bounds.

First layer of a stacked PR sequence formalizing the EHKV lower bound on
PAC sample complexity.
---
 Cslib.lean                                    |   1 +
 .../PACLearning/VCDimension.lean              | 128 ++++++++++++++++++
 2 files changed, 129 insertions(+)
 create mode 100644 Cslib/MachineLearning/PACLearning/VCDimension.lean

diff --git a/Cslib.lean b/Cslib.lean
index b504973c3e..070e6dc0f2 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -139,4 +139,5 @@ public import Cslib.Logics.Modal.Denotation
 public import Cslib.Logics.Propositional.Defs
 public import Cslib.Logics.Propositional.NaturalDeduction.Basic
 public import Cslib.MachineLearning.PACLearning.Defs
+public import Cslib.MachineLearning.PACLearning.VCDimension
 public import Cslib.Probability.PMF
diff --git a/Cslib/MachineLearning/PACLearning/VCDimension.lean b/Cslib/MachineLearning/PACLearning/VCDimension.lean
new file mode 100644
index 0000000000..3084b95629
--- /dev/null
+++ b/Cslib/MachineLearning/PACLearning/VCDimension.lean
@@ -0,0 +1,128 @@
+/-
+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.MachineLearning.PACLearning.Defs
+public import Mathlib.Combinatorics.SetFamily.Shatter
+
+/-! # VC Dimension for Concept Classes
+
+This file defines *shattering* and the *Vapnik-Chervonenkis dimension* for
+binary concept classes `C : ConceptClass α Bool`, i.e. sets of `α → Bool`
+classifiers. Each Boolean classifier `c` is identified with the subset
+`c ⁻¹' {true} ⊆ α` (the "positive set"), and `C` shatters a set `W` if every
+subset of `W` can be obtained as the positive set of some `c ∈ C` intersected
+with `W`. See also the `Finset`-based definitions in
+`Mathlib.Combinatorics.SetFamily.Shatter`.
+
+## Main definitions
+
+- `SetShatters C W`: the concept class `C` shatters the set `W`.
+- `vcDim C`: the VC dimension of `C`, i.e. the supremum of the cardinalities of
+  finite sets shattered by `C`.
+
+## Main statements
+
+- `SetShatters.subset`: shattering is anti-monotone in the shattered set.
+- `SetShatters.superset`: shattering is monotone in the concept class.
+- `Finset.Shatters.toSetShatters`: bridge from Mathlib's `Finset.Shatters`
+  to `SetShatters`.
+
+## References
+
+* [A. Ehrenfeucht, D. Haussler, M. Kearns, L. Valiant,
+  *A General Lower Bound on the Number of Examples Needed
+  for Learning*][EHKV1989]
+-/
+
+@[expose] public section
+
+open Set
+
+namespace Cslib.MachineLearning.PACLearning
+
+variable {α : Type*}
+
+/-- A binary concept class `C` *shatters* a set `W` if for every subset `W' ⊆ W`,
+there exists a concept `c ∈ C` whose positive set `c ⁻¹' {true}` intersects `W`
+in exactly `W'`. -/
+def SetShatters (C : ConceptClass α Bool) (W : Set α) : Prop :=
+  ∀ W' ⊆ W, ∃ c ∈ C, c ⁻¹' {true} ∩ W = W'
+
+/-- Shattering is anti-monotone in the shattered set: if `C` shatters `W` and
+`V ⊆ W`, then `C` shatters `V`. -/
+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)
+  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]
+  refine ⟨?_, fun h => ⟨Or.inl h, hV'V h⟩⟩
+  rintro ⟨h1 | ⟨_, h2⟩, h3⟩
+  · exact h1
+  · exact absurd h3 h2
+
+/-- Shattering is monotone in the concept class: if `C` shatters `W` and `C ⊆ C'`,
+then `C'` shatters `W`. -/
+theorem SetShatters.superset {C C' : ConceptClass α Bool} {W : Set α}
+    (hW : SetShatters C W) (hCC' : C ⊆ C') : SetShatters C' W := by
+  intro W' hW'
+  obtain ⟨c, hc, hcW⟩ := hW W' hW'
+  exact ⟨c, hCC' hc, hcW⟩
+
+open Classical in
+/-- If a finite set family `𝒜` shatters a finite set `s` in the sense of Mathlib's
+`Finset.Shatters`, then the concept class of characteristic functions of sets in `𝒜`
+shatters `↑s` in the sense of `SetShatters`. This bridges Mathlib's finset-based
+shattering to the predicate used by the PAC learning lower bounds. -/
+theorem _root_.Finset.Shatters.toSetShatters {𝒜 : Finset (Finset α)} {s : Finset α}
+    (h : 𝒜.Shatters s) :
+    SetShatters
+      {c : α → Bool | ∃ t ∈ 𝒜, ∀ x, c x = decide (x ∈ t)} ↑s := by
+  intro W' hW'
+  have hfin : Set.Finite W' := s.finite_toSet.subset hW'
+  set t := hfin.toFinset
+  have ht_eq : (↑t : Set α) = W' := hfin.coe_toFinset
+  have ht_sub : t ⊆ s := Finset.coe_subset.mp (ht_eq ▸ hW')
+  obtain ⟨u, hu, hsu⟩ := h ht_sub
+  have hut : u ∩ s = t := by rwa [Finset.inter_comm] at hsu
+  refine ⟨fun x => decide (x ∈ u), ⟨u, hu, fun _ => rfl⟩, ?_⟩
+  rw [← ht_eq]
+  ext x
+  simp only [mem_inter_iff, mem_preimage, mem_singleton_iff,
+    decide_eq_true_eq, Finset.mem_coe]
+  exact ⟨fun ⟨h1, h2⟩ => hut ▸ Finset.mem_inter.mpr ⟨h1, h2⟩,
+    fun h => Finset.mem_inter.mp (hut.symm ▸ h)⟩
+
+/-- The *Vapnik-Chervonenkis dimension* of a binary concept class `C` is the
+supremum of the cardinalities of finite sets shattered by `C`. Returns `0` when
+no finite set is shattered (i.e. the defining set is empty).
+
+**Caveat**: because `sSup` on `ℕ` returns `0` for unbounded sets, this definition
+is only meaningful when the VC dimension is finite — see `HasFiniteVCDim`. -/
+noncomputable def vcDim (C : ConceptClass α Bool) : ℕ :=
+  sSup {n : ℕ | ∃ W : Finset α, W.card = n ∧ SetShatters C (↑W)}
+
+/-- A binary concept class `C` has *finite VC dimension* if there is a uniform
+upper bound on the cardinalities of finite sets it shatters. This is the
+hypothesis under which `vcDim C` is mathematically meaningful (otherwise
+`vcDim` returns `0` for unbounded shattered families via `sSup` on `ℕ`). -/
+def HasFiniteVCDim (C : ConceptClass α Bool) : Prop :=
+  BddAbove {n : ℕ | ∃ W : Finset α, W.card = n ∧ SetShatters C (↑W)}
+
+/-- A class has finite VC dimension iff there is a uniform bound on the
+cardinality of every shattered finite set. -/
+theorem hasFiniteVCDim_iff {C : ConceptClass α Bool} :
+    HasFiniteVCDim C ↔ ∃ N : ℕ, ∀ W : Finset α, SetShatters C ↑W → W.card ≤ N :=
+  ⟨fun ⟨N, hN⟩ => ⟨N, fun W hW => hN ⟨W, rfl, hW⟩⟩,
+   fun ⟨N, hN⟩ => ⟨N, fun _ ⟨W, hWc, hW⟩ => hWc ▸ hN W hW⟩⟩
+
+end Cslib.MachineLearning.PACLearning

From 8e4dcb32d320e261e6a4ee5ad619bbde6c7b6f3a Mon Sep 17 00:00:00 2001
From: Chris Henson <46805207+chenson2018@users.noreply.github.com>
Date: Thu, 28 May 2026 12:54:57 -0400
Subject: [PATCH 38/53] feat: more lemmas on Euclidean relations (#574)

A few more lemmas on Euclidean relations. Some other changes to note:
- The addition of `Relation.{cod,dom}`, mirroring what is done in
Mathlib with `SetRel` but for unbundled relations. I am mulling over
making a dedicated definition for restrictions of an unbundled relation,
but wanted to have a few theorems to test with first.
- I change the name `RightEuclidean.refl_range` to
`RightEuclidean.refl_cod` for naming consistency
- Using `Relator.LeftTotal` for the definition of `Serial`. None of the
modal logic proofs change at all, as these are identical.
---
 Cslib/Foundations/Data/Relation.lean | 229 ++++++++++++++++++++++++++-
 references.bib                       |  12 ++
 2 files changed, 235 insertions(+), 6 deletions(-)

diff --git a/Cslib/Foundations/Data/Relation.lean b/Cslib/Foundations/Data/Relation.lean
index bc3f0ec2bf..4e8953f121 100644
--- a/Cslib/Foundations/Data/Relation.lean
+++ b/Cslib/Foundations/Data/Relation.lean
@@ -12,18 +12,22 @@ 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
 
-variable {α : Type*} {r : α → α → Prop}
+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]
@@ -38,6 +42,78 @@ namespace Relation
 @[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
@@ -83,7 +159,9 @@ namespace RightEuclidean
 variable [RightEuclidean r]
 
 /-- A `RightEuclidean` relation is reflexive on its range -/
-theorem refl_range (ab : r a b) : r b b := rightEuclidean ab ab
+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
@@ -95,7 +173,7 @@ instance [Std.Refl r] : Std.Symm r where
 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_range bc
+    have cc := refl_cod bc
     have (ca : r c a) := rightEuclidean ca cc
     grind
 
@@ -104,7 +182,63 @@ theorem antisymm_rightUnique [Std.Antisymm r] : Relator.RightUnique r := by
   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_range ab)
+  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
 
@@ -115,6 +249,8 @@ 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
@@ -136,6 +272,62 @@ theorem antisymm_leftUnique [Std.Antisymm r] : Relator.LeftUnique r := by
 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
@@ -163,6 +355,31 @@ theorem symm_rightEuclidean_iff_trans : RightEuclidean r ↔ IsTrans α r :=
 
 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
 
@@ -242,9 +459,9 @@ theorem Confluent_of_unique_end {x : α} (h : ∀ y : α, ReflTransGen r y x) :
 /-- 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`. -/
+/-- A relation `r` is serial if every element is `Reducible`, i.e. `Relator.LeftTotal`. -/
 class Serial (r : α → α → Prop) where
-  serial a : Reducible r a
+  serial : Relator.LeftTotal r
 
 @[scoped grind →]
 lemma refl_serial (r : α → α → Prop) (h : Std.Refl r) : Relation.Serial r where
diff --git a/references.bib b/references.bib
index f0d122d179..7b68d1f7ad 100644
--- a/references.bib
+++ b/references.bib
@@ -49,6 +49,18 @@ @book{Blackburn2001
   collection={Cambridge Tracts in Theoretical Computer Science}
 }
 
+@misc{Burghardt2018,
+	title = {Simple {Laws} about {Nonprominent} {Properties} of {Binary} {Relations}},
+	url = {https://arxiv.org/abs/1806.05036v2},
+	abstract = {We checked each binary relation on a 5-element set for a given set of properties, including usual ones like asymmetry and less known ones like Euclideanness. Using a poor man's Quine-McCluskey algorithm, we computed prime implicants of non-occurring property combinations, like "not irreflexive, but asymmetric". We considered the non-trivial laws obtained this way, and manually proved them true for binary relations on arbitrary sets, thus contributing to the encyclopedic knowledge about less known properties.},
+	language = {en},
+	urldate = {2026-05-19},
+	journal = {arXiv.org},
+	author = {Burghardt, Jochen},
+	month = jun,
+	year = {2018},
+}
+
 @inproceedings{Danielsson2008,
 author = {Danielsson, Nils Anders},
 title = {Lightweight semiformal time complexity analysis for purely functional data structures},

From 00ecf15624690cf6bdc9ce244efe3fa40bdc54fb Mon Sep 17 00:00:00 2001
From: Chris Henson <46805207+chenson2018@users.noreply.github.com>
Date: Thu, 28 May 2026 13:12:31 -0400
Subject: [PATCH 39/53] chore: refactor proofs where `grind?` fails (#602)

These are sources of technical debt as now reported in the [weekly
linting
report](https://leanprover.zulipchat.com/#narrow/channel/513188-CSLib/topic/Weekly.20linting.20log/with/563737370).
The idea is that a successful grind proof can fail to report the
theorems it used via `grind?`, which means that if these proofs break
across toolchains that it becomes significantly harder to repair.

Most of these are fixed by squeezing the call to grind and unsetting
`linter.tacticAnalysis.verifyGrindOnly` so they no longer appear in the
weekly report. Unfortunately, this can't be on by default for
performance reasons, but I highly encourage using this linter when
adding any grind proofs.

---------

Co-authored-by: Ching-Tsun Chou <chingtsun.chou@gmail.com>
---
 Cslib/Computability/Automata/DA/ToNA.lean     |  5 ++-
 .../Computability/Automata/NA/BuchiInter.lean |  4 +-
 Cslib/Computability/Automata/NA/Concat.lean   | 11 +++++-
 Cslib/Computability/Automata/NA/Hist.lean     |  3 +-
 Cslib/Computability/Automata/NA/Loop.lean     |  9 ++++-
 Cslib/Computability/Automata/NA/Pair.lean     |  7 ++--
 Cslib/Computability/Automata/NA/Prod.lean     |  3 +-
 Cslib/Computability/Automata/NA/Sum.lean      |  9 +++--
 .../Congruences/BuchiCongruence.lean          | 23 ++++++-----
 .../Languages/ExampleEventuallyZero.lean      |  7 +++-
 .../Languages/OmegaLanguage.lean              | 11 ++++--
 Cslib/Computability/URM/Execution.lean        |  7 +++-
 Cslib/Computability/URM/StraightLine.lean     |  7 +++-
 .../Foundations/Data/OmegaSequence/Defs.lean  |  3 +-
 .../Foundations/Data/OmegaSequence/Init.lean  |  6 ++-
 .../Data/OmegaSequence/Temporal.lean          |  3 +-
 Cslib/Foundations/Data/Relation.lean          |  5 ++-
 .../Foundations/Semantics/FLTS/LTSToFLTS.lean |  4 +-
 .../Semantics/LTS/Bisimulation.lean           |  7 ++--
 .../Foundations/Semantics/LTS/Execution.lean  |  2 +-
 .../Semantics/LTS/OmegaExecution.lean         |  8 ++--
 Cslib/Foundations/Semantics/LTS/Total.lean    |  5 ++-
 Cslib/Languages/CCS/Basic.lean                |  2 +-
 .../LocallyNameless/Fsub/Safety.lean          |  9 ++++-
 .../LocallyNameless/Fsub/Subtype.lean         |  4 +-
 .../LocallyNameless/Fsub/Typing.lean          | 39 ++++++++++++++-----
 .../LocallyNameless/Fsub/WellFormed.lean      |  3 +-
 .../LocallyNameless/Stlc/Basic.lean           |  4 +-
 .../LocallyNameless/Stlc/StrongNorm.lean      |  5 ++-
 .../LocallyNameless/Untyped/FullBeta.lean     |  5 ++-
 .../LocallyNameless/Untyped/FullEta.lean      |  6 ++-
 .../LocallyNameless/Untyped/LcAt.lean         | 15 ++++++-
 .../LocallyNameless/Untyped/MultiApp.lean     |  3 +-
 .../LocallyNameless/Untyped/Properties.lean   | 19 ++++++---
 .../LocallyNameless/Untyped/StrongNorm.lean   |  4 +-
 .../LinearLogic/CLL/PhaseSemantics/Basic.lean |  5 ++-
 Cslib/Logics/Modal/Cube.lean                  | 21 +++++-----
 37 files changed, 200 insertions(+), 93 deletions(-)

diff --git a/Cslib/Computability/Automata/DA/ToNA.lean b/Cslib/Computability/Automata/DA/ToNA.lean
index cd1a98501a..fe8c58f25c 100644
--- a/Cslib/Computability/Automata/DA/ToNA.lean
+++ b/Cslib/Computability/Automata/DA/ToNA.lean
@@ -30,6 +30,7 @@ def toNA (a : DA State Symbol) : NA State Symbol :=
 instance : Coe (DA State Symbol) (NA State Symbol) where
   coe := toNA
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 open scoped FLTS NA NA.Run LTS in
 @[simp, scoped grind =]
 theorem toNA_run {a : DA State Symbol} {xs : ωSequence Symbol} {ss : ωSequence State} :
@@ -37,7 +38,9 @@ theorem toNA_run {a : DA State Symbol} {xs : ωSequence Symbol} {ss : ωSequence
   constructor
   · rintro _
     ext n
-    induction n <;> grind [NA.Run]
+    induction n
+    · grind only [NA.Run, toNA, = run_zero, = Set.mem_singleton_iff]
+    · grind only [NA.Run, toNA, = run_succ, = LTS.OmegaExecution, = FLTS.toLTS_tr]
   · grind [NA.Run]
 
 namespace FinAcc
diff --git a/Cslib/Computability/Automata/NA/BuchiInter.lean b/Cslib/Computability/Automata/NA/BuchiInter.lean
index 17fab7eff4..b68b0a5311 100644
--- a/Cslib/Computability/Automata/NA/BuchiInter.lean
+++ b/Cslib/Computability/Automata/NA/BuchiInter.lean
@@ -93,6 +93,7 @@ lemma inter_freq_comp_acc_freq_acc {xs : ωSequence Symbol} {ss : ωSequence ((
   apply leadsTo_cases_or (q := {⟨_, b⟩ | b = false}) <;>
   grind [until_frequently_leadsTo_and, univ_inter]
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- The language accepted by the intersection automaton is the intersection of
 the languages accepted by the two component automata. -/
 @[simp, scoped grind =]
@@ -122,7 +123,8 @@ theorem inter_language_eq :
   · intro h
     choose ss_i h_ss_i using h
     let ss_p : ωSequence (Π i, State i) := fun k i ↦ ss_i i k
-    have h_ss_p : (iProd na).Run xs ss_p := by grind [Run]
+    have h_ss_p : (iProd na).Run xs ss_p := by
+      grind only [Run, = iProd_run_iff, = get_fun, = LTS.OmegaExecution, = get_map]
     have (k : ℕ) (i : Bool) : ss_p k i = ss_i i k := rfl
     obtain ⟨ss, h_run, _⟩ := hist_run_exists h_ss_p
     use ss, h_run
diff --git a/Cslib/Computability/Automata/NA/Concat.lean b/Cslib/Computability/Automata/NA/Concat.lean
index 298e607fd1..9b53b12fc8 100644
--- a/Cslib/Computability/Automata/NA/Concat.lean
+++ b/Cslib/Computability/Automata/NA/Concat.lean
@@ -90,6 +90,7 @@ theorem concat_run_proj {xs : ωSequence Symbol} {ss : ωSequence (State1 ⊕ St
     · grind [concat_run_left_right]
   · exact concat_run_right hc n hl (Nat.find_spec hr')
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Given an accepting finite run of `na1` and a run of `na2`, there exists a run of
 `concat na1 na2` that is the concatenation of the two runs. -/
 theorem concat_run_exists {xs1 : List Symbol} {xs2 : ωSequence Symbol} {ss2 : ωSequence State2}
@@ -97,7 +98,11 @@ theorem concat_run_exists {xs1 : List Symbol} {xs2 : ωSequence Symbol} {ss2 : 
     ∃ ss, (concat na1 na2).Run (xs1 ++ω xs2) ss ∧ ss.drop xs1.length = ss2.map inr := by
   by_cases h_xs1 : xs1.length = 0
   · obtain ⟨rfl⟩ : xs1 = [] := List.eq_nil_iff_length_eq_zero.mpr h_xs1
-    refine ⟨ss2.map inr, by simp only [concat]; grind [Run, LTS.OmegaExecution], by simp⟩
+    use ss2.map inr
+    split_ands
+    · simp [concat]
+      grind only [LTS.OmegaExecution, = Set.mem_union, = get_map, = Set.mem_image, Run]
+    · simp
   · obtain ⟨s0, _, _, _, h_mtr⟩ := h1
     obtain ⟨ss1, _, _, _, _⟩ := LTS.Execution.of_mTr h_mtr
     let ss := (ss1.map inl).take xs1.length ++ω ss2.map inr
@@ -105,7 +110,9 @@ theorem concat_run_exists {xs1 : List Symbol} {xs2 : ωSequence Symbol} {ss2 : 
     · grind [concat, get_append_left]
     · have (k) (h_k : ¬ k < xs1.length) : k + 1 - xs1.length = k - xs1.length + 1 := by grind
       simp only [concat]
-      grind [Run, LTS.OmegaExecution, get_append_right', get_append_left, LTS.Execution]
+      grind only [Run, LTS.OmegaExecution, get_append_right', get_append_left,
+        = List.length_take, = get_map, = List.length_map, = min_def, = List.getElem_take,
+        = List.getElem_map]
     · grind [drop_append_of_le_length]
 
 namespace Buchi
diff --git a/Cslib/Computability/Automata/NA/Hist.lean b/Cslib/Computability/Automata/NA/Hist.lean
index 41c4432715..ed2137efe6 100644
--- a/Cslib/Computability/Automata/NA/Hist.lean
+++ b/Cslib/Computability/Automata/NA/Hist.lean
@@ -49,6 +49,7 @@ def makeHist (start' : State → Hist) (tr' : State × Hist → Symbol → State
   | 0 => start' (ss 0)
   | n + 1 => tr' (ss n, makeHist start' tr' xs ss n) (xs n) (ss (n + 1))
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- For every run `ss` of the original automaton, there exists a run `ss'` of the history automaton
 which projects back onto `ss`. -/
 theorem hist_run_exists {xs : ωSequence Symbol} {ss : ωSequence State}
@@ -56,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 [Run]
+    grind only [Run, usr Set.mem_setOf_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 a114cb384b..2b543787fe 100644
--- a/Cslib/Computability/Automata/NA/Loop.lean
+++ b/Cslib/Computability/Automata/NA/Loop.lean
@@ -92,6 +92,7 @@ theorem loop_run_one_iter {xs : ωSequence Symbol} {ss : ωSequence (Unit ⊕ St
     exact neq.imp (congrArg List.length)
   · grind [loop_run_from_left]
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 open List in
 /-- For any finite word in `language na`, there is a corresponding finite run of `na.loop`. -/
 theorem loop_fin_run_exists {xl : List Symbol} (h : xl ∈ language na) :
@@ -127,7 +128,8 @@ theorem loop_run_exists [Inhabited Symbol] {xls : ωSequence (List Symbol)}
     ∃ ss, na.loop.Run xls.flatten ss ∧ ∀ k, ss (xls.cumLen k) = inl () := by
   let ts := ωSequence.const (inl () : Unit ⊕ State)
   have h_mtr (k : ℕ) : na.loop.MTr (ts k) (xls k) (ts (k + 1)) := by grind [loop_fin_run_mtr]
-  have h_pos (k : ℕ) : (xls k).length > 0 := by grind
+  have (k : ℕ) : xls k ≠ [] := by grind
+  have h_pos (k : ℕ) : (xls k).length > 0 := List.length_pos_iff.mpr (this k)
   obtain ⟨ss, _, _⟩ := LTS.OmegaExecution.flatten_mTr h_mtr h_pos
   use ss
   grind [Run.mk, FinAcc.loop, cumLen_zero (ls := xls)]
@@ -158,7 +160,10 @@ theorem loop_language_eq [Inhabited Symbol] :
     use ss, h_run
     apply frequently_iff_strictMono.mpr
     use xls.cumLen, ?_, by grind
-    grind [cumLen_strictMono, List.eq_nil_iff_length_eq_zero]
+    apply cumLen_strictMono
+    intro k
+    apply List.length_pos_iff.mpr
+    grind
 
 end Buchi
 
diff --git a/Cslib/Computability/Automata/NA/Pair.lean b/Cslib/Computability/Automata/NA/Pair.lean
index e1df491330..45beb89d7a 100644
--- a/Cslib/Computability/Automata/NA/Pair.lean
+++ b/Cslib/Computability/Automata/NA/Pair.lean
@@ -99,6 +99,7 @@ namespace Automata.NA.Buchi
 
 open Set Filter ωSequence ωLanguage ωAcceptor
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- The ω-language accepted by a finite-state Büchi automaton is the finite union of ω-languages
 of the form `L * M^ω`, where all `L`s and `M`s are regular languages. -/
 theorem language_eq_fin_iSup_hmul_omegaPow
@@ -110,11 +111,11 @@ theorem language_eq_fin_iSup_hmul_omegaPow
   constructor
   · rintro ⟨ss, h_run, h_inf⟩
     obtain ⟨t, h_acc, h_t⟩ := frequently_in_finite_type.mp h_inf
-    use ss 0, by grind [NA.Run], t, h_acc
+    use ss 0, by grind only [NA.Run], t, h_acc
     obtain ⟨f, h_mono, h_f⟩ := frequently_iff_strictMono.mp h_t
     refine ⟨xs.take (f 0), ?_, xs.drop (f 0), ?_, by grind⟩
     · have : na.MTr (ss 0) (xs.extract 0 (f 0)) (ss (f 0)) := by
-        grind [LTS.OmegaExecution.extract_mTr, NA.Run]
+        grind only [LTS.OmegaExecution.extract_mTr, NA.Run]
       grind [extract_eq_drop_take]
     · simp only [omegaPow_seq_prop, LTS.mem_pairLang]
       use (f · - f 0)
@@ -131,7 +132,7 @@ theorem language_eq_fin_iSup_hmul_omegaPow
     have h_mtr (n : ℕ) : na.MTr (ts n) (zls n) (ts (n + 1)) := by
       grind [Language.mem_sub_one, LTS.mem_pairLang]
     have h_pos (n : ℕ) : (zls n).length > 0 := by
-      grind [Language.mem_sub_one, List.eq_nil_iff_length_eq_zero]
+      grind only [Language.mem_sub_one, List.eq_nil_iff_length_eq_zero]
     obtain ⟨zss, h_zss, _⟩ := LTS.OmegaExecution.flatten_mTr h_mtr h_pos
     have (n : ℕ) : zss (zls.cumLen n) = t := by grind
     obtain ⟨xss, _, _, _, _⟩ := LTS.OmegaExecution.append h_yl h_zss
diff --git a/Cslib/Computability/Automata/NA/Prod.lean b/Cslib/Computability/Automata/NA/Prod.lean
index 8b86ab9406..37ea9afc60 100644
--- a/Cslib/Computability/Automata/NA/Prod.lean
+++ b/Cslib/Computability/Automata/NA/Prod.lean
@@ -25,6 +25,7 @@ def iProd (na : (i : I) → NA (State i) Symbol) : NA (Π i, State i) Symbol whe
   Tr s x t := ∀ i, (na i).Tr (s i) x (t i)
   start := ⋂ i, (· i) ⁻¹' (na i).start
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Every run of the product automaton projects onto runs of its component automata,
 and vice versa. -/
 @[simp, scoped grind =]
@@ -39,7 +40,7 @@ theorem iProd_run_iff {na : (i : I) → NA (State i) Symbol}
   · intro h
     constructor
     · simp only [mem_iInter]
-      grind [Run]
+      grind only [Run, = mem_preimage, Run.mk, = ωSequence.head_map]
     · intro n i
       exact (h i).trans n
 
diff --git a/Cslib/Computability/Automata/NA/Sum.lean b/Cslib/Computability/Automata/NA/Sum.lean
index 029e912eda..26bbe0c9d7 100644
--- a/Cslib/Computability/Automata/NA/Sum.lean
+++ b/Cslib/Computability/Automata/NA/Sum.lean
@@ -25,6 +25,7 @@ def iSum (na : (i : I) → NA (State i) Symbol) : NA (Σ i, State i) Symbol wher
   start := ⋃ i, Sigma.mk i '' (na i).start
   Tr s x t := ∃ i s_i t_i, (na i).Tr s_i x t_i ∧ ⟨i, s_i⟩ = s ∧ ⟨i, t_i⟩ = t
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- An infinite run of the sum automaton is an infinite run of one of its component automata. -/
 @[simp, scoped grind =]
 theorem iSum_run_iff {na : (i : I) → NA (State i) Symbol}
@@ -50,9 +51,9 @@ theorem iSum_run_iff {na : (i : I) → NA (State i) Symbol}
   · rintro ⟨i, ss, h_run, rfl⟩
     constructor
     · simp only [iSum, get_map, mem_iUnion]
-      grind [NA.Run]
+      grind only [NA.Run, = mem_image]
     · simp only [LTS.OmegaExecution]
-      grind [NA.Run]
+      grind only [NA.Run, = get_map, iSum, LTS.OmegaExecution]
 
 namespace Buchi
 
@@ -76,7 +77,9 @@ theorem iSum_language_eq {na : (i : I) → NA (State i) Symbol} {acc : (i : I) 
   · rintro ⟨i, ss_i, _⟩
     use ss_i.map (Sigma.mk i)
     simp only [mem_iUnion]
-    grind
+    constructor
+    · grind
+    · grind
 
 end Buchi
 
diff --git a/Cslib/Computability/Languages/Congruences/BuchiCongruence.lean b/Cslib/Computability/Languages/Congruences/BuchiCongruence.lean
index 48e60cb611..f9c3ff0051 100644
--- a/Cslib/Computability/Languages/Congruences/BuchiCongruence.lean
+++ b/Cslib/Computability/Languages/Congruences/BuchiCongruence.lean
@@ -25,6 +25,7 @@ open Function Set Filter ωAcceptor ωLanguage ωSequence
 
 variable {Symbol : Type*} {State : Type}
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Given a Buchi automaton `na`, two finite words `u` and `v` are Buchi-congruent
 according to `na` iff for every pair of states `s` and `t` of `na`, both of the
 following two conditions hold:
@@ -40,7 +41,7 @@ def BuchiCongruence (na : Buchi State Symbol) : RightCongruence Symbol where
   eq.iseqv.symm := by grind
   eq.iseqv.trans := by grind
   right_cov.elim := by
-    grind [Covariant, → LTS.pairLang_split, <= LTS.pairLang_append, → LTS.pairViaLang_split,
+    grind only [Covariant, → LTS.pairLang_split, <= LTS.pairLang_append, → LTS.pairViaLang_split,
       <= LTS.pairViaLang_append_pairLang, <= LTS.pairLang_append_pairViaLang]
 
 open scoped Classical in
@@ -89,11 +90,12 @@ lemma buchiCongruence_transfer
     have : ⟦xl⟧ = a := mem_singleton_iff.mp <| mem_preimage.mp hc
     have : ⟦yl⟧ = a := mem_singleton_iff.mp <| mem_preimage.mp hc'
     grind
-  have := h_eq s t
-  have h_yl : yl ∈ na.pairLang s t := by grind
-  have := LTS.Execution.of_mTr h_yl
-  grind [LTS.mem_pairViaLang, LTS.Execution, → LTS.Execution.comp,
-    → LTS.Execution.of_mTr]
+  obtain ⟨l, r⟩ := h_eq s t
+  by_cases h_xl : xl ∈ na.pairViaLang na.accept s t
+  · obtain := LTS.mem_pairViaLang.mp (r.mp h_xl)
+    grind [LTS.Execution, → LTS.Execution.comp, → LTS.Execution.of_mTr]
+  · use LTS.Execution.of_mTr (l.mp hp) |>.choose
+    grind
 
 /-- `na.buchiFamily` is a family of ω-languages indexed by a pair of equivalence classes
 of `na.BuchiCongruence` which will turn out to saturate the ω-language accepted by `na`
@@ -184,13 +186,15 @@ theorem buchiFamily_saturation [Inhabited Symbol] :
   obtain ⟨ss, ⟨h_init, h_exec⟩, h_acc⟩ := h_lang
   let f (k : ℕ) := xl.length + xls.cumLen k
   let ts := ωSequence.mk (fun k ↦ ss (f k))
-  have h_xls_p (k : ℕ) : (xls k).length > 0 := by grind [Language.mem_sub_one]
+  have (k : ℕ) : xls k ≠ [] := by grind [Language.mem_sub_one]
+  have h_xls_p (k : ℕ) : (xls k).length > 0 := List.length_pos_iff.mpr (this k)
   have h_xls_e (k : ℕ) : xls k ∈ na.pairLang (ts k) (ts (k + 1)) := by
     grind [LTS.OmegaExecution.extract_mTr h_exec (?_ : f k ≤ f (k + 1)), LTS.mem_pairLang,
       extract_append_right_right, add_tsub_cancel_left]
   have h_yls (k : ℕ) := buchiCongruence_transfer ((h_xls_c k).left) ((h_yls_c k).left) (h_xls_e k)
   choose sls h_yls_e h_yls_a using h_yls
-  have h_yls_p (k : ℕ) : (yls k).length > 0 := by grind [Language.mem_sub_one]
+  have (k : ℕ) : yls k ≠ [] := by grind [Language.mem_sub_one]
+  have h_yls_p (k : ℕ) : (yls k).length > 0 := List.length_pos_iff.mpr (this k)
   obtain ⟨ss1, h_ss1_run, h_ss1_seg⟩ := LTS.OmegaExecution.flatten_execution h_yls_e h_yls_p
   suffices ∃ᶠ (k : ℕ) in atTop, ss1 k ∈ na.accept by
     have h_xl_e : xl ∈ na.pairLang (ss 0) (ts 0) := by
@@ -200,7 +204,8 @@ theorem buchiFamily_saturation [Inhabited Symbol] :
       grind [buchiCongruence_transfer h_xl_c h_yl_c h_xl_e, LTS.mem_pairLang, LTS.Execution.to_mTr]
     have h_ss1_ts : ss1 0 = ts 0 := by
       have h : 0 < yls.cumLen 1 - yls.cumLen 0 := by grind
-      have : 0 < (sls 0).length := by grind
+      have : sls 0 ≠ [] := by grind
+      have : 0 < (sls 0).length := List.length_pos_iff.mpr this
       have : ss1 0 = (sls 0)[0] := by grind [get_extract (xs := ss1) h]
       have : (sls 0)[0] = ts 0 := h_yls_e 0 |>.choose_spec |>.1
       grind
diff --git a/Cslib/Computability/Languages/ExampleEventuallyZero.lean b/Cslib/Computability/Languages/ExampleEventuallyZero.lean
index dc777d9a8b..19f637161e 100644
--- a/Cslib/Computability/Languages/ExampleEventuallyZero.lean
+++ b/Cslib/Computability/Languages/ExampleEventuallyZero.lean
@@ -39,6 +39,7 @@ def eventuallyZeroNa : NA.Buchi (Fin 2) (Fin 2) where
   start := {0}
   accept := {1}
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 theorem eventuallyZero_accepted_by_na_buchi :
     language eventuallyZeroNa = eventuallyZero := by
   ext xs; unfold eventuallyZeroNa; constructor
@@ -49,7 +50,9 @@ theorem eventuallyZero_accepted_by_na_buchi :
     obtain ⟨k, rfl⟩ := Nat.exists_eq_add_of_le h_n
     suffices h1 : xs (m + k) = 0 ∧ ss (m + k) = 1 by grind
     have := h_run.trans m
-    induction k <;> grind [NA.Run]
+    induction k
+    · grind
+    · grind only [NA.Run, = LTS.OmegaExecution]
   · intro h
     obtain ⟨m, h_m⟩ := eventually_atTop.mp h
     let ss : ωSequence (Fin 2) := fun k ↦ if k ≤ m then (0 : Fin 2) else 1
@@ -97,7 +100,7 @@ theorem eventuallyZero_not_omegaLim :
   rintro ⟨l, h⟩
   let ls := ωSequence.mk (oneSegs h)
   have h_segs := oneSegs_lemma h
-  have h_pos : ∀ k, (ls k).length > 0 := by grind
+  have h_pos (k : ℕ) : 0 < (ls k).length := List.length_pos_iff.mpr (by grind)
   have h_ev : ls.flatten ∈ eventuallyZero := by
     rw [← h, mem_omegaLim, frequently_iff_strictMono]
     use (fun k ↦ ls.cumLen (k + 1))
diff --git a/Cslib/Computability/Languages/OmegaLanguage.lean b/Cslib/Computability/Languages/OmegaLanguage.lean
index 8cf0229cb8..14dfff4d36 100644
--- a/Cslib/Computability/Languages/OmegaLanguage.lean
+++ b/Cslib/Computability/Languages/OmegaLanguage.lean
@@ -98,9 +98,10 @@ def equiv : ωLanguage α ≃ Set (ωSequence α) where
 instance : CompleteAtomicBooleanAlgebra (ωLanguage α) :=
   equiv.completeAtomicBooleanAlgebra
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 instance : SetLike (ωLanguage α) (ωSequence α) where
   coe := ωLanguage.toSet
-  coe_injective' := by grind [Function.Injective, ωLanguage]
+  coe_injective' := by grind only [Function.Injective, ωLanguage]
 
 instance : HasSubset (ωLanguage α) := ⟨(· ≤ ·)⟩
 
@@ -400,8 +401,12 @@ theorem omegaPow_coind [Inhabited α] (h_le : p ≤ (l - 1) * p) : p ≤ l^ω :=
 theorem omegaPow_le_hmul_omegaPow' [Inhabited α] (l : Language α) :
     l^ω ≤ (l - 1) * l^ω := by
   rintro s ⟨xs, rfl, h_xs⟩
-  refine ⟨xs.head, h_xs 0, xs.tail.flatten, ⟨xs.tail, rfl, ?_⟩, ?_⟩ <;>
-  grind [l.mem_sub_one]
+  refine ⟨xs.head, h_xs 0, xs.tail.flatten, ⟨xs.tail, rfl, ?_⟩, ?_⟩
+  · grind
+  · apply cons_flatten
+    intro k
+    apply List.length_pos_iff.mpr
+    exact h_xs k |>.right
 
 theorem omegaPow_le_hmul_omegaPow [Inhabited α] (l : Language α) : l^ω ≤ l * l^ω := by
   have h1 := omegaPow_le_hmul_omegaPow' l
diff --git a/Cslib/Computability/URM/Execution.lean b/Cslib/Computability/URM/Execution.lean
index ace5db66b4..00526d3893 100644
--- a/Cslib/Computability/URM/Execution.lean
+++ b/Cslib/Computability/URM/Execution.lean
@@ -82,8 +82,9 @@ namespace Step
 
 variable {p : Program}
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- The step relation is deterministic: each state has at most one successor. -/
-theorem deterministic : Relator.RightUnique (Step p) := by grind [Relator.RightUnique]
+theorem deterministic : Relator.RightUnique (Step p) := by grind only [Relator.RightUnique]
 
 /-- A halted state has no successor in the step relation. -/
 theorem no_step_of_halted {s s' : State} (hhalted : s.isHalted p) : ¬Step p s s' := by
@@ -146,7 +147,7 @@ theorem preserves_register {s s' : State} {r : ℕ}
     s'.regs.read r = s.regs.read r := by
   induction hsteps using Relation.ReflTransGen.head_induction_on with
   | refl => rfl
-  | head => grind [Step.preserves_register]
+  | head hstep => grind [Step.preserves_register hstep (r := r)]
 
 /-- If two halted states are reachable from the same start, they are equal.
 
@@ -160,6 +161,8 @@ theorem eq_of_halts {init s₁ s₂ : State}
   -- But s₁ and s₂ are normal forms, so w must equal both
   have hn1 := isHalted_iff_normal.mp hh1
   have hn2 := isHalted_iff_normal.mp hh2
+  obtain ⟨pc₁, regs₁⟩ := s₁
+  obtain ⟨pc₂, regs₂⟩ := s₂
   grind
 
 end Steps
diff --git a/Cslib/Computability/URM/StraightLine.lean b/Cslib/Computability/URM/StraightLine.lean
index 750a8c51da..f8c0d2e382 100644
--- a/Cslib/Computability/URM/StraightLine.lean
+++ b/Cslib/Computability/URM/StraightLine.lean
@@ -87,10 +87,13 @@ theorem straight_line_halts_from_regs {p : Program} (hsl : p.IsStraightLine) (r
     exact ⟨s', hsteps, Nat.le_of_eq hpc'.symm, hpc'⟩
   intro s hpc_le
   generalize hrem : p.length - s.pc = remaining
-  induction remaining using Nat.strong_induction_on generalizing s
+  induction remaining using Nat.strong_induction_on generalizing s with
+  | h n ih =>
   by_cases hhalted : s.pc ≥ p.length
   · grind
-  · grind [Program.IsStraightLine, Step.of_nonJump, Relation.ReflTransGen.head]
+  · have jmp : ¬p[s.pc].IsJump := by apply hsl; grind
+    have := Step.of_nonJump (by lia) jmp
+    grind [Relation.ReflTransGen.head]
 
 /-- A straight-line program halts on any input. -/
 theorem straight_line_halts {p : Program} (hsl : p.IsStraightLine) (inputs : List ℕ) :
diff --git a/Cslib/Foundations/Data/OmegaSequence/Defs.lean b/Cslib/Foundations/Data/OmegaSequence/Defs.lean
index 49f73f00fe..20a4b7d190 100644
--- a/Cslib/Foundations/Data/OmegaSequence/Defs.lean
+++ b/Cslib/Foundations/Data/OmegaSequence/Defs.lean
@@ -35,9 +35,10 @@ structure ωSequence (α : Type u) where
   /-- The function that defines this infinite sequence. -/
   get : ℕ → α
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 instance : FunLike (ωSequence α) ℕ α where
   coe := ωSequence.get
-  coe_injective' := by grind [ωSequence, Function.Injective]
+  coe_injective' := by grind only [ωSequence, Function.Injective]
 
 instance : Coe (ℕ → α) (ωSequence α) where
   coe f := ⟨f⟩
diff --git a/Cslib/Foundations/Data/OmegaSequence/Init.lean b/Cslib/Foundations/Data/OmegaSequence/Init.lean
index a5b3cf0996..3c54d06ecf 100644
--- a/Cslib/Foundations/Data/OmegaSequence/Init.lean
+++ b/Cslib/Foundations/Data/OmegaSequence/Init.lean
@@ -516,8 +516,10 @@ theorem take_extract {xs : ωSequence α} {m n k : ℕ} (h : k ≤ n - m) :
 @[simp, scoped grind =]
 theorem drop_extract {xs : ωSequence α} {m n k : ℕ} (h : k ≤ n - m) :
     (xs.extract m n).drop k = xs.extract (m + k) n := by
-  have := extract_lu_extract_lu (xs := xs) (m := m) (n := n) (i := k) (j := n - m)
-  grind [length_extract, List.take_length]
+  by_cases m ≤ n
+  · grind only [extract_lu_extract_lu, length_extract, List.length_drop, List.take_length]
+  · have : k = 0 := by grind only
+    grind only [List.drop_zero]
 
 end ωSequence
 
diff --git a/Cslib/Foundations/Data/OmegaSequence/Temporal.lean b/Cslib/Foundations/Data/OmegaSequence/Temporal.lean
index 884f7350c3..22fb04aafa 100644
--- a/Cslib/Foundations/Data/OmegaSequence/Temporal.lean
+++ b/Cslib/Foundations/Data/OmegaSequence/Temporal.lean
@@ -49,10 +49,11 @@ variable {xs : ωSequence α}
 theorem step_leadsTo {p q : Set α} (h : xs.Step p q) : xs.LeadsTo p q := by
   grind
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- `LeadsTo` is transitive. -/
 theorem leadsTo_trans {p q r : Set α}
     (h1 : xs.LeadsTo p q) (h2 : xs.LeadsTo q r) : xs.LeadsTo p r := by
-  grind
+  grind only [LeadsTo]
 
 /-- If `p ∩ q` leads to `r` and `p ∩ qᶜ` leads to `s`, then `p` leads to `r ∪ s`. -/
 theorem leadsTo_cases_or {p q r s : Set α}
diff --git a/Cslib/Foundations/Data/Relation.lean b/Cslib/Foundations/Data/Relation.lean
index 4e8953f121..262ccbbd8c 100644
--- a/Cslib/Foundations/Data/Relation.lean
+++ b/Cslib/Foundations/Data/Relation.lean
@@ -497,7 +497,7 @@ theorem ChurchRosser.normal_eqvGen_reflTransGen (cr : ChurchRosser r) (norm : No
 /-- 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 ⟨_, _, _⟩ := cr xy
+  have ⟨z, _, _⟩ := cr xy
   grind
 
 /-- A pair of subrelations lifts to transitivity on the relation. -/
@@ -526,7 +526,8 @@ theorem Confluent.equivalence_join_reflTransGen (h : Confluent r) :
 the inverse of `r`. -/
 abbrev SN (r : α → α → Prop) := Acc (fun a b => r b a)
 
-lemma SN_iff_SN_of_rel (x : α) : SN r x ↔ ∀ y, r x y → SN r y := by grind [Acc]
+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
 
diff --git a/Cslib/Foundations/Semantics/FLTS/LTSToFLTS.lean b/Cslib/Foundations/Semantics/FLTS/LTSToFLTS.lean
index f286c1eeb4..34ff856e7a 100644
--- a/Cslib/Foundations/Semantics/FLTS/LTSToFLTS.lean
+++ b/Cslib/Foundations/Semantics/FLTS/LTSToFLTS.lean
@@ -33,8 +33,8 @@ theorem toFLTS_mem_tr {lts : LTS State Label} {S : Set State} {s' : State} {μ :
 original `LTS`. -/
 @[scoped grind =]
 theorem toFLTS_mem_mtr {lts : LTS State Label} {S : Set State} {s' : State} {μs : List Label} :
-  s' ∈ lts.toFLTS.mtr S μs ↔ ∃ s ∈ S, lts.MTr s μs s' := by
-  grind [LTS.toFLTS, FLTS.mtr]
+    s' ∈ lts.toFLTS.mtr S μs ↔ ∃ s ∈ S, lts.MTr s μs s' :=
+  ⟨by grind [FLTS.mtr], by grind [FLTS.mtr]⟩
 
 /-- Characterisation of multistep transitions in `LTS.toFLTS` as image transitions in `LTS`. -/
 @[scoped grind =]
diff --git a/Cslib/Foundations/Semantics/LTS/Bisimulation.lean b/Cslib/Foundations/Semantics/LTS/Bisimulation.lean
index 2d4009c2e8..21ffd67eb5 100644
--- a/Cslib/Foundations/Semantics/LTS/Bisimulation.lean
+++ b/Cslib/Foundations/Semantics/LTS/Bisimulation.lean
@@ -777,6 +777,7 @@ theorem IsBisimulation.isSimulation_iff :
   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 =
@@ -790,10 +791,8 @@ theorem HomBisimilarity.symm_simulation :
       grind [Std.Symm, Bisimilarity.symm, IsBisimulation.isSimulation]
     grind
   · intro ⟨r, hr, hsymm, hsim⟩
-    have : r = (flip r) := by
-      grind [flip, Std.Symm]
-    have : IsHomBisimulation lts r := by
-      grind [IsBisimulation.isSimulation_iff]
+    have : r = (flip r) := by grind only [flip, Std.Symm]
+    have : IsHomBisimulation lts r := by grind [IsBisimulation.isSimulation_iff]
     grind
 
 end Bisimulation
diff --git a/Cslib/Foundations/Semantics/LTS/Execution.lean b/Cslib/Foundations/Semantics/LTS/Execution.lean
index 589819fa45..ac51c2a1c8 100644
--- a/Cslib/Foundations/Semantics/LTS/Execution.lean
+++ b/Cslib/Foundations/Semantics/LTS/Execution.lean
@@ -119,7 +119,7 @@ theorem Execution.comp
     · grind only [Execution, = List.getElem_append]
     · have := Execution.comp_helper h1 h2 (k - μs1.length)
       have := Execution.comp_helper h1 h2 (k - μs1.length + 1)
-      grind
+      grind only [Execution, = List.getElem_append]
 
 /-- An execution can be split at any intermediate state into two executions. -/
 theorem Execution.split
diff --git a/Cslib/Foundations/Semantics/LTS/OmegaExecution.lean b/Cslib/Foundations/Semantics/LTS/OmegaExecution.lean
index 963035f0cc..66502ed9cf 100644
--- a/Cslib/Foundations/Semantics/LTS/OmegaExecution.lean
+++ b/Cslib/Foundations/Semantics/LTS/OmegaExecution.lean
@@ -31,8 +31,8 @@ variable {State Label : Type*} {lts : LTS State Label}
 /-- Any finite execution extracted from an infinite execution is valid. -/
 theorem OmegaExecution.extract_execution
     (h : lts.OmegaExecution ss μs) {n m : ℕ} (hnm : n ≤ m) :
-    lts.Execution (ss n) (μs.extract n m) (ss m) (ss.extract n (m + 1)) := by
-  grind
+    lts.Execution (ss n) (μs.extract n m) (ss m) (ss.extract n (m + 1)) :=
+  ⟨by grind, by grind⟩
 
 /-- Any multistep transition extracted from an infinite execution is valid. -/
 theorem OmegaExecution.extract_mTr
@@ -113,7 +113,9 @@ theorem OmegaExecution.flatten_mTr [Inhabited Label]
   obtain ⟨ss, h_ss, h_seg⟩ := OmegaExecution.flatten_execution h_sls hpos
   use ss, h_ss
   intro k
-  have h1 : 0 < (ss.extract (μls.cumLen k) (μls.cumLen (k + 1))).length := by grind
+  have : ss.extract (μls.cumLen k) (μls.cumLen (k + 1)) ≠ [] := by grind
+  have h1 : 0 < (ss.extract (μls.cumLen k) (μls.cumLen (k + 1))).length :=
+    List.length_pos_iff.mpr this
   grind [List.getElem_of_eq (h_seg k) h1]
 
 end Cslib.LTS
diff --git a/Cslib/Foundations/Semantics/LTS/Total.lean b/Cslib/Foundations/Semantics/LTS/Total.lean
index 37073920f3..2980aa9261 100644
--- a/Cslib/Foundations/Semantics/LTS/Total.lean
+++ b/Cslib/Foundations/Semantics/LTS/Total.lean
@@ -74,6 +74,7 @@ instance (lts : LTS State Label) : lts.totalize.Total where
     use none
     simp [totalize]
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- In `totalize`, there is no finite execution from the sink state to any non-sink state. -/
 theorem totalize.no_sink_to_nonsink {μs : List Label} {t : State} :
     ¬ lts.totalize.MTr (none) μs (some t) := by
@@ -81,7 +82,9 @@ theorem totalize.no_sink_to_nonsink {μs : List Label} {t : State} :
   generalize h_s : (none : Option State) = s'
   generalize h_t : (some t : Option State) = t'
   rw [h_s, h_t] at h
-  induction h <;> grind [totalize]
+  induction h
+  · grind
+  · grind only [totalize]
 
 /-- In `totalize`, the transitions between non-sink states correspond exactly to
 the transitions in the original LTS. -/
diff --git a/Cslib/Languages/CCS/Basic.lean b/Cslib/Languages/CCS/Basic.lean
index 4a9956085f..c30c1849d4 100644
--- a/Cslib/Languages/CCS/Basic.lean
+++ b/Cslib/Languages/CCS/Basic.lean
@@ -87,7 +87,7 @@ def isCo [DecidableEq Name] (μ μ' : Act Name) : Bool :=
   | _, _ => false
 
 theorem isCo_iff [DecidableEq Name] {μ μ' : Act Name} : isCo μ μ' ↔ Co μ μ' := by
-  grind [cases Act]
+  cases μ <;> cases μ' <;> grind
 
 /-- `Act.Co` is decidable if `Name` equality is decidable. -/
 instance [DecidableEq Name] {μ μ' : Act Name} : Decidable (Co μ μ') :=
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
index cf294d3b1c..1bb05bd29f 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
@@ -71,6 +71,7 @@ lemma Typing.preservation (der : Typing Γ t τ) (step : t ⭢βᵛ t') : Typing
       grind [fresh_exists <| free_union [fvTm] Var, openTm_substTm_intro, subst_tm]
   all_goals grind [cases Red]
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Any typable term either has a reduction step or is a value. -/
 lemma Typing.progress (der : Typing [] t τ) : t.Value ∨ ∃ t', t ⭢βᵛ t' := by
   generalize eq : [] = Γ at der
@@ -146,11 +147,15 @@ lemma Typing.progress (der : Typing [] t τ) : t.Value ∨ ∃ t', t ⭢βᵛ t'
   case abs σ _ τ L _ _=>
     left
     constructor
-    apply LC.abs L <;> grind [cases Env.Wf, cases Term.LC]
+    apply LC.abs L
+    · grind only [→ wf, cases Term.LC]
+    · grind only [→ wf]
   case tabs L _ _=>
     left
     constructor
-    apply LC.tabs L <;> grind [cases Env.Wf, cases Term.LC]
+    apply LC.tabs L
+    · grind only [→ wf, cases Term.LC]
+    · grind only [→ wf]
 
 end LambdaCalculus.LocallyNameless.Fsub
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Subtype.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Subtype.lean
index 1a8abe649d..7cdb72133c 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Subtype.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Subtype.lean
@@ -112,10 +112,10 @@ lemma trans : Sub Γ σ δ → Sub Γ δ τ → Sub Γ σ τ := by
     induction sub₁ <;> grind [cases Sub]
   case arrow σ' τ' _ _ _ _ =>
     generalize eq : σ'.arrow τ' = γ at sub₁
-    induction sub₁ <;> grind [cases Sub]
+    induction sub₁ <;> cases sub₂ <;> grind
   case sum σ' τ' _ _ _ _ =>
     generalize eq : σ'.sum τ' = γ at sub₁
-    induction sub₁ <;> grind [cases Sub]
+    induction sub₁ <;> cases sub₂ <;> grind
   case all σ' τ' _ _ _ _ _ =>
     generalize eq : σ'.all τ' = γ at sub₁
     induction sub₁
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Typing.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Typing.lean
index 7a9e8efe0e..c4aa13facd 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Typing.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Typing.lean
@@ -62,19 +62,25 @@ variable {Γ Δ Θ : Env Var} {σ τ δ : Ty Var}
 
 attribute [grind .] Typing.var Typing.app Typing.tapp Typing.sub Typing.inl Typing.inr
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Typings have well-formed contexts and types. -/
 @[grind →]
 lemma wf {Γ : Env Var} {t : Term Var} {τ : Ty Var} (der : Typing Γ t τ) : Γ.Wf ∧ t.LC ∧ τ.Wf Γ := by
   induction der <;> let L := free_union Var <;> have ⟨x, nmem⟩ := fresh_exists L
   case tabs ih =>
     cases (ih x (by grind)).left
-    grind [LC.tabs L, Ty.Wf.all L]
+    split_ands
+    · grind
+    · apply LC.tabs L <;> grind
+    · apply Ty.Wf.all L <;> grind
   case abs ih =>
     cases (ih x (by grind)).left
     grind [LC.abs L, Wf.strengthen]
   case let' => grind [LC.let' L, Ty.Wf.strengthen]
   case case => refine ⟨?_, LC.case L ?_ ?_ ?_, ?_⟩ <;> grind [Ty.Wf.strengthen]
-  all_goals grind [of_bind_ty, open_lc, cases Ty.Wf]
+  case var => grind [of_bind_ty]
+  case app => grind only [LC.app, cases Ty.Wf]
+  all_goals grind [open_lc]
 
 /-- Weakening of typings. -/
 lemma weaken (der : Typing (Γ ++ Δ) t τ) (wf : (Γ ++ Θ ++ Δ).Wf) :
@@ -203,38 +209,53 @@ lemma tabs_inv (der : Typing Γ (.tabs γ' t) τ) (sub : Sub Γ τ (all γ δ))
     · exists δ', L
   all_goals grind
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Invert the typing of a left case. -/
 lemma inl_inv (der : Typing Γ (.inl t) τ) (sub : Sub Γ τ (sum γ δ)) :
     ∃ γ', Typing Γ t γ' ∧ Sub Γ γ' γ := by
-  generalize eq : t.inl =t at der
-  induction der generalizing γ δ <;> grind [cases Sub]
+  generalize eq : t.inl = t at der
+  induction der generalizing γ δ with
+  | inl => grind only [cases Sub]
+  | _ => grind
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Invert the typing of a right case. -/
 lemma inr_inv (der : Typing Γ (.inr t) T) (sub : Sub Γ T (sum γ δ)) :
     ∃ δ', Typing Γ t δ' ∧ Sub Γ δ' δ := by
-  generalize eq : t.inr =t at der
-  induction der generalizing γ δ <;> grind [cases Sub]
+  generalize eq : t.inr = t at der
+  induction der generalizing γ δ with
+  | inr => grind only [cases Sub]
+  | _ => grind
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- A value that types as a function is an abstraction. -/
 lemma canonical_form_abs (val : Value t) (der : Typing [] t (arrow σ τ)) :
     ∃ δ t', t = .abs δ t' := by
   generalize eq  : σ.arrow τ = γ at der
   generalize eq' : [] = Γ at der
-  induction der generalizing σ τ <;> grind [cases Sub, cases Value]
+  induction der generalizing σ τ with
+  | sub _ _ _ => grind only [= Option.mem_def, = dlookup_nil, cases Sub]
+  | _ => grind
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- A value that types as a quantifier is a type abstraction. -/
 lemma canonical_form_tabs (val : Value t) (der : Typing [] t (all σ τ)) :
     ∃ δ t', t = .tabs δ t' := by
   generalize eq  : σ.all τ = γ at der
   generalize eq' : [] = Γ at der
-  induction der generalizing σ τ <;> grind [cases Sub, cases Value]
+  induction der generalizing σ τ with
+  | sub _ _ _ => grind only [= Option.mem_def, = dlookup_nil, cases Sub]
+  | _ => grind
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- A value that types as a sum is a left or right case. -/
 lemma canonical_form_sum (val : Value t) (der : Typing [] t (sum σ τ)) :
     ∃ t', t = .inl t' ∨ t = .inr t' := by
   generalize eq  : σ.sum τ = γ at der
   generalize eq' : [] = Γ at der
-  induction der generalizing σ τ <;> grind [cases Sub, cases Value]
+  induction der generalizing σ τ with
+  | sub => grind only [= Option.mem_def, = dlookup_nil, cases Sub]
+  |  _ => grind
 
 end Typing
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean
index ffb6f30237..c24a0ab669 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/WellFormed.lean
@@ -155,7 +155,8 @@ variable [HasFresh Var] in
 lemma nmem_fv {σ : Ty Var} (wf : σ.Wf Γ) (nmem : X ∉ Γ.dom) : X ∉ σ.fv := by
   induction wf with
   | all => grind [fresh_exists <| free_union [dom] Var, nmem_fv_open, openRec_lc]
-  | _ => grind [dlookup_isSome]
+  | @var _ Γ => grind => have : (dlookup X Γ).isSome = true; finish;
+  | _ => grind
 
 end Ty.Wf
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean
index a3e80e3310..405554ffb4 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean
@@ -110,8 +110,8 @@ lemma subst_aux (h : Δ ++ ⟨x, σ⟩ :: Γ ⊢ t ∶ τ) (der : Γ ⊢ s ∶ 
     case cons =>
     observe perm : (Γ ++ Δ).Perm (Δ ++ Γ)
     by_cases h : x = x'
-    case neg => grind
-    case pos => grind [(weaken der ?_).perm perm]
+    · have := (weaken der ?_).perm perm <;> grind
+    · grind
   case abs =>
     grind [Typing.abs <| free_union Var, subst_open_var _ _ _ _ ?_ der.lc]
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
index d9ab413bdc..8496ba8b9e 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/StrongNorm.lean
@@ -59,13 +59,16 @@ 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
   | base => grind [sn_abs_app_multiApp, sn_neutral, open_abs_lc]
   | arrow τ₁ τ₂ ih₁ ih₂ =>
     constructor
-    · grind [ih₁.neutal_lc (fvar <| fresh {}) (.fvar <| fresh {}) (.fvar <| fresh {}), cases LC]
+    · 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 [sn_app_left (Var := Var) (N := fvar <| fresh {})]
     · grind
     · intro M N P _ _ _ s _
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
index 698f52b6ca..f23f6c5083 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
@@ -63,6 +63,7 @@ theorem redex_app_l_cong (redex : M ↠βᶠ M') (lc_N : LC N) : app M N ↠β
 theorem redex_app_r_cong (redex : M ↠βᶠ M') (lc_N : LC N) : app N M ↠βᶠ app N M' := by
   induction redex <;> grind
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /- Single reduction `app M (fvar x) ⭢βᶠ N` implies reduction on `M` or a root beta step. -/
 @[scoped grind →]
 lemma invert_step_app_fvar (step : app M (fvar x) ⭢βᶠ N) :
@@ -70,7 +71,7 @@ lemma invert_step_app_fvar (step : app M (fvar x) ⭢βᶠ N) :
   cases step
   case base h => cases h with | beta => exact .inr ⟨_, rfl, rfl⟩
   case appR step_M _ => exact .inl ⟨_, rfl, step_M⟩
-  all_goals grind [cases Xi]
+  all_goals grind only [cases Xi]
 
 variable [HasFresh Var] [DecidableEq Var]
 
@@ -88,7 +89,7 @@ lemma steps_lc_or_rfl {M M' : Term Var} (redex : M ↠βᶠ M') : (LC M ∧ LC M
 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
   induction step with
-  | base => grind [subst_open]
+  | base beta => cases beta; grind [subst_open]
   | abs  => grind [Xi.abs <| free_union Var]
   | _ => grind
 
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
index 856541e6e3..ee2ee01d1c 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullEta.lean
@@ -60,13 +60,14 @@ theorem redex_app_l_cong (redex : M ↠ηᶠ M') (lc_N : LC N) : app M N ↠η
 theorem redex_app_r_cong (redex : M ↠ηᶠ M') (lc_N : LC N) : app N M ↠ηᶠ app N M' := by
   induction redex <;> grind
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /- Single reduction `app M (fvar x) ⭢ηᶠ N` implies `N = app M' (fvar x)` for some M' -/
 @[scoped grind →]
 lemma invert_step_app_fvar (step : (app M (fvar x)) ⭢ηᶠ N) :
     ∃ M', N = app M' (fvar x) ∧ M ⭢ηᶠ M' := by
   cases step with
   | appR _ step_M => exact ⟨_, rfl, step_M⟩
-  | _ => grind [cases Xi]
+  | _ => grind only [cases Xi]
 
 variable [HasFresh Var] [DecidableEq Var]
 
@@ -84,7 +85,8 @@ lemma step_not_fv (step : M ⭢ηᶠ M') : M.fv = M'.fv := by
 @[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 => grind [Xi.abs <| free_union Var]
+  | abs => apply Xi.abs <| free_union Var; grind
+  | @base M N => grind
   | _ => grind
 
 /-- Abstracting then closing preserves a single η-reduction step. -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
index 691939af75..72fce48957 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
@@ -41,6 +41,7 @@ def depth : Term Var → ℕ
 | app t₁ t₂ => max (depth t₁) (depth t₂)
 | abs t => depth t + 1
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 @[elab_as_elim]
 protected lemma ind_on_depth (P : Term Var → Prop) (bvar : ∀ i, P (bvar i)) (fvar : ∀ x, P (fvar x))
     (app : ∀ M N, P M → P N → P (app M N))
@@ -49,7 +50,8 @@ protected lemma ind_on_depth (P : Term Var → Prop) (bvar : ∀ i, P (bvar i))
   induction h : M.depth using Nat.strong_induction_on generalizing M with | _ n ih
   induction M with
   | abs M' => apply abs M' <;> grind
-  | _ => grind [sup_le_iff]
+  | bvar | fvar => grind
+  | app => apply app <;> grind only [depth, = max_def]
 
 /-- The depth of the lambda expression doesn't change by opening at i-th bound variable
  for some free variable. -/
@@ -84,6 +86,7 @@ attribute [scoped grind .] LC.fvar LC.app
 inductive Value : Term Var → Prop
 | abs (e : Term Var) : e.abs.LC → e.abs.Value
 
+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
   induction M using LambdaCalculus.LocallyNameless.Untyped.Term.ind_on_depth with
@@ -93,7 +96,15 @@ theorem lcAt_iff_LC (M : Term Var) [HasFresh Var] : LcAt 0 M ↔ M.LC := by
       · intros h2
         rcases h2 with ⟨⟩|⟨L,_,_⟩
         grind [fresh_exists L]
-    | _ => grind [cases LC]
+    | fvar => grind
+    | bvar =>
+      constructor
+      · grind
+      · grind only [cases LC]
+    | app =>
+      constructor
+      · grind
+      · grind only [cases LC, LcAt]
 
 instance [HasFresh Var] (t : Term Var) : Decidable t.LC := by
   rw [← lcAt_iff_LC]
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiApp.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiApp.lean
index f9f85133e7..d7016d7dc4 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiApp.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/MultiApp.lean
@@ -72,6 +72,7 @@ lemma step_multiApp_r (steps : Ns ⭢lβᶠ Ns') (lc_M : LC M) : M.multiApp Ns 
 lemma steps_multiApp_r (steps : Ns ↠lβᶠ Ns') (lc_M : LC M) : M.multiApp Ns ↠βᶠ M.multiApp Ns' := by
   induction steps <;> 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,7 +87,7 @@ lemma invert_abs_multiApp_st {Ps} {M N Q : Term Var}
     (∃ Ps', Ps ⭢lβᶠ Ps' ∧ Q = multiApp (M.abs.app N) Ps') ∨
     (Q = multiApp (M ^ N) Ps) := by
   induction Ps generalizing M N Q with
-  | nil => grind [cases Xi]
+  | 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
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
index f7810940df..54b3b6c9ab 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean
@@ -55,15 +55,21 @@ lemma close_rec_fv {k y} (m : Term Var) : (m⟦k ↜ y⟧).fv = m.fv.erase y :=
 @[scoped grind =]
 lemma close_var_not_fvar (x) (t : Term Var) : (t ^* x).fv = t.fv.erase x := close_rec_fv t
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Opening preserves free variables. -/
 theorem open_preserve_not_fvar (k) (m n : Term Var) :
     m⟦k ↝ n⟧.fv = m.fv ∪ n.fv ∨ m⟦k ↝ n⟧.fv = m.fv := by
-  induction m generalizing k <;> grind
+  induction m generalizing k with
+  | app => grind only [= openRec, = fv]
+  | _ => grind
 
+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
-  induction m <;> grind
+  induction m with
+  | app => grind only [fv, = subst_app, = Finset.mem_union, = Finset.mem_erase]
+  | _ => grind
 
 lemma subst_refl (m : Term Var) (x : Var) : m[x := fvar x] = m := by
   induction m <;> grind
@@ -129,10 +135,11 @@ lemma close_open_to_subst (m n : Term Var) (x : Var) (k : ℕ) (m_lc : LC m) (n_
   induction m_lc generalizing k with
   | abs xs t =>
     have ⟨x', _⟩ := fresh_exists <| free_union [fv] Var
-    grind [
-      swap_open, =_ swap_open_fvar_close,
-      open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ n⟧) 0, open_close x' (t[x := n]) 0,
-       open_preserve_not_fvar, close_rec_fv, subst_preserve_not_fvar]
+    simp only [closeRec_abs, openRec_abs, subst_abs]
+    rw [open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ n⟧) 0, open_close x' (t[x := n]) 0]
+    · grind [swap_open, =_ swap_open_fvar_close]
+    · grind [subst_preserve_not_fvar]
+    · grind [open_preserve_not_fvar]
   | _ => grind
 
 /-- Closing and opening are inverses. -/
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean
index 793061cfee..6a0163c97a 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StrongNorm.lean
@@ -36,6 +36,7 @@ lemma sn_step (t_st_t' : t ⭢βᶠ t') (sn_t : SN FullBeta t) : SN FullBeta t'
 lemma sn_steps (t_st_t' : t ↠βᶠ t') (sn_t : SN FullBeta t) : SN FullBeta t' :=
   sn_t.of_rel_reflTransGen t_st_t'
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Free variables are strongly normalizing. -/
 lemma sn_fvar {x : Var} : SN FullBeta (fvar x) := by
   rw [SN_iff_SN_of_rel]
@@ -92,10 +93,11 @@ lemma neutral_step (Hneut : Neutral t) (Hstep : t ⭢βᶠ t') : Neutral t' := b
 lemma neutral_steps (Hneut : Neutral t) (Hsteps : t ↠βᶠ t') : Neutral t' := by
   induction Hsteps <;> grind [neutral_step]
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Neutral terms are strongly normalizing. -/
 lemma sn_neutral (Hneut : Neutral t) : SN FullBeta t := by
   induction Hneut with
-  | app => grind [→ neutral_steps, sn_app]
+  | app => grind only [→ neutral_steps, sn_app]
   | _ =>
     rw [SN_iff_SN_of_rel]
     grind only [cases Xi]
diff --git a/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean b/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
index df33df215b..32d86d85c8 100644
--- a/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
+++ b/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
@@ -149,9 +149,10 @@ structure Fact (P : Type*) [PhaseSpace P] where
   (carrier : Set P)
   (property : isFact carrier)
 
+set_option linter.tacticAnalysis.verifyGrindOnly false in
 instance : SetLike (Fact P) P where
   coe := Fact.carrier
-  coe_injective' _ _ _ := by grind [cases Fact]
+  coe_injective' _ _ _ := by grind only [cases Fact]
 
 instance : PartialOrder (Fact P) := PartialOrder.ofSetLike (Fact P) P
 
@@ -174,7 +175,7 @@ lemma subset_dual_dual {G : Set P} :
 lemma of_Fact {G : Fact P} {p : P}
     (hp : ∀ q, (∀ r ∈ G, q * r ∈ PhaseSpace.bot) → p * q ∈ PhaseSpace.bot) : p ∈ G := by
   rw [← SetLike.mem_coe, G.eq]
-  grind
+  simpa
 
 @[scoped grind =, simp] lemma mem_carrier (G : Fact P) : G.carrier = (G : Set P) := rfl
 
diff --git a/Cslib/Logics/Modal/Cube.lean b/Cslib/Logics/Modal/Cube.lean
index 38b28295af..3106b08fda 100644
--- a/Cslib/Logics/Modal/Cube.lean
+++ b/Cslib/Logics/Modal/Cube.lean
@@ -94,22 +94,23 @@ in `k_subset_t`.
 -/
 
 open scoped Proposition
+open Set
 
-theorem k_subset_d : (K World Atom ⊆ D World Atom) := by
-  intro φ; grind
+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]
 
-theorem k_subset_b : (K World Atom ⊆ B World Atom) := by
-  intro φ; grind
+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]
 
-theorem k_subset_four : (K World Atom ⊆ Four World Atom) := by
-  intro φ; grind
+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]
 
-theorem k_subset_five : (K World Atom ⊆ Five World Atom) := by
-  intro φ; grind
+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]
 
 open scoped Relation in
-theorem d_subset_t : (D World Atom ⊆ T World Atom) := by
-  intro φ; grind
+theorem d_subset_t : D World Atom ⊆ T World Atom := by
+  grind
 
 theorem k_subset_t : (K World Atom ⊆ T World Atom) := by
   calc

From 45072a305103b7a1383b2ce66a37a6a367d4a80a Mon Sep 17 00:00:00 2001
From: Dhruv Gupta <dhruv@zetesislabs.com>
Date: Fri, 29 May 2026 18:11:27 +0530
Subject: [PATCH 40/53] feat(MachineLearning/PACLearning): add VersionSpace
 abstraction (#592)

Adds the classical version space abstraction (Mitchell 1982, Angluin
1980) as a companion to the PAC learning definitions from #492.

- `VersionSpace C S`: the subset of `C` whose concepts agree with `S` on
every sample point
- `versionSpace_subset`, `versionSpace_empty_sample`: sanity lemmas
- `versionSpace_antitone`: more data gives a smaller version space
- `IsConsistent A C`: predicate on learners whose output always lies in
the version space
- `mem_versionSpace_of_realizable`,
`versionSpace_nonempty_of_realizable`: realizable-case bridge

Foundation for downstream proofs (Sauer-Shelah, PAC lower bounds,
infinite NFL).

---------

Co-authored-by: dhruvgupta-zetesis <dhruv.gupta@artpark.in>
Co-authored-by: Fabrizio Montesi <famontesi@gmail.com>
---
 Cslib.lean                                    |   1 +
 .../PACLearning/VersionSpace.lean             | 310 ++++++++++++++++++
 references.bib                                |  39 +++
 3 files changed, 350 insertions(+)
 create mode 100644 Cslib/MachineLearning/PACLearning/VersionSpace.lean

diff --git a/Cslib.lean b/Cslib.lean
index 070e6dc0f2..565352e8e3 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -140,4 +140,5 @@ public import Cslib.Logics.Propositional.Defs
 public import Cslib.Logics.Propositional.NaturalDeduction.Basic
 public import Cslib.MachineLearning.PACLearning.Defs
 public import Cslib.MachineLearning.PACLearning.VCDimension
+public import Cslib.MachineLearning.PACLearning.VersionSpace
 public import Cslib.Probability.PMF
diff --git a/Cslib/MachineLearning/PACLearning/VersionSpace.lean b/Cslib/MachineLearning/PACLearning/VersionSpace.lean
new file mode 100644
index 0000000000..37f8072cf0
--- /dev/null
+++ b/Cslib/MachineLearning/PACLearning/VersionSpace.lean
@@ -0,0 +1,310 @@
+/-
+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.Defs
+public import Mathlib.MeasureTheory.Measure.Dirac
+public import Mathlib.MeasureTheory.Measure.Map
+
+/-! # Version Space
+
+The *version space* of a concept class `C` given a labeled sample `S` is the
+subset of `C` whose concepts agree with `S` on every observed point — the
+classical "concepts still consistent with the data" of Mitchell (1977) and
+Angluin (1980).
+
+## Main definitions
+
+- `VersionSpace C S`: the subset of `C` whose concepts agree with `S` on every
+  sample point.
+- `IsConsistent A C`: a learner is consistent with `C` if its output always lies
+  in the version space at the received sample.
+- `empiricalMiscount h S`: number of sample points where `h` errs (`[DecidableEq β]`).
+- `empiricalMeasure S`: the uniform Dirac mixture over the sample.
+- `empiricalError h S`: the empirical distribution's mass on the disagreement set.
+- `Realizable C S`: some concept in `C` labels every sample point correctly.
+
+## Main results
+
+- `versionSpace_subset`, `versionSpace_empty_sample`, `versionSpace_reindex`,
+  `versionSpace_antitone`, `versionSpace_mono_C`: structural properties.
+- `mem_versionSpace_iff_empiricalMiscount_zero`: combinatorial bridge.
+- `mem_versionSpace_iff_empiricalError_zero`: measure-theoretic bridge.
+- `IsConsistent.empiricalMiscount_eq_zero`, `IsConsistent.empiricalError_eq_zero`:
+  consistent learners achieve zero error / miscount on every sample.
+- `mem_versionSpace_of_realizable`, `Realizable.versionSpace_nonempty`: realizable
+  samples give non-empty version spaces.
+- `ae_mem_versionSpace_of_realizable`: under iid sampling from a realizable
+  joint distribution, the target concept lies in the version space almost surely.
+
+## References
+
+* [Mitchell1977]
+* [Mitchell1982]
+* [Angluin1980]
+* [Mitchell1997]
+-/
+
+@[expose] public section
+
+open MeasureTheory Set
+open scoped ENNReal
+
+namespace Cslib.MachineLearning.PACLearning
+
+variable {α : Type*} {β : Type*}
+
+/-! ### Version Space -/
+
+/-- The *version space* of a concept class `C` given a labeled sample `S`:
+the set of concepts in `C` whose labels agree with `S` on every observed point. -/
+def VersionSpace {m : ℕ} (C : ConceptClass α β) (S : LabeledSample α β m) :
+    ConceptClass α β :=
+  {h ∈ C | ∀ i : Fin m, h (S i).1 = (S i).2}
+
+/-- Membership in the version space unfolds to concept membership plus
+per-sample consistency. -/
+theorem mem_versionSpace_iff {m : ℕ} {C : ConceptClass α β}
+    {S : LabeledSample α β m} {h : α → β} :
+    h ∈ VersionSpace C S ↔ h ∈ C ∧ ∀ i : Fin m, h (S i).1 = (S i).2 := Iff.rfl
+
+/-- The version space is a subset of the original concept class. -/
+theorem versionSpace_subset {m : ℕ} (C : ConceptClass α β)
+    (S : LabeledSample α β m) :
+    VersionSpace C S ⊆ C := fun _ hh => hh.1
+
+/-- Version space on the empty sample equals the whole concept class. -/
+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⟩⟩
+
+/-- *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
+`S ∘ f`. -/
+theorem versionSpace_reindex {m n : ℕ} (f : Fin m → Fin n) (C : ConceptClass α β)
+    (S : LabeledSample α β n) :
+    VersionSpace C S ⊆ VersionSpace C (S ∘ f) :=
+  fun _ hh => ⟨hh.1, fun i => hh.2 (f i)⟩
+
+/-- *Version space antitonicity.* Given a sample of size `n` and `m ≤ n`, the
+version space on all `n` observations is a subset of the version space on the
+first `m` observations. Special case of `versionSpace_reindex` with
+`f := Fin.castLE hmn`. -/
+theorem versionSpace_antitone {m n : ℕ} (hmn : m ≤ n) (C : ConceptClass α β)
+    (S : LabeledSample α β n) :
+    VersionSpace C S ⊆ VersionSpace C (S ∘ Fin.castLE hmn) :=
+  versionSpace_reindex (Fin.castLE hmn) C S
+
+/-- *Version space is monotone in the concept class.* -/
+theorem versionSpace_mono_C {m : ℕ} {C C' : ConceptClass α β} (hCC' : C ⊆ C')
+    (S : LabeledSample α β m) :
+    VersionSpace C S ⊆ VersionSpace C' S :=
+  fun _ hh => ⟨hCC' hh.1, hh.2⟩
+
+/-! ### Empirical Error -/
+
+/-- The *empirical miscount* of a hypothesis `h` on a labeled sample `S`: the
+number of sample points where `h` predicts incorrectly. -/
+def empiricalMiscount [DecidableEq β] {m : ℕ} (h : α → β)
+    (S : LabeledSample α β m) : ℕ :=
+  (Finset.univ.filter fun i : Fin m => h (S i).1 ≠ (S i).2).card
+
+section EmpiricalMeasure
+variable [MeasurableSpace α] [MeasurableSpace β]
+
+/-- The *empirical distribution* of a labeled sample: the uniform mixture of
+Dirac measures at each sample point. Equals the zero measure when `m = 0`. -/
+noncomputable def empiricalMeasure {m : ℕ} (S : LabeledSample α β m) :
+    Measure (α × β) :=
+  if _hm : m = 0 then 0
+  else (m : ℝ≥0∞)⁻¹ • ∑ i, Measure.dirac (S i)
+
+/-- The *empirical 0-1 error* of `h` on `S`: the empirical distribution's
+mass on the disagreement set. -/
+noncomputable def empiricalError {m : ℕ} (h : α → β) (S : LabeledSample α β m) :
+    ℝ≥0∞ :=
+  error (empiricalMeasure S) h
+
+end EmpiricalMeasure
+
+/-- Version-space membership equals concept-class membership plus zero empirical
+miscount (combinatorial bridge). -/
+theorem mem_versionSpace_iff_empiricalMiscount_zero [DecidableEq β]
+    {m : ℕ} {C : ConceptClass α β} {S : LabeledSample α β m} {h : α → β} :
+    h ∈ VersionSpace C S ↔ h ∈ C ∧ empiricalMiscount h S = 0 := by
+  simp only [empiricalMiscount, Finset.card_eq_zero, Finset.filter_eq_empty_iff,
+             Finset.mem_univ, true_implies, ne_eq, Decidable.not_not]
+  rfl
+
+/-- Version-space membership equals concept-class membership plus zero empirical
+error (measure-theoretic bridge). -/
+theorem mem_versionSpace_iff_empiricalError_zero
+    [MeasurableSpace α] [MeasurableSpace β]
+    [MeasurableSingletonClass α] [MeasurableSingletonClass β]
+    {m : ℕ} {C : ConceptClass α β} {S : LabeledSample α β m} {h : α → β} :
+    h ∈ VersionSpace C S ↔ h ∈ C ∧ empiricalError h S = 0 := by
+  refine and_congr_right fun _ => ?_
+  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
+
+/-- The empirical 0-1 error equals the empirical miscount divided by the
+sample size. -/
+theorem empiricalError_eq_div [DecidableEq β]
+    [MeasurableSpace α] [MeasurableSpace β]
+    [MeasurableSingletonClass α] [MeasurableSingletonClass β]
+    {m : ℕ} (hm : 0 < m) (h : α → β) (S : LabeledSample α β m) :
+    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 [Finset.sum_boole, ← ENNReal.div_eq_inv_mul]
+
+/-! ### Consistent Learners -/
+
+/-- A learner is *consistent* with the concept class `C` if, on every labeled
+sample it receives, its output hypothesis lies in the version space of `C` at
+that sample — i.e. the output is in `C` and agrees with every observed
+labeled pair. -/
+def IsConsistent {m : ℕ} (A : Learner α β m) (C : ConceptClass α β) : Prop :=
+  ∀ S : LabeledSample α β m, A S ∈ VersionSpace C S
+
+/-- A consistent learner's output is always in the concept class. -/
+theorem IsConsistent.output_mem_conceptClass {m : ℕ} {A : Learner α β m}
+    {C : ConceptClass α β} (hA : IsConsistent A C) (S : LabeledSample α β m) :
+    A S ∈ C := (hA S).1
+
+/-- A consistent learner's output agrees with the sample on every observed
+point. -/
+theorem IsConsistent.output_agrees {m : ℕ} {A : Learner α β m}
+    {C : ConceptClass α β} (hA : IsConsistent A C) (S : LabeledSample α β m)
+    (i : Fin m) :
+    A S (S i).1 = (S i).2 := (hA S).2 i
+
+/-- A consistent learner has zero empirical miscount on every sample. -/
+theorem IsConsistent.empiricalMiscount_eq_zero [DecidableEq β]
+    {m : ℕ} {A : Learner α β m} {C : ConceptClass α β} (hA : IsConsistent A C)
+    (S : LabeledSample α β m) :
+    empiricalMiscount (A S) S = 0 :=
+  (mem_versionSpace_iff_empiricalMiscount_zero.mp (hA S)).2
+
+/-- A consistent learner has zero empirical error on every sample. -/
+theorem IsConsistent.empiricalError_eq_zero
+    [MeasurableSpace α] [MeasurableSpace β]
+    [MeasurableSingletonClass α] [MeasurableSingletonClass β]
+    {m : ℕ} {A : Learner α β m} {C : ConceptClass α β}
+    (hA : IsConsistent A C) (S : LabeledSample α β m) :
+    empiricalError (A S) S = 0 :=
+  (mem_versionSpace_iff_empiricalError_zero.mp (hA S)).2
+
+/-! ### Realizable case -/
+
+/-- A labeled sample `S` is *realizable* by concept class `C` if some concept
+in `C` labels every sample point correctly. -/
+def Realizable {m : ℕ} (C : ConceptClass α β) (S : LabeledSample α β m) : Prop :=
+  ∃ c ∈ C, ∀ i : Fin m, (S i).2 = c (S i).1
+
+/-- *Realizable version-space nonemptiness.* If a target concept `c` lies in
+`C` and the sample `S` is labeled by `c` (i.e. every `(S i).2 = c (S i).1`),
+then `c` itself lies in the version space `VersionSpace C S`. -/
+theorem mem_versionSpace_of_realizable {m : ℕ} {C : ConceptClass α β}
+    {c : α → β} (hc : c ∈ C) (S : LabeledSample α β m)
+    (hS : ∀ i : Fin m, (S i).2 = c (S i).1) :
+    c ∈ VersionSpace C S :=
+  ⟨hc, fun i => (hS i).symm⟩
+
+/-- A realizable sample has nonempty version space. -/
+theorem Realizable.versionSpace_nonempty {m : ℕ} {C : ConceptClass α β}
+    {S : LabeledSample α β m} (h : Realizable C S) :
+    (VersionSpace C S).Nonempty :=
+  ⟨h.choose, mem_versionSpace_of_realizable h.choose_spec.1 S h.choose_spec.2⟩
+
+/-! ### Probabilistic Realizable -/
+
+/-- Under the pushforward of a probability measure `P` along the graph map
+`x ↦ (x, c x)`, the graph of `c` has measure `1`. -/
+private lemma map_graph_eq_one
+    [MeasurableSpace α] [MeasurableSpace β]
+    {c : α → β} (hcm : Measurable c) (P : Measure α) [IsProbabilityMeasure P]
+    (hG : MeasurableSet {p : α × β | p.2 = c p.1}) :
+    (P.map (fun x => (x, c x))) {p : α × β | p.2 = c p.1} = 1 := by
+  have hφ : Measurable (fun x : α => (x, c x)) := by fun_prop
+  rw [Measure.map_apply hφ hG]
+  have hpre : (fun x : α => (x, c x)) ⁻¹' {p : α × β | p.2 = c p.1} = Set.univ := by
+    ext x; simp
+  rw [hpre, measure_univ]
+
+/-- The iid product of the realizable joint distribution assigns measure `1`
+to the set of samples where every coordinate lies on the graph of `c`. -/
+private lemma pi_map_graph_eq_one
+    [MeasurableSpace α] [MeasurableSpace β]
+    {c : α → β} (hcm : Measurable c) (P : Measure α) [IsProbabilityMeasure P]
+    (hG : MeasurableSet {p : α × β | p.2 = c p.1}) {m : ℕ} :
+    (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))) :=
+    Measure.isProbabilityMeasure_map hφ.aemeasurable
+  rw [Measure.pi_pi]
+  simp [map_graph_eq_one hcm P hG]
+
+/-- Under iid sampling from the realizable joint distribution induced by
+`c ∈ C` and a probability measure `P` on `α`, the target concept `c` lies in
+the version space almost surely. -/
+theorem ae_mem_versionSpace_of_realizable
+    [MeasurableSpace α] [MeasurableSpace β]
+    {C : ConceptClass α β} {c : α → β} (hc : c ∈ C) (hcm : Measurable c)
+    (hG : MeasurableSet {p : α × β | p.2 = c p.1})
+    (P : Measure α) [IsProbabilityMeasure P] (m : ℕ) :
+    ∀ᵐ S : LabeledSample α β m
+      ∂(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))) :=
+    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⟩
+  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),
+        pi_map_graph_eq_one hcm P hG, tsub_self]
+  exact measure_mono_null hsub hcompl
+
+end Cslib.MachineLearning.PACLearning
diff --git a/references.bib b/references.bib
index 7b68d1f7ad..e43b1cdbeb 100644
--- a/references.bib
+++ b/references.bib
@@ -382,3 +382,42 @@ @incollection{WinskelNielsen1995
   url          = {https://doi.org/10.1093/oso/9780198537809.003.0001},
   eprint       = {https://academic.oup.com/book/0/chapter/421962123/chapter-pdf/52352653/isbn-9780198537809-book-part-1.pdf},
 }
+
+@inproceedings{Mitchell1977,
+  author       = {Mitchell, Tom M.},
+  title        = {Version Spaces: A Candidate Elimination Approach to Rule Learning},
+  booktitle    = {Proceedings of the 5th International Joint Conference on Artificial Intelligence},
+  volume       = {1},
+  pages        = {305--310},
+  year         = {1977}
+}
+
+@article{Mitchell1982,
+  author       = {Mitchell, Tom M.},
+  title        = {Generalization as Search},
+  journal      = {Artificial Intelligence},
+  volume       = {18},
+  number       = {2},
+  pages        = {203--226},
+  year         = {1982},
+  doi          = {10.1016/0004-3702(82)90040-6}
+}
+
+@article{Angluin1980,
+  author       = {Angluin, Dana},
+  title        = {Inductive Inference of Formal Languages from Positive Data},
+  journal      = {Information and Control},
+  volume       = {45},
+  number       = {2},
+  pages        = {117--135},
+  year         = {1980},
+  doi          = {10.1016/S0019-9958(80)90285-5}
+}
+
+@book{Mitchell1997,
+  author       = {Mitchell, Tom M.},
+  title        = {Machine Learning},
+  year         = {1997},
+  publisher    = {McGraw-Hill},
+  isbn         = {0070428077}
+}

From d0c137a2e65bb13d906be55bcde4fecaa7972c0b Mon Sep 17 00:00:00 2001
From: Fabrizio Montesi <famontesi@gmail.com>
Date: Fri, 29 May 2026 15:30:25 +0200
Subject: [PATCH 41/53] doc(Governance): add @SamuelSchlesinger to reviewers
 (#608)

Adds @SamuelSchlesinger to the GOVERNANCE file as a reviewer.
---
 GOVERNANCE.md | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/GOVERNANCE.md b/GOVERNANCE.md
index 50bc561aff..200340c6e7 100644
--- a/GOVERNANCE.md
+++ b/GOVERNANCE.md
@@ -46,5 +46,6 @@ Area maintainers are trusted contributors who take ownership of specific areas o
 Reviewers are trusted contributors who provide regular reviewing and technical guidance to PRs to CSLib.
 
 - Ching-Tsun Chou (@ctchou).
-- Thomas Waring (@thomaskwaring). 
+- Samuel Schlesinger (@SamuelSchlesinger).
+- Thomas Waring (@thomaskwaring).
 - Eric Wieser (@eric-wieser), Google DeepMind.

From 2f677bfc8ef76fa7a27feafc597c1e4a7eda3e42 Mon Sep 17 00:00:00 2001
From: Garmelon <joscha@plugh.de>
Date: Fri, 29 May 2026 16:31:42 +0100
Subject: [PATCH 42/53] chore: bump toolchain to v4.31.0-rc1 (#609)

Co-authored-by: Kim Morrison <477956+kim-em@users.noreply.github.com>
Co-authored-by: mathlib4-bot <github-mathlib4-bot@leanprover.zulipchat.com>
Co-authored-by: mathlib-nightly-testing[bot] <258991302+mathlib-nightly-testing[bot]@users.noreply.github.com>
Co-authored-by: leanprover-community-mathlib4-bot <129911861+leanprover-community-mathlib4-bot@users.noreply.github.com>
Co-authored-by: Kim Morrison <kim@tqft.net>
Co-authored-by: leanprover-community-mathlib4-bot <leanprover-community-mathlib4-bot@users.noreply.github.com>
Co-authored-by: Chris Henson <chrishenson.net@gmail.com>
Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com>
Co-authored-by: Ching-Tsun Chou <chingtsun.chou@gmail.com>
Co-authored-by: Alexandre Rademaker <arademaker@gmail.com>
Co-authored-by: mathlib-nightly-testing[bot] <mathlib-nightly-testing[bot]@users.noreply.github.com>
Co-authored-by: Fabrizio Montesi <famontesi@gmail.com>
---
 Cslib.lean                                    |   2 +-
 Cslib/Computability/Automata/DA/Congr.lean    |   2 +-
 .../Congruences/BuchiCongruence.lean          |   2 +-
 .../Machines/SingleTapeTuring/Basic.lean      |   4 -
 .../Protocols/SecretSharing/Shamir.lean       |   2 +-
 Cslib/Foundations/Control/Monad/Free.lean     |   3 +-
 .../Control/Monad/Free/Effects.lean           |   2 +-
 Cslib/Foundations/Data/HasFresh.lean          | 121 +++++++++---------
 .../LocallyNameless/Fsub/Safety.lean          |  22 ++--
 .../LinearLogic/CLL/PhaseSemantics/Basic.lean |   4 +-
 Cslib/Logics/Modal/Cube.lean                  |  30 ++---
 CslibTests.lean                               |   2 +-
 CslibTests/FreeMonad.lean                     |   4 +-
 lake-manifest.json                            |  28 ++--
 lakefile.toml                                 |   2 +-
 lean-toolchain                                |   2 +-
 16 files changed, 116 insertions(+), 116 deletions(-)

diff --git a/Cslib.lean b/Cslib.lean
index 565352e8e3..22881196dc 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -1,4 +1,4 @@
-module  -- shake: keep-all
+module  -- shake: keep-all --deprecated_module: ignore
 
 public import Cslib.Algorithms.Lean.MergeSort.MergeSort
 public import Cslib.Algorithms.Lean.TimeM
diff --git a/Cslib/Computability/Automata/DA/Congr.lean b/Cslib/Computability/Automata/DA/Congr.lean
index c1c49edf5d..d4c4356373 100644
--- a/Cslib/Computability/Automata/DA/Congr.lean
+++ b/Cslib/Computability/Automata/DA/Congr.lean
@@ -62,7 +62,7 @@ theorem congr_language_eq {a : Quotient c.eq} : language (FinAcc.mk c.toDA {a})
   /-- A grind regression found moving to nightly-2026-03-31 (changes from lean#13166) -/
   constructor <;>
   · intro h
-    simpa [mem_language, Accepts, congr_mtr_eq] using h
+    simpa [mem_language, Accepts, congr_mtr_eq] using! h
 
 end FinAcc
 
diff --git a/Cslib/Computability/Languages/Congruences/BuchiCongruence.lean b/Cslib/Computability/Languages/Congruences/BuchiCongruence.lean
index f9c3ff0051..9f837fd73f 100644
--- a/Cslib/Computability/Languages/Congruences/BuchiCongruence.lean
+++ b/Cslib/Computability/Languages/Congruences/BuchiCongruence.lean
@@ -142,7 +142,7 @@ theorem buchiFamily_cover [Inhabited Symbol] [Finite State] :
       simp_all only [extract_drop, color]
       split_ifs with h
       · have : f k ≤ f (k + 1) := by lia
-        have : f 0 + (f k - f 0) = f k := by lia
+        have : f 0 + (f k - f 0) = f k := by grind
         have : f 0 + (f (k + 1) - f 0) = f (k + 1) := by lia
         simp_all
         rfl
diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
index b956b62869..debad7d43f 100644
--- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
@@ -384,8 +384,6 @@ This section defines the notion of time-bounded Turing Machines
 
 section TimeComputable
 
-variable [Inhabited Symbol] [Fintype Symbol]
-
 /-- A Turing machine + a time function +
 a proof it outputs `f` in at most `time(input.length)` steps. -/
 structure TimeComputable (f : List Symbol → List Symbol) where
@@ -470,8 +468,6 @@ section PolyTimeComputable
 
 open Polynomial
 
-variable [Inhabited Symbol] [Fintype Symbol]
-
 /-- A Turing machine + a polynomial time function +
 a proof it outputs `f` in at most `time(input.length)` steps. -/
 structure PolyTimeComputable (f : List Symbol → List Symbol) extends TimeComputable f where
diff --git a/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean b/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean
index 5e5d7f2930..bd0de00d3b 100644
--- a/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean
+++ b/Cslib/Crypto/Protocols/SecretSharing/Shamir.lean
@@ -153,7 +153,7 @@ private theorem privacyCorrectionPolynomial_eval
     (privacyCorrectionPolynomial (F := F) params s secret₀ secret₁).eval (params.point i) =
       (secret₀ - secret₁) / params.point i := by
   classical
-  simpa using
+  simpa using!
     (_root_.Lagrange.eval_interpolate_at_node
       (s := s.attach)
       (v := fun j : s => params.point j)
diff --git a/Cslib/Foundations/Control/Monad/Free.lean b/Cslib/Foundations/Control/Monad/Free.lean
index dd8b2e66ad..90b2fea4c0 100644
--- a/Cslib/Foundations/Control/Monad/Free.lean
+++ b/Cslib/Foundations/Control/Monad/Free.lean
@@ -230,7 +230,8 @@ lemma liftM_lift_bind (interp : {ι : Type u} → F ι → m ι) (op : F β) (co
 @[simp]
 lemma liftM_lift [LawfulMonad m] (interp : {ι : Type u} → F ι → m ι) (op : F β) :
     (lift op).liftM interp = interp op := by
-  simp_rw [lift, FreeM.liftM, _root_.bind_pure]
+  rw [lift, FreeM.liftM]
+  simp
 
 @[simp]
 lemma liftM_bind [LawfulMonad m]
diff --git a/Cslib/Foundations/Control/Monad/Free/Effects.lean b/Cslib/Foundations/Control/Monad/Free/Effects.lean
index 7c58bca5a9..65ab32302e 100644
--- a/Cslib/Foundations/Control/Monad/Free/Effects.lean
+++ b/Cslib/Foundations/Control/Monad/Free/Effects.lean
@@ -449,7 +449,7 @@ instance instMonadWithReaderOf : MonadWithReaderOf σ (FreeReader σ) where
   | pure a => rfl
   | liftBind op cont ih =>
     cases op
-    simpa [withTheReader, instMonadWithReaderOf, run] using (ih (f s) s)
+    simpa [withTheReader, instMonadWithReaderOf, run] using! (ih (f s) s)
 
 end FreeReader
 
diff --git a/Cslib/Foundations/Data/HasFresh.lean b/Cslib/Foundations/Data/HasFresh.lean
index 6c095a334d..01ae7bc7fd 100644
--- a/Cslib/Foundations/Data/HasFresh.lean
+++ b/Cslib/Foundations/Data/HasFresh.lean
@@ -8,16 +8,17 @@ module -- shake: keep-downstream
 
 public import Cslib.Init
 public import Mathlib.Analysis.Normed.Field.Lemmas
+meta import Lean.Elab.ConfigEval
 import Qq
 
 /-! Computable chacterization of infinite types. -/
 
+namespace Cslib
+
 @[expose] public section
 
 universe u
 
-namespace Cslib
-
 /-- A type `α` has a computable `fresh` function if it is always possible, for any finite set
 of `α`, to compute a fresh element not in the set. -/
 class HasFresh (α : Type u) where
@@ -33,6 +34,63 @@ in proofs. -/
 theorem HasFresh.fresh_exists {α : Type u} [HasFresh α] (s : Finset α) : ∃ a, a ∉ s :=
   ⟨fresh s, fresh_notMem s⟩
 
+export HasFresh (fresh fresh_notMem fresh_exists)
+
+/-- `HasFresh α` implies a computably infinite type. -/
+instance HasFresh.to_infinite (α : Type u) [HasFresh α] : Infinite α := by
+  apply Infinite.of_not_fintype
+  rintro ⟨elems, _⟩
+  grind [fresh_notMem elems]
+
+/-- All infinite types have an associated (at least noncomputable) fresh function.
+This, in conjunction with `HasFresh.to_infinite`, characterizes `HasFresh`. -/
+noncomputable instance (α : Type u) [Infinite α] : HasFresh α where
+  fresh s := Infinite.exists_notMem_finset s |>.choose
+  fresh_notMem s := by grind
+
+open Finset in
+/-- Construct a fresh element from an embedding of `ℕ` using `Nat.find`. -/
+@[implicit_reducible]
+def HasFresh.ofNatEmbed {α : Type u} [DecidableEq α] (e : ℕ ↪ α) : HasFresh α where
+  fresh s := e (Nat.find (p := fun n ↦ e n ∉ s) ⟨(s.preimage e e.2.injOn).max.succ,
+    fun h ↦ not_lt_of_ge (le_max <| mem_preimage.2 h) (WithBot.lt_succ _)⟩)
+  fresh_notMem s := Nat.find_spec (p := fun n ↦ e n ∉ s) _
+
+/-- Construct a fresh element given a function `f` with `x < f x`. -/
+@[implicit_reducible]
+def HasFresh.ofSucc {α : Type u} [Inhabited α] [SemilatticeSup α] (f : α → α) (hf : ∀ x, x < f x) :
+    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
+    else hs ⟨_, h⟩
+
+/-- `ℕ` has a computable fresh function. -/
+instance : HasFresh ℕ :=
+  .ofSucc (· + 1) Nat.lt_add_one
+
+/-- `ℤ` has a computable fresh function. -/
+instance : HasFresh ℤ :=
+  .ofSucc (· + 1) Int.lt_succ
+
+/-- `ℚ` has a computable fresh function. -/
+instance : HasFresh ℚ :=
+  .ofSucc (· + 1) fun x ↦ lt_add_of_pos_right x one_pos
+
+/-- If `α` has a computable fresh function, then so does `Finset α`. -/
+instance {α : Type u} [DecidableEq α] [HasFresh α] : HasFresh (Finset α) :=
+  .ofSucc (fun s ↦ insert (fresh s) s) fun s ↦ Finset.ssubset_insert <| fresh_notMem s
+
+/-- If `α` is inhabited, then `Multiset α` has a computable fresh function. -/
+instance {α : Type u} [DecidableEq α] [Inhabited α] : HasFresh (Multiset α) :=
+  .ofSucc (fun s ↦ default ::ₘ s) fun _ ↦ Multiset.lt_cons_self _ _
+
+/-- `ℕ → ℕ` has a computable fresh function. -/
+instance : HasFresh (ℕ → ℕ) :=
+  .ofSucc (fun f x ↦ f x + 1) fun _ ↦ Pi.lt_def.2 ⟨fun _ ↦ Nat.le_succ _, 0, Nat.lt_succ_self _⟩
+
+end
+
 public meta section
 
 open Lean Elab Term Meta Parser Tactic
@@ -45,7 +103,7 @@ structure FreeUnionConfig where
   finset : Bool := true
 
 /-- Elaborate a FreeUnionConfig. -/
-declare_config_elab elabFreeUnionConfig FreeUnionConfig
+declare_term_config_elab elabFreeUnionConfig FreeUnionConfig
 
 /--
   Given a `DecidableEq Var` instance, this elaborator automatically constructs
@@ -87,7 +145,7 @@ set_option linter.style.emptyLine false in
 def HasFresh.freeUnion : TermElab := fun stx _ => do
   match stx with
   | `(free_union $cfg $[[$maps,*]]? $var:term) =>
-    let cfg ← elabFreeUnionConfig cfg |>.run { elaborator := .anonymous } |>.run' { goals := [] }
+    let cfg ← elabFreeUnionConfig cfg
 
     -- the type of our variables
     let var ← elabType var
@@ -124,59 +182,4 @@ def HasFresh.freeUnion : TermElab := fun stx _ => do
 
 end
 
-export HasFresh (fresh fresh_notMem fresh_exists)
-
-/-- `HasFresh α` implies a computably infinite type. -/
-instance HasFresh.to_infinite (α : Type u) [HasFresh α] : Infinite α := by
-  apply Infinite.of_not_fintype
-  rintro ⟨elems, _⟩
-  grind [fresh_notMem elems]
-
-/-- All infinite types have an associated (at least noncomputable) fresh function.
-This, in conjunction with `HasFresh.to_infinite`, characterizes `HasFresh`. -/
-noncomputable instance (α : Type u) [Infinite α] : HasFresh α where
-  fresh s := Infinite.exists_notMem_finset s |>.choose
-  fresh_notMem s := by grind
-
-open Finset in
-/-- Construct a fresh element from an embedding of `ℕ` using `Nat.find`. -/
-@[implicit_reducible]
-def HasFresh.ofNatEmbed {α : Type u} [DecidableEq α] (e : ℕ ↪ α) : HasFresh α where
-  fresh s := e (Nat.find (p := fun n ↦ e n ∉ s) ⟨(s.preimage e e.2.injOn).max.succ,
-    fun h ↦ not_lt_of_ge (le_max <| mem_preimage.2 h) (WithBot.lt_succ _)⟩)
-  fresh_notMem s := Nat.find_spec (p := fun n ↦ e n ∉ s) _
-
-/-- Construct a fresh element given a function `f` with `x < f x`. -/
-@[implicit_reducible]
-def HasFresh.ofSucc {α : Type u} [Inhabited α] [SemilatticeSup α] (f : α → α) (hf : ∀ x, x < f x) :
-    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
-    else hs ⟨_, h⟩
-
-/-- `ℕ` has a computable fresh function. -/
-instance : HasFresh ℕ :=
-  .ofSucc (· + 1) Nat.lt_add_one
-
-/-- `ℤ` has a computable fresh function. -/
-instance : HasFresh ℤ :=
-  .ofSucc (· + 1) Int.lt_succ
-
-/-- `ℚ` has a computable fresh function. -/
-instance : HasFresh ℚ :=
-  .ofSucc (· + 1) fun x ↦ lt_add_of_pos_right x one_pos
-
-/-- If `α` has a computable fresh function, then so does `Finset α`. -/
-instance {α : Type u} [DecidableEq α] [HasFresh α] : HasFresh (Finset α) :=
-  .ofSucc (fun s ↦ insert (fresh s) s) fun s ↦ Finset.ssubset_insert <| fresh_notMem s
-
-/-- If `α` is inhabited, then `Multiset α` has a computable fresh function. -/
-instance {α : Type u} [DecidableEq α] [Inhabited α] : HasFresh (Multiset α) :=
-  .ofSucc (fun s ↦ default ::ₘ s) fun _ ↦ Multiset.lt_cons_self _ _
-
-/-- `ℕ → ℕ` has a computable fresh function. -/
-instance : HasFresh (ℕ → ℕ) :=
-  .ofSucc (fun f x ↦ f x + 1) fun _ ↦ Pi.lt_def.2 ⟨fun _ ↦ Nat.le_succ _, 0, Nat.lt_succ_self _⟩
-
 end Cslib
diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
index 1bb05bd29f..e777ed0ea7 100644
--- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
+++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Fsub/Safety.lean
@@ -75,14 +75,14 @@ set_option linter.tacticAnalysis.verifyGrindOnly false in
 /-- Any typable term either has a reduction step or is a value. -/
 lemma Typing.progress (der : Typing [] t τ) : t.Value ∨ ∃ t', t ⭢βᵛ t' := by
   generalize eq : [] = Γ at der
-  have der' : Typing Γ t τ := by assumption
-  induction der <;> subst eq <;> simp only [forall_const] at *
+  have der' : Typing Γ t τ := der
+  induction der <;> subst eq
   case var mem => grind
   case app t₁ _ _ t₂ l r ih_l ih_r =>
     right
-    cases ih_l l with
+    cases ih_l rfl l with
     | inl val_l =>
-        cases ih_r r with
+        cases ih_r rfl r with
         | inl val_r =>
             have ⟨σ, t₁, eq⟩ := l.canonical_form_abs val_l
             exists t₁ ^ᵗᵗ t₂
@@ -97,7 +97,7 @@ lemma Typing.progress (der : Typing [] t τ) : t.Value ∨ ∃ t', t ⭢βᵛ t'
         grind
   case tapp σ' der _ ih =>
     right
-    specialize ih der
+    specialize ih rfl der
     cases ih with
     | inl val =>
         obtain ⟨_, t, _⟩ := der.canonical_form_tabs val
@@ -107,9 +107,9 @@ lemma Typing.progress (der : Typing [] t τ) : t.Value ∨ ∃ t', t ⭢βᵛ t'
         obtain ⟨t', _⟩ := red
         exists .tapp t' σ'
         grind
-  case let' t₁ σ t₂ τ L der _ _ ih =>
+  case let' t₁ σ t₂ τ L der _ ih _ =>
     right
-    cases ih der with
+    cases ih rfl der with
     | inl _ =>
         exists t₂ ^ᵗᵗ t₁
         grind
@@ -118,7 +118,7 @@ lemma Typing.progress (der : Typing [] t τ) : t.Value ∨ ∃ t', t ⭢βᵛ t'
         exists t₁'.let' t₂
         grind
   case inl der _ ih =>
-    cases (ih der) with
+    cases (ih rfl der) with
     | inl val => grind
     | inr red =>
         right
@@ -126,16 +126,16 @@ lemma Typing.progress (der : Typing [] t τ) : t.Value ∨ ∃ t', t ⭢βᵛ t'
         exists .inl t'
         grind
   case inr der _ ih =>
-    cases (ih der) with
+    cases (ih rfl der) with
     | inl val => grind
     | inr red =>
         right
         obtain ⟨t', _⟩ := red
         exists .inr t'
         grind
-  case case t₁ _ _ t₂ _ t₃ _ der _ _ _ _ ih =>
+  case case t₁ _ _ t₂ _ t₃ _ der _ _ ih _ _ =>
     right
-    cases ih der with
+    cases ih rfl der with
     | inl val =>
         have ⟨t₁, lr⟩ := der.canonical_form_sum val
         cases lr <;> [exists t₂ ^ᵗᵗ t₁; exists t₃ ^ᵗᵗ t₁] <;> grind
diff --git a/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean b/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
index 32d86d85c8..887d8f549d 100644
--- a/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
+++ b/Cslib/Logics/LinearLogic/CLL/PhaseSemantics/Basic.lean
@@ -264,7 +264,7 @@ lemma biorth_least_fact (G : Set P) :
       symm at hF ⊢
       apply ClosureOperator.IsClosed.closure_eq (congrArg orthogonal (congrArg orthogonal hF))
     have hF_closed : c.IsClosed F := (c.isClosed_iff).2 this.symm
-    simpa [c] using ClosureOperator.closure_min hGF hF_closed
+    simpa [c] using! ClosureOperator.closure_min hGF hF_closed
   apply h_min
 
 /-- `0` is the least fact (w.r.t. inclusion). -/
@@ -304,7 +304,7 @@ lemma inter_isFact_of_isFact {A B : Set P}
   let FB : Fact P := ⟨B, hB⟩
   have h := sInf_isFact (S := ({FA, FB} : Set (Fact P)))
   simpa [carriersInf, Set.image_pair, sInf_insert, sInf_singleton, inf_eq_inter]
-    using h
+    using! h
 
 instance : InfSet (Fact P) where
   sInf S := ⟨carriersInf S, sInf_isFact (S := S)⟩
diff --git a/Cslib/Logics/Modal/Cube.lean b/Cslib/Logics/Modal/Cube.lean
index 3106b08fda..98e825014c 100644
--- a/Cslib/Logics/Modal/Cube.lean
+++ b/Cslib/Logics/Modal/Cube.lean
@@ -24,63 +24,63 @@ relationships.
 namespace Cslib.Logic.Modal
 
 /-- The modal logic K. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def K World Atom := logic (Set.univ (α := Model World Atom))
 
 /-- The modal logic T. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def T World Atom := logic {m : Model World Atom | Std.Refl m.r}
 
 /-- The modal logic B. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def B World Atom := logic {m : Model World Atom | Std.Symm m.r}
 
 /-- The modal logic 4. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def Four World Atom := logic {m : Model World Atom | IsTrans World m.r}
 
 /-- The modal logic 5. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def Five World Atom := logic {m : Model World Atom | Relation.RightEuclidean m.r}
 
 /-- The modal logic K45. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def K45 World Atom := (K World Atom) ∪ (Four World Atom) ∪ (Five World Atom)
 
 /-- The modal logic D. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def D World Atom := logic {m : Model World Atom | Relation.Serial m.r}
 
 /-- The modal logic D4. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def D4 World Atom := (K World Atom) ∪ (D World Atom) ∪ (Four World Atom)
 
 /-- The modal logic D5. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def D5 World Atom := (K World Atom) ∪ (D World Atom) ∪ (Five World Atom)
 
 /-- The modal logic D45. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def D45 World Atom := (K World Atom) ∪ (D World Atom) ∪ (Four World Atom) ∪ (Five World Atom)
 
 /-- The modal logic DB. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def DB World Atom := (K World Atom) ∪ (D World Atom) ∪ (B World Atom)
 
 /-- The modal logic TB. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def TB World Atom := (K World Atom) ∪ (T World Atom) ∪ (B World Atom)
 
 /-- The modal logic KB5. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def KB5 World Atom := (K World Atom) ∪ (B World Atom) ∪ (Five World Atom)
 
 /-- The modal logic S4. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def S4 World Atom := (K World Atom) ∪ (T World Atom) ∪ (Four World Atom)
 
 /-- The modal logic S5. -/
-@[simp, scoped grind =]
+@[scoped grind =]
 def S5 World Atom := (K World Atom) ∪ (T World Atom) ∪ (Four World Atom) ∪ (Five World Atom)
 
 section Order
diff --git a/CslibTests.lean b/CslibTests.lean
index 7b52a3a319..12bc0e4611 100644
--- a/CslibTests.lean
+++ b/CslibTests.lean
@@ -1,4 +1,4 @@
-module  -- shake: keep-all
+module  -- shake: keep-all --deprecated_module: ignore
 
 public import CslibTests.Bisimulation
 public import CslibTests.CCS
diff --git a/CslibTests/FreeMonad.lean b/CslibTests/FreeMonad.lean
index 9928038563..6e6ce0359a 100644
--- a/CslibTests/FreeMonad.lean
+++ b/CslibTests/FreeMonad.lean
@@ -264,7 +264,7 @@ theorem runEff_bind_ok {α β}
     (h : runEff p env tr = .ok (v, env', tr')) :
     runEff (p >>= k) env tr = runEff (k v) env' tr' := by
   revert h
-  induction p generalizing env env' tr tr' v <;> simp only [runEff, bind, foldFreeM] <;> intro h
+  induction p generalizing env env' tr tr' v <;> simp only [runEff, bind] <;> intro h
   · case pure => cases h; rfl
   · case lift_bind _ op _ ih =>
     cases op
@@ -285,7 +285,7 @@ theorem runEff_bind_err {α β}
     {env : Env} {tr : Trace} {msg : String} :
     runEff p env tr = .error msg →
     runEff (p >>= k) env tr = .error msg := by
-  induction p generalizing env tr msg <;> simp only [runEff, bind, foldFreeM] <;> intro h
+  induction p generalizing env tr msg <;> simp only [runEff, bind] <;> intro h
   · case pure => simp [effPure] at h
   · case lift_bind _ op _ ih =>
     cases op
diff --git a/lake-manifest.json b/lake-manifest.json
index 7b2d3b8f19..16cc306345 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -5,17 +5,17 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "c5ea00351c28e24afc9f0f84379aa41082b1188f",
+   "rev": "d568c8c09630de097a046763c17b9ea99f95f950",
    "name": "mathlib",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "c5ea00351c28e24afc9f0f84379aa41082b1188f",
+   "inputRev": "d568c8c09630de097a046763c17b9ea99f95f950",
    "inherited": false,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/plausible",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "a456461b368b71d2accd95234832cd9c174b5437",
+   "rev": "d575be693add4fe9cb996968968ce42ce75c5ccd",
    "name": "plausible",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -35,7 +35,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "515cf9d0c00ece5e661f6de4326a53dedc1e8ea1",
+   "rev": "6db47de43aa7f516708053ae2fdadd29dd9baaaa",
    "name": "importGraph",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -45,50 +45,50 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "a84b3e2475d5c5ab979567b1ad8aea21b764bcf8",
+   "rev": "85bb7e7637e84a7d9803be7d954579fdae42c64b",
    "name": "proofwidgets",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v0.0.99",
+   "inputRev": "v0.0.100",
    "inherited": true,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/aesop",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "558915ae105bfd8074e22d597613d1961822adc2",
+   "rev": "fafca80479ff95e041d84373dda7122adf1295f2",
    "name": "aesop",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.30.0",
+   "inputRev": "v4.31.0-rc1",
    "inherited": true,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover-community/quote4",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "a6e6c34c4ef182f83b219a3a5a385f51f44bdc4c",
+   "rev": "8d33324ee877e9735d2829bc6f1f439e60cf98b1",
    "name": "Qq",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.30.0",
+   "inputRev": "v4.31.0-rc1",
    "inherited": true,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover-community/batteries",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "32dc18cde3684679f3c003de608743b57498c56f",
+   "rev": "708b057842c4cd0845fba132bd94b08493f6fc42",
    "name": "batteries",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "main",
+   "inputRev": "v4.31.0-rc1",
    "inherited": true,
    "configFile": "lakefile.toml"},
   {"url": "https://github.com/leanprover/lean4-cli",
    "type": "git",
    "subDir": null,
    "scope": "leanprover",
-   "rev": "6b907cf12b2e445ccb7c24bc208ef04a1f39e84c",
+   "rev": "48bdcff4c5fa27e09028f9f330e59baa0d4640cf",
    "name": "Cli",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.30.0",
+   "inputRev": "v4.31.0-rc1",
    "inherited": true,
    "configFile": "lakefile.toml"}],
  "name": "cslib",
diff --git a/lakefile.toml b/lakefile.toml
index 38c08dd947..4168dea38a 100644
--- a/lakefile.toml
+++ b/lakefile.toml
@@ -18,7 +18,7 @@ weak.linter.unicodeLinter = false
 [[require]]
 name = "mathlib"
 scope = "leanprover-community"
-rev = "c5ea00351c28e24afc9f0f84379aa41082b1188f"
+rev = "d568c8c09630de097a046763c17b9ea99f95f950"
 
 [[lean_lib]]
 name = "Cslib"
diff --git a/lean-toolchain b/lean-toolchain
index af9e5d339a..8c7e931aab 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.30.0
+leanprover/lean4:v4.31.0-rc1

From 43f68e97153616714e31d90163b958f4bf4b532d Mon Sep 17 00:00:00 2001
From: Ching-Tsun Chou <chingtsun.chou@gmail.com>
Date: Mon, 1 Jun 2026 00:18:02 -0700
Subject: [PATCH 43/53] feat(FLP): distributed algorithms for solving the
 consensus problem (#556)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This is the first PR of the formalization of Völzer's proof of the
famous result in distributed computing, first proved by Fischer, Lynch
and Paterson, that distributed consensus is impossible in the presence
of even a single crash fault.
* `Algorithm.lean` defines the "syntax" of a distributed algorithm for
solving the consensus problem and proves some basic properties.
* `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.
* README.md is for the overall project and mentions Lean files which
will be PR-ed later.
* references.bib is updated to add the papers by FLP and Völzer.

Zulip discussion:
[#CSLib > Impossibility of distributed
consensus](https://leanprover.zulipchat.com/#narrow/channel/513188-CSLib/topic/Impossibility.20of.20distributed.20consensus/with/592462001)
[#CSLib: PR reviews > #556:
consensus](https://leanprover.zulipchat.com/#narrow/channel/605128-CSLib.3A-PR-reviews/topic/.23556.3A.20consensus/with/598654217)
---
 Cslib.lean                                    |   2 +
 .../Distributed/FLP/Algorithm.lean            | 239 ++++++++++++++++++
 .../Distributed/FLP/Consensus.lean            | 144 +++++++++++
 Cslib/Computability/Distributed/FLP/README.md |  49 ++++
 references.bib                                |  31 +++
 5 files changed, 465 insertions(+)
 create mode 100644 Cslib/Computability/Distributed/FLP/Algorithm.lean
 create mode 100644 Cslib/Computability/Distributed/FLP/Consensus.lean
 create mode 100644 Cslib/Computability/Distributed/FLP/README.md

diff --git a/Cslib.lean b/Cslib.lean
index 22881196dc..c0269e0bbb 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -22,6 +22,8 @@ public import Cslib.Computability.Automata.NA.Prod
 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.Distributed.FLP.Algorithm
+public import Cslib.Computability.Distributed.FLP.Consensus
 public import Cslib.Computability.Languages.Congruences.BuchiCongruence
 public import Cslib.Computability.Languages.Congruences.RightCongruence
 public import Cslib.Computability.Languages.ExampleEventuallyZero
diff --git a/Cslib/Computability/Distributed/FLP/Algorithm.lean b/Cslib/Computability/Distributed/FLP/Algorithm.lean
new file mode 100644
index 0000000000..ccd90dbf65
--- /dev/null
+++ b/Cslib/Computability/Distributed/FLP/Algorithm.lean
@@ -0,0 +1,239 @@
+/-
+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.Semantics.LTS.OmegaExecution
+
+/-! # Distributed algorithms for solving the consensus problem
+
+In the consensus problem, each process of a distributed algorithm is given a boolean value
+at the beginning.  Then by exchanging messages asynchronously, they are supposed to agree on
+one of the initial boolean values. This file contains a very general definition of such
+a distributed algorithm.
+
+Borrowing an idea from Leslie Lamport, we allow the LTS defined by such an algorithm to
+"stutter" at any time, in the sense of taking a dummy step without changing the
+global state of the distributed algorithm.  This idea enables us to focus on infinite
+executions alone without loss of generality, because an algorithm that has run out of
+useful steps to take can always take the stuttering step.  Pathological executions in which
+the stuttering step is taken forever when there is useful work to be done are outlawed by
+the fairness assumptions defined in `Consensus.lean`.
+
+The types `P`, `M`, and `S` below are the types of processes (more precisely, process identifiers),
+messages contents, and process states.  Eventually `P` will be assumed to be finite in the form of
+`[Fintype P]`, but that assumption will be added only where necessary.  No assumption whatsoever
+will be made about `M` and `S`.  In particular, they could be infinite.
+-/
+
+@[expose] public section
+
+namespace Cslib.FLP
+
+open Set Sum Multiset
+
+variable {P M S : Type*} [DecidableEq P] [DecidableEq M]
+
+/-- The type of messages that processes send to each other. -/
+@[ext]
+structure Message (P M : Type*) where
+  /-- The destination of a message. -/
+  dest : P
+  /-- The content of the message, where the `Bool` option is used to carry to the
+      initial boolean value to each process. -/
+  msg : Bool ⊕ M
+deriving DecidableEq
+
+/-- The type of a process's local state. -/
+structure ProcState (S : Type*) where
+  /-- The internal state of a process. -/
+  state : S
+  /-- The state component used by a process to signal the boolean value it decides on. -/
+  out : Option Bool
+
+/-- The global state of the distributed algorithm. -/
+structure State (P M S : Type*) where
+  /-- A multiset containing all messages that are in-flight (namely, they have been sent but
+  not yet received). Note that being a multiset implies that the messages are not ordered. -/
+  msgs : Multiset (Message P M)
+  /-- A map giving the local states of all processes. -/
+  proc : P → ProcState S
+
+/-- The specification of a distributed algorithm for solving the consensus problem.
+Note that each field below can depend on a process's identifier (recall that each `Message`
+contains its destination's identifier), so the algorithm is not required to be uniform
+across processes. -/
+structure Algorithm (P M S : Type*) where
+  /-- A map specifying the initial state of each process. -/
+  init : P → S
+  /-- A map specifying how a process changes its internal state upon receiving a message. -/
+  next : Message P M → ProcState S → S
+  /-- A map specifying what messages a process sends out upon receiving a message. -/
+  send : Message P M → ProcState S → Multiset (Message P M)
+  /-- A map specifying the boolean decision a process makes upon receiving a message,
+      where `none` means that no decision is made. -/
+  out : Message P M → ProcState S → Option Bool
+
+/-- The type of labels of the LTS defined by an `Algorithm`, where `some m` denotes
+the reception of message `m` and `none` denotes a stuttering step. -/
+abbrev Action (P M : Type*) := Option (Message P M)
+
+/-- `DestIn ps x` means that if `x ≠ none`, then `x = some m` with `m.dest ∈ ps`. -/
+def DestIn (ps : Set P) : Action P M → Prop
+  | some m => m.dest ∈ ps
+  | none => True
+
+/-- Given `inp : P → Bool`, the initial state of the algorithm `a` contains a single message
+carrying the boolean value `inp p` to each process `p`, where the initial internal state is
+`a.init p` and no decision has been made.  The assumption `[Fintype P]` is made because
+a multiset may contain only finitely many elements. -/
+def Algorithm.start [Fintype P] (a : Algorithm P M S) (inp : P → Bool) : State P M S where
+  msgs := Multiset.map (fun p ↦ ⟨p, inl (inp p)⟩) Finset.univ.val
+  proc := fun p ↦ ⟨a.init p, none⟩
+
+/-- The specification of how the global state of the algorithm changes when a process `p`
+receives a message `m`.  (This function will be used only when such a message `m` exists.)
+Note that once `p` has made a boolean decision in its `out` field, it is not allowed to
+"change its mind" anymore. -/
+def Algorithm.recvMsg (a : Algorithm P M S) (m : Message P M) (s : State P M S) : State P M S :=
+  let p := m.dest
+  { msgs := s.msgs.erase m + a.send m (s.proc p)
+    proc := fun q ↦
+      if q = p then
+        ⟨ a.next m (s.proc p),
+          if (s.proc p).out.isNone then a.out m (s.proc p) else (s.proc p).out ⟩
+      else s.proc q }
+
+/-- The transition relation of the LTS defined by the algorithm `a`.
+Note that the stuttering step is always allowed. -/
+def Algorithm.lts (a : Algorithm P M S) : LTS (State P M S) (Action P M) where
+  Tr s x s' := match x with
+    | some m => m ∈ s.msgs ∧ s' = a.recvMsg m s
+    | none => s' = s
+
+/-- `a.Reachable inp s` means that `s` is a reachable state of `a` given the initial `inp`. -/
+def Algorithm.Reachable [Fintype P]
+    (a : Algorithm P M S) (inp : P → Bool) (s : State P M S) : Prop :=
+  a.lts.CanReach (a.start inp) s
+
+/-- `s.ProcDecided p b` means that process `p` is decided on the boolean value `b`
+in the state `s`. -/
+abbrev State.ProcDecided (s : State P M S) (p : P) (b : Bool) : Prop :=
+  (s.proc p).out = some b
+
+/-- `s.Decided b` means that at least one process is decided on the boolean value `b`
+in the state `s`. -/
+def State.Decided (s : State P M S) (b : Bool) : Prop :=
+  ∃ p, s.ProcDecided p b
+
+/-- `s.Agreed` says that all boolean values decided on in state `s` must agree with each other. -/
+def State.Agreed (s : State P M S) : Prop :=
+  ∀ b b', s.Decided b ∧ s.Decided b' → b = b'
+
+/-- `a.SafeConsensus` says that in any reachable state of `a`, (1) all boolean values decided on
+in that state must agree with each other and (2) that boolean value (if it exists) must be
+one of the boolean values given by `inp` at the beginning.  `a.SafeConsensus` is the minimal
+correctness requirement on `a` and is a safety property (hence its name). -/
+def Algorithm.SafeConsensus [Fintype P] (a : Algorithm P M S) : Prop :=
+  ∀ inp s, a.Reachable inp s → s.Agreed ∧ ∀ b, s.Decided b → ∃ p, inp p = b
+
+namespace Algorithm
+
+variable {a : Algorithm P M S} {inp : P → Bool}
+
+/-- The stuttering step does not change the global state. -/
+theorem tr_none {s s' : State P M S} (h : a.lts.Tr s none s') : s = s' := by
+  grind [Algorithm.lts]
+
+/-- The initial state is reachable. -/
+theorem reachable_start [Fintype P] :
+    a.Reachable inp (a.start inp) := by
+  simp [Algorithm.Reachable, LTS.CanReach.refl]
+
+/-- If `s` is reachable from the initial state and `s'` is reachable from `s`,
+then `s'` is reachable from the initial state. -/
+theorem reachable_stable [Fintype P] {s s' : State P M S}
+    (hr : a.Reachable inp s) (hc : a.lts.CanReach s s') : a.Reachable inp s' := by
+  obtain ⟨xs, _⟩ := hr
+  obtain ⟨xs', _⟩ := hc
+  use xs ++ xs'
+  grind [LTS.MTr.comp]
+
+/-- If `p` is decided on the boolean value `b` in `s` and `s'` is reachable from `s`,
+then `p` is still decided on `b` in `s'`. -/
+theorem procDecided_stable {s s' : State P M S} {p : P} {b : Bool}
+    (hd : s.ProcDecided p b) (hc : a.lts.CanReach s s') : s'.ProcDecided p b := by
+  obtain ⟨xs, h_mtr⟩ := hc
+  induction h_mtr <;> grind [Algorithm.lts, Algorithm.recvMsg]
+
+/-- If at least one process is decided on the boolean value `b` in `s` and `s'` is reachable
+from `s`, then at least one process is still decided on `b` in `s'`. -/
+theorem decided_stable {s s' : State P M S} {b : Bool}
+    (hd : s.Decided b) (hc : a.lts.CanReach s s') : s'.Decided b := by
+  obtain ⟨p, _⟩ := hd
+  use p
+  grind [procDecided_stable]
+
+/-- If `m1` and `m2` are both inflight and they have different destinations,
+then receiving them in either order produces the same end state. -/
+theorem recvMsg_comm {m1 m2 : Message P M} {s : State P M S}
+    (hd : m1.dest ≠ m2.dest) (h1 : m1 ∈ s.msgs) (h2 : m2 ∈ s.msgs) :
+    m2 ∈ (a.recvMsg m1 s).msgs ∧ m1 ∈ (a.recvMsg m2 s).msgs ∧
+    a.recvMsg m2 (a.recvMsg m1 s) = a.recvMsg m1 (a.recvMsg m2 s) := by
+  rw [State.mk.injEq]
+  split_ands
+  · grind [Algorithm.recvMsg, mem_erase_of_ne]
+  · grind [Algorithm.recvMsg, mem_erase_of_ne]
+  · have he1 (x) : (s.msgs.erase m1 + x).erase m2 = (s.msgs.erase m1).erase m2 + x := by
+      grind [erase_add_left_pos, mem_erase_of_ne]
+    have he2 (x) : (s.msgs.erase m2 + x).erase m1 = (s.msgs.erase m1).erase m2 + x := by
+      grind [erase_add_left_pos, mem_erase_of_ne, erase_comm]
+    simp [Algorithm.recvMsg, hd, hd.symm, he1, he2, add_assoc]
+    grind [add_comm]
+  · ext p
+    by_cases h_p1 : p = m1.dest <;> by_cases h_p2 : p = m2.dest <;>
+      simp [Algorithm.recvMsg, h_p1, h_p2, hd, hd.symm]
+
+/-- A diamond property for the transition relation `a.lts.Tr`. -/
+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]
+
+/-- A message that is in-flight stays in-flight as long as it is not received
+(finite execution version). -/
+theorem mTr_notRcvd_enabled {s t : State P M S} {xl : List (Action P M)} {m : Message P M}
+    (hst : a.lts.MTr s xl t) (hs : m ∈ s.msgs) (hxl : ¬ some m ∈ xl) : m ∈ t.msgs := by
+  induction hst
+  case refl _ => assumption
+  case stepL s x s1 xl t h_tr h_mtr h_ind =>
+    rcases Option.eq_none_or_eq_some x <;>
+      grind [Algorithm.lts, Algorithm.recvMsg, mem_erase_of_ne]
+
+/-- A message that is in-flight stays in-flight as long as it is not received
+(infinite execution version). -/
+theorem omega_notRcvd_enabled
+    {ss : ωSequence (State P M S)} {xs : ωSequence (Action P M)} {k : ℕ} {m : Message P M}
+    (he : a.lts.OmegaExecution ss xs) (hm : m ∈ (ss k).msgs) (hn : ∀ j, k ≤ j → xs j ≠ some m) :
+    ∀ j, k ≤ j → m ∈ (ss j).msgs := by
+  intro j h_j
+  obtain ⟨i, rfl⟩ : ∃ i, j = k + i := by use j - k; grind
+  induction i
+  case zero => grind
+  case succ i _ =>
+    rcases Option.eq_none_or_eq_some (xs (k + i)) <;>
+      grind [he (k + i), Algorithm.lts, Algorithm.recvMsg, mem_erase_of_ne]
+
+end Algorithm
+
+end Cslib.FLP
diff --git a/Cslib/Computability/Distributed/FLP/Consensus.lean b/Cslib/Computability/Distributed/FLP/Consensus.lean
new file mode 100644
index 0000000000..b7209ed905
--- /dev/null
+++ b/Cslib/Computability/Distributed/FLP/Consensus.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
+public import Mathlib.Data.Set.Card
+
+/-! # Fault-tolerant consensus
+
+Roughly speaking, a distributed consensus algorithm can tolerate `f` faults if up to `f`
+processes can be "faulty" and yet the non-faulty processes can still reach a consensus.
+The fault we consider here is limited to the crash fault, in which a process stops responding
+to messages from some point onward.  We do not consider Byzantine faults.
+-/
+
+@[expose] public section
+
+namespace Cslib.FLP
+
+open Function Set Multiset Fintype ωSequence
+
+variable {P M S : Type*}
+
+/-- A process `p` is faulty in an infinite execution iff there is a time `k` from which onward
+there is a message in-flight to `p` but `p` has stopped receiving messages. -/
+def ProcFaulty (p : P) (ss : ωSequence (State P M S)) (xs : ωSequence (Action P M)) : Prop :=
+  ∃ k, (∃ m, m ∈ (ss k).msgs ∧ m.dest = p) ∧ ∀ j, k ≤ j → ∀ m', xs j = some m' → m'.dest ≠ p
+
+/-- A process `p` is fair in an infinite execution iff every message in-flight to `p` is
+received by `p`. -/
+def ProcFair (p : P) (ss : ωSequence (State P M S)) (xs : ωSequence (Action P M)) : Prop :=
+  ∀ m, m.dest = p → ∀ k, m ∈ (ss k).msgs → ∃ j, k ≤ j ∧ xs j = some m
+
+/-- A process `p` cannot be both faulty and fair in an infinite execution.  Note, however, that
+it is possible for `p` to be neither faulty nor fair, because `p` can keep on receiving messages
+but at the same time keep ignoring some messages sent to it. -/
+theorem not_procFaulty_and_procFair (p : P)
+    (ss : ωSequence (State P M S)) (xs : ωSequence (Action P M)) :
+    ¬ (ProcFaulty p ss xs ∧ ProcFair p ss xs) := by
+  grind [ProcFaulty, ProcFair]
+
+/-- An infinite execution is fair iff every process is either faulty or fair
+(cf. the comment for the theorem `not_procFaulty_and_procFair`). -/
+def FairRun (ss : ωSequence (State P M S)) (xs : ωSequence (Action P M)) : Prop :=
+  ∀ p, ProcFaulty p ss xs ∨ ProcFair p ss xs
+
+/-- The number of faulty processes in an infinite execution. -/
+noncomputable def numProcFaulty (ss : ωSequence (State P M S)) (xs : ωSequence (Action P M)) : ℕ :=
+  {p | ProcFaulty p ss xs}.ncard
+
+/-- If the number of faulty processes in an infinite execution is less than the total number
+of processes, then at least one process is not faulty. -/
+theorem not_procFaulty_of_numProcFaulty [Fintype P]
+    {ss : ωSequence (State P M S)} {xs : ωSequence (Action P M)}
+    (h : numProcFaulty ss xs < card P) : ∃ p, ¬ ProcFaulty p ss xs := by
+  let nf := {p | ProcFaulty p ss xs}ᶜ
+  have h1 : 0 < nf.ncard := by
+    rw [ncard_compl]
+    grind [numProcFaulty, card_eq_nat_card]
+  obtain ⟨p, _⟩ := (ncard_pos (s := nf)).mp h1
+  grind
+
+/-- If every process in a set `ps` is fair, then the number of faulty processes is bounded by
+the total number of processes minus the cardinality of `ps`. -/
+theorem numProcFaulty_le_not_procFair [Fintype P]
+    {ss : ωSequence (State P M S)} {xs : ωSequence (Action P M)} {ps : Set P}
+    (h : ∀ p, p ∈ ps → ProcFair p ss xs) : numProcFaulty ss xs ≤ card P - ps.ncard := by
+  rw [numProcFaulty, card_eq_nat_card, ← ncard_compl]
+  suffices h1 : {p | ProcFaulty p ss xs} ⊆ psᶜ by exact ncard_le_ncard h1
+  grind [not_procFaulty_and_procFair]
+
+variable [DecidableEq P] [DecidableEq M]
+
+/-- The notion of an infinite admissible execution for an algorithm `a` with input `inp`
+and containing at most `f` faulty processes. -/
+def Algorithm.AdmissibleRun [Fintype P] (a : Algorithm P M S) (inp : P → Bool) (f : ℕ)
+    (ss : ωSequence (State P M S)) (xs : ωSequence (Action P M)) : Prop :=
+  ss 0 = a.start inp ∧ a.lts.OmegaExecution ss xs ∧
+  FairRun ss xs ∧ numProcFaulty ss xs ≤ f
+
+/-- A process terminates in an infinite execution iff either it crashes or it decides on
+a boolean value at some point. -/
+def ProcTermination (p : P) (ss : ωSequence (State P M S)) (xs : ωSequence (Action P M)) : Prop :=
+  ProcFaulty p ss xs ∨ ∃ k b, (ss k).ProcDecided p b
+
+/-- An algorithm `a` terminates with up to `f` faulty processes iff all its processes terminate
+in every infinite admissible execution containing at most `f` faulty processes. -/
+def Algorithm.Termination [Fintype P] (a : Algorithm P M S) (f : ℕ) : Prop :=
+  ∀ inp ss xs, a.AdmissibleRun inp f ss xs → ∀ p, ProcTermination p ss xs
+
+/-- An algorithm `a` is a consensus algorithm tolerating up to `f` faulty processes iff
+it both satisfies the consensus safety property `a.SafeConsensus` and terminates
+with up to `f` faulty processes. -/
+def Algorithm.Consensus [Fintype P] (a : Algorithm P M S) (f : ℕ) : Prop :=
+  a.SafeConsensus ∧ a.Termination f
+
+variable {a : Algorithm P M S} {inp : P → Bool}
+
+/-- 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' : ℕ}
+    {xs : ωSequence (Action P M)} {ss : ωSequence (State P M S)}
+    (hle : f ≤ f') (ha : a.AdmissibleRun inp f ss xs) : a.AdmissibleRun inp f' ss xs := by
+  grind [Algorithm.AdmissibleRun]
+
+/-- If `a` is a consensus algorithm tolerating up to `f` faulty processes,
+then it is also a consensus algorithm tolerating up to `f' ≤ f` faulty processes. -/
+theorem Consensus.fault_mono [Fintype P] {f f' : ℕ}
+    (hle : f ≥ f') (hc : a.Consensus f) : a.Consensus f' := by
+  obtain ⟨h_sc, h_f⟩ := hc
+  use h_sc
+  intro inp
+  grind [h_f inp, AdmissibleRun.fault_mono]
+
+/-- If a process `p` is not fair in an infinite execution of an algorithm `a`, then there is
+a message that is in-flight to, but never received, by `p` from some point onward. -/
+theorem Algorithm.not_fair_stay_enabled
+    {ss : ωSequence (State P M S)} {xs : ωSequence (Action P M)} {p : P}
+    (he : a.lts.OmegaExecution ss xs) (hnf : ¬ ProcFair p ss xs) :
+    ∃ m, m.dest = p ∧ ∃ k, m ∈ (ss k).msgs ∧ ∀ j, k ≤ j → m ∈ (ss j).msgs ∧ (xs j) ≠ some m := by
+  simp only [ProcFair, not_forall, not_exists, not_and] at hnf
+  grind only [omega_notRcvd_enabled]
+
+/-- In an infinite execution of an algorithm `a`, a process `p` is fair iff `p` is fair in
+all suffixes of the execution. -/
+theorem Algorithm.drop_procFair_iff
+    {ss : ωSequence (State P M S)} {xs : ωSequence (Action P M)}
+    (he : a.lts.OmegaExecution ss xs) (p : P) (n : ℕ) :
+    ProcFair p (ss.drop n) (xs.drop n) ↔ ProcFair p ss xs := by
+  constructor <;> intro h
+  · by_contra h_contra
+    obtain ⟨m, h_m, k, h_k, h_ge⟩ := Algorithm.not_fair_stay_enabled he h_contra
+    have := h m h_m k
+    grind
+  · intro m h_m k h_k
+    obtain ⟨j, _, _⟩ := h m h_m (n + k) (by grind)
+    use j - n
+    grind
+
+end Cslib.FLP
diff --git a/Cslib/Computability/Distributed/FLP/README.md b/Cslib/Computability/Distributed/FLP/README.md
new file mode 100644
index 0000000000..7bc8e7bd36
--- /dev/null
+++ b/Cslib/Computability/Distributed/FLP/README.md
@@ -0,0 +1,49 @@
+# Impossibility of 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.
+
+## Lean files
+
+1. `Algorithm.lean` defines the "syntax" of a distributed algorithm for solving the consensus problem
+   and proves some basic properties.
+
+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`.
+
+4. `CanReachVia.lean` defines the notion of reachability via a subset of processes and proves some of
+   its properties.
+
+5. `PseudoConsensus.lean` defines the notion of a fault-tolerant "pseudo-consensus" algorithm, which
+   is central to Völzer's proof, and proves that every `f`-tolerant consensus algorithm is also a
+   `f`-tolerant pseudo-consensus algorithm.
+
+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
+   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.
+
+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,
+as is explained further in each file.
+
+## References
+
+[FLP1985]
+M.J. Fischer, N.A. Lynch, M.S. Paterson, Impossibility of distributed consensus with one faulty process,
+JACM 32 (2) (April 1985) 374–382.
+
+[Volzer2004]
+H. Völzer, A constructive proof for FLP. Information Processing Letters 92(2), (October 2004) 83–87.
diff --git a/references.bib b/references.bib
index e43b1cdbeb..b2d78518f8 100644
--- a/references.bib
+++ b/references.bib
@@ -113,6 +113,24 @@ @article{         Chargueraud2012
 	file = {Full Text PDF:/home/chenson/mount/Zotero/storage/WBJWAZGI/Charguéraud - 2012 - The Locally Nameless Representation.pdf:application/pdf},
 }
 
+@article{ FLP1985,
+  author    = {Fischer, Michael J. and Lynch, Nancy A. and Paterson, Michael S.},
+  title     = {Impossibility of Distributed Consensus with One Faulty Process},
+  year      = {1985},
+  issue_date = {April 1985},
+  publisher = {Association for Computing Machinery},
+  address   = {New York, NY, USA},
+  volume    = {32},
+  number    = {2},
+  issn      = {0004-5411},
+  url       = {https://doi.org/10.1145/3149.214121},
+  doi       = {10.1145/3149.214121},
+  journal   = {J. ACM},
+  month     = {apr},
+  pages     = {374–382},
+  numpages  = {9}
+}
+
 @article{        Girard1987,
   title={Linear logic},
   author={Girard, Jean-Yves},
@@ -370,6 +388,19 @@ @book{KearnsVazirani1994
   address      = {Cambridge, MA, USA}
 }
 
+@article{ Volzer2004,
+  title     = {A constructive proof for {FLP}},
+  author    = {V{\"o}lzer, Hagen},
+  journal   = {Information Processing Letters},
+  volume    = {92},
+  number    = {2},
+  pages     = {83--87},
+  year      = {2004},
+  publisher = {Elsevier},
+  doi       = {10.1016/j.ipl.2004.06.008},
+  url       = {https://doi.org/10.1016/j.ipl.2004.06.008}
+}
+
 @incollection{WinskelNielsen1995,
   author       = {Winskel, Glynn and Nielsen, Mogens},
   isbn         = {9780198537809},

From 883e8687949015f702629dc1722445386c2d6a5b Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Tue, 2 Jun 2026 18:03:35 +0200
Subject: [PATCH 44/53] Introduce read-only input tape and write-only output
 tape and define time and space consumption.

---
 .../Machines/MultiTapeTuring/Basic.lean       | 404 ++++++++++--------
 1 file changed, 223 insertions(+), 181 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index 91ee0c781d..5aed397c69 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -8,56 +8,51 @@ module
 
 public import Mathlib.Data.Part
 public import Mathlib.Data.Fintype.Defs
+public import Mathlib.Data.Finset.Max
+public import Mathlib.Algebra.Order.BigOperators.Group.Finset
+public import Mathlib.Computability.Language
 public import Cslib.Foundations.Data.BiTape
 public import Cslib.Foundations.Data.RelatesInSteps
 public import Cslib.Computability.Machines.TuringCommon
-public import Mathlib.Algebra.Order.BigOperators.Group.Finset
 
 /-!
 # Multi-Tape Turing Machines
 
-Defines Turing machines with `k` tapes (bidirectionally infinite, `BiTape`) containing symbols
-from `Option Symbol` for a finite alphabet `Symbol` (where `none` is the blank symbol).
+Defines 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 design of the multi-tape Turing machine follows the one for single-tape Turing machines.
-With multiple tapes, it is not immediatly clear how to define the function computed by a Turing
-machine. For a single-tape Turing machine, function composition follows easily from composition
-of configurations. For multi-tape machines, we focus on composition of tape configurations
-(cf. `MultiTapeTM.eval`) and defer the decision of how to define the function computed by a
-Turing machine to a later stage.
-
-Since these Turing machines are deterministic, we base the definition of semantics on the sequence
-of configurations instead of reachability in a configuration relation, although equivalence
-between these two notions is proven.
+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, the input and output tapes do not count towards the space usage of
+the machine. The space usage of the work tapes is the number of cells the head accessed.
 
 ## Important Declarations
 
-We define a number of structures related to multi-tape Turing machine computation:
+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, including internal state and the state of the tapes
-* `UsesSpaceUntilStep`: a TM uses at most space `s` when run for up to `t` steps
-* `TrasformsTapesInExactTime`: a TM transforms tapes `tapes` to `tapes'` in exactly `t` steps
-* `TransformsTapesInTime`: a TM transforms tapes `tapes` to `tapes'` in up to `t` steps
-* `TransformsTapes`: a TM transforms tapes `tapes` to `tapes'` in some number of steps
-* `TransformsTapesInTimeAndSpace`: a TM transforms tapes `tapes` to `tapes'` in up to `t` steps
-  and uses at most `s` space
-
-There are multiple ways to talk about the behaviour of a multi-tape Turing machine:
+* `Cfg`: the configuration of a TM, including internal state, the tapes and the output so far
+* `spaceUsed`: the number of work tape cells touched by the head until a certain step
+* `TransitionRelation`: the transition relation from one configuration to the next
+* `ComputesInTimeAndSpace`: a proof that a TM computes an output from an input in a certain number
+    of steps and using a certain number of tape cells
+* `ComputesFunInTimeAndSpace`: a proof that a TM computes a function (on strings) respecting a
+    time and space bound in the input length
+* `DecidesLanguageInTimeAndSpace`: 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
-* `TransformsTapes`: a TM transforms initial tapes `tapes` and halts with tapes `tapes'`
-* `MultiTapeTM.eval`: executes a TM on initial tapes `tapes` and returns the resulting tapes if it
-  eventually halts
-
-## TODOs
-
-* Define sequential composition of multi-tape Turing machines.
-* Define different kinds of tapes (input-only, output-only, oracle, etc) and how they influence
-   how space is counted.
-* Define the notion of a multi-tape Turing machine computing a function.
+* `RelatesInSteps tm.TransitionRelation cfg cfg' t`: a proof that `tm` transforms the configuration
+    `cfg` into `cfg'` in exactly `t` steps
 
 -/
 
@@ -73,9 +68,20 @@ variable {Symbol : Type}
 
 variable {k : ℕ}
 
+/-- The output of the transition function. -/
+structure TransitionOut (k : ℕ) (Symbol State : Type) where
+  /-- The movement (attempt) of the input head. -/
+  inputMove : Option Dir
+  /-- Actions on the work tapes: optionally a symbol to write and the head movement. -/
+  stmts : Fin k → Stmt Symbol
+  /-- An optional symbol to output. -/
+  outS : Option Symbol
+  /-- The successor state or none to halt. -/
+  q' : Option State
+
 /--
-A `k`-tape Turing machine
-over the alphabet of `Option Symbol` (where `none` is the blank `BiTape` symbol).
+A multi-tape Turing machine with `k` work tapes over the alphabet of `Option Symbol` (where `none`
+is the blank `BiTape` symbol).
 -/
 structure MultiTapeTM k Symbol [Inhabited Symbol] [Fintype Symbol] where
   /-- type of state labels -/
@@ -84,9 +90,9 @@ structure MultiTapeTM k Symbol [Inhabited Symbol] [Fintype Symbol] where
   [stateFintype : Fintype State]
   /-- initial state -/
   q₀ : State
-  /-- transition function, mapping a state and a tuple of head symbols to a `Stmt` to invoke
-  for each tape and optionally the new state to transition to afterwards (`none` for halt) -/
-  tr : State → (Fin k → Option Symbol) → ((Fin k → (Stmt Symbol)) × Option State)
+  /-- transition function, mapping a state and a tuple of head symbols to a movement for the
+  input head, actions on the work tape, optionally a symbol to output and the successor state -/
+  tr : State → (Fin (k + 1) → Option Symbol) → TransitionOut k Symbol State
 
 namespace MultiTapeTM
 
@@ -102,43 +108,54 @@ and the intended initial and final configurations.
 
 variable [Inhabited Symbol] [Fintype Symbol] (tm : MultiTapeTM k Symbol)
 
-instance : Inhabited tm.State := ⟨tm.q₀⟩
-
-instance : Fintype tm.State := tm.stateFintype
-
-instance inhabitedStmt : Inhabited (Stmt Symbol) := inferInstance
-
-
 /--
 The configurations of a Turing machine consist of:
-an `Option`al state (or none for the halting state),
-and a `BiTape` representing the tape contents.
+- an `Option`al state (or none for the halting state),
+- `BiTape`s representing the tape contents and
+- the output so far.
 -/
 @[ext]
 structure Cfg : Type where
   /-- the state of the TM (or none for the halting state) -/
   state : Option tm.State
-  /-- the BiTape contents -/
-  tapes : Fin k → BiTape Symbol
+  /-- the tape contents -/
+  tapes : Fin (k + 1) → BiTape Symbol
+  /-- the output so far -/
+  output : List Symbol
 deriving Inhabited
 
+/-- Applies the actions / statements to the tapes.
+The input tape is handled specially: The machine can read one empty cell outside of the input,
+but any attempted movement beyond that results in no movement. -/
+def applyTapeActions
+    (inputMove : Option Dir)
+    (stmts : Fin k → Stmt Symbol)
+    (tapes : Fin (k + 1) → BiTape Symbol) :
+    Fin (k + 1) → BiTape Symbol
+  | ⟨0, _⟩ => match inputMove, tapes ⟨0, by omega⟩ with
+    | none, t => t
+    | some .left, t => if t.left.toList = [] ∧ t.head = none then t else t.move_left
+    | some .right, t => if t.right.toList = [] ∧ t.head = none then t else t.move_right
+  | ⟨i + 1, _⟩ => let s := stmts ⟨i, by omega⟩
+    ((tapes ⟨i + 1, by omega⟩).write s.symbol).optionMove s.movement
+
+/-- The output of the transition function applied to a configuration. -/
+def transitionOutput : tm.Cfg → Option (TransitionOut k Symbol tm.State)
+  | ⟨none, _, _⟩ => none -- halting state
+  | ⟨some q, tapes, _⟩ => some (tm.tr q (fun i => (tapes i).head))
+
 /-- The step function corresponding to a `MultiTapeTM`. -/
-def step : tm.Cfg → Option tm.Cfg
-  | ⟨none, _⟩ =>
-    -- If in the halting state, there is no next configuration
-    none
-  | ⟨some q, tapes⟩ =>
-    -- If in state q, perform look up in the transition function
-    match tm.tr q (fun i => (tapes i).head) with
-    -- and enter a new configuration with state q' (or none for halting)
-    -- and tapes updated according to the Stmt
-    | ⟨stmts, q'⟩ => some ⟨q', fun i =>
-        ((tapes i).write (stmts i).symbol).optionMove (stmts i).movement⟩
+def step (cfg : tm.Cfg) : Option tm.Cfg :=
+  (tm.transitionOutput cfg).map fun {inputMove, stmts, outS, q'} =>
+    let output := match outS with
+      | none => cfg.output
+      | some s => cfg.output ++ [s]
+    ⟨q', applyTapeActions inputMove stmts cfg.tapes, output⟩
 
 /-- Any number of positive steps run from a halting configuration lead to `none`. -/
 @[simp, scoped grind =]
-lemma step_iter_none_eq_none (tapes : Fin k → BiTape Symbol) (n : ℕ) :
-    (Option.bind · tm.step)^[n + 1] (some ⟨none, tapes⟩) = none := by
+lemma step_iter_none_eq_none (tapes : Fin (k + 1) → BiTape Symbol) (out : List Symbol) (n : ℕ) :
+    (Option.bind · tm.step)^[n + 1] (some ⟨none, tapes, out⟩) = none := by
   rw [Function.iterate_succ_apply]
   induction n with
   | zero => rfl
@@ -149,64 +166,124 @@ def firstTape (s : List Symbol) : Fin k → BiTape Symbol
   | ⟨0, _⟩ => BiTape.mk₁ s
   | ⟨_, _⟩ => default
 
-/--
-The initial configuration corresponding to a list in the input alphabet.
-Note that the entries of the tape constructed by `BiTape.mk₁` are all `some` values.
-This is to ensure that distinct lists map to distinct initial configurations.
--/
+/-- The initial configuration corresponding to a list in the input alphabet. -/
 @[simp]
 def initCfg (s : List Symbol) : tm.Cfg :=
-  ⟨some tm.q₀, firstTape s⟩
+  ⟨some tm.q₀, firstTape s, []⟩
 
-/-- Create an initial configuration given a tuple of tapes. -/
-@[simp]
-def initCfgTapes (tapes : Fin k → BiTape Symbol) : tm.Cfg :=
-  ⟨some tm.q₀, tapes⟩
+/-- The sequence of configurations of the Turing machine starting from `cfg`.
+If the Turing machine halts, it will eventually get and stay `none` after reaching the halting
+configuration. -/
+def configs (cfg : tm.Cfg) (t : ℕ) : Option tm.Cfg :=
+  (Option.bind · tm.step)^[t] cfg
+
+end Cfg
+
+section Space
+/-! Now we define space usage and add some helper lemmas. -/
+
+variable [Inhabited Symbol] [Fintype Symbol] (tm : MultiTapeTM k Symbol)
+
+/-- Convert an "optional movement" to an integer where positive is "right". -/
+@[simp, grind]
+def OptionDirToInt : Option Dir → ℤ
+  | some .left => -1
+  | none => 0
+  | some .right => 1
 
-/-- The final configuration corresponding to a list in the output alphabet.
-(We demand that the head halts at the leftmost position of the output.)
+/-- The movements of the work tape heads after configuration `cfg`. -/
+def headMovements (cfg : tm.Cfg) : Fin k → ℤ
+  | i => match tm.transitionOutput cfg with
+      | some tro => OptionDirToInt (tro.stmts ⟨i, by omega⟩).movement
+      | none => 0
+
+/-- The head positions of the work tapes as a function of the number of steps, relative to
+the starting position in `cfg`. -/
+def headPositions (cfg : tm.Cfg) (t : ℕ) : Fin k → ℤ
+  | i => ∑ t' ∈ Finset.range t, (tm.configs cfg t').elim 0 (tm.headMovements · 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`.
 -/
-@[simp]
-def haltCfg (s : List Symbol) : tm.Cfg :=
-  ⟨none, firstTape s⟩
+def spaceUsedByTape (cfg : tm.Cfg) (t : ℕ) (i : Fin k) : ℕ :=
+  let positions := (Finset.range (t + 1)).image (fun t' => tm.headPositions cfg t' i)
+  have ne := Finset.image_nonempty.mpr ⟨0, by simp⟩
+  (positions.max' ne - positions.min' ne).toNat + 1
 
-/-- The final configuration of a Turing machine given a tuple of tapes. -/
-@[simp]
-def haltCfgTapes (tapes : Fin k → BiTape Symbol) : tm.Cfg :=
-  ⟨none, tapes⟩
+/--
+The number of work tape cells touched by a computation starting from configuration
+`cfg` up to step `t`.
+-/
+def spaceUsed (cfg : tm.Cfg) (t : ℕ) : ℕ := ∑ i, tm.spaceUsedByTape cfg t i
 
-/-- The sequence of configurations of the Turing machine starting with initial state and
-given tapes at step `t`.
-If the Turing machine halts, it will eventually get and stay `none` after reaching the halting
-configuration. -/
-def configs (tapes : Fin k → BiTape Symbol) (t : ℕ) : Option tm.Cfg :=
-  (Option.bind · tm.step)^[t] (tm.initCfgTapes tapes)
+/-- A zero-tape Turing machine uses zero space. -/
+@[simp]
+lemma spaceUsed_zero_tapes_eq_zero (cfg : tm.Cfg) (t : ℕ) (h_zero : k = 0) :
+    tm.spaceUsed cfg t = 0 := by
+  unfold spaceUsed
+  subst h_zero
+  simp
+
+@[scoped grind .]
+lemma OptionDirToInt_bound (d : Option Dir) :
+    -1 ≤ OptionDirToInt d ∧ OptionDirToInt d ≤ 1 := by
+  rcases d with _ | d
+  · decide
+  · rcases d <;> decide
+
+/-- A single step moves each work tape head by at most one cell. -/
+lemma step_head_movement_bound (cfg : tm.Cfg) (t : ℕ) (i : Fin k) :
+    -1 ≤ (tm.configs cfg t).elim 0 (tm.headMovements · i)
+      ∧ (tm.configs cfg t).elim 0 (tm.headMovements · i) ≤ 1 := by
+  unfold headMovements
+  dsimp
+  rcases h : tm.configs cfg t <;>
+  grind
+
+/-- The head position changes by the corresponding head movement on each step. -/
+lemma headPositions_succ (cfg : tm.Cfg) (t : ℕ) (i : Fin k) :
+    tm.headPositions cfg (t + 1) i
+      = tm.headPositions cfg t i + (tm.configs cfg t).elim 0 (tm.headMovements · i) := by
+  simp only [headPositions, Finset.sum_range_succ]
 
 /--
-The space used by a configuration is the sum of the space used by its tapes.
+Inserting one new point `a`, adjacent to an existing point `q` of `s`, widens the spanned
+interval `max' - min'` by at most one cell.
 -/
-def Cfg.space_used (cfg : tm.Cfg) : ℕ := ∑ i, (cfg.tapes i).space_used
+lemma span_insert_le {s S : Finset ℤ} (hs : s.Nonempty) (hS : S.Nonempty)
+    {a q : ℤ} (hSeq : S = insert a s) (hq : q ∈ s) (h1 : a ≤ q + 1) (h2 : q ≤ a + 1) :
+    (S.max' hS - S.min' hS).toNat ≤ (s.max' hs - s.min' hs).toNat + 1 := by
+  subst hSeq
+  rw [Finset.max'_insert _ _ hs, Finset.min'_insert _ _ hs]
+  have hm := Finset.min'_le _ _ hq
+  have hM := Finset.le_max' _ _ hq
+  grind
+
+/-- The number of cells touched by a single work tape grows by at most one each step. -/
+lemma spaceUsedByTape_succ_le (cfg : tm.Cfg) (t : ℕ) (i : Fin k) :
+    tm.spaceUsedByTape cfg (t + 1) i ≤ tm.spaceUsedByTape cfg t i + 1 := by
+  unfold spaceUsedByTape
+  have hs := tm.headPositions_succ cfg t i
+  have step_bound := tm.step_head_movement_bound cfg t i
+  apply Nat.add_le_add_right
+  refine span_insert_le _ _
+    (by rw [Finset.range_add_one, Finset.image_insert])
+    (by exact Finset.mem_image_of_mem _ (Finset.mem_range.mpr (Nat.lt_succ_self t)))
+    (by grind)
+    (by grind)
 
 /--
 The space used by a configuration grows by at most `k` each step.
 -/
-lemma Cfg.space_used_step (cfg cfg' : tm.Cfg)
-    (hstep : tm.step cfg = some cfg') : cfg'.space_used ≤ cfg.space_used + k := by
-  obtain ⟨_ | q, tapes⟩ := cfg
-  · simp [step] at hstep
-  · simp only [step] at hstep
-    generalize h_tr : tm.tr q (fun i => (tapes i).head) = result at hstep
-    obtain ⟨stmts, q''⟩ := result
-    injection hstep with hstep
-    subst hstep
-    simp only [space_used]
-    trans ∑ i : Fin k, ((tapes i).space_used + 1)
-    · refine Finset.sum_le_sum fun i _ => ?_
-      unfold BiTape.optionMove
-      grind [BiTape.space_used_write, BiTape.space_used_move]
-    · simp [Finset.sum_add_distrib]
+lemma spaceUsed_linear (cfg : tm.Cfg) (t : ℕ) :
+    tm.spaceUsed cfg (t + 1) ≤ tm.spaceUsed cfg t + k := by
+  calc tm.spaceUsed cfg (t + 1)
+      ≤ ∑ i, (tm.spaceUsedByTape cfg t i + 1) :=
+        Finset.sum_le_sum fun i _ => tm.spaceUsedByTape_succ_le cfg t i
+    _ = (∑ i, tm.spaceUsedByTape cfg t i) + k := by simp [Finset.sum_add_distrib]
 
-end Cfg
+end Space
 
 open Cfg
 
@@ -221,44 +298,38 @@ which maps a configuration to its next configuration, if it exists.
 def TransitionRelation (tm : MultiTapeTM k Symbol) (c₁ c₂ : tm.Cfg) : Prop :=
   tm.step c₁ = some c₂
 
-/-- A proof that the Turing machine `tm` transforms tapes `tapes` to `tapes'` in exactly
-`t` steps. -/
-def TransformsTapesInExactTime
-    (tm : MultiTapeTM k Symbol)
-    (tapes tapes' : Fin k → BiTape Symbol)
-    (t : ℕ) : Prop :=
-  RelatesInSteps tm.TransitionRelation (tm.initCfgTapes tapes) (tm.haltCfgTapes tapes') t
-
-/-- A proof that the Turing machine `tm` transforms tapes `tapes` to `tapes'` in up to
-`t` steps. -/
-def TransformsTapesInTime
-    (tm : MultiTapeTM k Symbol)
-    (tapes tapes' : Fin k → BiTape Symbol)
-    (t : ℕ) : Prop :=
-  RelatesWithinSteps tm.TransitionRelation (tm.initCfgTapes tapes) (tm.haltCfgTapes tapes') t
-
-/-- The Turing machine `tm` transforms tapes `tapes` to `tapes'`. -/
-def TransformsTapes (tm : MultiTapeTM k Symbol) (tapes tapes' : Fin k → BiTape Symbol) : Prop :=
-  ∃ t, tm.TransformsTapesInExactTime tapes tapes' t
-
-/-- A proof that the Turing machine `tm` uses at most space `s` when run for up to `t` steps
-on initial tapes `tapes`. -/
-def UsesSpaceUntilStep
-    (tm : MultiTapeTM k Symbol)
-    (tapes : Fin k → BiTape Symbol)
-    (s t : ℕ) : Prop :=
-  ∀ t' ≤ t, match tm.configs tapes t' with
-    | none => true
-    | some cfg => cfg.space_used ≤ s
-
-/-- A proof that the Turing machine `tm` transforms tapes `tapes` to `tapes'` in exactly `t` steps
+/-- A proof that the Turing machine `tm` on input `input` outputs `output` in exactly `t` steps
 and uses at most `s` space. -/
-def TransformsTapesInTimeAndSpace
+def ComputesInTimeAndSpace
     (tm : MultiTapeTM k Symbol)
-    (tapes tapes' : Fin k → BiTape Symbol)
+    (input output : List Symbol)
     (t s : ℕ) : Prop :=
-  tm.TransformsTapesInExactTime tapes tapes' t ∧
-    tm.UsesSpaceUntilStep tapes s t
+  ∃ cfg,
+  cfg.state = none ∧
+  cfg.output = output ∧
+  RelatesInSteps tm.TransitionRelation (tm.initCfg input) cfg t ∧
+  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. -/
+def ComputesFunInTimeAndSpace
+    (tm : MultiTapeTM k Symbol)
+    (f : List Symbol → List Symbol)
+    (t s : ℕ → ℕ) : Prop :=
+  ∀ input, ∃ t' ≤ t input.length, ∃ s' ≤ s input.length,
+  ComputesInTimeAndSpace tm input (f input) t' s'
+
+open Classical in
+/-- The indicator function of a language. -/
+noncomputable def indicator (l : Language Symbol) : List Symbol → List Symbol
+  | x => if x ∈ l then [default] else []
+
+/-- A proof that a Turing machine `tm` decides a language `l` with time and space bounds. -/
+def DecidesLanguageInTimeAndSpace
+    (tm : MultiTapeTM k Symbol)
+    (L : Language Symbol)
+    (t s : ℕ → ℕ) : Prop :=
+  ComputesFunInTimeAndSpace tm (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. -/
@@ -282,19 +353,19 @@ lemma relatesInSteps_iff_step_iter_eq_some
         use cfg'
         grind
 
-/-- The Turing machine `tm` halts after exactly `t` steps on initial tapes `tapes`. -/
-def haltsAtStep (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) (t : ℕ) : Bool :=
-  match (tm.configs tapes t) with
-  | some ⟨none, _⟩ => true
+/-- The Turing machine `tm` halts after exactly `t` steps on input `input`. -/
+def haltsAtStep (tm : MultiTapeTM k Symbol) (input : List Symbol) (t : ℕ) : Bool :=
+  match (tm.configs (tm.initCfg input) t) with
+  | some ⟨none, _, _⟩ => true
   | _ => false
 
 /-- If a Turing machine halts, the time step is uniquely determined. -/
 lemma halting_step_unique
     {tm : MultiTapeTM k Symbol}
-    {tapes : Fin k → BiTape Symbol}
+    {input : List Symbol}
     {t₁ t₂ : ℕ}
-    (h_halts₁ : tm.haltsAtStep tapes t₁)
-    (h_halts₂ : tm.haltsAtStep tapes 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
@@ -302,46 +373,17 @@ lemma halting_step_unique
   cases d with
   | zero => rfl
   | succ d =>
-    -- this is a contradiction.
     unfold haltsAtStep configs at h_halts₁ h_halts₂
-    split at h_halts₁ <;> try contradiction
-    next tapes' h_iter_t₁ =>
-      rw [Nat.add_comm t₁ (d + 1), Function.iterate_add_apply, h_iter_t₁,
-          step_iter_none_eq_none (tm := tm) tapes' d] at h_halts₂
-      simp at h_halts₂
+    rw [Nat.add_comm t₁ (d + 1), Function.iterate_add_apply] at h_halts₂
+    grind
 
 /-- At the halting step, the configuration sequence of a Turing machine is still `some`. -/
 lemma configs_isSome_of_haltsAtStep
-    {tm : MultiTapeTM k Symbol} {tapes : Fin k → BiTape Symbol} {t : ℕ}
-    (h_halts : tm.haltsAtStep tapes t) :
-    (tm.configs tapes t).isSome := by
+    {tm : MultiTapeTM k Symbol} {input : List Symbol} {t : ℕ}
+    (h_halts : tm.haltsAtStep input t) :
+    (tm.configs (tm.initCfg input) t).isSome := by
   grind [haltsAtStep]
 
-/-- Execute the Turing machine `tm` on initial tapes `tapes` and return the resulting tapes
-if it eventually halts. -/
-def eval (tm : MultiTapeTM k Symbol) (tapes : Fin k → BiTape Symbol) :
-    Part (Fin k → BiTape Symbol) :=
-  ⟨∃ t, tm.haltsAtStep tapes t,
-    fun h => ((tm.configs tapes (Nat.find h)).get
-      (configs_isSome_of_haltsAtStep (Nat.find_spec h))).tapes⟩
-
-/-- Evaluating a Turing machine on a tuple of tapes `tapes` has a value `tapes'` if and only if
-it transforms `tapes` into `tapes'`. -/
-@[scoped grind =]
-lemma eval_eq_some_iff_transformsTapes
-    {tm : MultiTapeTM k Symbol}
-    {tapes tapes' : Fin k → BiTape Symbol} :
-    tm.eval tapes = .some tapes' ↔ tm.TransformsTapes tapes tapes' := by
-  simp only [eval, Part.eq_some_iff, Part.mem_mk_iff]
-  constructor
-  · intro ⟨h_dom, h_get⟩
-    use Nat.find h_dom
-    grind [TransformsTapesInExactTime, configs, haltCfgTapes, haltsAtStep]
-  · intro ⟨t, h_iter⟩
-    rw [TransformsTapesInExactTime, relatesInSteps_iff_step_iter_eq_some, ← configs] at h_iter
-    have h_halts_at_t : tm.haltsAtStep tapes t := by grind [haltsAtStep]
-    have : ∃ t, tm.haltsAtStep tapes t := ⟨t, h_halts_at_t⟩
-    grind [haltCfgTapes, halting_step_unique]
 
 end MultiTapeTM
 

From 3ac3ac872da42fa2b2f45f672c7fdc49270852bd Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Tue, 2 Jun 2026 18:06:03 +0200
Subject: [PATCH 45/53] Clean up imports.

---
 Cslib/Computability/Machines/MultiTapeTuring/Basic.lean | 2 --
 1 file changed, 2 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index 5aed397c69..6147be7269 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -6,8 +6,6 @@ Authors: Christian Reitwiessner
 
 module
 
-public import Mathlib.Data.Part
-public import Mathlib.Data.Fintype.Defs
 public import Mathlib.Data.Finset.Max
 public import Mathlib.Algebra.Order.BigOperators.Group.Finset
 public import Mathlib.Computability.Language

From b5689a11b478d952501d7e69c42e0514c6c9f775 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Tue, 2 Jun 2026 18:09:34 +0200
Subject: [PATCH 46/53] more cleanup

---
 Cslib/Computability/Machines/MultiTapeTuring/Basic.lean | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index 6147be7269..4c5bb9d500 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -249,7 +249,7 @@ lemma headPositions_succ (cfg : tm.Cfg) (t : ℕ) (i : Fin k) :
 Inserting one new point `a`, adjacent to an existing point `q` of `s`, widens the spanned
 interval `max' - min'` by at most one cell.
 -/
-lemma span_insert_le {s S : Finset ℤ} (hs : s.Nonempty) (hS : S.Nonempty)
+private lemma span_insert_le {s S : Finset ℤ} (hs : s.Nonempty) (hS : S.Nonempty)
     {a q : ℤ} (hSeq : S = insert a s) (hq : q ∈ s) (h1 : a ≤ q + 1) (h2 : q ≤ a + 1) :
     (S.max' hS - S.min' hS).toNat ≤ (s.max' hs - s.min' hs).toNat + 1 := by
   subst hSeq
@@ -319,8 +319,8 @@ def ComputesFunInTimeAndSpace
 
 open Classical in
 /-- The indicator function of a language. -/
-noncomputable def indicator (l : Language Symbol) : List Symbol → List Symbol
-  | x => if x ∈ l then [default] else []
+noncomputable def indicator (L : Language Symbol) : List Symbol → List Symbol
+  | x => if x ∈ L then [default] else []
 
 /-- A proof that a Turing machine `tm` decides a language `l` with time and space bounds. -/
 def DecidesLanguageInTimeAndSpace

From c684b79558d8d831b3a3a33f5d86d90a8821190f Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Thu, 4 Jun 2026 12:22:13 +0200
Subject: [PATCH 47/53] copy semantics.

---
 .../Machines/MultiTapeTuring/Basic.lean       | 105 +++++++++++-------
 Cslib/Foundations/Data/BiTape.lean            |  43 ++++++-
 2 files changed, 107 insertions(+), 41 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index 4c5bb9d500..aa53df046d 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -88,9 +88,10 @@ structure MultiTapeTM k Symbol [Inhabited Symbol] [Fintype Symbol] where
   [stateFintype : Fintype State]
   /-- initial state -/
   q₀ : State
-  /-- transition function, mapping a state and a tuple of head symbols to a movement for the
-  input head, actions on the work tape, optionally a symbol to output and the successor state -/
-  tr : State → (Fin (k + 1) → Option Symbol) → TransitionOut k Symbol State
+  /-- transition function, mapping a state, the current input symbol and a tuple of head symbols
+  to a movement for the input head, actions on the work tape, optionally a symbol to output and
+  the successor state -/
+  tr : State → (Option Symbol) → (Fin k → Option Symbol) → TransitionOut k Symbol State
 
 namespace MultiTapeTM
 
@@ -116,58 +117,73 @@ The configurations of a Turing machine consist of:
 structure Cfg : Type where
   /-- the state of the TM (or none for the halting state) -/
   state : Option tm.State
-  /-- the tape contents -/
-  tapes : Fin (k + 1) → BiTape Symbol
+  /-- the input -/
+  input : List Symbol
+  /-- the position of the input head, shifted by one -/
+  inputPos : Fin (input.length + 2)
+  /-- the work tape -/
+  workTapes : Fin k → BiTape Symbol
   /-- the output so far -/
   output : List Symbol
 deriving Inhabited
 
-/-- Applies the actions / statements to the tapes.
-The input tape is handled specially: The machine can read one empty cell outside of the input,
-but any attempted movement beyond that results in no movement. -/
-def applyTapeActions
-    (inputMove : Option Dir)
-    (stmts : Fin k → Stmt Symbol)
-    (tapes : Fin (k + 1) → BiTape Symbol) :
-    Fin (k + 1) → BiTape Symbol
-  | ⟨0, _⟩ => match inputMove, tapes ⟨0, by omega⟩ with
-    | none, t => t
-    | some .left, t => if t.left.toList = [] ∧ t.head = none then t else t.move_left
-    | some .right, t => if t.right.toList = [] ∧ t.head = none then t else t.move_right
-  | ⟨i + 1, _⟩ => let s := stmts ⟨i, by omega⟩
-    ((tapes ⟨i + 1, by omega⟩).write s.symbol).optionMove s.movement
-
-/-- The output of the transition function applied to a configuration. -/
-def transitionOutput : tm.Cfg → Option (TransitionOut k Symbol tm.State)
-  | ⟨none, _, _⟩ => none -- halting state
-  | ⟨some q, tapes, _⟩ => some (tm.tr q (fun i => (tapes i).head))
+/-- 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. -/
+@[scoped grind =]
+def moveInputPos {n : ℕ} (pos : Fin (n + 2)) (m : Option Dir) : Fin (n + 2) :=
+  let p := (pos + optionDirToInt m).toNat
+  if h : p < n + 2 then ⟨p, h⟩ else ⟨n + 1, by omega⟩
+
+/-- The output of the transition function applied to a state and the set of topes. -/
+def transitionOutput (q : tm.State) (inputSymbol : Option Symbol) (work : Fin k → BiTape Symbol) :
+    TransitionOut k Symbol tm.State :=
+  tm.tr q inputSymbol (fun i => (work i).head)
+
+/-- The symbol currently under the input tape head. -/
+@[scoped grind =]
+def inputSymbol (cfg : tm.Cfg) : Option Symbol :=
+  if h₁ : cfg.inputPos = 0 then none
+  else if h₂ : cfg.inputPos = cfg.input.length + 1 then none
+  else cfg.input[cfg.inputPos.val - 1]'(by grind)
+
+@[simp]
+lemma inputSymbolInner {cfg : tm.Cfg} (p : ℕ)
+    (h₁ : cfg.inputPos.val = 1 + p)
+    (h₂ : p < cfg.input.length) :
+    tm.inputSymbol cfg = some cfg.input[p] := by
+  simp [inputSymbol, h₁]
+  grind
 
 /-- The step function corresponding to a `MultiTapeTM`. -/
 def step (cfg : tm.Cfg) : Option tm.Cfg :=
-  (tm.transitionOutput cfg).map fun {inputMove, stmts, outS, q'} =>
-    let output := match outS with
+  match cfg.state with
+  | none => none
+  | some q =>
+    let {inputMove, stmts, outS, q'} := tm.transitionOutput q (tm.inputSymbol cfg) cfg.workTapes
+    some {
+      state := q',
+      input := cfg.input,
+      inputPos := moveInputPos cfg.inputPos inputMove,
+      workTapes i := cfg.workTapes i |>.write (stmts i).symbol |>.optionMove (stmts i).movement
+      output := match outS with
       | none => cfg.output
       | some s => cfg.output ++ [s]
-    ⟨q', applyTapeActions inputMove stmts cfg.tapes, output⟩
+    }
 
 /-- Any number of positive steps run from a halting configuration lead to `none`. -/
 @[simp, scoped grind =]
-lemma step_iter_none_eq_none (tapes : Fin (k + 1) → BiTape Symbol) (out : List Symbol) (n : ℕ) :
-    (Option.bind · tm.step)^[n + 1] (some ⟨none, tapes, out⟩) = none := by
+lemma step_iter_none_eq_none (cfg : tm.Cfg) (n : ℕ) (h_halt : cfg.state = none) :
+    (Option.bind · tm.step)^[n + 1] (some cfg) = none := by
   rw [Function.iterate_succ_apply]
   induction n with
-  | zero => rfl
+  | zero => simp [step, h_halt]
   | succ n ih => grind [Function.iterate_succ_apply']
 
-/-- A collection of tapes where the first tape contains `s` -/
-def firstTape (s : List Symbol) : Fin k → BiTape Symbol
-  | ⟨0, _⟩ => BiTape.mk₁ s
-  | ⟨_, _⟩ => default
-
 /-- The initial configuration corresponding to a list in the input alphabet. -/
 @[simp]
 def initCfg (s : List Symbol) : tm.Cfg :=
-  ⟨some tm.q₀, firstTape s, []⟩
+  ⟨some tm.q₀, s, 1, default, []⟩
 
 /-- The sequence of configurations of the Turing machine starting from `cfg`.
 If the Turing machine halts, it will eventually get and stay `none` after reaching the halting
@@ -175,6 +191,14 @@ configuration. -/
 def configs (cfg : tm.Cfg) (t : ℕ) : Option tm.Cfg :=
   (Option.bind · tm.step)^[t] cfg
 
+lemma configs_succ' (cfg : tm.Cfg) (t : ℕ) :
+    tm.configs cfg (t + 1) = (Option.bind · tm.step) (tm.configs cfg t) := by
+  simp [configs, Function.iterate_succ_apply']
+
+lemma configs_succ (cfg : tm.Cfg) (t : ℕ) :
+    tm.configs cfg (t + 1) = tm.configs cfg t >>= tm.step := by
+  simp [configs, Function.iterate_succ_apply']
+
 end Cfg
 
 section Space
@@ -191,9 +215,10 @@ def OptionDirToInt : Option Dir → ℤ
 
 /-- The movements of the work tape heads after configuration `cfg`. -/
 def headMovements (cfg : tm.Cfg) : Fin k → ℤ
-  | i => match tm.transitionOutput cfg with
-      | some tro => OptionDirToInt (tro.stmts ⟨i, by omega⟩).movement
-      | none => 0
+  | i => match cfg.state with
+    | none => 0
+    | some q => OptionDirToInt
+      (tm.transitionOutput q (tm.inputSymbol cfg) cfg.workTapes |>.stmts i |>.movement)
 
 /-- The head positions of the work tapes as a function of the number of steps, relative to
 the starting position in `cfg`. -/
@@ -354,7 +379,7 @@ lemma relatesInSteps_iff_step_iter_eq_some
 /-- The Turing machine `tm` halts after exactly `t` steps on input `input`. -/
 def haltsAtStep (tm : MultiTapeTM k Symbol) (input : List Symbol) (t : ℕ) : Bool :=
   match (tm.configs (tm.initCfg input) t) with
-  | some ⟨none, _, _⟩ => true
+  | some ⟨none, _, _, _, _⟩ => true
   | _ => false
 
 /-- If a Turing machine halts, the time step is uniquely determined. -/
diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean
index c64b61cb43..076d675005 100644
--- a/Cslib/Foundations/Data/BiTape.lean
+++ b/Cslib/Foundations/Data/BiTape.lean
@@ -78,6 +78,9 @@ def mk₁ (l : List Symbol) : BiTape Symbol :=
   | [] => ∅
   | h :: t => { head := some h, left := ∅, right := StackTape.map_some t }
 
+@[simp, scoped grind =]
+lemma mk₁_nil : mk₁ ([] : List Symbol) = nil := rfl
+
 open scoped Int in
 /-- Returns the tape symbol at positon `p` relative to the head, where
 positive numbers are right of the head and negative are left of the head. -/
@@ -101,24 +104,41 @@ lemma ext_get (t₁ t₂ : BiTape Symbol) (h_get_eq : ∀ p, t₁.get p = t₂.g
     intro p
     simpa [get] using h_get_eq (p + 1)
 
+/-- Simplification lemma that explains the contents of each of the cells after tape
+construction using mk₁. -/
+@[simp, scoped grind =]
+lemma get_mk₁ (l : List Symbol) (p : ℤ) :
+  (mk₁ l).get p = if p < 0 then none else l[p.toNat]? := by
+  match p with
+  | Int.ofNat 0 => cases l <;> simp [mk₁, get, nil]
+  | Int.ofNat (n + 1) =>
+    cases l with
+    | nil => simp [mk₁, get, nil]
+    | cons h t =>
+      simp only [mk₁, get, StackTape.map_some]
+      grind
+  | Int.negSucc n => cases l <;> simp [mk₁, get, nil]
 
 section Move
 
 /--
 Move the head left by shifting the left StackTape under the head.
 -/
+@[scoped grind =]
 def move_left (t : BiTape Symbol) : BiTape Symbol :=
   ⟨t.left.head, t.left.tail, StackTape.cons t.head t.right⟩
 
 /--
 Move the head right by shifting the right StackTape under the head.
 -/
+@[scoped grind =]
 def move_right (t : BiTape Symbol) : BiTape Symbol :=
   ⟨t.right.head, StackTape.cons t.head t.left, t.right.tail⟩
 
 /--
 Move the head to the left or right, shifting the tape underneath it.
 -/
+@[scoped grind =]
 def move (t : BiTape Symbol) : Dir → BiTape Symbol
   | .left => t.move_left
   | .right => t.move_right
@@ -126,6 +146,7 @@ def move (t : BiTape Symbol) : Dir → BiTape Symbol
 /--
 Optionally perform a `move`, or do nothing if `none`.
 -/
+@[simp, scoped grind =]
 def optionMove : BiTape Symbol → Option Dir → BiTape Symbol
   | t, none => t
   | t, some d => t.move d
@@ -140,7 +161,7 @@ lemma move_right_move_left (t : BiTape Symbol) : t.move_right.move_left = t := b
 
 /-- Translate an optional direction into a head movement offset, where the positive
 direction is to the right. -/
-@[scoped grind]
+@[scoped grind =]
 def optionDirToInt (d : Option Dir) : ℤ :=
   match d with
   | none => 0
@@ -194,6 +215,26 @@ lemma get_move_left_iterate (t : BiTape Symbol) (n : ℕ) (p : ℤ) :
     have : p - n - 1 = p - (n + 1) := by lia
     simp [Function.iterate_succ_apply, ih, this]
 
+/-- Move the tape head by an integer amount where positive numbers move the head to the right and
+negative to the left. -/
+def moveInt (t : BiTape Symbol) (Δ : ℤ) : BiTape Symbol :=
+  if Δ ≥ 0 then
+    .move_right^[Δ.toNat] t
+  else
+    .move_left^[(-Δ).toNat] t
+
+/-- Simplification lemma that connects `moveInt` and the function view via `get`. -/
+@[simp, scoped grind =]
+lemma get_moveInt (t : BiTape Symbol) (Δ p : ℤ) :
+  (moveInt t Δ).get p = t.get (p + Δ) := by
+  grind [moveInt]
+
+@[simp, scoped grind =]
+lemma moveInt_head (t : BiTape Symbol) (Δ : ℤ) :
+  (moveInt t Δ).head = t.get Δ := by
+  rw [show (moveInt t Δ).head = (moveInt t Δ).get 0 from rfl]
+  grind [moveInt]
+
 end Move
 
 /--

From ea151562d7716c9d26bd44402cef08648e01497f Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Thu, 4 Jun 2026 16:33:44 +0200
Subject: [PATCH 48/53] more sim

---
 Cslib/Foundations/Data/BiTape.lean | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean
index 076d675005..d1038d49d3 100644
--- a/Cslib/Foundations/Data/BiTape.lean
+++ b/Cslib/Foundations/Data/BiTape.lean
@@ -56,6 +56,8 @@ namespace BiTape
 
 variable {Symbol : Type}
 
+-- TODO remove this definition, just use `default`.
+
 /-- The empty `BiTape` -/
 def nil : BiTape Symbol := ⟨none, ∅, ∅⟩
 
@@ -68,6 +70,9 @@ instance : EmptyCollection (BiTape Symbol) :=
 @[simp]
 lemma empty_eq_nil : (∅ : BiTape Symbol) = nil := rfl
 
+@[simp]
+lemma nil_eq_default : (default : BiTape Symbol) = nil := rfl
+
 /--
 Given a `List` of `Symbol`s, construct a `BiTape` by mapping the list to `some` elements
 and laying them out to the right side,
@@ -199,6 +204,11 @@ lemma get_optionMove (t : BiTape Symbol) (d : Option Dir) (p : ℤ) :
   unfold optionMove optionDirToInt
   grind [move]
 
+@[simp, scoped grind =]
+lemma get_move (t : BiTape Symbol) (d : Dir) (p : ℤ) :
+    (t.move d).get p = t.get (p + optionDirToInt (some d)) := by
+  cases d <;> grind
+
 @[simp, scoped grind =]
 lemma get_move_right_iterate (t : BiTape Symbol) (n : ℕ) (p : ℤ) :
     (move_right^[n] t).get p = t.get (p + n):= by

From 3d406b75e131e3e010056ad847f9b8f380f43cdd Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Thu, 4 Jun 2026 16:37:36 +0200
Subject: [PATCH 49/53] Do not use BiTape for input.

---
 .../Machines/MultiTapeTuring/Basic.lean       | 105 +++++++++++-------
 1 file changed, 65 insertions(+), 40 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index 4c5bb9d500..aa53df046d 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -88,9 +88,10 @@ structure MultiTapeTM k Symbol [Inhabited Symbol] [Fintype Symbol] where
   [stateFintype : Fintype State]
   /-- initial state -/
   q₀ : State
-  /-- transition function, mapping a state and a tuple of head symbols to a movement for the
-  input head, actions on the work tape, optionally a symbol to output and the successor state -/
-  tr : State → (Fin (k + 1) → Option Symbol) → TransitionOut k Symbol State
+  /-- transition function, mapping a state, the current input symbol and a tuple of head symbols
+  to a movement for the input head, actions on the work tape, optionally a symbol to output and
+  the successor state -/
+  tr : State → (Option Symbol) → (Fin k → Option Symbol) → TransitionOut k Symbol State
 
 namespace MultiTapeTM
 
@@ -116,58 +117,73 @@ The configurations of a Turing machine consist of:
 structure Cfg : Type where
   /-- the state of the TM (or none for the halting state) -/
   state : Option tm.State
-  /-- the tape contents -/
-  tapes : Fin (k + 1) → BiTape Symbol
+  /-- the input -/
+  input : List Symbol
+  /-- the position of the input head, shifted by one -/
+  inputPos : Fin (input.length + 2)
+  /-- the work tape -/
+  workTapes : Fin k → BiTape Symbol
   /-- the output so far -/
   output : List Symbol
 deriving Inhabited
 
-/-- Applies the actions / statements to the tapes.
-The input tape is handled specially: The machine can read one empty cell outside of the input,
-but any attempted movement beyond that results in no movement. -/
-def applyTapeActions
-    (inputMove : Option Dir)
-    (stmts : Fin k → Stmt Symbol)
-    (tapes : Fin (k + 1) → BiTape Symbol) :
-    Fin (k + 1) → BiTape Symbol
-  | ⟨0, _⟩ => match inputMove, tapes ⟨0, by omega⟩ with
-    | none, t => t
-    | some .left, t => if t.left.toList = [] ∧ t.head = none then t else t.move_left
-    | some .right, t => if t.right.toList = [] ∧ t.head = none then t else t.move_right
-  | ⟨i + 1, _⟩ => let s := stmts ⟨i, by omega⟩
-    ((tapes ⟨i + 1, by omega⟩).write s.symbol).optionMove s.movement
-
-/-- The output of the transition function applied to a configuration. -/
-def transitionOutput : tm.Cfg → Option (TransitionOut k Symbol tm.State)
-  | ⟨none, _, _⟩ => none -- halting state
-  | ⟨some q, tapes, _⟩ => some (tm.tr q (fun i => (tapes i).head))
+/-- 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. -/
+@[scoped grind =]
+def moveInputPos {n : ℕ} (pos : Fin (n + 2)) (m : Option Dir) : Fin (n + 2) :=
+  let p := (pos + optionDirToInt m).toNat
+  if h : p < n + 2 then ⟨p, h⟩ else ⟨n + 1, by omega⟩
+
+/-- The output of the transition function applied to a state and the set of topes. -/
+def transitionOutput (q : tm.State) (inputSymbol : Option Symbol) (work : Fin k → BiTape Symbol) :
+    TransitionOut k Symbol tm.State :=
+  tm.tr q inputSymbol (fun i => (work i).head)
+
+/-- The symbol currently under the input tape head. -/
+@[scoped grind =]
+def inputSymbol (cfg : tm.Cfg) : Option Symbol :=
+  if h₁ : cfg.inputPos = 0 then none
+  else if h₂ : cfg.inputPos = cfg.input.length + 1 then none
+  else cfg.input[cfg.inputPos.val - 1]'(by grind)
+
+@[simp]
+lemma inputSymbolInner {cfg : tm.Cfg} (p : ℕ)
+    (h₁ : cfg.inputPos.val = 1 + p)
+    (h₂ : p < cfg.input.length) :
+    tm.inputSymbol cfg = some cfg.input[p] := by
+  simp [inputSymbol, h₁]
+  grind
 
 /-- The step function corresponding to a `MultiTapeTM`. -/
 def step (cfg : tm.Cfg) : Option tm.Cfg :=
-  (tm.transitionOutput cfg).map fun {inputMove, stmts, outS, q'} =>
-    let output := match outS with
+  match cfg.state with
+  | none => none
+  | some q =>
+    let {inputMove, stmts, outS, q'} := tm.transitionOutput q (tm.inputSymbol cfg) cfg.workTapes
+    some {
+      state := q',
+      input := cfg.input,
+      inputPos := moveInputPos cfg.inputPos inputMove,
+      workTapes i := cfg.workTapes i |>.write (stmts i).symbol |>.optionMove (stmts i).movement
+      output := match outS with
       | none => cfg.output
       | some s => cfg.output ++ [s]
-    ⟨q', applyTapeActions inputMove stmts cfg.tapes, output⟩
+    }
 
 /-- Any number of positive steps run from a halting configuration lead to `none`. -/
 @[simp, scoped grind =]
-lemma step_iter_none_eq_none (tapes : Fin (k + 1) → BiTape Symbol) (out : List Symbol) (n : ℕ) :
-    (Option.bind · tm.step)^[n + 1] (some ⟨none, tapes, out⟩) = none := by
+lemma step_iter_none_eq_none (cfg : tm.Cfg) (n : ℕ) (h_halt : cfg.state = none) :
+    (Option.bind · tm.step)^[n + 1] (some cfg) = none := by
   rw [Function.iterate_succ_apply]
   induction n with
-  | zero => rfl
+  | zero => simp [step, h_halt]
   | succ n ih => grind [Function.iterate_succ_apply']
 
-/-- A collection of tapes where the first tape contains `s` -/
-def firstTape (s : List Symbol) : Fin k → BiTape Symbol
-  | ⟨0, _⟩ => BiTape.mk₁ s
-  | ⟨_, _⟩ => default
-
 /-- The initial configuration corresponding to a list in the input alphabet. -/
 @[simp]
 def initCfg (s : List Symbol) : tm.Cfg :=
-  ⟨some tm.q₀, firstTape s, []⟩
+  ⟨some tm.q₀, s, 1, default, []⟩
 
 /-- The sequence of configurations of the Turing machine starting from `cfg`.
 If the Turing machine halts, it will eventually get and stay `none` after reaching the halting
@@ -175,6 +191,14 @@ configuration. -/
 def configs (cfg : tm.Cfg) (t : ℕ) : Option tm.Cfg :=
   (Option.bind · tm.step)^[t] cfg
 
+lemma configs_succ' (cfg : tm.Cfg) (t : ℕ) :
+    tm.configs cfg (t + 1) = (Option.bind · tm.step) (tm.configs cfg t) := by
+  simp [configs, Function.iterate_succ_apply']
+
+lemma configs_succ (cfg : tm.Cfg) (t : ℕ) :
+    tm.configs cfg (t + 1) = tm.configs cfg t >>= tm.step := by
+  simp [configs, Function.iterate_succ_apply']
+
 end Cfg
 
 section Space
@@ -191,9 +215,10 @@ def OptionDirToInt : Option Dir → ℤ
 
 /-- The movements of the work tape heads after configuration `cfg`. -/
 def headMovements (cfg : tm.Cfg) : Fin k → ℤ
-  | i => match tm.transitionOutput cfg with
-      | some tro => OptionDirToInt (tro.stmts ⟨i, by omega⟩).movement
-      | none => 0
+  | i => match cfg.state with
+    | none => 0
+    | some q => OptionDirToInt
+      (tm.transitionOutput q (tm.inputSymbol cfg) cfg.workTapes |>.stmts i |>.movement)
 
 /-- The head positions of the work tapes as a function of the number of steps, relative to
 the starting position in `cfg`. -/
@@ -354,7 +379,7 @@ lemma relatesInSteps_iff_step_iter_eq_some
 /-- The Turing machine `tm` halts after exactly `t` steps on input `input`. -/
 def haltsAtStep (tm : MultiTapeTM k Symbol) (input : List Symbol) (t : ℕ) : Bool :=
   match (tm.configs (tm.initCfg input) t) with
-  | some ⟨none, _, _⟩ => true
+  | some ⟨none, _, _, _, _⟩ => true
   | _ => false
 
 /-- If a Turing machine halts, the time step is uniquely determined. -/

From d8fef554a8311a46bdc486f8358bf8871aaa504f Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Thu, 4 Jun 2026 16:43:49 +0200
Subject: [PATCH 50/53] simulation

---
 .../Machines/MultiTapeTuring/Simulations.lean | 142 ++++++++++++++++++
 1 file changed, 142 insertions(+)
 create mode 100644 Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean b/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean
new file mode 100644
index 0000000000..ab6bd80732
--- /dev/null
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean
@@ -0,0 +1,142 @@
+/-
+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.SingleTapeTuring.Basic
+public import Cslib.Computability.Machines.MultiTapeTuring.Basic
+public import Mathlib.Computability.DFA
+public import Mathlib.Data.Fin.VecNotation
+public import Mathlib.Tactic.FinCases
+
+/-!
+# Simulations between different machines
+
+
+-/
+
+@[expose] public section
+
+open Cslib Relation Turing.BiTape Turing.MultiTapeTM.Cfg
+
+namespace Turing
+
+variable {Symbol : Type} [Inhabited Symbol] [Fintype Symbol]
+
+namespace MultiTapeTM
+
+section SingleTapeTMSimulation
+/-! Simulation of a single-tape TM by a multi-tape TM. -/
+
+variable (tm : SingleTapeTM Symbol)
+
+-- Stages of simulating a single-tape TM in a multi-tape TM:
+-- 1. copy input to work tape
+-- 2. move to start of work tape
+-- 3. run single-tape-tm on work tape
+-- 4. copy output to output tape and halt
+
+
+inductive SimState where
+  | copyInput -- copy from the input tape to the work tape
+  | moveToStart -- move to the start of the work tape
+  | runSingleTape (q : tm.State) -- simulate single-tape TM on work tape
+  | copyOutput -- copy output to output tape
+deriving Fintype
+
+def SimTr :
+    (SimState tm) → (Option Symbol) → (Fin 1 → Option Symbol) → TransitionOut 1 Symbol (SimState tm)
+  | .copyInput => fun input _ => match input with
+    | none => ⟨none, fun _ => ⟨none, some .left⟩, none, some .moveToStart⟩
+    | some c => ⟨some .right, fun _ => ⟨some c, some .right⟩, none, some .copyInput⟩
+  | .moveToStart => fun _ syms => match syms 0 with
+    | none => ⟨none, fun _ => ⟨none, some .right⟩, none, some (.runSingleTape tm.q₀)⟩
+    | some c => ⟨none, fun _ => ⟨some c, some .left⟩, none, some .moveToStart⟩
+  | .runSingleTape q => sorry
+  | .copyOutput => sorry
+
+def MultiFromSingle : MultiTapeTM (k := 1) Symbol where
+  State := SimState tm
+  q₀ := .copyInput
+  tr := SimTr tm
+
+-- TODO re-prove this using RelatesInSteps?
+
+lemma copyInput_innerStep
+    (input : List Symbol) (t : ℕ) (h_lt : t ≤ input.length) :
+    (MultiFromSingle tm).configs ((MultiFromSingle tm).initCfg input) t =
+      some ⟨some .copyInput, input, ⟨1 + t, by omega⟩,
+            fun _ => (BiTape.mk₁ (input.take t)).moveInt t, []⟩ := by
+  induction t with
+  | zero =>
+    simp [configs, Function.iterate_zero, initCfg, MultiFromSingle, moveInt]
+  | succ t ih =>
+    have hinput (work : BiTape Symbol) : (MultiFromSingle tm).inputSymbol
+        ⟨some .copyInput, input, ⟨1 + t, by omega⟩, fun _ => work, []⟩ = some input[t] := by
+      grind
+    have htransitionOut (work : BiTape Symbol) :
+        (MultiFromSingle tm).transitionOutput .copyInput (some input[t]) (fun _ => work) =
+        ⟨some .right, fun _ => ⟨some input[t], some .right⟩, none, some .copyInput⟩ := by
+      unfold MultiFromSingle SimTr
+      simp [transitionOutput]
+    have htape : (((mk₁ (List.take t input)).moveInt ↑t).write (some input[t])).move Dir.right =
+        (mk₁ (List.take (t + 1) input)).moveInt (↑t + 1) := by
+      ext1 i
+      simp [Function.update]
+      grind
+    rw [configs_succ, ih (by omega)]
+    simp [step, hinput, htransitionOut, moveInputPos, optionDirToInt, htape]
+    grind
+
+lemma copyInput_lastStep
+    (input : List Symbol) (work : BiTape Symbol) :
+    (MultiFromSingle tm).step
+      ⟨some .copyInput, input, ⟨1 + input.length, by omega⟩, fun _ => work, []⟩ =
+      some ⟨some .moveToStart, input, ⟨1 + input.length, by omega⟩,
+          fun _ => work.write none |>.move_left, []⟩ := by
+  have hinput : (MultiFromSingle tm).inputSymbol
+      ⟨some .copyInput, input, ⟨1 + input.length, by omega⟩, fun _ => work, []⟩ = none := by
+    grind
+  have htransitionOut :
+      (MultiFromSingle tm).transitionOutput .copyInput none (fun _ => work) =
+      ⟨none, fun _ => ⟨none, some .left⟩, none, some .moveToStart⟩ := by
+    unfold MultiFromSingle SimTr
+    simp [transitionOutput]
+  simp [step, hinput, htransitionOut]
+  grind
+
+lemma moveToStart_semantics (input work : List Symbol) (ip : Fin (input.length + 2))
+    (t : ℕ) (h_lt : t < work.length - 1) :
+    RelatesInSteps (MultiFromSingle tm).TransitionRelation
+      ⟨some .moveToStart, input, ip, fun _ => (BiTape.mk₁ work).moveInt (t - 1), []⟩
+      ⟨some .moveToStart, input, ip, fun _ => (BiTape.mk₁ work).moveInt (-1), []⟩
+      t := by
+  induction t with
+  | zero => simp [RelatesInSteps.zero_iff]
+  | succ t ih =>
+    specialize ih (by omega)
+    rw [RelatesInSteps.succ'_iff]
+    refine ⟨⟨some .moveToStart, input, ip, fun _ => (BiTape.mk₁ work).moveInt (t - 1), []⟩, ?_, ih⟩
+    have htout (σ) : (MultiFromSingle tm).transitionOutput
+          .moveToStart ((MultiFromSingle tm).inputSymbol σ) (fun _ => (BiTape.mk₁ work).moveInt t) =
+        ⟨none, fun _ => ⟨some work[t], some .left⟩, none, some .moveToStart⟩ := by
+      simp [inputSymbol]
+      sorry
+
+    --   grind
+    simp [TransitionRelation, step, htout, moveInputPos, optionDirToInt]
+    ext i
+    simp [optionDirToInt]
+    grind
+    sorry
+
+
+
+end SingleTapeTMSimulation
+
+end MultiTapeTM
+
+end Turing

From d07c117e5d229db523f3df31d6b200d22a1aca17 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Fri, 5 Jun 2026 12:48:10 +0200
Subject: [PATCH 51/53] more sim

---
 .../Machines/MultiTapeTuring/Basic.lean       | 25 +++++++++----------
 .../Machines/MultiTapeTuring/Simulations.lean | 19 ++++++++------
 2 files changed, 23 insertions(+), 21 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index aa53df046d..7bd9b5ed9b 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -71,7 +71,7 @@ structure TransitionOut (k : ℕ) (Symbol State : Type) where
   /-- The movement (attempt) of the input head. -/
   inputMove : Option Dir
   /-- Actions on the work tapes: optionally a symbol to write and the head movement. -/
-  stmts : Fin k → Stmt Symbol
+  stmts : Fin k → (Option (Option Symbol) × Option Dir)
   /-- An optional symbol to output. -/
   outS : Option Symbol
   /-- The successor state or none to halt. -/
@@ -165,7 +165,11 @@ def step (cfg : tm.Cfg) : Option tm.Cfg :=
       state := q',
       input := cfg.input,
       inputPos := moveInputPos cfg.inputPos inputMove,
-      workTapes i := cfg.workTapes i |>.write (stmts i).symbol |>.optionMove (stmts i).movement
+      workTapes i := match stmts i with
+        | (none, none) => cfg.workTapes i
+        | (some sym, none) => cfg.workTapes i |>.write sym
+        | (none, some d) => cfg.workTapes i |>.move d
+        | (some sym, some d) => cfg.workTapes i |>.write sym |>.move d,
       output := match outS with
       | none => cfg.output
       | some s => cfg.output ++ [s]
@@ -206,19 +210,14 @@ section Space
 
 variable [Inhabited Symbol] [Fintype Symbol] (tm : MultiTapeTM k Symbol)
 
-/-- Convert an "optional movement" to an integer where positive is "right". -/
-@[simp, grind]
-def OptionDirToInt : Option Dir → ℤ
-  | some .left => -1
-  | none => 0
-  | some .right => 1
-
 /-- The movements of the work tape heads after configuration `cfg`. -/
 def headMovements (cfg : tm.Cfg) : Fin k → ℤ
   | i => match cfg.state with
     | none => 0
-    | some q => OptionDirToInt
-      (tm.transitionOutput q (tm.inputSymbol cfg) cfg.workTapes |>.stmts i |>.movement)
+    | some q => match tm.transitionOutput q (tm.inputSymbol cfg) cfg.workTapes |>.stmts i |>.2 with
+      | none => 0
+      | some .left => -1
+      | some .right => 1
 
 /-- The head positions of the work tapes as a function of the number of steps, relative to
 the starting position in `cfg`. -/
@@ -249,8 +248,8 @@ lemma spaceUsed_zero_tapes_eq_zero (cfg : tm.Cfg) (t : ℕ) (h_zero : k = 0) :
   simp
 
 @[scoped grind .]
-lemma OptionDirToInt_bound (d : Option Dir) :
-    -1 ≤ OptionDirToInt d ∧ OptionDirToInt d ≤ 1 := by
+lemma optionDirToInt_bound (d : Option Dir) :
+    -1 ≤ optionDirToInt d ∧ optionDirToInt d ≤ 1 := by
   rcases d with _ | d
   · decide
   · rcases d <;> decide
diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean b/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean
index ab6bd80732..ae80fc4e93 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean
@@ -51,10 +51,10 @@ def SimTr :
     (SimState tm) → (Option Symbol) → (Fin 1 → Option Symbol) → TransitionOut 1 Symbol (SimState tm)
   | .copyInput => fun input _ => match input with
     | none => ⟨none, fun _ => ⟨none, some .left⟩, none, some .moveToStart⟩
-    | some c => ⟨some .right, fun _ => ⟨some c, some .right⟩, none, some .copyInput⟩
+    | some c => ⟨some .right, fun _ => ⟨some (some c), some .right⟩, none, some .copyInput⟩
   | .moveToStart => fun _ syms => match syms 0 with
+    | some c => ⟨none, fun _ => ⟨none, some .left⟩, none, some .moveToStart⟩
     | none => ⟨none, fun _ => ⟨none, some .right⟩, none, some (.runSingleTape tm.q₀)⟩
-    | some c => ⟨none, fun _ => ⟨some c, some .left⟩, none, some .moveToStart⟩
   | .runSingleTape q => sorry
   | .copyOutput => sorry
 
@@ -96,7 +96,7 @@ lemma copyInput_lastStep
     (MultiFromSingle tm).step
       ⟨some .copyInput, input, ⟨1 + input.length, by omega⟩, fun _ => work, []⟩ =
       some ⟨some .moveToStart, input, ⟨1 + input.length, by omega⟩,
-          fun _ => work.write none |>.move_left, []⟩ := by
+          fun _ => work.move_left, []⟩ := by
   have hinput : (MultiFromSingle tm).inputSymbol
       ⟨some .copyInput, input, ⟨1 + input.length, by omega⟩, fun _ => work, []⟩ = none := by
     grind
@@ -120,18 +120,21 @@ lemma moveToStart_semantics (input work : List Symbol) (ip : Fin (input.length +
     specialize ih (by omega)
     rw [RelatesInSteps.succ'_iff]
     refine ⟨⟨some .moveToStart, input, ip, fun _ => (BiTape.mk₁ work).moveInt (t - 1), []⟩, ?_, ih⟩
-    have htout (σ) : (MultiFromSingle tm).transitionOutput
-          .moveToStart ((MultiFromSingle tm).inputSymbol σ) (fun _ => (BiTape.mk₁ work).moveInt t) =
-        ⟨none, fun _ => ⟨some work[t], some .left⟩, none, some .moveToStart⟩ := by
+    have h_inputSymbol : (MultiFromSingle tm).inputSymbol
+        ⟨some .moveToStart, input, ip, fun _ => (BiTape.mk₁ work).moveInt (t - 1), []⟩ ≠ none := by
+      grind
+    have htout (c : Symbol) : (MultiFromSingle tm).transitionOutput
+          .moveToStart (some c) (fun _ => (BiTape.mk₁ work).moveInt t) =
+        ⟨none, fun _ => ⟨none, some .left⟩, none, some .moveToStart⟩ := by
+      unfold MultiFromSingle SimTr
       simp [inputSymbol]
       sorry
 
     --   grind
-    simp [TransitionRelation, step, htout, moveInputPos, optionDirToInt]
+    simp [TransitionRelation, step, h_inputSymbol, htout, moveInputPos, optionDirToInt]
     ext i
     simp [optionDirToInt]
     grind
-    sorry
 
 
 

From 6847a62c39b365a3404809394a75d286813c7bcc Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Fri, 5 Jun 2026 17:46:49 +0200
Subject: [PATCH 52/53] Make move optional.

---
 Cslib.lean                                    |  1 -
 .../Machines/MultiTapeTuring/Basic.lean       | 15 +++++-----
 .../Machines/SingleTapeTuring/Basic.lean      | 21 ++++++++++++--
 .../Computability/Machines/TuringCommon.lean  | 28 -------------------
 Cslib/Foundations/Data/BiTape.lean            |  9 ++++++
 5 files changed, 36 insertions(+), 38 deletions(-)
 delete mode 100644 Cslib/Computability/Machines/TuringCommon.lean

diff --git a/Cslib.lean b/Cslib.lean
index 32cde3201e..7dd907cd62 100644
--- a/Cslib.lean
+++ b/Cslib.lean
@@ -33,7 +33,6 @@ public import Cslib.Computability.Languages.OmegaRegularLanguage
 public import Cslib.Computability.Languages.RegularLanguage
 public import Cslib.Computability.Machines.MultiTapeTuring.Basic
 public import Cslib.Computability.Machines.SingleTapeTuring.Basic
-public import Cslib.Computability.Machines.TuringCommon
 public import Cslib.Computability.URM.Basic
 public import Cslib.Computability.URM.Computable
 public import Cslib.Computability.URM.Defs
diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index aa53df046d..f83bf9c47a 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -11,7 +11,6 @@ public import Mathlib.Algebra.Order.BigOperators.Group.Finset
 public import Mathlib.Computability.Language
 public import Cslib.Foundations.Data.BiTape
 public import Cslib.Foundations.Data.RelatesInSteps
-public import Cslib.Computability.Machines.TuringCommon
 
 /-!
 # Multi-Tape Turing Machines
@@ -71,7 +70,7 @@ structure TransitionOut (k : ℕ) (Symbol State : Type) where
   /-- The movement (attempt) of the input head. -/
   inputMove : Option Dir
   /-- Actions on the work tapes: optionally a symbol to write and the head movement. -/
-  stmts : Fin k → Stmt Symbol
+  stmts : Fin k → (Option (Option Symbol)) × (Option Dir)
   /-- An optional symbol to output. -/
   outS : Option Symbol
   /-- The successor state or none to halt. -/
@@ -165,7 +164,9 @@ def step (cfg : tm.Cfg) : Option tm.Cfg :=
       state := q',
       input := cfg.input,
       inputPos := moveInputPos cfg.inputPos inputMove,
-      workTapes i := cfg.workTapes i |>.write (stmts i).symbol |>.optionMove (stmts i).movement
+      workTapes i := match stmts i with
+        | (none, m) =>  cfg.workTapes i |>.optionMove m
+        | (some s, m) => cfg.workTapes i |>.write s |>.optionMove m
       output := match outS with
       | none => cfg.output
       | some s => cfg.output ++ [s]
@@ -208,7 +209,7 @@ variable [Inhabited Symbol] [Fintype Symbol] (tm : MultiTapeTM k Symbol)
 
 /-- Convert an "optional movement" to an integer where positive is "right". -/
 @[simp, grind]
-def OptionDirToInt : Option Dir → ℤ
+def optionDirToInt : Option Dir → ℤ
   | some .left => -1
   | none => 0
   | some .right => 1
@@ -217,8 +218,8 @@ def OptionDirToInt : Option Dir → ℤ
 def headMovements (cfg : tm.Cfg) : Fin k → ℤ
   | i => match cfg.state with
     | none => 0
-    | some q => OptionDirToInt
-      (tm.transitionOutput q (tm.inputSymbol cfg) cfg.workTapes |>.stmts i |>.movement)
+    | some q => optionDirToInt
+      (tm.transitionOutput q (tm.inputSymbol cfg) cfg.workTapes |>.stmts i |>.2)
 
 /-- The head positions of the work tapes as a function of the number of steps, relative to
 the starting position in `cfg`. -/
@@ -250,7 +251,7 @@ lemma spaceUsed_zero_tapes_eq_zero (cfg : tm.Cfg) (t : ℕ) (h_zero : k = 0) :
 
 @[scoped grind .]
 lemma OptionDirToInt_bound (d : Option Dir) :
-    -1 ≤ OptionDirToInt d ∧ OptionDirToInt d ≤ 1 := by
+    -1 ≤ optionDirToInt d ∧ optionDirToInt d ≤ 1 := by
   rcases d with _ | d
   · decide
   · rcases d <;> decide
diff --git a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
index 80d5d13181..debad7d43f 100644
--- a/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/SingleTapeTuring/Basic.lean
@@ -9,7 +9,6 @@ module
 public import Cslib.Foundations.Data.BiTape
 public import Cslib.Foundations.Data.RelatesInSteps
 public import Mathlib.Algebra.Polynomial.Eval.Defs
-public import Cslib.Computability.Machines.TuringCommon
 
 /-!
 # Single-Tape Turing Machines
@@ -43,6 +42,7 @@ for convenience in composition of machines.
 
 We define a number of structures related to Turing machine computation:
 
+* `Stmt`: the write and movement operations a TM can do in a single step.
 * `SingleTapeTM`: the TM itself.
 * `Cfg`: the configuration of a TM, including internal and tape state.
 * `TimeComputable f`: a TM for computing `f`, packaged with a bound on runtime.
@@ -70,6 +70,21 @@ open BiTape StackTape
 
 variable {Symbol : Type}
 
+namespace SingleTapeTM
+
+/--
+A Turing machine "statement" is just a `Option`al command to move left or right,
+and write a symbol (i.e. an `Option Symbol`, where `none` is the blank symbol) on the `BiTape`
+-/
+structure Stmt (Symbol : Type) where
+  /-- The symbol to write at the current head position -/
+  symbol : Option Symbol
+  /-- The direction to move the tape head -/
+  movement : Option Dir
+deriving Inhabited
+
+end SingleTapeTM
+
 /--
 A single-tape Turing machine
 over the alphabet of `Option Symbol` (where `none` is the blank `BiTape` symbol).
@@ -83,7 +98,7 @@ structure SingleTapeTM Symbol [Inhabited Symbol] [Fintype Symbol] where
   (q₀ : State)
   /-- Transition function, mapping a state and a head symbol to a `Stmt` to invoke,
   and optionally the new state to transition to afterwards (`none` for halt) -/
-  (tr : State → Option Symbol → Stmt Symbol × Option State)
+  (tr : State → Option Symbol → SingleTapeTM.Stmt Symbol × Option State)
 
 namespace SingleTapeTM
 
@@ -103,6 +118,8 @@ instance : Inhabited tm.State := ⟨tm.q₀⟩
 
 instance : Fintype tm.State := tm.stateFintype
 
+instance inhabitedStmt : Inhabited (Stmt Symbol) := inferInstance
+
 /--
 The configurations of a Turing machine consist of:
 an `Option`al state (or none for the halting state),
diff --git a/Cslib/Computability/Machines/TuringCommon.lean b/Cslib/Computability/Machines/TuringCommon.lean
deleted file mode 100644
index 60d0636639..0000000000
--- a/Cslib/Computability/Machines/TuringCommon.lean
+++ /dev/null
@@ -1,28 +0,0 @@
-/-
-Copyright (c) 2026 Bolton Bailey. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Bolton Bailey, Pim Spelier, Daan van Gent
--/
-
-module
-
-public import Mathlib.Computability.TuringMachine.Tape
-
-@[expose] public section
-
-namespace Turing
-
-/--
-A Turing machine "statement" is just a `Option`al command to move left or right,
-and write a symbol (i.e. an `Option Symbol`, where `none` is the blank symbol) on the `BiTape`
--/
-structure Stmt (Symbol : Type) where
-  /-- The symbol to write at the current head position -/
-  symbol : Option Symbol
-  /-- The direction to move the tape head -/
-  movement : Option Dir
-deriving Inhabited
-
-instance inhabitedStmt : Inhabited (Stmt Symbol) := inferInstance
-
-end Turing
diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean
index e61272d57d..7df3d2e736 100644
--- a/Cslib/Foundations/Data/BiTape.lean
+++ b/Cslib/Foundations/Data/BiTape.lean
@@ -114,6 +114,15 @@ lemma moveLeft_moveRight (t : BiTape Symbol) : t.moveLeft.moveRight = t := by
 lemma moveRight_moveLeft (t : BiTape Symbol) : t.moveRight.moveLeft = t := by
   simp [moveLeft, moveRight]
 
+/-- Translate an optional direction into a head movement offset, where the positive
+direction is to the right. -/
+@[scoped grind =]
+def optionDirToInt (d : Option Dir) : ℤ :=
+  match d with
+  | none => 0
+  | some .left => -1
+  | some .right => 1
+
 end Move
 
 /--

From 2681d91dbe59d2feea761e704e41ece8bfd8b843 Mon Sep 17 00:00:00 2001
From: crei <crei.github@gmail.com>
Date: Sun, 7 Jun 2026 19:26:34 +0200
Subject: [PATCH 53/53] sim

---
 .../Machines/MultiTapeTuring/Basic.lean       |  4 +++
 .../Machines/MultiTapeTuring/Simulations.lean | 34 ++++++++++---------
 Cslib/Foundations/Data/BiTape.lean            | 13 +++++++
 3 files changed, 35 insertions(+), 16 deletions(-)

diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
index f83bf9c47a..e63f8becf1 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Basic.lean
@@ -134,6 +134,10 @@ def moveInputPos {n : ℕ} (pos : Fin (n + 2)) (m : Option Dir) : Fin (n + 2) :=
   let p := (pos + optionDirToInt m).toNat
   if h : p < n + 2 then ⟨p, h⟩ else ⟨n + 1, by omega⟩
 
+@[simp, scoped grind =]
+lemma moveInputPos_none (pos : Fin (n + 2)) : moveInputPos pos none = pos := by
+  simp [moveInputPos, optionDirToInt]
+
 /-- The output of the transition function applied to a state and the set of topes. -/
 def transitionOutput (q : tm.State) (inputSymbol : Option Symbol) (work : Fin k → BiTape Symbol) :
     TransitionOut k Symbol tm.State :=
diff --git a/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean b/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean
index ae80fc4e93..daf485a9cb 100644
--- a/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean
+++ b/Cslib/Computability/Machines/MultiTapeTuring/Simulations.lean
@@ -53,10 +53,14 @@ def SimTr :
     | none => ⟨none, fun _ => ⟨none, some .left⟩, none, some .moveToStart⟩
     | some c => ⟨some .right, fun _ => ⟨some (some c), some .right⟩, none, some .copyInput⟩
   | .moveToStart => fun _ syms => match syms 0 with
-    | some c => ⟨none, fun _ => ⟨none, some .left⟩, none, some .moveToStart⟩
+    | some _ => ⟨none, fun _ => ⟨none, some .left⟩, none, some .moveToStart⟩
     | none => ⟨none, fun _ => ⟨none, some .right⟩, none, some (.runSingleTape tm.q₀)⟩
-  | .runSingleTape q => sorry
-  | .copyOutput => sorry
+  | .runSingleTape q => fun _ syms => match tm.tr q (syms 0) with
+    | ⟨⟨w, m⟩, some q'⟩ => ⟨none, fun _ => ⟨some w, m⟩, none, some (.runSingleTape q')⟩
+    | ⟨⟨w, m⟩, none⟩ => ⟨none, fun _ => ⟨some w, m⟩, none, some .copyOutput⟩
+  | .copyOutput => fun _ syms => match syms 0 with
+    | some c => ⟨none, fun _ => ⟨none, some .right⟩, some c, some .copyOutput⟩
+    | none => ⟨none, fun _ => ⟨none, none⟩, none, none⟩
 
 def MultiFromSingle : MultiTapeTM (k := 1) Symbol where
   State := SimState tm
@@ -88,7 +92,7 @@ lemma copyInput_innerStep
       simp [Function.update]
       grind
     rw [configs_succ, ih (by omega)]
-    simp [step, hinput, htransitionOut, moveInputPos, optionDirToInt, htape]
+    simp [step, hinput, htransitionOut, moveInputPos, htape]
     grind
 
 lemma copyInput_lastStep
@@ -96,7 +100,7 @@ lemma copyInput_lastStep
     (MultiFromSingle tm).step
       ⟨some .copyInput, input, ⟨1 + input.length, by omega⟩, fun _ => work, []⟩ =
       some ⟨some .moveToStart, input, ⟨1 + input.length, by omega⟩,
-          fun _ => work.move_left, []⟩ := by
+          fun _ => work.moveLeft, []⟩ := by
   have hinput : (MultiFromSingle tm).inputSymbol
       ⟨some .copyInput, input, ⟨1 + input.length, by omega⟩, fun _ => work, []⟩ = none := by
     grind
@@ -109,6 +113,7 @@ lemma copyInput_lastStep
   grind
 
 lemma moveToStart_semantics (input work : List Symbol) (ip : Fin (input.length + 2))
+    (h_ip : ip ≠ 0 ∧ ip ≠ input.length + 1)
     (t : ℕ) (h_lt : t < work.length - 1) :
     RelatesInSteps (MultiFromSingle tm).TransitionRelation
       ⟨some .moveToStart, input, ip, fun _ => (BiTape.mk₁ work).moveInt (t - 1), []⟩
@@ -121,19 +126,16 @@ lemma moveToStart_semantics (input work : List Symbol) (ip : Fin (input.length +
     rw [RelatesInSteps.succ'_iff]
     refine ⟨⟨some .moveToStart, input, ip, fun _ => (BiTape.mk₁ work).moveInt (t - 1), []⟩, ?_, ih⟩
     have h_inputSymbol : (MultiFromSingle tm).inputSymbol
-        ⟨some .moveToStart, input, ip, fun _ => (BiTape.mk₁ work).moveInt (t - 1), []⟩ ≠ none := by
-      grind
-    have htout (c : Symbol) : (MultiFromSingle tm).transitionOutput
-          .moveToStart (some c) (fun _ => (BiTape.mk₁ work).moveInt t) =
+        ⟨some .moveToStart, input, ip, fun _ => (BiTape.mk₁ work).moveInt t, []⟩ ≠ none := by
+      unfold inputSymbol
+      simp [h_ip]
+    have htout (c : Option Symbol) (h_c : c ≠ none) : (MultiFromSingle tm).transitionOutput
+          .moveToStart c (fun _ => (BiTape.mk₁ work).moveInt t) =
         ⟨none, fun _ => ⟨none, some .left⟩, none, some .moveToStart⟩ := by
       unfold MultiFromSingle SimTr
-      simp [inputSymbol]
-      sorry
-
-    --   grind
-    simp [TransitionRelation, step, h_inputSymbol, htout, moveInputPos, optionDirToInt]
-    ext i
-    simp [optionDirToInt]
+      simp [transitionOutput]
+      grind
+    simp [TransitionRelation, step, move_eq_moveInt, BiTape.optionDirToInt, htout _ h_inputSymbol]
     grind
 
 
diff --git a/Cslib/Foundations/Data/BiTape.lean b/Cslib/Foundations/Data/BiTape.lean
index 4b64299379..256bf1e29d 100644
--- a/Cslib/Foundations/Data/BiTape.lean
+++ b/Cslib/Foundations/Data/BiTape.lean
@@ -243,6 +243,19 @@ lemma moveInt_head (t : BiTape Symbol) (Δ : ℤ) :
   rw [show (moveInt t Δ).head = (moveInt t Δ).get 0 from rfl]
   grind [moveInt]
 
+@[simp, scoped grind =]
+lemma moveInt_moveInt (t : BiTape Symbol) (Δ₁ Δ₂ : ℤ) :
+  (t.moveInt Δ₁).moveInt Δ₂ = t.moveInt (Δ₁ + Δ₂) := by
+  sorry
+
+lemma move_eq_moveInt (t : BiTape Symbol) (d : Dir) : t.move d = t.moveInt (optionDirToInt (some d)) := by
+  sorry
+
+lemma moveLeft_eq_moveInt (t : BiTape Symbol) : t.moveLeft = t.moveInt (-1) := by
+  sorry
+
+lemma moveRight_eq_moveInt (t : BiTape Symbol) : t.moveRight = t.moveInt 1 := by
+  sorry
 
 end Move