|
| 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