SICP/ex-5_39-xx.scm

(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")