profile image(wat-aro)
2016/01/15

SICP 問題 4.51

バックトラックで戻らないpermanent-set!の実装

;; permanent-set!
(define (analyze-permanent-assignment exp)
  (let ((var (assignment-variable exp))
        (vproc (analyze (assignment-value exp))))
    (lambda (env succeed fail)
      (vproc env
             (lambda (val fail2)
                 (set-variable-value! var val env)
                 (succeed 'ok
                          fail2))
             fail))))

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

(define (analyze exp)
  (cond ((self-evaluating? exp) (analyze-self-evaluating exp))
        ((quoted? exp) (analyze-quoted exp))
        ((variable? exp) (analyze-variable exp))
        ((assignment? exp) (analyze-assignment exp))
        ((permanent-assignment? exp) (analyze-permanent-assignment exp))
        ((definition? exp) (analyze-definition exp))
        ((amb? exp) (analyze-amb exp))
        ((ramb? exp) (analyze-ramb exp))
        ((if? exp) (analyze-if exp))
        ((lambda? exp) (analyze-lambda exp))
        ((let? exp) (analyze (let->combination exp)))
        ((begin? exp) (analyze-sequence (begin-actions exp)))
        ((cond? exp) (analyze (cond->if exp)))
        ((application? exp) (analyze-application exp))
        (else (error "Unknown expression type: ANALYZE" exp))))

test

;;; Amb-Eval input:
(define count 0)

;;; Starting a new problem
;;; Amb-Eval value:
ok

;;; Amb-Eval input:
(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)

permanent-set!のかわりにset!を使うと

;;; Amb-Eval input:
(define count 0)

;;; Starting a new problem
;;; Amb-Eval value:
ok

;;; Amb-Eval input:
(let ((x (an-element-of '(a b c)))
      (y (an-element-of '(a b c))))
  (set! count (+ count 1))
  (require (not (eq? x y)))
  (list x y count))

;;; 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)

バックトラックで代入が元に戻るのでカウントが増えていかなくなる．

計算機プログラムの構造と解釈 第2版

計算機プログラムの構造と解釈 第2版

© 2022 wat-aro