Implement 5.42
parent
54bc6725f3
commit
ff4fa9e844
|
@ -73,28 +73,30 @@
|
|||
(define (empty-compile-time-env) '())
|
||||
|
||||
(define (extend-compile-time-env parameters base-env)
|
||||
(display base-env) (newline)
|
||||
(display parameters) (newline)
|
||||
(cons parameters base-env))
|
||||
|
||||
(compile-to-file
|
||||
'(let ((x 3) (y 4))
|
||||
(lambda (a b c d e)
|
||||
(let ((y (* a b x))
|
||||
(z (+ c d x)))
|
||||
(* x y z))))
|
||||
'val 'next "f-lex-adr.scm")
|
||||
(display "[done]\n")
|
||||
|
||||
(display "\nex-5.41 - find-variable\n")
|
||||
|
||||
; Exercise 5.41. Write a procedure find-variable that takes as arguments a
|
||||
; variable and a compile-time environment and returns the lexical address of
|
||||
; the variable with respect to that environment. For example, in the program
|
||||
; fragment that is shown above, the compile-time environment during the
|
||||
; compilation of expression <e1> is ((y z) (a b c d e) (x y)). Find-variable
|
||||
; should produce
|
||||
|
||||
(define (find-variable var env) '9)
|
||||
(define (find-variable var env)
|
||||
(define (get-index frame current-index)
|
||||
(cond
|
||||
((null? frame) (error "var not found -- FIND-VARIABLE"))
|
||||
((eq? (car frame) var) current-index)
|
||||
(else (get-index (cdr frame) (+ current-index 1)))))
|
||||
(define (find-env i frames)
|
||||
(cond
|
||||
((null? frames) 'not-found)
|
||||
((memq var (car frames)) (cons i (car frames)))
|
||||
(else (find-env (+ i 1) (cdr frames)))))
|
||||
(let ((find-env-result (find-env 0 env)))
|
||||
(if (eq? find-env-result 'not-found)
|
||||
'not-found
|
||||
(let* ((frame-number (car find-env-result))
|
||||
(frame (cdr find-env-result))
|
||||
(index-number (get-index frame 0)))
|
||||
(make-address frame-number index-number)))))
|
||||
|
||||
(assert (find-variable 'c '((y z) (a b c d e) (x y)))
|
||||
(make-address 1 2))
|
||||
|
@ -105,6 +107,30 @@
|
|||
(assert (find-variable 'w '((y z) (a b c d e) (x y)))
|
||||
'not-found)
|
||||
|
||||
(display "\nex-5.42\n")
|
||||
; (display "\nex-5.43\n")
|
||||
(display "\nex-5.42 - compile-lexical-addressing\n")
|
||||
|
||||
(compile-to-file
|
||||
'(let ((x 3) (y 4))
|
||||
(lambda (a b c d e)
|
||||
(let ((y (* a b x))
|
||||
(z (+ c d x)))
|
||||
(set! y 3)
|
||||
(* x y z))))
|
||||
'val 'next "f-lex-adr.scm")
|
||||
|
||||
(display "[done]\n")
|
||||
|
||||
|
||||
(display "\nex-5.43 - scan-out-defines\n")
|
||||
|
||||
; Exercise 5.43. We argued in section 4.1.6 that internal definitions for
|
||||
; block structure should not be considered ``real'' defines. Rather, a
|
||||
; procedure body should be interpreted as if the internal variables being
|
||||
; defined were installed as ordinary lambda variables initialized to their
|
||||
; correct values using set!. Section 4.1.6 and exercise 4.16 showed how to
|
||||
; modify the metacircular interpreter to accomplish this by scanning out
|
||||
; internal definitions. Modify the compiler to perform the same transformation
|
||||
; before it compiles a procedure body.
|
||||
|
||||
(display "\nex-5.44\n")
|
||||
|
||||
|
|
|
@ -88,26 +88,37 @@
|
|||
`((assign ,target (const ,(text-of-quotation exp)))))))
|
||||
|
||||
(define (compile-variable exp ct-env target linkage)
|
||||
(end-with-linkage linkage
|
||||
(make-instruction-sequence '(env) (list target)
|
||||
`((assign ,target
|
||||
(op lookup-variable-value)
|
||||
(const ,exp)
|
||||
(reg env))))))
|
||||
(let ((adr (find-variable exp ct-env)))
|
||||
(if (eq? adr 'not-found)
|
||||
(end-with-linkage linkage
|
||||
(make-instruction-sequence '(env) (list target 'env)
|
||||
`((assign env (op get-global-environment) (reg env))
|
||||
(assign ,target
|
||||
(op lookup-variable-value)
|
||||
(const ,exp)
|
||||
(reg env)))))
|
||||
(end-with-linkage linkage
|
||||
(make-instruction-sequence '(env) (list target)
|
||||
`((assign ,target
|
||||
(op lexical-address-lookup)
|
||||
(const ,adr)
|
||||
(reg env))))))))
|
||||
|
||||
(define (compile-assignment exp ct-env target linkage)
|
||||
(let ((var (assignment-variable exp))
|
||||
(get-value-code
|
||||
(compile (assignment-value exp) 'val 'next)))
|
||||
(end-with-linkage linkage
|
||||
(preserving '(env)
|
||||
get-value-code
|
||||
(make-instruction-sequence '(env val) (list target)
|
||||
`((perform (op set-variable-value!)
|
||||
(const ,var)
|
||||
(reg val)
|
||||
(reg env))
|
||||
(assign ,target (const ok))))))))
|
||||
(let* ((var (assignment-variable exp))
|
||||
(get-value-code (compile (assignment-value exp) ct-env 'val 'next))
|
||||
(adr (find-variable var ct-env)))
|
||||
(if (eq? adr 'not-found)
|
||||
(error "var not found -- compile-assignment" var)
|
||||
(end-with-linkage linkage
|
||||
(preserving '(env)
|
||||
get-value-code
|
||||
(make-instruction-sequence '(env val) (list target)
|
||||
`((perform (op lexical-address-set!)
|
||||
(const ,adr) ;; (const ,var) before
|
||||
(reg val)
|
||||
(reg env))
|
||||
(assign ,target (const ok)))))))))
|
||||
|
||||
(define (compile-definition exp ct-env target linkage)
|
||||
(let ((var (definition-variable exp))
|
||||
|
|
Loading…
Reference in New Issue