Skip to content

Commit 47f3ea1

Browse files
seckcoderseckcoder
committed
why y-combinator
1 parent 405b026 commit 47f3ea1

File tree

1 file changed

+265
-0
lines changed

1 file changed

+265
-0
lines changed

‎src/little-schemer/y-combinator.scm

Lines changed: 265 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,265 @@
1+
; the deduction of y-combinator
2+
(define (add1 x)
3+
(+ x 1))
4+
5+
(define (eternity x)
6+
(eternity x))
7+
8+
; initial length definition
9+
(define length
10+
(lambda (l)
11+
(cond ((null? l) 0)
12+
(else
13+
(add1 (length (cdr l)))))))
14+
15+
; how to implement it without use of define
16+
; y-combinator
17+
18+
; length0
19+
(lambda (l)
20+
(cond ((null? l) 0)
21+
(else
22+
(add1 (eternity (cdr l))))))
23+
24+
; length<=1
25+
(lambda (l)
26+
(cond ((null? l) 0)
27+
(else
28+
(add1 ((lambda (l)
29+
(cond ((null? l) 0)
30+
(else
31+
(add1 (eternity (cdr l)))))))))))
32+
33+
; abstract a function: mk-length
34+
; mk-length: makes length from function that looks like length
35+
(define mk-length
36+
(lambda (length)
37+
(lambda (l)
38+
(cond ((null? l) 0)
39+
(else
40+
(add1 (length (cdr l))))))))
41+
42+
; then, length0
43+
((lambda (length)
44+
(lambda (l)
45+
(cond ((null? l) 0)
46+
(else
47+
(add1 (length (cdr l)))))))
48+
eternity)
49+
50+
; that is
51+
(make-length eternity)
52+
53+
; then, length<=1
54+
((lambda (length)
55+
(lambda (l)
56+
(cond ((null? l) 0)
57+
(else
58+
(add1 (length (cdr l)))))))
59+
((lambda (length)
60+
(lambda (l)
61+
(cond ((null? l) 0)
62+
(else
63+
(add1 (length (cdr l)))))))
64+
eternity))
65+
66+
; that is
67+
(make-length length0)
68+
69+
; =
70+
(make-length
71+
(make-length eternity))
72+
73+
; length<=2
74+
((lambda (length)
75+
(lambda (l)
76+
(cond ((null? l) 0)
77+
(else
78+
(add1 (length (cdr l)))))))
79+
((lambda (length)
80+
(lambda (l)
81+
(cond ((null? l) 0)
82+
(else
83+
(add1 (length (cdr l)))))))
84+
((lambda (length)
85+
(lambda (l)
86+
(cond ((null? l) 0)
87+
(else
88+
(add1 (length (cdr l)))))))
89+
eternity)))
90+
91+
; that is
92+
(make-length
93+
(make-length
94+
(make-length eternity)))
95+
96+
; make use of mk-length without define
97+
98+
; length0
99+
((lambda (mk-length)
100+
(mk-length eternity))
101+
(lambda (length)
102+
(lambda (l)
103+
(cond ((null? l) 0)
104+
(else
105+
(add1 (length (cdr l))))))))
106+
107+
; length<=1
108+
((lambda (mk-length)
109+
(mk-length
110+
(mk-length eternity)))
111+
(lambda (length)
112+
(lambda (l)
113+
(cond ((null? l) 0)
114+
(else
115+
(add1 (length (cdr l))))))))
116+
117+
118+
; this can also be written as
119+
120+
((lambda (mk-length)
121+
(mk-length mk-length))
122+
(lambda (mk-length)
123+
(lambda (l)
124+
(cond ((null? l) 0)
125+
(else
126+
(add1 ((mk-length eternity)
127+
(cdr l))))))))
128+
129+
; we don't care about the eternity func,
130+
; it can be anything
131+
((lambda (mk-length)
132+
(mk-length mk-length))
133+
(lambda (mk-length)
134+
(lambda (l)
135+
(cond ((null? l) 0)
136+
(else
137+
(add1 ((mk-length mk-length)
138+
(cdr l))))))))
139+
140+
; we also want to use our mk-length func defintion.
141+
; then we have
142+
((lambda (mk-length)
143+
(mk-length mk-length))
144+
(lambda (mk-length)
145+
; here is our mk-length
146+
((lambda (length)
147+
(lambda (l)
148+
(cond ((null? l) 0)
149+
(else
150+
(add1 (length
151+
(cdr l)))))))
152+
(mk-length mk-length))))
153+
154+
155+
; try to expand it
156+
((lambda (mk-length)
157+
((lambda (length)
158+
(lambda (l)
159+
(cond ((null? l) 0)
160+
(else
161+
(add1 (length
162+
(cdr l)))))))
163+
(mk-length mk-length)))
164+
(lambda (mk-length)
165+
((lambda (length)
166+
(lambda (l)
167+
(cond ((null? l) 0)
168+
(else
169+
(add1 (length
170+
(cdr l)))))))
171+
(mk-length mk-length))))
172+
173+
; again...
174+
; Oh, shit! this is a infinite recursion
175+
((lambda (length)
176+
(lambda (l)
177+
(cond ((null? l) 0)
178+
(else
179+
(add1 (length
180+
(cdr l)))))))
181+
; infinite recursion here when evaluate this.
182+
; the problem is that, before we can evaluate the mk-length body
183+
; wrap in lambda, we will first evaluate it's argument: (mk-length mk-length),
184+
; which is recursive. therefore we need to make it lazy(evaluate when we really need
185+
; it)
186+
((lambda (mk-length)
187+
((lambda (length)
188+
(lambda (l)
189+
(cond ((null? l) 0)
190+
(else
191+
(add1 (length
192+
(cdr l)))))))
193+
(mk-length mk-length)))
194+
(lambda (mk-length)
195+
((lambda (length)
196+
(lambda (l)
197+
(cond ((null? l) 0)
198+
(else
199+
(add1 (length
200+
(cdr l)))))))
201+
(mk-length mk-length)))))
202+
203+
; make it lazy
204+
(f x) = ((lambda (x)
205+
(f x))
206+
x)
207+
208+
((lambda (mk-length)
209+
(mk-length mk-length))
210+
(lambda (mk-length)
211+
(lambda (l)
212+
(cond ((null? l) 0)
213+
(else
214+
(add1 ((lambda (x)
215+
((mk-length mk-length) x))
216+
(cdr l))))))))
217+
218+
; we want to use our mk-length func defintion
219+
; then we have
220+
((lambda (mk-length)
221+
(mk-length mk-length))
222+
(lambda (mk-length)
223+
; here is our mk-length
224+
((lambda (length)
225+
(lambda (l)
226+
(cond ((null? l) 0)
227+
(else
228+
(add1
229+
; lazy func will be evaluated here.
230+
(length (cdr l)))))))
231+
; here, the argument will not be evaluate until we call length
232+
(lambda (x)
233+
((mk-length mk-length) x)))))
234+
235+
; how about extract mk-length definition, name it le
236+
((lambda (le)
237+
((lambda (mk-length)
238+
(mk-length mk-length))
239+
(lambda (mk-length)
240+
(le
241+
(lambda (x)
242+
((mk-length mk-length) x))))))
243+
; mk-length here
244+
(lambda (length)
245+
(lambda (l)
246+
(cond ((null? l) 0)
247+
(else
248+
(add1 (length (cdr l))))))))
249+
250+
; we define the part that is not related to length/mk-length as Y
251+
; that is y-combinator
252+
(define Y
253+
(lambda (le)
254+
((lambda (f) (f f))
255+
(lambda (f)
256+
(le (lambda (x) ((f f) x)))))))
257+
258+
(define mk-length
259+
(lambda (length)
260+
(lambda (l)
261+
(cond ((null? l) 0)
262+
(else
263+
(add1 (length (cdr l))))))))
264+
265+
(Y mk-length) = length

0 commit comments

Comments
 (0)