SICP演習問題5.39

たいぶおかしなコードですがお許しください。

(define (search-frame frame-num env)
  (define (scan-frame count env)
    (cond ((null? env)
           (error "search-frame" frame-num env))
          ((= count frame-num)
           (car env))
          (else (scan-frame (+ count 1) (cdr env)))))
  (scan-frame 0 env))

(define (search-bind arg-num frame)
  (define (scan-bind count variables values)
    (cond ((null? variables)
           (error "search-num" arg-num (car frame)))
          ((= count arg-num)
           (list (car variables) (car values)))
          (else (scan-bind (+ count 1) (cdr variables) (cdr values)))))
  (scan-bind 0 (car frame) (cdr frame)))

(define (lexical-address-lookup lexical-address env)
  (let ((frame-num (car lexical-address))
        (arg-num (cadr lexical-address)))
    (let ((frame (search-frame frame-num env)))
      (let ((bind (search-bind arg-num frame)))
        (if (eq? (cadr bind) '*unassigned*)
            (error "Unassigned variable *unassigned* -- lexical-address-lookup"
                   lexical-address
                   frame
                   bind)
            (cadr bind))))))
(define (lexical-address-set! lexical-address env value)
    (define (scan-frame count frame-num env)
      (cond ((null? env)
             (error "search-frame" frame-num env))
            ((= count frame-num)
             (car env))
            (else (scan-frame (+ count 1) frame-num (cdr env)))))
    (define (scan-bind count arg-num variables values value)
      (cond ((null? variables)
             (error "search-num" arg-num (car frame)))
            ((= count arg-num)
             ;(print (list (car variables) (car values)))
             (set-car! values value))
            (else (scan-bind (+ count 1) arg-num (cdr variables) (cdr values) value))))
    (let ((frame-num (car lexical-address))
          (arg-num (cadr lexical-address)))
      (let ((frame (scan-frame 0 frame-num env)))
        (let ((bind (scan-bind 0 arg-num (car frame) (cdr frame) value)))
          ;(print env))
          'done))))