Skip to content

feat: helper lemmas for use in the planned strong norm proof #381

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
WegmannDavid wants to merge 12 commits into
base: main
Choose a base branch
from
+105 −0
Open

feat: helper lemmas for use in the planned strong norm proof #381

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
12 commits
Select commit Hold shift + click to select a range
c9d1677
added helper lemmas for use in the planned strong norm proof
WegmannDavid Feb 28, 2026
e70160a
whitespace in Propertires
chenson2018 Mar 1, 2026
2b7143f
Apply suggestion from @chenson2018
WegmannDavid Mar 1, 2026
ec6c1ca
Apply suggestion from @chenson2018
WegmannDavid Mar 1, 2026
5923365
Apply suggestion from @chenson2018
WegmannDavid Mar 1, 2026
4763a10
Apply suggestion from @chenson2018
WegmannDavid Mar 1, 2026
f890c5c
Apply suggestion from @chenson2018
WegmannDavid Mar 1, 2026
6139222
Apply suggestion from @chenson2018
WegmannDavid Mar 1, 2026
c9e3055
Apply suggestion from @chenson2018
WegmannDavid Mar 1, 2026
13a860b
Apply suggestion from @chenson2018
WegmannDavid Mar 1, 2026
40b226d
Apply suggestion from @chenson2018
WegmannDavid Mar 1, 2026
50ed967
Apply suggestion from @chenson2018
WegmannDavid Mar 1, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
94 changes: 94 additions & 0 deletions Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/FullBeta.lean
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ module

public import Cslib.Foundations.Data.Relation
public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.Properties
public import Cslib.Languages.LambdaCalculus.LocallyNameless.Untyped.LcAt

public section

