SICP 問題 5.39

文面アドレスと実行時環境とり値を検索するlexical-address-lookupと 値を変更するlexical-address-set!を実装する．

;;; 文面アドレスを使って変数の値を探す
(define (lexical-address-lookup lex-add r-env)
  (let ((frame (frame-values (list-ref r-env (car lex-add)))))
    (let ((val (list-ref frame (cadr lex-add))))
      (if (eq? val '*unassigned*)
          (error "*Unassigned* variable")
          val))))

;;; 文面アドレスにある値を変更する
(define (lexical-address-set! lex-add val r-env)
  (let ((frame (frame-values (list-ref r-env (car lex-add)))))
    (define (iter frame count)
      (if (= count 0)
          (begin (set-car! frame val)
                 'ok)
          (iter (cdr frame) (- count 1))))
    (iter frame (cadr lex-add))))

test

gosh> (define my-env (extend-environment '(x y) '(1 2) the-global-environment))
my-env
gosh> my-env
(((x y) 1 2)
 ((false true car cdr cons null? = - + * / > <)
  #f
  #t
  (primitive #<subr car>)
  (primitive #<subr cdr>)
  (primitive #<subr cons>)
  (primitive #<subr null?>)
  (primitive #<subr =>)
  (primitive #<subr ->)
  (primitive #<subr +>)
  (primitive #<subr *>)
  (primitive #<subr />)
  (primitive #<subr >>)
  (primitive #<subr <>)))
gosh> (lexical-address-lookup '(0 0) my-env)
1
gosh> (lexical-address-lookup '(0 1) my-env)
2
gosh> (lexical-address-lookup '(1 0) my-env)
#f
gosh> (lexical-address-lookup '(1 1) my-env)
#t
gosh> (lexical-address-set! '(0 0) 'scheme my-env)
ok
gosh> (lexical-address-lookup '(0 0) my-env)
scheme
gosh> (lexical-address-set! '(1 1) 'SICP my-env)
ok
gosh> (lexical-address-lookup '(1 1) my-env)
SICP