SICP 読み (168) 4.1.6 内部定義

早めに出勤してきたので以下を試してみた。

• make-procedure で使っているのは lambda-body でこれはリストのリストになる
• procedure-body で取り出すのもリストのリスト

という事は scan-out-defines で出力するソレも同様の形になっている必要あり。短気を起こして組み込んでしまう。scan-out-defines は以下のように修正。

(define (scan-out-defines exp)
  (define (make-set exp)
    (let f ((init '()) (set '()) (exp exp))
      (cond ((null? exp)
             (append (list 'let init) set))
            (else
             (cond ((definition? (car exp))
                    (f (append init (list (list (definition-variable (car exp))
                                                ''*unassigned*)))
                       (append set (list (list 'set!
                                               (definition-variable (car exp))
                                               (definition-value (car exp)))))
                       (cdr exp)))
                   (else
                    (f init set (cdr exp))))))))
  (append (make-set exp)
          (let f ((l '()) (exp exp))
            (cond ((null? exp) l)
                  ((definition? (car exp))
                   (f l (cdr exp)))
                  (else
                   (f (append l (list (car exp))) (cdr exp)))))))

試験も修正。まず、これを make-procedure に組み込んでみる。

make-procedure

(define (make-procedure parameters body env)
;  (list 'procedure parameters body env))
  (list 'procedure parameters (scan-out-defines body) env)

で、試験してみるとなんかおかしい。以下の試験を追加してみると

    (let ((l1 '((+ a b)))
	  (l2 '((+ a b))))
      (assert-equal l2 (scan-out-defines l1))
      )

こうなった。(鬱

 expected:<((+ a b))>
  but was:<((let () (+ a b)))> in scan-out-defines

必ず let が付加されてしまう。馬鹿だなぁ。とりあえず急場シノギで以下のように修正。(なにが一発ツモか

(define (scan-out-defines exp)
  (define (make-set exp)
    (let f ((init '()) (set '()) (exp exp))
      (cond ((null? exp)
	     (if (null? init)
		 '()
		 (append (list 'let init) set)))
	    (else
	     (cond ((definition? (car exp))
		    (f (append init (list (list (definition-variable (car exp))
						''*unassigned*)))
		       (append set (list (list 'set!
					       (definition-variable (car exp))
					       (definition-value (car exp)))))
		       (cdr exp)))
		   (else
		    (f init set (cdr exp))))))))
  (let ((result (make-set exp)))
    (cond ((null? result) exp)
	  (else
	   (list 
	    (append result
		    (let f ((l '()) (exp exp))
		      (cond ((null? exp) l)
			    ((definition? (car exp))
			     (f l (cdr exp)))
			    (else
			     (f (append l (list (car exp))) (cdr exp)))))))))))

しかし長い。一応既存の試験にはパス。次は procedure-body か。

procedure-body

(define (procedure-body p) (scan-out-defines (caddr p)))

これも既存なソレにはパスしますな。両方に以下の試験を追加してみる。

   ("example"
    (let ((nenv (extend-environment '(tmp) '(0) the-global-environment)))
      (eval '(define (f x)
	       (define (even? n) 
		 (if (= n 0) true (odd? (- n 1)))) 
	       (define (odd? n) 
		 (if (= n 0) false (even? (- n 1))))
	       (even? x)) nenv)
      (assert-true (eval '(f 2) nenv))
      )
    )

で試験してみたんですが、どっちもパス。(当たり前

ちょっとネかせてみた方が良いのかなぁ。> 問題 4.16