From 5393822ad3f1caee98e34b35e6cf3d06ae5ddd04 Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Tue, 7 Jul 2026 12:44:33 -0600 Subject: [PATCH 01/11] add reference --- references.bib | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/references.bib b/references.bib index 18281428d..c7b00e4d1 100644 --- a/references.bib +++ b/references.bib @@ -483,4 +483,12 @@ @book{Sipser2013 edition = {3rd}, publisher = {Cengage Learning}, year = {2013} +} + +@mastersthesis{Copes2018, + author = {Copes, Martín}, + title = {A machine-checked proof of the Standardization Theorem + in Lambda Calculus using multiple substitution}, + school = {Universidad ORT Uruguay}, + year = {2018} } \ No newline at end of file From 096ca56f16df410fb59f5d0810eb858b26d05e3d Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Tue, 7 Jul 2026 13:00:13 -0600 Subject: [PATCH 02/11] update Cslib --- Cslib.lean | 1 + .../Untyped/LeftmostReduction.lean | 35 +++++++++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean diff --git a/Cslib.lean b/Cslib.lean index 43c374ae7..d99833bb9 100644 --- a/Cslib.lean +++ b/Cslib.lean @@ -138,6 +138,7 @@ public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullBetaEta public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullEta public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.FullEtaConfluence public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LcAt +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LeftmostReduction public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.MultiApp public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.MultiSubst public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean new file mode 100644 index 000000000..79ac307fb --- /dev/null +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Maximiliano Onofre Martínez. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Maximiliano Onofre Martínez +-/ + +module + +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.StandardReduction + +/-! # The Leftmost Reduction Theorem + +## Reference + +* [M. Copes, *A machine-checked proof of the Standardization Theorem in λ-calculus*][Copes2018] + +-/ + +@[expose] public section + +set_option linter.unusedDecidableInType false + +namespace Cslib + +universe u + +variable {Var : Type u} + +namespace LambdaCalculus.LocallyNameless.Untyped.Term + + + +end LambdaCalculus.LocallyNameless.Untyped.Term + +end Cslib From 8582753d6be847ba82ca10c0c48af2e377d23ea4 Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Tue, 7 Jul 2026 13:58:27 -0600 Subject: [PATCH 03/11] add leftmost reduction definitions --- .../Untyped/LeftmostReduction.lean | 36 ++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean index 79ac307fb..a70478575 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -28,7 +28,41 @@ variable {Var : Type u} namespace LambdaCalculus.LocallyNameless.Untyped.Term - +/-- The number of β-redexes occurring in a term. -/ +def countRedexes : Term Var → Nat +| fvar _ => 0 +| bvar _ => 0 +| abs m => countRedexes m +| app (abs m) n => (countRedexes (abs m) + countRedexes n) + 1 +| app m n => countRedexes m + countRedexes n + +/-- A term is in normal form when it contains no β-redexes. -/ +def NormalForm (m : Term Var) : Prop := countRedexes m = 0 + +/-- `IsAbs m` holds when `m` is an abstraction. -/ +inductive IsAbs : Term Var → Prop +| abs (m : Term Var) : IsAbs (abs m) + +/-- `BetaAt M N i` reduces the redex at position `i` of `M` to obtain `N`; + positions are counted from left to right. -/ +inductive BetaAt : Term Var → Term Var → Nat → Prop +/-- The outermost redex sits at position `0`. -/ +| outer : LC (abs M) → LC N → BetaAt (app (abs M) N) (M ^ N) 0 +/-- Reducing a non-abstraction operator keeps the position. -/ +| appNoAbsL : BetaAt M M' i → ¬ IsAbs M → BetaAt (app M N) (app M' N) i +/-- Reducing an abstraction operator advances the position by one. -/ +| appAbsL : BetaAt M M' i → IsAbs M → BetaAt (app M N) (app M' N) (i + 1) +/-- Reducing the operand adds the redex count of a non-abstraction operator. -/ +| appNoAbsR : BetaAt M M' i → ¬ IsAbs N → BetaAt (app N M) (app N M') (i + countRedexes N) +/-- Reducing the operand adds the redex count of an abstraction operator, plus one. -/ +| appAbsR : BetaAt M M' i → IsAbs N → BetaAt (app N M) (app N M') (i + countRedexes N + 1) +/-- Reducing under a binder keeps the position. -/ +| abs (xs : Finset Var) : + (∀ x ∉ xs, BetaAt (M ^ fvar x) (M' ^ fvar x) i) → BetaAt (abs M) (abs M') i + +/-- Leftmost reduction: a β-reduction contracting the redex at position 0. -/ +@[reduction_sys "ℓ"] +abbrev Leftmost (M N : Term Var) : Prop := BetaAt M N 0 end LambdaCalculus.LocallyNameless.Untyped.Term From 95315858c4474464bac4ba990565cf41071be32a Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Tue, 7 Jul 2026 22:19:30 -0600 Subject: [PATCH 04/11] add redex counting and normal form lemmas --- .../Untyped/LeftmostReduction.lean | 48 ++++++++++++++++++- 1 file changed, 46 insertions(+), 2 deletions(-) diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean index a70478575..e2ee9aba3 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -49,11 +49,11 @@ inductive BetaAt : Term Var → Term Var → Nat → Prop /-- The outermost redex sits at position `0`. -/ | outer : LC (abs M) → LC N → BetaAt (app (abs M) N) (M ^ N) 0 /-- Reducing a non-abstraction operator keeps the position. -/ -| appNoAbsL : BetaAt M M' i → ¬ IsAbs M → BetaAt (app M N) (app M' N) i +| appNoAbsL : BetaAt M M' i → ¬IsAbs M → BetaAt (app M N) (app M' N) i /-- Reducing an abstraction operator advances the position by one. -/ | appAbsL : BetaAt M M' i → IsAbs M → BetaAt (app M N) (app M' N) (i + 1) /-- Reducing the operand adds the redex count of a non-abstraction operator. -/ -| appNoAbsR : BetaAt M M' i → ¬ IsAbs N → BetaAt (app N M) (app N M') (i + countRedexes N) +| appNoAbsR : BetaAt M M' i → ¬IsAbs N → BetaAt (app N M) (app N M') (i + countRedexes N) /-- Reducing the operand adds the redex count of an abstraction operator, plus one. -/ | appAbsR : BetaAt M M' i → IsAbs N → BetaAt (app N M) (app N M') (i + countRedexes N + 1) /-- Reducing under a binder keeps the position. -/ @@ -64,6 +64,50 @@ inductive BetaAt : Term Var → Term Var → Nat → Prop @[reduction_sys "ℓ"] abbrev Leftmost (M N : Term Var) : Prop := BetaAt M N 0 +variable {L L' M M' N : Term Var} {i : Nat} + +/-- Opening with a free variable preserves the number of redexes. -/ +lemma countRedexes_openRec_fvar (M : Term Var) (k : Nat) (x : Var) : + countRedexes (M⟦k ↝ fvar x⟧) = countRedexes M := by + induction M generalizing k with + | bvar j => simp only [openRec_bvar]; split <;> rfl + | fvar => rfl + | abs M ih => grind [openRec_abs, countRedexes] + | app L R ihL ihR => cases L <;> grind [countRedexes, openRec_bvar, openRec_app, openRec_abs] + +/-- In a normal-form application, both sides are normal and the operator is not an + abstraction. -/ +lemma NormalForm.app_inv (h : NormalForm (app L M)) : + ¬IsAbs L ∧ NormalForm L ∧ NormalForm M := by + cases L <;> grind [NormalForm, countRedexes, IsAbs] + +/-- The body of a normal-form abstraction opens to a normal form. -/ +lemma NormalForm.abs_open {x : Var} (h : NormalForm (abs M)) : NormalForm (M ^ fvar x) := by + have e : countRedexes (M ^ fvar x) = countRedexes M := countRedexes_openRec_fvar M 0 x + rw [NormalForm, e] + exact h + +/-- The source of a Call-by-Name step is never an abstraction. -/ +lemma cbn_not_isAbs (h : M ⭢ₙ N) : ¬IsAbs M := by + intro ha + cases ha + trivial + +variable [DecidableEq Var] + +/-- Renaming a free variable preserves the number of redexes. -/ +lemma countRedexes_subst_fvar (M : Term Var) (x y : Var) : + countRedexes (M[x := fvar y]) = countRedexes M := by + induction M with + | fvar z => simp only [subst_fvar]; split <;> rfl + | bvar => rfl + | abs M ih => grind [countRedexes] + | app L R ihL ihR => cases L <;> grind [countRedexes] + +/-- Renaming a free variable preserves being an abstraction. -/ +lemma isAbs_subst_fvar {x y : Var} : IsAbs (M[x := fvar y]) ↔ IsAbs M := by + cases M <;> grind [IsAbs] + end LambdaCalculus.LocallyNameless.Untyped.Term end Cslib From 20fb8ed2204d39db9052c4be8c55857c4e9c6baf Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Tue, 7 Jul 2026 22:20:43 -0600 Subject: [PATCH 05/11] add basic properties of BetaAt --- .../Untyped/LeftmostReduction.lean | 68 +++++++++++++++++++ 1 file changed, 68 insertions(+) diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean index e2ee9aba3..14e5728e0 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -87,6 +87,18 @@ lemma NormalForm.abs_open {x : Var} (h : NormalForm (abs M)) : NormalForm (M ^ f rw [NormalForm, e] exact h +/-- Contracting a redex of an abstraction yields an abstraction. -/ +lemma BetaAt.isAbs_r (h : BetaAt M N i) (ha : IsAbs M) : IsAbs N := by + cases ha + cases h + exact .abs _ + +/-- Reducing the operand across a non-abstraction normal form keeps the position. -/ +lemma BetaAt.app_r_cong (h : BetaAt M M' i) (hL : NormalForm L) (hna : ¬IsAbs L) : + BetaAt (app L M) (app L M') i := by + have := h.appNoAbsR hna + rwa [hL] at this + /-- The source of a Call-by-Name step is never an abstraction. -/ lemma cbn_not_isAbs (h : M ⭢ₙ N) : ¬IsAbs M := by intro ha @@ -108,6 +120,62 @@ lemma countRedexes_subst_fvar (M : Term Var) (x y : Var) : lemma isAbs_subst_fvar {x y : Var} : IsAbs (M[x := fvar y]) ↔ IsAbs M := by cases M <;> grind [IsAbs] +variable [HasFresh Var] + +/-- Renaming a free variable preserves the position of the contracted redex. -/ +lemma BetaAt.rename (h : BetaAt M M' i) (x y : Var) : + BetaAt (M[x := fvar y]) (M'[x := fvar y]) i := by + induction h + case outer lcm lcn => + rw [subst_app, subst_abs, subst_open x (fvar y) _ _ (.fvar y)] + exact .outer (subst_lc lcm (.fvar y)) (subst_lc lcn (.fvar y)) + case appNoAbsL _ hna ih => + simp only [subst_app] + exact .appNoAbsL ih (mt isAbs_subst_fvar.mp hna) + case appAbsL _ ha ih => + simp only [subst_app] + exact .appAbsL ih (isAbs_subst_fvar.mpr ha) + case appNoAbsR M M' i N _ hna ih => + simp only [subst_app, ← countRedexes_subst_fvar N x y] + exact .appNoAbsR ih (mt isAbs_subst_fvar.mp hna) + case appAbsR M M' i N _ ha ih => + simp only [subst_app, ← countRedexes_subst_fvar N x y] + exact .appAbsR ih (isAbs_subst_fvar.mpr ha) + case abs M M' i xs _ ih => + simp only [subst_abs] + apply BetaAt.abs <| free_union [fv] Var + intro z hz + have hzx : x ≠ z := by aesop + rw [← subst_open_var z x (fvar y) M hzx (.fvar y), + ← subst_open_var z x (fvar y) M' hzx (.fvar y)] + exact ih z (by aesop) + +/-- Contracting a redex preserves local closure. -/ +lemma BetaAt.lc_r (h : BetaAt M M' i) (lc : LC M) : LC M' := by + induction h with + | outer lcm lcn => exact beta_lc lcm lcn + | appNoAbsL _ _ ih | appAbsL _ _ ih => + cases lc with + | app lcL lcR => exact .app (ih lcL) lcR + | appNoAbsR _ _ ih | appAbsR _ _ ih => + cases lc with + | app lcL lcR => exact .app lcL (ih lcR) + | abs xs _ ih => + cases lc with + | abs ys _ hbody => + apply LC.abs (xs ∪ ys) + intro z hz + exact ih z (by aesop) (hbody z (by aesop)) + +/-- Closing a variable and abstracting preserves the position of the contracted redex. -/ +lemma BetaAt.abs_close {x : Var} (h : BetaAt M M' i) (lc : LC M) : + BetaAt (M⟦0 ↜ x⟧.abs) (M'⟦0 ↜ x⟧.abs) i := by + apply BetaAt.abs ∅ + intro z _ + have lc' := h.lc_r lc + have hr : BetaAt (M[x := fvar z]) (M'[x := fvar z]) i := h.rename x z + grind + end LambdaCalculus.LocallyNameless.Untyped.Term end Cslib From b722eff9204c9c1574a85a4324e02bbe78d79016 Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Tue, 7 Jul 2026 22:22:27 -0600 Subject: [PATCH 06/11] add lemmas for leftmost reduction --- .../Untyped/LeftmostReduction.lean | 66 +++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean index 14e5728e0..e5b8ae487 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -93,18 +93,61 @@ lemma BetaAt.isAbs_r (h : BetaAt M N i) (ha : IsAbs M) : IsAbs N := by cases h exact .abs _ +/-- Leftmost reduction preserves being an abstraction. -/ +lemma Leftmost.steps_isAbs_r (h : M ↠ℓ N) (ha : IsAbs M) : IsAbs N := by + induction h with + | refl => exact ha + | tail _ step ih => exact step.isAbs_r ih + +/-- Left congruence for leftmost reduction, provided the target is not an abstraction. -/ +lemma Leftmost.steps_app_l_cong (h : L ↠ℓ L') (hna : ¬IsAbs L') : + app L M ↠ℓ app L' M := by + induction h + case refl => rfl + case tail P _ _ step ih => + have hnb : ¬IsAbs P := mt step.isAbs_r hna + exact (ih hnb).tail (step.appNoAbsL hnb) + /-- Reducing the operand across a non-abstraction normal form keeps the position. -/ lemma BetaAt.app_r_cong (h : BetaAt M M' i) (hL : NormalForm L) (hna : ¬IsAbs L) : BetaAt (app L M) (app L M') i := by have := h.appNoAbsR hna rwa [hL] at this +/-- Right congruence for leftmost reduction, provided the operator is a non-abstraction + normal form. -/ +lemma Leftmost.steps_app_r_cong (h : M ↠ℓ M') (hL : NormalForm L) (hna : ¬IsAbs L) : + app L M ↠ℓ app L M' := by + induction h with + | refl => rfl + | tail _ step ih => exact ih.tail (step.app_r_cong hL hna) + +/-- Congruence for leftmost reduction on applications whose reduced operator is a + non-abstraction normal form. -/ +lemma Leftmost.steps_app_cong (hL : L ↠ℓ L') (hM : M ↠ℓ M') + (hnf : NormalForm L') (hna : ¬IsAbs L') : app L M ↠ℓ app L' M' := + (steps_app_l_cong hL hna).trans (steps_app_r_cong hM hnf hna) + /-- The source of a Call-by-Name step is never an abstraction. -/ lemma cbn_not_isAbs (h : M ⭢ₙ N) : ¬IsAbs M := by intro ha cases ha trivial +/-- A single Call-by-Name step contracts the leftmost redex. -/ +lemma Leftmost.of_cbn_step (h : M ⭢ₙ N) : M ⭢ℓ N := by + induction h with + | base hb => + cases hb with + | beta lcm lcn => exact .outer lcm lcn + | app _ hMN ih => exact .appNoAbsL ih (cbn_not_isAbs hMN) + +/-- Call-by-Name reduction is contained in leftmost reduction. -/ +lemma Leftmost.of_cbn (h : M ↠ₙ N) : M ↠ℓ N := by + induction h with + | refl => rfl + | tail _ step ih => exact ih.tail (of_cbn_step step) + variable [DecidableEq Var] /-- Renaming a free variable preserves the number of redexes. -/ @@ -176,6 +219,29 @@ lemma BetaAt.abs_close {x : Var} (h : BetaAt M M' i) (lc : LC M) : have hr : BetaAt (M[x := fvar z]) (M'[x := fvar z]) i := h.rename x z grind +/-- Leftmost reduction preserves local closure. -/ +lemma Leftmost.steps_lc_r (h : M ↠ℓ M') (lc : LC M) : LC M' := by + induction h with + | refl => exact lc + | tail _ step ih => exact step.lc_r ih + +/-- Leftmost reduction is preserved by closing a variable and abstracting. -/ +lemma Leftmost.steps_abs_close {x : Var} (h : M ↠ℓ M') (lc : LC M) : + (M⟦0 ↜ x⟧.abs) ↠ℓ (M'⟦0 ↜ x⟧.abs) := by + induction h with + | refl => rfl + | tail hs step ih => exact ih.tail (step.abs_close (Leftmost.steps_lc_r hs lc)) + +/-- Cofinite congruence rule for leftmost reduction under an abstraction. -/ +lemma Leftmost.steps_abs_cong (xs : Finset Var) + (cofin : ∀ x ∉ xs, (M ^ fvar x) ↠ℓ (M' ^ fvar x)) (lc : LC (abs M)) : + abs M ↠ℓ abs M' := by + have ⟨w, _⟩ := fresh_exists <| free_union [fv] Var + rw [open_close w M 0 (by aesop), open_close w M' 0 (by aesop)] + have hstep := cofin w (by aesop) + have hlc := beta_lc lc (.fvar w) + exact Leftmost.steps_abs_close hstep hlc + end LambdaCalculus.LocallyNameless.Untyped.Term end Cslib From 68118496cb7044d64e1e81a7cc520b86e4df1d91 Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Tue, 7 Jul 2026 22:23:02 -0600 Subject: [PATCH 07/11] add leftmost reduction theorem --- .../Untyped/LeftmostReduction.lean | 24 +++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean index e5b8ae487..4c4124c54 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -242,6 +242,30 @@ lemma Leftmost.steps_abs_cong (xs : Finset Var) have hlc := beta_lc lc (.fvar w) exact Leftmost.steps_abs_close hstep hlc +/-- A standard reduction to a normal form is a leftmost reduction. -/ +theorem Leftmost.of_standard (h : M ⭢ₛ N) (hn : NormalForm N) : M ↠ℓ N := by + induction h + case fvar x => rfl + case app _ _ ihL ihM => + obtain ⟨hna, hL', hM'⟩ := hn.app_inv + exact Leftmost.steps_app_cong (ihL hL') (ihM hM') hL' hna + case abs xs hbody ih => + have lc := Standard.lc_l (Standard.abs xs hbody) + apply Leftmost.steps_abs_cong xs _ lc + intro x hx + exact ih x hx hn.abs_open + case rdx M N M' _ lcM lcN cbn stdP ih => + have s1 : Term.app M N ↠ℓ Term.app (Term.abs M') N := + of_cbn (CBN.steps_app_l_cong cbn lcN) + have s2 : Term.app (Term.abs M') N ⭢ℓ (M' ^ N) := + BetaAt.outer (CBN.steps_lc_r lcM cbn) lcN + exact (s1.tail s2).trans (ih hn) + +/-- The leftmost reduction theorem: if a term β-reduces to a normal form, then leftmost + reduction reaches it. -/ +theorem Leftmost.normalization (lc : LC M) (h : M ↠βᶠ N) (hn : NormalForm N) : M ↠ℓ N := + of_standard (.standardization lc h) hn + end LambdaCalculus.LocallyNameless.Untyped.Term end Cslib From 45c8341409f57d21ae2362d29b20832daa398339 Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Wed, 8 Jul 2026 13:21:00 -0600 Subject: [PATCH 08/11] replace aesop with grind --- .../LocallyNameless/Untyped/LeftmostReduction.lean | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean index 4c4124c54..31ee7f3de 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -188,10 +188,10 @@ lemma BetaAt.rename (h : BetaAt M M' i) (x y : Var) : simp only [subst_abs] apply BetaAt.abs <| free_union [fv] Var intro z hz - have hzx : x ≠ z := by aesop + have hzx : x ≠ z := by grind rw [← subst_open_var z x (fvar y) M hzx (.fvar y), ← subst_open_var z x (fvar y) M' hzx (.fvar y)] - exact ih z (by aesop) + exact ih z (by grind) /-- Contracting a redex preserves local closure. -/ lemma BetaAt.lc_r (h : BetaAt M M' i) (lc : LC M) : LC M' := by @@ -208,7 +208,7 @@ lemma BetaAt.lc_r (h : BetaAt M M' i) (lc : LC M) : LC M' := by | abs ys _ hbody => apply LC.abs (xs ∪ ys) intro z hz - exact ih z (by aesop) (hbody z (by aesop)) + exact ih z (by grind) (hbody z (by grind)) /-- Closing a variable and abstracting preserves the position of the contracted redex. -/ lemma BetaAt.abs_close {x : Var} (h : BetaAt M M' i) (lc : LC M) : @@ -237,8 +237,8 @@ lemma Leftmost.steps_abs_cong (xs : Finset Var) (cofin : ∀ x ∉ xs, (M ^ fvar x) ↠ℓ (M' ^ fvar x)) (lc : LC (abs M)) : abs M ↠ℓ abs M' := by have ⟨w, _⟩ := fresh_exists <| free_union [fv] Var - rw [open_close w M 0 (by aesop), open_close w M' 0 (by aesop)] - have hstep := cofin w (by aesop) + rw [open_close w M 0 (by grind), open_close w M' 0 (by grind)] + have hstep := cofin w (by grind) have hlc := beta_lc lc (.fvar w) exact Leftmost.steps_abs_close hstep hlc From ccddd9fb5ed3abdb47fd6d768fd4f87f3eb8fedd Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Wed, 8 Jul 2026 13:22:48 -0600 Subject: [PATCH 09/11] use dot notation --- .../LocallyNameless/Untyped/LeftmostReduction.lean | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean index 31ee7f3de..73340b39c 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -255,10 +255,8 @@ theorem Leftmost.of_standard (h : M ⭢ₛ N) (hn : NormalForm N) : M ↠ℓ N : intro x hx exact ih x hx hn.abs_open case rdx M N M' _ lcM lcN cbn stdP ih => - have s1 : Term.app M N ↠ℓ Term.app (Term.abs M') N := - of_cbn (CBN.steps_app_l_cong cbn lcN) - have s2 : Term.app (Term.abs M') N ⭢ℓ (M' ^ N) := - BetaAt.outer (CBN.steps_lc_r lcM cbn) lcN + have s1 : M.app N ↠ℓ M'.abs.app N := of_cbn (CBN.steps_app_l_cong cbn lcN) + have s2 : M'.abs.app N ⭢ℓ M' ^ N := .outer (CBN.steps_lc_r lcM cbn) lcN exact (s1.tail s2).trans (ih hn) /-- The leftmost reduction theorem: if a term β-reduces to a normal form, then leftmost From 6ed85b7c488a41f6141a1f6b1cbd69cb5c3b724a Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Wed, 8 Jul 2026 13:36:38 -0600 Subject: [PATCH 10/11] simplify BetaAt.rename proof --- .../LocallyNameless/Untyped/LeftmostReduction.lean | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean index 73340b39c..33e3d5efb 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -170,19 +170,17 @@ lemma BetaAt.rename (h : BetaAt M M' i) (x y : Var) : BetaAt (M[x := fvar y]) (M'[x := fvar y]) i := by induction h case outer lcm lcn => - rw [subst_app, subst_abs, subst_open x (fvar y) _ _ (.fvar y)] + rw [subst_open x (fvar y) _ _ (.fvar y)] exact .outer (subst_lc lcm (.fvar y)) (subst_lc lcn (.fvar y)) case appNoAbsL _ hna ih => - simp only [subst_app] exact .appNoAbsL ih (mt isAbs_subst_fvar.mp hna) case appAbsL _ ha ih => - simp only [subst_app] exact .appAbsL ih (isAbs_subst_fvar.mpr ha) case appNoAbsR M M' i N _ hna ih => - simp only [subst_app, ← countRedexes_subst_fvar N x y] + rw [← countRedexes_subst_fvar N x y] exact .appNoAbsR ih (mt isAbs_subst_fvar.mp hna) case appAbsR M M' i N _ ha ih => - simp only [subst_app, ← countRedexes_subst_fvar N x y] + rw [← countRedexes_subst_fvar N x y] exact .appAbsR ih (isAbs_subst_fvar.mpr ha) case abs M M' i xs _ ih => simp only [subst_abs] From 59ce2ac8b5e117cd7280284b7e138e16ec4e3258 Mon Sep 17 00:00:00 2001 From: Maximiliano Date: Thu, 9 Jul 2026 09:48:44 -0600 Subject: [PATCH 11/11] rename NormalForm to BetaNormal --- .../Untyped/LeftmostReduction.lean | 73 +++++++++---------- 1 file changed, 34 insertions(+), 39 deletions(-) diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean index 33e3d5efb..62268ed23 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -37,7 +37,7 @@ def countRedexes : Term Var → Nat | app m n => countRedexes m + countRedexes n /-- A term is in normal form when it contains no β-redexes. -/ -def NormalForm (m : Term Var) : Prop := countRedexes m = 0 +def BetaNormal (m : Term Var) : Prop := countRedexes m = 0 /-- `IsAbs m` holds when `m` is an abstraction. -/ inductive IsAbs : Term Var → Prop @@ -77,14 +77,14 @@ lemma countRedexes_openRec_fvar (M : Term Var) (k : Nat) (x : Var) : /-- In a normal-form application, both sides are normal and the operator is not an abstraction. -/ -lemma NormalForm.app_inv (h : NormalForm (app L M)) : - ¬IsAbs L ∧ NormalForm L ∧ NormalForm M := by - cases L <;> grind [NormalForm, countRedexes, IsAbs] +lemma BetaNormal.app_inv (h : BetaNormal (app L M)) : + ¬IsAbs L ∧ BetaNormal L ∧ BetaNormal M := by + cases L <;> grind [BetaNormal, countRedexes, IsAbs] /-- The body of a normal-form abstraction opens to a normal form. -/ -lemma NormalForm.abs_open {x : Var} (h : NormalForm (abs M)) : NormalForm (M ^ fvar x) := by +lemma BetaNormal.abs_open {x : Var} (h : BetaNormal (abs M)) : BetaNormal (M ^ fvar x) := by have e : countRedexes (M ^ fvar x) = countRedexes M := countRedexes_openRec_fvar M 0 x - rw [NormalForm, e] + rw [BetaNormal, e] exact h /-- Contracting a redex of an abstraction yields an abstraction. -/ @@ -109,14 +109,14 @@ lemma Leftmost.steps_app_l_cong (h : L ↠ℓ L') (hna : ¬IsAbs L') : exact (ih hnb).tail (step.appNoAbsL hnb) /-- Reducing the operand across a non-abstraction normal form keeps the position. -/ -lemma BetaAt.app_r_cong (h : BetaAt M M' i) (hL : NormalForm L) (hna : ¬IsAbs L) : +lemma BetaAt.app_r_cong (h : BetaAt M M' i) (hL : BetaNormal L) (hna : ¬IsAbs L) : BetaAt (app L M) (app L M') i := by have := h.appNoAbsR hna rwa [hL] at this /-- Right congruence for leftmost reduction, provided the operator is a non-abstraction normal form. -/ -lemma Leftmost.steps_app_r_cong (h : M ↠ℓ M') (hL : NormalForm L) (hna : ¬IsAbs L) : +lemma Leftmost.steps_app_r_cong (h : M ↠ℓ M') (hL : BetaNormal L) (hna : ¬IsAbs L) : app L M ↠ℓ app L M' := by induction h with | refl => rfl @@ -125,7 +125,7 @@ lemma Leftmost.steps_app_r_cong (h : M ↠ℓ M') (hL : NormalForm L) (hna : ¬I /-- Congruence for leftmost reduction on applications whose reduced operator is a non-abstraction normal form. -/ lemma Leftmost.steps_app_cong (hL : L ↠ℓ L') (hM : M ↠ℓ M') - (hnf : NormalForm L') (hna : ¬IsAbs L') : app L M ↠ℓ app L' M' := + (hnf : BetaNormal L') (hna : ¬IsAbs L') : app L M ↠ℓ app L' M' := (steps_app_l_cong hL hna).trans (steps_app_r_cong hM hnf hna) /-- The source of a Call-by-Name step is never an abstraction. -/ @@ -137,10 +137,10 @@ lemma cbn_not_isAbs (h : M ⭢ₙ N) : ¬IsAbs M := by /-- A single Call-by-Name step contracts the leftmost redex. -/ lemma Leftmost.of_cbn_step (h : M ⭢ₙ N) : M ⭢ℓ N := by induction h with - | base hb => - cases hb with - | beta lcm lcn => exact .outer lcm lcn - | app _ hMN ih => exact .appNoAbsL ih (cbn_not_isAbs hMN) + | base h_beta => + cases h_beta with + | beta lc_M lc_N => exact .outer lc_M lc_N + | app _ step_M ih => exact .appNoAbsL ih (cbn_not_isAbs step_M) /-- Call-by-Name reduction is contained in leftmost reduction. -/ lemma Leftmost.of_cbn (h : M ↠ₙ N) : M ↠ℓ N := by @@ -169,9 +169,9 @@ variable [HasFresh Var] lemma BetaAt.rename (h : BetaAt M M' i) (x y : Var) : BetaAt (M[x := fvar y]) (M'[x := fvar y]) i := by induction h - case outer lcm lcn => + case outer lc_M lc_N => rw [subst_open x (fvar y) _ _ (.fvar y)] - exact .outer (subst_lc lcm (.fvar y)) (subst_lc lcn (.fvar y)) + exact .outer (subst_lc lc_M (.fvar y)) (subst_lc lc_N (.fvar y)) case appNoAbsL _ hna ih => exact .appNoAbsL ih (mt isAbs_subst_fvar.mp hna) case appAbsL _ ha ih => @@ -182,31 +182,26 @@ lemma BetaAt.rename (h : BetaAt M M' i) (x y : Var) : case appAbsR M M' i N _ ha ih => rw [← countRedexes_subst_fvar N x y] exact .appAbsR ih (isAbs_subst_fvar.mpr ha) - case abs M M' i xs _ ih => - simp only [subst_abs] + case abs => apply BetaAt.abs <| free_union [fv] Var - intro z hz - have hzx : x ≠ z := by grind - rw [← subst_open_var z x (fvar y) M hzx (.fvar y), - ← subst_open_var z x (fvar y) M' hzx (.fvar y)] - exact ih z (by grind) + grind /-- Contracting a redex preserves local closure. -/ lemma BetaAt.lc_r (h : BetaAt M M' i) (lc : LC M) : LC M' := by induction h with - | outer lcm lcn => exact beta_lc lcm lcn + | outer lc_M lc_N => exact beta_lc lc_M lc_N | appNoAbsL _ _ ih | appAbsL _ _ ih => cases lc with - | app lcL lcR => exact .app (ih lcL) lcR + | app lc_L lc_R => exact .app (ih lc_L) lc_R | appNoAbsR _ _ ih | appAbsR _ _ ih => cases lc with - | app lcL lcR => exact .app lcL (ih lcR) + | app lc_L lc_R => exact .app lc_L (ih lc_R) | abs xs _ ih => cases lc with - | abs ys _ hbody => + | abs ys _ h_body => apply LC.abs (xs ∪ ys) intro z hz - exact ih z (by grind) (hbody z (by grind)) + exact ih z (by grind) (h_body z (by grind)) /-- Closing a variable and abstracting preserves the position of the contracted redex. -/ lemma BetaAt.abs_close {x : Var} (h : BetaAt M M' i) (lc : LC M) : @@ -228,7 +223,7 @@ lemma Leftmost.steps_abs_close {x : Var} (h : M ↠ℓ M') (lc : LC M) : (M⟦0 ↜ x⟧.abs) ↠ℓ (M'⟦0 ↜ x⟧.abs) := by induction h with | refl => rfl - | tail hs step ih => exact ih.tail (step.abs_close (Leftmost.steps_lc_r hs lc)) + | tail hs step ih => exact ih.tail (step.abs_close (steps_lc_r hs lc)) /-- Cofinite congruence rule for leftmost reduction under an abstraction. -/ lemma Leftmost.steps_abs_cong (xs : Finset Var) @@ -238,28 +233,28 @@ lemma Leftmost.steps_abs_cong (xs : Finset Var) rw [open_close w M 0 (by grind), open_close w M' 0 (by grind)] have hstep := cofin w (by grind) have hlc := beta_lc lc (.fvar w) - exact Leftmost.steps_abs_close hstep hlc + exact steps_abs_close hstep hlc /-- A standard reduction to a normal form is a leftmost reduction. -/ -theorem Leftmost.of_standard (h : M ⭢ₛ N) (hn : NormalForm N) : M ↠ℓ N := by +theorem Leftmost.of_standard (h : M ⭢ₛ N) (hn : BetaNormal N) : M ↠ℓ N := by induction h case fvar x => rfl case app _ _ ihL ihM => - obtain ⟨hna, hL', hM'⟩ := hn.app_inv - exact Leftmost.steps_app_cong (ihL hL') (ihM hM') hL' hna - case abs xs hbody ih => - have lc := Standard.lc_l (Standard.abs xs hbody) - apply Leftmost.steps_abs_cong xs _ lc + have ⟨hna, hL', hM'⟩ := hn.app_inv + exact steps_app_cong (ihL hL') (ihM hM') hL' hna + case abs xs h_body ih => + have lc := (Standard.abs xs h_body).lc_l + apply steps_abs_cong xs _ lc intro x hx exact ih x hx hn.abs_open - case rdx M N M' _ lcM lcN cbn stdP ih => - have s1 : M.app N ↠ℓ M'.abs.app N := of_cbn (CBN.steps_app_l_cong cbn lcN) - have s2 : M'.abs.app N ⭢ℓ M' ^ N := .outer (CBN.steps_lc_r lcM cbn) lcN + case rdx M N M' _ lc_M lc_N cbn std_P ih => + have s1 : M.app N ↠ℓ M'.abs.app N := of_cbn (CBN.steps_app_l_cong cbn lc_N) + have s2 : M'.abs.app N ⭢ℓ M' ^ N := .outer (CBN.steps_lc_r lc_M cbn) lc_N exact (s1.tail s2).trans (ih hn) /-- The leftmost reduction theorem: if a term β-reduces to a normal form, then leftmost reduction reaches it. -/ -theorem Leftmost.normalization (lc : LC M) (h : M ↠βᶠ N) (hn : NormalForm N) : M ↠ℓ N := +theorem Leftmost.normalization (lc : LC M) (h : M ↠βᶠ N) (hn : BetaNormal N) : M ↠ℓ N := of_standard (.standardization lc h) hn end LambdaCalculus.LocallyNameless.Untyped.Term