Practical Common Lisp学习笔记——之第3章

3.实践:一个简单的数据库

很显然想要开始制造一个真正的Lisp软件,需要学会这个语言。但是,或许这和Practical Common Lisp相矛盾?所以这章会用一个简单的例子来展示能用Common Lisp做什么。会写个简单的数据库记录CD,在第27章会用到类似的技术构建MP3的数据库播放MP3。可以把这个想象成是MP3软件的一部分,能帮助记录CD音确定哪个翻录成MP3,在完成后就可以听一系列的MP3了。

这章会讲述足够多的Lisp内容完成代码工作,但是,会忽略一些细节。现在不必为那些小点烦恼,将在后面的章节系统的学习。

术语注意点:本章会讨论少数Lisp运算符。第4章会学到Common Lisp提供的3种不同的运算符:functions(函数),macros(宏)和special operators(特殊运算符)。在本章的工作中不必完全知道它们的区别,在清楚知道operator后面的细节前,现在只要把它们看作差不多就行。

本章的目的不是告诉你怎么用Lisp写一个数据库,更确切地是给你一个的Lisp编程的想法,会看到再小的一个Lisp程序也相当具有特色。

CD和记录

数据库用来记录哪些CD需要翻录成MP3,哪个CD先进行。每个记录都包含title标题和artist艺术家,听户的评分和一个标志说明是否已经翻录了。CL有很多数据结构来表示一个CD,用Common Lisp Object SystemCLOS)用四元列表four-item list,表示用户自定义类。

 

现在就简单的用链表(list),用LIST函数构造一个链表,返回它的参数。

 

       CL-USER> (list 1 2 3)

       1 2 3

 

可以用四元列表来映射记录的一个字段。另外可以用属性表property list简称plist来表示更方便。属性表从第一个元素开始,都有一个符号symbol描述下一个元素。现在省略很多符号的细节,基本上是一个名字。用关键字keyword符号,代表CD中的一个字段的名字。关键字是由冒号(:)开头的任何名字,比如,:foo。下面有个例子用关键字符:a:b:c表示属性名。

 

       CL-USER> (list :a 1 :b 2 :c 3)

       (:A 1 :B 2 :C 3)

 

可以用LIST函数创建属性表。

GETF函数可以方便的用plist表示一条记录,用到一个表和一个符合,返回符号后面跟随的值,用plist形成一个排序的劣质的哈希表。Lisp有真正的hash表,但是在这里用plist完全能满足了也方便保存文件。

 

       CL-USER> (getf (list :a 1 :b 2 :c 3) :a)

       1

       CL-USER> (getf (list :a 1 :b 2 :c 3) :c)

       3

 

这些足以写个make-cd函数,由4个参数表示字段返回一个plist代表CD

 

       (defun make-cd (title artist rating ripped)

       (list :title title :artist artist :rating rating :ripped ripped))

 

DEFUN说明这个form是定义一个新函数。make-cd是函数名。后面是参数列表。有4个参数:titleartistratingripped。在参数表后面的是函数体。这里函数体是另一个叫LISTform。比如,构造一个记录可以这样调用make-cd

 

       CL-USER> (make-cd “Roses” “Kathyt Mattea” 7 t)

        (:TITLE “Roses” :ARTIST “Kathy Mattea” :RATING 7 :RIPPED T)

 

归档CD

用全局变量*db*来保存记录,使用DEFVAR宏定义。在名字里面的星号(*)是Lisp的对全局变量的命名方式。

 

       (defvar *db* nil)

 

能够用PUSH宏往*db*中增加项。但是最好抽象一点,定义一个add-record函数向数据库增加记录。

 

       (defun add-record (cd) (push cd *db*))

 

add-recordmake-cd一起用向数据库增加CD

 

CL-USER> (add-record (make-cd "Roses" "Kathy Mattea" 7 t))

((:TITLE "Roses" :ARTIST "Kathy Mattea" :RATING 7 :RIPPED T))

CL-USER> (add-record (make-cd "Fly" "Dixie Chicks" 8 t))

((:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T)

       (:TITLE "Roses" :ARTIST "Kathy Mattea" :RATING 7 :RIPPED T))

