92 lines
3.2 KiB
Scheme
92 lines
3.2 KiB
Scheme
(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")
|
|
|