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 ~A>" (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 "#<ARC ~A / ~A / ~A>"
(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用来声明常量，一旦声明之后不能对该变量的值进行修改，否则会出错
扫一扫
886
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