Expand Down Expand Up @@ -55,6 +56,8 @@ lemma step_lc_l (step : M ⭢βᶠ M') : LC M := by
induction step <;> constructor
all_goals assumption



/-- Left congruence rule for application in multiple reduction. -/
@[scoped grind ←]
theorem redex_app_l_cong (redex : M ↠βᶠ M') (lc_N : LC N) : app M N ↠βᶠ app M' N := by
Expand All @@ -74,6 +77,9 @@ lemma step_lc_r (step : M ⭢βᶠ M') : LC M' := by
case' abs => constructor; assumption
all_goals grind

lemma steps_lc_or_rfl {M M' : Term Var} (redex : M ↠βᶠ M') : (LC M ∧ LC M') ∨ M = M' := by
grind

/-- Substitution respects a single reduction step. -/
lemma redex_subst_cong (s s' : Term Var) (x y : Var) (step : s ⭢βᶠ s') :
s [ x := fvar y ] ⭢βᶠ s' [ x := fvar y ] := by
Expand All @@ -86,6 +92,20 @@ lemma redex_subst_cong (s s' : Term Var) (x y : Var) (step : s ⭢βᶠ s') :
case abs => grind [abs <| free_union Var]
all_goals grind

/-- Substitution respects a single reduction step. -/
Copy link
Collaborator

@chenson2018 chenson2018 Mar 1, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is now more general than the above, so we should have

/-- Substitution of a locally closed term respects a single reduction step. -/
lemma redex_subst_cong_lc (s s' t : Term Var) (x : Var) (step : s ⭢βᶠ s') (h_lc : LC t) :
    s [ x := t ] ⭢βᶠ s' [ x := t ] := ... -- proof omitted

/-- Substitution respects a single reduction step of a free variable. -/
lemma redex_subst_cong (s s' : Term Var) (x y : Var) (step : s ⭢βᶠ s') :
    s [ x := fvar y ] ⭢βᶠ s' [ x := fvar y ] := by
  grind [redex_subst_cong_lc]

Please note that I tweaked the docstrings a bit.

(The redex_subst_cong name should probably change, but these earliest modules have bad naming in general so I'll come back and do that myself.)

lemma redex_subst_cong_lc (s s' t : Term Var) (x : Var) (step : s ⭢βᶠ s') (h_lc : LC t) :
s [ x := t ] ⭢βᶠ s' [ x := t ] := by
induction step with
| beta => grind [subst_open, beta]
| abs => grind [abs <| free_union Var]
| _ => grind

Copy link
Collaborator

@chenson2018 chenson2018 Mar 1, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Please only leave one newline between each theorem.







/-- Abstracting then closing preserves a single reduction. -/
lemma step_abs_close {x : Var} (step : M ⭢βᶠ M') : M⟦0 ↜ x⟧.abs ⭢βᶠ M'⟦0 ↜ x⟧.abs := by
grind [abs ∅, redex_subst_cong]
Expand All @@ -97,13 +117,87 @@ lemma redex_abs_close {x : Var} (step : M ↠βᶠ M') : (M⟦0 ↜ x⟧.abs ↠
case single ih => exact Relation.ReflTransGen.single (step_abs_close ih)
case trans l r => exact Relation.ReflTransGen.trans l r

/-- Multiple reduction of opening implies multiple reduction of abstraction. -/
theorem step_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 [fv] Var
rw [open_close fresh M 0 ?_, open_close fresh M' 0 ?_]
all_goals grind [step_abs_close]

/-- 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 [fv] Var
rw [open_close fresh M 0 ?_, open_close fresh M' 0 ?_]
all_goals grind [redex_abs_close]

theorem redex_abs_fvar_finset_exists (xs : Finset Var)
Copy link
Collaborator

@chenson2018 chenson2018 Mar 1, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm not sure I'd add this as a theorem, because it is exactly the definition of the constructor. Anywhere (like below in steps_open_l_abs) you would use this, you can just do cases on the M.abs ⭢βᶠ M'.abs and get the same result.

Copy link
Author

@WegmannDavid WegmannDavid Mar 1, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You are right.

(M M' : Term Var)
(step : M.abs ⭢βᶠ M'.abs) :
∃ (L : Finset Var), ∀ x ∉ L, (M ^ fvar x) ⭢βᶠ (M' ^ fvar x) := by
cases step
case abs L cofin => exists L


lemma step_open_cong
(s s' t) (L : Finset Var) (step : ∀ x ∉ L, (s ^ fvar x) ⭢βᶠ (s' ^ fvar x)) (h_lc : LC t) :
(s ^ t) ⭢βᶠ (s' ^ t) := by
have ⟨x, _⟩ := fresh_exists <| free_union [fv] Var
grind [subst_intro, redex_subst_cong_lc]

lemma invert_steps_abs {s t : Term Var} (step : s.abs ↠βᶠ t) :
∃ (s' : Term Var), s.abs ↠βᶠ s'.abs ∧ t = s'.abs := by
induction step with
| refl => grind
| tail _ step _ => cases step with grind [step_abs_cong (free_union Var)]



lemma steps_open_l_abs
(s s' t : Term Var) (steps : s.abs ↠βᶠ s'.abs) (lc_s : LC s.abs) (lc_t : LC t) :
(s ^ t) ↠βᶠ (s' ^ t) := by
generalize eq : s.abs = s_abs at steps
generalize eq' : s'.abs = s'_abs at steps
induction steps generalizing s s' with
| refl => grind
| tail _ step ih =>
specialize ih s
cases step with grind [invert_steps_abs, step_open_cong (L := free_union Var)]

lemma step_subst_r {x : Var} (s t t' : Term Var) (step : t ⭢βᶠ t') (h_lc : LC s) :
(s [ x := t ]) ↠βᶠ (s [ x := t' ]) := by
induction h_lc with
| fvar y => grind
| abs => grind [redex_abs_cong (free_union Var)]
| @app l r =>
calc
(l.app r)[x:=t] ↠βᶠ l[x := t].app (r[x:=t']) := by grind
_ ↠βᶠ (l.app r)[x:=t'] := by grind

lemma steps_subst_cong2 {x : Var} (s t t' : Term Var) (step : t ↠βᶠ t') (h_lc : LC s) :
Copy link
Collaborator

@chenson2018 chenson2018 Mar 1, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

A better name without a number?

Copy link
Author

@WegmannDavid WegmannDavid Mar 1, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

steps_subst_cong_r? I was not sure how to name many of these, I did not yet figure out the naming algorithm behind the existing lemmas.

Copy link
Collaborator

@chenson2018 chenson2018 Mar 1, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This seems fine. (As I think I mentioned elsewhere I need to overhaul the naming for these modules, so any difficultly picking names is probably my fault!)

(s [ x := t ]) ↠βᶠ (s [ x := t' ]) := by
induction step
· case refl => rfl
· case tail t' t'' steps step ih =>
transitivity
· apply ih
· apply step_subst_r <;> assumption

lemma steps_open_cong_abs (s s' t t' : Term Var)
(step1 : t ↠βᶠ t')
(step2 : s.abs ↠βᶠ s'.abs)
(lc_t : LC t)
(lc_s : LC s.abs) :
(s ^ t) ↠βᶠ (s' ^ t') := by
cases lc_s with
| abs L h_lc =>
have ⟨x, _⟩ := fresh_exists <| free_union [fv] Var
rw [subst_intro x t s, subst_intro x t' s']
· trans (s ^ fvar x)[x:=t']
· grind [steps_subst_cong2]
· grind [=_ subst_intro, steps_open_l_abs]
all_goals grind

end LambdaCalculus.LocallyNameless.Untyped.Term.FullBeta

end Cslib
11 changes: 11 additions & 0 deletions Cslib/Languages/LambdaCalculus/LocallyNameless/Untyped/LcAt.lean
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -86,4 +86,15 @@ theorem lcAt_iff_LC (M : Term Var) [HasFresh Var] : LcAt 0 M ↔ M.LC := by
grind [fresh_exists L]
| _ => grind [cases LC]

theorem lcAt_openRec_lcAt (M N : Term Var) (i : ℕ) :
LcAt i (M⟦i ↝ N⟧) → LcAt (i + 1) M := by
induction M generalizing i <;> grind

lemma open_abs_lc [HasFresh Var] : forall {M N : Term Var},
Copy link
Collaborator

@chenson2018 chenson2018 Mar 1, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Please use named hypotheses here.

LC (M ^ N) → LC (M.abs) := by
intro M N hlc
rw[←lcAt_iff_LC]
rw[←lcAt_iff_LC] at hlc
apply lcAt_openRec_lcAt _ _ _ hlc

end Cslib.LambdaCalculus.LocallyNameless.Untyped.Term
Loading