(wat-aro)

無職から有職者にランクアップしました

SICP 問題 4.11

;; フレームを束縛のリストとして表現
(define (make-frame variables values)
  (map cons variables values))

(define (first-binding frame) (car frame))
(define (rest-bindings frame) (cdr frame))

(define (binding-variable binding) (car binding))
(define (binding-value binding) (cdr binding))
(define (make-binding var val) (cons var val))


(define (add-binding-to-frame! var val fram)
  (set! frame (cons (make-binding var val) frame)))

;; 変更無し
(define (extend-environment vars vals base-env)
  (if (= (length vars) (length vals))
      (cons (make-frame vars vals) base-env)
      (if (< (length vars) (length vals))
          (error "Too many arguments supplied" vars vals)
          (error "Too few arguments supplied" vars vals))))

;; 変更無し
(define (lookup-variable-value var env)
  (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)
        (error "Unbound variable" var)
        (let ((frame (first-frame env)))
          (scan (frame-variables frame)
                (frame-values frame)))))
  (env-loop env))

;; frame-variablesとframe-valuesを作ればset-variable-value!とdefine-variable!は変更なし
(define (frame-variables frame) (map car frame))
(define (frame-values frame) (map cdr frame))
(define (set-variable-value! var 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))

(define (define-variable! var val env)
  (let ((frame (first-frame env)))
    (define (scan vars vals)
      (cond ((null? vars)
             (add-binding-to-frame! var val frame))
            ((eq? var (car vars)) (set-car! vals val))
            (else (scan (cdr vars) (cdr vals)))))
    (scan (frame-variables frame) (frame-values frame))))

;; 作らない場合はassqで走査する
(define (set-variable-value var val env)
  (define (env-loop env)
    (let ((target (assq var (first-frame env))))
      (if target
          (set-cdr! target val)
          (env-loop (enclosing-environment env))))))
(env-loop env)

(define (define-variable! var val env)
  (let* ((frame (first-frame env))
         (target (assq var frame)))
    (if target
        (set-cdr! target val)
        (add-binding-to-frame! var val frame))))