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/LcAt.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean index 539e92ff8..4a74cf41d 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean @@ -86,6 +86,16 @@ attribute [scoped grind .] LC.fvar LC.app inductive Value : Term Var → Prop | abs (e : Term Var) : e.abs.LC → e.abs.Value +/-- `IsAbs m` holds when `m` is an abstraction. -/ +@[scoped grind] +inductive IsAbs : Term Var → Prop +| abs (m : Term Var) : IsAbs (abs m) + +instance (m : Term Var) : Decidable (IsAbs m) := by + cases m + case abs => exact isTrue (.abs _) + all_goals exact isFalse (by intro _; contradiction) + set_option linter.tacticAnalysis.verifyGrindOnly false in /-- `M` is `LcAt 0` if and only if `M` is locally closed. -/ theorem lcAt_iff_LC (M : Term Var) [HasFresh Var] : LcAt 0 M ↔ M.LC := by diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean new file mode 100644 index 000000000..1dd5a6139 --- /dev/null +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LeftmostReduction.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2026 Maximiliano Onofre Martínez. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Maximiliano Onofre Martínez +-/ + +module + +public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.StandardReduction + +/-! # The Leftmost Reduction Theorem + +## Reference + +* [M. Copes, *A machine-checked proof of the Standardization Theorem in λ-calculus*][Copes2018] + +-/ + +@[expose] public section + +set_option linter.unusedDecidableInType false + +namespace Cslib + +universe u + +variable {Var : Type u} + +namespace LambdaCalculus.LocallyNameless.Untyped.Term + +/-- A term is in normal form when it contains no β-redexes. -/ +def BetaNormal (m : Term Var) : Prop := countRedexes m = 0 + +/-- Leftmost reduction: a β-reduction contracting the redex at position 0. -/ +@[reduction_sys "ℓ"] +abbrev Leftmost : Term Var → Term Var → Prop := BetaAt 0 + +variable {L L' M M' N : Term Var} {i : Nat} + +/-- In a normal-form application, both sides are normal and the operator is not an + abstraction. -/ +lemma BetaNormal.app_inv (h : BetaNormal (app L M)) : + ¬IsAbs L ∧ BetaNormal L ∧ BetaNormal M := by + cases L <;> grind [BetaNormal, countRedexes] + +/-- The body of a normal-form abstraction opens to a normal form. -/ +lemma BetaNormal.abs_open {x : Var} (h : BetaNormal (abs M)) : BetaNormal (M ^ fvar x) := by + rw [BetaNormal, countRedexes_open_fvar] + exact h + +/-- Leftmost reduction preserves being an abstraction. -/ +lemma Leftmost.steps_isAbs_r (h : M ↠ℓ N) (ha : IsAbs M) : IsAbs N := by + induction h with + | refl => exact ha + | tail _ step ih => exact step.isAbs_r ih + +/-- Left congruence for leftmost reduction, provided the target is not an abstraction. -/ +lemma Leftmost.steps_app_l_cong (h : L ↠ℓ L') (hna : ¬IsAbs L') : + app L M ↠ℓ app L' M := by + induction h + case refl => rfl + case tail P _ _ step ih => + have hnb : ¬IsAbs P := mt step.isAbs_r hna + exact (ih hnb).tail (step.appNoAbsL hnb) + +/-- Reducing the operand across a non-abstraction normal form keeps the position. -/ +lemma BetaAt.app_r_cong (h : BetaAt i M M') (hL : BetaNormal L) (hna : ¬IsAbs L) : + BetaAt i (app L M) (app L M') := by + have := h.appNoAbsR hna + rwa [hL] at this + +/-- Right congruence for leftmost reduction, provided the operator is a non-abstraction + normal form. -/ +lemma Leftmost.steps_app_r_cong (h : M ↠ℓ M') (hL : BetaNormal L) (hna : ¬IsAbs L) : + app L M ↠ℓ app L M' := by + induction h with + | refl => rfl + | tail _ step ih => exact ih.tail (step.app_r_cong hL hna) + +/-- Congruence for leftmost reduction on applications whose reduced operator is a + non-abstraction normal form. -/ +lemma Leftmost.steps_app_cong (hL : L ↠ℓ L') (hM : M ↠ℓ M') + (hnf : BetaNormal L') (hna : ¬IsAbs L') : app L M ↠ℓ app L' M' := + (steps_app_l_cong hL hna).trans (steps_app_r_cong hM hnf hna) + +/-- Call-by-Name reduction is contained in leftmost reduction. -/ +lemma Leftmost.of_cbn (h : M ↠ₙ N) : M ↠ℓ N := by + induction h with + | refl => rfl + | tail _ step ih => exact ih.tail (BetaAt.of_cbn_step step) + +variable [DecidableEq Var] [HasFresh Var] + +/-- Leftmost reduction preserves local closure. -/ +lemma Leftmost.steps_lc_r (h : M ↠ℓ M') (lc : LC M) : LC M' := by + induction h with + | refl => exact lc + | tail _ step ih => exact step.lc_r ih + +/-- Leftmost reduction is preserved by closing a variable and abstracting. -/ +lemma Leftmost.steps_abs_close {x : Var} (h : M ↠ℓ M') (lc : LC M) : + (M⟦0 ↜ x⟧.abs) ↠ℓ (M'⟦0 ↜ x⟧.abs) := by + induction h with + | refl => rfl + | tail hs step ih => exact ih.tail (step.abs_close (steps_lc_r hs lc)) + +/-- Cofinite congruence rule for leftmost reduction under an abstraction. -/ +lemma Leftmost.steps_abs_cong (xs : Finset Var) + (cofin : ∀ x ∉ xs, (M ^ fvar x) ↠ℓ (M' ^ fvar x)) (lc : LC (abs M)) : + abs M ↠ℓ abs M' := by + have ⟨w, _⟩ := fresh_exists <| free_union [fv] Var + rw [open_close w M 0 (by grind), open_close w M' 0 (by grind)] + have hstep := cofin w (by grind) + have hlc := beta_lc lc (.fvar w) + exact steps_abs_close hstep hlc + +/-- A standard reduction to a normal form is a leftmost reduction. -/ +theorem Leftmost.of_standard (h : M ⭢ₛ N) (hn : BetaNormal N) : M ↠ℓ N := by + induction h + case fvar x => rfl + case app _ _ ihL ihM => + have ⟨hna, hL', hM'⟩ := hn.app_inv + exact steps_app_cong (ihL hL') (ihM hM') hL' hna + case abs xs h_body ih => + have lc := (Standard.abs xs h_body).lc_l + apply steps_abs_cong xs _ lc + intro x hx + exact ih x hx hn.abs_open + case rdx M N M' _ lc_M lc_N cbn std_P ih => + have s1 : M.app N ↠ℓ M'.abs.app N := of_cbn (CBN.steps_app_l_cong cbn lc_N) + have s2 : M'.abs.app N ⭢ℓ M' ^ N := .outer (CBN.steps_lc_r lc_M cbn) lc_N + exact (s1.tail s2).trans (ih hn) + +/-- The leftmost reduction theorem: if a term β-reduces to a normal form, then leftmost + reduction reaches it. -/ +theorem Leftmost.normalization (lc : LC M) (h : M ↠βᶠ N) (hn : BetaNormal N) : M ↠ℓ N := + of_standard (.standardization lc h) hn + +end LambdaCalculus.LocallyNameless.Untyped.Term + +end Cslib diff --git a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StandardReduction.lean b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StandardReduction.lean index e9cfe09ec..74919b2cf 100644 --- a/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StandardReduction.lean +++ b/Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/StandardReduction.lean @@ -10,9 +10,10 @@ public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.CallByName /-! # Standard Reduction and the Standardization Theorem -## Reference +## References * [B. Calisto, *Formalization in Coq of the Standardization Theorem for λ-calculus*][Calisto2022] +* [M. Copes, *A machine-checked proof of the Standardization Theorem in λ-calculus*][Copes2018] -/ @@ -28,6 +29,36 @@ 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 m + countRedexes n + 1 +| app m n => countRedexes m + countRedexes n + +/-- `BetaAt i M N` reduces the redex at position `i` of `M` to obtain `N`; + positions are counted from left to right. -/ +inductive BetaAt : Nat → Term Var → Term Var → Prop +/-- The outermost redex sits at position `0`. -/ +| outer : LC (abs M) → LC N → BetaAt 0 (app (abs M) N) (M ^ N) +/-- Reducing the operator advances the position by one when the operator is an abstraction. -/ +| appL : BetaAt i M M' → BetaAt (i + if IsAbs M then 1 else 0) (app M N) (app M' N) +/-- Reducing the operand adds the operator's redex count, plus one when it is an abstraction. -/ +| appR : BetaAt i M M' → + BetaAt (i + countRedexes N + if IsAbs N then 1 else 0) (app N M) (app N M') +/-- Reducing under a binder keeps the position. -/ +| abs (xs : Finset Var) : + (∀ x ∉ xs, BetaAt i (M ^ fvar x) (M' ^ fvar x)) → BetaAt i (abs M) (abs M') + +/-- A standard β-reduction sequence from `M` to `N`: the contracted redex positions are + non-decreasing and all at least `n`. -/ +inductive StandardSeq : Nat → Term Var → Term Var → Prop +/-- The empty sequence is standard for any lower bound. -/ +| refl : StandardSeq n M M +/-- A first step at position `i ≥ n`, followed by a standard sequence bounded below by `i`. -/ +| head : BetaAt i M P → n ≤ i → StandardSeq i P N → StandardSeq n M N + /-- The Standard reduction relation. -/ @[reduction_sys "ₛ"] inductive Standard : Term Var → Term Var → Prop @@ -41,7 +72,27 @@ inductive Standard : Term Var → Term Var → Prop /-- Standard reduction of a head redex. -/ | rdx : LC m → LC n → m ↠ₙ (abs m') → Standard (m' ^ n) p → Standard (app m n) p -variable {M N P M' N' : Term Var} +variable {L L' M M' N N' P : Term Var} {i m n : Nat} + +/-- Reducing a non-abstraction operator keeps the position. -/ +lemma BetaAt.appNoAbsL (h : BetaAt i M M') (hna : ¬IsAbs M) : + BetaAt i (app M N) (app M' N) := by + simpa [if_neg hna] using h.appL + +/-- Reducing an abstraction operator advances the position by one. -/ +lemma BetaAt.appAbsL (h : BetaAt i M M') (ha : IsAbs M) : + BetaAt (i + 1) (app M N) (app M' N) := by + simpa [if_pos ha] using h.appL + +/-- Reducing the operand adds the redex count of a non-abstraction operator. -/ +lemma BetaAt.appNoAbsR (h : BetaAt i M M') (hna : ¬IsAbs N) : + BetaAt (i + countRedexes N) (app N M) (app N M') := by + simpa [if_neg hna] using h.appR (N := N) + +/-- Reducing the operand adds the redex count of an abstraction operator, plus one. -/ +lemma BetaAt.appAbsR (h : BetaAt i M M') (ha : IsAbs N) : + BetaAt (i + countRedexes N + 1) (app N M) (app N M') := by + simpa [if_pos ha] using h.appR (N := N) /-- The left side of a standard reduction is locally closed. -/ lemma Standard.lc_l (step : M ⭢ₛ N) : LC M := by @@ -91,7 +142,196 @@ lemma Standard.cbn_trans (h1 : M ↠ₙ P) (h2 : P ⭢ₛ N) : M ⭢ₛ N := by lemma Standard.of_cbn (step : M ↠ₙ N) (lc_N : LC N) : M ⭢ₛ N := cbn_trans step (lc_refl N lc_N) -variable [DecidableEq Var] [HasFresh Var] +/-- 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] + +/-- Opening the outermost binder with a free variable preserves the number of redexes. -/ +lemma countRedexes_open_fvar (M : Term Var) (x : Var) : + countRedexes (M ^ fvar x) = countRedexes M := + countRedexes_openRec_fvar M 0 x + +/-- An application has at least as many redexes as its operator and operand combined. -/ +lemma countRedexes_app_le (M N : Term Var) : + countRedexes M + countRedexes N ≤ countRedexes (app M N) := by + cases M <;> grind [countRedexes] + +/-- An application with an abstraction operator has one more redex than its parts. -/ +lemma countRedexes_app_abs {M : Term Var} (ha : IsAbs M) (N : Term Var) : + countRedexes (app M N) = countRedexes M + countRedexes N + 1 := by + cases ha; grind [countRedexes] + +/-- Contracting a redex of an abstraction yields an abstraction. -/ +lemma BetaAt.isAbs_r (h : BetaAt i M N) (ha : IsAbs M) : IsAbs N := by + cases ha + cases h + exact .abs _ + +/-- The source of a Call-by-Name step is never an abstraction. -/ +lemma cbn_not_isAbs (h : M ⭢ₙ N) : ¬IsAbs M := by + intro ha + cases ha + trivial + +/-- A single Call-by-Name step contracts the redex at position `0`. -/ +lemma BetaAt.of_cbn_step (h : M ⭢ₙ N) : BetaAt 0 M N := by + induction h with + | base h_beta => + cases h_beta with + | beta lc_M lc_N => exact .outer lc_M lc_N + | app _ step_M ih => exact .appNoAbsL ih (cbn_not_isAbs step_M) + +/-- A standard sequence remains standard under a smaller lower bound. -/ +lemma StandardSeq.mono (h : StandardSeq n M N) (hmn : m ≤ n) : StandardSeq m M N := by + cases h with + | refl => exact .refl + | head step hni tail => exact .head step (le_trans hmn hni) tail + +/-- Standard sequences preserve being an abstraction. -/ +lemma StandardSeq.isAbs_r (h : StandardSeq n M N) (ha : IsAbs M) : IsAbs N := by + induction h with + | refl => exact ha + | head step _ _ ih => exact ih (step.isAbs_r ha) + +/-- A standard sequence stays standard when preceded by a Call-by-Name reduction. -/ +lemma StandardSeq.cbn_head (h : M ↠ₙ P) (hseq : StandardSeq 0 P N) : + StandardSeq 0 M N := by + induction h with + | refl => exact hseq + | tail _ step ih => exact ih (.head (BetaAt.of_cbn_step step) (Nat.le_refl 0) hseq) + +/-- Right congruence for standard sequences when the operator is an abstraction. -/ +lemma StandardSeq.app_r_abs (h : StandardSeq n M M') (ha : IsAbs L) : + StandardSeq (n + countRedexes L + 1) (app L M) (app L M') := by + induction h with + | refl => exact .refl + | head step hni tail ih => exact .head (step.appAbsR ha) (by omega) ih + +/-- Right congruence for standard sequences when the operator is a non-abstraction. -/ +lemma StandardSeq.app_r_noAbs (h : StandardSeq n M M') (hna : ¬IsAbs L) : + StandardSeq (n + countRedexes L) (app L M) (app L M') := by + induction h with + | refl => exact .refl + | head step hni tail ih => exact .head (step.appNoAbsR hna) (by omega) ih + +/-- Renaming a free variable preserves the number of redexes. -/ +lemma countRedexes_subst_fvar [DecidableEq Var] (M : Term Var) (x y : Var) : + countRedexes (M[x := fvar y]) = countRedexes M := by + induction M with + | fvar z => simp only [subst_fvar]; split <;> rfl + | bvar => rfl + | abs M ih => grind [countRedexes] + | app L R ihL ihR => cases L <;> grind [countRedexes] + +/-- Renaming a free variable preserves being an abstraction. -/ +lemma isAbs_subst_fvar [DecidableEq Var] {x y : Var} : IsAbs (M[x := fvar y]) ↔ IsAbs M := by + cases M <;> grind + +/-- A `BetaAt` step is a full β-step. -/ +lemma BetaAt.to_step [DecidableEq Var] (h : BetaAt i M N) (lc : LC M) : M ⭢βᶠ N := by + induction h with + | outer lc_M lc_N => exact .base (.beta lc_M lc_N) + | appL _ ih => + cases lc with + | app lc_L lc_R => exact .appR lc_R (ih lc_L) + | appR _ ih => + cases lc with + | app lc_L lc_R => exact .appL lc_L (ih lc_R) + | abs xs _ ih => + cases lc with + | abs ys _ h_body => + apply Xi.abs (xs ∪ ys) + intro z hz + exact ih z (by grind) (h_body z (by grind)) + +variable [HasFresh Var] + +/-- The position of a contracted redex is at most the redex count of the result. -/ +lemma BetaAt.le_countRedexes (h : BetaAt i M N) : i ≤ countRedexes N := by + induction h with + | outer => exact Nat.zero_le _ + | appL step => + split + · rw [countRedexes_app_abs (step.isAbs_r (by assumption))] + omega + · exact le_trans (by omega) (countRedexes_app_le _ _) + | appR => + split + · rw [countRedexes_app_abs (by assumption)] + omega + · exact le_trans (by omega) (countRedexes_app_le _ _) + | abs xs => + have := fresh_exists xs + grind [countRedexes_open_fvar, countRedexes] + +/-- In a nonempty standard sequence the lower bound is at most the target's redex count. -/ +lemma StandardSeq.bound_le (h : StandardSeq n M N) : n ≤ countRedexes N ∨ M = N := by + induction h with + | refl => exact .inr rfl + | head step hni _ ih => + left + rcases ih with hle | rfl + · omega + · exact le_trans hni step.le_countRedexes + +/-- The leading position of a standard sequence is at most the redex count of its target. -/ +lemma StandardSeq.head_le (step : BetaAt i M P) (tail : StandardSeq i P N) : + i ≤ countRedexes N := by + rcases tail.bound_le with h | rfl + · exact h + · exact step.le_countRedexes + +/-- The reduction of an abstraction operator followed by an application sequence + is a standard sequence. -/ +lemma StandardSeq.app_l_trans_abs (hL : StandardSeq n L L') (ha : IsAbs L) + (hm : countRedexes L' + 1 ≤ m) (hnm : n + 1 ≤ m) + (hM : StandardSeq m (app L' M) (app L' M')) : + StandardSeq (n + 1) (app L M) (app L' M') := by + induction hL with + | refl => exact hM.mono hnm + | head step hni tail ih => + have hseam := StandardSeq.head_le step tail + exact .head (step.appAbsL ha) (by omega) (ih (step.isAbs_r ha) hm (by omega) hM) + +/-- The reduction of an operator ending in an abstraction followed by an application sequence + is a standard sequence. -/ +lemma StandardSeq.app_l_trans (hL : StandardSeq n L L') (ha : IsAbs L') + (hm : countRedexes L' + 1 ≤ m) (hnm : n ≤ m) + (hM : StandardSeq m (app L' M) (app L' M')) : StandardSeq n (app L M) (app L' M') := by + induction hL + case refl => exact hM.mono hnm + case head _ K _ _ _ step hni tail ih => + have hseam := StandardSeq.head_le step tail + by_cases haK : IsAbs K + · exact .head (step.appAbsL haK) (by omega) + (app_l_trans_abs tail (step.isAbs_r haK) hm (by omega) hM) + · exact .head (step.appNoAbsL haK) hni (ih ha hm (by omega) hM) + +/-- The reduction of a non-abstraction operator followed by an application sequence + is a standard sequence. -/ +lemma StandardSeq.app_l_trans_noAbs (hL : StandardSeq n L L') (hna : ¬IsAbs L') + (hm : countRedexes L' ≤ m) (hnm : n ≤ m) + (hM : StandardSeq m (app L' M) (app L' M')) : StandardSeq n (app L M) (app L' M') := by + induction hL with + | refl => exact hM.mono hnm + | head step hni tail ih => + have hseam := StandardSeq.head_le step tail + have hP := mt tail.isAbs_r hna + exact .head (step.appNoAbsL (mt step.isAbs_r hP)) hni (ih hna hm (by omega) hM) + +/-- If operator and operand each reduce by a standard sequence, so does the application. -/ +lemma StandardSeq.app_cong (hL : StandardSeq 0 L L') (hM : StandardSeq 0 M M') : + StandardSeq 0 (app L M) (app L' M') := by + by_cases ha : IsAbs L' + · exact hL.app_l_trans ha (by omega) (Nat.zero_le _) (hM.app_r_abs ha) + · exact hL.app_l_trans_noAbs ha (by omega) (Nat.zero_le _) (hM.app_r_noAbs ha) + +variable [DecidableEq Var] /-- Standard reduction is preserved by substitution. -/ lemma Standard.subst (hM : M ⭢ₛ M') (hN : N ⭢ₛ N') (x : Var) (lc_N : LC N) (lc_N' : LC N') : @@ -217,6 +457,100 @@ theorem Standard.standardization (lc_M : LC M) (step : M ↠βᶠ N) : M ⭢ₛ theorem Standard.iff_redex (lc_M : LC M) : M ⭢ₛ N ↔ M ↠βᶠ N := ⟨to_redex, standardization lc_M⟩ +/-- Renaming a free variable preserves the position of the contracted redex. -/ +lemma BetaAt.rename (h : BetaAt i M M') (x y : Var) : + BetaAt i (M[x := fvar y]) (M'[x := fvar y]) := by + induction h with + | outer lc_M lc_N => + rw [subst_open x (fvar y) _ _ (.fvar y)] + exact .outer (subst_lc lc_M (.fvar y)) (subst_lc lc_N (.fvar y)) + | appL _ ih => + split + · exact ih.appAbsL (isAbs_subst_fvar.mpr (by assumption)) + · exact ih.appNoAbsL (mt isAbs_subst_fvar.mp (by assumption)) + | appR _ ih => + rw [← countRedexes_subst_fvar _ x y] + split + · exact ih.appAbsR (isAbs_subst_fvar.mpr (by assumption)) + · exact ih.appNoAbsR (mt isAbs_subst_fvar.mp (by assumption)) + | abs => + apply BetaAt.abs <| free_union [fv] Var + grind + +/-- Contracting a redex preserves local closure. -/ +lemma BetaAt.lc_r (h : BetaAt i M M') (lc : LC M) : LC M' := by + induction h with + | outer lc_M lc_N => exact beta_lc lc_M lc_N + | appL _ ih => + cases lc with + | app lc_L lc_R => exact .app (ih lc_L) lc_R + | appR _ ih => + cases lc with + | app lc_L lc_R => exact .app lc_L (ih lc_R) + | abs xs _ ih => + cases lc with + | abs ys _ h_body => + apply LC.abs (xs ∪ ys) + intro z hz + exact ih z (by grind) (h_body z (by grind)) + +/-- Closing a variable and abstracting preserves the position of the contracted redex. -/ +lemma BetaAt.abs_close {x : Var} (h : BetaAt i M M') (lc : LC M) : + BetaAt i (M⟦0 ↜ x⟧.abs) (M'⟦0 ↜ x⟧.abs) := by + apply BetaAt.abs ∅ + intro z _ + have lc' := h.lc_r lc + have hr : BetaAt i (M[x := fvar z]) (M'[x := fvar z]) := h.rename x z + grind + +/-- Closing a variable and abstracting preserves a standard sequence. -/ +lemma StandardSeq.abs_close {x : Var} (h : StandardSeq i M M') (lc : LC M) : + StandardSeq i (M⟦0 ↜ x⟧.abs) (M'⟦0 ↜ x⟧.abs) := by + induction h with + | refl => exact .refl + | head step hni tail ih => exact .head (step.abs_close lc) hni (ih (step.lc_r lc)) + +/-- Cofinite congruence rule for standard sequences under an abstraction. -/ +lemma StandardSeq.abs_cong (xs : Finset Var) + (cofin : ∀ x ∉ xs, StandardSeq i (M ^ fvar x) (M' ^ fvar x)) (lc : LC (abs M)) : + StandardSeq i (abs M) (abs M') := by + have ⟨w, _⟩ := fresh_exists <| free_union [fv] Var + rw [open_close w M 0 (by grind), open_close w M' 0 (by grind)] + have hseq := cofin w (by grind) + have hlc := beta_lc lc (.fvar w) + exact hseq.abs_close hlc + +/-- A standard sequence is a full β-reduction. -/ +lemma StandardSeq.to_redex (h : StandardSeq i M N) (lc_M : LC M) : M ↠βᶠ N := by + induction h with + | refl => rfl + | head step _ _ ih => exact (ih (step.lc_r lc_M)).head (step.to_step lc_M) + +/-- A standard reduction gives a standard β-reduction sequence. -/ +theorem Standard.to_seq (h : M ⭢ₛ N) : StandardSeq 0 M N := by + induction h + case fvar x => exact .refl + case app _ _ ihL ihM => exact ihL.app_cong ihM + case abs xs h_body ih => exact .abs_cong xs ih ((Standard.abs xs h_body).lc_l) + case rdx K P K' _ lc_K lc_P cbn _ ih => + have cbn_full : K.app P ↠ₙ K' ^ P := + (CBN.steps_app_l_cong cbn lc_P).tail (.base (.beta (CBN.steps_lc_r lc_K cbn) lc_P)) + exact StandardSeq.cbn_head cbn_full ih + +/-- A standard β-reduction sequence gives a standard reduction. -/ +theorem StandardSeq.to_standard (h : StandardSeq i M N) (lc_M : LC M) : M ⭢ₛ N := by + induction h with + | refl => exact Standard.lc_refl _ lc_M + | head step _ _ ih => + exact (Standard.of_beta_step (step.to_step lc_M) lc_M).trans (ih (step.lc_r lc_M)) + +/-- Standard reduction coincides with the existence of a standard β-reduction sequence. -/ +theorem Standard.iff_seq (lc_M : LC M) : M ⭢ₛ N ↔ StandardSeq 0 M N := by + constructor + · exact Standard.to_seq + · intro h + exact h.to_standard lc_M + end LambdaCalculus.LocallyNameless.Untyped.Term end Cslib diff --git a/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