CL-USER> (add-record (make-cd "Home" "Dixie Chicks" 9 t))

((:TITLE "Home" :ARTIST "Dixie Chicks" :RATING 9 :RIPPED T)

       (:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T)

       (:TITLE "Roses" :ARTIST "Kathy Mattea" :RATING 7 :RIPPED T))

 

REPL输出在add-record后面的是函数体中最后一个表达式PUSH返回的值。PUSH返回变量修改后的新值。

查看数据目录

*db*输入REPL就能查看它当前的值。

 

CL-USER> *db*

((:TITLE "Home" :ARTIST "Dixie Chicks" :RATING 9 :RIPPED T)

       (:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T)

       (:TITLE "Roses" :ARTIST "Kathy Mattea" :RATING 7 :RIPPED T))

 

写一个dump-db函数让输出向这样让人更易读:

 

TITLE:    Home

ARTIST:   Dixie Chicks

RATING:   9

RIPPED:   T

 

TITLE:    Fly

ARTIST:   Dixie Chicks

RATING:   8

RIPPED:   T

 

TITLE:    Roses

ARTIST:   Kathy Mattea

RATING:   7

RIPPED:   T

 

函数是这样:

 

(defun dump-db ()

  (dolist (cd *db*)

(format t "~{~a:~10t~a~%~}~%" cd)))

 

这个函数用DOLIST宏循环*db*的每个元素,绑定到变量cd上。用FORMAT输出每个cd的值。

在第18章会详细讨论FORMAT,现在只要晓得至少需要两个参数,第一个是输出的目标流,t是标准输出流*standard-output*的简写。

第二个参数是格式化字符串,包含原始字符和指令类directives告诉FORMAT如何插入剩下的参数。格式化指令类都由~开始(printf是由%开始)。一共有12个指令类,现在只会介绍到dump-db中需要的。

~a是一个美观aesthetic的指令,在显示关键字的时候会去掉:并且显示字符串的时候会去掉双引号。比如:

 

CL-USER> (format t "~a" "Dixie Chicks")

Dixie Chicks

NIL

 

或者:

 

CL-USER> (format t "~a" :title)

TITLE

NIL

 

~t用于制表。~10t告诉FORMAT预留足够的空格,在下一个~a处理前移动10列。~t不需要任何参数。

 

CL-USER> (format t "~a:~10t~a" :artist "Dixie Chicks")

ARTIST:   Dixie Chicks

NIL

 

~{必须要一个list参数。在~{~}FORMAT循环处理list中的每个元素。在dump-db中,FORMAT的循环每次会消耗list的一个关键字和一个值。~%不需要任何参数只是换行。在~}后面的~%让每个CD间多输出一个空行。

技术上而言,能用FORMAT对数据库本身循环,新的dump-db

 

(defun dump-db ()

  (format t "~{~{~a:~10t~a~%~}~%~}" *db*))

 

这由自己的观点决定是否酷或者惊慌。

改善用户交互

想添加一系列记录时,需要一些提示信息知道需要输入什么。下面写函数提示信息并读取。

 

(defun prompt-read (prompt)

  (format *query-io* "~a: " prompt)

  (force-output *query-io*)

  (read-line *query-io*))

 

仍然使用FORMAT来输出提示,没有~%所以光标会停留在同一层。调用FORCE-OUTPUT是对某些实现确保Lisp不会在输出提示前等待一个新行。

READ-LINE函数可以读取一行字符。变量*query-io*是个全局变量,包含连接到终端的输入流。READ-LINE读取的字符串(不包含后面的新行)作为prompt-read的返回值。

组合make-cdprompt-read函数绑定一个新函数,按提示取得值,构造一个新的CD记录。

 

(defun prompt-for-cd ()

  (make-cd

   (prompt-read "Title")

   (prompt-read "Artist")

   (prompt-read "Rating")

   (prompt-read "Ripped [y/n]")))

 

