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

SICP 問題 4.54

requireを特殊形式で実装する．

(define (require? exp)
  (tagged-list? exp 'require))

(define (require-predicate exp) (cadr exp))

(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))
        ((require? exp) (analyze-require exp))
        ((ramb? exp) (analyze-ramb exp))
        ((if? exp) (analyze-if exp))
        ((if-fail? exp) (analyze-if-fail 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))))

(define (analyze-require exp)
  (let ((pproc (analyze (require-predicate exp))))
    (lambda (env succeed fail)
      (pproc env
             (lambda (pred-value fail2)
               (if (not (true? pred-value))
                   (fail2)
                   (succeed 'ok fail2)))
             fail))))

test

;;; 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:
(an-element-of '(1 2 3))

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

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
2

;;; Amb-Eval input:
try-again

;;; Amb-Eval value:
3

;;; Amb-Eval input:
try-again

;;; There are no more values of
(an-element-of '(1 2 3))

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

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

© 2022 wat-aro