SICP演習問題4.51, 4.52, 4.53

4.51

;;;; exercise4.51
;;parmanent-set!
(define (permanent-assignment? exp)
  (tagged-list? exp '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))))

4.52

(define (if-fail? exp)
  (tagged-list? exp 'if-fail))

(define (if-fail-conequence exp)
  (cadr exp))

(define (if-fail-alternative exp)
  (caddr exp))

(define (analyze-if-fail exp)
  (let ((cproc (analyze (if-fail-conequence exp)))
        (aproc (analyze (if-fail-alternative exp))))
    (lambda (env succeed fail)
      (cproc env
             (lambda (val fail2)
               (succeed val fail2))
             (lambda () (aproc env
                               ([36mlambda (val fail2)
                                     (succeed val fail2))
                                   fail))))))

最初はこの式で実行したが，

(define (analyze-if-fail exp)
  (let ((cproc (analyze (if-fail-conequence exp)))
        (aproc (analyze (if-fail-alternative exp))))
    (lambda (env succeed fail)
      (cproc env succeed (lambda () (aproc env succeed fail))))))

でもできることに気が付く．
実際valなどの内部変数が必要なのは,4.51のように,valを使って何かさらにべつのことを行う場合．
使わないのであれば,succeedだけでいい．cprocを実行するときに,cprocの結果は出力される．

4.53

互いに素な組が自動的に作られる．
if-failの第二引数が(amb)なので,第一引数に失敗した場合,自動的にバックトラックされ,最後まで検索される．

;;; Amb-Eval input:
(let ((pairs '()))
  (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
             (permanent-set! pairs (cons p pairs))
             (amb))
           pairs))

;;; Starting a new problem
;;; Amb-Eval value:
((8 35) (3 110) (3 20))

ここで,prime-sum-pairの実装に,以下のようにprint文を加えてみる．

;;; Amb-Eval input:
(define (prime-sum-pair list1 list2)
  (let ((a (an-element-of list1))
        (b (an-element-of list2)))
    (print a)
    (print b)
    (require (prime? (+ a b)))
    (list a b)))

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

こうすると,バックトラックの順序がわかる．

;;; Amb-Eval input:
(let ((pairs '()))
  (if-fail (let ((p (prime-sum-pair '(1 3 5 8) '(20 35 110))))
             (permanent-set! pairs (cons p pairs))
             (amb))
           pairs))

;;; Starting a new problem 1
20
1
35
1
110
3
20
3
35
3
110
5
20
5
35
5
110
8
20
8
35
8
110

;;; Amb-Eval value:
((8 35) (3 110) (3 20))