## 第 24 章 Prolog
本章將介紹如何編寫嵌入式的 Prolog 解釋器。第 19 章中已經展示了編寫數據庫查詢語句編譯器的方法，這里我們再加入一個新的元素：規則。有了規則，就可以根據已有的知識通過推理得到新知。一組規則定義了表明事實之間相互蘊含關系的一棵樹。由于這棵樹可能包含無限多的事實，所以我們必須使用非確定性的搜索。
Prolog 是嵌入式語言的一個極好的例子。它融合了三個元素：模式匹配，非確定性，規則。其中，前兩個元素在第 18 章和第 22 章曾分別介紹過。把 Prolog 建立在模式匹配和非確定性選擇操作的基礎之上，我們可以得到一個真正的，多層的，自底向上的系統。圖 (24.1) 展示了有關幾個抽象層的結構。
~~~
![enter image description here][1]
~~~
本章的第二個目標是學習Prolog。對于經驗豐富的程序員來說，簡要地說明一下其實現方式可能會更有助于講解這門語言。而用Lisp 實現Prolog 非常有趣，因為在這過程中能夠發掘出這兩者間的共同點。
### 24.1 概念
第19章介紹了如何寫一個能接受復雜查詢語句的數據庫系統，這個系統能自動生成所有滿足查詢條件的綁定。在下例中，(調用 clear-db 之后)，我們聲明兩個事實，然后對數據庫進行查詢：
~~~
> (fact painter reynolds)
(REYNOLDS)
> (fact painter gainsborough)
(GAINSBOROUGH)
> (with-answer (painter ?x)
(print ?x))
GAINSBOROUGH
REYNOLDS
NIL
~~~
從概念上說，Prolog 是一個 "附有規則的數據庫程序"。它不僅僅能夠直接從數據庫中查找匹配的數據來滿足查詢語句，還能夠從已知的事實(數據) 中推導出匹配的數據。例如，若有如下的規則：
~~~
If (hungry ?x) and (smells-of ?x turpentine)
en (painter ?x)
~~~
則，只要數據庫中存在 (hungry raoul) 和 (smells-of raoul turpentine) 這兩個事實，那么 ?x = raoul 就能滿足查詢語句 (painter ?x)，即使數據庫中沒有 (painter raoul) 這個事實。
在 Prolog 中，規則的 "if" 部分被稱作 body，"then" 部分被稱作 head。(在邏輯中，它們分別叫做前提 (an-tecedent) 和推論 (consequent)，不過用不同的名字也好，能強調 Prolog 的推導不同于邏輯的推導)。在我們試圖生成查詢的綁定時，程序首先檢查規則的 head，如果 head 能滿足查詢，那么程序會做出響應，為 body 建立各種綁定。根據定義，如果綁定滿足 body，那么它也滿足 head。
在規則的 body 中用到的各種事實可能會轉而由其他規則中推演得出。例如：
~~~
If (gaunt ?x) or (eats-ravenously ?x)
en (hungry ?x)
~~~
規則也可以是遞歸的，例如：
~~~
If (surname ?f ?n) and (father ?f ?c)
en (surname ?c ?n)
~~~
如果 Prolog 能在種種規則中找到一條通往已知事實的路徑，它便會為該查詢建立各種綁定。因而，它實質上是一個搜索引擎：它遍歷由各種規則形成的邏輯蘊含樹，尋找一條通往事實的成功之路。
雖然規則和事實聽上去像兩回事，其實它們在概念上是可以互換的 規則可以被看作虛擬事實。如果我們希望我們的數據庫能夠反映出 "兇猛的大型動物是稀有的" 這個發現，我們可以尋找所有的 x ，令 x 滿足 (species)，(big) 和 (fierce) 這些事實，找到的話就加上一個新的事實 (rare )。如果定義下面的規則：
~~~
If (species ?x)and (big ?x) and (fierce ?x)
en (rare ?x)
~~~
就會得到相同的效果，而無需在數據庫中加入所有的 (rare x) 事實。我們甚至可以定義能推出無窮個事實的規則。因此，在回應查詢的時候，我們通過使用規則，用額外的數據處理作為代價，縮小了數據庫的規模。
另一方面，事實則是規則的一種退化形式。任一事實 F 的效用，都可以用一個 body 恒為真的規則來達到，如下：
~~~
If true
en F
~~~
為了簡化實現,我們將利用這個性質,并用body less rules 來表達事實。
### 24.2 解釋器
第 18.4 節展示了兩種定義 if-match 的方式，前一種簡潔但效率低下，后來者由于在編譯期完成了大量工作，因而速度有很大的提高。這里，我們將沿用這個策略。為了便于引出相關的幾個話題，我們先從一個簡單的解釋器開始，然后再介紹如何把同一程序寫得更加高效。
[示例代碼 24.2]–24.4 包含了一個簡單的 Prolog 解釋器。它能接受與第 19.3 節查詢解釋器相同的輸入，但使用的是規則而非數據庫來生成綁定。查詢解釋器是通過宏 with-answer 來調用的，我們的 Prolog 解釋器的接口也打算采用一個類似的宏，稱其為 with-inference 。猶如 with-answer ，with-inference 的輸入是一個查詢語句和一組 Lisp 表達式。查詢語句中的變量是以問號開頭的符號，例如：
~~~
(with-inference (painter ?x)
(print ?x))
~~~
with-inference 的一個調用會展開成一段代碼，該代碼則將Lisp 表達式應用于生成的綁定并求值。比如上面那段代碼，會把所有能導出 (painter ) 的x 打印出來。
這章的許多概念，比如 binding 的含義，在第 18.4 節已經說明。
* * *
**[示例代碼 24.2]**?Toplevel 宏
~~~
(defmacro with-inference (query &body body)
'(progn
(setq *paths* nil)
(=bind (binds) (prove-query ',(rep_ query) nil)
(let ,(mapcar #'(lambda (v)
'(,v (fullbind ',v binds)))
(vars-in query #'atom))
，@body
(fail)))))
(defun rep_ (x)
(if (atom x)
(if (eq x '_) (gensym "?") x)
(cons (rep_ (car x)) (rep_ (cdr x)))))
(defun fullbind (x b)
(cond ((varsym? x) (aif2 (binding x b)
(fullbind it b)
(gensym)))
((atom x) x)
(t (cons (fullbind (car x) b)
(fullbind (cdr x) b)))))
(defun varsym? (x)
(and (symbolp x) (eq (char (symbol-name x) 0) #\?)))
~~~
* * *
[示例代碼 24.2] 給出了 with-inference 的定義，及其生成綁定所需的函數。with-answer 和 with-inference 有個顯著的區別：前者只是簡單地收集所有的有效綁定，而后者則進行非確定性的搜索。我們可以在 with-inference 的定義里注意到這一點：它沒有展開成循環，而是展開成了一段能返回一組綁定的代碼，緊接著是一個 fail 用來重啟下個搜索。這無形中給我們帶來了迭代結構。比如：
~~~
> (choose-bind x '(0 1 2 3 4 5 6 7 8 9)
(princ x)
(if (= x 6) x (fail)))
0123456
6
~~~
函數 fullbind 則點出了 with-answer 和 with-inference 的又一不同之處，沿著規則往回跟蹤，我們可以建立一系列綁定 變量的綁定是其他變量組成的列表。要使用該查詢語句的結果，我們需要一個遞歸函數來幫我們找到相應的綁定。這就是fullbind 的目的，例如：
~~~
> (setq b '((?x . (?y . ?z)) (?y . foo) (?z . nil)))
((?X ?Y . ?Z) (?Y . FOO) (?Z))
> (values (binding '?x b))
(?Y . ?Z)
> (fullbind '?x b)
(FOO)
~~~
查詢語句的綁定的是由 with-inference 展開式中的 prove-query 生成的。[示例代碼 24.3] 給出了這個函數的定義及其組成部分。這段代碼和第 19.3 節中描述的查詢解釋器結構相同。兩者都用相同的函數用于匹配，只不過查詢解釋器用mapping 和迭代，而 Prolog 解釋器則用等價的 choose。
不過，使用非確定性搜索替代迭代的方式確實讓解釋否定的查詢語句變得更難了。例如下面的查詢語句：
* * *
[示例代碼 24.3]： 查詢語句的解釋
~~~
(not (painter ?x))
(=defun prove-query (expr binds)
(case (car expr)
(and (prove-and (cdr expr) binds))
(or (prove-or (cdr expr) binds))
(not (prove-not (cadr expr) binds))
(t (prove-simple expr binds))))
(=defun prove-and (clauses binds)
(if (null clauses)
(=values binds)
(=bind (binds) (prove-query (car clauses) binds)
(prove-and (cdr clauses) binds))))
(=defun prove-or (clauses binds)
(choose-bind c clauses
(prove-query c binds)))
(=defun prove-not (expr binds)
(let ((save-paths *paths*))
(setq *paths* nil)
(choose (=bind (b) (prove-query expr binds)
(setq *paths* save-paths)
(fail))
(progn
(setq *paths* save-paths)
(=values binds)))))
(=defun prove-simple (query binds)
(choose-bind r *rlist*
(implies r query binds)))
~~~
* * *
查詢解釋器只需要為 (painter ?x) 建立綁定，如果找到任意的綁定則返回 nil 。而使用非確定性搜索的話，就必須更加小心，因為我們不希望 (painter ?x) 在 not 的作用域之外 fail，同時(如果 (painter ?x) 為真) 我們也不希望保留其剩下還未探索的路徑。所以，(painter ?x) 的判斷被應用在一個臨時的空的搜索路徑的環境中。當判斷結束時，會恢復原先的路徑。
它們之間的另一區別在于對簡單模板的解釋 類似于 (painter ?x) 的僅僅由一個謂詞和幾個參數組成的表達式。當查詢解釋器對簡單模板生成綁定時，它調用 lookup (第 19.3 節)。在 Prolog 解釋器中，我們必須找到所有規則所能推導出的綁定，因此 lookup 已不適用。
[示例代碼 24.4] 中給出了定義和使用規則的代碼。規則被放在全局列表 *rlist* 中。每個規則由 body 和 head 所組成的點對(dottedpair) 表達。當一個規則被定義后，任一下劃線會被替換為一個唯一的變量。
<- 的定義遵循了三個慣例，一般來說，編寫這類程序時通常都會采納這些習慣做法：
1. 加入新規則的時候，應當把規則放到列表末尾，而不是最前面，這樣應用規則時的順序就和定義規則的順序一致了。
2. 在表示規則的時候，要把head 放在前面，因為程序查看規則的順序就是如此。
3. 如果 body 里有多個表達式的話，它們事實上被放在了看不見的 and 里面。
在 <- 的展開式最外層調用了 length ，其目的是為了避免在 toplevel 調用 <- 時，打印出巨大的列表。
規則的語法如 [示例代碼 24.5] 所示。規則的 head 必須是一種事實的模式：一個列表，列表的每個元素都由一個謂
~~~
(defvar *rlist* nil)
(defmacro <- (con &rest ant)
(let ((ant (if (= (length ant) 1)
(car ant)
'(and ,@ant))))
'(length (conc1f *rlist* (rep_ (cons ',ant ',con))))))
(=defun implies (r query binds)
(let ((r2 (change-vars r)))
(aif2 (match query (cdr r2) binds)
(prove-query (car r2) it)
(fail))))
(defun change-vars (r)
(sublis (mapcar #'(lambda (v)
(cons v (symb '? (gensym))))
(vars-in r #'atom))
r))
~~~
## [示例代碼 24.4]： 包含規則的代碼
~~~
?rule? : (<- ?sentence? ?query?)
?query? : (not ?query?)
: (and ?query?*)
: (or ?query?*)
: ?sentence?
?sentence? : (?symbol? ?argument?*)
?argument? : ?variable?
: ?symbol?
: ?number?
?variable? : ??symbol?
~~~
[示例代碼 24.5]： 規則的語法
* * *
詞，跟著任意數量的參數。body 可以是任何查詢語句，只要第19章的查詢解釋器能讀懂它就行。下面是本章前面曾用過的一個規則：
~~~
(<- (painter ?x) (and (hungry ?x)
(smells-of ?x turpentine)))
~~~
或直接
~~~
(<- (painter ?x) (hungry ?x)
(smells-of ?x turpentine))
~~~
和查詢解釋器一樣，類似turpentine 的參數不會被求值，所以它們沒有必要被quoted。
當我們讓prove-simple 為某個查詢生成綁定時，它的非確定地選擇一條規則，并把該規則和查詢一同送給implies。下一個函數則試圖把查詢和規則的head 匹配起來。一旦匹配成功，implies 將會調用prove-query ，讓它幫助為body 建立綁定。用這種方法，我們遞歸搜索邏輯蘊含樹。
change-vars 函數把規則中所有的變量換成新生成的。如果在某個規則里使用了?x ，那么這個?x 是和其它規則里面的?x 是沒有關系的。為了避免現有綁定之間發生沖突，每應用一條規則，都會調用change-vars 。
為了給用戶提供方便，這里可以把_ (下劃線) 用作規則里的通配符變量。在定義規則的時候，會調用函數rep_ ，它把每個下劃線都替換成真正的變量。下劃線也可以用在傳給with-inference 的查詢里面。
### 24.3 規則
本節將介紹如何為我們的Prolog 編制規則。先以第24.1 節中的兩條規則為例：
~~~
(<- (painter ?x) (hungry ?x)
(smells-of ?x turpentine))
(<- (hungry ?x) (or (gaunt ?x) (eats-ravenously ?x)))
~~~
倘若我們同樣也斷言了(assert) 下面幾個事實：
~~~
(<- (gaunt raoul))
(<- (smells-of raoul turpentine))
(<- (painter rubens))
~~~
它們將根據其定義的順序，來決定要生成的綁定：
~~~
> (with-inference (painter ?x)
(print ?x))
RAOUL
RUBENS
@
~~~
with-inference 宏和with-answer 一樣，對變量綁定有著相同限制(見第19.1節)。
我們能寫出這樣一種規則，它意味著：對所有可能的綁定，都可以令給定形式的事實為真。這并非不可能。
比如說，如果有變量出現在規則的head 里，但卻在body 里銷聲匿跡。這種規則就能滿足要求。下面的規則
~~~
(<- (eats ?x ?f) (glutton ?x))
~~~
說道：如果?x 是個吃貨(glutton)，那么?x 就來者不據，照單全收。因為?f 在body 里沒有出現，所以，只消為?x 設立一個綁定，就能證明任意形如 (eats ?x ) 的事實。如果我們用一個字面值作為eats 的第二個參數，進行查詢，
~~~
> (<- (glutton hubert))
7
> (with-inference (eats ?x spinach)
(print ?x))
HUBERT
@
~~~
那么任何字面值都能滿足要求。如果把一個變量作為第二個參數的話：
~~~
> (with-inference (eats ?x ?y)
(print (list ?x ?y)))
(HUBERT #:G229)
@
~~~
我們會得到一個gensym。在查詢中把gensym 作為變量的綁定返回，這表示任意值都能令事實為真。在編程序的時候，可以顯式地利用這一慣例：
~~~
> (progn
(<- (eats monster bad-children))
(<- (eats warhol candy)))
9
> (with-inference (eats ?x ?y)
(format t "~A eats ~A.~%"
?x
(if (gensym? ?y) 'everything ?y)))
HUBERT eats EVERYTHING.
MONSTER eats BAD-CHILDREN.
WARHOL eats CANDY.
@
~~~
最后，如果我們想要指定一個特定形式的事實對任意參數都為真，那么可以令其body 為無參數的合取式。 (and) 表達式和永真式的事實，其行為表現是一樣的。由于在<- 宏中([示例代碼 24.4])，body 的缺省設置就是 (and)，所以對于這種規則，我們可以直接略去其body ：
~~~
> (<- (identical ?x ?x))
10
> (with-inference (identical a ?x)
(print ?x))
A
@
~~~
若是讀者已經粗通Prolog，就可以看出[示例代碼 24.6] 展示了把Prolog 語法轉換到我們程序語法的過程。照老習慣，第一個Prolog 程序往往是append ，它可以寫成[示例代碼 24.6] 結尾的那樣。在一次append 中，兩個較短的列表被并成一個更長的列表。Lisp 的函數append 把兩個短列表作為參數，而將長列表當成返回值。Prolog 的append 更通用一些。[示例代碼 24.6] 中的兩條規則定義了一個程序，只要傳入任意兩個相關的列表，這個程序就能找到第三個。
我們的語法和傳統的Prolog 語法間有如下幾點區別：
1. 使用以問號開頭的符號，而非大寫字母來表示變量。因為Common Lisp 缺省是不區分大小寫的，
所以用大寫字母的話可能會得不償失。
1. [ ]變成了nil 。
2. 形如 [x | y] 的表達式成了(x . y)。
3. 形如 [x，y，...] 的表達式成了(x y...)。
4. 斷言被挪到了括弧里面，而且用來分隔參數的逗號也被去掉了： ( ，，...) 成了 ( ...)。
于是乎，Prolog 對append 的定義：
~~~
append([ ], Xs, Xs).
append([X | Xs], Ys, [X | Zs]) <- append(Xs, Ys, Zs).
~~~
就成了下面的模樣：
~~~
(<- (append nil ?xs ?xs))
(<- (append (?x . ?xs) ?ys (?x . ?zs))
(append ?xs ?ys ?zs))
~~~
[示例代碼 24.6]： 和Prolog 語法的對應關系
~~~
> (with-inference (append ?x (c d) (a b c d))
(format t "Left: ~A~%" ?x))
Left: (A B)
@
> (with-inference (append (a b) ?x (a b c d))
(format t "Right: ~A~%" ?x))
Right: (C D)
@
> (with-inference (append (a b) (c d) ?x)
(format t "Whole: ~A~%" ?x))
Whole: (ABCD)
@
~~~
不僅如此，如果給出了最后一個列表，它還能找出前兩個列表所有可能的組合：
~~~
> (with-inference (append ?x ?y (a b c))
(format t "Left: ~A Right: ~A~%" ?x ?y))
Left: NIL Right: (A B C)
Left: (A) Right: (B C)
Left: (A B) Right: (C)
Left: (A B C) Right: NIL
@
~~~
append 這個例子揭示出了Prolog 和其它語言之間的天差地別。一組Prolog 規則不一定非要推出某個特定的值。這些規則也可以給出一些約束(constraints)，而這些約束和由程序其他部分生成的約束一同，將能得出一個特定的值。舉例來說，如果這樣定義member ：
~~~
(<- (member ?x (?x . ?rest)))
(<- (member ?x (_ . ?rest)) (member ?x ?rest))
~~~
就能用它判斷列表的成員關系，和Lisp 的函數member 的用法一模一樣：
~~~
> (with-inference (member a (a b)) (print t))
T
@
~~~
不過，我們也可以用它新建一個成員關系的約束，這個約束和其他約束一起，同樣可以得出一個特定的列表。如果我們手里還有個謂詞叫cara
~~~
(<- (cara (a _)))
~~~
任意一個有兩個元素的列表，只要其car 為a ，那么這個事實就為真。這樣，有了這個謂詞和member ，就有了充足的約束條件，可以讓Prolog 為我們想出一個確定的答案了：
~~~
> (with-inference (and (cara ?lst) (member b ?lst))
(print ?lst))
(A B)
@
~~~
例子很簡單，但是其中的道理在編寫更大規模的程序時也一樣適用。無論何時，只要我們想通過把部分結果組合到一起的方式來編寫程序，那么就能用上Prolog。事實上借助這種方式可以表達很多類型的問題：
比如說，[示例代碼 24.14] 就展示了一個排序算法，這個排序算法是由一組對計算結果的約束來表示的。
### 24.4 對于非確定性的需求
第22 章解釋了確定性和非確定性搜索的區別所在。使用確定性搜索的程序能接受一個查詢，并生成所有滿足這個查詢的結果。而用非確定性搜索的程序則會借助choose，每次生成一個結果，如果用戶需要更多的結果，那么它會調用fail ，來重新啟動這個搜索過程。
如果我們手中的規則得出的都是有限大小的綁定集合，而且我們希望一次性的得到所有這些綁定，那么就沒有理由用非確定性搜索。倘若我們的查詢會產生無窮多的綁定，而我們要的只是其中的一個有限子集，那么這兩種搜索策略的區別就一目了然了。比如說，下面的規則
~~~
(<- (all-elements ?x nil))
(<- (all-elements ?x (?x . ?rest))
(all-elements ?x ?rest))
~~~
蘊含所有形如 (all-elements x y) 的事實，的每一個成員都等于 。不用回溯的話，我們有能力處理類似下面的查詢：
~~~
(all-elements a (a a a))
(all-elements a (a a b))
(all-elements ?x (a a a))
~~~
然而，有無數多的?x 可以滿足 (all-elements a ?x) 這個查詢，比如：nil、(a)、(a a)，等等。要是想用迭代的方式為這個查詢生成答案，那么這個迭代就會永不休止，一直運行下去。就算我們弱水三千只取一瓢飲，在這無窮多的答案中僅僅要一個，如果算法的實現在走到下一個Lisp 表達式之前，必須為查詢準備好所有的綁定，那么我們永遠等不到那一天，更不用說得到答案了。
這就是為什么with-inference 把綁定的產生過程和其body 的求值過程交錯進行的原因。由于查詢可能會對應無窮多的答案，所以唯一的辦法只能是每次產生一個答案，并通過重啟前被暫停的搜索來取得新的答案。因為我們的程序使用了choose 和fail ，所以它能夠解決下面的問題：
~~~
> (block nil
(with-inference (all-elements a ?x)
(if (= (length ?x) 3)
(return ?x)
(princ ?x))))
NIL(A)(A A)
(A A A)
~~~
和所有的Prolog 實現一樣，我們也是借助帶回溯的深度優先搜索來模擬非確定性的。從理論上而言，"邏輯程序" 是由真正的非確定性驅動的。而實際上，各家Prolog 實現卻常常用的是深度優先搜索。這個選擇非但沒有造成不便，相反，深度優先版的非確定性是標準的Prolog 程序賴以正常工作的基礎。在使用真實非確定性的世界里，下面的查詢
~~~
(and (all-elements a ?x) (length ?x 3))
~~~
是有答案的，但是在得到這個答案之前，你必須先等到海枯石爛。
Prolog 使用深度優先搜索實現非確定性，不僅如此，它使用的深度優先還和第 22.3 節中定義的版本等價。正如我們在那里提到的，這個實現是不能保證終止的。所以 Prolog 程序員必須采取專門的措施，避免在搜索空間里面產生環。舉例來說，如果我們以相反的順序定義member
~~~
(<- (member ?x (_ . ?rest)) (member ?x ?rest))
(<- (member ?x (?x . ?rest)))
~~~
那么照道理來說，其意義應該保持不變，但是作為Prolog 程序的話，效果就完全不同了。如果使用member 原來的定義，那么查詢 (member 'a ?x)，會得到一系列連綿不絕，無窮多的答案。但是如果把定義的順序反過來，則會產生一個無窮遞歸，一個答案都得不到。
### 24.5 新的實現
在這一節，我們會故友重逢，碰到一個熟悉模式的另一實例。在第18.4 節，在編完if-match 的最初版本之后，我們發現其實可以把它實現得更快。通過利用編譯期的已知信息，我們本可以寫一個新的版本，讓它在運行期做更少的事情。后來，在第19章，我們經歷了同樣的問題，不過這一次程序的規模更大。我們把查詢解釋器換成了一個與之等價，但更高效的版本。歷史將會在我們的Prolog 解釋器上重演。
[示例代碼 24.7]，24.8，24.10 一起以另一種方式定義了Prolog。宏with-inference 以前只是Prolog 解釋器的接口。
它現在成了程序的主要的組成部分。新程序的結構和原來基本一致，不過在[示例代碼 24.8] 中定義的函數里面，只有prove 是在運行期調用的。其他函數則由with-inference 調用，被用來生成其展開式。
[示例代碼 24.7] 中是with-inference 的新定義。和if-match 以及 with-answer 中一樣，模式匹配變量在開始的時候會被綁定到gensym 上，表示它們還沒有被匹配過程賦予真正的值。因而，被match 和fullbind 用來辨別變量的函數varsym? ，就需要修改一下，轉而檢查是否是gensym。
with-inference 調用gen-query ([示例代碼 24.8]) 的目的是為了生成一部分代碼，這些代碼將為查詢建立綁定。
gen-query 要做的的一件事是檢查它的第一個參數是不是那種以and 或者or 開頭的復雜查詢。這個過程會遞歸地進行，直至遇到簡單查詢，這些簡單查詢會被展開成對prove 的調用。在原來的實現中，這種邏輯結構是在運行期完成解析的。以前，每次使用規則時，都必須重新分析body 中的復雜查詢。顯然，這毫無必要。因為規則和查詢的邏輯結構是事先已知的。針對這個問題，新版的實現把復雜表達式的解析工作移到了編譯期。
和原來的實現一樣，with-inference 表達式展開出的代碼會先進行一次查詢，查詢中的模式變量所綁定到的值是由規則一一設定的，然后再迭代執行Lisp 代碼。with-inference 的展開式以一個fail 作結，后者會重啟之前保存的狀態。
[示例代碼 24.8] 中其他函數會為復雜查詢生成對應的展開式 即由諸如and、or 和not 的操作符結合起來的查詢。倘若有如下的查詢
~~~
(and (big ?x) (red ?x))
~~~
并且，我們希望只有那些能同時prove 兩個合取式的?x ，才被帶入Lisp 代碼求值。因此，為了生成and 的展開式，我們把第二個合取式的展開式嵌入到第一個合取式的展開式中。要是 (big ?x) 成功了，就繼續嘗試 (red ?x)，如果后者也成功的話，則對這個Lisp 表達式進行求值。如此，整個表達式展開后如[示例代碼 24.9] 所示。
~~~
(defmacro with-inference (query &rest body)
(let ((vars (vars-in query #'simple?)) (gb (gensym)))
'(with-gensyms ,vars
(setq *paths* nil)
(=bind (,gb) ,(gen-query (rep_ query))
(let ,(mapcar #'(lambda (v)
'(,v (fullbind ,v ,gb)))
vars)
,@body)
(fail)))))
(defun varsym? (x)
(and (symbolp x) (not (symbol-package x))))
~~~
[示例代碼 24.7]： 新的toplevel 宏
and 意味著嵌入；而or 則意味著choose。有下列查詢
~~~
(or (big ?x) (red ?x))
~~~
兩個子查詢，如果其中任意一個能建立?x 的綁定，我們將希望Lisp 表達式使用這些?x 來進行求值。
函數gen-or 會展開成choose ，后者會在諸參數的gen-query 中選擇一個。至于not ，gen-not 基本上和prove-not 同出一轍(見[示例代碼 24.3])。
[示例代碼 24.10] 中是定義規則的代碼。規則被直接轉換成Lisp 代碼，而后者是由 rule-fn 生成的。因為現在<- 把規則展開成了Lisp 代碼，所以如果把一個寫滿了規則定義的文件編譯了的話，就會讓這些規則變成編譯過的函數。
當一個rule-function 收到一個模式時，它會試圖把自己所表示規則的head 與之匹配。如果匹配成功，這個rule-function 就會試圖為其body 設立綁定。這個過程和with-inference 的功能基本一致，而且，事實上rule-fn 會在結束的時候調用gen-query 。rule-function 最終會返回一些綁定，它們是為規則的head 中出現的變量而設立的。
### 24.6 增添Prolog 特性 233
~~~
(defun gen-query (expr &optional binds)
(case (car expr)
(and (gen-and (cdr expr) binds))
(or (gen-or (cdr expr) binds))
(not (gen-not (cadr expr) binds))
(t '(prove (list ',(car expr)
,@(mapcar #'form (cdr expr)))
,binds))))
(defun gen-and (clauses binds)
(if (null clauses)
'(=values ,binds)
(let ((gb (gensym)))
'(=bind (,gb) ,(gen-query (car clauses) binds)
,(gen-and (cdr clauses) gb)))))
(defun gen-or (clauses binds)
'(choose
,@(mapcar #'(lambda (c) (gen-query c binds))
clauses)))
(defun gen-not (expr binds)
(let ((gpaths (gensym)))
'(let ((,gpaths *paths*))
(setq *paths* nil)
(choose (=bind (b) ,(gen-query expr binds)
(setq *paths* ,gpaths)
(fail))
(progn
(setq *paths* ,gpaths)
(=values ,binds))))))
(=defun prove (query binds)
(choose-bind r *rules* (=funcall r query binds)))
(defun form (pat)
(if (simple? pat)
pat
'(cons ,(form (car pat)) ,(form (cdr pat)))))
~~~
[示例代碼 24.8]： 對查詢進行的編譯處理
### 24.6 增添Prolog 特性
現有的代碼已足以運行絕大多數的"純"Prolog 程序。最后一步是再加入一些特性，諸如：減枝(cut)，數學計算，還有I/O。
在Prolog 規則中加入cut，就能對搜索樹進行剪枝了。通常，當我們的程序碰到fail 的時候，它會回溯到最后一個選擇點。在第22.4 節實現的 choose 中，把歷史上的選擇點都放到了全局變量*paths*里。調用fail ，會在最新近的一個選擇點重新啟動搜索過程，而這個選擇點就是*paths*?的car。cut 讓問題更復雜了。當程序遇到cut 時，它會放棄保存在?*paths*?里的一部分最新選擇點，具體說，就是在最后一次調用prove 之后保存的選擇點。
其結果就是讓規則之間互斥。我們可以用cut 來在Prolog 程序中達到case 語句的效果。舉例來說，如果像下面這樣定義minimum ：
~~~
(with-inference (and (big ?x) (red ?x))
(print ?x))
expandsinto:
(with-gensyms (?x)
(setq *paths* nil)
(=bind (#:g1) (=bind (#:g2) (prove (list 'big ?x) nil)
(=bind (#:g3) (prove (list 'red ?x) #:g2)
(=values #:g3)))
(let ((?x (fullbind ?x #:g1)))
(print ?x))
(fail)))
~~~
[示例代碼 24.9]： 合取式的展開
~~~
(defvar *rules* nil)
(defmacro <- (con &rest ant)
(let ((ant (if (= (length ant) 1)
(car ant)
'(and ,@ant))))
'(length (conc1f *rules*
,(rule-fn (rep_ ant) (rep_ con))))))
(defun rule-fn (ant con)
(with-gensyms (val win fact binds)
'(=lambda (,fact ,binds)
(with-gensyms ,(vars-in (list ant con) #'simple?)
(multiple-value-bind
(,val ,win)
(match ,fact
(list ',(car con)
,@(mapcar #'form (cdr con)))
,binds)
(if ,win
,(gen-query ant val)
(fail)))))))
~~~
[示例代碼 24.10]： 定義規則的代碼
~~~
(<- (minimum ?x ?y ?x) (lisp (<= ?x ?y)))
(<- (minimum ?x ?y ?y) (lisp (> ?x ?y)))
~~~
它會工作正常，但是比較沒有效率。若有下列查詢
~~~
(minimum 1 2 ?x)
~~~
根據第一條規則，Prolog 將會立即建立?x = 1。倘若是人的話，就會到此為止，但是程序會虛擲光陰，繼續從第二條規則那里找尋答案，因為沒人告訴它這兩條規則是互斥的。平均情況下，這個版本的minimum 會多做50% 的無用功。如果在第一個測試后面加個cut 就能解決這一問題：
~~~
(<- (minimum ?x ?y ?x) (lisp (<= ?x ?y)) (cut))
(<- (minimum ?x ?y ?y))
~~~
現在，一旦Prolog 完成了第一條規則，它就會一路掠過剩下的規則，完成查詢，而不是繼續處理下一條規則。
要讓我們的程序支持減枝，簡直易如反掌。每次在調用 prove 時，當前*paths*?的狀態都會被當作參數傳進去。如果程序碰到了 cut，它就把*paths*?設置回上一次當作參數傳入的值。[示例代碼 24.11] 和24.12 顯示了為了支持減枝，必須改動的部分代碼。(修改過的代碼行后面有分號以示區別。并非所有的改動都是由于減枝而造成的。)
僅僅提高程序效率的cut 叫做greencuts 。minimum 中的cut 就是個greencut。那種會改變程序行為的cut 則被稱為redcuts。比如說，如果我們像下面那樣定義謂詞artist ：
~~~
(<- (artist ?x) (sculptor ?x) (cut))
(<- (artist ?x) (painter ?x))
~~~
結果就是：如果有雕塑家，那么查詢到此結束。如果一個雕塑家都找不到，那么就把畫家認作藝術家：
~~~
> (progn (<- (painter 'klee))
(<- (painter 'soutine)))
4
> (with-inference (artist ?x)
(print ?x))
KLEE
SOUTINE
@
~~~
但如果存在雕塑家的話，減枝機制使得推理在處理第一條規則時就會停止：
~~~
> (<- (sculptor 'hepworth))
5
> (with-inference (artist ?x)
(print ?x))
HEPWORTH
@
~~~
有時，cut 會和Prolog 的fail 操作符一起搭配使用。我們的fail 函數也是如此。把cut 放到規則里，就如同把這條規則變成了單行道：一旦你駛上這條路，你就只能用這條規則，不能回頭。把cut-fail 組合加到規則里，則意味著治安堪憂的單行道：只要開上這條路，就只能兇多吉少。not-equal 的實現里就有個典型的例子：
~~~
(<- (not-equal ?x ?x) (cut) (fail))
(<- (not-equal ?x ?y))
~~~
這里的第一條規則是為冒牌貨設下的陷阱。如果我們試圖證明形如 (not-equal 1 1) 的事實，它會先和第一條規則的head 匹配，然后就自取滅亡了。而(not-equal 1 2) 的查詢則不會和第一條規則的head 匹配，因此會繼續與第二條規則匹配，在這里它會匹配成功：
~~~
> (with-inference (not-equal 'a 'a)
(print t))
@
> (with-inference (not-equal '(a a) '(a b))
(print t))
T
@
~~~
[示例代碼 24.11] 和24.12 中的代碼同樣也為我們的程序帶來了數學計算、I/O 和Prolog 的is 操作符。[示例代碼 24.13] 列出了規則和查詢的所有語法。
我們為Lisp 開了個后門，通過這種方式加入了數學計算(及其他功能) 的支持。現在，除了諸如and 和or 的操作符，我們又有了lisp 操作符。這個操作符可以跟任意Lisp 表達式，對表達式求值時，將會用查詢產生的變量綁定，作為表達式中變量的值。如果表達式求值的結果是nil ，那么整個lisp 表達式會被視為與 (fail) 等價；否則它就和 (and) 等價。
下面舉個應用lisp 操作符的例子。試想一下ordered 的Prolog 實現，只有當列表中元素以升序排列的時候，它才是真：
~~~
(defun rule-fn (ant con)
(with-gensyms (val win fact binds paths) ;
'(=lambda (,fact ,binds ,paths) ;
(with-gensyms ,(vars-in (list ant con) #'simple?)
(multiple-value-bind
(,val ,win)
(match ,fact
(list ',(car con)
,@(mapcar #'form (cdr con)))
,binds)
(if ,win
,(gen-query ant val paths) ;
(fail)))))))
(defmacro with-inference (query &rest body)
(let ((vars (vars-in query #'simple?)) (gb (gensym)))
'(with-gensyms ,vars
(setq *paths* nil)
(=bind (,gb) ,(gen-query (rep_ query) nil '*paths*) ;
(let ,(mapcar #'(lambda (v)
'(,v (fullbind ,v ,gb)))
vars)
,@body)
(fail)))))
(defun gen-query (expr binds paths) ;
(case (car expr)
(and (gen-and (cdr expr) binds paths)) ;
(or (gen-or (cdr expr) binds paths)) ;
(not (gen-not (cadr expr) binds paths)) ;
(lisp (gen-lisp (cadr expr) binds)) ;
(is (gen-is (cadr expr) (third expr) binds)) ;
(cut '(progn (setq *paths* ,paths) ;
(=values ,binds))) ;
(t '(prove (list ',(car expr)
,@(mapcar #'form (cdr expr)))
,binds *paths*)))) ;
(=defun prove (query binds paths) ;
(choose-bind r *rules*
(=funcall r query binds paths))) ;
~~~
[示例代碼 24.11]： 加入對新操作符的支持
~~~
(<- (ordered (?x)))
(<- (ordered (?x ?y . ?ys))
(lisp (<= ?x ?y))
(ordered (?y . ?ys)))
~~~
用漢語來表述，就是說，單元素的列表是有序的；如果列表中有兩個或更多元素，那么只有當第一個元素小于或等于第二個元素，而且從第二個元素開始的列表也是有序的，那么才能說該列表是有序的。
~~~
> (with-inference (ordered '(1 2 3))
(print t))
T
@
> (with-inference (ordered '(1 3 2))
(defun gen-and (clauses binds paths) ;
(if (null clauses)
'(=values ,binds)
(let ((gb (gensym)))
'(=bind (,gb) ,(gen-query (car clauses) binds paths) ;
,(gen-and (cdr clauses) gb paths))))) ;
(defun gen-or (clauses binds paths) ;
'(choose
,@(mapcar #'(lambda (c) (gen-query c binds paths)) ;
clauses)))
(defun gen-not (expr binds paths) ;
(let ((gpaths (gensym)))
'(let ((,gpaths *paths*))
(setq *paths* nil)
(choose (=bind (b) ,(gen-query expr binds paths) ;
(setq *paths* ,gpaths)
(fail))
(progn
(setq *paths* ,gpaths)
(=values ,binds))))))
(defmacro with-binds (binds expr)
'(let ,(mapcar #'(lambda (v) '(,v (fullbind ,v ,binds)))
(vars-in expr))
,expr))
(defun gen-lisp (expr binds)
'(if (with-binds ,binds ,expr)
(=values ,binds)
(fail)))
(defun gen-is (expr1 expr2 binds)
'(aif2 (match ,expr1 (with-binds ,binds ,expr2) ,binds)
(=values it)
(fail)))
~~~
[示例代碼 24.12]： 加入對新操作符的支持
~~~
(print t))
~~~
@
借助lisp 操作符，我們得以提供典型Prolog 實現具有的一些其他特性。要實現Prolog 的I/O 謂詞，可以把Lisp 的I/O 調用放到lisp 表達式里。而Prolog 的assert ，它有個副作用，會順帶著定義一些規則。它可以通過在lisp 表達式里調用<- 宏來實現一樣的功能。
is 操作符提供了一種賦值的形式。它有兩個參數：一個是匹配模式，一個是個Lisp 表達式。它會試圖把模式和表達式的返回結果匹配起來。如果匹配失敗，那么程序就會調用fail ；否則它會使用新的綁定繼續運行。因而，表達式 (is ?x 1) 的作用就是把?x 設置成1，或者更準確地說，程序會認為?x 應該是1。我們希望能讓is 進行計算。比如說，計算階乘：
~~~
(<- (factorial 0 1))
(<- (factorial ?n ?f)
(lisp (> ?n 0))
(is ?n1 (- ?n 1))
(factorial ?n1 ?f1)
(is ?f (* ?n ?f1)))
~~~
?rule? ： (<- ?sentence? ?query?)
?query? ： (not ?query?)
： (and ?query?*)
： (lisp ?lisp expression?)
： (is ?variable? ?lisp expression?)
： (cut)
： (fail)
： ?sentence?
?sentence? ： (?symbol? ?argument?*)
?argument? ： ?variable?
： ?lisp expression?
?variable? ： ??symbol? [示例代碼 24.13]： 規則的新語法
我們構造一個查詢，讓數字 作為它的首個參數，讓一個變量作為第二個參數，用這個辦法來使用這個定義：
~~~
> (with-inference (factorial 8 ?x)
(print ?x))
40320
@
~~~
注意到，lisp 表達式中用到的變量，以及is 的第二個參數，都必須有已建立的綁定與其對應，這樣，表達式才能返回值。所有Prolog 都存在這個限制。比如說，下面的查詢：
~~~
(with-inference (factorial ?x 120) ; wrong
(print ?x))
~~~
就不能和這個factorial 的定義一同工作，因為在求值lisp 表達式的時候，?n 還是個未知數。因此，不是所有的Prolog 程序都和append 一樣：它們中有許多都要求某些參數應該是真實的值，比如factorial。
### 24.7 例子
這一節會展示幾個Prolog 例程，介紹如何編寫能在我們的Prolog 實現中運行的程序。[示例代碼 24.14] 的規則一齊定義了快速排序算法。這些規則蘊含了形如 (quicksort ) 的事實，其中 是一個列表，而 是由前一列表中的相同元素構成的另一個列表，不過其中的元素以增序排列。變量可以出現在第二個參數的位置上：
~~~
> (with-inference (quicksort '(3 2 1) ?x)
(print ?x))
(1 2 3)
@
~~~
這里之所以用I/O 循環來測試我們的Prolog 實現，原因是它同時利用了cut，lisp，以及is 這幾個操作符。
代碼如[示例代碼 24.15] 所示。在試圖證明 (echo) 的時候，會不帶參數地調用這些規則。查詢會先和第一個規則匹配，后者會把?x 綁定到read 返回的結果上，并試圖建立 (echo ?x)。而新的查詢則會與后兩條規則之一匹配。如果?x = done ，那么查詢就會在第二條規則停下來。否則，查詢將匹配第三條規則，打印出讀到的值，然后重新開始處理。
這些規則共同定義了一個程序，它會一直回顯輸入的字串，直到你打done ：
譯者注：原文為"isnalsectionshows..."，譯文根據實情去掉了"最后"。
~~~
(setq *rules* nil)
(<- (append nil ?ys ?ys))
(<- (append (?x . ?xs) ?ys (?x . ?zs))
(append ?xs ?ys ?zs))
(<- (quicksort (?x . ?xs) ?ys)
(partition ?xs ?x ?littles ?bigs)
(quicksort ?littles ?ls)
(quicksort ?bigs ?bs)
(append ?ls (?x . ?bs) ?ys))
(<- (quicksort nil nil))
(<- (partition (?x . ?xs) ?y (?x . ?ls) ?bs)
(lisp (<= ?x ?y))
(partition ?xs ?y ?ls ?bs))
(<- (partition (?x . ?xs) ?y ?ls (?x . ?bs))
(lisp (> ?x ?y))
(partition ?xs ?y ?ls ?bs))
(<- (partition nil ?y nil nil))
~~~
[示例代碼 24.14]： Quicksort
~~~
(<- (echo)
(is ?x (read))
(echo ?x))
(<- (echo 'done)
(cut))
(<- (echo ?x)
(lisp (prog1 t (format t "~A~%" ?x)))
(is ?y (read))
(cut)
(echo ?y))
~~~
[示例代碼 24.15]： Prolog 編寫的I/O 循環
~~~
> (with-inference (echo))
hi
HI
ho
HO
done
@
~~~
像這樣的程序很難懂，因為它背離了Prolog 的抽象模型。如果把它在字面上翻譯成Lisp 的話，可能就容易懂些了
~~~
(defun echo (&rest args)
(cond ((null args) (echo (read)))
((eq (car args) 'done) nil)
(t (format t "~A~%" (car args))
(echo (read)))))
~~~
如果用地道的Common Lisp 來說，就是：
~~~
(defun echo (&optional (arg (read)))
(unless (eq arg 'done)
(format t "~A~%" arg)
(echo)))
~~~
### 24.8 編譯的含義
"編譯" 這個詞有好幾層意思。通常，它指：把一個程序的某種抽象表述轉換成更底層的代碼。當然，如果用這個含義的話，本章介紹的程序就是個編譯器，因為它會把規則翻譯成Lisp 函數。
比較狹義地說，編譯是指把程序轉換成機器語言的過程。良好的Common Lisp 實現會把函數編譯成機器語言。正如第 2.9 節上提到的，如果一段產生閉包的代碼是編譯過的，那么這段代碼產生的閉包也會是
編譯過的。因此，在更嚴格的意義上，這里所說的程序同樣也是編譯器。如果使用實現良好的Lisp，我們的Prolog 程序就會被轉換成為機器語言。
然而，文中描述的程序仍然不能稱為Prolog 編譯器。對程序設計語言而言，"編譯" 的意思要更進一步，單單生成機器代碼還不夠。一門編程語言的編譯器在轉換源程序的同時，還必須能優化產生的代碼。比如說，如果讓一個Lisp 的編譯器編譯下列表達式
~~~
(+ x (+ 2 5))
~~~
它必須足夠智能，能意識到沒有必要等到運行期才去對(+ 2 5)進行求值。我們可以用7 取而代之，以此優化程序，這樣就變成編譯下面的表達式了
~~~
(+ x 7)
~~~
在我們的程序中，所有的編譯工作都是由Lisp 編譯器完成的，而且，它追求的優化是在Lisp 上做文章，而不是在Prolog 上動腦筋。這些優化的確能提升性能，但是它們都太底層了。Lisp 編譯器并不知道它正在編譯的代碼是用來表示規則的。真正的Prolog 編譯器會找出那些能轉換成循環的規則，而我們的程序尋找的卻是能產生常量的表達式，以及能直接在棧上分配的閉包。
嵌入式語言讓你從現有的抽象機制中獲益良多，但是這些語言也不是一攬子的解決方案。如果你希望把程序從非常抽象的表達方式一路轉化成高效的機器代碼，還是需要有人教會計算機如何做。在本章，我們用少得驚人的代碼完成了這個工作中的相當一部分，但是這和編寫一個真正意義上的Prolog 編譯器相比還差得很遠。
- 封面
- 譯者序
- 前言
- 第 1 章 可擴展語言
- 第 2 章 函數
- 第 3 章 函數式編程
- 第 4 章 實用函數
- 第 5 章 函數作為返回值
- 第 6 章 函數作為表達方式
- 第 7 章 宏
- 第 8 章 何時使用宏
- 第 9 章 變量捕捉
- 第 10 章 其他的宏陷阱
- 第 11 章 經典宏
- 第 12 章 廣義變量
- 第 13 章 編譯期計算
- 第 14 章 指代宏
- 第 15 章 返回函數的宏
- 第 16 章 定義宏的宏
- 第 17 章 讀取宏（read-macro）
- 第 18 章 解構
- 第 19 章 一個查詢編譯器
- 第 20 章 續延(continuation)
- 第 21 章 多進程
- 第 22 章 非確定性
- 第 23 章 使用 ATN 分析句子
- 第 24 章 Prolog
- 第 25 章 面向對象的 Lisp
- 附錄： 包(packages)