Serendip

Web Studio

問題4.52

第1引数が成功した場合はそのまま成功継続を返し、失敗した場合は第2引数の評価を行う。

(define (analyze exp)
  (cond ((self-evaluating? exp)
         (analyze-self-evaluating exp))
        ;; 省略
        ((if-fail? exp) (analyze-if-fail exp))
        ;; 省略
        (else
          (error "Unknown expression type -- ANALYZE" exp))))

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

(define (if-succeed exp) (cadr exp))

(define (if-failed exp) (caddr exp))

(define (analyze-if-fail exp)
  (let ((sproc (analyze (if-succeed exp)))
        (fproc (analyze (if-failed exp))))
       (lambda (env succeed fail)
               (sproc env
                      succeed    ;; 第1引数の成功継続
                      (lambda () ;; 第1引数の失敗継続
                              (fproc env succeed fail))))))

実行結果

;;; Amb-Eval input:
(define (require p)
  (if (not p) (amb)))

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

;;; Amb-Eval input:
(define (an-element-of items)
  (require (not (null? items)))
  (amb (car items) (an-element-of (cdr items))))

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

;;; Amb-Eval input:
(if-fail (let ((x (an-element-of '(1 3 5))))
              (require (even? x))
              x)
         'all-odd)

;;; Starting a new problem 
;;; Amb-Eval value:
all-odd

;;; Amb-Eval input:
(if-fail (let ((x (an-element-of '(1 2 3 5 8))))
              (require (even? x))
              x)
         'all-odd)

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

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
8

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
all-odd

;;; Amb-Eval input:
try-again

;;; There are no more values of
(if-fail (let ((x (an-element-of '(1 2 3 5 8)))) (require (even? x)) x) 'all-odd)

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

posted with amazlet at 08.11.07

ジェラルド・ジェイ サスマン ジュリー サスマン ハロルド エイブルソン
ピアソンエデュケーション
売り上げランキング: 6542

Amazon.co.jp で詳細を見る