这个函数基本上都是正确的,但是prompt-read返回字符串,对TitleArtist字段是正确的。对RatingRipped字段应该是一个数字和布尔值。还可以依赖高级的用户接口,效验用户输入数据的长度。继续,用PARSE-INTEGER,包装对rating读取的prompt-read

 

       (parse-integer (prompt-read "Rating"))

 

但是,默认情况下PARSE-INTEGER如果不能从字符串中解析出整数或者有非数值在字符串中,会发出一个错误。它有一个可选参数:junk-allowed,让它的判断放松些。

 

       (parse-integer (prompt-read "Rating") :junk-allowed t)

 

如果PARSE-INTEGER在那些垃圾字符中找不到整数,就会返回NIL。这种情况下可以用0表示,使用OR宏然后继续。和C中的或“||”操作符类似,计算一系列表达式,并且返回第一个非NIL得值,如果全部结果都为NIL则返回NIL

 

       (or (parse-integer (prompt-read "Rating") :junk-allowed t) 0)

 

这样就可以得到默认值0

CLY-OR-N-P函数来修改Ripped

 

       (y-or-n-p "Ripped [y/n]: ")

 

这是prompt-for-cd中最健壮的部分,因为如果输入的字符不是以yYnN开头,Y-OR-N-P会重复提示。

整合前面的就得到一个相对健壮的prompt-for-cd函数。

 

(defun prompt-for-cd ()

  (make-cd

   (prompt-read "Title")

   (prompt-read "Artist")

   (or (parse-integer (prompt-read "Rating") :junk-allowed t) 0)

   (y-or-n-p "Ripped [y/n]: ")))

 

最后包装prompt-for-cd函数,循环接受用户输入直到完成,就可以完成“增加一系列CD”的接口。用LOOP宏重复执行一个表达式直到调用RETURN就退出。例如:

 

(defun add-cds ()

  (loop (add-record (prompt-for-cd))

      (if (not (y-or-n-p "Another? [y/n]: ")) (return))))

 

现在可以用add-cds增加一些CD记录。

 

CL-USER> (add-cds)

Title: Rockin' the Suburbs

Artist: Ben Folds

Rating: 6

Ripped  [y/n]: y

Another?  [y/n]: y

Title: Give Us a Break

Artist: Limpopo

Rating: 10

Ripped  [y/n]: y

Another?  [y/n]: y

Title: Lyle Lovett

Artist: Lyle Lovett

Rating: 9

Ripped  [y/n]: y

Another?  [y/n]: n

NIL

 

加载和保存数据库

现在save-db函数用以个文件名做参数并且保存当前状态的数据库。

 

(defun save-db (filename)

  (with-open-file (out filename

                   :direction :output

                   :if-exists :supersede)

    (with-standard-io-syntax

      (print *db* out))))

 

WITH-OPEN-FILE宏打开一个文件,绑定流到一个变量,在执行一系列表达式后再关闭文件。它同样保证文件关闭即使在求值过程中有错误。跟在WITH-OPEN-FILE后面的不是函数调用而是由它定义的语法。包含一个变量名用来保存文件流,一个文件名,还有一些选项控制文件怎样打开。这里指定:direction :output文件打开用于写,并且想覆盖一个已存在的相同文件名再加上:if-exists :supersede

打开文件后用(print *db* out)输出数据库的内容。与FORMAT不同的是PRINTform输出Lisp的对象可以由Lisp读取器读回。WITH-STANDARD-IO-SYNTAX宏保证PRINT的行为是标准的。在读回数据的时候会再用到这个宏确保读和输出操作一致。

save-db的参数应该是一个包含文件名的字符串,作为存储的位置。正确的字符串依赖于操作系统。比如在Unix上像这样调用save-db

 

CL-USER> (save-db "~/my-cds.db")

((:TITLE "Lyle Lovett" :ARTIST "Lyle Lovett" :RATING 9 :RIPPED T)

 (:TITLE "Give Us a Break" :ARTIST "Limpopo" :RATING 10 :RIPPED T)

 (:TITLE "Rockin' the Suburbs" :ARTIST "Ben Folds" :RATING 6 :RIPPED

  T)

 (:TITLE "Home" :ARTIST "Dixie Chicks" :RATING 9 :RIPPED T)

 (:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T)

 (:TITLE "Roses" :ARTIST "Kathy Mattea" :RATING 9 :RIPPED T))

 

