[SICP] 問題4.51

計算機プログラムの構造と解釈
計算機プログラムの構造と解釈
posted with amazlet at 08.11.10
ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 25618
おすすめ度の平均: 3.0
4 紙と鉛筆と計算機と
1 内容最高。翻訳最低。
5 食わず嫌いでした。
5 プログラマにとって必読の本です
1 この第２版の日本語訳は大変よくない
Amazon.co.jp で詳細を見る


permanent-set! をどのように実装したらいいかを考えました。
そもそも、この元にすべきset! はどうだったのかな？
set! はch4-mceval.scm で実装されていて、評価器に組み込みの特殊形式でした。

よって、ch4-mceval.scm を参考に、次のように評価器に組み込みを開始します。

(define (analyze exp)
  (cond ((self-evaluating? exp) 
         (analyze-self-evaluating exp))
        ((quoted? exp) (analyze-quoted exp))
        ((variable? exp) (analyze-variable exp))
        ((permanent-assignment? exp) (analyze-permanent-assignment exp))	;; これを追加！
        ((assignment? exp) (analyze-assignment exp))
        ((definition? exp) (analyze-definition exp))
        ((if? exp) (analyze-if exp))
        ((lambda? exp) (analyze-lambda exp))
        ((begin? exp) (analyze-sequence (begin-actions exp)))
        ((cond? exp) (analyze (cond->if exp)))
        ((let? exp) (analyze (let->combination exp))) ;**
        ((amb? exp) (analyze-amb exp))                ;**
        ((application? exp) (analyze-application exp))
        (else
         (error "Unknown expression type -- ANALYZE" exp))))

;; こちらも追加

(define (permanent-assignment? exp)
  (tagged-list? exp 'permanent-set!))

(define (permanent-assignment-variable exp) (cadr exp))

(define (permanent-assignment-value exp) (caddr exp))

この評価を実行する、analyze-permanent-assignment を定義します。
set! は失敗継続を扱うようにわざわざ工夫されたものなので、その"やり戻し" の部分を無効にしたものとして作ればよいはず。
set! の評価を実行するanalyze-assignment(P.257) を参考に、次のように作ってみました。

;; set! のanalyze-assignment （参考にする方）
(define (analyze-assignment exp)
  (let ((var (assignment-variable exp))
        (vproc (analyze (assignment-value exp))))
    (lambda (env succeed fail)
      (vproc env
             (lambda (val fail2)        ; *1*
               (let ((old-value
                      (lookup-variable-value var env))) 
                 (set-variable-value! var val env)
                 (succeed 'ok
                          (lambda ()    ; *2*
                            (set-variable-value! var		;; ここでやり戻し処理を行っている
                                                 old-value
                                                 env)
                            (fail2)))))
             fail))))

;; 新しく用意したもの
(define (analyze-permanent-assignment exp)
  (let ((var (permanent-assignment-variable exp))
        (vproc (analyze (permanent-assignment-value exp))))
    (lambda (env succeed fail)
      (vproc env
             (lambda (val fail2)
               (begin
                 (set-variable-value! var val env)
                 (succeed 'ok
                          fail2)))	;; やり戻しをしないようにごっそり削除
             fail))))

準備できた。
問題にあるコードを流してみる。
(require とan-element-of は動作に際して必要なので実際に流すコード全体は次の通りです)

(define (require p)
  (if (not p) (amb)))

(define (an-element-of items)
  (require (not (null? items)))
  (amb (car items) (an-element-of (cdr items))))

(define count 0)

(let ((x (an-element-of '(a b c)))
      (y (an-element-of '(a b c))))
  (permanent-set! count (+ count 1))
  (require (not (eq? x y)))
  (list x y count))

実行結果はこうなりました。

;;; Starting a new problem 
;;; Amb-Eval value:
(a b 2)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(a c 3)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(b a 4)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(b c 6)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(c a 7)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(c b 8)

;;; Amb-Eval input:
try-again

;;; There are no more values of
(let ((x (an-element-of '(a b c))) (y (an-element-of '(a b c)))) (permanent-set! count (+ count 1)) (require (not (eq? x y))) (list x y count))

うまく動いている！


続いてもう一つの問いについても答える。
「permanent-set! の代わりにset! を使ったらどうなるか？」ということだが、set! のやり戻しが発生するため、count 値がそのたびに1 に戻るはずだ。

やってみよう。

;;; Starting a new problem 
;;; Amb-Eval value:
(a b 1)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(a c 1)

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
(b a 1)

できた。