SICP Exercise 4.16

首先，我们先定义一下关于unassigned的定义和函数：

;;Representing unassigned constant
(define UNASSIGNED (quote '*unassigned*))

(define (unassigned? val)
  (eq? val '*unassigned*))

1、修改lookup-variable-value，这个比较简单，这里直接贴出代码：

(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))
             (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)))))
  (let ((val (env-loop env)))
    (if (unassigned? val)
        (error "Unassigned variable" var)
        val)))

2、scan-out-defines的定义如下：

(define (scan-out-defines body)
  " Translate the form:
  ((define u <e1>)
   (define v <e2>)
   <e3>)
  to:
  ((let ((u '*unassigned*)
         (v '*unassigned*))
     (set! u <e1>)
     (set! v <e2>)
     <e3>))"
  (let ((vars '())
        (vals '()))
    (define new-body 
      (map (lambda (exp)
             (if (definition? exp)
                 (begin (set! vars (cons (definition-variable exp) vars))
                        (set! vals (cons UNASSIGNED vals))
                        (list 'set! (definition-variable exp) (definition-value exp)))
                 exp))
           body))
    (list (make-let vars vals new-body))))

这里用到了一个make-let函数，其定义如下：

;(let ((var1 val1) (var2 val2) ...) body)
(define (make-let vars vals body)
  (cons 'let (cons (map list vars vals) body)))

3，我把scan-out-defines安装到make-procedure里面，因为这样的话，这个转换过程只用在定义时转化一次，如果安装在procedure-body的话，我们需要在每次调用这个procedure的时候，都转换一次。

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