4 (define (lookup-variable-value var env)
6 (define (scan vars vals)
8 (env-loop (enclosing-environment env))]
10 (let ([value (car vals)])
11 (if (eq? value '*unassigned*)
12 (error "evaluating a variable which has not been assigned -- LOOKUP-VARIABLE-VALUE:" value)
14 [else (scan (cdr vars) (cdr vals))]))
15 (if (eq? env the-empty-environment)
16 (error "unbound variable" var)
17 (let ([frame (first-frame env)])
18 (scan (frame-variables frame)
19 (frame-values frame)))))
23 (define (tagged-list? expr tag)
24 (and (pair? expr) (eq? (car expr) tag)))
26 (define (definition? expr)
27 (tagged-list? expr 'define))
29 (define (lambda? expr)
30 (tagged-list? expr 'lambda))
32 (define (lambda-parameters expr)
35 (define (make-lambda params body)
36 (cons 'lambda (cons params body)))
38 ;;(lambda (x) (..)(..)...(..))
39 (define (lambda-body expr)
42 (define (scan-out-defines body)
43 (define (internal-definition-names defs)
46 [else (cons (cadr (car defs)) (internal-definition-names (cdr defs)))]))
47 (define (internal-definition-values defs)
50 [else (cons (caddr (car defs)) (internal-definition-values (cdr defs)))]))
52 ;; assumes that definitions come first in the body
53 (letrec ([get-body-internal (lambda (b)
56 [(definition? (car b)) (get-body-internal (cdr b))]
58 (get-body-internal (cdr b)))]))]
59 [get-definitions (lambda (b)
62 [(definition? (car b)) (cons (car b) (get-definitions (cdr b)))]
64 (let ([internal-definitions (get-definitions body)])
65 (let ([def-names (internal-definition-names internal-definitions)]
66 [def-vals (internal-definition-values internal-definitions)]
67 [internal-body (get-body-internal body)])
68 (letrec ([p (lambda (name-list)
70 [(empty? name-list) '()]
71 [else (cons (list (car name-list) ''*unassigned*)
72 (p (cdr name-list)))]))]
73 [s (lambda (names vals)
76 [else (cons (list 'set! (car names) (car vals))
77 (s (cdr names) (cdr vals)))]))])
80 (append (s def-names def-vals)
86 It is better to do this change in the procedure-body so that the procedure abstractions
87 are maintained as it is. The change we are introducing is related to Scheme and hence
88 should be done at the lowest level. We should be able to replace procedure-body for another
89 language and still be able to use the same eval function.
93 (define (procedure-body p) (scan-out-defines (caddr p)))