(load "util.scm") (load "misc/sicp-compiler-lexical-addressing.scm") (display "\nex-5.39 - lexical-addressing\n") ; Exercise 5.39. Write a procedure lexical-address-lookup that implements the ; new lookup operation. It should take two arguments -- a lexical address and a ; run-time environment -- and return the value of the variable stored at the ; specified lexical address. Lexical-address-lookup should signal an error if ; the value of the variable is the symbol *unassigned*.46 Also write a ; procedure lexical-address-set! that implements the operation that changes the ; value of the variable at a specified lexical address. (define (make-address frame-number index-number) (list 'address frame-number index-number)) (define (frame-number address) (cadr address)) (define (index-number address) (caddr address)) (define test-env '((1 2 3) (4 5 6) (7 8 9))) (define (lexical-address-lookup adr env) (define (iter-env frame-number env) (cond ((null? env) (error "frame does not exist - LEXICAL-ADDRESS-LOOKUP" adr env)) ((= frame-number 0) (car env)) (else (iter-env (- frame-number 1) (cdr env))))) (define (iter-frame index-number frame) (cond ((null? frame) (error "index does not exist - LEXICAL-ADDRESS-LOOKUP" adr env)) ((and (= index-number 0) (eq? (car frame) '*unassigned*)) (error "var not assigned - LEXICAL-ADDRESS-LOOKUP" adr env)) ((= index-number 0) (car frame)) (else (iter-frame (- index-number 1) (cdr frame))))) (let ((frame (iter-env (frame-number adr) env))) (iter-frame (index-number adr) frame))) (assert (lexical-address-lookup (make-address 0 0) test-env) 1) (assert (lexical-address-lookup (make-address 0 1) test-env) 2) (assert (lexical-address-lookup (make-address 0 2) test-env) 3) (assert (lexical-address-lookup (make-address 1 0) test-env) 4) (assert (lexical-address-lookup (make-address 2 2) test-env) 9) ; (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) ; 'unbound-variable-error ; (let ((frame (first-frame env))) ; (scan (frame-variables frame) ; (frame-values frame))))) ; (env-loop env)) ;(define (unbound-variable? var) ; (eq? var 'unbound-variable-error)) (define (lexical-address-set! adr val env) '()) ; (define (env-loop env) ; (define (scan vars vals) ; (cond ((null? vars) ; (env-loop (enclosing-environment env))) ; ((eq? var (car vars)) ; (set-car! vals val)) ; (else (scan (cdr vars) (cdr vals))))) ; (if (eq? env the-empty-environment) ; (error "Unbound variable -- SET!" var) ; (let ((frame (first-frame env))) ; (scan (frame-variables frame) ; (frame-values frame))))) ; (env-loop env)) (display "\nex-5.40\n") ;(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-lexaddr.scm") ; (display "\nex-5.41\n") ; (display "\nex-5.42\n")