計算機プログラムの構造と解釈　第二版 P226 問題4.13

sicp

束縛を解放する手続きunbind!を作りなさいという問題。
解放する手続きは今いるスコープの中のモノだけで良いと思う。つまりfirst-frameで取得できる所から消すだけでよい。そうじゃないと、他の手続きとかが使おうとしてたりするのに、勝手に消してしまうことになって、使えなくなる可能性がある。


実装ですが、ここまでにたような問題をやってきたそう復習みたいなもんだ。

  • evalに設定してもにゃもにゃやる
  • lookup-variableの応用で、見つけた後、削除するような手続きを作る。


実装

#!/usr/local/bin/gosh
;; -*- coding: utf-8 -*-

;;;実装
(load "./modules/4th.scm")
(load "./modules/let.scm")


(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))
        ;;4.13
        ((unbind? exp) (eval-unbind exp env))

        ((if? exp) (eval-if exp env))
        ((lambda? exp)
         (make-procedure (lambda-parameters exp)
                         (lambda-body exp)
                         env))
        ((begin? exp) 
         (eval-sequence (begin-actions exp) env))
        ((cond? exp) (eval (cond->if exp) env))
        ;;4.6
        ((let? exp) (eval (let->combination exp) env))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
          (error "Unknown expression type -- EVAL" exp))))


(define (unbind? exp) (tagged-list? exp 'unbind!))

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

(define (unbind-varialbe exp) (cadr exp))


(define (unbind-variable! var env)
  (let ((frame (first-frame env)))
    (define (scan vars vals)
      (cond ((null? vars)
             (error "Unbound variabl --UNBIND-VARIABLE:" var))
            ((eq? var (car vars))
             (set-car! vars (cadr vars))
             (set-cdr! vars (cddr vars))
             (set-car! vals (cadr vals))
             (set-cdr! vals (cddr vals)))
            (else (scan (cdr vars) (cdr vals)))))
    (scan (frame-variables frame)
          (frame-values frame))))


;;確認用
(define env1 (list (list (list 'a 'b 'c 'd) 1 2 3 4) (list (list 'a2 'b2 'c2 'd2) 1 2 3 4)))

(display "envの実態:")(print env1)
(display "(first-frame env1):")(print (first-frame env1))
(display "(frame-variables (first-frame env1)):")(print (frame-variables (first-frame env1)))
(display "(frame-values (first-frame env1)):")(print (frame-values (first-frame env1)))
(unbind-variable! 'c env1)
(display "(unbind-variable! 'c env1)のあとのenv1):")(print env1)


(define the-global-environment (setup-environment))
(driver-loop)


実行

envの実態:(((a b c d) 1 2 3 4) ((a2 b2 c2 d2) 1 2 3 4))
(first-frame env1):((a b c d) 1 2 3 4)
(frame-variables (first-frame env1)):(a b c d)
(frame-values (first-frame env1)):(1 2 3 4)
(unbind-variable! 'c env1)のあとのenv1):(((a b d) 1 2 4) ((a2 b2 c2 d2) 1 2 3 4))


;;; M-Eval input:
(define a 1)

;;; M-Eval value:
ok

;;; M-Eval input:
a

;;; M-Eval value:
1

;;; M-Eval input:
(unbind! a)

;;; M-Eval value:
ok

;;; M-Eval input:
a
gosh: "error": Unbound variable a

プロンプトが始まる前の部分はenvとかの確認です。