14 Macros

宏通常通过defmacro来定义，它定义了怎样"翻译"出一个函数调用。 我们定义一个宏的时候说明一个函数调用应该翻译成什么，这个翻译称为宏展开(macro-expansion)，由编译器自动 完成。因为宏能”翻译“出能执行的函数，所以这样可以写出能写程序的程序

nil!函数将其参数设为nil

(defmacro nil! (x)

(list 'setf x nil))

可以这样理解，(list 'setf x nil)先翻译成一个正确的lisp表达式(setf a nil)，然后进行eval操作执行这句话， 将a设为nil。需要注意的是(list 'setf x nil)翻译的时候没有对x进行eval，因为macro是不对参数进行eval操作的

要测试一个宏，可以看它的展开式expansion，函数macroexpand-1接受一个宏参数，产生展开式

> (macroexpand-1 '(nil! x))

(setf x nil)

t

一个宏调用可以翻译为另一个宏调用，这时候编译器会持续的翻译它，直到不能再展开为止

toolkit: ppmx

ppmx: Pretty Print Macro eXpansion

(defmacro ppmx (form)

"Pretty prints the macro expansion of FORM."

`(let* ((exp1 (macroexpand-1 ',form))

(exp (macroexpand exp1))

(*print-circle* nil))

(cond ((equal exp exp1)

(format t "~&Macro expansion:")

(pprint exp))

(t (format t "~&First step of expansion:")

(pprint exp1)

(format t "~%~%Final expansion:")

(pprint exp)))

(format t "~%~%")

(values)))

> (ppmx (incf a))

(setq a (+ a 1))

14.4 defining a macro

(defmacro simple-incf (var)

(list 'setq var (list '+ var 1)))

> (ppmx (simple-incf a))

macro expansion:

(setq a (+ a 1))

宏对其参数var不进行eval，所以翻译后的结果就是(setq a (+ a 1))

如果要定义一个可以接受增加多少的参数的incf，需要用到关键字参数&optional

(defmacro simple-incf (var &optional (amount 1))

(list 'setq var (list '+ var amount)))

只有一个参数即要被增加的变量的时候，缺省增加amount为1

为什么这里要使用macro？现在尝试定义一个做incf的函数，使用defun

(defun faulty-incf (var)

(setq var (+ var 1)))

(setf a 7)

> (faulty-incf a)

8

> (faulty-incf a)

8

> a

7

可以发现函数调用之后，a的值还是7而没有改变，那是因为函数接受参数a的时候，本地实例化了一个变量var 作为拷贝，相当于call by value，所以不能改变a的值

setq函数可以修改参数的值，但它不是一个macro，它是一种special function

14.5 macros as syntactic extensions

普通函数和宏函数有三个重要的区别：

普通函数的参数都会eval，而宏函数的参数不会被eval

普通函数的结果可以是任意的值，而宏产生的结果一定要是合法的lisp表达式，因为翻译之后还要执行表达式

宏返回一个合法表达式之后，马上会对其进行eval

除此之外，lisp中还有一些特殊函数如setq, if, let, block等不属于普通函数，它们也不会对参数eval。通过普通 函数和特殊函数的组合使用，其实也可以完成任意使用macro实现的任务

14.6 backquote

backquote符号即`，类似与单引号的用法，也是为了阻止变量被eval，不同之处在于反引号对一个list使用时， 里面的元素可以在前面加上一个逗号,，表示"unquoted"，即要使用它的值而不是表达式本身

(setf name 'fred)

> `(this is ,name)

(this is fred)

> `(i give ,name ,(* 10 10) dollars)

(i give fred 100 dollars)

ex 14.5

(defmacro set-mutual (a b)

`(progn

(setf ,a ',b)

(setf ,b ',a)))

(setf a 'hello)

(setf b 'world)

(set-mutual a b)

> a

b

> b

a

这个函数将a的值置为b的变量名，将b的值置为a的变量名，`(setf ,a ',b)中,a即引用a变量，不是a的值，这里可以 理解为a的变量名，然后',b表示先,b得到b的变量名再加单引号表示这个符号

14.7 splicing with backquote

上一节对反引号的list里面的元素使用逗号可以"unquote"，即忽视反引号对其eval。 ,@的用法类似逗号，作用是对该元素eval，并且得到的结果要是一个list，然后将list里面的全部元素拿出来 替换原来的位置，即不要list的括号

(setf name 'fred)

(setf address '(10 maple drive))

> `(,name lives at ,address)

(fred lives at (10 maple drive))

;;;不要地址两边的括号

> `(,name lives at ,@address now)

(fred lives at 10 maple drive)

通过&rest参数可以搜集主体的表达式列表，来定义这样一个宏，接着使用comma-at来扒开这个列表并执行里面的 语句

(defmacro while (test &rest body)

`(do ()

((not ,test))

,@body))

有了这个while宏就可以实现一个快速排序的程序quicksort，这是一个非常依赖宏的程序，输入为一个vector，还有 排序区域的左右下标l,r

(defun quicksort (vec l r)

(let ((i l)

(j r)

([ (svref vec (round (+ l r) 2))))

(while (<= i j)

(while (< (svref vec i) p) (incf i))

(while (> (svref vec j) p) (decf j))

(when (<= i j)

(rotatef (svref vec i) (svref vec j))

(incf i)

(decf j)))

(if (>= (- j l) 1) (quicksort vec l j))

(if (>= (- r i) 1) (quicksort vec i r)))

vec)

程序说明：

每次选取主键是取中间那个数作为主键，(round (+ l r) 2)算出中间位置下标

下标i,j从两边开始向中间收缩，保证i左边的数都小于主键，右边的数都大于主键，而[i,j]之间的数则待处理

每次准备交换之前，i位置的数>=主键，j位置的数<=主键，交换两个位置的数就可以继续满足上一条件

结束时将原区域划分为主键那个数的左右两边两个区域，多余一个数的区域则继续递归调用该函数来排序

设计宏

设计一个宏ntimes，接受一个数字n并且对主体求值n次 比如(ntimes 10 (princ ".")) -> .........

下面是一个不正确的定义

(defmacro ntimes (n &rest body)

`(do ((x 0 (+ x 1)))

((>= x ,n))

,@body))

下面定义的宏函数set-zero接收一系列的参数并将它们置为0，并返回操作的信息，即翻译后的结果为

> (ppmx (set-zero a b c))

(progn

(setf a 0)

(setf b 0)

(setf c 0)

'(zeroed a b c))

现在要拼接一系列的(setf a 0) ... ，可以考虑对参数list使用mapcar，对每个元素返回一个(setf a 0)这样的 list，然后因为mapcar会将这些list再组成一个list返回，所以可以用,@来将外层的括号去掉，成为一系列 可以用progn执行的语句

(defmacro set-zero (&rest vars)

`(progn

,@(mapcar #'(lambda (var) `(setf ,var 0)) vars)

'(zeroed ,@vars)))

代码中的引号可能会感觉有点奇怪，最外面一层是反引号，而最后'(zeroed ,@vars)则用单引号就行， 可能是最外面一层的反引号对这里仍然起作用，如果将这个单引号改为反引号则会提示变量vars没有值的错误。 而中间lambda函数中(setf)外面用的则是反引号

ex 14.6

(defmacro variable-chain (&rest vars)

`(progn

,@(do ((v vars (rest v))

(res nil))

((null (rest v)) (reverse res))

(push `(setf ,(first v)

',(second v))

res))))

14.8 complier

编译器可以将lisp程序编译为机器语言。这样相比直接用解释器来运行程序可能速度要快10倍以上。 compile可以编译一个函数，compile-file则可以编译整个文件

(defun tedious-sqrt (n)

(dotimes (i n)

(if (> (* i i) n) (return i))))

> (compile 'tedious-sqrt)

tedious-sqrt

compile加上'func-name就可以编译函数，后面调用这个函数速度将会变快

14.9 compilation and macro expansion

common lisp标准允许宏调用在任何时候被进行扩展，所以我们不应该写出那种有副作用的宏，比如赋值和i/o。 但是如果是宏扩展之后变成有副作用的表达式则没有问题

(defmacro bad-announce-macro ()

(format t "~&hello"))

(defun say-hi ()

(bad-announce-macro))

> (compile 'say-hi)

hello

say-hi

> say-hi

nil

这个例子中宏在编译say-hi函数的时候进行了扩展，所以编译的时候已经输出hello，剩下结果是nil，所以后面 调用函数只是输出nil，改进的方法是使宏返回一个format的表达式

(defmacro good-announce-macro ()

`(format t "~&hello"))

14.11 FSM

(defstruct (node (:print-function print-node))

(name nil)

(inputs nil)

(outputs nil))

(defun print-node (node stream depth)

(format stream "#" (node-name node)))

(defstruct (arc (:print-function print-arc))

(from nil)

(to nil)

(label nil)

(action nil))

(defun print-arc (arc stream depth)

(format stream "#"

(node-name (arc-from arc))

(arc-label arc)

(node-name (arc-to arc))))

(defvar *nodes*)

(defvar *arcs*)

(defvar *current-node*)

(defun initialize ()

(setf *nodes* nil)

(setf *arcs* nil)

(setf *current-node* nil))

(defmacro defnode (name)

`(add-node ',name))

(defun add-node (name)

(let ((new-node (make-node :name name)))

(setf *nodes* (nconc *nodes* (list new-node)))

new-node))

(defun find-node (name)

(or (find name *nodes* :key #'node-name)

(error "no node named ~A exists." name)))

(defun add-arc (from-name label to-name action)

(let* ((from (find-node from-name))

(to (find-node to-name))

(new-arc (make-arc :from from

:label label

:to to

:action action)))

(setf *arcs* (nconc *arcs* (list new-arc)))

(setf (node-outputs from) (nconc (node-outputs from) (list new-arc)))

(setf (node-inputs to) (nconc (node-inputs to) (list new-arc)))

new-arc))

(defmacro defarc (from label to &optional action)

`(add-arc ',from ',label ',to ',action))

(defun fsm (&optional (starting-point 'start))

(setf *current-node* (find-node starting-point))

(do ()

((null (node-outputs *current-node*)))

(one-transition)))

(defun one-transition ()

(format t "~&state ~A. input: " (node-name *current-node*))

(let* ((ans (read))

(arc (find ans (node-outputs *current-node*) :key #'arc-label)))

(unless arc

(format t "~&no arc from ~A has label ~A.~%" (node-name *current-node*) ans)

(return-from one-transition nil))

(let ((new (arc-to arc)))

(format t "~&~A" (arc-action arc))

(setf *current-node* new))))

(initialize)

(defnode start)

(defnode have-5)

(defnode have-10)

(defnode have-15)

(defnode have-20)

(defnode end)

(defarc start nickel have-5 "clunk!")

(defarc start dime have-10 "clink!")

(defarc start coin-return start "nothing to return!")

(defarc have-5 nickel have-10 "Clunk!")

(defarc have-5 dime have-15 "Clink!")

(defarc have-5 coin-return start "Returned five cents.")

(defarc have-10 nickel have-15 "Clunk!")

(defarc have-10 dime have-20 "Clink!")

(defarc have-10 coint-return start "Returned ten cents.")

(defarc have-15 nickel have-20 "Clunk!")

(defarc have-15 dime have-20 "Nickel change.")

(defarc have-15 gum-button end "Deliver gum.")

(defarc have-15 coin-return start "Returned fifteen cents.")

(defarc have-20 nickel have-20 "Nickel returned.")

(defarc have-20 dime have-20 "Dime returned.")

(defarc have-20 gum-button end "Deliver gum, nickel change.")

(defarc have-20 mint-button end "Deliver mints.")

(defarc have-20 coin-return start "Returned twenty cents.")

ex 14.11

(defun compile-arc (arc)

`((equal this-input ',(arc-label arc))

(format t "~&~A" ,(arc-action arc))

(,(node-name (arc-to arc)) (rest input-syms))))

(defun compile-node (node)

`(defun ,(node-name node) (input-syms &aux (this-input (first input-syms)))

(cond ((null input-syms) ',(node-name node))

,@(mapcar #'compile-arc (node-outputs node))

(t (error "no arc from ~A with label ~A." ',(node-name node) this-input)))))

(defmacro compile-machine ()

`(progn

,@(mapcar #'compile-node *nodes*)))

14.12 &body

使用宏的原因是可以给lisp增加一些新的语法，如实现一个while循环

(defmacro while (test &body body)

`(do ()

((not ,test))

,@body))

这里&body类似于&rest的用法，但是lisp为了表示一些控制结构的主体还有可读性提供了&body关键词。

14.14 macros and lexical scoping

看回之前的函数faulty-incf，希望使用函数而不是宏来实现incf。如果我们在调用函数的时候不是 (faulty-incf a), 而是通过(faulty-incf 'a)，在a前面加上单引号。这样函数就要找出参数当前的值并 用新的值替代它

如果参数是全局变量这时可以实现的。我们可以使用symbol-value来获取符号的变量值，然后通过set来将 新的值存到这个符号(全局变量)的变量值的空间，即真正修改全局变量的值

(defun faulty-incf (var)

(set var (+ (symbol-value var) 1)))

(setf a 9)

> (faulty-incf 'a)

10

> a

10

这样就可以在函数中修改全局变量的值。注意新的faulty-incf在调用的时候要在变量名前面加上单引号，作为一个 symbol来传到函数中。否则会因为没有这个symbol而报错

faulty-incf只能对全局变量使用，而局部变量就会出错。假设在一个函数中对它进行调用

(defun test-faulty (turnip)

(faulty-incf 'turnip))

(defun test-simple (turnip)

(simple-incf turnip))

在正确的使用宏的test-simple中，首先会创建一个本地变量turnip，然后对其进行incf。而test-faulty会先创建 变量turnip，然后调用simple-incf，进入后创建本地变量var = 'turnip，然后对其加1会出错。而我们原先 希望执行的是(symbol-value 'turnip) -> value of 'turnip，而不是(symbol-value var) - > 'turnip

14.15 dynamic scoping

前面我们使用过的作用域都是lexical scoping，一个函数只能访问到在这个函数里面说明的变量，或者全局变量。

另一种方法是使用dynamic scoping.所谓动态，就是说一个变量名不一定总是绑定一个全局变量，可以在一个 函数里面使用同样的变量名，这时相当于覆盖掉全局的这个变量名，所有访问这个变量名都会访问到这个新的 变量，直到这个函数结束

动态作用域的变量也称为特殊变量。当一个变量声明为特殊变量的时候，它不是任何函数的局部变量。

defvar宏可以声明一个特殊变量

(defvar birds)

(setf fish '(hello world))

(setf birds '(a bird))

(defun ref-rish () fish)

(defun ref-birds () birds)

(defun test-lexical (fish)

(list fish (ref-fish)))

> (test-lexical '(new fish))

((new fish) (hello world))

test函数中先创建局部变量fish，所以list中第一个元素是新的fish.但是调用ref-fish时，它只能访问到全局变量的 fish

(defun test-dynamic (birds)

(list birds (ref-birds)))

> (test-dynamic '(new bird))

((new bird) (new bird))

> (ref-bird)

(a bird)

进入test函数会创建一个新的动态变量birds，然后这时任何函数访问birds都会得到这个新的birds，直到test结束

14.17 defvar, defparameter, defconstant

三个函数都用于声明特殊变量，都有同样的形势如(func var-name value doc-string).

> (defvar *total-glassed* 0 "total glasses sold so far")

*total*glasses*

如果变量本身已经有一个值，defvar中给的值不会改变变量本身的值，除非变量本身没有值defvar才会给它赋值

defparameter类似于defvar，用来声明一些程序运行时不会改变的变量，不同的是它会修改变量的值，即使变量 本身已经有一个值

defconstant用来声明常量，一旦声明之后不能对该变量的值进行修改，否则会出错