Windows文件名可能像这样“c:/my-cds.db" or "c://my-cds.db。”

可以在文本编辑器中打开文件,会看和在REPL中输入*db*产生的输出一样。

加载数据库函数和保存很像。

 

(defun load-db (filename)

  (with-open-file (in filename)

    (with-standard-io-syntax

      (setf *db* (read in)))))

 

这次WITH-OPEN-FILE不必特别指定:direction,它默认的就是:input。用READ函数从in流中读取。这和REPL中使用的读取器一样,可以读取任何在REPL提示下输入的Lisp的表达式。这种情况下只是对表达式读取和保存并未对它们求值。WITH-STANDARD-IO-SYNTAX宏再一次的保证READsave-db中的PRINT用的相同的基本语法。

SETF宏是CL中的主要赋值操作符。它设定第一个参数是第二个参数的求值的结果。在load-db*db*就会包含从文件读取的对象。需要注意的是一件事——load-db会覆盖之前在*db*中的内容。所以如果用add-record或者add-cds增加了记录但是没有用save-db保存,那就会丢失那些记录。

查询数据库

有足够多的记录后,想要查询某些东西的时候,可能像这样使用:

 

(select :artist "Dixie Chicks")

 

得到一个表包含了艺术家是Dixie Chicks的所有记录。

函数REMOVE-IF-NOT需要一个谓词predicate和一个表list,返回一个表,表包含在原始表中符合谓词的元素。换句话说就是移除掉所有不符合谓词的元素。但是,REMOVE-IF-NOT不会真的移除任何东西——它会创建一个新的表,对原始的表不会改动。谓词参数可以是任何的函数,判断一个单参数并返回一个布尔值——NIL是作为false其他任何值都是true

比如,想要得到所有偶数,可以这样用REMOVE-IF-NOT:

 

