さかもとのブログ

つらつらと

SICP演習問題4.13

;;exercise4.13
;;今見てる環境の変数のみを削除
;;内部で使おうとして上の環境の変数も削除されては大変
(define (unbind! variable env)
  (let ((frame (first-frame env)))
    (define (scan-and-delete variables values)
      (cond [(null?  variables)
             (error "Unbound variables -- UNBIND!" variable)]
            [(eq? variable (car variables))
             (set-car! variables (cadr variables))
             (set-cdr! variables (cddr variables))
             (set-car! values (cadr values))
             (set-cdr! values (cddr values))]
            [else (scan-and-delete (cdr variables) (cdr values))]))
    (scan-and-delete (frame-variables frame)
                     (frame-values frame))))

;;;;評価器の中に入れる
(define (unbind? exp) (tagged-list? exp 'unbind!))

(define (eval-unbind exp env)
  (let ((variable (cadr exp)))
    (unbind-variable! variable env)
    'ok))

;;evalを載せる
(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((quoted? exp) (text-of-quotation exp))
        ((assignment? exp) (eval-assignment exp env))
        ((definition? exp) (eval-definition exp env))
        ((unbind? exp) (eval-unbind exp env))
        ((if? exp) (eval-if exp env))
        ((and? exp) (eval-and exp env))
        ((or? exp) (eval-or exp env))
        ((lambda? exp)
         (make-procedure (lambda-parameters exp)
                         (lambda-body exp)
                         env))
        ((let? exp)
         (eval (let->combination exp)
               env))
        ((let*? exp)
         (eval (let*->nested-lets exp)
               env))
        ((begin? exp)
         (eval-sequence (begin-actions exp) env))
        ((cond? exp) (eval (cond->if exp) env))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
          (error "Unknown expression type -- EVAL" exp))))