Ex. 4.75
構文的には、not と同じ使い方。なので、negate を改造して作る。という方針で。あとは適当に。
;; 追加関数
(define (uniquely-asserted operands frame-stream)
(stream-flatmap
(lambda (frame)
(let ((stream (qeval (negated-query operands)
(singleton-stream frame)))) ;; フレームの拡張結果を一旦ローカル変数へ
(cond ((stream-null? stream) the-empty-stream) ;; フレームなくなったとき。つまりマッチング失敗。
((stream-null? (stream-cdr stream)) stream) ;; フレーム拡張なし、ユニークであるとき
(else the-empty-stream)))) ;;フレームが拡張して、ユニークでなくなった場合。
frame-stream))
;; unique 形式の登録
(define (initialize-data-base rules-and-assertions)
...
(put 'unique 'qeval uniquely-asserted) ;; 追加
(put 'and 'qeval conjoin)
...
フレームストリームの中のフレームの個数(0個、1個、2個以上)を判定するためどうしてもローカル変数を使わざるを得なかった。
動作テスト
;;; Query input: (unique (job (Bitdiddle Ben) (computer wizard))) ;;; Query results: (unique (job (Bitdiddle Ben) (computer wizard))) ------ ;;; Query input: (unique (job ?x (computer programmer))) ;;; Query results: なし ------ ;;; Query input: (and (job ?x ?j) (unique (job ?anyone ?j))) ;;; Query results: (and (job (Aull DeWitt) (administration secretary)) (unique (job (Aull DeWitt) (administration secretary)))) (and (job (Cratchet Robert) (accounting scrivener)) (unique (job (Cratchet Robert) (accounting scrivener)))) (and (job (Scrooge Eben) (accounting chief accountant)) (unique (job (Scrooge Eben) (accounting chief accountant)))) (and (job (Warbucks Oliver) (administration big wheel)) (unique (job (Warbucks Oliver) (administration big wheel)))) (and (job (Reasoner Louis) (computer programmer trainee)) (unique (job (Reasoner Louis) (computer programmer trainee)))) (and (job (Tweakit Lem E) (computer technician)) (unique (job (Tweakit Lem E) (computer technician)))) (and (job (Bitdiddle Ben) (computer wizard)) (unique (job (Bitdiddle Ben) (computer wizard)))) ------