SICP 問題 4.76

本文中のandはひとつ目の質問を満たす表明に対して次の質問を満たす表明をデータベースから探してくる．
それを２つの質問をそれぞれ満たすストリームをまず作り，
矛盾がないようにそれらを組み合わせるconjoin特殊形式を実装する．

(define (conjoin conjuncts frame-stream)
  (if (empty-conjunction? conjuncts)
      frame-stream
      (let ((first (qeval (first-conjunct conjuncts) frame-stream))
            (rest (conjoin (rest-conjuncts conjuncts) frame-stream)))
        (conjoin-frame-stream first rest))))

(define (conjoin-frame-stream fs1 fs2)
  (stream-filter
   (lambda (frame) (not (eq? frame 'failed)))
   (stream-flatmap
    (lambda (frame1)
      (stream-map
       (lambda (frame2) (conjoin-consistent frame1 frame2))
       fs2))
    fs1)))


;; f2をフレームと考え，f1のvarがf2にあるかを調べる．
;; f2にあってf1のvarの値と同じならOK．違えばfailed.なければf2を拡張する．
;; 上記手順はexend-if-possibleがやる．
(define (conjoin-consistent f1 f2)
  (if (null? f1) f2
      (let ((extend-frame2 (extend-if-possible (caar f1) (cdar f1) f2)))
        (if (eq? extend-frame2 'failed)
            'failed
            (conjoin-consistent (cdr f1) extend-frame2)))))

(put 'and 'qeval conjoin)

;; 本文で定義されたextend-if-possible
;; (? x)が値を指していればその値を返す．(? y)となっていれば，さらにその値を探す．
;; varもvalも(? x)同じものを指していればfailedが返る．
(define (extend-if-possible var val frame)
  (let ((binding (binding-in-frame var frame))) ;フレームからvarに対応するvalを探して束縛
    (cond (binding
           (unify-match (binding-value binding) val frame))
          ;; 上のletで探してきたvalもまた(? y)という形だった場合は更にフレームから探してくる．
          ((var? val)
           (let ((binding (binding-in-frame val frame)))
             (if binding
                 (unify-match var (binding-value binding) frame)
                 (extend var val frame)))) ;見つからなければフレームを拡張
          ((depends-on? val var frame)     ;valとvarが同じく(? x)だった場合はfailed
           'failed)
          (else (extend var val frame)))))