Yコンビネータ 継続編

• http://okmij.org/ftp/Scheme/callcc-fixpoint.txt

fixed point of call/cc だそうです。

• Fixed point combinator - Wikipedia, the free encyclopedia
  

タイトルに Y Combinator と入れましたが、正確にはそうではないようです。

すごくおもしろそうだったのでプリントアウトして頑張って読んでます。印刷したら10ページありました。まだ3ページくらいしか読んでないので、残りを読んでみます。

で、一見してもよくわかりません。よくわからないので、いじくり回してみました。先日ノーマルな Y Combinator でやったことの、逆過程のようなことをやりました。

• vallog: Scheme 紙面プログラミング

結果、理解できてないのですが、なんとなく雰囲気がつかめた気がします。気がするだけかもしれません。
以下コード。

	;; call/cc fixed point
	;; http://okmij.org/ftp/Scheme/callcc-fixpoint.txt
	;; varargs Y-combinator
	(define y
	(lambda (c)
	((lambda (f)
	(f f))
	(lambda (g)
	(c (lambda x
	(apply (g g) x)))))))
	;; fact
	((y (lambda (f)
	(lambda (n)
	(if (zero? n)
	1
	(* n (f (- n 1))))))) 5)
	; -> 120
	;; Y-Combinator via call/cc
	(define (y/cc f)
	((lambda (u)
	(u (lambda (x)
	(lambda (n)
	((f (u x)) n)))))
	(call/cc (call/cc (lambda (x)
	x)))))
	;; fact
	((y/cc (lambda (f)
	(lambda (n)
	(if (zero? n)
	1
	(* n (f (- n 1))))))) 5)
	; -> 120
	;; observationally equivalent
	;; (lambda (p) ((call/cc ... (call/cc call/cc)) p))
	;; (lambda (p) ((call/cc ... (call/cc (call/cc id))) p))
	;; (lambda (p) ((lambda (x) (x x)) p))
	;;; (step 1)
	;; y/cc
	(lambda (f)
	((lambda (u)
	(u (lambda (x)
	(lambda (n)
	((f (u x)) n)))))
	(call/cc (call/cc (lambda (x)
	x)))))
	;;; (step 2)
	;; fact
	((lambda (f)
	((lambda (u)
	(u (lambda (x)
	(lambda (n)
	((f (u x)) n)))))
	(call/cc (call/cc (lambda (x)
	x)))))
	(lambda (f)
	(lambda (n)
	(if (zero? n)
	1
	(* n (f (- n 1)))))))
	; -> #<closure (#f #f #f #f)>
	;;; (step 3)
	;; fact 5
	(((lambda (f)
	((lambda (u)
	(u (lambda (x)
	(lambda (n)
	((f (u x)) n)))))
	(call/cc (call/cc (lambda (x)
	x)))))
	(lambda (f)
	(lambda (n)
	(if (zero? n)
	1
	(* n (f (- n 1))))))) 5)
	; -> 120
	;;; (step 4)
	(lambda (g)
	(lambda (n)
	(if (zero? n)
	1
	(* n (g (- n 1))))))
	(lambda (f)
	((lambda (u)
	(u (lambda (x)
	(lambda (n)
	(((lambda (g)
	(lambda (n)
	(if (zero? n)
	1
	(* n (g (- n 1)))))) (u x)) n)))))
	(call/cc (call/cc (lambda (x)
	x)))))
	;;; (step 5)
	((lambda (u)
	(u (lambda (x)
	(lambda (n)
	(((lambda (g)
	(lambda (n)
	(if (zero? n)
	1
	(* n (g (- n 1)))))) (u x)) n)))))
	(call/cc (call/cc (lambda (x)
	x))))
	(((lambda (u)
	(u (lambda (x)
	(lambda (n)
	(((lambda (g)
	(lambda (n)
	(if (zero? n)
	1
	(* n (g (- n 1)))))) (u x)) n)))))
	(call/cc (call/cc (lambda (x)
	x)))) 5)
	; -> 120
	;;; (step 6)
	((lambda (u)
	(u (lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n ((u x)(- n 1))))) n)))))
	(call/cc (call/cc (lambda (x)
	x))))
	(((lambda (u)
	(u (lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n ((u x)(- n 1))))) n)))))
	(call/cc (call/cc (lambda (x)
	x)))) 5)
	; -> 120
	;;; (step 7)
	((call/cc (call/cc (lambda (x)
	x)))
	(lambda (u)
	(u (lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n ((u x)(- n 1))))) n))))))
	(((call/cc (call/cc (lambda (x)
	x)))
	(lambda (u)
	(u (lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n ((u x)(- n 1))))) n)))))) 5)
	; -> 120
	;; (step 8)
	((call/cc (call/cc (lambda (x)
	x)))
	(lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n (((call/cc (call/cc (lambda (x)
	x))) x)(- n 1))))) n))))
	(((call/cc (call/cc (lambda (x)
	x)))
	(lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n (((call/cc (call/cc (lambda (x)
	x))) x)(- n 1))))) n)))) 5)
	; -> 120
	;;; (step 9)
	((call/cc (lambda (x)
	x))
	(lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n (((call/cc (lambda (x)
	x)) x)(- n 1))))) n))))
	(((call/cc (lambda (x)
	x))
	(lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n (((call/cc (lambda (x)
	x)) x)(- n 1))))) n)))) 5)
	; -> 120
	;;; (step 9.5)
	;; (step 2)
	(((lambda (f)
	((lambda (u)
	(u (lambda (x)
	(lambda (n)
	((f (u x)) n)))))
	(call/cc (lambda (x)
	x))))
	(lambda (f)
	(lambda (n)
	(if (zero? n)
	1
	(* n (f (- n 1))))))) 5)
	; -> 120
	;;; (step 10)
	((call/cc identity)
	(lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n (((call/cc identity) x)(- n 1))))) n))))
	(((call/cc identity)
	(lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n (((call/cc identity) x)(- n 1))))) n)))) 5)
	; -> 120
	(((lambda (u)
	(u (lambda (x)
	(lambda (n)
	((lambda (n)
	(if (zero? n)
	1
	(* n ((u x)(- n 1))))) n)))))
	(call/cc identity)) 5)

view raw cc.scm hosted with ❤ by GitHub

• vallog: amb
• vallog: メモ化された Y Combinator
• vallog: pluggable Y Combinator
• vallog: pluggable Y Combinator 2