Skip to content

Commit b13a672

Browse files
feat(CombinatoryLogic): add Church-encoded list infrastructure for SKI terms (#331)
Adds Church-encoded list operations (nil, cons, head, tail) for SKI combinatory logic, along with conversions to/from Church numerals and helper combinators (PrependZero, SuccHead). Head is defined via a general HeadD that takes an arbitrary default value; Head specializes to default 0. This is a stepping stone toward proving the equivalence of SKI combinatory logic with Mathlib's Turing machines. --------- Co-authored-by: Chris Henson <46805207+chenson2018@users.noreply.github.com>
1 parent f87b4e8 commit b13a672

4 files changed

Lines changed: 320 additions & 3 deletions

File tree

Cslib.lean

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,7 @@ public import Cslib.Languages.CombinatoryLogic.Basic
7171
public import Cslib.Languages.CombinatoryLogic.Confluence
7272
public import Cslib.Languages.CombinatoryLogic.Defs
7373
public import Cslib.Languages.CombinatoryLogic.Evaluation
74+
public import Cslib.Languages.CombinatoryLogic.List
7475
public import Cslib.Languages.CombinatoryLogic.Recursion
7576
public import Cslib.Languages.LambdaCalculus.LocallyNameless.Context
7677
public import Cslib.Languages.LambdaCalculus.LocallyNameless.Fsub.Basic

Cslib/Languages/CombinatoryLogic/Basic.lean

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -172,13 +172,21 @@ def B : SKI := BPoly.toSKI
172172
theorem B_def (f g x : SKI) : (B ⬝ f ⬝ g ⬝ x) ↠ f ⬝ (g ⬝ x) :=
173173
BPoly.toSKI_correct [f, g, x] (by simp)
174174

175+
/-- B followed by tail reduction -/
176+
lemma B_tail_mred (f g x y : SKI) (h : (g ⬝ x) ↠ y) : (B ⬝ f ⬝ g ⬝ x) ↠ f ⬝ y :=
177+
Trans.trans (B_def f g x) (MRed.tail f h)
178+
175179
/-- C := λ f x y. f y x -/
176180
def CPoly : SKI.Polynomial 3 := &0 ⬝' &2 ⬝' &1
177181
/-- A SKI term representing C -/
178182
def C : SKI := CPoly.toSKI
179183
theorem C_def (f x y : SKI) : (C ⬝ f ⬝ x ⬝ y) ↠ f ⬝ y ⬝ x :=
180184
CPoly.toSKI_correct [f, x, y] (by simp)
181185

186+
/-- C followed by head reduction -/
187+
lemma C_head_mred (f x y z : SKI) (h : (f ⬝ y) ↠ z) : (C ⬝ f ⬝ x ⬝ y) ↠ z ⬝ x :=
188+
Trans.trans (C_def f x y) (MRed.head x h)
189+
182190
/-- Rotate right: RotR := λ x y z. z x y -/
183191
def RotRPoly : SKI.Polynomial 3 := &2 ⬝' &0 ⬝' &1
184192
/-- A SKI term representing RotR -/
@@ -259,10 +267,12 @@ theorem isBool_trans (u : Bool) (a a' : SKI) (h : a ↠ a') (ha' : IsBool u a')
259267

260268
/-- Standard true: TT := λ x y. x -/
261269
def TT : SKI := K
270+
@[scoped grind .]
262271
theorem TT_correct : IsBool true TT := fun x y ↦ MRed.K x y
263272

264273
/-- Standard false: FF := λ x y. y -/
265274
def FF : SKI := K ⬝ I
275+
@[scoped grind .]
266276
theorem FF_correct : IsBool false FF :=
267277
fun x y ↦ calc
268278
(FF ⬝ x ⬝ y) ↠ I ⬝ y := by apply Relation.ReflTransGen.single; apply red_head; exact red_K I x
@@ -336,10 +346,12 @@ def Fst : SKI := R ⬝ TT
336346
/-- Second projection -/
337347
def Snd : SKI := R ⬝ FF
338348

349+
@[scoped grind .]
339350
theorem fst_correct (a b : SKI) : (Fst ⬝ (MkPair ⬝ a ⬝ b)) ↠ a := by calc
340351
_ ↠ SKI.Cond ⬝ a ⬝ b ⬝ TT := R_def _ _
341352
_ ↠ a := cond_correct TT a b true TT_correct
342353

354+
@[scoped grind .]
343355
theorem snd_correct (a b : SKI) : (Snd ⬝ (MkPair ⬝ a ⬝ b)) ↠ b := by calc
344356
_ ↠ SKI.Cond ⬝ a ⬝ b ⬝ FF := R_def _ _
345357
_ ↠ b := cond_correct FF a b false FF_correct
Lines changed: 279 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,279 @@
1+
/-
2+
Copyright (c) 2026 Jesse Alama. All rights reserved.
3+
Released under Apache 2.0 license as described in the file LICENSE.
4+
Authors: Jesse Alama
5+
-/
6+
7+
module
8+
9+
public import Cslib.Languages.CombinatoryLogic.Recursion
10+
11+
@[expose] public section
12+
13+
/-!
14+
# Church-Encoded Lists in SKI Combinatory Logic
15+
16+
Church-encoded lists for proving SKI ≃ TM equivalence. A list is encoded as
17+
`λ c n. c a₀ (c a₁ (... (c aₖ n)...))` where each `aᵢ` is a Church numeral.
18+
-/
19+
20+
namespace Cslib
21+
22+
namespace SKI
23+
24+
open Red MRed
25+
26+
/-! ### Church List Representation -/
27+
28+
/-- A term correctly Church-encodes a list of natural numbers. -/
29+
def IsChurchList : List ℕ → SKI → Prop
30+
| [], cns => ∀ c n : SKI, (cns ⬝ c ⬝ n) ↠ n
31+
| x :: xs, cns => ∀ c n : SKI,
32+
∃ cx cxs : SKI, IsChurch x cx ∧ IsChurchList xs cxs ∧
33+
(cns ⬝ c ⬝ n) ↠ c ⬝ cx ⬝ (cxs ⬝ c ⬝ n)
34+
35+
/-- `IsChurchList` is preserved under multi-step reduction of the term. -/
36+
theorem isChurchList_trans {ns : List ℕ} {cns cns' : SKI} (h : cns ↠ cns')
37+
(hcns' : IsChurchList ns cns') : IsChurchList ns cns := by
38+
match ns with
39+
| [] =>
40+
intro c n
41+
exact Trans.trans (parallel_mRed (MRed.head c h) .refl) (hcns' c n)
42+
| x :: xs =>
43+
intro c n
44+
obtain ⟨cx, cxs, hcx, hcxs, hred⟩ := hcns' c n
45+
exact ⟨cx, cxs, hcx, hcxs, Trans.trans (parallel_mRed (MRed.head c h) .refl) hred⟩
46+
47+
/-- Both components of a pair are Church lists. -/
48+
structure IsChurchListPair (prev curr : List ℕ) (p : SKI) : Prop where
49+
fst : IsChurchList prev (Fst ⬝ p)
50+
snd : IsChurchList curr (Snd ⬝ p)
51+
52+
/-- IsChurchListPair is preserved under reduction. -/
53+
@[scoped grind →]
54+
theorem isChurchListPair_trans {prev curr : List ℕ} {p p' : SKI} (hp : p ↠ p')
55+
(hp' : IsChurchListPair prev curr p') : IsChurchListPair prev curr p := by
56+
constructor
57+
· apply isChurchList_trans (MRed.tail Fst hp)
58+
exact hp'.1
59+
· apply isChurchList_trans (MRed.tail Snd hp)
60+
exact hp'.2
61+
62+
namespace List
63+
64+
/-! ### Nil: The empty list -/
65+
66+
/-- nil = λ c n. n -/
67+
def NilPoly : SKI.Polynomial 2 := &1
68+
69+
/-- The SKI term for the empty list. -/
70+
def Nil : SKI := NilPoly.toSKI
71+
72+
/-- Reduction: `Nil ⬝ c ⬝ n ↠ n`. -/
73+
theorem nil_def (c n : SKI) : (Nil ⬝ c ⬝ n) ↠ n :=
74+
NilPoly.toSKI_correct [c, n] (by simp)
75+
76+
/-- The empty list term correctly represents `[]`. -/
77+
theorem nil_correct : IsChurchList [] Nil := nil_def
78+
79+
/-! ### Cons: Consing an element onto a list -/
80+
81+
/-- cons = λ x xs c n. c x (xs c n) -/
82+
def ConsPoly : SKI.Polynomial 4 := &2 ⬝' &0 ⬝' (&1 ⬝' &2 ⬝' &3)
83+
84+
/-- The SKI term for list cons. -/
85+
def Cons : SKI := ConsPoly.toSKI
86+
87+
/-- Reduction: `Cons ⬝ x ⬝ xs ⬝ c ⬝ n ↠ c ⬝ x ⬝ (xs ⬝ c ⬝ n)`. -/
88+
theorem cons_def (x xs c n : SKI) :
89+
(Cons ⬝ x ⬝ xs ⬝ c ⬝ n) ↠ c ⬝ x ⬝ (xs ⬝ c ⬝ n) :=
90+
ConsPoly.toSKI_correct [x, xs, c, n] (by simp)
91+
92+
/-- Cons preserves Church list representation. -/
93+
theorem cons_correct {x : ℕ} {xs : List ℕ} {cx cxs : SKI}
94+
(hcx : IsChurch x cx) (hcxs : IsChurchList xs cxs) :
95+
IsChurchList (x :: xs) (Cons ⬝ cx ⬝ cxs) := by
96+
intro c n
97+
use cx, cxs, hcx, hcxs
98+
exact cons_def cx cxs c n
99+
100+
/-- Singleton list correctness. -/
101+
theorem singleton_correct {x : ℕ} {cx : SKI} (hcx : IsChurch x cx) :
102+
IsChurchList [x] (Cons ⬝ cx ⬝ Nil) :=
103+
cons_correct hcx nil_correct
104+
105+
/-- The canonical SKI term for a Church-encoded list. -/
106+
def toChurch : List ℕ → SKI
107+
| [] => Nil
108+
| x :: xs => Cons ⬝ (SKI.toChurch x) ⬝ (toChurch xs)
109+
110+
/-- `toChurch [] = Nil`. -/
111+
@[simp]
112+
lemma toChurch_nil : toChurch [] = Nil := rfl
113+
114+
/-- `toChurch (x :: xs) = Cons ⬝ SKI.toChurch x ⬝ toChurch xs`. -/
115+
@[simp]
116+
lemma toChurch_cons (x : ℕ) (xs : List ℕ) :
117+
toChurch (x :: xs) = Cons ⬝ (SKI.toChurch x) ⬝ (toChurch xs) := rfl
118+
119+
/-- `toChurch ns` correctly represents `ns`. -/
120+
theorem toChurch_correct (ns : List ℕ) : IsChurchList ns (toChurch ns) := by
121+
induction ns with
122+
| nil => exact nil_correct
123+
| cons x xs ih => exact cons_correct (SKI.toChurch_correct x) ih
124+
125+
/-! ### Head: Extract the head of a list -/
126+
127+
/-- headD d xs = xs K d (returns d for empty list) -/
128+
def HeadDPoly : SKI.Polynomial 2 := &1 ⬝' K ⬝' &0
129+
130+
/-- The SKI term for list head with default. -/
131+
def HeadD : SKI := HeadDPoly.toSKI
132+
133+
/-- Reduction: `HeadD ⬝ d ⬝ xs ↠ xs ⬝ K ⬝ d`. -/
134+
theorem headD_def (d xs : SKI) : (HeadD ⬝ d ⬝ xs) ↠ xs ⬝ K ⬝ d :=
135+
HeadDPoly.toSKI_correct [d, xs] (by simp)
136+
137+
/-- General head-with-default correctness. -/
138+
theorem headD_correct {d : ℕ} {cd : SKI} (hcd : IsChurch d cd)
139+
{ns : List ℕ} {cns : SKI} (hcns : IsChurchList ns cns) :
140+
IsChurch (ns.headD d) (HeadD ⬝ cd ⬝ cns) := by
141+
match ns with
142+
| [] =>
143+
simp only [List.headD_nil]
144+
apply isChurch_trans d (headD_def cd cns)
145+
apply isChurch_trans d (hcns K cd)
146+
exact hcd
147+
| x :: xs =>
148+
simp only [List.headD_cons]
149+
apply isChurch_trans x (headD_def cd cns)
150+
obtain ⟨cx, cxs, hcx, _, hred⟩ := hcns K cd
151+
exact isChurch_trans x hred (isChurch_trans x (MRed.K cx _) hcx)
152+
153+
/-- The SKI term for list head (default 0). -/
154+
def Head : SKI := HeadD ⬝ SKI.Zero
155+
156+
/-- Reduction: `Head ⬝ xs ↠ xs ⬝ K ⬝ Zero`. -/
157+
theorem head_def (xs : SKI) : (Head ⬝ xs) ↠ xs ⬝ K ⬝ SKI.Zero :=
158+
headD_def SKI.Zero xs
159+
160+
/-- Head correctness (default 0). -/
161+
theorem head_correct (ns : List ℕ) (cns : SKI) (hcns : IsChurchList ns cns) :
162+
IsChurch (ns.headD 0) (Head ⬝ cns) :=
163+
headD_correct zero_correct hcns
164+
165+
/-! ### Tail: Extract the tail of a list -/
166+
167+
/-- Step function for tail: (prev, curr) → (curr, cons h curr) -/
168+
def TailStepPoly : SKI.Polynomial 2 :=
169+
MkPair ⬝' (Snd ⬝' &1) ⬝' (Cons ⬝' &0 ⬝' (Snd ⬝' &1))
170+
171+
/-- The step function for computing list tail. -/
172+
def TailStep : SKI := TailStepPoly.toSKI
173+
174+
/-- Reduction of the tail step function. -/
175+
theorem tailStep_def (h p : SKI) :
176+
(TailStep ⬝ h ⬝ p) ↠ MkPair ⬝ (Snd ⬝ p) ⬝ (Cons ⬝ h ⬝ (Snd ⬝ p)) :=
177+
TailStepPoly.toSKI_correct [h, p] (by simp)
178+
179+
/-- tail xs = Fst (xs TailStep (MkPair Nil Nil)) -/
180+
def TailPoly : SKI.Polynomial 1 :=
181+
Fst ⬝' (&0 ⬝' TailStep ⬝' (MkPair ⬝ Nil ⬝ Nil))
182+
183+
/-- The tail of a Church-encoded list. -/
184+
def Tail : SKI := TailPoly.toSKI
185+
186+
/-- Reduction: `Tail ⬝ xs ↠ Fst ⬝ (xs ⬝ TailStep ⬝ (MkPair ⬝ Nil ⬝ Nil))`. -/
187+
theorem tail_def (xs : SKI) :
188+
(Tail ⬝ xs) ↠ Fst ⬝ (xs ⬝ TailStep ⬝ (MkPair ⬝ Nil ⬝ Nil)) :=
189+
TailPoly.toSKI_correct [xs] (by simp)
190+
191+
/-- The initial pair (nil, nil) satisfies the invariant. -/
192+
@[simp]
193+
theorem tail_init : IsChurchListPair [] [] (MkPair ⬝ Nil ⬝ Nil) := by
194+
constructor
195+
· apply isChurchList_trans (fst_correct _ _); exact nil_correct
196+
· apply isChurchList_trans (snd_correct _ _); exact nil_correct
197+
198+
/-- The step function preserves the tail-computing invariant. -/
199+
theorem tailStep_correct {x : ℕ} {xs : List ℕ} {cx p : SKI}
200+
(hcx : IsChurch x cx) (hp : IsChurchListPair xs.tail xs p) :
201+
IsChurchListPair xs (x :: xs) (TailStep ⬝ cx ⬝ p) := by
202+
apply isChurchListPair_trans (tailStep_def cx p)
203+
exact ⟨isChurchList_trans (fst_correct _ _) hp.2,
204+
isChurchList_trans (snd_correct _ _) (cons_correct hcx hp.2)⟩
205+
206+
theorem tailFold_correct (ns : List ℕ) (cns : SKI) (hcns : IsChurchList ns cns) :
207+
∃ p, (cns ⬝ TailStep ⬝ (MkPair ⬝ Nil ⬝ Nil)) ↠ p ∧
208+
IsChurchListPair ns.tail ns p := by
209+
induction ns generalizing cns with
210+
| nil =>
211+
-- For empty list, the fold returns the initial pair
212+
use MkPair ⬝ Nil ⬝ Nil
213+
constructor
214+
· exact hcns TailStep (MkPair ⬝ Nil ⬝ Nil)
215+
· exact tail_init
216+
| cons x xs ih =>
217+
-- For x :: xs, first fold xs, then apply step
218+
-- cns ⬝ TailStep ⬝ init ↠ TailStep ⬝ cx ⬝ (cxs ⬝ TailStep ⬝ init)
219+
-- Get the Church representations for x and xs
220+
obtain ⟨cx, cxs, hcx, hcxs, hred⟩ := hcns TailStep (MkPair ⬝ Nil ⬝ Nil)
221+
-- By IH, folding xs gives a pair representing (xs.tail, xs)
222+
obtain ⟨p_xs, hp_xs_red, hp_xs_pair⟩ := ih cxs hcxs
223+
-- After step, we get a pair representing (xs, x :: xs)
224+
have hstep := tailStep_correct hcx hp_xs_pair
225+
-- The full fold: cns ⬝ TailStep ⬝ init ↠ TailStep ⬝ cx ⬝ (cxs ⬝ TailStep ⬝ init)
226+
-- ↠ TailStep ⬝ cx ⬝ p_xs
227+
use TailStep ⬝ cx ⬝ p_xs
228+
constructor
229+
· exact Trans.trans hred (MRed.tail _ hp_xs_red)
230+
· exact hstep
231+
232+
/-- Tail correctness. -/
233+
theorem tail_correct (ns : List ℕ) (cns : SKI) (hcns : IsChurchList ns cns) :
234+
IsChurchList ns.tail (Tail ⬝ cns) := by
235+
-- Tail ⬝ cns ↠ Fst ⬝ (cns ⬝ TailStep ⬝ (MkPair ⬝ Nil ⬝ Nil))
236+
apply isChurchList_trans (tail_def cns)
237+
-- Get the fold result
238+
obtain ⟨p, hp_red, hp_pair⟩ := tailFold_correct ns cns hcns
239+
-- Fst ⬝ (cns ⬝ TailStep ⬝ init) ↠ Fst ⬝ p
240+
apply isChurchList_trans (MRed.tail Fst hp_red)
241+
-- Fst ⬝ p represents ns.tail (from hp_pair)
242+
exact hp_pair.1
243+
244+
/-! ### Prepending zero to a list (for Code.zero') -/
245+
246+
/-- PrependZero xs = cons 0 xs = Cons ⬝ Zero ⬝ xs -/
247+
def PrependZeroPoly : SKI.Polynomial 1 := Cons ⬝' SKI.Zero ⬝' &0
248+
249+
/-- Prepend zero to a Church-encoded list. -/
250+
def PrependZero : SKI := PrependZeroPoly.toSKI
251+
252+
/-- Reduction: `PrependZero ⬝ xs ↠ Cons ⬝ Zero ⬝ xs`. -/
253+
theorem prependZero_def (xs : SKI) : (PrependZero ⬝ xs) ↠ Cons ⬝ SKI.Zero ⬝ xs :=
254+
PrependZeroPoly.toSKI_correct [xs] (by simp)
255+
256+
/-- Prepending zero preserves Church list representation. -/
257+
theorem prependZero_correct {ns : List ℕ} {cns : SKI} (hcns : IsChurchList ns cns) :
258+
IsChurchList (0 :: ns) (PrependZero ⬝ cns) := by
259+
apply isChurchList_trans (prependZero_def cns)
260+
exact cons_correct zero_correct hcns
261+
262+
/-! ### Successor on list head (for Code.succ) -/
263+
264+
/-- SuccHead xs = cons (succ (head xs)) nil -/
265+
def SuccHead : SKI := B ⬝ (C ⬝ Cons ⬝ Nil) ⬝ (B ⬝ SKI.Succ ⬝ Head)
266+
267+
/-- `SuccHead` correctly computes a singleton containing `succ(head ns)`. -/
268+
theorem succHead_correct (ns : List ℕ) (cns : SKI) (hcns : IsChurchList ns cns) :
269+
IsChurchList [ns.headD 0 + 1] (SuccHead ⬝ cns) := by
270+
have hhead := head_correct ns cns hcns
271+
have hsucc := succ_correct (ns.headD 0) (Head ⬝ cns) hhead
272+
apply isChurchList_trans (.trans (B_tail_mred _ _ _ _ (B_def .Succ Head cns)) (C_def Cons Nil _))
273+
exact cons_correct hsucc nil_correct
274+
275+
end List
276+
277+
end SKI
278+
279+
end Cslib

0 commit comments

Comments
 (0)