演習問題4.16

最近の演習問題は難しくてなえるw
全然進まない!

今回も1時間以上掛かってしまった．
なんとか読める範囲のプログラムにはなったかなぁ...

追記(20090626)

バグがあったので修正した．
definition?の位置がおかしかった．

評価器には入れないで，単純に式変形ができるかどうかを試した．
また，引数には始めから，procedure-bodyを渡す．

;;exercise4.16a
(define (lookup-variable-value var env)
  (define (env-loop env)
    (define (scan vars vals)
      (cond [(null? vars)
             (env-loop (enclosing-environment env))]
            [(eq? var (car vars))
             (if (eq? (car vals) '*unassigned*)
                 (error "Unbound variable *unassigned*")
                 (car vals))]
            [else (scan (cdr vars) (cdr vals))]))
    (if (eq? env the-empty-environment)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
             (scan (frame-variables frame)
                   (frame-values frame)))))
  (env-loop env))

;;exercise4.16b
(define hoge     ;procedure-body
  '((define a 1)
    (define b 2)
    (+ a b)
    (* a b)))

;このtestを実行する場合は，appendの前のlistを外す
(define (scan-out-defines body)
  (let ((lets '())
        (sets '())
        (not-define '()))
    (map (lambda (exp)
           (if (definition? exp)
               (let ((variable (definition-variable exp))
                     (value (definition-value exp)))
                 (set! lets
                       (cons (list variable ''*unassigned*)
                             lets))
                 (set! sets
                       (cons (list 'set! variable value)
                             sets)))
               (set! not-define
                     (cons exp not-define))))
           body)
    (list (append (cons 'let
                        (cons (reverse lets)
                              (reverse sets)))
                  not-define))))

(scan-out-defines hoge)

gosh> hoge
((define a 1) (define b 2) (+ a b) (* a b))
gosh> (scan-out-defines hoge)
(let ((a #0='*unassigned) (b #0#)) (set! a 1) (set! b 2) (* a b) (+ a b))
gosh> (let ((a #0='*unassigned) (b #0#)) (set! a 1) (set! b 2) (* a b) (+ a b))
3

;;exercise4.16c
;scan-out-definesをevaluatorに組み込む場合appendの前にlistが必要
;make-procedureに組み込むと，evalのときに変換される
;procedure-bodyに組み込むと，applyのときに, つまり実行時に変換される
;どちらがいいのか?わからん．