第 19 章一個查詢編譯器 · On Lisp 中文版

## 第 19 章一個查詢編譯器在前面章節里定義的有些宏很長。為了生成展開式，`if-match`?需要用到圖 18.7 和18.8 中的所有代碼，以及 [示例代碼 18.1] 中的?`destruc`?。如此之長的宏自然而然地將我們帶入最后一個主題：嵌入式語言。如果說短小的宏是Lisp 的擴展，那么大的宏就是在其中定義子語言可能帶有它們自己的語法或者控制結構。我們在?`if-match`?中看出了些端倪，在這個宏里，它有自己的一套表達變量的方式。我們把實現在 Lisp 中的語言稱為嵌入式語言。和 "實用工具" 一樣，這個術語并沒有嚴格的定義；`if-match`?可能仍算是實用工具，但它已經開始有一點嵌入式語言的意思了。嵌入式語言和那些用傳統的編譯器或解釋器實現的語言截然不同。它是用某種現有的語言實現的，實現的方式通常是采用轉換。沒有必要在基語言和它的擴展之間制造人為的隔閡：可以將兩者自由地混用在一起。對于實現者來說，這意味著可以省下大量精力。你可以讓你想要的部分實現成嵌入的，而讓其余的部分使用基語言。轉換，在 Lisp 里，意味著使用宏。在某種程度上，你可以用預處理器來實現嵌入式語言。但預處理器通常只能操作文本，而宏卻可以利用 Lisp 的一個獨一無二的特性：在讀取器和編譯器之間，你的 Lisp 程序被表達成 Lisp 對象的列表。在這個階段進行轉換要更自如一些。最著名的嵌入式語言例子是 CLOS，即 Common Lisp Object System。如果你想要把一個普通的語言改造成面向對象的版本，那只能寫一個新的編譯器。在Lisp 里就不是這樣了。調整編譯器將使 ??? 跑得更快，而在理論上，編譯器不需要有絲毫改變。這一整套系統都可以用Lisp 寫出來。接下來的章節會給出幾個嵌入式語言的例子。本章將描述如何將一個回答數據庫查詢的程序嵌入到 Lisp 中。(你將會注意到這個程序和?`if-match`?有一系列相通的地方。) 第一節將介紹如何寫一個系統，該系統用于解釋查詢語句。之后，這個程序被重新實現成一個查詢編譯器，實質上，是實現成了一個巨大的宏, 這既使程序更加高效，也讓它能更好地與 Lisp 集成。 ### 19.1 數據庫鑒于當前的目的，數據庫的形式并不是關鍵。所以，這里出于方便起見把信息保存在列表里。例如，我們將 "Joshua Reynolds 是一位生活于 1723 至 1792 年的英國畫家" 這個事實表示成： ~~~ (painter reynolds joshua english) (dates reynolds 1723 1792) ~~~ 把信息壓縮表示成列表，并無標準辦法可循。我們可以依法炮制，也干脆用一個大列表： ~~~ (painter reynolds joshua 1723 1792 english) ~~~ 組織數據庫表項的方式由用戶來決定。唯一的限制是這些項目(事實) 將用其第一個元素(謂詞) 來索引。在這些約束下，任何一致的形式都可以工作，盡管某些形式的查詢速度更快些。任何數據庫系統都至少要支持兩種操作：修改數據庫，和查詢數據庫。[示例代碼 19.1] 中給出的代碼以一個基本的形式提供了這些操作。數據庫由一張哈希表表示，表項則是一個個事實，事實的謂詞作為哈希表的鍵值。盡管圖 19.1 中定義的數據庫函數支持多個數據庫，但它們默認的操作對象都是?`\*default-db\*`。作為 Common Lisp 里的包，那些不需要操作多個數據庫的程序甚至不需要關心它們。在本章所有的例子將只用到?`\*default-db\*`。 * * * **[示例代碼 19.1]：基本的數據庫函數** ~~~ (defun make-db (&optional (size 100)) (make-hash-table :size size)) (defvar *default-db* (make-db)) (defun clear-db (&optional (db *default-db*)) (clrhash db)) (defmacro db-query (key &optional (db '*default-db*)) '(gethash ,key ,db)) (defun db-push (key val &optional (db *default-db*)) (push val (db-query key db))) (defmacro fact (pred &rest args) '(progn (db-push ',pred ',args) ',args)) ~~~ * * * 我們調用?`clear-db`?，初始化系統，這個命令會清空當前數據庫。我們通過給db-query 一個謂詞來查詢事實，并用?`db-push`?將新事實插入到一個數據庫項里。正如第 12.1 節里解釋的那樣，一個展開成可逆引用的宏其自身也將是可逆的。由于?`db-query`?就是以這種方式定義的，所以我們可以簡單地在謂詞的?`db-query`?上?`push`?新事實。在 Common Lisp 里，除非特別指定，哈希表中的項被初始化為?`nil`?，這樣任何key 在初始時都會有一個空列表與之關聯。最后，`fact`?宏用來給數據庫加入新事實。 ~~~ > (fact painter reynolds joshua english) (REYNOLDS JOSHUA ENGLISH) > (fact painter canale antonio venetian) (CANALE ANTONIO VENETIAN) > (db-query 'painter) ((CANALE ANTONIO VENETIAN) (REYNOLDS JOSHUA ENGLISH)) T ~~~ 其中，`t`?是?`db-query`?返回的第二個值。而?`db-query`?會展開成?`gethash`?，后者則把它返回的第二個值作為標記，以區別兩種情況：即沒有發現項目，和發現了一個值為?`nil`?的項目。 ### 19.2 模式匹配查詢之前用?`db-query`?來查詢數據庫中的數據，其實這種方式不是很靈活。通常用戶會想要問的問題不會單單依賴事實的第一個元素。所謂查詢語言就是一種用來表達更復雜查詢的語言。在一個典型的查詢語言里，用戶可以詢問所有滿足某些約束組合的值例如，所有生于?`1697`?年的畫家的姓氏。我們的程序將提供一種聲明式的查詢語言。在這種查詢語言中，由用戶指定答案必須滿足的約束，而把如何生成答案的麻煩事留給系統。這樣表達查詢和人們日常會話中的方式很類似。對于我們的程序，我們可以要求系統找出所有這樣的：存在一個?`(painter ...)`?形式的事實，以及一個?`(dates 1697 ...)`形式的事實，以此來表達這個例子查詢。如此，就能通過下面這個查詢來引用所有生于 1697 年的畫家： ~~~ (and (painter ?x ?y ?z) (dates ?x 1697 ?w)) ~~~ 我們的程序不但接受由謂詞和一些參數組成的簡單查詢，還將能夠回答由?`and`?和?`or`?這些邏輯操作符連接而成的任意復雜查詢。圖 19.2 中給出了查詢語言的語法。 * * * **[示例代碼 19.2] 查詢語法** ~~~ <query> : (<symbol> <argument>*) : (not <query>) : (and <query>*) : (or <query>*) <argument> : ?<symbol> : <symbol> : <number> ~~~ * * * 由于事實是用它們的謂詞來索引的，所以變量不能出現在謂詞的位置上。如果你愿意放棄索引帶來的好處，你可以通過總是使用相同的謂詞，并且使第一個參數成為事實上的標準謂詞來繞過這個限制。和許多類似的系統一樣，這個程序對于真值采取懷疑論的觀點：除了已知的事實之外，其他所有陳述都是錯誤的。如果問題中的事實不在數據庫里，`not`?操作符就會成功。某種程度上，你可以使用`Wayne's World`【注1】的方式顯式地表達邏輯假： ~~~ (edible motor-oil not) ~~~ 就算這樣，`not`?操作符也不會對這些事實另眼相待。在編程語言里，解釋性和編譯性的程序之間有著根本的區別。在本章實現查詢的時候，我們也將體會到這一點。查詢解釋器接受查詢，并根據它從數據庫里生成答案。而查詢編譯器接受查詢，然后生成一個程序，當這個程序運行時，會得出相同的結果。接下來幾節里，會先描述一個查詢解釋器，然后再實現一個查詢編譯器。 ### 19.3 一個查詢解釋器為了實現一個聲明式的查詢語言，我們將使用在第 18.4 節定義的模式匹配工具。[示例代碼 19.3] 中的函數可以解釋 [示例代碼 19.2] 那種形式的查詢。這段代碼里的核心函數是?`interpret-query`，它遞歸地對復雜查詢的數據結構進行處理，在這個過程中生成綁定。復雜查詢的求值按從左到右的順序進行，就像 Common Lisp 本身那樣。當遞歸進行到代表事實的模式上時，`interpret-query`?調用?`lookup`。這里正是模式匹配發生的地方。函數?`lookup`?接受一個由謂詞及其參數列表所組成的模式，然后返回一個能夠使模式匹配到數據庫中某個事實的所有綁定的列表。它首先獲取所有該謂詞的數據庫表項，然后調用match (18.5 節) 把它們和模式逐一比較。每當匹配成功，就返回一個綁定列表，然后 lookup 返回一個含有所有這些列表的列表。 ~~~ > (lookup 'painter '(?x ?y english)) (((?Y . JOSHUA) (?X . REYNOLDS))) ~~~ 然后，這些結果會根據旁邊的邏輯操作符或被濾除，或被組合。最終的結果將以列表的形式返回，其中，列表的元素是綁定的集合。如果用[示例代碼 19.4] 中所給出的斷言，那么下面是本章先前例子對應的結果： ~~~ > (interpret-query '(and (painter ?x ?y ?z) (dates ?x 1697 ?w))) (((?W . 1768) (?Z . VENETIAN) (?Y . ANTONIO) (?X . CANALE)) ((?W . 1772) (?Z . ENGLISH) (?Y . WILLIAM) (?X . HOGARTH))) ~~~ 這是一個普適的原則，即查詢可以無限制地組合和嵌套。在少數情況下，查詢語法會有一些細微的限制，但分析完一些例子，了解了這部分代碼的用法之后，我們就能很從容地處理這些問題了。 * * * **[示例代碼 19.3]：查詢解釋器** ~~~ (defmacro with-answer (query &body body) (let ((binds (gensym))) '(dolist (,binds (interpret-query ',query)) (let ,(mapcar #'(lambda (v) '(,v (binding ',v ,binds))) (vars-in query #'atom)) ,@body)))) (defun interpret-query (expr &optional binds) (case (car expr) (and (interpret-and (reverse (cdr expr)) binds)) (or (interpret-or (cdr expr) binds)) (not (interpret-not (cadr expr) binds)) (t (lookup (car expr) (cdr expr) binds)))) (defun interpret-and (clauses binds) (if (null clauses) (list binds) (mapcan #'(lambda (b) (interpret-query (car clauses) b)) (interpret-and (cdr clauses) binds)))) (defun interpret-or (clauses binds) (mapcan #'(lambda (c) (interpret-query c binds)) clauses)) (defun interpret-not (clause binds) (if (interpret-query clause binds) nil (list binds))) (defun lookup (pred args &optional binds) (mapcan #'(lambda (x) (aif2 (match x args binds) (list it))) (db-query pred))) ~~~ * * * **[示例代碼 19.4]：一些作為示例的事實斷言** ~~~ (clear-db) (fact painter hogarth william english) (fact painter canale antonio venetian) (fact painter reynolds joshua english) (fact dates hogarth 1697 1772) (fact dates canale 1697 1768) (fact dates reynolds 1723 1792) ~~~ * * * 宏?`with-answer`?提供了一個在 Lisp 程序里使用這個查詢解釋器的清爽簡潔的方法。它的第一個參數可以是任意合法的查詢；其余參數被視為一個代碼體。`with-answer`?會展開成這樣的代碼，它收集由查詢生成的所有綁定的集合，然后用每個綁定集合所指定的變量來迭代整個代碼體。出現在一個`with-answer`?的查詢里的變量(通常) 可以在其代碼體里使用。當查詢成功但卻不含有變量時，`with-answer`?只求值代碼體一次。每一個名字叫 Hogarth 的畫家的姓氏和國籍。 ~~~ > (with-answer (painter hogarth ?x ?y) (princ (list ?x ?y))) (WILLIAM ENGLISH) NIL ~~~ 每一個生于 1697 年的畫家的姓氏。(我們最初的例子) ~~~ > (with-answer (and (painter ?x _ _) (dates ?x 1697 _)) (princ (list ?x))) (CANALE)(HOGARTH) NIL ~~~ 每一個卒于 1772 年或者 1792 年的人的姓氏和出生年份。 ~~~ > (with-answer (or (dates ?x ?y 1772) (dates ?x ?y 1792)) (princ (list ?x ?y))) (HOGARTH 1697)(REYNOLDS 1723) NIL ~~~ 每一個不和某個威尼斯畫家生于同年的英國畫家的姓氏。 * * * **[示例代碼 19.5] 使用查詢解釋器** > (with-answer (and (painter ?x _ english) (dates ?x ?b _) (not (and (painter ?x2 _ venetian) (dates ?x2 ?b _)))) (princ ?x)) REYNOLDS NIL * * * 根據定義在 [示例代碼 19.4] 中的數據庫，[示例代碼 19.5] 中羅列了一些帶中文翻譯的查詢作例子。因為模式匹配是由?`match`?完成的，因此在模式中可以使用下劃線作為通配符。為了讓這些例子不至于太長，查詢的代碼體中的代碼僅僅打印了查詢結果。一般而言，`with-answer`的代碼體中可以由任何 Lisp 表達式構成。 ### 19.4 綁定上的限制對于哪些變量將會被一個查詢所綁定這個問題上存在一些限制。例如，為什么下列查詢 ~~~ (not (painter ?x ?y ?z)) ~~~ 應該將任何綁定賦值給?`?x`?和?`?y`?呢？存在無限多種不是某個畫家名字的?`?x`?和?`?y`?的組合。因此我們加了一個限制：`not`?操作符將過濾掉那些已生成的綁定，例如這里 ~~~ (and (painter ?x ?y ?z) (not (dates ?x 1772 ?d))) ~~~ 但你不能指望它會全自動地生成綁定。我們在生成綁定集合的時候，必須先找出所有的畫家，然后再排除那些沒有生于 1772 年的。要是我們寫子句的順序相反： ~~~ (and (not (dates ?x 1772 ?d)) (painter ?x ?y ?z)) ; wrong ~~~ 那么，只要存在任何生于 1772 年的畫家，結果將是?`nil`?。即使在第一個例子里，我們也不該認為可以在?`with-answer`?表達式的代碼體里使用?`?d`?的值。同樣，形如?`(or )`?的表達式只保證可以實際生成那些出現在所有里的變量的綁定。如果一個?`with-answer`?包含了查詢 ~~~ (or (painter ?x ?y ?z) (dates ?x ?b ?d)) ~~~ 你可以預期?x 的綁定是可用的，因為無論哪一個子查詢成功了，它都會生成一個 ?x 的綁定。但不管是 ?y 還是 ?b 都不保證可以從查詢中得到綁定，盡管它其中一個子查詢可以。沒有被查詢綁定的模式變量在迭代時將是 nil 。 ### 19.5 一個查詢編譯器 [示例代碼 19.3] 中的代碼實現了我們想要的功能，但效率不彰。首先，盡管查詢結構在編譯期就是已知的，程序還是把分析工作放在了運行期完成。其次，程序通過構造列表來保存變量綁定，其實，本可以用變量來保存它們自己的值的。我們不妨換一種方式定義 with-answer ，同時解決這兩個問題。 [示例代碼 19.6] 定義了一個新版的?`with-answer`?。這個新的實現秉承了一個傳統，它始于?`avg`(13.1 節)，在?`if-match`?(18.4 節) 繼承了下來：新的實現在編譯期完成了原來舊版本在運行期的大部分工作。[示例代碼 19.6] 和 [示例代碼 19.3] 中的代碼貌似一模一樣，但前者中的函數無一是在運行期調用的。這些函數不再生成綁定，它們直接生成代碼，而這些生成的代碼將成為?`with-answer`展開式的一部分。在運行期，這些代碼將根據當前數據庫的狀態，產生滿足查詢要求的綁定。從效果上來看，這個程序是一個巨大的宏。[示例代碼 19.7] 中顯示了?`with-answer`?宏展開后的模樣。大多數的工作是由?`pat-match`?(18.4 節) 完成的，它本身也是一個宏。現在，運行期需要的新函數就只有[示例代碼 19.1] 中給出的基本的數據庫函數了。雖然在?`toplevel`?下調用?`with-answer`?，對查詢進行編譯處理幾乎沒什么好處。表示查詢的代碼被生成，求值，然后就被扔在一邊。但是當with-answer 表達式出現在Lisp 程序里的時候，表示查詢的代碼就成為了其宏展開的一部分。這樣，當編譯包含查詢的程序時，所有的查詢代碼都將在這個過程中被內聯(inline) 編譯。盡管這個新方法的主要優勢是性能，但它也讓?`with-answer`?表達式更好地融入了它所在的代碼。這具體表現在兩個改進上。首先，查詢中的參數現在被求值了，所以我們可以說： ~~~ > (setq my-favorite-year 1723) 1723 > (with-answer (dates ?x my-favorite-year ?d) (format t "~A was born in my favorite year.~%" ?x)) REYNOLDS was born in my favorite year. NIL ~~~ 雖然在查詢解釋器里同樣可以做到這點，但代價是必須顯式調用?`eval`。而且即便如此，在查詢參數中還是無法引用詞法變量。由于現在查詢中的參數都會被求值，所以任何不會求值到其自身的字面參數(例如 english ) 都應該被引用起來。(見[示例代碼 19.8]) 新方法的第二個優點是：它現在可以更容易地在查詢中包含普通的 Lisp 表達式。查詢編譯器增加了一個 lisp 操作符，它可以跟任意 Lisp 表達式。就像 not 操作符那樣，它不會生成任何綁定，但它將排除那些使表達式返回nil 的綁定。在需要使用諸如> 的內置謂詞時，lisp 操作符就能幫上忙： ~~~ > (with-answer (and (dates ?x ?b ?d) (lisp (> (- ?d ?b) 70))) (format t "~A lived over 70 years.~%" ?x)) CANALE lived over 70 years. HOGARTH lived over 70 years. ~~~ 一個實現良好的嵌入式語言可以跟基語言在這兩方面都結合得天衣無縫。除了這兩個附加特性以外參數的求值以及新的 lisp 操作符查詢編譯器和查詢解釋器支持的查詢語言是完全相同的。[示例代碼 19.8]顯示了有查詢編譯器用 [示例代碼 19.4] 中定義的數據庫所生成的示例結果。 * * * **[示例代碼 19.6] 查詢編譯器** ~~~ (defmacro with-answer (query &body body) '(with-gensyms ,(vars-in query #'simple?) ,(compile-query query '(progn ,@body)))) (defun compile-query (q body) (case (car q) (and (compile-and (cdr q) body)) (or (compile-or (cdr q) body)) (not (compile-not (cadr q) body)) (lisp '(if ,(cadr q) ,body)) (t (compile-simple q body)))) (defun compile-simple (q body) (let ((fact (gensym))) '(dolist (,fact (db-query ',(car q))) (pat-match ,(cdr q) ,fact ,body nil)))) (defun compile-and (clauses body) (if (null clauses) body (compile-query (car clauses) (compile-and (cdr clauses) body)))) (defun compile-or (clauses body) (if (null clauses) nil (let ((gbod (gensym)) (vars (vars-in body #'simple?))) '(labels ((,gbod ,vars ,body)) ,@(mapcar #'(lambda (cl) (compile-query cl '(,gbod ,@vars))) clauses))))) (defun compile-not (q body) (let ((tag (gensym))) '(if (block ,tag ,(compile-query q '(return-from ,tag nil)) t) ,body))) ~~~ * * * 我們曾提到，把表達式編譯后再求值，比將其作為列表送給?`eval`?更勝一籌。第 17.2 節對個中原委解釋了兩點。前者更快，而且允許表達式在外圍的詞法上下文中進行求值。對查詢加以編譯的優點與之非常相似。通常要在運行期做的事現在在編譯期就完成了。而且因為這些查詢在編譯后和周圍的 Lisp 代碼成為了一體，所以它們得以利用詞法上下文。 * * * **[示例代碼 19.7] 同一查詢的兩個展開式** ~~~ (with-answer (painter ?x ?y ?z) (format t "~A ~A is a painter.~%" ?y ?x)) ~~~ 被解釋器展開成： ~~~ (dolist (#:g1 (interpret-query '(painter ?x ?y ?z))) (let ((?x (binding '?x #:g1)) (?y (binding '?y #:g1)) (?z (binding '?z #:g1))) (format t "~A ~A is a painter.~%" ?y ?x))) ~~~ 而被編譯器展開成： ~~~ (with-gensyms (?x ?y ?z) (dolist (#:g1 (db-query 'painter)) (pat-match (?x ?y ?z) #:g1 (progn (format t "~A ~A is a painter.~%" ?y ?x)) nil))) ~~~ * * * 每一個名字叫?**Hogarth**?的畫家的姓氏和國籍。 ~~~ > (with-answer (painter 'hogarth ?x ?y) (princ (list ?x ?y))) (WILLIAM ENGLISH) NIL ~~~ 每一個不跟某個威尼斯畫家生于同年的英國畫家的姓氏。 ~~~ > (with-answer (and (painter ?x _ 'english) (dates ?x ?b _) (not (and (painter ?x2 _ 'venetian) (dates ?x2 ?b _)))) (princ ?x)) REYNOLDS NIL ~~~ 每一個死于 1770 年到 1800 年開區間的畫家的姓氏和死亡年份。備注：【注1】譯者注：Wayne's World 是上世紀 90 年代 NBC 拍攝的系列短劇，后被改編為電影，中文名為《反斗智多星》。其中的角色經常用類似"這是歷史的巧合，才怪！" 的方式表達否定和挖苦的情緒。該劇讓這種故意搞怪的表達方式在北美變得流行起來。