首先,我们先定义一下关于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))