From 0fb6da6a76573eea2eedef4c2b4088245e586a80 Mon Sep 17 00:00:00 2001 From: twwar Date: Tue, 22 Jul 2025 10:56:30 +0200 Subject: [PATCH 001/107] reduction system attribute --- .../Computability/CombinatoryLogic/Basic.lean | 62 ++++++------ .../CombinatoryLogic/Confluence.lean | 28 +++--- .../Computability/CombinatoryLogic/Defs.lean | 64 +++++------- .../CombinatoryLogic/Recursion.lean | 98 +++++++++---------- Cslib/Semantics/ReductionSystem/Basic.lean | 20 ++-- 5 files changed, 132 insertions(+), 140 deletions(-) diff --git a/Cslib/Computability/CombinatoryLogic/Basic.lean b/Cslib/Computability/CombinatoryLogic/Basic.lean index 2926527e..10e830b2 100644 --- a/Cslib/Computability/CombinatoryLogic/Basic.lean +++ b/Cslib/Computability/CombinatoryLogic/Basic.lean @@ -61,7 +61,7 @@ def Polynomial.eval {n : Nat} (Γ : SKI.Polynomial n) (l : List SKI) (hl : List. def Polynomial.varFreeToSKI (Γ : SKI.Polynomial 0) : SKI := Γ.eval [] (by trivial) /-- Inductively define a polynomial `Γ'` so that (up to the fact that we haven't -defined reduction on polynomials) `Γ' ⬝ t ⇒* Γ[xₙ ← t]`. -/ +defined reduction on polynomials) `Γ' ⬝ t ↠ Γ[xₙ ← t]`. -/ def Polynomial.elimVar {n : Nat} : SKI.Polynomial (n+1) → SKI.Polynomial n /- The K-combinator leaves plain terms unchanged by substitution `K ⬝ x ⬝ t ⇒ x` -/ | SKI.Polynomial.term x => K ⬝' x @@ -83,7 +83,7 @@ for the inner variables. -/ theorem Polynomial.elimVar_correct {n : Nat} (Γ : SKI.Polynomial (n+1)) {ys : List SKI} (hys : ys.length = n) (z : SKI) : - Γ.elimVar.eval ys hys ⬝ z ⇒* Γ.eval (ys ++ [z]) + Γ.elimVar.eval ys hys ⬝ z ↠ Γ.eval (ys ++ [z]) (by rw [List.length_append, hys, List.length_singleton]) := by match n, Γ with @@ -125,13 +125,13 @@ def Polynomial.toSKI {n : Nat} (Γ : SKI.Polynomial n) : SKI := /-- Correctness for the toSKI (bracket abstraction) algorithm. -/ theorem Polynomial.toSKI_correct {n : Nat} (Γ : SKI.Polynomial n) (xs : List SKI) - (hxs : xs.length = n) : Γ.toSKI.applyList xs ⇒* Γ.eval xs hxs := by + (hxs : xs.length = n) : Γ.toSKI.applyList xs ↠ Γ.eval xs hxs := by match n with | 0 => unfold toSKI varFreeToSKI applyList rw [List.length_eq_zero_iff] at hxs simp_rw [hxs, List.foldl_nil] - apply MRed.refl + rfl | n+1 => -- show that xs = ys + [z] have : xs ≠ [] := List.ne_nil_of_length_eq_add_one hxs @@ -165,7 +165,7 @@ choose a descriptive name. def RPoly : SKI.Polynomial 2 := &1 ⬝' &0 /-- A SKI term representing R -/ def R : SKI := RPoly.toSKI -theorem R_def (x y : SKI) : R ⬝ x ⬝ y ⇒* y ⬝ x := +theorem R_def (x y : SKI) : R ⬝ x ⬝ y ↠ y ⬝ x := RPoly.toSKI_correct [x, y] (by simp) @@ -173,7 +173,7 @@ theorem R_def (x y : SKI) : R ⬝ x ⬝ y ⇒* y ⬝ x := def BPoly : SKI.Polynomial 3 := &0 ⬝' (&1 ⬝' &2) /-- A SKI term representing B -/ def B : SKI := BPoly.toSKI -theorem B_def (f g x : SKI) : B ⬝ f ⬝ g ⬝ x ⇒* f ⬝ (g ⬝ x) := +theorem B_def (f g x : SKI) : B ⬝ f ⬝ g ⬝ x ↠ f ⬝ (g ⬝ x) := BPoly.toSKI_correct [f, g, x] (by simp) @@ -181,7 +181,7 @@ theorem B_def (f g x : SKI) : B ⬝ f ⬝ g ⬝ x ⇒* f ⬝ (g ⬝ x) := def CPoly : SKI.Polynomial 3 := &0 ⬝' &2 ⬝' &1 /-- A SKI term representing C -/ def C : SKI := CPoly.toSKI -theorem C_def (f x y : SKI) : C ⬝ f ⬝ x ⬝ y ⇒* f ⬝ y ⬝ x := +theorem C_def (f x y : SKI) : C ⬝ f ⬝ x ⬝ y ↠ f ⬝ y ⬝ x := CPoly.toSKI_correct [f, x, y] (by simp) @@ -189,7 +189,7 @@ theorem C_def (f x y : SKI) : C ⬝ f ⬝ x ⬝ y ⇒* f ⬝ y ⬝ x := def RotRPoly : SKI.Polynomial 3 := &2 ⬝' &0 ⬝' &1 /-- A SKI term representing RotR -/ def RotR : SKI := RotRPoly.toSKI -theorem rotR_def (x y z : SKI) : RotR ⬝ x ⬝ y ⬝ z ⇒* z ⬝ x ⬝ y := +theorem rotR_def (x y z : SKI) : RotR ⬝ x ⬝ y ⬝ z ↠ z ⬝ x ⬝ y := RotRPoly.toSKI_correct [x, y, z] (by simp) @@ -197,7 +197,7 @@ theorem rotR_def (x y z : SKI) : RotR ⬝ x ⬝ y ⬝ z ⇒* z ⬝ x ⬝ y := def RotLPoly : SKI.Polynomial 3 := &1 ⬝' &2 ⬝' &0 /-- A SKI term representing RotL -/ def RotL : SKI := RotLPoly.toSKI -theorem rotL_def (x y z : SKI) : RotL ⬝ x ⬝ y ⬝ z ⇒* y ⬝ z ⬝ x := +theorem rotL_def (x y z : SKI) : RotL ⬝ x ⬝ y ⬝ z ↠ y ⬝ z ⬝ x := RotLPoly.toSKI_correct [x, y, z] (by simp) @@ -205,7 +205,7 @@ theorem rotL_def (x y z : SKI) : RotL ⬝ x ⬝ y ⬝ z ⇒* y ⬝ z ⬝ x := def δPoly : SKI.Polynomial 1 := &0 ⬝' &0 /-- A SKI term representing δ -/ def δ : SKI := δPoly.toSKI -theorem δ_def (x : SKI) : δ ⬝ x ⇒* x ⬝ x := +theorem δ_def (x : SKI) : δ ⬝ x ↠ x ⬝ x := δPoly.toSKI_correct [x] (by simp) @@ -213,7 +213,7 @@ theorem δ_def (x : SKI) : δ ⬝ x ⇒* x ⬝ x := def HPoly : SKI.Polynomial 2 := &0 ⬝' (&1 ⬝' &1) /-- A SKI term representing H -/ def H : SKI := HPoly.toSKI -theorem H_def (f x : SKI) : H ⬝ f ⬝ x ⇒* f ⬝ (x ⬝ x) := +theorem H_def (f x : SKI) : H ⬝ f ⬝ x ↠ f ⬝ (x ⬝ x) := HPoly.toSKI_correct [f, x] (by simp) @@ -221,7 +221,7 @@ theorem H_def (f x : SKI) : H ⬝ f ⬝ x ⇒* f ⬝ (x ⬝ x) := def YPoly : SKI.Polynomial 1 := H ⬝' &0 ⬝' (H ⬝' &0) /-- A SKI term representing Y -/ def Y : SKI := YPoly.toSKI -theorem Y_def (f : SKI) : Y ⬝ f ⇒* H ⬝ f ⬝ (H ⬝ f) := +theorem Y_def (f : SKI) : Y ⬝ f ↠ H ⬝ f ⬝ (H ⬝ f) := YPoly.toSKI_correct [f] (by simp) @@ -239,29 +239,29 @@ rather than up to a common reduct. An alternative is to use Turing's fixed-point (defined below). -/ def fixedPoint (f : SKI) : SKI := H ⬝ f ⬝ (H ⬝ f) -theorem fixedPoint_correct (f : SKI) : f.fixedPoint ⇒* f ⬝ f.fixedPoint := H_def f (H ⬝ f) +theorem fixedPoint_correct (f : SKI) : f.fixedPoint ↠ f ⬝ f.fixedPoint := H_def f (H ⬝ f) /-- Auxiliary definition for Turing's fixed-point combinator: ΘAux := λ x y. y (x x y) -/ def ΘAuxPoly : SKI.Polynomial 2 := &1 ⬝' (&0 ⬝' &0 ⬝' &1) /-- A term representing ΘAux -/ def ΘAux : SKI := ΘAuxPoly.toSKI -theorem ΘAux_def (x y : SKI) : ΘAux ⬝ x ⬝ y ⇒* y ⬝ (x ⬝ x ⬝ y) := +theorem ΘAux_def (x y : SKI) : ΘAux ⬝ x ⬝ y ↠ y ⬝ (x ⬝ x ⬝ y) := ΘAuxPoly.toSKI_correct [x, y] (by simp) /--Turing's fixed-point combinator: Θ := (λ x y. y (x x y)) (λ x y. y (x x y)) -/ def Θ : SKI := ΘAux ⬝ ΘAux /-- A SKI term representing Θ -/ -theorem Θ_correct (f : SKI) : Θ ⬝ f ⇒* f ⬝ (Θ ⬝ f) := ΘAux_def ΘAux f +theorem Θ_correct (f : SKI) : Θ ⬝ f ↠ f ⬝ (Θ ⬝ f) := ΘAux_def ΘAux f /-! ### Church Booleans -/ /-- A term a represents the boolean value u if it is βη-equivalent to a standard Church boolean. -/ def IsBool (u : Bool) (a : SKI) : Prop := - ∀ x y : SKI, a ⬝ x ⬝ y ⇒* (if u then x else y) + ∀ x y : SKI, a ⬝ x ⬝ y ↠ (if u then x else y) -theorem isBool_trans (u : Bool) (a a' : SKI) (h : a ⇒* a') (ha' : IsBool u a') : +theorem isBool_trans (u : Bool) (a a' : SKI) (h : a ↠ a') (ha' : IsBool u a') : IsBool u a := by intro x y trans a' ⬝ x ⬝ y @@ -278,13 +278,13 @@ theorem TT_correct : IsBool true TT := fun x y ↦ MRed.K x y def FF : SKI := K ⬝ I theorem FF_correct : IsBool false FF := fun x y ↦ calc - FF ⬝ x ⬝ y ⇒ I ⬝ y := by apply red_head; exact red_K I x - _ ⇒ y := red_I y + FF ⬝ x ⬝ y ⭢ I ⬝ y := by apply red_head; exact red_K I x + _ ⭢ y := red_I y /-- Conditional: Cond x y b := if b then x else y -/ protected def Cond : SKI := RotR theorem cond_correct (a x y : SKI) (u : Bool) (h : IsBool u a) : - SKI.Cond ⬝ x ⬝ y ⬝ a ⇒* if u then x else y := by + SKI.Cond ⬝ x ⬝ y ⬝ a ↠ if u then x else y := by trans a ⬝ x ⬝ y · exact rotR_def x y a · exact h x y @@ -302,7 +302,7 @@ theorem neg_correct (a : SKI) (ua : Bool) (h : IsBool ua a) : IsBool (¬ ua) (SK def AndPoly : SKI.Polynomial 2 := SKI.Cond ⬝' (SKI.Cond ⬝ TT ⬝ FF ⬝' &1) ⬝' FF ⬝' &0 /-- A SKI term representing And -/ protected def And : SKI := AndPoly.toSKI -theorem and_def (a b : SKI) : SKI.And ⬝ a ⬝ b ⇒* SKI.Cond ⬝ (SKI.Cond ⬝ TT ⬝ FF ⬝ b) ⬝ FF ⬝ a := +theorem and_def (a b : SKI) : SKI.And ⬝ a ⬝ b ↠ SKI.Cond ⬝ (SKI.Cond ⬝ TT ⬝ FF ⬝ b) ⬝ FF ⬝ a := AndPoly.toSKI_correct [a, b] (by simp) theorem and_correct (a b : SKI) (ua ub : Bool) (ha : IsBool ua a) (hb : IsBool ub b) : @@ -321,7 +321,7 @@ theorem and_correct (a b : SKI) (ua ub : Bool) (ha : IsBool ua a) (hb : IsBool u def OrPoly : SKI.Polynomial 2 := SKI.Cond ⬝' TT ⬝' (SKI.Cond ⬝ TT ⬝ FF ⬝' &1) ⬝' &0 /-- A SKI term representing Or -/ protected def Or : SKI := OrPoly.toSKI -theorem or_def (a b : SKI) : SKI.Or ⬝ a ⬝ b ⇒* SKI.Cond ⬝ TT ⬝ (SKI.Cond ⬝ TT ⬝ FF ⬝ b) ⬝ a := +theorem or_def (a b : SKI) : SKI.Or ⬝ a ⬝ b ↠ SKI.Cond ⬝ TT ⬝ (SKI.Cond ⬝ TT ⬝ FF ⬝ b) ⬝ a := OrPoly.toSKI_correct [a, b] (by simp) theorem or_correct (a b : SKI) (ua ub : Bool) (ha : IsBool ua a) (hb : IsBool ub b) : @@ -350,22 +350,22 @@ def Fst : SKI := R ⬝ TT /-- Second projection -/ def Snd : SKI := R ⬝ FF -theorem fst_correct (a b : SKI) : Fst ⬝ (MkPair ⬝ a ⬝ b) ⇒* a := by calc - _ ⇒* SKI.Cond ⬝ a ⬝ b ⬝ TT := R_def _ _ - _ ⇒* a := cond_correct TT a b true TT_correct +theorem fst_correct (a b : SKI) : Fst ⬝ (MkPair ⬝ a ⬝ b) ↠ a := by calc + _ ↠ SKI.Cond ⬝ a ⬝ b ⬝ TT := R_def _ _ + _ ↠ a := cond_correct TT a b true TT_correct -theorem snd_correct (a b : SKI) : Snd ⬝ (MkPair ⬝ a ⬝ b) ⇒* b := by calc - _ ⇒* SKI.Cond ⬝ a ⬝ b ⬝ FF := R_def _ _ - _ ⇒* b := cond_correct FF a b false FF_correct +theorem snd_correct (a b : SKI) : Snd ⬝ (MkPair ⬝ a ⬝ b) ↠ b := by calc + _ ↠ SKI.Cond ⬝ a ⬝ b ⬝ FF := R_def _ _ + _ ↠ b := cond_correct FF a b false FF_correct /-- Unpaired f ⟨x, y⟩ := f x y, cf `Nat.unparied`. -/ def UnpairedPoly : SKI.Polynomial 2 := &0 ⬝' (Fst ⬝' &1) ⬝' (Snd ⬝' &1) /-- A term representing Unpaired -/ protected def Unpaired : SKI := UnpairedPoly.toSKI -theorem unpaired_def (f p : SKI) : SKI.Unpaired ⬝ f ⬝ p ⇒* f ⬝ (Fst ⬝ p) ⬝ (Snd ⬝ p) := +theorem unpaired_def (f p : SKI) : SKI.Unpaired ⬝ f ⬝ p ↠ f ⬝ (Fst ⬝ p) ⬝ (Snd ⬝ p) := UnpairedPoly.toSKI_correct [f, p] (by simp) -theorem unpaired_correct (f x y : SKI) : SKI.Unpaired ⬝ f ⬝ (MkPair ⬝ x ⬝ y) ⇒* f ⬝ x ⬝ y := by +theorem unpaired_correct (f x y : SKI) : SKI.Unpaired ⬝ f ⬝ (MkPair ⬝ x ⬝ y) ↠ f ⬝ x ⬝ y := by trans f ⬝ (Fst ⬝ (MkPair ⬝ x ⬝ y)) ⬝ (Snd ⬝ (MkPair ⬝ x ⬝ y)) . exact unpaired_def f _ . apply parallel_mRed @@ -377,5 +377,5 @@ theorem unpaired_correct (f x y : SKI) : SKI.Unpaired ⬝ f ⬝ (MkPair ⬝ x def PairPoly : SKI.Polynomial 3 := MkPair ⬝' (&0 ⬝' &2) ⬝' (&1 ⬝' &2) /-- A SKI term representing Pair -/ protected def Pair : SKI := PairPoly.toSKI -theorem pair_def (f g x : SKI) : SKI.Pair ⬝ f ⬝ g ⬝ x ⇒* MkPair ⬝ (f ⬝ x) ⬝ (g ⬝ x) := +theorem pair_def (f g x : SKI) : SKI.Pair ⬝ f ⬝ g ⬝ x ↠ MkPair ⬝ (f ⬝ x) ⬝ (g ⬝ x) := PairPoly.toSKI_correct [f, g, x] (by simp) diff --git a/Cslib/Computability/CombinatoryLogic/Confluence.lean b/Cslib/Computability/CombinatoryLogic/Confluence.lean index 5c0fb508..4c426396 100644 --- a/Cslib/Computability/CombinatoryLogic/Confluence.lean +++ b/Cslib/Computability/CombinatoryLogic/Confluence.lean @@ -9,11 +9,11 @@ import Cslib.Utils.Relation /-! # SKI reduction is confluent -This file proves the **Church-Rosser** theorem for the SKI calculus, that is, if `a ⇒* b` and -`a ⇒* c`, `b ⇒* d` and `c ⇒* d` for some term `d`. More strongly (though equivalently), we show +This file proves the **Church-Rosser** theorem for the SKI calculus, that is, if `a ↠ b` and +`a ↠ c`, `b ↠ d` and `c ↠ d` for some term `d`. More strongly (though equivalently), we show that the relation of having a common reduct is transitive — in the above situation, `a` and `b`, and `a` and `c` have common reducts, so the result implies the same of `b` and `c`. Note that -`CommonReduct` is symmetric (trivially) and reflexive (since `⇒*` is), so we in fact show that +`CommonReduct` is symmetric (trivially) and reflexive (since `↠` is), so we in fact show that `CommonReduct` is an equivalence. Our proof @@ -23,7 +23,7 @@ Chapter 4 of Peter Selinger's notes: ## Main definitions -- `ParallelReduction` : a relation `⇒ₚ` on terms such that `⇒ ⊆ ⇒ₚ ⊆ ⇒*`, allowing simultaneous +- `ParallelReduction` : a relation `⇒ₚ` on terms such that `⇒ ⊆ ⇒ₚ ⊆ ↠`, allowing simultaneous reduction on the head and tail of a term. ## Main results @@ -31,13 +31,13 @@ reduction on the head and tail of a term. - `parallelReduction_diamond` : parallel reduction satisfies the diamond property, that is, it is confluent in a single step. - `commonReduct_equivalence` : by a general result, the diamond property for `⇒ₚ` implies the same -for its reflexive-transitive closure. This closure is exactly `⇒*`, which implies the +for its reflexive-transitive closure. This closure is exactly `↠`, which implies the **Church-Rosser** theorem as sketched above. -/ namespace SKI -open Red MRed +open Red MRed ReductionSystem /-- A reduction step allowing simultaneous reduction of disjoint redexes -/ inductive ParallelReduction : SKI → SKI → Prop @@ -55,8 +55,8 @@ inductive ParallelReduction : SKI → SKI → Prop /-- Notation for parallel reduction -/ scoped infix:90 " ⇒ₚ " => ParallelReduction -/-- The inclusion `⇒ₚ ⊆ ⇒*` -/ -theorem mRed_of_parallelReduction {a a' : SKI} (h : a ⇒ₚ a') : a ⇒* a' := by +/-- The inclusion `⇒ₚ ⊆ ↠` -/ +theorem mRed_of_parallelReduction {a a' : SKI} (h : a ⇒ₚ a') : a ↠ a' := by cases h case refl => exact Relation.ReflTransGen.refl case par a a' b b' ha hb => @@ -68,7 +68,7 @@ theorem mRed_of_parallelReduction {a a' : SKI} (h : a ⇒ₚ a') : a ⇒* a' := case red_S a b c => exact Relation.ReflTransGen.single (red_S a b c) /-- The inclusion `⇒ ⊆ ⇒ₚ` -/ -theorem parallelReduction_of_red {a a' : SKI} (h : a ⇒ a') : a ⇒ₚ a' := by +theorem parallelReduction_of_red {a a' : SKI} (h : a ⭢ a') : a ⇒ₚ a' := by cases h case red_S => apply ParallelReduction.red_S case red_K => apply ParallelReduction.red_K @@ -86,12 +86,12 @@ theorem parallelReduction_of_red {a a' : SKI} (h : a ⇒ a') : a ⇒ₚ a' := by `parallelReduction_of_red` imply that `⇒` and `⇒ₚ` have the same reflexive-transitive closure. -/ theorem reflTransGen_parallelReduction_mRed : - Relation.ReflTransGen ParallelReduction = MRed := by + Relation.ReflTransGen ParallelReduction = RedSKI.MRed := by ext a b constructor · apply Relation.reflTransGen_minimal - · exact MRed.reflexive - · exact MRed.transitive + · exact λ _ => by rfl + · exact instTransitiveMRed RedSKI · exact @mRed_of_parallelReduction · apply Relation.reflTransGen_minimal · exact Relation.reflexive_reflTransGen @@ -101,7 +101,7 @@ theorem reflTransGen_parallelReduction_mRed : /-! Irreducibility for the (partially applied) primitive combinators. -TODO: possibly these should be proven more generally (in another file) for `⇒*`. +TODO: possibly these should be proven more generally (in another file) for `↠`. -/ lemma I_irreducible (a : SKI) (h : I ⇒ₚ a) : a = I := by @@ -233,7 +233,7 @@ theorem commonReduct_equivalence : Equivalence CommonReduct := by exact join_parallelReduction_equivalence /-- The **Church-Rosser** theorem in the form it is usually stated. -/ -theorem MRed.diamond (a b c : SKI) (hab : a ⇒* b) (hac : a ⇒* c) : CommonReduct b c := by +theorem MRed.diamond (a b c : SKI) (hab : a ↠ b) (hac : a ↠ c) : CommonReduct b c := by apply commonReduct_equivalence.trans (y := a) · exact commonReduct_equivalence.symm (commonReduct_of_single hab) · exact commonReduct_of_single hac diff --git a/Cslib/Computability/CombinatoryLogic/Defs.lean b/Cslib/Computability/CombinatoryLogic/Defs.lean index c0b993db..ca4c8b09 100644 --- a/Cslib/Computability/CombinatoryLogic/Defs.lean +++ b/Cslib/Computability/CombinatoryLogic/Defs.lean @@ -5,6 +5,7 @@ Authors: Thomas Waring -/ import Mathlib.Logic.Relation import Cslib.Utils.Relation +import Cslib.Semantics.ReductionSystem.Basic /-! # SKI Combinatory Logic @@ -23,7 +24,7 @@ using the SKI basis. - `⬝` : application between SKI terms, - `⇒` : single-step reduction, -- `⇒*` : multi-step reduction, +- `↠` : multi-step reduction, ## References @@ -60,6 +61,7 @@ lemma applyList_concat (f : SKI) (ys : List SKI) (z : SKI) : /-! ### Reduction relations between SKI terms -/ /-- Single-step reduction of SKI terms -/ +@[reduction_sys RedSKI] inductive Red : SKI → SKI → Prop where /-- The operational semantics of the `S`, -/ | red_S (x y z : SKI) : Red (S ⬝ x ⬝ y ⬝ z) (x ⬝ z ⬝ (y ⬝ z)) @@ -72,60 +74,47 @@ inductive Red : SKI → SKI → Prop where /-- and tail of an SKI term. -/ | red_tail (x y y' : SKI) (_ : Red y y') : Red (x ⬝ y) (x ⬝ y') -/-- Notation for single-step reduction -/ -scoped infix:90 " ⇒ " => Red -/-- Multi-step reduction of SKI terms -/ -def MRed : SKI → SKI → Prop := Relation.ReflTransGen Red +open Red ReductionSystem -/-- Notation for multi-step reduction (by analogy with the Kleene star) -/ -scoped infix:90 " ⇒* " => MRed +theorem MRed.S (x y z : SKI) : (S ⬝ x ⬝ y ⬝ z) ↠ (x ⬝ z ⬝ (y ⬝ z)) := MRed.single RedSKI <| red_S .. +theorem MRed.K (x y : SKI) : (K ⬝ x ⬝ y) ↠ x := MRed.single RedSKI <| red_K .. +theorem MRed.I (x : SKI) : (I ⬝ x) ↠ x := MRed.single RedSKI <| red_I .. -open Red - -@[refl] -theorem MRed.refl (a : SKI) : a ⇒* a := Relation.ReflTransGen.refl - -theorem MRed.single {a b : SKI} (h : a ⇒ b) : a ⇒* b := Relation.ReflTransGen.single h - -theorem MRed.S (x y z : SKI) : MRed (S ⬝ x ⬝ y ⬝ z) (x ⬝ z ⬝ (y ⬝ z)) := MRed.single <| red_S .. -theorem MRed.K (x y : SKI) : MRed (K ⬝ x ⬝ y) x := MRed.single <| red_K .. -theorem MRed.I (x : SKI) : MRed (I ⬝ x) x := MRed.single <| red_I .. - -theorem MRed.head {a a' : SKI} (b : SKI) (h : a ⇒* a') : (a ⬝ b) ⇒* (a' ⬝ b) := by +theorem MRed.head {a a' : SKI} (b : SKI) (h : a ↠ a') : (a ⬝ b) ↠ (a' ⬝ b) := by induction h with | refl => apply MRed.refl | @tail a' a'' _ ha'' ih => apply Relation.ReflTransGen.tail (b := a' ⬝ b) ih exact Red.red_head a' a'' b ha'' -theorem MRed.tail (a : SKI) {b b' : SKI} (h : b ⇒* b') : (a ⬝ b) ⇒* (a ⬝ b') := by +theorem MRed.tail (a : SKI) {b b' : SKI} (h : b ↠ b') : (a ⬝ b) ↠ (a ⬝ b') := by induction h with | refl => apply MRed.refl | @tail b' b'' _ hb'' ih => apply Relation.ReflTransGen.tail (b := a ⬝ b') ih exact Red.red_tail a b' b'' hb'' -instance MRed.instTrans : IsTrans SKI MRed := Relation.instIsTransReflTransGen -theorem MRed.transitive : Transitive MRed := transitive_of_trans MRed +-- instance MRed.instTrans : IsTrans SKI MRed := Relation.instIsTransReflTransGen +-- theorem MRed.transitive : Transitive MRed := transitive_of_trans MRed -instance MRed.instIsRefl : IsRefl SKI MRed := Relation.instIsReflReflTransGen -theorem MRed.reflexive : Reflexive MRed := IsRefl.reflexive +-- instance MRed.instIsRefl : IsRefl SKI MRed := Relation.instIsReflReflTransGen +-- theorem MRed.reflexive : Reflexive MRed := IsRefl.reflexive -instance MRedTrans : Trans Red MRed MRed := - ⟨fun hab => Relation.ReflTransGen.trans (MRed.single hab)⟩ +-- instance MRedTrans : Trans Red MRed MRed := +-- ⟨fun hab => Relation.ReflTransGen.trans (MRed.single hab)⟩ -instance MRedRedTrans : Trans MRed Red MRed := - ⟨fun hab hbc => Relation.ReflTransGen.trans hab (MRed.single hbc)⟩ +-- instance MRedRedTrans : Trans MRed Red MRed := +-- ⟨fun hab hbc => Relation.ReflTransGen.trans hab (MRed.single hbc)⟩ -instance RedMRedTrans : Trans Red Red MRed := - ⟨fun hab hbc => Relation.ReflTransGen.trans (MRed.single hab) (MRed.single hbc)⟩ +-- instance RedMRedTrans : Trans Red Red MRed := +-- ⟨fun hab hbc => Relation.ReflTransGen.trans (MRed.single hab) (MRed.single hbc)⟩ -lemma parallel_mRed {a a' b b' : SKI} (ha : a ⇒* a') (hb : b ⇒* b') : - (a ⬝ b) ⇒* (a' ⬝ b') := +lemma parallel_mRed {a a' b b' : SKI} (ha : a ↠ a') (hb : b ↠ b') : + (a ⬝ b) ↠ (a' ⬝ b') := Trans.simple (MRed.head b ha) (MRed.tail a' hb) -lemma parallel_red {a a' b b' : SKI} (ha : a ⇒ a') (hb : b ⇒ b') : (a ⬝ b) ⇒* (a' ⬝ b') := by +lemma parallel_red {a a' b b' : SKI} (ha : a ⭢ a') (hb : b ⭢ b') : (a ⬝ b) ↠ (a' ⬝ b') := by trans a' ⬝ b all_goals apply MRed.single · exact Red.red_head a a' b ha @@ -133,11 +122,10 @@ lemma parallel_red {a a' b b' : SKI} (ha : a ⇒ a') (hb : b ⇒ b') : (a ⬝ b) /-- Express that two terms have a reduce to a common term. -/ -def CommonReduct : SKI → SKI → Prop := Relation.Join MRed +def CommonReduct : SKI → SKI → Prop := Relation.Join RedSKI.MRed -lemma commonReduct_of_single {a b : SKI} (h : a ⇒* b) : CommonReduct a b := by - refine Relation.join_of_single MRed.reflexive h +lemma commonReduct_of_single {a b : SKI} (h : a ↠ b) : CommonReduct a b := ⟨b, h, by rfl⟩ theorem symmetric_commonReduct : Symmetric CommonReduct := Relation.symmetric_join -theorem reflexive_commonReduct : Reflexive CommonReduct := - Relation.reflexive_join MRed.reflexive +theorem reflexive_commonReduct : Reflexive CommonReduct := λ x => by + refine ⟨x,?_,?_⟩ <;> rfl diff --git a/Cslib/Computability/CombinatoryLogic/Recursion.lean b/Cslib/Computability/CombinatoryLogic/Recursion.lean index 9ef05ba6..18448030 100644 --- a/Cslib/Computability/CombinatoryLogic/Recursion.lean +++ b/Cslib/Computability/CombinatoryLogic/Recursion.lean @@ -15,16 +15,16 @@ formalisation of `Mathlib.Computability.Partrec`. Since composition (`B`-combina what remains are the following definitions and proofs of their correctness. - Church numerals : a predicate `IsChurch n a` expressing that the term `a` is βη-equivalent to -the standard church numeral `n` — that is, `a ⬝ f ⬝ x ⇒* f ⬝ (f ⬝ ... ⬝ (f ⬝ x)))`. +the standard church numeral `n` — that is, `a ⬝ f ⬝ x ↠ f ⬝ (f ⬝ ... ⬝ (f ⬝ x)))`. - SKI numerals : `Zero` and `Succ`, corresponding to `Partrec.zero` and `Partrec.succ`, and correctness proofs `zero_correct` and `succ_correct`. - Predecessor : a term `Pred` so that (`pred_correct`) `IsChurch n a → IsChurch n.pred (Pred ⬝ a)`. - Primitive recursion : a term `Rec` so that (`rec_correct_succ`) `IsChurch (n+1) a` implies -`Rec ⬝ x ⬝ g ⬝ a ⇒* g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))` and (`rec_correct_zero`) `IsChurch 0 a` implies -`Rec ⬝ x ⬝ g ⬝ a ⇒* x`. +`Rec ⬝ x ⬝ g ⬝ a ↠ g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))` and (`rec_correct_zero`) `IsChurch 0 a` implies +`Rec ⬝ x ⬝ g ⬝ a ↠ x`. - Unbounded root finding (μ-recursion) : given a term `f` representing a function `fℕ: Nat → Nat`, -which takes on the value 0 a term `RFind` such that (`rFind_correct`) `RFind ⬝ f ⇒* a` such that +which takes on the value 0 a term `RFind` such that (`rFind_correct`) `RFind ⬝ f ↠ a` such that `IsChurch n a` for `n` the smallest root of `fℕ`. ## References @@ -49,7 +49,7 @@ sense of `Mathlib.Data.Part` (as used in `Mathlib.Computability.Partrec`). namespace SKI -open Red MRed +open Red MRed ReductionSystem /-- Function form of the church numerals. -/ def Church (n : Nat) (f x : SKI) : SKI := @@ -58,22 +58,22 @@ match n with | n+1 => f ⬝ (Church n f x) /-- `church` commutes with reduction. -/ -lemma church_red (n : Nat) (f f' x x' : SKI) (hf : f ⇒* f') (hx : x ⇒* x') : - Church n f x ⇒* Church n f' x' := by +lemma church_red (n : Nat) (f f' x x' : SKI) (hf : f ↠ f') (hx : x ↠ x') : + Church n f x ↠ Church n f' x' := by induction n with | zero => exact hx | succ n ih => exact parallel_mRed hf ih /-- The term `a` is βη-equivalent to a standard church numeral. -/ -def IsChurch (n : Nat) (a : SKI) : Prop := ∀ f x : SKI, a ⬝ f ⬝ x ⇒* Church n f x +def IsChurch (n : Nat) (a : SKI) : Prop := ∀ f x : SKI, a ⬝ f ⬝ x ↠ Church n f x /-- To show `IsChurch n a` it suffices to show the same for a reduct of `a`. -/ -theorem isChurch_trans (n : Nat) {a a' : SKI} (h : a ⇒* a') : IsChurch n a' → IsChurch n a := by +theorem isChurch_trans (n : Nat) {a a' : SKI} (h : a ↠ a') : IsChurch n a' → IsChurch n a := by simp_rw [IsChurch] intro ha' f x calc - _ ⇒* a' ⬝ f ⬝ x := by apply MRed.head; apply MRed.head; exact h - _ ⇒* Church n f x := by apply ha' + _ ↠ a' ⬝ f ⬝ x := by apply MRed.head; apply MRed.head; exact h + _ ↠ Church n f x := by apply ha' /-! ### Church numeral basics -/ @@ -84,24 +84,24 @@ theorem zero_correct : IsChurch 0 SKI.Zero := by unfold IsChurch SKI.Zero Church intro f x calc - _ ⇒ I ⬝ x := by apply red_head; apply red_K - _ ⇒ x := by apply red_I + _ ⭢ I ⬝ x := by apply red_head; apply red_K + _ ⭢ x := by apply red_I /-- Church one := λ f x. f x -/ protected def One : SKI := I theorem one_correct : IsChurch 1 SKI.One := by intro f x apply head - exact single (red_I f) + exact MRed.single RedSKI (red_I f) /-- Church succ := λ a f x. f (a f x) ~ λ a f. B f (a f) ~ λ a. S B a ~ S B -/ protected def Succ : SKI := S ⬝ B theorem succ_correct (n : Nat) (a : SKI) (h : IsChurch n a) : IsChurch (n+1) (SKI.Succ ⬝ a) := by intro f x calc - _ ⇒ B ⬝ f ⬝ (a ⬝ f) ⬝ x := by apply red_head; apply red_S - _ ⇒* f ⬝ (a ⬝ f ⬝ x) := by apply B_def - _ ⇒* f ⬝ (Church n f x) := by apply MRed.tail; exact h f x + _ ⭢ B ⬝ f ⬝ (a ⬝ f) ⬝ x := by apply red_head; apply red_S + _ ↠ f ⬝ (a ⬝ f ⬝ x) := by apply B_def + _ ↠ f ⬝ (Church n f x) := by apply MRed.tail; exact h f x /-- To define the predecessor, iterate the function `PredAux` ⟨i, j⟩ ↦ ⟨j, j+1⟩ on ⟨0,0⟩, then take @@ -110,14 +110,14 @@ the first component. def PredAuxPoly : SKI.Polynomial 1 := MkPair ⬝' (Snd ⬝' &0) ⬝' (SKI.Succ ⬝' (Snd ⬝' &0)) /-- A term representing PredAux-/ def PredAux : SKI := PredAuxPoly.toSKI -theorem predAux_def (p : SKI) : PredAux ⬝ p ⇒* MkPair ⬝ (Snd ⬝ p) ⬝ (SKI.Succ ⬝ (Snd ⬝ p)) := +theorem predAux_def (p : SKI) : PredAux ⬝ p ↠ MkPair ⬝ (Snd ⬝ p) ⬝ (SKI.Succ ⬝ (Snd ⬝ p)) := PredAuxPoly.toSKI_correct [p] (by simp) /-- Useful auxiliary definition expressing that `p` represents ns ∈ Nat × Nat. -/ def IsChurchPair (ns : Nat × Nat) (x : SKI) : Prop := IsChurch ns.1 (Fst ⬝ x) ∧ IsChurch ns.2 (Snd ⬝ x) -theorem isChurchPair_trans (ns : Nat × Nat) (a a' : SKI) (h : a ⇒* a') : +theorem isChurchPair_trans (ns : Nat × Nat) (a a' : SKI) (h : a ↠ a') : IsChurchPair ns a' → IsChurchPair ns a := by simp_rw [IsChurchPair] intro ⟨ha₁,ha₂⟩ @@ -154,7 +154,7 @@ theorem predAux_correct' (n : Nat) : def PredPoly : SKI.Polynomial 1 := Fst ⬝' (&0 ⬝' PredAux ⬝' (MkPair ⬝ SKI.Zero ⬝ SKI.Zero)) /-- A term representing Pred -/ def Pred : SKI := PredPoly.toSKI -theorem pred_def (a : SKI) : Pred ⬝ a ⇒* Fst ⬝ (a ⬝ PredAux ⬝ (MkPair ⬝ SKI.Zero ⬝ SKI.Zero)) := +theorem pred_def (a : SKI) : Pred ⬝ a ↠ Fst ⬝ (a ⬝ PredAux ⬝ (MkPair ⬝ SKI.Zero ⬝ SKI.Zero)) := PredPoly.toSKI_correct [a] (by simp) theorem pred_correct (n : Nat) (a : SKI) (h : IsChurch n a) : IsChurch n.pred (Pred ⬝ a) := by @@ -172,7 +172,7 @@ theorem pred_correct (n : Nat) (a : SKI) (h : IsChurch n a) : IsChurch n.pred (P def IsZeroPoly : SKI.Polynomial 1 := &0 ⬝' (K ⬝ FF) ⬝' TT /-- A term representing IsZero -/ def IsZero : SKI := IsZeroPoly.toSKI -theorem isZero_def (a : SKI) : IsZero ⬝ a ⇒* a ⬝ (K ⬝ FF) ⬝ TT := +theorem isZero_def (a : SKI) : IsZero ⬝ a ↠ a ⬝ (K ⬝ FF) ⬝ TT := IsZeroPoly.toSKI_correct [a] (by simp) theorem isZero_correct (n : Nat) (a : SKI) (h : IsChurch n a) : IsBool (n = 0) (IsZero ⬝ a) := by @@ -189,8 +189,8 @@ theorem isZero_correct (n : Nat) (a : SKI) (h : IsChurch n a) : rw [hk] at h apply isBool_trans (ha' := FF_correct) calc - _ ⇒* (K ⬝ FF) ⬝ Church k (K ⬝ FF) TT := h _ _ - _ ⇒ FF := red_K _ _ + _ ↠ (K ⬝ FF) ⬝ Church k (K ⬝ FF) TT := h _ _ + _ ⭢ FF := red_K _ _ /-- @@ -202,33 +202,33 @@ def RecAuxPoly : SKI.Polynomial 4 := /-- A term representing RecAux -/ def RecAux : SKI := RecAuxPoly.toSKI theorem recAux_def (R₀ x g a : SKI) : - RecAux ⬝ R₀ ⬝ x ⬝ g ⬝ a ⇒* SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (R₀ ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := + RecAux ⬝ R₀ ⬝ x ⬝ g ⬝ a ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (R₀ ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := RecAuxPoly.toSKI_correct [R₀, x, g, a] (by simp) /-- We define Rec so that -`Rec ⬝ x ⬝ g ⬝ a ⇒* SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a)` +`Rec ⬝ x ⬝ g ⬝ a ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a)` -/ def Rec : SKI := fixedPoint RecAux theorem rec_def (x g a : SKI) : - Rec ⬝ x ⬝ g ⬝ a ⇒* SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := calc - _ ⇒* RecAux ⬝ Rec ⬝ x ⬝ g ⬝ a := by + Rec ⬝ x ⬝ g ⬝ a ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := calc + _ ↠ RecAux ⬝ Rec ⬝ x ⬝ g ⬝ a := by apply MRed.head; apply MRed.head; apply MRed.head apply fixedPoint_correct - _ ⇒* SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := recAux_def Rec x g a + _ ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := recAux_def Rec x g a -theorem rec_zero (x g a : SKI) (ha : IsChurch 0 a) : Rec ⬝ x ⬝ g ⬝ a ⇒* x := by +theorem rec_zero (x g a : SKI) (ha : IsChurch 0 a) : Rec ⬝ x ⬝ g ⬝ a ↠ x := by calc - _ ⇒* SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := rec_def _ _ _ - _ ⇒* if (Nat.beq 0 0) then x else (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) := by + _ ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := rec_def _ _ _ + _ ↠ if (Nat.beq 0 0) then x else (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) := by apply cond_correct exact isZero_correct 0 a ha theorem rec_succ (n : Nat) (x g a : SKI) (ha : IsChurch (n+1) a) : - Rec ⬝ x ⬝ g ⬝ a ⇒* g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a)) := by + Rec ⬝ x ⬝ g ⬝ a ↠ g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a)) := by calc - _ ⇒* SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := rec_def _ _ _ - _ ⇒* if (Nat.beq (n+1) 0) then x else (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) := by + _ ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := rec_def _ _ _ + _ ↠ if (Nat.beq (n+1) 0) then x else (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) := by apply cond_correct exact isZero_correct (n+1) a ha @@ -245,19 +245,19 @@ def RFindAboveAuxPoly : SKI.Polynomial 3 := /-- A term representing RFindAboveAux -/ def RFindAboveAux : SKI := RFindAboveAuxPoly.toSKI lemma rfindAboveAux_def (R₀ f a : SKI) : - RFindAboveAux ⬝ R₀ ⬝ a ⬝ f ⇒* SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := + RFindAboveAux ⬝ R₀ ⬝ a ⬝ f ↠ SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := RFindAboveAuxPoly.toSKI_correct [R₀, a, f] (by trivial) theorem rfindAboveAux_base (R₀ f a : SKI) (hfa : IsChurch 0 (f ⬝ a)) : - RFindAboveAux ⬝ R₀ ⬝ a ⬝ f ⇒* a := calc - _ ⇒* SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := rfindAboveAux_def _ _ _ - _ ⇒* if (Nat.beq 0 0) then a else (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) := by + RFindAboveAux ⬝ R₀ ⬝ a ⬝ f ↠ a := calc + _ ↠ SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := rfindAboveAux_def _ _ _ + _ ↠ if (Nat.beq 0 0) then a else (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) := by apply cond_correct apply isZero_correct _ _ hfa theorem rfindAboveAux_step (R₀ f a : SKI) {m : Nat} (hfa : IsChurch (m+1) (f ⬝ a)) : - RFindAboveAux ⬝ R₀ ⬝ a ⬝ f ⇒* R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f := calc - _ ⇒* SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := rfindAboveAux_def _ _ _ - _ ⇒* if (Nat.beq (m+1) 0) then a else (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) := by + RFindAboveAux ⬝ R₀ ⬝ a ⬝ f ↠ R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f := calc + _ ↠ SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := rfindAboveAux_def _ _ _ + _ ↠ if (Nat.beq (m+1) 0) then a else (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) := by apply cond_correct apply isZero_correct _ _ hfa @@ -314,15 +314,15 @@ theorem RFind_correct (fNat : Nat → Nat) (f : SKI) def AddPoly : SKI.Polynomial 2 := &0 ⬝' SKI.Succ ⬝' &1 /-- A term representing addition on church numerals -/ protected def Add : SKI := AddPoly.toSKI -theorem add_def (a b : SKI) : SKI.Add ⬝ a ⬝ b ⇒* a ⬝ SKI.Succ ⬝ b := +theorem add_def (a b : SKI) : SKI.Add ⬝ a ⬝ b ↠ a ⬝ SKI.Succ ⬝ b := AddPoly.toSKI_correct [a, b] (by simp) theorem add_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m b) : IsChurch (n+m) (SKI.Add ⬝ a ⬝ b) := by refine isChurch_trans (n+m) (a' := Church n SKI.Succ b) ?_ ?_ · calc - _ ⇒* a ⬝ SKI.Succ ⬝ b := add_def a b - _ ⇒* Church n SKI.Succ b := ha SKI.Succ b + _ ↠ a ⬝ SKI.Succ ⬝ b := add_def a b + _ ↠ Church n SKI.Succ b := ha SKI.Succ b · clear ha induction n with | zero => simp_rw [Nat.zero_add, Church]; exact hb @@ -334,7 +334,7 @@ theorem add_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m def MulPoly : SKI.Polynomial 2 := &0 ⬝' (SKI.Add ⬝' &1) ⬝' SKI.Zero /-- A term representing multiplication on church numerals -/ protected def Mul : SKI := MulPoly.toSKI -theorem mul_def (a b : SKI) : SKI.Mul ⬝ a ⬝ b ⇒* a ⬝ (SKI.Add ⬝ b) ⬝ SKI.Zero := +theorem mul_def (a b : SKI) : SKI.Mul ⬝ a ⬝ b ↠ a ⬝ (SKI.Add ⬝ b) ⬝ SKI.Zero := MulPoly.toSKI_correct [a, b] (by simp) theorem mul_correct {n m : Nat} {a b : SKI} (ha : IsChurch n a) (hb : IsChurch m b) : @@ -352,15 +352,15 @@ theorem mul_correct {n m : Nat} {a b : SKI} (ha : IsChurch n a) (hb : IsChurch m def SubPoly : SKI.Polynomial 2 := &1 ⬝' Pred ⬝' &0 /-- A term representing subtraction on church numerals -/ protected def Sub : SKI := SubPoly.toSKI -theorem sub_def (a b : SKI) : SKI.Sub ⬝ a ⬝ b ⇒* b ⬝ Pred ⬝ a := +theorem sub_def (a b : SKI) : SKI.Sub ⬝ a ⬝ b ↠ b ⬝ Pred ⬝ a := SubPoly.toSKI_correct [a, b] (by simp) theorem sub_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m b) : IsChurch (n-m) (SKI.Sub ⬝ a ⬝ b) := by refine isChurch_trans (n-m) (a' := Church m Pred a) ?_ ?_ · calc - _ ⇒* b ⬝ Pred ⬝ a := sub_def a b - _ ⇒* Church m Pred a := hb Pred a + _ ↠ b ⬝ Pred ⬝ a := sub_def a b + _ ↠ Church m Pred a := hb Pred a · clear hb induction m with | zero => simp_rw [Nat.sub_zero, Church]; exact ha @@ -372,7 +372,7 @@ theorem sub_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m def LEPoly : SKI.Polynomial 2 := IsZero ⬝' (SKI.Sub ⬝' &0 ⬝' &1) /-- A term representing comparison on church numerals -/ protected def LE : SKI := LEPoly.toSKI -theorem le_def (a b : SKI) : SKI.LE ⬝ a ⬝ b ⇒* IsZero ⬝ (SKI.Sub ⬝ a ⬝ b) := +theorem le_def (a b : SKI) : SKI.LE ⬝ a ⬝ b ↠ IsZero ⬝ (SKI.Sub ⬝ a ⬝ b) := LEPoly.toSKI_correct [a, b] (by simp) theorem le_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m b) : diff --git a/Cslib/Semantics/ReductionSystem/Basic.lean b/Cslib/Semantics/ReductionSystem/Basic.lean index f5c277d1..00e7aac0 100644 --- a/Cslib/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Semantics/ReductionSystem/Basic.lean @@ -52,15 +52,19 @@ instance {α} (R : α → α → Prop) : Trans R (ReflTransGen R) (ReflTransGen instance {α} (R : α → α → Prop) : Trans (ReflTransGen R) R (ReflTransGen R) where trans := tail -instance (rs : ReductionSystem Term) : Trans rs.Red rs.Red rs.MRed := by infer_instance +-- instance (rs : ReductionSystem Term) : Trans rs.Red rs.Red rs.MRed := by infer_instance instance (rs : ReductionSystem Term) : Trans rs.Red rs.MRed rs.MRed := by infer_instance instance (rs : ReductionSystem Term) : Trans rs.MRed rs.Red rs.MRed := by infer_instance +instance (rs : ReductionSystem Term) : IsTrans Term rs.MRed := by infer_instance +instance (rs : ReductionSystem Term) : Transitive rs.MRed := transitive_of_trans rs.MRed +instance (rs : ReductionSystem Term) : Trans rs.MRed rs.MRed rs.MRed := instTransOfIsTrans + end MultiStep open Lean Elab Meta Command Term --- thank you to Kyle Miller for this: +-- thank you to Kyle Miller for this: -- https://leanprover.zulipchat.com/#narrow/channel/239415-metaprogramming-.2F-tactics/topic/Working.20with.20variables.20in.20a.20command/near/529324084 /-- A command to create a `ReductionSystem` from a relation, robust to use of `variable `-/ @@ -91,10 +95,10 @@ elab "create_reduction_sys" rel:ident name:ident : command => do } addTermInfo' name (.const name.getId params) (isBinder := true) addDeclarationRangesFromSyntax name.getId name - -/-- + +/-- This command adds notations for a `ReductionSystem.Red` and `ReductionSystem.MRed`. This should - not usually be called directly, but from the `reduction_sys` attribute. + not usually be called directly, but from the `reduction_sys` attribute. As an example `reduction_notation foo "β"` will add the notations "⭢β" and "↠β". @@ -104,19 +108,19 @@ elab "create_reduction_sys" rel:ident name:ident : command => do -/ syntax "reduction_notation" ident (Lean.Parser.Command.notationItem)? : command macro_rules - | `(reduction_notation $rs $sym) => + | `(reduction_notation $rs $sym) => `( notation:39 t " ⭢"$sym t' => (ReductionSystem.Red $rs) t t' notation:39 t " ↠"$sym t' => (ReductionSystem.MRed $rs) t t' ) - | `(reduction_notation $rs) => + | `(reduction_notation $rs) => `( notation:39 t " ⭢" t' => (ReductionSystem.Red $rs) t t' notation:39 t " ↠" t' => (ReductionSystem.MRed $rs) t t' ) -/-- +/-- This attribute calls the `reduction_notation` command for the annotated declaration, such as in: ``` From 62b1776d1089fcf9e7f1ac3611fd069b72068980 Mon Sep 17 00:00:00 2001 From: twwar Date: Tue, 22 Jul 2025 12:58:25 +0200 Subject: [PATCH 002/107] evaluation results --- .../Computability/CombinatoryLogic/Defs.lean | 7 + .../CombinatoryLogic/Evaluation.lean | 179 ++++++++++++++++++ 2 files changed, 186 insertions(+) create mode 100644 Cslib/Computability/CombinatoryLogic/Evaluation.lean diff --git a/Cslib/Computability/CombinatoryLogic/Defs.lean b/Cslib/Computability/CombinatoryLogic/Defs.lean index ca4c8b09..168a92f0 100644 --- a/Cslib/Computability/CombinatoryLogic/Defs.lean +++ b/Cslib/Computability/CombinatoryLogic/Defs.lean @@ -77,6 +77,13 @@ inductive Red : SKI → SKI → Prop where open Red ReductionSystem +lemma Red.ne {x y : SKI} : (x ⭢ y) → x ≠ y + | red_S _ _ _, h => by cases h + | red_K _ _, h => by cases h + | red_I _, h => by cases h + | red_head _ _ _ h', h => Red.ne h' (SKI.app.inj h).1 + | red_tail _ _ _ h', h => Red.ne h' (SKI.app.inj h).2 + theorem MRed.S (x y z : SKI) : (S ⬝ x ⬝ y ⬝ z) ↠ (x ⬝ z ⬝ (y ⬝ z)) := MRed.single RedSKI <| red_S .. theorem MRed.K (x y : SKI) : (K ⬝ x ⬝ y) ↠ x := MRed.single RedSKI <| red_K .. theorem MRed.I (x : SKI) : (I ⬝ x) ↠ x := MRed.single RedSKI <| red_I .. diff --git a/Cslib/Computability/CombinatoryLogic/Evaluation.lean b/Cslib/Computability/CombinatoryLogic/Evaluation.lean new file mode 100644 index 00000000..7c73c3a9 --- /dev/null +++ b/Cslib/Computability/CombinatoryLogic/Evaluation.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2025 Thomas Waring. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Thomas Waring +-/ +import Cslib.Computability.CombinatoryLogic.Defs +import Cslib.Computability.CombinatoryLogic.Confluence + +/-! +# Evaluation results + +This file draws heavily from +-/ + +open SKI Red + +/-- The predicate that a term has no reducible sub-terms. -/ +def RedexFree : SKI → Prop + | S => True + | K => True + | I => True + | S ⬝ x => RedexFree x + | K ⬝ x => RedexFree x + | I ⬝ _ => False + | S ⬝ x ⬝ y => RedexFree x ∧ RedexFree y + | K ⬝ _ ⬝ _ => False + | I ⬝ _ ⬝ _ => False + | S ⬝ _ ⬝ _ ⬝ _ => False + | K ⬝ _ ⬝ _ ⬝ _ => False + | I ⬝ _ ⬝ _ ⬝ _ => False + | a ⬝ b ⬝ c ⬝ d ⬝ e => RedexFree (a ⬝ b ⬝ c ⬝ d) ∧ RedexFree e + +/-- +One-step evaluation as a function: either it returns a term that has been reduced by one step, +or a proof that the term is redex free. Uses normal-order reduction. +-/ +def evalStep : (x : SKI) → PLift (RedexFree x) ⊕ SKI + | S => Sum.inl (PLift.up trivial) + | K => Sum.inl (PLift.up trivial) + | I => Sum.inl (PLift.up trivial) + | S ⬝ x => match evalStep x with + | Sum.inl h => Sum.inl h + | Sum.inr x' => Sum.inr (S ⬝ x') + | K ⬝ x => match evalStep x with + | Sum.inl h => Sum.inl h + | Sum.inr x' => Sum.inr (K ⬝ x') + | I ⬝ x => Sum.inr x + | S ⬝ x ⬝ y => match evalStep x, evalStep y with + | Sum.inl h1, Sum.inl h2 => Sum.inl (.up ⟨h1.down, h2.down⟩) + | Sum.inl _, Sum.inr y' => Sum.inr (S ⬝ x ⬝ y') + | Sum.inr x', _ => Sum.inr (S ⬝ x' ⬝ y) + | K ⬝ x ⬝ _ => Sum.inr x + | I ⬝ x ⬝ y => Sum.inr (x ⬝ y) + | S ⬝ x ⬝ y ⬝ z => Sum.inr (x ⬝ z ⬝ (y ⬝ z)) + | K ⬝ x ⬝ _ ⬝ z => Sum.inr (x ⬝ z) + | I ⬝ x ⬝ y ⬝ z => Sum.inr (x ⬝ y ⬝ z) + | a ⬝ b ⬝ c ⬝ d ⬝ e => match evalStep (a ⬝ b ⬝ c ⬝ d), evalStep e with + | Sum.inl h1, Sum.inl h2 => Sum.inl (.up ⟨h1.down, h2.down⟩) + | Sum.inl _, Sum.inr e' => Sum.inr (a ⬝ b ⬝ c ⬝ d ⬝ e') + | Sum.inr abcd', _ => Sum.inr (abcd' ⬝ e) + +/-- The normal-order reduction implemented by `evalStep` indeed computes a one-step reduction. -/ +theorem evalStep_right_correct : (x y : SKI) → (evalStep x = Sum.inr y) → x ⭢ y + | S ⬝ x, a, h => + match hx : evalStep x with + | Sum.inl _ => by simp only [hx, evalStep, reduceCtorEq] at h + | Sum.inr x' => by + simp only [evalStep, hx, Sum.inr.injEq] at h + rw [←h] + exact .red_tail _ _ _ (evalStep_right_correct _ _ hx) + | K ⬝ x, a, h => + match hx : evalStep x with + | Sum.inl _ => by simp only [hx, evalStep, reduceCtorEq] at h + | Sum.inr x' => by + simp only [evalStep, hx, Sum.inr.injEq] at h + rw [←h] + exact .red_tail _ _ _ (evalStep_right_correct _ _ hx) + | I ⬝ x, a, h => Sum.inr.inj h ▸ red_I _ + | S ⬝ x ⬝ y, a, h => + match hx : evalStep x, hy : evalStep y with + | Sum.inl _, Sum.inl _ => by simp only [hx, hy, evalStep, reduceCtorEq] at h + | Sum.inl _, Sum.inr y' => by + simp only [hx, hy, evalStep, Sum.inr.injEq] at h + rw [←h] + exact .red_tail _ _ _ <| evalStep_right_correct _ _ hy + | Sum.inr x', _ => by + simp only [hx, hy, evalStep, Sum.inr.injEq] at h + rw [←h] + exact .red_head _ _ _ <| .red_tail _ _ _ <| evalStep_right_correct _ _ hx + | K ⬝ x ⬝ y, a, h => Sum.inr.inj h ▸ red_K .. + | I ⬝ x ⬝ y, a, h => Sum.inr.inj h ▸ (red_head _ _ _ <| red_I _) + | S ⬝ x ⬝ y ⬝ z, a, h => Sum.inr.inj h ▸ red_S .. + | K ⬝ x ⬝ y ⬝ z, a, h => Sum.inr.inj h ▸ (red_head _ _ _ <| red_K ..) + | I ⬝ x ⬝ y ⬝ z, a, h => Sum.inr.inj h ▸ (red_head _ _ _ <| red_head _ _ _ <| red_I _) + | a ⬝ b ⬝ c ⬝ d ⬝ e, x, h => + match habcd : evalStep (a ⬝ b ⬝ c ⬝ d), he : evalStep e with + | Sum.inl _, Sum.inl _ => by simp only [habcd, he, evalStep, reduceCtorEq] at h + | Sum.inl _, Sum.inr e' => by + simp only [habcd, he, evalStep, Sum.inr.injEq] at h + rw [←h] + exact red_tail _ _ _ <| evalStep_right_correct _ _ he + | Sum.inr abcd', _ => by + simp only [habcd, he, evalStep, Sum.inr.injEq] at h + rw [←h] + exact red_head _ _ _ <| evalStep_right_correct _ _ habcd + +theorem redexFree_of_no_red {x : SKI} (h : ∀ y, ¬ (x ⭢ y)) : RedexFree x := by + match hx : evalStep x with + | Sum.inl h' => exact h'.down + | Sum.inr y => cases h _ (evalStep_right_correct x y hx) + +theorem RedexFree.no_red : {x : SKI} → RedexFree x → ∀ y, ¬ (x ⭢ y) +| S ⬝ x, hx, S ⬝ y, red_tail _ _ _ hx' => by rw [RedexFree] at hx; exact hx.no_red y hx' +| K ⬝ x, hx, K ⬝ y, red_tail _ _ _ hx' => by rw [RedexFree] at hx; exact hx.no_red y hx' +| S ⬝ _ ⬝ _, ⟨hx, _⟩, S ⬝ _ ⬝ _, red_head _ _ _ (red_tail _ _ _ h3) => hx.no_red _ h3 +| S ⬝ _ ⬝ _, ⟨_, hy⟩, S ⬝ _ ⬝ _, red_tail _ _ _ h3 => hy.no_red _ h3 +| _ ⬝ _ ⬝ _ ⬝ _ ⬝ _, ⟨hx, _⟩, _ ⬝ _, red_head _ _ _ hq => hx.no_red _ hq +| _ ⬝ _ ⬝ _ ⬝ _ ⬝ _, ⟨_, hy⟩, _ ⬝ _, red_tail _ _ _ he => hy.no_red _ he + +/-- A term is redex free iff it has no one-step reductions. -/ +theorem redexFree_iff {x : SKI} : RedexFree x ↔ ∀ y, ¬ (x ⭢ y) := + ⟨RedexFree.no_red, redexFree_of_no_red⟩ + +theorem redexFree_iff_onceEval {x : SKI} : RedexFree x ↔ (evalStep x).isLeft = true := by + constructor + case mp => + intro h + match hx : evalStep x with + | Sum.inl h' => exact rfl + | Sum.inr y => cases h.no_red _ (evalStep_right_correct _ _ hx) + case mpr => + intro h + match hx : evalStep x with + | Sum.inl h' => exact h'.down + | Sum.inr y => rw [hx] at h; cases h + +instance : DecidablePred RedexFree := fun _ => decidable_of_iff' _ redexFree_iff_onceEval + +/-- A term is redex free iff its only many-step reduction is itself. -/ +theorem redexFree_iff' {x : SKI} : RedexFree x ↔ ∀ y, (x ↠ y) ↔ x = y := by + constructor + case mp => + intro h y + constructor + case mp => + intro h' + cases h'.cases_head + case inl => assumption + case inr h' => + obtain ⟨z, hz, _⟩ := h' + cases h.no_red _ hz + case mpr => + intro h + rw [h] + case mpr => + intro h + rw [redexFree_iff] + intro y hy + specialize h y + exact Red.ne hy (h.1 (Relation.ReflTransGen.single hy)) + +/-- If a term has a common reduct with a normal term, it in fact reduces to that term. -/ +theorem commonReduct_redexFree {x y : SKI} (hy : RedexFree y) (h : CommonReduct x y) : x ↠ y := + let ⟨w, hyw, hzw⟩ := h + (redexFree_iff'.1 hy _ |>.1 hzw : y = w) ▸ hyw + +/-- If `x` reduces to both `y` and `z`, and `z` is not reducible, then `y` reduces to `z`. -/ +lemma confluent_redexFree {x y z : SKI} (hxy : x ↠ y) (hxz : x ↠ z) (hz : RedexFree z) : y ↠ z := + let ⟨w, hyw, hzw⟩ := MRed.diamond x y z hxy hxz + (redexFree_iff'.1 hz _ |>.1 hzw : z = w) ▸ hyw + +/-- +If `x` reduces to both `y` and `z`, and both `y` and `z` are in normal form, then they are equal. +-/ +lemma unique_normal_form {x y z : SKI} + (hxy : x ↠ y) (hxz : x ↠ z) (hy : RedexFree y) (hz : RedexFree z) : y = z := + (redexFree_iff'.1 hy _).1 (confluent_redexFree hxy hxz hz) + +#check From b11c41452db08d5c9fd9ad8e735de7a4d164f82a Mon Sep 17 00:00:00 2001 From: twwar Date: Tue, 22 Jul 2025 15:10:04 +0200 Subject: [PATCH 003/107] injectivity, rice's theorem --- .../Computability/CombinatoryLogic/Defs.lean | 12 ++ .../CombinatoryLogic/Evaluation.lean | 113 +++++++++++++++++- 2 files changed, 123 insertions(+), 2 deletions(-) diff --git a/Cslib/Computability/CombinatoryLogic/Defs.lean b/Cslib/Computability/CombinatoryLogic/Defs.lean index 168a92f0..1199f83e 100644 --- a/Cslib/Computability/CombinatoryLogic/Defs.lean +++ b/Cslib/Computability/CombinatoryLogic/Defs.lean @@ -57,6 +57,12 @@ lemma applyList_concat (f : SKI) (ys : List SKI) (z : SKI) : f.applyList (ys ++ [z]) = f.applyList ys ⬝ z := by simp [applyList] +/-- The size of an SKI term is its number of combinators. -/ +def size : SKI → Nat + | S => 1 + | K => 1 + | I => 1 + | x ⬝ y => size x + size y /-! ### Reduction relations between SKI terms -/ @@ -136,3 +142,9 @@ lemma commonReduct_of_single {a b : SKI} (h : a ↠ b) : CommonReduct a b := ⟨ theorem symmetric_commonReduct : Symmetric CommonReduct := Relation.symmetric_join theorem reflexive_commonReduct : Reflexive CommonReduct := λ x => by refine ⟨x,?_,?_⟩ <;> rfl + +theorem commonReduct_head {x x' : SKI} (y : SKI) : CommonReduct x x' → CommonReduct (x ⬝ y) (x' ⬝ y) + | ⟨z, hz, hz'⟩ => ⟨z ⬝ y, MRed.head y hz, MRed.head y hz'⟩ + +theorem commonReduct_tail (x : SKI) {y y' : SKI} : CommonReduct y y' → CommonReduct (x ⬝ y) (x ⬝ y') + | ⟨z, hz, hz'⟩ => ⟨x ⬝ z, MRed.tail x hz, MRed.tail x hz'⟩ diff --git a/Cslib/Computability/CombinatoryLogic/Evaluation.lean b/Cslib/Computability/CombinatoryLogic/Evaluation.lean index 7c73c3a9..c2dba55b 100644 --- a/Cslib/Computability/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Computability/CombinatoryLogic/Evaluation.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Waring -/ import Cslib.Computability.CombinatoryLogic.Defs +import Cslib.Computability.CombinatoryLogic.Basic import Cslib.Computability.CombinatoryLogic.Confluence +import Cslib.Computability.CombinatoryLogic.Recursion /-! # Evaluation results -This file draws heavily from +This file draws heavily from . -/ open SKI Red @@ -176,4 +178,111 @@ lemma unique_normal_form {x y z : SKI} (hxy : x ↠ y) (hxz : x ↠ z) (hy : RedexFree y) (hz : RedexFree z) : y = z := (redexFree_iff'.1 hy _).1 (confluent_redexFree hxy hxz hz) -#check +lemma unique_normal_form' {x y : SKI} (h : CommonReduct x y) + (hx : RedexFree x) (hy : RedexFree y) : x = y := + (redexFree_iff'.1 hx _).1 (commonReduct_redexFree hy h) + +/-! ### Injectivity for datatypes -/ + + +lemma sk_nequiv : ¬ CommonReduct S K := by + intro ⟨z, hsz, hkz⟩ + have hS : RedexFree S := by simp [RedexFree] + have hK : RedexFree K := by simp [RedexFree] + cases (redexFree_iff'.1 hS z).1 hsz + cases (redexFree_iff'.1 hK _).1 hkz + +/-- Injectivity for booleans. -/ +theorem isBool_injective (x y : SKI) (u v : Bool) (hx : IsBool u x) (hy : IsBool v y) + (hxy : CommonReduct x y) : u = v := by + have h : CommonReduct (if u then S else K) (if v then S else K) := by + apply commonReduct_equivalence.trans (y := x ⬝ S ⬝ K) + · apply commonReduct_equivalence.symm + apply commonReduct_of_single + exact hx S K + · apply commonReduct_equivalence.trans (y := y ⬝ S ⬝ K) + · exact commonReduct_head K <| commonReduct_head S hxy + · apply commonReduct_of_single + exact hy S K + by_cases u + case pos hu => + by_cases v + case pos hv => + rw [hu, hv] + case neg hv => + simp_rw [hu, hv, Bool.false_eq_true, reduceIte] at h + exact False.elim <| sk_nequiv h + case neg hu => + by_cases v + case pos hv => + simp_rw [hu, hv, Bool.false_eq_true, reduceIte] at h + exact False.elim <| sk_nequiv (commonReduct_equivalence.symm h) + case neg hv => + simp_rw [hu, hv] + +lemma TF_nequiv : ¬ CommonReduct TT FF := fun h => + (Bool.eq_not_self true).mp <| isBool_injective TT FF true false TT_correct FF_correct h + +/-- A specialisation of `Church : Nat → SKI`. -/ +def churchK : Nat → SKI + | 0 => K + | n+1 => K ⬝ (churchK n) + +lemma churchK_church : (n : Nat) → churchK n = Church n K K + | 0 => rfl + | n+1 => by simp [churchK, Church, churchK_church n] + +lemma churchK_redexFree : (n : Nat) → RedexFree (churchK n) + | 0 => trivial + | n+1 => churchK_redexFree n + +@[simp] +lemma churchK_size : (n : Nat) → (churchK n).size = n+1 + | 0 => rfl + | n + 1 => by rw [churchK, size, size, churchK_size, Nat.add_comm] + +lemma churchK_injective : Function.Injective churchK := + fun n m h => by simpa using congrArg SKI.size h + +theorem isChurch_injective (x y : SKI) (n m : Nat) (hx : IsChurch n x) (hy : IsChurch m y) + (hxy : CommonReduct x y) : n = m := by + suffices CommonReduct (churchK n) (churchK m) by + apply churchK_injective + exact unique_normal_form' this (churchK_redexFree n) (churchK_redexFree m) + apply commonReduct_equivalence.trans (y := x ⬝ K ⬝ K) + · simp_rw [churchK_church] + exact commonReduct_equivalence.symm <| commonReduct_of_single (hx K K) + · apply commonReduct_equivalence.trans (y := y ⬝ K ⬝ K) + · apply commonReduct_head; apply commonReduct_head; assumption + · simp_rw [churchK_church] + exact commonReduct_of_single (hy K K) + + +/-- **Rice's theorem**: no SKI term is a non-trivial predicate. -/ +theorem rice {P : SKI} (hP : ∀ x : SKI, (P ⬝ x ↠ TT) ∨ P ⬝ x ↠ FF) + (hxt : ∃ x : SKI, P ⬝ x ↠ TT) (hxf : ∃ x : SKI, P ⬝ x ↠ FF) : False := by + obtain ⟨a, ha⟩ := hxt + obtain ⟨b, hb⟩ := hxf + let Neg : SKI := S ⬝ (S ⬝ P ⬝ (K ⬝ b)) ⬝ (K ⬝ a) + let Abs : SKI := Neg.fixedPoint + have Neg_app : ∀ x : SKI, Neg ⬝ x ↠ P ⬝ x ⬝ b ⬝ a := fun x => calc + _ ↠ S ⬝ P ⬝ (K ⬝ b) ⬝ x ⬝ ((K ⬝ a) ⬝ x) := MRed.S .. + _ ↠ P ⬝ x ⬝ (K ⬝ b ⬝ x) ⬝ a := by apply parallel_mRed; apply MRed.S; apply MRed.K + _ ↠ P ⬝ x ⬝ b ⬝ a := by apply MRed.head; apply MRed.tail; apply MRed.K + cases hP Abs + case inl h => + have : P ⬝ Abs ↠ FF := calc + _ ↠ P ⬝ (Neg ⬝ Abs) := by apply MRed.tail; apply fixedPoint_correct + _ ↠ P ⬝ (P ⬝ Abs ⬝ b ⬝ a) := by apply MRed.tail; apply Neg_app + _ ↠ P ⬝ (TT ⬝ b ⬝ a) := by apply MRed.tail; apply MRed.head; apply MRed.head; exact h + _ ↠ P ⬝ b := by apply MRed.tail; apply TT_correct + _ ↠ FF := hb + exact TF_nequiv <| MRed.diamond _ _ _ h this + case inr h => + have : P ⬝ Abs ↠ TT := calc + _ ↠ P ⬝ (Neg ⬝ Abs) := by apply MRed.tail; apply fixedPoint_correct + _ ↠ P ⬝ (P ⬝ Abs ⬝ b ⬝ a) := by apply MRed.tail; apply Neg_app + _ ↠ P ⬝ (FF ⬝ b ⬝ a) := by apply MRed.tail; apply MRed.head; apply MRed.head; exact h + _ ↠ P ⬝ a := by apply MRed.tail; apply FF_correct + _ ↠ TT := ha + exact TF_nequiv <| MRed.diamond _ _ _ this h From 86c8407487c56d559b0b64a66243fd09f184447e Mon Sep 17 00:00:00 2001 From: twwar Date: Fri, 5 Sep 2025 16:46:47 +0200 Subject: [PATCH 004/107] rice's theorem --- .../Computability/CombinatoryLogic/Defs.lean | 12 ++ .../CombinatoryLogic/Evaluation.lean | 115 +++++++++++++++++- 2 files changed, 126 insertions(+), 1 deletion(-) diff --git a/Cslib/Computability/CombinatoryLogic/Defs.lean b/Cslib/Computability/CombinatoryLogic/Defs.lean index 168a92f0..1199f83e 100644 --- a/Cslib/Computability/CombinatoryLogic/Defs.lean +++ b/Cslib/Computability/CombinatoryLogic/Defs.lean @@ -57,6 +57,12 @@ lemma applyList_concat (f : SKI) (ys : List SKI) (z : SKI) : f.applyList (ys ++ [z]) = f.applyList ys ⬝ z := by simp [applyList] +/-- The size of an SKI term is its number of combinators. -/ +def size : SKI → Nat + | S => 1 + | K => 1 + | I => 1 + | x ⬝ y => size x + size y /-! ### Reduction relations between SKI terms -/ @@ -136,3 +142,9 @@ lemma commonReduct_of_single {a b : SKI} (h : a ↠ b) : CommonReduct a b := ⟨ theorem symmetric_commonReduct : Symmetric CommonReduct := Relation.symmetric_join theorem reflexive_commonReduct : Reflexive CommonReduct := λ x => by refine ⟨x,?_,?_⟩ <;> rfl + +theorem commonReduct_head {x x' : SKI} (y : SKI) : CommonReduct x x' → CommonReduct (x ⬝ y) (x' ⬝ y) + | ⟨z, hz, hz'⟩ => ⟨z ⬝ y, MRed.head y hz, MRed.head y hz'⟩ + +theorem commonReduct_tail (x : SKI) {y y' : SKI} : CommonReduct y y' → CommonReduct (x ⬝ y) (x ⬝ y') + | ⟨z, hz, hz'⟩ => ⟨x ⬝ z, MRed.tail x hz, MRed.tail x hz'⟩ diff --git a/Cslib/Computability/CombinatoryLogic/Evaluation.lean b/Cslib/Computability/CombinatoryLogic/Evaluation.lean index 7c73c3a9..6e7bc7f8 100644 --- a/Cslib/Computability/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Computability/CombinatoryLogic/Evaluation.lean @@ -4,7 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Waring -/ import Cslib.Computability.CombinatoryLogic.Defs +import Cslib.Computability.CombinatoryLogic.Basic import Cslib.Computability.CombinatoryLogic.Confluence +import Cslib.Computability.CombinatoryLogic.Recursion +import Mathlib.Tactic.Common /-! # Evaluation results @@ -176,4 +179,114 @@ lemma unique_normal_form {x y z : SKI} (hxy : x ↠ y) (hxz : x ↠ z) (hy : RedexFree y) (hz : RedexFree z) : y = z := (redexFree_iff'.1 hy _).1 (confluent_redexFree hxy hxz hz) -#check +lemma unique_normal_form' {x y : SKI} (h : CommonReduct x y) + (hx : RedexFree x) (hy : RedexFree y) : x = y := + (redexFree_iff'.1 hx _).1 (commonReduct_redexFree hy h) + +/-! ### Injectivity for datatypes -/ + +lemma sk_nequiv : ¬ CommonReduct S K := by + intro ⟨z, hsz, hkz⟩ + have hS : RedexFree S := by simp [RedexFree] + have hK : RedexFree K := by simp [RedexFree] + cases (redexFree_iff'.1 hS z).1 hsz + cases (redexFree_iff'.1 hK _).1 hkz + +/-- Injectivity for booleans. -/ +theorem isBool_injective (x y : SKI) (u v : Bool) (hx : IsBool u x) (hy : IsBool v y) + (hxy : CommonReduct x y) : u = v := by + have h : CommonReduct (if u then S else K) (if v then S else K) := by + apply commonReduct_equivalence.trans (y := x ⬝ S ⬝ K) + · apply commonReduct_equivalence.symm + apply commonReduct_of_single + exact hx S K + · apply commonReduct_equivalence.trans (y := y ⬝ S ⬝ K) + · exact commonReduct_head K <| commonReduct_head S hxy + · apply commonReduct_of_single + exact hy S K + by_cases u + case pos hu => + by_cases v + case pos hv => + rw [hu, hv] + case neg hv => + simp_rw [hu, hv, Bool.false_eq_true, reduceIte] at h + exact False.elim <| sk_nequiv h + case neg hu => + by_cases v + case pos hv => + simp_rw [hu, hv, Bool.false_eq_true, reduceIte] at h + exact False.elim <| sk_nequiv (commonReduct_equivalence.symm h) + case neg hv => + simp_rw [hu, hv] + +lemma TF_nequiv : ¬ CommonReduct TT FF := fun h => + (Bool.eq_not_self true).mp <| isBool_injective TT FF true false TT_correct FF_correct h + +/-- A specialisation of `Church : Nat → SKI`. -/ +def churchK : Nat → SKI + | 0 => K + | n+1 => K ⬝ (churchK n) + +lemma churchK_church : (n : Nat) → churchK n = Church n K K + | 0 => rfl + | n+1 => by simp [churchK, Church, churchK_church n] + +lemma churchK_redexFree : (n : Nat) → RedexFree (churchK n) + | 0 => trivial + | n+1 => churchK_redexFree n + +@[simp] +lemma churchK_size : (n : Nat) → (churchK n).size = n+1 + | 0 => rfl + | n + 1 => by rw [churchK, size, size, churchK_size, Nat.add_comm] + +lemma churchK_injective : Function.Injective churchK := + fun n m h => by simpa using congrArg SKI.size h + +theorem isChurch_injective (x y : SKI) (n m : Nat) (hx : IsChurch n x) (hy : IsChurch m y) + (hxy : CommonReduct x y) : n = m := by + suffices CommonReduct (churchK n) (churchK m) by + apply churchK_injective + exact unique_normal_form' this (churchK_redexFree n) (churchK_redexFree m) + apply commonReduct_equivalence.trans (y := x ⬝ K ⬝ K) + · simp_rw [churchK_church] + exact commonReduct_equivalence.symm <| commonReduct_of_single (hx K K) + · apply commonReduct_equivalence.trans (y := y ⬝ K ⬝ K) + · apply commonReduct_head; apply commonReduct_head; assumption + · simp_rw [churchK_church] + exact commonReduct_of_single (hy K K) + +/-- **Rice's theorem**: no SKI term is a non-trivial predicate. -/ +theorem rice {P : SKI} (hP : ∀ x : SKI, (P ⬝ x ↠ TT) ∨ P ⬝ x ↠ FF) + (hxt : ∃ x : SKI, P ⬝ x ↠ TT) (hxf : ∃ x : SKI, P ⬝ x ↠ FF) : False := by + obtain ⟨a, ha⟩ := hxt + obtain ⟨b, hb⟩ := hxf + let Neg : SKI := P ⬝' &0 ⬝' b ⬝' a |>.toSKI (n := 1) + let Abs : SKI := Neg.fixedPoint + have Neg_app : ∀ x : SKI, Neg ⬝ x ↠ P ⬝ x ⬝ b ⬝ a := + fun x => (P ⬝' &0 ⬝' b ⬝' a) |>.toSKI_correct (n := 1) [x] (by simp) + cases hP Abs + case inl h => + have : P ⬝ Abs ↠ FF := calc + _ ↠ P ⬝ (Neg ⬝ Abs) := by apply MRed.tail; apply fixedPoint_correct + _ ↠ P ⬝ (P ⬝ Abs ⬝ b ⬝ a) := by apply MRed.tail; apply Neg_app + _ ↠ P ⬝ (TT ⬝ b ⬝ a) := by apply MRed.tail; apply MRed.head; apply MRed.head; exact h + _ ↠ P ⬝ b := by apply MRed.tail; apply TT_correct + _ ↠ FF := hb + exact TF_nequiv <| MRed.diamond _ _ _ h this + case inr h => + have : P ⬝ Abs ↠ TT := calc + _ ↠ P ⬝ (Neg ⬝ Abs) := by apply MRed.tail; apply fixedPoint_correct + _ ↠ P ⬝ (P ⬝ Abs ⬝ b ⬝ a) := by apply MRed.tail; apply Neg_app + _ ↠ P ⬝ (FF ⬝ b ⬝ a) := by apply MRed.tail; apply MRed.head; apply MRed.head; exact h + _ ↠ P ⬝ a := by apply MRed.tail; apply FF_correct + _ ↠ TT := ha + exact TF_nequiv <| MRed.diamond _ _ _ this h + +/-- **Rice's theorem**: any SKI predicate is trivial. -/ +theorem rice' {P : SKI} (hP : ∀ x : SKI, (P ⬝ x ↠ TT) ∨ P ⬝ x ↠ FF) : + (∀ x : SKI, P ⬝ x ↠ TT) ∨ (∀ x : SKI, P ⬝ x ↠ FF) := by + by_contra! h + obtain ⟨⟨a, ha⟩, b, hb⟩ := h + exact rice hP ⟨b, (hP _).resolve_right hb⟩ ⟨a, (hP _).resolve_left ha⟩ From 7df191082d000b60e0a1733da81a14e85649cd41 Mon Sep 17 00:00:00 2001 From: twwar Date: Fri, 5 Sep 2025 16:58:50 +0200 Subject: [PATCH 005/107] documentation --- .../CombinatoryLogic/Evaluation.lean | 24 +++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/Cslib/Computability/CombinatoryLogic/Evaluation.lean b/Cslib/Computability/CombinatoryLogic/Evaluation.lean index 6e7bc7f8..4a232f2c 100644 --- a/Cslib/Computability/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Computability/CombinatoryLogic/Evaluation.lean @@ -12,6 +12,24 @@ import Mathlib.Tactic.Common /-! # Evaluation results +This file formalises evaluation and normal forms of SKI terms. + +## Main definitions + +- `RedexFree` : a predicate expressing that a term has no redexes +- `evalStep` : SKI-reduction as a function + +## Main results + +- `evalStep_right_correct` : correctness for `evalStep` +- `redexFree_iff` and `redexFree_iff'` : a term is redex free if and only if it has (respectively) +no one-step reductions, or if its only many step reduction is itself. +- `unique_normal_form` : if `x` reduces to both `y` and `z`, and both `y` and `z` are in normal +form, then they are equal. +- **Rice's theorem**: no SKI term is a non-trivial predicate. + +## References + This file draws heavily from -/ @@ -124,7 +142,7 @@ theorem RedexFree.no_red : {x : SKI} → RedexFree x → ∀ y, ¬ (x ⭢ y) theorem redexFree_iff {x : SKI} : RedexFree x ↔ ∀ y, ¬ (x ⭢ y) := ⟨RedexFree.no_red, redexFree_of_no_red⟩ -theorem redexFree_iff_onceEval {x : SKI} : RedexFree x ↔ (evalStep x).isLeft = true := by +theorem redexFree_iff_evalStep {x : SKI} : RedexFree x ↔ (evalStep x).isLeft = true := by constructor case mp => intro h @@ -137,7 +155,7 @@ theorem redexFree_iff_onceEval {x : SKI} : RedexFree x ↔ (evalStep x).isLeft = | Sum.inl h' => exact h'.down | Sum.inr y => rw [hx] at h; cases h -instance : DecidablePred RedexFree := fun _ => decidable_of_iff' _ redexFree_iff_onceEval +instance : DecidablePred RedexFree := fun _ => decidable_of_iff' _ redexFree_iff_evalStep /-- A term is redex free iff its only many-step reduction is itself. -/ theorem redexFree_iff' {x : SKI} : RedexFree x ↔ ∀ y, (x ↠ y) ↔ x = y := by @@ -179,6 +197,7 @@ lemma unique_normal_form {x y z : SKI} (hxy : x ↠ y) (hxz : x ↠ z) (hy : RedexFree y) (hz : RedexFree z) : y = z := (redexFree_iff'.1 hy _).1 (confluent_redexFree hxy hxz hz) +/-- If `x` and `y` are normal and have a common reduct, then they are equal. -/ lemma unique_normal_form' {x y : SKI} (h : CommonReduct x y) (hx : RedexFree x) (hy : RedexFree y) : x = y := (redexFree_iff'.1 hx _).1 (commonReduct_redexFree hy h) @@ -244,6 +263,7 @@ lemma churchK_size : (n : Nat) → (churchK n).size = n+1 lemma churchK_injective : Function.Injective churchK := fun n m h => by simpa using congrArg SKI.size h +/-- Injectivity for Church numerals-/ theorem isChurch_injective (x y : SKI) (n m : Nat) (hx : IsChurch n x) (hy : IsChurch m y) (hxy : CommonReduct x y) : n = m := by suffices CommonReduct (churchK n) (churchK m) by From e693e051673c0c5e7a4901c8dd3ba76cc70fdc25 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Maximiliano=20Onofre-Mart=C3=ADnez?= Date: Mon, 21 Jul 2025 13:26:55 -0600 Subject: [PATCH 006/107] Add proofs for tensor-zero and parr-top equivalences (#15) * add tensor zero eqv * add parr top eqv * use notation for zero and top * add parr and tensor scoped notation --- Cslib/Logic/LinearLogic/CLL/Basic.lean | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/Cslib/Logic/LinearLogic/CLL/Basic.lean b/Cslib/Logic/LinearLogic/CLL/Basic.lean index 6608ce3f..ec407541 100644 --- a/Cslib/Logic/LinearLogic/CLL/Basic.lean +++ b/Cslib/Logic/LinearLogic/CLL/Basic.lean @@ -56,6 +56,9 @@ instance : Top (@Proposition Atom) where instance : Bot (@Proposition Atom) where bot := Proposition.bot +scoped infix:35 " ⊗ " => Proposition.tensor +scoped infix:30 " ⅋ " => Proposition.parr + /-- Positive propositions. -/ def Proposition.Pos (a : @Proposition Atom) : Prop := match a with @@ -169,7 +172,7 @@ section LogicalEquiv /-- Two propositions are equivalent if one implies the other and vice versa. -/ def Proposition.equiv (a b : @Proposition Atom) : Prop := ⊢[a.dual, b] ∧ ⊢[b.dual, a] -scoped infix:90 " ≡ " => Proposition.equiv +scoped infix:29 " ≡ " => Proposition.equiv namespace Proposition @@ -195,6 +198,26 @@ theorem quest_zero_eqv_bot : (@quest Atom 0) ≡ ⊥ := by apply Proof.weaken exact Proof.one +/-- a ⊗ 0 ≡ 0 -/ +theorem tensor_zero_eqv_zero (a : @Proposition Atom) : + a ⊗ 0 ≡ 0 := by + constructor + · apply Proof.parr + apply Proof.exchange (List.Perm.swap a.dual (top) [zero]) + exact Proof.top + · exact Proof.top + +/-- a ⅋ ⊤ ≡ ⊤ -/ +theorem parr_top_eqv_top (a : @Proposition Atom) : + a ⅋ ⊤ ≡ ⊤ := by + constructor + · apply Proof.exchange (List.Perm.swap (parr a top).dual top []) + exact Proof.top + · apply Proof.exchange (List.Perm.swap top.dual (parr a top) []) + apply Proof.parr + apply Proof.exchange (List.Perm.swap a top [top.dual]) + exact Proof.top + end Proposition end LogicalEquiv From 6993f889cc5158bccd3852e3f4531185ee395b85 Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Mon, 21 Jul 2025 15:30:37 -0400 Subject: [PATCH 007/107] Locally Nameless Beta Confluence (#11) * confluence * non-terminal simps * style * use reduction_sys * non-terminal simp * remove redundant lemma * update TODO * style * fix Trans instances * use Trans instance for brevity * add a reference * para_lc_l and para_lc_r as * naming conventions * change confusing names * aesop ruleset * rm unused lemma * ASCII arrows * missed rule_sets * use proof irrelevance * style * namespace rule set --- .../Untyped/LocallyNameless/AesopRuleset.lean | 3 + .../Untyped/LocallyNameless/Basic.lean | 74 ++++- .../Untyped/LocallyNameless/FullBeta.lean | 122 +++++++++ .../LocallyNameless/FullBetaConfluence.lean | 254 ++++++++++++++++++ .../Untyped/LocallyNameless/Properties.lean | 126 ++++----- Cslib/Semantics/ReductionSystem/Basic.lean | 6 +- Cslib/Utils/Relation.lean | 37 ++- CslibTests/ReductionSystem.lean | 2 +- 8 files changed, 525 insertions(+), 99 deletions(-) create mode 100644 Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/AesopRuleset.lean create mode 100644 Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBeta.lean create mode 100644 Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/AesopRuleset.lean b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/AesopRuleset.lean new file mode 100644 index 00000000..1e43b5ba --- /dev/null +++ b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/AesopRuleset.lean @@ -0,0 +1,3 @@ +import Aesop + +declare_aesop_rule_sets [LambdaCalculus.LocallyNameless.ruleSet] (default := true) diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean index 7b3038e2..646cae50 100644 --- a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean @@ -6,6 +6,7 @@ Authors: Chris Henson import Cslib.Data.HasFresh import Cslib.Syntax.HasSubstitution +import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.AesopRuleset /-! # λ-calculus @@ -36,9 +37,10 @@ inductive Term (Var : Type u) /-- Function application. -/ | app : Term Var → Term Var → Term Var +namespace Term + /-- Variable opening of the ith bound variable. -/ -@[simp] -def Term.openRec (i : ℕ) (sub : Term Var) : Term Var → Term Var +def openRec (i : ℕ) (sub : Term Var) : Term Var → Term Var | bvar i' => if i = i' then sub else bvar i' | fvar x => fvar x | app l r => app (openRec i sub l) (openRec i sub r) @@ -46,15 +48,25 @@ def Term.openRec (i : ℕ) (sub : Term Var) : Term Var → Term Var scoped notation:68 e "⟦" i " ↝ " sub "⟧"=> Term.openRec i sub e +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma openRec_bvar : (bvar i')⟦i ↝ s⟧ = if i = i' then s else bvar i' := by rfl + +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma openRec_fvar : (fvar x)⟦i ↝ s⟧ = fvar x := by rfl + +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma openRec_app : (app l r)⟦i ↝ s⟧ = app (l⟦i ↝ s⟧) (r⟦i ↝ s⟧) := by rfl + +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma openRec_abs : M.abs⟦i ↝ s⟧ = M⟦i + 1 ↝ s⟧.abs := by rfl + /-- Variable opening of the closest binding. -/ -@[simp] -def Term.open' {X} (e u):= @Term.openRec X 0 u e +def open' {X} (e u):= @Term.openRec X 0 u e infixr:80 " ^ " => Term.open' /-- Variable closing, replacing a free `fvar x` with `bvar k` -/ -@[simp] -def Term.closeRec (k : ℕ) (x : Var) : Term Var → Term Var +def closeRec (k : ℕ) (x : Var) : Term Var → Term Var | fvar x' => if x = x' then bvar k else fvar x' | bvar i => bvar i | app l r => app (closeRec k x l) (closeRec k x r) @@ -62,15 +74,31 @@ def Term.closeRec (k : ℕ) (x : Var) : Term Var → Term Var scoped notation:68 e "⟦" k " ↜ " x "⟧"=> Term.closeRec k x e +variable {x : Var} + +omit [HasFresh Var] in +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma closeRec_bvar : (bvar i)⟦k ↜ x⟧ = bvar i := by rfl + +omit [HasFresh Var] in +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma closeRec_fvar : (fvar x')⟦k ↜ x⟧ = if x = x' then bvar k else fvar x' := by rfl + +omit [HasFresh Var] in +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma closeRec_app : (app l r)⟦k ↜ x⟧ = app (l⟦k ↜ x⟧) (r⟦k ↜ x⟧) := by rfl + +omit [HasFresh Var] in +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma closeRec_abs : t.abs⟦k ↜ x⟧ = t⟦k + 1 ↜ x⟧.abs := by rfl + /-- Variable closing of the closest binding. -/ -@[simp] -def Term.close {Var} [DecidableEq Var] (e u):= @Term.closeRec Var _ 0 u e +def close {Var} [DecidableEq Var] (e u):= @Term.closeRec Var _ 0 u e infixr:80 " ^* " => Term.close /- Substitution of a free variable to a term. -/ -@[simp] -def Term.subst (m : Term Var) (x : Var) (sub : Term Var) : Term Var := +def subst (m : Term Var) (x : Var) (sub : Term Var) : Term Var := match m with | bvar i => bvar i | fvar x' => if x = x' then sub else fvar x' @@ -78,20 +106,40 @@ def Term.subst (m : Term Var) (x : Var) (sub : Term Var) : Term Var := | abs M => abs $ M.subst x sub /-- `Term.subst` is a substitution for λ-terms. Gives access to the notation `m[x := n]`. -/ -@[simp] instance instHasSubstitutionTerm : HasSubstitution (Term Var) Var where subst := Term.subst +omit [HasFresh Var] in +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma subst_bvar {n : Term Var} : (bvar i)[x := n] = bvar i := by rfl + +omit [HasFresh Var] in +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma subst_fvar : (fvar x')[x := n] = if x = x' then n else fvar x' := by rfl + +omit [HasFresh Var] in +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma subst_app {l r : Term Var} : (app l r)[x := n] = app (l[x := n]) (r[x := n]) := by rfl + +omit [HasFresh Var] in +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma subst_abs {M : Term Var} : M.abs[x := n] = M[x := n].abs := by rfl + +omit [HasFresh Var] in +@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma subst_def (m : Term Var) (x : Var) (n : Term Var) : m.subst x n = m[x := n] := by rfl + /-- Free variables of a term. -/ @[simp] -def Term.fv : Term Var → Finset Var +def fv : Term Var → Finset Var | bvar _ => {} | fvar x => {x} | abs e1 => e1.fv | app l r => l.fv ∪ r.fv /-- Locally closed terms. -/ -inductive Term.LC : Term Var → Prop +@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet]) [constructors]] +inductive LC : Term Var → Prop | fvar (x) : LC (fvar x) | abs (L : Finset Var) (e : Term Var) : (∀ x : Var, x ∉ L → LC (e ^ fvar x)) → LC (abs e) | app {l r} : l.LC → r.LC → LC (app l r) diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBeta.lean b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBeta.lean new file mode 100644 index 00000000..35bc61bc --- /dev/null +++ b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBeta.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2025 Chris Henson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Henson +-/ + +import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Basic +import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Properties +import Cslib.Semantics.ReductionSystem.Basic + +/-! # β-reduction for the λ-calculus + +## References + +* [A. Chargueraud, *The Locally Nameless Representation*] [Chargueraud2012] +* See also https://www.cis.upenn.edu/~plclub/popl08-tutorial/code/, from which + this is partially adapted + +-/ + +universe u + +variable {Var : Type u} + +namespace LambdaCalculus.LocallyNameless.Term + +/-- A single β-reduction step. -/ +@[reduction_sys fullBetaRs "βᶠ"] +inductive FullBeta : Term Var → Term Var → Prop +/-- Reduce an application to a lambda term. -/ +| beta : LC (abs M)→ LC N → FullBeta (app (abs M) N) (M ^ N) +/-- Left congruence rule for application. -/ +| appL: LC Z → FullBeta M N → FullBeta (app Z M) (app Z N) +/-- Right congruence rule for application. -/ +| appR : LC Z → FullBeta M N → FullBeta (app M Z) (app N Z) +/-- Congruence rule for lambda terms. -/ +| abs (xs : Finset Var) : (∀ x ∉ xs, FullBeta (M ^ fvar x) (N ^ fvar x)) → FullBeta (abs M) (abs N) + +namespace FullBeta + +variable {M M' N N' : Term Var} + +/-- The left side of a reduction is locally closed. -/ +lemma step_lc_l (step : M ⭢βᶠ M') : LC M := by + induction step <;> constructor + all_goals assumption + +/-- Left congruence rule for application in multiple reduction.-/ +theorem redex_app_l_cong : (M ↠βᶠ M') → LC N → (app M N ↠βᶠ app M' N) := by + intros redex lc_N + induction' redex + case refl => rfl + case tail ih r => exact Relation.ReflTransGen.tail r (appR lc_N ih) + +/-- Right congruence rule for application in multiple reduction.-/ +theorem redex_app_r_cong : (M ↠βᶠ M') → LC N → (app N M ↠βᶠ app N M') := by + intros redex lc_N + induction' redex + case refl => rfl + case tail ih r => exact Relation.ReflTransGen.tail r (appL lc_N ih) + +variable [HasFresh Var] [DecidableEq Var] + +/-- The right side of a reduction is locally closed. -/ +lemma step_lc_r (step : M ⭢βᶠ M') : LC M' := by + induction step + case beta => apply beta_lc <;> assumption + all_goals try constructor <;> assumption + +/-- Substitution respects a single reduction step. -/ +lemma redex_subst_cong (s s' : Term Var) (x y : Var) : (s ⭢βᶠ s') → (s [ x := fvar y ]) ⭢βᶠ (s' [ x := fvar y ]) := by + intros step + induction step + case appL ih => exact appL (subst_lc (by assumption) (by constructor)) ih + case appR ih => exact appR (subst_lc (by assumption) (by constructor)) ih + case beta m n abs_lc n_lc => + cases abs_lc with | abs xs _ mem => + simp only [open'] + rw [subst_open x (fvar y) 0 n m (by constructor)] + refine beta ?_ (subst_lc n_lc (by constructor)) + exact subst_lc (LC.abs xs m mem) (LC.fvar y) + case abs m' m xs mem ih => + apply abs ({x} ∪ xs) + intros z z_mem + simp only [open'] + rw [ + subst_def, subst_def, + ←subst_fresh x (fvar z) (fvar y), ←subst_open x (fvar y) 0 (fvar z) m (by constructor), + subst_fresh x (fvar z) (fvar y), ←subst_fresh x (fvar z) (fvar y), + ←subst_open x (fvar y) 0 (fvar z) m' (by constructor), subst_fresh x (fvar z) (fvar y) + ] + apply ih + all_goals aesop + +/-- Abstracting then closing preserves a single reduction. -/ +lemma step_abs_close {x : Var} : (M ⭢βᶠ M') → (M⟦0 ↜ x⟧.abs ⭢βᶠ M'⟦0 ↜ x⟧.abs) := by + intros step + apply abs ∅ + intros y _ + simp only [open'] + repeat rw [open_close_to_subst] + exact redex_subst_cong M M' x y step + exact step_lc_r step + exact step_lc_l step + +/-- Abstracting then closing preserves multiple reductions. -/ +lemma redex_abs_close {x : Var} : (M ↠βᶠ M') → (M⟦0 ↜ x⟧.abs ↠βᶠ M'⟦0 ↜ x⟧.abs) := by + intros step + induction step using Relation.ReflTransGen.trans_induction_on + case ih₁ => rfl + case ih₂ ih => exact Relation.ReflTransGen.single (step_abs_close ih) + case ih₃ l r => trans; exact l; exact r + +/-- Multiple reduction of opening implies multiple reduction of abstraction. -/ +theorem redex_abs_cong (xs : Finset Var) : (∀ x ∉ xs, (M ^ fvar x) ↠βᶠ (M' ^ fvar x)) → M.abs ↠βᶠ M'.abs := by + intros mem + have ⟨fresh, union⟩ := fresh_exists (xs ∪ M.fv ∪ M'.fv) + simp only [Finset.union_assoc, Finset.mem_union, not_or] at union + obtain ⟨_, _, _⟩ := union + rw [←open_close fresh M 0 ?_, ←open_close fresh M' 0 ?_] + refine redex_abs_close (mem fresh ?_) + all_goals assumption diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean new file mode 100644 index 00000000..5dfc85ba --- /dev/null +++ b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean @@ -0,0 +1,254 @@ +/- +Copyright (c) 2025 Chris Henson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Henson +-/ + +import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Basic +import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Properties +import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.FullBeta +import Cslib.Utils.Relation + +/-! # β-confluence for the λ-calculus -/ + +universe u + +variable {Var : Type u} + +namespace LambdaCalculus.LocallyNameless.Term + +/-- A parallel β-reduction step. -/ +@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet]) [constructors], reduction_sys paraRs "ₚ"] +inductive Parallel : Term Var → Term Var → Prop +/-- Free variables parallel step to themselves. -/ +| fvar (x : Var) : Parallel (fvar x) (fvar x) +/-- A parallel left and right congruence rule for application. -/ +| app : Parallel L L' → Parallel M M' → Parallel (app L M) (app L' M') +/-- Congruence rule for lambda terms. -/ +| abs (xs : Finset Var) : (∀ x ∉ xs, Parallel (m ^ fvar x) (m' ^ fvar x)) → Parallel (abs m) (abs m') +/-- A parallel β-reduction. -/ +| beta (xs : Finset Var) : + (∀ x ∉ xs, Parallel (m ^ fvar x) (m' ^ fvar x) ) → + Parallel n n' → + Parallel (app (abs m) n) (m' ^ n') + +-- TODO: I think this could be generated along with `para_rs` +lemma para_rs_Red_eq {α} : (@paraRs α).Red = Parallel := by rfl + +variable {M M' N N' : Term Var} + +/-- The left side of a parallel reduction is locally closed. -/ +@[aesop unsafe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma para_lc_l (step : M ⭢ₚ N) : LC M := by + induction step + case abs _ _ xs _ ih => exact LC.abs xs _ ih + case beta => refine LC.app (LC.abs ?_ _ ?_) ?_ <;> assumption + all_goals constructor <;> assumption + +variable [HasFresh Var] [DecidableEq Var] + +/-- The right side of a parallel reduction is locally closed. -/ +@[aesop unsafe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma para_lc_r (step : M ⭢ₚ N) : LC N := by + induction step + case abs _ _ xs _ ih => exact LC.abs xs _ ih + case beta => refine beta_lc (LC.abs ?_ _ ?_) ?_ <;> assumption + all_goals constructor <;> assumption + +/-- Parallel reduction is reflexive for locally closed terms. -/ +@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +def Parallel.lc_refl (M : Term Var) : LC M → M ⭢ₚ M := by + intros lc + induction lc + all_goals constructor <;> assumption + +-- TODO: better ways to handle this? +-- The problem is that sometimes when we apply a theorem we get out of our notation, so aesop can't +-- see they are the same, including constructors. +@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +def Parallel.lc_refl' (M : Term Var) : LC M → Parallel M M := Parallel.lc_refl M + +omit [HasFresh Var] [DecidableEq Var] in +/-- A single β-reduction implies a single parallel reduction. -/ +lemma step_to_para (step : M ⭢βᶠ N) : (M ⭢ₚ N) := by + induction step <;> simp only [para_rs_Red_eq] + case beta _ abs_lc _ => cases abs_lc with | abs xs _ => + apply Parallel.beta xs <;> intros <;> apply Parallel.lc_refl <;> aesop + all_goals aesop (config := {enableSimp := false}) + +open FullBeta in +/-- A single parallel reduction implies a multiple β-reduction. -/ +lemma para_to_redex (para : M ⭢ₚ N) : (M ↠βᶠ N) := by + induction para + case fvar => constructor + case app _ _ _ _ l_para m_para redex_l redex_m => + trans + exact redex_app_l_cong redex_l (para_lc_l m_para) + exact redex_app_r_cong redex_m (para_lc_r l_para) + case abs t t' xs _ ih => + apply redex_abs_cong xs + intros x mem + exact ih x mem + case beta m m' n n' xs para_ih para_n redex_ih redex_n => + have m'_abs_lc : LC m'.abs := by + apply LC.abs xs + intros _ mem + exact para_lc_r (para_ih _ mem) + calc + m.abs.app n ↠βᶠ m'.abs.app n := redex_app_l_cong (redex_abs_cong xs (λ _ mem ↦ redex_ih _ mem)) (para_lc_l para_n) + _ ↠βᶠ m'.abs.app n' := redex_app_r_cong redex_n m'_abs_lc + _ ⭢βᶠ m' ^ n' := beta m'_abs_lc (para_lc_r para_n) + +/-- Multiple parallel reduction is equivalent to multiple β-reduction. -/ +theorem parachain_iff_redex : (M ↠ₚ N) ↔ (M ↠βᶠ N) := by + refine Iff.intro ?chain_to_redex ?redex_to_chain <;> intros h <;> induction' h <;> try rfl + case redex_to_chain.tail redex chain => exact Relation.ReflTransGen.tail chain (step_to_para redex) + case chain_to_redex.tail para redex => exact Relation.ReflTransGen.trans redex (para_to_redex para) + +/-- Parallel reduction respects substitution. -/ +lemma para_subst (x : Var) : (M ⭢ₚ M') → (N ⭢ₚ N') → (M[x := N] ⭢ₚ M'[x := N']) := by + intros pm pn + induction pm + case fvar => aesop + case beta _ _ _ _ xs _ _ ih _ => + simp only [open'] + rw [subst_open _ _ _ _ _ (para_lc_r pn)] + apply Parallel.beta (xs ∪ {x}) + intros y ymem + simp only [Finset.mem_union, Finset.mem_singleton, not_or] at ymem + push_neg at ymem + rw [ + subst_def, + subst_open_var _ _ _ _ _ (para_lc_r pn), + subst_open_var _ _ _ _ _ (para_lc_l pn) + ] + apply ih + all_goals aesop + case app => constructor <;> assumption + case abs u u' xs mem ih => + apply Parallel.abs (xs ∪ {x}) + intros y ymem + simp only [Finset.mem_union, Finset.mem_singleton, not_or] at ymem + repeat rw [subst_def] + rw [subst_open_var _ _ _ _ ?_ (para_lc_l pn), subst_open_var _ _ _ _ ?_ (para_lc_r pn)] + push_neg at ymem + apply ih + all_goals aesop + +/-- Parallel substitution respects closing and opening. -/ +lemma para_open_close (x y z) : + (M ⭢ₚ M') → + y ∉ (M.fv ∪ M'.fv ∪ {x}) → + M⟦z ↜ x⟧⟦z ↝ fvar y⟧ ⭢ₚ M'⟦z ↜ x⟧⟦z ↝ fvar y⟧ + := by + intros para vars + simp only [Finset.union_assoc, Finset.mem_union, Finset.mem_singleton, not_or] at vars + rw [open_close_to_subst, open_close_to_subst] + apply para_subst + exact para + constructor + exact para_lc_r para + exact para_lc_l para + +/-- Parallel substitution respects fresh opening. -/ +lemma para_open_out (L : Finset Var) : + (∀ x, x ∉ L → (M ^ fvar x) ⭢ₚ (N ^ fvar x)) + → (M' ⭢ₚ N') → (M ^ M') ⭢ₚ (N ^ N') := by + intros mem para + let ⟨x, qx⟩ := fresh_exists (L ∪ N.fv ∪ M.fv) + simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx + obtain ⟨q1, q2, q3⟩ := qx + rw [subst_intro x M' _ q3 (para_lc_l para), subst_intro x N' _ q2 (para_lc_r para)] + exact para_subst x (mem x q1) para + +-- TODO: the Takahashi translation would be a much nicer and shorter proof, but I had difficultly +-- writing it for locally nameless terms. + +-- adapted from https://github.com/ElifUskuplu/Stlc_deBruijn/blob/main/Stlc/confluence.lean +/-- Parallel reduction has the diamond property. -/ +theorem para_diamond : Diamond (@Parallel Var) := by + intros t t1 t2 tpt1 + revert t2 + induction tpt1 <;> intros t2 tpt2 + case fvar x => exact ⟨t2, by aesop⟩ + case abs s1 s2' xs mem ih => + cases tpt2 + case abs t2' xs' mem' => + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ t2'.fv ∪ s2'.fv) + simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx + have ⟨q1, q2, q3, q4⟩ := qx + have ⟨t', qt'_l, qt'_r⟩ := ih x q1 (mem' _ q2) + exists abs (t' ^* x) + constructor + <;> [let z := s2'; let z := t2'] + <;> apply Parallel.abs ((z ^ fvar x).fv ∪ t'.fv ∪ {x}) + <;> intros y qy <;> simp only [open', close] + <;> [rw [←open_close x _ 0 q4]; rw [←open_close x _ 0 q3]] + <;> refine para_open_close x y 0 ?_ qy <;> [exact qt'_l; exact qt'_r] + case beta s1 s1' s2 s2' xs mem ps ih1 ih2 => + cases tpt2 + case app u2 u2' s1pu2 s2pu2' => + cases s1pu2 + case abs s1'' xs' mem' => + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ s1''.fv ∪ s1'.fv) + simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx + obtain ⟨q1, q2, q3, q4⟩ := qx + have ⟨t', qt'_l, qt'_r⟩ := ih2 s2pu2' + have ⟨t'', qt''_l, qt''_r⟩ := @ih1 x q1 _ (mem' _ q2) + exists (t'' ^* x) ^ t' + constructor + · rw [subst_intro x s2' _ q4 (para_lc_l qt'_l), + subst_intro x t' _ (close_var_not_fvar x t'') (para_lc_r qt'_l)] + simp only [open', close] + rw [close_open _ _ _ (para_lc_r qt''_l)] + exact para_subst x qt''_l qt'_l + · apply Parallel.beta ((s1'' ^ fvar x).fv ∪ t''.fv ∪ {x}) + intros y qy + rw [←open_close x s1'' 0] + apply para_open_close + all_goals aesop + case beta u1' u2' xs' mem' s2pu2' => + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ u1'.fv ∪ s1'.fv ∪ s2'.fv ∪ u2'.fv) + simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx + have ⟨q1, q2, q3, q4, q5, q6⟩ := qx + have ⟨t', qt'_l, qt'_r⟩ := ih2 s2pu2' + have ⟨t'', qt''_l, qt''_r⟩ := @ih1 x q1 _ (mem' _ q2) + rw [subst_intro x u2' u1' _ (para_lc_l qt'_r), subst_intro x s2' s1' _ (para_lc_l qt'_l)] + exists t'' [x := t'] + exact ⟨para_subst x qt''_l qt'_l, para_subst x qt''_r qt'_r⟩ + all_goals aesop + case app s1 s1' s2 s2' s1ps1' _ ih1 ih2 => + cases tpt2 + case app u1 u2' s1 s2 => + have ⟨l, _, _⟩ := ih1 s1 + have ⟨r, _, _⟩ := ih2 s2 + exact ⟨app l r, by aesop⟩ + case beta t1' u1' u2' xs mem s2pu2' => + cases s1ps1' + case abs s1'' xs' mem' => + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ s1''.fv ∪ u1'.fv) + simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx + obtain ⟨q1, q2, q3, q4⟩ := qx + have ⟨t', qt'_l, qt'_r⟩ := ih2 s2pu2' + have ⟨t'', qt''_l, qt''_r⟩ := @ih1 (abs u1') (Parallel.abs xs mem) + cases qt''_l + next w1 xs'' mem'' => + cases qt''_r + case abs xs''' mem''' => + exists w1 ^ t' + constructor + · aesop (config := {enableSimp := false}) + · exact para_open_out xs''' mem''' qt'_r + +/-- Parallel reduction is confluent. -/ +theorem para_confluence : Confluence (@Parallel Var) := + Relation.ReflTransGen.diamond_confluence para_diamond + +/-- β-reduction is confluent. -/ +theorem confluence_beta : Confluence (@FullBeta Var) := by + simp only [Confluence] + have eq : Relation.ReflTransGen (@Parallel Var) = Relation.ReflTransGen (@FullBeta Var) := by + ext + exact parachain_iff_redex + rw [←eq] + exact @para_confluence Var _ _ diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Properties.lean b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Properties.lean index 2ca6e005..69fbb9b2 100644 --- a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Properties.lean +++ b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Properties.lean @@ -12,44 +12,43 @@ variable {Var : Type u} namespace LambdaCalculus.LocallyNameless.Term +lemma open_app_inj : app l r = (app l r)⟦i ↝ s⟧ ↔ l = l⟦i ↝ s⟧ ∧ r = r⟦i ↝ s⟧ := by + simp [openRec] + +lemma open_abs_inj : M.abs = M⟦i + 1 ↝ s⟧.abs ↔ M = M⟦i + 1 ↝ s⟧ := by + simp + /-- 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), - i ≠ j -> - e ⟦j ↝ v⟧ = (e ⟦j ↝ v⟧) ⟦i ↝ u⟧ -> + i ≠ j → + e ⟦j ↝ v⟧ = (e ⟦j ↝ v⟧) ⟦i ↝ u⟧ → e = e ⟦i ↝ u⟧ := by - induction' e - <;> intros j v i u neq h - <;> simp only [openRec, app.injEq, abs.injEq] at * - case bvar => aesop - case app ih_l ih_r => - obtain ⟨hl, hr⟩ := h + induction' e <;> intros j v i u neq h + case app l r ih_l ih_r => + obtain ⟨hl, hr⟩ := open_app_inj.mp h + simp only [open_app_inj] exact ⟨ih_l j v i u neq hl, ih_r j v i u neq hr⟩ - case abs ih => exact ih (j+1) v (i+1) u (by aesop) h + case abs ih => + simp only [openRec_abs, open_abs_inj] at * + exact ih (j+1) v (i+1) u (by aesop) h + all_goals aesop /-- Opening is associative for nonclashing free variables. -/ lemma swap_open_fvars (k n : ℕ) (x y : Var) (m : Term Var) : k ≠ n → x ≠ y → m⟦n ↝ fvar y⟧⟦k ↝ fvar x⟧ = m⟦k ↝ fvar x⟧⟦n ↝ fvar y⟧ := by revert k n - induction' m <;> intros k n ne_kn ne_xy <;> simp only [openRec, app.injEq, abs.injEq] - case bvar n' => aesop - case abs ih => apply ih <;> aesop - case app => aesop + induction' m <;> aesop variable [DecidableEq Var] /-- Substitution of a free variable not present in a term leaves it unchanged. -/ theorem subst_fresh (x : Var) (t sub : Term Var) : x ∉ t.fv → (t [x := sub]) = t := by - induction t <;> intros <;> aesop + induction t <;> aesop /- Opening and closing are inverses. -/ lemma open_close (x : Var) (t : Term Var) (k : ℕ) : x ∉ t.fv → t⟦k ↝ fvar x⟧⟦k ↜ x⟧ = t := by - intros mem revert k - induction t <;> intros k <;> simp only [openRec, closeRec, app.injEq, abs.injEq] - case bvar n => split <;> simp_all - case abs t ih => exact ih mem (k + 1) - case app l r ih_l ih_r => refine ⟨ih_l ?_ k, ih_r ?_ k⟩ <;> aesop - all_goals aesop + induction t <;> aesop /-- Opening is injective. -/ lemma open_injective (x : Var) (M M' : Term Var) : x ∉ M.fv → x ∉ M'.fv → M ^ fvar x = M' ^ fvar x → M = M' := by @@ -61,49 +60,27 @@ lemma open_injective (x : Var) (M M' : Term Var) : x ∉ M.fv → x ∉ M'.fv lemma swap_open_fvar_close (k n: ℕ) (x y : Var) (m : Term Var) : k ≠ n → x ≠ y → m⟦n ↝ fvar y⟧⟦k ↜ x⟧ = m⟦k ↜ x⟧⟦n ↝ fvar y⟧ := by revert k n - induction' m - <;> intros k n ne_kn ne_xy - <;> simp only [openRec, closeRec, app.injEq, abs.injEq] - case bvar n' => split <;> aesop - case fvar x' => split <;> aesop - case abs ih => apply ih <;> aesop - case app => aesop + induction' m <;> aesop /-- Closing preserves free variables. -/ lemma close_preserve_not_fvar {k x y} (m : Term Var) : x ∉ m.fv → x ∉ (m⟦k ↜ y⟧).fv := by - intros mem revert k - induction m <;> intros k <;> simp only [closeRec] - case fvar y' => split <;> aesop - case abs ih => exact ih mem - all_goals aesop + induction m <;> aesop /-- Opening to a fresh free variable preserves free variables. -/ lemma open_fresh_preserve_not_fvar {k x y} (m : Term Var) : x ∉ m.fv → x ≠ y → x ∉ (m⟦k ↝ fvar y⟧).fv := by - intros mem neq revert k - induction m <;> intros k <;> simp only [openRec] - case bvar n' => split <;> aesop - case fvar => aesop - case abs ih => exact ih mem - all_goals aesop + induction m <;> aesop /-- Substitution preserves free variables. -/ lemma subst_preserve_not_fvar {x y : Var} (m n : Term Var) : x ∉ m.fv ∪ n.fv → x ∉ (m [y := n]).fv := by - intros mem - simp only [Finset.mem_union, not_or] at mem - induction m <;> simp only [instHasSubstitutionTerm, subst] - case fvar y' => split <;> simp only [fv, Finset.mem_singleton, mem] <;> aesop - case abs ih => exact ih mem + induction m all_goals aesop /-- Closing removes a free variable. -/ lemma close_var_not_fvar_rec (x) (k) (t : Term Var) : x ∉ (t⟦k ↜ x⟧).fv := by revert k - induction t <;> intros k <;> simp only [closeRec] - case fvar x' => split <;> simp_all - case abs ih => exact ih (k + 1) - all_goals aesop + induction t <;> aesop /-- 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 @@ -112,55 +89,47 @@ variable [HasFresh Var] omit [DecidableEq Var] in /-- A locally closed term is unchanged by opening. -/ +@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] lemma open_lc (k t) (e : Term Var) : e.LC → e = e⟦k ↝ t⟧ := by intros e_lc revert k - induction e_lc <;> intros k <;> simp only [openRec, app.injEq, abs.injEq] - case app => aesop - case abs xs e _ ih => refine open_lc_aux e 0 (fvar (fresh xs)) (k+1) t ?_ ?_ <;> aesop + induction e_lc + case abs xs e _ ih => + intros k + simp only [openRec_abs, abs.injEq] + refine open_lc_aux e 0 (fvar (fresh xs)) (k+1) t ?_ ?_ <;> aesop + all_goals aesop /-- Substitution of a locally closed term distributes with opening. -/ lemma subst_open (x : Var) (t : Term Var) (k : ℕ) (u e) : LC t → (e ⟦ k ↝ u ⟧) [ x := t ] = (e [ x := t ]) ⟦k ↝ u [ x := t ]⟧ := by revert k - induction' e - <;> intros k t_lv - <;> simp only [openRec, instHasSubstitutionTerm, subst, app.injEq, abs.injEq] - case bvar k' => aesop - case fvar x' => - split <;> simp_all - exact open_lc k (u[x':=t]) t t_lv - case abs ih => exact ih (k + 1) t_lv - case app ih_l ih_r => exact ⟨ih_l k t_lv, ih_r k t_lv⟩ + induction' e <;> aesop /-- Specialize `subst_open` to the first opening. -/ theorem subst_open_var (x y : Var) (u e : Term Var) : y ≠ x → LC u → (e [y := u]) ^ fvar x = (e ^ fvar x) [y := u] := by intros neq u_lc - have := subst_open y u 0 (fvar x) e u_lc + have h : (e ^ fvar x)[y:=u] = e[y:=u] ^ (fvar x)[y:=u] := subst_open y u 0 (fvar x) e u_lc aesop /-- Substitution of locally closed terms is locally closed. -/ theorem subst_lc {x : Var} {e u : Term Var} : LC e → LC u → LC (e [x := u]) := by intros lc_e lc_u - induction lc_e <;> simp only [instHasSubstitutionTerm, subst] - case fvar => split <;> [assumption; constructor] - case app ih_l ih_r => exact LC.app ih_l ih_r + induction lc_e case abs xs e _ ih => refine LC.abs ({x} ∪ xs) _ (?_ : ∀ y ∉ {x} ∪ xs, (e[x := u] ^ fvar y).LC) intros y mem rw [subst_open_var y x u e ?_ lc_u] - apply ih all_goals aesop + all_goals aesop /-- Opening to a term `t` is equivalent to opening to a free variable and substituting it for `t`. -/ lemma subst_intro (x : Var) (t e : Term Var) : x ∉ e.fv → LC t → e ^ t = (e ^ fvar x) [ x := t ] := by intros mem t_lc simp only [open'] - rw [subst_open x t 0 (fvar x) e t_lc] - have s := subst_fresh _ _ t mem - simp only [instHasSubstitutionTerm, subst, ↓reduceIte] at * - rw [s] + rw [subst_open x t 0 (fvar x) e t_lc, subst_fresh _ _ t mem] + aesop /-- Opening of locally closed terms is locally closed. -/ theorem beta_lc {M N : Term Var} : LC (abs M) → LC N → LC (M ^ N) := by @@ -174,23 +143,20 @@ theorem beta_lc {M N : Term Var} : LC (abs M) → LC N → LC (M ^ N) := by rw [subst_intro y N M] apply subst_lc apply mem - all_goals aesop + all_goals aesop /-- Opening then closing is equivalent to substitution. -/ lemma open_close_to_subst (m : Term Var) (x y : Var) (k : ℕ) : LC m → m ⟦k ↜ x⟧⟦k ↝ fvar y⟧ = m [x := fvar y] := by intros m_lc revert k induction' m_lc - <;> intros k - <;> simp only [closeRec, openRec, instHasSubstitutionTerm, subst, abs.injEq, app.injEq] - case fvar x' => split <;> simp - case app ih_l ih_r => exact ⟨ih_l _, ih_r _⟩ case abs xs t x_mem ih => + intros k have ⟨x', x'_mem⟩ := fresh_exists ({x} ∪ {y} ∪ t.fv ∪ xs) have s := subst_open_var x' x (fvar y) t ?_ (by constructor) - simp only [open', Finset.union_assoc, Finset.mem_union, Finset.mem_singleton, not_or] at * - rw [←open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ fvar y⟧) 0 ?f₁, ←open_close x' (t.subst x (fvar y)) 0 ?f₂] - simp [instHasSubstitutionTerm] at s + simp only [closeRec_abs, openRec_abs, subst_abs] + rw [←open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ fvar y⟧) 0 ?f₁, ←open_close x' (t[x := fvar y]) 0 ?f₂] + simp only [open'] at * rw [swap_open_fvars, ←swap_open_fvar_close, s, ih] case f₁ => apply open_fresh_preserve_not_fvar @@ -200,14 +166,16 @@ lemma open_close_to_subst (m : Term Var) (x y : Var) (k : ℕ) : LC m → m ⟦k apply subst_preserve_not_fvar aesop all_goals aesop + all_goals aesop /-- Closing and opening are inverses. -/ lemma close_open (x : Var) (t : Term Var) (k : ℕ) : LC t → t⟦k ↜ x⟧⟦k ↝ fvar x⟧ = t := by intros lc_t revert k - induction lc_t <;> intros k <;> simp only [closeRec, openRec, abs.injEq, app.injEq] - case fvar x' => split <;> simp_all + induction lc_t case abs xs t t_open_lc ih => + intros k + simp only [closeRec_abs, openRec_abs, abs.injEq] have ⟨y, hy⟩ := fresh_exists (xs ∪ t.fv ∪ (t⟦k + 1 ↜ x⟧⟦k + 1 ↝ fvar x⟧).fv ∪ {x}) simp only [Finset.union_assoc, Finset.mem_union, Finset.mem_singleton, not_or] at hy obtain ⟨q1, q2, q3, q4⟩ := hy @@ -216,4 +184,4 @@ lemma close_open (x : Var) (t : Term Var) (k : ℕ) : LC t → t⟦k ↜ x⟧⟦ simp only [open'] rw [swap_open_fvar_close, swap_open_fvars] all_goals aesop - case app => aesop + all_goals aesop diff --git a/Cslib/Semantics/ReductionSystem/Basic.lean b/Cslib/Semantics/ReductionSystem/Basic.lean index 00e7aac0..9012d3bd 100644 --- a/Cslib/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Semantics/ReductionSystem/Basic.lean @@ -42,17 +42,13 @@ theorem ReductionSystem.MRed.single (rs : ReductionSystem Term) (h : rs.Red a b) open Relation Relation.ReflTransGen --- these instance allow us to switch between single and multistep reductions in a `calc` block -instance {α} (R : α → α → Prop) : Trans R R (ReflTransGen R) where - trans hab hbc := head hab (single hbc) - +-- these instances allow us to switch between single and multistep reductions in a `calc` block instance {α} (R : α → α → Prop) : Trans R (ReflTransGen R) (ReflTransGen R) where trans := head instance {α} (R : α → α → Prop) : Trans (ReflTransGen R) R (ReflTransGen R) where trans := tail --- instance (rs : ReductionSystem Term) : Trans rs.Red rs.Red rs.MRed := by infer_instance instance (rs : ReductionSystem Term) : Trans rs.Red rs.MRed rs.MRed := by infer_instance instance (rs : ReductionSystem Term) : Trans rs.MRed rs.Red rs.MRed := by infer_instance diff --git a/Cslib/Utils/Relation.lean b/Cslib/Utils/Relation.lean index 43ea0b19..ceaf7382 100644 --- a/Cslib/Utils/Relation.lean +++ b/Cslib/Utils/Relation.lean @@ -1,10 +1,45 @@ /- Copyright (c) 2025 Thomas Waring. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Thomas Waring +Authors: Thomas Waring, Chris Henson -/ import Mathlib.Logic.Relation +universe u + +variable {α : Type u} {R R' : α → α → Prop} + +/-- 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 → (∃ D, R B D ∧ R C D) + +/-- A relation is confluent when its reflexive transitive closure has the diamond property. -/ +abbrev Confluence (R : α → α → Prop) := Diamond (Relation.ReflTransGen R) + +/-- Extending a multistep reduction by a single step preserves multi-joinability. -/ +lemma Relation.ReflTransGen.diamond_extend (h : Diamond R) : + Relation.ReflTransGen R A B → + R A C → + ∃ D, Relation.ReflTransGen R B D ∧ Relation.ReflTransGen R C D := by + intros AB _ + revert C + induction AB using Relation.ReflTransGen.head_induction_on <;> intros C AC + case refl => exact ⟨C, ⟨single AC, by rfl⟩⟩ + case head A'_C' _ ih => + obtain ⟨D, ⟨CD, C'_D⟩⟩ := h AC A'_C' + obtain ⟨D', ⟨B_D', D_D'⟩⟩ := ih C'_D + exact ⟨D', ⟨B_D', head CD D_D'⟩⟩ + +/-- The diamond property implies confluence. -/ +theorem Relation.ReflTransGen.diamond_confluence (h : Diamond R) : Confluence R := by + intros A B C AB BC + revert C + induction AB using Relation.ReflTransGen.head_induction_on <;> intros C BC + case refl => exists C + case head _ _ A'_C' _ ih => + obtain ⟨D, ⟨CD, C'_D⟩⟩ := diamond_extend h BC A'_C' + obtain ⟨D', ⟨B_D', D_D'⟩⟩ := ih C'_D + exact ⟨D', ⟨B_D', trans CD D_D'⟩⟩ + -- not sure why this doesn't compile as an "instance" but oh well def trans_of_subrelation {α : Type _} (s s' r : α → α → Prop) (hr : Transitive r) (h : ∀ a b : α, s a b → r a b) (h' : ∀ a b : α, s' a b → r a b) : Trans s s' r where diff --git a/CslibTests/ReductionSystem.lean b/CslibTests/ReductionSystem.lean index 727bcbc3..f31e6342 100644 --- a/CslibTests/ReductionSystem.lean +++ b/CslibTests/ReductionSystem.lean @@ -15,7 +15,7 @@ lemma multiple_step : 5 ↠ₙ 1 := by 5 ⭢ₙ 4 := by simp [h] _ ↠ₙ 2 := by calc - 4 ⭢ₙ 3 := by simp [h] + 4 ↠ₙ 3 := by apply ReductionSystem.MRed.single; simp [h] _ ⭢ₙ 2 := by simp [h] _ ⭢ₙ 1 := by simp [h] From 175ac3a87380ed83c20120e69553a69335fc061b Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Tue, 22 Jul 2025 12:34:58 +0200 Subject: [PATCH 008/107] Testing CCS --- CslibTests/CCS.lean | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 CslibTests/CCS.lean diff --git a/CslibTests/CCS.lean b/CslibTests/CCS.lean new file mode 100644 index 00000000..1f7dc278 --- /dev/null +++ b/CslibTests/CCS.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2025 Fabrizio Montesi. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Fabrizio Montesi +-/ + +import Cslib.ConcurrencyTheory.CCS.Semantics + +open CCS Process + +@[lts ltsNat "ₙ"] +def TrNat := @CCS.Tr ℕ ℕ (fun _ _ => False) + +def p : Process ℕ ℕ := (pre Act.τ (pre Act.τ nil)) + +example : p [Act.τ]⭢ₙ (pre Act.τ nil) := by constructor + +-- WIP below, trying to get Trans to work for LTS + +instance (lts : LTS State Label) : Trans (fun s1 => lts.Tr s1 μ1) (fun s2 => lts.Tr s2 μ2) (fun s3 => lts.MTr s3 [μ1, μ2]) where + trans := by + intro s1 s2 s3 htr1 htr2 + apply LTS.MTr.single at htr1 + apply LTS.MTr.single at htr2 + apply LTS.MTr.comp lts htr1 htr2 + +-- Problematic: +-- example : p [[Act.τ, Act.τ]]↠ₙ nil := by +-- calc +-- p [Act.τ]⭢ₙ (pre Act.τ nil) := by constructor +-- _ [Act.τ]⭢ₙ nil := by constructor From 47c7db8393019508b4a67506061f407c9ddac4b3 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Tue, 22 Jul 2025 12:40:54 +0200 Subject: [PATCH 009/107] arrow shortcuts --- .vscode/settings.json | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index b4eec9fe..f75be9a0 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -7,7 +7,11 @@ "eppr": "⟧", "merge": "⊔", "moreBranches": "⊒", - "par": "‖" + "par": "‖", + "tr": "⭢", + "mtr": "↠", + "red": "⭢", + "mred": "↠" }, "editor.rulers": [ 100 From 8ba26a37b7bc8196b4a57aa9885e2532672e1e5a Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Tue, 22 Jul 2025 16:10:58 +0200 Subject: [PATCH 010/107] better CCS example --- CslibTests/CCS.lean | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/CslibTests/CCS.lean b/CslibTests/CCS.lean index 1f7dc278..3ec2e1a5 100644 --- a/CslibTests/CCS.lean +++ b/CslibTests/CCS.lean @@ -11,9 +11,9 @@ open CCS Process @[lts ltsNat "ₙ"] def TrNat := @CCS.Tr ℕ ℕ (fun _ _ => False) -def p : Process ℕ ℕ := (pre Act.τ (pre Act.τ nil)) +def p : Process ℕ ℕ := (pre Act.τ (pre (Act.name 1) nil)) -example : p [Act.τ]⭢ₙ (pre Act.τ nil) := by constructor +example : p [Act.τ]⭢ₙ (pre (Act.name 1) nil) := by constructor -- WIP below, trying to get Trans to work for LTS @@ -25,7 +25,7 @@ instance (lts : LTS State Label) : Trans (fun s1 => lts.Tr s1 μ1) (fun s2 => lt apply LTS.MTr.comp lts htr1 htr2 -- Problematic: --- example : p [[Act.τ, Act.τ]]↠ₙ nil := by +-- example : p [[Act.τ, Act.name 1]]↠ₙ nil := by -- calc --- p [Act.τ]⭢ₙ (pre Act.τ nil) := by constructor --- _ [Act.τ]⭢ₙ nil := by constructor +-- (p [Act.τ]⭢ₙ (pre (Act.name 1) nil)) := by constructor +-- _ [Act.name 1]⭢ₙ nil := by constructor From db126c8985389a5eeb3874ba4c6ddc702019aef0 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 23 Jul 2025 15:47:17 +0200 Subject: [PATCH 011/107] Switch to the standard type for relations. (#16) * Switch to the standard type for relations. * Missing changes --- Cslib.lean | 2 +- .../CombinatoryLogic/Confluence.lean | 2 +- .../Computability/CombinatoryLogic/Defs.lean | 1 + .../LocallyNameless/FullBetaConfluence.lean | 2 +- .../CCS/BehaviouralTheory.lean | 16 +-- Cslib/ConcurrencyTheory/CCS/Semantics.lean | 5 +- Cslib/{Utils => Data}/Relation.lean | 40 +++++- Cslib/Semantics/LTS/Basic.lean | 14 +- Cslib/Semantics/LTS/Bisimulation.lean | 127 +++++++++--------- Cslib/Semantics/LTS/Simulation.lean | 32 ++--- Cslib/Utils/Rel.lean | 18 --- CslibTests/Bisimulation.lean | 2 +- CslibTests/LTS.lean | 2 +- 13 files changed, 137 insertions(+), 126 deletions(-) rename Cslib/{Utils => Data}/Relation.lean (72%) delete mode 100644 Cslib/Utils/Rel.lean diff --git a/Cslib.lean b/Cslib.lean index 9ed21b31..aa2a1c43 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,6 +1,6 @@ import Cslib.Semantics.LTS.Basic import Cslib.Semantics.LTS.Bisimulation import Cslib.Semantics.LTS.TraceEq -import Cslib.Utils.Relation +import Cslib.Data.Relation import Cslib.Computability.CombinatoryLogic.Defs import Cslib.Computability.CombinatoryLogic.Basic diff --git a/Cslib/Computability/CombinatoryLogic/Confluence.lean b/Cslib/Computability/CombinatoryLogic/Confluence.lean index 4c426396..4643ba56 100644 --- a/Cslib/Computability/CombinatoryLogic/Confluence.lean +++ b/Cslib/Computability/CombinatoryLogic/Confluence.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Waring -/ import Cslib.Computability.CombinatoryLogic.Defs -import Cslib.Utils.Relation +import Cslib.Data.Relation /-! # SKI reduction is confluent diff --git a/Cslib/Computability/CombinatoryLogic/Defs.lean b/Cslib/Computability/CombinatoryLogic/Defs.lean index 1199f83e..c989da5e 100644 --- a/Cslib/Computability/CombinatoryLogic/Defs.lean +++ b/Cslib/Computability/CombinatoryLogic/Defs.lean @@ -6,6 +6,7 @@ Authors: Thomas Waring import Mathlib.Logic.Relation import Cslib.Utils.Relation import Cslib.Semantics.ReductionSystem.Basic +import Cslib.Data.Relation /-! # SKI Combinatory Logic diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean index 5dfc85ba..9c64387c 100644 --- a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean +++ b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean @@ -7,7 +7,7 @@ Authors: Chris Henson import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Basic import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Properties import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.FullBeta -import Cslib.Utils.Relation +import Cslib.Data.Relation /-! # β-confluence for the λ-calculus -/ diff --git a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean index df3c1707..35189c24 100644 --- a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean +++ b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean @@ -23,13 +23,13 @@ Additionally, some standard laws of bisimilarity for CCS, including: section CCS.BehaviouralTheory -variable {Name : Type u} {Constant : Type v} {defs : Rel Constant (CCS.Process Name Constant)} +variable {Name : Type u} {Constant : Type v} {defs : Constant → (CCS.Process Name Constant) → Prop} open CCS CCS.Process CCS.Act namespace CCS -private inductive ParNil : Rel (Process Name Constant) (Process Name Constant) where +private inductive ParNil : (Process Name Constant) → (Process Name Constant) → Prop where | parNil : ParNil (par p nil) p /-- P | 𝟎 ~ P -/ @@ -60,7 +60,7 @@ theorem bisimilarity_par_nil (p : Process Name Constant) : (par p nil) ~[@lts Na case right => constructor -private inductive ParComm : Rel (Process Name Constant) (Process Name Constant) where +private inductive ParComm : (Process Name Constant) → (Process Name Constant) → Prop where | parComm : ParComm (par p q) (par q p) /-- P | Q ~ Q | P -/ @@ -114,7 +114,7 @@ theorem bisimilarity_par_comm (p q : Process Name Constant) : (par p q) ~[@lts N apply Tr.com htrq htrp . constructor -private inductive ChoiceComm : Rel (Process Name Constant) (Process Name Constant) where +private inductive ChoiceComm : (Process Name Constant) → (Process Name Constant) → Prop where | choiceComm : ChoiceComm (choice p q) (choice q p) | bisim : (p ~[@lts Name Constant defs] q) → ChoiceComm p q @@ -166,7 +166,7 @@ theorem bisimilarity_choice_comm : (choice p q) ~[@lts Name Constant defs] (choi apply And.intro htr1 constructor; assumption -private inductive PreBisim : Rel (Process Name Constant) (Process Name Constant) where +private inductive PreBisim : (Process Name Constant) → (Process Name Constant) → Prop where | pre : (p ~[@lts Name Constant defs] q) → PreBisim (pre μ p) (pre μ q) | bisim : (p ~[@lts Name Constant defs] q) → PreBisim p q @@ -217,7 +217,7 @@ theorem bisimilarity_congr_pre : (p ~[@lts Name Constant defs] q) → (pre μ p) constructor apply Bisimilarity.largest_bisimulation _ r hbisim s1' s2' hr1 -private inductive ResBisim : Rel (Process Name Constant) (Process Name Constant) where +private inductive ResBisim : (Process Name Constant) → (Process Name Constant) → Prop where | res : (p ~[@lts Name Constant defs] q) → ResBisim (res a p) (res a q) -- | bisim : (p ~[@lts Name Constant defs] q) → ResBisim p q @@ -250,7 +250,7 @@ theorem bisimilarity_congr_res : (p ~[@lts Name Constant defs] q) → (res a p) constructor; constructor; repeat assumption constructor; assumption -private inductive ChoiceBisim : Rel (Process Name Constant) (Process Name Constant) where +private inductive ChoiceBisim : (Process Name Constant) → (Process Name Constant) → Prop where | choice : (p ~[@lts Name Constant defs] q) → ChoiceBisim (choice p r) (choice q r) | bisim : (p ~[@lts Name Constant defs] q) → ChoiceBisim p q @@ -315,7 +315,7 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice constructor apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr1 -private inductive ParBisim : Rel (Process Name Constant) (Process Name Constant) where +private inductive ParBisim : (Process Name Constant) → (Process Name Constant) → Prop where | par : (p ~[@lts Name Constant defs] q) → ParBisim (par p r) (par q r) /-- P ~ Q → P | R ~ Q | R-/ diff --git a/Cslib/ConcurrencyTheory/CCS/Semantics.lean b/Cslib/ConcurrencyTheory/CCS/Semantics.lean index 1292edd3..04bec2d5 100644 --- a/Cslib/ConcurrencyTheory/CCS/Semantics.lean +++ b/Cslib/ConcurrencyTheory/CCS/Semantics.lean @@ -15,7 +15,10 @@ import Cslib.ConcurrencyTheory.CCS.Basic -/ -variable {Name : Type u} {Constant : Type v} {defs : Rel Constant (CCS.Process Name Constant)} +variable + {Name : Type u} + {Constant : Type v} + {defs : Constant → (CCS.Process Name Constant) → Prop} namespace CCS diff --git a/Cslib/Utils/Relation.lean b/Cslib/Data/Relation.lean similarity index 72% rename from Cslib/Utils/Relation.lean rename to Cslib/Data/Relation.lean index ceaf7382..6ca9b30d 100644 --- a/Cslib/Utils/Relation.lean +++ b/Cslib/Data/Relation.lean @@ -1,13 +1,37 @@ /- -Copyright (c) 2025 Thomas Waring. All rights reserved. +Copyright (c) 2025 Fabrizio Montesi and Thomas Waring. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Thomas Waring, Chris Henson +Authors: Fabrizio Montesi, Thomas Waring, Chris Henson -/ + import Mathlib.Logic.Relation -universe u +/-! # Relations -/ + +universe u v + +section Relation + +/-- Union of two relations. -/ +def Relation.union (r s : α → β → Prop) : α → β → Prop := + fun x y => r x y ∨ s x y + +instance {α : Type u} {β : Type v} : Union (α → β → Prop) where + union := Relation.union -variable {α : Type u} {R R' : α → α → Prop} +/-- Inverse of a relation. -/ +def Relation.inv (r : α → β → Prop) : β → α → Prop := flip r + +-- /-- Composition of two relations. -/ +-- def Relation.comp (r : α → β → Prop) (s : β → γ → Prop) : α → γ → Prop := +-- fun x z => ∃ y, r x y ∧ s y z + +/-- The relation `r` 'up to' the relation `s`. -/ +def Relation.upTo (r s : α → α → Prop) : α → α → Prop := Relation.Comp s (Relation.Comp r s) + +/-- The identity relation. -/ +inductive Relation.Id : α → α → Prop where +| id {x : α} : Id x x /-- 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 → (∃ D, R B D ∧ R C D) @@ -16,9 +40,9 @@ abbrev Diamond (R : α → α → Prop) := ∀ {A B C : α}, R A B → R A C → abbrev Confluence (R : α → α → Prop) := Diamond (Relation.ReflTransGen R) /-- Extending a multistep reduction by a single step preserves multi-joinability. -/ -lemma Relation.ReflTransGen.diamond_extend (h : Diamond R) : - Relation.ReflTransGen R A B → - R A C → +lemma Relation.ReflTransGen.diamond_extend (h : Diamond R) : + Relation.ReflTransGen R A B → + R A C → ∃ D, Relation.ReflTransGen R B D ∧ Relation.ReflTransGen R C D := by intros AB _ revert C @@ -75,3 +99,5 @@ theorem church_rosser_of_diamond {α : Type _} {r : α → α → Prop} constructor . exact Relation.ReflGen.single hd.1 . exact Relation.ReflTransGen.single hd.2 + +end Relation diff --git a/Cslib/Semantics/LTS/Basic.lean b/Cslib/Semantics/LTS/Basic.lean index 4d379793..2b473edb 100644 --- a/Cslib/Semantics/LTS/Basic.lean +++ b/Cslib/Semantics/LTS/Basic.lean @@ -7,7 +7,6 @@ Authors: Fabrizio Montesi import Mathlib.Tactic.Lemma import Mathlib.Data.Finite.Defs import Mathlib.Data.Fintype.Basic -import Mathlib.Data.Rel import Mathlib.Logic.Function.Defs import Mathlib.Data.Set.Finite.Basic import Mathlib.Data.Stream.Defs @@ -64,11 +63,12 @@ section Relation and `s2` such that `lts.Tr s1 μ s2`. This can be useful, for example, to see a reduction relation as an LTS. -/ -def LTS.toRel (lts : LTS State Label) (μ : Label) : Rel State State := +def LTS.toRelation (lts : LTS State Label) (μ : Label) : State → State → Prop := fun s1 s2 => lts.Tr s1 μ s2 /-- Any homogeneous relation can be seen as an LTS where all transitions have the same label. -/ -def Rel.toLTS [DecidableEq Label] (r : Rel State State) (μ : Label) : LTS State Label where +def Relation.toLTS [DecidableEq Label] (r : State → State → Prop) (μ : Label) : + LTS State Label where Tr := fun s1 μ' s2 => if μ' = μ then r s1 s2 else False end Relation @@ -576,9 +576,9 @@ elab "create_lts" lt:ident name:ident : command => do addTermInfo' name (.const name.getId params) (isBinder := true) addDeclarationRangesFromSyntax name.getId name -/-- +/-- This command adds notations for an `LTS.Tr`. This should not usually be called directly, but from - the `lts` attribute. + the `lts` attribute. As an example `lts_reduction_notation foo "β"` will add the notations "[⬝]⭢β" and "[⬝]↠β" @@ -588,12 +588,12 @@ elab "create_lts" lt:ident name:ident : command => do -/ syntax "lts_reduction_notation" ident (Lean.Parser.Command.notationItem)? : command macro_rules - | `(lts_reduction_notation $lts $sym) => + | `(lts_reduction_notation $lts $sym) => `( notation:39 t "["μ"]⭢"$sym t' => (LTS.Tr $lts) t μ t' notation:39 t "["μ"]↠"$sym t' => (LTS.MTr $lts) t μ t' ) - | `(lts_reduction_notation $lts) => + | `(lts_reduction_notation $lts) => `( notation:39 t "["μ"]⭢" t' => (LTS.Tr $lts) t μ t' notation:39 t "["μ"]↠" t' => (LTS.MTr $lts) t μ t' diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index 9dd0546a..d529eddb 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -6,8 +6,7 @@ Authors: Fabrizio Montesi import Cslib.Semantics.LTS.Basic import Cslib.Semantics.LTS.TraceEq -import Mathlib.Data.Rel -import Cslib.Utils.Rel +import Cslib.Data.Relation import Cslib.Semantics.LTS.Simulation /-! # Bisimulation and Bisimilarity @@ -73,7 +72,7 @@ variable {State : Type u} {Label : Type v} (lts : LTS State Label) /-- A relation is a bisimulation if, whenever it relates two states in an lts, the transitions originating from these states mimic each other and the reached derivatives are themselves related. -/ -def Bisimulation (lts : LTS State Label) (r : Rel State State) : Prop := +def Bisimulation (lts : LTS State Label) (r : State → State → Prop) : Prop := ∀ s1 s2, r s1 s2 → ∀ μ, ( (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ r s1' s2') ∧ @@ -81,17 +80,17 @@ def Bisimulation (lts : LTS State Label) (r : Rel State State) : Prop := ) /-- Helper for following a transition using the first component of a `Bisimulation`. -/ -def Bisimulation.follow_fst {lts : LTS State Label} {r : Rel State State} (hb : Bisimulation lts r) (hr : r s1 s2) (μ : Label) (htr : lts.Tr s1 μ s1'):= +def Bisimulation.follow_fst {lts : LTS State Label} {r : State → State → Prop} (hb : Bisimulation lts r) (hr : r s1 s2) (μ : Label) (htr : lts.Tr s1 μ s1'):= (hb _ _ hr μ).1 _ htr /-- Helper for following a transition using the second component of a `Bisimulation`. -/ -def Bisimulation.follow_snd {lts : LTS State Label} {r : Rel State State} (hb : Bisimulation lts r) (hr : r s1 s2) (μ : Label) (htr : lts.Tr s2 μ s2'):= +def Bisimulation.follow_snd {lts : LTS State Label} {r : State → State → Prop} (hb : Bisimulation lts r) (hr : r s1 s2) (μ : Label) (htr : lts.Tr s2 μ s2'):= (hb _ _ hr μ).2 _ htr /-- Two states are bisimilar if they are related by some bisimulation. -/ -def Bisimilarity (lts : LTS State Label) : Rel State State := +def Bisimilarity (lts : LTS State Label) : State → State → Prop := fun s1 s2 => - ∃ r : Rel State State, r s1 s2 ∧ Bisimulation lts r + ∃ r : State → State → Prop, r s1 s2 ∧ Bisimulation lts r /-- Notation for bisimilarity. @@ -103,7 +102,7 @@ notation s:max " ~[" lts "] " s':max => Bisimilarity lts s s' /-- Bisimilarity is reflexive. -/ theorem Bisimilarity.refl (s : State) : s ~[lts] s := by - exists Rel.Id + exists Relation.Id constructor case left => constructor @@ -126,8 +125,8 @@ theorem Bisimilarity.refl (s : State) : s ~[lts] s := by · constructor /-- The inverse of a bisimulation is a bisimulation. -/ -theorem Bisimulation.inv (r : Rel State State) (h : Bisimulation lts r) : - Bisimulation lts r.inv := by +theorem Bisimulation.inv (r : State → State → Prop) (h : Bisimulation lts r) : + Bisimulation lts (Relation.inv r) := by simp only [Bisimulation] at h simp only [Bisimulation] intro s1 s2 hrinv μ @@ -148,7 +147,7 @@ theorem Bisimulation.inv (r : Rel State State) (h : Bisimulation lts r) : /-- Bisimilarity is symmetric. -/ theorem Bisimilarity.symm {s1 s2 : State} (h : s1 ~[lts] s2) : s2 ~[lts] s1 := by obtain ⟨r, hr, hb⟩ := h - exists r.inv + exists (Relation.inv r) constructor case left => exact hr @@ -158,8 +157,8 @@ theorem Bisimilarity.symm {s1 s2 : State} (h : s1 ~[lts] s2) : s2 ~[lts] s1 := b /-- The composition of two bisimulations is a bisimulation. -/ theorem Bisimulation.comp - (r1 r2 : Rel State State) (h1 : Bisimulation lts r1) (h2 : Bisimulation lts r2) : - Bisimulation lts (r1.comp r2) := by + (r1 r2 : State → State → Prop) (h1 : Bisimulation lts r1) (h2 : Bisimulation lts r2) : + Bisimulation lts (Relation.Comp r1 r2) := by simp_all only [Bisimulation] intro s1 s2 hrc μ constructor @@ -175,7 +174,7 @@ theorem Bisimulation.comp exists s2'' constructor · exact h2'tr - · simp [Rel.comp] + · simp only [Relation.Comp] exists s1'' case right => intro s2' htr @@ -189,7 +188,7 @@ theorem Bisimulation.comp exists s1'' constructor · exact h1'tr - · simp [Rel.comp] + · simp only [Relation.Comp] exists s2'' /-- Bisimilarity is transitive. -/ @@ -198,10 +197,10 @@ theorem Bisimilarity.trans s1 ~[lts] s3 := by obtain ⟨r1, hr1, hr1b⟩ := h1 obtain ⟨r2, hr2, hr2b⟩ := h2 - exists r1.comp r2 + exists Relation.Comp r1 r2 constructor case left => - simp only [Rel.comp] + simp only [Relation.Comp] exists s2 case right => apply Bisimulation.comp lts r1 r2 hr1b hr2b @@ -250,31 +249,31 @@ theorem Bisimilarity.is_bisimulation : Bisimulation lts (Bisimilarity lts) := by /-- Bisimilarity is the largest bisimulation. -/ theorem Bisimilarity.largest_bisimulation - (r : Rel State State) (h : Bisimulation lts r) (s1 s2 : State) : + (r : State → State → Prop) (h : Bisimulation lts r) (s1 s2 : State) : r s1 s2 → s1 ~[lts] s2 := by intro hr exists r /-- The union of bisimilarity with any bisimulation is bisimilarity. -/ -theorem Bisimilarity.gfp (r : Rel State State) (h : Bisimulation lts r) : - (Bisimilarity lts).union r = Bisimilarity lts := by +theorem Bisimilarity.gfp (r : State → State → Prop) (h : Bisimulation lts r) : + (Bisimilarity lts) ∪ r = Bisimilarity lts := by funext s1 s2 - simp [Rel.union] + simp only [Union.union, Relation.union, eq_iff_iff, or_iff_left_iff_imp] apply Bisimilarity.largest_bisimulation lts r h /-- A relation `r` is a bisimulation up to bisimilarity if, whenever it relates two states in an lts, the transitions originating from these states mimic each other and the reached derivatives are themselves related by `r` up to bisimilarity. -/ -def BisimulationUpTo (lts : LTS State Label) (r : Rel State State) : Prop := +def BisimulationUpTo (lts : LTS State Label) (r : State → State → Prop) : Prop := ∀ s1 s2, r s1 s2 → ∀ μ, ( - (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ r.upTo (Bisimilarity lts) s1' s2') + (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ Relation.upTo r (Bisimilarity lts) s1' s2') ∧ - (∀ s2', lts.Tr s2 μ s2' → ∃ s1', lts.Tr s1 μ s1' ∧ r.upTo (Bisimilarity lts) s1' s2') + (∀ s2', lts.Tr s2 μ s2' → ∃ s1', lts.Tr s1 μ s1' ∧ Relation.upTo r (Bisimilarity lts) s1' s2') ) /-- Any bisimulation up to bisimilarity is a bisimulation. -/ -theorem Bisimulation.upTo_bisimulation (r : Rel State State) (h : BisimulationUpTo lts r) : - Bisimulation lts (r.upTo (Bisimilarity lts)) := by +theorem Bisimulation.upTo_bisimulation (r : State → State → Prop) (h : BisimulationUpTo lts r) : + Bisimulation lts (Relation.upTo r (Bisimilarity lts)) := by simp [Bisimulation] simp [BisimulationUpTo] at h intro s1 s2 hr μ @@ -297,7 +296,7 @@ theorem Bisimulation.upTo_bisimulation (r : Rel State State) (h : BisimulationUp constructor · apply Bisimilarity.trans lts (Bisimilarity.largest_bisimulation lts r1 hr1b _ _ hs1b'r) hsmidb - · simp [Rel.comp] + · simp only [Relation.Comp] exists smid2 constructor · exact hsmidr @@ -314,7 +313,7 @@ theorem Bisimulation.upTo_bisimulation (r : Rel State State) (h : BisimulationUp exact hs1btr case right => obtain ⟨smid1, hsmidb, smid2, hsmidr, hsmidrb⟩ := hs1b'r - simp [Rel.upTo, Rel.comp] + simp only [Relation.upTo, Relation.Comp] constructor constructor · apply Bisimilarity.trans lts (Bisimilarity.largest_bisimulation lts r1 hr1b _ _ _) hsmidb @@ -329,7 +328,7 @@ theorem Bisimulation.upTo_bisimulation (r : Rel State State) (h : BisimulationUp /-- If two states are related by a bisimulation, they can mimic each other's multi-step transitions. -/ theorem Bisimulation.bisim_trace - (s1 s2 : State) (r : Rel State State) (hb : Bisimulation lts r) (hr : r s1 s2) : + (s1 s2 : State) (r : State → State → Prop) (hb : Bisimulation lts r) (hr : r s1 s2) : ∀ μs s1', lts.MTr s1 μs s1' → ∃ s2', lts.MTr s2 μs s2' ∧ r s1' s2' := by intro μs induction μs generalizing s1 s2 @@ -363,7 +362,7 @@ theorem Bisimulation.bisim_trace /-- Any bisimulation implies trace equivalence. -/ theorem Bisimulation.bisim_traceEq - (s1 s2 : State) (r : Rel State State) (hb : Bisimulation lts r) (hr : r s1 s2) : + (s1 s2 : State) (r : State → State → Prop) (hb : Bisimulation lts r) (hr : r s1 s2) : s1 ~tr[lts] s2 := by simp [TraceEq, LTS.traces, setOf] funext μs @@ -379,7 +378,7 @@ theorem Bisimulation.bisim_traceEq intro h obtain ⟨s2', h⟩ := h have hinv := @Bisimulation.inv State Label lts r hb - obtain ⟨s1', hmtr⟩ := @Bisimulation.bisim_trace State Label lts s2 s1 r.inv hinv hr μs s2' h + obtain ⟨s1', hmtr⟩ := @Bisimulation.bisim_trace State Label lts s2 s1 (Relation.inv r) hinv hr μs s2' h exists s1' exact hmtr.1 @@ -738,7 +737,7 @@ theorem Bisimilarity.deterministic_bisim_eq_traceEq /-! ### Relation to simulation -/ /-- Any bisimulation is also a simulation. -/ -theorem Bisimulation.is_simulation (lts : LTS State Label) (r : Rel State State) : Bisimulation lts r → Simulation lts r := by +theorem Bisimulation.is_simulation (lts : LTS State Label) (r : State → State → Prop) : Bisimulation lts r → Simulation lts r := by intro h simp only [Bisimulation] at h simp only [Simulation] @@ -748,7 +747,7 @@ theorem Bisimulation.is_simulation (lts : LTS State Label) (r : Rel State State) apply h1 s1' htr /-- A relation is a bisimulation iff both it and its inverse are simulations. -/ -theorem Bisimulation.simulation_iff (lts : LTS State Label) (r : Rel State State) : Bisimulation lts r ↔ (Simulation lts r ∧ Simulation lts r.inv) := by +theorem Bisimulation.simulation_iff (lts : LTS State Label) (r : State → State → Prop) : Bisimulation lts r ↔ (Simulation lts r ∧ Simulation lts (Relation.inv r)) := by constructor intro h simp only [Simulation] @@ -762,7 +761,7 @@ theorem Bisimulation.simulation_iff (lts : LTS State Label) (r : Rel State State obtain ⟨s2', h1⟩ := h1 exists s2' case right => - simp only [Rel.inv, flip] + simp only [Relation.inv, flip] intro s2 s1 hr μ s2' htr simp only [Bisimulation] at h specialize h s1 s2 hr μ @@ -791,13 +790,13 @@ section WeakBisimulation /-- A weak bisimulation is similar to a `Bisimulation`, but allows for the related processes to do internal work. Technically, this is defined as a `Bisimulation` on the saturation of the LTS. -/ -def WeakBisimulation [HasTau Label] (lts : LTS State Label) (r : Rel State State) := +def WeakBisimulation [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) := Bisimulation (lts.saturate) r /-- Two states are weakly bisimilar if they are related by some weak bisimulation. -/ -def WeakBisimilarity [HasTau Label] (lts : LTS State Label) : Rel State State := +def WeakBisimilarity [HasTau Label] (lts : LTS State Label) : State → State → Prop := fun s1 s2 => - ∃ r : Rel State State, r s1 s2 ∧ WeakBisimulation lts r + ∃ r : State → State → Prop, r s1 s2 ∧ WeakBisimulation lts r /-- Notation for weak bisimilarity. -/ notation s:max " ≈[" lts "] " s':max => WeakBisimilarity lts s s' @@ -805,7 +804,7 @@ notation s:max " ≈[" lts "] " s':max => WeakBisimilarity lts s s' /-- An `SWBisimulation` is a more convenient definition of weak bisimulation, because the challenge is a single transition. We prove later that this technique is sound, following a strategy inspired by [Sangiorgi2011]. -/ -def SWBisimulation [HasTau Label] (lts : LTS State Label) (r : Rel State State) : Prop := +def SWBisimulation [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) : Prop := ∀ s1 s2, r s1 s2 → ∀ μ, ( (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.STr s2 μ s2' ∧ r s1' s2') ∧ @@ -813,9 +812,9 @@ def SWBisimulation [HasTau Label] (lts : LTS State Label) (r : Rel State State) ) /-- Two states are sw-bisimilar if they are related by some sw-bisimulation. -/ -def SWBisimilarity [HasTau Label] (lts : LTS State Label) : Rel State State := +def SWBisimilarity [HasTau Label] (lts : LTS State Label) : State → State → Prop := fun s1 s2 => - ∃ r : Rel State State, r s1 s2 ∧ SWBisimulation lts r + ∃ r : State → State → Prop, r s1 s2 ∧ SWBisimulation lts r /-- Notation for swbisimilarity. -/ notation s:max " ≈sw[" lts "] " s':max => SWBisimilarity lts s s' @@ -823,7 +822,7 @@ notation s:max " ≈sw[" lts "] " s':max => SWBisimilarity lts s s' /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (first component, weighted version). -/ theorem SWBisimulation.follow_internal_fst_n - [HasTau Label] (lts : LTS State Label) (r : Rel State State) + [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstrN : lts.strN n s1 HasTau.τ s1') : ∃ s2', lts.STr s2 HasTau.τ s2' ∧ r s1' s2' := by cases n @@ -851,7 +850,7 @@ theorem SWBisimulation.follow_internal_fst_n /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (second component, weighted version). -/ theorem SWBisimulation.follow_internal_snd_n - [HasTau Label] (lts : LTS State Label) (r : Rel State State) + [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstrN : lts.strN n s2 HasTau.τ s2') : ∃ s1', lts.STr s1 HasTau.τ s1' ∧ r s1' s2' := by cases n @@ -879,7 +878,7 @@ theorem SWBisimulation.follow_internal_snd_n /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (first component). -/ theorem SWBisimulation.follow_internal_fst - [HasTau Label] (lts : LTS State Label) (r : Rel State State) + [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstr : lts.STr s1 HasTau.τ s1') : ∃ s2', lts.STr s2 HasTau.τ s2' ∧ r s1' s2' := by obtain ⟨n, hstrN⟩ := (LTS.str_strN lts).1 hstr @@ -888,14 +887,14 @@ theorem SWBisimulation.follow_internal_fst /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (second component). -/ theorem SWBisimulation.follow_internal_snd - [HasTau Label] (lts : LTS State Label) (r : Rel State State) + [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstr : lts.STr s2 HasTau.τ s2') : ∃ s1', lts.STr s1 HasTau.τ s1' ∧ r s1' s2' := by obtain ⟨n, hstrN⟩ := (LTS.str_strN lts).1 hstr apply SWBisimulation.follow_internal_snd_n lts r hswb hr hstrN /-- We can now prove that any relation is a `WeakBisimulation` iff it is an `SWBisimulation`. This formalises lemma 4.2.10 in [Sangiorgi2011]. -/ -theorem WeakBisimulation.iff_swBisimulation [HasTau Label] (lts : LTS State Label) (r : Rel State State) : +theorem WeakBisimulation.iff_swBisimulation [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) : WeakBisimulation lts r ↔ SWBisimulation lts r := by apply Iff.intro case mp => @@ -954,13 +953,13 @@ theorem WeakBisimulation.iff_swBisimulation [HasTau Label] (lts : LTS State Labe apply LTS.STr.comp lts hstr1b hstr1b' hstr1' · exact hrb2 -theorem WeakBisimulation.toSwBisimulation [HasTau Label] {lts : LTS State Label} {r : Rel State State} (h : WeakBisimulation lts r) : SWBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).1 h +theorem WeakBisimulation.toSwBisimulation [HasTau Label] {lts : LTS State Label} {r : State → State → Prop} (h : WeakBisimulation lts r) : SWBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).1 h -theorem SWBisimulation.toWeakBisimulation [HasTau Label] {lts : LTS State Label} {r : Rel State State} (h : SWBisimulation lts r) : WeakBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).2 h +theorem SWBisimulation.toWeakBisimulation [HasTau Label] {lts : LTS State Label} {r : State → State → Prop} (h : SWBisimulation lts r) : WeakBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).2 h /-- If two states are related by an `SWBisimulation`, then they are weakly bisimilar. -/ theorem WeakBisimilarity.by_swBisimulation [HasTau Label] - (lts : LTS State Label) (r : Rel State State) + (lts : LTS State Label) (r : State → State → Prop) (hb : SWBisimulation lts r) (hr : r s1 s2) : s1 ≈[lts] s2 := by exists r constructor; exact hr @@ -988,7 +987,7 @@ theorem WeakBisimilarity.weakBisim_eq_swBisim [HasTau Label] (lts : LTS State La /-- sw-bisimilarity is reflexive. -/ theorem SWBisimilarity.refl [HasTau Label] (lts : LTS State Label) (s : State) : s ≈sw[lts] s := by simp [SWBisimilarity] - exists Rel.Id + exists Relation.Id constructor; constructor simp [SWBisimulation] intro s1 s2 hr μ @@ -1014,8 +1013,8 @@ theorem WeakBisimilarity.refl [HasTau Label] (lts : LTS State Label) (s : State) /-- The inverse of an sw-bisimulation is an sw-bisimulation. -/ theorem SWBisimulation.inv [HasTau Label] (lts : LTS State Label) - (r : Rel State State) (h : SWBisimulation lts r) : - SWBisimulation lts r.inv := by + (r : State → State → Prop) (h : SWBisimulation lts r) : + SWBisimulation lts (Relation.inv r) := by simp only [SWBisimulation] at h simp only [SWBisimulation] intro s1 s2 hrinv μ @@ -1035,8 +1034,8 @@ theorem SWBisimulation.inv [HasTau Label] (lts : LTS State Label) /-- The inverse of a weak bisimulation is a weak bisimulation. -/ theorem WeakBisimulation.inv [HasTau Label] (lts : LTS State Label) - (r : Rel State State) (h : WeakBisimulation lts r) : - WeakBisimulation lts r.inv := by + (r : State → State → Prop) (h : WeakBisimulation lts r) : + WeakBisimulation lts (Relation.inv r) := by apply WeakBisimulation.toSwBisimulation at h have h' := SWBisimulation.inv lts r h apply SWBisimulation.toWeakBisimulation at h' @@ -1045,10 +1044,10 @@ theorem WeakBisimulation.inv [HasTau Label] (lts : LTS State Label) /-- sw-bisimilarity is symmetric. -/ theorem SWBisimilarity.symm [HasTau Label] (lts : LTS State Label) (h : s1 ≈sw[lts] s2) : s2 ≈sw[lts] s1 := by obtain ⟨r, hr, hrh⟩ := h - exists r.inv + exists (Relation.inv r) constructor case left => - simp only [Rel.inv, flip] + simp only [Relation.inv, flip] exact hr case right => apply SWBisimulation.inv lts r hrh @@ -1063,8 +1062,8 @@ theorem WeakBisimilarity.symm [HasTau Label] (lts : LTS State Label) (h : s1 ≈ theorem WeakBisimulation.comp [HasTau Label] (lts : LTS State Label) - (r1 r2 : Rel State State) (h1 : WeakBisimulation lts r1) (h2 : WeakBisimulation lts r2) : - WeakBisimulation lts (r1.comp r2) := by + (r1 r2 : State → State → Prop) (h1 : WeakBisimulation lts r1) (h2 : WeakBisimulation lts r2) : + WeakBisimulation lts (Relation.Comp r1 r2) := by simp_all only [WeakBisimulation] intro s1 s2 hrc μ constructor @@ -1080,7 +1079,7 @@ theorem WeakBisimulation.comp exists s2'' constructor · exact h2'tr - · simp [Rel.comp] + · simp only [Relation.Comp] exists s1'' case right => intro s2' htr @@ -1094,18 +1093,18 @@ theorem WeakBisimulation.comp exists s1'' constructor · exact h1'tr - · simp [Rel.comp] + · simp only [Relation.Comp] exists s2'' /-- The composition of two sw-bisimulations is an sw-bisimulation. -/ theorem SWBisimulation.comp [HasTau Label] (lts : LTS State Label) - (r1 r2 : Rel State State) (h1 : SWBisimulation lts r1) (h2 : SWBisimulation lts r2) : - SWBisimulation lts (r1.comp r2) := by + (r1 r2 : State → State → Prop) (h1 : SWBisimulation lts r1) (h2 : SWBisimulation lts r2) : + SWBisimulation lts (Relation.Comp r1 r2) := by apply SWBisimulation.toWeakBisimulation at h1 apply SWBisimulation.toWeakBisimulation at h2 - apply (WeakBisimulation.iff_swBisimulation lts (r1.comp r2)).1 + apply (WeakBisimulation.iff_swBisimulation lts (Relation.Comp r1 r2)).1 apply WeakBisimulation.comp lts r1 r2 h1 h2 /-- Weak bisimilarity is transitive. -/ @@ -1114,10 +1113,10 @@ theorem WeakBisimilarity.trans s1 ≈[lts] s3 := by obtain ⟨r1, hr1, hr1b⟩ := h1 obtain ⟨r2, hr2, hr2b⟩ := h2 - exists r1.comp r2 + exists Relation.Comp r1 r2 constructor case left => - simp only [Rel.comp] + simp only [Relation.Comp] exists s2 case right => apply WeakBisimulation.comp lts r1 r2 hr1b hr2b diff --git a/Cslib/Semantics/LTS/Simulation.lean b/Cslib/Semantics/LTS/Simulation.lean index 10afc985..3972f2e5 100644 --- a/Cslib/Semantics/LTS/Simulation.lean +++ b/Cslib/Semantics/LTS/Simulation.lean @@ -5,7 +5,7 @@ Authors: Fabrizio Montesi -/ import Cslib.Semantics.LTS.Basic -import Cslib.Utils.Rel +import Cslib.Data.Relation /-! # Simulation and Similarity @@ -46,13 +46,13 @@ variable {State : Type u} {Label : Type v} (lts : LTS State Label) /-- A relation is a simulation if, whenever it relates two states in an lts, any transition originating from the first state is mimicked by a transition from the second state and the reached derivatives are themselves related. -/ -def Simulation (lts : LTS State Label) (r : Rel State State) : Prop := +def Simulation (lts : LTS State Label) (r : State → State → Prop) : Prop := ∀ s1 s2, r s1 s2 → ∀ μ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ r s1' s2' /-- Two states are similar if they are related by some simulation. -/ -def Similarity (lts : LTS State Label) : Rel State State := +def Similarity (lts : LTS State Label) : State → State → Prop := fun s1 s2 => - ∃ r : Rel State State, r s1 s2 ∧ Simulation lts r + ∃ r : State → State → Prop, r s1 s2 ∧ Simulation lts r /-- Notation for similarity. @@ -64,7 +64,7 @@ notation s:max " ≤[" lts "] " s':max => Similarity lts s s' /-- Similarity is reflexive. -/ theorem Similarity.refl (s : State) : s ≤[lts] s := by - exists Rel.Id + exists Relation.Id apply And.intro (by constructor) simp only [Simulation] intro s1 s2 hr μ s1' htr @@ -74,8 +74,8 @@ theorem Similarity.refl (s : State) : s ≤[lts] s := by /-- The composition of two simulations is a simulation. -/ theorem Simulation.comp - (r1 r2 : Rel State State) (h1 : Simulation lts r1) (h2 : Simulation lts r2) : - Simulation lts (r1.comp r2) := by + (r1 r2 : State → State → Prop) (h1 : Simulation lts r1) (h2 : Simulation lts r2) : + Simulation lts (Relation.Comp r1 r2) := by simp_all only [Simulation] intro s1 s2 hrc μ s1' htr rcases hrc with ⟨sb, hr1, hr2⟩ @@ -88,24 +88,24 @@ theorem Simulation.comp exists s2'' constructor · exact h2'tr - · simp [Rel.comp] + · simp only [Relation.Comp] exists s1'' /-- Similarity is transitive. -/ theorem Similarity.trans (h1 : s1 ≤[lts] s2) (h2 : s2 ≤[lts] s3) : s1 ≤[lts] s3 := by obtain ⟨r1, hr1, hr1s⟩ := h1 obtain ⟨r2, hr2, hr2s⟩ := h2 - exists r1.comp r2 + exists Relation.Comp r1 r2 constructor case left => - simp only [Rel.comp] + simp only [Relation.Comp] exists s2 case right => apply Simulation.comp lts r1 r2 hr1s hr2s /-- Simulation equivalence relates all states `s1` and `s2` such that `s1 ≤[lts] s2` and `s2 ≤[lts] s1`. -/ -def SimulationEquiv (lts : LTS State Label) : Rel State State := +def SimulationEquiv (lts : LTS State Label) : State → State → Prop := fun s1 s2 => s1 ≤[lts] s2 ∧ s2 ≤[lts] s1 @@ -117,7 +117,7 @@ notation s:max " ≤≥[" lts "] " s':max => SimulationEquiv lts s s' /-- Simulation equivalence is reflexive. -/ theorem SimulationEquiv.refl (s : State) : s ≤≥[lts] s := by simp [SimulationEquiv] - exists Rel.Id + exists Relation.Id constructor; constructor simp only [Simulation] intro s1 s2 hr μ s1' htr @@ -142,17 +142,17 @@ theorem SimulationEquiv.trans {s1 s2 s3 : State} (h1 : s1 ≤≥[lts] s2) (h2 : case left => obtain ⟨r1, hr1, hr1s⟩ := h1l obtain ⟨r2, hr2, hr2s⟩ := h2l - exists r1.comp r2 + exists Relation.Comp r1 r2 constructor - · simp only [Rel.comp] + · simp only [Relation.Comp] exists s2 · apply Simulation.comp lts r1 r2 hr1s hr2s case right => obtain ⟨r1, hr1, hr1s⟩ := h1r obtain ⟨r2, hr2, hr2s⟩ := h2r - exists r2.comp r1 + exists Relation.Comp r2 r1 constructor - · simp only [Rel.comp] + · simp only [Relation.Comp] exists s2 · apply Simulation.comp lts r2 r1 hr2s hr1s diff --git a/Cslib/Utils/Rel.lean b/Cslib/Utils/Rel.lean deleted file mode 100644 index 10ff4751..00000000 --- a/Cslib/Utils/Rel.lean +++ /dev/null @@ -1,18 +0,0 @@ -/- -Copyright (c) 2025 Fabrizio Montesi. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Fabrizio Montesi --/ - -import Mathlib.Data.Rel - -/-- Union of two relations. -/ -def Rel.union {α β} (r s : Rel α β) : Rel α β := - fun x y => r x y ∨ s x y - -/-- The relation `r` 'up to' the relation `s`. -/ -def Rel.upTo {α} (r s : Rel α α) : Rel α α := s.comp (r.comp s) - -/-- The identity relation. -/ -inductive Rel.Id {α} : Rel α α where -| id {x : α} : Rel.Id x x diff --git a/CslibTests/Bisimulation.lean b/CslibTests/Bisimulation.lean index 2b30fbbb..ca68989c 100644 --- a/CslibTests/Bisimulation.lean +++ b/CslibTests/Bisimulation.lean @@ -19,7 +19,7 @@ private inductive tr1 : ℕ → Char → ℕ → Prop where def lts1 := LTS.mk tr1 -private inductive Bisim15 : Rel ℕ ℕ where +private inductive Bisim15 : ℕ → ℕ → Prop where | oneFive : Bisim15 1 5 | twoSix : Bisim15 2 6 | threeSeven : Bisim15 3 7 diff --git a/CslibTests/LTS.lean b/CslibTests/LTS.lean index 4fc4021d..78904276 100644 --- a/CslibTests/LTS.lean +++ b/CslibTests/LTS.lean @@ -23,7 +23,7 @@ theorem NatTr.dom : NatTr n μ m → (n = 1 ∨ n = 2) ∧ (m = 1 ∨ m = 2) := def natLts : LTS ℕ ℕ := ⟨NatTr⟩ -inductive NatBisim : Rel ℕ ℕ where +inductive NatBisim : ℕ → ℕ → Prop where | one_one : NatBisim 1 1 | one_two : NatBisim 1 2 | two_one : NatBisim 2 1 From 8efce25e18e26862ac98f10bef4adca534696821 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 23 Jul 2025 17:01:03 +0200 Subject: [PATCH 012/107] Make calc work with LTS --- Cslib/Semantics/LTS/Basic.lean | 91 +++++++++++++++++++++++----------- CslibTests/CCS.lean | 18 ++----- 2 files changed, 67 insertions(+), 42 deletions(-) diff --git a/Cslib/Semantics/LTS/Basic.lean b/Cslib/Semantics/LTS/Basic.lean index 2b473edb..c91227ed 100644 --- a/Cslib/Semantics/LTS/Basic.lean +++ b/Cslib/Semantics/LTS/Basic.lean @@ -57,22 +57,6 @@ structure LTS (State : Type u) (Label : Type v) where /-- The transition relation. -/ Tr : State → Label → State → Prop -section Relation - -/-- Given an `lts` and a transition label `μ`, returns the relation that relates all states `s1` -and `s2` such that `lts.Tr s1 μ s2`. - -This can be useful, for example, to see a reduction relation as an LTS. -/ -def LTS.toRelation (lts : LTS State Label) (μ : Label) : State → State → Prop := - fun s1 s2 => lts.Tr s1 μ s2 - -/-- Any homogeneous relation can be seen as an LTS where all transitions have the same label. -/ -def Relation.toLTS [DecidableEq Label] (r : State → State → Prop) (μ : Label) : - LTS State Label where - Tr := fun s1 μ' s2 => if μ' = μ then r s1 s2 else False - -end Relation - section MultiStep /-! ## Multi-step transitions -/ @@ -545,6 +529,57 @@ def LTS.DivergenceFree [HasTau Label] (lts : LTS State Label) : Prop := end Divergence +section Relation + +/-- Returns the relation that relates all states `s1` and `s2` via a fixed transition label `μ`. -/ +def LTS.Tr.toRelation (lts : LTS State Label) (μ : Label) : State → State → Prop := + fun s1 s2 => lts.Tr s1 μ s2 + +/-- Returns the relation that relates all states `s1` and `s2` via a fixed list of transition labels `μs`. -/ +def LTS.MTr.toRelation (lts : LTS State Label) (μs : List Label) : State → State → Prop := + fun s1 s2 => lts.MTr s1 μs s2 + +/-- Any homogeneous relation can be seen as an LTS where all transitions have the same label. -/ +def Relation.toLTS [DecidableEq Label] (r : State → State → Prop) (μ : Label) : + LTS State Label where + Tr := fun s1 μ' s2 => if μ' = μ then r s1 s2 else False + +end Relation + +section Trans + +/-! ## Support for the calc tactic -/ + +/-- Transitions can be chained. -/ +instance (lts : LTS State Label) : Trans (LTS.Tr.toRelation lts μ1) (LTS.Tr.toRelation lts μ2) (LTS.MTr.toRelation lts [μ1, μ2]) where + trans := by + intro s1 s2 s3 htr1 htr2 + apply LTS.MTr.single at htr1 + apply LTS.MTr.single at htr2 + apply LTS.MTr.comp lts htr1 htr2 + +/-- Transitions can be chained with multi-step transitions. -/ +instance (lts : LTS State Label) : Trans (LTS.Tr.toRelation lts μ) (LTS.MTr.toRelation lts μs) (LTS.MTr.toRelation lts (μ :: μs)) where + trans := by + intro s1 s2 s3 htr1 hmtr2 + apply LTS.MTr.single at htr1 + apply LTS.MTr.comp lts htr1 hmtr2 + +/-- Multi-step transitions can be chained with transitions. -/ +instance (lts : LTS State Label) : Trans (LTS.MTr.toRelation lts μs) (LTS.Tr.toRelation lts μ) (LTS.MTr.toRelation lts (μs ++ [μ])) where + trans := by + intro s1 s2 s3 hmtr1 htr2 + apply LTS.MTr.single at htr2 + apply LTS.MTr.comp lts hmtr1 htr2 + +/-- Multi-step transitions can be chained. -/ +instance (lts : LTS State Label) : Trans (LTS.MTr.toRelation lts μs1) (LTS.MTr.toRelation lts μs2) (LTS.MTr.toRelation lts (μs1 ++ μs2)) where + trans := by + intro s1 s2 s3 hmtr1 hmtr2 + apply LTS.MTr.comp lts hmtr1 hmtr2 + +end Trans + open Lean Elab Meta Command Term /-- A command to create an `LTS` from a labelled transition `α → β → α → Prop`, robust to use of `variable `-/ @@ -577,29 +612,29 @@ elab "create_lts" lt:ident name:ident : command => do addDeclarationRangesFromSyntax name.getId name /-- - This command adds notations for an `LTS.Tr`. This should not usually be called directly, but from + This command adds transition notations for an `LTS`. This should not usually be called directly, but from the `lts` attribute. - As an example `lts_reduction_notation foo "β"` will add the notations "[⬝]⭢β" and "[⬝]↠β" + As an example `lts_transition_notation foo "β"` will add the notations "[⬝]⭢β" and "[⬝]↠β" Note that the string used will afterwards be registered as a notation. This means that if you have also used this as a constructor name, you will need quotes to access corresponding cases, e.g. «β» in the above example. -/ -syntax "lts_reduction_notation" ident (Lean.Parser.Command.notationItem)? : command +syntax "lts_transition_notation" ident (Lean.Parser.Command.notationItem)? : command macro_rules - | `(lts_reduction_notation $lts $sym) => + | `(lts_transition_notation $lts $sym) => `( - notation:39 t "["μ"]⭢"$sym t' => (LTS.Tr $lts) t μ t' - notation:39 t "["μ"]↠"$sym t' => (LTS.MTr $lts) t μ t' + notation:39 t "["μ"]⭢"$sym t' => (LTS.Tr.toRelation $lts μ) t t' + notation:39 t "["μs"]↠"$sym t' => (LTS.MTr.toRelation $lts μs) t t' ) - | `(lts_reduction_notation $lts) => + | `(lts_transition_notation $lts) => `( - notation:39 t "["μ"]⭢" t' => (LTS.Tr $lts) t μ t' - notation:39 t "["μ"]↠" t' => (LTS.MTr $lts) t μ t' + notation:39 t "["μ"]⭢" t' => (LTS.Tr.toRelation $lts μ) t t' + notation:39 t "["μs"]↠" t' => (LTS.MTr.toRelation $lts μs) t t' ) -/-- This attribute calls the `lts_reduction_notation` command for the annotated declaration. -/ +/-- This attribute calls the `lts_transition_notation` command for the annotated declaration. -/ syntax (name := lts_attr) "lts" ident (Lean.Parser.Command.notationItem)? : attr initialize Lean.registerBuiltinAttribute { @@ -609,9 +644,9 @@ initialize Lean.registerBuiltinAttribute { match stx with | `(attr | lts $lts $sym) => liftCommandElabM <| Command.elabCommand (← `(create_lts $(mkIdent decl) $lts)) - liftCommandElabM <| Command.elabCommand (← `(lts_reduction_notation $lts $sym)) + liftCommandElabM <| Command.elabCommand (← `(lts_transition_notation $lts $sym)) | `(attr | lts $lts) => liftCommandElabM <| Command.elabCommand (← `(create_lts $(mkIdent decl) $lts)) - liftCommandElabM <| Command.elabCommand (← `(lts_reduction_notation $lts)) + liftCommandElabM <| Command.elabCommand (← `(lts_transition_notation $lts)) | _ => throwError "invalid syntax for 'lts' attribute" } diff --git a/CslibTests/CCS.lean b/CslibTests/CCS.lean index 3ec2e1a5..67a8d953 100644 --- a/CslibTests/CCS.lean +++ b/CslibTests/CCS.lean @@ -15,17 +15,7 @@ def p : Process ℕ ℕ := (pre Act.τ (pre (Act.name 1) nil)) example : p [Act.τ]⭢ₙ (pre (Act.name 1) nil) := by constructor --- WIP below, trying to get Trans to work for LTS - -instance (lts : LTS State Label) : Trans (fun s1 => lts.Tr s1 μ1) (fun s2 => lts.Tr s2 μ2) (fun s3 => lts.MTr s3 [μ1, μ2]) where - trans := by - intro s1 s2 s3 htr1 htr2 - apply LTS.MTr.single at htr1 - apply LTS.MTr.single at htr2 - apply LTS.MTr.comp lts htr1 htr2 - --- Problematic: --- example : p [[Act.τ, Act.name 1]]↠ₙ nil := by --- calc --- (p [Act.τ]⭢ₙ (pre (Act.name 1) nil)) := by constructor --- _ [Act.name 1]⭢ₙ nil := by constructor +example : p [[Act.τ, Act.name 1]]↠ₙ nil := + calc + (p [Act.τ]⭢ₙ (pre (Act.name 1) nil)) := by constructor + _ [Act.name 1]⭢ₙ nil := by constructor From 2f588e04fe4d1f96576ccd7e3e11cc0280703002 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 23 Jul 2025 22:10:13 +0200 Subject: [PATCH 013/107] Remove some simps and a commented out def --- Cslib/Data/Relation.lean | 4 ---- Cslib/Semantics/LTS/Bisimulation.lean | 18 +++++------------- Cslib/Semantics/LTS/Simulation.lean | 10 +++------- 3 files changed, 8 insertions(+), 24 deletions(-) diff --git a/Cslib/Data/Relation.lean b/Cslib/Data/Relation.lean index 6ca9b30d..909cb68e 100644 --- a/Cslib/Data/Relation.lean +++ b/Cslib/Data/Relation.lean @@ -22,10 +22,6 @@ instance {α : Type u} {β : Type v} : Union (α → β → Prop) where /-- Inverse of a relation. -/ def Relation.inv (r : α → β → Prop) : β → α → Prop := flip r --- /-- Composition of two relations. -/ --- def Relation.comp (r : α → β → Prop) (s : β → γ → Prop) : α → γ → Prop := --- fun x z => ∃ y, r x y ∧ s y z - /-- The relation `r` 'up to' the relation `s`. -/ def Relation.upTo (r s : α → α → Prop) : α → α → Prop := Relation.Comp s (Relation.Comp r s) diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index d529eddb..873d209b 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -174,8 +174,7 @@ theorem Bisimulation.comp exists s2'' constructor · exact h2'tr - · simp only [Relation.Comp] - exists s1'' + · exists s1'' case right => intro s2' htr rcases hrc with ⟨sb, hr1, hr2⟩ @@ -188,8 +187,7 @@ theorem Bisimulation.comp exists s1'' constructor · exact h1'tr - · simp only [Relation.Comp] - exists s2'' + · exists s2'' /-- Bisimilarity is transitive. -/ theorem Bisimilarity.trans @@ -200,7 +198,6 @@ theorem Bisimilarity.trans exists Relation.Comp r1 r2 constructor case left => - simp only [Relation.Comp] exists s2 case right => apply Bisimulation.comp lts r1 r2 hr1b hr2b @@ -296,8 +293,7 @@ theorem Bisimulation.upTo_bisimulation (r : State → State → Prop) (h : Bisim constructor · apply Bisimilarity.trans lts (Bisimilarity.largest_bisimulation lts r1 hr1b _ _ hs1b'r) hsmidb - · simp only [Relation.Comp] - exists smid2 + · exists smid2 constructor · exact hsmidr · apply Bisimilarity.trans lts hsmidrb @@ -313,7 +309,6 @@ theorem Bisimulation.upTo_bisimulation (r : State → State → Prop) (h : Bisim exact hs1btr case right => obtain ⟨smid1, hsmidb, smid2, hsmidr, hsmidrb⟩ := hs1b'r - simp only [Relation.upTo, Relation.Comp] constructor constructor · apply Bisimilarity.trans lts (Bisimilarity.largest_bisimulation lts r1 hr1b _ _ _) hsmidb @@ -1079,8 +1074,7 @@ theorem WeakBisimulation.comp exists s2'' constructor · exact h2'tr - · simp only [Relation.Comp] - exists s1'' + · exists s1'' case right => intro s2' htr rcases hrc with ⟨sb, hr1, hr2⟩ @@ -1093,8 +1087,7 @@ theorem WeakBisimulation.comp exists s1'' constructor · exact h1'tr - · simp only [Relation.Comp] - exists s2'' + · exists s2'' /-- The composition of two sw-bisimulations is an sw-bisimulation. -/ theorem SWBisimulation.comp @@ -1116,7 +1109,6 @@ theorem WeakBisimilarity.trans exists Relation.Comp r1 r2 constructor case left => - simp only [Relation.Comp] exists s2 case right => apply WeakBisimulation.comp lts r1 r2 hr1b hr2b diff --git a/Cslib/Semantics/LTS/Simulation.lean b/Cslib/Semantics/LTS/Simulation.lean index 3972f2e5..d9461e05 100644 --- a/Cslib/Semantics/LTS/Simulation.lean +++ b/Cslib/Semantics/LTS/Simulation.lean @@ -88,8 +88,7 @@ theorem Simulation.comp exists s2'' constructor · exact h2'tr - · simp only [Relation.Comp] - exists s1'' + · exists s1'' /-- Similarity is transitive. -/ theorem Similarity.trans (h1 : s1 ≤[lts] s2) (h2 : s2 ≤[lts] s3) : s1 ≤[lts] s3 := by @@ -98,7 +97,6 @@ theorem Similarity.trans (h1 : s1 ≤[lts] s2) (h2 : s2 ≤[lts] s3) : s1 ≤[lt exists Relation.Comp r1 r2 constructor case left => - simp only [Relation.Comp] exists s2 case right => apply Simulation.comp lts r1 r2 hr1s hr2s @@ -144,16 +142,14 @@ theorem SimulationEquiv.trans {s1 s2 s3 : State} (h1 : s1 ≤≥[lts] s2) (h2 : obtain ⟨r2, hr2, hr2s⟩ := h2l exists Relation.Comp r1 r2 constructor - · simp only [Relation.Comp] - exists s2 + · exists s2 · apply Simulation.comp lts r1 r2 hr1s hr2s case right => obtain ⟨r1, hr1, hr1s⟩ := h1r obtain ⟨r2, hr2, hr2s⟩ := h2r exists Relation.Comp r2 r1 constructor - · simp only [Relation.Comp] - exists s2 + · exists s2 · apply Simulation.comp lts r2 r1 hr2s hr1s /-- Simulation equivalence is an equivalence relation. -/ From acb0c94563501534a6b9f947db7d1688dc01d0cc Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Fri, 25 Jul 2025 15:21:20 +0200 Subject: [PATCH 014/107] Adopt \sup and Eq instead of custom defs --- Cslib/Data/Relation.lean | 11 ----------- Cslib/Semantics/LTS/Bisimulation.lean | 21 +++++++-------------- Cslib/Semantics/LTS/Simulation.lean | 9 +++------ 3 files changed, 10 insertions(+), 31 deletions(-) diff --git a/Cslib/Data/Relation.lean b/Cslib/Data/Relation.lean index 909cb68e..4186a699 100644 --- a/Cslib/Data/Relation.lean +++ b/Cslib/Data/Relation.lean @@ -12,23 +12,12 @@ universe u v section Relation -/-- Union of two relations. -/ -def Relation.union (r s : α → β → Prop) : α → β → Prop := - fun x y => r x y ∨ s x y - -instance {α : Type u} {β : Type v} : Union (α → β → Prop) where - union := Relation.union - /-- Inverse of a relation. -/ def Relation.inv (r : α → β → Prop) : β → α → Prop := flip r /-- The relation `r` 'up to' the relation `s`. -/ def Relation.upTo (r s : α → α → Prop) : α → α → Prop := Relation.Comp s (Relation.Comp r s) -/-- The identity relation. -/ -inductive Relation.Id : α → α → Prop where -| id {x : α} : Id x x - /-- 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 → (∃ D, R B D ∧ R C D) diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index 873d209b..10cbb9a8 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -102,10 +102,9 @@ notation s:max " ~[" lts "] " s':max => Bisimilarity lts s s' /-- Bisimilarity is reflexive. -/ theorem Bisimilarity.refl (s : State) : s ~[lts] s := by - exists Relation.Id + exists Eq constructor - case left => - constructor + case left => rfl case right => simp only [Bisimulation] intro s1 s2 hr μ @@ -114,15 +113,9 @@ theorem Bisimilarity.refl (s : State) : s ~[lts] s := by case left => intro s1' htr exists s1' - constructor - · exact htr - · constructor case right => intro s1' htr exists s1' - constructor - · exact htr - · constructor /-- The inverse of a bisimulation is a bisimulation. -/ theorem Bisimulation.inv (r : State → State → Prop) (h : Bisimulation lts r) : @@ -253,9 +246,9 @@ theorem Bisimilarity.largest_bisimulation /-- The union of bisimilarity with any bisimulation is bisimilarity. -/ theorem Bisimilarity.gfp (r : State → State → Prop) (h : Bisimulation lts r) : - (Bisimilarity lts) ∪ r = Bisimilarity lts := by + (Bisimilarity lts) ⊔ r = Bisimilarity lts := by funext s1 s2 - simp only [Union.union, Relation.union, eq_iff_iff, or_iff_left_iff_imp] + simp only [max, SemilatticeSup.sup, eq_iff_iff, or_iff_left_iff_imp] apply Bisimilarity.largest_bisimulation lts r h /-- A relation `r` is a bisimulation up to bisimilarity if, whenever it relates two @@ -982,9 +975,9 @@ theorem WeakBisimilarity.weakBisim_eq_swBisim [HasTau Label] (lts : LTS State La /-- sw-bisimilarity is reflexive. -/ theorem SWBisimilarity.refl [HasTau Label] (lts : LTS State Label) (s : State) : s ≈sw[lts] s := by simp [SWBisimilarity] - exists Relation.Id - constructor; constructor - simp [SWBisimulation] + exists Eq + constructor; rfl + simp only [SWBisimulation] intro s1 s2 hr μ cases hr constructor diff --git a/Cslib/Semantics/LTS/Simulation.lean b/Cslib/Semantics/LTS/Simulation.lean index d9461e05..757e2aa9 100644 --- a/Cslib/Semantics/LTS/Simulation.lean +++ b/Cslib/Semantics/LTS/Simulation.lean @@ -64,13 +64,12 @@ notation s:max " ≤[" lts "] " s':max => Similarity lts s s' /-- Similarity is reflexive. -/ theorem Similarity.refl (s : State) : s ≤[lts] s := by - exists Relation.Id + exists Eq apply And.intro (by constructor) simp only [Simulation] intro s1 s2 hr μ s1' htr cases hr exists s1' - apply And.intro htr (by constructor) /-- The composition of two simulations is a simulation. -/ theorem Simulation.comp @@ -115,14 +114,12 @@ notation s:max " ≤≥[" lts "] " s':max => SimulationEquiv lts s s' /-- Simulation equivalence is reflexive. -/ theorem SimulationEquiv.refl (s : State) : s ≤≥[lts] s := by simp [SimulationEquiv] - exists Relation.Id - constructor; constructor + exists Eq + constructor; rfl simp only [Simulation] intro s1 s2 hr μ s1' htr cases hr exists s1' - constructor; exact htr - constructor /-- Simulation equivalence is symmetric. -/ theorem SimulationEquiv.symm {s1 s2 : State} (h : s1 ≤≥[lts] s2) : s2 ≤≥[lts] s1 := by From 8e34a71ca22d6106d62e1d880f3d35545e826609 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Fri, 25 Jul 2025 15:47:21 +0200 Subject: [PATCH 015/107] Activate mathlib linters and fix some warnings. (#19) * Activate mathlib linters and fix some warnings. * Add lint & suggest action --- .github/workflows/lean_lint_suggest.yml | 13 ++++++ Cslib/Semantics/LTS/Basic.lean | 56 ++++++++++++++++++------- lakefile.toml | 3 ++ 3 files changed, 58 insertions(+), 14 deletions(-) create mode 100644 .github/workflows/lean_lint_suggest.yml diff --git a/.github/workflows/lean_lint_suggest.yml b/.github/workflows/lean_lint_suggest.yml new file mode 100644 index 00000000..6f83ca22 --- /dev/null +++ b/.github/workflows/lean_lint_suggest.yml @@ -0,0 +1,13 @@ +on: + pull_request + +name: Lint and suggest + +jobs: + lint: + if: github.repository == 'cs-lean/cslib' && github.event.pull_request.draft == false + runs-on: ubuntu-latest + steps: + - uses: leanprover-community/lint-style-action + with: + mode: suggest \ No newline at end of file diff --git a/Cslib/Semantics/LTS/Basic.lean b/Cslib/Semantics/LTS/Basic.lean index c91227ed..f4226175 100644 --- a/Cslib/Semantics/LTS/Basic.lean +++ b/Cslib/Semantics/LTS/Basic.lean @@ -396,13 +396,20 @@ theorem LTS.STr.single [HasTau Label] (lts : LTS State Label) : lts.Tr s μ s' intro h apply LTS.STr.tr LTS.STr.refl h LTS.STr.refl -/-- As `LTS.str`, but counts the number of `τ`-transitions. This is convenient as induction metric. -/ -inductive LTS.strN [HasTau Label] (lts : LTS State Label) : ℕ → State → Label → State → Prop where -| refl : lts.strN 0 s HasTau.τ s -| tr : lts.strN n s1 HasTau.τ s2 → lts.Tr s2 μ s3 → lts.strN m s3 HasTau.τ s4 → lts.strN (n + m + 1) s1 μ s4 +/-- As `LTS.str`, but counts the number of `τ`-transitions. This is convenient as induction +metric. -/ +inductive LTS.strN [HasTau Label] (lts : LTS State Label) : + ℕ → State → Label → State → Prop where + | refl : lts.strN 0 s HasTau.τ s + | tr : + lts.strN n s1 HasTau.τ s2 → + lts.Tr s2 μ s3 → + lts.strN m s3 HasTau.τ s4 → + lts.strN (n + m + 1) s1 μ s4 /-- `LTS.str` and `LTS.strN` are equivalent. -/ -theorem LTS.str_strN [HasTau Label] (lts : LTS State Label) : lts.STr s1 μ s2 ↔ ∃ n, lts.strN n s1 μ s2 := by +theorem LTS.str_strN [HasTau Label] (lts : LTS State Label) : + lts.STr s1 μ s2 ↔ ∃ n, lts.strN n s1 μ s2 := by apply Iff.intro <;> intro h case mp => induction h @@ -512,7 +519,10 @@ def LTS.Divergent [HasTau Label] (lts : LTS State Label) (s : State) : Prop := ∃ stream : Stream' State, stream 0 = s ∧ lts.DivergentExecution stream /-- If a stream is a divergent execution, then any 'suffix' is also a divergent execution. -/ -theorem LTS.divergent_drop [HasTau Label] (lts : LTS State Label) (stream : Stream' State) (h : lts.DivergentExecution stream) (n : ℕ) : lts.DivergentExecution (stream.drop n) := by +theorem LTS.divergent_drop + [HasTau Label] (lts : LTS State Label) (stream : Stream' State) + (h : lts.DivergentExecution stream) (n : ℕ) : + lts.DivergentExecution (stream.drop n) := by simp only [LTS.DivergentExecution] intro m simp only [Stream'.drop, Stream'.get] @@ -535,7 +545,8 @@ section Relation def LTS.Tr.toRelation (lts : LTS State Label) (μ : Label) : State → State → Prop := fun s1 s2 => lts.Tr s1 μ s2 -/-- Returns the relation that relates all states `s1` and `s2` via a fixed list of transition labels `μs`. -/ +/-- Returns the relation that relates all states `s1` and `s2` via a fixed list of transition +labels `μs`. -/ def LTS.MTr.toRelation (lts : LTS State Label) (μs : List Label) : State → State → Prop := fun s1 s2 => lts.MTr s1 μs s2 @@ -551,7 +562,11 @@ section Trans /-! ## Support for the calc tactic -/ /-- Transitions can be chained. -/ -instance (lts : LTS State Label) : Trans (LTS.Tr.toRelation lts μ1) (LTS.Tr.toRelation lts μ2) (LTS.MTr.toRelation lts [μ1, μ2]) where +instance (lts : LTS State Label) : + Trans + (LTS.Tr.toRelation lts μ1) + (LTS.Tr.toRelation lts μ2) + (LTS.MTr.toRelation lts [μ1, μ2]) where trans := by intro s1 s2 s3 htr1 htr2 apply LTS.MTr.single at htr1 @@ -559,21 +574,33 @@ instance (lts : LTS State Label) : Trans (LTS.Tr.toRelation lts μ1) (LTS.Tr.toR apply LTS.MTr.comp lts htr1 htr2 /-- Transitions can be chained with multi-step transitions. -/ -instance (lts : LTS State Label) : Trans (LTS.Tr.toRelation lts μ) (LTS.MTr.toRelation lts μs) (LTS.MTr.toRelation lts (μ :: μs)) where +instance (lts : LTS State Label) : + Trans + (LTS.Tr.toRelation lts μ) + (LTS.MTr.toRelation lts μs) + (LTS.MTr.toRelation lts (μ :: μs)) where trans := by intro s1 s2 s3 htr1 hmtr2 apply LTS.MTr.single at htr1 apply LTS.MTr.comp lts htr1 hmtr2 /-- Multi-step transitions can be chained with transitions. -/ -instance (lts : LTS State Label) : Trans (LTS.MTr.toRelation lts μs) (LTS.Tr.toRelation lts μ) (LTS.MTr.toRelation lts (μs ++ [μ])) where +instance (lts : LTS State Label) : + Trans + (LTS.MTr.toRelation lts μs) + (LTS.Tr.toRelation lts μ) + (LTS.MTr.toRelation lts (μs ++ [μ])) where trans := by intro s1 s2 s3 hmtr1 htr2 apply LTS.MTr.single at htr2 apply LTS.MTr.comp lts hmtr1 htr2 /-- Multi-step transitions can be chained. -/ -instance (lts : LTS State Label) : Trans (LTS.MTr.toRelation lts μs1) (LTS.MTr.toRelation lts μs2) (LTS.MTr.toRelation lts (μs1 ++ μs2)) where +instance (lts : LTS State Label) : + Trans + (LTS.MTr.toRelation lts μs1) + (LTS.MTr.toRelation lts μs2) + (LTS.MTr.toRelation lts (μs1 ++ μs2)) where trans := by intro s1 s2 s3 hmtr1 hmtr2 apply LTS.MTr.comp lts hmtr1 hmtr2 @@ -582,7 +609,8 @@ end Trans open Lean Elab Meta Command Term -/-- A command to create an `LTS` from a labelled transition `α → β → α → Prop`, robust to use of `variable `-/ +/-- A command to create an `LTS` from a labelled transition `α → β → α → Prop`, robust to use of +`variable `-/ elab "create_lts" lt:ident name:ident : command => do liftTermElabM do let lt ← realizeGlobalConstNoOverloadWithInfo lt @@ -612,8 +640,8 @@ elab "create_lts" lt:ident name:ident : command => do addDeclarationRangesFromSyntax name.getId name /-- - This command adds transition notations for an `LTS`. This should not usually be called directly, but from - the `lts` attribute. + This command adds transition notations for an `LTS`. This should not usually be called directly, + but from the `lts` attribute. As an example `lts_transition_notation foo "β"` will add the notations "[⬝]⭢β" and "[⬝]↠β" diff --git a/lakefile.toml b/lakefile.toml index 79fb9b28..8b170180 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -3,6 +3,9 @@ version = "0.1.0" defaultTargets = ["Cslib"] testDriver = "CslibTests" +[leanOptions] +weak.linter.mathlibStandardSet = true + [[require]] name = "mathlib" scope = "leanprover-community" From 174a932ca02e4aec68060cca0f1eb10df340653a Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Fri, 25 Jul 2025 16:38:32 +0200 Subject: [PATCH 016/107] Trans instances for behavioural equivalences --- Cslib/Semantics/LTS/Bisimulation.lean | 16 ++++++++++++---- Cslib/Semantics/LTS/Simulation.lean | 27 ++++++++++++++++++--------- Cslib/Semantics/LTS/TraceEq.lean | 6 +++++- 3 files changed, 35 insertions(+), 14 deletions(-) diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index 10cbb9a8..8c59216d 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -19,7 +19,8 @@ these transitions remain related by the bisimulation. Bisimilarity is the largest bisimulation: given an `LTS`, it relates any two states that are related by a bisimulation for that LTS. -Weak bisimulation (resp. bisimilarity) is the relaxed version of bisimulation (resp. bisimilarity) whereby internal actions performed by processes can be ignored. +Weak bisimulation (resp. bisimilarity) is the relaxed version of bisimulation (resp. bisimilarity) +whereby internal actions performed by processes can be ignored. For an introduction to theory of bisimulation, we refer to [Sangiorgi2011]. @@ -57,7 +58,8 @@ related by some sw-bisimulation on `lts`. trace equivalent (see `TraceEq`). - `Bisimilarity.deterministic_bisim_eq_traceEq`: in a deterministic LTS, bisimilarity and trace equivalence coincide. -- `WeakBisimilarity.weakBisim_eq_swBisim`: weak bisimilarity and sw-bisimilarity coincide in all LTSs. +- `WeakBisimilarity.weakBisim_eq_swBisim`: weak bisimilarity and sw-bisimilarity coincide in all +LTSs. - `WeakBisimilarity.eqv`: weak bisimilarity is an equivalence relation. - `SWBisimilarity.eqv`: sw-bisimilarity is an equivalence relation. @@ -251,6 +253,12 @@ theorem Bisimilarity.gfp (r : State → State → Prop) (h : Bisimulation lts r) simp only [max, SemilatticeSup.sup, eq_iff_iff, or_iff_left_iff_imp] apply Bisimilarity.largest_bisimulation lts r h +/-- `calc` support for bisimilarity. -/ +instance : Trans (Bisimilarity lts) (Bisimilarity lts) (Bisimilarity lts) where + trans := Bisimilarity.trans lts + +/-! ## Bisimulation up-to -/ + /-- A relation `r` is a bisimulation up to bisimilarity if, whenever it relates two states in an lts, the transitions originating from these states mimic each other and the reached derivatives are themselves related by `r` up to bisimilarity. -/ @@ -346,7 +354,7 @@ theorem Bisimulation.bisim_trace case right => exact hr' -/-! ### Relation to trace equivalence -/ +/-! ## Relation to trace equivalence -/ /-- Any bisimulation implies trace equivalence. -/ theorem Bisimulation.bisim_traceEq @@ -722,7 +730,7 @@ theorem Bisimilarity.deterministic_bisim_eq_traceEq case mpr => apply Bisimilarity.deterministic_traceEq_bisim lts hdet -/-! ### Relation to simulation -/ +/-! ## Relation to simulation -/ /-- Any bisimulation is also a simulation. -/ theorem Bisimulation.is_simulation (lts : LTS State Label) (r : State → State → Prop) : Bisimulation lts r → Simulation lts r := by diff --git a/Cslib/Semantics/LTS/Simulation.lean b/Cslib/Semantics/LTS/Simulation.lean index 757e2aa9..e88dc6ce 100644 --- a/Cslib/Semantics/LTS/Simulation.lean +++ b/Cslib/Semantics/LTS/Simulation.lean @@ -9,12 +9,12 @@ import Cslib.Data.Relation /-! # Simulation and Similarity -A simulation is a binary relation on the states of an `LTS`: if two states `s1` and `s2` are related by a simulation, then -`s2` can mimic all transitions of `s1`. Furthermore, the derivatives reaches through -these transitions remain related by the simulation. +A simulation is a binary relation on the states of an `LTS`: if two states `s1` and `s2` are +related by a simulation, then `s2` can mimic all transitions of `s1`. Furthermore, the derivatives +reaches through these transitions remain related by the simulation. Similarity is the largest simulation: given an `LTS`, it relates any two states that are related -by a bisimulation for that LTS. +by a simulation for that LTS. For an introduction to theory of simulation, we refer to [Sangiorgi2011]. @@ -115,11 +115,12 @@ notation s:max " ≤≥[" lts "] " s':max => SimulationEquiv lts s s' theorem SimulationEquiv.refl (s : State) : s ≤≥[lts] s := by simp [SimulationEquiv] exists Eq - constructor; rfl - simp only [Simulation] - intro s1 s2 hr μ s1' htr - cases hr - exists s1' + constructor + · rfl + · simp only [Simulation] + intro s1 s2 hr μ s1' htr + cases hr + exists s1' /-- Simulation equivalence is symmetric. -/ theorem SimulationEquiv.symm {s1 s2 : State} (h : s1 ≤≥[lts] s2) : s2 ≤≥[lts] s1 := by @@ -157,4 +158,12 @@ theorem SimulationEquiv.eqv (lts : LTS State Label) : trans := SimulationEquiv.trans lts } +/-- `calc` support for simulation equivalence. -/ +instance : + Trans + (SimulationEquiv lts) + (SimulationEquiv lts) + (SimulationEquiv lts) where + trans := SimulationEquiv.trans lts + end Simulation diff --git a/Cslib/Semantics/LTS/TraceEq.lean b/Cslib/Semantics/LTS/TraceEq.lean index 1cd73651..4e77eef9 100644 --- a/Cslib/Semantics/LTS/TraceEq.lean +++ b/Cslib/Semantics/LTS/TraceEq.lean @@ -73,13 +73,17 @@ theorem TraceEq.trans {s1 s2 s3 : State} (h1 : s1 ~tr[lts] s2) (h2 : s2 ~tr[lts] simp only [TraceEq] at h2 rw [h1, h2] -/-- Bisimilarity is an equivalence relation. -/ +/-- Trace equivalence is an equivalence relation. -/ theorem TraceEq.eqv (lts : LTS State Label) : Equivalence (TraceEq lts) := { refl := TraceEq.refl lts symm := TraceEq.symm lts trans := TraceEq.trans lts } +/-- `calc` support for simulation equivalence. -/ +instance : Trans (TraceEq lts) (TraceEq lts) (TraceEq lts) where + trans := TraceEq.trans lts + /-- In a deterministic LTS, trace equivalence is a simulation. -/ theorem TraceEq.deterministic_sim (lts : LTS State Label) (hdet : lts.Deterministic) (s1 s2 : State) (h : s1 ~tr[lts] s2) : From 4585fe44c7536cb1192949844aa001765734f94b Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sat, 26 Jul 2025 09:34:35 +0200 Subject: [PATCH 017/107] Remove Relation.inv in favour of the built-in flip --- Cslib/Data/Relation.lean | 3 --- Cslib/Semantics/LTS/Bisimulation.lean | 18 +++++++++--------- 2 files changed, 9 insertions(+), 12 deletions(-) diff --git a/Cslib/Data/Relation.lean b/Cslib/Data/Relation.lean index 4186a699..36a263b4 100644 --- a/Cslib/Data/Relation.lean +++ b/Cslib/Data/Relation.lean @@ -12,9 +12,6 @@ universe u v section Relation -/-- Inverse of a relation. -/ -def Relation.inv (r : α → β → Prop) : β → α → Prop := flip r - /-- The relation `r` 'up to' the relation `s`. -/ def Relation.upTo (r s : α → α → Prop) : α → α → Prop := Relation.Comp s (Relation.Comp r s) diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index 8c59216d..651539a9 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -121,7 +121,7 @@ theorem Bisimilarity.refl (s : State) : s ~[lts] s := by /-- The inverse of a bisimulation is a bisimulation. -/ theorem Bisimulation.inv (r : State → State → Prop) (h : Bisimulation lts r) : - Bisimulation lts (Relation.inv r) := by + Bisimulation lts (flip r) := by simp only [Bisimulation] at h simp only [Bisimulation] intro s1 s2 hrinv μ @@ -142,7 +142,7 @@ theorem Bisimulation.inv (r : State → State → Prop) (h : Bisimulation lts r) /-- Bisimilarity is symmetric. -/ theorem Bisimilarity.symm {s1 s2 : State} (h : s1 ~[lts] s2) : s2 ~[lts] s1 := by obtain ⟨r, hr, hb⟩ := h - exists (Relation.inv r) + exists (flip r) constructor case left => exact hr @@ -374,7 +374,7 @@ theorem Bisimulation.bisim_traceEq intro h obtain ⟨s2', h⟩ := h have hinv := @Bisimulation.inv State Label lts r hb - obtain ⟨s1', hmtr⟩ := @Bisimulation.bisim_trace State Label lts s2 s1 (Relation.inv r) hinv hr μs s2' h + obtain ⟨s1', hmtr⟩ := @Bisimulation.bisim_trace State Label lts s2 s1 (flip r) hinv hr μs s2' h exists s1' exact hmtr.1 @@ -743,7 +743,7 @@ theorem Bisimulation.is_simulation (lts : LTS State Label) (r : State → State apply h1 s1' htr /-- A relation is a bisimulation iff both it and its inverse are simulations. -/ -theorem Bisimulation.simulation_iff (lts : LTS State Label) (r : State → State → Prop) : Bisimulation lts r ↔ (Simulation lts r ∧ Simulation lts (Relation.inv r)) := by +theorem Bisimulation.simulation_iff (lts : LTS State Label) (r : State → State → Prop) : Bisimulation lts r ↔ (Simulation lts r ∧ Simulation lts (flip r)) := by constructor intro h simp only [Simulation] @@ -757,7 +757,7 @@ theorem Bisimulation.simulation_iff (lts : LTS State Label) (r : State → State obtain ⟨s2', h1⟩ := h1 exists s2' case right => - simp only [Relation.inv, flip] + simp only [flip, flip] intro s2 s1 hr μ s2' htr simp only [Bisimulation] at h specialize h s1 s2 hr μ @@ -1010,7 +1010,7 @@ theorem WeakBisimilarity.refl [HasTau Label] (lts : LTS State Label) (s : State) /-- The inverse of an sw-bisimulation is an sw-bisimulation. -/ theorem SWBisimulation.inv [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) (h : SWBisimulation lts r) : - SWBisimulation lts (Relation.inv r) := by + SWBisimulation lts (flip r) := by simp only [SWBisimulation] at h simp only [SWBisimulation] intro s1 s2 hrinv μ @@ -1031,7 +1031,7 @@ theorem SWBisimulation.inv [HasTau Label] (lts : LTS State Label) /-- The inverse of a weak bisimulation is a weak bisimulation. -/ theorem WeakBisimulation.inv [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) (h : WeakBisimulation lts r) : - WeakBisimulation lts (Relation.inv r) := by + WeakBisimulation lts (flip r) := by apply WeakBisimulation.toSwBisimulation at h have h' := SWBisimulation.inv lts r h apply SWBisimulation.toWeakBisimulation at h' @@ -1040,10 +1040,10 @@ theorem WeakBisimulation.inv [HasTau Label] (lts : LTS State Label) /-- sw-bisimilarity is symmetric. -/ theorem SWBisimilarity.symm [HasTau Label] (lts : LTS State Label) (h : s1 ≈sw[lts] s2) : s2 ≈sw[lts] s1 := by obtain ⟨r, hr, hrh⟩ := h - exists (Relation.inv r) + exists (flip r) constructor case left => - simp only [Relation.inv, flip] + simp only [flip, flip] exact hr case right => apply SWBisimulation.inv lts r hrh From 84115c1f299c0fe87e1c9b98543a9d893d013cc9 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sat, 26 Jul 2025 09:44:47 +0200 Subject: [PATCH 018/107] Bisimilarity life improvements (use Subrelation and implicit in largest_bisimulation) --- .../CCS/BehaviouralTheory.lean | 27 ++++++++++--------- Cslib/Data/Relation.lean | 4 +-- Cslib/Semantics/LTS/Bisimulation.lean | 19 +++++++------ 3 files changed, 27 insertions(+), 23 deletions(-) diff --git a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean index 35189c24..63e47d2f 100644 --- a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean +++ b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean @@ -203,7 +203,7 @@ theorem bisimilarity_congr_pre : (p ~[@lts Name Constant defs] q) → (pre μ p) exists s2' apply And.intro htr2 constructor - apply Bisimilarity.largest_bisimulation _ r hbisim _ _ hr2 + apply Bisimilarity.largest_bisimulation _ hbisim hr2 case right => intro s2' htr obtain ⟨r, hr, hb⟩ := hbis @@ -215,7 +215,7 @@ theorem bisimilarity_congr_pre : (p ~[@lts Name Constant defs] q) → (pre μ p) exists s1' apply And.intro htr1 constructor - apply Bisimilarity.largest_bisimulation _ r hbisim s1' s2' hr1 + apply Bisimilarity.largest_bisimulation _ hbisim hr1 private inductive ResBisim : (Process Name Constant) → (Process Name Constant) → Prop where | res : (p ~[@lts Name Constant defs] q) → ResBisim (res a p) (res a q) @@ -274,7 +274,7 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice constructor · apply Tr.choiceL htr2 · constructor - apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr2 + apply Bisimilarity.largest_bisimulation _ hb hr2 case choiceR a b c htr => exists s1' constructor @@ -287,7 +287,7 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice exists s2' constructor; assumption constructor - apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr2 + apply Bisimilarity.largest_bisimulation _ hb hr2 case right => intro s2' htr cases r @@ -300,7 +300,7 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice constructor · apply Tr.choiceL htr1 · constructor - apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr1 + apply Bisimilarity.largest_bisimulation _ hb hr1 case choiceR a b c htr => exists s2' constructor @@ -311,9 +311,10 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice obtain ⟨rel, hr, hb⟩ := hbisim obtain ⟨s1', htr1, hr1⟩ := hb.follow_snd hr μ htr exists s1' - constructor; assumption constructor - apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr1 + · assumption + · constructor + apply Bisimilarity.largest_bisimulation _ hb hr1 private inductive ParBisim : (Process Name Constant) → (Process Name Constant) → Prop where | par : (p ~[@lts Name Constant defs] q) → ParBisim (par p r) (par q r) @@ -338,20 +339,20 @@ theorem bisimilarity_congr_par : (p ~[@lts Name Constant defs] q) → (par p r) constructor · apply Tr.parL htr2 · constructor - apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr2 + apply Bisimilarity.largest_bisimulation _ hb hr2 case parR _ _ r' htr => exists (par q r') constructor · apply Tr.parR htr · constructor - apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr + apply Bisimilarity.largest_bisimulation _ hb hr case com μ' p' r' htrp htrr => obtain ⟨q', htr2, hr2⟩ := hb.follow_fst hr μ' htrp exists (par q' r') constructor · apply Tr.com htr2 htrr · constructor - apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr2 + apply Bisimilarity.largest_bisimulation _ hb hr2 case right => intro s2' htr cases r @@ -364,20 +365,20 @@ theorem bisimilarity_congr_par : (p ~[@lts Name Constant defs] q) → (par p r) constructor · apply Tr.parL htr2 · constructor - apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr2 + apply Bisimilarity.largest_bisimulation _ hb hr2 case parR _ _ r' htr => exists (par p r') constructor · apply Tr.parR htr · constructor - apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr + apply Bisimilarity.largest_bisimulation _ hb hr case com μ' p' r' htrq htrr => obtain ⟨q', htr2, hr2⟩ := hb.follow_snd hr μ' htrq exists (par q' r') constructor · apply Tr.com htr2 htrr · constructor - apply Bisimilarity.largest_bisimulation _ _ hb _ _ hr2 + apply Bisimilarity.largest_bisimulation _ hb hr2 /-- Bisimilarity is a congruence in CCS. -/ theorem bisimilarity_congr (c : Context Name Constant) (p q : Process Name Constant) (h : p ~[@lts Name Constant defs] q) : diff --git a/Cslib/Data/Relation.lean b/Cslib/Data/Relation.lean index 36a263b4..9bc36b69 100644 --- a/Cslib/Data/Relation.lean +++ b/Cslib/Data/Relation.lean @@ -79,7 +79,7 @@ theorem church_rosser_of_diamond {α : Type _} {r : α → α → Prop} let ⟨d, hd⟩ := h a b c hab hac use d constructor - . exact Relation.ReflGen.single hd.1 - . exact Relation.ReflTransGen.single hd.2 + · exact Relation.ReflGen.single hd.1 + · exact Relation.ReflTransGen.single hd.2 end Relation diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index 651539a9..3bc7e724 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -241,17 +241,20 @@ theorem Bisimilarity.is_bisimulation : Bisimulation lts (Bisimilarity lts) := by /-- Bisimilarity is the largest bisimulation. -/ theorem Bisimilarity.largest_bisimulation - (r : State → State → Prop) (h : Bisimulation lts r) (s1 s2 : State) : - r s1 s2 → s1 ~[lts] s2 := by - intro hr + (h : Bisimulation lts r) : + Subrelation r (Bisimilarity lts) := by + -- simp only [Subrelation] + intro s1 s2 hr exists r + -- intro hr + -- exists r /-- The union of bisimilarity with any bisimulation is bisimilarity. -/ theorem Bisimilarity.gfp (r : State → State → Prop) (h : Bisimulation lts r) : (Bisimilarity lts) ⊔ r = Bisimilarity lts := by funext s1 s2 simp only [max, SemilatticeSup.sup, eq_iff_iff, or_iff_left_iff_imp] - apply Bisimilarity.largest_bisimulation lts r h + apply Bisimilarity.largest_bisimulation lts h /-- `calc` support for bisimilarity. -/ instance : Trans (Bisimilarity lts) (Bisimilarity lts) (Bisimilarity lts) where @@ -292,13 +295,13 @@ theorem Bisimulation.upTo_bisimulation (r : State → State → Prop) (h : Bisim obtain ⟨smid1, hsmidb, smid2, hsmidr, hsmidrb⟩ := hs2b'r constructor constructor - · apply Bisimilarity.trans lts (Bisimilarity.largest_bisimulation lts r1 hr1b _ _ hs1b'r) + · apply Bisimilarity.trans lts (Bisimilarity.largest_bisimulation lts hr1b hs1b'r) hsmidb · exists smid2 constructor · exact hsmidr · apply Bisimilarity.trans lts hsmidrb - apply Bisimilarity.largest_bisimulation lts r2 hr2b s2b' s2' hs2br + apply Bisimilarity.largest_bisimulation lts hr2b hs2br case right => intro s2' htr2 obtain ⟨s2b', hs2b'tr, hs2b'r⟩ := (hr2b _ _ hr2 μ).2 s2' htr2 @@ -312,13 +315,13 @@ theorem Bisimulation.upTo_bisimulation (r : State → State → Prop) (h : Bisim obtain ⟨smid1, hsmidb, smid2, hsmidr, hsmidrb⟩ := hs1b'r constructor constructor - · apply Bisimilarity.trans lts (Bisimilarity.largest_bisimulation lts r1 hr1b _ _ _) hsmidb + · apply Bisimilarity.trans lts (Bisimilarity.largest_bisimulation lts hr1b _) hsmidb · exact hs1br · exists smid2 constructor · exact hsmidr · apply Bisimilarity.trans lts hsmidrb - apply Bisimilarity.largest_bisimulation lts r2 hr2b s2b' s2' _ + apply Bisimilarity.largest_bisimulation lts hr2b _ exact hs2b'r /-- If two states are related by a bisimulation, they can mimic each other's multi-step From 60d00fc325b788dc20991a6e525f10b2cb6855df Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sat, 26 Jul 2025 15:43:06 +0200 Subject: [PATCH 019/107] Bisimilarity: better implicits --- .../CCS/BehaviouralTheory.lean | 34 ++++++++++--------- Cslib/Semantics/LTS/Bisimulation.lean | 12 +++++-- 2 files changed, 27 insertions(+), 19 deletions(-) diff --git a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean index 63e47d2f..23abd37b 100644 --- a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean +++ b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean @@ -153,14 +153,14 @@ theorem bisimilarity_choice_comm : (choice p q) ~[@lts Name Constant defs] (choi constructor case left => intro s1' htr - have hb := Bisimulation.follow_fst (Bisimilarity.is_bisimulation lts) h μ htr + have hb := Bisimulation.follow_fst (Bisimilarity.is_bisimulation lts) h htr obtain ⟨s2', htr2, hr2⟩ := hb exists s2' apply And.intro htr2 constructor; assumption case right => intro s2' htr - have hb := Bisimulation.follow_snd (Bisimilarity.is_bisimulation lts) h μ htr + have hb := Bisimulation.follow_snd (Bisimilarity.is_bisimulation lts) h htr obtain ⟨s1', htr1, hr1⟩ := hb exists s1' apply And.intro htr1 @@ -199,7 +199,7 @@ theorem bisimilarity_congr_pre : (p ~[@lts Name Constant defs] q) → (pre μ p) intro s1' htr obtain ⟨r, hr, hb⟩ := hbis let hbisim := hb - obtain ⟨s2', htr2, hr2⟩ := hb.follow_fst hr μ' htr + obtain ⟨s2', htr2, hr2⟩ := hb.follow_fst hr htr exists s2' apply And.intro htr2 constructor @@ -235,7 +235,7 @@ theorem bisimilarity_congr_res : (p ~[@lts Name Constant defs] q) → (res a p) intro s1' htr cases htr rename_i p' h1 h2 htr - have h := Bisimulation.follow_fst (Bisimilarity.is_bisimulation lts) h μ' htr + have h := Bisimulation.follow_fst (Bisimilarity.is_bisimulation lts) h htr obtain ⟨q', htrq, h⟩ := h exists (res a q') constructor; constructor; repeat assumption @@ -244,7 +244,7 @@ theorem bisimilarity_congr_res : (p ~[@lts Name Constant defs] q) → (res a p) intro s2' htr cases htr rename_i q' h1 h2 htr - have h := Bisimulation.follow_snd (Bisimilarity.is_bisimulation lts) h μ' htr + have h := Bisimulation.follow_snd (Bisimilarity.is_bisimulation lts) h htr obtain ⟨p', htrq, h⟩ := h exists (res a p') constructor; constructor; repeat assumption @@ -269,7 +269,7 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice obtain ⟨rel, hr, hb⟩ := hbisim cases htr case choiceL a b c htr => - obtain ⟨s2', htr2, hr2⟩ := hb.follow_fst hr μ htr + obtain ⟨s2', htr2, hr2⟩ := hb.follow_fst hr htr exists s2' constructor · apply Tr.choiceL htr2 @@ -283,7 +283,7 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice apply Bisimilarity.refl case bisim hbisim => obtain ⟨rel, hr, hb⟩ := hbisim - obtain ⟨s2', htr2, hr2⟩ := hb.follow_fst hr μ htr + obtain ⟨s2', htr2, hr2⟩ := hb.follow_fst hr htr exists s2' constructor; assumption constructor @@ -295,7 +295,7 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice obtain ⟨rel, hr, hb⟩ := hbisim cases htr case choiceL a b c htr => - obtain ⟨s1', htr1, hr1⟩ := hb.follow_snd hr μ htr + obtain ⟨s1', htr1, hr1⟩ := hb.follow_snd hr htr exists s1' constructor · apply Tr.choiceL htr1 @@ -309,7 +309,7 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice apply Bisimilarity.refl case bisim hbisim => obtain ⟨rel, hr, hb⟩ := hbisim - obtain ⟨s1', htr1, hr1⟩ := hb.follow_snd hr μ htr + obtain ⟨s1', htr1, hr1⟩ := hb.follow_snd hr htr exists s1' constructor · assumption @@ -319,8 +319,9 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice private inductive ParBisim : (Process Name Constant) → (Process Name Constant) → Prop where | par : (p ~[@lts Name Constant defs] q) → ParBisim (par p r) (par q r) -/-- P ~ Q → P | R ~ Q | R-/ -theorem bisimilarity_congr_par : (p ~[@lts Name Constant defs] q) → (par p r) ~[@lts Name Constant defs] (par q r) := by +/-- P ~ Q → P | R ~ Q | R -/ +theorem bisimilarity_congr_par : + (p ~[@lts Name Constant defs] q) → (par p r) ~[@lts Name Constant defs] (par q r) := by intro h exists @ParBisim _ _ defs constructor; constructor; assumption @@ -334,7 +335,7 @@ theorem bisimilarity_congr_par : (p ~[@lts Name Constant defs] q) → (par p r) obtain ⟨rel, hr, hb⟩ := hbisim cases htr case parL _ _ p' htr => - obtain ⟨q', htr2, hr2⟩ := hb.follow_fst hr μ htr + obtain ⟨q', htr2, hr2⟩ := hb.follow_fst hr htr exists (par q' r) constructor · apply Tr.parL htr2 @@ -347,7 +348,7 @@ theorem bisimilarity_congr_par : (p ~[@lts Name Constant defs] q) → (par p r) · constructor apply Bisimilarity.largest_bisimulation _ hb hr case com μ' p' r' htrp htrr => - obtain ⟨q', htr2, hr2⟩ := hb.follow_fst hr μ' htrp + obtain ⟨q', htr2, hr2⟩ := hb.follow_fst hr htrp exists (par q' r') constructor · apply Tr.com htr2 htrr @@ -360,7 +361,7 @@ theorem bisimilarity_congr_par : (p ~[@lts Name Constant defs] q) → (par p r) obtain ⟨rel, hr, hb⟩ := hbisim cases htr case parL _ _ p' htr => - obtain ⟨p', htr2, hr2⟩ := hb.follow_snd hr μ htr + obtain ⟨p', htr2, hr2⟩ := hb.follow_snd hr htr exists (par p' r) constructor · apply Tr.parL htr2 @@ -373,7 +374,7 @@ theorem bisimilarity_congr_par : (p ~[@lts Name Constant defs] q) → (par p r) · constructor apply Bisimilarity.largest_bisimulation _ hb hr case com μ' p' r' htrq htrr => - obtain ⟨q', htr2, hr2⟩ := hb.follow_snd hr μ' htrq + obtain ⟨q', htr2, hr2⟩ := hb.follow_snd hr htrq exists (par q' r') constructor · apply Tr.com htr2 htrr @@ -381,7 +382,8 @@ theorem bisimilarity_congr_par : (p ~[@lts Name Constant defs] q) → (par p r) apply Bisimilarity.largest_bisimulation _ hb hr2 /-- Bisimilarity is a congruence in CCS. -/ -theorem bisimilarity_congr (c : Context Name Constant) (p q : Process Name Constant) (h : p ~[@lts Name Constant defs] q) : +theorem bisimilarity_congr + (c : Context Name Constant) (p q : Process Name Constant) (h : p ~[@lts Name Constant defs] q) : (c.fill p) ~[@lts Name Constant defs] (c.fill q) := by induction c case hole => diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index 3bc7e724..119cbaa1 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -82,11 +82,17 @@ def Bisimulation (lts : LTS State Label) (r : State → State → Prop) : Prop : ) /-- Helper for following a transition using the first component of a `Bisimulation`. -/ -def Bisimulation.follow_fst {lts : LTS State Label} {r : State → State → Prop} (hb : Bisimulation lts r) (hr : r s1 s2) (μ : Label) (htr : lts.Tr s1 μ s1'):= +def Bisimulation.follow_fst + {lts : LTS State Label} {r : State → State → Prop} + {s1 s2 : State} {μ : Label} {s1' : State} + (hb : Bisimulation lts r) (hr : r s1 s2) (htr : lts.Tr s1 μ s1') := (hb _ _ hr μ).1 _ htr /-- Helper for following a transition using the second component of a `Bisimulation`. -/ -def Bisimulation.follow_snd {lts : LTS State Label} {r : State → State → Prop} (hb : Bisimulation lts r) (hr : r s1 s2) (μ : Label) (htr : lts.Tr s2 μ s2'):= +def Bisimulation.follow_snd + {lts : LTS State Label} {r : State → State → Prop} + {s1 s2 : State} {μ : Label} {s2' : State} + (hb : Bisimulation lts r) (hr : r s1 s2) (htr : lts.Tr s2 μ s2') := (hb _ _ hr μ).2 _ htr /-- Two states are bisimilar if they are related by some bisimulation. -/ @@ -120,7 +126,7 @@ theorem Bisimilarity.refl (s : State) : s ~[lts] s := by exists s1' /-- The inverse of a bisimulation is a bisimulation. -/ -theorem Bisimulation.inv (r : State → State → Prop) (h : Bisimulation lts r) : +theorem Bisimulation.inv (h : Bisimulation lts r) : Bisimulation lts (flip r) := by simp only [Bisimulation] at h simp only [Bisimulation] From b1e5e73294c5d9d24ff6029fb9bd5e3cc67e92f5 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sat, 26 Jul 2025 19:57:58 +0200 Subject: [PATCH 020/107] Bisimulations equipped with union form a join-semilattice and a bounded order --- .github/CODEOWNERS | 1 + Cslib/Semantics/LTS/Bisimulation.lean | 128 +++++++++++++++++++++++--- 2 files changed, 117 insertions(+), 12 deletions(-) diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 091b796e..5c842faf 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -3,4 +3,5 @@ /CslibTests @cs-lean/reviewers /Cslib/Computability/LambdaCalculus/ @cs-lean/lambda-calculus +/Cslib/ConcurrencyTheory/ @cs-lean/concurrency-theory /Cslib/Logic/ @cs-lean/logic diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index 119cbaa1..9b97ac17 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -249,11 +249,8 @@ theorem Bisimilarity.is_bisimulation : Bisimulation lts (Bisimilarity lts) := by theorem Bisimilarity.largest_bisimulation (h : Bisimulation lts r) : Subrelation r (Bisimilarity lts) := by - -- simp only [Subrelation] intro s1 s2 hr exists r - -- intro hr - -- exists r /-- The union of bisimilarity with any bisimulation is bisimilarity. -/ theorem Bisimilarity.gfp (r : State → State → Prop) (h : Bisimulation lts r) : @@ -266,6 +263,106 @@ theorem Bisimilarity.gfp (r : State → State → Prop) (h : Bisimulation lts r) instance : Trans (Bisimilarity lts) (Bisimilarity lts) (Bisimilarity lts) where trans := Bisimilarity.trans lts +section Lattice + +/-! ## Lattice properties -/ + +/-- The union of two bisimulations is a bisimulation. -/ +theorem Bisimulation.union (hrb : Bisimulation lts r) (hsb : Bisimulation lts s) : + Bisimulation lts (r ⊔ s) := by + intro s1 s2 hrs μ + cases hrs + case inl h => + constructor + · intro s1' htr + obtain ⟨s2', htr', hr'⟩ := Bisimulation.follow_fst hrb h htr + exists s2' + constructor + · assumption + · simp only [max, SemilatticeSup.sup] + left + exact hr' + · intro s2' htr + obtain ⟨s1', htr', hr'⟩ := Bisimulation.follow_snd hrb h htr + exists s1' + constructor + · assumption + · simp only [max, SemilatticeSup.sup] + left + exact hr' + case inr h => + constructor + · intro s1' htr + obtain ⟨s2', htr', hs'⟩ := Bisimulation.follow_fst hsb h htr + exists s2' + constructor + · assumption + · simp only [max, SemilatticeSup.sup] + right + exact hs' + · intro s2' htr + obtain ⟨s1', htr', hs'⟩ := Bisimulation.follow_snd hsb h htr + exists s1' + constructor + · assumption + · simp only [max, SemilatticeSup.sup] + right + exact hs' + +instance : Max ({r // Bisimulation lts r}) where + max r s := ⟨r.1 ⊔ s.1, Bisimulation.union lts r.2 s.2⟩ + +/-- Bisimulations equipped with union form a join-semilattice. -/ +instance : SemilatticeSup ({r // Bisimulation lts r}) where + sup r s := r ⊔ s + le_sup_left r s := by + simp only [LE.le] + intro s1 s2 hr + simp only [max, SemilatticeSup.sup] + left + exact hr + le_sup_right r s := by + simp only [LE.le] + intro s1 s2 hs + simp only [max, SemilatticeSup.sup] + right + exact hs + sup_le r s t := by + intro h1 h2 + simp only [LE.le, max, SemilatticeSup.sup] + intro s1 s2 + intro h + cases h + case inl h => + apply h1 _ _ h + case inr h => + apply h2 _ _ h + +/-- The empty relation is a bisimulation. -/ +theorem Bisimulation.emptyRelation_bisimulation : Bisimulation lts emptyRelation := by + intro s1 s2 hr + cases hr + +/-- In the inclusion order on bisimulations: + +- The empty relation is the bottom element. +- Bisimilarity is the top element. +-/ +instance : BoundedOrder ({r // Bisimulation lts r}) where + top := ⟨Bisimilarity lts, Bisimilarity.is_bisimulation lts⟩ + bot := ⟨emptyRelation, Bisimulation.emptyRelation_bisimulation lts⟩ + le_top r := by + intro s1 s2 + simp only [LE.le] + apply Bisimilarity.largest_bisimulation lts r.2 + bot_le r := by + intro s1 s2 + simp only [LE.le] + intro hr + cases hr + +end Lattice + /-! ## Bisimulation up-to -/ /-- A relation `r` is a bisimulation up to bisimilarity if, whenever it relates two @@ -602,7 +699,8 @@ theorem Bisimulation.traceEq_not_bisim : apply Set.ext_iff.1 at cih specialize cih ['c'] obtain ⟨cih1, cih2⟩ := cih - have cih1h : ['c'] ∈ @insert (List Char) (Set (List Char)) Set.instInsert [] {['b'], ['c']} := by + have cih1h : ['c'] ∈ @insert + (List Char) (Set (List Char)) Set.instInsert [] {['b'], ['c']} := by simp specialize cih1 cih1h simp at cih1 @@ -680,13 +778,15 @@ theorem Bisimulation.traceEq_not_bisim : apply Set.ext_iff.1 at cih specialize cih ['b'] obtain ⟨cih1, cih2⟩ := cih - have cih1h : ['b'] ∈ @insert (List Char) (Set (List Char)) Set.instInsert [] {['b'], ['c']} := by + have cih1h : ['b'] ∈ @insert + (List Char) (Set (List Char)) Set.instInsert [] {['b'], ['c']} := by simp specialize cih1 cih1h simp at cih1 /-- In general, bisimilarity and trace equivalence are distinct. -/ -theorem Bisimilarity.bisimilarity_neq_traceEq : ∃ (State : Type) (Label : Type) (lts : LTS State Label), Bisimilarity lts ≠ TraceEq lts := by +theorem Bisimilarity.bisimilarity_neq_traceEq : + ∃ (State : Type) (Label : Type) (lts : LTS State Label), Bisimilarity lts ≠ TraceEq lts := by obtain ⟨State, Label, lts, h⟩ := Bisimulation.traceEq_not_bisim exists State; exists Label; exists lts simp @@ -742,7 +842,8 @@ theorem Bisimilarity.deterministic_bisim_eq_traceEq /-! ## Relation to simulation -/ /-- Any bisimulation is also a simulation. -/ -theorem Bisimulation.is_simulation (lts : LTS State Label) (r : State → State → Prop) : Bisimulation lts r → Simulation lts r := by +theorem Bisimulation.is_simulation (lts : LTS State Label) (r : State → State → Prop) : + Bisimulation lts r → Simulation lts r := by intro h simp only [Bisimulation] at h simp only [Simulation] @@ -752,11 +853,12 @@ theorem Bisimulation.is_simulation (lts : LTS State Label) (r : State → State apply h1 s1' htr /-- A relation is a bisimulation iff both it and its inverse are simulations. -/ -theorem Bisimulation.simulation_iff (lts : LTS State Label) (r : State → State → Prop) : Bisimulation lts r ↔ (Simulation lts r ∧ Simulation lts (flip r)) := by +theorem Bisimulation.simulation_iff (lts : LTS State Label) (r : State → State → Prop) : + Bisimulation lts r ↔ (Simulation lts r ∧ Simulation lts (flip r)) := by constructor - intro h - simp only [Simulation] case mp => + intro h + simp only [Simulation] constructor case left => intro s1 s2 hr μ s1' htr @@ -898,8 +1000,10 @@ theorem SWBisimulation.follow_internal_snd obtain ⟨n, hstrN⟩ := (LTS.str_strN lts).1 hstr apply SWBisimulation.follow_internal_snd_n lts r hswb hr hstrN -/-- We can now prove that any relation is a `WeakBisimulation` iff it is an `SWBisimulation`. This formalises lemma 4.2.10 in [Sangiorgi2011]. -/ -theorem WeakBisimulation.iff_swBisimulation [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) : +/-- We can now prove that any relation is a `WeakBisimulation` iff it is an `SWBisimulation`. +This formalises lemma 4.2.10 in [Sangiorgi2011]. -/ +theorem WeakBisimulation.iff_swBisimulation + [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) : WeakBisimulation lts r ↔ SWBisimulation lts r := by apply Iff.intro case mp => From 969814521ac5683dfe8be1815df216024fdc10ae Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sat, 26 Jul 2025 20:17:03 +0200 Subject: [PATCH 021/107] minor moving around --- Cslib/Semantics/LTS/Bisimulation.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index 9b97ac17..556f8a8e 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -263,9 +263,9 @@ theorem Bisimilarity.gfp (r : State → State → Prop) (h : Bisimulation lts r) instance : Trans (Bisimilarity lts) (Bisimilarity lts) (Bisimilarity lts) where trans := Bisimilarity.trans lts -section Lattice +section Order -/-! ## Lattice properties -/ +/-! ## Order properties -/ /-- The union of two bisimulations is a bisimulation. -/ theorem Bisimulation.union (hrb : Bisimulation lts r) (hsb : Bisimulation lts s) : @@ -361,7 +361,7 @@ instance : BoundedOrder ({r // Bisimulation lts r}) where intro hr cases hr -end Lattice +end Order /-! ## Bisimulation up-to -/ From f351e369a72b34c12c3595aeda05cac1f54c7e14 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sat, 26 Jul 2025 20:17:10 +0200 Subject: [PATCH 022/107] minor moving around --- Cslib/Semantics/LTS/Bisimulation.lean | 84 +++++++++++++-------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index 556f8a8e..f5d19179 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -211,6 +211,48 @@ theorem Bisimilarity.eqv (lts : LTS State Label) : trans := Bisimilarity.trans lts } +/-- The union of two bisimulations is a bisimulation. -/ +theorem Bisimulation.union (hrb : Bisimulation lts r) (hsb : Bisimulation lts s) : + Bisimulation lts (r ⊔ s) := by + intro s1 s2 hrs μ + cases hrs + case inl h => + constructor + · intro s1' htr + obtain ⟨s2', htr', hr'⟩ := Bisimulation.follow_fst hrb h htr + exists s2' + constructor + · assumption + · simp only [max, SemilatticeSup.sup] + left + exact hr' + · intro s2' htr + obtain ⟨s1', htr', hr'⟩ := Bisimulation.follow_snd hrb h htr + exists s1' + constructor + · assumption + · simp only [max, SemilatticeSup.sup] + left + exact hr' + case inr h => + constructor + · intro s1' htr + obtain ⟨s2', htr', hs'⟩ := Bisimulation.follow_fst hsb h htr + exists s2' + constructor + · assumption + · simp only [max, SemilatticeSup.sup] + right + exact hs' + · intro s2' htr + obtain ⟨s1', htr', hs'⟩ := Bisimulation.follow_snd hsb h htr + exists s1' + constructor + · assumption + · simp only [max, SemilatticeSup.sup] + right + exact hs' + /-- Bisimilarity is a bisimulation. -/ theorem Bisimilarity.is_bisimulation : Bisimulation lts (Bisimilarity lts) := by simp only [Bisimulation] @@ -267,48 +309,6 @@ section Order /-! ## Order properties -/ -/-- The union of two bisimulations is a bisimulation. -/ -theorem Bisimulation.union (hrb : Bisimulation lts r) (hsb : Bisimulation lts s) : - Bisimulation lts (r ⊔ s) := by - intro s1 s2 hrs μ - cases hrs - case inl h => - constructor - · intro s1' htr - obtain ⟨s2', htr', hr'⟩ := Bisimulation.follow_fst hrb h htr - exists s2' - constructor - · assumption - · simp only [max, SemilatticeSup.sup] - left - exact hr' - · intro s2' htr - obtain ⟨s1', htr', hr'⟩ := Bisimulation.follow_snd hrb h htr - exists s1' - constructor - · assumption - · simp only [max, SemilatticeSup.sup] - left - exact hr' - case inr h => - constructor - · intro s1' htr - obtain ⟨s2', htr', hs'⟩ := Bisimulation.follow_fst hsb h htr - exists s2' - constructor - · assumption - · simp only [max, SemilatticeSup.sup] - right - exact hs' - · intro s2' htr - obtain ⟨s1', htr', hs'⟩ := Bisimulation.follow_snd hsb h htr - exists s1' - constructor - · assumption - · simp only [max, SemilatticeSup.sup] - right - exact hs' - instance : Max ({r // Bisimulation lts r}) where max r s := ⟨r.1 ⊔ s.1, Bisimulation.union lts r.2 s.2⟩ From cc122d31baf3ba7d60cab197ee4a01c43b50857a Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sat, 26 Jul 2025 20:54:51 +0200 Subject: [PATCH 023/107] Bisimilarity is included in trace equivalence --- Cslib/Semantics/LTS/Bisimulation.lean | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index f5d19179..31b63e71 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -464,7 +464,7 @@ theorem Bisimulation.bisim_trace /-- Any bisimulation implies trace equivalence. -/ theorem Bisimulation.bisim_traceEq - (s1 s2 : State) (r : State → State → Prop) (hb : Bisimulation lts r) (hr : r s1 s2) : + (hb : Bisimulation lts r) (hr : r s1 s2) : s1 ~tr[lts] s2 := by simp [TraceEq, LTS.traces, setOf] funext μs @@ -484,11 +484,12 @@ theorem Bisimulation.bisim_traceEq exists s1' exact hmtr.1 -/-- Bisimilarity implies trace equivalence. -/ -theorem Bisimilarity.bisim_traceEq (s1 s2 : State) (h : s1 ~[lts] s2) : - s1 ~tr[lts] s2 := by +/-- Bisimilarity is included in trace equivalence. -/ +theorem Bisimilarity.le_traceEq : Bisimilarity lts ≤ TraceEq lts := by + simp [LE.le] + intro s1 s2 h obtain ⟨r, hr, hb⟩ := h - apply Bisimulation.bisim_traceEq lts s1 s2 r hb hr + apply Bisimulation.bisim_traceEq lts hb hr /- One of the standard motivating examples for bisimulation: `1` and `5` are trace equivalent, but not bisimilar. -/ @@ -835,7 +836,7 @@ theorem Bisimilarity.deterministic_bisim_eq_traceEq simp [eq_iff_iff] constructor case mp => - apply Bisimilarity.bisim_traceEq + apply Bisimilarity.le_traceEq case mpr => apply Bisimilarity.deterministic_traceEq_bisim lts hdet From 4a4f267f18cfd76e4daf9372a96425d19c7ddadc Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Sun, 27 Jul 2025 08:01:06 -0400 Subject: [PATCH 024/107] Docs fixes (#21) * Use Std.Range, qualified name Lean.ReducibilityHints.abbrev * mark instances as noncomputable --- Cslib/Semantics/LTS/Basic.lean | 6 +++--- Cslib/Semantics/LTS/Bisimulation.lean | 4 ++-- Cslib/Semantics/ReductionSystem/Basic.lean | 6 +++--- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/Cslib/Semantics/LTS/Basic.lean b/Cslib/Semantics/LTS/Basic.lean index f4226175..f5016a66 100644 --- a/Cslib/Semantics/LTS/Basic.lean +++ b/Cslib/Semantics/LTS/Basic.lean @@ -624,9 +624,9 @@ elab "create_lts" lt:ident name:ident : command => do unless (← whnf ty).isProp do throwError m!"expecting Prop, not{indentExpr ty}" let params := ci.levelParams.map .param - let lt := mkAppN (.const lt params) args[0...args.size-3] + let lt := mkAppN (.const lt params) args[0:args.size-3] let bundle ← mkAppM ``LTS.mk #[lt] - let value ← mkLambdaFVars args[0...args.size-3] bundle + let value ← mkLambdaFVars args[0:args.size-3] bundle let type ← inferType value addAndCompile <| .defnDecl { name := name.getId @@ -634,7 +634,7 @@ elab "create_lts" lt:ident name:ident : command => do type value safety := .safe - hints := .abbrev + hints := Lean.ReducibilityHints.abbrev } addTermInfo' name (.const name.getId params) (isBinder := true) addDeclarationRangesFromSyntax name.getId name diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/LTS/Bisimulation.lean index 31b63e71..e46ad63f 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/LTS/Bisimulation.lean @@ -309,11 +309,11 @@ section Order /-! ## Order properties -/ -instance : Max ({r // Bisimulation lts r}) where +noncomputable instance : Max ({r // Bisimulation lts r}) where max r s := ⟨r.1 ⊔ s.1, Bisimulation.union lts r.2 s.2⟩ /-- Bisimulations equipped with union form a join-semilattice. -/ -instance : SemilatticeSup ({r // Bisimulation lts r}) where +noncomputable instance : SemilatticeSup ({r // Bisimulation lts r}) where sup r s := r ⊔ s le_sup_left r s := by simp only [LE.le] diff --git a/Cslib/Semantics/ReductionSystem/Basic.lean b/Cslib/Semantics/ReductionSystem/Basic.lean index 9012d3bd..98950bd5 100644 --- a/Cslib/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Semantics/ReductionSystem/Basic.lean @@ -77,9 +77,9 @@ elab "create_reduction_sys" rel:ident name:ident : command => do unless (← whnf ty).isProp do throwError m!"expecting Prop, not{indentExpr ty}" let params := ci.levelParams.map .param - let rel := mkAppN (.const rel params) args[0...args.size-2] + let rel := mkAppN (.const rel params) args[0:args.size-2] let bundle ← mkAppM ``ReductionSystem.mk #[rel] - let value ← mkLambdaFVars args[0...args.size-2] bundle + let value ← mkLambdaFVars args[0:args.size-2] bundle let type ← inferType value addAndCompile <| .defnDecl { name := name.getId @@ -87,7 +87,7 @@ elab "create_reduction_sys" rel:ident name:ident : command => do type value safety := .safe - hints := .abbrev + hints := Lean.ReducibilityHints.abbrev } addTermInfo' name (.const name.getId params) (isBinder := true) addDeclarationRangesFromSyntax name.getId name From 742627add8c3d2759dc3610e010195ea671338bc Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sun, 27 Jul 2025 14:02:44 +0200 Subject: [PATCH 025/107] upgrade lean-toolchain --- docs/lean-toolchain | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/lean-toolchain b/docs/lean-toolchain index 765d8d7f..28f76d10 100644 --- a/docs/lean-toolchain +++ b/docs/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.21.0-rc3 \ No newline at end of file +leanprover/lean4:v4.22.0-rc3 \ No newline at end of file From 4fab70b30e028ec4c0b529ad57516cf1817949c6 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sun, 27 Jul 2025 14:05:00 +0200 Subject: [PATCH 026/107] Check the docs toolchain is up to date --- .github/workflows/lean_action_ci.yml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/.github/workflows/lean_action_ci.yml b/.github/workflows/lean_action_ci.yml index 09cd4ca6..2c96e1ed 100644 --- a/.github/workflows/lean_action_ci.yml +++ b/.github/workflows/lean_action_ci.yml @@ -6,6 +6,13 @@ on: workflow_dispatch: jobs: + check-toolchains: + runs-on: ubuntu-latest + steps: + - run: | + set -e + cmp -s lean-toolchain docs/lean-toolchain + build: runs-on: ubuntu-latest From a5b81ca4e6b37105d816aaeba6a03c2314b8b023 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sun, 27 Jul 2025 14:13:32 +0200 Subject: [PATCH 027/107] rename LTS to Lts --- Cslib.lean | 6 +- .../CCS/BehaviouralTheory.lean | 4 +- Cslib/ConcurrencyTheory/CCS/Semantics.lean | 4 +- Cslib/Semantics/{LTS => Lts}/Basic.lean | 320 +++++++++--------- .../Semantics/{LTS => Lts}/Bisimulation.lean | 166 ++++----- Cslib/Semantics/{LTS => Lts}/Simulation.lean | 24 +- Cslib/Semantics/{LTS => Lts}/TraceEq.lean | 48 +-- CslibTests/Bisimulation.lean | 8 +- CslibTests/LTS.lean | 20 +- 9 files changed, 300 insertions(+), 300 deletions(-) rename Cslib/Semantics/{LTS => Lts}/Basic.lean (66%) rename Cslib/Semantics/{LTS => Lts}/Bisimulation.lean (89%) rename Cslib/Semantics/{LTS => Lts}/Simulation.lean (88%) rename Cslib/Semantics/{LTS => Lts}/TraceEq.lean (70%) diff --git a/Cslib.lean b/Cslib.lean index aa2a1c43..7b712c49 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,6 +1,6 @@ -import Cslib.Semantics.LTS.Basic -import Cslib.Semantics.LTS.Bisimulation -import Cslib.Semantics.LTS.TraceEq +import Cslib.Semantics.Lts.Basic +import Cslib.Semantics.Lts.Bisimulation +import Cslib.Semantics.Lts.TraceEq import Cslib.Data.Relation import Cslib.Computability.CombinatoryLogic.Defs import Cslib.Computability.CombinatoryLogic.Basic diff --git a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean index 23abd37b..42b87684 100644 --- a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean +++ b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.LTS.Basic -import Cslib.Semantics.LTS.Bisimulation +import Cslib.Semantics.Lts.Basic +import Cslib.Semantics.Lts.Bisimulation import Cslib.ConcurrencyTheory.CCS.Basic import Cslib.ConcurrencyTheory.CCS.Semantics diff --git a/Cslib/ConcurrencyTheory/CCS/Semantics.lean b/Cslib/ConcurrencyTheory/CCS/Semantics.lean index 04bec2d5..f82d7960 100644 --- a/Cslib/ConcurrencyTheory/CCS/Semantics.lean +++ b/Cslib/ConcurrencyTheory/CCS/Semantics.lean @@ -4,14 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.LTS.Basic +import Cslib.Semantics.Lts.Basic import Cslib.ConcurrencyTheory.CCS.Basic /-! # Semantics of CCS ## Main definitions - `CCS.Tr`: transition relation for CCS. -- `CCS.lts`: the `LTS` of CCS. +- `CCS.lts`: the `Lts` of CCS. -/ diff --git a/Cslib/Semantics/LTS/Basic.lean b/Cslib/Semantics/Lts/Basic.lean similarity index 66% rename from Cslib/Semantics/LTS/Basic.lean rename to Cslib/Semantics/Lts/Basic.lean index f5016a66..c7a6da9c 100644 --- a/Cslib/Semantics/LTS/Basic.lean +++ b/Cslib/Semantics/Lts/Basic.lean @@ -12,33 +12,33 @@ import Mathlib.Data.Set.Finite.Basic import Mathlib.Data.Stream.Defs /-! -# Labelled Transition System +# Labelled Transition System (LTS) -A Labelled Transition System (LTS) models the observable behaviour of the possible states of a +A Labelled Transition System (`Lts`) models the observable behaviour of the possible states of a system. They are particularly popular in the fields of concurrency theory, logic, and programming languages. ## Main definitions -- `LTS` is a structure for labelled transition systems, consisting of a labelled transition +- `Lts` is a structure for labelled transition systems, consisting of a labelled transition relation `Tr` between states. We follow the style and conventions in [Sangiorgi2011]. -- `LTS.MTr` extends the transition relation of any LTS to a multi-step transition relation, +- `Lts.MTr` extends the transition relation of any Lts to a multi-step transition relation, formalising the inference system and admissible rules for such relations in [Montesi2023]. -- Definitions for all the common classes of LTSs: image-finite, finitely branching, finite-state, +- Definitions for all the common classes of Ltss: image-finite, finitely branching, finite-state, finite, and deterministic. ## Main statements -- A series of results on `LTS.MTr` that allow for obtaining and composing multi-step transitions in +- A series of results on `Lts.MTr` that allow for obtaining and composing multi-step transitions in different ways. -- `LTS.deterministic_imageFinite`: every deterministic LTS is also image-finite. +- `Lts.deterministic_imageFinite`: every deterministic Lts is also image-finite. -- `LTS.finiteState_imageFinite`: every finite-state LTS is also image-finite. +- `Lts.finiteState_imageFinite`: every finite-state Lts is also image-finite. -- `LTS.finiteState_finitelyBranching`: every finite-state LTS is also finitely-branching, if the +- `Lts.finiteState_finitelyBranching`: every finite-state Lts is also finitely-branching, if the type of labels is finite. ## References @@ -50,10 +50,10 @@ type of labels is finite. universe u v /-- -A Labelled Transition System (LTS) consists of a type of states (`State`), a type of transition +A Labelled Transition System (Lts) consists of a type of states (`State`), a type of transition labels (`Label`), and a labelled transition relation (`Tr`). -/ -structure LTS (State : Type u) (Label : Type v) where +structure Lts (State : Type u) (Label : Type v) where /-- The transition relation. -/ Tr : State → Label → State → Prop @@ -61,7 +61,7 @@ section MultiStep /-! ## Multi-step transitions -/ -variable {State : Type u} {Label : Type v} (lts : LTS State Label) +variable {State : Type u} {Label : Type v} (lts : Lts State Label) /-- Definition of a multi-step transition. @@ -70,35 +70,35 @@ Definition of a multi-step transition. rule. This makes working with lists of labels more convenient, because we follow the same construction. It is also similar to what is done in the `SimpleGraph` library in mathlib.) -/ -inductive LTS.MTr (lts : LTS State Label) : State → List Label → State → Prop where +inductive Lts.MTr (lts : Lts State Label) : State → List Label → State → Prop where | refl {s : State} : lts.MTr s [] s | stepL {s1 : State} {μ : Label} {s2 : State} {μs : List Label} {s3 : State} : lts.Tr s1 μ s2 → lts.MTr s2 μs s3 → lts.MTr s1 (μ :: μs) s3 /-- Any transition is also a multi-step transition. -/ -theorem LTS.MTr.single {s1 : State} {μ : Label} {s2 : State} : +theorem Lts.MTr.single {s1 : State} {μ : Label} {s2 : State} : lts.Tr s1 μ s2 → lts.MTr s1 [μ] s2 := by intro h - apply LTS.MTr.stepL + apply Lts.MTr.stepL · exact h - · apply LTS.MTr.refl + · apply Lts.MTr.refl /-- Any multi-step transition can be extended by adding a transition. -/ -theorem LTS.MTr.stepR {s1 : State} {μs : List Label} {s2 : State} {μ : Label} {s3 : State} : +theorem Lts.MTr.stepR {s1 : State} {μs : List Label} {s2 : State} {μ : Label} {s3 : State} : lts.MTr s1 μs s2 → lts.Tr s2 μ s3 → lts.MTr s1 (μs ++ [μ]) s3 := by intro h1 h2 induction h1 case refl s1' => simp - apply LTS.MTr.single lts h2 + apply Lts.MTr.single lts h2 case stepL s1' μ' s2' μs' s3' h1' h3 ih => - apply LTS.MTr.stepL + apply Lts.MTr.stepL · exact h1' · apply ih h2 /-- Multi-step transitions can be composed. -/ -theorem LTS.MTr.comp {s1 : State} {μs1 : List Label} {s2 : State} {μs2 : List Label} {s3 : State} : +theorem Lts.MTr.comp {s1 : State} {μs1 : List Label} {s2 : State} {μs2 : List Label} {s3 : State} : lts.MTr s1 μs1 s2 → lts.MTr s2 μs2 s3 → lts.MTr s1 (μs1 ++ μs2) s3 := by intro h1 h2 @@ -107,12 +107,12 @@ theorem LTS.MTr.comp {s1 : State} {μs1 : List Label} {s2 : State} {μs2 : List simp assumption case stepL s1 μ s' μs1' s'' h1' h3 ih => - apply LTS.MTr.stepL + apply Lts.MTr.stepL · exact h1' · apply ih h2 /-- Any 1-sized multi-step transition implies a transition with the same states and label. -/ -theorem LTS.MTr.single_invert (s1 : State) (μ : Label) (s2 : State) : +theorem Lts.MTr.single_invert (s1 : State) (μ : Label) (s2 : State) : lts.MTr s1 [μ] s2 → lts.Tr s1 μ s2 := by intro h cases h @@ -121,22 +121,22 @@ theorem LTS.MTr.single_invert (s1 : State) (μ : Label) (s2 : State) : exact htr /-- In any zero-steps multi-step transition, the origin and the derivative are the same. -/ -theorem LTS.MTr.nil_eq (h : lts.MTr s1 [] s2) : s1 = s2 := by +theorem Lts.MTr.nil_eq (h : lts.MTr s1 [] s2) : s1 = s2 := by cases h rfl /-- A state `s1` can reach a state `s2` if there exists a multi-step transition from `s1` to `s2`. -/ -def LTS.CanReach (s1 s2 : State) : Prop := +def Lts.CanReach (s1 s2 : State) : Prop := ∃ μs, lts.MTr s1 μs s2 /-- Any state can reach itself. -/ -theorem LTS.CanReach.refl (s : State) : lts.CanReach s s := by +theorem Lts.CanReach.refl (s : State) : lts.CanReach s s := by exists [] - apply LTS.MTr.refl + apply Lts.MTr.refl -/-- The LTS generated by a state `s` is the LTS given by all the states reachable from `s`. -/ -def LTS.generatedBy (s : State) : LTS {s' : State // lts.CanReach s s'} Label where +/-- The Lts generated by a state `s` is the Lts given by all the states reachable from `s`. -/ +def Lts.generatedBy (s : State) : Lts {s' : State // lts.CanReach s s'} Label where Tr := fun s1 μ s2 => lts.CanReach s s1 ∧ lts.CanReach s s2 ∧ lts.Tr s1 μ s2 end MultiStep @@ -144,34 +144,34 @@ end MultiStep section Termination /-! ## Definitions about termination -/ -variable {State} {Label} (lts : LTS State Label) {Terminated : State → Prop} +variable {State} {Label} (lts : Lts State Label) {Terminated : State → Prop} /-- A state 'may terminate' if it can reach a terminated state. The definition of `Terminated` is a parameter. -/ -def LTS.MayTerminate (s : State) : Prop := ∃ s', Terminated s' ∧ lts.CanReach s s' +def Lts.MayTerminate (s : State) : Prop := ∃ s', Terminated s' ∧ lts.CanReach s s' /-- A state 'is stuck' if it is not terminated and cannot go forward. The definition of `Terminated` is a parameter. -/ -def LTS.Stuck (s : State) : Prop := +def Lts.Stuck (s : State) : Prop := ¬Terminated s ∧ ¬∃ μ s', lts.Tr s μ s' end Termination section Union -/-! ## Definitions for the unions of LTSs +/-! ## Definitions for the unions of Ltss Note: there is a nontrivial balance between ergonomics and generality here. These definitions might change in the future. -/ variable {State : Type u} {Label : Type v} -/-- The union of two LTSs that have common supertypes for states and labels. -/ -def LTS.unionSubtype +/-- The union of two Ltss that have common supertypes for states and labels. -/ +def Lts.unionSubtype {S1 : State → Prop} {L1 : Label → Prop} {S2 : State → Prop} {L2 : Label → Prop} [DecidablePred S1] [DecidablePred L1] [DecidablePred S2] [DecidablePred L2] -(lts1 : LTS (@Subtype State S1) (@Subtype Label L1)) -(lts2 : LTS (@Subtype State S2) (@Subtype Label L2)) : - LTS State Label where +(lts1 : Lts (@Subtype State S1) (@Subtype Label L1)) +(lts2 : Lts (@Subtype State S2) (@Subtype Label L2)) : + Lts State Label where Tr := fun s μ s' => if h : S1 s ∧ L1 μ ∧ S1 s' then lts1.Tr ⟨s, h.1⟩ ⟨μ, h.2.1⟩ ⟨s', h.2.2⟩ @@ -186,9 +186,9 @@ def Sum.isLeftP {α} {β} (x : α ⊕ β) : Prop := Sum.isLeft x = true /-- TODO: move this to `Sum`? -/ def Sum.isRightP {α} {β} (x : α ⊕ β) : Prop := Sum.isRight x = true -/-- Lifting of an `LTS State Label` to `LTS (State ⊕ State') Label`. -/ -def LTS.inl {State'} (lts : LTS State Label) : - LTS (@Subtype (State ⊕ State') Sum.isLeftP) (@Subtype Label (Function.const Label True)) where +/-- Lifting of an `Lts State Label` to `Lts (State ⊕ State') Label`. -/ +def Lts.inl {State'} (lts : Lts State Label) : + Lts (@Subtype (State ⊕ State') Sum.isLeftP) (@Subtype Label (Function.const Label True)) where Tr := fun s μ s' => let ⟨s, _⟩ := s let ⟨s', _⟩ := s' @@ -196,9 +196,9 @@ def LTS.inl {State'} (lts : LTS State Label) : | Sum.inl s1, μ, Sum.inl s2 => lts.Tr s1 μ s2 | _, _, _ => False -/-- Lifting of an `LTS State Label` to `LTS (State' ⊕ State) Label`. -/ -def LTS.inr {State'} (lts : LTS State Label) : - LTS (@Subtype (State' ⊕ State) Sum.isRightP) (@Subtype Label (Function.const Label True)) where +/-- Lifting of an `Lts State Label` to `Lts (State' ⊕ State) Label`. -/ +def Lts.inr {State'} (lts : Lts State Label) : + Lts (@Subtype (State' ⊕ State) Sum.isRightP) (@Subtype Label (Function.const Label True)) where Tr := fun s μ s' => let ⟨s, _⟩ := s let ⟨s', _⟩ := s' @@ -206,11 +206,11 @@ def LTS.inr {State'} (lts : LTS State Label) : | Sum.inr s1, μ, Sum.inr s2 => lts.Tr s1 μ s2 | _, _, _ => False -/-- Union of two LTSs with the same `Label` type. The result combines the original respective state +/-- Union of two Ltss with the same `Label` type. The result combines the original respective state types `State1` and `State2` into `(State1 ⊕ State2)`. -/ -def LTS.unionSum {State1} {State2} (lts1 : LTS State1 Label) (lts2 : LTS State2 Label) : - LTS (State1 ⊕ State2) Label := - @LTS.unionSubtype +def Lts.unionSum {State1} {State2} (lts1 : Lts State1 Label) (lts2 : Lts State2 Label) : + Lts (State1 ⊕ State2) Label := + @Lts.unionSubtype (State1 ⊕ State2) Label Sum.isLeftP (Function.const Label True) @@ -251,27 +251,27 @@ end Union section Classes /-! -### Classes of LTSs +### Classes of Ltss -/ -variable {State : Type u} {Label : Type v} (lts : LTS State Label) +variable {State : Type u} {Label : Type v} (lts : Lts State Label) /-- An lts is deterministic if a state cannot reach different states with the same transition label. -/ -def LTS.Deterministic : Prop := +def Lts.Deterministic : Prop := ∀ (s1 : State) (μ : Label) (s2 s3 : State), lts.Tr s1 μ s2 → lts.Tr s1 μ s3 → s2 = s3 /-- The `μ`-image of a state `s` is the set of all `μ`-derivatives of `s`. -/ -def LTS.Image (s : State) (μ : Label) : Set State := { s' : State | lts.Tr s μ s' } +def Lts.Image (s : State) (μ : Label) : Set State := { s' : State | lts.Tr s μ s' } /-- An lts is image-finite if all images of its states are finite. -/ -def LTS.ImageFinite : Prop := +def Lts.ImageFinite : Prop := ∀ s μ, Finite (lts.Image s μ) -/-- In a deterministic LTS, if a state has a `μ`-derivative, then it can have no other +/-- In a deterministic Lts, if a state has a `μ`-derivative, then it can have no other `μ`-derivative. -/ -theorem LTS.deterministic_not_lto (hDet : lts.Deterministic) : +theorem Lts.deterministic_not_lto (hDet : lts.Deterministic) : ∀ s μ s' s'', s' ≠ s'' → lts.Tr s μ s' → ¬lts.Tr s μ s'' := by intro s μ s' s'' hneq hltos' by_contra hltos'' @@ -279,8 +279,8 @@ theorem LTS.deterministic_not_lto (hDet : lts.Deterministic) : simp only [← hDet'] at hneq contradiction -/-- In a deterministic LTS, any image is either a singleton or the empty set. -/ -theorem LTS.deterministic_image_char (hDet : lts.Deterministic) : +/-- In a deterministic Lts, any image is either a singleton or the empty set. -/ +theorem Lts.deterministic_image_char (hDet : lts.Deterministic) : ∀ s μ, (∃ s', lts.Image s μ = { s' }) ∨ (lts.Image s μ = ∅) := by intro s μ by_cases hs' : ∃ s', lts.Tr s μ s' @@ -297,7 +297,7 @@ theorem LTS.deterministic_image_char (hDet : lts.Deterministic) : simp [heq] at hs' exact hs' case neg => - have hDet' := LTS.deterministic_not_lto lts hDet s μ s' s'' heq hs' + have hDet' := Lts.deterministic_not_lto lts hDet s μ s' s'' heq hs' simp [hDet'] exact Ne.symm heq case neg => @@ -312,12 +312,12 @@ theorem LTS.deterministic_image_char (hDet : lts.Deterministic) : specialize hs' s'' contradiction -/-- Every deterministic LTS is also image-finite. -/ -theorem LTS.deterministic_imageFinite : +/-- Every deterministic Lts is also image-finite. -/ +theorem Lts.deterministic_imageFinite : lts.Deterministic → lts.ImageFinite := by simp only [ImageFinite] intro h s μ - have hDet := LTS.deterministic_image_char lts h s μ + have hDet := Lts.deterministic_image_char lts h s μ cases hDet case inl hDet => obtain ⟨s', hDet'⟩ := hDet @@ -328,48 +328,48 @@ theorem LTS.deterministic_imageFinite : apply Set.finite_empty /-- A state has an outgoing label `μ` if it has a `μ`-derivative. -/ -def LTS.HasOutLabel (s : State) (μ : Label) : Prop := +def Lts.HasOutLabel (s : State) (μ : Label) : Prop := ∃ s', lts.Tr s μ s' /-- The set of outgoing labels of a state. -/ -def LTS.OutgoingLabels (s : State) := { μ | lts.HasOutLabel s μ } +def Lts.OutgoingLabels (s : State) := { μ | lts.HasOutLabel s μ } -/-- An LTS is finitely branching if it is image-finite and all states have finite sets of +/-- An Lts is finitely branching if it is image-finite and all states have finite sets of outgoing labels. -/ -def LTS.FinitelyBranching : Prop := +def Lts.FinitelyBranching : Prop := lts.ImageFinite ∧ ∀ s, Finite (lts.OutgoingLabels s) -/-- An LTS is finite-state if it has a finite `State` type. -/ +/-- An Lts is finite-state if it has a finite `State` type. -/ @[nolint unusedArguments] -def LTS.FiniteState (_ : LTS State Label) : Prop := Finite State +def Lts.FiniteState (_ : Lts State Label) : Prop := Finite State -/-- Every finite-state LTS is also image-finite. -/ -theorem LTS.finiteState_imageFinite (hFinite : lts.FiniteState) : +/-- Every finite-state Lts is also image-finite. -/ +theorem Lts.finiteState_imageFinite (hFinite : lts.FiniteState) : lts.ImageFinite := by simp [ImageFinite, Image] simp [FiniteState] at hFinite intro s μ apply @Subtype.finite State hFinite -/-- Every LTS with finite types for states and labels is also finitely branching. -/ -theorem LTS.finiteState_finitelyBranching +/-- Every Lts with finite types for states and labels is also finitely branching. -/ +theorem Lts.finiteState_finitelyBranching (hFiniteLabel : Finite Label) (hFiniteState : lts.FiniteState) : lts.FinitelyBranching := by simp [FinitelyBranching, OutgoingLabels, HasOutLabel] simp [FiniteState] at hFiniteState constructor case left => - apply LTS.finiteState_imageFinite lts hFiniteState + apply Lts.finiteState_imageFinite lts hFiniteState case right => intro s apply @Subtype.finite Label hFiniteLabel -/-- An LTS is acyclic if there are no infinite multi-step transitions. -/ -def LTS.Acyclic : Prop := +/-- An Lts is acyclic if there are no infinite multi-step transitions. -/ +def Lts.Acyclic : Prop := ∃ n, ∀ s1 μs s2, lts.MTr s1 μs s2 → μs.length < n -/-- An LTS is finite if it is finite-state and acyclic. -/ -def LTS.Finite : Prop := +/-- An Lts is finite if it is finite-state and acyclic. -/ +def Lts.Finite : Prop := lts.FiniteState ∧ lts.Acyclic end Classes @@ -383,22 +383,22 @@ class HasTau (Label : Type v) where τ : Label /-- Saturated transition relation. -/ -inductive LTS.STr [HasTau Label] (lts : LTS State Label) : State → Label → State → Prop where +inductive Lts.STr [HasTau Label] (lts : Lts State Label) : State → Label → State → Prop where | refl : lts.STr s HasTau.τ s | tr : lts.STr s1 HasTau.τ s2 → lts.Tr s2 μ s3 → lts.STr s3 HasTau.τ s4 → lts.STr s1 μ s4 -/-- The `LTS` obtained by saturating the transition relation in `lts`. -/ -def LTS.saturate [HasTau Label] (lts : LTS State Label) : LTS State Label where - Tr := LTS.STr lts +/-- The `Lts` obtained by saturating the transition relation in `lts`. -/ +def Lts.saturate [HasTau Label] (lts : Lts State Label) : Lts State Label where + Tr := Lts.STr lts /-- Any transition is also a saturated transition. -/ -theorem LTS.STr.single [HasTau Label] (lts : LTS State Label) : lts.Tr s μ s' → lts.STr s μ s' := by +theorem Lts.STr.single [HasTau Label] (lts : Lts State Label) : lts.Tr s μ s' → lts.STr s μ s' := by intro h - apply LTS.STr.tr LTS.STr.refl h LTS.STr.refl + apply Lts.STr.tr Lts.STr.refl h Lts.STr.refl -/-- As `LTS.str`, but counts the number of `τ`-transitions. This is convenient as induction +/-- As `Lts.str`, but counts the number of `τ`-transitions. This is convenient as induction metric. -/ -inductive LTS.strN [HasTau Label] (lts : LTS State Label) : +inductive Lts.strN [HasTau Label] (lts : Lts State Label) : ℕ → State → Label → State → Prop where | refl : lts.strN 0 s HasTau.τ s | tr : @@ -407,31 +407,31 @@ inductive LTS.strN [HasTau Label] (lts : LTS State Label) : lts.strN m s3 HasTau.τ s4 → lts.strN (n + m + 1) s1 μ s4 -/-- `LTS.str` and `LTS.strN` are equivalent. -/ -theorem LTS.str_strN [HasTau Label] (lts : LTS State Label) : +/-- `Lts.str` and `Lts.strN` are equivalent. -/ +theorem Lts.str_strN [HasTau Label] (lts : Lts State Label) : lts.STr s1 μ s2 ↔ ∃ n, lts.strN n s1 μ s2 := by apply Iff.intro <;> intro h case mp => induction h case refl => exists 0 - exact LTS.strN.refl + exact Lts.strN.refl case tr s1 sb μ sb' s2 hstr1 htr hstr2 ih1 ih2 => obtain ⟨n1, ih1⟩ := ih1 obtain ⟨n2, ih2⟩ := ih2 exists (n1 + n2 + 1) - apply LTS.strN.tr ih1 htr ih2 + apply Lts.strN.tr ih1 htr ih2 case mpr => obtain ⟨n, h⟩ := h induction h case refl => constructor case tr n s1 sb μ sb' m s2 hstr1 htr hstr2 ih1 ih2 => - apply LTS.STr.tr ih1 htr ih2 + apply Lts.STr.tr ih1 htr ih2 /-- Saturated transitions labelled by τ can be composed (weighted version). -/ -theorem LTS.strN.trans_τ - [HasTau Label] (lts : LTS State Label) +theorem Lts.strN.trans_τ + [HasTau Label] (lts : Lts State Label) (h1 : lts.strN n s1 HasTau.τ s2) (h2 : lts.strN m s2 HasTau.τ s3) : lts.strN (n + m) s1 HasTau.τ s3 := by cases h1 @@ -439,25 +439,25 @@ theorem LTS.strN.trans_τ simp exact h2 case tr n1 sb sb' n2 hstr1 htr hstr2 => - have ih := LTS.strN.trans_τ lts hstr2 h2 - have conc := LTS.strN.tr hstr1 htr ih + have ih := Lts.strN.trans_τ lts hstr2 h2 + have conc := Lts.strN.tr hstr1 htr ih have n_eq : n1 + (n2 + m) + 1 = n1 + n2 + 1 + m := by omega rw [← n_eq] exact conc /-- Saturated transitions labelled by τ can be composed. -/ -theorem LTS.STr.trans_τ - [HasTau Label] (lts : LTS State Label) +theorem Lts.STr.trans_τ + [HasTau Label] (lts : Lts State Label) (h1 : lts.STr s1 HasTau.τ s2) (h2 : lts.STr s2 HasTau.τ s3) : lts.STr s1 HasTau.τ s3 := by - obtain ⟨n, h1N⟩ := (LTS.str_strN lts).1 h1 - obtain ⟨m, h2N⟩ := (LTS.str_strN lts).1 h2 - have concN := LTS.strN.trans_τ lts h1N h2N - apply (LTS.str_strN lts).2 ⟨n + m, concN⟩ + obtain ⟨n, h1N⟩ := (Lts.str_strN lts).1 h1 + obtain ⟨m, h2N⟩ := (Lts.str_strN lts).1 h2 + have concN := Lts.strN.trans_τ lts h1N h2N + apply (Lts.str_strN lts).2 ⟨n + m, concN⟩ /-- Saturated transitions can be appended with τ-transitions (weighted version). -/ -theorem LTS.strN.append - [HasTau Label] (lts : LTS State Label) +theorem Lts.strN.append + [HasTau Label] (lts : Lts State Label) (h1 : lts.strN n1 s1 μ s2) (h2 : lts.strN n2 s2 HasTau.τ s3) : lts.strN (n1 + n2) s1 μ s3 := by @@ -466,41 +466,41 @@ theorem LTS.strN.append simp exact h2 case tr n11 sb sb' n12 hstr1 htr hstr2 => - have hsuffix := LTS.strN.trans_τ lts hstr2 h2 + have hsuffix := Lts.strN.trans_τ lts hstr2 h2 have n_eq : n11 + (n12 + n2) + 1 = (n11 + n12 + 1 + n2) := by omega rw [← n_eq] - apply LTS.strN.tr hstr1 htr hsuffix + apply Lts.strN.tr hstr1 htr hsuffix /-- Saturated transitions can be composed (weighted version). -/ -theorem LTS.strN.comp - [HasTau Label] (lts : LTS State Label) +theorem Lts.strN.comp + [HasTau Label] (lts : Lts State Label) (h1 : lts.strN n1 s1 HasTau.τ s2) (h2 : lts.strN n2 s2 μ s3) (h3 : lts.strN n3 s3 HasTau.τ s4) : lts.strN (n1 + n2 + n3) s1 μ s4 := by cases h2 case refl => - apply LTS.strN.trans_τ lts h1 h3 + apply Lts.strN.trans_τ lts h1 h3 case tr n21 sb sb' n22 hstr1 htr hstr2 => - have hprefix_τ := LTS.strN.trans_τ lts h1 hstr1 - have hprefix := LTS.strN.tr hprefix_τ htr hstr2 - have conc := LTS.strN.append lts hprefix h3 + have hprefix_τ := Lts.strN.trans_τ lts h1 hstr1 + have hprefix := Lts.strN.tr hprefix_τ htr hstr2 + have conc := Lts.strN.append lts hprefix h3 have n_eq : (n1 + n21 + n22 + 1 + n3) = (n1 + (n21 + n22 + 1) + n3) := by omega rw [← n_eq] apply conc /-- Saturated transitions can be composed. -/ -theorem LTS.STr.comp - [HasTau Label] (lts : LTS State Label) +theorem Lts.STr.comp + [HasTau Label] (lts : Lts State Label) (h1 : lts.STr s1 HasTau.τ s2) (h2 : lts.STr s2 μ s3) (h3 : lts.STr s3 HasTau.τ s4) : lts.STr s1 μ s4 := by - obtain ⟨n1, h1N⟩ := (LTS.str_strN lts).1 h1 - obtain ⟨n2, h2N⟩ := (LTS.str_strN lts).1 h2 - obtain ⟨n3, h3N⟩ := (LTS.str_strN lts).1 h3 - have concN := LTS.strN.comp lts h1N h2N h3N - apply (LTS.str_strN lts).2 ⟨n1 + n2 + n3, concN⟩ + obtain ⟨n1, h1N⟩ := (Lts.str_strN lts).1 h1 + obtain ⟨n2, h2N⟩ := (Lts.str_strN lts).1 h2 + obtain ⟨n3, h3N⟩ := (Lts.str_strN lts).1 h3 + have concN := Lts.strN.comp lts h1N h2N h3N + apply (Lts.str_strN lts).2 ⟨n1 + n2 + n3, concN⟩ end Weak @@ -510,31 +510,31 @@ section Divergence /-- A divergent execution is a stream of states where each state is the anti-τ-derivative of the next. -/ -def LTS.DivergentExecution [HasTau Label] (lts : LTS State Label) +def Lts.DivergentExecution [HasTau Label] (lts : Lts State Label) (stream : Stream' State) : Prop := ∀ n, lts.Tr (stream n) HasTau.τ (stream n.succ) /-- A state is divergent if there is a divergent execution from it. -/ -def LTS.Divergent [HasTau Label] (lts : LTS State Label) (s : State) : Prop := +def Lts.Divergent [HasTau Label] (lts : Lts State Label) (s : State) : Prop := ∃ stream : Stream' State, stream 0 = s ∧ lts.DivergentExecution stream /-- If a stream is a divergent execution, then any 'suffix' is also a divergent execution. -/ -theorem LTS.divergent_drop - [HasTau Label] (lts : LTS State Label) (stream : Stream' State) +theorem Lts.divergent_drop + [HasTau Label] (lts : Lts State Label) (stream : Stream' State) (h : lts.DivergentExecution stream) (n : ℕ) : lts.DivergentExecution (stream.drop n) := by - simp only [LTS.DivergentExecution] + simp only [Lts.DivergentExecution] intro m simp only [Stream'.drop, Stream'.get] - simp [LTS.DivergentExecution] at h + simp [Lts.DivergentExecution] at h specialize h (n + m) have n_eq : m.succ + n = n + m + 1 := by omega have n_comm : n + m = m + n := by apply Nat.add_comm rw [n_eq, ← n_comm] apply h -/-- An LTS is divergence-free if it has no divergent state. -/ -def LTS.DivergenceFree [HasTau Label] (lts : LTS State Label) : Prop := +/-- An Lts is divergence-free if it has no divergent state. -/ +def Lts.DivergenceFree [HasTau Label] (lts : Lts State Label) : Prop := ¬∃ s, lts.Divergent s end Divergence @@ -542,17 +542,17 @@ end Divergence section Relation /-- Returns the relation that relates all states `s1` and `s2` via a fixed transition label `μ`. -/ -def LTS.Tr.toRelation (lts : LTS State Label) (μ : Label) : State → State → Prop := +def Lts.Tr.toRelation (lts : Lts State Label) (μ : Label) : State → State → Prop := fun s1 s2 => lts.Tr s1 μ s2 /-- Returns the relation that relates all states `s1` and `s2` via a fixed list of transition labels `μs`. -/ -def LTS.MTr.toRelation (lts : LTS State Label) (μs : List Label) : State → State → Prop := +def Lts.MTr.toRelation (lts : Lts State Label) (μs : List Label) : State → State → Prop := fun s1 s2 => lts.MTr s1 μs s2 -/-- Any homogeneous relation can be seen as an LTS where all transitions have the same label. -/ -def Relation.toLTS [DecidableEq Label] (r : State → State → Prop) (μ : Label) : - LTS State Label where +/-- Any homogeneous relation can be seen as an Lts where all transitions have the same label. -/ +def Relation.toLts [DecidableEq Label] (r : State → State → Prop) (μ : Label) : + Lts State Label where Tr := fun s1 μ' s2 => if μ' = μ then r s1 s2 else False end Relation @@ -562,54 +562,54 @@ section Trans /-! ## Support for the calc tactic -/ /-- Transitions can be chained. -/ -instance (lts : LTS State Label) : +instance (lts : Lts State Label) : Trans - (LTS.Tr.toRelation lts μ1) - (LTS.Tr.toRelation lts μ2) - (LTS.MTr.toRelation lts [μ1, μ2]) where + (Lts.Tr.toRelation lts μ1) + (Lts.Tr.toRelation lts μ2) + (Lts.MTr.toRelation lts [μ1, μ2]) where trans := by intro s1 s2 s3 htr1 htr2 - apply LTS.MTr.single at htr1 - apply LTS.MTr.single at htr2 - apply LTS.MTr.comp lts htr1 htr2 + apply Lts.MTr.single at htr1 + apply Lts.MTr.single at htr2 + apply Lts.MTr.comp lts htr1 htr2 /-- Transitions can be chained with multi-step transitions. -/ -instance (lts : LTS State Label) : +instance (lts : Lts State Label) : Trans - (LTS.Tr.toRelation lts μ) - (LTS.MTr.toRelation lts μs) - (LTS.MTr.toRelation lts (μ :: μs)) where + (Lts.Tr.toRelation lts μ) + (Lts.MTr.toRelation lts μs) + (Lts.MTr.toRelation lts (μ :: μs)) where trans := by intro s1 s2 s3 htr1 hmtr2 - apply LTS.MTr.single at htr1 - apply LTS.MTr.comp lts htr1 hmtr2 + apply Lts.MTr.single at htr1 + apply Lts.MTr.comp lts htr1 hmtr2 /-- Multi-step transitions can be chained with transitions. -/ -instance (lts : LTS State Label) : +instance (lts : Lts State Label) : Trans - (LTS.MTr.toRelation lts μs) - (LTS.Tr.toRelation lts μ) - (LTS.MTr.toRelation lts (μs ++ [μ])) where + (Lts.MTr.toRelation lts μs) + (Lts.Tr.toRelation lts μ) + (Lts.MTr.toRelation lts (μs ++ [μ])) where trans := by intro s1 s2 s3 hmtr1 htr2 - apply LTS.MTr.single at htr2 - apply LTS.MTr.comp lts hmtr1 htr2 + apply Lts.MTr.single at htr2 + apply Lts.MTr.comp lts hmtr1 htr2 /-- Multi-step transitions can be chained. -/ -instance (lts : LTS State Label) : +instance (lts : Lts State Label) : Trans - (LTS.MTr.toRelation lts μs1) - (LTS.MTr.toRelation lts μs2) - (LTS.MTr.toRelation lts (μs1 ++ μs2)) where + (Lts.MTr.toRelation lts μs1) + (Lts.MTr.toRelation lts μs2) + (Lts.MTr.toRelation lts (μs1 ++ μs2)) where trans := by intro s1 s2 s3 hmtr1 hmtr2 - apply LTS.MTr.comp lts hmtr1 hmtr2 + apply Lts.MTr.comp lts hmtr1 hmtr2 end Trans open Lean Elab Meta Command Term -/-- A command to create an `LTS` from a labelled transition `α → β → α → Prop`, robust to use of +/-- A command to create an `Lts` from a labelled transition `α → β → α → Prop`, robust to use of `variable `-/ elab "create_lts" lt:ident name:ident : command => do liftTermElabM do @@ -625,7 +625,7 @@ elab "create_lts" lt:ident name:ident : command => do throwError m!"expecting Prop, not{indentExpr ty}" let params := ci.levelParams.map .param let lt := mkAppN (.const lt params) args[0:args.size-3] - let bundle ← mkAppM ``LTS.mk #[lt] + let bundle ← mkAppM ``Lts.mk #[lt] let value ← mkLambdaFVars args[0:args.size-3] bundle let type ← inferType value addAndCompile <| .defnDecl { @@ -640,7 +640,7 @@ elab "create_lts" lt:ident name:ident : command => do addDeclarationRangesFromSyntax name.getId name /-- - This command adds transition notations for an `LTS`. This should not usually be called directly, + This command adds transition notations for an `Lts`. This should not usually be called directly, but from the `lts` attribute. As an example `lts_transition_notation foo "β"` will add the notations "[⬝]⭢β" and "[⬝]↠β" @@ -653,13 +653,13 @@ syntax "lts_transition_notation" ident (Lean.Parser.Command.notationItem)? : com macro_rules | `(lts_transition_notation $lts $sym) => `( - notation:39 t "["μ"]⭢"$sym t' => (LTS.Tr.toRelation $lts μ) t t' - notation:39 t "["μs"]↠"$sym t' => (LTS.MTr.toRelation $lts μs) t t' + notation:39 t "["μ"]⭢"$sym t' => (Lts.Tr.toRelation $lts μ) t t' + notation:39 t "["μs"]↠"$sym t' => (Lts.MTr.toRelation $lts μs) t t' ) | `(lts_transition_notation $lts) => `( - notation:39 t "["μ"]⭢" t' => (LTS.Tr.toRelation $lts μ) t t' - notation:39 t "["μs"]↠" t' => (LTS.MTr.toRelation $lts μs) t t' + notation:39 t "["μ"]⭢" t' => (Lts.Tr.toRelation $lts μ) t t' + notation:39 t "["μs"]↠" t' => (Lts.MTr.toRelation $lts μs) t t' ) /-- This attribute calls the `lts_transition_notation` command for the annotated declaration. -/ @@ -667,7 +667,7 @@ syntax (name := lts_attr) "lts" ident (Lean.Parser.Command.notationItem)? : attr initialize Lean.registerBuiltinAttribute { name := `lts_attr - descr := "Register notation for an LTS" + descr := "Register notation for an Lts" add := fun decl stx _ => MetaM.run' do match stx with | `(attr | lts $lts $sym) => diff --git a/Cslib/Semantics/LTS/Bisimulation.lean b/Cslib/Semantics/Lts/Bisimulation.lean similarity index 89% rename from Cslib/Semantics/LTS/Bisimulation.lean rename to Cslib/Semantics/Lts/Bisimulation.lean index e46ad63f..b78be41c 100644 --- a/Cslib/Semantics/LTS/Bisimulation.lean +++ b/Cslib/Semantics/Lts/Bisimulation.lean @@ -4,20 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.LTS.Basic -import Cslib.Semantics.LTS.TraceEq +import Cslib.Semantics.Lts.Basic +import Cslib.Semantics.Lts.TraceEq import Cslib.Data.Relation -import Cslib.Semantics.LTS.Simulation +import Cslib.Semantics.Lts.Simulation /-! # Bisimulation and Bisimilarity -A bisimulation is a binary relation on the states of an `LTS`, which establishes a tight semantic +A bisimulation is a binary relation on the states of an `Lts`, which establishes a tight semantic correspondence. More specifically, if two states `s1` and `s2` are related by a bisimulation, then `s1` can mimic all transitions of `s2` and vice versa. Furthermore, the derivatives reaches through these transitions remain related by the bisimulation. -Bisimilarity is the largest bisimulation: given an `LTS`, it relates any two states that are related -by a bisimulation for that LTS. +Bisimilarity is the largest bisimulation: given an `Lts`, it relates any two states that are related +by a bisimulation for that Lts. Weak bisimulation (resp. bisimilarity) is the relaxed version of bisimulation (resp. bisimilarity) whereby internal actions performed by processes can be ignored. @@ -26,13 +26,13 @@ For an introduction to theory of bisimulation, we refer to [Sangiorgi2011]. ## Main definitions -- `Bisimulation lts r`: the relation `r` on the states of the LTS `lts` is a bisimulation. +- `Bisimulation lts r`: the relation `r` on the states of the Lts `lts` is a bisimulation. - `Bisimilarity lts` is the binary relation on the states of `lts` that relates any two states related by some bisimulation on `lts`. - `BisimulationUpTo lts r`: the relation `r` is a bisimulation up to bisimilarity (this is known as one of the 'up to' techniques for bisimulation). -- `WeakBisimulation lts r`: the relation `r` on the states of the LTS `lts` is a weak bisimulation. +- `WeakBisimulation lts r`: the relation `r` on the states of the Lts `lts` is a weak bisimulation. - `WeakBisimilarity lts` is the binary relation on the states of `lts` that relates any two states related by some weak bisimulation on `lts`. - `SWBisimulation lts` is a more convenient definition for establishing weak bisimulations, which @@ -42,9 +42,9 @@ related by some sw-bisimulation on `lts`. ## Notations -- `s1 ~[lts] s2`: the states `s1` and `s2` are bisimilar in the LTS `lts`. -- `s1 ≈[lts] s2`: the states `s1` and `s2` are weakly bisimilar in the LTS `lts`. -- `s1 ≈sw[lts] s2`: the states `s1` and `s2` are sw bisimilar in the LTS `lts`. +- `s1 ~[lts] s2`: the states `s1` and `s2` are bisimilar in the Lts `lts`. +- `s1 ≈[lts] s2`: the states `s1` and `s2` are weakly bisimilar in the Lts `lts`. +- `s1 ≈sw[lts] s2`: the states `s1` and `s2` are sw bisimilar in the Lts `lts`. ## Main statements @@ -56,10 +56,10 @@ related by some sw-bisimulation on `lts`. - `Bisimulation.upTo_bisimulation`: any bisimulation up to bisimilarity is a bisimulation. - `Bisimulation.bisim_traceEq`: any bisimulation that relates two states implies that they are trace equivalent (see `TraceEq`). -- `Bisimilarity.deterministic_bisim_eq_traceEq`: in a deterministic LTS, bisimilarity and trace +- `Bisimilarity.deterministic_bisim_eq_traceEq`: in a deterministic Lts, bisimilarity and trace equivalence coincide. - `WeakBisimilarity.weakBisim_eq_swBisim`: weak bisimilarity and sw-bisimilarity coincide in all -LTSs. +Ltss. - `WeakBisimilarity.eqv`: weak bisimilarity is an equivalence relation. - `SWBisimilarity.eqv`: sw-bisimilarity is an equivalence relation. @@ -69,12 +69,12 @@ universe u v section Bisimulation -variable {State : Type u} {Label : Type v} (lts : LTS State Label) +variable {State : Type u} {Label : Type v} (lts : Lts State Label) /-- A relation is a bisimulation if, whenever it relates two states in an lts, the transitions originating from these states mimic each other and the reached derivatives are themselves related. -/ -def Bisimulation (lts : LTS State Label) (r : State → State → Prop) : Prop := +def Bisimulation (lts : Lts State Label) (r : State → State → Prop) : Prop := ∀ s1 s2, r s1 s2 → ∀ μ, ( (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ r s1' s2') ∧ @@ -83,20 +83,20 @@ def Bisimulation (lts : LTS State Label) (r : State → State → Prop) : Prop : /-- Helper for following a transition using the first component of a `Bisimulation`. -/ def Bisimulation.follow_fst - {lts : LTS State Label} {r : State → State → Prop} + {lts : Lts State Label} {r : State → State → Prop} {s1 s2 : State} {μ : Label} {s1' : State} (hb : Bisimulation lts r) (hr : r s1 s2) (htr : lts.Tr s1 μ s1') := (hb _ _ hr μ).1 _ htr /-- Helper for following a transition using the second component of a `Bisimulation`. -/ def Bisimulation.follow_snd - {lts : LTS State Label} {r : State → State → Prop} + {lts : Lts State Label} {r : State → State → Prop} {s1 s2 : State} {μ : Label} {s2' : State} (hb : Bisimulation lts r) (hr : r s1 s2) (htr : lts.Tr s2 μ s2') := (hb _ _ hr μ).2 _ htr /-- Two states are bisimilar if they are related by some bisimulation. -/ -def Bisimilarity (lts : LTS State Label) : State → State → Prop := +def Bisimilarity (lts : Lts State Label) : State → State → Prop := fun s1 s2 => ∃ r : State → State → Prop, r s1 s2 ∧ Bisimulation lts r @@ -204,7 +204,7 @@ theorem Bisimilarity.trans apply Bisimulation.comp lts r1 r2 hr1b hr2b /-- Bisimilarity is an equivalence relation. -/ -theorem Bisimilarity.eqv (lts : LTS State Label) : +theorem Bisimilarity.eqv (lts : Lts State Label) : Equivalence (Bisimilarity lts) := { refl := Bisimilarity.refl lts symm := Bisimilarity.symm lts @@ -368,7 +368,7 @@ end Order /-- A relation `r` is a bisimulation up to bisimilarity if, whenever it relates two states in an lts, the transitions originating from these states mimic each other and the reached derivatives are themselves related by `r` up to bisimilarity. -/ -def BisimulationUpTo (lts : LTS State Label) (r : State → State → Prop) : Prop := +def BisimulationUpTo (lts : Lts State Label) (r : State → State → Prop) : Prop := ∀ s1 s2, r s1 s2 → ∀ μ, ( (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ Relation.upTo r (Bisimilarity lts) s1' s2') ∧ @@ -466,7 +466,7 @@ theorem Bisimulation.bisim_trace theorem Bisimulation.bisim_traceEq (hb : Bisimulation lts r) (hr : r s1 s2) : s1 ~tr[lts] s2 := by - simp [TraceEq, LTS.traces, setOf] + simp [TraceEq, Lts.traces, setOf] funext μs simp only [eq_iff_iff] constructor @@ -507,10 +507,10 @@ private inductive BisimMotTr : ℕ → Char → ℕ → Prop where /-- In general, trace equivalence is not a bisimulation (extra conditions are needed, see for example `Bisimulation.deterministic_trace_eq_is_bisim`). -/ theorem Bisimulation.traceEq_not_bisim : - ∃ (State : Type) (Label : Type) (lts : LTS State Label), ¬(Bisimulation lts (TraceEq lts)) := by + ∃ (State : Type) (Label : Type) (lts : Lts State Label), ¬(Bisimulation lts (TraceEq lts)) := by exists ℕ exists Char - let lts := LTS.mk BisimMotTr + let lts := Lts.mk BisimMotTr exists lts intro h simp [Bisimulation] at h @@ -518,7 +518,7 @@ theorem Bisimulation.traceEq_not_bisim : have htreq : (1 ~tr[lts] 5) := by simp [TraceEq] have htraces1 : lts.traces 1 = {[], ['a'], ['a', 'b'], ['a', 'c']} := by - simp [LTS.traces] + simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -546,21 +546,21 @@ theorem Bisimulation.traceEq_not_bisim : case inl h1 => simp [h1] exists 2 - apply LTS.MTr.single; constructor + apply Lts.MTr.single; constructor case inr h1 => cases h1 case inl h1 => simp [h1] exists 3 - constructor; apply BisimMotTr.one2two; apply LTS.MTr.single; + constructor; apply BisimMotTr.one2two; apply Lts.MTr.single; apply BisimMotTr.two2three case inr h1 => cases h1 exists 4 - constructor; apply BisimMotTr.one2two; apply LTS.MTr.single; + constructor; apply BisimMotTr.one2two; apply Lts.MTr.single; apply BisimMotTr.two2four have htraces2 : lts.traces 5 = {[], ['a'], ['a', 'b'], ['a', 'c']} := by - simp [LTS.traces] + simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -606,18 +606,18 @@ theorem Bisimulation.traceEq_not_bisim : case inl h1 => simp [h1] exists 6 - apply LTS.MTr.single; constructor + apply Lts.MTr.single; constructor case inr h1 => cases h1 case inl h1 => simp [h1] exists 7 - constructor; apply BisimMotTr.five2six; apply LTS.MTr.single; + constructor; apply BisimMotTr.five2six; apply Lts.MTr.single; apply BisimMotTr.six2seven case inr h1 => cases h1 exists 9 - constructor; apply BisimMotTr.five2eight; apply LTS.MTr.single; + constructor; apply BisimMotTr.five2eight; apply Lts.MTr.single; apply BisimMotTr.eight2nine simp [htraces1, htraces2] specialize h htreq @@ -629,7 +629,7 @@ theorem Bisimulation.traceEq_not_bisim : case five2six => simp [TraceEq] at cih have htraces2 : lts.traces 2 = {[], ['b'], ['c']} := by - simp [LTS.traces] + simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -668,7 +668,7 @@ theorem Bisimulation.traceEq_not_bisim : simp [h] constructor; constructor; constructor have htraces6 : lts.traces 6 = {[], ['b']} := by - simp [LTS.traces] + simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -708,7 +708,7 @@ theorem Bisimulation.traceEq_not_bisim : case five2eight => simp [TraceEq] at cih have htraces2 : lts.traces 2 = {[], ['b'], ['c']} := by - simp [LTS.traces] + simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -747,7 +747,7 @@ theorem Bisimulation.traceEq_not_bisim : simp [h] constructor; constructor; constructor have htraces8 : lts.traces 8 = {[], ['c']} := by - simp [LTS.traces] + simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -787,7 +787,7 @@ theorem Bisimulation.traceEq_not_bisim : /-- In general, bisimilarity and trace equivalence are distinct. -/ theorem Bisimilarity.bisimilarity_neq_traceEq : - ∃ (State : Type) (Label : Type) (lts : LTS State Label), Bisimilarity lts ≠ TraceEq lts := by + ∃ (State : Type) (Label : Type) (lts : Lts State Label), Bisimilarity lts ≠ TraceEq lts := by obtain ⟨State, Label, lts, h⟩ := Bisimulation.traceEq_not_bisim exists State; exists Label; exists lts simp @@ -796,9 +796,9 @@ theorem Bisimilarity.bisimilarity_neq_traceEq : rw [heq] at hb contradiction -/-- In any deterministic LTS, trace equivalence is a bisimulation. -/ +/-- In any deterministic Lts, trace equivalence is a bisimulation. -/ theorem Bisimulation.deterministic_traceEq_is_bisim - (lts : LTS State Label) (hdet : lts.Deterministic) : + (lts : Lts State Label) (hdet : lts.Deterministic) : (Bisimulation lts (TraceEq lts)) := by simp only [Bisimulation] intro s1 s2 hteq μ @@ -817,9 +817,9 @@ theorem Bisimulation.deterministic_traceEq_is_bisim case right => apply h.2.symm -/-- In any deterministic LTS, trace equivalence implies bisimilarity. -/ +/-- In any deterministic Lts, trace equivalence implies bisimilarity. -/ theorem Bisimilarity.deterministic_traceEq_bisim - (lts : LTS State Label) (hdet : lts.Deterministic) (s1 s2 : State) (h : s1 ~tr[lts] s2) : + (lts : Lts State Label) (hdet : lts.Deterministic) (s1 s2 : State) (h : s1 ~tr[lts] s2) : (s1 ~[lts] s2) := by exists TraceEq lts constructor @@ -828,9 +828,9 @@ theorem Bisimilarity.deterministic_traceEq_bisim case right => apply Bisimulation.deterministic_traceEq_is_bisim lts hdet -/-- In any deterministic LTS, bisimilarity and trace equivalence coincide. -/ +/-- In any deterministic Lts, bisimilarity and trace equivalence coincide. -/ theorem Bisimilarity.deterministic_bisim_eq_traceEq - (lts : LTS State Label) (hdet : lts.Deterministic) : + (lts : Lts State Label) (hdet : lts.Deterministic) : Bisimilarity lts = TraceEq lts := by funext s1 s2 simp [eq_iff_iff] @@ -843,7 +843,7 @@ theorem Bisimilarity.deterministic_bisim_eq_traceEq /-! ## Relation to simulation -/ /-- Any bisimulation is also a simulation. -/ -theorem Bisimulation.is_simulation (lts : LTS State Label) (r : State → State → Prop) : +theorem Bisimulation.is_simulation (lts : Lts State Label) (r : State → State → Prop) : Bisimulation lts r → Simulation lts r := by intro h simp only [Bisimulation] at h @@ -854,7 +854,7 @@ theorem Bisimulation.is_simulation (lts : LTS State Label) (r : State → State apply h1 s1' htr /-- A relation is a bisimulation iff both it and its inverse are simulations. -/ -theorem Bisimulation.simulation_iff (lts : LTS State Label) (r : State → State → Prop) : +theorem Bisimulation.simulation_iff (lts : Lts State Label) (r : State → State → Prop) : Bisimulation lts r ↔ (Simulation lts r ∧ Simulation lts (flip r)) := by constructor case mp => @@ -897,12 +897,12 @@ section WeakBisimulation /-! ## Weak bisimulation and weak bisimilarity -/ /-- A weak bisimulation is similar to a `Bisimulation`, but allows for the related processes to do -internal work. Technically, this is defined as a `Bisimulation` on the saturation of the LTS. -/ -def WeakBisimulation [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) := +internal work. Technically, this is defined as a `Bisimulation` on the saturation of the Lts. -/ +def WeakBisimulation [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) := Bisimulation (lts.saturate) r /-- Two states are weakly bisimilar if they are related by some weak bisimulation. -/ -def WeakBisimilarity [HasTau Label] (lts : LTS State Label) : State → State → Prop := +def WeakBisimilarity [HasTau Label] (lts : Lts State Label) : State → State → Prop := fun s1 s2 => ∃ r : State → State → Prop, r s1 s2 ∧ WeakBisimulation lts r @@ -912,7 +912,7 @@ notation s:max " ≈[" lts "] " s':max => WeakBisimilarity lts s s' /-- An `SWBisimulation` is a more convenient definition of weak bisimulation, because the challenge is a single transition. We prove later that this technique is sound, following a strategy inspired by [Sangiorgi2011]. -/ -def SWBisimulation [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) : Prop := +def SWBisimulation [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) : Prop := ∀ s1 s2, r s1 s2 → ∀ μ, ( (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.STr s2 μ s2' ∧ r s1' s2') ∧ @@ -920,7 +920,7 @@ def SWBisimulation [HasTau Label] (lts : LTS State Label) (r : State → State ) /-- Two states are sw-bisimilar if they are related by some sw-bisimulation. -/ -def SWBisimilarity [HasTau Label] (lts : LTS State Label) : State → State → Prop := +def SWBisimilarity [HasTau Label] (lts : Lts State Label) : State → State → Prop := fun s1 s2 => ∃ r : State → State → Prop, r s1 s2 ∧ SWBisimulation lts r @@ -930,7 +930,7 @@ notation s:max " ≈sw[" lts "] " s':max => SWBisimilarity lts s s' /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (first component, weighted version). -/ theorem SWBisimulation.follow_internal_fst_n - [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) + [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstrN : lts.strN n s1 HasTau.τ s1') : ∃ s2', lts.STr s2 HasTau.τ s2' ∧ r s1' s2' := by cases n @@ -952,13 +952,13 @@ theorem SWBisimulation.follow_internal_fst_n obtain ⟨s2', hstrs2', hrs2⟩ := ih2 exists s2' constructor - · apply LTS.STr.trans_τ lts (LTS.STr.trans_τ lts hstrs2 hstrsb2) hstrs2' + · apply Lts.STr.trans_τ lts (Lts.STr.trans_τ lts hstrs2 hstrsb2) hstrs2' · exact hrs2 /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (second component, weighted version). -/ theorem SWBisimulation.follow_internal_snd_n - [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) + [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstrN : lts.strN n s2 HasTau.τ s2') : ∃ s1', lts.STr s1 HasTau.τ s1' ∧ r s1' s2' := by cases n @@ -980,31 +980,31 @@ theorem SWBisimulation.follow_internal_snd_n obtain ⟨s2', hstrs2', hrs2⟩ := ih2 exists s2' constructor - · apply LTS.STr.trans_τ lts (LTS.STr.trans_τ lts hstrs1 hstrsb2) hstrs2' + · apply Lts.STr.trans_τ lts (Lts.STr.trans_τ lts hstrs1 hstrsb2) hstrs2' · exact hrs2 /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (first component). -/ theorem SWBisimulation.follow_internal_fst - [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) + [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstr : lts.STr s1 HasTau.τ s1') : ∃ s2', lts.STr s2 HasTau.τ s2' ∧ r s1' s2' := by - obtain ⟨n, hstrN⟩ := (LTS.str_strN lts).1 hstr + obtain ⟨n, hstrN⟩ := (Lts.str_strN lts).1 hstr apply SWBisimulation.follow_internal_fst_n lts r hswb hr hstrN /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (second component). -/ theorem SWBisimulation.follow_internal_snd - [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) + [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstr : lts.STr s2 HasTau.τ s2') : ∃ s1', lts.STr s1 HasTau.τ s1' ∧ r s1' s2' := by - obtain ⟨n, hstrN⟩ := (LTS.str_strN lts).1 hstr + obtain ⟨n, hstrN⟩ := (Lts.str_strN lts).1 hstr apply SWBisimulation.follow_internal_snd_n lts r hswb hr hstrN /-- We can now prove that any relation is a `WeakBisimulation` iff it is an `SWBisimulation`. This formalises lemma 4.2.10 in [Sangiorgi2011]. -/ theorem WeakBisimulation.iff_swBisimulation - [HasTau Label] (lts : LTS State Label) (r : State → State → Prop) : + [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) : WeakBisimulation lts r ↔ SWBisimulation lts r := by apply Iff.intro case mp => @@ -1016,13 +1016,13 @@ theorem WeakBisimulation.iff_swBisimulation case left => intro s1' htr specialize h s1 s2 hr μ - have h' := h.1 s1' (LTS.STr.single lts htr) + have h' := h.1 s1' (Lts.STr.single lts htr) obtain ⟨s2', htr2, hr2⟩ := h' exists s2' case right => intro s2' htr specialize h s1 s2 hr μ - have h' := h.2 s2' (LTS.STr.single lts htr) + have h' := h.2 s2' (Lts.STr.single lts htr) obtain ⟨s1', htr1, hr1⟩ := h' exists s1' case mpr => @@ -1043,8 +1043,8 @@ theorem WeakBisimulation.iff_swBisimulation obtain ⟨s2', hstr2', hrb2⟩ := SWBisimulation.follow_internal_fst lts r h hrb' hstr2 exists s2' constructor - · simp [LTS.saturate] - apply LTS.STr.comp lts hstr2b hstr2b' hstr2' + · simp [Lts.saturate] + apply Lts.STr.comp lts hstr2b hstr2b' hstr2' · exact hrb2 case right => intro s2' hstr @@ -1059,24 +1059,24 @@ theorem WeakBisimulation.iff_swBisimulation obtain ⟨s1', hstr1', hrb2⟩ := SWBisimulation.follow_internal_snd lts r h hrb' hstr2 exists s1' constructor - · simp [LTS.saturate] - apply LTS.STr.comp lts hstr1b hstr1b' hstr1' + · simp [Lts.saturate] + apply Lts.STr.comp lts hstr1b hstr1b' hstr1' · exact hrb2 -theorem WeakBisimulation.toSwBisimulation [HasTau Label] {lts : LTS State Label} {r : State → State → Prop} (h : WeakBisimulation lts r) : SWBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).1 h +theorem WeakBisimulation.toSwBisimulation [HasTau Label] {lts : Lts State Label} {r : State → State → Prop} (h : WeakBisimulation lts r) : SWBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).1 h -theorem SWBisimulation.toWeakBisimulation [HasTau Label] {lts : LTS State Label} {r : State → State → Prop} (h : SWBisimulation lts r) : WeakBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).2 h +theorem SWBisimulation.toWeakBisimulation [HasTau Label] {lts : Lts State Label} {r : State → State → Prop} (h : SWBisimulation lts r) : WeakBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).2 h /-- If two states are related by an `SWBisimulation`, then they are weakly bisimilar. -/ theorem WeakBisimilarity.by_swBisimulation [HasTau Label] - (lts : LTS State Label) (r : State → State → Prop) + (lts : Lts State Label) (r : State → State → Prop) (hb : SWBisimulation lts r) (hr : r s1 s2) : s1 ≈[lts] s2 := by exists r constructor; exact hr apply (WeakBisimulation.iff_swBisimulation lts r).2 hb -/-- Weak bisimilarity and sw-bisimilarity coincide for all LTSs. -/ -theorem WeakBisimilarity.weakBisim_eq_swBisim [HasTau Label] (lts : LTS State Label) : +/-- Weak bisimilarity and sw-bisimilarity coincide for all Ltss. -/ +theorem WeakBisimilarity.weakBisim_eq_swBisim [HasTau Label] (lts : Lts State Label) : WeakBisimilarity lts = SWBisimilarity lts := by funext s1 s2 simp [WeakBisimilarity, SWBisimilarity] @@ -1095,7 +1095,7 @@ theorem WeakBisimilarity.weakBisim_eq_swBisim [HasTau Label] (lts : LTS State La apply (WeakBisimulation.iff_swBisimulation lts r).2 hrh /-- sw-bisimilarity is reflexive. -/ -theorem SWBisimilarity.refl [HasTau Label] (lts : LTS State Label) (s : State) : s ≈sw[lts] s := by +theorem SWBisimilarity.refl [HasTau Label] (lts : Lts State Label) (s : State) : s ≈sw[lts] s := by simp [SWBisimilarity] exists Eq constructor; rfl @@ -1107,22 +1107,22 @@ theorem SWBisimilarity.refl [HasTau Label] (lts : LTS State Label) (s : State) : intro s1' htr exists s1' constructor - · apply LTS.STr.single _ htr + · apply Lts.STr.single _ htr · constructor case right => intro s2' htr exists s2' constructor - · apply LTS.STr.single _ htr + · apply Lts.STr.single _ htr · constructor /-- Weak bisimilarity is reflexive. -/ -theorem WeakBisimilarity.refl [HasTau Label] (lts : LTS State Label) (s : State) : s ≈[lts] s := by +theorem WeakBisimilarity.refl [HasTau Label] (lts : Lts State Label) (s : State) : s ≈[lts] s := by rw [WeakBisimilarity.weakBisim_eq_swBisim lts] apply SWBisimilarity.refl /-- The inverse of an sw-bisimulation is an sw-bisimulation. -/ -theorem SWBisimulation.inv [HasTau Label] (lts : LTS State Label) +theorem SWBisimulation.inv [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) (h : SWBisimulation lts r) : SWBisimulation lts (flip r) := by simp only [SWBisimulation] at h @@ -1143,7 +1143,7 @@ theorem SWBisimulation.inv [HasTau Label] (lts : LTS State Label) exists s1' /-- The inverse of a weak bisimulation is a weak bisimulation. -/ -theorem WeakBisimulation.inv [HasTau Label] (lts : LTS State Label) +theorem WeakBisimulation.inv [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) (h : WeakBisimulation lts r) : WeakBisimulation lts (flip r) := by apply WeakBisimulation.toSwBisimulation at h @@ -1152,7 +1152,7 @@ theorem WeakBisimulation.inv [HasTau Label] (lts : LTS State Label) exact h' /-- sw-bisimilarity is symmetric. -/ -theorem SWBisimilarity.symm [HasTau Label] (lts : LTS State Label) (h : s1 ≈sw[lts] s2) : s2 ≈sw[lts] s1 := by +theorem SWBisimilarity.symm [HasTau Label] (lts : Lts State Label) (h : s1 ≈sw[lts] s2) : s2 ≈sw[lts] s1 := by obtain ⟨r, hr, hrh⟩ := h exists (flip r) constructor @@ -1163,7 +1163,7 @@ theorem SWBisimilarity.symm [HasTau Label] (lts : LTS State Label) (h : s1 ≈sw apply SWBisimulation.inv lts r hrh /-- Weak bisimilarity is symmetric. -/ -theorem WeakBisimilarity.symm [HasTau Label] (lts : LTS State Label) (h : s1 ≈[lts] s2) : s2 ≈[lts] s1 := by +theorem WeakBisimilarity.symm [HasTau Label] (lts : Lts State Label) (h : s1 ≈[lts] s2) : s2 ≈[lts] s1 := by rw [WeakBisimilarity.weakBisim_eq_swBisim] rw [WeakBisimilarity.weakBisim_eq_swBisim] at h apply SWBisimilarity.symm lts h @@ -1171,7 +1171,7 @@ theorem WeakBisimilarity.symm [HasTau Label] (lts : LTS State Label) (h : s1 ≈ /-- The composition of two weak bisimulations is a weak bisimulation. -/ theorem WeakBisimulation.comp [HasTau Label] - (lts : LTS State Label) + (lts : Lts State Label) (r1 r2 : State → State → Prop) (h1 : WeakBisimulation lts r1) (h2 : WeakBisimulation lts r2) : WeakBisimulation lts (Relation.Comp r1 r2) := by simp_all only [WeakBisimulation] @@ -1207,7 +1207,7 @@ theorem WeakBisimulation.comp /-- The composition of two sw-bisimulations is an sw-bisimulation. -/ theorem SWBisimulation.comp [HasTau Label] - (lts : LTS State Label) + (lts : Lts State Label) (r1 r2 : State → State → Prop) (h1 : SWBisimulation lts r1) (h2 : SWBisimulation lts r2) : SWBisimulation lts (Relation.Comp r1 r2) := by apply SWBisimulation.toWeakBisimulation at h1 @@ -1217,7 +1217,7 @@ theorem SWBisimulation.comp /-- Weak bisimilarity is transitive. -/ theorem WeakBisimilarity.trans - [HasTau Label] {s1 s2 s3 : State} (lts : LTS State Label) (h1 : s1 ≈[lts] s2) (h2 : s2 ≈[lts] s3) : + [HasTau Label] {s1 s2 s3 : State} (lts : Lts State Label) (h1 : s1 ≈[lts] s2) (h2 : s2 ≈[lts] s3) : s1 ≈[lts] s3 := by obtain ⟨r1, hr1, hr1b⟩ := h1 obtain ⟨r2, hr2, hr2b⟩ := h2 @@ -1230,13 +1230,13 @@ theorem WeakBisimilarity.trans /-- sw-bisimilarity is transitive. -/ theorem SWBisimilarity.trans - [HasTau Label] {s1 s2 s3 : State} (lts : LTS State Label) (h1 : s1 ≈sw[lts] s2) (h2 : s2 ≈sw[lts] s3) : + [HasTau Label] {s1 s2 s3 : State} (lts : Lts State Label) (h1 : s1 ≈sw[lts] s2) (h2 : s2 ≈sw[lts] s3) : s1 ≈sw[lts] s3 := by rw [← (WeakBisimilarity.weakBisim_eq_swBisim lts)] at * apply WeakBisimilarity.trans lts h1 h2 /-- Weak bisimilarity is an equivalence relation. -/ -theorem WeakBisimilarity.eqv [HasTau Label] {lts : LTS State Label} : +theorem WeakBisimilarity.eqv [HasTau Label] {lts : Lts State Label} : Equivalence (WeakBisimilarity lts) := { refl := WeakBisimilarity.refl lts symm := WeakBisimilarity.symm lts @@ -1244,7 +1244,7 @@ theorem WeakBisimilarity.eqv [HasTau Label] {lts : LTS State Label} : } /-- SW-bisimilarity is an equivalence relation. -/ -theorem SWBisimilarity.eqv [HasTau Label] {lts : LTS State Label} : +theorem SWBisimilarity.eqv [HasTau Label] {lts : Lts State Label} : Equivalence (SWBisimilarity lts) := { refl := SWBisimilarity.refl lts symm := SWBisimilarity.symm lts diff --git a/Cslib/Semantics/LTS/Simulation.lean b/Cslib/Semantics/Lts/Simulation.lean similarity index 88% rename from Cslib/Semantics/LTS/Simulation.lean rename to Cslib/Semantics/Lts/Simulation.lean index e88dc6ce..acd21f7e 100644 --- a/Cslib/Semantics/LTS/Simulation.lean +++ b/Cslib/Semantics/Lts/Simulation.lean @@ -4,23 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.LTS.Basic +import Cslib.Semantics.Lts.Basic import Cslib.Data.Relation /-! # Simulation and Similarity -A simulation is a binary relation on the states of an `LTS`: if two states `s1` and `s2` are +A simulation is a binary relation on the states of an `Lts`: if two states `s1` and `s2` are related by a simulation, then `s2` can mimic all transitions of `s1`. Furthermore, the derivatives reaches through these transitions remain related by the simulation. -Similarity is the largest simulation: given an `LTS`, it relates any two states that are related -by a simulation for that LTS. +Similarity is the largest simulation: given an `Lts`, it relates any two states that are related +by a simulation for that Lts. For an introduction to theory of simulation, we refer to [Sangiorgi2011]. ## Main definitions -- `Simulation lts r`: the relation `r` on the states of the LTS `lts` is a simulation. +- `Simulation lts r`: the relation `r` on the states of the Lts `lts` is a simulation. - `Similarity lts` is the binary relation on the states of `lts` that relates any two states related by some simulation on `lts`. - `SimulationEquiv lts` is the binary relation on the states of `lts` that relates any two states @@ -28,8 +28,8 @@ similar to each other. ## Notations -- `s1 ≤[lts] s2`: the states `s1` and `s2` are similar in the LTS `lts`. -- `s1 ≤≥[lts] s2`: the states `s1` and `s2` are simulation equivalent in the LTS `lts`. +- `s1 ≤[lts] s2`: the states `s1` and `s2` are similar in the Lts `lts`. +- `s1 ≤≥[lts] s2`: the states `s1` and `s2` are simulation equivalent in the Lts `lts`. ## Main statements @@ -41,16 +41,16 @@ universe u v section Simulation -variable {State : Type u} {Label : Type v} (lts : LTS State Label) +variable {State : Type u} {Label : Type v} (lts : Lts State Label) /-- A relation is a simulation if, whenever it relates two states in an lts, any transition originating from the first state is mimicked by a transition from the second state and the reached derivatives are themselves related. -/ -def Simulation (lts : LTS State Label) (r : State → State → Prop) : Prop := +def Simulation (lts : Lts State Label) (r : State → State → Prop) : Prop := ∀ s1 s2, r s1 s2 → ∀ μ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ r s1' s2' /-- Two states are similar if they are related by some simulation. -/ -def Similarity (lts : LTS State Label) : State → State → Prop := +def Similarity (lts : Lts State Label) : State → State → Prop := fun s1 s2 => ∃ r : State → State → Prop, r s1 s2 ∧ Simulation lts r @@ -102,7 +102,7 @@ theorem Similarity.trans (h1 : s1 ≤[lts] s2) (h2 : s2 ≤[lts] s3) : s1 ≤[lt /-- Simulation equivalence relates all states `s1` and `s2` such that `s1 ≤[lts] s2` and `s2 ≤[lts] s1`. -/ -def SimulationEquiv (lts : LTS State Label) : State → State → Prop := +def SimulationEquiv (lts : Lts State Label) : State → State → Prop := fun s1 s2 => s1 ≤[lts] s2 ∧ s2 ≤[lts] s1 @@ -151,7 +151,7 @@ theorem SimulationEquiv.trans {s1 s2 s3 : State} (h1 : s1 ≤≥[lts] s2) (h2 : · apply Simulation.comp lts r2 r1 hr2s hr1s /-- Simulation equivalence is an equivalence relation. -/ -theorem SimulationEquiv.eqv (lts : LTS State Label) : +theorem SimulationEquiv.eqv (lts : Lts State Label) : Equivalence (SimulationEquiv lts) := { refl := SimulationEquiv.refl lts symm := SimulationEquiv.symm lts diff --git a/Cslib/Semantics/LTS/TraceEq.lean b/Cslib/Semantics/Lts/TraceEq.lean similarity index 70% rename from Cslib/Semantics/LTS/TraceEq.lean rename to Cslib/Semantics/Lts/TraceEq.lean index 4e77eef9..1864b5ab 100644 --- a/Cslib/Semantics/LTS/TraceEq.lean +++ b/Cslib/Semantics/Lts/TraceEq.lean @@ -4,17 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.LTS.Basic +import Cslib.Semantics.Lts.Basic import Mathlib.Data.Set.Finite.Basic /-! # Trace Equivalence -Definitions and results on trace equivalence for `LTS`s. +Definitions and results on trace equivalence for `Lts`s. ## Main definitions -- `LTS.traces`: the set of traces of a state. +- `Lts.traces`: the set of traces of a state. - `TraceEq s1 s2`: `s1` and `s2` are trace equivalent, i.e., they have the same sets of traces. ## Notations @@ -24,23 +24,23 @@ Definitions and results on trace equivalence for `LTS`s. ## Main statements - `TraceEq.eqv`: trace equivalence is an equivalence relation (see `Equivalence`). -- `TraceEq.deterministic_sim`: in any deterministic `LTS`, trace equivalence is a simulation. +- `TraceEq.deterministic_sim`: in any deterministic `Lts`, trace equivalence is a simulation. -/ universe u v -variable {State : Type u} {Label : Type v} (lts : LTS State Label) +variable {State : Type u} {Label : Type v} (lts : Lts State Label) /-- The traces of a state `s` is the set of all lists of labels `μs` such that there is a multi-step transition labelled by `μs` originating from `s`. -/ -def LTS.traces (s : State) := { μs : List Label | ∃ s', lts.MTr s μs s' } +def Lts.traces (s : State) := { μs : List Label | ∃ s', lts.MTr s μs s' } /-- If there is a multi-step transition from `s` labelled by `μs`, then `μs` is in the traces of `s`. -/ -theorem LTS.traces_in (s : State) (μs : List Label) (s' : State) (h : lts.MTr s μs s') : +theorem Lts.traces_in (s : State) (μs : List Label) (s' : State) (h : lts.MTr s μs s') : μs ∈ lts.traces s := by - simp [LTS.traces] + simp [Lts.traces] exists s' /-- Two states are trace equivalent if they have the same set of traces. -/ @@ -59,7 +59,7 @@ theorem TraceEq.refl (s : State) : s ~tr[lts] s := by simp only [TraceEq] /-- Trace equivalence is symmetric. -/ -theorem TraceEq.symm (lts : LTS State Label) {s1 s2 : State} (h : s1 ~tr[lts] s2) : +theorem TraceEq.symm (lts : Lts State Label) {s1 s2 : State} (h : s1 ~tr[lts] s2) : s2 ~tr[lts] s1 := by simp only [TraceEq] at h simp only [TraceEq] @@ -74,7 +74,7 @@ theorem TraceEq.trans {s1 s2 s3 : State} (h1 : s1 ~tr[lts] s2) (h2 : s2 ~tr[lts] rw [h1, h2] /-- Trace equivalence is an equivalence relation. -/ -theorem TraceEq.eqv (lts : LTS State Label) : Equivalence (TraceEq lts) := { +theorem TraceEq.eqv (lts : Lts State Label) : Equivalence (TraceEq lts) := { refl := TraceEq.refl lts symm := TraceEq.symm lts trans := TraceEq.trans lts @@ -84,20 +84,20 @@ theorem TraceEq.eqv (lts : LTS State Label) : Equivalence (TraceEq lts) := { instance : Trans (TraceEq lts) (TraceEq lts) (TraceEq lts) where trans := TraceEq.trans lts -/-- In a deterministic LTS, trace equivalence is a simulation. -/ +/-- In a deterministic Lts, trace equivalence is a simulation. -/ theorem TraceEq.deterministic_sim - (lts : LTS State Label) (hdet : lts.Deterministic) (s1 s2 : State) (h : s1 ~tr[lts] s2) : + (lts : Lts State Label) (hdet : lts.Deterministic) (s1 s2 : State) (h : s1 ~tr[lts] s2) : ∀ μ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ s1' ~tr[lts] s2' := by intro μ s1' htr1 - have hmtr1 := LTS.MTr.single lts htr1 + have hmtr1 := Lts.MTr.single lts htr1 simp [TraceEq] at h - have hin := LTS.traces_in lts s1 [μ] s1' hmtr1 + have hin := Lts.traces_in lts s1 [μ] s1' hmtr1 rw [h] at hin obtain ⟨s2', hmtr2⟩ := hin exists s2' constructor - · apply LTS.MTr.single_invert lts _ _ _ hmtr2 - · simp only [TraceEq, LTS.traces] + · apply Lts.MTr.single_invert lts _ _ _ hmtr2 + · simp only [TraceEq, Lts.traces] funext μs' simp only [eq_iff_iff] simp only [setOf] @@ -105,30 +105,30 @@ theorem TraceEq.deterministic_sim case mp => intro hmtr1' obtain ⟨s1'', hmtr1'⟩ := hmtr1' - have hmtr1comp := LTS.MTr.comp lts hmtr1 hmtr1' - have hin := LTS.traces_in lts s1 ([μ] ++ μs') s1'' hmtr1comp + have hmtr1comp := Lts.MTr.comp lts hmtr1 hmtr1' + have hin := Lts.traces_in lts s1 ([μ] ++ μs') s1'' hmtr1comp rw [h] at hin - simp [LTS.traces] at hin + simp [Lts.traces] at hin obtain ⟨s', hmtr2'⟩ := hin cases hmtr2' case stepL s2'' htr2 hmtr2' => exists s' - have htr2' := LTS.MTr.single_invert lts _ _ _ hmtr2 + have htr2' := Lts.MTr.single_invert lts _ _ _ hmtr2 have hdets2 := hdet s2 μ s2' s2'' htr2' htr2 rw [hdets2] exact hmtr2' case mpr => intro hmtr2' obtain ⟨s2'', hmtr2'⟩ := hmtr2' - have hmtr2comp := LTS.MTr.comp lts hmtr2 hmtr2' - have hin := LTS.traces_in lts s2 ([μ] ++ μs') s2'' hmtr2comp + have hmtr2comp := Lts.MTr.comp lts hmtr2 hmtr2' + have hin := Lts.traces_in lts s2 ([μ] ++ μs') s2'' hmtr2comp rw [← h] at hin - simp [LTS.traces] at hin + simp [Lts.traces] at hin obtain ⟨s', hmtr1'⟩ := hin cases hmtr1' case stepL s1'' htr1 hmtr1' => exists s' - have htr1' := LTS.MTr.single_invert lts _ _ _ hmtr1 + have htr1' := Lts.MTr.single_invert lts _ _ _ hmtr1 have hdets1 := hdet s1 μ s1' s1'' htr1' htr1 rw [hdets1] exact hmtr1' diff --git a/CslibTests/Bisimulation.lean b/CslibTests/Bisimulation.lean index ca68989c..cb2ac965 100644 --- a/CslibTests/Bisimulation.lean +++ b/CslibTests/Bisimulation.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.LTS.Bisimulation +import Cslib.Semantics.Lts.Bisimulation /- An LTS with two bisimilar states. -/ private inductive tr1 : ℕ → Char → ℕ → Prop where @@ -17,7 +17,7 @@ private inductive tr1 : ℕ → Char → ℕ → Prop where | six2seven : tr1 6 'b' 7 | six2eight : tr1 6 'c' 8 -def lts1 := LTS.mk tr1 +def lts1 := Lts.mk tr1 private inductive Bisim15 : ℕ → ℕ → Prop where | oneFive : Bisim15 1 5 @@ -51,8 +51,8 @@ example : 1 ~[lts1] 5 := by -- (add simp Bisimulation) -- (add safe constructors Bisim15) -- (add safe cases Bisim15) - -- (add safe cases [LTS.mtr]) - -- (add simp LTS.tr) + -- (add safe cases [Lts.mtr]) + -- (add simp Lts.tr) -- (add safe constructors tr1) -- (add unsafe apply Bisimulation.follow_fst) -- (add unsafe apply Bisimulation.follow_snd) diff --git a/CslibTests/LTS.lean b/CslibTests/LTS.lean index 78904276..e74cfebc 100644 --- a/CslibTests/LTS.lean +++ b/CslibTests/LTS.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.LTS.Basic -import Cslib.Semantics.LTS.Bisimulation +import Cslib.Semantics.Lts.Basic +import Cslib.Semantics.Lts.Bisimulation import Mathlib.Algebra.Group.Even import Mathlib.Algebra.Ring.Parity @@ -21,7 +21,7 @@ theorem NatTr.dom : NatTr n μ m → (n = 1 ∨ n = 2) ∧ (m = 1 ∨ m = 2) := intro h cases h <;> simp -def natLts : LTS ℕ ℕ := ⟨NatTr⟩ +def natLts : Lts ℕ ℕ := ⟨NatTr⟩ inductive NatBisim : ℕ → ℕ → Prop where | one_one : NatBisim 1 1 @@ -51,39 +51,39 @@ instance : HasTau TLabel := { inductive NatDivergentTr : ℕ → TLabel → ℕ → Prop where | step : NatDivergentTr n τ n.succ -def natDivLts : LTS ℕ TLabel := ⟨NatDivergentTr⟩ +def natDivLts : Lts ℕ TLabel := ⟨NatDivergentTr⟩ def natInfiniteExecution : Stream' ℕ := fun n => n theorem natInfiniteExecution.infiniteExecution : natDivLts.DivergentExecution natInfiniteExecution := by - simp [LTS.DivergentExecution] + simp [Lts.DivergentExecution] intro n constructor example : natDivLts.Divergent 0 := by - simp [LTS.Divergent] + simp [Lts.Divergent] exists natInfiniteExecution constructor; constructor exact natInfiniteExecution.infiniteExecution example : natDivLts.Divergent 3 := by - simp [LTS.Divergent] + simp [Lts.Divergent] exists natInfiniteExecution.drop 3 simp [Stream'.drop] constructor · constructor - · simp [LTS.DivergentExecution] + · simp [Lts.DivergentExecution] simp [Stream'.drop] intro n constructor example : natDivLts.Divergent n := by - simp [LTS.Divergent] + simp [Lts.Divergent] exists natInfiniteExecution.drop n simp [Stream'.drop] constructor · constructor - · apply LTS.divergent_drop + · apply Lts.divergent_drop exact natInfiniteExecution.infiniteExecution -- check that notation works From 90d312d17f75168e1c64bf90b4440082b30aabb1 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sun, 27 Jul 2025 14:18:27 +0200 Subject: [PATCH 028/107] checkout before checking toolchains --- .github/workflows/lean_action_ci.yml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/.github/workflows/lean_action_ci.yml b/.github/workflows/lean_action_ci.yml index 2c96e1ed..d6274ad1 100644 --- a/.github/workflows/lean_action_ci.yml +++ b/.github/workflows/lean_action_ci.yml @@ -6,6 +6,11 @@ on: workflow_dispatch: jobs: + checkout: + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v4 + check-toolchains: runs-on: ubuntu-latest steps: @@ -15,7 +20,5 @@ jobs: build: runs-on: ubuntu-latest - steps: - - uses: actions/checkout@v4 - uses: leanprover/lean-action@v1 From 02ab4e85d585edc4cfa6c52b69ffc95623c4d96e Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sun, 27 Jul 2025 14:19:43 +0200 Subject: [PATCH 029/107] checkout in the same job --- .github/workflows/lean_action_ci.yml | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/.github/workflows/lean_action_ci.yml b/.github/workflows/lean_action_ci.yml index d6274ad1..dd55a9f3 100644 --- a/.github/workflows/lean_action_ci.yml +++ b/.github/workflows/lean_action_ci.yml @@ -6,19 +6,11 @@ on: workflow_dispatch: jobs: - checkout: + build: runs-on: ubuntu-latest steps: - uses: actions/checkout@v4 - - check-toolchains: - runs-on: ubuntu-latest - steps: - run: | set -e cmp -s lean-toolchain docs/lean-toolchain - - build: - runs-on: ubuntu-latest - steps: - uses: leanprover/lean-action@v1 From d034d8c6c2b98ffbaac6741c3d01053ef1a3cad0 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Sun, 27 Jul 2025 15:49:30 +0200 Subject: [PATCH 030/107] remove useless parens --- Cslib/Semantics/Lts/Bisimulation.lean | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Cslib/Semantics/Lts/Bisimulation.lean b/Cslib/Semantics/Lts/Bisimulation.lean index b78be41c..2bf519d4 100644 --- a/Cslib/Semantics/Lts/Bisimulation.lean +++ b/Cslib/Semantics/Lts/Bisimulation.lean @@ -8,6 +8,7 @@ import Cslib.Semantics.Lts.Basic import Cslib.Semantics.Lts.TraceEq import Cslib.Data.Relation import Cslib.Semantics.Lts.Simulation +import Mathlib.Order.CompleteLattice.Defs /-! # Bisimulation and Bisimilarity @@ -309,11 +310,11 @@ section Order /-! ## Order properties -/ -noncomputable instance : Max ({r // Bisimulation lts r}) where +noncomputable instance : Max {r // Bisimulation lts r} where max r s := ⟨r.1 ⊔ s.1, Bisimulation.union lts r.2 s.2⟩ /-- Bisimulations equipped with union form a join-semilattice. -/ -noncomputable instance : SemilatticeSup ({r // Bisimulation lts r}) where +noncomputable instance : SemilatticeSup {r // Bisimulation lts r} where sup r s := r ⊔ s le_sup_left r s := by simp only [LE.le] @@ -348,7 +349,7 @@ theorem Bisimulation.emptyRelation_bisimulation : Bisimulation lts emptyRelation - The empty relation is the bottom element. - Bisimilarity is the top element. -/ -instance : BoundedOrder ({r // Bisimulation lts r}) where +instance : BoundedOrder {r // Bisimulation lts r} where top := ⟨Bisimilarity lts, Bisimilarity.is_bisimulation lts⟩ bot := ⟨emptyRelation, Bisimulation.emptyRelation_bisimulation lts⟩ le_top r := by From 9ab1bc045bc0284e5d61a2b892fd31f6f0a40c1b Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 28 Jul 2025 08:11:12 +0200 Subject: [PATCH 031/107] Class for well-formedness. (#22) --- Cslib/Syntax/HasWellFormed.lean | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 Cslib/Syntax/HasWellFormed.lean diff --git a/Cslib/Syntax/HasWellFormed.lean b/Cslib/Syntax/HasWellFormed.lean new file mode 100644 index 00000000..b2f33d2f --- /dev/null +++ b/Cslib/Syntax/HasWellFormed.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2025 Fabrizio Montesi. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Fabrizio Montesi +-/ + +/-- Typeclass for types equipped with a well-formedness predicate. -/ +class HasWellFormed (α : Type _) where + /-- Establishes whether `x` is well-formed. -/ + wf (x : α) : Prop + +/-- Notation for well-formedness. -/ +notation x:max "✓" => HasWellFormed.wf x From 9e7409685b8c93eb6133c9a26382eef69294dc55 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 28 Jul 2025 15:12:35 +0200 Subject: [PATCH 032/107] dep bumps --- Cslib/Data/HasFresh.lean | 13 ++++++------- docs/lean-toolchain | 2 +- lake-manifest.json | 16 ++++++++-------- lakefile.toml | 2 +- lean-toolchain | 2 +- 5 files changed, 17 insertions(+), 18 deletions(-) diff --git a/Cslib/Data/HasFresh.lean b/Cslib/Data/HasFresh.lean index 7d9707fd..f4ee9af5 100644 --- a/Cslib/Data/HasFresh.lean +++ b/Cslib/Data/HasFresh.lean @@ -15,7 +15,8 @@ import Mathlib.Order.SuccPred.WithBot universe u -/-- 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. -/ +/-- 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 /-- Given a finite set, returns an element not in the set. -/ fresh : Finset α → α @@ -24,15 +25,13 @@ class HasFresh (α : Type u) where attribute [simp] HasFresh.fresh_notMem -/-- An existential version of the `HasFresh` typeclass. This is useful for the sake of brevity in proofs. -/ -theorem HasFresh.fresh_exists {α : Type u} [HasFresh α] (s : Finset α) : ∃ a, a ∉ s := ⟨fresh s, fresh_notMem s⟩ +/-- An existential version of the `HasFresh` typeclass. This is useful for the sake of brevity +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) -lemma WithBot.lt_succ {α : Type u} [Preorder α] [OrderBot α] [SuccOrder α] [NoMaxOrder α] - (x : WithBot α) : x < x.succ := - succ_eq_succ x ▸ Order.lt_succ x - open Finset in /-- Construct a fresh element from an embedding of `ℕ` using `Nat.find`. -/ def HasFresh.ofNatEmbed {α : Type u} [DecidableEq α] (e : ℕ ↪ α) : HasFresh α where diff --git a/docs/lean-toolchain b/docs/lean-toolchain index 28f76d10..8ce10238 100644 --- a/docs/lean-toolchain +++ b/docs/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.22.0-rc3 \ No newline at end of file +leanprover/lean4:v4.22.0-rc4 \ No newline at end of file diff --git a/lake-manifest.json b/lake-manifest.json index 1de4cb23..8cc16931 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -5,17 +5,17 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "19f4ef2c52b278bd96626e02d594751e6e12ac98", + "rev": "928758ac3743dc7f171fc66f450506723896f1c5", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.22.0-rc3", + "inputRev": "v4.22.0-rc4", "inherited": false, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/plausible", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "61c44bec841faabd47d11c2eda15f57ec2ffe9d5", + "rev": "c37191eba2da78393070da8c4367689d8c4276e4", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -35,7 +35,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "140dc642f4f29944abcdcd3096e8ea9b4469c873", + "rev": "4241928fd3ebae83a037a253e39d9b773e34c3b4", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -55,7 +55,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "a62ecd0343a2dcfbcac6d1e8243f5821879c0244", + "rev": "0a136f764a5dfedc4498e93ad8e297cff57ba2fc", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -65,7 +65,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "867d9dc77534341321179c9aa40fceda675c50d4", + "rev": "1ef3dac0f872ca6aaa7d02e015427e06dd0b6195", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -75,7 +75,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "3cabaef23886b82ba46f07018f2786d9496477d6", + "rev": "e96b5eca4fcfe2e0e96a1511a6cd5747515aba82", "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -85,7 +85,7 @@ "type": "git", "subDir": null, "scope": "leanprover", - "rev": "e22ed0883c7d7f9a7e294782b6b137b783715386", + "rev": "c682c91d2d4dd59a7187e2ab977ac25bd1f87329", "name": "Cli", "manifestFile": "lake-manifest.json", "inputRev": "main", diff --git a/lakefile.toml b/lakefile.toml index 8b170180..e693bf44 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -9,7 +9,7 @@ weak.linter.mathlibStandardSet = true [[require]] name = "mathlib" scope = "leanprover-community" -rev = "v4.22.0-rc3" +rev = "v4.22.0-rc4" [[lean_lib]] name = "Cslib" diff --git a/lean-toolchain b/lean-toolchain index 28f76d10..8ce10238 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.22.0-rc3 \ No newline at end of file +leanprover/lean4:v4.22.0-rc4 \ No newline at end of file From 8d44d552e6d9f518619b6ff359433d083d43f987 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 28 Jul 2025 15:15:14 +0200 Subject: [PATCH 033/107] fixes for Rel --- .../LambdaCalculus/Untyped/Named/Basic.lean | 36 ++++++++++--------- Cslib/Syntax/HasAlphaEquiv.lean | 4 +-- 2 files changed, 20 insertions(+), 20 deletions(-) diff --git a/Cslib/Computability/LambdaCalculus/Untyped/Named/Basic.lean b/Cslib/Computability/LambdaCalculus/Untyped/Named/Basic.lean index 516d93e0..0ceb95fd 100644 --- a/Cslib/Computability/LambdaCalculus/Untyped/Named/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/Untyped/Named/Basic.lean @@ -8,7 +8,6 @@ import Cslib.Data.HasFresh import Cslib.Syntax.HasAlphaEquiv import Cslib.Syntax.HasSubstitution import Mathlib.Data.Finset.Basic -import Mathlib.Data.Rel /-! # λ-calculus @@ -28,9 +27,9 @@ namespace LambdaCalculus.Named /-- Syntax of terms. -/ inductive Term (Var : Type u) : Type u where -| var (x : Var) -| abs (x : Var) (m : Term Var) -| app (m n : Term Var) + | var (x : Var) + | abs (x : Var) (m : Term Var) + | app (m n : Term Var) deriving DecidableEq /-- Free variables. -/ @@ -51,11 +50,11 @@ def Term.vars [DecidableEq Var] (m : Term Var) : Finset Var := /-- Capture-avoiding substitution, as an inference system. -/ inductive Term.Subst [DecidableEq Var] : Term Var → Var → Term Var → Term Var → Prop where -| varHit : (var x).Subst x r r -| varMiss : x ≠ y → (var y).Subst x r (var y) -| absShadow : (abs x m).Subst x r (abs x m) -| absIn : x ≠ y → y ∉ r.fv → m.Subst x r m' → (abs y m).Subst x r (abs y m') -| app : m.Subst x r m' → n.Subst x r n' → (app m n).Subst x r (app m' n') + | varHit : (var x).Subst x r r + | varMiss : x ≠ y → (var y).Subst x r (var y) + | absShadow : (abs x m).Subst x r (abs x m) + | absIn : x ≠ y → y ∉ r.fv → m.Subst x r m' → (abs y m).Subst x r (abs y m') + | app : m.Subst x r m' → n.Subst x r n' → (app m n).Subst x r (app m' n') /-- Renaming, or variable substitution. `m.rename x y` renames `x` into `y` in `m`. -/ def Term.rename [DecidableEq Var] (m : Term Var) (x y : Var) : Term Var := @@ -71,11 +70,14 @@ def Term.rename [DecidableEq Var] (m : Term Var) (x y : Var) : Term Var := /-- Renaming preserves size. -/ @[simp] -theorem Term.rename.eq_sizeOf {m : Term Var} {x y : Var} [DecidableEq Var] : sizeOf (m.rename x y) = sizeOf m := by +theorem Term.rename.eq_sizeOf {m : Term Var} {x y : Var} [DecidableEq Var] : + sizeOf (m.rename x y) = sizeOf m := by induction m <;> aesop (add simp [Term.rename]) -/-- Capture-avoiding substitution. `m.subst x r` replaces the free occurrences of variable `x` in `m` with `r`. -/ -def Term.subst [DecidableEq Var] [HasFresh Var] (m : Term Var) (x : Var) (r : Term Var) : Term Var := +/-- Capture-avoiding substitution. `m.subst x r` replaces the free occurrences of variable `x` +in `m` with `r`. -/ +def Term.subst [DecidableEq Var] [HasFresh Var] (m : Term Var) (x : Var) (r : Term Var) : + Term Var := match m with | var y => if y = x then r else var y | abs y m' => @@ -106,10 +108,10 @@ instance instHasSubstitutionTerm [DecidableEq Var] [HasFresh Var] : /-- Contexts. -/ inductive Context (Var : Type u) : Type u where -| hole -| abs (x : Var) (c : Context Var) -| appL (c : Context Var) (m : Term Var) -| appR (m : Term Var) (c : Context Var) + | hole + | abs (x : Var) (c : Context Var) + | appL (c : Context Var) (m : Term Var) + | appR (m : Term Var) (c : Context Var) deriving DecidableEq /-- Replaces the hole in a `Context` with a `Term`. -/ @@ -138,7 +140,7 @@ theorem Context.complete (m : Term Var) : open Term /-- α-equivalence. -/ -inductive Term.AlphaEquiv [DecidableEq Var] : Rel (Term Var) (Term Var) where +inductive Term.AlphaEquiv [DecidableEq Var] : Term Var → Term Var → Prop where -- The α-axiom | ax {m : Term Var} {x y : Var} : y ∉ m.fv → AlphaEquiv (abs x m) (abs y (m.rename x y)) diff --git a/Cslib/Syntax/HasAlphaEquiv.lean b/Cslib/Syntax/HasAlphaEquiv.lean index dd8776b9..3f6d45bc 100644 --- a/Cslib/Syntax/HasAlphaEquiv.lean +++ b/Cslib/Syntax/HasAlphaEquiv.lean @@ -4,11 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Mathlib.Data.Rel - /-- Typeclass for the α-equivalence notation `x =α y`. -/ class HasAlphaEquiv (β : Type u) where /-- α-equivalence relation for type β. -/ - AlphaEquiv : Rel β β + AlphaEquiv : β → β → Prop notation m:max " =α " n:max => HasAlphaEquiv.AlphaEquiv m n From 3abfe9640166fab334e631890f640d8379be191e Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 28 Jul 2025 15:23:59 +0200 Subject: [PATCH 034/107] docgen4 bump --- docs/lakefile.toml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/lakefile.toml b/docs/lakefile.toml index 6bc3df1c..3a78bd4d 100644 --- a/docs/lakefile.toml +++ b/docs/lakefile.toml @@ -6,7 +6,7 @@ buildDir = "." [[require]] scope = "leanprover" name = "doc-gen4" -rev = "v4.21.0-rc3" +rev = "v4.22.0-rc4" [[require]] name = "cslib" From ca10096c5eeda97e36997513333bf276d82d8750 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 28 Jul 2025 15:47:37 +0200 Subject: [PATCH 035/107] Sorry doc(s), you should be ok now --- docs/lake-manifest.json | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/docs/lake-manifest.json b/docs/lake-manifest.json index 413876e1..2921873c 100644 --- a/docs/lake-manifest.json +++ b/docs/lake-manifest.json @@ -12,27 +12,27 @@ "type": "git", "subDir": null, "scope": "leanprover", - "rev": "baed49c0d4851bafe4d3a3bffb2252a603ea990e", + "rev": "ab0dca34de1a12caedcf3f94a10bc9ed303f67da", "name": "«doc-gen4»", "manifestFile": "lake-manifest.json", - "inputRev": "v4.21.0-rc3", + "inputRev": "v4.22.0-rc4", "inherited": false, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/mathlib4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "6455ba8ab6d25ef9f661dc663a524375d3984164", + "rev": "928758ac3743dc7f171fc66f450506723896f1c5", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.21.0-rc3", + "inputRev": "v4.22.0-rc4", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/plausible", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "1603151ac0db4e822908e18094f16acc250acaff", + "rev": "c37191eba2da78393070da8c4367689d8c4276e4", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -52,7 +52,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "e25fe66cf13e902ba550533ef681cc35a9f18dc2", + "rev": "4241928fd3ebae83a037a253e39d9b773e34c3b4", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -62,17 +62,17 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "6980f6ca164de593cb77cd03d8eac549cc444156", + "rev": "96c67159f161fb6bf6ce91a2587232034ac33d7e", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.62", + "inputRev": "v0.0.67", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/aesop", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "f0424862c97fec5bae253f4f1e0ff001f78187c0", + "rev": "0a136f764a5dfedc4498e93ad8e297cff57ba2fc", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -82,7 +82,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "e1d2994e0acdee2f0c03c9d84d28a5df34aa0020", + "rev": "1ef3dac0f872ca6aaa7d02e015427e06dd0b6195", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -92,7 +92,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "08681ddeb7536a50dea8026c6693cb9b07f01717", + "rev": "e96b5eca4fcfe2e0e96a1511a6cd5747515aba82", "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -102,7 +102,7 @@ "type": "git", "subDir": null, "scope": "leanprover", - "rev": "a0abd472348dd725adbb26732e79b26e7e220913", + "rev": "c682c91d2d4dd59a7187e2ab977ac25bd1f87329", "name": "Cli", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -112,7 +112,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "9f94839235c03d3e04aaed60d277a287f9c84873", + "rev": "bb6eb5b25892aa968e9d35f6ef9ca5c6b896c16d", "name": "UnicodeBasic", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -132,7 +132,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "8ba0ef10d178ab95a5d6fe3cfbd586c6ecef2717", + "rev": "b16338c5c66f57ef5510d4334eb6fa4e2c6c8cd8", "name": "MD4Lean", "manifestFile": "lake-manifest.json", "inputRev": "main", From 50e33655cf3fe8e30f571dbff7948e7b21a3979d Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 28 Jul 2025 19:58:00 +0200 Subject: [PATCH 036/107] bib fixes --- Cslib/Semantics/Lts/Basic.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cslib/Semantics/Lts/Basic.lean b/Cslib/Semantics/Lts/Basic.lean index c7a6da9c..0b18e119 100644 --- a/Cslib/Semantics/Lts/Basic.lean +++ b/Cslib/Semantics/Lts/Basic.lean @@ -43,8 +43,8 @@ type of labels is finite. ## References -* [F. Montesi, *Introduction to Choreographies*] [Montesi2023] -* [D. Sangiorgi, *Introduction to Bisimulation and Coinduction*] [Sangiorgi2011] +* [F. Montesi, *Introduction to Choreographies*][Montesi2023] +* [D. Sangiorgi, *Introduction to Bisimulation and Coinduction*][Sangiorgi2011] -/ universe u v From 730a236c53d46d27f7099f3039b11728b44035e1 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 28 Jul 2025 19:58:39 +0200 Subject: [PATCH 037/107] bib fixes --- Cslib/ConcurrencyTheory/CCS/Basic.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cslib/ConcurrencyTheory/CCS/Basic.lean b/Cslib/ConcurrencyTheory/CCS/Basic.lean index 55728185..6bf98345 100644 --- a/Cslib/ConcurrencyTheory/CCS/Basic.lean +++ b/Cslib/ConcurrencyTheory/CCS/Basic.lean @@ -19,8 +19,8 @@ option of constant definitions (K = P). ## References -* [R. Milner, *A Calculus of Communicating Systems*] [Milner80] -* [D. Sangiorgi, *Introduction to Bisimulation and Coinduction*] [Sangiorgi2011] +* [R. Milner, *A Calculus of Communicating Systems*][Milner80] +* [D. Sangiorgi, *Introduction to Bisimulation and Coinduction*][Sangiorgi2011] -/ variable (Name : Type u) (Constant : Type v) From ae0207a5dfd25fc286aa38b50df5ebdf3462ca79 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 28 Jul 2025 21:02:10 +0200 Subject: [PATCH 038/107] fix links --- .../LambdaCalculus/Untyped/LocallyNameless/Basic.lean | 8 ++++---- .../Computability/LambdaCalculus/Untyped/Named/Basic.lean | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean index 646cae50..5f831b3b 100644 --- a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean @@ -14,8 +14,8 @@ The untyped λ-calculus, with a locally nameless representation of syntax. ## References -* [A. Chargueraud, *The Locally Nameless Representation*] [Chargueraud2012] -* See also https://www.cis.upenn.edu/~plclub/popl08-tutorial/code/, from which +* [A. Chargueraud, *The Locally Nameless Representation*][Chargueraud2012] +* See also , from which this is partially adapted -/ @@ -46,7 +46,7 @@ def openRec (i : ℕ) (sub : Term Var) : Term Var → Term Var | app l r => app (openRec i sub l) (openRec i sub r) | abs M => abs $ openRec (i+1) sub M -scoped notation:68 e "⟦" i " ↝ " sub "⟧"=> Term.openRec i sub e +scoped notation:68 e "⟦" i " ↝ " sub "⟧"=> Term.openRec i sub e @[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] lemma openRec_bvar : (bvar i')⟦i ↝ s⟧ = if i = i' then s else bvar i' := by rfl @@ -72,7 +72,7 @@ def closeRec (k : ℕ) (x : Var) : Term Var → Term Var | app l r => app (closeRec k x l) (closeRec k x r) | abs t => abs $ closeRec (k+1) x t -scoped notation:68 e "⟦" k " ↜ " x "⟧"=> Term.closeRec k x e +scoped notation:68 e "⟦" k " ↜ " x "⟧"=> Term.closeRec k x e variable {x : Var} diff --git a/Cslib/Computability/LambdaCalculus/Untyped/Named/Basic.lean b/Cslib/Computability/LambdaCalculus/Untyped/Named/Basic.lean index 0ceb95fd..a18d457e 100644 --- a/Cslib/Computability/LambdaCalculus/Untyped/Named/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/Untyped/Named/Basic.lean @@ -15,7 +15,7 @@ The untyped λ-calculus. ## References -* [H. Barendregt, *Introduction to Lambda Calculus*] [Barendregt1984] +* [H. Barendregt, *Introduction to Lambda Calculus*][Barendregt1984] -/ From bcf793829d933fe67f5e35707f93a0efcf22b50d Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 28 Jul 2025 21:08:50 +0200 Subject: [PATCH 039/107] grind is awesome --- .../CCS/BehaviouralTheory.lean | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean index 42b87684..b1f8fc3b 100644 --- a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean +++ b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean @@ -33,7 +33,8 @@ private inductive ParNil : (Process Name Constant) → (Process Name Constant) | parNil : ParNil (par p nil) p /-- P | 𝟎 ~ P -/ -theorem bisimilarity_par_nil (p : Process Name Constant) : (par p nil) ~[@lts Name Constant defs] p := by +@[simp, grind] +theorem bisimilarity_par_nil : (par p nil) ~[@lts Name Constant defs] p := by exists ParNil constructor; constructor simp only [Bisimulation] @@ -64,7 +65,8 @@ private inductive ParComm : (Process Name Constant) → (Process Name Constant) | parComm : ParComm (par p q) (par q p) /-- P | Q ~ Q | P -/ -theorem bisimilarity_par_comm (p q : Process Name Constant) : (par p q) ~[@lts Name Constant defs] (par q p) := by +@[grind] +theorem bisimilarity_par_comm : (par p q) ~[@lts Name Constant defs] (par q p) := by exists ParComm constructor case left => @@ -93,7 +95,7 @@ theorem bisimilarity_par_comm (p q : Process Name Constant) : (par p q) ~[@lts N constructor · rw [← Act.co.involution Name μ] at htrp apply Tr.com htrq htrp - . constructor + · constructor case right => intro t htr cases htr @@ -112,7 +114,14 @@ theorem bisimilarity_par_comm (p q : Process Name Constant) : (par p q) ~[@lts N constructor · rw [← Act.co.involution Name μ] at htrp apply Tr.com htrq htrp - . constructor + · constructor + +/-- 𝟎 | P ~ P -/ +@[simp, grind] +theorem bisimilarity_nil_par : (par nil p) ~[@lts Name Constant defs] p := + calc + (par nil p) ~[@lts Name Constant defs] (par p nil) := by grind + _ ~[@lts Name Constant defs] p := by simp private inductive ChoiceComm : (Process Name Constant) → (Process Name Constant) → Prop where | choiceComm : ChoiceComm (choice p q) (choice q p) From eb8ac4bb9764f4a4c93e36323a3a5948fd68b896 Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Wed, 30 Jul 2025 01:59:47 -0400 Subject: [PATCH 040/107] Use parent namespace in lts and reduction_sys attributes (#24) * Use parent namespace in lts and reduction_sys attributes * tests --- Cslib/Semantics/Lts/Basic.lean | 2 ++ Cslib/Semantics/ReductionSystem/Basic.lean | 2 ++ CslibTests/{LTS.lean => Lts.lean} | 14 ++++++++++++++ CslibTests/ReductionSystem.lean | 14 ++++++++++++++ 4 files changed, 32 insertions(+) rename CslibTests/{LTS.lean => Lts.lean} (90%) diff --git a/Cslib/Semantics/Lts/Basic.lean b/Cslib/Semantics/Lts/Basic.lean index 0b18e119..05ff45bc 100644 --- a/Cslib/Semantics/Lts/Basic.lean +++ b/Cslib/Semantics/Lts/Basic.lean @@ -671,9 +671,11 @@ initialize Lean.registerBuiltinAttribute { add := fun decl stx _ => MetaM.run' do match stx with | `(attr | lts $lts $sym) => + let lts := lts.getId.updatePrefix decl.getPrefix |> Lean.mkIdent liftCommandElabM <| Command.elabCommand (← `(create_lts $(mkIdent decl) $lts)) liftCommandElabM <| Command.elabCommand (← `(lts_transition_notation $lts $sym)) | `(attr | lts $lts) => + let lts := lts.getId.updatePrefix decl.getPrefix |> Lean.mkIdent liftCommandElabM <| Command.elabCommand (← `(create_lts $(mkIdent decl) $lts)) liftCommandElabM <| Command.elabCommand (← `(lts_transition_notation $lts)) | _ => throwError "invalid syntax for 'lts' attribute" diff --git a/Cslib/Semantics/ReductionSystem/Basic.lean b/Cslib/Semantics/ReductionSystem/Basic.lean index 98950bd5..9f6c935c 100644 --- a/Cslib/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Semantics/ReductionSystem/Basic.lean @@ -132,9 +132,11 @@ initialize Lean.registerBuiltinAttribute { add := fun decl stx _ => MetaM.run' do match stx with | `(attr | reduction_sys $rs $sym) => + let rs := rs.getId.updatePrefix decl.getPrefix |> Lean.mkIdent liftCommandElabM <| Command.elabCommand (← `(create_reduction_sys $(mkIdent decl) $rs)) liftCommandElabM <| Command.elabCommand (← `(reduction_notation $rs $sym)) | `(attr | reduction_sys $rs) => + let rs := rs.getId.updatePrefix decl.getPrefix |> Lean.mkIdent liftCommandElabM <| Command.elabCommand (← `(create_reduction_sys $(mkIdent decl) $rs)) liftCommandElabM <| Command.elabCommand (← `(reduction_notation $rs)) | _ => throwError "invalid syntax for 'reduction_sys' attribute" diff --git a/CslibTests/LTS.lean b/CslibTests/Lts.lean similarity index 90% rename from CslibTests/LTS.lean rename to CslibTests/Lts.lean index e74cfebc..275f247d 100644 --- a/CslibTests/LTS.lean +++ b/CslibTests/Lts.lean @@ -101,3 +101,17 @@ attribute [lts cannonical_lts] labelled_transition example (a b : Term) (μ : Label) : a [μ]⭢ b := by change labelled_transition a μ b simp + +--check that namespaces are respected +namespace foo +@[lts namespaced_lts] +def bar (_ _ _ : ℕ) : Prop := True +end foo + +/-- info: foo.bar : ℕ → ℕ → ℕ → Prop -/ +#guard_msgs in +#check foo.bar + +/-- info: foo.namespaced_lts : Lts ℕ ℕ -/ +#guard_msgs in +#check foo.namespaced_lts diff --git a/CslibTests/ReductionSystem.lean b/CslibTests/ReductionSystem.lean index f31e6342..1e6ccb63 100644 --- a/CslibTests/ReductionSystem.lean +++ b/CslibTests/ReductionSystem.lean @@ -36,3 +36,17 @@ attribute [reduction_sys cannonical_rs] PredReduction example : 5 ⭢ 4 := by change PredReduction _ _ simp + +--check that namespaces are respected +namespace foo +@[reduction_sys namespaced_rs] +def bar (_ _ : ℕ) : Prop := True +end foo + +/-- info: foo.bar : ℕ → ℕ → Prop -/ +#guard_msgs in +#check foo.bar + +/-- info: foo.namespaced_rs : ReductionSystem ℕ -/ +#guard_msgs in +#check foo.namespaced_rs From 56fdfeb1b4e9989fa76b83062f004f2291061219 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 30 Jul 2025 16:37:02 +0200 Subject: [PATCH 041/107] try fixing the linter action --- .github/workflows/lean_lint_suggest.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/lean_lint_suggest.yml b/.github/workflows/lean_lint_suggest.yml index 6f83ca22..0d854515 100644 --- a/.github/workflows/lean_lint_suggest.yml +++ b/.github/workflows/lean_lint_suggest.yml @@ -5,7 +5,6 @@ name: Lint and suggest jobs: lint: - if: github.repository == 'cs-lean/cslib' && github.event.pull_request.draft == false runs-on: ubuntu-latest steps: - uses: leanprover-community/lint-style-action From 8369ceb5b190768559759bdf6954b2f0ab7e3d05 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 30 Jul 2025 16:56:20 +0200 Subject: [PATCH 042/107] fix linting action --- .github/workflows/lean_lint_suggest.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/lean_lint_suggest.yml b/.github/workflows/lean_lint_suggest.yml index 0d854515..91c55f8a 100644 --- a/.github/workflows/lean_lint_suggest.yml +++ b/.github/workflows/lean_lint_suggest.yml @@ -5,8 +5,9 @@ name: Lint and suggest jobs: lint: + if: github.repository == 'cs-lean/cslib' && github.event.pull_request.draft == false runs-on: ubuntu-latest steps: - - uses: leanprover-community/lint-style-action + - uses: leanprover-community/lint-style-action@main with: mode: suggest \ No newline at end of file From d5fd4e28669056180ffe973bb06d5f8f20b23b17 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 28 Jul 2025 08:20:26 +0200 Subject: [PATCH 043/107] begin parassoc --- .../CCS/BehaviouralTheory.lean | 59 +++++++++++++++---- 1 file changed, 48 insertions(+), 11 deletions(-) diff --git a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean index b1f8fc3b..70bc6fc1 100644 --- a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean +++ b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean @@ -33,7 +33,6 @@ private inductive ParNil : (Process Name Constant) → (Process Name Constant) | parNil : ParNil (par p nil) p /-- P | 𝟎 ~ P -/ -@[simp, grind] theorem bisimilarity_par_nil : (par p nil) ~[@lts Name Constant defs] p := by exists ParNil constructor; constructor @@ -65,7 +64,6 @@ private inductive ParComm : (Process Name Constant) → (Process Name Constant) | parComm : ParComm (par p q) (par q p) /-- P | Q ~ Q | P -/ -@[grind] theorem bisimilarity_par_comm : (par p q) ~[@lts Name Constant defs] (par q p) := by exists ParComm constructor @@ -116,12 +114,48 @@ theorem bisimilarity_par_comm : (par p q) ~[@lts Name Constant defs] (par q p) : apply Tr.com htrq htrp · constructor -/-- 𝟎 | P ~ P -/ -@[simp, grind] -theorem bisimilarity_nil_par : (par nil p) ~[@lts Name Constant defs] p := - calc - (par nil p) ~[@lts Name Constant defs] (par p nil) := by grind - _ ~[@lts Name Constant defs] p := by simp +private inductive ParAssoc : (Process Name Constant) → (Process Name Constant) → Prop where +| parAssoc : ParAssoc (par p (par q r)) (par (par p q) r) + +attribute [local grind] CCS.Tr +attribute [local grind cases] ParAssoc +attribute [local grind] ParAssoc +attribute [local grind <=] CCS.Tr.parL CCS.Tr.parR CCS.Tr.com + +/-- P | (Q | R) ~ (P | Q) | R -/ +theorem bisimilarity_par_assoc : + (par p (par q r)) ~[@lts Name Constant defs] (par (par p q) r) := by + exists ParAssoc + constructor + case left => + constructor + case right => + intro s1 s2 hr μ + cases hr + case parAssoc p q r => + constructor + case left => + intro s1' htr + cases htr + case parL p q p' htr' => + exists (par (par p' q) r) + -- grind + -- aesop + -- (add safe constructors Tr) (add safe apply Tr.parL) (add safe constructors ParAssoc) + constructor + case left => + aesop (add unsafe constructors Tr) + + -- repeat apply Tr.parL + -- assumption + -- case right => + -- constructor + case parR p q qr' htr' => + cases htr' + + + + private inductive ChoiceComm : (Process Name Constant) → (Process Name Constant) → Prop where | choiceComm : ChoiceComm (choice p q) (choice q p) @@ -180,7 +214,8 @@ private inductive PreBisim : (Process Name Constant) → (Process Name Constant) | bisim : (p ~[@lts Name Constant defs] q) → PreBisim p q /-- P ~ Q → μ.P ~ μ.Q -/ -theorem bisimilarity_congr_pre : (p ~[@lts Name Constant defs] q) → (pre μ p) ~[@lts Name Constant defs] (pre μ q) := by +theorem bisimilarity_congr_pre : + (p ~[@lts Name Constant defs] q) → (pre μ p) ~[@lts Name Constant defs] (pre μ q) := by intro hpq exists @PreBisim _ _ defs constructor; constructor; assumption @@ -231,7 +266,8 @@ private inductive ResBisim : (Process Name Constant) → (Process Name Constant) -- | bisim : (p ~[@lts Name Constant defs] q) → ResBisim p q /-- P ~ Q → (ν a) P ~ (ν a) Q -/ -theorem bisimilarity_congr_res : (p ~[@lts Name Constant defs] q) → (res a p) ~[@lts Name Constant defs] (res a q) := by +theorem bisimilarity_congr_res : + (p ~[@lts Name Constant defs] q) → (res a p) ~[@lts Name Constant defs] (res a q) := by intro hpq exists @ResBisim _ _ defs constructor; constructor; assumption @@ -264,7 +300,8 @@ private inductive ChoiceBisim : (Process Name Constant) → (Process Name Consta | bisim : (p ~[@lts Name Constant defs] q) → ChoiceBisim p q /-- P ~ Q → P + R ~ Q + R -/ -theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice p r) ~[@lts Name Constant defs] (choice q r) := by +theorem bisimilarity_congr_choice : + (p ~[@lts Name Constant defs] q) → (choice p r) ~[@lts Name Constant defs] (choice q r) := by intro h exists @ChoiceBisim _ _ defs constructor; constructor; assumption From 49da602d8cc7ba5dfb6ba02cf912c12abd27a2f7 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Thu, 31 Jul 2025 14:35:19 +0200 Subject: [PATCH 044/107] some proof_wanted in CCS --- .../CCS/BehaviouralTheory.lean | 117 +++++++----------- 1 file changed, 48 insertions(+), 69 deletions(-) diff --git a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean index 70bc6fc1..93776744 100644 --- a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean +++ b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean @@ -114,52 +114,21 @@ theorem bisimilarity_par_comm : (par p q) ~[@lts Name Constant defs] (par q p) : apply Tr.com htrq htrp · constructor -private inductive ParAssoc : (Process Name Constant) → (Process Name Constant) → Prop where -| parAssoc : ParAssoc (par p (par q r)) (par (par p q) r) - -attribute [local grind] CCS.Tr -attribute [local grind cases] ParAssoc -attribute [local grind] ParAssoc -attribute [local grind <=] CCS.Tr.parL CCS.Tr.parR CCS.Tr.com - /-- P | (Q | R) ~ (P | Q) | R -/ -theorem bisimilarity_par_assoc : - (par p (par q r)) ~[@lts Name Constant defs] (par (par p q) r) := by - exists ParAssoc - constructor - case left => - constructor - case right => - intro s1 s2 hr μ - cases hr - case parAssoc p q r => - constructor - case left => - intro s1' htr - cases htr - case parL p q p' htr' => - exists (par (par p' q) r) - -- grind - -- aesop - -- (add safe constructors Tr) (add safe apply Tr.parL) (add safe constructors ParAssoc) - constructor - case left => - aesop (add unsafe constructors Tr) - - -- repeat apply Tr.parL - -- assumption - -- case right => - -- constructor - case parR p q qr' htr' => - cases htr' - - +proof_wanted bisimilarity_par_assoc : + (par p (par q r)) ~[@lts Name Constant defs] (par (par p q) r) +/-- P + 𝟎 ~ P -/ +proof_wanted bisimilarity_choice_nil : + (choice p nil) ~[@lts Name Constant defs] p +/-- P + P ~ P -/ +proof_wanted bisimilarity_choice_idem : + (choice p p) ~[@lts Name Constant defs] p private inductive ChoiceComm : (Process Name Constant) → (Process Name Constant) → Prop where -| choiceComm : ChoiceComm (choice p q) (choice q p) -| bisim : (p ~[@lts Name Constant defs] q) → ChoiceComm p q + | choiceComm : ChoiceComm (choice p q) (choice q p) + | bisim : (p ~[@lts Name Constant defs] q) → ChoiceComm p q /-- P + Q ~ Q + P -/ theorem bisimilarity_choice_comm : (choice p q) ~[@lts Name Constant defs] (choice q p) := by @@ -168,30 +137,31 @@ theorem bisimilarity_choice_comm : (choice p q) ~[@lts Name Constant defs] (choi simp only [Bisimulation] intro s1 s2 hr μ cases hr - rename_i p q - constructor - case left => - intro s1' htr - exists s1' + case choiceComm => + rename_i p q constructor - · cases htr - · apply Tr.choiceR - assumption - · apply Tr.choiceL - assumption - · constructor - apply Bisimilarity.refl (@lts _ _ defs) s1' - case right => - intro s1' htr - exists s1' - constructor - · cases htr - · apply Tr.choiceR - assumption - · apply Tr.choiceL - assumption - · constructor - apply Bisimilarity.refl (@lts _ _ defs) s1' + case left => + intro s1' htr + exists s1' + constructor + · cases htr + · apply Tr.choiceR + assumption + · apply Tr.choiceL + assumption + · constructor + apply Bisimilarity.refl (@lts _ _ defs) s1' + case right => + intro s1' htr + exists s1' + constructor + · cases htr + · apply Tr.choiceR + assumption + · apply Tr.choiceL + assumption + · constructor + apply Bisimilarity.refl (@lts _ _ defs) s1' case bisim h => constructor case left => @@ -209,6 +179,10 @@ theorem bisimilarity_choice_comm : (choice p q) ~[@lts Name Constant defs] (choi apply And.intro htr1 constructor; assumption +/-- P + (Q + R) ~ (P + Q) + R -/ +proof_wanted bisimilarity_choice_assoc : + (choice p (choice q r)) ~[@lts Name Constant defs] (choice (choice p q) r) + private inductive PreBisim : (Process Name Constant) → (Process Name Constant) → Prop where | pre : (p ~[@lts Name Constant defs] q) → PreBisim (pre μ p) (pre μ q) | bisim : (p ~[@lts Name Constant defs] q) → PreBisim p q @@ -218,7 +192,8 @@ theorem bisimilarity_congr_pre : (p ~[@lts Name Constant defs] q) → (pre μ p) ~[@lts Name Constant defs] (pre μ q) := by intro hpq exists @PreBisim _ _ defs - constructor; constructor; assumption + constructor + · constructor; assumption simp only [Bisimulation] intro s1 s2 hr μ' cases hr @@ -270,7 +245,8 @@ theorem bisimilarity_congr_res : (p ~[@lts Name Constant defs] q) → (res a p) ~[@lts Name Constant defs] (res a q) := by intro hpq exists @ResBisim _ _ defs - constructor; constructor; assumption + constructor + · constructor; assumption simp only [Bisimulation] intro s1 s2 hr μ' cases hr @@ -304,7 +280,8 @@ theorem bisimilarity_congr_choice : (p ~[@lts Name Constant defs] q) → (choice p r) ~[@lts Name Constant defs] (choice q r) := by intro h exists @ChoiceBisim _ _ defs - constructor; constructor; assumption + constructor + · constructor; assumption simp only [Bisimulation] intro s1 s2 r μ constructor @@ -331,7 +308,8 @@ theorem bisimilarity_congr_choice : obtain ⟨rel, hr, hb⟩ := hbisim obtain ⟨s2', htr2, hr2⟩ := hb.follow_fst hr htr exists s2' - constructor; assumption + constructor + · assumption constructor apply Bisimilarity.largest_bisimulation _ hb hr2 case right => @@ -370,7 +348,8 @@ theorem bisimilarity_congr_par : (p ~[@lts Name Constant defs] q) → (par p r) ~[@lts Name Constant defs] (par q r) := by intro h exists @ParBisim _ _ defs - constructor; constructor; assumption + constructor + · constructor; assumption simp only [Bisimulation] intro s1 s2 r μ constructor From 276144a6ed946b5b99be019598438e5aaeda3b65 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Thu, 31 Jul 2025 14:48:35 +0200 Subject: [PATCH 045/107] minor move --- Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean index 93776744..74edf1ee 100644 --- a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean +++ b/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean @@ -114,6 +114,13 @@ theorem bisimilarity_par_comm : (par p q) ~[@lts Name Constant defs] (par q p) : apply Tr.com htrq htrp · constructor +/-- 𝟎 | P ~ P -/ +@[simp, grind] +theorem bisimilarity_nil_par : (par nil p) ~[@lts Name Constant defs] p := + calc + (par nil p) ~[@lts Name Constant defs] (par p nil) := by grind + _ ~[@lts Name Constant defs] p := by simp + /-- P | (Q | R) ~ (P | Q) | R -/ proof_wanted bisimilarity_par_assoc : (par p (par q r)) ~[@lts Name Constant defs] (par (par p q) r) From 2a3dbc18509b8d92f8a2859260c3b6950f7e8f2b Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Mon, 4 Aug 2025 04:21:05 -0400 Subject: [PATCH 046/107] use notation3 for Lts and ReductionSystem (#25) * use notation3 * precedence on args, not notation --- Cslib/Semantics/Lts/Basic.lean | 16 ++++++++++------ Cslib/Semantics/ReductionSystem/Basic.lean | 16 ++++++++++------ CslibTests/Lts.lean | 10 ++++++++++ CslibTests/ReductionSystem.lean | 18 ++++++++++++++++++ 4 files changed, 48 insertions(+), 12 deletions(-) diff --git a/Cslib/Semantics/Lts/Basic.lean b/Cslib/Semantics/Lts/Basic.lean index 05ff45bc..d3b1a778 100644 --- a/Cslib/Semantics/Lts/Basic.lean +++ b/Cslib/Semantics/Lts/Basic.lean @@ -10,6 +10,7 @@ import Mathlib.Data.Fintype.Basic import Mathlib.Logic.Function.Defs import Mathlib.Data.Set.Finite.Basic import Mathlib.Data.Stream.Defs +import Mathlib.Util.Notation3 /-! # Labelled Transition System (LTS) @@ -649,21 +650,21 @@ elab "create_lts" lt:ident name:ident : command => do also used this as a constructor name, you will need quotes to access corresponding cases, e.g. «β» in the above example. -/ -syntax "lts_transition_notation" ident (Lean.Parser.Command.notationItem)? : command +syntax "lts_transition_notation" ident (str)? : command macro_rules | `(lts_transition_notation $lts $sym) => `( - notation:39 t "["μ"]⭢"$sym t' => (Lts.Tr.toRelation $lts μ) t t' - notation:39 t "["μs"]↠"$sym t' => (Lts.MTr.toRelation $lts μs) t t' + notation3 t:39 "["μ"]⭢" $sym:str t':39 => (Lts.Tr.toRelation $lts μ) t t' + notation3 t:39 "["μs"]↠" $sym:str t':39 => (Lts.MTr.toRelation $lts μs) t t' ) | `(lts_transition_notation $lts) => `( - notation:39 t "["μ"]⭢" t' => (Lts.Tr.toRelation $lts μ) t t' - notation:39 t "["μs"]↠" t' => (Lts.MTr.toRelation $lts μs) t t' + notation3 t:39 "["μ"]⭢" t':39 => (Lts.Tr.toRelation $lts μ) t t' + notation3 t:39 "["μs"]↠" t':39 => (Lts.MTr.toRelation $lts μs) t t' ) /-- This attribute calls the `lts_transition_notation` command for the annotated declaration. -/ -syntax (name := lts_attr) "lts" ident (Lean.Parser.Command.notationItem)? : attr +syntax (name := lts_attr) "lts" ident (ppSpace str)? : attr initialize Lean.registerBuiltinAttribute { name := `lts_attr @@ -671,6 +672,9 @@ initialize Lean.registerBuiltinAttribute { add := fun decl stx _ => MetaM.run' do match stx with | `(attr | lts $lts $sym) => + let mut sym := sym + unless sym.getString.endsWith " " do + sym := Syntax.mkStrLit (sym.getString ++ " ") let lts := lts.getId.updatePrefix decl.getPrefix |> Lean.mkIdent liftCommandElabM <| Command.elabCommand (← `(create_lts $(mkIdent decl) $lts)) liftCommandElabM <| Command.elabCommand (← `(lts_transition_notation $lts $sym)) diff --git a/Cslib/Semantics/ReductionSystem/Basic.lean b/Cslib/Semantics/ReductionSystem/Basic.lean index 9f6c935c..a7e555c8 100644 --- a/Cslib/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Semantics/ReductionSystem/Basic.lean @@ -5,6 +5,7 @@ Authors: Fabrizio Montesi, Thomas Waring -/ import Mathlib.Logic.Relation +import Mathlib.Util.Notation3 /-! # Reduction System @@ -102,17 +103,17 @@ elab "create_reduction_sys" rel:ident name:ident : command => do also used this as a constructor name, you will need quotes to access corresponding cases, e.g. «β» in the above example. -/ -syntax "reduction_notation" ident (Lean.Parser.Command.notationItem)? : command +syntax "reduction_notation" ident (str)? : command macro_rules | `(reduction_notation $rs $sym) => `( - notation:39 t " ⭢"$sym t' => (ReductionSystem.Red $rs) t t' - notation:39 t " ↠"$sym t' => (ReductionSystem.MRed $rs) t t' + notation3 t:39 " ⭢" $sym:str t':39 => (ReductionSystem.Red $rs) t t' + notation3 t:39 " ↠" $sym:str t':39 => (ReductionSystem.MRed $rs) t t' ) | `(reduction_notation $rs) => `( - notation:39 t " ⭢" t' => (ReductionSystem.Red $rs) t t' - notation:39 t " ↠" t' => (ReductionSystem.MRed $rs) t t' + notation3 t:39 " ⭢" t':39 => (ReductionSystem.Red $rs) t t' + notation3 t:39 " ↠" t':39 => (ReductionSystem.MRed $rs) t t' ) @@ -124,7 +125,7 @@ macro_rules def PredReduction (a b : ℕ) : Prop := a = b + 1 ``` -/ -syntax (name := reduction_sys) "reduction_sys" ident (Lean.Parser.Command.notationItem)? : attr +syntax (name := reduction_sys) "reduction_sys" ident (ppSpace str)? : attr initialize Lean.registerBuiltinAttribute { name := `reduction_sys @@ -132,6 +133,9 @@ initialize Lean.registerBuiltinAttribute { add := fun decl stx _ => MetaM.run' do match stx with | `(attr | reduction_sys $rs $sym) => + let mut sym := sym + unless sym.getString.endsWith " " do + sym := Syntax.mkStrLit (sym.getString ++ " ") let rs := rs.getId.updatePrefix decl.getPrefix |> Lean.mkIdent liftCommandElabM <| Command.elabCommand (← `(create_reduction_sys $(mkIdent decl) $rs)) liftCommandElabM <| Command.elabCommand (← `(reduction_notation $rs $sym)) diff --git a/CslibTests/Lts.lean b/CslibTests/Lts.lean index 275f247d..1c4328d9 100644 --- a/CslibTests/Lts.lean +++ b/CslibTests/Lts.lean @@ -115,3 +115,13 @@ end foo /-- info: foo.namespaced_lts : Lts ℕ ℕ -/ #guard_msgs in #check foo.namespaced_lts + +-- check that delaborators work, including with variables + +/-- info: ∀ (a b : Term) (μ : Label), a[μ]⭢β b : Prop -/ +#guard_msgs in +#check ∀ (a b : Term) (μ : Label), a [μ]⭢β b + +/-- info: ∀ (a b : Term) (μ : Label), a[[μ]]↠β b : Prop -/ +#guard_msgs in +#check ∀ (a b : Term) (μ : Label), a [[μ]]↠β b diff --git a/CslibTests/ReductionSystem.lean b/CslibTests/ReductionSystem.lean index 1e6ccb63..f5c68e22 100644 --- a/CslibTests/ReductionSystem.lean +++ b/CslibTests/ReductionSystem.lean @@ -50,3 +50,21 @@ end foo /-- info: foo.namespaced_rs : ReductionSystem ℕ -/ #guard_msgs in #check foo.namespaced_rs + +-- check that delaborators work, including with variables + +/-- info: ∀ (a b : ℕ), a ⭢ₙ b : Prop -/ +#guard_msgs in +#check ∀ (a b : ℕ), a ⭢ₙ b + +/-- info: ∀ (a b : ℕ), a ↠ₙ b : Prop -/ +#guard_msgs in +#check ∀ (a b : ℕ), a ↠ₙ b + +/-- info: ∀ (a b : Term Var), a ⭢β b : Prop -/ +#guard_msgs in +#check ∀ (a b : Term Var), a ⭢β b + +/-- info: ∀ (a b : Term Var), a ↠β b : Prop -/ +#guard_msgs in +#check ∀ (a b : Term Var), a ↠β b From 01b9d00e1d9eee3878f0054678a48de6e3e117ba Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 4 Aug 2025 10:25:02 +0200 Subject: [PATCH 047/107] fix linting again --- .github/workflows/lean_lint_suggest.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/lean_lint_suggest.yml b/.github/workflows/lean_lint_suggest.yml index 91c55f8a..619136f7 100644 --- a/.github/workflows/lean_lint_suggest.yml +++ b/.github/workflows/lean_lint_suggest.yml @@ -8,6 +8,6 @@ jobs: if: github.repository == 'cs-lean/cslib' && github.event.pull_request.draft == false runs-on: ubuntu-latest steps: - - uses: leanprover-community/lint-style-action@main + - uses: leanprover-community/lint-style-action@f2e7272aad56233a642b08fe974cf09dd664b0c8 # 2025-05-22 (taken from mathlib) with: mode: suggest \ No newline at end of file From 1253ae47e936d61763e11cd31826094f4f6510b3 Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Tue, 5 Aug 2025 04:38:15 -0400 Subject: [PATCH 048/107] Locally nameless STLC (#17) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * first pass at STLC, should consider splitting this file * structure * progress * minimize imports * docs typo * docs * docs * remove redundant lemma * style * style * eliminate private lemma * eliminate private lemma * scope safety theorems * STLC namespace * restructure for clarity * reverse directory structure * paramaterize Ty base a base type * rm unused notation * naming convention * nicer speelling of Ctx.dom * rm terminal refine * style * use Data.List.Sigma * use HasWellFormed notation * Ctx -> Context * no space before ✓ * link/reference formatting * indent inductives * Context name convention * naming conventions * style * naming conventions * style --- .../LocallyNameless/Stlc/Basic.lean | 164 ++++++++++++++++++ .../LocallyNameless/Stlc/Context.lean | 57 ++++++ .../LocallyNameless/Stlc/Safety.lean | 92 ++++++++++ .../Untyped}/AesopRuleset.lean | 0 .../Untyped}/Basic.lean | 9 +- .../Untyped}/FullBeta.lean | 4 +- .../Untyped}/FullBetaConfluence.lean | 6 +- .../Untyped}/Properties.lean | 2 +- .../Named => Named/Untyped}/Basic.lean | 0 CslibTests/LambdaCalculus.lean | 2 +- 10 files changed, 326 insertions(+), 10 deletions(-) create mode 100644 Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean create mode 100644 Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean create mode 100644 Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Safety.lean rename Cslib/Computability/LambdaCalculus/{Untyped/LocallyNameless => LocallyNameless/Untyped}/AesopRuleset.lean (100%) rename Cslib/Computability/LambdaCalculus/{Untyped/LocallyNameless => LocallyNameless/Untyped}/Basic.lean (94%) rename Cslib/Computability/LambdaCalculus/{Untyped/LocallyNameless => LocallyNameless/Untyped}/FullBeta.lean (96%) rename Cslib/Computability/LambdaCalculus/{Untyped/LocallyNameless => LocallyNameless/Untyped}/FullBetaConfluence.lean (97%) rename Cslib/Computability/LambdaCalculus/{Untyped/LocallyNameless => LocallyNameless/Untyped}/Properties.lean (98%) rename Cslib/Computability/LambdaCalculus/{Untyped/Named => Named/Untyped}/Basic.lean (100%) diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean new file mode 100644 index 00000000..94b8f223 --- /dev/null +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2025 Chris Henson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Henson +-/ + +import Cslib.Computability.LambdaCalculus.LocallyNameless.Stlc.Context +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Properties + +/-! # λ-calculus + +The simply typed λ-calculus, with a locally nameless representation of syntax. + +## References + +* [A. Chargueraud, *The Locally Nameless Representation*][Chargueraud2012] +* See also , from which + this is partially adapted + +-/ + +universe u v + +variable {Var : Type u} {Base : Type v} [DecidableEq Var] + +namespace LambdaCalculus.LocallyNameless.Stlc + +/-- Types of the simply typed lambda calculus. -/ +inductive Ty (Base : Type v) + /-- A base type, from a typing context. -/ + | base : Base → Ty Base + /-- A function type. -/ + | arrow : Ty Base → Ty Base → Ty Base + +scoped infixr:70 " ⤳ " => Ty.arrow + +open Term Ty + +/-- An extrinsic typing derivation for locally nameless terms. -/ +@[aesop unsafe [constructors (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])]] +inductive Typing : Context Var (Ty Base) → Term Var → Ty Base → Prop + /-- Free variables, from a context judgement. -/ + | var : Γ✓ → ⟨x,σ⟩ ∈ Γ → Typing Γ (fvar x) σ + /-- Lambda abstraction. -/ + | abs (L : Finset Var) : (∀ x ∉ L, Typing (⟨x,σ⟩ :: Γ) (t ^ fvar x) τ) → Typing Γ t.abs (σ ⤳ τ) + /-- Function application. -/ + | app : Typing Γ t (σ ⤳ τ) → Typing Γ t' σ → Typing Γ (app t t') τ + +scoped notation:50 Γ " ⊢ " t " ∶" τ:arg => Typing Γ t τ + +namespace Typing + +variable {Γ Δ Θ : Context Var (Ty Base)} + +omit [DecidableEq Var] in +/-- Typing is preserved on permuting a context. -/ +theorem perm (ht : Γ ⊢ t ∶τ) (hperm : Γ.Perm Δ) : Δ ⊢ t ∶ τ := by + revert Δ + induction ht <;> intros Δ p + case app => aesop + case var => + have := @p.mem_iff + aesop + case abs ih => + constructor + intros x mem + exact ih x mem (by aesop) + +/-- Weakening of a typing derivation with an appended context. -/ +lemma weaken_aux : + Γ ++ Δ ⊢ t ∶ τ → (Γ ++ Θ ++ Δ)✓ → (Γ ++ Θ ++ Δ) ⊢ t ∶ τ := by + generalize eq : Γ ++ Δ = Γ_Δ + intros h + revert Γ Δ Θ + induction h <;> intros Γ Δ Θ eq ok_Γ_Θ_Δ + case var => aesop + case app => aesop + case abs σ Γ' τ t xs ext ih => + apply Typing.abs (xs ∪ (Γ ++ Θ ++ Δ).dom) + intros x _ + have h : ⟨x, σ⟩ :: Γ ++ Δ = ⟨x, σ⟩ :: Γ' := by aesop + refine @ih x (by aesop) _ _ Θ h ?_ + simp only [HasWellFormed.wf] + aesop + +/-- Weakening of a typing derivation by an additional context. -/ +lemma weaken : Γ ⊢ t ∶ τ → (Γ ++ Δ)✓ → Γ ++ Δ ⊢ t ∶ τ := by + intros der ok + rw [←List.append_nil (Γ ++ Δ)] at * + exact weaken_aux (by simp_all) ok + +omit [DecidableEq Var] in +/-- Typing derivations exist only for locally closed terms. -/ +lemma lc : Γ ⊢ t ∶ τ → t.LC := by + intros h + induction h <;> constructor + case abs ih => exact ih + all_goals aesop + +variable [HasFresh Var] + +open Term + +/-- Substitution for a context weakened by a single type between appended contexts. -/ +lemma subst_aux : + (Δ ++ ⟨x, σ⟩ :: Γ) ⊢ t ∶ τ → + Γ ⊢ s ∶ σ → + (Δ ++ Γ) ⊢ (t [x := s]) ∶ τ := by + generalize eq : Δ ++ ⟨x, σ⟩ :: Γ = Θ + intros h + revert Γ Δ + induction h <;> intros Γ Δ eq der + case app => aesop + case var x' τ ok mem => + simp only [subst_fvar] + rw [←eq] at mem + rw [←eq] at ok + cases (Context.wf_perm (by aesop) ok : (⟨x, σ⟩ :: Δ ++ Γ)✓) + case cons ok_weak _ => + observe perm : (Γ ++ Δ).Perm (Δ ++ Γ) + by_cases h : x = x' <;> simp only [h] + case neg => aesop + case pos nmem => + subst h eq + have nmem_Γ : ∀ γ, ⟨x, γ⟩ ∉ Γ := by + intros γ _ + exact nmem x (List.mem_keys.mpr ⟨γ, by aesop⟩) rfl + have nmem_Δ : ∀ γ, ⟨x, γ⟩ ∉ Δ := by + intros γ _ + exact nmem x (List.mem_keys.mpr ⟨γ, by aesop⟩) rfl + have eq' : τ = σ := by + simp only [List.mem_append, List.mem_cons, Sigma.mk.injEq, heq_eq_eq] at mem + match mem with | _ => aesop + rw [eq'] + refine (weaken der ?_).perm perm + exact Context.wf_perm (id (List.Perm.symm perm)) ok_weak + case abs σ Γ' t T2 xs ih' ih => + apply Typing.abs (xs ∪ {x} ∪ (Δ ++ Γ).dom) + intros x _ + rw [ + subst_def, + subst_open_var _ _ _ _ _ der.lc, + show ⟨x, σ⟩ :: (Δ ++ Γ) = (⟨x, σ⟩ :: Δ) ++ Γ by aesop + ] + apply ih + all_goals aesop + +/-- Substitution for a context weakened by a single type. -/ +lemma typing_subst_head : + ⟨x, σ⟩ :: Γ ⊢ t ∶ τ → Γ ⊢ s ∶ σ → Γ ⊢ (t [x := s]) ∶ τ := by + intros weak der + rw [←List.nil_append Γ] + exact subst_aux weak der + +/-- Typing preservation for opening. -/ +@[aesop safe forward (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +theorem preservation_open {xs : Finset Var} : + (∀ x ∉ xs, ⟨x, σ⟩ :: Γ ⊢ m ^ fvar x ∶ τ) → + Γ ⊢ n ∶ σ → Γ ⊢ m ^ n ∶ τ + := by + intros mem der + have ⟨fresh, free⟩ := fresh_exists (xs ∪ m.fv) + rw [subst_intro fresh n m (by aesop) der.lc] + exact typing_subst_head (mem fresh (by aesop)) der diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean new file mode 100644 index 00000000..0ce7da16 --- /dev/null +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2025 Chris Henson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Henson +-/ + +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.AesopRuleset +import Cslib.Syntax.HasWellFormed +import Mathlib.Data.Finset.Defs +import Mathlib.Data.Finset.Dedup +import Mathlib.Data.List.Sigma + +/-! # λ-calculus + +Contexts as pairs of free variables and types. + +-/ + +universe u v + +variable {Var : Type u} {Ty : Type v} [DecidableEq Var] + +namespace LambdaCalculus.LocallyNameless.Stlc + +/-- A typing context is a list of free variables and corresponding types. -/ +abbrev Context (Var : Type u) (Ty : Type v) := List ((_ : Var) × Ty) + +namespace Context + +/-- The domain of a context is the finite set of free variables it uses. -/ +@[simp] +def dom : Context Var Ty → Finset Var := List.toFinset ∘ List.keys + +/-- A well-formed context. -/ +abbrev Ok : Context Var Ty → Prop := List.NodupKeys + +instance : HasWellFormed (Context Var Ty) := + ⟨Ok⟩ + +variable {Γ Δ : Context Var Ty} + +/-- Context membership is preserved on permuting a context. -/ +theorem dom_perm_mem_iff (h : Γ.Perm Δ) {x : Var} : + x ∈ Γ.dom ↔ x ∈ Δ.dom := by + induction h <;> aesop + +omit [DecidableEq Var] in +/-- Context well-formedness is preserved on permuting a context. -/ +@[aesop safe forward (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +theorem wf_perm (h : Γ.Perm Δ) : Γ✓ → Δ✓ := (List.perm_nodupKeys h).mp + +omit [DecidableEq Var] in +@[aesop safe forward (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +theorem wf_strengthen : (Δ ++ ⟨x, σ⟩ :: Γ)✓ → (Δ ++ Γ)✓ := by + intros ok + have sl : List.Sublist (Δ ++ Γ) (Δ ++ ⟨x, σ⟩ :: Γ) := by simp + exact List.NodupKeys.sublist sl ok diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Safety.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Safety.lean new file mode 100644 index 00000000..33c8add3 --- /dev/null +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Safety.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2025 Chris Henson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Henson +-/ + +import Cslib.Computability.LambdaCalculus.LocallyNameless.Stlc.Basic +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Basic +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Properties +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence + +/-! # λ-calculus + +Type safety of the simply typed λ-calculus, with a locally nameless representation of syntax. +Theorems in this file are namespaced by their respective reductions. + +## References + +* [A. Chargueraud, *The Locally Nameless Representation*][Chargueraud2012] +* See also , from which + this is partially adapted + +-/ + +universe u v + +namespace LambdaCalculus.LocallyNameless + +open Stlc Typing + +variable {Var : Type u} {Base : Type v} {R : Term Var → Term Var → Prop} + +def PreservesTyping (R : Term Var → Term Var → Prop) (Base : Type v) := + ∀ {Γ t t'} {τ : Ty Base}, Γ ⊢ t ∶ τ → R t t' → Γ ⊢ t' ∶ τ + +/-- If a reduction preserves types, so does its reflexive transitive closure. -/ +@[aesop safe forward (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +theorem redex_preservesTyping : + PreservesTyping R Base → PreservesTyping (Relation.ReflTransGen R) Base := by + intros _ _ _ _ _ _ redex + induction redex <;> aesop + +open Relation in +/-- Confluence preserves type preservation. -/ +theorem confluence_preservesTyping {τ : Ty Base} : + Confluence R → PreservesTyping R Base → Γ ⊢ a ∶ τ → + (ReflTransGen R) a b → (ReflTransGen R) a c → + ∃ d, (ReflTransGen R) b d ∧ (ReflTransGen R) c d ∧ Γ ⊢ d ∶ τ := by + intros con p der ab ac + have ⟨d, bd, cd⟩ := con ab ac + exact ⟨d, bd, cd, redex_preservesTyping p der (ab.trans bd)⟩ + +variable [HasFresh Var] [DecidableEq Var] {Γ : Context Var (Ty Base)} + +namespace Term.FullBeta + +/-- Typing preservation for full beta reduction. -/ +@[aesop safe forward (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +theorem preservation : Γ ⊢ t ∶ τ → (t ⭢βᶠt') → Γ ⊢ t' ∶ τ := by + intros der + revert t' + induction der <;> intros t' step <;> cases step + case' abs.abs xs _ _ _ xs' _=> apply Typing.abs (xs ∪ xs') + case' app.beta der_l _ _ => cases der_l + all_goals aesop + +omit [HasFresh Var] [DecidableEq Var] in +/-- A typed term either full beta reduces or is a value. -/ +theorem progress {t : Term Var} {τ : Ty Base} (ht : [] ⊢ t ∶τ) : t.Value ∨ ∃ t', t ⭢βᶠ t' := by + generalize eq : [] = Γ at ht + induction ht + case var => aesop + case abs xs mem ih => + left + constructor + apply Term.LC.abs xs + intros _ mem' + exact (mem _ mem').lc + case app Γ M σ τ N der_l der_r ih_l ih_r => + simp only [eq, forall_const] at * + right + cases ih_l + -- if the lhs is a value, beta reduce the application + next val => + cases val + next M M_abs_lc => exact ⟨M ^ N, FullBeta.beta M_abs_lc der_r.lc⟩ + -- otherwise, propogate the step to the lhs of the application + next step => + obtain ⟨M', stepM⟩ := step + exact ⟨M'.app N, FullBeta.appR der_r.lc stepM⟩ + +end LambdaCalculus.LocallyNameless.Term.FullBeta diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/AesopRuleset.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/AesopRuleset.lean similarity index 100% rename from Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/AesopRuleset.lean rename to Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/AesopRuleset.lean diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean similarity index 94% rename from Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean rename to Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean index 5f831b3b..e72e979a 100644 --- a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean @@ -6,7 +6,7 @@ Authors: Chris Henson import Cslib.Data.HasFresh import Cslib.Syntax.HasSubstitution -import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.AesopRuleset +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.AesopRuleset /-! # λ-calculus @@ -26,9 +26,9 @@ variable {Var : Type u} [HasFresh Var] [DecidableEq Var] namespace LambdaCalculus.LocallyNameless -/-- Syntax of locally nameless absbda terms, with free variables over `Var`. -/ +/-- Syntax of locally nameless lambda terms, with free variables over `Var`. -/ inductive Term (Var : Type u) -/-- Bound variables that appear under a absbda abstraction, using a de-Bruijn index. -/ +/-- Bound variables that appear under a lambda abstraction, using a de-Bruijn index. -/ | bvar : ℕ → Term Var /-- Free variables. -/ | fvar : Var → Term Var @@ -143,3 +143,6 @@ inductive LC : Term Var → Prop | fvar (x) : LC (fvar x) | abs (L : Finset Var) (e : Term Var) : (∀ x : Var, x ∉ L → LC (e ^ fvar x)) → LC (abs e) | app {l r} : l.LC → r.LC → LC (app l r) + +inductive Value : Term Var → Prop +| abs (e : Term Var) : e.abs.LC → e.abs.Value diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBeta.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean similarity index 96% rename from Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBeta.lean rename to Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean index 35bc61bc..e1572151 100644 --- a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBeta.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Basic -import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Properties +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Basic +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Properties import Cslib.Semantics.ReductionSystem.Basic /-! # β-reduction for the λ-calculus diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean similarity index 97% rename from Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean rename to Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean index 9c64387c..ac9c00f1 100644 --- a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/FullBetaConfluence.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean @@ -4,9 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Basic -import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Properties -import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.FullBeta +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Basic +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Properties +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.FullBeta import Cslib.Data.Relation /-! # β-confluence for the λ-calculus -/ diff --git a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Properties.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean similarity index 98% rename from Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Properties.lean rename to Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean index 69fbb9b2..f9fb146e 100644 --- a/Cslib/Computability/LambdaCalculus/Untyped/LocallyNameless/Properties.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Computability.LambdaCalculus.Untyped.LocallyNameless.Basic +import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Basic universe u diff --git a/Cslib/Computability/LambdaCalculus/Untyped/Named/Basic.lean b/Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean similarity index 100% rename from Cslib/Computability/LambdaCalculus/Untyped/Named/Basic.lean rename to Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean diff --git a/CslibTests/LambdaCalculus.lean b/CslibTests/LambdaCalculus.lean index abc6dfb8..c92d97a8 100644 --- a/CslibTests/LambdaCalculus.lean +++ b/CslibTests/LambdaCalculus.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Computability.LambdaCalculus.Untyped.Named.Basic +import Cslib.Computability.LambdaCalculus.Named.Untyped.Basic open LambdaCalculus.Named open LambdaCalculus.Named.Term From e1da3c13e58e49b8f845e143bf1f60c12b4a7d03 Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Tue, 5 Aug 2025 07:51:03 -0400 Subject: [PATCH 049/107] All Lints Corrected! (#26) * all lints corrected! * whitespace --- .../Computability/CombinatoryLogic/Basic.lean | 22 +-- .../CombinatoryLogic/Confluence.lean | 17 ++- .../Computability/CombinatoryLogic/Defs.lean | 2 +- .../CombinatoryLogic/Recursion.lean | 11 +- .../LocallyNameless/Stlc/Basic.lean | 7 +- .../LocallyNameless/Stlc/Context.lean | 2 + .../LocallyNameless/Untyped/Basic.lean | 8 +- .../LocallyNameless/Untyped/FullBeta.lean | 23 ++-- .../Untyped/FullBetaConfluence.lean | 125 +++++++++--------- .../LocallyNameless/Untyped/Properties.lean | 53 ++++---- Cslib/Data/FinFun.lean | 70 ++++++---- Cslib/Logic/LinearLogic/CLL/Basic.lean | 8 +- Cslib/Semantics/Lts/Bisimulation.lean | 36 +++-- CslibTests/Lts.lean | 13 +- CslibTests/ReductionSystem.lean | 2 +- 15 files changed, 215 insertions(+), 184 deletions(-) diff --git a/Cslib/Computability/CombinatoryLogic/Basic.lean b/Cslib/Computability/CombinatoryLogic/Basic.lean index 10e830b2..58bd309c 100644 --- a/Cslib/Computability/CombinatoryLogic/Basic.lean +++ b/Cslib/Computability/CombinatoryLogic/Basic.lean @@ -81,7 +81,7 @@ algorithm. We induct backwards on the list, corresponding to applying the transf inside out. Since we haven't defined reduction for polynomials, we substitute arbitrary terms for the inner variables. -/ -theorem Polynomial.elimVar_correct {n : Nat} (Γ : SKI.Polynomial (n+1)) {ys : List SKI} +theorem Polynomial.elimVar_correct {n : Nat} (Γ : SKI.Polynomial (n + 1)) {ys : List SKI} (hys : ys.length = n) (z : SKI) : Γ.elimVar.eval ys hys ⬝ z ↠ Γ.eval (ys ++ [z]) (by rw [List.length_append, hys, List.length_singleton]) @@ -93,10 +93,10 @@ theorem Polynomial.elimVar_correct {n : Nat} (Γ : SKI.Polynomial (n+1)) {ys : L | _, SKI.Polynomial.app Γ Δ => rw [SKI.Polynomial.elimVar, SKI.Polynomial.eval] trans Γ.elimVar.eval ys hys ⬝ z ⬝ (Δ.elimVar.eval ys hys ⬝ z) - . exact MRed.S _ _ _ - . apply parallel_mRed - . exact elimVar_correct Γ hys z - . exact elimVar_correct Δ hys z + · exact MRed.S _ _ _ + · apply parallel_mRed + · exact elimVar_correct Γ hys z + · exact elimVar_correct Δ hys z | n, SKI.Polynomial.var i => rw [SKI.Polynomial.elimVar] split_ifs with hi @@ -249,7 +249,7 @@ theorem ΘAux_def (x y : SKI) : ΘAux ⬝ x ⬝ y ↠ y ⬝ (x ⬝ x ⬝ y) := ΘAuxPoly.toSKI_correct [x, y] (by simp) -/--Turing's fixed-point combinator: Θ := (λ x y. y (x x y)) (λ x y. y (x x y)) -/ +/-- Turing's fixed-point combinator: Θ := (λ x y. y (x x y)) (λ x y. y (x x y)) -/ def Θ : SKI := ΘAux ⬝ ΘAux /-- A SKI term representing Θ -/ theorem Θ_correct (f : SKI) : Θ ⬝ f ↠ f ⬝ (Θ ⬝ f) := ΘAux_def ΘAux f @@ -367,11 +367,11 @@ theorem unpaired_def (f p : SKI) : SKI.Unpaired ⬝ f ⬝ p ↠ f ⬝ (Fst ⬝ p theorem unpaired_correct (f x y : SKI) : SKI.Unpaired ⬝ f ⬝ (MkPair ⬝ x ⬝ y) ↠ f ⬝ x ⬝ y := by trans f ⬝ (Fst ⬝ (MkPair ⬝ x ⬝ y)) ⬝ (Snd ⬝ (MkPair ⬝ x ⬝ y)) - . exact unpaired_def f _ - . apply parallel_mRed - . apply MRed.tail + · exact unpaired_def f _ + · apply parallel_mRed + · apply MRed.tail exact fst_correct _ _ - . exact snd_correct _ _ + · exact snd_correct _ _ /-- Pair f g x := ⟨f x, g x⟩, cf `Primrec.Pair`. -/ def PairPoly : SKI.Polynomial 3 := MkPair ⬝' (&0 ⬝' &2) ⬝' (&1 ⬝' &2) @@ -379,3 +379,5 @@ def PairPoly : SKI.Polynomial 3 := MkPair ⬝' (&0 ⬝' &2) ⬝' (&1 ⬝' &2) protected def Pair : SKI := PairPoly.toSKI theorem pair_def (f g x : SKI) : SKI.Pair ⬝ f ⬝ g ⬝ x ↠ MkPair ⬝ (f ⬝ x) ⬝ (g ⬝ x) := PairPoly.toSKI_correct [f, g, x] (by simp) + +end SKI diff --git a/Cslib/Computability/CombinatoryLogic/Confluence.lean b/Cslib/Computability/CombinatoryLogic/Confluence.lean index 4643ba56..766438d2 100644 --- a/Cslib/Computability/CombinatoryLogic/Confluence.lean +++ b/Cslib/Computability/CombinatoryLogic/Confluence.lean @@ -61,8 +61,8 @@ theorem mRed_of_parallelReduction {a a' : SKI} (h : a ⇒ₚ a') : a ↠ a' := b case refl => exact Relation.ReflTransGen.refl case par a a' b b' ha hb => apply parallel_mRed - exact mRed_of_parallelReduction ha - exact mRed_of_parallelReduction hb + · exact mRed_of_parallelReduction ha + · exact mRed_of_parallelReduction hb case red_I => exact Relation.ReflTransGen.single (red_I a') case red_K b => exact Relation.ReflTransGen.single (red_K a' b) case red_S a b c => exact Relation.ReflTransGen.single (red_S a b c) @@ -75,12 +75,12 @@ theorem parallelReduction_of_red {a a' : SKI} (h : a ⭢ a') : a ⇒ₚ a' := by case red_I => apply ParallelReduction.red_I case red_head a a' b h => apply ParallelReduction.par - exact parallelReduction_of_red h - exact ParallelReduction.refl b + · exact parallelReduction_of_red h + · exact ParallelReduction.refl b case red_tail a b b' h => apply ParallelReduction.par - exact ParallelReduction.refl a - exact parallelReduction_of_red h + · exact ParallelReduction.refl a + · exact parallelReduction_of_red h /-- The inclusions of `mRed_of_parallelReduction` and `parallelReduction_of_red` imply that `⇒` and `⇒ₚ` have the same reflexive-transitive @@ -135,7 +135,8 @@ lemma Sa_irreducible (a c : SKI) (h : S ⬝ a ⇒ₚ c) : ∃ a', a ⇒ₚ a' rw [S_irreducible b h] exact ⟨h', rfl⟩ -lemma Sab_irreducible (a b c : SKI) (h : S ⬝ a ⬝ b ⇒ₚ c) : ∃ a' b', a ⇒ₚ a' ∧ b ⇒ₚ b' ∧ c = S ⬝ a' ⬝ b' := by +lemma Sab_irreducible (a b c : SKI) (h : S ⬝ a ⬝ b ⇒ₚ c) : + ∃ a' b', a ⇒ₚ a' ∧ b ⇒ₚ b' ∧ c = S ⬝ a' ⬝ b' := by cases h case refl => use a; use b @@ -237,3 +238,5 @@ theorem MRed.diamond (a b c : SKI) (hab : a ↠ b) (hac : a ↠ c) : CommonReduc apply commonReduct_equivalence.trans (y := a) · exact commonReduct_equivalence.symm (commonReduct_of_single hab) · exact commonReduct_of_single hac + +end SKI diff --git a/Cslib/Computability/CombinatoryLogic/Defs.lean b/Cslib/Computability/CombinatoryLogic/Defs.lean index c989da5e..34ffe6fb 100644 --- a/Cslib/Computability/CombinatoryLogic/Defs.lean +++ b/Cslib/Computability/CombinatoryLogic/Defs.lean @@ -52,7 +52,7 @@ namespace SKI scoped infixl:100 " ⬝ " => app /-- Apply a term to a list of terms -/ -def applyList (f : SKI) (xs : List SKI) : SKI := List.foldl (. ⬝ .) f xs +def applyList (f : SKI) (xs : List SKI) : SKI := List.foldl (· ⬝ ·) f xs lemma applyList_concat (f : SKI) (ys : List SKI) (z : SKI) : f.applyList (ys ++ [z]) = f.applyList ys ⬝ z := by diff --git a/Cslib/Computability/CombinatoryLogic/Recursion.lean b/Cslib/Computability/CombinatoryLogic/Recursion.lean index 18448030..ea8af396 100644 --- a/Cslib/Computability/CombinatoryLogic/Recursion.lean +++ b/Cslib/Computability/CombinatoryLogic/Recursion.lean @@ -108,7 +108,7 @@ To define the predecessor, iterate the function `PredAux` ⟨i, j⟩ ↦ ⟨j, j the first component. -/ def PredAuxPoly : SKI.Polynomial 1 := MkPair ⬝' (Snd ⬝' &0) ⬝' (SKI.Succ ⬝' (Snd ⬝' &0)) -/-- A term representing PredAux-/ +/-- A term representing PredAux -/ def PredAux : SKI := PredAuxPoly.toSKI theorem predAux_def (p : SKI) : PredAux ⬝ p ↠ MkPair ⬝ (Snd ⬝ p) ⬝ (SKI.Succ ⬝ (Snd ⬝ p)) := PredAuxPoly.toSKI_correct [p] (by simp) @@ -122,11 +122,12 @@ theorem isChurchPair_trans (ns : Nat × Nat) (a a' : SKI) (h : a ↠ a') : simp_rw [IsChurchPair] intro ⟨ha₁,ha₂⟩ constructor - . apply isChurch_trans (a' := Fst ⬝ a') + · apply isChurch_trans (a' := Fst ⬝ a') · apply MRed.tail; exact h · exact ha₁ - . apply isChurch_trans (a' := Snd ⬝ a') - apply MRed.tail; exact h; exact ha₂ + · apply isChurch_trans (a' := Snd ⬝ a') + · apply MRed.tail; exact h + · exact ha₂ theorem predAux_correct (p : SKI) (ns : Nat × Nat) (h : IsChurchPair ns p) : IsChurchPair ⟨ns.2, ns.2+1⟩ (PredAux ⬝ p) := by @@ -381,3 +382,5 @@ theorem le_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m apply isBool_trans (a' := IsZero ⬝ (SKI.Sub ⬝ a ⬝ b)) (h := le_def _ _) apply isZero_correct apply sub_correct <;> assumption + +end SKI diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean index 94b8f223..e8110214 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean @@ -139,11 +139,10 @@ lemma subst_aux : intros x _ rw [ subst_def, - subst_open_var _ _ _ _ _ der.lc, + subst_open_var _ _ _ _ (by aesop) der.lc, show ⟨x, σ⟩ :: (Δ ++ Γ) = (⟨x, σ⟩ :: Δ) ++ Γ by aesop ] - apply ih - all_goals aesop + apply ih <;> aesop /-- Substitution for a context weakened by a single type. -/ lemma typing_subst_head : @@ -162,3 +161,5 @@ theorem preservation_open {xs : Finset Var} : have ⟨fresh, free⟩ := fresh_exists (xs ∪ m.fv) rw [subst_intro fresh n m (by aesop) der.lc] exact typing_subst_head (mem fresh (by aesop)) der + +end LambdaCalculus.LocallyNameless.Stlc.Typing diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean index 0ce7da16..64d94f9b 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean @@ -55,3 +55,5 @@ theorem wf_strengthen : (Δ ++ ⟨x, σ⟩ :: Γ)✓ → (Δ ++ Γ)✓ := by intros ok have sl : List.Sublist (Δ ++ Γ) (Δ ++ ⟨x, σ⟩ :: Γ) := by simp exact List.NodupKeys.sublist sl ok + +end LambdaCalculus.LocallyNameless.Stlc.Context diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean index e72e979a..60c31b63 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean @@ -44,7 +44,7 @@ def openRec (i : ℕ) (sub : Term Var) : Term Var → Term Var | bvar i' => if i = i' then sub else bvar i' | fvar x => fvar x | app l r => app (openRec i sub l) (openRec i sub r) -| abs M => abs $ openRec (i+1) sub M +| abs M => abs <| openRec (i+1) sub M scoped notation:68 e "⟦" i " ↝ " sub "⟧"=> Term.openRec i sub e @@ -70,7 +70,7 @@ def closeRec (k : ℕ) (x : Var) : Term Var → Term Var | fvar x' => if x = x' then bvar k else fvar x' | bvar i => bvar i | app l r => app (closeRec k x l) (closeRec k x r) -| abs t => abs $ closeRec (k+1) x t +| abs t => abs <| closeRec (k+1) x t scoped notation:68 e "⟦" k " ↜ " x "⟧"=> Term.closeRec k x e @@ -103,7 +103,7 @@ def subst (m : Term Var) (x : Var) (sub : Term Var) : Term Var := | bvar i => bvar i | fvar x' => if x = x' then sub else fvar x' | app l r => app (l.subst x sub) (r.subst x sub) - | abs M => abs $ M.subst x sub + | abs M => abs <| M.subst x sub /-- `Term.subst` is a substitution for λ-terms. Gives access to the notation `m[x := n]`. -/ instance instHasSubstitutionTerm : HasSubstitution (Term Var) Var where @@ -146,3 +146,5 @@ inductive LC : Term Var → Prop inductive Value : Term Var → Prop | abs (e : Term Var) : e.abs.LC → e.abs.Value + +end LambdaCalculus.LocallyNameless.Term diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean index e1572151..edc73333 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean @@ -45,14 +45,14 @@ lemma step_lc_l (step : M ⭢βᶠ M') : LC M := by induction step <;> constructor all_goals assumption -/-- Left congruence rule for application in multiple reduction.-/ +/-- Left congruence rule for application in multiple reduction. -/ theorem redex_app_l_cong : (M ↠βᶠ M') → LC N → (app M N ↠βᶠ app M' N) := by intros redex lc_N induction' redex case refl => rfl case tail ih r => exact Relation.ReflTransGen.tail r (appR lc_N ih) -/-- Right congruence rule for application in multiple reduction.-/ +/-- Right congruence rule for application in multiple reduction. -/ theorem redex_app_r_cong : (M ↠βᶠ M') → LC N → (app N M ↠βᶠ app N M') := by intros redex lc_N induction' redex @@ -68,7 +68,8 @@ lemma step_lc_r (step : M ⭢βᶠ M') : LC M' := by all_goals try constructor <;> assumption /-- Substitution respects a single reduction step. -/ -lemma redex_subst_cong (s s' : Term Var) (x y : Var) : (s ⭢βᶠ s') → (s [ x := fvar y ]) ⭢βᶠ (s' [ x := fvar y ]) := by +lemma redex_subst_cong (s s' : Term Var) (x y : Var) : + s ⭢βᶠ s' → s [ x := fvar y ] ⭢βᶠ s' [ x := fvar y ] := by intros step induction step case appL ih => exact appL (subst_lc (by assumption) (by constructor)) ih @@ -89,7 +90,6 @@ lemma redex_subst_cong (s s' : Term Var) (x y : Var) : (s ⭢βᶠ s') → (s [ subst_fresh x (fvar z) (fvar y), ←subst_fresh x (fvar z) (fvar y), ←subst_open x (fvar y) 0 (fvar z) m' (by constructor), subst_fresh x (fvar z) (fvar y) ] - apply ih all_goals aesop /-- Abstracting then closing preserves a single reduction. -/ @@ -99,9 +99,9 @@ lemma step_abs_close {x : Var} : (M ⭢βᶠ M') → (M⟦0 ↜ x⟧.abs ⭢β intros y _ simp only [open'] repeat rw [open_close_to_subst] - exact redex_subst_cong M M' x y step - exact step_lc_r step - exact step_lc_l step + · exact redex_subst_cong M M' x y step + · exact step_lc_r step + · exact step_lc_l step /-- Abstracting then closing preserves multiple reductions. -/ lemma redex_abs_close {x : Var} : (M ↠βᶠ M') → (M⟦0 ↜ x⟧.abs ↠βᶠ M'⟦0 ↜ x⟧.abs) := by @@ -109,14 +109,17 @@ lemma redex_abs_close {x : Var} : (M ↠βᶠ M') → (M⟦0 ↜ x⟧.abs ↠β induction step using Relation.ReflTransGen.trans_induction_on case ih₁ => rfl case ih₂ ih => exact Relation.ReflTransGen.single (step_abs_close ih) - case ih₃ l r => trans; exact l; exact r + case ih₃ l r => exact .trans l r /-- Multiple reduction of opening implies multiple reduction of abstraction. -/ -theorem redex_abs_cong (xs : Finset Var) : (∀ x ∉ xs, (M ^ fvar x) ↠βᶠ (M' ^ fvar x)) → M.abs ↠βᶠ M'.abs := by +theorem redex_abs_cong (xs : Finset Var) : + (∀ x ∉ xs, (M ^ fvar x) ↠βᶠ (M' ^ fvar x)) → M.abs ↠βᶠ M'.abs := by intros mem have ⟨fresh, union⟩ := fresh_exists (xs ∪ M.fv ∪ M'.fv) simp only [Finset.union_assoc, Finset.mem_union, not_or] at union obtain ⟨_, _, _⟩ := union rw [←open_close fresh M 0 ?_, ←open_close fresh M' 0 ?_] - refine redex_abs_close (mem fresh ?_) + · exact redex_abs_close (mem fresh (by assumption)) all_goals assumption + +end LambdaCalculus.LocallyNameless.Term.FullBeta diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean index ac9c00f1..a283d3ea 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean @@ -18,14 +18,16 @@ variable {Var : Type u} namespace LambdaCalculus.LocallyNameless.Term /-- A parallel β-reduction step. -/ -@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet]) [constructors], reduction_sys paraRs "ₚ"] +@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet]) [constructors], + reduction_sys paraRs "ₚ"] inductive Parallel : Term Var → Term Var → Prop /-- Free variables parallel step to themselves. -/ | fvar (x : Var) : Parallel (fvar x) (fvar x) /-- A parallel left and right congruence rule for application. -/ | app : Parallel L L' → Parallel M M' → Parallel (app L M) (app L' M') /-- Congruence rule for lambda terms. -/ -| abs (xs : Finset Var) : (∀ x ∉ xs, Parallel (m ^ fvar x) (m' ^ fvar x)) → Parallel (abs m) (abs m') +| abs (xs : Finset Var) : + (∀ x ∉ xs, Parallel (m ^ fvar x) (m' ^ fvar x)) → Parallel (abs m) (abs m') /-- A parallel β-reduction. -/ | beta (xs : Finset Var) : (∀ x ∉ xs, Parallel (m ^ fvar x) (m' ^ fvar x) ) → @@ -45,20 +47,9 @@ lemma para_lc_l (step : M ⭢ₚ N) : LC M := by case beta => refine LC.app (LC.abs ?_ _ ?_) ?_ <;> assumption all_goals constructor <;> assumption -variable [HasFresh Var] [DecidableEq Var] - -/-- The right side of a parallel reduction is locally closed. -/ -@[aesop unsafe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma para_lc_r (step : M ⭢ₚ N) : LC N := by - induction step - case abs _ _ xs _ ih => exact LC.abs xs _ ih - case beta => refine beta_lc (LC.abs ?_ _ ?_) ?_ <;> assumption - all_goals constructor <;> assumption - /-- Parallel reduction is reflexive for locally closed terms. -/ @[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -def Parallel.lc_refl (M : Term Var) : LC M → M ⭢ₚ M := by - intros lc +lemma Parallel.lc_refl (M : Term Var) (lc : LC M) : M ⭢ₚ M := by induction lc all_goals constructor <;> assumption @@ -66,11 +57,21 @@ def Parallel.lc_refl (M : Term Var) : LC M → M ⭢ₚ M := by -- The problem is that sometimes when we apply a theorem we get out of our notation, so aesop can't -- see they are the same, including constructors. @[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -def Parallel.lc_refl' (M : Term Var) : LC M → Parallel M M := Parallel.lc_refl M +lemma Parallel.lc_refl' (M : Term Var) : LC M → Parallel M M := Parallel.lc_refl M + +variable [HasFresh Var] [DecidableEq Var] + +/-- The right side of a parallel reduction is locally closed. -/ +@[aesop unsafe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +lemma para_lc_r (step : M ⭢ₚ N) : LC N := by + induction step + case abs _ _ xs _ ih => exact LC.abs xs _ ih + case beta => refine beta_lc (LC.abs ?_ _ ?_) ?_ <;> assumption + all_goals constructor <;> assumption omit [HasFresh Var] [DecidableEq Var] in /-- A single β-reduction implies a single parallel reduction. -/ -lemma step_to_para (step : M ⭢βᶠ N) : (M ⭢ₚ N) := by +lemma step_to_para (step : M ⭢βᶠ N) : M ⭢ₚ N := by induction step <;> simp only [para_rs_Red_eq] case beta _ abs_lc _ => cases abs_lc with | abs xs _ => apply Parallel.beta xs <;> intros <;> apply Parallel.lc_refl <;> aesop @@ -78,12 +79,12 @@ lemma step_to_para (step : M ⭢βᶠ N) : (M ⭢ₚ N) := by open FullBeta in /-- A single parallel reduction implies a multiple β-reduction. -/ -lemma para_to_redex (para : M ⭢ₚ N) : (M ↠βᶠ N) := by +lemma para_to_redex (para : M ⭢ₚ N) : M ↠βᶠ N := by induction para case fvar => constructor case app _ _ _ _ l_para m_para redex_l redex_m => trans - exact redex_app_l_cong redex_l (para_lc_l m_para) + · exact redex_app_l_cong redex_l (para_lc_l m_para) exact redex_app_r_cong redex_m (para_lc_r l_para) case abs t t' xs _ ih => apply redex_abs_cong xs @@ -95,71 +96,62 @@ lemma para_to_redex (para : M ⭢ₚ N) : (M ↠βᶠ N) := by intros _ mem exact para_lc_r (para_ih _ mem) calc - m.abs.app n ↠βᶠ m'.abs.app n := redex_app_l_cong (redex_abs_cong xs (λ _ mem ↦ redex_ih _ mem)) (para_lc_l para_n) + m.abs.app n ↠βᶠ + m'.abs.app n := + redex_app_l_cong (redex_abs_cong xs (fun _ mem ↦ redex_ih _ mem)) (para_lc_l para_n) _ ↠βᶠ m'.abs.app n' := redex_app_r_cong redex_n m'_abs_lc _ ⭢βᶠ m' ^ n' := beta m'_abs_lc (para_lc_r para_n) /-- Multiple parallel reduction is equivalent to multiple β-reduction. -/ -theorem parachain_iff_redex : (M ↠ₚ N) ↔ (M ↠βᶠ N) := by - refine Iff.intro ?chain_to_redex ?redex_to_chain <;> intros h <;> induction' h <;> try rfl - case redex_to_chain.tail redex chain => exact Relation.ReflTransGen.tail chain (step_to_para redex) - case chain_to_redex.tail para redex => exact Relation.ReflTransGen.trans redex (para_to_redex para) +theorem parachain_iff_redex : M ↠ₚ N ↔ M ↠βᶠ N := by + refine Iff.intro ?chain_redex ?redex_chain <;> intros h <;> induction' h <;> try rfl + case redex_chain.tail redex chain => exact Relation.ReflTransGen.tail chain (step_to_para redex) + case chain_redex.tail para redex => exact Relation.ReflTransGen.trans redex (para_to_redex para) /-- Parallel reduction respects substitution. -/ -lemma para_subst (x : Var) : (M ⭢ₚ M') → (N ⭢ₚ N') → (M[x := N] ⭢ₚ M'[x := N']) := by - intros pm pn +lemma para_subst (x : Var) (pm : M ⭢ₚ M') (pn : N ⭢ₚ N') : M[x := N] ⭢ₚ M'[x := N'] := by induction pm case fvar => aesop case beta _ _ _ _ xs _ _ ih _ => simp only [open'] rw [subst_open _ _ _ _ _ (para_lc_r pn)] - apply Parallel.beta (xs ∪ {x}) - intros y ymem - simp only [Finset.mem_union, Finset.mem_singleton, not_or] at ymem - push_neg at ymem - rw [ - subst_def, - subst_open_var _ _ _ _ _ (para_lc_r pn), - subst_open_var _ _ _ _ _ (para_lc_l pn) - ] - apply ih - all_goals aesop + refine Parallel.beta (xs ∪ {x}) ?_ (by assumption) + · intros y ymem + simp only [Finset.mem_union, Finset.mem_singleton, not_or] at ymem + push_neg at ymem + rw [ + subst_def, + subst_open_var _ _ _ _ _ (para_lc_r pn), + subst_open_var _ _ _ _ _ (para_lc_l pn) + ] <;> aesop case app => constructor <;> assumption case abs u u' xs mem ih => apply Parallel.abs (xs ∪ {x}) intros y ymem simp only [Finset.mem_union, Finset.mem_singleton, not_or] at ymem repeat rw [subst_def] - rw [subst_open_var _ _ _ _ ?_ (para_lc_l pn), subst_open_var _ _ _ _ ?_ (para_lc_r pn)] push_neg at ymem - apply ih - all_goals aesop + rw [ + subst_open_var _ _ _ _ ?_ (para_lc_l pn), + subst_open_var _ _ _ _ ?_ (para_lc_r pn) + ] <;> aesop /-- Parallel substitution respects closing and opening. -/ -lemma para_open_close (x y z) : - (M ⭢ₚ M') → - y ∉ (M.fv ∪ M'.fv ∪ {x}) → - M⟦z ↜ x⟧⟦z ↝ fvar y⟧ ⭢ₚ M'⟦z ↜ x⟧⟦z ↝ fvar y⟧ - := by - intros para vars - simp only [Finset.union_assoc, Finset.mem_union, Finset.mem_singleton, not_or] at vars - rw [open_close_to_subst, open_close_to_subst] - apply para_subst - exact para +lemma para_open_close (x y z) (para : M ⭢ₚ M') (_ : y ∉ M.fv ∪ M'.fv ∪ {x}) : + M⟦z ↜ x⟧⟦z ↝ fvar y⟧ ⭢ₚ M'⟦z ↜ x⟧⟦z ↝ fvar y⟧ := by + simp only [Finset.union_assoc, Finset.mem_union, Finset.mem_singleton, not_or] at * + rw [open_close_to_subst _ _ _ _ (para_lc_l para), open_close_to_subst _ _ _ _ (para_lc_r para)] + apply para_subst _ para constructor - exact para_lc_r para - exact para_lc_l para /-- Parallel substitution respects fresh opening. -/ -lemma para_open_out (L : Finset Var) : - (∀ x, x ∉ L → (M ^ fvar x) ⭢ₚ (N ^ fvar x)) - → (M' ⭢ₚ N') → (M ^ M') ⭢ₚ (N ^ N') := by - intros mem para - let ⟨x, qx⟩ := fresh_exists (L ∪ N.fv ∪ M.fv) - simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx - obtain ⟨q1, q2, q3⟩ := qx - rw [subst_intro x M' _ q3 (para_lc_l para), subst_intro x N' _ q2 (para_lc_r para)] - exact para_subst x (mem x q1) para +lemma para_open_out (L : Finset Var) (mem : ∀ x, x ∉ L → (M ^ fvar x) ⭢ₚ N ^ fvar x) + (para : M' ⭢ₚ N') : (M ^ M') ⭢ₚ (N ^ N') := by + let ⟨x, qx⟩ := fresh_exists (L ∪ N.fv ∪ M.fv) + simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx + obtain ⟨q1, q2, q3⟩ := qx + rw [subst_intro x M' _ q3 (para_lc_l para), subst_intro x N' _ q2 (para_lc_r para)] + exact para_subst x (mem x q1) para -- TODO: the Takahashi translation would be a much nicer and shorter proof, but I had difficultly -- writing it for locally nameless terms. @@ -202,20 +194,19 @@ theorem para_diamond : Diamond (@Parallel Var) := by simp only [open', close] rw [close_open _ _ _ (para_lc_r qt''_l)] exact para_subst x qt''_l qt'_l - · apply Parallel.beta ((s1'' ^ fvar x).fv ∪ t''.fv ∪ {x}) + · refine Parallel.beta ((s1'' ^ fvar x).fv ∪ t''.fv ∪ {x}) ?_ (by aesop) intros y qy - rw [←open_close x s1'' 0] - apply para_open_close - all_goals aesop + rw [←open_close x s1'' 0 (by aesop)] + apply para_open_close <;> aesop case beta u1' u2' xs' mem' s2pu2' => have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ u1'.fv ∪ s1'.fv ∪ s2'.fv ∪ u2'.fv) simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx have ⟨q1, q2, q3, q4, q5, q6⟩ := qx have ⟨t', qt'_l, qt'_r⟩ := ih2 s2pu2' have ⟨t'', qt''_l, qt''_r⟩ := @ih1 x q1 _ (mem' _ q2) + refine ⟨t'' [x := t'], ?_⟩ + have : _ ∧ _ := ⟨para_subst x qt''_l qt'_l, para_subst x qt''_r qt'_r⟩ rw [subst_intro x u2' u1' _ (para_lc_l qt'_r), subst_intro x s2' s1' _ (para_lc_l qt'_l)] - exists t'' [x := t'] - exact ⟨para_subst x qt''_l qt'_l, para_subst x qt''_r qt'_r⟩ all_goals aesop case app s1 s1' s2 s2' s1ps1' _ ih1 ih2 => cases tpt2 @@ -252,3 +243,5 @@ theorem confluence_beta : Confluence (@FullBeta Var) := by exact parachain_iff_redex rw [←eq] exact @para_confluence Var _ _ + +end LambdaCalculus.LocallyNameless.Term diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean index f9fb146e..e15244d8 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean @@ -51,13 +51,13 @@ lemma open_close (x : Var) (t : Term Var) (k : ℕ) : x ∉ t.fv → t⟦k ↝ f induction t <;> aesop /-- Opening is injective. -/ -lemma open_injective (x : Var) (M M' : Term Var) : x ∉ M.fv → x ∉ M'.fv → M ^ fvar x = M' ^ fvar x → M = M' := by - intros free_M free_M' eq +lemma open_injective (x : Var) (M M') (free_M : x ∉ M.fv) (free_M' : x ∉ M'.fv) + (eq : M ^ fvar x = M' ^ fvar x) : M = M' := by rw [←open_close x M 0 free_M, ←open_close x M' 0 free_M'] exact congrArg (closeRec 0 x) eq /-- Opening and closing are associative for nonclashing free variables. -/ -lemma swap_open_fvar_close (k n: ℕ) (x y : Var) (m : Term Var) : +lemma swap_open_fvar_close (k n : ℕ) (x y : Var) (m : Term Var) : k ≠ n → x ≠ y → m⟦n ↝ fvar y⟧⟦k ↜ x⟧ = m⟦k ↜ x⟧⟦n ↝ fvar y⟧ := by revert k n induction' m <;> aesop @@ -68,12 +68,14 @@ lemma close_preserve_not_fvar {k x y} (m : Term Var) : x ∉ m.fv → x ∉ (m induction m <;> aesop /-- Opening to a fresh free variable preserves free variables. -/ -lemma open_fresh_preserve_not_fvar {k x y} (m : Term Var) : x ∉ m.fv → x ≠ y → x ∉ (m⟦k ↝ fvar y⟧).fv := by +lemma open_fresh_preserve_not_fvar {k x y} (m : Term Var) : + x ∉ m.fv → x ≠ y → x ∉ (m⟦k ↝ fvar y⟧).fv := by revert k induction m <;> aesop /-- Substitution preserves free variables. -/ -lemma subst_preserve_not_fvar {x y : Var} (m n : Term Var) : x ∉ m.fv ∪ n.fv → x ∉ (m [y := n]).fv := by +lemma subst_preserve_not_fvar {x y : Var} (m n : Term Var) : + x ∉ m.fv ∪ n.fv → x ∉ (m [y := n]).fv := by induction m all_goals aesop @@ -108,8 +110,8 @@ lemma subst_open (x : Var) (t : Term Var) (k : ℕ) (u e) : induction' e <;> aesop /-- Specialize `subst_open` to the first opening. -/ -theorem subst_open_var (x y : Var) (u e : Term Var) : y ≠ x → LC u → (e [y := u]) ^ fvar x = (e ^ fvar x) [y := u] := by - intros neq u_lc +theorem subst_open_var (x y : Var) (u e : Term Var) (neq : y ≠ x) (u_lc : LC u) : + (e [y := u]) ^ fvar x = (e ^ fvar x) [y := u] := by have h : (e ^ fvar x)[y:=u] = e[y:=u] ^ (fvar x)[y:=u] := subst_open y u 0 (fvar x) e u_lc aesop @@ -124,48 +126,39 @@ theorem subst_lc {x : Var} {e u : Term Var} : LC e → LC u → LC (e [x := u]) all_goals aesop all_goals aesop -/-- Opening to a term `t` is equivalent to opening to a free variable and substituting it for `t`. -/ -lemma subst_intro (x : Var) (t e : Term Var) : x ∉ e.fv → LC t → e ^ t = (e ^ fvar x) [ x := t ] := by - intros mem t_lc +/-- Opening to a term `t` is equivalent to opening to a free variable and substituting for `t`. -/ +lemma subst_intro (x : Var) (t e : Term Var) (mem : x ∉ e.fv) (t_lc : LC t) : + e ^ t = (e ^ fvar x) [ x := t ] := by simp only [open'] rw [subst_open x t 0 (fvar x) e t_lc, subst_fresh _ _ t mem] aesop /-- Opening of locally closed terms is locally closed. -/ -theorem beta_lc {M N : Term Var} : LC (abs M) → LC N → LC (M ^ N) := by - intros m_lc +theorem beta_lc {M N : Term Var} (m_lc : M.abs.LC) : LC N → LC (M ^ N) := by cases m_lc case abs xs mem => intros n_lc have ⟨y, ymem⟩ := fresh_exists (xs ∪ M.fv) simp only [Finset.mem_union, not_or] at ymem cases ymem - rw [subst_intro y N M] - apply subst_lc - apply mem - all_goals aesop + rw [subst_intro y N M (by aesop) (by assumption)] + apply subst_lc <;> aesop /-- Opening then closing is equivalent to substitution. -/ -lemma open_close_to_subst (m : Term Var) (x y : Var) (k : ℕ) : LC m → m ⟦k ↜ x⟧⟦k ↝ fvar y⟧ = m [x := fvar y] := by - intros m_lc +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 revert k induction' m_lc case abs xs t x_mem ih => intros k have ⟨x', x'_mem⟩ := fresh_exists ({x} ∪ {y} ∪ t.fv ∪ xs) - have s := subst_open_var x' x (fvar y) t ?_ (by constructor) + have s := subst_open_var x' x (fvar y) t (by aesop) (by constructor) simp only [closeRec_abs, openRec_abs, subst_abs] - rw [←open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ fvar y⟧) 0 ?f₁, ←open_close x' (t[x := fvar y]) 0 ?f₂] simp only [open'] at * - rw [swap_open_fvars, ←swap_open_fvar_close, s, ih] - case f₁ => - apply open_fresh_preserve_not_fvar - apply close_preserve_not_fvar - all_goals aesop - case f₂ => - apply subst_preserve_not_fvar - aesop - all_goals aesop + rw [←open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ fvar y⟧) 0 ?f₁, ←open_close x' (t[x := fvar y]) 0 ?f₂] + rw [swap_open_fvars, ←swap_open_fvar_close, s, ih] <;> aesop + case f₁ => refine open_fresh_preserve_not_fvar _ (close_preserve_not_fvar _ ?_) ?_ <;> aesop + case f₂ => apply subst_preserve_not_fvar; aesop all_goals aesop /-- Closing and opening are inverses. -/ @@ -185,3 +178,5 @@ lemma close_open (x : Var) (t : Term Var) (k : ℕ) : LC t → t⟦k ↜ x⟧⟦ rw [swap_open_fvar_close, swap_open_fvars] all_goals aesop all_goals aesop + +end LambdaCalculus.LocallyNameless.Term diff --git a/Cslib/Data/FinFun.lean b/Cslib/Data/FinFun.lean index db34b4e7..8f36f82e 100644 --- a/Cslib/Data/FinFun.lean +++ b/Cslib/Data/FinFun.lean @@ -30,14 +30,17 @@ abbrev FinFun.apply (f : α ⇀ β) (x : α) : β := f.f x /- Conversion from FinFun to a function. -/ @[coe] def FinFun.toFun [DecidableEq α] [Zero β] (f : α ⇀ β) : (α → β) := - λ x => if x ∈ f.dom then f.f x else Zero.zero + fun x => if x ∈ f.dom then f.f x else Zero.zero instance [DecidableEq α] [Zero β] : Coe (α ⇀ β) (α → β) where coe := FinFun.toFun -theorem FinFun.toFun_char [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : (f : α → β) = (g : α → β)) : ∀ x, (x ∈ (f.dom ∩ g.dom) → f.apply x = g.apply x) ∧ (x ∈ (f.dom \ g.dom) → f.apply x = Zero.zero) ∧ (x ∈ (g.dom \ f.dom) → g.apply x = Zero.zero) := by +theorem FinFun.toFun_char [DecidableEq α] [Zero β] + {f g : α ⇀ β} (h : (f : α → β) = (g : α → β)) (x) : + (x ∈ (f.dom ∩ g.dom) → + f.apply x = g.apply x) ∧ (x ∈ (f.dom \ g.dom) → + f.apply x = Zero.zero) ∧ (x ∈ (g.dom \ f.dom) → g.apply x = Zero.zero) := by rename_i hdec hzero - intro x have happlyx : f.toFun x = g.toFun x := by simp [h] constructorm* _ ∧ _ case left => @@ -57,13 +60,14 @@ theorem FinFun.toFun_char [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : (f : simp [toFun, hx] at happlyx simp only [happlyx] -theorem FinFun.toFun_dom [DecidableEq α] [Zero β] {f : α ⇀ β} (h : ∀ x, x ∉ f.dom → f.apply x = Zero.zero) : (f : α → β) = f.f := by +theorem FinFun.toFun_dom [DecidableEq α] [Zero β] {f : α ⇀ β} + (h : ∀ x, x ∉ f.dom → f.apply x = Zero.zero) : (f : α → β) = f.f := by rename_i hdec hzero funext x by_cases hx : x ∈ f.dom - . simp only [FinFun.toFun] + · simp only [FinFun.toFun] simp [hx] - . simp only [FinFun.toFun] + · simp only [FinFun.toFun] simp [hx] specialize h x simp only [h hx] @@ -75,10 +79,11 @@ theorem FinFun.toFun_dom [DecidableEq α] [Zero β] {f : α ⇀ β} (h : ∀ x, -- dom := dom -- } -def FinFun.mapBin [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option β → Option β) : Option (α ⇀ β) := +def FinFun.mapBin [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option β → Option β) : + Option (α ⇀ β) := if f.dom = g.dom ∧ ∀ x ∈ f.dom, (op (some (f.f x)) (some (g.f x))).isSome then some { - f := λ x => + f := fun x => match op (some (f.f x)) (some (g.f x)) with | some y => y | none => f.f x @@ -87,20 +92,22 @@ def FinFun.mapBin [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option else none -theorem FinFun.mapBin_dom [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option β → Option β) (h : FinFun.mapBin f g op = some fg) : - fg.dom = f.dom ∧ fg.dom = g.dom := by +theorem FinFun.mapBin_dom [DecidableEq α] (f g : α ⇀ β) + (op : Option β → Option β → Option β) (h : FinFun.mapBin f g op = some fg) : + fg.dom = f.dom ∧ fg.dom = g.dom := by rename_i hdec simp [mapBin] at h constructor - . simp only [← h] - . simp only [← h] + · simp only [← h] + · simp only [← h] -theorem FinFun.mapBin_char₁ [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option β → Option β) (h : FinFun.mapBin f g op = some fg) : - ∀ x ∈ fg.dom, fg.apply x = y ↔ (op (some (f.f x)) (some (g.f x))) = some y := by +theorem FinFun.mapBin_char₁ [DecidableEq α] (f g : α ⇀ β) + (op : Option β → Option β → Option β) (h : FinFun.mapBin f g op = some fg) : + ∀ x ∈ fg.dom, fg.apply x = y ↔ (op (some (f.f x)) (some (g.f x))) = some y := by rename_i hdec intro x hxdom constructor - . intro happ + · intro happ simp only [FinFun.apply] at happ simp [mapBin] at h rcases h with ⟨⟨ h_fg_dom_eq, hxsome ⟩, ⟨fgf, what⟩⟩ @@ -112,13 +119,16 @@ theorem FinFun.mapBin_char₁ [DecidableEq α] (f g : α ⇀ β) (op : Option β simp only [happ] | none => simp [hsome?] at hxsome - . intro hop + · intro hop simp [mapBin] at h rcases h with ⟨⟨ h_fg_dom_eq, hxsome ⟩, ⟨fgf, what⟩⟩ simp simp [hop] -theorem FinFun.mapBin_char₂ [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option β → Option β) (hdom : f.dom = g.dom) (hop : ∀ x ∈ f.dom, (op (some (f.f x)) (some (g.f x))).isSome) : (FinFun.mapBin f g op).isSome := by +theorem FinFun.mapBin_char₂ [DecidableEq α] (f g : α ⇀ β) + (op : Option β → Option β → Option β) (hdom : f.dom = g.dom) + (hop : ∀ x ∈ f.dom, (op (some (f.f x)) (some (g.f x))).isSome) + : (FinFun.mapBin f g op).isSome := by rename_i hdec simp [mapBin] simp [hdom] @@ -131,24 +141,25 @@ theorem FinFun.mapBin_char₂ [DecidableEq α] (f g : α ⇀ β) (op : Option β -- Fun to FinFun def Function.toFinFun [DecidableEq α] (f : α → β) (dom : Finset α) : α ⇀ β := FinFun.mk f dom -lemma Function.toFinFun_eq [DecidableEq α] [Zero β] (f : α → β) (dom : Finset α) (h : ∀ x, x ∉ dom → f x = 0) : - f = (Function.toFinFun f dom) := by +lemma Function.toFinFun_eq [DecidableEq α] [Zero β] (f : α → β) (dom : Finset α) + (h : ∀ x, x ∉ dom → f x = 0) : f = (Function.toFinFun f dom) := by funext p by_cases hp : p ∈ dom - . simp [Function.toFinFun, FinFun.toFun] + · simp [Function.toFinFun, FinFun.toFun] simp [hp] - . simp [Function.toFinFun, FinFun.toFun] + · simp [Function.toFinFun, FinFun.toFun] simp [hp] specialize h p hp exact h @[coe] def FinFun.toDomFun (f : α ⇀ β) : {x // x ∈ f.dom} → β := - λ x => f.f x + fun x => f.f x theorem FinFun.toDomFun_char (f : α ⇀ β) (h : x ∈ f.dom) : f.toDomFun ⟨ x, h ⟩ = f.f x := by simp [FinFun.toDomFun] -theorem FinFun.congrFinFun [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : f = g) (a : α) : f.apply a = g.apply a := by +theorem FinFun.congrFinFun [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : f = g) (a : α) : + f.apply a = g.apply a := by simp [FinFun.apply] cases f rename_i ff fdom @@ -158,7 +169,8 @@ theorem FinFun.congrFinFun [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : f = obtain ⟨ h1, h2⟩ := h exact congrFun h1 a -theorem FinFun.eq_char₁ [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : f = g) : f.f = g.f ∧ f.dom = g.dom := by +theorem FinFun.eq_char₁ [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : f = g) : + f.f = g.f ∧ f.dom = g.dom := by cases f rename_i ff fdom cases g @@ -166,7 +178,8 @@ theorem FinFun.eq_char₁ [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : f = simp at h assumption -theorem FinFun.eq_char₂ [DecidableEq α] [Zero β] {f g : α ⇀ β} (heq : f.f = g.f ∧ f.dom = g.dom) : f = g := by +theorem FinFun.eq_char₂ [DecidableEq α] [Zero β] {f g : α ⇀ β} (heq : f.f = g.f ∧ f.dom = g.dom) : + f = g := by cases f rename_i ff fdom cases g @@ -175,7 +188,8 @@ theorem FinFun.eq_char₂ [DecidableEq α] [Zero β] {f g : α ⇀ β} (heq : f. simp assumption -theorem FinFun.eq_char [DecidableEq α] [Zero β] {f g : α ⇀ β} : f = g ↔ f.f = g.f ∧ f.dom = g.dom := by +theorem FinFun.eq_char [DecidableEq α] [Zero β] {f g : α ⇀ β} : + f = g ↔ f.f = g.f ∧ f.dom = g.dom := by apply Iff.intro - . apply FinFun.eq_char₁ - . apply FinFun.eq_char₂ + · apply FinFun.eq_char₁ + · apply FinFun.eq_char₂ diff --git a/Cslib/Logic/LinearLogic/CLL/Basic.lean b/Cslib/Logic/LinearLogic/CLL/Basic.lean index ec407541..c11163e8 100644 --- a/Cslib/Logic/LinearLogic/CLL/Basic.lean +++ b/Cslib/Logic/LinearLogic/CLL/Basic.lean @@ -83,11 +83,15 @@ def Proposition.Neg (a : @Proposition Atom) : Prop := /-- Whether a `Proposition` is positive is decidable. -/ instance Proposition.pos_decidable (a : @Proposition Atom) : Decidable a.Pos := by - cases a <;> simp [Proposition.Pos] <;> first | apply Decidable.isTrue; simp | apply Decidable.isFalse; simp + cases a <;> + simp only [Proposition.Pos] <;> + first | apply Decidable.isTrue; trivial | apply Decidable.isFalse; trivial /-- Whether a `Proposition` is negative is decidable. -/ instance Proposition.neg_decidable (a : @Proposition Atom) : Decidable a.Neg := by - cases a <;> simp [Proposition.Neg] <;> first | apply Decidable.isTrue; simp | apply Decidable.isFalse; simp + cases a <;> + simp only [Proposition.Neg] <;> + first | apply Decidable.isTrue; trivial | apply Decidable.isFalse; trivial /-- Propositional duality. -/ def Proposition.dual (a : @Proposition Atom) : @Proposition Atom := diff --git a/Cslib/Semantics/Lts/Bisimulation.lean b/Cslib/Semantics/Lts/Bisimulation.lean index 2bf519d4..d11fd45a 100644 --- a/Cslib/Semantics/Lts/Bisimulation.lean +++ b/Cslib/Semantics/Lts/Bisimulation.lean @@ -1064,16 +1064,21 @@ theorem WeakBisimulation.iff_swBisimulation apply Lts.STr.comp lts hstr1b hstr1b' hstr1' · exact hrb2 -theorem WeakBisimulation.toSwBisimulation [HasTau Label] {lts : Lts State Label} {r : State → State → Prop} (h : WeakBisimulation lts r) : SWBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).1 h +theorem WeakBisimulation.toSwBisimulation + [HasTau Label] {lts : Lts State Label} {r : State → State → Prop} (h : WeakBisimulation lts r) : + SWBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).1 h -theorem SWBisimulation.toWeakBisimulation [HasTau Label] {lts : Lts State Label} {r : State → State → Prop} (h : SWBisimulation lts r) : WeakBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).2 h +theorem SWBisimulation.toWeakBisimulation + [HasTau Label] {lts : Lts State Label} {r : State → State → Prop} (h : SWBisimulation lts r) : + WeakBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).2 h /-- If two states are related by an `SWBisimulation`, then they are weakly bisimilar. -/ theorem WeakBisimilarity.by_swBisimulation [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) (hb : SWBisimulation lts r) (hr : r s1 s2) : s1 ≈[lts] s2 := by exists r - constructor; exact hr + constructor + · exact hr apply (WeakBisimulation.iff_swBisimulation lts r).2 hb /-- Weak bisimilarity and sw-bisimilarity coincide for all Ltss. -/ @@ -1086,20 +1091,23 @@ theorem WeakBisimilarity.weakBisim_eq_swBisim [HasTau Label] (lts : Lts State La intro h obtain ⟨r, hr, hrh⟩ := h exists r - constructor; exact hr + constructor + · exact hr apply (WeakBisimulation.iff_swBisimulation lts r).1 hrh case mpr => intro h obtain ⟨r, hr, hrh⟩ := h exists r - constructor; exact hr + constructor + · exact hr apply (WeakBisimulation.iff_swBisimulation lts r).2 hrh /-- sw-bisimilarity is reflexive. -/ theorem SWBisimilarity.refl [HasTau Label] (lts : Lts State Label) (s : State) : s ≈sw[lts] s := by simp [SWBisimilarity] exists Eq - constructor; rfl + constructor + · rfl simp only [SWBisimulation] intro s1 s2 hr μ cases hr @@ -1153,7 +1161,8 @@ theorem WeakBisimulation.inv [HasTau Label] (lts : Lts State Label) exact h' /-- sw-bisimilarity is symmetric. -/ -theorem SWBisimilarity.symm [HasTau Label] (lts : Lts State Label) (h : s1 ≈sw[lts] s2) : s2 ≈sw[lts] s1 := by +theorem SWBisimilarity.symm [HasTau Label] (lts : Lts State Label) (h : s1 ≈sw[lts] s2) : + s2 ≈sw[lts] s1 := by obtain ⟨r, hr, hrh⟩ := h exists (flip r) constructor @@ -1164,7 +1173,8 @@ theorem SWBisimilarity.symm [HasTau Label] (lts : Lts State Label) (h : s1 ≈sw apply SWBisimulation.inv lts r hrh /-- Weak bisimilarity is symmetric. -/ -theorem WeakBisimilarity.symm [HasTau Label] (lts : Lts State Label) (h : s1 ≈[lts] s2) : s2 ≈[lts] s1 := by +theorem WeakBisimilarity.symm [HasTau Label] (lts : Lts State Label) (h : s1 ≈[lts] s2) : + s2 ≈[lts] s1 := by rw [WeakBisimilarity.weakBisim_eq_swBisim] rw [WeakBisimilarity.weakBisim_eq_swBisim] at h apply SWBisimilarity.symm lts h @@ -1217,9 +1227,8 @@ theorem SWBisimulation.comp apply WeakBisimulation.comp lts r1 r2 h1 h2 /-- Weak bisimilarity is transitive. -/ -theorem WeakBisimilarity.trans - [HasTau Label] {s1 s2 s3 : State} (lts : Lts State Label) (h1 : s1 ≈[lts] s2) (h2 : s2 ≈[lts] s3) : - s1 ≈[lts] s3 := by +theorem WeakBisimilarity.trans [HasTau Label] {s1 s2 s3 : State} + (lts : Lts State Label) (h1 : s1 ≈[lts] s2) (h2 : s2 ≈[lts] s3) : s1 ≈[lts] s3 := by obtain ⟨r1, hr1, hr1b⟩ := h1 obtain ⟨r2, hr2, hr2b⟩ := h2 exists Relation.Comp r1 r2 @@ -1230,9 +1239,8 @@ theorem WeakBisimilarity.trans apply WeakBisimulation.comp lts r1 r2 hr1b hr2b /-- sw-bisimilarity is transitive. -/ -theorem SWBisimilarity.trans - [HasTau Label] {s1 s2 s3 : State} (lts : Lts State Label) (h1 : s1 ≈sw[lts] s2) (h2 : s2 ≈sw[lts] s3) : - s1 ≈sw[lts] s3 := by +theorem SWBisimilarity.trans [HasTau Label] {s1 s2 s3 : State} + (lts : Lts State Label) (h1 : s1 ≈sw[lts] s2) (h2 : s2 ≈sw[lts] s3) : s1 ≈sw[lts] s3 := by rw [← (WeakBisimilarity.weakBisim_eq_swBisim lts)] at * apply WeakBisimilarity.trans lts h1 h2 diff --git a/CslibTests/Lts.lean b/CslibTests/Lts.lean index 1c4328d9..3a46bb80 100644 --- a/CslibTests/Lts.lean +++ b/CslibTests/Lts.lean @@ -32,13 +32,13 @@ inductive NatBisim : ℕ → ℕ → Prop where example : 1 ~[natLts] 2 := by exists NatBisim constructor - . constructor - . simp [Bisimulation] + · constructor + · simp [Bisimulation] intro s1 s2 hr μ constructor - . intro s1' htr + · intro s1' htr cases htr <;> (cases hr <;> repeat constructor) - . intro s2' htr + · intro s2' htr cases htr <;> (cases hr <;> repeat constructor) inductive TLabel : Type where @@ -55,7 +55,8 @@ def natDivLts : Lts ℕ TLabel := ⟨NatDivergentTr⟩ def natInfiniteExecution : Stream' ℕ := fun n => n -theorem natInfiniteExecution.infiniteExecution : natDivLts.DivergentExecution natInfiniteExecution := by +theorem natInfiniteExecution.infiniteExecution : + natDivLts.DivergentExecution natInfiniteExecution := by simp [Lts.DivergentExecution] intro n constructor @@ -89,7 +90,7 @@ example : natDivLts.Divergent n := by -- check that notation works variable {Term : Type} {Label : Type} @[lts lts "β", simp] -def labelled_transition : Term → Label → Term → Prop := λ _ _ _ ↦ True +def labelled_transition : Term → Label → Term → Prop := fun _ _ _ ↦ True example (a b : Term) (μ : Label) : a [μ]⭢β b := by change labelled_transition a μ b diff --git a/CslibTests/ReductionSystem.lean b/CslibTests/ReductionSystem.lean index f5c68e22..9c6b985f 100644 --- a/CslibTests/ReductionSystem.lean +++ b/CslibTests/ReductionSystem.lean @@ -24,7 +24,7 @@ inductive Term (Var : Type) variable {Var : Type} @[reduction_sys rs' "β", simp] -def term_rel : Term Var → Term Var → Prop := λ _ _ ↦ True +def term_rel : Term Var → Term Var → Prop := fun _ _ ↦ True example (a b : Term Var) : a ⭢β b := by change (@term_rel Var) a b From 23ddc1938d425b19d42ef5c4beac5236391a4318 Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Tue, 5 Aug 2025 13:22:37 -0400 Subject: [PATCH 050/107] add wfail option to CI build (#27) * add wfail option to CI build * testing: lint error * Revert "testing: lint error" This reverts commit cb9790b753e6b5af67b12278d1f57f2b50dc4900. * try a lint failure in a test file * Revert "try a lint failure in a test file" This reverts commit 832032bbe119a7593b91be06f446f54015a0143d. --- .github/workflows/lean_action_ci.yml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/.github/workflows/lean_action_ci.yml b/.github/workflows/lean_action_ci.yml index dd55a9f3..f60bce6c 100644 --- a/.github/workflows/lean_action_ci.yml +++ b/.github/workflows/lean_action_ci.yml @@ -14,3 +14,5 @@ jobs: set -e cmp -s lean-toolchain docs/lean-toolchain - uses: leanprover/lean-action@v1 + with: + build-args: "--wfail" From 00a438af808c0059e80d1a849a24e1863261be94 Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Thu, 14 Aug 2025 10:37:23 -0400 Subject: [PATCH 051/107] Toolchain v4.22.0 (#31) * bump toolchain * docs toolchain * pin new mathlib rev * manifest using pin * docs manifest using pin --- .../LocallyNameless/Untyped/FullBeta.lean | 6 ++-- Cslib/Semantics/ReductionSystem/Basic.lean | 7 ----- docs/lake-manifest.json | 30 +++++++++---------- docs/lean-toolchain | 2 +- lake-manifest.json | 30 +++++++++---------- lakefile.toml | 2 +- lean-toolchain | 2 +- 7 files changed, 36 insertions(+), 43 deletions(-) diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean index edc73333..6491b468 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean @@ -107,9 +107,9 @@ lemma step_abs_close {x : Var} : (M ⭢βᶠ M') → (M⟦0 ↜ x⟧.abs ⭢β lemma redex_abs_close {x : Var} : (M ↠βᶠ M') → (M⟦0 ↜ x⟧.abs ↠βᶠ M'⟦0 ↜ x⟧.abs) := by intros step induction step using Relation.ReflTransGen.trans_induction_on - case ih₁ => rfl - case ih₂ ih => exact Relation.ReflTransGen.single (step_abs_close ih) - case ih₃ l r => exact .trans l r + case refl => rfl + case single ih => exact Relation.ReflTransGen.single (step_abs_close ih) + case trans l r => exact .trans l r /-- Multiple reduction of opening implies multiple reduction of abstraction. -/ theorem redex_abs_cong (xs : Finset Var) : diff --git a/Cslib/Semantics/ReductionSystem/Basic.lean b/Cslib/Semantics/ReductionSystem/Basic.lean index a7e555c8..dcf7e9ee 100644 --- a/Cslib/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Semantics/ReductionSystem/Basic.lean @@ -43,13 +43,6 @@ theorem ReductionSystem.MRed.single (rs : ReductionSystem Term) (h : rs.Red a b) open Relation Relation.ReflTransGen --- these instances allow us to switch between single and multistep reductions in a `calc` block -instance {α} (R : α → α → Prop) : Trans R (ReflTransGen R) (ReflTransGen R) where - trans := head - -instance {α} (R : α → α → Prop) : Trans (ReflTransGen R) R (ReflTransGen R) where - trans := tail - instance (rs : ReductionSystem Term) : Trans rs.Red rs.MRed rs.MRed := by infer_instance instance (rs : ReductionSystem Term) : Trans rs.MRed rs.Red rs.MRed := by infer_instance diff --git a/docs/lake-manifest.json b/docs/lake-manifest.json index 2921873c..55d12c99 100644 --- a/docs/lake-manifest.json +++ b/docs/lake-manifest.json @@ -22,27 +22,27 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "928758ac3743dc7f171fc66f450506723896f1c5", + "rev": "79e94a093aff4a60fb1b1f92d9681e407124c2ca", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.22.0-rc4", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/plausible", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "c37191eba2da78393070da8c4367689d8c4276e4", + "rev": "b100ad4c5d74a464f497aaa8e7c74d86bf39a56f", "name": "plausible", "manifestFile": "lake-manifest.json", - "inputRev": "main", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/LeanSearchClient", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "6c62474116f525d2814f0157bb468bf3a4f9f120", + "rev": "99657ad92e23804e279f77ea6dbdeebaa1317b98", "name": "LeanSearchClient", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -52,50 +52,50 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "4241928fd3ebae83a037a253e39d9b773e34c3b4", + "rev": "eb164a46de87078f27640ee71e6c3841defc2484", "name": "importGraph", "manifestFile": "lake-manifest.json", - "inputRev": "main", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/ProofWidgets4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "96c67159f161fb6bf6ce91a2587232034ac33d7e", + "rev": "1253a071e6939b0faf5c09d2b30b0bfc79dae407", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.67", + "inputRev": "v0.0.68", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/aesop", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "0a136f764a5dfedc4498e93ad8e297cff57ba2fc", + "rev": "1256a18522728c2eeed6109b02dd2b8f207a2a3c", "name": "aesop", "manifestFile": "lake-manifest.json", - "inputRev": "master", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/quote4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "1ef3dac0f872ca6aaa7d02e015427e06dd0b6195", + "rev": "917bfa5064b812b7fbd7112d018ea0b4def25ab3", "name": "Qq", "manifestFile": "lake-manifest.json", - "inputRev": "master", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/batteries", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "e96b5eca4fcfe2e0e96a1511a6cd5747515aba82", + "rev": "240676e9568c254a69be94801889d4b13f3b249f", "name": "batteries", "manifestFile": "lake-manifest.json", - "inputRev": "main", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover/lean4-cli", diff --git a/docs/lean-toolchain b/docs/lean-toolchain index 8ce10238..1f2f20aa 100644 --- a/docs/lean-toolchain +++ b/docs/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.22.0-rc4 \ No newline at end of file +leanprover/lean4:v4.22.0 \ No newline at end of file diff --git a/lake-manifest.json b/lake-manifest.json index 8cc16931..41d60bcf 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -5,27 +5,27 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "928758ac3743dc7f171fc66f450506723896f1c5", + "rev": "79e94a093aff4a60fb1b1f92d9681e407124c2ca", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.22.0-rc4", + "inputRev": "v4.22.0", "inherited": false, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/plausible", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "c37191eba2da78393070da8c4367689d8c4276e4", + "rev": "b100ad4c5d74a464f497aaa8e7c74d86bf39a56f", "name": "plausible", "manifestFile": "lake-manifest.json", - "inputRev": "main", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/LeanSearchClient", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "6c62474116f525d2814f0157bb468bf3a4f9f120", + "rev": "99657ad92e23804e279f77ea6dbdeebaa1317b98", "name": "LeanSearchClient", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -35,50 +35,50 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "4241928fd3ebae83a037a253e39d9b773e34c3b4", + "rev": "eb164a46de87078f27640ee71e6c3841defc2484", "name": "importGraph", "manifestFile": "lake-manifest.json", - "inputRev": "main", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/ProofWidgets4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "96c67159f161fb6bf6ce91a2587232034ac33d7e", + "rev": "1253a071e6939b0faf5c09d2b30b0bfc79dae407", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.67", + "inputRev": "v0.0.68", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/aesop", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "0a136f764a5dfedc4498e93ad8e297cff57ba2fc", + "rev": "1256a18522728c2eeed6109b02dd2b8f207a2a3c", "name": "aesop", "manifestFile": "lake-manifest.json", - "inputRev": "master", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/quote4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "1ef3dac0f872ca6aaa7d02e015427e06dd0b6195", + "rev": "917bfa5064b812b7fbd7112d018ea0b4def25ab3", "name": "Qq", "manifestFile": "lake-manifest.json", - "inputRev": "master", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/batteries", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "e96b5eca4fcfe2e0e96a1511a6cd5747515aba82", + "rev": "240676e9568c254a69be94801889d4b13f3b249f", "name": "batteries", "manifestFile": "lake-manifest.json", - "inputRev": "main", + "inputRev": "v4.22.0", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover/lean4-cli", diff --git a/lakefile.toml b/lakefile.toml index e693bf44..225d1be1 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -9,7 +9,7 @@ weak.linter.mathlibStandardSet = true [[require]] name = "mathlib" scope = "leanprover-community" -rev = "v4.22.0-rc4" +rev = "v4.22.0" [[lean_lib]] name = "Cslib" diff --git a/lean-toolchain b/lean-toolchain index 8ce10238..1f2f20aa 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.22.0-rc4 \ No newline at end of file +leanprover/lean4:v4.22.0 \ No newline at end of file From 13d5d5b27d071a95f9bdba757a927858fa1b0967 Mon Sep 17 00:00:00 2001 From: "Tristan F.-R." Date: Thu, 14 Aug 2025 09:06:35 -0700 Subject: [PATCH 052/107] feat(HasFresh): characterize (#29) * feat(HasFresh): characterize Associated lemmas to `HasFresh` which characterize its behavior. * move hasfresh lemmas a little up --- Cslib/Data/HasFresh.lean | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/Cslib/Data/HasFresh.lean b/Cslib/Data/HasFresh.lean index f4ee9af5..838bea73 100644 --- a/Cslib/Data/HasFresh.lean +++ b/Cslib/Data/HasFresh.lean @@ -32,6 +32,15 @@ theorem HasFresh.fresh_exists {α : Type u} [HasFresh α] (s : Finset α) : ∃ export HasFresh (fresh fresh_notMem fresh_exists) +lemma HasFresh.not_of_finite (α : Type u) [Fintype α] : IsEmpty (HasFresh α) := + ⟨fun f ↦ (f.fresh_notMem .univ).elim (Finset.mem_univ _)⟩ + +/-- All infinite types have an associated (at least noncomputable) fresh function. +This, in conjunction with `HasFresh.not_of_finite`, characterizes `HasFresh`. -/ +noncomputable def HasFresh.of_infinite (α : Type u) [Infinite α] : HasFresh α where + fresh s := s.finite_toSet.infinite_compl.nonempty.choose + fresh_notMem s := s.finite_toSet.infinite_compl.nonempty.choose_spec + open Finset in /-- Construct a fresh element from an embedding of `ℕ` using `Nat.find`. -/ def HasFresh.ofNatEmbed {α : Type u} [DecidableEq α] (e : ℕ ↪ α) : HasFresh α where From 276f02e59e9997c37f1a1c53be9720f8cdf7adf3 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Fri, 15 Aug 2025 21:29:07 +0200 Subject: [PATCH 053/107] move to leanprover --- .github/CODEOWNERS | 12 ++++++------ .github/workflows/lean_lint_suggest.yml | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 5c842faf..3b5151da 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -1,7 +1,7 @@ -* @cs-lean/jokers -/docs @cs-lean/reviewers -/CslibTests @cs-lean/reviewers +* @fmontesi +/docs @fmontesi @chenson2018 +/CslibTests @fmontesi @chenson2018 -/Cslib/Computability/LambdaCalculus/ @cs-lean/lambda-calculus -/Cslib/ConcurrencyTheory/ @cs-lean/concurrency-theory -/Cslib/Logic/ @cs-lean/logic +/Cslib/Computability/LambdaCalculus/ @chenson2018 +/Cslib/ConcurrencyTheory/ @fmontesi +/Cslib/Logic/ @fmontesi @m-ow diff --git a/.github/workflows/lean_lint_suggest.yml b/.github/workflows/lean_lint_suggest.yml index 619136f7..1ff9ac90 100644 --- a/.github/workflows/lean_lint_suggest.yml +++ b/.github/workflows/lean_lint_suggest.yml @@ -5,7 +5,7 @@ name: Lint and suggest jobs: lint: - if: github.repository == 'cs-lean/cslib' && github.event.pull_request.draft == false + if: github.repository == 'leanprover/cslib' && github.event.pull_request.draft == false runs-on: ubuntu-latest steps: - uses: leanprover-community/lint-style-action@f2e7272aad56233a642b08fe974cf09dd664b0c8 # 2025-05-22 (taken from mathlib) From 55f88dc7c462e9d7e85fd8d89a0318c79231d314 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Fri, 15 Aug 2025 21:38:39 +0200 Subject: [PATCH 054/107] Fix type name in CONTRIBUTING.md (#33) --- CONTRIBUTING.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 0833f6a0..68f3ccce 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -10,7 +10,7 @@ We generally follow the [mathlib style for coding and documentation](https://lea ## Variable names -Feel free to use variable names that make sense in the domain that you are dealing with. For example, in the `LTS` library, `State` is used for types of states and `μ` is used as variable name for transition labels. +Feel free to use variable names that make sense in the domain that you are dealing with. For example, in the `Lts` library, `State` is used for types of states and `μ` is used as variable name for transition labels. ## Proof style and golfing :golf: @@ -22,4 +22,4 @@ Golfing and automation are welcome, as long as proofs remain reasonably readable The library hosts a number of languages with their own syntax and semantics, so we try to manage notation with reusability and maintainability in mind. - If you want notation for a common concept, like reductions or transitions in an operational semantics, try to find an existing typeclass that fits your need. -- If you define new notation that in principle can apply to different types (e.g., syntax or semantics of other languages), keep it locally scoped or create a new typeclass. \ No newline at end of file +- If you define new notation that in principle can apply to different types (e.g., syntax or semantics of other languages), keep it locally scoped or create a new typeclass. From 05e531029887b7bcc220d0cdae8957c9bf61b898 Mon Sep 17 00:00:00 2001 From: "Tristan F.-R." Date: Sat, 16 Aug 2025 03:34:12 -0700 Subject: [PATCH 055/107] feat(LinearLogic): logical equivalence is an equivalence relation (#34) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * feat(LinearLogic): logical equivalence is an equivalence relation * use ʔ --- .vscode/settings.json | 3 +- Cslib/Logic/LinearLogic/CLL/Basic.lean | 179 ++++++++++++------------- 2 files changed, 90 insertions(+), 92 deletions(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index f75be9a0..7242e3a0 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -11,7 +11,8 @@ "tr": "⭢", "mtr": "↠", "red": "⭢", - "mred": "↠" + "mred": "↠", + "_?": "ʔ" }, "editor.rulers": [ 100 diff --git a/Cslib/Logic/LinearLogic/CLL/Basic.lean b/Cslib/Logic/LinearLogic/CLL/Basic.lean index c11163e8..ef426f65 100644 --- a/Cslib/Logic/LinearLogic/CLL/Basic.lean +++ b/Cslib/Logic/LinearLogic/CLL/Basic.lean @@ -11,7 +11,6 @@ import Mathlib.Order.Notation ## TODO - First-order polymorphism. -- Logical equivalences. - Cut elimination. ## References @@ -22,46 +21,49 @@ import Mathlib.Order.Notation universe u -section CLL - variable {Atom : Type u} namespace CLL /-- Propositions. -/ -inductive Proposition {Atom : Type u} : Type u where +inductive Proposition (Atom : Type u) : Type u where | atom (x : Atom) | atomDual (x : Atom) | one | zero | top | bot - | tensor (a b : @Proposition Atom) - | parr (a b : @Proposition Atom) - | oplus (a b : @Proposition Atom) - | with (a b : @Proposition Atom) - | bang (a : @Proposition Atom) - | quest (a : @Proposition Atom) + /-- The multiplicative conjunction connective. -/ + | tensor (a b : Proposition Atom) + /-- The multiplicative disjunction connective. -/ + | parr (a b : Proposition Atom) + /-- The additive disjunction connective. -/ + | oplus (a b : Proposition Atom) + /-- The additive conjunction connective. -/ + | with (a b : Proposition Atom) + /-- The "of course" exponential. -/ + | bang (a : Proposition Atom) + /-- The "why not" exponential. + This is written as ʔ, or \_?, to distinguish itself from the lean syntatical hole ? syntax -/ + | quest (a : Proposition Atom) deriving DecidableEq, BEq -instance : One (@Proposition Atom) where - one := Proposition.one - -instance : Zero (@Proposition Atom) where - zero := Proposition.zero +instance : Zero (Proposition Atom) := ⟨.zero⟩ +instance : One (Proposition Atom) := ⟨.one⟩ -instance : Top (@Proposition Atom) where - top := Proposition.top +instance : Top (Proposition Atom) := ⟨.top⟩ +instance : Bot (Proposition Atom) := ⟨.bot⟩ -instance : Bot (@Proposition Atom) where - bot := Proposition.bot +@[inherit_doc] scoped infix:35 " ⊗ " => Proposition.tensor +@[inherit_doc] scoped infix:35 " ⊕ " => Proposition.oplus +@[inherit_doc] scoped infix:30 " ⅋ " => Proposition.parr +@[inherit_doc] scoped infix:30 " & " => Proposition.with -scoped infix:35 " ⊗ " => Proposition.tensor -scoped infix:30 " ⅋ " => Proposition.parr +@[inherit_doc] scoped prefix:95 "!" => Proposition.bang +@[inherit_doc] scoped prefix:95 "ʔ" => Proposition.quest /-- Positive propositions. -/ -def Proposition.Pos (a : @Proposition Atom) : Prop := - match a with +def Proposition.Pos : Proposition Atom → Prop | atom _ => True | one => True | zero => True @@ -71,31 +73,27 @@ def Proposition.Pos (a : @Proposition Atom) : Prop := | _ => False /-- Negative propositions. -/ -def Proposition.Neg (a : @Proposition Atom) : Prop := - match a with +def Proposition.Neg : Proposition Atom → Prop | atomDual _ => True | bot => True | top => True | parr _ _ => True - | Proposition.with _ _ => True + | .with _ _ => True | quest _ => True | _ => False /-- Whether a `Proposition` is positive is decidable. -/ -instance Proposition.pos_decidable (a : @Proposition Atom) : Decidable a.Pos := by - cases a <;> - simp only [Proposition.Pos] <;> - first | apply Decidable.isTrue; trivial | apply Decidable.isFalse; trivial +instance Proposition.pos_decidable (a : Proposition Atom) : Decidable a.Pos := by + unfold Proposition.Pos + split <;> infer_instance /-- Whether a `Proposition` is negative is decidable. -/ -instance Proposition.neg_decidable (a : @Proposition Atom) : Decidable a.Neg := by - cases a <;> - simp only [Proposition.Neg] <;> - first | apply Decidable.isTrue; trivial | apply Decidable.isFalse; trivial +instance Proposition.neg_decidable (a : Proposition Atom) : Decidable a.Neg := by + unfold Proposition.Neg + split <;> infer_instance /-- Propositional duality. -/ -def Proposition.dual (a : @Proposition Atom) : @Proposition Atom := - match a with +def Proposition.dual : Proposition Atom → Proposition Atom | atom x => atomDual x | atomDual x => atom x | one => bot @@ -104,68 +102,55 @@ def Proposition.dual (a : @Proposition Atom) : @Proposition Atom := | top => zero | tensor a b => parr a.dual b.dual | parr a b => tensor a.dual b.dual - | oplus a b => Proposition.with a.dual b.dual - | Proposition.with a b => oplus a.dual b.dual + | oplus a b => .with a.dual b.dual + | .with a b => oplus a.dual b.dual | bang a => quest a.dual | quest a => bang a.dual /-- No proposition is equal to its dual. -/ -theorem Proposition.dual.neq (a : @Proposition Atom) : a ≠ a.dual := by +theorem Proposition.dual.neq (a : Proposition Atom) : a ≠ a.dual := by cases a <;> simp [Proposition.dual] /-- Two propositions are equal iff their respective duals are equal. -/ -theorem Proposition.dual.eq_iff (a b : @Proposition Atom) : a = b ↔ a.dual = b.dual := by - apply Iff.intro <;> intro h - · cases a <;> cases b <;> simp at h <;> simp [h] - · induction a generalizing b <;> cases b - all_goals try cases h - all_goals try rfl - all_goals simp_all [Proposition.dual]; aesop +@[simp] +theorem Proposition.dual_inj (a b : Proposition Atom) : a.dual = b.dual ↔ a = b := by + refine ⟨fun h ↦ ?_, congrArg dual⟩ + induction a generalizing b <;> cases b + all_goals aesop (add simp [Proposition.dual]) /-- Duality is an involution. -/ -theorem Proposition.dual.involution (a : @Proposition Atom) : a.dual.dual = a := by - induction a <;> simp only [dual] - case tensor a b iha ihb => - simp only [iha, ihb] - case parr a b iha ihb => - simp only [iha, ihb] - case oplus a b iha ihb => - simp only [iha, ihb] - case _ a b iha ihb => - simp only [iha, ihb] - case bang a iha => - simp only [iha] - case quest a iha => - simp only [iha] +@[simp] +theorem Proposition.dual.involution (a : Proposition Atom) : a.dual.dual = a := by + induction a <;> simp_all [dual] /-- Linear implication. -/ -def Proposition.linImpl (a b : @Proposition Atom) : @Proposition Atom := a.dual.parr b +def Proposition.linImpl (a b : Proposition Atom) : Proposition Atom := a.dual ⅋ b /-- A sequent in CLL is a list of propositions. -/ -abbrev Sequent := List (@Proposition Atom) +abbrev Sequent (Atom) := List (Proposition Atom) /-- Checks that all propositions in `Γ` are question marks. -/ -def Sequent.allQuest (Γ : @Sequent Atom) := +def Sequent.allQuest (Γ : Sequent Atom) := ∀ a ∈ Γ, ∃ b, a = Proposition.quest b open Proposition in /-- Sequent calculus for CLL. -/ -inductive Proof : @Sequent Atom → Prop where +inductive Proof : Sequent Atom → Prop where | ax : Proof [a, a.dual] | cut : Proof (a :: Γ) → Proof (a.dual :: Δ) → Proof (Γ ++ Δ) | exchange : List.Perm Γ Δ → Proof Γ → Proof Δ | one : Proof [one] - | bot : Proof Γ → Proof (bot :: Γ) - | parr : Proof (a :: b :: Γ) → Proof ((parr a b) :: Γ) - | tensor : Proof (a :: Γ) → Proof (b :: Δ) → Proof ((tensor a b) :: (Γ ++ Δ)) - | oplus₁ : Proof (a :: Γ) → Proof ((oplus a b) :: Γ) - | oplus₂ : Proof (b :: Γ) → Proof ((oplus a b) :: Γ) - | with : Proof (a :: Γ) → Proof (b :: Γ) → Proof ((a.with b) :: Γ) + | bot : Proof Γ → Proof (⊥ :: Γ) + | parr : Proof (a :: b :: Γ) → Proof ((a ⅋ b) :: Γ) + | tensor : Proof (a :: Γ) → Proof (b :: Δ) → Proof ((a ⊗ b) :: (Γ ++ Δ)) + | oplus₁ : Proof (a :: Γ) → Proof ((a ⊕ b) :: Γ) + | oplus₂ : Proof (b :: Γ) → Proof ((a ⊕ b) :: Γ) + | with : Proof (a :: Γ) → Proof (b :: Γ) → Proof ((a & b) :: Γ) | top : Proof (top :: Γ) - | quest : Proof (a :: Γ) → Proof (quest a :: Γ) - | weaken : Proof Γ → Proof (quest a :: Γ) - | contract : Proof (quest a :: quest a :: Γ) → Proof (quest a :: Γ) - | bang {Γ : @Sequent Atom} {a} : Γ.allQuest → Proof (a :: Γ) → Proof (bang a :: Γ) + | quest : Proof (a :: Γ) → Proof (ʔa :: Γ) + | weaken : Proof Γ → Proof (ʔa :: Γ) + | contract : Proof (ʔa :: ʔa :: Γ) → Proof (ʔa :: Γ) + | bang {Γ : Sequent Atom} {a} : Γ.allQuest → Proof (a :: Γ) → Proof ((!a) :: Γ) scoped notation "⊢" Γ:90 => Proof Γ @@ -174,14 +159,33 @@ section LogicalEquiv /-! ## Logical equivalences -/ /-- Two propositions are equivalent if one implies the other and vice versa. -/ -def Proposition.equiv (a b : @Proposition Atom) : Prop := ⊢[a.dual, b] ∧ ⊢[b.dual, a] +def Proposition.equiv (a b : Proposition Atom) : Prop := ⊢[a.dual, b] ∧ ⊢[b.dual, a] scoped infix:29 " ≡ " => Proposition.equiv namespace Proposition -/-- !⊤ ≡ 1 -/ -theorem bang_top_eqv_one : (@bang Atom ⊤) ≡ 1 := by +@[refl] +theorem refl (a : Proposition Atom) : a ≡ a := by + constructor + all_goals + apply Proof.exchange (List.Perm.swap ..) + exact Proof.ax + +@[symm] +theorem symm {a b : Proposition Atom} (h : a ≡ b) : b ≡ a := ⟨h.2, h.1⟩ + +theorem trans {a b c : Proposition Atom} (hab : a ≡ b) (hbc : b ≡ c) : a ≡ c := + ⟨ + Proof.cut (Proof.exchange (List.Perm.swap ..) hab.1) hbc.1, + Proof.cut (Proof.exchange (List.Perm.swap ..) hbc.2) hab.2 + ⟩ + +/-- The canonical equivalence relation for propositions. -/ +def propositionSetoid : Setoid (Proposition Atom) := + ⟨equiv, refl, symm, trans⟩ + +theorem bang_top_eqv_one : (!⊤ : Proposition Atom) ≡ 1 := by constructor · apply Proof.weaken exact Proof.one @@ -190,8 +194,7 @@ theorem bang_top_eqv_one : (@bang Atom ⊤) ≡ 1 := by · intro _ _; contradiction exact Proof.top -/-- ?0 ≡ ⊥ -/ -theorem quest_zero_eqv_bot : (@quest Atom 0) ≡ ⊥ := by +theorem quest_zero_eqv_bot : (ʔ0 : Proposition Atom) ≡ ⊥ := by constructor · apply Proof.exchange (List.Perm.swap (bang top) bot []) apply Proof.bot @@ -202,17 +205,13 @@ theorem quest_zero_eqv_bot : (@quest Atom 0) ≡ ⊥ := by apply Proof.weaken exact Proof.one -/-- a ⊗ 0 ≡ 0 -/ -theorem tensor_zero_eqv_zero (a : @Proposition Atom) : - a ⊗ 0 ≡ 0 := by - constructor - · apply Proof.parr - apply Proof.exchange (List.Perm.swap a.dual (top) [zero]) - exact Proof.top - · exact Proof.top +theorem tensor_zero_eqv_zero (a : Proposition Atom) : a ⊗ 0 ≡ 0 := by + refine ⟨?_, .top⟩ + apply Proof.parr + apply Proof.exchange (List.Perm.swap a.dual ⊤ [0]) + exact Proof.top -/-- a ⅋ ⊤ ≡ ⊤ -/ -theorem parr_top_eqv_top (a : @Proposition Atom) : +theorem parr_top_eqv_top (a : Proposition Atom) : a ⅋ ⊤ ≡ ⊤ := by constructor · apply Proof.exchange (List.Perm.swap (parr a top).dual top []) @@ -227,5 +226,3 @@ end Proposition end LogicalEquiv end CLL - -end CLL From 2f7bfa993282920f05365c2fabb1d6670af9924e Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Mon, 18 Aug 2025 00:18:38 -0400 Subject: [PATCH 056/107] term elaborator for selecting fresh variables (#32) * first pass at fresh_select * comment * single variables * naming, example * move synth outside of loop * placeholder for free configuration * correct pattern match * working with free variables * porting, tests * unused name * style: prefer mkAppN * consistent style * docs * style * use elab name free_union * documentation * docs typo * suggested doc wording * perf/style nit: don't check for impossible defeq * rename optItem to map --- .../LocallyNameless/Stlc/Basic.lean | 2 +- .../LocallyNameless/Untyped/FullBeta.lean | 8 +- .../Untyped/FullBetaConfluence.lean | 10 +-- .../LocallyNameless/Untyped/Properties.lean | 22 +++-- Cslib/Data/HasFresh.lean | 80 +++++++++++++++++++ CslibTests/HasFresh.lean | 21 +++++ 6 files changed, 120 insertions(+), 23 deletions(-) create mode 100644 CslibTests/HasFresh.lean diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean index e8110214..ec3465c6 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean @@ -158,7 +158,7 @@ theorem preservation_open {xs : Finset Var} : Γ ⊢ n ∶ σ → Γ ⊢ m ^ n ∶ τ := by intros mem der - have ⟨fresh, free⟩ := fresh_exists (xs ∪ m.fv) + have ⟨fresh, _⟩ := fresh_exists <| free_union (map := Term.fv) Var rw [subst_intro fresh n m (by aesop) der.lc] exact typing_subst_head (mem fresh (by aesop)) der diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean index 6491b468..04c4a701 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean @@ -115,11 +115,9 @@ lemma redex_abs_close {x : Var} : (M ↠βᶠ M') → (M⟦0 ↜ x⟧.abs ↠β theorem redex_abs_cong (xs : Finset Var) : (∀ x ∉ xs, (M ^ fvar x) ↠βᶠ (M' ^ fvar x)) → M.abs ↠βᶠ M'.abs := by intros mem - have ⟨fresh, union⟩ := fresh_exists (xs ∪ M.fv ∪ M'.fv) - simp only [Finset.union_assoc, Finset.mem_union, not_or] at union - obtain ⟨_, _, _⟩ := union + have ⟨fresh, _⟩ := fresh_exists <| free_union (map := fv) Var rw [←open_close fresh M 0 ?_, ←open_close fresh M' 0 ?_] - · exact redex_abs_close (mem fresh (by assumption)) - all_goals assumption + · exact redex_abs_close (mem fresh (by aesop)) + all_goals aesop end LambdaCalculus.LocallyNameless.Term.FullBeta diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean index a283d3ea..e2b49b39 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean @@ -147,11 +147,11 @@ lemma para_open_close (x y z) (para : M ⭢ₚ M') (_ : y ∉ M.fv ∪ M'.fv ∪ /-- Parallel substitution respects fresh opening. -/ lemma para_open_out (L : Finset Var) (mem : ∀ x, x ∉ L → (M ^ fvar x) ⭢ₚ N ^ fvar x) (para : M' ⭢ₚ N') : (M ^ M') ⭢ₚ (N ^ N') := by - let ⟨x, qx⟩ := fresh_exists (L ∪ N.fv ∪ M.fv) - simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx - obtain ⟨q1, q2, q3⟩ := qx - rw [subst_intro x M' _ q3 (para_lc_l para), subst_intro x N' _ q2 (para_lc_r para)] - exact para_subst x (mem x q1) para + let ⟨x, _⟩ := fresh_exists <| free_union (map := fv) Var + rw [subst_intro x M' _ ?_ (para_lc_l para), subst_intro x N' _ ?_ (para_lc_r para)] + · refine para_subst x (mem x ?_) para + aesop + all_goals aesop -- TODO: the Takahashi translation would be a much nicer and shorter proof, but I had difficultly -- writing it for locally nameless terms. diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean index e15244d8..7f114c3e 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean @@ -138,9 +138,7 @@ theorem beta_lc {M N : Term Var} (m_lc : M.abs.LC) : LC N → LC (M ^ N) := by cases m_lc case abs xs mem => intros n_lc - have ⟨y, ymem⟩ := fresh_exists (xs ∪ M.fv) - simp only [Finset.mem_union, not_or] at ymem - cases ymem + have ⟨y, _⟩ := fresh_exists <| free_union (map := fv) Var rw [subst_intro y N M (by aesop) (by assumption)] apply subst_lc <;> aesop @@ -151,7 +149,7 @@ lemma open_close_to_subst (m : Term Var) (x y : Var) (k : ℕ) (m_lc : LC m) : induction' m_lc case abs xs t x_mem ih => intros k - have ⟨x', x'_mem⟩ := fresh_exists ({x} ∪ {y} ∪ t.fv ∪ xs) + have ⟨x', _⟩ := fresh_exists <| free_union (map := fv) Var have s := subst_open_var x' x (fvar y) t (by aesop) (by constructor) simp only [closeRec_abs, openRec_abs, subst_abs] simp only [open'] at * @@ -169,14 +167,14 @@ lemma close_open (x : Var) (t : Term Var) (k : ℕ) : LC t → t⟦k ↜ x⟧⟦ case abs xs t t_open_lc ih => intros k simp only [closeRec_abs, openRec_abs, abs.injEq] - have ⟨y, hy⟩ := fresh_exists (xs ∪ t.fv ∪ (t⟦k + 1 ↜ x⟧⟦k + 1 ↝ fvar x⟧).fv ∪ {x}) - simp only [Finset.union_assoc, Finset.mem_union, Finset.mem_singleton, not_or] at hy - obtain ⟨q1, q2, q3, q4⟩ := hy - refine open_injective y _ _ q3 q2 ?_ - rw [←ih y q1 (k+1)] - simp only [open'] - rw [swap_open_fvar_close, swap_open_fvars] - all_goals aesop + let z := t⟦k + 1 ↜ x⟧⟦k + 1 ↝ fvar x⟧ + have ⟨y, _⟩ := fresh_exists <| free_union (map := fv) Var + refine open_injective y _ _ (by aesop) (by aesop) ?_ + rw [←ih y ?_ (k+1)] + · simp only [open'] + rw [swap_open_fvar_close, swap_open_fvars] + all_goals aesop + aesop all_goals aesop end LambdaCalculus.LocallyNameless.Term diff --git a/Cslib/Data/HasFresh.lean b/Cslib/Data/HasFresh.lean index 838bea73..be908326 100644 --- a/Cslib/Data/HasFresh.lean +++ b/Cslib/Data/HasFresh.lean @@ -30,6 +30,86 @@ in proofs. -/ theorem HasFresh.fresh_exists {α : Type u} [HasFresh α] (s : Finset α) : ∃ a, a ∉ s := ⟨fresh s, fresh_notMem s⟩ +open Lean Elab Term Meta Parser Tactic in +/-- + Given a `DecidableEq Var` instance, this elaborator automatically constructs the union of any + variables, finite sets of variables, and optionally the results of a provided function mapping to + variables. + + As an example, consider the following: + + ``` + variable {Var Term : Type} [DecidableEq Var] + + example (x : Var) (xs : Finset Var) : True := by + -- free : Finset Var := ∅ ∪ {x} ∪ xs + let free := free_union Var + trivial + + example (x : Var) (xs : Finset Var) (t : Term) (fv : Term → Finset Var) : True := by + -- free : Finset Var := ∅ ∪ {x} ∪ xs ∪ fv t + let free := free_union (map := fv) Var + trivial + ``` +-/ +elab "free_union" cfg:optConfig var:term : term => do + -- the type of our variables + let var ← elabType var + + -- handle the optional map calculation + let map ← + match cfg with + | `(optConfig| (map := $map:term)) => elabTerm map none + | _ => mkConst ``Empty + + let map_ty ← inferType map + + let map_dom := + match map_ty with + | Expr.forallE _ dom _ _ => dom + | _ => mkConst ``Empty + + let mut finsets := #[] + + -- construct ∅ + let dl ← getDecLevel var + let FinsetType := mkApp (mkConst ``Finset [dl]) var + let EmptyCollectionInst ← synthInstance (mkApp (mkConst ``EmptyCollection [dl]) FinsetType) + let empty := + mkAppN (mkConst ``EmptyCollection.emptyCollection [dl]) #[FinsetType, EmptyCollectionInst] + + let SingletonInst ← synthInstance <| mkAppN (mkConst ``Singleton [dl, dl]) #[var, FinsetType] + + for ldecl in (← getLCtx) do + if !ldecl.isImplementationDetail then + let local_type ← inferType (mkFVar ldecl.fvarId) + + -- any finite sets + if let (``Finset, #[var']) := local_type.getAppFnArgs then + if (← isDefEq var var') then + finsets := finsets.push ldecl.toExpr + else + -- singleton variables + if (← isDefEq local_type var) then + let singleton := + mkAppN + (mkConst ``Singleton.singleton [dl, dl]) + #[var, FinsetType, SingletonInst, ldecl.toExpr] + finsets := finsets.push singleton + else + -- map to variables + if (←isDefEq local_type map_dom) then + finsets := finsets.push (mkApp map ldecl.toExpr) + else + pure () + + -- construct a union fold + let UnionInst ← synthInstance (mkApp (mkConst ``Union [dl]) FinsetType) + let UnionFinset := mkAppN (mkConst `Union.union [dl]) #[FinsetType, UnionInst] + let union := finsets.foldl (mkApp2 UnionFinset) empty + + return union + export HasFresh (fresh fresh_notMem fresh_exists) lemma HasFresh.not_of_finite (α : Type u) [Fintype α] : IsEmpty (HasFresh α) := diff --git a/CslibTests/HasFresh.lean b/CslibTests/HasFresh.lean new file mode 100644 index 00000000..5297b051 --- /dev/null +++ b/CslibTests/HasFresh.lean @@ -0,0 +1,21 @@ +import Cslib.Data.HasFresh + +variable {Var Term : Type} [DecidableEq Var] [HasFresh Var] + +open HasFresh + +/-- An example picking free from `Var` and `Finset Var`. -/ +example (x : Var) (xs : Finset Var) : ∃ y, x ≠ y ∧ y ∉ xs := by + let ⟨fresh, _⟩ := fresh_exists <| free_union Var + exists fresh + aesop + +@[simp] +def fv : Term → Finset ℕ := fun _ ↦ {1, 2, 3} + +/-- An example including a specified `free` function. -/ +example (t : Term) (x : ℕ) (xs : Finset ℕ) : + ∃ y : ℕ, x ≠ y ∧ y ∉ xs ∧ y ∉ ({1, 2, 3} : Finset ℕ) := by + let ⟨fresh, _⟩ := fresh_exists <| free_union (map := @fv Term) ℕ + exists fresh + aesop From 26fa6a07f6e049c81c527c1b797ebb19a05a388d Mon Sep 17 00:00:00 2001 From: euprunin <178733547+euprunin@users.noreply.github.com> Date: Tue, 19 Aug 2025 20:06:26 +0200 Subject: [PATCH 057/107] chore(Data): golf entire `FinFun.congrFinFun` (#36) Co-authored-by: euprunin --- Cslib/Data/FinFun.lean | 10 +--------- 1 file changed, 1 insertion(+), 9 deletions(-) diff --git a/Cslib/Data/FinFun.lean b/Cslib/Data/FinFun.lean index 8f36f82e..cd875a5c 100644 --- a/Cslib/Data/FinFun.lean +++ b/Cslib/Data/FinFun.lean @@ -159,15 +159,7 @@ theorem FinFun.toDomFun_char (f : α ⇀ β) (h : x ∈ f.dom) : f.toDomFun ⟨ simp [FinFun.toDomFun] theorem FinFun.congrFinFun [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : f = g) (a : α) : - f.apply a = g.apply a := by - simp [FinFun.apply] - cases f - rename_i ff fdom - cases g - rename_i gf gdom - simp at h - obtain ⟨ h1, h2⟩ := h - exact congrFun h1 a + f.apply a = g.apply a := congrFun (congrArg apply h) a theorem FinFun.eq_char₁ [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : f = g) : f.f = g.f ∧ f.dom = g.dom := by From bfcb34ffe81f8e9e1079dde556ce591a452fc2b1 Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Tue, 19 Aug 2025 14:07:44 -0400 Subject: [PATCH 058/107] Migrate LambdaCalculus.LocallyNameless to `grind` (#35) * migrate to grind * have direction of open_close match other APIs * style * style * prefer simp to simp_all when possible * a couple of free_union --- .../LocallyNameless/{Stlc => }/Context.lean | 30 ++-- .../LocallyNameless/Stlc/Basic.lean | 108 +++++------- .../LocallyNameless/Stlc/Safety.lean | 54 +++--- .../LocallyNameless/Untyped/AesopRuleset.lean | 3 - .../LocallyNameless/Untyped/Basic.lean | 87 ++++----- .../LocallyNameless/Untyped/FullBeta.lean | 74 ++++---- .../Untyped/FullBetaConfluence.lean | 157 +++++++---------- .../LocallyNameless/Untyped/Properties.lean | 166 +++++++----------- Cslib/Data/HasFresh.lean | 2 +- 9 files changed, 283 insertions(+), 398 deletions(-) rename Cslib/Computability/LambdaCalculus/LocallyNameless/{Stlc => }/Context.lean (57%) delete mode 100644 Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/AesopRuleset.lean diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Context.lean similarity index 57% rename from Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean rename to Cslib/Computability/LambdaCalculus/LocallyNameless/Context.lean index 64d94f9b..c7006d84 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Context.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Context.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.AesopRuleset import Cslib.Syntax.HasWellFormed import Mathlib.Data.Finset.Defs import Mathlib.Data.Finset.Dedup @@ -20,19 +19,21 @@ universe u v variable {Var : Type u} {Ty : Type v} [DecidableEq Var] -namespace LambdaCalculus.LocallyNameless.Stlc +namespace LambdaCalculus.LocallyNameless /-- A typing context is a list of free variables and corresponding types. -/ abbrev Context (Var : Type u) (Ty : Type v) := List ((_ : Var) × Ty) namespace Context +open List + /-- The domain of a context is the finite set of free variables it uses. -/ -@[simp] -def dom : Context Var Ty → Finset Var := List.toFinset ∘ List.keys +@[simp, grind =] +def dom : Context Var Ty → Finset Var := toFinset ∘ keys /-- A well-formed context. -/ -abbrev Ok : Context Var Ty → Prop := List.NodupKeys +abbrev Ok : Context Var Ty → Prop := NodupKeys instance : HasWellFormed (Context Var Ty) := ⟨Ok⟩ @@ -40,20 +41,19 @@ instance : HasWellFormed (Context Var Ty) := variable {Γ Δ : Context Var Ty} /-- Context membership is preserved on permuting a context. -/ -theorem dom_perm_mem_iff (h : Γ.Perm Δ) {x : Var} : - x ∈ Γ.dom ↔ x ∈ Δ.dom := by - induction h <;> aesop +theorem dom_perm_mem_iff (h : Γ.Perm Δ) {x : Var} : x ∈ Γ.dom ↔ x ∈ Δ.dom := by + induction h <;> simp_all only [dom, Function.comp_apply, mem_toFinset, keys_cons, mem_cons] + grind omit [DecidableEq Var] in /-- Context well-formedness is preserved on permuting a context. -/ -@[aesop safe forward (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +@[scoped grind →] theorem wf_perm (h : Γ.Perm Δ) : Γ✓ → Δ✓ := (List.perm_nodupKeys h).mp omit [DecidableEq Var] in -@[aesop safe forward (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -theorem wf_strengthen : (Δ ++ ⟨x, σ⟩ :: Γ)✓ → (Δ ++ Γ)✓ := by - intros ok - have sl : List.Sublist (Δ ++ Γ) (Δ ++ ⟨x, σ⟩ :: Γ) := by simp - exact List.NodupKeys.sublist sl ok +/-- Context well-formedness is preserved on removing an element. -/ +@[scoped grind →] +theorem wf_strengthen (ok : (Δ ++ ⟨x, σ⟩ :: Γ)✓) : (Δ ++ Γ)✓ := by + exact List.NodupKeys.sublist (by simp) ok -end LambdaCalculus.LocallyNameless.Stlc.Context +end LambdaCalculus.LocallyNameless.Context diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean index ec3465c6..3cbca448 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Computability.LambdaCalculus.LocallyNameless.Stlc.Context +import Cslib.Computability.LambdaCalculus.LocallyNameless.Context import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Properties /-! # λ-calculus @@ -23,6 +23,8 @@ universe u v variable {Var : Type u} {Base : Type v} [DecidableEq Var] +open LambdaCalculus.LocallyNameless.Untyped Term + namespace LambdaCalculus.LocallyNameless.Stlc /-- Types of the simply typed lambda calculus. -/ @@ -34,10 +36,9 @@ inductive Ty (Base : Type v) scoped infixr:70 " ⤳ " => Ty.arrow -open Term Ty +open Ty Context /-- An extrinsic typing derivation for locally nameless terms. -/ -@[aesop unsafe [constructors (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])]] inductive Typing : Context Var (Ty Base) → Term Var → Ty Base → Prop /-- Free variables, from a context judgement. -/ | var : Γ✓ → ⟨x,σ⟩ ∈ Γ → Typing Γ (fvar x) σ @@ -46,7 +47,9 @@ inductive Typing : Context Var (Ty Base) → Term Var → Ty Base → Prop /-- Function application. -/ | app : Typing Γ t (σ ⤳ τ) → Typing Γ t' σ → Typing Γ (app t t') τ -scoped notation:50 Γ " ⊢ " t " ∶" τ:arg => Typing Γ t τ +attribute [scoped grind] Typing.var Typing.app + +scoped notation:50 Γ " ⊢ " t " ∶ " τ:arg => Typing Γ t τ namespace Typing @@ -54,112 +57,87 @@ variable {Γ Δ Θ : Context Var (Ty Base)} omit [DecidableEq Var] in /-- Typing is preserved on permuting a context. -/ -theorem perm (ht : Γ ⊢ t ∶τ) (hperm : Γ.Perm Δ) : Δ ⊢ t ∶ τ := by - revert Δ - induction ht <;> intros Δ p - case app => aesop - case var => - have := @p.mem_iff - aesop +theorem perm (ht : Γ ⊢ t ∶ τ) (hperm : Γ.Perm Δ) : Δ ⊢ t ∶ τ := by + induction ht generalizing Δ case abs ih => constructor intros x mem - exact ih x mem (by aesop) + exact ih x mem (by simp_all) + all_goals grind /-- Weakening of a typing derivation with an appended context. -/ -lemma weaken_aux : - Γ ++ Δ ⊢ t ∶ τ → (Γ ++ Θ ++ Δ)✓ → (Γ ++ Θ ++ Δ) ⊢ t ∶ τ := by - generalize eq : Γ ++ Δ = Γ_Δ - intros h - revert Γ Δ Θ - induction h <;> intros Γ Δ Θ eq ok_Γ_Θ_Δ - case var => aesop - case app => aesop +lemma weaken_aux (der : Γ ++ Δ ⊢ t ∶ τ) : (Γ ++ Θ ++ Δ)✓ → (Γ ++ Θ ++ Δ) ⊢ t ∶ τ := by + generalize eq : Γ ++ Δ = Γ_Δ at der + induction der generalizing Γ Δ Θ <;> intros ok_Γ_Θ_Δ case abs σ Γ' τ t xs ext ih => apply Typing.abs (xs ∪ (Γ ++ Θ ++ Δ).dom) intros x _ - have h : ⟨x, σ⟩ :: Γ ++ Δ = ⟨x, σ⟩ :: Γ' := by aesop - refine @ih x (by aesop) _ _ Θ h ?_ - simp only [HasWellFormed.wf] - aesop + have h : ⟨x, σ⟩ :: Γ ++ Δ = ⟨x, σ⟩ :: Γ' := by grind + refine @ih x (by grind) _ _ Θ h ?_ + simp_all [HasWellFormed.wf] + all_goals grind /-- Weakening of a typing derivation by an additional context. -/ -lemma weaken : Γ ⊢ t ∶ τ → (Γ ++ Δ)✓ → Γ ++ Δ ⊢ t ∶ τ := by - intros der ok +lemma weaken (der : Γ ⊢ t ∶ τ) (ok : (Γ ++ Δ)✓) : Γ ++ Δ ⊢ t ∶ τ := by rw [←List.append_nil (Γ ++ Δ)] at * exact weaken_aux (by simp_all) ok omit [DecidableEq Var] in /-- Typing derivations exist only for locally closed terms. -/ -lemma lc : Γ ⊢ t ∶ τ → t.LC := by - intros h - induction h <;> constructor +lemma lc (der : Γ ⊢ t ∶ τ) : t.LC := by + induction der <;> constructor case abs ih => exact ih - all_goals aesop + all_goals grind variable [HasFresh Var] open Term /-- Substitution for a context weakened by a single type between appended contexts. -/ -lemma subst_aux : - (Δ ++ ⟨x, σ⟩ :: Γ) ⊢ t ∶ τ → - Γ ⊢ s ∶ σ → - (Δ ++ Γ) ⊢ (t [x := s]) ∶ τ := by - generalize eq : Δ ++ ⟨x, σ⟩ :: Γ = Θ - intros h - revert Γ Δ - induction h <;> intros Γ Δ eq der - case app => aesop +lemma subst_aux (h : Δ ++ ⟨x, σ⟩ :: Γ ⊢ t ∶ τ) (der : Γ ⊢ s ∶ σ) : + Δ ++ Γ ⊢ t[x := s] ∶ τ := by + generalize eq : Δ ++ ⟨x, σ⟩ :: Γ = Θ at h + induction h generalizing Γ Δ der + case app => grind case var x' τ ok mem => simp only [subst_fvar] - rw [←eq] at mem - rw [←eq] at ok - cases (Context.wf_perm (by aesop) ok : (⟨x, σ⟩ :: Δ ++ Γ)✓) + subst eq + cases (Context.wf_perm (by simp) ok : (⟨x, σ⟩ :: Δ ++ Γ)✓) case cons ok_weak _ => observe perm : (Γ ++ Δ).Perm (Δ ++ Γ) by_cases h : x = x' <;> simp only [h] - case neg => aesop + case neg => grind case pos nmem => - subst h eq + subst h have nmem_Γ : ∀ γ, ⟨x, γ⟩ ∉ Γ := by intros γ _ - exact nmem x (List.mem_keys.mpr ⟨γ, by aesop⟩) rfl + exact nmem x (List.mem_keys.mpr ⟨γ, by simp_all⟩) rfl have nmem_Δ : ∀ γ, ⟨x, γ⟩ ∉ Δ := by intros γ _ - exact nmem x (List.mem_keys.mpr ⟨γ, by aesop⟩) rfl + exact nmem x (List.mem_keys.mpr ⟨γ, by simp_all⟩) rfl have eq' : τ = σ := by simp only [List.mem_append, List.mem_cons, Sigma.mk.injEq, heq_eq_eq] at mem - match mem with | _ => aesop + match mem with | _ => simp_all rw [eq'] refine (weaken der ?_).perm perm exact Context.wf_perm (id (List.Perm.symm perm)) ok_weak case abs σ Γ' t T2 xs ih' ih => apply Typing.abs (xs ∪ {x} ∪ (Δ ++ Γ).dom) - intros x _ - rw [ - subst_def, - subst_open_var _ _ _ _ (by aesop) der.lc, - show ⟨x, σ⟩ :: (Δ ++ Γ) = (⟨x, σ⟩ :: Δ) ++ Γ by aesop - ] - apply ih <;> aesop + intros + rw [subst_def, ←subst_open_var _ _ _ _ ?_ der.lc] <;> grind /-- Substitution for a context weakened by a single type. -/ -lemma typing_subst_head : - ⟨x, σ⟩ :: Γ ⊢ t ∶ τ → Γ ⊢ s ∶ σ → Γ ⊢ (t [x := s]) ∶ τ := by - intros weak der +lemma typing_subst_head (weak : ⟨x, σ⟩ :: Γ ⊢ t ∶ τ) (der : Γ ⊢ s ∶ σ) : + Γ ⊢ (t [x := s]) ∶ τ := by rw [←List.nil_append Γ] exact subst_aux weak der /-- Typing preservation for opening. -/ -@[aesop safe forward (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -theorem preservation_open {xs : Finset Var} : - (∀ x ∉ xs, ⟨x, σ⟩ :: Γ ⊢ m ^ fvar x ∶ τ) → - Γ ⊢ n ∶ σ → Γ ⊢ m ^ n ∶ τ - := by - intros mem der +theorem preservation_open {xs : Finset Var} + (cofin : ∀ x ∉ xs, ⟨x, σ⟩ :: Γ ⊢ m ^ fvar x ∶ τ) (der : Γ ⊢ n ∶ σ) : + Γ ⊢ m ^ n ∶ τ := by have ⟨fresh, _⟩ := fresh_exists <| free_union (map := Term.fv) Var - rw [subst_intro fresh n m (by aesop) der.lc] - exact typing_subst_head (mem fresh (by aesop)) der + rw [subst_intro fresh n m (by grind) der.lc] + exact typing_subst_head (by grind) der end LambdaCalculus.LocallyNameless.Stlc.Typing diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Safety.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Safety.lean index 33c8add3..ed74dd6e 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Safety.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Safety.lean @@ -24,9 +24,9 @@ Theorems in this file are namespaced by their respective reductions. universe u v -namespace LambdaCalculus.LocallyNameless +namespace LambdaCalculus.LocallyNameless.Stlc -open Stlc Typing +open Untyped Typing variable {Var : Type u} {Base : Type v} {R : Term Var → Term Var → Prop} @@ -34,42 +34,44 @@ def PreservesTyping (R : Term Var → Term Var → Prop) (Base : Type v) := ∀ {Γ t t'} {τ : Ty Base}, Γ ⊢ t ∶ τ → R t t' → Γ ⊢ t' ∶ τ /-- If a reduction preserves types, so does its reflexive transitive closure. -/ -@[aesop safe forward (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +@[scoped grind →] theorem redex_preservesTyping : PreservesTyping R Base → PreservesTyping (Relation.ReflTransGen R) Base := by intros _ _ _ _ _ _ redex - induction redex <;> aesop + induction redex <;> [grind; aesop] open Relation in /-- Confluence preserves type preservation. -/ -theorem confluence_preservesTyping {τ : Ty Base} : - Confluence R → PreservesTyping R Base → Γ ⊢ a ∶ τ → - (ReflTransGen R) a b → (ReflTransGen R) a c → - ∃ d, (ReflTransGen R) b d ∧ (ReflTransGen R) c d ∧ Γ ⊢ d ∶ τ := by - intros con p der ab ac +theorem confluence_preservesTyping {τ : Ty Base} + (con : Confluence R) (p : PreservesTyping R Base) (der : Γ ⊢ a ∶ τ) + (ab : ReflTransGen R a b) (ac : ReflTransGen R a c) : + ∃ d, ReflTransGen R b d ∧ ReflTransGen R c d ∧ Γ ⊢ d ∶ τ := by have ⟨d, bd, cd⟩ := con ab ac exact ⟨d, bd, cd, redex_preservesTyping p der (ab.trans bd)⟩ - + variable [HasFresh Var] [DecidableEq Var] {Γ : Context Var (Ty Base)} -namespace Term.FullBeta +namespace FullBeta -/-- Typing preservation for full beta reduction. -/ -@[aesop safe forward (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -theorem preservation : Γ ⊢ t ∶ τ → (t ⭢βᶠt') → Γ ⊢ t' ∶ τ := by - intros der - revert t' - induction der <;> intros t' step <;> cases step - case' abs.abs xs _ _ _ xs' _=> apply Typing.abs (xs ∪ xs') - case' app.beta der_l _ _ => cases der_l - all_goals aesop +open LambdaCalculus.LocallyNameless.Untyped.Term FullBeta +/-- Typing preservation for full beta reduction. -/ +@[scoped grind →] +theorem preservation (der : Γ ⊢ t ∶ τ) (step : t ⭢βᶠ t') : Γ ⊢ t' ∶ τ := by + induction der generalizing t' <;> cases step + case abs.abs xs _ _ _ xs' _ => apply Typing.abs (free_union Var); grind + case app.beta der _ _ _ der_l _ _ => + -- TODO: this is a regression from aesop, where `preservation_open` was a forward rule + cases der_l with | abs _ cofin => simp [preservation_open cofin der] + all_goals grind + +open scoped Term in omit [HasFresh Var] [DecidableEq Var] in /-- A typed term either full beta reduces or is a value. -/ -theorem progress {t : Term Var} {τ : Ty Base} (ht : [] ⊢ t ∶τ) : t.Value ∨ ∃ t', t ⭢βᶠ t' := by +theorem progress {t : Term Var} {τ : Ty Base} (ht : [] ⊢ t ∶ τ) : t.Value ∨ ∃ t', t ⭢βᶠ t' := by generalize eq : [] = Γ at ht induction ht - case var => aesop + case var => simp_all case abs xs mem ih => left constructor @@ -83,10 +85,12 @@ theorem progress {t : Term Var} {τ : Ty Base} (ht : [] ⊢ t ∶τ) : t.Value -- if the lhs is a value, beta reduce the application next val => cases val - next M M_abs_lc => exact ⟨M ^ N, FullBeta.beta M_abs_lc der_r.lc⟩ + next M M_abs_lc => exact ⟨M ^ N, Term.FullBeta.beta M_abs_lc der_r.lc⟩ -- otherwise, propogate the step to the lhs of the application next step => obtain ⟨M', stepM⟩ := step - exact ⟨M'.app N, FullBeta.appR der_r.lc stepM⟩ + exact ⟨M'.app N, Term.FullBeta.appR der_r.lc stepM⟩ + +end FullBeta -end LambdaCalculus.LocallyNameless.Term.FullBeta +end LambdaCalculus.LocallyNameless.Stlc diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/AesopRuleset.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/AesopRuleset.lean deleted file mode 100644 index 1e43b5ba..00000000 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/AesopRuleset.lean +++ /dev/null @@ -1,3 +0,0 @@ -import Aesop - -declare_aesop_rule_sets [LambdaCalculus.LocallyNameless.ruleSet] (default := true) diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean index 60c31b63..3a7fabd7 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean @@ -6,7 +6,6 @@ Authors: Chris Henson import Cslib.Data.HasFresh import Cslib.Syntax.HasSubstitution -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.AesopRuleset /-! # λ-calculus @@ -24,7 +23,7 @@ universe u variable {Var : Type u} [HasFresh Var] [DecidableEq Var] -namespace LambdaCalculus.LocallyNameless +namespace LambdaCalculus.LocallyNameless.Untyped /-- Syntax of locally nameless lambda terms, with free variables over `Var`. -/ inductive Term (Var : Type u) @@ -40,6 +39,7 @@ inductive Term (Var : Type u) namespace Term /-- Variable opening of the ith bound variable. -/ +@[scoped grind =] def openRec (i : ℕ) (sub : Term Var) : Term Var → Term Var | bvar i' => if i = i' then sub else bvar i' | fvar x => fvar x @@ -48,24 +48,22 @@ def openRec (i : ℕ) (sub : Term Var) : Term Var → Term Var scoped notation:68 e "⟦" i " ↝ " sub "⟧"=> Term.openRec i sub e -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] lemma openRec_bvar : (bvar i')⟦i ↝ s⟧ = if i = i' then s else bvar i' := by rfl -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] lemma openRec_fvar : (fvar x)⟦i ↝ s⟧ = fvar x := by rfl -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] lemma openRec_app : (app l r)⟦i ↝ s⟧ = app (l⟦i ↝ s⟧) (r⟦i ↝ s⟧) := by rfl -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] lemma openRec_abs : M.abs⟦i ↝ s⟧ = M⟦i + 1 ↝ s⟧.abs := by rfl /-- Variable opening of the closest binding. -/ +@[scoped grind =] def open' {X} (e u):= @Term.openRec X 0 u e -infixr:80 " ^ " => Term.open' +scoped infixr:80 " ^ " => Term.open' /-- Variable closing, replacing a free `fvar x` with `bvar k` -/ +@[scoped grind =] def closeRec (k : ℕ) (x : Var) : Term Var → Term Var | fvar x' => if x = x' then bvar k else fvar x' | bvar i => bvar i @@ -76,28 +74,14 @@ scoped notation:68 e "⟦" k " ↜ " x "⟧"=> Term.closeRec k x e variable {x : Var} -omit [HasFresh Var] in -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma closeRec_bvar : (bvar i)⟦k ↜ x⟧ = bvar i := by rfl - -omit [HasFresh Var] in -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma closeRec_fvar : (fvar x')⟦k ↜ x⟧ = if x = x' then bvar k else fvar x' := by rfl - -omit [HasFresh Var] in -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma closeRec_app : (app l r)⟦k ↜ x⟧ = app (l⟦k ↜ x⟧) (r⟦k ↜ x⟧) := by rfl - -omit [HasFresh Var] in -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma closeRec_abs : t.abs⟦k ↜ x⟧ = t⟦k + 1 ↜ x⟧.abs := by rfl - /-- Variable closing of the closest binding. -/ +@[scoped grind =] def close {Var} [DecidableEq Var] (e u):= @Term.closeRec Var _ 0 u e -infixr:80 " ^* " => Term.close +scoped infixr:80 " ^* " => Term.close /- Substitution of a free variable to a term. -/ +@[scoped grind =] def subst (m : Term Var) (x : Var) (sub : Term Var) : Term Var := match m with | bvar i => bvar i @@ -109,28 +93,8 @@ def subst (m : Term Var) (x : Var) (sub : Term Var) : Term Var := instance instHasSubstitutionTerm : HasSubstitution (Term Var) Var where subst := Term.subst -omit [HasFresh Var] in -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma subst_bvar {n : Term Var} : (bvar i)[x := n] = bvar i := by rfl - -omit [HasFresh Var] in -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma subst_fvar : (fvar x')[x := n] = if x = x' then n else fvar x' := by rfl - -omit [HasFresh Var] in -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma subst_app {l r : Term Var} : (app l r)[x := n] = app (l[x := n]) (r[x := n]) := by rfl - -omit [HasFresh Var] in -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma subst_abs {M : Term Var} : M.abs[x := n] = M[x := n].abs := by rfl - -omit [HasFresh Var] in -@[aesop norm (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma subst_def (m : Term Var) (x : Var) (n : Term Var) : m.subst x n = m[x := n] := by rfl - /-- Free variables of a term. -/ -@[simp] +@[simp, scoped grind =] def fv : Term Var → Finset Var | bvar _ => {} | fvar x => {x} @@ -138,13 +102,40 @@ def fv : Term Var → Finset Var | app l r => l.fv ∪ r.fv /-- Locally closed terms. -/ -@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet]) [constructors]] inductive LC : Term Var → Prop | fvar (x) : LC (fvar x) -| abs (L : Finset Var) (e : Term Var) : (∀ x : Var, x ∉ L → LC (e ^ fvar x)) → LC (abs e) +| 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 + inductive Value : Term Var → Prop | abs (e : Term Var) : e.abs.LC → e.abs.Value -end LambdaCalculus.LocallyNameless.Term +section + +omit [HasFresh Var] + +lemma closeRec_bvar : (bvar i)⟦k ↜ x⟧ = bvar i := by rfl + +lemma closeRec_fvar : (fvar x')⟦k ↜ x⟧ = if x = x' then bvar k else fvar x' := by rfl + +lemma closeRec_app : (app l r)⟦k ↜ x⟧ = app (l⟦k ↜ x⟧) (r⟦k ↜ x⟧) := by rfl + +lemma closeRec_abs : t.abs⟦k ↜ x⟧ = t⟦k + 1 ↜ x⟧.abs := by rfl + +lemma subst_bvar {n : Term Var} : (bvar i)[x := n] = bvar i := by rfl + +lemma subst_fvar : (fvar x')[x := n] = if x = x' then n else fvar x' := by rfl + +lemma subst_app {l r : Term Var} : (app l r)[x := n] = app (l[x := n]) (r[x := n]) := by rfl + +lemma subst_abs {M : Term Var} : M.abs[x := n] = M[x := n].abs := by rfl + +lemma subst_def (m : Term Var) (x : Var) (n : Term Var) : m.subst x n = m[x := n] := by rfl + +attribute [scoped grind =] subst_bvar subst_fvar subst_app subst_abs subst_def + +end + +end LambdaCalculus.LocallyNameless.Untyped.Term diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean index 04c4a701..ae22ab76 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean @@ -22,7 +22,7 @@ universe u variable {Var : Type u} -namespace LambdaCalculus.LocallyNameless.Term +namespace LambdaCalculus.LocallyNameless.Untyped.Term /-- A single β-reduction step. -/ @[reduction_sys fullBetaRs "βᶠ"] @@ -38,23 +38,32 @@ inductive FullBeta : Term Var → Term Var → Prop namespace FullBeta +attribute [scoped grind] appL appR + variable {M M' N N' : Term Var} +--- TODO: I think this could be generated along with the ReductionSystem +@[scoped grind _=_] +private lemma fullBetaRs_Red_eq : M ⭢βᶠ N ↔ FullBeta M N := by + have : (@fullBetaRs Var).Red = FullBeta := by rfl + simp_all + /-- The left side of a reduction is locally closed. -/ +@[scoped grind →] lemma step_lc_l (step : M ⭢βᶠ M') : LC M := by induction step <;> constructor all_goals assumption /-- Left congruence rule for application in multiple reduction. -/ -theorem redex_app_l_cong : (M ↠βᶠ M') → LC N → (app M N ↠βᶠ app M' N) := by - intros redex lc_N +@[scoped grind ←] +theorem redex_app_l_cong (redex : M ↠βᶠ M') (lc_N : LC N) : app M N ↠βᶠ app M' N := by induction' redex case refl => rfl case tail ih r => exact Relation.ReflTransGen.tail r (appR lc_N ih) /-- Right congruence rule for application in multiple reduction. -/ -theorem redex_app_r_cong : (M ↠βᶠ M') → LC N → (app N M ↠βᶠ app N M') := by - intros redex lc_N +@[scoped grind ←] +theorem redex_app_r_cong (redex : M ↠βᶠ M') (lc_N : LC N) : app N M ↠βᶠ app N M' := by induction' redex case refl => rfl case tail ih r => exact Relation.ReflTransGen.tail r (appL lc_N ih) @@ -62,62 +71,43 @@ theorem redex_app_r_cong : (M ↠βᶠ M') → LC N → (app N M ↠βᶠ app N variable [HasFresh Var] [DecidableEq Var] /-- The right side of a reduction is locally closed. -/ +@[scoped grind →] lemma step_lc_r (step : M ⭢βᶠ M') : LC M' := by induction step - case beta => apply beta_lc <;> assumption - all_goals try constructor <;> assumption + case' abs => constructor; assumption + all_goals grind /-- Substitution respects a single reduction step. -/ -lemma redex_subst_cong (s s' : Term Var) (x y : Var) : - s ⭢βᶠ s' → s [ x := fvar y ] ⭢βᶠ s' [ x := fvar y ] := by - intros step +lemma redex_subst_cong (s s' : Term Var) (x y : Var) (step : s ⭢βᶠ s') : + s [ x := fvar y ] ⭢βᶠ s' [ x := fvar y ] := by induction step - case appL ih => exact appL (subst_lc (by assumption) (by constructor)) ih - case appR ih => exact appR (subst_lc (by assumption) (by constructor)) ih case beta m n abs_lc n_lc => cases abs_lc with | abs xs _ mem => - simp only [open'] - rw [subst_open x (fvar y) 0 n m (by constructor)] - refine beta ?_ (subst_lc n_lc (by constructor)) + rw [subst_open x (fvar y) n m (by grind)] + refine beta ?_ (by grind) exact subst_lc (LC.abs xs m mem) (LC.fvar y) case abs m' m xs mem ih => - apply abs ({x} ∪ xs) - intros z z_mem - simp only [open'] - rw [ - subst_def, subst_def, - ←subst_fresh x (fvar z) (fvar y), ←subst_open x (fvar y) 0 (fvar z) m (by constructor), - subst_fresh x (fvar z) (fvar y), ←subst_fresh x (fvar z) (fvar y), - ←subst_open x (fvar y) 0 (fvar z) m' (by constructor), subst_fresh x (fvar z) (fvar y) - ] - all_goals aesop + apply abs (free_union Var) + grind + all_goals grind /-- Abstracting then closing preserves a single reduction. -/ -lemma step_abs_close {x : Var} : (M ⭢βᶠ M') → (M⟦0 ↜ x⟧.abs ⭢βᶠ M'⟦0 ↜ x⟧.abs) := by - intros step +lemma step_abs_close {x : Var} (step : M ⭢βᶠ M') : M⟦0 ↜ x⟧.abs ⭢βᶠ M'⟦0 ↜ x⟧.abs := by apply abs ∅ - intros y _ - simp only [open'] - repeat rw [open_close_to_subst] - · exact redex_subst_cong M M' x y step - · exact step_lc_r step - · exact step_lc_l step + grind [redex_subst_cong] /-- Abstracting then closing preserves multiple reductions. -/ -lemma redex_abs_close {x : Var} : (M ↠βᶠ M') → (M⟦0 ↜ x⟧.abs ↠βᶠ M'⟦0 ↜ x⟧.abs) := by - intros step +lemma redex_abs_close {x : Var} (step : M ↠βᶠ M') : (M⟦0 ↜ x⟧.abs ↠βᶠ M'⟦0 ↜ x⟧.abs) := by induction step using Relation.ReflTransGen.trans_induction_on case refl => rfl case single ih => exact Relation.ReflTransGen.single (step_abs_close ih) case trans l r => exact .trans l r /-- Multiple reduction of opening implies multiple reduction of abstraction. -/ -theorem redex_abs_cong (xs : Finset Var) : - (∀ x ∉ xs, (M ^ fvar x) ↠βᶠ (M' ^ fvar x)) → M.abs ↠βᶠ M'.abs := by - intros mem +theorem redex_abs_cong (xs : Finset Var) (cofin : ∀ x ∉ xs, (M ^ fvar x) ↠βᶠ (M' ^ fvar x)) : + M.abs ↠βᶠ M'.abs := by have ⟨fresh, _⟩ := fresh_exists <| free_union (map := fv) Var - rw [←open_close fresh M 0 ?_, ←open_close fresh M' 0 ?_] - · exact redex_abs_close (mem fresh (by aesop)) - all_goals aesop + rw [open_close fresh M 0 ?_, open_close fresh M' 0 ?_] + all_goals grind [redex_abs_close] -end LambdaCalculus.LocallyNameless.Term.FullBeta +end LambdaCalculus.LocallyNameless.Untyped.Term.FullBeta diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean index e2b49b39..9b066e4b 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean @@ -15,11 +15,10 @@ universe u variable {Var : Type u} -namespace LambdaCalculus.LocallyNameless.Term +namespace LambdaCalculus.LocallyNameless.Untyped.Term /-- A parallel β-reduction step. -/ -@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet]) [constructors], - reduction_sys paraRs "ₚ"] +@[reduction_sys paraRs "ₚ"] inductive Parallel : Term Var → Term Var → Prop /-- Free variables parallel step to themselves. -/ | fvar (x : Var) : Parallel (fvar x) (fvar x) @@ -34,73 +33,71 @@ inductive Parallel : Term Var → Term Var → Prop Parallel n n' → Parallel (app (abs m) n) (m' ^ n') --- TODO: I think this could be generated along with `para_rs` -lemma para_rs_Red_eq {α} : (@paraRs α).Red = Parallel := by rfl +open Parallel + +attribute [scoped grind] Parallel.fvar Parallel.app +attribute [scoped grind cases] Parallel variable {M M' N N' : Term Var} +--- TODO: I think this could be generated along with the ReductionSystem +@[scoped grind _=_] +private lemma para_rs_Red_eq : M ⭢ₚ N ↔ Parallel M N := by + have : (@paraRs Var).Red = Parallel := by rfl + simp_all + /-- The left side of a parallel reduction is locally closed. -/ -@[aesop unsafe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +@[scoped grind] lemma para_lc_l (step : M ⭢ₚ N) : LC M := by induction step case abs _ _ xs _ ih => exact LC.abs xs _ ih case beta => refine LC.app (LC.abs ?_ _ ?_) ?_ <;> assumption - all_goals constructor <;> assumption + all_goals grind /-- Parallel reduction is reflexive for locally closed terms. -/ -@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +@[scoped grind] lemma Parallel.lc_refl (M : Term Var) (lc : LC M) : M ⭢ₚ M := by induction lc all_goals constructor <;> assumption --- TODO: better ways to handle this? --- The problem is that sometimes when we apply a theorem we get out of our notation, so aesop can't --- see they are the same, including constructors. -@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma Parallel.lc_refl' (M : Term Var) : LC M → Parallel M M := Parallel.lc_refl M - variable [HasFresh Var] [DecidableEq Var] /-- The right side of a parallel reduction is locally closed. -/ -@[aesop unsafe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] +@[scoped grind] lemma para_lc_r (step : M ⭢ₚ N) : LC N := by induction step case abs _ _ xs _ ih => exact LC.abs xs _ ih case beta => refine beta_lc (LC.abs ?_ _ ?_) ?_ <;> assumption - all_goals constructor <;> assumption + all_goals grind omit [HasFresh Var] [DecidableEq Var] in /-- A single β-reduction implies a single parallel reduction. -/ lemma step_to_para (step : M ⭢βᶠ N) : M ⭢ₚ N := by - induction step <;> simp only [para_rs_Red_eq] - case beta _ abs_lc _ => cases abs_lc with | abs xs _ => - apply Parallel.beta xs <;> intros <;> apply Parallel.lc_refl <;> aesop - all_goals aesop (config := {enableSimp := false}) + induction step + case beta _ abs_lc _ => cases abs_lc with | abs xs _ => apply Parallel.beta xs <;> grind + case abs xs _ _ => apply Parallel.abs xs; grind + all_goals grind open FullBeta in /-- A single parallel reduction implies a multiple β-reduction. -/ lemma para_to_redex (para : M ⭢ₚ N) : M ↠βᶠ N := by induction para case fvar => constructor - case app _ _ _ _ l_para m_para redex_l redex_m => - trans - · exact redex_app_l_cong redex_l (para_lc_l m_para) - exact redex_app_r_cong redex_m (para_lc_r l_para) + case app L L' R R' l_para m_para redex_l redex_m => + refine .trans (?_ : L.app R ↠βᶠ L'.app R) (?_ : L'.app R ↠βᶠ L'.app R') <;> grind case abs t t' xs _ ih => apply redex_abs_cong xs - intros x mem - exact ih x mem + grind case beta m m' n n' xs para_ih para_n redex_ih redex_n => have m'_abs_lc : LC m'.abs := by apply LC.abs xs - intros _ mem - exact para_lc_r (para_ih _ mem) + grind calc m.abs.app n ↠βᶠ m'.abs.app n := redex_app_l_cong (redex_abs_cong xs (fun _ mem ↦ redex_ih _ mem)) (para_lc_l para_n) - _ ↠βᶠ m'.abs.app n' := redex_app_r_cong redex_n m'_abs_lc - _ ⭢βᶠ m' ^ n' := beta m'_abs_lc (para_lc_r para_n) + _ ↠βᶠ m'.abs.app n' := by grind + _ ⭢βᶠ m' ^ n' := beta m'_abs_lc (by grind) /-- Multiple parallel reduction is equivalent to multiple β-reduction. -/ theorem parachain_iff_redex : M ↠ₚ N ↔ M ↠βᶠ N := by @@ -109,49 +106,27 @@ theorem parachain_iff_redex : M ↠ₚ N ↔ M ↠βᶠ N := by case chain_redex.tail para redex => exact Relation.ReflTransGen.trans redex (para_to_redex para) /-- Parallel reduction respects substitution. -/ +@[scoped grind] lemma para_subst (x : Var) (pm : M ⭢ₚ M') (pn : N ⭢ₚ N') : M[x := N] ⭢ₚ M'[x := N'] := by induction pm - case fvar => aesop - case beta _ _ _ _ xs _ _ ih _ => - simp only [open'] - rw [subst_open _ _ _ _ _ (para_lc_r pn)] - refine Parallel.beta (xs ∪ {x}) ?_ (by assumption) - · intros y ymem - simp only [Finset.mem_union, Finset.mem_singleton, not_or] at ymem - push_neg at ymem - rw [ - subst_def, - subst_open_var _ _ _ _ _ (para_lc_r pn), - subst_open_var _ _ _ _ _ (para_lc_l pn) - ] <;> aesop + case fvar => grind + case beta => + rw [subst_open _ _ _ _ (by grind)] + refine Parallel.beta (free_union Var) ?_ ?_ <;> grind case app => constructor <;> assumption case abs u u' xs mem ih => - apply Parallel.abs (xs ∪ {x}) - intros y ymem - simp only [Finset.mem_union, Finset.mem_singleton, not_or] at ymem - repeat rw [subst_def] - push_neg at ymem - rw [ - subst_open_var _ _ _ _ ?_ (para_lc_l pn), - subst_open_var _ _ _ _ ?_ (para_lc_r pn) - ] <;> aesop + apply Parallel.abs (free_union Var) + grind /-- Parallel substitution respects closing and opening. -/ lemma para_open_close (x y z) (para : M ⭢ₚ M') (_ : y ∉ M.fv ∪ M'.fv ∪ {x}) : - M⟦z ↜ x⟧⟦z ↝ fvar y⟧ ⭢ₚ M'⟦z ↜ x⟧⟦z ↝ fvar y⟧ := by - simp only [Finset.union_assoc, Finset.mem_union, Finset.mem_singleton, not_or] at * - rw [open_close_to_subst _ _ _ _ (para_lc_l para), open_close_to_subst _ _ _ _ (para_lc_r para)] - apply para_subst _ para - constructor + M⟦z ↜ x⟧⟦z ↝ fvar y⟧ ⭢ₚ M'⟦z ↜ x⟧⟦z ↝ fvar y⟧ := by grind /-- Parallel substitution respects fresh opening. -/ lemma para_open_out (L : Finset Var) (mem : ∀ x, x ∉ L → (M ^ fvar x) ⭢ₚ N ^ fvar x) (para : M' ⭢ₚ N') : (M ^ M') ⭢ₚ (N ^ N') := by let ⟨x, _⟩ := fresh_exists <| free_union (map := fv) Var - rw [subst_intro x M' _ ?_ (para_lc_l para), subst_intro x N' _ ?_ (para_lc_r para)] - · refine para_subst x (mem x ?_) para - aesop - all_goals aesop + grind -- TODO: the Takahashi translation would be a much nicer and shorter proof, but I had difficultly -- writing it for locally nameless terms. @@ -162,74 +137,60 @@ theorem para_diamond : Diamond (@Parallel Var) := by intros t t1 t2 tpt1 revert t2 induction tpt1 <;> intros t2 tpt2 - case fvar x => exact ⟨t2, by aesop⟩ + case fvar x => exact ⟨t2, by grind⟩ case abs s1 s2' xs mem ih => cases tpt2 case abs t2' xs' mem' => - have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ t2'.fv ∪ s2'.fv) + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union (map := fv) Var) simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx - have ⟨q1, q2, q3, q4⟩ := qx - have ⟨t', qt'_l, qt'_r⟩ := ih x q1 (mem' _ q2) + have ⟨q1, q2, _⟩ := qx + have ⟨t', _⟩ := ih x q1 (mem' _ q2) exists abs (t' ^* x) constructor - <;> [let z := s2'; let z := t2'] - <;> apply Parallel.abs ((z ^ fvar x).fv ∪ t'.fv ∪ {x}) - <;> intros y qy <;> simp only [open', close] - <;> [rw [←open_close x _ 0 q4]; rw [←open_close x _ 0 q3]] - <;> refine para_open_close x y 0 ?_ qy <;> [exact qt'_l; exact qt'_r] + <;> [let z := s2' ^ fvar x; let z := t2' ^ fvar x] + <;> apply Parallel.abs (free_union (map := fv) Var) <;> grind case beta s1 s1' s2 s2' xs mem ps ih1 ih2 => cases tpt2 case app u2 u2' s1pu2 s2pu2' => cases s1pu2 case abs s1'' xs' mem' => - have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ s1''.fv ∪ s1'.fv) + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union (map := fv) Var) simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx - obtain ⟨q1, q2, q3, q4⟩ := qx - have ⟨t', qt'_l, qt'_r⟩ := ih2 s2pu2' - have ⟨t'', qt''_l, qt''_r⟩ := @ih1 x q1 _ (mem' _ q2) + obtain ⟨q1, q2, _⟩ := qx + have ⟨t', _⟩ := ih2 s2pu2' + have ⟨t'', _⟩ := @ih1 x q1 _ (mem' _ q2) exists (t'' ^* x) ^ t' constructor - · rw [subst_intro x s2' _ q4 (para_lc_l qt'_l), - subst_intro x t' _ (close_var_not_fvar x t'') (para_lc_r qt'_l)] - simp only [open', close] - rw [close_open _ _ _ (para_lc_r qt''_l)] - exact para_subst x qt''_l qt'_l - · refine Parallel.beta ((s1'' ^ fvar x).fv ∪ t''.fv ∪ {x}) ?_ (by aesop) - intros y qy - rw [←open_close x s1'' 0 (by aesop)] - apply para_open_close <;> aesop + · grind + · apply Parallel.beta (free_union (map := fv) Var) <;> grind case beta u1' u2' xs' mem' s2pu2' => - have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ u1'.fv ∪ s1'.fv ∪ s2'.fv ∪ u2'.fv) + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union (map := fv) Var) simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx - have ⟨q1, q2, q3, q4, q5, q6⟩ := qx - have ⟨t', qt'_l, qt'_r⟩ := ih2 s2pu2' - have ⟨t'', qt''_l, qt''_r⟩ := @ih1 x q1 _ (mem' _ q2) + have ⟨q1, q2, _⟩ := qx + have ⟨t', _⟩ := ih2 s2pu2' + have ⟨t'', _⟩ := @ih1 x q1 _ (mem' _ q2) refine ⟨t'' [x := t'], ?_⟩ - have : _ ∧ _ := ⟨para_subst x qt''_l qt'_l, para_subst x qt''_r qt'_r⟩ - rw [subst_intro x u2' u1' _ (para_lc_l qt'_r), subst_intro x s2' s1' _ (para_lc_l qt'_l)] - all_goals aesop + grind case app s1 s1' s2 s2' s1ps1' _ ih1 ih2 => cases tpt2 case app u1 u2' s1 s2 => have ⟨l, _, _⟩ := ih1 s1 have ⟨r, _, _⟩ := ih2 s2 - exact ⟨app l r, by aesop⟩ + exact ⟨app l r, by grind⟩ case beta t1' u1' u2' xs mem s2pu2' => cases s1ps1' case abs s1'' xs' mem' => - have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ s1''.fv ∪ u1'.fv) + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union (map := fv) Var) simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx - obtain ⟨q1, q2, q3, q4⟩ := qx + obtain ⟨q1, q2, _⟩ := qx have ⟨t', qt'_l, qt'_r⟩ := ih2 s2pu2' have ⟨t'', qt''_l, qt''_r⟩ := @ih1 (abs u1') (Parallel.abs xs mem) cases qt''_l next w1 xs'' mem'' => cases qt''_r case abs xs''' mem''' => - exists w1 ^ t' - constructor - · aesop (config := {enableSimp := false}) - · exact para_open_out xs''' mem''' qt'_r + refine ⟨w1 ^ t', ?_, para_open_out xs''' mem''' qt'_r⟩ + apply Parallel.beta (free_union Var) <;> grind /-- Parallel reduction is confluent. -/ theorem para_confluence : Confluence (@Parallel Var) := @@ -244,4 +205,4 @@ theorem confluence_beta : Confluence (@FullBeta Var) := by rw [←eq] exact @para_confluence Var _ _ -end LambdaCalculus.LocallyNameless.Term +end LambdaCalculus.LocallyNameless.Untyped.Term diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean index 7f114c3e..5cc2d4a6 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean @@ -10,79 +10,59 @@ universe u variable {Var : Type u} -namespace LambdaCalculus.LocallyNameless.Term +namespace LambdaCalculus.LocallyNameless.Untyped.Term -lemma open_app_inj : app l r = (app l r)⟦i ↝ s⟧ ↔ l = l⟦i ↝ s⟧ ∧ r = r⟦i ↝ s⟧ := by - simp [openRec] - -lemma open_abs_inj : M.abs = M⟦i + 1 ↝ s⟧.abs ↔ M = M⟦i + 1 ↝ s⟧ := by - simp +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), - i ≠ j → - e ⟦j ↝ v⟧ = (e ⟦j ↝ v⟧) ⟦i ↝ u⟧ → - e = e ⟦i ↝ u⟧ := by - induction' e <;> intros j v i u neq h - case app l r ih_l ih_r => - obtain ⟨hl, hr⟩ := open_app_inj.mp h - simp only [open_app_inj] - exact ⟨ih_l j v i u neq hl, ih_r j v i u neq hr⟩ - case abs ih => - simp only [openRec_abs, open_abs_inj] at * - exact ih (j+1) v (i+1) u (by aesop) h - all_goals aesop +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 /-- Opening is associative for nonclashing free variables. -/ -lemma swap_open_fvars (k n : ℕ) (x y : Var) (m : Term Var) : - k ≠ n → x ≠ y → m⟦n ↝ fvar y⟧⟦k ↝ fvar x⟧ = m⟦k ↝ fvar x⟧⟦n ↝ fvar y⟧ := by - revert k n - induction' m <;> aesop +lemma swap_open_fvars (k n : ℕ) (x y : Var) (m : Term Var) (neq : k ≠ n) : + m⟦n ↝ fvar y⟧⟦k ↝ fvar x⟧ = m⟦k ↝ fvar x⟧⟦n ↝ fvar y⟧ := by + induction m generalizing k n <;> grind variable [DecidableEq Var] /-- Substitution of a free variable not present in a term leaves it unchanged. -/ -theorem subst_fresh (x : Var) (t sub : Term Var) : x ∉ t.fv → (t [x := sub]) = t := by - induction t <;> aesop +theorem subst_fresh (x : Var) (t sub : Term Var) (nmem : x ∉ t.fv) : t [x := sub] = t := by + induction t <;> grind /- Opening and closing are inverses. -/ -lemma open_close (x : Var) (t : Term Var) (k : ℕ) : x ∉ t.fv → t⟦k ↝ fvar x⟧⟦k ↜ x⟧ = t := by - revert k - induction t <;> aesop +lemma open_close (x : Var) (t : Term Var) (k : ℕ) (nmem : x ∉ t.fv) : t = t⟦k ↝ fvar x⟧⟦k ↜ x⟧ := by + induction t generalizing k <;> grind /-- Opening is injective. -/ lemma open_injective (x : Var) (M M') (free_M : x ∉ M.fv) (free_M' : x ∉ M'.fv) (eq : M ^ fvar x = M' ^ fvar x) : M = M' := by - rw [←open_close x M 0 free_M, ←open_close x M' 0 free_M'] + rw [open_close x M 0 free_M, open_close x M' 0 free_M'] exact congrArg (closeRec 0 x) eq /-- Opening and closing are associative for nonclashing free variables. -/ -lemma swap_open_fvar_close (k n : ℕ) (x y : Var) (m : Term Var) : - k ≠ n → x ≠ y → m⟦n ↝ fvar y⟧⟦k ↜ x⟧ = m⟦k ↜ x⟧⟦n ↝ fvar y⟧ := by - revert k n - induction' m <;> aesop +lemma swap_open_fvar_close (k n : ℕ) (x y : Var) (m : Term Var) (neq₁ : k ≠ n) (neq₂ : x ≠ y) : + m⟦n ↝ fvar y⟧⟦k ↜ x⟧ = m⟦k ↜ x⟧⟦n ↝ fvar y⟧ := by + induction m generalizing k n <;> grind /-- Closing preserves free variables. -/ -lemma close_preserve_not_fvar {k x y} (m : Term Var) : x ∉ m.fv → x ∉ (m⟦k ↜ y⟧).fv := by - revert k - induction m <;> aesop +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) : - x ∉ m.fv → x ≠ y → x ∉ (m⟦k ↝ fvar y⟧).fv := by - revert k - induction m <;> aesop +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 /-- Substitution preserves free variables. -/ -lemma subst_preserve_not_fvar {x y : Var} (m n : Term Var) : - x ∉ m.fv ∪ n.fv → x ∉ (m [y := n]).fv := by - induction m - all_goals aesop +lemma subst_preserve_not_fvar {x y : Var} (m n : Term Var) (nmem : x ∉ m.fv ∪ n.fv) : + x ∉ (m [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 - revert k - induction t <;> aesop + 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 @@ -91,58 +71,50 @@ variable [HasFresh Var] omit [DecidableEq Var] in /-- A locally closed term is unchanged by opening. -/ -@[aesop safe (rule_sets := [LambdaCalculus.LocallyNameless.ruleSet])] -lemma open_lc (k t) (e : Term Var) : e.LC → e = e⟦k ↝ t⟧ := by - intros e_lc - revert k - induction e_lc +@[scoped grind =_] +lemma open_lc (k t) (e : Term Var) (e_lc : e.LC) : e = e⟦k ↝ t⟧ := by + induction e_lc generalizing k case abs xs e _ ih => - intros k simp only [openRec_abs, abs.injEq] - refine open_lc_aux e 0 (fvar (fresh xs)) (k+1) t ?_ ?_ <;> aesop - all_goals aesop + apply open_lc_aux e 0 (fvar (fresh xs)) (k+1) t <;> grind + all_goals grind /-- Substitution of a locally closed term distributes with opening. -/ -lemma subst_open (x : Var) (t : Term Var) (k : ℕ) (u e) : - LC t → - (e ⟦ k ↝ u ⟧) [ x := t ] = (e [ x := t ]) ⟦k ↝ u [ x := t ]⟧ := by - revert k - induction' e <;> aesop +@[scoped grind] +lemma subst_openRec (x : Var) (t : Term Var) (k : ℕ) (u e) (lc : LC t) : + (e⟦ k ↝ u ⟧)[x := t] = e[x := t]⟦k ↝ u [ x := t ]⟧ := by + induction e generalizing k <;> grind -/-- Specialize `subst_open` to the first opening. -/ +/-- Specialize `subst_openRec` to the first opening. -/ +lemma subst_open (x : Var) (t : Term Var) (u e) (lc : LC t) : + (e ^ u)[x := t] = e[x := t] ^ u [ x := t ] := by grind + +/-- Specialize `subst_open` to the free variables. -/ theorem subst_open_var (x y : Var) (u e : Term Var) (neq : y ≠ x) (u_lc : LC u) : - (e [y := u]) ^ fvar x = (e ^ fvar x) [y := u] := by - have h : (e ^ fvar x)[y:=u] = e[y:=u] ^ (fvar x)[y:=u] := subst_open y u 0 (fvar x) e u_lc - aesop + (e ^ fvar x)[y := u] = e[y := u] ^ fvar x := by grind /-- Substitution of locally closed terms is locally closed. -/ -theorem subst_lc {x : Var} {e u : Term Var} : LC e → LC u → LC (e [x := u]) := by - intros lc_e lc_u - induction lc_e - case abs xs e _ ih => - refine LC.abs ({x} ∪ xs) _ (?_ : ∀ y ∉ {x} ∪ xs, (e[x := u] ^ fvar y).LC) - intros y mem - rw [subst_open_var y x u e ?_ lc_u] - all_goals aesop - all_goals aesop +@[scoped grind] +theorem subst_lc {x : Var} {e u : Term Var} (e_lc : LC e) (u_lc : LC u) : LC (e [x := u]) := by + induction e_lc + case' abs => apply LC.abs (free_union Var) + all_goals grind /-- Opening to a term `t` is equivalent to opening to a free variable and substituting for `t`. -/ +@[scoped grind] lemma subst_intro (x : Var) (t e : Term Var) (mem : x ∉ e.fv) (t_lc : LC t) : - e ^ t = (e ^ fvar x) [ x := t ] := by - simp only [open'] - rw [subst_open x t 0 (fvar x) e t_lc, subst_fresh _ _ t mem] - aesop + e ^ t = (e ^ fvar x) [ x := t ] := by grind [subst_fresh] /-- Opening of locally closed terms is locally closed. -/ -theorem beta_lc {M N : Term Var} (m_lc : M.abs.LC) : LC N → LC (M ^ N) := by +@[scoped grind ←] +theorem beta_lc {M N : Term Var} (m_lc : M.abs.LC) (n_lc : LC N) : LC (M ^ N) := by cases m_lc case abs xs mem => - intros n_lc have ⟨y, _⟩ := fresh_exists <| free_union (map := fv) Var - rw [subst_intro y N M (by aesop) (by assumption)] - apply subst_lc <;> aesop + grind /-- Opening then closing 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 revert k @@ -150,31 +122,23 @@ lemma open_close_to_subst (m : Term Var) (x y : Var) (k : ℕ) (m_lc : LC m) : case abs xs t x_mem ih => intros k have ⟨x', _⟩ := fresh_exists <| free_union (map := fv) Var - have s := subst_open_var x' x (fvar y) t (by aesop) (by constructor) simp only [closeRec_abs, openRec_abs, subst_abs] - simp only [open'] at * - rw [←open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ fvar y⟧) 0 ?f₁, ←open_close x' (t[x := fvar y]) 0 ?f₂] - rw [swap_open_fvars, ←swap_open_fvar_close, s, ih] <;> aesop - case f₁ => refine open_fresh_preserve_not_fvar _ (close_preserve_not_fvar _ ?_) ?_ <;> aesop - case f₂ => apply subst_preserve_not_fvar; aesop - all_goals aesop + rw [open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ fvar y⟧) 0 ?f₁, open_close x' (t[x := fvar y]) 0 ?f₂] + rw [swap_open_fvars, ←swap_open_fvar_close] <;> grind + case f₁ => grind [open_fresh_preserve_not_fvar, close_preserve_not_fvar] + case f₂ => grind [subst_preserve_not_fvar] + all_goals grind /-- Closing and opening are inverses. -/ -lemma close_open (x : Var) (t : Term Var) (k : ℕ) : LC t → t⟦k ↜ x⟧⟦k ↝ fvar x⟧ = t := by - intros lc_t - revert k - induction lc_t +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 case abs xs t t_open_lc ih => - intros k simp only [closeRec_abs, openRec_abs, abs.injEq] let z := t⟦k + 1 ↜ x⟧⟦k + 1 ↝ fvar x⟧ have ⟨y, _⟩ := fresh_exists <| free_union (map := fv) Var - refine open_injective y _ _ (by aesop) (by aesop) ?_ - rw [←ih y ?_ (k+1)] - · simp only [open'] - rw [swap_open_fvar_close, swap_open_fvars] - all_goals aesop - aesop - all_goals aesop - -end LambdaCalculus.LocallyNameless.Term + refine open_injective y _ _ ?_ ?_ ?f + case f => rw [←ih y ?_ (k+1)] <;> grind [swap_open_fvar_close, swap_open_fvars] + all_goals grind + all_goals grind + +end LambdaCalculus.LocallyNameless.Untyped.Term diff --git a/Cslib/Data/HasFresh.lean b/Cslib/Data/HasFresh.lean index be908326..2b84817b 100644 --- a/Cslib/Data/HasFresh.lean +++ b/Cslib/Data/HasFresh.lean @@ -23,7 +23,7 @@ class HasFresh (α : Type u) where /-- Proof that `fresh` returns a fresh element for its input set. -/ fresh_notMem (s : Finset α) : fresh s ∉ s -attribute [simp] HasFresh.fresh_notMem +attribute [grind <=] HasFresh.fresh_notMem /-- An existential version of the `HasFresh` typeclass. This is useful for the sake of brevity in proofs. -/ From 826cabb6a4b2a7a296ed6a5d8081d93673c65021 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 20 Aug 2025 06:07:26 +0200 Subject: [PATCH 059/107] Update README.md --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index b67e0146..83f7eae2 100644 --- a/README.md +++ b/README.md @@ -10,8 +10,8 @@ Cslib is a Lean library for computer science. ## Aims -One aim is to offer reusable APIs for formalisation projects, software verification, and certified software (among others). -Another aim is to try and establish a common ground for connecting different developments in Computer Science as much as possible, in order to foster reuse of ideas and results. +- Offer reusable APIs and languages for formalisation projects, software verification, and certified software (among others). +- Establish a common ground for connecting different developments in Computer Science, in order to foster synergies and reuse. # Contributing and Discussion From 4fe669422dc5b8ff10ab06c314884f2e1a8bb349 Mon Sep 17 00:00:00 2001 From: euprunin <178733547+euprunin@users.noreply.github.com> Date: Wed, 20 Aug 2025 17:41:50 +0200 Subject: [PATCH 060/107] =?UTF-8?q?chore(Data):=20golf=20entire=20`FinFun.?= =?UTF-8?q?eq=5Fchar=E2=82=81`.=20golf=20using=20grind.=20remove=20comment?= =?UTF-8?q?ed=20out=20code=20(#37)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: euprunin --- Cslib/Data/FinFun.lean | 102 +++----------------------- Cslib/Semantics/Lts/Bisimulation.lean | 47 +----------- 2 files changed, 15 insertions(+), 134 deletions(-) diff --git a/Cslib/Data/FinFun.lean b/Cslib/Data/FinFun.lean index cd875a5c..d0ccb9a8 100644 --- a/Cslib/Data/FinFun.lean +++ b/Cslib/Data/FinFun.lean @@ -40,44 +40,12 @@ theorem FinFun.toFun_char [DecidableEq α] [Zero β] (x ∈ (f.dom ∩ g.dom) → f.apply x = g.apply x) ∧ (x ∈ (f.dom \ g.dom) → f.apply x = Zero.zero) ∧ (x ∈ (g.dom \ f.dom) → g.apply x = Zero.zero) := by - rename_i hdec hzero have happlyx : f.toFun x = g.toFun x := by simp [h] - constructorm* _ ∧ _ - case left => - intro hx - simp only [FinFun.apply] - simp only [Finset.mem_inter] at hx - simp [toFun, hx] at happlyx - exact happlyx - case right.left => - intro hx - simp only [Finset.mem_sdiff] at hx - simp [toFun, hx] at happlyx - exact happlyx - case right.right => - intro hx - simp only [Finset.mem_sdiff] at hx - simp [toFun, hx] at happlyx - simp only [happlyx] + grind [FinFun.toFun] theorem FinFun.toFun_dom [DecidableEq α] [Zero β] {f : α ⇀ β} (h : ∀ x, x ∉ f.dom → f.apply x = Zero.zero) : (f : α → β) = f.f := by - rename_i hdec hzero - funext x - by_cases hx : x ∈ f.dom - · simp only [FinFun.toFun] - simp [hx] - · simp only [FinFun.toFun] - simp [hx] - specialize h x - simp only [h hx] - --- /- A function with a finite domain of definition is a FinFun. -/ --- @[simp] --- def FinFun.mk [Zero β] (f : α → β) (dom : Finset α) (h : ∀ x, x ∉ dom → f ) : α ⇀ β := { --- f := f --- dom := dom --- } + grind [FinFun.toFun] def FinFun.mapBin [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option β → Option β) : Option (α ⇀ β) := @@ -94,49 +62,21 @@ def FinFun.mapBin [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option theorem FinFun.mapBin_dom [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option β → Option β) (h : FinFun.mapBin f g op = some fg) : - fg.dom = f.dom ∧ fg.dom = g.dom := by - rename_i hdec - simp [mapBin] at h - constructor - · simp only [← h] - · simp only [← h] + fg.dom = f.dom ∧ fg.dom = g.dom := by grind [mapBin] theorem FinFun.mapBin_char₁ [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option β → Option β) (h : FinFun.mapBin f g op = some fg) : ∀ x ∈ fg.dom, fg.apply x = y ↔ (op (some (f.f x)) (some (g.f x))) = some y := by - rename_i hdec intro x hxdom constructor - · intro happ - simp only [FinFun.apply] at happ - simp [mapBin] at h - rcases h with ⟨⟨ h_fg_dom_eq, hxsome ⟩, ⟨fgf, what⟩⟩ - specialize hxsome x hxdom - simp at happ - match hsome? : op (some (f.f x)) (some (g.f x)) with - | some z => - simp [hsome?] at happ - simp only [happ] - | none => - simp [hsome?] at hxsome - · intro hop - simp [mapBin] at h - rcases h with ⟨⟨ h_fg_dom_eq, hxsome ⟩, ⟨fgf, what⟩⟩ - simp - simp [hop] + <;> simp only [mapBin, Option.ite_none_right_eq_some] at h + <;> rcases h with ⟨_, _, _, _⟩ + <;> grind theorem FinFun.mapBin_char₂ [DecidableEq α] (f g : α ⇀ β) (op : Option β → Option β → Option β) (hdom : f.dom = g.dom) (hop : ∀ x ∈ f.dom, (op (some (f.f x)) (some (g.f x))).isSome) - : (FinFun.mapBin f g op).isSome := by - rename_i hdec - simp [mapBin] - simp [hdom] - rw [← hdom] - intro x - intro hxdom - specialize hop x hxdom - simp [hop] + : (FinFun.mapBin f g op).isSome := by grind [mapBin] -- Fun to FinFun def Function.toFinFun [DecidableEq α] (f : α → β) (dom : Finset α) : α ⇀ β := FinFun.mk f dom @@ -144,13 +84,8 @@ def Function.toFinFun [DecidableEq α] (f : α → β) (dom : Finset α) : α lemma Function.toFinFun_eq [DecidableEq α] [Zero β] (f : α → β) (dom : Finset α) (h : ∀ x, x ∉ dom → f x = 0) : f = (Function.toFinFun f dom) := by funext p - by_cases hp : p ∈ dom - · simp [Function.toFinFun, FinFun.toFun] - simp [hp] - · simp [Function.toFinFun, FinFun.toFun] - simp [hp] - specialize h p hp - exact h + by_cases hp : p ∈ dom <;> simp only [toFinFun, FinFun.toFun, hp, reduceIte] + exact h p hp @[coe] def FinFun.toDomFun (f : α ⇀ β) : {x // x ∈ f.dom} → β := fun x => f.f x @@ -162,26 +97,13 @@ theorem FinFun.congrFinFun [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : f = f.apply a = g.apply a := congrFun (congrArg apply h) a theorem FinFun.eq_char₁ [DecidableEq α] [Zero β] {f g : α ⇀ β} (h : f = g) : - f.f = g.f ∧ f.dom = g.dom := by - cases f - rename_i ff fdom - cases g - rename_i gf gdom - simp at h - assumption + f.f = g.f ∧ f.dom = g.dom := ⟨congrArg FinFun.f h, congrArg dom h⟩ theorem FinFun.eq_char₂ [DecidableEq α] [Zero β] {f g : α ⇀ β} (heq : f.f = g.f ∧ f.dom = g.dom) : f = g := by cases f - rename_i ff fdom cases g - rename_i gf gdom - simp at heq - simp - assumption + grind theorem FinFun.eq_char [DecidableEq α] [Zero β] {f g : α ⇀ β} : - f = g ↔ f.f = g.f ∧ f.dom = g.dom := by - apply Iff.intro - · apply FinFun.eq_char₁ - · apply FinFun.eq_char₂ + f = g ↔ f.f = g.f ∧ f.dom = g.dom := by grind [FinFun.eq_char₁, FinFun.eq_char₂] diff --git a/Cslib/Semantics/Lts/Bisimulation.lean b/Cslib/Semantics/Lts/Bisimulation.lean index d11fd45a..af9afe65 100644 --- a/Cslib/Semantics/Lts/Bisimulation.lean +++ b/Cslib/Semantics/Lts/Bisimulation.lean @@ -697,15 +697,7 @@ theorem Bisimulation.traceEq_not_bisim : simp at h simp [h] constructor; constructor; constructor - rw [htraces2, htraces6] at cih - apply Set.ext_iff.1 at cih - specialize cih ['c'] - obtain ⟨cih1, cih2⟩ := cih - have cih1h : ['c'] ∈ @insert - (List Char) (Set (List Char)) Set.instInsert [] {['b'], ['c']} := by - simp - specialize cih1 cih1h - simp at cih1 + grind case five2eight => simp [TraceEq] at cih have htraces2 : lts.traces 2 = {[], ['b'], ['c']} := by @@ -846,13 +838,7 @@ theorem Bisimilarity.deterministic_bisim_eq_traceEq /-- Any bisimulation is also a simulation. -/ theorem Bisimulation.is_simulation (lts : Lts State Label) (r : State → State → Prop) : Bisimulation lts r → Simulation lts r := by - intro h - simp only [Bisimulation] at h - simp only [Simulation] - intro s1 s2 hr μ s1' htr - specialize h s1 s2 hr μ - rcases h with ⟨h1, h2⟩ - apply h1 s1' htr + grind [Bisimulation, Simulation] /-- A relation is a bisimulation iff both it and its inverse are simulations. -/ theorem Bisimulation.simulation_iff (lts : Lts State Label) (r : State → State → Prop) : @@ -1186,34 +1172,7 @@ theorem WeakBisimulation.comp (r1 r2 : State → State → Prop) (h1 : WeakBisimulation lts r1) (h2 : WeakBisimulation lts r2) : WeakBisimulation lts (Relation.Comp r1 r2) := by simp_all only [WeakBisimulation] - intro s1 s2 hrc μ - constructor - case left => - intro s1' htr - rcases hrc with ⟨sb, hr1, hr2⟩ - specialize h1 s1 sb hr1 μ - specialize h2 sb s2 hr2 μ - have h1' := h1.1 s1' htr - obtain ⟨s1'', h1'tr, h1'⟩ := h1' - have h2' := h2.1 s1'' h1'tr - obtain ⟨s2'', h2'tr, h2'⟩ := h2' - exists s2'' - constructor - · exact h2'tr - · exists s1'' - case right => - intro s2' htr - rcases hrc with ⟨sb, hr1, hr2⟩ - specialize h1 s1 sb hr1 μ - specialize h2 sb s2 hr2 μ - have h2' := h2.2 s2' htr - obtain ⟨s2'', h2'tr, h2'⟩ := h2' - have h1' := h1.2 s2'' h2'tr - obtain ⟨s1'', h1'tr, h1'⟩ := h1' - exists s1'' - constructor - · exact h1'tr - · exists s2'' + exact Bisimulation.comp lts.saturate r1 r2 h1 h2 /-- The composition of two sw-bisimulations is an sw-bisimulation. -/ theorem SWBisimulation.comp From 9c0aee950e6dcb4373d60bc4cc8258fe0a5aba8a Mon Sep 17 00:00:00 2001 From: euprunin <178733547+euprunin@users.noreply.github.com> Date: Fri, 22 Aug 2025 06:56:27 +0200 Subject: [PATCH 061/107] =?UTF-8?q?chore(Semantics/Lts):=20golf=20`Lts.det?= =?UTF-8?q?erministic=5Fimage=5Fchar`,=20`Lts.strN.trans=5F=CF=84`,=20`Lts?= =?UTF-8?q?.strN.comp`=20and=20`Lts.divergent=5Fdrop`=20using=20`grind`,?= =?UTF-8?q?=20`aesop`=20and=20`simp=5Fall`=20(#41)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * chore: golf `Lts.deterministic_image_char`, `Lts.strN.trans_τ`, `Lts.strN.comp` and `Lts.divergent_drop` using `grind`, `aesop` and `simp_all` * golf further --------- Co-authored-by: euprunin --- Cslib/Semantics/Lts/Basic.lean | 43 ++++------------------------------ 1 file changed, 4 insertions(+), 39 deletions(-) diff --git a/Cslib/Semantics/Lts/Basic.lean b/Cslib/Semantics/Lts/Basic.lean index d3b1a778..a01d21d5 100644 --- a/Cslib/Semantics/Lts/Basic.lean +++ b/Cslib/Semantics/Lts/Basic.lean @@ -284,34 +284,7 @@ theorem Lts.deterministic_not_lto (hDet : lts.Deterministic) : theorem Lts.deterministic_image_char (hDet : lts.Deterministic) : ∀ s μ, (∃ s', lts.Image s μ = { s' }) ∨ (lts.Image s μ = ∅) := by intro s μ - by_cases hs' : ∃ s', lts.Tr s μ s' - case pos => - obtain ⟨s', hs'⟩ := hs' - left - apply Exists.intro s' - simp [Image] - simp [setOf, singleton, Set.singleton] - funext s'' - by_cases heq : s' = s'' - case pos => - simp [heq] - simp [heq] at hs' - exact hs' - case neg => - have hDet' := Lts.deterministic_not_lto lts hDet s μ s' s'' heq hs' - simp [hDet'] - exact Ne.symm heq - case neg => - right - simp [Image] - simp [setOf] - simp [EmptyCollection.emptyCollection] - funext s'' - by_contra hf - simp at hf - simp at hs' - specialize hs' s'' - contradiction + by_cases hs' : ∃ s', lts.Tr s μ s' <;> aesop (add simp [Image]) /-- Every deterministic Lts is also image-finite. -/ theorem Lts.deterministic_imageFinite : @@ -442,9 +415,7 @@ theorem Lts.strN.trans_τ case tr n1 sb sb' n2 hstr1 htr hstr2 => have ih := Lts.strN.trans_τ lts hstr2 h2 have conc := Lts.strN.tr hstr1 htr ih - have n_eq : n1 + (n2 + m) + 1 = n1 + n2 + 1 + m := by omega - rw [← n_eq] - exact conc + grind /-- Saturated transitions labelled by τ can be composed. -/ theorem Lts.STr.trans_τ @@ -486,9 +457,7 @@ theorem Lts.strN.comp have hprefix_τ := Lts.strN.trans_τ lts h1 hstr1 have hprefix := Lts.strN.tr hprefix_τ htr hstr2 have conc := Lts.strN.append lts hprefix h3 - have n_eq : (n1 + n21 + n22 + 1 + n3) = (n1 + (n21 + n22 + 1) + n3) := by omega - rw [← n_eq] - apply conc + grind /-- Saturated transitions can be composed. -/ theorem Lts.STr.comp @@ -528,11 +497,7 @@ theorem Lts.divergent_drop intro m simp only [Stream'.drop, Stream'.get] simp [Lts.DivergentExecution] at h - specialize h (n + m) - have n_eq : m.succ + n = n + m + 1 := by omega - have n_comm : n + m = m + n := by apply Nat.add_comm - rw [n_eq, ← n_comm] - apply h + grind /-- An Lts is divergence-free if it has no divergent state. -/ def Lts.DivergenceFree [HasTau Label] (lts : Lts State Label) : Prop := From 4ed0f874bdfd69034aaf7a7aff7df54612ad04b5 Mon Sep 17 00:00:00 2001 From: euprunin <178733547+euprunin@users.noreply.github.com> Date: Fri, 22 Aug 2025 06:57:07 +0200 Subject: [PATCH 062/107] chore(Computability/CombinatoryLogic): golf `RFindAbove_correct` using `grind` (#42) Co-authored-by: euprunin --- Cslib/Computability/CombinatoryLogic/Recursion.lean | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/Cslib/Computability/CombinatoryLogic/Recursion.lean b/Cslib/Computability/CombinatoryLogic/Recursion.lean index ea8af396..bc4e0d5d 100644 --- a/Cslib/Computability/CombinatoryLogic/Recursion.lean +++ b/Cslib/Computability/CombinatoryLogic/Recursion.lean @@ -288,12 +288,7 @@ theorem RFindAbove_correct (fNat : Nat → Nat) (f x : SKI) apply rfindAboveAux_step assumption · replace ih := ih (SKI.Succ ⬝ x) (m+1) (succ_correct _ x hx) - simp_rw [Nat.add_assoc, Nat.add_comm] at ih - apply ih - · assumption - · intro i hi - apply hpos (i+1) - simp [hi] + grind -- close the `h` goals of the above `apply isChurch_trans` all_goals {apply MRed.head; apply MRed.head; exact fixedPoint_correct _} From df2bea9adac023ccb1510e338bfcc76a0c8a4630 Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Mon, 25 Aug 2025 04:16:51 -0400 Subject: [PATCH 063/107] Allow multiple maps in `free_union` (#46) * allow multiple maps * docs --- .../LocallyNameless/Stlc/Basic.lean | 4 +- .../LocallyNameless/Untyped/FullBeta.lean | 2 +- .../Untyped/FullBetaConfluence.lean | 14 +- .../LocallyNameless/Untyped/Properties.lean | 10 +- Cslib/Data/HasFresh.lean | 155 ++++++++++-------- CslibTests/HasFresh.lean | 34 +++- 6 files changed, 132 insertions(+), 87 deletions(-) diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean index 3cbca448..08795dd4 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean @@ -122,7 +122,7 @@ lemma subst_aux (h : Δ ++ ⟨x, σ⟩ :: Γ ⊢ t ∶ τ) (der : Γ ⊢ s ∶ refine (weaken der ?_).perm perm exact Context.wf_perm (id (List.Perm.symm perm)) ok_weak case abs σ Γ' t T2 xs ih' ih => - apply Typing.abs (xs ∪ {x} ∪ (Δ ++ Γ).dom) + apply Typing.abs (free_union Var) intros rw [subst_def, ←subst_open_var _ _ _ _ ?_ der.lc] <;> grind @@ -136,7 +136,7 @@ lemma typing_subst_head (weak : ⟨x, σ⟩ :: Γ ⊢ t ∶ τ) (der : Γ ⊢ s theorem preservation_open {xs : Finset Var} (cofin : ∀ x ∉ xs, ⟨x, σ⟩ :: Γ ⊢ m ^ fvar x ∶ τ) (der : Γ ⊢ n ∶ σ) : Γ ⊢ m ^ n ∶ τ := by - have ⟨fresh, _⟩ := fresh_exists <| free_union (map := Term.fv) Var + have ⟨fresh, _⟩ := fresh_exists <| free_union [Term.fv] Var rw [subst_intro fresh n m (by grind) der.lc] exact typing_subst_head (by grind) der diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean index ae22ab76..0122f639 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean @@ -106,7 +106,7 @@ lemma redex_abs_close {x : Var} (step : M ↠βᶠ M') : (M⟦0 ↜ x⟧.abs ↠ /-- Multiple reduction of opening implies multiple reduction of abstraction. -/ theorem redex_abs_cong (xs : Finset Var) (cofin : ∀ x ∉ xs, (M ^ fvar x) ↠βᶠ (M' ^ fvar x)) : M.abs ↠βᶠ M'.abs := by - have ⟨fresh, _⟩ := fresh_exists <| free_union (map := fv) Var + have ⟨fresh, _⟩ := fresh_exists <| free_union [fv] Var rw [open_close fresh M 0 ?_, open_close fresh M' 0 ?_] all_goals grind [redex_abs_close] diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean index 9b066e4b..75195c82 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean @@ -125,7 +125,7 @@ lemma para_open_close (x y z) (para : M ⭢ₚ M') (_ : y ∉ M.fv ∪ M'.fv ∪ /-- Parallel substitution respects fresh opening. -/ lemma para_open_out (L : Finset Var) (mem : ∀ x, x ∉ L → (M ^ fvar x) ⭢ₚ N ^ fvar x) (para : M' ⭢ₚ N') : (M ^ M') ⭢ₚ (N ^ N') := by - let ⟨x, _⟩ := fresh_exists <| free_union (map := fv) Var + let ⟨x, _⟩ := fresh_exists <| free_union [fv] Var grind -- TODO: the Takahashi translation would be a much nicer and shorter proof, but I had difficultly @@ -141,20 +141,20 @@ theorem para_diamond : Diamond (@Parallel Var) := by case abs s1 s2' xs mem ih => cases tpt2 case abs t2' xs' mem' => - have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union (map := fv) Var) + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union [fv] Var) simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx have ⟨q1, q2, _⟩ := qx have ⟨t', _⟩ := ih x q1 (mem' _ q2) exists abs (t' ^* x) constructor <;> [let z := s2' ^ fvar x; let z := t2' ^ fvar x] - <;> apply Parallel.abs (free_union (map := fv) Var) <;> grind + <;> apply Parallel.abs (free_union [fv] Var) <;> grind case beta s1 s1' s2 s2' xs mem ps ih1 ih2 => cases tpt2 case app u2 u2' s1pu2 s2pu2' => cases s1pu2 case abs s1'' xs' mem' => - have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union (map := fv) Var) + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union [fv] Var) simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx obtain ⟨q1, q2, _⟩ := qx have ⟨t', _⟩ := ih2 s2pu2' @@ -162,9 +162,9 @@ theorem para_diamond : Diamond (@Parallel Var) := by exists (t'' ^* x) ^ t' constructor · grind - · apply Parallel.beta (free_union (map := fv) Var) <;> grind + · apply Parallel.beta (free_union [fv] Var) <;> grind case beta u1' u2' xs' mem' s2pu2' => - have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union (map := fv) Var) + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union [fv] Var) simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx have ⟨q1, q2, _⟩ := qx have ⟨t', _⟩ := ih2 s2pu2' @@ -180,7 +180,7 @@ theorem para_diamond : Diamond (@Parallel Var) := by case beta t1' u1' u2' xs mem s2pu2' => cases s1ps1' case abs s1'' xs' mem' => - have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union (map := fv) Var) + have ⟨x, qx⟩ := fresh_exists (xs ∪ xs' ∪ free_union [fv] Var) simp only [Finset.union_assoc, Finset.mem_union, not_or] at qx obtain ⟨q1, q2, _⟩ := qx have ⟨t', qt'_l, qt'_r⟩ := ih2 s2pu2' diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean index 5cc2d4a6..0aa0189e 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean @@ -81,12 +81,12 @@ lemma open_lc (k t) (e : Term Var) (e_lc : e.LC) : e = e⟦k ↝ t⟧ := by /-- Substitution of a locally closed term distributes with opening. -/ @[scoped grind] -lemma subst_openRec (x : Var) (t : Term Var) (k : ℕ) (u e) (lc : LC t) : +lemma subst_openRec (x : Var) (t : Term Var) (k : ℕ) (u e : Term Var) (lc : LC t) : (e⟦ k ↝ u ⟧)[x := t] = e[x := t]⟦k ↝ u [ x := t ]⟧ := by induction e generalizing k <;> grind /-- Specialize `subst_openRec` to the first opening. -/ -lemma subst_open (x : Var) (t : Term Var) (u e) (lc : LC t) : +lemma subst_open (x : Var) (t : Term Var) (u e : Term Var) (lc : LC t) : (e ^ u)[x := t] = e[x := t] ^ u [ x := t ] := by grind /-- Specialize `subst_open` to the free variables. -/ @@ -110,7 +110,7 @@ lemma subst_intro (x : Var) (t e : Term Var) (mem : x ∉ e.fv) (t_lc : LC t) : theorem beta_lc {M N : Term Var} (m_lc : M.abs.LC) (n_lc : LC N) : LC (M ^ N) := by cases m_lc case abs xs mem => - have ⟨y, _⟩ := fresh_exists <| free_union (map := fv) Var + have ⟨y, _⟩ := fresh_exists <| free_union [fv] Var grind /-- Opening then closing is equivalent to substitution. -/ @@ -121,7 +121,7 @@ lemma open_close_to_subst (m : Term Var) (x y : Var) (k : ℕ) (m_lc : LC m) : induction' m_lc case abs xs t x_mem ih => intros k - have ⟨x', _⟩ := fresh_exists <| free_union (map := fv) Var + have ⟨x', _⟩ := fresh_exists <| free_union [fv] Var simp only [closeRec_abs, openRec_abs, subst_abs] rw [open_close x' (t⟦k+1 ↜ x⟧⟦k+1 ↝ fvar y⟧) 0 ?f₁, open_close x' (t[x := fvar y]) 0 ?f₂] rw [swap_open_fvars, ←swap_open_fvar_close] <;> grind @@ -135,7 +135,7 @@ lemma close_open (x : Var) (t : Term Var) (k : ℕ) (t_lc : LC t) : t⟦k ↜ x case abs xs t t_open_lc ih => simp only [closeRec_abs, openRec_abs, abs.injEq] let z := t⟦k + 1 ↜ x⟧⟦k + 1 ↝ fvar x⟧ - have ⟨y, _⟩ := fresh_exists <| free_union (map := fv) Var + have ⟨y, _⟩ := fresh_exists <| free_union [fv] Var refine open_injective y _ _ ?_ ?_ ?f case f => rw [←ih y ?_ (k+1)] <;> grind [swap_open_fvar_close, swap_open_fvars] all_goals grind diff --git a/Cslib/Data/HasFresh.lean b/Cslib/Data/HasFresh.lean index 2b84817b..be44dfeb 100644 --- a/Cslib/Data/HasFresh.lean +++ b/Cslib/Data/HasFresh.lean @@ -30,85 +30,100 @@ in proofs. -/ theorem HasFresh.fresh_exists {α : Type u} [HasFresh α] (s : Finset α) : ∃ a, a ∉ s := ⟨fresh s, fresh_notMem s⟩ -open Lean Elab Term Meta Parser Tactic in +open Lean Elab Term Meta Parser Tactic + +/-- Configuration for the `free_union` term elaborator. -/ +structure FreeUnionConfig where + /-- For `free_union Var`, include all `x : Var`. Defaults to true. -/ + singleton : Bool := true + /-- For `free_union Var`, include all `xs : Finset Var`. Defaults to true. -/ + finset : Bool := true + +/-- Elaborate a FreeUnionConfig. -/ +declare_config_elab elabFreeUnionConfig FreeUnionConfig + /-- - Given a `DecidableEq Var` instance, this elaborator automatically constructs the union of any - variables, finite sets of variables, and optionally the results of a provided function mapping to - variables. + Given a `DecidableEq Var` instance, this elaborator automatically constructs + the union of any variables, finite sets of variables, and optionally the + results of provided functions mapping to variables. This is configurable with + optional boolean boolean arguments `singleton` and `finset`. As an example, consider the following: ``` - variable {Var Term : Type} [DecidableEq Var] + variable (x : ℕ) (xs : Finset ℕ) (var : String) + + def f (_ : String) : Finset ℕ := {1, 2, 3} + def g (_ : String) : Finset ℕ := {4, 5, 6} + + -- info: ∅ ∪ {x} ∪ id xs : Finset ℕ + #check free_union ℕ + + -- info: ∅ ∪ {x} ∪ id xs ∪ f var ∪ g var : Finset ℕ + #check free_union [f, g] ℕ + + info: ∅ ∪ id xs : Finset ℕ + #check free_union (singleton := false) ℕ - example (x : Var) (xs : Finset Var) : True := by - -- free : Finset Var := ∅ ∪ {x} ∪ xs - let free := free_union Var - trivial + -- info: ∅ ∪ {x} : Finset ℕ + #check free_union (finset := false) ℕ - example (x : Var) (xs : Finset Var) (t : Term) (fv : Term → Finset Var) : True := by - -- free : Finset Var := ∅ ∪ {x} ∪ xs ∪ fv t - let free := free_union (map := fv) Var - trivial + -- info: ∅ : Finset ℕ + #check free_union (singleton := false) (finset := false) ℕ ``` -/ -elab "free_union" cfg:optConfig var:term : term => do - -- the type of our variables - let var ← elabType var - - -- handle the optional map calculation - let map ← - match cfg with - | `(optConfig| (map := $map:term)) => elabTerm map none - | _ => mkConst ``Empty - - let map_ty ← inferType map - - let map_dom := - match map_ty with - | Expr.forallE _ dom _ _ => dom - | _ => mkConst ``Empty - - let mut finsets := #[] - - -- construct ∅ - let dl ← getDecLevel var - let FinsetType := mkApp (mkConst ``Finset [dl]) var - let EmptyCollectionInst ← synthInstance (mkApp (mkConst ``EmptyCollection [dl]) FinsetType) - let empty := - mkAppN (mkConst ``EmptyCollection.emptyCollection [dl]) #[FinsetType, EmptyCollectionInst] - - let SingletonInst ← synthInstance <| mkAppN (mkConst ``Singleton [dl, dl]) #[var, FinsetType] - - for ldecl in (← getLCtx) do - if !ldecl.isImplementationDetail then - let local_type ← inferType (mkFVar ldecl.fvarId) - - -- any finite sets - if let (``Finset, #[var']) := local_type.getAppFnArgs then - if (← isDefEq var var') then - finsets := finsets.push ldecl.toExpr - else - -- singleton variables - if (← isDefEq local_type var) then - let singleton := - mkAppN - (mkConst ``Singleton.singleton [dl, dl]) - #[var, FinsetType, SingletonInst, ldecl.toExpr] - finsets := finsets.push singleton - else - -- map to variables - if (←isDefEq local_type map_dom) then - finsets := finsets.push (mkApp map ldecl.toExpr) - else - pure () - - -- construct a union fold - let UnionInst ← synthInstance (mkApp (mkConst ``Union [dl]) FinsetType) - let UnionFinset := mkAppN (mkConst `Union.union [dl]) #[FinsetType, UnionInst] - let union := finsets.foldl (mkApp2 UnionFinset) empty - - return union +syntax (name := freeUnion) "free_union" optConfig (" [" (term,*) "]")? term : term + +/-- Elaborator for `free_union`. -/ +@[term_elab freeUnion] +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 := [] } + + -- the type of our variables + let var ← elabType var + + -- maps to variables + let maps := maps.map (·.getElems) |>.getD #[] + let mut maps ← maps.mapM (flip elabTerm none) + + -- construct ∅ + let dl ← getDecLevel var + let FinsetType := mkApp (mkConst ``Finset [dl]) var + let EmptyCollectionInst ← synthInstance (mkApp (mkConst ``EmptyCollection [dl]) FinsetType) + let empty := + mkAppN (mkConst ``EmptyCollection.emptyCollection [dl]) #[FinsetType, EmptyCollectionInst] + + -- singleton variables + if cfg.singleton then + let SingletonInst ← synthInstance <| mkAppN (mkConst ``Singleton [dl, dl]) #[var, FinsetType] + let singleton_map := + mkAppN (mkConst ``Singleton.singleton [dl, dl]) #[var, FinsetType, SingletonInst] + maps := maps.push singleton_map + + -- any finite sets + if cfg.finset then + let id_map := mkApp (mkConst ``id [← getLevel var]) FinsetType + maps := maps.push id_map + + let mut finsets := #[] + + for ldecl in (← getLCtx) do + if !ldecl.isImplementationDetail then + let local_type ← ldecl.toExpr |> inferType >=> whnf + for map in maps do + if let Expr.forallE _ dom _ _ := ← inferType map then + if (←isDefEq local_type dom) then + finsets := finsets.push (mkApp map ldecl.toExpr) + + -- construct a union fold + let UnionInst ← synthInstance (mkApp (mkConst ``Union [dl]) FinsetType) + let UnionFinset := mkAppN (mkConst ``Union.union [dl]) #[FinsetType, UnionInst] + let union := finsets.foldl (mkApp2 UnionFinset) empty + + return union + | _ => throwUnsupportedSyntax export HasFresh (fresh fresh_notMem fresh_exists) diff --git a/CslibTests/HasFresh.lean b/CslibTests/HasFresh.lean index 5297b051..88943c64 100644 --- a/CslibTests/HasFresh.lean +++ b/CslibTests/HasFresh.lean @@ -14,8 +14,38 @@ example (x : Var) (xs : Finset Var) : ∃ y, x ≠ y ∧ y ∉ xs := by def fv : Term → Finset ℕ := fun _ ↦ {1, 2, 3} /-- An example including a specified `free` function. -/ -example (t : Term) (x : ℕ) (xs : Finset ℕ) : +example (_ : Term) (x : ℕ) (xs : Finset ℕ) : ∃ y : ℕ, x ≠ y ∧ y ∉ xs ∧ y ∉ ({1, 2, 3} : Finset ℕ) := by - let ⟨fresh, _⟩ := fresh_exists <| free_union (map := @fv Term) ℕ + let ⟨fresh, _⟩ := fresh_exists <| free_union [@fv Term] ℕ exists fresh aesop + +-- check that options work as expected +section + +variable (x : ℕ) (xs : Finset ℕ) (var : String) + +def f (_ : String) : Finset ℕ := {1, 2, 3} +def g (_ : String) : Finset ℕ := {4, 5, 6} + +/-- info: ∅ ∪ {x} ∪ id xs : Finset ℕ -/ +#guard_msgs in +#check free_union ℕ + +/-- info: ∅ ∪ {x} ∪ id xs ∪ f var ∪ g var : Finset ℕ -/ +#guard_msgs in +#check free_union [f, g] ℕ + +/-- info: ∅ ∪ id xs : Finset ℕ -/ +#guard_msgs in +#check free_union (singleton := false) ℕ + +/-- info: ∅ ∪ {x} : Finset ℕ -/ +#guard_msgs in +#check free_union (finset := false) ℕ + +/-- info: ∅ : Finset ℕ -/ +#guard_msgs in +#check free_union (singleton := false) (finset := false) ℕ + +end From ba25dd70e188b47735eb2a49a08d501ddc803a7d Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Mon, 25 Aug 2025 04:17:33 -0400 Subject: [PATCH 064/107] add type paramater to HasSubstitution (#45) --- .../LambdaCalculus/LocallyNameless/Untyped/Basic.lean | 6 ++++-- Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean | 2 +- Cslib/Syntax/HasSubstitution.lean | 4 ++-- 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean index 3a7fabd7..82a964f6 100644 --- a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean @@ -90,7 +90,7 @@ def subst (m : Term Var) (x : Var) (sub : Term Var) : Term Var := | abs M => abs <| M.subst x sub /-- `Term.subst` is a substitution for λ-terms. Gives access to the notation `m[x := n]`. -/ -instance instHasSubstitutionTerm : HasSubstitution (Term Var) Var where +instance instHasSubstitutionTerm : HasSubstitution (Term Var) Var (Term Var) where subst := Term.subst /-- Free variables of a term. -/ @@ -124,7 +124,9 @@ lemma closeRec_app : (app l r)⟦k ↜ x⟧ = app (l⟦k ↜ x⟧) (r⟦k ↜ x lemma closeRec_abs : t.abs⟦k ↜ x⟧ = t⟦k + 1 ↜ x⟧.abs := by rfl -lemma subst_bvar {n : Term Var} : (bvar i)[x := n] = bvar i := by rfl +variable {x : Var} {n : Term Var} + +lemma subst_bvar : (bvar i : Term Var)[x := n] = bvar i := by rfl lemma subst_fvar : (fvar x')[x := n] = if x = x' then n else fvar x' := by rfl diff --git a/Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean b/Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean index a18d457e..d4e44007 100644 --- a/Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean @@ -94,7 +94,7 @@ decreasing_by all_goals grind [rename.eq_sizeOf, abs.sizeOf_spec, app.sizeOf_spe /-- `Term.subst` is a substitution for λ-terms. Gives access to the notation `m[x := n]`. -/ instance instHasSubstitutionTerm [DecidableEq Var] [HasFresh Var] : - HasSubstitution (Term Var) Var where + HasSubstitution (Term Var) Var (Term Var) where subst := Term.subst -- TODO diff --git a/Cslib/Syntax/HasSubstitution.lean b/Cslib/Syntax/HasSubstitution.lean index 71e88d35..2e742627 100644 --- a/Cslib/Syntax/HasSubstitution.lean +++ b/Cslib/Syntax/HasSubstitution.lean @@ -5,9 +5,9 @@ Authors: Fabrizio Montesi -/ /-- Typeclass for substitution relations and access to their notation. -/ -class HasSubstitution (α : Type u) (β : Type v) where +class HasSubstitution (α : Type u) (β : Type v) (γ : Type w) where /-- Substitution function. Replaces `x` in `t` with `t'`. -/ - subst (t : α) (x : β) (t' : α) : α + subst (t : α) (x : β) (t' : γ) : α /-- Notation for substitution. -/ notation t:max "[" x ":=" t' "]" => HasSubstitution.subst t x t' From 08689a8f16d37b00ba54cf3932e308a86c70a326 Mon Sep 17 00:00:00 2001 From: euprunin <178733547+euprunin@users.noreply.github.com> Date: Mon, 25 Aug 2025 18:42:16 +0200 Subject: [PATCH 065/107] chore(Semantics/Lts): golf `Bisimilarity.refl` and `Bisimulation.simulation_iff` using `grind` and `aesop` (#43) * chore(Semantics/Lts): golf `Bisimilarity.refl` and `Bisimulation.simulation_iff` using `grind` and `aesop` * golf further --------- Co-authored-by: euprunin --- Cslib/Semantics/Lts/Bisimulation.lean | 48 ++------------------------- 1 file changed, 3 insertions(+), 45 deletions(-) diff --git a/Cslib/Semantics/Lts/Bisimulation.lean b/Cslib/Semantics/Lts/Bisimulation.lean index af9afe65..5182f39e 100644 --- a/Cslib/Semantics/Lts/Bisimulation.lean +++ b/Cslib/Semantics/Lts/Bisimulation.lean @@ -112,19 +112,7 @@ notation s:max " ~[" lts "] " s':max => Bisimilarity lts s s' /-- Bisimilarity is reflexive. -/ theorem Bisimilarity.refl (s : State) : s ~[lts] s := by exists Eq - constructor - case left => rfl - case right => - simp only [Bisimulation] - intro s1 s2 hr μ - cases hr - constructor - case left => - intro s1' htr - exists s1' - case right => - intro s1' htr - exists s1' + grind [Bisimulation] /-- The inverse of a bisimulation is a bisimulation. -/ theorem Bisimulation.inv (h : Bisimulation lts r) : @@ -844,38 +832,8 @@ theorem Bisimulation.is_simulation (lts : Lts State Label) (r : State → State theorem Bisimulation.simulation_iff (lts : Lts State Label) (r : State → State → Prop) : Bisimulation lts r ↔ (Simulation lts r ∧ Simulation lts (flip r)) := by constructor - case mp => - intro h - simp only [Simulation] - constructor - case left => - intro s1 s2 hr μ s1' htr - specialize h s1 s2 hr μ - rcases h with ⟨h1, h2⟩ - specialize h1 _ htr - obtain ⟨s2', h1⟩ := h1 - exists s2' - case right => - simp only [flip, flip] - intro s2 s1 hr μ s2' htr - simp only [Bisimulation] at h - specialize h s1 s2 hr μ - obtain ⟨h1, h2⟩ := h - specialize h2 _ htr - apply h2 - case mpr => - intro hs - obtain ⟨hs, hsinv⟩ := hs - simp only [Bisimulation] - intro s1 s2 hr μ - constructor - case left => - intro s1' htr - simp only [Simulation] at hs - apply hs _ _ hr _ _ htr - case right => - intro s2' htr - apply hsinv _ _ hr _ _ htr + case mp => grind [Bisimulation, Simulation, flip] + case mpr => aesop (add simp [Bisimulation]) end Bisimulation From 2145d1af6d57a748f4b2c5848c094d0320c0135b Mon Sep 17 00:00:00 2001 From: euprunin <178733547+euprunin@users.noreply.github.com> Date: Tue, 26 Aug 2025 06:57:39 +0200 Subject: [PATCH 066/107] chore(Semantics/Lts): golf `SimulationEquiv.refl`, `SimulationEquiv.symm` and `SimulationEquiv.trans` using `grind` (#47) Co-authored-by: euprunin --- Cslib/Semantics/Lts/Simulation.lean | 32 +++-------------------------- 1 file changed, 3 insertions(+), 29 deletions(-) diff --git a/Cslib/Semantics/Lts/Simulation.lean b/Cslib/Semantics/Lts/Simulation.lean index acd21f7e..80d5c29a 100644 --- a/Cslib/Semantics/Lts/Simulation.lean +++ b/Cslib/Semantics/Lts/Simulation.lean @@ -113,42 +113,16 @@ notation s:max " ≤≥[" lts "] " s':max => SimulationEquiv lts s s' /-- Simulation equivalence is reflexive. -/ theorem SimulationEquiv.refl (s : State) : s ≤≥[lts] s := by - simp [SimulationEquiv] - exists Eq - constructor - · rfl - · simp only [Simulation] - intro s1 s2 hr μ s1' htr - cases hr - exists s1' + grind [SimulationEquiv, Similarity.refl] /-- Simulation equivalence is symmetric. -/ theorem SimulationEquiv.symm {s1 s2 : State} (h : s1 ≤≥[lts] s2) : s2 ≤≥[lts] s1 := by - simp only [SimulationEquiv] - simp only [SimulationEquiv] at h - simp [h] + grind [SimulationEquiv] /-- Simulation equivalence is transitive. -/ theorem SimulationEquiv.trans {s1 s2 s3 : State} (h1 : s1 ≤≥[lts] s2) (h2 : s2 ≤≥[lts] s3) : s1 ≤≥[lts] s3 := by - simp only [SimulationEquiv] at * - obtain ⟨h1l, h1r⟩ := h1 - obtain ⟨h2l, h2r⟩ := h2 - constructor - case left => - obtain ⟨r1, hr1, hr1s⟩ := h1l - obtain ⟨r2, hr2, hr2s⟩ := h2l - exists Relation.Comp r1 r2 - constructor - · exists s2 - · apply Simulation.comp lts r1 r2 hr1s hr2s - case right => - obtain ⟨r1, hr1, hr1s⟩ := h1r - obtain ⟨r2, hr2, hr2s⟩ := h2r - exists Relation.Comp r2 r1 - constructor - · exists s2 - · apply Simulation.comp lts r2 r1 hr2s hr1s + grind [SimulationEquiv, Similarity.trans] /-- Simulation equivalence is an equivalence relation. -/ theorem SimulationEquiv.eqv (lts : Lts State Label) : From 18314718f2505542cea92d057a0f6326bd2c6e1b Mon Sep 17 00:00:00 2001 From: kei <70096720+thelissimus@users.noreply.github.com> Date: Tue, 26 Aug 2025 11:18:21 +0500 Subject: [PATCH 067/107] fix: `LambdaCalculus.Named.Term.subst` scoping problem (#48) * fix: `Term.subst` scoping problem * add: test case for `Term.subst` scoping issue * Add additional test --------- Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com> --- .../LambdaCalculus/Named/Untyped/Basic.lean | 2 +- CslibTests/LambdaCalculus.lean | 16 ++++++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean b/Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean index d4e44007..bbe3ad02 100644 --- a/Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean +++ b/Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean @@ -86,7 +86,7 @@ def Term.subst [DecidableEq Var] [HasFresh Var] (m : Term Var) (x : Var) (r : Te else if y ∉ r.fv then abs y (m'.subst x r) else - let z := HasFresh.fresh (abs y m').vars + let z := HasFresh.fresh (m'.vars ∪ r.vars ∪ {x}) abs z ((m'.rename y z).subst x r) | app m1 m2 => app (m1.subst x r) (m2.subst x r) termination_by m diff --git a/CslibTests/LambdaCalculus.lean b/CslibTests/LambdaCalculus.lean index c92d97a8..ab6f1276 100644 --- a/CslibTests/LambdaCalculus.lean +++ b/CslibTests/LambdaCalculus.lean @@ -17,4 +17,20 @@ example : (abs 0 (var 0)) =α (abs 1 (var 1)) := by constructor simp [Term.fv] +example : (abs 1 (var 0)).subst 0 (app (var 1) (var 2)) = (abs 3 (app (var 1) (var 2))) := by + simp [subst, fv, bv, vars, rename, instHasFreshNat, HasFresh.ofSucc] + +def x := 0 +def y := 1 +def z := 2 +def w := 3 + +attribute [simp] x y z w + +local instance coeNatTerm : Coe ℕ (Term ℕ) := ⟨Term.var⟩ + +-- section 5.3.4 of TAPL +example : (abs y (app x y))[x := (app y z : Term ℕ)] = (abs w (app (app y z) w)) := by + simp [subst, fv, bv, vars, rename, instHasFreshNat, HasFresh.ofSucc, instHasSubstitutionTerm] + -- example : (abs 0 (abs 1 (app (var 0) (var 1)))) =α (abs 1 (abs 0 (app (var 1) (var 0)))) := by From 89945fe84a72fd5c8808f828807e0ff7a2d56a42 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Tue, 26 Aug 2025 08:19:49 +0200 Subject: [PATCH 068/107] Fix citation --- Cslib/Logic/LinearLogic/CLL/Basic.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Logic/LinearLogic/CLL/Basic.lean b/Cslib/Logic/LinearLogic/CLL/Basic.lean index ef426f65..ad499704 100644 --- a/Cslib/Logic/LinearLogic/CLL/Basic.lean +++ b/Cslib/Logic/LinearLogic/CLL/Basic.lean @@ -15,7 +15,7 @@ import Mathlib.Order.Notation ## References -* [J.-Y. Girard, *Linear Logic: its syntax and semantics*] [Girard1995] +* [J.-Y. Girard, *Linear Logic: its syntax and semantics*][Girard1995] -/ From 08ebd481aed47ea9fcbb5be018b3b4dc56205abc Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Tue, 26 Aug 2025 08:24:46 +0200 Subject: [PATCH 069/107] Further Simulation golfing --- Cslib/Semantics/Lts/Simulation.lean | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/Cslib/Semantics/Lts/Simulation.lean b/Cslib/Semantics/Lts/Simulation.lean index 80d5c29a..7cd1c221 100644 --- a/Cslib/Semantics/Lts/Simulation.lean +++ b/Cslib/Semantics/Lts/Simulation.lean @@ -65,11 +65,7 @@ notation s:max " ≤[" lts "] " s':max => Similarity lts s s' /-- Similarity is reflexive. -/ theorem Similarity.refl (s : State) : s ≤[lts] s := by exists Eq - apply And.intro (by constructor) - simp only [Simulation] - intro s1 s2 hr μ s1' htr - cases hr - exists s1' + grind [Simulation] /-- The composition of two simulations is a simulation. -/ theorem Simulation.comp From b7add91fa42c1e1f8e3902b6beef5dbb57e695ad Mon Sep 17 00:00:00 2001 From: Juan Pablo Yamamoto Date: Wed, 27 Aug 2025 07:26:07 -0600 Subject: [PATCH 070/107] CLL equivalences and substitution of equivalent formulas (#49) * More theorems about CLL Added some theorems to the CLL namespace regarding equivalences and substitution of equivalent formulas. * Undo a typo * Rename subst_eqv_left -> subst_eqv_head. Added docstrings. --- Cslib/Logic/LinearLogic/CLL/Basic.lean | 95 ++++++++++++++++++++++++++ 1 file changed, 95 insertions(+) diff --git a/Cslib/Logic/LinearLogic/CLL/Basic.lean b/Cslib/Logic/LinearLogic/CLL/Basic.lean index ad499704..64a79502 100644 --- a/Cslib/Logic/LinearLogic/CLL/Basic.lean +++ b/Cslib/Logic/LinearLogic/CLL/Basic.lean @@ -5,7 +5,9 @@ Authors: Fabrizio Montesi -/ import Aesop +import Mathlib.Tactic.ApplyAt import Mathlib.Order.Notation +import Mathlib.Order.Defs.Unbundled /-! # Classical Linear Logic @@ -126,6 +128,8 @@ theorem Proposition.dual.involution (a : Proposition Atom) : a.dual.dual = a := /-- Linear implication. -/ def Proposition.linImpl (a b : Proposition Atom) : Proposition Atom := a.dual ⅋ b +@[inherit_doc] scoped infix:25 " ⊸ " => Proposition.linImpl + /-- A sequent in CLL is a list of propositions. -/ abbrev Sequent (Atom) := List (Proposition Atom) @@ -154,6 +158,9 @@ inductive Proof : Sequent Atom → Prop where scoped notation "⊢" Γ:90 => Proof Γ +theorem Proof.ax' {a : Proposition Atom} : Proof [a.dual, a] := + Proof.exchange (List.Perm.swap _ _ _) Proof.ax + section LogicalEquiv /-! ## Logical equivalences -/ @@ -221,6 +228,94 @@ theorem parr_top_eqv_top (a : Proposition Atom) : apply Proof.exchange (List.Perm.swap a top [top.dual]) exact Proof.top +theorem tensor_distrib_oplus (a b c : Proposition Atom) : + a ⊗ (b ⊕ c) ≡ (a ⊗ b) ⊕ (a ⊗ c) := by + constructor + · apply Proof.parr + apply Proof.exchange (List.Perm.swap a.dual (.with b.dual c.dual) _) + apply Proof.with + · apply Proof.exchange (List.reverse_perm _) + apply Proof.oplus₁ + apply Proof.tensor (Γ := [a.dual]) <;> exact Proof.ax + · apply Proof.exchange (List.reverse_perm _) + apply Proof.oplus₂ + apply Proof.tensor (Γ := [a.dual]) <;> exact Proof.ax + · apply Proof.with + · apply Proof.parr + apply Proof.exchange + (List.Perm.trans (List.Perm.swap ..) (List.Perm.cons _ (List.Perm.swap ..))) + apply Proof.tensor (Γ := [a.dual]) + · exact Proof.ax + · apply Proof.oplus₁ + exact Proof.ax + · apply Proof.parr + apply Proof.exchange + (List.Perm.trans (List.Perm.swap ..) (List.Perm.cons _ (List.Perm.swap ..))) + apply Proof.tensor (Γ := [a.dual]) + · exact Proof.ax + · apply Proof.oplus₂ + exact Proof.ax + +/-- The proposition at the head of a proof can be substituted by an equivalent + proposition. -/ +theorem subst_eqv_head {Γ : Sequent Atom} {a b : Proposition Atom} (heqv : a ≡ b) : + ⊢(a :: Γ) → ⊢(b :: Γ) := + fun h => Proof.exchange (List.perm_append_singleton b Γ) (Proof.cut h heqv.left) + +/-- Any proposition in a proof (regardless of its position) can be substituted by + an equivalent proposition. -/ +theorem subst_eqv {Γ Δ : Sequent Atom} {a b : Proposition Atom} (heqv : a ≡ b) : + ⊢(Γ ++ [a] ++ Δ) → ⊢(Γ ++ [b] ++ Δ) := by + simp + intro h + apply Proof.exchange (List.perm_middle.symm) + apply Proof.exchange (List.perm_middle) at h + apply subst_eqv_head heqv h + +theorem tensor_symm {a b : Proposition Atom} : a ⊗ b ≡ b ⊗ a := by + constructor + · apply Proof.parr + apply Proof.exchange (List.reverse_perm _) + apply Proof.tensor (Γ := [b.dual]) <;> exact Proof.ax + · apply Proof.parr + apply Proof.exchange (List.reverse_perm _) + apply Proof.tensor (Γ := [a.dual]) <;> exact Proof.ax + +theorem tensor_assoc {a b c : Proposition Atom} : a ⊗ (b ⊗ c) ≡ (a ⊗ b) ⊗ c := by + constructor + · apply Proof.parr + apply Proof.exchange (List.Perm.swap ..) + apply Proof.parr + apply Proof.exchange (List.Perm.swap ..) + apply Proof.exchange (List.reverse_perm _) + apply Proof.tensor (Γ := [a.dual, b.dual]) + · apply Proof.tensor (Γ := [a.dual]) <;> exact Proof.ax + · exact Proof.ax + · apply Proof.parr + apply Proof.parr + apply Proof.exchange (List.reverse_perm _) + apply Proof.exchange (List.Perm.cons _ (List.reverse_perm _)) + apply Proof.tensor (Γ := [a.dual]) + · exact Proof.ax + · apply Proof.tensor (Γ := [b.dual]) <;> exact Proof.ax + +instance {Γ : Sequent Atom} : IsSymm (Proposition Atom) (fun a b => ⊢((a ⊗ b) :: Γ)) where + symm := fun _ _ => subst_eqv_head tensor_symm + +theorem oplus_idem {a : Proposition Atom} : a ⊕ a ≡ a := by + constructor + · apply Proof.with <;> exact Proof.ax' + · apply Proof.exchange (List.Perm.swap ..) + apply Proof.oplus₁ + exact Proof.ax + +theorem with_idem {a : Proposition Atom} : a & a ≡ a := by + constructor + · apply Proof.oplus₁ + exact Proof.ax' + · apply Proof.exchange (List.Perm.swap ..) + apply Proof.with <;> exact Proof.ax + end Proposition end LogicalEquiv From ea6fc77ed020cf33533e21ae2150d1aab2da6247 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 27 Aug 2025 16:21:36 +0200 Subject: [PATCH 071/107] Reorg of directories --- Cslib/{ => Foundations}/Data/FinFun.lean | 0 Cslib/{ => Foundations}/Data/HasFresh.lean | 0 Cslib/{ => Foundations}/Data/Relation.lean | 0 Cslib/{ => Foundations}/Semantics/Lts/Basic.lean | 0 Cslib/{ => Foundations}/Semantics/Lts/Bisimulation.lean | 0 Cslib/{ => Foundations}/Semantics/Lts/Simulation.lean | 0 Cslib/{ => Foundations}/Semantics/Lts/TraceEq.lean | 0 Cslib/{ => Foundations}/Semantics/ReductionSystem/Basic.lean | 0 Cslib/{ => Foundations}/Syntax/HasAlphaEquiv.lean | 0 Cslib/{ => Foundations}/Syntax/HasSubstitution.lean | 0 Cslib/{ => Foundations}/Syntax/HasWellFormed.lean | 0 Cslib/{ConcurrencyTheory => Languages}/CCS/Basic.lean | 0 Cslib/{ConcurrencyTheory => Languages}/CCS/BehaviouralTheory.lean | 0 Cslib/{ConcurrencyTheory => Languages}/CCS/Semantics.lean | 0 Cslib/{Computability => Languages}/CombinatoryLogic/Basic.lean | 0 .../{Computability => Languages}/CombinatoryLogic/Confluence.lean | 0 Cslib/{Computability => Languages}/CombinatoryLogic/Defs.lean | 0 .../{Computability => Languages}/CombinatoryLogic/Evaluation.lean | 0 .../{Computability => Languages}/CombinatoryLogic/Recursion.lean | 0 .../LambdaCalculus/LocallyNameless/Context.lean | 0 .../LambdaCalculus/LocallyNameless/Stlc/Basic.lean | 0 .../LambdaCalculus/LocallyNameless/Stlc/Safety.lean | 0 .../LambdaCalculus/LocallyNameless/Untyped/Basic.lean | 0 .../LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean | 0 .../LocallyNameless/Untyped/FullBetaConfluence.lean | 0 .../LambdaCalculus/LocallyNameless/Untyped/Properties.lean | 0 .../LambdaCalculus/Named/Untyped/Basic.lean | 0 Cslib/{Logic => Logics}/LinearLogic/CLL/Basic.lean | 0 28 files changed, 0 insertions(+), 0 deletions(-) rename Cslib/{ => Foundations}/Data/FinFun.lean (100%) rename Cslib/{ => Foundations}/Data/HasFresh.lean (100%) rename Cslib/{ => Foundations}/Data/Relation.lean (100%) rename Cslib/{ => Foundations}/Semantics/Lts/Basic.lean (100%) rename Cslib/{ => Foundations}/Semantics/Lts/Bisimulation.lean (100%) rename Cslib/{ => Foundations}/Semantics/Lts/Simulation.lean (100%) rename Cslib/{ => Foundations}/Semantics/Lts/TraceEq.lean (100%) rename Cslib/{ => Foundations}/Semantics/ReductionSystem/Basic.lean (100%) rename Cslib/{ => Foundations}/Syntax/HasAlphaEquiv.lean (100%) rename Cslib/{ => Foundations}/Syntax/HasSubstitution.lean (100%) rename Cslib/{ => Foundations}/Syntax/HasWellFormed.lean (100%) rename Cslib/{ConcurrencyTheory => Languages}/CCS/Basic.lean (100%) rename Cslib/{ConcurrencyTheory => Languages}/CCS/BehaviouralTheory.lean (100%) rename Cslib/{ConcurrencyTheory => Languages}/CCS/Semantics.lean (100%) rename Cslib/{Computability => Languages}/CombinatoryLogic/Basic.lean (100%) rename Cslib/{Computability => Languages}/CombinatoryLogic/Confluence.lean (100%) rename Cslib/{Computability => Languages}/CombinatoryLogic/Defs.lean (100%) rename Cslib/{Computability => Languages}/CombinatoryLogic/Evaluation.lean (100%) rename Cslib/{Computability => Languages}/CombinatoryLogic/Recursion.lean (100%) rename Cslib/{Computability => Languages}/LambdaCalculus/LocallyNameless/Context.lean (100%) rename Cslib/{Computability => Languages}/LambdaCalculus/LocallyNameless/Stlc/Basic.lean (100%) rename Cslib/{Computability => Languages}/LambdaCalculus/LocallyNameless/Stlc/Safety.lean (100%) rename Cslib/{Computability => Languages}/LambdaCalculus/LocallyNameless/Untyped/Basic.lean (100%) rename Cslib/{Computability => Languages}/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean (100%) rename Cslib/{Computability => Languages}/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean (100%) rename Cslib/{Computability => Languages}/LambdaCalculus/LocallyNameless/Untyped/Properties.lean (100%) rename Cslib/{Computability => Languages}/LambdaCalculus/Named/Untyped/Basic.lean (100%) rename Cslib/{Logic => Logics}/LinearLogic/CLL/Basic.lean (100%) diff --git a/Cslib/Data/FinFun.lean b/Cslib/Foundations/Data/FinFun.lean similarity index 100% rename from Cslib/Data/FinFun.lean rename to Cslib/Foundations/Data/FinFun.lean diff --git a/Cslib/Data/HasFresh.lean b/Cslib/Foundations/Data/HasFresh.lean similarity index 100% rename from Cslib/Data/HasFresh.lean rename to Cslib/Foundations/Data/HasFresh.lean diff --git a/Cslib/Data/Relation.lean b/Cslib/Foundations/Data/Relation.lean similarity index 100% rename from Cslib/Data/Relation.lean rename to Cslib/Foundations/Data/Relation.lean diff --git a/Cslib/Semantics/Lts/Basic.lean b/Cslib/Foundations/Semantics/Lts/Basic.lean similarity index 100% rename from Cslib/Semantics/Lts/Basic.lean rename to Cslib/Foundations/Semantics/Lts/Basic.lean diff --git a/Cslib/Semantics/Lts/Bisimulation.lean b/Cslib/Foundations/Semantics/Lts/Bisimulation.lean similarity index 100% rename from Cslib/Semantics/Lts/Bisimulation.lean rename to Cslib/Foundations/Semantics/Lts/Bisimulation.lean diff --git a/Cslib/Semantics/Lts/Simulation.lean b/Cslib/Foundations/Semantics/Lts/Simulation.lean similarity index 100% rename from Cslib/Semantics/Lts/Simulation.lean rename to Cslib/Foundations/Semantics/Lts/Simulation.lean diff --git a/Cslib/Semantics/Lts/TraceEq.lean b/Cslib/Foundations/Semantics/Lts/TraceEq.lean similarity index 100% rename from Cslib/Semantics/Lts/TraceEq.lean rename to Cslib/Foundations/Semantics/Lts/TraceEq.lean diff --git a/Cslib/Semantics/ReductionSystem/Basic.lean b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean similarity index 100% rename from Cslib/Semantics/ReductionSystem/Basic.lean rename to Cslib/Foundations/Semantics/ReductionSystem/Basic.lean diff --git a/Cslib/Syntax/HasAlphaEquiv.lean b/Cslib/Foundations/Syntax/HasAlphaEquiv.lean similarity index 100% rename from Cslib/Syntax/HasAlphaEquiv.lean rename to Cslib/Foundations/Syntax/HasAlphaEquiv.lean diff --git a/Cslib/Syntax/HasSubstitution.lean b/Cslib/Foundations/Syntax/HasSubstitution.lean similarity index 100% rename from Cslib/Syntax/HasSubstitution.lean rename to Cslib/Foundations/Syntax/HasSubstitution.lean diff --git a/Cslib/Syntax/HasWellFormed.lean b/Cslib/Foundations/Syntax/HasWellFormed.lean similarity index 100% rename from Cslib/Syntax/HasWellFormed.lean rename to Cslib/Foundations/Syntax/HasWellFormed.lean diff --git a/Cslib/ConcurrencyTheory/CCS/Basic.lean b/Cslib/Languages/CCS/Basic.lean similarity index 100% rename from Cslib/ConcurrencyTheory/CCS/Basic.lean rename to Cslib/Languages/CCS/Basic.lean diff --git a/Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean b/Cslib/Languages/CCS/BehaviouralTheory.lean similarity index 100% rename from Cslib/ConcurrencyTheory/CCS/BehaviouralTheory.lean rename to Cslib/Languages/CCS/BehaviouralTheory.lean diff --git a/Cslib/ConcurrencyTheory/CCS/Semantics.lean b/Cslib/Languages/CCS/Semantics.lean similarity index 100% rename from Cslib/ConcurrencyTheory/CCS/Semantics.lean rename to Cslib/Languages/CCS/Semantics.lean diff --git a/Cslib/Computability/CombinatoryLogic/Basic.lean b/Cslib/Languages/CombinatoryLogic/Basic.lean similarity index 100% rename from Cslib/Computability/CombinatoryLogic/Basic.lean rename to Cslib/Languages/CombinatoryLogic/Basic.lean diff --git a/Cslib/Computability/CombinatoryLogic/Confluence.lean b/Cslib/Languages/CombinatoryLogic/Confluence.lean similarity index 100% rename from Cslib/Computability/CombinatoryLogic/Confluence.lean rename to Cslib/Languages/CombinatoryLogic/Confluence.lean diff --git a/Cslib/Computability/CombinatoryLogic/Defs.lean b/Cslib/Languages/CombinatoryLogic/Defs.lean similarity index 100% rename from Cslib/Computability/CombinatoryLogic/Defs.lean rename to Cslib/Languages/CombinatoryLogic/Defs.lean diff --git a/Cslib/Computability/CombinatoryLogic/Evaluation.lean b/Cslib/Languages/CombinatoryLogic/Evaluation.lean similarity index 100% rename from Cslib/Computability/CombinatoryLogic/Evaluation.lean rename to Cslib/Languages/CombinatoryLogic/Evaluation.lean diff --git a/Cslib/Computability/CombinatoryLogic/Recursion.lean b/Cslib/Languages/CombinatoryLogic/Recursion.lean similarity index 100% rename from Cslib/Computability/CombinatoryLogic/Recursion.lean rename to Cslib/Languages/CombinatoryLogic/Recursion.lean diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Context.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Context.lean similarity index 100% rename from Cslib/Computability/LambdaCalculus/LocallyNameless/Context.lean rename to Cslib/Languages/LambdaCalculus/LocallyNameless/Context.lean diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean similarity index 100% rename from Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Basic.lean rename to Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Safety.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Safety.lean similarity index 100% rename from Cslib/Computability/LambdaCalculus/LocallyNameless/Stlc/Safety.lean rename to Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Safety.lean diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Basic.lean similarity index 100% rename from Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Basic.lean rename to Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Basic.lean diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean similarity index 100% rename from Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean rename to Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean similarity index 100% rename from Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean rename to Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean diff --git a/Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean similarity index 100% rename from Cslib/Computability/LambdaCalculus/LocallyNameless/Untyped/Properties.lean rename to Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean diff --git a/Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean b/Cslib/Languages/LambdaCalculus/Named/Untyped/Basic.lean similarity index 100% rename from Cslib/Computability/LambdaCalculus/Named/Untyped/Basic.lean rename to Cslib/Languages/LambdaCalculus/Named/Untyped/Basic.lean diff --git a/Cslib/Logic/LinearLogic/CLL/Basic.lean b/Cslib/Logics/LinearLogic/CLL/Basic.lean similarity index 100% rename from Cslib/Logic/LinearLogic/CLL/Basic.lean rename to Cslib/Logics/LinearLogic/CLL/Basic.lean From 69ad85b882437af90d2371d0859e0842d4e2eaab Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 27 Aug 2025 16:23:55 +0200 Subject: [PATCH 072/107] Reorg: fix imports --- Cslib.lean | 12 ++++++------ Cslib/Foundations/Semantics/Lts/Bisimulation.lean | 8 ++++---- Cslib/Foundations/Semantics/Lts/Simulation.lean | 4 ++-- Cslib/Foundations/Semantics/Lts/TraceEq.lean | 2 +- Cslib/Languages/CCS/BehaviouralTheory.lean | 8 ++++---- Cslib/Languages/CCS/Semantics.lean | 4 ++-- Cslib/Languages/CombinatoryLogic/Basic.lean | 2 +- Cslib/Languages/CombinatoryLogic/Confluence.lean | 4 ++-- Cslib/Languages/CombinatoryLogic/Recursion.lean | 4 ++-- .../LambdaCalculus/LocallyNameless/Context.lean | 2 +- .../LambdaCalculus/LocallyNameless/Stlc/Basic.lean | 4 ++-- .../LambdaCalculus/LocallyNameless/Stlc/Safety.lean | 8 ++++---- .../LocallyNameless/Untyped/Basic.lean | 4 ++-- .../LocallyNameless/Untyped/FullBeta.lean | 6 +++--- .../LocallyNameless/Untyped/FullBetaConfluence.lean | 8 ++++---- .../LocallyNameless/Untyped/Properties.lean | 2 +- .../LambdaCalculus/Named/Untyped/Basic.lean | 6 +++--- CslibTests/Bisimulation.lean | 2 +- CslibTests/CCS.lean | 2 +- CslibTests/HasFresh.lean | 2 +- CslibTests/LambdaCalculus.lean | 2 +- CslibTests/Lts.lean | 4 ++-- CslibTests/ReductionSystem.lean | 2 +- 23 files changed, 51 insertions(+), 51 deletions(-) diff --git a/Cslib.lean b/Cslib.lean index 7b712c49..c50fa2ec 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -1,6 +1,6 @@ -import Cslib.Semantics.Lts.Basic -import Cslib.Semantics.Lts.Bisimulation -import Cslib.Semantics.Lts.TraceEq -import Cslib.Data.Relation -import Cslib.Computability.CombinatoryLogic.Defs -import Cslib.Computability.CombinatoryLogic.Basic +import Cslib.Foundations.Semantics.Lts.Basic +import Cslib.Foundations.Semantics.Lts.Bisimulation +import Cslib.Foundations.Semantics.Lts.TraceEq +import Cslib.Foundations.Data.Relation +import Cslib.Languages.CombinatoryLogic.Defs +import Cslib.Languages.CombinatoryLogic.Basic diff --git a/Cslib/Foundations/Semantics/Lts/Bisimulation.lean b/Cslib/Foundations/Semantics/Lts/Bisimulation.lean index 5182f39e..48472146 100644 --- a/Cslib/Foundations/Semantics/Lts/Bisimulation.lean +++ b/Cslib/Foundations/Semantics/Lts/Bisimulation.lean @@ -4,10 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.Lts.Basic -import Cslib.Semantics.Lts.TraceEq -import Cslib.Data.Relation -import Cslib.Semantics.Lts.Simulation +import Cslib.Foundations.Semantics.Lts.Basic +import Cslib.Foundations.Semantics.Lts.TraceEq +import Cslib.Foundations.Data.Relation +import Cslib.Foundations.Semantics.Lts.Simulation import Mathlib.Order.CompleteLattice.Defs /-! # Bisimulation and Bisimilarity diff --git a/Cslib/Foundations/Semantics/Lts/Simulation.lean b/Cslib/Foundations/Semantics/Lts/Simulation.lean index 7cd1c221..9e69c92a 100644 --- a/Cslib/Foundations/Semantics/Lts/Simulation.lean +++ b/Cslib/Foundations/Semantics/Lts/Simulation.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.Lts.Basic -import Cslib.Data.Relation +import Cslib.Foundations.Semantics.Lts.Basic +import Cslib.Foundations.Data.Relation /-! # Simulation and Similarity diff --git a/Cslib/Foundations/Semantics/Lts/TraceEq.lean b/Cslib/Foundations/Semantics/Lts/TraceEq.lean index 1864b5ab..7ac979ba 100644 --- a/Cslib/Foundations/Semantics/Lts/TraceEq.lean +++ b/Cslib/Foundations/Semantics/Lts/TraceEq.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.Lts.Basic +import Cslib.Foundations.Semantics.Lts.Basic import Mathlib.Data.Set.Finite.Basic /-! diff --git a/Cslib/Languages/CCS/BehaviouralTheory.lean b/Cslib/Languages/CCS/BehaviouralTheory.lean index 74edf1ee..3a9fd317 100644 --- a/Cslib/Languages/CCS/BehaviouralTheory.lean +++ b/Cslib/Languages/CCS/BehaviouralTheory.lean @@ -4,10 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.Lts.Basic -import Cslib.Semantics.Lts.Bisimulation -import Cslib.ConcurrencyTheory.CCS.Basic -import Cslib.ConcurrencyTheory.CCS.Semantics +import Cslib.Foundations.Semantics.Lts.Basic +import Cslib.Foundations.Semantics.Lts.Bisimulation +import Cslib.Languages.CCS.Basic +import Cslib.Languages.CCS.Semantics /-! # Behavioural theory of CCS diff --git a/Cslib/Languages/CCS/Semantics.lean b/Cslib/Languages/CCS/Semantics.lean index f82d7960..c588b371 100644 --- a/Cslib/Languages/CCS/Semantics.lean +++ b/Cslib/Languages/CCS/Semantics.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.Lts.Basic -import Cslib.ConcurrencyTheory.CCS.Basic +import Cslib.Foundations.Semantics.Lts.Basic +import Cslib.Languages.CCS.Basic /-! # Semantics of CCS diff --git a/Cslib/Languages/CombinatoryLogic/Basic.lean b/Cslib/Languages/CombinatoryLogic/Basic.lean index 58bd309c..4dc3b2cb 100644 --- a/Cslib/Languages/CombinatoryLogic/Basic.lean +++ b/Cslib/Languages/CombinatoryLogic/Basic.lean @@ -3,7 +3,7 @@ Copyright (c) 2025 Thomas Waring. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Waring -/ -import Cslib.Computability.CombinatoryLogic.Defs +import Cslib.Languages.CombinatoryLogic.Defs /-! # Basic results for the SKI calculus diff --git a/Cslib/Languages/CombinatoryLogic/Confluence.lean b/Cslib/Languages/CombinatoryLogic/Confluence.lean index 766438d2..d26e4cf9 100644 --- a/Cslib/Languages/CombinatoryLogic/Confluence.lean +++ b/Cslib/Languages/CombinatoryLogic/Confluence.lean @@ -3,8 +3,8 @@ Copyright (c) 2025 Thomas Waring. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Waring -/ -import Cslib.Computability.CombinatoryLogic.Defs -import Cslib.Data.Relation +import Cslib.Languages.CombinatoryLogic.Defs +import Cslib.Foundations.Data.Relation /-! # SKI reduction is confluent diff --git a/Cslib/Languages/CombinatoryLogic/Recursion.lean b/Cslib/Languages/CombinatoryLogic/Recursion.lean index bc4e0d5d..4b43b8ea 100644 --- a/Cslib/Languages/CombinatoryLogic/Recursion.lean +++ b/Cslib/Languages/CombinatoryLogic/Recursion.lean @@ -3,8 +3,8 @@ Copyright (c) 2025 Thomas Waring. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Waring -/ -import Cslib.Computability.CombinatoryLogic.Defs -import Cslib.Computability.CombinatoryLogic.Basic +import Cslib.Languages.CombinatoryLogic.Defs +import Cslib.Languages.CombinatoryLogic.Basic /-! # General recursion in the SKI calculus diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Context.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Context.lean index c7006d84..c1c20a96 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Context.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Context.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Syntax.HasWellFormed +import Cslib.Foundations.Syntax.HasWellFormed import Mathlib.Data.Finset.Defs import Mathlib.Data.Finset.Dedup import Mathlib.Data.List.Sigma diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean index 08795dd4..5e28a18f 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Basic.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Computability.LambdaCalculus.LocallyNameless.Context -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Properties +import Cslib.Languages.LambdaCalculus.LocallyNameless.Context +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties /-! # λ-calculus diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Safety.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Safety.lean index ed74dd6e..83e0197f 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Safety.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Stlc/Safety.lean @@ -4,10 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Computability.LambdaCalculus.LocallyNameless.Stlc.Basic -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Basic -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Properties -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence +import Cslib.Languages.LambdaCalculus.LocallyNameless.Stlc.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaConfluence /-! # λ-calculus diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Basic.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Basic.lean index 82a964f6..8961af5f 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Basic.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Basic.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Data.HasFresh -import Cslib.Syntax.HasSubstitution +import Cslib.Foundations.Data.HasFresh +import Cslib.Foundations.Syntax.HasSubstitution /-! # λ-calculus diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean index 0122f639..e08ceb8c 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean @@ -4,9 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Basic -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Properties -import Cslib.Semantics.ReductionSystem.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties +import Cslib.Foundations.Semantics.ReductionSystem.Basic /-! # β-reduction for the λ-calculus diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean index 75195c82..2b1fa4c5 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBetaConfluence.lean @@ -4,10 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Basic -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Properties -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.FullBeta -import Cslib.Data.Relation +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBeta +import Cslib.Foundations.Data.Relation /-! # β-confluence for the λ-calculus -/ diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean index 0aa0189e..885bf590 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/Properties.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Henson -/ -import Cslib.Computability.LambdaCalculus.LocallyNameless.Untyped.Basic +import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Basic universe u diff --git a/Cslib/Languages/LambdaCalculus/Named/Untyped/Basic.lean b/Cslib/Languages/LambdaCalculus/Named/Untyped/Basic.lean index bbe3ad02..264387a1 100644 --- a/Cslib/Languages/LambdaCalculus/Named/Untyped/Basic.lean +++ b/Cslib/Languages/LambdaCalculus/Named/Untyped/Basic.lean @@ -4,9 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Data.HasFresh -import Cslib.Syntax.HasAlphaEquiv -import Cslib.Syntax.HasSubstitution +import Cslib.Foundations.Data.HasFresh +import Cslib.Foundations.Syntax.HasAlphaEquiv +import Cslib.Foundations.Syntax.HasSubstitution import Mathlib.Data.Finset.Basic /-! # λ-calculus diff --git a/CslibTests/Bisimulation.lean b/CslibTests/Bisimulation.lean index cb2ac965..d3869954 100644 --- a/CslibTests/Bisimulation.lean +++ b/CslibTests/Bisimulation.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.Lts.Bisimulation +import Cslib.Foundations.Semantics.Lts.Bisimulation /- An LTS with two bisimilar states. -/ private inductive tr1 : ℕ → Char → ℕ → Prop where diff --git a/CslibTests/CCS.lean b/CslibTests/CCS.lean index 67a8d953..09d2b339 100644 --- a/CslibTests/CCS.lean +++ b/CslibTests/CCS.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.ConcurrencyTheory.CCS.Semantics +import Cslib.Languages.CCS.Semantics open CCS Process diff --git a/CslibTests/HasFresh.lean b/CslibTests/HasFresh.lean index 88943c64..4ab59dcb 100644 --- a/CslibTests/HasFresh.lean +++ b/CslibTests/HasFresh.lean @@ -1,4 +1,4 @@ -import Cslib.Data.HasFresh +import Cslib.Foundations.Data.HasFresh variable {Var Term : Type} [DecidableEq Var] [HasFresh Var] diff --git a/CslibTests/LambdaCalculus.lean b/CslibTests/LambdaCalculus.lean index ab6f1276..7c6f32ea 100644 --- a/CslibTests/LambdaCalculus.lean +++ b/CslibTests/LambdaCalculus.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Computability.LambdaCalculus.Named.Untyped.Basic +import Cslib.Languages.LambdaCalculus.Named.Untyped.Basic open LambdaCalculus.Named open LambdaCalculus.Named.Term diff --git a/CslibTests/Lts.lean b/CslibTests/Lts.lean index 3a46bb80..10f0bb12 100644 --- a/CslibTests/Lts.lean +++ b/CslibTests/Lts.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fabrizio Montesi -/ -import Cslib.Semantics.Lts.Basic -import Cslib.Semantics.Lts.Bisimulation +import Cslib.Foundations.Semantics.Lts.Basic +import Cslib.Foundations.Semantics.Lts.Bisimulation import Mathlib.Algebra.Group.Even import Mathlib.Algebra.Ring.Parity diff --git a/CslibTests/ReductionSystem.lean b/CslibTests/ReductionSystem.lean index 9c6b985f..3e37a8ee 100644 --- a/CslibTests/ReductionSystem.lean +++ b/CslibTests/ReductionSystem.lean @@ -1,4 +1,4 @@ -import Cslib.Semantics.ReductionSystem.Basic +import Cslib.Foundations.Semantics.ReductionSystem.Basic @[reduction_sys rs "ₙ", simp] def PredReduction (a b : ℕ) : Prop := a = b + 1 From 11112da633866a9def53e84c58ae1744f224c35c Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Wed, 27 Aug 2025 10:45:20 -0400 Subject: [PATCH 073/107] update CODEOWNERS (#51) --- .github/CODEOWNERS | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 3b5151da..d164c7c3 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -2,6 +2,6 @@ /docs @fmontesi @chenson2018 /CslibTests @fmontesi @chenson2018 -/Cslib/Computability/LambdaCalculus/ @chenson2018 -/Cslib/ConcurrencyTheory/ @fmontesi -/Cslib/Logic/ @fmontesi @m-ow +/Cslib/Languages/LambdaCalculus/ @chenson2018 +/Cslib/Languages/CCS/ @fmontesi +/Cslib/Logics/ @fmontesi @m-ow From 4c329db9eb569213931d4c69e5da5e02da394663 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Thu, 28 Aug 2025 09:26:12 +0200 Subject: [PATCH 074/107] Notation for duality in CLL --- .vscode/settings.json | 3 +- Cslib/Logics/LinearLogic/CLL/Basic.lean | 50 +++++++++++++------------ 2 files changed, 28 insertions(+), 25 deletions(-) diff --git a/.vscode/settings.json b/.vscode/settings.json index 7242e3a0..2a88a81d 100644 --- a/.vscode/settings.json +++ b/.vscode/settings.json @@ -12,7 +12,8 @@ "mtr": "↠", "red": "⭢", "mred": "↠", - "_?": "ʔ" + "_?": "ʔ", + "dual": "⫠" }, "editor.rulers": [ 100 diff --git a/Cslib/Logics/LinearLogic/CLL/Basic.lean b/Cslib/Logics/LinearLogic/CLL/Basic.lean index 64a79502..0830628b 100644 --- a/Cslib/Logics/LinearLogic/CLL/Basic.lean +++ b/Cslib/Logics/LinearLogic/CLL/Basic.lean @@ -109,24 +109,26 @@ def Proposition.dual : Proposition Atom → Proposition Atom | bang a => quest a.dual | quest a => bang a.dual +@[inherit_doc] scoped postfix:max "⫠" => Proposition.dual + /-- No proposition is equal to its dual. -/ -theorem Proposition.dual.neq (a : Proposition Atom) : a ≠ a.dual := by +theorem Proposition.dual.neq (a : Proposition Atom) : a ≠ a⫠ := by cases a <;> simp [Proposition.dual] /-- Two propositions are equal iff their respective duals are equal. -/ @[simp] -theorem Proposition.dual_inj (a b : Proposition Atom) : a.dual = b.dual ↔ a = b := by +theorem Proposition.dual_inj (a b : Proposition Atom) : a⫠ = b⫠ ↔ a = b := by refine ⟨fun h ↦ ?_, congrArg dual⟩ induction a generalizing b <;> cases b all_goals aesop (add simp [Proposition.dual]) /-- Duality is an involution. -/ @[simp] -theorem Proposition.dual.involution (a : Proposition Atom) : a.dual.dual = a := by +theorem Proposition.dual.involution (a : Proposition Atom) : a⫠⫠ = a := by induction a <;> simp_all [dual] /-- Linear implication. -/ -def Proposition.linImpl (a b : Proposition Atom) : Proposition Atom := a.dual ⅋ b +def Proposition.linImpl (a b : Proposition Atom) : Proposition Atom := a⫠ ⅋ b @[inherit_doc] scoped infix:25 " ⊸ " => Proposition.linImpl @@ -140,8 +142,8 @@ def Sequent.allQuest (Γ : Sequent Atom) := open Proposition in /-- Sequent calculus for CLL. -/ inductive Proof : Sequent Atom → Prop where - | ax : Proof [a, a.dual] - | cut : Proof (a :: Γ) → Proof (a.dual :: Δ) → Proof (Γ ++ Δ) + | ax : Proof [a, a⫠] + | cut : Proof (a :: Γ) → Proof (a⫠ :: Δ) → Proof (Γ ++ Δ) | exchange : List.Perm Γ Δ → Proof Γ → Proof Δ | one : Proof [one] | bot : Proof Γ → Proof (⊥ :: Γ) @@ -158,15 +160,15 @@ inductive Proof : Sequent Atom → Prop where scoped notation "⊢" Γ:90 => Proof Γ -theorem Proof.ax' {a : Proposition Atom} : Proof [a.dual, a] := - Proof.exchange (List.Perm.swap _ _ _) Proof.ax +theorem Proof.ax' {a : Proposition Atom} : Proof [a⫠, a] := + Proof.exchange (List.Perm.swap ..) Proof.ax section LogicalEquiv /-! ## Logical equivalences -/ /-- Two propositions are equivalent if one implies the other and vice versa. -/ -def Proposition.equiv (a b : Proposition Atom) : Prop := ⊢[a.dual, b] ∧ ⊢[b.dual, a] +def Proposition.equiv (a b : Proposition Atom) : Prop := ⊢[a⫠, b] ∧ ⊢[b⫠, a] scoped infix:29 " ≡ " => Proposition.equiv @@ -215,43 +217,43 @@ theorem quest_zero_eqv_bot : (ʔ0 : Proposition Atom) ≡ ⊥ := by theorem tensor_zero_eqv_zero (a : Proposition Atom) : a ⊗ 0 ≡ 0 := by refine ⟨?_, .top⟩ apply Proof.parr - apply Proof.exchange (List.Perm.swap a.dual ⊤ [0]) + apply Proof.exchange (List.Perm.swap a⫠ ⊤ [0]) exact Proof.top theorem parr_top_eqv_top (a : Proposition Atom) : a ⅋ ⊤ ≡ ⊤ := by constructor - · apply Proof.exchange (List.Perm.swap (parr a top).dual top []) + · apply Proof.exchange (List.Perm.swap (parr a top)⫠ top []) exact Proof.top - · apply Proof.exchange (List.Perm.swap top.dual (parr a top) []) + · apply Proof.exchange (List.Perm.swap top⫠ (parr a top) []) apply Proof.parr - apply Proof.exchange (List.Perm.swap a top [top.dual]) + apply Proof.exchange (List.Perm.swap a top [top⫠]) exact Proof.top theorem tensor_distrib_oplus (a b c : Proposition Atom) : a ⊗ (b ⊕ c) ≡ (a ⊗ b) ⊕ (a ⊗ c) := by constructor · apply Proof.parr - apply Proof.exchange (List.Perm.swap a.dual (.with b.dual c.dual) _) + apply Proof.exchange (List.Perm.swap a⫠ (.with b⫠ c⫠) _) apply Proof.with · apply Proof.exchange (List.reverse_perm _) apply Proof.oplus₁ - apply Proof.tensor (Γ := [a.dual]) <;> exact Proof.ax + apply Proof.tensor (Γ := [a⫠]) <;> exact Proof.ax · apply Proof.exchange (List.reverse_perm _) apply Proof.oplus₂ - apply Proof.tensor (Γ := [a.dual]) <;> exact Proof.ax + apply Proof.tensor (Γ := [a⫠]) <;> exact Proof.ax · apply Proof.with · apply Proof.parr apply Proof.exchange (List.Perm.trans (List.Perm.swap ..) (List.Perm.cons _ (List.Perm.swap ..))) - apply Proof.tensor (Γ := [a.dual]) + apply Proof.tensor (Γ := [a⫠]) · exact Proof.ax · apply Proof.oplus₁ exact Proof.ax · apply Proof.parr apply Proof.exchange (List.Perm.trans (List.Perm.swap ..) (List.Perm.cons _ (List.Perm.swap ..))) - apply Proof.tensor (Γ := [a.dual]) + apply Proof.tensor (Γ := [a⫠]) · exact Proof.ax · apply Proof.oplus₂ exact Proof.ax @@ -276,10 +278,10 @@ theorem tensor_symm {a b : Proposition Atom} : a ⊗ b ≡ b ⊗ a := by constructor · apply Proof.parr apply Proof.exchange (List.reverse_perm _) - apply Proof.tensor (Γ := [b.dual]) <;> exact Proof.ax + apply Proof.tensor (Γ := [b⫠]) <;> exact Proof.ax · apply Proof.parr apply Proof.exchange (List.reverse_perm _) - apply Proof.tensor (Γ := [a.dual]) <;> exact Proof.ax + apply Proof.tensor (Γ := [a⫠]) <;> exact Proof.ax theorem tensor_assoc {a b c : Proposition Atom} : a ⊗ (b ⊗ c) ≡ (a ⊗ b) ⊗ c := by constructor @@ -288,16 +290,16 @@ theorem tensor_assoc {a b c : Proposition Atom} : a ⊗ (b ⊗ c) ≡ (a ⊗ b) apply Proof.parr apply Proof.exchange (List.Perm.swap ..) apply Proof.exchange (List.reverse_perm _) - apply Proof.tensor (Γ := [a.dual, b.dual]) - · apply Proof.tensor (Γ := [a.dual]) <;> exact Proof.ax + apply Proof.tensor (Γ := [a⫠, b⫠]) + · apply Proof.tensor (Γ := [a⫠]) <;> exact Proof.ax · exact Proof.ax · apply Proof.parr apply Proof.parr apply Proof.exchange (List.reverse_perm _) apply Proof.exchange (List.Perm.cons _ (List.reverse_perm _)) - apply Proof.tensor (Γ := [a.dual]) + apply Proof.tensor (Γ := [a⫠]) · exact Proof.ax - · apply Proof.tensor (Γ := [b.dual]) <;> exact Proof.ax + · apply Proof.tensor (Γ := [b⫠]) <;> exact Proof.ax instance {Γ : Sequent Atom} : IsSymm (Proposition Atom) (fun a b => ⊢((a ⊗ b) :: Γ)) where symm := fun _ _ => subst_eqv_head tensor_symm From 3bb54f3057d9e038d48f287c30be2d05ea689994 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Thu, 28 Aug 2025 09:26:48 +0200 Subject: [PATCH 075/107] use notation for ? --- Cslib/Logics/LinearLogic/CLL/Basic.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Cslib/Logics/LinearLogic/CLL/Basic.lean b/Cslib/Logics/LinearLogic/CLL/Basic.lean index 0830628b..a82f2ec4 100644 --- a/Cslib/Logics/LinearLogic/CLL/Basic.lean +++ b/Cslib/Logics/LinearLogic/CLL/Basic.lean @@ -137,7 +137,7 @@ abbrev Sequent (Atom) := List (Proposition Atom) /-- Checks that all propositions in `Γ` are question marks. -/ def Sequent.allQuest (Γ : Sequent Atom) := - ∀ a ∈ Γ, ∃ b, a = Proposition.quest b + ∀ a ∈ Γ, ∃ b, a = ʔb open Proposition in /-- Sequent calculus for CLL. -/ From 8edf9eeeea919c775469f21cb89ba1b4c1390e90 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Thu, 28 Aug 2025 12:41:49 +0200 Subject: [PATCH 076/107] Some notation fixes and statement of cut admissibility and elimination --- Cslib/Logics/LinearLogic/CLL/Basic.lean | 5 +- .../LinearLogic/CLL/CutElimination.lean | 66 +++++++++++++++++++ 2 files changed, 69 insertions(+), 2 deletions(-) create mode 100644 Cslib/Logics/LinearLogic/CLL/CutElimination.lean diff --git a/Cslib/Logics/LinearLogic/CLL/Basic.lean b/Cslib/Logics/LinearLogic/CLL/Basic.lean index a82f2ec4..a6d1e037 100644 --- a/Cslib/Logics/LinearLogic/CLL/Basic.lean +++ b/Cslib/Logics/LinearLogic/CLL/Basic.lean @@ -145,18 +145,19 @@ inductive Proof : Sequent Atom → Prop where | ax : Proof [a, a⫠] | cut : Proof (a :: Γ) → Proof (a⫠ :: Δ) → Proof (Γ ++ Δ) | exchange : List.Perm Γ Δ → Proof Γ → Proof Δ - | one : Proof [one] + | one : Proof [1] | bot : Proof Γ → Proof (⊥ :: Γ) | parr : Proof (a :: b :: Γ) → Proof ((a ⅋ b) :: Γ) | tensor : Proof (a :: Γ) → Proof (b :: Δ) → Proof ((a ⊗ b) :: (Γ ++ Δ)) | oplus₁ : Proof (a :: Γ) → Proof ((a ⊕ b) :: Γ) | oplus₂ : Proof (b :: Γ) → Proof ((a ⊕ b) :: Γ) | with : Proof (a :: Γ) → Proof (b :: Γ) → Proof ((a & b) :: Γ) - | top : Proof (top :: Γ) + | top : Proof (⊤ :: Γ) | quest : Proof (a :: Γ) → Proof (ʔa :: Γ) | weaken : Proof Γ → Proof (ʔa :: Γ) | contract : Proof (ʔa :: ʔa :: Γ) → Proof (ʔa :: Γ) | bang {Γ : Sequent Atom} {a} : Γ.allQuest → Proof (a :: Γ) → Proof ((!a) :: Γ) + -- No rule for zero. scoped notation "⊢" Γ:90 => Proof Γ diff --git a/Cslib/Logics/LinearLogic/CLL/CutElimination.lean b/Cslib/Logics/LinearLogic/CLL/CutElimination.lean new file mode 100644 index 00000000..dccd2786 --- /dev/null +++ b/Cslib/Logics/LinearLogic/CLL/CutElimination.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2025 Fabrizio Montesi. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Fabrizio Montesi +-/ + +import Batteries.Util.ProofWanted +import Cslib.Logics.LinearLogic.CLL.Basic + +namespace CLL + +universe u + +variable {Atom : Type u} + +/-- A proof is cut-free if it does not contain any applications of rule cut. -/ +inductive Proof.CutFree : {Γ : Sequent Atom} → ⊢Γ → Prop where + | ax : Proof.ax.CutFree + | one : Proof.one.CutFree + | bot (p : ⊢Γ) (hp : CutFree p) : p.bot.CutFree + | exchange (hperm : Γ.Perm Δ) (p : ⊢Γ) : (Proof.exchange hperm p).CutFree + | parr (p : ⊢(a :: b :: Γ)) : p.CutFree → p.parr.CutFree + | tensor (p : ⊢(a :: Γ)) (q : ⊢(b :: Δ)) : + p.CutFree → q.CutFree → (Proof.tensor p q).CutFree + | oplus₁ (p : ⊢(a :: Γ)) : p.CutFree → p.oplus₁.CutFree + | oplus₂ (p : ⊢(b :: Γ)) : p.CutFree → p.oplus₂.CutFree + | with (p : ⊢(a :: Γ)) (q : ⊢(b :: Γ)) : + p.CutFree → q.CutFree → (Proof.with p q).CutFree + | top : Proof.top.CutFree + | quest (p : ⊢(a :: Γ)) : p.CutFree → p.quest.CutFree + | weaken (p : ⊢Γ) : p.CutFree → p.weaken.CutFree + | contract (p : ⊢(ʔa :: ʔa :: Γ)) : p.contract.CutFree + | bang (hqs: Sequent.allQuest Γ) (p : ⊢(a :: Γ)) : p.CutFree → (p.bang hqs).CutFree + -- No rule for cut. + +/-- Cut is admissible. -/ +proof_wanted Proof.cut_admissible + (p : ⊢(a :: Γ)) (q : ⊢(a.dual :: Δ)) (hp : p.CutFree) (hq : q.CutFree) : + ∃ r : ⊢(Γ ++ Δ), r.CutFree + +/-- Cut elimination: for any sequent Γ, if there is a proof of Γ, then there exists a cut-free +proof of Γ. -/ +proof_wanted Proof.cut_elim (p : ⊢Γ) : ∃ q : ⊢Γ, q.CutFree + /- The following is just some sanity checks. We'll need to formulate the appropriate induction + metric to satisfy the termination checker, as usual for this kind of proofs. + -/ + /- + cases p + case ax a => + exists Proof.ax + constructor + case cut a Γ Δ p q => + have ihp := Proof.cut_elim p + have ihq := Proof.cut_elim q + grind [Proof.cut_admissible] + case exchange Atom Δ p hperm => + obtain ⟨pcf, hp⟩ := Proof.cut_elim p + exists (pcf.exchange hperm) + apply CutFree.exchange hperm pcf + case one => + exists one; constructor + -/ + + + +end CLL From 3d7dc8c66703891c0e52b2be1941eccc785291a4 Mon Sep 17 00:00:00 2001 From: Chris Henson <46805207+chenson2018@users.noreply.github.com> Date: Thu, 28 Aug 2025 09:26:03 -0400 Subject: [PATCH 077/107] add to lakefile.toml (#52) --- Cslib/Foundations/Semantics/Lts/Basic.lean | 32 ++----- .../Semantics/Lts/Bisimulation.lean | 92 +++++++------------ Cslib/Foundations/Semantics/Lts/TraceEq.lean | 10 +- Cslib/Languages/CCS/BehaviouralTheory.lean | 24 ++--- .../Languages/CombinatoryLogic/Recursion.lean | 2 +- Cslib/Logics/LinearLogic/CLL/Basic.lean | 2 +- CslibTests/Bisimulation.lean | 1 - CslibTests/Lts.lean | 15 +-- lakefile.toml | 1 + 9 files changed, 54 insertions(+), 125 deletions(-) diff --git a/Cslib/Foundations/Semantics/Lts/Basic.lean b/Cslib/Foundations/Semantics/Lts/Basic.lean index a01d21d5..24b62305 100644 --- a/Cslib/Foundations/Semantics/Lts/Basic.lean +++ b/Cslib/Foundations/Semantics/Lts/Basic.lean @@ -90,9 +90,7 @@ theorem Lts.MTr.stepR {s1 : State} {μs : List Label} {s2 : State} {μ : Label} lts.MTr s1 μs s2 → lts.Tr s2 μ s3 → lts.MTr s1 (μs ++ [μ]) s3 := by intro h1 h2 induction h1 - case refl s1' => - simp - apply Lts.MTr.single lts h2 + case refl s1' => exact Lts.MTr.single lts h2 case stepL s1' μ' s2' μs' s3' h1' h3 ih => apply Lts.MTr.stepL · exact h1' @@ -104,9 +102,7 @@ theorem Lts.MTr.comp {s1 : State} {μs1 : List Label} {s2 : State} {μs2 : List lts.MTr s1 (μs1 ++ μs2) s3 := by intro h1 h2 induction h1 - case refl => - simp - assumption + case refl => assumption case stepL s1 μ s' μs1' s'' h1' h3 ih => apply Lts.MTr.stepL · exact h1' @@ -218,31 +214,27 @@ def Lts.unionSum {State1} {State2} (lts1 : Lts State1 Label) (lts2 : Lts State2 Sum.isRightP (Function.const Label True) (by - simp [DecidablePred] intro s cases h : s · apply Decidable.isTrue trivial - · simp [Sum.isLeftP] + · simp only [Sum.isLeftP, Sum.isLeft_inr, Bool.false_eq_true] apply Decidable.isFalse trivial) (by intro μ - simp [Function.const] apply Decidable.isTrue trivial) (by - simp [DecidablePred] intro s cases h : s - · simp [Sum.isRightP] + · simp only [Sum.isRightP, Sum.isRight_inl, Bool.false_eq_true] apply Decidable.isFalse trivial · apply Decidable.isTrue trivial) (by intro μ - simp [Function.const] apply Decidable.isTrue trivial) lts1.inl @@ -295,10 +287,10 @@ theorem Lts.deterministic_imageFinite : cases hDet case inl hDet => obtain ⟨s', hDet'⟩ := hDet - simp [hDet'] + simp only [hDet'] apply Set.finite_singleton case inr hDet => - simp [hDet] + simp only [hDet] apply Set.finite_empty /-- A state has an outgoing label `μ` if it has a `μ`-derivative. -/ @@ -320,8 +312,6 @@ def Lts.FiniteState (_ : Lts State Label) : Prop := Finite State /-- Every finite-state Lts is also image-finite. -/ theorem Lts.finiteState_imageFinite (hFinite : lts.FiniteState) : lts.ImageFinite := by - simp [ImageFinite, Image] - simp [FiniteState] at hFinite intro s μ apply @Subtype.finite State hFinite @@ -329,8 +319,6 @@ theorem Lts.finiteState_imageFinite (hFinite : lts.FiniteState) : theorem Lts.finiteState_finitelyBranching (hFiniteLabel : Finite Label) (hFiniteState : lts.FiniteState) : lts.FinitelyBranching := by - simp [FinitelyBranching, OutgoingLabels, HasOutLabel] - simp [FiniteState] at hFiniteState constructor case left => apply Lts.finiteState_imageFinite lts hFiniteState @@ -409,9 +397,7 @@ theorem Lts.strN.trans_τ (h1 : lts.strN n s1 HasTau.τ s2) (h2 : lts.strN m s2 HasTau.τ s3) : lts.strN (n + m) s1 HasTau.τ s3 := by cases h1 - case refl => - simp - exact h2 + case refl => grind case tr n1 sb sb' n2 hstr1 htr hstr2 => have ih := Lts.strN.trans_τ lts hstr2 h2 have conc := Lts.strN.tr hstr1 htr ih @@ -434,9 +420,7 @@ theorem Lts.strN.append (h2 : lts.strN n2 s2 HasTau.τ s3) : lts.strN (n1 + n2) s1 μ s3 := by cases h1 - case refl => - simp - exact h2 + case refl => grind case tr n11 sb sb' n12 hstr1 htr hstr2 => have hsuffix := Lts.strN.trans_τ lts hstr2 h2 have n_eq : n11 + (n12 + n2) + 1 = (n11 + n12 + 1 + n2) := by omega diff --git a/Cslib/Foundations/Semantics/Lts/Bisimulation.lean b/Cslib/Foundations/Semantics/Lts/Bisimulation.lean index 48472146..c5a2796d 100644 --- a/Cslib/Foundations/Semantics/Lts/Bisimulation.lean +++ b/Cslib/Foundations/Semantics/Lts/Bisimulation.lean @@ -248,7 +248,6 @@ theorem Bisimilarity.is_bisimulation : Bisimulation lts (Bisimilarity lts) := by intro s1 s2 h μ obtain ⟨r, hr, hb⟩ := h have hrBisim := hb - simp [Bisimulation] at hb specialize hb s1 s2 constructor case left => @@ -367,8 +366,6 @@ def BisimulationUpTo (lts : Lts State Label) (r : State → State → Prop) : Pr /-- Any bisimulation up to bisimilarity is a bisimulation. -/ theorem Bisimulation.upTo_bisimulation (r : State → State → Prop) (h : BisimulationUpTo lts r) : Bisimulation lts (Relation.upTo r (Bisimilarity lts)) := by - simp [Bisimulation] - simp [BisimulationUpTo] at h intro s1 s2 hr μ rcases hr with ⟨s1b, hr1b, s2b, hrb, hr2b⟩ obtain ⟨r1, hr1, hr1b⟩ := hr1b @@ -434,7 +431,6 @@ theorem Bisimulation.bisim_trace intro s1' hmtr1 cases hmtr1 case stepL s1'' htr hmtr => - simp [Bisimulation] at hb specialize hb s1 s2 hr μ have hf := hb.1 s1'' htr obtain ⟨s2'', htr2, hb2⟩ := hf @@ -455,7 +451,6 @@ theorem Bisimulation.bisim_trace theorem Bisimulation.bisim_traceEq (hb : Bisimulation lts r) (hr : r s1 s2) : s1 ~tr[lts] s2 := by - simp [TraceEq, Lts.traces, setOf] funext μs simp only [eq_iff_iff] constructor @@ -475,7 +470,6 @@ theorem Bisimulation.bisim_traceEq /-- Bisimilarity is included in trace equivalence. -/ theorem Bisimilarity.le_traceEq : Bisimilarity lts ≤ TraceEq lts := by - simp [LE.le] intro s1 s2 h obtain ⟨r, hr, hb⟩ := h apply Bisimulation.bisim_traceEq lts hb hr @@ -502,12 +496,10 @@ theorem Bisimulation.traceEq_not_bisim : let lts := Lts.mk BisimMotTr exists lts intro h - simp [Bisimulation] at h specialize h 1 5 have htreq : (1 ~tr[lts] 5) := by simp [TraceEq] have htraces1 : lts.traces 1 = {[], ['a'], ['a', 'b'], ['a', 'c']} := by - simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -519,27 +511,31 @@ theorem Bisimulation.traceEq_not_bisim : simp case intro.stepL μ sb μs' htr hmtr => cases htr - simp - cases hmtr <;> simp + cases hmtr case one2two.stepL μ sb μs' htr hmtr => - cases htr <;> cases hmtr <;> simp <;> contradiction + cases htr <;> cases hmtr <;> + simp only [↓Char.isValue, Set.mem_insert_iff, reduceCtorEq, List.cons.injEq, + List.cons_ne_self, and_false, Set.mem_singleton_iff, Char.reduceEq, and_true, + or_false, or_true] <;> + contradiction + simp case mpr => intro h1 cases h1 case inl h1 => - simp [h1] + simp only [h1] exists 1 constructor case inr h1 => cases h1 case inl h1 => - simp [h1] + simp only [h1] exists 2 apply Lts.MTr.single; constructor case inr h1 => cases h1 case inl h1 => - simp [h1] + simp only [h1] exists 3 constructor; apply BisimMotTr.one2two; apply Lts.MTr.single; apply BisimMotTr.two2three @@ -549,7 +545,6 @@ theorem Bisimulation.traceEq_not_bisim : constructor; apply BisimMotTr.one2two; apply Lts.MTr.single; apply BisimMotTr.two2four have htraces2 : lts.traces 5 = {[], ['a'], ['a', 'b'], ['a', 'c']} := by - simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -562,18 +557,16 @@ theorem Bisimulation.traceEq_not_bisim : case intro.stepL μ sb μs' htr hmtr => cases htr case five2six => - simp cases hmtr case refl => simp case stepL μ sb μs' htr hmtr => cases htr cases hmtr - case refl => right; left; simp + case refl => simp case stepL μ sb μs' htr hmtr => cases htr case five2eight => - simp cases hmtr case refl => simp @@ -587,19 +580,19 @@ theorem Bisimulation.traceEq_not_bisim : intro h1 cases h1 case inl h1 => - simp [h1] + simp only [h1] exists 5 constructor case inr h1 => cases h1 case inl h1 => - simp [h1] + simp only [h1] exists 6 apply Lts.MTr.single; constructor case inr h1 => cases h1 case inl h1 => - simp [h1] + simp only [h1] exists 7 constructor; apply BisimMotTr.five2six; apply Lts.MTr.single; apply BisimMotTr.six2seven @@ -618,7 +611,6 @@ theorem Bisimulation.traceEq_not_bisim : case five2six => simp [TraceEq] at cih have htraces2 : lts.traces 2 = {[], ['b'], ['c']} := by - simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -630,9 +622,9 @@ theorem Bisimulation.traceEq_not_bisim : case stepL μ sb μs' htr hmtr => cases htr case two2three => - cases hmtr <;> simp - case stepL μ sb μs' htr hmtr => - cases htr + cases hmtr + case stepL μ sb μs' htr hmtr => cases htr + simp case two2four => cases hmtr case refl => simp @@ -642,12 +634,10 @@ theorem Bisimulation.traceEq_not_bisim : intro h cases h case inl h => - simp exists 2 simp [h] constructor case inr h => - simp cases h case inl h => exists 3; simp [h]; constructor; constructor; constructor @@ -657,7 +647,6 @@ theorem Bisimulation.traceEq_not_bisim : simp [h] constructor; constructor; constructor have htraces6 : lts.traces 6 = {[], ['b']} := by - simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -668,28 +657,25 @@ theorem Bisimulation.traceEq_not_bisim : case refl => simp case stepL μ sb μs' htr hmtr => cases htr - cases hmtr <;> simp - case stepL μ sb μs' htr hmtr => - cases htr + cases hmtr + case stepL μ sb μs' htr hmtr => cases htr + simp case mpr => intro h cases h case inl h => - simp exists 6 simp [h] constructor case inr h => - simp exists 7 simp at h simp [h] constructor; constructor; constructor grind case five2eight => - simp [TraceEq] at cih + simp only [TraceEq] at cih have htraces2 : lts.traces 2 = {[], ['b'], ['c']} := by - simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -701,9 +687,9 @@ theorem Bisimulation.traceEq_not_bisim : case stepL μ sb μs' htr hmtr => cases htr case two2three => - cases hmtr <;> simp - case stepL μ sb μs' htr hmtr => - cases htr + cases hmtr + case stepL μ sb μs' htr hmtr => cases htr + simp case two2four => cases hmtr case refl => simp @@ -713,12 +699,10 @@ theorem Bisimulation.traceEq_not_bisim : intro h cases h case inl h => - simp exists 2 simp [h] constructor case inr h => - simp cases h case inl h => exists 3; simp [h]; constructor; constructor; constructor @@ -728,7 +712,6 @@ theorem Bisimulation.traceEq_not_bisim : simp [h] constructor; constructor; constructor have htraces8 : lts.traces 8 = {[], ['c']} := by - simp [Lts.traces] apply Set.ext_iff.2 intro μs apply Iff.intro @@ -739,23 +722,21 @@ theorem Bisimulation.traceEq_not_bisim : case refl => simp case stepL μ sb μs' htr hmtr => cases htr - cases hmtr <;> simp - case stepL μ sb μs' htr hmtr => - cases htr + cases hmtr + case stepL μ sb μs' htr hmtr => cases htr + simp case mpr => intro h cases h case inl h => - simp exists 8 simp [h] constructor case inr h => - simp exists 9 simp at h simp [h] - constructor; constructor; constructor + repeat constructor rw [htraces2, htraces8] at cih apply Set.ext_iff.1 at cih specialize cih ['b'] @@ -771,7 +752,6 @@ theorem Bisimilarity.bisimilarity_neq_traceEq : ∃ (State : Type) (Label : Type) (lts : Lts State Label), Bisimilarity lts ≠ TraceEq lts := by obtain ⟨State, Label, lts, h⟩ := Bisimulation.traceEq_not_bisim exists State; exists Label; exists lts - simp intro heq have hb := Bisimilarity.is_bisimulation lts rw [heq] at hb @@ -814,7 +794,7 @@ theorem Bisimilarity.deterministic_bisim_eq_traceEq (lts : Lts State Label) (hdet : lts.Deterministic) : Bisimilarity lts = TraceEq lts := by funext s1 s2 - simp [eq_iff_iff] + simp only [eq_iff_iff] constructor case mp => apply Bisimilarity.le_traceEq @@ -888,7 +868,6 @@ theorem SWBisimulation.follow_internal_fst_n cases hstrN rename_i n1 sb sb' n2 hstrN1 htr hstrN2 let hswb_m := hswb - simp [SWBisimulation] at hswb have ih1 := SWBisimulation.follow_internal_fst_n lts r hswb hr hstrN1 obtain ⟨sb2, hstrs2, hrsb⟩ := ih1 have h := (hswb sb sb2 hrsb HasTau.τ).1 sb' htr @@ -916,7 +895,6 @@ theorem SWBisimulation.follow_internal_snd_n cases hstrN rename_i n1 sb sb' n2 hstrN1 htr hstrN2 let hswb_m := hswb - simp [SWBisimulation] at hswb have ih1 := SWBisimulation.follow_internal_snd_n lts r hswb hr hstrN1 obtain ⟨sb1, hstrs1, hrsb⟩ := ih1 have h := (hswb sb1 sb hrsb HasTau.τ).2 sb' htr @@ -954,8 +932,6 @@ theorem WeakBisimulation.iff_swBisimulation apply Iff.intro case mp => intro h - simp [WeakBisimulation, Bisimulation] at h - simp [SWBisimulation] intro s1 s2 hr μ apply And.intro case left => @@ -972,7 +948,6 @@ theorem WeakBisimulation.iff_swBisimulation exists s1' case mpr => intro h - simp [WeakBisimulation, Bisimulation] intro s1 s2 hr μ apply And.intro case left => @@ -988,8 +963,7 @@ theorem WeakBisimulation.iff_swBisimulation obtain ⟨s2', hstr2', hrb2⟩ := SWBisimulation.follow_internal_fst lts r h hrb' hstr2 exists s2' constructor - · simp [Lts.saturate] - apply Lts.STr.comp lts hstr2b hstr2b' hstr2' + · exact Lts.STr.comp lts hstr2b hstr2b' hstr2' · exact hrb2 case right => intro s2' hstr @@ -1004,8 +978,7 @@ theorem WeakBisimulation.iff_swBisimulation obtain ⟨s1', hstr1', hrb2⟩ := SWBisimulation.follow_internal_snd lts r h hrb' hstr2 exists s1' constructor - · simp [Lts.saturate] - apply Lts.STr.comp lts hstr1b hstr1b' hstr1' + · exact Lts.STr.comp lts hstr1b hstr1b' hstr1' · exact hrb2 theorem WeakBisimulation.toSwBisimulation @@ -1029,7 +1002,7 @@ theorem WeakBisimilarity.by_swBisimulation [HasTau Label] theorem WeakBisimilarity.weakBisim_eq_swBisim [HasTau Label] (lts : Lts State Label) : WeakBisimilarity lts = SWBisimilarity lts := by funext s1 s2 - simp [WeakBisimilarity, SWBisimilarity] + simp only [eq_iff_iff] constructor case mp => intro h @@ -1048,7 +1021,6 @@ theorem WeakBisimilarity.weakBisim_eq_swBisim [HasTau Label] (lts : Lts State La /-- sw-bisimilarity is reflexive. -/ theorem SWBisimilarity.refl [HasTau Label] (lts : Lts State Label) (s : State) : s ≈sw[lts] s := by - simp [SWBisimilarity] exists Eq constructor · rfl diff --git a/Cslib/Foundations/Semantics/Lts/TraceEq.lean b/Cslib/Foundations/Semantics/Lts/TraceEq.lean index 7ac979ba..0ecd49e0 100644 --- a/Cslib/Foundations/Semantics/Lts/TraceEq.lean +++ b/Cslib/Foundations/Semantics/Lts/TraceEq.lean @@ -39,8 +39,7 @@ def Lts.traces (s : State) := { μs : List Label | ∃ s', lts.MTr s μs s' } /-- If there is a multi-step transition from `s` labelled by `μs`, then `μs` is in the traces of `s`. -/ theorem Lts.traces_in (s : State) (μs : List Label) (s' : State) (h : lts.MTr s μs s') : - μs ∈ lts.traces s := by - simp [Lts.traces] + μs ∈ lts.traces s := by exists s' /-- Two states are trace equivalent if they have the same set of traces. -/ @@ -68,9 +67,7 @@ theorem TraceEq.symm (lts : Lts State Label) {s1 s2 : State} (h : s1 ~tr[lts] s2 /-- Trace equivalence is transitive. -/ theorem TraceEq.trans {s1 s2 s3 : State} (h1 : s1 ~tr[lts] s2) (h2 : s2 ~tr[lts] s3) : s1 ~tr[lts] s3 := by - simp only [TraceEq] - simp only [TraceEq] at h1 - simp only [TraceEq] at h2 + simp only [TraceEq] at * rw [h1, h2] /-- Trace equivalence is an equivalence relation. -/ @@ -90,7 +87,6 @@ theorem TraceEq.deterministic_sim ∀ μ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ s1' ~tr[lts] s2' := by intro μ s1' htr1 have hmtr1 := Lts.MTr.single lts htr1 - simp [TraceEq] at h have hin := Lts.traces_in lts s1 [μ] s1' hmtr1 rw [h] at hin obtain ⟨s2', hmtr2⟩ := hin @@ -108,7 +104,6 @@ theorem TraceEq.deterministic_sim have hmtr1comp := Lts.MTr.comp lts hmtr1 hmtr1' have hin := Lts.traces_in lts s1 ([μ] ++ μs') s1'' hmtr1comp rw [h] at hin - simp [Lts.traces] at hin obtain ⟨s', hmtr2'⟩ := hin cases hmtr2' case stepL s2'' htr2 hmtr2' => @@ -123,7 +118,6 @@ theorem TraceEq.deterministic_sim have hmtr2comp := Lts.MTr.comp lts hmtr2 hmtr2' have hin := Lts.traces_in lts s2 ([μ] ++ μs') s2'' hmtr2comp rw [← h] at hin - simp [Lts.traces] at hin obtain ⟨s', hmtr1'⟩ := hin cases hmtr1' case stepL s1'' htr1 hmtr1' => diff --git a/Cslib/Languages/CCS/BehaviouralTheory.lean b/Cslib/Languages/CCS/BehaviouralTheory.lean index 3a9fd317..8c09a364 100644 --- a/Cslib/Languages/CCS/BehaviouralTheory.lean +++ b/Cslib/Languages/CCS/BehaviouralTheory.lean @@ -418,15 +418,9 @@ theorem bisimilarity_congr (c : Context Name Constant) (p q : Process Name Constant) (h : p ~[@lts Name Constant defs] q) : (c.fill p) ~[@lts Name Constant defs] (c.fill q) := by induction c - case hole => - simp only [Context.fill] - exact h - case pre μ c ih => - simp [Context.fill] - apply bisimilarity_congr_pre ih - case parL c r ih => - simp [Context.fill] - apply bisimilarity_congr_par ih + case hole => exact h + case pre _ _ ih => exact bisimilarity_congr_pre ih + case parL _ _ ih => exact bisimilarity_congr_par ih case parR r c ih => apply Bisimilarity.trans · apply bisimilarity_par_comm @@ -434,20 +428,14 @@ theorem bisimilarity_congr · apply bisimilarity_congr_par exact ih · apply bisimilarity_par_comm - case choiceL c r ih => - simp [Context.fill] - apply bisimilarity_congr_choice - exact ih + case choiceL _ _ ih => exact bisimilarity_congr_choice ih case choiceR r c ih => - simp [Context.fill] apply Bisimilarity.trans · apply bisimilarity_choice_comm · apply Bisimilarity.trans - · apply bisimilarity_congr_choice - exact ih - · apply bisimilarity_choice_comm + · exact bisimilarity_congr_choice ih + · exact bisimilarity_choice_comm case res => - simp [Context.fill] apply bisimilarity_congr_res assumption diff --git a/Cslib/Languages/CombinatoryLogic/Recursion.lean b/Cslib/Languages/CombinatoryLogic/Recursion.lean index 4b43b8ea..bbe5f533 100644 --- a/Cslib/Languages/CombinatoryLogic/Recursion.lean +++ b/Cslib/Languages/CombinatoryLogic/Recursion.lean @@ -373,7 +373,7 @@ theorem le_def (a b : SKI) : SKI.LE ⬝ a ⬝ b ↠ IsZero ⬝ (SKI.Sub ⬝ a theorem le_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m b) : IsBool (n ≤ m) (SKI.LE ⬝ a ⬝ b) := by - simp [← decide_eq_decide.mpr <| Nat.sub_eq_zero_iff_le] + simp only [← decide_eq_decide.mpr <| Nat.sub_eq_zero_iff_le] apply isBool_trans (a' := IsZero ⬝ (SKI.Sub ⬝ a ⬝ b)) (h := le_def _ _) apply isZero_correct apply sub_correct <;> assumption diff --git a/Cslib/Logics/LinearLogic/CLL/Basic.lean b/Cslib/Logics/LinearLogic/CLL/Basic.lean index a6d1e037..fa016912 100644 --- a/Cslib/Logics/LinearLogic/CLL/Basic.lean +++ b/Cslib/Logics/LinearLogic/CLL/Basic.lean @@ -269,7 +269,7 @@ theorem subst_eqv_head {Γ : Sequent Atom} {a b : Proposition Atom} (heqv : a an equivalent proposition. -/ theorem subst_eqv {Γ Δ : Sequent Atom} {a b : Proposition Atom} (heqv : a ≡ b) : ⊢(Γ ++ [a] ++ Δ) → ⊢(Γ ++ [b] ++ Δ) := by - simp + simp only [List.append_assoc, List.cons_append, List.nil_append] intro h apply Proof.exchange (List.perm_middle.symm) apply Proof.exchange (List.perm_middle) at h diff --git a/CslibTests/Bisimulation.lean b/CslibTests/Bisimulation.lean index d3869954..5b2f3818 100644 --- a/CslibTests/Bisimulation.lean +++ b/CslibTests/Bisimulation.lean @@ -28,7 +28,6 @@ private inductive Bisim15 : ℕ → ℕ → Prop where example : 1 ~[lts1] 5 := by exists Bisim15 apply And.intro; constructor - simp [Bisimulation] intro s1 s2 hr μ constructor case left => diff --git a/CslibTests/Lts.lean b/CslibTests/Lts.lean index 10f0bb12..4f292dc2 100644 --- a/CslibTests/Lts.lean +++ b/CslibTests/Lts.lean @@ -33,8 +33,7 @@ example : 1 ~[natLts] 2 := by exists NatBisim constructor · constructor - · simp [Bisimulation] - intro s1 s2 hr μ + · intro s1 s2 hr μ constructor · intro s1' htr cases htr <;> (cases hr <;> repeat constructor) @@ -57,31 +56,23 @@ def natInfiniteExecution : Stream' ℕ := fun n => n theorem natInfiniteExecution.infiniteExecution : natDivLts.DivergentExecution natInfiniteExecution := by - simp [Lts.DivergentExecution] intro n constructor example : natDivLts.Divergent 0 := by - simp [Lts.Divergent] exists natInfiniteExecution constructor; constructor exact natInfiniteExecution.infiniteExecution example : natDivLts.Divergent 3 := by - simp [Lts.Divergent] exists natInfiniteExecution.drop 3 - simp [Stream'.drop] constructor · constructor - · simp [Lts.DivergentExecution] - simp [Stream'.drop] - intro n - constructor + · intro; constructor example : natDivLts.Divergent n := by - simp [Lts.Divergent] exists natInfiniteExecution.drop n - simp [Stream'.drop] + simp only [Stream'.drop, zero_add] constructor · constructor · apply Lts.divergent_drop diff --git a/lakefile.toml b/lakefile.toml index 225d1be1..020fe1c6 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -5,6 +5,7 @@ testDriver = "CslibTests" [leanOptions] weak.linter.mathlibStandardSet = true +weak.linter.flexible = true [[require]] name = "mathlib" From 2b32feacd625d5bad6104664d627f64e7c615f7f Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Fri, 29 Aug 2025 10:17:49 +0200 Subject: [PATCH 078/107] scope some grinds --- Cslib/Languages/CCS/BehaviouralTheory.lean | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/Cslib/Languages/CCS/BehaviouralTheory.lean b/Cslib/Languages/CCS/BehaviouralTheory.lean index 8c09a364..2c0d9790 100644 --- a/Cslib/Languages/CCS/BehaviouralTheory.lean +++ b/Cslib/Languages/CCS/BehaviouralTheory.lean @@ -33,6 +33,7 @@ private inductive ParNil : (Process Name Constant) → (Process Name Constant) | parNil : ParNil (par p nil) p /-- P | 𝟎 ~ P -/ +@[simp, scoped grind] theorem bisimilarity_par_nil : (par p nil) ~[@lts Name Constant defs] p := by exists ParNil constructor; constructor @@ -64,6 +65,7 @@ private inductive ParComm : (Process Name Constant) → (Process Name Constant) | parComm : ParComm (par p q) (par q p) /-- P | Q ~ Q | P -/ +@[scoped grind] theorem bisimilarity_par_comm : (par p q) ~[@lts Name Constant defs] (par q p) := by exists ParComm constructor @@ -115,7 +117,7 @@ theorem bisimilarity_par_comm : (par p q) ~[@lts Name Constant defs] (par q p) : · constructor /-- 𝟎 | P ~ P -/ -@[simp, grind] +@[simp, scoped grind] theorem bisimilarity_nil_par : (par nil p) ~[@lts Name Constant defs] p := calc (par nil p) ~[@lts Name Constant defs] (par p nil) := by grind From c2ce28d605cc5c8d619f574f91b7c437e0982b9d Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Fri, 29 Aug 2025 12:55:39 +0200 Subject: [PATCH 079/107] grinding grind on CCS --- Cslib/Languages/CCS/BehaviouralTheory.lean | 36 ++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) diff --git a/Cslib/Languages/CCS/BehaviouralTheory.lean b/Cslib/Languages/CCS/BehaviouralTheory.lean index 2c0d9790..41b217a6 100644 --- a/Cslib/Languages/CCS/BehaviouralTheory.lean +++ b/Cslib/Languages/CCS/BehaviouralTheory.lean @@ -131,9 +131,41 @@ proof_wanted bisimilarity_par_assoc : proof_wanted bisimilarity_choice_nil : (choice p nil) ~[@lts Name Constant defs] p +private inductive ChoiceIdem : (Process Name Constant) → (Process Name Constant) → Prop where + | idem : ChoiceIdem (choice p p) p + | id : ChoiceIdem p p + /-- P + P ~ P -/ -proof_wanted bisimilarity_choice_idem : - (choice p p) ~[@lts Name Constant defs] p +theorem bisimilarity_choice_idem : + (choice p p) ~[@lts Name Constant defs] p := by + exists ChoiceIdem + apply And.intro + case left => grind [ChoiceIdem] + case right => + intro s1 s2 hr μ + apply And.intro <;> cases hr + case left.idem => + intro s2' htr + exists s2' + apply And.intro + case left => + cases htr <;> unfold lts <;> grind + case right => + grind [ChoiceIdem] + case left.id => + grind [ChoiceIdem] + case right.idem => + intro s1' htr + exists s1' + apply And.intro + case left => + unfold lts + unfold lts at htr + grind [Tr] + case right => + grind [ChoiceIdem] + case right.id => + grind [ChoiceIdem] private inductive ChoiceComm : (Process Name Constant) → (Process Name Constant) → Prop where | choiceComm : ChoiceComm (choice p q) (choice q p) From 86e9fab595c88f5539ee1f0abaf43315fb53743d Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 3 Sep 2025 08:16:50 +0200 Subject: [PATCH 080/107] Governance --- CONTRIBUTING.md | 10 +++++++++- GOVERNANCE.md | 42 ++++++++++++++++++++++++++++++++++++++++++ README.md | 11 ++++++----- 3 files changed, 57 insertions(+), 6 deletions(-) create mode 100644 GOVERNANCE.md diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 68f3ccce..a94dc405 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -2,7 +2,15 @@ Great that you're interested in contributing to cslib! :tada: -Please read the rest of this document before submitting a pull request. If you have any questions, a good place to ask them is the [Lean community Zulip chat](https://leanprover.zulipchat.com/). +Please read the rest of this document before submitting a pull request. +If you have any questions, a good place to ask them is the [Lean prover Zulip chat](https://leanprover.zulipchat.com/). + +# Contribution model + +To get your code approved, you need to submit a [pull request (PR)](https://github.com/leanprover/cslib/pulls). +Each PR needs to be approved by at least one relevant maintainer. You can read the [list of current maintainers](/GOVERNANCE.md#maintainers). + +If you are adding something new to cslib and are in doubt about it, you are very welcome to contact us on the [Lean prover Zulip chat](https://leanprover.zulipchat.com/). # Style and documentation diff --git a/GOVERNANCE.md b/GOVERNANCE.md new file mode 100644 index 00000000..9e40cccc --- /dev/null +++ b/GOVERNANCE.md @@ -0,0 +1,42 @@ +# Governance model for cslib + +Cslib is governed by two main bodies: +- A [steering committee](#steering-committee), responsible for securing financial support and guiding the overall vision of the project. +- A [maintainer team](#maintainers), responsible for curating, expanding, and maintaining the code repository and its technical direction. + +These groups work together to define the project's roadmap and foster a welcoming and productive environment. +New members may be invited based on project needs and individual merit (e.g., contributions, review activity). + + +## Steering committee + +- Clark Barrett (@barrettcw), Stanford University and Amazon. +- Swarat Chaudhuri (@swaratchaudhuri), Google DeepMind and UT Austin. +- Jim Grundy, Amazon. +- Pushmeet Kohli, Google DeepMind. +- Fabrizio Montesi (@fmontesi), University of Southern Denmark and Danish Institute for Advanced Study. +- Leonardo de Moura (@leodemoura), Lean FRO and Amazon. + +## Maintainers + +The maintainer team is responsible for the quality of the codebase, establishing technical standards and ensuring coherence across contributions. + +### Lead maintainer + +The lead maintainer coordinates the overall work of the maintainer team and oversees the project's repositories. + +- Fabrizio Montesi (@fmontesi), University of Southern Denmark and Danish Institute for Advanced Study. + +### Technical leads + +Technical leads guide long-term developments that may span multiple areas of the codebase, offering specialised expertise. + +- Alexandre Rademaker (@arademaker), IBM Research Brazil and Getulio Vargas Foundation. +- Sorrachai Yingchareonthawornchai (@sorrachai), ETH Zurich. + +### Area maintainers + +Area maintainers are trusted contributors who take ownership of specific areas of the codebase, supporting their growth both as subject-matter experts and reviewers. + +- Chris Henson (@chenson2018), Drexel University. Areas: Lambda calculus, metaprogramming. +- Kim Morrison (@kim-em), Lean FRO. Areas: Continuous Integration and Deployment (CI/CD) with upstream (Lean, mathlib). diff --git a/README.md b/README.md index 83f7eae2..24a9910f 100644 --- a/README.md +++ b/README.md @@ -1,20 +1,21 @@ # cslib -A Lean library for Computer Science. +The Lean library for Computer Science. Documentation at . # What's cslib? -Cslib is a Lean library for computer science. +Cslib aims at formalising Computer Science theories and tools, broadly construed, in the Lean programming language. ## Aims -- Offer reusable APIs and languages for formalisation projects, software verification, and certified software (among others). +- Offer APIs and languages for formalisation projects, software verification, and certified software (among others). - Establish a common ground for connecting different developments in Computer Science, in order to foster synergies and reuse. -# Contributing and Discussion +# Contributing and discussion + Please see our [contribution guide](/CONTRIBUTING.md) and [code of conduct](/CODE_OF_CONDUCT.md). -For discussions, you can reach out on the [leanprover Zulip chat](https://leanprover.zulipchat.com/). +For discussions, you can reach out to us on the [Lean prover Zulip chat](https://leanprover.zulipchat.com/). From d0e4a5ed0b35b14a6f9388d535dee0149e5e05a6 Mon Sep 17 00:00:00 2001 From: Kim Morrison <477956+kim-em@users.noreply.github.com> Date: Wed, 3 Sep 2025 18:31:41 +1000 Subject: [PATCH 081/107] chore: use grind in CCS.BehaviouralTheory (#54) --- Cslib/Languages/CCS/BehaviouralTheory.lean | 60 ++++++---------------- 1 file changed, 16 insertions(+), 44 deletions(-) diff --git a/Cslib/Languages/CCS/BehaviouralTheory.lean b/Cslib/Languages/CCS/BehaviouralTheory.lean index 41b217a6..80cf04bc 100644 --- a/Cslib/Languages/CCS/BehaviouralTheory.lean +++ b/Cslib/Languages/CCS/BehaviouralTheory.lean @@ -29,37 +29,26 @@ open CCS CCS.Process CCS.Act namespace CCS +@[grind cases] private inductive ParNil : (Process Name Constant) → (Process Name Constant) → Prop where | parNil : ParNil (par p nil) p +attribute [grind] ParNil.parNil + /-- P | 𝟎 ~ P -/ @[simp, scoped grind] theorem bisimilarity_par_nil : (par p nil) ~[@lts Name Constant defs] p := by + unfold lts at * exists ParNil constructor; constructor - simp only [Bisimulation] intro s1 s2 hr μ constructor case left => - intro s1' htr - cases hr - cases htr - case parL p' htr => - exists p' - apply And.intro htr ParNil.parNil - case parR q' htr => - cases htr - case com μ p' q' htrp htrq => - cases htrq + grind [cases Tr] case right => intro s2' htr - cases hr exists (par s2' nil) - constructor - case left => - apply Tr.parL htr - case right => - constructor + grind [Tr.parL] private inductive ParComm : (Process Name Constant) → (Process Name Constant) → Prop where | parComm : ParComm (par p q) (par q p) @@ -137,7 +126,7 @@ private inductive ChoiceIdem : (Process Name Constant) → (Process Name Constan /-- P + P ~ P -/ theorem bisimilarity_choice_idem : - (choice p p) ~[@lts Name Constant defs] p := by + (choice p p) ~[lts (defs := defs)] p := by exists ChoiceIdem apply And.intro case left => grind [ChoiceIdem] @@ -145,25 +134,15 @@ theorem bisimilarity_choice_idem : intro s1 s2 hr μ apply And.intro <;> cases hr case left.idem => - intro s2' htr - exists s2' - apply And.intro - case left => - cases htr <;> unfold lts <;> grind - case right => - grind [ChoiceIdem] + unfold lts + grind [cases Tr, ChoiceIdem] case left.id => grind [ChoiceIdem] case right.idem => intro s1' htr exists s1' - apply And.intro - case left => - unfold lts - unfold lts at htr - grind [Tr] - case right => - grind [ChoiceIdem] + unfold lts at * + grind [Tr, ChoiceIdem] case right.id => grind [ChoiceIdem] @@ -179,30 +158,23 @@ theorem bisimilarity_choice_comm : (choice p q) ~[@lts Name Constant defs] (choi intro s1 s2 hr μ cases hr case choiceComm => + unfold lts rename_i p q constructor case left => intro s1' htr exists s1' constructor - · cases htr - · apply Tr.choiceR - assumption - · apply Tr.choiceL - assumption + · cases htr with grind [Tr.choiceR, Tr.choiceL] · constructor - apply Bisimilarity.refl (@lts _ _ defs) s1' + grind [Bisimilarity.refl] case right => intro s1' htr exists s1' constructor - · cases htr - · apply Tr.choiceR - assumption - · apply Tr.choiceL - assumption + · cases htr with grind [Tr.choiceR, Tr.choiceL] · constructor - apply Bisimilarity.refl (@lts _ _ defs) s1' + grind [Bisimilarity.refl] case bisim h => constructor case left => From b3ce876c2c37eb999a71b6c05be5759f2dbf98e5 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 3 Sep 2025 11:03:26 +0200 Subject: [PATCH 082/107] Make lts look nice --- Cslib/Languages/CCS/BehaviouralTheory.lean | 53 +++++++++++----------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/Cslib/Languages/CCS/BehaviouralTheory.lean b/Cslib/Languages/CCS/BehaviouralTheory.lean index 80cf04bc..c2ae6221 100644 --- a/Cslib/Languages/CCS/BehaviouralTheory.lean +++ b/Cslib/Languages/CCS/BehaviouralTheory.lean @@ -37,7 +37,7 @@ attribute [grind] ParNil.parNil /-- P | 𝟎 ~ P -/ @[simp, scoped grind] -theorem bisimilarity_par_nil : (par p nil) ~[@lts Name Constant defs] p := by +theorem bisimilarity_par_nil : (par p nil) ~[lts (defs := defs)] p := by unfold lts at * exists ParNil constructor; constructor @@ -55,7 +55,7 @@ private inductive ParComm : (Process Name Constant) → (Process Name Constant) /-- P | Q ~ Q | P -/ @[scoped grind] -theorem bisimilarity_par_comm : (par p q) ~[@lts Name Constant defs] (par q p) := by +theorem bisimilarity_par_comm : (par p q) ~[lts (defs := defs)] (par q p) := by exists ParComm constructor case left => @@ -107,18 +107,18 @@ theorem bisimilarity_par_comm : (par p q) ~[@lts Name Constant defs] (par q p) : /-- 𝟎 | P ~ P -/ @[simp, scoped grind] -theorem bisimilarity_nil_par : (par nil p) ~[@lts Name Constant defs] p := +theorem bisimilarity_nil_par : (par nil p) ~[lts (defs := defs)] p := calc - (par nil p) ~[@lts Name Constant defs] (par p nil) := by grind - _ ~[@lts Name Constant defs] p := by simp + (par nil p) ~[lts (defs := defs)] (par p nil) := by grind + _ ~[lts (defs := defs)] p := by simp /-- P | (Q | R) ~ (P | Q) | R -/ proof_wanted bisimilarity_par_assoc : - (par p (par q r)) ~[@lts Name Constant defs] (par (par p q) r) + (par p (par q r)) ~[lts (defs := defs)] (par (par p q) r) /-- P + 𝟎 ~ P -/ proof_wanted bisimilarity_choice_nil : - (choice p nil) ~[@lts Name Constant defs] p + (choice p nil) ~[lts (defs := defs)] p private inductive ChoiceIdem : (Process Name Constant) → (Process Name Constant) → Prop where | idem : ChoiceIdem (choice p p) p @@ -148,31 +148,32 @@ theorem bisimilarity_choice_idem : private inductive ChoiceComm : (Process Name Constant) → (Process Name Constant) → Prop where | choiceComm : ChoiceComm (choice p q) (choice q p) - | bisim : (p ~[@lts Name Constant defs] q) → ChoiceComm p q + | bisim : (p ~[lts (defs := defs)] q) → ChoiceComm p q /-- P + Q ~ Q + P -/ -theorem bisimilarity_choice_comm : (choice p q) ~[@lts Name Constant defs] (choice q p) := by +theorem bisimilarity_choice_comm : (choice p q) ~[lts (defs := defs)] (choice q p) := by exists @ChoiceComm Name Constant defs repeat constructor simp only [Bisimulation] intro s1 s2 hr μ cases hr case choiceComm => - unfold lts rename_i p q constructor case left => intro s1' htr exists s1' constructor - · cases htr with grind [Tr.choiceR, Tr.choiceL] + · unfold lts + cases htr with grind [Tr.choiceR, Tr.choiceL] · constructor grind [Bisimilarity.refl] case right => intro s1' htr exists s1' constructor - · cases htr with grind [Tr.choiceR, Tr.choiceL] + · unfold lts + cases htr with grind [Tr.choiceR, Tr.choiceL] · constructor grind [Bisimilarity.refl] case bisim h => @@ -194,15 +195,15 @@ theorem bisimilarity_choice_comm : (choice p q) ~[@lts Name Constant defs] (choi /-- P + (Q + R) ~ (P + Q) + R -/ proof_wanted bisimilarity_choice_assoc : - (choice p (choice q r)) ~[@lts Name Constant defs] (choice (choice p q) r) + (choice p (choice q r)) ~[lts (defs := defs)] (choice (choice p q) r) private inductive PreBisim : (Process Name Constant) → (Process Name Constant) → Prop where -| pre : (p ~[@lts Name Constant defs] q) → PreBisim (pre μ p) (pre μ q) -| bisim : (p ~[@lts Name Constant defs] q) → PreBisim p q +| pre : (p ~[lts (defs := defs)] q) → PreBisim (pre μ p) (pre μ q) +| bisim : (p ~[lts (defs := defs)] q) → PreBisim p q /-- P ~ Q → μ.P ~ μ.Q -/ theorem bisimilarity_congr_pre : - (p ~[@lts Name Constant defs] q) → (pre μ p) ~[@lts Name Constant defs] (pre μ q) := by + (p ~[lts (defs := defs)] q) → (pre μ p) ~[lts (defs := defs)] (pre μ q) := by intro hpq exists @PreBisim _ _ defs constructor @@ -250,12 +251,12 @@ theorem bisimilarity_congr_pre : apply Bisimilarity.largest_bisimulation _ hbisim hr1 private inductive ResBisim : (Process Name Constant) → (Process Name Constant) → Prop where -| res : (p ~[@lts Name Constant defs] q) → ResBisim (res a p) (res a q) --- | bisim : (p ~[@lts Name Constant defs] q) → ResBisim p q +| res : (p ~[lts (defs := defs)] q) → ResBisim (res a p) (res a q) +-- | bisim : (p ~[lts (defs := defs)] q) → ResBisim p q /-- P ~ Q → (ν a) P ~ (ν a) Q -/ theorem bisimilarity_congr_res : - (p ~[@lts Name Constant defs] q) → (res a p) ~[@lts Name Constant defs] (res a q) := by + (p ~[lts (defs := defs)] q) → (res a p) ~[lts (defs := defs)] (res a q) := by intro hpq exists @ResBisim _ _ defs constructor @@ -285,12 +286,12 @@ theorem bisimilarity_congr_res : constructor; assumption private inductive ChoiceBisim : (Process Name Constant) → (Process Name Constant) → Prop where -| choice : (p ~[@lts Name Constant defs] q) → ChoiceBisim (choice p r) (choice q r) -| bisim : (p ~[@lts Name Constant defs] q) → ChoiceBisim p q +| choice : (p ~[lts (defs := defs)] q) → ChoiceBisim (choice p r) (choice q r) +| bisim : (p ~[lts (defs := defs)] q) → ChoiceBisim p q /-- P ~ Q → P + R ~ Q + R -/ theorem bisimilarity_congr_choice : - (p ~[@lts Name Constant defs] q) → (choice p r) ~[@lts Name Constant defs] (choice q r) := by + (p ~[lts (defs := defs)] q) → (choice p r) ~[lts (defs := defs)] (choice q r) := by intro h exists @ChoiceBisim _ _ defs constructor @@ -354,11 +355,11 @@ theorem bisimilarity_congr_choice : apply Bisimilarity.largest_bisimulation _ hb hr1 private inductive ParBisim : (Process Name Constant) → (Process Name Constant) → Prop where -| par : (p ~[@lts Name Constant defs] q) → ParBisim (par p r) (par q r) +| par : (p ~[lts (defs := defs)] q) → ParBisim (par p r) (par q r) /-- P ~ Q → P | R ~ Q | R -/ theorem bisimilarity_congr_par : - (p ~[@lts Name Constant defs] q) → (par p r) ~[@lts Name Constant defs] (par q r) := by + (p ~[lts (defs := defs)] q) → (par p r) ~[lts (defs := defs)] (par q r) := by intro h exists @ParBisim _ _ defs constructor @@ -421,8 +422,8 @@ theorem bisimilarity_congr_par : /-- Bisimilarity is a congruence in CCS. -/ theorem bisimilarity_congr - (c : Context Name Constant) (p q : Process Name Constant) (h : p ~[@lts Name Constant defs] q) : - (c.fill p) ~[@lts Name Constant defs] (c.fill q) := by + (c : Context Name Constant) (p q : Process Name Constant) (h : p ~[lts (defs := defs)] q) : + (c.fill p) ~[lts (defs := defs)] (c.fill q) := by induction c case hole => exact h case pre _ _ ih => exact bisimilarity_congr_pre ih From 6644835c2a970175d7cac817aa670565900b401f Mon Sep 17 00:00:00 2001 From: Alexandre Rademaker Date: Wed, 3 Sep 2025 10:43:12 -0300 Subject: [PATCH 083/107] small update in affiliation (#56) --- GOVERNANCE.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GOVERNANCE.md b/GOVERNANCE.md index 9e40cccc..a196c1d7 100644 --- a/GOVERNANCE.md +++ b/GOVERNANCE.md @@ -31,7 +31,7 @@ The lead maintainer coordinates the overall work of the maintainer team and over Technical leads guide long-term developments that may span multiple areas of the codebase, offering specialised expertise. -- Alexandre Rademaker (@arademaker), IBM Research Brazil and Getulio Vargas Foundation. +- Alexandre Rademaker (@arademaker), Atlas Computing and Getulio Vargas Foundation. - Sorrachai Yingchareonthawornchai (@sorrachai), ETH Zurich. ### Area maintainers From dd02d603d250973bb1fa39b5453d1c268ec9d4ce Mon Sep 17 00:00:00 2001 From: Clark Barrett Date: Fri, 5 Sep 2025 16:11:03 -0700 Subject: [PATCH 084/107] Added Boole directory --- Cslib/Languages/Boole/README.md | 1 + 1 file changed, 1 insertion(+) create mode 100644 Cslib/Languages/Boole/README.md diff --git a/Cslib/Languages/Boole/README.md b/Cslib/Languages/Boole/README.md new file mode 100644 index 00000000..78e4c7aa --- /dev/null +++ b/Cslib/Languages/Boole/README.md @@ -0,0 +1 @@ +Placeholder for the Boole language. From 8e94a0da3e70e554ec9e095098ea4e3101807ab8 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Wed, 3 Sep 2025 14:07:07 +0200 Subject: [PATCH 085/107] Fix CLL exchange, add HasSize, add cut' --- Cslib/Logics/LinearLogic/CLL/Basic.lean | 5 +++ .../LinearLogic/CLL/CutElimination.lean | 31 +++++++++++++++++-- 2 files changed, 34 insertions(+), 2 deletions(-) diff --git a/Cslib/Logics/LinearLogic/CLL/Basic.lean b/Cslib/Logics/LinearLogic/CLL/Basic.lean index fa016912..8ee52020 100644 --- a/Cslib/Logics/LinearLogic/CLL/Basic.lean +++ b/Cslib/Logics/LinearLogic/CLL/Basic.lean @@ -161,9 +161,14 @@ inductive Proof : Sequent Atom → Prop where scoped notation "⊢" Γ:90 => Proof Γ +/-- The axiom, but where the order of propositions is reversed. -/ theorem Proof.ax' {a : Proposition Atom} : Proof [a⫠, a] := Proof.exchange (List.Perm.swap ..) Proof.ax +/-- Cut, but where the premises are reversed. -/ +theorem Proof.cut' (p : ⊢(a⫠ :: Γ)) (q : ⊢(a :: Δ)) : ⊢(Γ ++ Δ) := by + grind [Proof.cut, Proposition.dual.involution] + section LogicalEquiv /-! ## Logical equivalences -/ diff --git a/Cslib/Logics/LinearLogic/CLL/CutElimination.lean b/Cslib/Logics/LinearLogic/CLL/CutElimination.lean index dccd2786..bb666574 100644 --- a/Cslib/Logics/LinearLogic/CLL/CutElimination.lean +++ b/Cslib/Logics/LinearLogic/CLL/CutElimination.lean @@ -18,7 +18,7 @@ inductive Proof.CutFree : {Γ : Sequent Atom} → ⊢Γ → Prop where | ax : Proof.ax.CutFree | one : Proof.one.CutFree | bot (p : ⊢Γ) (hp : CutFree p) : p.bot.CutFree - | exchange (hperm : Γ.Perm Δ) (p : ⊢Γ) : (Proof.exchange hperm p).CutFree + | exchange (hperm : Γ.Perm Δ) (p : ⊢Γ) : p.CutFree → (Proof.exchange hperm p).CutFree | parr (p : ⊢(a :: b :: Γ)) : p.CutFree → p.parr.CutFree | tensor (p : ⊢(a :: Γ)) (q : ⊢(b :: Δ)) : p.CutFree → q.CutFree → (Proof.tensor p q).CutFree @@ -33,9 +33,36 @@ inductive Proof.CutFree : {Γ : Sequent Atom} → ⊢Γ → Prop where | bang (hqs: Sequent.allQuest Γ) (p : ⊢(a :: Γ)) : p.CutFree → (p.bang hqs).CutFree -- No rule for cut. +/-- Size of a `Proof`. -/ +inductive Proof.HasSize : {Γ : Sequent Atom} → ⊢Γ → Nat → Prop where + | ax : Proof.ax.HasSize 1 + | one : Proof.one.HasSize 1 + | bot (p : ⊢Γ) (n : Nat) (hp : p.HasSize n) : p.bot.HasSize (n + 1) + | exchange (hperm : Γ.Perm Δ) (p : ⊢Γ) (n : Nat) (hp : p.HasSize n) : + (Proof.exchange hperm p).HasSize n + | parr (p : ⊢(a :: b :: Γ)) (n : Nat) (hp : p.HasSize n) : p.parr.HasSize (n + 1) + | tensor (p : ⊢(a :: Γ)) (q : ⊢(b :: Δ)) (np nq : Nat) + (hp : p.HasSize np) (hq : q.HasSize nq) : + (Proof.tensor p q).HasSize (np + nq + 1) + | oplus₁ (p : ⊢(a :: Γ)) (n : Nat) (hp : p.HasSize n) : p.oplus₁.HasSize (n + 1) + | oplus₂ (p : ⊢(b :: Γ)) (n : Nat) (hp : p.HasSize n) : p.oplus₂.HasSize (n + 1) + | with (p : ⊢(a :: Γ)) (q : ⊢(b :: Γ)) (np nq : Nat) + (hp : p.HasSize np) (hq : q.HasSize nq) : + (Proof.with p q).HasSize (np + nq + 1) + | top : Proof.top.HasSize 1 + | quest (p : ⊢(a :: Γ)) (n : Nat) (hp : p.HasSize n) : p.quest.HasSize (n + 1) + | weaken (p : ⊢Γ) (n : Nat) (hp : p.HasSize n) : p.weaken.HasSize (n + 1) + | contract (p : ⊢(ʔa :: ʔa :: Γ)) (n : Nat) (hp : p.HasSize n) : + p.contract.HasSize (n + 1) + | bang (hqs: Sequent.allQuest Γ) (p : ⊢(a :: Γ)) (n : Nat) (hp : p.HasSize n) : + (p.bang hqs).HasSize (n + 1) + | cut (p : ⊢(a :: Γ)) (q : ⊢(a.dual :: Δ)) (np nq : Nat) + (hp : p.HasSize np) (hq : q.HasSize nq) : + (Proof.cut p q).HasSize (np + nq + 1) + /-- Cut is admissible. -/ proof_wanted Proof.cut_admissible - (p : ⊢(a :: Γ)) (q : ⊢(a.dual :: Δ)) (hp : p.CutFree) (hq : q.CutFree) : + {a : Proposition Atom} (p : ⊢(a :: Γ)) (q : ⊢(a.dual :: Δ)) (hp : p.CutFree) (hq : q.CutFree) : ∃ r : ⊢(Γ ++ Δ), r.CutFree /-- Cut elimination: for any sequent Γ, if there is a proof of Γ, then there exists a cut-free From 6e7ce4a245a4f637871fe83cf9e8dc54f7af5ba2 Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 8 Sep 2025 09:27:56 +0200 Subject: [PATCH 086/107] Bisimulation -> IsBisimulation and lots of grinding --- Cslib/Foundations/Data/Relation.lean | 2 +- .../Semantics/Lts/Bisimulation.lean | 419 ++++++++---------- Cslib/Languages/CCS/BehaviouralTheory.lean | 61 +-- 3 files changed, 205 insertions(+), 277 deletions(-) diff --git a/Cslib/Foundations/Data/Relation.lean b/Cslib/Foundations/Data/Relation.lean index 9bc36b69..e3bd649e 100644 --- a/Cslib/Foundations/Data/Relation.lean +++ b/Cslib/Foundations/Data/Relation.lean @@ -13,7 +13,7 @@ universe u v section Relation /-- The relation `r` 'up to' the relation `s`. -/ -def Relation.upTo (r s : α → α → Prop) : α → α → Prop := Relation.Comp s (Relation.Comp r s) +def Relation.UpTo (r s : α → α → Prop) : α → α → Prop := Relation.Comp s (Relation.Comp r s) /-- 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 → (∃ D, R B D ∧ R C D) diff --git a/Cslib/Foundations/Semantics/Lts/Bisimulation.lean b/Cslib/Foundations/Semantics/Lts/Bisimulation.lean index c5a2796d..2067fc2f 100644 --- a/Cslib/Foundations/Semantics/Lts/Bisimulation.lean +++ b/Cslib/Foundations/Semantics/Lts/Bisimulation.lean @@ -27,16 +27,17 @@ For an introduction to theory of bisimulation, we refer to [Sangiorgi2011]. ## Main definitions -- `Bisimulation lts r`: the relation `r` on the states of the Lts `lts` is a bisimulation. +- `lts.IsBisimulation r`: the relation `r` is a bisimulation for the LTS `lts`. - `Bisimilarity lts` is the binary relation on the states of `lts` that relates any two states related by some bisimulation on `lts`. -- `BisimulationUpTo lts r`: the relation `r` is a bisimulation up to bisimilarity (this is known as -one of the 'up to' techniques for bisimulation). +- `lts.IsBisimulationUpTo r`: the relation `r` is a bisimulation up to bisimilarity (this is known +as one of the 'up to' techniques for bisimulation). -- `WeakBisimulation lts r`: the relation `r` on the states of the Lts `lts` is a weak bisimulation. +- `lts.IsWeakBisimulation r`: the relation `r` on the states of the Lts `lts` is a weak +bisimulation. - `WeakBisimilarity lts` is the binary relation on the states of `lts` that relates any two states related by some weak bisimulation on `lts`. -- `SWBisimulation lts` is a more convenient definition for establishing weak bisimulations, which +- `lts.IsSWBisimulation` is a more convenient definition for establishing weak bisimulations, which we prove to be sound and complete. - `SWBisimilarity lts` is the binary relation on the states of `lts` that relates any two states related by some sw-bisimulation on `lts`. @@ -70,36 +71,47 @@ universe u v section Bisimulation -variable {State : Type u} {Label : Type v} (lts : Lts State Label) +variable {State : Type u} {Label : Type v} {lts : Lts State Label} /-- A relation is a bisimulation if, whenever it relates two states in an lts, the transitions originating from these states mimic each other and the reached derivatives are themselves related. -/ -def Bisimulation (lts : Lts State Label) (r : State → State → Prop) : Prop := - ∀ s1 s2, r s1 s2 → ∀ μ, ( +@[grind] +def Lts.IsBisimulation (lts : Lts State Label) (r : State → State → Prop) : Prop := + ∀ ⦃s1 s2⦄, r s1 s2 → ∀ μ, ( (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ r s1' s2') ∧ (∀ s2', lts.Tr s2 μ s2' → ∃ s1', lts.Tr s1 μ s1' ∧ r s1' s2') ) -/-- Helper for following a transition using the first component of a `Bisimulation`. -/ -def Bisimulation.follow_fst - {lts : Lts State Label} {r : State → State → Prop} - {s1 s2 : State} {μ : Label} {s1' : State} - (hb : Bisimulation lts r) (hr : r s1 s2) (htr : lts.Tr s1 μ s1') := - (hb _ _ hr μ).1 _ htr - -/-- Helper for following a transition using the second component of a `Bisimulation`. -/ -def Bisimulation.follow_snd - {lts : Lts State Label} {r : State → State → Prop} - {s1 s2 : State} {μ : Label} {s2' : State} - (hb : Bisimulation lts r) (hr : r s1 s2) (htr : lts.Tr s2 μ s2') := - (hb _ _ hr μ).2 _ htr +/- Semi-bundled version of `Lts.IsBisimulation`. -/ +-- @[grind ext] +-- structure Bisimulation (lts : Lts State Label) where +-- /-- The relation on the states of the lts. -/ +-- rel : State → State → Prop +-- /-- Proof that the relation is a bisimulation. -/ +-- is_bisimulation : lts.IsBisimulation rel + +/- Any `Bisimulation` can be coerced into a relation. -/ +-- instance : CoeFun (lts.IsBisimulation) (fun _ => State → State → Prop) where +-- coe := fun bisim => bisim.rel + +/-- Helper for following a transition by the first state in a pair of a `Bisimulation`. -/ +theorem Lts.IsBisimulation.follow_fst + (hb : lts.IsBisimulation r) (hr : r s1 s2) (htr : lts.Tr s1 μ s1') : + ∃ s2', lts.Tr s2 μ s2' ∧ r s1' s2' := + (hb hr μ).1 _ htr + +/-- Helper for following a transition by the second state in a pair of a `Bisimulation`. -/ +theorem Lts.IsBisimulation.follow_snd + (hb : lts.IsBisimulation r) (hr : r s1 s2) (htr : lts.Tr s2 μ s2') : + ∃ s1', lts.Tr s1 μ s1' ∧ r s1' s2' := + (hb hr μ).2 _ htr /-- Two states are bisimilar if they are related by some bisimulation. -/ +@[grind] def Bisimilarity (lts : Lts State Label) : State → State → Prop := - fun s1 s2 => - ∃ r : State → State → Prop, r s1 s2 ∧ Bisimulation lts r + fun s1 s2 => ∃ r : State → State → Prop, r s1 s2 ∧ lts.IsBisimulation r /-- Notation for bisimilarity. @@ -110,105 +122,57 @@ explicitly. notation s:max " ~[" lts "] " s':max => Bisimilarity lts s s' /-- Bisimilarity is reflexive. -/ +@[grind, refl] theorem Bisimilarity.refl (s : State) : s ~[lts] s := by exists Eq - grind [Bisimulation] + grind /-- The inverse of a bisimulation is a bisimulation. -/ -theorem Bisimulation.inv (h : Bisimulation lts r) : - Bisimulation lts (flip r) := by - simp only [Bisimulation] at h - simp only [Bisimulation] - intro s1 s2 hrinv μ - constructor - case left => - intro s1' htr - specialize h s2 s1 hrinv μ - have h' := h.2 s1' htr - obtain ⟨ s2', h' ⟩ := h' - exists s2' - case right => - intro s2' htr - specialize h s2 s1 hrinv μ - have h' := h.1 s2' htr - obtain ⟨ s1', h' ⟩ := h' - exists s1' +@[grind] +theorem Bisimulation.inv (h : lts.IsBisimulation r) : + lts.IsBisimulation (flip r) := by grind [flip] /-- Bisimilarity is symmetric. -/ +@[grind, symm] theorem Bisimilarity.symm {s1 s2 : State} (h : s1 ~[lts] s2) : s2 ~[lts] s1 := by - obtain ⟨r, hr, hb⟩ := h + obtain ⟨r, _, _⟩ := h exists (flip r) - constructor - case left => - exact hr - case right => - apply Bisimulation.inv - exact hb + grind [flip] /-- The composition of two bisimulations is a bisimulation. -/ +@[grind] theorem Bisimulation.comp - (r1 r2 : State → State → Prop) (h1 : Bisimulation lts r1) (h2 : Bisimulation lts r2) : - Bisimulation lts (Relation.Comp r1 r2) := by - simp_all only [Bisimulation] - intro s1 s2 hrc μ - constructor - case left => - intro s1' htr - rcases hrc with ⟨sb, hr1, hr2⟩ - specialize h1 s1 sb hr1 μ - specialize h2 sb s2 hr2 μ - have h1' := h1.1 s1' htr - obtain ⟨s1'', h1'tr, h1'⟩ := h1' - have h2' := h2.1 s1'' h1'tr - obtain ⟨s2'', h2'tr, h2'⟩ := h2' - exists s2'' - constructor - · exact h2'tr - · exists s1'' - case right => - intro s2' htr - rcases hrc with ⟨sb, hr1, hr2⟩ - specialize h1 s1 sb hr1 μ - specialize h2 sb s2 hr2 μ - have h2' := h2.2 s2' htr - obtain ⟨s2'', h2'tr, h2'⟩ := h2' - have h1' := h1.2 s2'' h2'tr - obtain ⟨s1'', h1'tr, h1'⟩ := h1' - exists s1'' - constructor - · exact h1'tr - · exists s2'' + (h1 : lts.IsBisimulation r1) (h2 : lts.IsBisimulation r2) : + lts.IsBisimulation (Relation.Comp r1 r2) := by grind [Relation.Comp] /-- Bisimilarity is transitive. -/ +@[grind] theorem Bisimilarity.trans - {s1 s2 s3 : State} (h1 : s1 ~[lts] s2) (h2 : s2 ~[lts] s3) : + (h1 : s1 ~[lts] s2) (h2 : s2 ~[lts] s3) : s1 ~[lts] s3 := by - obtain ⟨r1, hr1, hr1b⟩ := h1 - obtain ⟨r2, hr2, hr2b⟩ := h2 + obtain ⟨r1, _, _⟩ := h1 + obtain ⟨r2, _, _⟩ := h2 exists Relation.Comp r1 r2 - constructor - case left => - exists s2 - case right => - apply Bisimulation.comp lts r1 r2 hr1b hr2b + grind [Relation.Comp] /-- Bisimilarity is an equivalence relation. -/ -theorem Bisimilarity.eqv (lts : Lts State Label) : +theorem Bisimilarity.eqv : Equivalence (Bisimilarity lts) := { - refl := Bisimilarity.refl lts - symm := Bisimilarity.symm lts - trans := Bisimilarity.trans lts + refl := Bisimilarity.refl + symm := Bisimilarity.symm + trans := Bisimilarity.trans } /-- The union of two bisimulations is a bisimulation. -/ -theorem Bisimulation.union (hrb : Bisimulation lts r) (hsb : Bisimulation lts s) : - Bisimulation lts (r ⊔ s) := by +@[grind] +theorem Bisimulation.union (hrb : lts.IsBisimulation r) (hsb : lts.IsBisimulation s) : + lts.IsBisimulation (r ⊔ s) := by intro s1 s2 hrs μ cases hrs case inl h => constructor · intro s1' htr - obtain ⟨s2', htr', hr'⟩ := Bisimulation.follow_fst hrb h htr + obtain ⟨s2', htr', hr'⟩ := hrb.follow_fst h htr exists s2' constructor · assumption @@ -216,7 +180,7 @@ theorem Bisimulation.union (hrb : Bisimulation lts r) (hsb : Bisimulation lts s) left exact hr' · intro s2' htr - obtain ⟨s1', htr', hr'⟩ := Bisimulation.follow_snd hrb h htr + obtain ⟨s1', htr', hr'⟩ := hrb.follow_snd h htr exists s1' constructor · assumption @@ -226,7 +190,7 @@ theorem Bisimulation.union (hrb : Bisimulation lts r) (hsb : Bisimulation lts s) case inr h => constructor · intro s1' htr - obtain ⟨s2', htr', hs'⟩ := Bisimulation.follow_fst hsb h htr + obtain ⟨s2', htr', hs'⟩ := hsb.follow_fst h htr exists s2' constructor · assumption @@ -234,7 +198,7 @@ theorem Bisimulation.union (hrb : Bisimulation lts r) (hsb : Bisimulation lts s) right exact hs' · intro s2' htr - obtain ⟨s1', htr', hs'⟩ := Bisimulation.follow_snd hsb h htr + obtain ⟨s1', htr', hs'⟩ := hsb.follow_snd h htr exists s1' constructor · assumption @@ -243,65 +207,38 @@ theorem Bisimulation.union (hrb : Bisimulation lts r) (hsb : Bisimulation lts s) exact hs' /-- Bisimilarity is a bisimulation. -/ -theorem Bisimilarity.is_bisimulation : Bisimulation lts (Bisimilarity lts) := by - simp only [Bisimulation] - intro s1 s2 h μ - obtain ⟨r, hr, hb⟩ := h - have hrBisim := hb - specialize hb s1 s2 - constructor - case left => - intro s1' htr - specialize hb hr μ - obtain ⟨hb1, hb2⟩ := hb - specialize hb1 s1' htr - obtain ⟨s2', htr2, hr2⟩ := hb1 - exists s2' - constructor - case left => - exact htr2 - case right => - exists r - case right => - intro s2' htr - specialize hb hr μ - obtain ⟨hb1, hb2⟩ := hb - specialize hb2 s2' htr - obtain ⟨s1', htr1, hr1⟩ := hb2 - exists s1' - constructor - case left => - exact htr1 - case right => - exists r +@[grind] +theorem Bisimilarity.is_bisimulation : lts.IsBisimulation (Bisimilarity lts) := by grind /-- Bisimilarity is the largest bisimulation. -/ +@[grind] theorem Bisimilarity.largest_bisimulation - (h : Bisimulation lts r) : + (h : lts.IsBisimulation r) : Subrelation r (Bisimilarity lts) := by intro s1 s2 hr exists r /-- The union of bisimilarity with any bisimulation is bisimilarity. -/ -theorem Bisimilarity.gfp (r : State → State → Prop) (h : Bisimulation lts r) : +@[grind, simp] +theorem Bisimilarity.gfp (r : State → State → Prop) (h : lts.IsBisimulation r) : (Bisimilarity lts) ⊔ r = Bisimilarity lts := by funext s1 s2 simp only [max, SemilatticeSup.sup, eq_iff_iff, or_iff_left_iff_imp] - apply Bisimilarity.largest_bisimulation lts h + apply Bisimilarity.largest_bisimulation h /-- `calc` support for bisimilarity. -/ instance : Trans (Bisimilarity lts) (Bisimilarity lts) (Bisimilarity lts) where - trans := Bisimilarity.trans lts + trans := Bisimilarity.trans section Order /-! ## Order properties -/ -noncomputable instance : Max {r // Bisimulation lts r} where - max r s := ⟨r.1 ⊔ s.1, Bisimulation.union lts r.2 s.2⟩ +noncomputable instance : Max {r // lts.IsBisimulation r} where + max r s := ⟨r.1 ⊔ s.1, Bisimulation.union r.2 s.2⟩ /-- Bisimulations equipped with union form a join-semilattice. -/ -noncomputable instance : SemilatticeSup {r // Bisimulation lts r} where +noncomputable instance : SemilatticeSup {r // lts.IsBisimulation r} where sup r s := r ⊔ s le_sup_left r s := by simp only [LE.le] @@ -327,7 +264,8 @@ noncomputable instance : SemilatticeSup {r // Bisimulation lts r} where apply h2 _ _ h /-- The empty relation is a bisimulation. -/ -theorem Bisimulation.emptyRelation_bisimulation : Bisimulation lts emptyRelation := by +@[grind] +theorem Bisimulation.emptyRelation_bisimulation : lts.IsBisimulation emptyRelation := by intro s1 s2 hr cases hr @@ -336,13 +274,13 @@ theorem Bisimulation.emptyRelation_bisimulation : Bisimulation lts emptyRelation - The empty relation is the bottom element. - Bisimilarity is the top element. -/ -instance : BoundedOrder {r // Bisimulation lts r} where - top := ⟨Bisimilarity lts, Bisimilarity.is_bisimulation lts⟩ - bot := ⟨emptyRelation, Bisimulation.emptyRelation_bisimulation lts⟩ +instance : BoundedOrder {r // lts.IsBisimulation r} where + top := ⟨Bisimilarity lts, Bisimilarity.is_bisimulation⟩ + bot := ⟨emptyRelation, Bisimulation.emptyRelation_bisimulation⟩ le_top r := by intro s1 s2 simp only [LE.le] - apply Bisimilarity.largest_bisimulation lts r.2 + apply Bisimilarity.largest_bisimulation r.2 bot_le r := by intro s1 s2 simp only [LE.le] @@ -356,16 +294,18 @@ end Order /-- A relation `r` is a bisimulation up to bisimilarity if, whenever it relates two states in an lts, the transitions originating from these states mimic each other and the reached derivatives are themselves related by `r` up to bisimilarity. -/ -def BisimulationUpTo (lts : Lts State Label) (r : State → State → Prop) : Prop := - ∀ s1 s2, r s1 s2 → ∀ μ, ( - (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ Relation.upTo r (Bisimilarity lts) s1' s2') +@[grind] +def Lts.IsBisimulationUpTo (lts : Lts State Label) (r : State → State → Prop) : Prop := + ∀ ⦃s1 s2⦄, r s1 s2 → ∀ μ, ( + (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.Tr s2 μ s2' ∧ Relation.UpTo r (Bisimilarity lts) s1' s2') ∧ - (∀ s2', lts.Tr s2 μ s2' → ∃ s1', lts.Tr s1 μ s1' ∧ Relation.upTo r (Bisimilarity lts) s1' s2') + (∀ s2', lts.Tr s2 μ s2' → ∃ s1', lts.Tr s1 μ s1' ∧ Relation.UpTo r (Bisimilarity lts) s1' s2') ) /-- Any bisimulation up to bisimilarity is a bisimulation. -/ -theorem Bisimulation.upTo_bisimulation (r : State → State → Prop) (h : BisimulationUpTo lts r) : - Bisimulation lts (Relation.upTo r (Bisimilarity lts)) := by +@[grind] +theorem Bisimulation.upTo_bisimulation (h : lts.IsBisimulationUpTo r) : + lts.IsBisimulation (Relation.UpTo r (Bisimilarity lts)) := by intro s1 s2 hr μ rcases hr with ⟨s1b, hr1b, s2b, hrb, hr2b⟩ obtain ⟨r1, hr1, hr1b⟩ := hr1b @@ -373,9 +313,9 @@ theorem Bisimulation.upTo_bisimulation (r : State → State → Prop) (h : Bisim constructor case left => intro s1' htr1 - obtain ⟨s1b', hs1b'tr, hs1b'r⟩ := (hr1b _ _ hr1 μ).1 s1' htr1 - obtain ⟨s2b', hs2b'tr, hs2b'r⟩ := (h s1b s2b hrb μ).1 s1b' hs1b'tr - obtain ⟨s2', hs2btr, hs2br⟩ := (hr2b _ _ hr2 μ).1 _ hs2b'tr + obtain ⟨s1b', hs1b'tr, hs1b'r⟩ := (hr1b hr1 μ).1 s1' htr1 + obtain ⟨s2b', hs2b'tr, hs2b'r⟩ := (h hrb μ).1 s1b' hs1b'tr + obtain ⟨s2', hs2btr, hs2br⟩ := (hr2b hr2 μ).1 _ hs2b'tr exists s2' constructor case left => @@ -384,18 +324,18 @@ theorem Bisimulation.upTo_bisimulation (r : State → State → Prop) (h : Bisim obtain ⟨smid1, hsmidb, smid2, hsmidr, hsmidrb⟩ := hs2b'r constructor constructor - · apply Bisimilarity.trans lts (Bisimilarity.largest_bisimulation lts hr1b hs1b'r) + · apply Bisimilarity.trans (Bisimilarity.largest_bisimulation hr1b hs1b'r) hsmidb · exists smid2 constructor · exact hsmidr - · apply Bisimilarity.trans lts hsmidrb - apply Bisimilarity.largest_bisimulation lts hr2b hs2br + · apply Bisimilarity.trans hsmidrb + apply Bisimilarity.largest_bisimulation hr2b hs2br case right => intro s2' htr2 - obtain ⟨s2b', hs2b'tr, hs2b'r⟩ := (hr2b _ _ hr2 μ).2 s2' htr2 - obtain ⟨s1b', hs1b'tr, hs1b'r⟩ := (h s1b s2b hrb μ).2 s2b' hs2b'tr - obtain ⟨s1', hs1btr, hs1br⟩ := (hr1b _ _ hr1 μ).2 _ hs1b'tr + obtain ⟨s2b', hs2b'tr, hs2b'r⟩ := (hr2b hr2 μ).2 s2' htr2 + obtain ⟨s1b', hs1b'tr, hs1b'r⟩ := (h hrb μ).2 s2b' hs2b'tr + obtain ⟨s1', hs1btr, hs1br⟩ := (hr1b hr1 μ).2 _ hs1b'tr exists s1' constructor case left => @@ -404,19 +344,19 @@ theorem Bisimulation.upTo_bisimulation (r : State → State → Prop) (h : Bisim obtain ⟨smid1, hsmidb, smid2, hsmidr, hsmidrb⟩ := hs1b'r constructor constructor - · apply Bisimilarity.trans lts (Bisimilarity.largest_bisimulation lts hr1b _) hsmidb + · apply Bisimilarity.trans (Bisimilarity.largest_bisimulation hr1b _) hsmidb · exact hs1br · exists smid2 constructor · exact hsmidr - · apply Bisimilarity.trans lts hsmidrb - apply Bisimilarity.largest_bisimulation lts hr2b _ + · apply Bisimilarity.trans hsmidrb + apply Bisimilarity.largest_bisimulation hr2b _ exact hs2b'r /-- If two states are related by a bisimulation, they can mimic each other's multi-step transitions. -/ theorem Bisimulation.bisim_trace - (s1 s2 : State) (r : State → State → Prop) (hb : Bisimulation lts r) (hr : r s1 s2) : + (hb : lts.IsBisimulation r) (hr : r s1 s2) : ∀ μs s1', lts.MTr s1 μs s1' → ∃ s2', lts.MTr s2 μs s2' ∧ r s1' s2' := by intro μs induction μs generalizing s1 s2 @@ -431,10 +371,10 @@ theorem Bisimulation.bisim_trace intro s1' hmtr1 cases hmtr1 case stepL s1'' htr hmtr => - specialize hb s1 s2 hr μ + specialize hb hr μ have hf := hb.1 s1'' htr obtain ⟨s2'', htr2, hb2⟩ := hf - specialize ih s1'' s2'' hb2 s1' hmtr + specialize ih hb2 s1' hmtr obtain ⟨s2', hmtr2, hr'⟩ := ih exists s2' constructor @@ -448,8 +388,9 @@ theorem Bisimulation.bisim_trace /-! ## Relation to trace equivalence -/ /-- Any bisimulation implies trace equivalence. -/ +@[grind] theorem Bisimulation.bisim_traceEq - (hb : Bisimulation lts r) (hr : r s1 s2) : + (hb : lts.IsBisimulation r) (hr : r s1 s2) : s1 ~tr[lts] s2 := by funext μs simp only [eq_iff_iff] @@ -457,22 +398,23 @@ theorem Bisimulation.bisim_traceEq case mp => intro h obtain ⟨s1', h⟩ := h - obtain ⟨s2', hmtr⟩ := @Bisimulation.bisim_trace State Label lts s1 s2 r hb hr μs s1' h + obtain ⟨s2', hmtr⟩ := Bisimulation.bisim_trace hb hr μs s1' h exists s2' exact hmtr.1 case mpr => intro h obtain ⟨s2', h⟩ := h have hinv := @Bisimulation.inv State Label lts r hb - obtain ⟨s1', hmtr⟩ := @Bisimulation.bisim_trace State Label lts s2 s1 (flip r) hinv hr μs s2' h + obtain ⟨s1', hmtr⟩ := Bisimulation.bisim_trace hinv hr μs s2' h exists s1' exact hmtr.1 /-- Bisimilarity is included in trace equivalence. -/ +@[grind] theorem Bisimilarity.le_traceEq : Bisimilarity lts ≤ TraceEq lts := by intro s1 s2 h obtain ⟨r, hr, hb⟩ := h - apply Bisimulation.bisim_traceEq lts hb hr + apply Bisimulation.bisim_traceEq hb hr /- One of the standard motivating examples for bisimulation: `1` and `5` are trace equivalent, but not bisimilar. -/ @@ -490,13 +432,13 @@ private inductive BisimMotTr : ℕ → Char → ℕ → Prop where /-- In general, trace equivalence is not a bisimulation (extra conditions are needed, see for example `Bisimulation.deterministic_trace_eq_is_bisim`). -/ theorem Bisimulation.traceEq_not_bisim : - ∃ (State : Type) (Label : Type) (lts : Lts State Label), ¬(Bisimulation lts (TraceEq lts)) := by + ∃ (State : Type) (Label : Type) (lts : Lts State Label), ¬(lts.IsBisimulation (TraceEq lts)) := by exists ℕ exists Char let lts := Lts.mk BisimMotTr exists lts intro h - specialize h 1 5 + -- specialize h 1 5 have htreq : (1 ~tr[lts] 5) := by simp [TraceEq] have htraces1 : lts.traces 1 = {[], ['a'], ['a', 'b'], ['a', 'c']} := by @@ -724,7 +666,7 @@ theorem Bisimulation.traceEq_not_bisim : cases htr cases hmtr case stepL μ sb μs' htr hmtr => cases htr - simp + simp case mpr => intro h cases h @@ -753,15 +695,15 @@ theorem Bisimilarity.bisimilarity_neq_traceEq : obtain ⟨State, Label, lts, h⟩ := Bisimulation.traceEq_not_bisim exists State; exists Label; exists lts intro heq - have hb := Bisimilarity.is_bisimulation lts + have hb := Bisimilarity.is_bisimulation (lts := lts) rw [heq] at hb contradiction /-- In any deterministic Lts, trace equivalence is a bisimulation. -/ theorem Bisimulation.deterministic_traceEq_is_bisim - (lts : Lts State Label) (hdet : lts.Deterministic) : - (Bisimulation lts (TraceEq lts)) := by - simp only [Bisimulation] + (hdet : lts.Deterministic) : + (lts.IsBisimulation (TraceEq lts)) := by + simp only [Lts.IsBisimulation] intro s1 s2 hteq μ constructor case left => @@ -780,14 +722,14 @@ theorem Bisimulation.deterministic_traceEq_is_bisim /-- In any deterministic Lts, trace equivalence implies bisimilarity. -/ theorem Bisimilarity.deterministic_traceEq_bisim - (lts : Lts State Label) (hdet : lts.Deterministic) (s1 s2 : State) (h : s1 ~tr[lts] s2) : + (hdet : lts.Deterministic) (h : s1 ~tr[lts] s2) : (s1 ~[lts] s2) := by exists TraceEq lts constructor case left => exact h case right => - apply Bisimulation.deterministic_traceEq_is_bisim lts hdet + apply Bisimulation.deterministic_traceEq_is_bisim hdet /-- In any deterministic Lts, bisimilarity and trace equivalence coincide. -/ theorem Bisimilarity.deterministic_bisim_eq_traceEq @@ -799,21 +741,21 @@ theorem Bisimilarity.deterministic_bisim_eq_traceEq case mp => apply Bisimilarity.le_traceEq case mpr => - apply Bisimilarity.deterministic_traceEq_bisim lts hdet + apply Bisimilarity.deterministic_traceEq_bisim hdet /-! ## Relation to simulation -/ /-- Any bisimulation is also a simulation. -/ theorem Bisimulation.is_simulation (lts : Lts State Label) (r : State → State → Prop) : - Bisimulation lts r → Simulation lts r := by - grind [Bisimulation, Simulation] + lts.IsBisimulation r → Simulation lts r := by + grind [Simulation] /-- A relation is a bisimulation iff both it and its inverse are simulations. -/ theorem Bisimulation.simulation_iff (lts : Lts State Label) (r : State → State → Prop) : - Bisimulation lts r ↔ (Simulation lts r ∧ Simulation lts (flip r)) := by + lts.IsBisimulation r ↔ (Simulation lts r ∧ Simulation lts (flip r)) := by constructor - case mp => grind [Bisimulation, Simulation, flip] - case mpr => aesop (add simp [Bisimulation]) + case mp => grind [Simulation, flip] + case mpr => aesop (add simp [Lts.IsBisimulation]) end Bisimulation @@ -823,13 +765,13 @@ section WeakBisimulation /-- A weak bisimulation is similar to a `Bisimulation`, but allows for the related processes to do internal work. Technically, this is defined as a `Bisimulation` on the saturation of the Lts. -/ -def WeakBisimulation [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) := - Bisimulation (lts.saturate) r +def Lts.IsWeakBisimulation [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) := + lts.saturate.IsBisimulation r /-- Two states are weakly bisimilar if they are related by some weak bisimulation. -/ def WeakBisimilarity [HasTau Label] (lts : Lts State Label) : State → State → Prop := fun s1 s2 => - ∃ r : State → State → Prop, r s1 s2 ∧ WeakBisimulation lts r + ∃ r : State → State → Prop, r s1 s2 ∧ lts.IsWeakBisimulation r /-- Notation for weak bisimilarity. -/ notation s:max " ≈[" lts "] " s':max => WeakBisimilarity lts s s' @@ -837,8 +779,8 @@ notation s:max " ≈[" lts "] " s':max => WeakBisimilarity lts s s' /-- An `SWBisimulation` is a more convenient definition of weak bisimulation, because the challenge is a single transition. We prove later that this technique is sound, following a strategy inspired by [Sangiorgi2011]. -/ -def SWBisimulation [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) : Prop := - ∀ s1 s2, r s1 s2 → ∀ μ, ( +def Lts.IsSWBisimulation [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) : Prop := + ∀ ⦃s1 s2⦄, r s1 s2 → ∀ μ, ( (∀ s1', lts.Tr s1 μ s1' → ∃ s2', lts.STr s2 μ s2' ∧ r s1' s2') ∧ (∀ s2', lts.Tr s2 μ s2' → ∃ s1', lts.STr s1 μ s1' ∧ r s1' s2') @@ -847,7 +789,7 @@ def SWBisimulation [HasTau Label] (lts : Lts State Label) (r : State → State /-- Two states are sw-bisimilar if they are related by some sw-bisimulation. -/ def SWBisimilarity [HasTau Label] (lts : Lts State Label) : State → State → Prop := fun s1 s2 => - ∃ r : State → State → Prop, r s1 s2 ∧ SWBisimulation lts r + ∃ r : State → State → Prop, r s1 s2 ∧ lts.IsSWBisimulation r /-- Notation for swbisimilarity. -/ notation s:max " ≈sw[" lts "] " s':max => SWBisimilarity lts s s' @@ -855,8 +797,8 @@ notation s:max " ≈sw[" lts "] " s':max => SWBisimilarity lts s s' /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (first component, weighted version). -/ theorem SWBisimulation.follow_internal_fst_n - [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) - (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstrN : lts.strN n s1 HasTau.τ s1') : + [HasTau Label] {lts : Lts State Label} + (hswb : lts.IsSWBisimulation r) (hr : r s1 s2) (hstrN : lts.strN n s1 HasTau.τ s1') : ∃ s2', lts.STr s2 HasTau.τ s2' ∧ r s1' s2' := by cases n case zero => @@ -868,11 +810,11 @@ theorem SWBisimulation.follow_internal_fst_n cases hstrN rename_i n1 sb sb' n2 hstrN1 htr hstrN2 let hswb_m := hswb - have ih1 := SWBisimulation.follow_internal_fst_n lts r hswb hr hstrN1 + have ih1 := SWBisimulation.follow_internal_fst_n hswb hr hstrN1 obtain ⟨sb2, hstrs2, hrsb⟩ := ih1 - have h := (hswb sb sb2 hrsb HasTau.τ).1 sb' htr + have h := (hswb hrsb HasTau.τ).1 sb' htr obtain ⟨sb2', hstrsb2, hrsb2⟩ := h - have ih2 := SWBisimulation.follow_internal_fst_n lts r hswb hrsb2 hstrN2 + have ih2 := SWBisimulation.follow_internal_fst_n hswb hrsb2 hstrN2 obtain ⟨s2', hstrs2', hrs2⟩ := ih2 exists s2' constructor @@ -882,8 +824,8 @@ theorem SWBisimulation.follow_internal_fst_n /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (second component, weighted version). -/ theorem SWBisimulation.follow_internal_snd_n - [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) - (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstrN : lts.strN n s2 HasTau.τ s2') : + [HasTau Label] {lts : Lts State Label} + (hswb : lts.IsSWBisimulation r) (hr : r s1 s2) (hstrN : lts.strN n s2 HasTau.τ s2') : ∃ s1', lts.STr s1 HasTau.τ s1' ∧ r s1' s2' := by cases n case zero => @@ -895,11 +837,11 @@ theorem SWBisimulation.follow_internal_snd_n cases hstrN rename_i n1 sb sb' n2 hstrN1 htr hstrN2 let hswb_m := hswb - have ih1 := SWBisimulation.follow_internal_snd_n lts r hswb hr hstrN1 + have ih1 := SWBisimulation.follow_internal_snd_n hswb hr hstrN1 obtain ⟨sb1, hstrs1, hrsb⟩ := ih1 - have h := (hswb sb1 sb hrsb HasTau.τ).2 sb' htr + have h := (hswb hrsb HasTau.τ).2 sb' htr obtain ⟨sb2', hstrsb2, hrsb2⟩ := h - have ih2 := SWBisimulation.follow_internal_snd_n lts r hswb hrsb2 hstrN2 + have ih2 := SWBisimulation.follow_internal_snd_n hswb hrsb2 hstrN2 obtain ⟨s2', hstrs2', hrs2⟩ := ih2 exists s2' constructor @@ -909,26 +851,26 @@ theorem SWBisimulation.follow_internal_snd_n /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (first component). -/ theorem SWBisimulation.follow_internal_fst - [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) - (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstr : lts.STr s1 HasTau.τ s1') : + [HasTau Label] {lts : Lts State Label} + (hswb : lts.IsSWBisimulation r) (hr : r s1 s2) (hstr : lts.STr s1 HasTau.τ s1') : ∃ s2', lts.STr s2 HasTau.τ s2' ∧ r s1' s2' := by obtain ⟨n, hstrN⟩ := (Lts.str_strN lts).1 hstr - apply SWBisimulation.follow_internal_fst_n lts r hswb hr hstrN + apply SWBisimulation.follow_internal_fst_n hswb hr hstrN /-- Utility theorem for 'following' internal transitions using an `SWBisimulation` (second component). -/ theorem SWBisimulation.follow_internal_snd - [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) - (hswb : SWBisimulation lts r) (hr : r s1 s2) (hstr : lts.STr s2 HasTau.τ s2') : + [HasTau Label] {lts : Lts State Label} + (hswb : lts.IsSWBisimulation r) (hr : r s1 s2) (hstr : lts.STr s2 HasTau.τ s2') : ∃ s1', lts.STr s1 HasTau.τ s1' ∧ r s1' s2' := by obtain ⟨n, hstrN⟩ := (Lts.str_strN lts).1 hstr - apply SWBisimulation.follow_internal_snd_n lts r hswb hr hstrN + apply SWBisimulation.follow_internal_snd_n hswb hr hstrN /-- We can now prove that any relation is a `WeakBisimulation` iff it is an `SWBisimulation`. This formalises lemma 4.2.10 in [Sangiorgi2011]. -/ -theorem WeakBisimulation.iff_swBisimulation - [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) : - WeakBisimulation lts r ↔ SWBisimulation lts r := by +theorem Lts.isWeakBisimulation_iff_isSWBisimulation + [HasTau Label] {lts : Lts State Label} : + lts.IsWeakBisimulation r ↔ lts.IsSWBisimulation r := by apply Iff.intro case mp => intro h @@ -936,13 +878,13 @@ theorem WeakBisimulation.iff_swBisimulation apply And.intro case left => intro s1' htr - specialize h s1 s2 hr μ + specialize h hr μ have h' := h.1 s1' (Lts.STr.single lts htr) obtain ⟨s2', htr2, hr2⟩ := h' exists s2' case right => intro s2' htr - specialize h s1 s2 hr μ + specialize h hr μ have h' := h.2 s2' (Lts.STr.single lts htr) obtain ⟨s1', htr1, hr1⟩ := h' exists s1' @@ -958,9 +900,9 @@ theorem WeakBisimulation.iff_swBisimulation constructor; constructor exact hr case tr sb sb' hstr1 htr hstr2 => - obtain ⟨sb2, hstr2b, hrb⟩ := SWBisimulation.follow_internal_fst lts r h hr hstr1 - obtain ⟨sb2', hstr2b', hrb'⟩ := (h sb sb2 hrb μ).1 _ htr - obtain ⟨s2', hstr2', hrb2⟩ := SWBisimulation.follow_internal_fst lts r h hrb' hstr2 + obtain ⟨sb2, hstr2b, hrb⟩ := SWBisimulation.follow_internal_fst h hr hstr1 + obtain ⟨sb2', hstr2b', hrb'⟩ := (h hrb μ).1 _ htr + obtain ⟨s2', hstr2', hrb2⟩ := SWBisimulation.follow_internal_fst h hrb' hstr2 exists s2' constructor · exact Lts.STr.comp lts hstr2b hstr2b' hstr2' @@ -973,32 +915,33 @@ theorem WeakBisimulation.iff_swBisimulation constructor; constructor exact hr case tr sb sb' hstr1 htr hstr2 => - obtain ⟨sb1, hstr1b, hrb⟩ := SWBisimulation.follow_internal_snd lts r h hr hstr1 - obtain ⟨sb2', hstr1b', hrb'⟩ := (h sb1 sb hrb μ).2 _ htr - obtain ⟨s1', hstr1', hrb2⟩ := SWBisimulation.follow_internal_snd lts r h hrb' hstr2 + obtain ⟨sb1, hstr1b, hrb⟩ := SWBisimulation.follow_internal_snd h hr hstr1 + obtain ⟨sb2', hstr1b', hrb'⟩ := (h hrb μ).2 _ htr + obtain ⟨s1', hstr1', hrb2⟩ := SWBisimulation.follow_internal_snd h hrb' hstr2 exists s1' constructor · exact Lts.STr.comp lts hstr1b hstr1b' hstr1' · exact hrb2 theorem WeakBisimulation.toSwBisimulation - [HasTau Label] {lts : Lts State Label} {r : State → State → Prop} (h : WeakBisimulation lts r) : - SWBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).1 h + [HasTau Label] {lts : Lts State Label} {r : State → State → Prop} (h : lts.IsWeakBisimulation r) : + lts.IsSWBisimulation r := Lts.isWeakBisimulation_iff_isSWBisimulation.1 h theorem SWBisimulation.toWeakBisimulation - [HasTau Label] {lts : Lts State Label} {r : State → State → Prop} (h : SWBisimulation lts r) : - WeakBisimulation lts r := (WeakBisimulation.iff_swBisimulation lts r).2 h + [HasTau Label] {lts : Lts State Label} {r : State → State → Prop} (h : lts.IsSWBisimulation r) : + lts.IsWeakBisimulation r := Lts.isWeakBisimulation_iff_isSWBisimulation.2 h /-- If two states are related by an `SWBisimulation`, then they are weakly bisimilar. -/ theorem WeakBisimilarity.by_swBisimulation [HasTau Label] (lts : Lts State Label) (r : State → State → Prop) - (hb : SWBisimulation lts r) (hr : r s1 s2) : s1 ≈[lts] s2 := by + (hb : lts.IsSWBisimulation r) (hr : r s1 s2) : s1 ≈[lts] s2 := by exists r constructor · exact hr - apply (WeakBisimulation.iff_swBisimulation lts r).2 hb + apply Lts.isWeakBisimulation_iff_isSWBisimulation.2 hb /-- Weak bisimilarity and sw-bisimilarity coincide for all Ltss. -/ +@[grind _=_] theorem WeakBisimilarity.weakBisim_eq_swBisim [HasTau Label] (lts : Lts State Label) : WeakBisimilarity lts = SWBisimilarity lts := by funext s1 s2 @@ -1010,21 +953,21 @@ theorem WeakBisimilarity.weakBisim_eq_swBisim [HasTau Label] (lts : Lts State La exists r constructor · exact hr - apply (WeakBisimulation.iff_swBisimulation lts r).1 hrh + apply Lts.isWeakBisimulation_iff_isSWBisimulation.1 hrh case mpr => intro h obtain ⟨r, hr, hrh⟩ := h exists r constructor · exact hr - apply (WeakBisimulation.iff_swBisimulation lts r).2 hrh + apply Lts.isWeakBisimulation_iff_isSWBisimulation.2 hrh /-- sw-bisimilarity is reflexive. -/ theorem SWBisimilarity.refl [HasTau Label] (lts : Lts State Label) (s : State) : s ≈sw[lts] s := by exists Eq constructor · rfl - simp only [SWBisimulation] + simp only [Lts.IsSWBisimulation] intro s1 s2 hr μ cases hr constructor @@ -1048,29 +991,29 @@ theorem WeakBisimilarity.refl [HasTau Label] (lts : Lts State Label) (s : State) /-- The inverse of an sw-bisimulation is an sw-bisimulation. -/ theorem SWBisimulation.inv [HasTau Label] (lts : Lts State Label) - (r : State → State → Prop) (h : SWBisimulation lts r) : - SWBisimulation lts (flip r) := by - simp only [SWBisimulation] at h - simp only [SWBisimulation] + (r : State → State → Prop) (h : lts.IsSWBisimulation r) : + lts.IsSWBisimulation (flip r) := by + simp only [Lts.IsSWBisimulation] at h + simp only [Lts.IsSWBisimulation] intro s1 s2 hrinv μ constructor case left => intro s1' htr - specialize h s2 s1 hrinv μ + specialize h hrinv μ have h' := h.2 s1' htr obtain ⟨ s2', h' ⟩ := h' exists s2' case right => intro s2' htr - specialize h s2 s1 hrinv μ + specialize h hrinv μ have h' := h.1 s2' htr obtain ⟨ s1', h' ⟩ := h' exists s1' /-- The inverse of a weak bisimulation is a weak bisimulation. -/ theorem WeakBisimulation.inv [HasTau Label] (lts : Lts State Label) - (r : State → State → Prop) (h : WeakBisimulation lts r) : - WeakBisimulation lts (flip r) := by + (r : State → State → Prop) (h : lts.IsWeakBisimulation r) : + lts.IsWeakBisimulation (flip r) := by apply WeakBisimulation.toSwBisimulation at h have h' := SWBisimulation.inv lts r h apply SWBisimulation.toWeakBisimulation at h' @@ -1099,20 +1042,20 @@ theorem WeakBisimilarity.symm [HasTau Label] (lts : Lts State Label) (h : s1 ≈ theorem WeakBisimulation.comp [HasTau Label] (lts : Lts State Label) - (r1 r2 : State → State → Prop) (h1 : WeakBisimulation lts r1) (h2 : WeakBisimulation lts r2) : - WeakBisimulation lts (Relation.Comp r1 r2) := by - simp_all only [WeakBisimulation] - exact Bisimulation.comp lts.saturate r1 r2 h1 h2 + (r1 r2 : State → State → Prop) (h1 : lts.IsWeakBisimulation r1) (h2 : lts.IsWeakBisimulation r2) : + lts.IsWeakBisimulation (Relation.Comp r1 r2) := by + simp_all only [Lts.IsWeakBisimulation] + exact Bisimulation.comp h1 h2 /-- The composition of two sw-bisimulations is an sw-bisimulation. -/ theorem SWBisimulation.comp [HasTau Label] (lts : Lts State Label) - (r1 r2 : State → State → Prop) (h1 : SWBisimulation lts r1) (h2 : SWBisimulation lts r2) : - SWBisimulation lts (Relation.Comp r1 r2) := by + (r1 r2 : State → State → Prop) (h1 : lts.IsSWBisimulation r1) (h2 : lts.IsSWBisimulation r2) : + lts.IsSWBisimulation (Relation.Comp r1 r2) := by apply SWBisimulation.toWeakBisimulation at h1 apply SWBisimulation.toWeakBisimulation at h2 - apply (WeakBisimulation.iff_swBisimulation lts (Relation.Comp r1 r2)).1 + apply Lts.isWeakBisimulation_iff_isSWBisimulation.1 apply WeakBisimulation.comp lts r1 r2 h1 h2 /-- Weak bisimilarity is transitive. -/ diff --git a/Cslib/Languages/CCS/BehaviouralTheory.lean b/Cslib/Languages/CCS/BehaviouralTheory.lean index c2ae6221..0d7d97cc 100644 --- a/Cslib/Languages/CCS/BehaviouralTheory.lean +++ b/Cslib/Languages/CCS/BehaviouralTheory.lean @@ -61,7 +61,7 @@ theorem bisimilarity_par_comm : (par p q) ~[lts (defs := defs)] (par q p) := by case left => constructor case right => - simp only [Bisimulation] + simp only [Lts.IsBisimulation] intro s1 s2 hr μ cases hr case parComm p q => @@ -154,7 +154,7 @@ private inductive ChoiceComm : (Process Name Constant) → (Process Name Constan theorem bisimilarity_choice_comm : (choice p q) ~[lts (defs := defs)] (choice q p) := by exists @ChoiceComm Name Constant defs repeat constructor - simp only [Bisimulation] + simp only [Lts.IsBisimulation] intro s1 s2 hr μ cases hr case choiceComm => @@ -174,24 +174,9 @@ theorem bisimilarity_choice_comm : (choice p q) ~[lts (defs := defs)] (choice q constructor · unfold lts cases htr with grind [Tr.choiceR, Tr.choiceL] - · constructor - grind [Bisimilarity.refl] + · grind [ChoiceComm] case bisim h => - constructor - case left => - intro s1' htr - have hb := Bisimulation.follow_fst (Bisimilarity.is_bisimulation lts) h htr - obtain ⟨s2', htr2, hr2⟩ := hb - exists s2' - apply And.intro htr2 - constructor; assumption - case right => - intro s2' htr - have hb := Bisimulation.follow_snd (Bisimilarity.is_bisimulation lts) h htr - obtain ⟨s1', htr1, hr1⟩ := hb - exists s1' - apply And.intro htr1 - constructor; assumption + grind [ChoiceComm] /-- P + (Q + R) ~ (P + Q) + R -/ proof_wanted bisimilarity_choice_assoc : @@ -208,7 +193,7 @@ theorem bisimilarity_congr_pre : exists @PreBisim _ _ defs constructor · constructor; assumption - simp only [Bisimulation] + simp only [Lts.IsBisimulation] intro s1 s2 hr μ' cases hr case pre => @@ -236,19 +221,19 @@ theorem bisimilarity_congr_pre : exists s2' apply And.intro htr2 constructor - apply Bisimilarity.largest_bisimulation _ hbisim hr2 + apply Bisimilarity.largest_bisimulation hbisim hr2 case right => intro s2' htr obtain ⟨r, hr, hb⟩ := hbis let hbisim := hb - specialize hb _ _ hr μ' + specialize hb hr μ' obtain ⟨hb1, hb2⟩ := hb specialize hb2 _ htr obtain ⟨s1', htr1, hr1⟩ := hb2 exists s1' apply And.intro htr1 constructor - apply Bisimilarity.largest_bisimulation _ hbisim hr1 + apply Bisimilarity.largest_bisimulation hbisim hr1 private inductive ResBisim : (Process Name Constant) → (Process Name Constant) → Prop where | res : (p ~[lts (defs := defs)] q) → ResBisim (res a p) (res a q) @@ -261,7 +246,7 @@ theorem bisimilarity_congr_res : exists @ResBisim _ _ defs constructor · constructor; assumption - simp only [Bisimulation] + simp only [Lts.IsBisimulation] intro s1 s2 hr μ' cases hr rename_i p q a h @@ -270,7 +255,7 @@ theorem bisimilarity_congr_res : intro s1' htr cases htr rename_i p' h1 h2 htr - have h := Bisimulation.follow_fst (Bisimilarity.is_bisimulation lts) h htr + have h := Bisimilarity.is_bisimulation.follow_fst h htr obtain ⟨q', htrq, h⟩ := h exists (res a q') constructor; constructor; repeat assumption @@ -279,7 +264,7 @@ theorem bisimilarity_congr_res : intro s2' htr cases htr rename_i q' h1 h2 htr - have h := Bisimulation.follow_snd (Bisimilarity.is_bisimulation lts) h htr + have h := Bisimilarity.is_bisimulation.follow_snd h htr obtain ⟨p', htrq, h⟩ := h exists (res a p') constructor; constructor; repeat assumption @@ -296,7 +281,7 @@ theorem bisimilarity_congr_choice : exists @ChoiceBisim _ _ defs constructor · constructor; assumption - simp only [Bisimulation] + simp only [Lts.IsBisimulation] intro s1 s2 r μ constructor case left => @@ -311,7 +296,7 @@ theorem bisimilarity_congr_choice : constructor · apply Tr.choiceL htr2 · constructor - apply Bisimilarity.largest_bisimulation _ hb hr2 + apply Bisimilarity.largest_bisimulation hb hr2 case choiceR a b c htr => exists s1' constructor @@ -325,7 +310,7 @@ theorem bisimilarity_congr_choice : constructor · assumption constructor - apply Bisimilarity.largest_bisimulation _ hb hr2 + apply Bisimilarity.largest_bisimulation hb hr2 case right => intro s2' htr cases r @@ -338,7 +323,7 @@ theorem bisimilarity_congr_choice : constructor · apply Tr.choiceL htr1 · constructor - apply Bisimilarity.largest_bisimulation _ hb hr1 + apply Bisimilarity.largest_bisimulation hb hr1 case choiceR a b c htr => exists s2' constructor @@ -352,7 +337,7 @@ theorem bisimilarity_congr_choice : constructor · assumption · constructor - apply Bisimilarity.largest_bisimulation _ hb hr1 + apply Bisimilarity.largest_bisimulation hb hr1 private inductive ParBisim : (Process Name Constant) → (Process Name Constant) → Prop where | par : (p ~[lts (defs := defs)] q) → ParBisim (par p r) (par q r) @@ -364,7 +349,7 @@ theorem bisimilarity_congr_par : exists @ParBisim _ _ defs constructor · constructor; assumption - simp only [Bisimulation] + simp only [Lts.IsBisimulation] intro s1 s2 r μ constructor case left => @@ -379,20 +364,20 @@ theorem bisimilarity_congr_par : constructor · apply Tr.parL htr2 · constructor - apply Bisimilarity.largest_bisimulation _ hb hr2 + apply Bisimilarity.largest_bisimulation hb hr2 case parR _ _ r' htr => exists (par q r') constructor · apply Tr.parR htr · constructor - apply Bisimilarity.largest_bisimulation _ hb hr + apply Bisimilarity.largest_bisimulation hb hr case com μ' p' r' htrp htrr => obtain ⟨q', htr2, hr2⟩ := hb.follow_fst hr htrp exists (par q' r') constructor · apply Tr.com htr2 htrr · constructor - apply Bisimilarity.largest_bisimulation _ hb hr2 + apply Bisimilarity.largest_bisimulation hb hr2 case right => intro s2' htr cases r @@ -405,20 +390,20 @@ theorem bisimilarity_congr_par : constructor · apply Tr.parL htr2 · constructor - apply Bisimilarity.largest_bisimulation _ hb hr2 + apply Bisimilarity.largest_bisimulation hb hr2 case parR _ _ r' htr => exists (par p r') constructor · apply Tr.parR htr · constructor - apply Bisimilarity.largest_bisimulation _ hb hr + apply Bisimilarity.largest_bisimulation hb hr case com μ' p' r' htrq htrr => obtain ⟨q', htr2, hr2⟩ := hb.follow_snd hr htrq exists (par q' r') constructor · apply Tr.com htr2 htrr · constructor - apply Bisimilarity.largest_bisimulation _ hb hr2 + apply Bisimilarity.largest_bisimulation hb hr2 /-- Bisimilarity is a congruence in CCS. -/ theorem bisimilarity_congr From 009def29ca063bb0726774a3e4966fa9fdaef80e Mon Sep 17 00:00:00 2001 From: Fabrizio Montesi Date: Mon, 8 Sep 2025 10:47:26 +0200 Subject: [PATCH 087/107] Better support for dot-notation in IsBisimulation --- .../Semantics/Lts/Bisimulation.lean | 23 +++++++++---------- 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/Cslib/Foundations/Semantics/Lts/Bisimulation.lean b/Cslib/Foundations/Semantics/Lts/Bisimulation.lean index 2067fc2f..393818a5 100644 --- a/Cslib/Foundations/Semantics/Lts/Bisimulation.lean +++ b/Cslib/Foundations/Semantics/Lts/Bisimulation.lean @@ -50,13 +50,13 @@ related by some sw-bisimulation on `lts`. ## Main statements -- `Bisimulation.inv`: the inverse of a bisimulation is a bisimulation. +- `Lts.IsBisimulation.inv`: the inverse of a bisimulation is a bisimulation. - `Bisimilarity.eqv`: bisimilarity is an equivalence relation (see `Equivalence`). -- `Bisimilarity.is_bisimulation`: bisimilarity is itself a bisimulation. +- `Bisimilarity.isBisimulation`: bisimilarity is itself a bisimulation. - `Bisimilarity.largest_bisimulation`: bisimilarity is the largest bisimulation. - `Bisimilarity.gfp`: the union of bisimilarity and any bisimulation is equal to bisimilarity. -- `Bisimulation.upTo_bisimulation`: any bisimulation up to bisimilarity is a bisimulation. -- `Bisimulation.bisim_traceEq`: any bisimulation that relates two states implies that they are +- `Lts.IsBisimulationUpTo.isBisimulation`: any bisimulation up to bisimilarity is a bisimulation. +- `Lts.IsBisimulation.traceEq`: any bisimulation that relates two states implies that they are trace equivalent (see `TraceEq`). - `Bisimilarity.deterministic_bisim_eq_traceEq`: in a deterministic Lts, bisimilarity and trace equivalence coincide. @@ -129,7 +129,7 @@ theorem Bisimilarity.refl (s : State) : s ~[lts] s := by /-- The inverse of a bisimulation is a bisimulation. -/ @[grind] -theorem Bisimulation.inv (h : lts.IsBisimulation r) : +theorem Lts.IsBisimulation.inv (h : lts.IsBisimulation r) : lts.IsBisimulation (flip r) := by grind [flip] /-- Bisimilarity is symmetric. -/ @@ -141,7 +141,7 @@ theorem Bisimilarity.symm {s1 s2 : State} (h : s1 ~[lts] s2) : s2 ~[lts] s1 := b /-- The composition of two bisimulations is a bisimulation. -/ @[grind] -theorem Bisimulation.comp +theorem Lts.IsBisimulation.comp (h1 : lts.IsBisimulation r1) (h2 : lts.IsBisimulation r2) : lts.IsBisimulation (Relation.Comp r1 r2) := by grind [Relation.Comp] @@ -304,7 +304,7 @@ def Lts.IsBisimulationUpTo (lts : Lts State Label) (r : State → State → Prop /-- Any bisimulation up to bisimilarity is a bisimulation. -/ @[grind] -theorem Bisimulation.upTo_bisimulation (h : lts.IsBisimulationUpTo r) : +theorem Lts.IsBisimulationUpTo.isBisimulation (h : lts.IsBisimulationUpTo r) : lts.IsBisimulation (Relation.UpTo r (Bisimilarity lts)) := by intro s1 s2 hr μ rcases hr with ⟨s1b, hr1b, s2b, hrb, hr2b⟩ @@ -389,7 +389,7 @@ theorem Bisimulation.bisim_trace /-- Any bisimulation implies trace equivalence. -/ @[grind] -theorem Bisimulation.bisim_traceEq +theorem Lts.IsBisimulation.traceEq (hb : lts.IsBisimulation r) (hr : r s1 s2) : s1 ~tr[lts] s2 := by funext μs @@ -404,8 +404,7 @@ theorem Bisimulation.bisim_traceEq case mpr => intro h obtain ⟨s2', h⟩ := h - have hinv := @Bisimulation.inv State Label lts r hb - obtain ⟨s1', hmtr⟩ := Bisimulation.bisim_trace hinv hr μs s2' h + obtain ⟨s1', hmtr⟩ := Bisimulation.bisim_trace hb.inv hr μs s2' h exists s1' exact hmtr.1 @@ -414,7 +413,7 @@ theorem Bisimulation.bisim_traceEq theorem Bisimilarity.le_traceEq : Bisimilarity lts ≤ TraceEq lts := by intro s1 s2 h obtain ⟨r, hr, hb⟩ := h - apply Bisimulation.bisim_traceEq hb hr + apply hb.traceEq hr /- One of the standard motivating examples for bisimulation: `1` and `5` are trace equivalent, but not bisimilar. -/ @@ -1045,7 +1044,7 @@ theorem WeakBisimulation.comp (r1 r2 : State → State → Prop) (h1 : lts.IsWeakBisimulation r1) (h2 : lts.IsWeakBisimulation r2) : lts.IsWeakBisimulation (Relation.Comp r1 r2) := by simp_all only [Lts.IsWeakBisimulation] - exact Bisimulation.comp h1 h2 + exact h1.comp h2 /-- The composition of two sw-bisimulations is an sw-bisimulation. -/ theorem SWBisimulation.comp From 7c9a1ba7b96e51a52fde0b8f4a5d452d4a958a75 Mon Sep 17 00:00:00 2001 From: twwar Date: Tue, 22 Jul 2025 10:56:30 +0200 Subject: [PATCH 088/107] reduction system attribute --- Cslib/Languages/CombinatoryLogic/Defs.lean | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Cslib/Languages/CombinatoryLogic/Defs.lean b/Cslib/Languages/CombinatoryLogic/Defs.lean index 34ffe6fb..5de242b4 100644 --- a/Cslib/Languages/CombinatoryLogic/Defs.lean +++ b/Cslib/Languages/CombinatoryLogic/Defs.lean @@ -6,7 +6,10 @@ Authors: Thomas Waring import Mathlib.Logic.Relation import Cslib.Utils.Relation import Cslib.Semantics.ReductionSystem.Basic +<<<<<<< HEAD import Cslib.Data.Relation +======= +>>>>>>> 9de7e5f (reduction system attribute) /-! # SKI Combinatory Logic @@ -84,6 +87,7 @@ inductive Red : SKI → SKI → Prop where open Red ReductionSystem +<<<<<<< HEAD lemma Red.ne {x y : SKI} : (x ⭢ y) → x ≠ y | red_S _ _ _, h => by cases h | red_K _ _, h => by cases h @@ -95,6 +99,12 @@ theorem MRed.S (x y z : SKI) : (S ⬝ x ⬝ y ⬝ z) ↠ (x ⬝ z ⬝ (y ⬝ z)) theorem MRed.K (x y : SKI) : (K ⬝ x ⬝ y) ↠ x := MRed.single RedSKI <| red_K .. theorem MRed.I (x : SKI) : (I ⬝ x) ↠ x := MRed.single RedSKI <| red_I .. +======= +theorem MRed.S (x y z : SKI) : (S ⬝ x ⬝ y ⬝ z) ↠ (x ⬝ z ⬝ (y ⬝ z)) := MRed.single RedSKI <| red_S .. +theorem MRed.K (x y : SKI) : (K ⬝ x ⬝ y) ↠ x := MRed.single RedSKI <| red_K .. +theorem MRed.I (x : SKI) : (I ⬝ x) ↠ x := MRed.single RedSKI <| red_I .. + +>>>>>>> 9de7e5f (reduction system attribute) theorem MRed.head {a a' : SKI} (b : SKI) (h : a ↠ a') : (a ⬝ b) ↠ (a' ⬝ b) := by induction h with | refl => apply MRed.refl From 75ad098496c0385ac9eeee9301b80eaf21936ea4 Mon Sep 17 00:00:00 2001 From: twwar Date: Tue, 22 Jul 2025 12:58:25 +0200 Subject: [PATCH 089/107] evaluation results --- Cslib/Languages/CombinatoryLogic/Defs.lean | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Defs.lean b/Cslib/Languages/CombinatoryLogic/Defs.lean index 5de242b4..fe744dd2 100644 --- a/Cslib/Languages/CombinatoryLogic/Defs.lean +++ b/Cslib/Languages/CombinatoryLogic/Defs.lean @@ -6,10 +6,7 @@ Authors: Thomas Waring import Mathlib.Logic.Relation import Cslib.Utils.Relation import Cslib.Semantics.ReductionSystem.Basic -<<<<<<< HEAD import Cslib.Data.Relation -======= ->>>>>>> 9de7e5f (reduction system attribute) /-! # SKI Combinatory Logic @@ -88,6 +85,9 @@ inductive Red : SKI → SKI → Prop where open Red ReductionSystem <<<<<<< HEAD +<<<<<<< HEAD +======= +>>>>>>> 9625db3 (evaluation results) lemma Red.ne {x y : SKI} : (x ⭢ y) → x ≠ y | red_S _ _ _, h => by cases h | red_K _ _, h => by cases h From 8b32be65438f41230b621d6e0ec11f576936225f Mon Sep 17 00:00:00 2001 From: twwar Date: Mon, 8 Sep 2025 11:54:13 +0200 Subject: [PATCH 090/107] fix imports, build --- Cslib/Languages/CombinatoryLogic/Basic.lean | 42 +++++++++---------- .../CombinatoryLogic/Evaluation.lean | 22 +++++----- .../Languages/CombinatoryLogic/Recursion.lean | 34 ++++++++------- 3 files changed, 50 insertions(+), 48 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Basic.lean b/Cslib/Languages/CombinatoryLogic/Basic.lean index 4dc3b2cb..2e7212f2 100644 --- a/Cslib/Languages/CombinatoryLogic/Basic.lean +++ b/Cslib/Languages/CombinatoryLogic/Basic.lean @@ -83,7 +83,7 @@ for the inner variables. -/ theorem Polynomial.elimVar_correct {n : Nat} (Γ : SKI.Polynomial (n + 1)) {ys : List SKI} (hys : ys.length = n) (z : SKI) : - Γ.elimVar.eval ys hys ⬝ z ↠ Γ.eval (ys ++ [z]) + (Γ.elimVar.eval ys hys ⬝ z) ↠ Γ.eval (ys ++ [z]) (by rw [List.length_append, hys, List.length_singleton]) := by match n, Γ with @@ -165,7 +165,7 @@ choose a descriptive name. def RPoly : SKI.Polynomial 2 := &1 ⬝' &0 /-- A SKI term representing R -/ def R : SKI := RPoly.toSKI -theorem R_def (x y : SKI) : R ⬝ x ⬝ y ↠ y ⬝ x := +theorem R_def (x y : SKI) : (R ⬝ x ⬝ y) ↠ y ⬝ x := RPoly.toSKI_correct [x, y] (by simp) @@ -173,7 +173,7 @@ theorem R_def (x y : SKI) : R ⬝ x ⬝ y ↠ y ⬝ x := def BPoly : SKI.Polynomial 3 := &0 ⬝' (&1 ⬝' &2) /-- A SKI term representing B -/ def B : SKI := BPoly.toSKI -theorem B_def (f g x : SKI) : B ⬝ f ⬝ g ⬝ x ↠ f ⬝ (g ⬝ x) := +theorem B_def (f g x : SKI) : (B ⬝ f ⬝ g ⬝ x) ↠ f ⬝ (g ⬝ x) := BPoly.toSKI_correct [f, g, x] (by simp) @@ -181,7 +181,7 @@ theorem B_def (f g x : SKI) : B ⬝ f ⬝ g ⬝ x ↠ f ⬝ (g ⬝ x) := def CPoly : SKI.Polynomial 3 := &0 ⬝' &2 ⬝' &1 /-- A SKI term representing C -/ def C : SKI := CPoly.toSKI -theorem C_def (f x y : SKI) : C ⬝ f ⬝ x ⬝ y ↠ f ⬝ y ⬝ x := +theorem C_def (f x y : SKI) : (C ⬝ f ⬝ x ⬝ y) ↠ f ⬝ y ⬝ x := CPoly.toSKI_correct [f, x, y] (by simp) @@ -189,7 +189,7 @@ theorem C_def (f x y : SKI) : C ⬝ f ⬝ x ⬝ y ↠ f ⬝ y ⬝ x := def RotRPoly : SKI.Polynomial 3 := &2 ⬝' &0 ⬝' &1 /-- A SKI term representing RotR -/ def RotR : SKI := RotRPoly.toSKI -theorem rotR_def (x y z : SKI) : RotR ⬝ x ⬝ y ⬝ z ↠ z ⬝ x ⬝ y := +theorem rotR_def (x y z : SKI) : (RotR ⬝ x ⬝ y ⬝ z) ↠ z ⬝ x ⬝ y := RotRPoly.toSKI_correct [x, y, z] (by simp) @@ -197,7 +197,7 @@ theorem rotR_def (x y z : SKI) : RotR ⬝ x ⬝ y ⬝ z ↠ z ⬝ x ⬝ y := def RotLPoly : SKI.Polynomial 3 := &1 ⬝' &2 ⬝' &0 /-- A SKI term representing RotL -/ def RotL : SKI := RotLPoly.toSKI -theorem rotL_def (x y z : SKI) : RotL ⬝ x ⬝ y ⬝ z ↠ y ⬝ z ⬝ x := +theorem rotL_def (x y z : SKI) : (RotL ⬝ x ⬝ y ⬝ z) ↠ y ⬝ z ⬝ x := RotLPoly.toSKI_correct [x, y, z] (by simp) @@ -205,7 +205,7 @@ theorem rotL_def (x y z : SKI) : RotL ⬝ x ⬝ y ⬝ z ↠ y ⬝ z ⬝ x := def δPoly : SKI.Polynomial 1 := &0 ⬝' &0 /-- A SKI term representing δ -/ def δ : SKI := δPoly.toSKI -theorem δ_def (x : SKI) : δ ⬝ x ↠ x ⬝ x := +theorem δ_def (x : SKI) : (δ ⬝ x) ↠ x ⬝ x := δPoly.toSKI_correct [x] (by simp) @@ -213,7 +213,7 @@ theorem δ_def (x : SKI) : δ ⬝ x ↠ x ⬝ x := def HPoly : SKI.Polynomial 2 := &0 ⬝' (&1 ⬝' &1) /-- A SKI term representing H -/ def H : SKI := HPoly.toSKI -theorem H_def (f x : SKI) : H ⬝ f ⬝ x ↠ f ⬝ (x ⬝ x) := +theorem H_def (f x : SKI) : (H ⬝ f ⬝ x) ↠ f ⬝ (x ⬝ x) := HPoly.toSKI_correct [f, x] (by simp) @@ -221,7 +221,7 @@ theorem H_def (f x : SKI) : H ⬝ f ⬝ x ↠ f ⬝ (x ⬝ x) := def YPoly : SKI.Polynomial 1 := H ⬝' &0 ⬝' (H ⬝' &0) /-- A SKI term representing Y -/ def Y : SKI := YPoly.toSKI -theorem Y_def (f : SKI) : Y ⬝ f ↠ H ⬝ f ⬝ (H ⬝ f) := +theorem Y_def (f : SKI) : (Y ⬝ f) ↠ H ⬝ f ⬝ (H ⬝ f) := YPoly.toSKI_correct [f] (by simp) @@ -245,21 +245,21 @@ theorem fixedPoint_correct (f : SKI) : f.fixedPoint ↠ f ⬝ f.fixedPoint := H_ def ΘAuxPoly : SKI.Polynomial 2 := &1 ⬝' (&0 ⬝' &0 ⬝' &1) /-- A term representing ΘAux -/ def ΘAux : SKI := ΘAuxPoly.toSKI -theorem ΘAux_def (x y : SKI) : ΘAux ⬝ x ⬝ y ↠ y ⬝ (x ⬝ x ⬝ y) := +theorem ΘAux_def (x y : SKI) : (ΘAux ⬝ x ⬝ y) ↠ y ⬝ (x ⬝ x ⬝ y) := ΘAuxPoly.toSKI_correct [x, y] (by simp) /-- Turing's fixed-point combinator: Θ := (λ x y. y (x x y)) (λ x y. y (x x y)) -/ def Θ : SKI := ΘAux ⬝ ΘAux /-- A SKI term representing Θ -/ -theorem Θ_correct (f : SKI) : Θ ⬝ f ↠ f ⬝ (Θ ⬝ f) := ΘAux_def ΘAux f +theorem Θ_correct (f : SKI) : (Θ ⬝ f) ↠ f ⬝ (Θ ⬝ f) := ΘAux_def ΘAux f /-! ### Church Booleans -/ /-- A term a represents the boolean value u if it is βη-equivalent to a standard Church boolean. -/ def IsBool (u : Bool) (a : SKI) : Prop := - ∀ x y : SKI, a ⬝ x ⬝ y ↠ (if u then x else y) + ∀ x y : SKI, (a ⬝ x ⬝ y) ↠ (if u then x else y) theorem isBool_trans (u : Bool) (a a' : SKI) (h : a ↠ a') (ha' : IsBool u a') : IsBool u a := by @@ -278,13 +278,13 @@ theorem TT_correct : IsBool true TT := fun x y ↦ MRed.K x y def FF : SKI := K ⬝ I theorem FF_correct : IsBool false FF := fun x y ↦ calc - FF ⬝ x ⬝ y ⭢ I ⬝ y := by apply red_head; exact red_K I x + (FF ⬝ x ⬝ y) ↠ I ⬝ y := by apply Relation.ReflTransGen.single; apply red_head; exact red_K I x _ ⭢ y := red_I y /-- Conditional: Cond x y b := if b then x else y -/ protected def Cond : SKI := RotR theorem cond_correct (a x y : SKI) (u : Bool) (h : IsBool u a) : - SKI.Cond ⬝ x ⬝ y ⬝ a ↠ if u then x else y := by + (SKI.Cond ⬝ x ⬝ y ⬝ a) ↠ if u then x else y := by trans a ⬝ x ⬝ y · exact rotR_def x y a · exact h x y @@ -302,7 +302,7 @@ theorem neg_correct (a : SKI) (ua : Bool) (h : IsBool ua a) : IsBool (¬ ua) (SK def AndPoly : SKI.Polynomial 2 := SKI.Cond ⬝' (SKI.Cond ⬝ TT ⬝ FF ⬝' &1) ⬝' FF ⬝' &0 /-- A SKI term representing And -/ protected def And : SKI := AndPoly.toSKI -theorem and_def (a b : SKI) : SKI.And ⬝ a ⬝ b ↠ SKI.Cond ⬝ (SKI.Cond ⬝ TT ⬝ FF ⬝ b) ⬝ FF ⬝ a := +theorem and_def (a b : SKI) : (SKI.And ⬝ a ⬝ b) ↠ SKI.Cond ⬝ (SKI.Cond ⬝ TT ⬝ FF ⬝ b) ⬝ FF ⬝ a := AndPoly.toSKI_correct [a, b] (by simp) theorem and_correct (a b : SKI) (ua ub : Bool) (ha : IsBool ua a) (hb : IsBool ub b) : @@ -321,7 +321,7 @@ theorem and_correct (a b : SKI) (ua ub : Bool) (ha : IsBool ua a) (hb : IsBool u def OrPoly : SKI.Polynomial 2 := SKI.Cond ⬝' TT ⬝' (SKI.Cond ⬝ TT ⬝ FF ⬝' &1) ⬝' &0 /-- A SKI term representing Or -/ protected def Or : SKI := OrPoly.toSKI -theorem or_def (a b : SKI) : SKI.Or ⬝ a ⬝ b ↠ SKI.Cond ⬝ TT ⬝ (SKI.Cond ⬝ TT ⬝ FF ⬝ b) ⬝ a := +theorem or_def (a b : SKI) : (SKI.Or ⬝ a ⬝ b) ↠ SKI.Cond ⬝ TT ⬝ (SKI.Cond ⬝ TT ⬝ FF ⬝ b) ⬝ a := OrPoly.toSKI_correct [a, b] (by simp) theorem or_correct (a b : SKI) (ua ub : Bool) (ha : IsBool ua a) (hb : IsBool ub b) : @@ -350,11 +350,11 @@ def Fst : SKI := R ⬝ TT /-- Second projection -/ def Snd : SKI := R ⬝ FF -theorem fst_correct (a b : SKI) : Fst ⬝ (MkPair ⬝ a ⬝ b) ↠ a := by calc +theorem fst_correct (a b : SKI) : (Fst ⬝ (MkPair ⬝ a ⬝ b)) ↠ a := by calc _ ↠ SKI.Cond ⬝ a ⬝ b ⬝ TT := R_def _ _ _ ↠ a := cond_correct TT a b true TT_correct -theorem snd_correct (a b : SKI) : Snd ⬝ (MkPair ⬝ a ⬝ b) ↠ b := by calc +theorem snd_correct (a b : SKI) : (Snd ⬝ (MkPair ⬝ a ⬝ b)) ↠ b := by calc _ ↠ SKI.Cond ⬝ a ⬝ b ⬝ FF := R_def _ _ _ ↠ b := cond_correct FF a b false FF_correct @@ -362,10 +362,10 @@ theorem snd_correct (a b : SKI) : Snd ⬝ (MkPair ⬝ a ⬝ b) ↠ b := by calc def UnpairedPoly : SKI.Polynomial 2 := &0 ⬝' (Fst ⬝' &1) ⬝' (Snd ⬝' &1) /-- A term representing Unpaired -/ protected def Unpaired : SKI := UnpairedPoly.toSKI -theorem unpaired_def (f p : SKI) : SKI.Unpaired ⬝ f ⬝ p ↠ f ⬝ (Fst ⬝ p) ⬝ (Snd ⬝ p) := +theorem unpaired_def (f p : SKI) : (SKI.Unpaired ⬝ f ⬝ p) ↠ f ⬝ (Fst ⬝ p) ⬝ (Snd ⬝ p) := UnpairedPoly.toSKI_correct [f, p] (by simp) -theorem unpaired_correct (f x y : SKI) : SKI.Unpaired ⬝ f ⬝ (MkPair ⬝ x ⬝ y) ↠ f ⬝ x ⬝ y := by +theorem unpaired_correct (f x y : SKI) : (SKI.Unpaired ⬝ f ⬝ (MkPair ⬝ x ⬝ y)) ↠ f ⬝ x ⬝ y := by trans f ⬝ (Fst ⬝ (MkPair ⬝ x ⬝ y)) ⬝ (Snd ⬝ (MkPair ⬝ x ⬝ y)) · exact unpaired_def f _ · apply parallel_mRed @@ -377,7 +377,7 @@ theorem unpaired_correct (f x y : SKI) : SKI.Unpaired ⬝ f ⬝ (MkPair ⬝ x def PairPoly : SKI.Polynomial 3 := MkPair ⬝' (&0 ⬝' &2) ⬝' (&1 ⬝' &2) /-- A SKI term representing Pair -/ protected def Pair : SKI := PairPoly.toSKI -theorem pair_def (f g x : SKI) : SKI.Pair ⬝ f ⬝ g ⬝ x ↠ MkPair ⬝ (f ⬝ x) ⬝ (g ⬝ x) := +theorem pair_def (f g x : SKI) : (SKI.Pair ⬝ f ⬝ g ⬝ x) ↠ MkPair ⬝ (f ⬝ x) ⬝ (g ⬝ x) := PairPoly.toSKI_correct [f, g, x] (by simp) end SKI diff --git a/Cslib/Languages/CombinatoryLogic/Evaluation.lean b/Cslib/Languages/CombinatoryLogic/Evaluation.lean index 3c326390..c35e9981 100644 --- a/Cslib/Languages/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Languages/CombinatoryLogic/Evaluation.lean @@ -3,10 +3,10 @@ Copyright (c) 2025 Thomas Waring. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Waring -/ -import Cslib.Computability.CombinatoryLogic.Defs -import Cslib.Computability.CombinatoryLogic.Basic -import Cslib.Computability.CombinatoryLogic.Confluence -import Cslib.Computability.CombinatoryLogic.Recursion +import Cslib.Languages.CombinatoryLogic.Defs +import Cslib.Languages.CombinatoryLogic.Basic +import Cslib.Languages.CombinatoryLogic.Confluence +import Cslib.Languages.CombinatoryLogic.Recursion import Mathlib.Tactic.Common /-! @@ -278,17 +278,17 @@ theorem isChurch_injective (x y : SKI) (n m : Nat) (hx : IsChurch n x) (hy : IsC exact commonReduct_of_single (hy K K) /-- **Rice's theorem**: no SKI term is a non-trivial predicate. -/ -theorem rice {P : SKI} (hP : ∀ x : SKI, (P ⬝ x ↠ TT) ∨ P ⬝ x ↠ FF) - (hxt : ∃ x : SKI, P ⬝ x ↠ TT) (hxf : ∃ x : SKI, P ⬝ x ↠ FF) : False := by +theorem rice {P : SKI} (hP : ∀ x : SKI, ((P ⬝ x) ↠ TT) ∨ (P ⬝ x) ↠ FF) + (hxt : ∃ x : SKI, (P ⬝ x) ↠ TT) (hxf : ∃ x : SKI, (P ⬝ x) ↠ FF) : False := by obtain ⟨a, ha⟩ := hxt obtain ⟨b, hb⟩ := hxf let Neg : SKI := P ⬝' &0 ⬝' b ⬝' a |>.toSKI (n := 1) let Abs : SKI := Neg.fixedPoint - have Neg_app : ∀ x : SKI, Neg ⬝ x ↠ P ⬝ x ⬝ b ⬝ a := + have Neg_app : ∀ x : SKI, (Neg ⬝ x) ↠ P ⬝ x ⬝ b ⬝ a := fun x => (P ⬝' &0 ⬝' b ⬝' a) |>.toSKI_correct (n := 1) [x] (by simp) cases hP Abs case inl h => - have : P ⬝ Abs ↠ FF := calc + have : (P ⬝ Abs) ↠ FF := calc _ ↠ P ⬝ (Neg ⬝ Abs) := by apply MRed.tail; apply fixedPoint_correct _ ↠ P ⬝ (P ⬝ Abs ⬝ b ⬝ a) := by apply MRed.tail; apply Neg_app _ ↠ P ⬝ (TT ⬝ b ⬝ a) := by apply MRed.tail; apply MRed.head; apply MRed.head; exact h @@ -296,7 +296,7 @@ theorem rice {P : SKI} (hP : ∀ x : SKI, (P ⬝ x ↠ TT) ∨ P ⬝ x ↠ FF) _ ↠ FF := hb exact TF_nequiv <| MRed.diamond _ _ _ h this case inr h => - have : P ⬝ Abs ↠ TT := calc + have : (P ⬝ Abs) ↠ TT := calc _ ↠ P ⬝ (Neg ⬝ Abs) := by apply MRed.tail; apply fixedPoint_correct _ ↠ P ⬝ (P ⬝ Abs ⬝ b ⬝ a) := by apply MRed.tail; apply Neg_app _ ↠ P ⬝ (FF ⬝ b ⬝ a) := by apply MRed.tail; apply MRed.head; apply MRed.head; exact h @@ -305,8 +305,8 @@ theorem rice {P : SKI} (hP : ∀ x : SKI, (P ⬝ x ↠ TT) ∨ P ⬝ x ↠ FF) exact TF_nequiv <| MRed.diamond _ _ _ this h /-- **Rice's theorem**: any SKI predicate is trivial. -/ -theorem rice' {P : SKI} (hP : ∀ x : SKI, (P ⬝ x ↠ TT) ∨ P ⬝ x ↠ FF) : - (∀ x : SKI, P ⬝ x ↠ TT) ∨ (∀ x : SKI, P ⬝ x ↠ FF) := by +theorem rice' {P : SKI} (hP : ∀ x : SKI, ((P ⬝ x) ↠ TT) ∨ (P ⬝ x) ↠ FF) : + (∀ x : SKI, (P ⬝ x) ↠ TT) ∨ (∀ x : SKI, (P ⬝ x) ↠ FF) := by by_contra! h obtain ⟨⟨a, ha⟩, b, hb⟩ := h exact rice hP ⟨b, (hP _).resolve_right hb⟩ ⟨a, (hP _).resolve_left ha⟩ diff --git a/Cslib/Languages/CombinatoryLogic/Recursion.lean b/Cslib/Languages/CombinatoryLogic/Recursion.lean index bbe5f533..154cdf98 100644 --- a/Cslib/Languages/CombinatoryLogic/Recursion.lean +++ b/Cslib/Languages/CombinatoryLogic/Recursion.lean @@ -65,7 +65,8 @@ lemma church_red (n : Nat) (f f' x x' : SKI) (hf : f ↠ f') (hx : x ↠ x') : | succ n ih => exact parallel_mRed hf ih /-- The term `a` is βη-equivalent to a standard church numeral. -/ -def IsChurch (n : Nat) (a : SKI) : Prop := ∀ f x : SKI, a ⬝ f ⬝ x ↠ Church n f x +def IsChurch (n : Nat) (a : SKI) : Prop := + ∀ f x :SKI, (a ⬝ f ⬝ x) ↠ (Church n f x) /-- To show `IsChurch n a` it suffices to show the same for a reduct of `a`. -/ theorem isChurch_trans (n : Nat) {a a' : SKI} (h : a ↠ a') : IsChurch n a' → IsChurch n a := by @@ -84,7 +85,7 @@ theorem zero_correct : IsChurch 0 SKI.Zero := by unfold IsChurch SKI.Zero Church intro f x calc - _ ⭢ I ⬝ x := by apply red_head; apply red_K + _ ↠ I ⬝ x := by apply Relation.ReflTransGen.single; apply red_head; apply red_K _ ⭢ x := by apply red_I /-- Church one := λ f x. f x -/ @@ -110,7 +111,7 @@ the first component. def PredAuxPoly : SKI.Polynomial 1 := MkPair ⬝' (Snd ⬝' &0) ⬝' (SKI.Succ ⬝' (Snd ⬝' &0)) /-- A term representing PredAux -/ def PredAux : SKI := PredAuxPoly.toSKI -theorem predAux_def (p : SKI) : PredAux ⬝ p ↠ MkPair ⬝ (Snd ⬝ p) ⬝ (SKI.Succ ⬝ (Snd ⬝ p)) := +theorem predAux_def (p : SKI) : (PredAux ⬝ p) ↠ MkPair ⬝ (Snd ⬝ p) ⬝ (SKI.Succ ⬝ (Snd ⬝ p)) := PredAuxPoly.toSKI_correct [p] (by simp) /-- Useful auxiliary definition expressing that `p` represents ns ∈ Nat × Nat. -/ @@ -155,7 +156,7 @@ theorem predAux_correct' (n : Nat) : def PredPoly : SKI.Polynomial 1 := Fst ⬝' (&0 ⬝' PredAux ⬝' (MkPair ⬝ SKI.Zero ⬝ SKI.Zero)) /-- A term representing Pred -/ def Pred : SKI := PredPoly.toSKI -theorem pred_def (a : SKI) : Pred ⬝ a ↠ Fst ⬝ (a ⬝ PredAux ⬝ (MkPair ⬝ SKI.Zero ⬝ SKI.Zero)) := +theorem pred_def (a : SKI) : (Pred ⬝ a) ↠ Fst ⬝ (a ⬝ PredAux ⬝ (MkPair ⬝ SKI.Zero ⬝ SKI.Zero)) := PredPoly.toSKI_correct [a] (by simp) theorem pred_correct (n : Nat) (a : SKI) (h : IsChurch n a) : IsChurch n.pred (Pred ⬝ a) := by @@ -173,7 +174,7 @@ theorem pred_correct (n : Nat) (a : SKI) (h : IsChurch n a) : IsChurch n.pred (P def IsZeroPoly : SKI.Polynomial 1 := &0 ⬝' (K ⬝ FF) ⬝' TT /-- A term representing IsZero -/ def IsZero : SKI := IsZeroPoly.toSKI -theorem isZero_def (a : SKI) : IsZero ⬝ a ↠ a ⬝ (K ⬝ FF) ⬝ TT := +theorem isZero_def (a : SKI) : (IsZero ⬝ a) ↠ a ⬝ (K ⬝ FF) ⬝ TT := IsZeroPoly.toSKI_correct [a] (by simp) theorem isZero_correct (n : Nat) (a : SKI) (h : IsChurch n a) : IsBool (n = 0) (IsZero ⬝ a) := by @@ -203,7 +204,8 @@ def RecAuxPoly : SKI.Polynomial 4 := /-- A term representing RecAux -/ def RecAux : SKI := RecAuxPoly.toSKI theorem recAux_def (R₀ x g a : SKI) : - RecAux ⬝ R₀ ⬝ x ⬝ g ⬝ a ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (R₀ ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := + (RecAux ⬝ R₀ ⬝ x ⬝ g ⬝ a) ↠ + SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (R₀ ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := RecAuxPoly.toSKI_correct [R₀, x, g, a] (by simp) /-- @@ -212,13 +214,13 @@ We define Rec so that -/ def Rec : SKI := fixedPoint RecAux theorem rec_def (x g a : SKI) : - Rec ⬝ x ⬝ g ⬝ a ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := calc + (Rec ⬝ x ⬝ g ⬝ a) ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := calc _ ↠ RecAux ⬝ Rec ⬝ x ⬝ g ⬝ a := by apply MRed.head; apply MRed.head; apply MRed.head apply fixedPoint_correct _ ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := recAux_def Rec x g a -theorem rec_zero (x g a : SKI) (ha : IsChurch 0 a) : Rec ⬝ x ⬝ g ⬝ a ↠ x := by +theorem rec_zero (x g a : SKI) (ha : IsChurch 0 a) : (Rec ⬝ x ⬝ g ⬝ a) ↠ x := by calc _ ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := rec_def _ _ _ _ ↠ if (Nat.beq 0 0) then x else (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) := by @@ -226,7 +228,7 @@ theorem rec_zero (x g a : SKI) (ha : IsChurch 0 a) : Rec ⬝ x ⬝ g ⬝ a ↠ x exact isZero_correct 0 a ha theorem rec_succ (n : Nat) (x g a : SKI) (ha : IsChurch (n+1) a) : - Rec ⬝ x ⬝ g ⬝ a ↠ g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a)) := by + (Rec ⬝ x ⬝ g ⬝ a) ↠ g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a)) := by calc _ ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := rec_def _ _ _ _ ↠ if (Nat.beq (n+1) 0) then x else (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) := by @@ -246,17 +248,17 @@ def RFindAboveAuxPoly : SKI.Polynomial 3 := /-- A term representing RFindAboveAux -/ def RFindAboveAux : SKI := RFindAboveAuxPoly.toSKI lemma rfindAboveAux_def (R₀ f a : SKI) : - RFindAboveAux ⬝ R₀ ⬝ a ⬝ f ↠ SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := + (RFindAboveAux ⬝ R₀ ⬝ a ⬝ f) ↠ SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := RFindAboveAuxPoly.toSKI_correct [R₀, a, f] (by trivial) theorem rfindAboveAux_base (R₀ f a : SKI) (hfa : IsChurch 0 (f ⬝ a)) : - RFindAboveAux ⬝ R₀ ⬝ a ⬝ f ↠ a := calc + (RFindAboveAux ⬝ R₀ ⬝ a ⬝ f) ↠ a := calc _ ↠ SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := rfindAboveAux_def _ _ _ _ ↠ if (Nat.beq 0 0) then a else (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) := by apply cond_correct apply isZero_correct _ _ hfa theorem rfindAboveAux_step (R₀ f a : SKI) {m : Nat} (hfa : IsChurch (m+1) (f ⬝ a)) : - RFindAboveAux ⬝ R₀ ⬝ a ⬝ f ↠ R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f := calc + (RFindAboveAux ⬝ R₀ ⬝ a ⬝ f) ↠ R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f := calc _ ↠ SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := rfindAboveAux_def _ _ _ _ ↠ if (Nat.beq (m+1) 0) then a else (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) := by apply cond_correct @@ -310,7 +312,7 @@ theorem RFind_correct (fNat : Nat → Nat) (f : SKI) def AddPoly : SKI.Polynomial 2 := &0 ⬝' SKI.Succ ⬝' &1 /-- A term representing addition on church numerals -/ protected def Add : SKI := AddPoly.toSKI -theorem add_def (a b : SKI) : SKI.Add ⬝ a ⬝ b ↠ a ⬝ SKI.Succ ⬝ b := +theorem add_def (a b : SKI) : (SKI.Add ⬝ a ⬝ b) ↠ a ⬝ SKI.Succ ⬝ b := AddPoly.toSKI_correct [a, b] (by simp) theorem add_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m b) : @@ -330,7 +332,7 @@ theorem add_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m def MulPoly : SKI.Polynomial 2 := &0 ⬝' (SKI.Add ⬝' &1) ⬝' SKI.Zero /-- A term representing multiplication on church numerals -/ protected def Mul : SKI := MulPoly.toSKI -theorem mul_def (a b : SKI) : SKI.Mul ⬝ a ⬝ b ↠ a ⬝ (SKI.Add ⬝ b) ⬝ SKI.Zero := +theorem mul_def (a b : SKI) : (SKI.Mul ⬝ a ⬝ b) ↠ a ⬝ (SKI.Add ⬝ b) ⬝ SKI.Zero := MulPoly.toSKI_correct [a, b] (by simp) theorem mul_correct {n m : Nat} {a b : SKI} (ha : IsChurch n a) (hb : IsChurch m b) : @@ -348,7 +350,7 @@ theorem mul_correct {n m : Nat} {a b : SKI} (ha : IsChurch n a) (hb : IsChurch m def SubPoly : SKI.Polynomial 2 := &1 ⬝' Pred ⬝' &0 /-- A term representing subtraction on church numerals -/ protected def Sub : SKI := SubPoly.toSKI -theorem sub_def (a b : SKI) : SKI.Sub ⬝ a ⬝ b ↠ b ⬝ Pred ⬝ a := +theorem sub_def (a b : SKI) : (SKI.Sub ⬝ a ⬝ b) ↠ b ⬝ Pred ⬝ a := SubPoly.toSKI_correct [a, b] (by simp) theorem sub_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m b) : @@ -368,7 +370,7 @@ theorem sub_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m def LEPoly : SKI.Polynomial 2 := IsZero ⬝' (SKI.Sub ⬝' &0 ⬝' &1) /-- A term representing comparison on church numerals -/ protected def LE : SKI := LEPoly.toSKI -theorem le_def (a b : SKI) : SKI.LE ⬝ a ⬝ b ↠ IsZero ⬝ (SKI.Sub ⬝ a ⬝ b) := +theorem le_def (a b : SKI) : (SKI.LE ⬝ a ⬝ b) ↠ IsZero ⬝ (SKI.Sub ⬝ a ⬝ b) := LEPoly.toSKI_correct [a, b] (by simp) theorem le_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m b) : From 8591e57a6c427cc2e354ac07058066914ea075f1 Mon Sep 17 00:00:00 2001 From: twwar Date: Mon, 8 Sep 2025 20:54:12 +0200 Subject: [PATCH 091/107] linting --- Cslib/Languages/CombinatoryLogic/Basic.lean | 2 +- .../CombinatoryLogic/Confluence.lean | 6 ++--- Cslib/Languages/CombinatoryLogic/Defs.lean | 22 ++++++------------- .../CombinatoryLogic/Evaluation.lean | 6 ++--- .../Languages/CombinatoryLogic/Recursion.lean | 14 ++++++------ 5 files changed, 21 insertions(+), 29 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Basic.lean b/Cslib/Languages/CombinatoryLogic/Basic.lean index 2e7212f2..837a6af4 100644 --- a/Cslib/Languages/CombinatoryLogic/Basic.lean +++ b/Cslib/Languages/CombinatoryLogic/Basic.lean @@ -261,7 +261,7 @@ theorem Θ_correct (f : SKI) : (Θ ⬝ f) ↠ f ⬝ (Θ ⬝ f) := ΘAux_def ΘAu def IsBool (u : Bool) (a : SKI) : Prop := ∀ x y : SKI, (a ⬝ x ⬝ y) ↠ (if u then x else y) -theorem isBool_trans (u : Bool) (a a' : SKI) (h : a ↠ a') (ha' : IsBool u a') : +theorem isBool_trans (u : Bool) (a a' : SKI) (h : a ↠a') (ha' : IsBool u a') : IsBool u a := by intro x y trans a' ⬝ x ⬝ y diff --git a/Cslib/Languages/CombinatoryLogic/Confluence.lean b/Cslib/Languages/CombinatoryLogic/Confluence.lean index d26e4cf9..e43c482d 100644 --- a/Cslib/Languages/CombinatoryLogic/Confluence.lean +++ b/Cslib/Languages/CombinatoryLogic/Confluence.lean @@ -68,7 +68,7 @@ theorem mRed_of_parallelReduction {a a' : SKI} (h : a ⇒ₚ a') : a ↠ a' := b case red_S a b c => exact Relation.ReflTransGen.single (red_S a b c) /-- The inclusion `⇒ ⊆ ⇒ₚ` -/ -theorem parallelReduction_of_red {a a' : SKI} (h : a ⭢ a') : a ⇒ₚ a' := by +theorem parallelReduction_of_red {a a' : SKI} (h : a ⭢a') : a ⇒ₚ a' := by cases h case red_S => apply ParallelReduction.red_S case red_K => apply ParallelReduction.red_K @@ -90,7 +90,7 @@ theorem reflTransGen_parallelReduction_mRed : ext a b constructor · apply Relation.reflTransGen_minimal - · exact λ _ => by rfl + · exact fun _ => by rfl · exact instTransitiveMRed RedSKI · exact @mRed_of_parallelReduction · apply Relation.reflTransGen_minimal @@ -234,7 +234,7 @@ theorem commonReduct_equivalence : Equivalence CommonReduct := by exact join_parallelReduction_equivalence /-- The **Church-Rosser** theorem in the form it is usually stated. -/ -theorem MRed.diamond (a b c : SKI) (hab : a ↠ b) (hac : a ↠ c) : CommonReduct b c := by +theorem MRed.diamond (a b c : SKI) (hab : a ↠b) (hac : a ↠c) : CommonReduct b c := by apply commonReduct_equivalence.trans (y := a) · exact commonReduct_equivalence.symm (commonReduct_of_single hab) · exact commonReduct_of_single hac diff --git a/Cslib/Languages/CombinatoryLogic/Defs.lean b/Cslib/Languages/CombinatoryLogic/Defs.lean index fe744dd2..57caed81 100644 --- a/Cslib/Languages/CombinatoryLogic/Defs.lean +++ b/Cslib/Languages/CombinatoryLogic/Defs.lean @@ -84,10 +84,6 @@ inductive Red : SKI → SKI → Prop where open Red ReductionSystem -<<<<<<< HEAD -<<<<<<< HEAD -======= ->>>>>>> 9625db3 (evaluation results) lemma Red.ne {x y : SKI} : (x ⭢ y) → x ≠ y | red_S _ _ _, h => by cases h | red_K _ _, h => by cases h @@ -99,12 +95,6 @@ theorem MRed.S (x y z : SKI) : (S ⬝ x ⬝ y ⬝ z) ↠ (x ⬝ z ⬝ (y ⬝ z)) theorem MRed.K (x y : SKI) : (K ⬝ x ⬝ y) ↠ x := MRed.single RedSKI <| red_K .. theorem MRed.I (x : SKI) : (I ⬝ x) ↠ x := MRed.single RedSKI <| red_I .. -======= -theorem MRed.S (x y z : SKI) : (S ⬝ x ⬝ y ⬝ z) ↠ (x ⬝ z ⬝ (y ⬝ z)) := MRed.single RedSKI <| red_S .. -theorem MRed.K (x y : SKI) : (K ⬝ x ⬝ y) ↠ x := MRed.single RedSKI <| red_K .. -theorem MRed.I (x : SKI) : (I ⬝ x) ↠ x := MRed.single RedSKI <| red_I .. - ->>>>>>> 9de7e5f (reduction system attribute) theorem MRed.head {a a' : SKI} (b : SKI) (h : a ↠ a') : (a ⬝ b) ↠ (a' ⬝ b) := by induction h with | refl => apply MRed.refl @@ -112,7 +102,7 @@ theorem MRed.head {a a' : SKI} (b : SKI) (h : a ↠ a') : (a ⬝ b) ↠ (a' ⬝ apply Relation.ReflTransGen.tail (b := a' ⬝ b) ih exact Red.red_head a' a'' b ha'' -theorem MRed.tail (a : SKI) {b b' : SKI} (h : b ↠ b') : (a ⬝ b) ↠ (a ⬝ b') := by +theorem MRed.tail (a : SKI) {b b' : SKI} (h : b ↠b') : (a ⬝ b) ↠ (a ⬝ b') := by induction h with | refl => apply MRed.refl | @tail b' b'' _ hb'' ih => @@ -134,11 +124,11 @@ theorem MRed.tail (a : SKI) {b b' : SKI} (h : b ↠ b') : (a ⬝ b) ↠ (a ⬝ b -- instance RedMRedTrans : Trans Red Red MRed := -- ⟨fun hab hbc => Relation.ReflTransGen.trans (MRed.single hab) (MRed.single hbc)⟩ -lemma parallel_mRed {a a' b b' : SKI} (ha : a ↠ a') (hb : b ↠ b') : +lemma parallel_mRed {a a' b b' : SKI} (ha : a ↠a') (hb : b ↠b') : (a ⬝ b) ↠ (a' ⬝ b') := Trans.simple (MRed.head b ha) (MRed.tail a' hb) -lemma parallel_red {a a' b b' : SKI} (ha : a ⭢ a') (hb : b ⭢ b') : (a ⬝ b) ↠ (a' ⬝ b') := by +lemma parallel_red {a a' b b' : SKI} (ha : a ⭢a') (hb : b ⭢b') : (a ⬝ b) ↠ (a' ⬝ b') := by trans a' ⬝ b all_goals apply MRed.single · exact Red.red_head a a' b ha @@ -148,10 +138,10 @@ lemma parallel_red {a a' b b' : SKI} (ha : a ⭢ a') (hb : b ⭢ b') : (a ⬝ b) /-- Express that two terms have a reduce to a common term. -/ def CommonReduct : SKI → SKI → Prop := Relation.Join RedSKI.MRed -lemma commonReduct_of_single {a b : SKI} (h : a ↠ b) : CommonReduct a b := ⟨b, h, by rfl⟩ +lemma commonReduct_of_single {a b : SKI} (h : a ↠b) : CommonReduct a b := ⟨b, h, by rfl⟩ theorem symmetric_commonReduct : Symmetric CommonReduct := Relation.symmetric_join -theorem reflexive_commonReduct : Reflexive CommonReduct := λ x => by +theorem reflexive_commonReduct : Reflexive CommonReduct := fun x => by refine ⟨x,?_,?_⟩ <;> rfl theorem commonReduct_head {x x' : SKI} (y : SKI) : CommonReduct x x' → CommonReduct (x ⬝ y) (x' ⬝ y) @@ -159,3 +149,5 @@ theorem commonReduct_head {x x' : SKI} (y : SKI) : CommonReduct x x' → CommonR theorem commonReduct_tail (x : SKI) {y y' : SKI} : CommonReduct y y' → CommonReduct (x ⬝ y) (x ⬝ y') | ⟨z, hz, hz'⟩ => ⟨x ⬝ z, MRed.tail x hz, MRed.tail x hz'⟩ + +end SKI diff --git a/Cslib/Languages/CombinatoryLogic/Evaluation.lean b/Cslib/Languages/CombinatoryLogic/Evaluation.lean index c35e9981..15f91081 100644 --- a/Cslib/Languages/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Languages/CombinatoryLogic/Evaluation.lean @@ -186,7 +186,7 @@ theorem commonReduct_redexFree {x y : SKI} (hy : RedexFree y) (h : CommonReduct (redexFree_iff'.1 hy _ |>.1 hzw : y = w) ▸ hyw /-- If `x` reduces to both `y` and `z`, and `z` is not reducible, then `y` reduces to `z`. -/ -lemma confluent_redexFree {x y z : SKI} (hxy : x ↠ y) (hxz : x ↠ z) (hz : RedexFree z) : y ↠ z := +lemma confluent_redexFree {x y z : SKI} (hxy : x ↠y) (hxz : x ↠z) (hz : RedexFree z) : y ↠ z := let ⟨w, hyw, hzw⟩ := MRed.diamond x y z hxy hxz (redexFree_iff'.1 hz _ |>.1 hzw : z = w) ▸ hyw @@ -194,7 +194,7 @@ lemma confluent_redexFree {x y z : SKI} (hxy : x ↠ y) (hxz : x ↠ z) (hz : Re If `x` reduces to both `y` and `z`, and both `y` and `z` are in normal form, then they are equal. -/ lemma unique_normal_form {x y z : SKI} - (hxy : x ↠ y) (hxz : x ↠ z) (hy : RedexFree y) (hz : RedexFree z) : y = z := + (hxy : x ↠y) (hxz : x ↠z) (hy : RedexFree y) (hz : RedexFree z) : y = z := (redexFree_iff'.1 hy _).1 (confluent_redexFree hxy hxz hz) /-- If `x` and `y` are normal and have a common reduct, then they are equal. -/ @@ -263,7 +263,7 @@ lemma churchK_size : (n : Nat) → (churchK n).size = n+1 lemma churchK_injective : Function.Injective churchK := fun n m h => by simpa using congrArg SKI.size h -/-- Injectivity for Church numerals-/ +/-- Injectivity for Church numerals -/ theorem isChurch_injective (x y : SKI) (n m : Nat) (hx : IsChurch n x) (hy : IsChurch m y) (hxy : CommonReduct x y) : n = m := by suffices CommonReduct (churchK n) (churchK m) by diff --git a/Cslib/Languages/CombinatoryLogic/Recursion.lean b/Cslib/Languages/CombinatoryLogic/Recursion.lean index 154cdf98..c6744103 100644 --- a/Cslib/Languages/CombinatoryLogic/Recursion.lean +++ b/Cslib/Languages/CombinatoryLogic/Recursion.lean @@ -21,8 +21,8 @@ correctness proofs `zero_correct` and `succ_correct`. - Predecessor : a term `Pred` so that (`pred_correct`) `IsChurch n a → IsChurch n.pred (Pred ⬝ a)`. - Primitive recursion : a term `Rec` so that (`rec_correct_succ`) `IsChurch (n+1) a` implies -`Rec ⬝ x ⬝ g ⬝ a ↠ g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))` and (`rec_correct_zero`) `IsChurch 0 a` implies -`Rec ⬝ x ⬝ g ⬝ a ↠ x`. +`Rec ⬝ x ⬝ g ⬝ a ↠ g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))` and (`rec_correct_zero`) `IsChurch 0 a` +implies `Rec ⬝ x ⬝ g ⬝ a ↠ x`. - Unbounded root finding (μ-recursion) : given a term `f` representing a function `fℕ: Nat → Nat`, which takes on the value 0 a term `RFind` such that (`rFind_correct`) `RFind ⬝ f ↠ a` such that `IsChurch n a` for `n` the smallest root of `fℕ`. @@ -58,7 +58,7 @@ match n with | n+1 => f ⬝ (Church n f x) /-- `church` commutes with reduction. -/ -lemma church_red (n : Nat) (f f' x x' : SKI) (hf : f ↠ f') (hx : x ↠ x') : +lemma church_red (n : Nat) (f f' x x' : SKI) (hf : f ↠f') (hx : x ↠x') : Church n f x ↠ Church n f' x' := by induction n with | zero => exact hx @@ -69,7 +69,7 @@ def IsChurch (n : Nat) (a : SKI) : Prop := ∀ f x :SKI, (a ⬝ f ⬝ x) ↠ (Church n f x) /-- To show `IsChurch n a` it suffices to show the same for a reduct of `a`. -/ -theorem isChurch_trans (n : Nat) {a a' : SKI} (h : a ↠ a') : IsChurch n a' → IsChurch n a := by +theorem isChurch_trans (n : Nat) {a a' : SKI} (h : a ↠a') : IsChurch n a' → IsChurch n a := by simp_rw [IsChurch] intro ha' f x calc @@ -118,7 +118,7 @@ theorem predAux_def (p : SKI) : (PredAux ⬝ p) ↠ MkPair ⬝ (Snd ⬝ p) ⬝ def IsChurchPair (ns : Nat × Nat) (x : SKI) : Prop := IsChurch ns.1 (Fst ⬝ x) ∧ IsChurch ns.2 (Snd ⬝ x) -theorem isChurchPair_trans (ns : Nat × Nat) (a a' : SKI) (h : a ↠ a') : +theorem isChurchPair_trans (ns : Nat × Nat) (a a' : SKI) (h : a ↠a') : IsChurchPair ns a' → IsChurchPair ns a := by simp_rw [IsChurchPair] intro ⟨ha₁,ha₂⟩ @@ -227,7 +227,7 @@ theorem rec_zero (x g a : SKI) (ha : IsChurch 0 a) : (Rec ⬝ x ⬝ g ⬝ a) ↠ apply cond_correct exact isZero_correct 0 a ha -theorem rec_succ (n : Nat) (x g a : SKI) (ha : IsChurch (n+1) a) : +theorem rec_succ (n : Nat) (x g a : SKI) (ha : IsChurch (n + 1) a) : (Rec ⬝ x ⬝ g ⬝ a) ↠ g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a)) := by calc _ ↠ SKI.Cond ⬝ x ⬝ (g ⬝ a ⬝ (Rec ⬝ x ⬝ g ⬝ (Pred ⬝ a))) ⬝ (IsZero ⬝ a) := rec_def _ _ _ @@ -257,7 +257,7 @@ theorem rfindAboveAux_base (R₀ f a : SKI) (hfa : IsChurch 0 (f ⬝ a)) : _ ↠ if (Nat.beq 0 0) then a else (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) := by apply cond_correct apply isZero_correct _ _ hfa -theorem rfindAboveAux_step (R₀ f a : SKI) {m : Nat} (hfa : IsChurch (m+1) (f ⬝ a)) : +theorem rfindAboveAux_step (R₀ f a : SKI) {m : Nat} (hfa : IsChurch (m + 1) (f ⬝ a)) : (RFindAboveAux ⬝ R₀ ⬝ a ⬝ f) ↠ R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f := calc _ ↠ SKI.Cond ⬝ a ⬝ (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) ⬝ (IsZero ⬝ (f ⬝ a)) := rfindAboveAux_def _ _ _ _ ↠ if (Nat.beq (m+1) 0) then a else (R₀ ⬝ (SKI.Succ ⬝ a) ⬝ f) := by From 6b1a05bfe3672d7903e72f6a8b11e280f029a1c3 Mon Sep 17 00:00:00 2001 From: twwar Date: Wed, 10 Sep 2025 12:30:07 +0200 Subject: [PATCH 092/107] spaces after transitions --- Cslib/Foundations/Semantics/ReductionSystem/Basic.lean | 4 ++-- Cslib/Languages/CombinatoryLogic/Basic.lean | 2 +- Cslib/Languages/CombinatoryLogic/Confluence.lean | 4 ++-- Cslib/Languages/CombinatoryLogic/Defs.lean | 8 ++++---- Cslib/Languages/CombinatoryLogic/Evaluation.lean | 4 ++-- Cslib/Languages/CombinatoryLogic/Recursion.lean | 6 +++--- 6 files changed, 14 insertions(+), 14 deletions(-) diff --git a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean index dcf7e9ee..a589be12 100644 --- a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean @@ -105,8 +105,8 @@ macro_rules ) | `(reduction_notation $rs) => `( - notation3 t:39 " ⭢" t':39 => (ReductionSystem.Red $rs) t t' - notation3 t:39 " ↠" t':39 => (ReductionSystem.MRed $rs) t t' + notation3 t:39 " ⭢ " t':39 => (ReductionSystem.Red $rs) t t' + notation3 t:39 " ↠ " t':39 => (ReductionSystem.MRed $rs) t t' ) diff --git a/Cslib/Languages/CombinatoryLogic/Basic.lean b/Cslib/Languages/CombinatoryLogic/Basic.lean index 837a6af4..2e7212f2 100644 --- a/Cslib/Languages/CombinatoryLogic/Basic.lean +++ b/Cslib/Languages/CombinatoryLogic/Basic.lean @@ -261,7 +261,7 @@ theorem Θ_correct (f : SKI) : (Θ ⬝ f) ↠ f ⬝ (Θ ⬝ f) := ΘAux_def ΘAu def IsBool (u : Bool) (a : SKI) : Prop := ∀ x y : SKI, (a ⬝ x ⬝ y) ↠ (if u then x else y) -theorem isBool_trans (u : Bool) (a a' : SKI) (h : a ↠a') (ha' : IsBool u a') : +theorem isBool_trans (u : Bool) (a a' : SKI) (h : a ↠ a') (ha' : IsBool u a') : IsBool u a := by intro x y trans a' ⬝ x ⬝ y diff --git a/Cslib/Languages/CombinatoryLogic/Confluence.lean b/Cslib/Languages/CombinatoryLogic/Confluence.lean index e43c482d..00c8df1d 100644 --- a/Cslib/Languages/CombinatoryLogic/Confluence.lean +++ b/Cslib/Languages/CombinatoryLogic/Confluence.lean @@ -68,7 +68,7 @@ theorem mRed_of_parallelReduction {a a' : SKI} (h : a ⇒ₚ a') : a ↠ a' := b case red_S a b c => exact Relation.ReflTransGen.single (red_S a b c) /-- The inclusion `⇒ ⊆ ⇒ₚ` -/ -theorem parallelReduction_of_red {a a' : SKI} (h : a ⭢a') : a ⇒ₚ a' := by +theorem parallelReduction_of_red {a a' : SKI} (h : a ⭢ a') : a ⇒ₚ a' := by cases h case red_S => apply ParallelReduction.red_S case red_K => apply ParallelReduction.red_K @@ -234,7 +234,7 @@ theorem commonReduct_equivalence : Equivalence CommonReduct := by exact join_parallelReduction_equivalence /-- The **Church-Rosser** theorem in the form it is usually stated. -/ -theorem MRed.diamond (a b c : SKI) (hab : a ↠b) (hac : a ↠c) : CommonReduct b c := by +theorem MRed.diamond (a b c : SKI) (hab : a ↠ b) (hac : a ↠ c) : CommonReduct b c := by apply commonReduct_equivalence.trans (y := a) · exact commonReduct_equivalence.symm (commonReduct_of_single hab) · exact commonReduct_of_single hac diff --git a/Cslib/Languages/CombinatoryLogic/Defs.lean b/Cslib/Languages/CombinatoryLogic/Defs.lean index 57caed81..c70b9400 100644 --- a/Cslib/Languages/CombinatoryLogic/Defs.lean +++ b/Cslib/Languages/CombinatoryLogic/Defs.lean @@ -102,7 +102,7 @@ theorem MRed.head {a a' : SKI} (b : SKI) (h : a ↠ a') : (a ⬝ b) ↠ (a' ⬝ apply Relation.ReflTransGen.tail (b := a' ⬝ b) ih exact Red.red_head a' a'' b ha'' -theorem MRed.tail (a : SKI) {b b' : SKI} (h : b ↠b') : (a ⬝ b) ↠ (a ⬝ b') := by +theorem MRed.tail (a : SKI) {b b' : SKI} (h : b ↠ b') : (a ⬝ b) ↠ (a ⬝ b') := by induction h with | refl => apply MRed.refl | @tail b' b'' _ hb'' ih => @@ -124,11 +124,11 @@ theorem MRed.tail (a : SKI) {b b' : SKI} (h : b ↠b') : (a ⬝ b) ↠ (a ⬝ b' -- instance RedMRedTrans : Trans Red Red MRed := -- ⟨fun hab hbc => Relation.ReflTransGen.trans (MRed.single hab) (MRed.single hbc)⟩ -lemma parallel_mRed {a a' b b' : SKI} (ha : a ↠a') (hb : b ↠b') : +lemma parallel_mRed {a a' b b' : SKI} (ha : a ↠ a') (hb : b ↠ b') : (a ⬝ b) ↠ (a' ⬝ b') := Trans.simple (MRed.head b ha) (MRed.tail a' hb) -lemma parallel_red {a a' b b' : SKI} (ha : a ⭢a') (hb : b ⭢b') : (a ⬝ b) ↠ (a' ⬝ b') := by +lemma parallel_red {a a' b b' : SKI} (ha : a ⭢ a') (hb : b ⭢ b') : (a ⬝ b) ↠ (a' ⬝ b') := by trans a' ⬝ b all_goals apply MRed.single · exact Red.red_head a a' b ha @@ -138,7 +138,7 @@ lemma parallel_red {a a' b b' : SKI} (ha : a ⭢a') (hb : b ⭢b') : (a ⬝ b) /-- Express that two terms have a reduce to a common term. -/ def CommonReduct : SKI → SKI → Prop := Relation.Join RedSKI.MRed -lemma commonReduct_of_single {a b : SKI} (h : a ↠b) : CommonReduct a b := ⟨b, h, by rfl⟩ +lemma commonReduct_of_single {a b : SKI} (h : a ↠ b) : CommonReduct a b := ⟨b, h, by rfl⟩ theorem symmetric_commonReduct : Symmetric CommonReduct := Relation.symmetric_join theorem reflexive_commonReduct : Reflexive CommonReduct := fun x => by diff --git a/Cslib/Languages/CombinatoryLogic/Evaluation.lean b/Cslib/Languages/CombinatoryLogic/Evaluation.lean index 15f91081..a71dcfb1 100644 --- a/Cslib/Languages/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Languages/CombinatoryLogic/Evaluation.lean @@ -186,7 +186,7 @@ theorem commonReduct_redexFree {x y : SKI} (hy : RedexFree y) (h : CommonReduct (redexFree_iff'.1 hy _ |>.1 hzw : y = w) ▸ hyw /-- If `x` reduces to both `y` and `z`, and `z` is not reducible, then `y` reduces to `z`. -/ -lemma confluent_redexFree {x y z : SKI} (hxy : x ↠y) (hxz : x ↠z) (hz : RedexFree z) : y ↠ z := +lemma confluent_redexFree {x y z : SKI} (hxy : x ↠ y) (hxz : x ↠ z) (hz : RedexFree z) : y ↠ z := let ⟨w, hyw, hzw⟩ := MRed.diamond x y z hxy hxz (redexFree_iff'.1 hz _ |>.1 hzw : z = w) ▸ hyw @@ -194,7 +194,7 @@ lemma confluent_redexFree {x y z : SKI} (hxy : x ↠y) (hxz : x ↠z) (hz : Rede If `x` reduces to both `y` and `z`, and both `y` and `z` are in normal form, then they are equal. -/ lemma unique_normal_form {x y z : SKI} - (hxy : x ↠y) (hxz : x ↠z) (hy : RedexFree y) (hz : RedexFree z) : y = z := + (hxy : x ↠ y) (hxz : x ↠ z) (hy : RedexFree y) (hz : RedexFree z) : y = z := (redexFree_iff'.1 hy _).1 (confluent_redexFree hxy hxz hz) /-- If `x` and `y` are normal and have a common reduct, then they are equal. -/ diff --git a/Cslib/Languages/CombinatoryLogic/Recursion.lean b/Cslib/Languages/CombinatoryLogic/Recursion.lean index c6744103..2d16dc23 100644 --- a/Cslib/Languages/CombinatoryLogic/Recursion.lean +++ b/Cslib/Languages/CombinatoryLogic/Recursion.lean @@ -58,7 +58,7 @@ match n with | n+1 => f ⬝ (Church n f x) /-- `church` commutes with reduction. -/ -lemma church_red (n : Nat) (f f' x x' : SKI) (hf : f ↠f') (hx : x ↠x') : +lemma church_red (n : Nat) (f f' x x' : SKI) (hf : f ↠ f') (hx : x ↠ x') : Church n f x ↠ Church n f' x' := by induction n with | zero => exact hx @@ -69,7 +69,7 @@ def IsChurch (n : Nat) (a : SKI) : Prop := ∀ f x :SKI, (a ⬝ f ⬝ x) ↠ (Church n f x) /-- To show `IsChurch n a` it suffices to show the same for a reduct of `a`. -/ -theorem isChurch_trans (n : Nat) {a a' : SKI} (h : a ↠a') : IsChurch n a' → IsChurch n a := by +theorem isChurch_trans (n : Nat) {a a' : SKI} (h : a ↠ a') : IsChurch n a' → IsChurch n a := by simp_rw [IsChurch] intro ha' f x calc @@ -118,7 +118,7 @@ theorem predAux_def (p : SKI) : (PredAux ⬝ p) ↠ MkPair ⬝ (Snd ⬝ p) ⬝ def IsChurchPair (ns : Nat × Nat) (x : SKI) : Prop := IsChurch ns.1 (Fst ⬝ x) ∧ IsChurch ns.2 (Snd ⬝ x) -theorem isChurchPair_trans (ns : Nat × Nat) (a a' : SKI) (h : a ↠a') : +theorem isChurchPair_trans (ns : Nat × Nat) (a a' : SKI) (h : a ↠ a') : IsChurchPair ns a' → IsChurchPair ns a := by simp_rw [IsChurchPair] intro ⟨ha₁,ha₂⟩ From b03bb3ade7dfcb2a5b51636840628a69c7a4b10c Mon Sep 17 00:00:00 2001 From: twwar Date: Wed, 24 Sep 2025 15:03:30 +0200 Subject: [PATCH 093/107] documentation --- Cslib/Languages/CombinatoryLogic/Evaluation.lean | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Evaluation.lean b/Cslib/Languages/CombinatoryLogic/Evaluation.lean index a71dcfb1..c41a0aed 100644 --- a/Cslib/Languages/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Languages/CombinatoryLogic/Evaluation.lean @@ -277,7 +277,15 @@ theorem isChurch_injective (x y : SKI) (n m : Nat) (hx : IsChurch n x) (hy : IsC · simp_rw [churchK_church] exact commonReduct_of_single (hy K K) -/-- **Rice's theorem**: no SKI term is a non-trivial predicate. -/ +/-- +**Rice's theorem**: no SKI term is a non-trivial predicate. + +More specifically, say a term `P` is a *predicate* if, for every term `x`, `P · x` reduces to either +`TT` or `FF`. A predicate `P` is *trivial* if either it always reduces to true, or always to false. +This version of Rice's theorem derives a contradiction from the existence of a predicate `P` and the +existence of terms `x` for which `P · x` is true (`P · x ↠ TT`) and for which `P · x` is false +(`P · x ↠ FF`). +-/ theorem rice {P : SKI} (hP : ∀ x : SKI, ((P ⬝ x) ↠ TT) ∨ (P ⬝ x) ↠ FF) (hxt : ∃ x : SKI, (P ⬝ x) ↠ TT) (hxf : ∃ x : SKI, (P ⬝ x) ↠ FF) : False := by obtain ⟨a, ha⟩ := hxt @@ -304,7 +312,11 @@ theorem rice {P : SKI} (hP : ∀ x : SKI, ((P ⬝ x) ↠ TT) ∨ (P ⬝ x) ↠ F _ ↠ TT := ha exact TF_nequiv <| MRed.diamond _ _ _ this h -/-- **Rice's theorem**: any SKI predicate is trivial. -/ +/-- **Rice's theorem**: any SKI predicate is trivial. + +This version of Rice's theorem proves (classically) that any SKI predicate `P` either is constantly +true (ie `P · x ↠ TT` for every `x`) or is constantly false (`P · x ↠ FF` for every `x`). +-/ theorem rice' {P : SKI} (hP : ∀ x : SKI, ((P ⬝ x) ↠ TT) ∨ (P ⬝ x) ↠ FF) : (∀ x : SKI, (P ⬝ x) ↠ TT) ∨ (∀ x : SKI, (P ⬝ x) ↠ FF) := by by_contra! h From 752d2c55539d42b8b2cadc7bc6629637be78ab25 Mon Sep 17 00:00:00 2001 From: twwar Date: Wed, 24 Sep 2025 15:14:57 +0200 Subject: [PATCH 094/107] dot notation --- .../CombinatoryLogic/Evaluation.lean | 46 +++++++++---------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Evaluation.lean b/Cslib/Languages/CombinatoryLogic/Evaluation.lean index c41a0aed..f46772fd 100644 --- a/Cslib/Languages/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Languages/CombinatoryLogic/Evaluation.lean @@ -36,14 +36,14 @@ This file draws heavily from True | K => True | I => True - | S ⬝ x => RedexFree x - | K ⬝ x => RedexFree x + | S ⬝ x => x.RedexFree + | K ⬝ x => x.RedexFree | I ⬝ _ => False - | S ⬝ x ⬝ y => RedexFree x ∧ RedexFree y + | S ⬝ x ⬝ y => x.RedexFree ∧ y.RedexFree | K ⬝ _ ⬝ _ => False | I ⬝ _ ⬝ _ => False | S ⬝ _ ⬝ _ ⬝ _ => False @@ -55,18 +55,18 @@ def RedexFree : SKI → Prop One-step evaluation as a function: either it returns a term that has been reduced by one step, or a proof that the term is redex free. Uses normal-order reduction. -/ -def evalStep : (x : SKI) → PLift (RedexFree x) ⊕ SKI +def SKI.evalStep : (x : SKI) → PLift (x.RedexFree) ⊕ SKI | S => Sum.inl (PLift.up trivial) | K => Sum.inl (PLift.up trivial) | I => Sum.inl (PLift.up trivial) - | S ⬝ x => match evalStep x with + | S ⬝ x => match x.evalStep with | Sum.inl h => Sum.inl h | Sum.inr x' => Sum.inr (S ⬝ x') - | K ⬝ x => match evalStep x with + | K ⬝ x => match x.evalStep with | Sum.inl h => Sum.inl h | Sum.inr x' => Sum.inr (K ⬝ x') | I ⬝ x => Sum.inr x - | S ⬝ x ⬝ y => match evalStep x, evalStep y with + | S ⬝ x ⬝ y => match x.evalStep, y.evalStep with | Sum.inl h1, Sum.inl h2 => Sum.inl (.up ⟨h1.down, h2.down⟩) | Sum.inl _, Sum.inr y' => Sum.inr (S ⬝ x ⬝ y') | Sum.inr x', _ => Sum.inr (S ⬝ x' ⬝ y) @@ -81,16 +81,16 @@ def evalStep : (x : SKI) → PLift (RedexFree x) ⊕ SKI | Sum.inr abcd', _ => Sum.inr (abcd' ⬝ e) /-- The normal-order reduction implemented by `evalStep` indeed computes a one-step reduction. -/ -theorem evalStep_right_correct : (x y : SKI) → (evalStep x = Sum.inr y) → x ⭢ y +theorem evalStep_right_correct : (x y : SKI) → (x.evalStep = Sum.inr y) → x ⭢ y | S ⬝ x, a, h => - match hx : evalStep x with + match hx : x.evalStep with | Sum.inl _ => by simp only [hx, evalStep, reduceCtorEq] at h | Sum.inr x' => by simp only [evalStep, hx, Sum.inr.injEq] at h rw [←h] exact .red_tail _ _ _ (evalStep_right_correct _ _ hx) | K ⬝ x, a, h => - match hx : evalStep x with + match hx : x.evalStep with | Sum.inl _ => by simp only [hx, evalStep, reduceCtorEq] at h | Sum.inr x' => by simp only [evalStep, hx, Sum.inr.injEq] at h @@ -98,7 +98,7 @@ theorem evalStep_right_correct : (x y : SKI) → (evalStep x = Sum.inr y) → x exact .red_tail _ _ _ (evalStep_right_correct _ _ hx) | I ⬝ x, a, h => Sum.inr.inj h ▸ red_I _ | S ⬝ x ⬝ y, a, h => - match hx : evalStep x, hy : evalStep y with + match hx : x.evalStep, hy : y.evalStep with | Sum.inl _, Sum.inl _ => by simp only [hx, hy, evalStep, reduceCtorEq] at h | Sum.inl _, Sum.inr y' => by simp only [hx, hy, evalStep, Sum.inr.injEq] at h @@ -125,12 +125,12 @@ theorem evalStep_right_correct : (x y : SKI) → (evalStep x = Sum.inr y) → x rw [←h] exact red_head _ _ _ <| evalStep_right_correct _ _ habcd -theorem redexFree_of_no_red {x : SKI} (h : ∀ y, ¬ (x ⭢ y)) : RedexFree x := by - match hx : evalStep x with +theorem redexFree_of_no_red {x : SKI} (h : ∀ y, ¬ (x ⭢ y)) : x.RedexFree := by + match hx : x.evalStep with | Sum.inl h' => exact h'.down | Sum.inr y => cases h _ (evalStep_right_correct x y hx) -theorem RedexFree.no_red : {x : SKI} → RedexFree x → ∀ y, ¬ (x ⭢ y) +theorem SKI.RedexFree.no_red : {x : SKI} → x.RedexFree → ∀ y, ¬ (x ⭢ y) | S ⬝ x, hx, S ⬝ y, red_tail _ _ _ hx' => by rw [RedexFree] at hx; exact hx.no_red y hx' | K ⬝ x, hx, K ⬝ y, red_tail _ _ _ hx' => by rw [RedexFree] at hx; exact hx.no_red y hx' | S ⬝ _ ⬝ _, ⟨hx, _⟩, S ⬝ _ ⬝ _, red_head _ _ _ (red_tail _ _ _ h3) => hx.no_red _ h3 @@ -139,26 +139,26 @@ theorem RedexFree.no_red : {x : SKI} → RedexFree x → ∀ y, ¬ (x ⭢ y) | _ ⬝ _ ⬝ _ ⬝ _ ⬝ _, ⟨_, hy⟩, _ ⬝ _, red_tail _ _ _ he => hy.no_red _ he /-- A term is redex free iff it has no one-step reductions. -/ -theorem redexFree_iff {x : SKI} : RedexFree x ↔ ∀ y, ¬ (x ⭢ y) := +theorem redexFree_iff {x : SKI} : x.RedexFree ↔ ∀ y, ¬ (x ⭢ y) := ⟨RedexFree.no_red, redexFree_of_no_red⟩ -theorem redexFree_iff_evalStep {x : SKI} : RedexFree x ↔ (evalStep x).isLeft = true := by +theorem redexFree_iff_evalStep {x : SKI} : x.RedexFree ↔ (x.evalStep).isLeft = true := by constructor case mp => intro h - match hx : evalStep x with + match hx : x.evalStep with | Sum.inl h' => exact rfl | Sum.inr y => cases h.no_red _ (evalStep_right_correct _ _ hx) case mpr => intro h - match hx : evalStep x with + match hx : x.evalStep with | Sum.inl h' => exact h'.down | Sum.inr y => rw [hx] at h; cases h instance : DecidablePred RedexFree := fun _ => decidable_of_iff' _ redexFree_iff_evalStep /-- A term is redex free iff its only many-step reduction is itself. -/ -theorem redexFree_iff' {x : SKI} : RedexFree x ↔ ∀ y, (x ↠ y) ↔ x = y := by +theorem redexFree_iff' {x : SKI} : x.RedexFree ↔ ∀ y, (x ↠ y) ↔ x = y := by constructor case mp => intro h y @@ -181,7 +181,7 @@ theorem redexFree_iff' {x : SKI} : RedexFree x ↔ ∀ y, (x ↠ y) ↔ x = y := exact Red.ne hy (h.1 (Relation.ReflTransGen.single hy)) /-- If a term has a common reduct with a normal term, it in fact reduces to that term. -/ -theorem commonReduct_redexFree {x y : SKI} (hy : RedexFree y) (h : CommonReduct x y) : x ↠ y := +theorem commonReduct_redexFree {x y : SKI} (hy : y.RedexFree) (h : CommonReduct x y) : x ↠ y := let ⟨w, hyw, hzw⟩ := h (redexFree_iff'.1 hy _ |>.1 hzw : y = w) ▸ hyw @@ -194,12 +194,12 @@ lemma confluent_redexFree {x y z : SKI} (hxy : x ↠ y) (hxz : x ↠ z) (hz : Re If `x` reduces to both `y` and `z`, and both `y` and `z` are in normal form, then they are equal. -/ lemma unique_normal_form {x y z : SKI} - (hxy : x ↠ y) (hxz : x ↠ z) (hy : RedexFree y) (hz : RedexFree z) : y = z := + (hxy : x ↠ y) (hxz : x ↠ z) (hy : y.RedexFree) (hz : RedexFree z) : y = z := (redexFree_iff'.1 hy _).1 (confluent_redexFree hxy hxz hz) /-- If `x` and `y` are normal and have a common reduct, then they are equal. -/ lemma unique_normal_form' {x y : SKI} (h : CommonReduct x y) - (hx : RedexFree x) (hy : RedexFree y) : x = y := + (hx : x.RedexFree) (hy : y.RedexFree) : x = y := (redexFree_iff'.1 hx _).1 (commonReduct_redexFree hy h) /-! ### Injectivity for datatypes -/ From 1aa92ab1014883a445089aee856ebed86684452f Mon Sep 17 00:00:00 2001 From: twwar Date: Sat, 27 Sep 2025 17:39:23 +0200 Subject: [PATCH 095/107] more descriptive names --- .../CombinatoryLogic/Evaluation.lean | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Evaluation.lean b/Cslib/Languages/CombinatoryLogic/Evaluation.lean index f46772fd..1559abbf 100644 --- a/Cslib/Languages/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Languages/CombinatoryLogic/Evaluation.lean @@ -22,7 +22,7 @@ This file formalises evaluation and normal forms of SKI terms. ## Main results - `evalStep_right_correct` : correctness for `evalStep` -- `redexFree_iff` and `redexFree_iff'` : a term is redex free if and only if it has (respectively) +- `redexFree_iff` and `redexFree_iff_mred_eq` : a term is redex free if and only if it has (respectively) no one-step reductions, or if its only many step reduction is itself. - `unique_normal_form` : if `x` reduces to both `y` and `z`, and both `y` and `z` are in normal form, then they are equal. @@ -158,7 +158,7 @@ theorem redexFree_iff_evalStep {x : SKI} : x.RedexFree ↔ (x.evalStep).isLeft = instance : DecidablePred RedexFree := fun _ => decidable_of_iff' _ redexFree_iff_evalStep /-- A term is redex free iff its only many-step reduction is itself. -/ -theorem redexFree_iff' {x : SKI} : x.RedexFree ↔ ∀ y, (x ↠ y) ↔ x = y := by +theorem redexFree_iff_mred_eq {x : SKI} : x.RedexFree ↔ ∀ y, (x ↠ y) ↔ x = y := by constructor case mp => intro h y @@ -183,24 +183,24 @@ theorem redexFree_iff' {x : SKI} : x.RedexFree ↔ ∀ y, (x ↠ y) ↔ x = y := /-- If a term has a common reduct with a normal term, it in fact reduces to that term. -/ theorem commonReduct_redexFree {x y : SKI} (hy : y.RedexFree) (h : CommonReduct x y) : x ↠ y := let ⟨w, hyw, hzw⟩ := h - (redexFree_iff'.1 hy _ |>.1 hzw : y = w) ▸ hyw + (redexFree_iff_mred_eq.1 hy _ |>.1 hzw : y = w) ▸ hyw /-- If `x` reduces to both `y` and `z`, and `z` is not reducible, then `y` reduces to `z`. -/ lemma confluent_redexFree {x y z : SKI} (hxy : x ↠ y) (hxz : x ↠ z) (hz : RedexFree z) : y ↠ z := let ⟨w, hyw, hzw⟩ := MRed.diamond x y z hxy hxz - (redexFree_iff'.1 hz _ |>.1 hzw : z = w) ▸ hyw + (redexFree_iff_mred_eq.1 hz _ |>.1 hzw : z = w) ▸ hyw /-- If `x` reduces to both `y` and `z`, and both `y` and `z` are in normal form, then they are equal. -/ lemma unique_normal_form {x y z : SKI} (hxy : x ↠ y) (hxz : x ↠ z) (hy : y.RedexFree) (hz : RedexFree z) : y = z := - (redexFree_iff'.1 hy _).1 (confluent_redexFree hxy hxz hz) + (redexFree_iff_mred_eq.1 hy _).1 (confluent_redexFree hxy hxz hz) /-- If `x` and `y` are normal and have a common reduct, then they are equal. -/ -lemma unique_normal_form' {x y : SKI} (h : CommonReduct x y) +lemma eq_of_commonReduct_redexFree {x y : SKI} (h : CommonReduct x y) (hx : x.RedexFree) (hy : y.RedexFree) : x = y := - (redexFree_iff'.1 hx _).1 (commonReduct_redexFree hy h) + (redexFree_iff_mred_eq.1 hx _).1 (commonReduct_redexFree hy h) /-! ### Injectivity for datatypes -/ @@ -208,8 +208,8 @@ lemma sk_nequiv : ¬ CommonReduct S K := by intro ⟨z, hsz, hkz⟩ have hS : RedexFree S := by simp [RedexFree] have hK : RedexFree K := by simp [RedexFree] - cases (redexFree_iff'.1 hS z).1 hsz - cases (redexFree_iff'.1 hK _).1 hkz + cases (redexFree_iff_mred_eq.1 hS z).1 hsz + cases (redexFree_iff_mred_eq.1 hK _).1 hkz /-- Injectivity for booleans. -/ theorem isBool_injective (x y : SKI) (u v : Bool) (hx : IsBool u x) (hy : IsBool v y) @@ -268,7 +268,7 @@ theorem isChurch_injective (x y : SKI) (n m : Nat) (hx : IsChurch n x) (hy : IsC (hxy : CommonReduct x y) : n = m := by suffices CommonReduct (churchK n) (churchK m) by apply churchK_injective - exact unique_normal_form' this (churchK_redexFree n) (churchK_redexFree m) + exact eq_of_commonReduct_redexFree this (churchK_redexFree n) (churchK_redexFree m) apply commonReduct_equivalence.trans (y := x ⬝ K ⬝ K) · simp_rw [churchK_church] exact commonReduct_equivalence.symm <| commonReduct_of_single (hx K K) From d7ba53abb76e1e2552466a0ff31180779259c16f Mon Sep 17 00:00:00 2001 From: twwar Date: Sat, 27 Sep 2025 17:43:59 +0200 Subject: [PATCH 096/107] lint --- Cslib/Languages/CombinatoryLogic/Evaluation.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Evaluation.lean b/Cslib/Languages/CombinatoryLogic/Evaluation.lean index 1559abbf..7546dd77 100644 --- a/Cslib/Languages/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Languages/CombinatoryLogic/Evaluation.lean @@ -22,8 +22,8 @@ This file formalises evaluation and normal forms of SKI terms. ## Main results - `evalStep_right_correct` : correctness for `evalStep` -- `redexFree_iff` and `redexFree_iff_mred_eq` : a term is redex free if and only if it has (respectively) -no one-step reductions, or if its only many step reduction is itself. +- `redexFree_iff` and `redexFree_iff_mred_eq` : a term is redex free if and only if it has +(respectively) no one-step reductions, or if its only many step reduction is itself. - `unique_normal_form` : if `x` reduces to both `y` and `z`, and both `y` and `z` are in normal form, then they are equal. - **Rice's theorem**: no SKI term is a non-trivial predicate. From 3473f8723681d703bd0e43c91b419586c31f89a5 Mon Sep 17 00:00:00 2001 From: twwar Date: Mon, 6 Oct 2025 13:57:01 +0200 Subject: [PATCH 097/107] fix imports --- Cslib/Languages/CombinatoryLogic/Defs.lean | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Defs.lean b/Cslib/Languages/CombinatoryLogic/Defs.lean index c70b9400..05f56aa0 100644 --- a/Cslib/Languages/CombinatoryLogic/Defs.lean +++ b/Cslib/Languages/CombinatoryLogic/Defs.lean @@ -4,9 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Waring -/ import Mathlib.Logic.Relation -import Cslib.Utils.Relation -import Cslib.Semantics.ReductionSystem.Basic -import Cslib.Data.Relation +import Cslib.Foundations.Semantics.ReductionSystem.Basic +import Cslib.Foundations.Data.Relation /-! # SKI Combinatory Logic From 26c32969229aae1ed03086784484675e643c7996 Mon Sep 17 00:00:00 2001 From: twwar Date: Mon, 6 Oct 2025 14:16:30 +0200 Subject: [PATCH 098/107] fix spaces in notation --- .../Semantics/ReductionSystem/Basic.lean | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean index cd83ef06..a589be12 100644 --- a/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean +++ b/Cslib/Foundations/Semantics/ReductionSystem/Basic.lean @@ -54,7 +54,7 @@ end MultiStep open Lean Elab Meta Command Term --- thank you to Kyle Miller for this: +-- thank you to Kyle Miller for this: -- https://leanprover.zulipchat.com/#narrow/channel/239415-metaprogramming-.2F-tactics/topic/Working.20with.20variables.20in.20a.20command/near/529324084 /-- A command to create a `ReductionSystem` from a relation, robust to use of `variable `-/ @@ -85,10 +85,10 @@ elab "create_reduction_sys" rel:ident name:ident : command => do } addTermInfo' name (.const name.getId params) (isBinder := true) addDeclarationRangesFromSyntax name.getId name - -/-- + +/-- This command adds notations for a `ReductionSystem.Red` and `ReductionSystem.MRed`. This should - not usually be called directly, but from the `reduction_sys` attribute. + not usually be called directly, but from the `reduction_sys` attribute. As an example `reduction_notation foo "β"` will add the notations "⭢β" and "↠β". @@ -98,19 +98,19 @@ elab "create_reduction_sys" rel:ident name:ident : command => do -/ syntax "reduction_notation" ident (str)? : command macro_rules - | `(reduction_notation $rs $sym) => + | `(reduction_notation $rs $sym) => `( notation3 t:39 " ⭢" $sym:str t':39 => (ReductionSystem.Red $rs) t t' notation3 t:39 " ↠" $sym:str t':39 => (ReductionSystem.MRed $rs) t t' ) - | `(reduction_notation $rs) => + | `(reduction_notation $rs) => `( - notation3 t:39 " ⭢" t':39 => (ReductionSystem.Red $rs) t t' - notation3 t:39 " ↠" t':39 => (ReductionSystem.MRed $rs) t t' + notation3 t:39 " ⭢ " t':39 => (ReductionSystem.Red $rs) t t' + notation3 t:39 " ↠ " t':39 => (ReductionSystem.MRed $rs) t t' ) -/-- +/-- This attribute calls the `reduction_notation` command for the annotated declaration, such as in: ``` From 97f94951b778474ab9d3a89267388140f8d3a504 Mon Sep 17 00:00:00 2001 From: thomaskwaring <51426330+thomaskwaring@users.noreply.github.com> Date: Wed, 15 Oct 2025 13:23:18 +0200 Subject: [PATCH 099/107] fix lake-manifest in docs --- docs/lake-manifest.json | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/docs/lake-manifest.json b/docs/lake-manifest.json index 61f0a3bf..922073cf 100644 --- a/docs/lake-manifest.json +++ b/docs/lake-manifest.json @@ -35,7 +35,7 @@ "rev": "c205f530395b57b520d3d78d975293f0c69b65ce", "name": "plausible", "manifestFile": "lake-manifest.json", - "inputRev": "v4.22.0", + "inputRev": "main", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/LeanSearchClient", @@ -85,7 +85,7 @@ "rev": "345a958916d27982d4ecb4500fba0ebb21096651", "name": "Qq", "manifestFile": "lake-manifest.json", - "inputRev": "v4.22.0", + "inputRev": "master", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/batteries", From 26fdf29a2d313c9bdce708b830de74f2b166754b Mon Sep 17 00:00:00 2001 From: thomaskwaring <51426330+thomaskwaring@users.noreply.github.com> Date: Wed, 15 Oct 2025 13:23:47 +0200 Subject: [PATCH 100/107] fix other lake-manifest --- lake-manifest.json | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/lake-manifest.json b/lake-manifest.json index 4c0e4d68..f04018da 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -5,20 +5,20 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "eed770a434957369c6262aa3fb1d6426419016d4", + "rev": "f897ebcf72cd16f89ab4577d0c826cd14afaafc7", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.24.0-rc1", + "inputRev": "v4.24.0", "inherited": false, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/plausible", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "c205f530395b57b520d3d78d975293f0c69b65ce", + "rev": "dfd06ebfe8d0e8fa7faba9cb5e5a2e74e7bd2805", "name": "plausible", "manifestFile": "lake-manifest.json", - "inputRev": "v4.22.0", + "inputRev": "main", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/LeanSearchClient", @@ -35,57 +35,57 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "a564b9c2252afef6e0d40613d4ec086b54ffe7df", + "rev": "d768126816be17600904726ca7976b185786e6b9", "name": "importGraph", "manifestFile": "lake-manifest.json", - "inputRev": "nightly-testing", + "inputRev": "main", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/ProofWidgets4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "557f2069977de1c95e68de09e693bc4d1eee7842", + "rev": "556caed0eadb7901e068131d1be208dd907d07a2", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.72-pre", + "inputRev": "v0.0.74", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/aesop", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "fc97e592e3e150370f17a12e3613e96252c4d3d0", + "rev": "725ac8cd67acd70a7beaf47c3725e23484c1ef50", "name": "aesop", "manifestFile": "lake-manifest.json", - "inputRev": "nightly-testing", + "inputRev": "master", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/quote4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "345a958916d27982d4ecb4500fba0ebb21096651", + "rev": "dea6a3361fa36d5a13f87333dc506ada582e025c", "name": "Qq", "manifestFile": "lake-manifest.json", - "inputRev": "v4.22.0", + "inputRev": "master", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/batteries", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "b3a8bc5f8b72102ebbe4da3302432b196e215522", + "rev": "8da40b72fece29b7d3fe3d768bac4c8910ce9bee", "name": "batteries", "manifestFile": "lake-manifest.json", - "inputRev": "nightly-testing", + "inputRev": "main", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover/lean4-cli", "type": "git", "subDir": null, "scope": "leanprover", - "rev": "c682c91d2d4dd59a7187e2ab977ac25bd1f87329", + "rev": "91c18fa62838ad0ab7384c03c9684d99d306e1da", "name": "Cli", "manifestFile": "lake-manifest.json", "inputRev": "main", From 7a6d62e9b39c909f02d116a7c31c793036476ec8 Mon Sep 17 00:00:00 2001 From: twwar Date: Wed, 15 Oct 2025 13:42:17 +0200 Subject: [PATCH 101/107] fix again? --- lake-manifest.json | 28 ++++++++++++++-------------- lean-toolchain | 2 +- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/lake-manifest.json b/lake-manifest.json index f04018da..b6fceb97 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -5,17 +5,17 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "f897ebcf72cd16f89ab4577d0c826cd14afaafc7", + "rev": "eed770a434957369c6262aa3fb1d6426419016d4", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.24.0", + "inputRev": "v4.24.0-rc1", "inherited": false, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/plausible", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "dfd06ebfe8d0e8fa7faba9cb5e5a2e74e7bd2805", + "rev": "c205f530395b57b520d3d78d975293f0c69b65ce", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -35,37 +35,37 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "d768126816be17600904726ca7976b185786e6b9", + "rev": "a564b9c2252afef6e0d40613d4ec086b54ffe7df", "name": "importGraph", "manifestFile": "lake-manifest.json", - "inputRev": "main", + "inputRev": "nightly-testing", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/ProofWidgets4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "556caed0eadb7901e068131d1be208dd907d07a2", + "rev": "557f2069977de1c95e68de09e693bc4d1eee7842", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.74", + "inputRev": "v0.0.72-pre", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/aesop", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "725ac8cd67acd70a7beaf47c3725e23484c1ef50", + "rev": "fc97e592e3e150370f17a12e3613e96252c4d3d0", "name": "aesop", "manifestFile": "lake-manifest.json", - "inputRev": "master", + "inputRev": "nightly-testing", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/quote4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "dea6a3361fa36d5a13f87333dc506ada582e025c", + "rev": "345a958916d27982d4ecb4500fba0ebb21096651", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -75,21 +75,21 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "8da40b72fece29b7d3fe3d768bac4c8910ce9bee", + "rev": "b3a8bc5f8b72102ebbe4da3302432b196e215522", "name": "batteries", "manifestFile": "lake-manifest.json", - "inputRev": "main", + "inputRev": "nightly-testing", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover/lean4-cli", "type": "git", "subDir": null, "scope": "leanprover", - "rev": "91c18fa62838ad0ab7384c03c9684d99d306e1da", + "rev": "e22ed0883c7d7f9a7e294782b6b137b783715386", "name": "Cli", "manifestFile": "lake-manifest.json", "inputRev": "main", "inherited": true, "configFile": "lakefile.toml"}], "name": "cslib", - "lakeDir": ".lake"} + "lakeDir": ".lake"} \ No newline at end of file diff --git a/lean-toolchain b/lean-toolchain index fd384f29..c00a5350 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.24.0-rc1 +leanprover/lean4:v4.24.0 From b7152df8863e853a310f34849ca041451c818feb Mon Sep 17 00:00:00 2001 From: twwar Date: Wed, 15 Oct 2025 13:44:06 +0200 Subject: [PATCH 102/107] once more with feeling --- lake-manifest.json | 2 +- lean-toolchain | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lake-manifest.json b/lake-manifest.json index b6fceb97..cf576f27 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -85,7 +85,7 @@ "type": "git", "subDir": null, "scope": "leanprover", - "rev": "e22ed0883c7d7f9a7e294782b6b137b783715386", + "rev": "e22ed0883c7d7f9a7e294782b6b137b783715386", "name": "Cli", "manifestFile": "lake-manifest.json", "inputRev": "main", diff --git a/lean-toolchain b/lean-toolchain index c00a5350..fd384f29 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.24.0 +leanprover/lean4:v4.24.0-rc1 From cb2365eb804730d70949eedd7164939650cd55fc Mon Sep 17 00:00:00 2001 From: thomaskwaring <51426330+thomaskwaring@users.noreply.github.com> Date: Wed, 15 Oct 2025 14:57:55 +0200 Subject: [PATCH 103/107] namespace Evaluation --- Cslib/Languages/CombinatoryLogic/Evaluation.lean | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Cslib/Languages/CombinatoryLogic/Evaluation.lean b/Cslib/Languages/CombinatoryLogic/Evaluation.lean index 7546dd77..8b3ef784 100644 --- a/Cslib/Languages/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Languages/CombinatoryLogic/Evaluation.lean @@ -33,6 +33,8 @@ form, then they are equal. This file draws heavily from . -/ +namespace Cslib + open SKI Red /-- The predicate that a term has no reducible sub-terms. -/ @@ -322,3 +324,5 @@ theorem rice' {P : SKI} (hP : ∀ x : SKI, ((P ⬝ x) ↠ TT) ∨ (P ⬝ x) ↠ by_contra! h obtain ⟨⟨a, ha⟩, b, hb⟩ := h exact rice hP ⟨b, (hP _).resolve_right hb⟩ ⟨a, (hP _).resolve_left ha⟩ + +end Cslib From 13c3c7febc16061686dac3af88dd69ab8c9619ee Mon Sep 17 00:00:00 2001 From: Chris Henson Date: Wed, 15 Oct 2025 09:12:54 -0400 Subject: [PATCH 104/107] take manifest from main --- lake-manifest.json | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lake-manifest.json b/lake-manifest.json index cf576f27..be8baa09 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -92,4 +92,4 @@ "inherited": true, "configFile": "lakefile.toml"}], "name": "cslib", - "lakeDir": ".lake"} \ No newline at end of file + "lakeDir": ".lake"} From 014a5f3398adfc61c0701e2cdab87a8bb5a04ab9 Mon Sep 17 00:00:00 2001 From: twwar Date: Wed, 15 Oct 2025 16:14:49 +0200 Subject: [PATCH 105/107] rm unicode id --- Cslib/Languages/CombinatoryLogic/Basic.lean | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Basic.lean b/Cslib/Languages/CombinatoryLogic/Basic.lean index 2e7212f2..86aa8b48 100644 --- a/Cslib/Languages/CombinatoryLogic/Basic.lean +++ b/Cslib/Languages/CombinatoryLogic/Basic.lean @@ -202,11 +202,11 @@ theorem rotL_def (x y z : SKI) : (RotL ⬝ x ⬝ y ⬝ z) ↠ y ⬝ z ⬝ x := /-- Self application: δ := λ x. x x -/ -def δPoly : SKI.Polynomial 1 := &0 ⬝' &0 +def DelPoly : SKI.Polynomial 1 := &0 ⬝' &0 /-- A SKI term representing δ -/ -def δ : SKI := δPoly.toSKI -theorem δ_def (x : SKI) : (δ ⬝ x) ↠ x ⬝ x := - δPoly.toSKI_correct [x] (by simp) +def Del : SKI := DelPoly.toSKI +theorem del_def (x : SKI) : (Del ⬝ x) ↠ x ⬝ x := + DelPoly.toSKI_correct [x] (by simp) /-- H := λ f x. f (x x) -/ @@ -242,17 +242,17 @@ def fixedPoint (f : SKI) : SKI := H ⬝ f ⬝ (H ⬝ f) theorem fixedPoint_correct (f : SKI) : f.fixedPoint ↠ f ⬝ f.fixedPoint := H_def f (H ⬝ f) /-- Auxiliary definition for Turing's fixed-point combinator: ΘAux := λ x y. y (x x y) -/ -def ΘAuxPoly : SKI.Polynomial 2 := &1 ⬝' (&0 ⬝' &0 ⬝' &1) +def ThAuxPoly : SKI.Polynomial 2 := &1 ⬝' (&0 ⬝' &0 ⬝' &1) /-- A term representing ΘAux -/ -def ΘAux : SKI := ΘAuxPoly.toSKI -theorem ΘAux_def (x y : SKI) : (ΘAux ⬝ x ⬝ y) ↠ y ⬝ (x ⬝ x ⬝ y) := - ΘAuxPoly.toSKI_correct [x, y] (by simp) +def ThAux : SKI := ThAuxPoly.toSKI +theorem ThAux_def (x y : SKI) : (ThAux ⬝ x ⬝ y) ↠ y ⬝ (x ⬝ x ⬝ y) := + ThAuxPoly.toSKI_correct [x, y] (by simp) /-- Turing's fixed-point combinator: Θ := (λ x y. y (x x y)) (λ x y. y (x x y)) -/ -def Θ : SKI := ΘAux ⬝ ΘAux +def Th : SKI := ThAux ⬝ ThAux /-- A SKI term representing Θ -/ -theorem Θ_correct (f : SKI) : (Θ ⬝ f) ↠ f ⬝ (Θ ⬝ f) := ΘAux_def ΘAux f +theorem Th_correct (f : SKI) : (Th ⬝ f) ↠ f ⬝ (Th ⬝ f) := ThAux_def ThAux f /-! ### Church Booleans -/ From de53b60ecd08760b2510c4212f06c792dc3769f5 Mon Sep 17 00:00:00 2001 From: twwar Date: Wed, 15 Oct 2025 16:30:50 +0200 Subject: [PATCH 106/107] fix namespaces --- Cslib/Languages/CombinatoryLogic/Basic.lean | 4 ++++ Cslib/Languages/CombinatoryLogic/Confluence.lean | 4 ++++ Cslib/Languages/CombinatoryLogic/Defs.lean | 4 ++++ Cslib/Languages/CombinatoryLogic/Evaluation.lean | 12 ++++++++---- Cslib/Languages/CombinatoryLogic/Recursion.lean | 4 ++++ 5 files changed, 24 insertions(+), 4 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Basic.lean b/Cslib/Languages/CombinatoryLogic/Basic.lean index 86aa8b48..8df43c42 100644 --- a/Cslib/Languages/CombinatoryLogic/Basic.lean +++ b/Cslib/Languages/CombinatoryLogic/Basic.lean @@ -29,6 +29,8 @@ For a presentation of the bracket abstraction algorithm see: -/ +namespace Cslib + namespace SKI open Red MRed @@ -381,3 +383,5 @@ theorem pair_def (f g x : SKI) : (SKI.Pair ⬝ f ⬝ g ⬝ x) ↠ MkPair ⬝ (f PairPoly.toSKI_correct [f, g, x] (by simp) end SKI + +end Cslib diff --git a/Cslib/Languages/CombinatoryLogic/Confluence.lean b/Cslib/Languages/CombinatoryLogic/Confluence.lean index 00c8df1d..ea2d6939 100644 --- a/Cslib/Languages/CombinatoryLogic/Confluence.lean +++ b/Cslib/Languages/CombinatoryLogic/Confluence.lean @@ -35,6 +35,8 @@ for its reflexive-transitive closure. This closure is exactly `↠`, which impli **Church-Rosser** theorem as sketched above. -/ +namespace Cslib + namespace SKI open Red MRed ReductionSystem @@ -240,3 +242,5 @@ theorem MRed.diamond (a b c : SKI) (hab : a ↠ b) (hac : a ↠ c) : CommonReduc · exact commonReduct_of_single hac end SKI + +end Cslib diff --git a/Cslib/Languages/CombinatoryLogic/Defs.lean b/Cslib/Languages/CombinatoryLogic/Defs.lean index 05f56aa0..a172fac1 100644 --- a/Cslib/Languages/CombinatoryLogic/Defs.lean +++ b/Cslib/Languages/CombinatoryLogic/Defs.lean @@ -33,6 +33,8 @@ The setup of SKI combinatory logic is standard, see for example: - -/ +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) -/ @@ -150,3 +152,5 @@ theorem commonReduct_tail (x : SKI) {y y' : SKI} : CommonReduct y y' → CommonR | ⟨z, hz, hz'⟩ => ⟨x ⬝ z, MRed.tail x hz, MRed.tail x hz'⟩ end SKI + +end Cslib diff --git a/Cslib/Languages/CombinatoryLogic/Evaluation.lean b/Cslib/Languages/CombinatoryLogic/Evaluation.lean index 8b3ef784..d753a1a0 100644 --- a/Cslib/Languages/CombinatoryLogic/Evaluation.lean +++ b/Cslib/Languages/CombinatoryLogic/Evaluation.lean @@ -35,10 +35,12 @@ This file draws heavily from True | K => True | I => True @@ -57,7 +59,7 @@ def SKI.RedexFree : SKI → Prop One-step evaluation as a function: either it returns a term that has been reduced by one step, or a proof that the term is redex free. Uses normal-order reduction. -/ -def SKI.evalStep : (x : SKI) → PLift (x.RedexFree) ⊕ SKI +def evalStep : (x : SKI) → PLift (x.RedexFree) ⊕ SKI | S => Sum.inl (PLift.up trivial) | K => Sum.inl (PLift.up trivial) | I => Sum.inl (PLift.up trivial) @@ -132,7 +134,7 @@ theorem redexFree_of_no_red {x : SKI} (h : ∀ y, ¬ (x ⭢ y)) : x.RedexFree := | Sum.inl h' => exact h'.down | Sum.inr y => cases h _ (evalStep_right_correct x y hx) -theorem SKI.RedexFree.no_red : {x : SKI} → x.RedexFree → ∀ y, ¬ (x ⭢ y) +theorem RedexFree.no_red : {x : SKI} → x.RedexFree → ∀ y, ¬ (x ⭢ y) | S ⬝ x, hx, S ⬝ y, red_tail _ _ _ hx' => by rw [RedexFree] at hx; exact hx.no_red y hx' | K ⬝ x, hx, K ⬝ y, red_tail _ _ _ hx' => by rw [RedexFree] at hx; exact hx.no_red y hx' | S ⬝ _ ⬝ _, ⟨hx, _⟩, S ⬝ _ ⬝ _, red_head _ _ _ (red_tail _ _ _ h3) => hx.no_red _ h3 @@ -325,4 +327,6 @@ theorem rice' {P : SKI} (hP : ∀ x : SKI, ((P ⬝ x) ↠ TT) ∨ (P ⬝ x) ↠ obtain ⟨⟨a, ha⟩, b, hb⟩ := h exact rice hP ⟨b, (hP _).resolve_right hb⟩ ⟨a, (hP _).resolve_left ha⟩ +end SKI + end Cslib diff --git a/Cslib/Languages/CombinatoryLogic/Recursion.lean b/Cslib/Languages/CombinatoryLogic/Recursion.lean index 2d16dc23..23c7ee25 100644 --- a/Cslib/Languages/CombinatoryLogic/Recursion.lean +++ b/Cslib/Languages/CombinatoryLogic/Recursion.lean @@ -47,6 +47,8 @@ sense of `Mathlib.Data.Part` (as used in `Mathlib.Computability.Partrec`). - The results of this file should define a surjection `SKI → Nat.Partrec`. -/ +namespace Cslib + namespace SKI open Red MRed ReductionSystem @@ -381,3 +383,5 @@ theorem le_correct (n m : Nat) (a b : SKI) (ha : IsChurch n a) (hb : IsChurch m apply sub_correct <;> assumption end SKI + +end Cslib From 30ba08f2997efa408ebafa11e755ace58749bc70 Mon Sep 17 00:00:00 2001 From: twwar Date: Wed, 15 Oct 2025 17:28:39 +0200 Subject: [PATCH 107/107] remove commented-out code --- Cslib/Languages/CombinatoryLogic/Defs.lean | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/Cslib/Languages/CombinatoryLogic/Defs.lean b/Cslib/Languages/CombinatoryLogic/Defs.lean index a172fac1..73891281 100644 --- a/Cslib/Languages/CombinatoryLogic/Defs.lean +++ b/Cslib/Languages/CombinatoryLogic/Defs.lean @@ -110,21 +110,6 @@ theorem MRed.tail (a : SKI) {b b' : SKI} (h : b ↠ b') : (a ⬝ b) ↠ (a ⬝ b apply Relation.ReflTransGen.tail (b := a ⬝ b') ih exact Red.red_tail a b' b'' hb'' --- instance MRed.instTrans : IsTrans SKI MRed := Relation.instIsTransReflTransGen --- theorem MRed.transitive : Transitive MRed := transitive_of_trans MRed - --- instance MRed.instIsRefl : IsRefl SKI MRed := Relation.instIsReflReflTransGen --- theorem MRed.reflexive : Reflexive MRed := IsRefl.reflexive - --- instance MRedTrans : Trans Red MRed MRed := --- ⟨fun hab => Relation.ReflTransGen.trans (MRed.single hab)⟩ - --- instance MRedRedTrans : Trans MRed Red MRed := --- ⟨fun hab hbc => Relation.ReflTransGen.trans hab (MRed.single hbc)⟩ - --- instance RedMRedTrans : Trans Red Red MRed := --- ⟨fun hab hbc => Relation.ReflTransGen.trans (MRed.single hab) (MRed.single hbc)⟩ - lemma parallel_mRed {a a' b b' : SKI} (ha : a ↠ a') (hb : b ↠ b') : (a ⬝ b) ↠ (a' ⬝ b') := Trans.simple (MRed.head b ha) (MRed.tail a' hb) @@ -135,7 +120,6 @@ lemma parallel_red {a a' b b' : SKI} (ha : a ⭢ a') (hb : b ⭢ b') : (a ⬝ b) · exact Red.red_head a a' b ha · exact Red.red_tail a' b b' hb - /-- Express that two terms have a reduce to a common term. -/ def CommonReduct : SKI → SKI → Prop := Relation.Join RedSKI.MRed