4.4.4 實現查詢系統
4.4.2部分描述了查詢系統如何工作。現在我們通過表示出系統的一個完整的實現，來填充它的細節。

4.4.4.1 驅動迴圈與例項化
查詢系統的驅動迴圈重複地讀取輸入的表示式。如果表示式是一個規則或者是斷言，
就被新增到資料庫中，然後資訊就加上了。否則，表示式被作為一個查詢來對待。
驅動把這個查詢傳給直譯器qeval,再結合初始化的幀的流，這個流包括了一個單獨的空的幀。
解釋的結果是通過滿足的查詢並且帶著從資料庫中找到的變數的值生成的幀的流。
這些幀被用來生成一個新的流，它由原始的查詢，並且它的變數例項化的副本組成。
這個最終的流被列印在終端上。

(define  input-prompt  ";;; Query input:")
(define  output-prompt  ";;; Query result:")
(define  (query-driver-loop)
    (prompt-for-input  input-prompt)
    (let  ((q  (query-syntax-process (read))))
          (cond   ((assertion-to-be-add?  q)
                         (add-rule-or-assertion!)
                         (newline)
                         (display "Assertion added to database.")
                         (query-driver-loop)
                       )
                      (else
                          (newline) 
                          (display  output-prompt) 
                          (display-stream 
                                 (stream-map 
                                         (lambda  (frame) 
                                                   (instantiate   q
                                                                  frame 
                                                                  (lambda  (v  f)   (contract-question-mark  v))
                                                   )
                                         )
                                        (qeval  q  (singleton-stream   '()))
                                  ))
                           (query-driver-loop)
                      )     
          )
    )
)

這裡，作為在這一章裡的另一個直譯器，我們為了查詢語言的表示式，
使用了一個抽象的語法。表示式語法的實現，包括在4.4.4.7部分中給出的
判斷式 assertion-to-be-added?和選擇子 add-assertion-body. 在4.4.4.5部分中
定義了 add-rule-or-assertion!

在一個輸入的表示式上做任何的處理之前，驅動迴圈為了讓處理過程更加高效，
把它做了語法上的形式轉換。這包括了改變了模式變數的表示形式。當查詢被例項化時，
在被列印之前，任何未被繫結的變數都被轉換回輸入時的表示形式。這些轉換被4.4.4.7
部分中的query-syntax-process 和 contract-question-mark程式執行。

為了例項化一個表示式，我們複製它，在表示式中用它們的在一個給定的幀的值來替換變數。
值本身被例項化，因為它能包括變數（例如，如果在exp中的?x 被繫結到?y 作為一致性的
結果，?y繫結到5）如果一個變數不能被例項化，採用的動作由Instantiate的一個程式化的引數給定。

(define (instantiate exp frame unbound-var-handler)
  (define (copy exp)
    (cond ((var? exp)
           (let ((binding (binding-in-frame exp frame)))
             (if binding
                 (copy (binding-value binding))
                 (unbound-var-handler exp frame))))
          ((pair? exp)
           (cons (copy (car exp)) (copy (cdr exp))))
          (else exp)))
  (copy exp))

在4.4.4.8部分中定義了操縱繫結的程式。

4.4.4.2 直譯器
qeval 程式被query-driver-loop 程式呼叫，是一個查詢系統的基本的直譯器。它以一個查詢和
一個幀的流為實際引數，並且它返回一個擴充套件的幀的流。它標識著關鍵字通過一個使用得到與放
操作的資料驅動的分發，正如在第二章中實現通用的操作時我們所做的那樣。任何的查詢沒有被識別
為一個關鍵字，就被假定為一個簡單的查詢， 由  simple-query程式來處理。

(define (qeval query frame-stream)
  (let ((qproc (get (type query) 'qeval)))
    (if qproc
        (qproc (contents query) frame-stream)
        (simple-query query frame-stream))))

型別和內容被定義在4.4.4.7部分中，實現了關鍵字的抽象的語法。

*簡單查詢
simple-query程式來處理簡單的查詢。它以一個簡單的查詢和一個幀的流為實際引數，返回擴充套件的幀
形成的流，通過查詢匹配的所有的資料。

(define (simple-query query-pattern frame-stream)
  (stream-flatmap
   (lambda (frame)
     (stream-append-delayed
      (find-assertions query-pattern frame)
      (delay (apply-rules query-pattern frame))))
   frame-stream))

對於輸入流中的每一個幀，我們使用 找到斷言（見4.4.4.3部分中的find-assertions） 來匹配
符合模式的資料庫中所有的斷言，生成一個擴充套件的幀的流，並且我們使用 應用規則
(見4.4.4.4部分中的 apply-rules)來應用所有的可能的規則，生成擴充套件的幀的另一個流。這兩個流被組合
（使用stream-append-delayed 見4.4.4.6部分）來生成一個流來保證給定的模型能夠被滿足
並且與原來的幀保持一致。輸入的幀的流被合併使用stream-flatmap(見4.4.4.6部分)來形成一個大的流，
原來的輸入的流的任何的幀能被擴充套件，來生成對給定的模式的匹配。

*複合查詢
與查詢 被程式 conjoin處理,正如圖4.5中的演示。conjoin以輸入的聯合和幀的流為實際引數，返回擴充套件的幀
的流。首先，conjoin處理幀的流來找到所有的可能的幀的擴充套件來滿足聯合中的第一個查詢的流。
然後，使用這個作為一個新的幀的流，它遞迴地應用conjoin來聯合查詢的其它部分。

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

表示式(put 'and 'qeval conjoin)在遇到了一個與表示式時，設定qeval 分發到conjoin。

或查詢的處理與之相似，顯示在圖4.6中。或的各個部分的輸出流被單獨地計算並且使用
interleave-delayed程式（來自於4.4.4.6部分）來合併。

(define (disjoin disjuncts frame-stream)
  (if (empty-disjunction? disjuncts)
      the-empty-stream
      (interleave-delayed
       (qeval (first-disjunct disjuncts) frame-stream)
       (delay (disjoin (rest-disjuncts disjuncts)
                       frame-stream)))))
(put 'or 'qeval disjoin)

與和或的語法的判斷式和選擇子在4.4.4.7部分中給出來了。

*過濾器
非的處理由4.4.2部分中列出的方法來處理。我們試著擴充套件輸入流中的每個幀來滿足否定的查詢，
並且，如果它不能被擴充套件的話，我們在輸出流中僅包括了一個給定的幀。

(define (negate operands frame-stream)
  (stream-flatmap
   (lambda (frame)
     (if (stream-null? (qeval (negated-query operands)
                              (singleton-stream frame)))
         (singleton-stream frame)
         the-empty-stream))
   frame-stream))
(put 'not 'qeval negate)

lisp-value是一個過濾器與非相似。在流中的每個幀被用來例項化模式中的變數，
顯示的判斷式被應用，判斷式的返回假的幀被過濾出輸入流。如果有未繫結的變數
有一個出錯的結果。

(define (lisp-value call frame-stream)
  (stream-flatmap
   (lambda (frame)
     (if (execute
          (instantiate
           call
           frame
           (lambda (v f)
             (error "Unknown pat var -- LISP-VALUE" v))))
         (singleton-stream frame)
         the-empty-stream))
   frame-stream))
(put 'lisp-value 'qeval lisp-value)

Execute把判斷式應用到它的實際引數上，必須解釋判斷式的表示式來得到要應用的
程式。然而，它不是必須解釋實際引數，因為它們已經是實際引數了，不是表示式將
生成實際引數。注意的是，execute使用eval和apply從底層的lisp系統實現了。

(define (execute exp)
  (apply (eval (predicate exp) user-initial-environment)
         (args exp)))

always-true關鍵字提供了一個總是被滿足的查詢。它忽略它的內容（正常是空的）
和簡單地傳遞於輸入流中的所有的幀。rule-body選擇子使用always-true提供了
被定義好的規則體，沒有規則體。（也就是，規則的結論總是被滿足）

(define (always-true ignore frame-stream) frame-stream)
(put 'always-true 'qeval always-true)

選擇子定義的not和lisp-value的語法在4.4.4.7部分中給出了。

4.4.4.3 通過模式匹配找到斷言
（在4.4.4.2部分中）simple-query呼叫了find-assertion,它有一個輸入模式和一個幀為引數，
它返回一個幀的流，用匹配給定的模式資料庫擴充套件每個幀。它使用fetch-assertions(在4.4.4.5部分中)
得到一個數據庫中的應該被檢查滿足一個模式的匹配的所有的斷言的流。這裡對於fetch-assertions的原因
是我們能夠經常應用簡單的測試從一個成功的匹配的候選者的池來消除資料庫的許多的記錄。如果我們消除了
fetch-assertion,這個系統仍然能工作，並且簡單檢查資料庫中的所有的斷言的一個流，但是計算可能沒有效率
因為我們做對匹配器的更多次的呼叫。

(define (find-assertions pattern frame)
  (stream-flatmap (lambda (datum)
                    (check-an-assertion datum pattern frame))
                  (fetch-assertions pattern frame)))

check-an-assertion以一個模式，一個數據物件，一個幀為引數，返回一個元素的包括了擴充套件幀的流
或者是如果匹配失敗的話，是一個空的流。

(define (check-an-assertion assertion query-pat query-frame)
  (let ((match-result
         (pattern-match query-pat assertion query-frame)))
    (if (eq? match-result 'failed)
        the-empty-stream
        (singleton-stream match-result))))

基本的模式匹配器返回符號failed或者是一個給定的幀的擴充套件。匹配器的基本的思想是
檢查模式與資料的匹配，一個元素接著一個元素，為模式變數累加繫結。如果模式和
資料物件是一致的，匹配成功，我們返回繫結被累加的幀。否則如果模式是一個變數，
通過繫結變數到資料，我們擴充套件當前的幀，只要這與幀中的已有的繫結是具有一致性的。
如果模式和資料都是數對，我們遞迴地匹配模式的頭部和資料的頭部，來生成一個幀，
在這個幀中，我們然後匹配模式的尾部和資料的尾部。如果這些情況沒有可用的，匹配
失敗了，我們返回符號fails.

(define (pattern-match pat dat frame)
  (cond ((eq? frame 'failed) 'failed)
        ((equal? pat dat) frame)
        ((var? pat) (extend-if-consistent pat dat frame))
        ((and (pair? pat) (pair? dat))
         (pattern-match (cdr pat)
                        (cdr dat)
                        (pattern-match (car pat)
                                       (car dat)
                                       frame)))
        (else 'failed)))

這是通過新增一個新的繫結來擴充套件一個幀的程式，如果這和幀中的已有的繫結有一致性的話。

(define (extend-if-consistent var dat frame)
  (let ((binding (binding-in-frame var frame)))
    (if binding
        (pattern-match (binding-value binding) dat frame)
        (extend var dat frame))))

如果在幀中的變數沒有繫結，我們簡單地加上變數的繫結到資料中。
否則我們匹配，在幀中的變數的值。如果儲存的值僅包含了常數，正如它必須
是在模式匹配期間由extend-if-consistent儲存的，然後匹配簡單地測試儲存的
值與新的值是否是相同的。如果相同，它返回未修改的幀；如果不同，它返回
一個失敗的顯示。儲存的模式與新的資料的遞迴的匹配將在這個模式中為變數
新增或者是檢查繫結情況。例如，假定我們有一個幀，它的?x被繫結為(f  ?y)和
?y 未繫結，我們要例項化這個幀，以x到(f b)的繫結。我們查詢?x並且發現它繫結
為(f  ?y). 這導致了我們要匹配（f ?y）和假定的新值（f b）在相同的幀中。最終
這個匹配以添加了?y到b的繫結而擴充套件了這個幀。我們根本沒有修改一個已儲存的繫結，
我們沒有儲存一個給定的變數的超過一個的繫結。

程式用extend-if-consistent來操縱在4.4.4.8部分中被定義的繫結。

*  有點結尾的模式
如果一個模式包括了一個點，後跟著一個模式變數，模式變數匹配資料列表的其它部分
（而不是資料列表的下一個元素），僅有一種情況除外，就是在練習2.20中描述的以
點結尾的標識。儘管我們已經實現的模式匹配器沒有查詢點，它的行為正如 我們所要的。
這是因為lisp的讀原生程式，它被query-driver-loop程式用來讀查詢，並且把它表示為
一個列表結構，處理點以一個特殊的方式。

當讀看到一個點時，代替讓下一項成列表的下一個元素，它讓下一項成為列表的其它的部分。
例如，讀為了模式(computer  ?type)生成的列表結構，通過解釋表示式(cons  'computer (cons '?type '()))
能被組裝,並且通過解釋表示式 (cons 'computer '?type) 能組裝 (computer .  ?type).

因此，正如pattern-match遞迴地比較一個數據列表的頭部和尾部，一個模式有一個點，它最終匹配
點後的變數和資料列表的一個子列表，繫結變數到那個列表。例如，匹配模式(computer .  ?type)
和資料 (computer  programmer trainee) 將把?type匹配成列表（programmer trainee）.