SICP 読み (175) 4.1.6 内部定義

直前エントリは大ボケをぶちカマしていた。正に

   ("example"
    (let ((l '(letrec ((fact
			(lambda (n)
			  (if (= n 1)
			      1
			      (+ n (fact (- n 1)))))))
		(fact 10)))
	  (r '(let ((fact '*unassigned*))
		(set! fact (lambda (n)
			     (if (= n 1)
				 1
				 (+ n (fact (- n 1))))))
		(fact 10))))
      (assert-equal r (letrec->let l))
      )
    )

にのみパスするコードだった。以下、修正版ですがまだボケてる可能性あり。
ま、あんなに簡単にデキる方がおかしいよな、と言いつつでっち上がった手続きが以下。

(define (letrec->let exp)
  (define (init l)
    (let f ((r '()) (l l))
      (cond ((null? l) r)
	    (else
	     (f (append r (list (list (caar l) ''*unassigned*))) (cdr l)))))
    )
  (define (init-set l)
    (let f ((r '()) (l l))
      (cond ((null? l) r)
	    (else
	     (f (append r (list (list 'set! (caar l) (cadar l))))
		(cdr l)))))
    )
  (append (list 'let (init (cadr exp)))
	  (init-set (cadr exp)) 
	  (cddr exp)))

一応以下の試験にはパスしておりますが ...

  ("4.20"
   ("example"
    (let ((l '(letrec ((fact
			(lambda (n)
			  (if (= n 1)
			      1
			      (+ n (fact (- n 1)))))))
		(fact 10)))
	  (r '(let ((fact '*unassigned*))
		(set! fact (lambda (n)
			     (if (= n 1)
				 1
				 (+ n (fact (- n 1))))))
		(fact 10))))
      (assert-equal r (letrec->let l))
      )
    )

   ("example2"
    (let ((l '(letrec ((even?
			(lambda (n)
			  (if (= n 0)
			      #t
			      (odd? (- n 1)))))
		       (odd?
			(lambda (n)
			  (if (= n 0)
			      #f
			      (even? (- n 1))))))
		(set! a (+ 1 2))
		(set! b (+ a 3))
		(even? b)))
	  (r '(let ((even? '*unassigned*)
		    (odd? '*unassigned*))
		(set! even? (lambda (n)
			      (if (= n 0)
				  #t
				  (odd? (- n 1)))))
		(set! odd? (lambda (n)
			     (if (= n 0)
				 #f
				 (even? (- n 1)))))
		(set! a (+ 1 2))
		(set! b (+ a 3))
		(even? b))))
      (assert-equal r (letrec->let l))
      )
    )
   )

どうも調子悪いです。色々な意味で。

追記

えーと、上記の試験は gosh 上で動かない手続きみたいなので動作するナニを追加。gosh 上でもその式がきちんと動くのかを確認。

   ("example3"
    (let ((l '(letrec ((even? (lambda (n)
				(if (= n 0)
				    #t
				    (odd? (- n 1)))))
		       (odd? (lambda (n)
			       (if (= n 0)
				   #f
				   (even? (- n 1))))))
		(let ((a (+ 1 2)))
		  (let ((b (+ a 3)))
		    (even? b)))))
	  (r '(let ((even? '*unassigned*)
		    (odd? '*unassigned*))
		(set! even? (lambda (n)
			      (if (= n 0)
				  #t
				  (odd? (- n 1)))))
		(set! odd? (lambda (n)
			     (if (= n 0)
				 #f
				 (even? (- n 1)))))
		(let ((a (+ 1 2)))
		  (let ((b (+ a 3)))
		    (even? b))))))
      (assert-equal r (letrec->let l))
      )
    )

gosh なナニを以下に。

gosh> (letrec ((even? (lambda (n)
				(if (= n 0)
				    #t
				    (odd? (- n 1)))))
		       (odd? (lambda (n)
			       (if (= n 0)
				   #f
				   (even? (- n 1))))))
		(let ((a (+ 1 2)))
		  (let ((b (+ a 3)))
		    (even? b))))
#t
gosh> (let ((even? '*unassigned*)
		    (odd? '*unassigned*))
		(set! even? (lambda (n)
			      (if (= n 0)
				  #t
				  (odd? (- n 1)))))
		(set! odd? (lambda (n)
			     (if (= n 0)
				 #f
				 (even? (- n 1)))))
		(let ((a (+ 1 2)))
		  (let ((b (+ a 3)))
		    (even? b))))
#t
gosh>