CL-USER> (remove-if-not #'evenp '(1 2 3 4 5 6 7 8 9 10))

(2 4 6 8 10)

 

谓词使用的是EVENP函数,它对偶数返回true。标记#’是“Get me the function with the following name。”的简写。如果没有#’lisp会把evenp看做是变量名并取得它的值,而不会看做一个函数。

REMOVE-IF-NOT也可以用在任何的匿名函数。比如,如果EVENP不存在,可以像这样写之前的表达式:

 

CL-USER> (remove-if-not #'(lambda (x) (= 0 (mod x 2))) '(1 2 3 4 5 6 7 8 9 10))

(2 4 6 8 10)

 

这里谓词用的匿名函数:

 

(lambda (x) (= 0 (mod x 2)))

 

判断参数在取2的模后是否等于0。用匿名函数取得奇数:

 

CL-USER> (remove-if-not #'(lambda (x) (= 1 (mod x 2))) '(1 2 3 4 5 6 7 8 9 10))

(1 3 5 7 9)

 

注意lambda不是函数名——它是定义一个匿名函数的指示物indicator。除了没有名字以外,LAMBDA表达式和DEFUN许多相同:在lambda后面跟随参数列表,后面是函数体。

 

在查询时用到REMOVE-IF-NOT需要一个函数,当记录的艺术家是Dixie Chicks时返回ture。用GETF可以提取出名字,如果cd是一个单独的记录用(getf cd :artist)取得艺术家的名字。EQUAL函数逐个比较字符串中的每个字符。用(equal (getf cd :artist) "Dixie Chicks")可以比较CD的艺术家是否等于"Dixie Chicks"。然后,用LAMBDA包装这个表达式作为一个匿名函数传递给REMOVE-IF-NOT

 

CL-USER> (remove-if-not

  #'(lambda (cd) (equal (getf cd :artist) "Dixie Chicks")) *db*)

((:TITLE "Home" :ARTIST "Dixie Chicks" :RATING 9 :RIPPED T)

 (:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T))

 

用一个函数包装整个表达式,以艺术家名作为参数:

 

(defun select-by-artist (artist)

  (remove-if-not

   #'(lambda (cd) (equal (getf cd :artist) artist))

   *db*))

 

匿名函数在REMOVE-IF-NOT调用之前不会执行,能够引用到artist变量。在这种情况下匿名函数不只是不必写一个正常函数,它可以部分源于artist的值的含义,这取决于它所嵌入的上下文。

 

除了select-by-artist外,还可以提供select-by-titleselect-by-ratingselect-by-title-and-artist等其他函数。但是他们都差不多,除了匿名函数里面。所以可以用更通用的select函数以一个函数作为参数。

 

(defun select (selector-fn)

  (remove-if-not selector-fn *db*))

 

REMOVE-IF-NOT不应该调用名selector-fn的函数。而是需要变量selector-fn里面作为参数的匿名函数,所以没有#’。不过在调用select的时候会用到#’

 

CL-USER> (select #'(lambda (cd) (equal (getf cd :artist) "Dixie Chicks")))

((:TITLE "Home" :ARTIST "Dixie Chicks" :RATING 9 :RIPPED T)

 (:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T))

 

基于前瞻性,可以包装下匿名函数的创建。

 

(defun artist-selector (artist)

  #'(lambda (cd) (equal (getf cd :artist) artist)))

 

这个函数返回一个函数,它引用的变量将在artist-selector返回时同时消失,这被称为“闭包closure”后面第6章会讨论。以"Dixie Chicks"调用artist-selector时匿名函数会比较CD的:artist字段是否是"Dixie Chicks",如果用"Lyle Lovett"来调用会是另一个函数比较:artist字段是否是"Lyle Lovett"

 

CL-USER> (select (artist-selector "Dixie Chicks"))

((:TITLE "Home" :ARTIST "Dixie Chicks" :RATING 9 :RIPPED T)

 (:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 8 :RIPPED T))

 

现在需要一个更通用的selector-function生成器,由传入的参数决定对哪个字段生成对应的函数,甚至可以是组合的字段。速成的方式使用关键字参数keyword parameters特性。

 

到目前为止的写的函数,都要指定参数列表作为函数调用时对应的自变量arguments。举个例子:

 

(defun foo (a b c) (list a b c))

 

这个函数在每次调用时都需要3个自变量。但有时需要可以变化数量的参数调用,关键字参数就是实现这个的。新的foo函数使用关键字参数:

 

(defun foo (&key a b c) (list a b c))

 

只有一处不同,&key在参数列表的前面。调用新的foo有所不同,所有合法的调用都用==>指向结果:

 

(foo :a 1 :b 2 :c 3)  ==> (1 2 3)

(foo :c 3 :b 2 :a 1)  ==> (1 2 3)

(foo :a 1 :c 3)       ==> (1 NIL 3)

(foo)                 ==> (NIL NIL NIL)

 

正常情况下在没有参数对应的关键字时,对应的变量被设为NIL。但有时需要区分,因为调用时没有传递参数所以是NIL,和传递的参数值就是NIL这两种情况。可以用以个表代替参数字名,表包含参数名、默认值、和一个传递供应supplied-p参数。这个传递供应参数在明确用参数调用时函数时会设为true否则是false

 

(defun foo (&key a (b 20) (c 30 c-p)) (list a b c c-p))

 

新的调用结果:

 

(foo :a 1 :b 2 :c 3)  ==> (1 2 3 T)

(foo :c 3 :b 2 :a 1)  ==> (1 2 3 T)

(foo :a 1 :c 3)       ==> (1 20 3 T)

(foo)                 ==> (NIL 20 30 NIL)

 

SQL数据库相似,通用的选择函数生成器,最好叫where,并且有4个关键字参数对应CD记录的4个字段。它会生成一个选择函数,并根据我们传递给where的值和CD中对应字段做比较。像这样调用:

 

(select (where :artist "Dixie Chicks"))

 

或者

 

(select (where :rating 10 :ripped nil))

 

函数where如下:

 

(defun where (&key title artist rating (ripped nil ripped-p))

  #'(lambda (cd)

      (and

       (if title    (equal (getf cd :title)  title)  t)

       (if artist   (equal (getf cd :artist) artist) t)

       (if rating   (equal (getf cd :rating) rating) t)

       (if ripped-p (equal (getf cd :ripped) ripped) t))))

 

这个函数返回的匿名函数,会返回对每个字段逻辑AND的结果。每个判断语句会先检查参数是否传递,如果是则和CD比较,否则返回tLisp的真。如果调用where的时候什么都没传递就表示对CD中所有记录的查询,这种情况下匿名函数正是返回t。对ripped参数需要3个项的表来指定,因为需要区分调用时用的:ripped nil表示“选择所有rippednilCD,”和没使用:ripped的调用表示“不在意ripped。”

 

WHERE的另一个用途——更新现有记录

函数update传入一个选择函数,挑选出需要更新的记录,并用关键字参数改变指定的值。用MAPCAR函数映射整个*db*表,对表的每个项应用一个函数,并返回一个新表。

 

(defun update (selector-fn &key title artist rating (ripped nil ripped-p))

  (setf *db*

        (mapcar

         #'(lambda (row)

             (when (funcall selector-fn row)

               (if title    (setf (getf row :title) title))

               (if artist   (setf (getf row :artist) artist))

               (if rating   (setf (getf row :rating) rating))

               (if ripped-p (setf (getf row :ripped) ripped)))

             row) *db*)))

 

SETF可以理解为一个通用的指派操作符,可以在很多“地方”用来赋值,不仅仅是变量。详细的SETF会在第6章讨论。(SETFGETF有很相似的名字但是他们没有任何特殊联系。)如果真的喜欢Dixie Chicks的所有专辑那么评级应该是11,像这样评价:

 

CL-USER> (update (where :artist "Dixie Chicks") :rating 11)

NIL

 

也可以:

 

CL-USER> (select (where :artist "Dixie Chicks"))

((:TITLE "Home" :ARTIST "Dixie Chicks" :RATING 11 :RIPPED T)

 (:TITLE "Fly" :ARTIST "Dixie Chicks" :RATING 11 :RIPPED T))

 

可以很容易的增加一个函数,从数据库删除一行记录。

 

(defun delete-rows (selector-fn)

  (setf *db* (remove-if selector-fn *db*)))

 

函数REMOVE-IFREMOVE-IF-NOT的互补;它移除所有满足谓词的元素并返回一个表。和REMOVE-IF-NOT一样并不会真的影响到传入的表,而是会保存一个新表再返回到*db*

 

大的完胜移除重复

开始去除重复代码,和让代码更灵活。在where函数中有很多对每个字的语句的重复:

 

(if title (equal (getf cd :title) title) t)

 

或许会想要移除掉每次运行时的检测,直接指定需要的字段用匿名函数代替where,如果数量庞大甚至可以编写一个单独的替换器。

 

Common Lisp使用宏macro系统可以简单应对这种事,和C/C++macro除了名字相同以外没有相同的。C的预处理器只是做文本替换,不会涉及到C/C++的结构。Lispmacro本质上是一个被编译器自动使用的代码生成器。当Lisp的一个表达式用到了macro,参数不会被立即求值并传给函数,编译器会把未求值的参数传给macro代码,宏代码返回新表达式并在在原来调用宏的地方被求值。

 

函数REVERSE以一个表做为参数并且返回一个逆序的新表,(reverse '(1 2 3))求值为(3 2 1)。定义宏:

 

(defmacro backwards (expr) (reverse expr))

 

宏的句法与函数最大的不同是用DEFMACRO,而函数是用DEFUN。随后的都与函数一样。然而,宏与函数有完全不同的作用,可以这样用:

 

CL-USER> (backwards ("hello, world" t format))

hello, world

NIL

 

REPL求值backwards表达式的时候,识别出backwards是一个宏,把("hello, world" t format)原样的传递给backwards。再传给REVERSE,返回(format t "hello, world")backwards再把这个结果传递给REPL,在原本表达式的地方求值。

 

可以用宏生成where调用的指定代码。需要一个表达式来替换在where中对特定字段的调用:

 

(equal (getf cd field) value)

 

 

如果写一个函数用字段名和值生成一个表达式,因为表达式是一个表,或许会这样写,但实际是错的:

 

(defun make-comparison-expr (field value)    ; wrong

  (list equal (list getf cd field) value))

 

Lispfieldvalue看做表的第1个元素,试图对他们求值,这是我们想要的。但是也会同样对equalgetfcd求值,为了避免这样所以需要特别对待。可以用单引号(')放在Lisp from前面防止求值,所以修改make-comparison-expr

 

(defun make-comparison-expr (field value)

  (list 'equal (list 'getf 'cd field) value))

 

可以换一个方式来写,用反引号(`)放在表达式前面也可以阻止求值:

 

CL-USER> `(1 2 3)

(1 2 3)

CL-USER> '(1 2 3)

(1 2 3)

 

在反引号的表达式中,可以用逗号让后一个子表达式求值,像这样:

 

`(1 2 (+ 1 2))        ==> (1 2 (+ 1 2))

`(1 2 ,(+ 1 2))       ==> (1 2 3)

 

用反引号修改make-comparison-expr

 

(defun make-comparison-expr (field value)

  `(equal (getf cd ,field) ,value))

 

前面的函数体中,fieldvalue成对的比较,用AND连接。如果把所有where宏传递的参数做为一个表。就只要一个函数对表中的每一对元素调用make-comparison-expr,收集好结果。用LOOP宏可以循环处理表中元素。

 

(defun make-comparisons-list (fields)

  (loop while fields

     collecting (make-comparison-expr (pop fileds) (pop fields))))

 

22章再完整讨论LOOPLOOP表达式,只要还有元素在fileds表中就一直循环,每次弹出2个元素传递给make-comparison-expr,并且收集结果在loop结束的时候返回。POP宏执行和PUSH宏相反的操作,在向*db*添加记录时用到过PUSH

 

AND和匿名函数把make-comparisons-list的返回值组装起来,再把这些封装到where宏中。用反引号构造一个模板,用make-comparisons-list填充它。

 

(defmacro where (&rest clauses)

  `#'(lambda (cd) (and ,@(make-comparisons-list clauses))))

 

make-comparisons-list前面用到了一个变体的逗号叫是(,@)。它把后面的表达式——必须求值为一个表——“衔接”成一个封闭的表。下面是一个差异比较:

 

`(and ,(list 1 2 3))   ==> (AND (1 2 3))

`(and ,@(list 1 2 3))  ==> (AND 1 2 3)

 

还可以用,@在中间衔接:

 

`(and ,@(list 1 2 3) 4)  ==> (AND 1 2 3 4)

 

where宏中另一个比较重要特性是,在参数列表中用到了&rest。和&key一样&rest修改了参数的解析方式。如果函数或者宏的参数列表带有&rest,那么它可以接受任意arbitrary数量的参数,这些参数都会被收集到一个单一的表中,这个表就是&rest后面名字的变量的值。可以这样调用:

 

       (where :title "Give Us a Break" : ripped t)

 

变量clauses包含这个表:

 

       (:title "Give Us a Break" :ripped t)

 

这个表传递给make-comparisons-list返回判断表达式的一个表。用函数MACROEXPAND-1可以看到where生成的代码。如果使用MACROEXPAND-1,一个form作为宏调用,它会调用宏代码并显示出参数和返回的表达式。这样检查前面的where

 

CL-USER> (MACROEXPAND-1 '(where :title "Give Us a Break" :ripped t))

#'LAMBDA (CD)

   (AND (EQUAL (GETF CD :TITLE) "Give Us a Break")

        (EQUAL (GETF CD :RIPPED) T)))

T

 

用到两个辅助函数where宏只有一行的长度比老的函数短了很多。更通用不再关系到CD记录中的特定字段。

 

结束语

用宏可以更好的抽象abstractions——句法层次的抽象,用更简明的方式表达基础概念的抽象。where宏可以用在任何以plist为基础的数据库。

 

这个还不是完整的数据库,第27章会构建MP3的数据库,也有新的特性加入。

 

这章是大致浏览下有用的Lisp特性,下章会更系统的介绍Lisp

 

  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值