Exercise 5.40. Modify the compiler to maintain the compile-time environment as described above. That is, add a compile-time-environment argument to compile and the various code generators, and extend it in compile-lambda-body. ———————————————————————————————————————————————————————————————————————— Modified compiler is in 5.40-compiler.scm, changes below. Not every compile-* procedure needs or uses the new argument, but we pass it to all of them anyway for consistency. --- ch5-compiler.scm 2001-06-21 12:54:32.000000000 -0600 +++ 5.40-compiler.scm 2010-06-06 15:01:20.000000000 -0600 @@ -17,25 +17,26 @@ ;;;SECTION 5.5.1 -(define (compile exp target linkage) +(define (compile exp target linkage env) (cond ((self-evaluating? exp) - (compile-self-evaluating exp target linkage)) - ((quoted? exp) (compile-quoted exp target linkage)) + (compile-self-evaluating exp target linkage env)) + ((quoted? exp) (compile-quoted exp target linkage env)) ((variable? exp) - (compile-variable exp target linkage)) + (compile-variable exp target linkage env)) ((assignment? exp) - (compile-assignment exp target linkage)) + (compile-assignment exp target linkage env)) ((definition? exp) - (compile-definition exp target linkage)) - ((if? exp) (compile-if exp target linkage)) - ((lambda? exp) (compile-lambda exp target linkage)) + (compile-definition exp target linkage env)) + ((if? exp) (compile-if exp target linkage env)) + ((lambda? exp) (compile-lambda exp target linkage env)) ((begin? exp) (compile-sequence (begin-actions exp) target - linkage)) - ((cond? exp) (compile (cond->if exp) target linkage)) + linkage + env)) + ((cond? exp) (compile (cond->if exp) target linkage env)) ((application? exp) - (compile-application exp target linkage)) + (compile-application exp target linkage env)) (else (error "Unknown expression type -- COMPILE" exp)))) @@ -69,17 +70,17 @@ ;;;simple expressions -(define (compile-self-evaluating exp target linkage) +(define (compile-self-evaluating exp target linkage env) (end-with-linkage linkage (make-instruction-sequence '() (list target) `((assign ,target (const ,exp)))))) -(define (compile-quoted exp target linkage) +(define (compile-quoted exp target linkage env) (end-with-linkage linkage (make-instruction-sequence '() (list target) `((assign ,target (const ,(text-of-quotation exp))))))) -(define (compile-variable exp target linkage) +(define (compile-variable exp target linkage env) (end-with-linkage linkage (make-instruction-sequence '(env) (list target) `((assign ,target @@ -87,7 +88,7 @@ (const ,exp) (reg env)))))) -(define (compile-assignment exp target linkage) +(define (compile-assignment exp target linkage env) (let ((var (assignment-variable exp)) (get-value-code (compile (assignment-value exp) 'val 'next))) @@ -101,10 +102,10 @@ (reg env)) (assign ,target (const ok)))))))) -(define (compile-definition exp target linkage) +(define (compile-definition exp target linkage env) (let ((var (definition-variable exp)) (get-value-code - (compile (definition-value exp) 'val 'next))) + (compile (definition-value exp) 'val 'next env))) (end-with-linkage linkage (preserving '(env) get-value-code @@ -131,18 +132,18 @@ (number->string (new-label-number))))) ;; end of footnote -(define (compile-if exp target linkage) +(define (compile-if exp target linkage env) (let ((t-branch (make-label 'true-branch)) (f-branch (make-label 'false-branch)) (after-if (make-label 'after-if))) (let ((consequent-linkage (if (eq? linkage 'next) after-if linkage))) - (let ((p-code (compile (if-predicate exp) 'val 'next)) + (let ((p-code (compile (if-predicate exp) 'val 'next env)) (c-code (compile - (if-consequent exp) target consequent-linkage)) + (if-consequent exp) target consequent-linkage env)) (a-code - (compile (if-alternative exp) target linkage))) + (compile (if-alternative exp) target linkage env))) (preserving '(env continue) p-code (append-instruction-sequences @@ -156,16 +157,16 @@ ;;; sequences -(define (compile-sequence seq target linkage) +(define (compile-sequence seq target linkage env) (if (last-exp? seq) - (compile (first-exp seq) target linkage) + (compile (first-exp seq) target linkage env) (preserving '(env continue) - (compile (first-exp seq) target 'next) - (compile-sequence (rest-exps seq) target linkage)))) + (compile (first-exp seq) target 'next env) + (compile-sequence (rest-exps seq) target linkage env)))) ;;;lambda expressions -(define (compile-lambda exp target linkage) +(define (compile-lambda exp target linkage env) (let ((proc-entry (make-label 'entry)) (after-lambda (make-label 'after-lambda))) (let ((lambda-linkage @@ -178,10 +179,10 @@ (op make-compiled-procedure) (label ,proc-entry) (reg env))))) - (compile-lambda-body exp proc-entry)) + (compile-lambda-body exp proc-entry env)) after-lambda)))) -(define (compile-lambda-body exp proc-entry) +(define (compile-lambda-body exp proc-entry env) (let ((formals (lambda-parameters exp))) (append-instruction-sequences (make-instruction-sequence '(env proc argl) '(env) @@ -192,23 +193,29 @@ (const ,formals) (reg argl) (reg env)))) - (compile-sequence (lambda-body exp) 'val 'return)))) - + (compile-sequence (lambda-body exp) + 'val + 'return + (extend-compilation-environment env formals))))) + +(define (extend-compilation-environment env new-variables) + (let ((vals (map (lambda (x) '*compile-time-val*) new-variables))) + (extend-environment new-variables vals env))) ;;;SECTION 5.5.3 ;;;combinations -(define (compile-application exp target linkage) - (let ((proc-code (compile (operator exp) 'proc 'next)) +(define (compile-application exp target linkage env) + (let ((proc-code (compile (operator exp) 'proc 'next env)) (operand-codes - (map (lambda (operand) (compile operand 'val 'next)) + (map (lambda (operand) (compile operand 'val 'next env)) (operands exp)))) (preserving '(env continue) proc-code (preserving '(proc continue) (construct-arglist operand-codes) - (compile-procedure-call target linkage))))) + (compile-procedure-call target linkage env))))) (define (construct-arglist operand-codes) (let ((operand-codes (reverse operand-codes))) @@ -242,7 +249,7 @@ ;;;applying procedures -(define (compile-procedure-call target linkage) +(define (compile-procedure-call target linkage env) (let ((primitive-branch (make-label 'primitive-branch)) (compiled-branch (make-label 'compiled-branch)) (after-call (make-label 'after-call))) @@ -255,7 +262,7 @@ (parallel-instruction-sequences (append-instruction-sequences compiled-branch - (compile-proc-appl target compiled-linkage)) + (compile-proc-appl target compiled-linkage env)) (append-instruction-sequences primitive-branch (end-with-linkage linkage @@ -269,7 +276,7 @@ ;;;applying compiled procedures -(define (compile-proc-appl target linkage) +(define (compile-proc-appl target linkage env) (cond ((and (eq? target 'val) (not (eq? linkage 'return))) (make-instruction-sequence '(proc) all-regs `((assign continue (label ,linkage))