common Lisp学习笔记（十四）

• 14 Macros
  • toolkit: ppmx
  • 14.4 defining a macro
  • 14.5 macros as syntactic extensions
  • 14.6 backquote
  • 14.7 splicing with backquote
    • 设计宏
  • 14.8 complier
  • 14.9 compilation and macro expansion
  • 14.11 FSM
  • 14.12 &body
  • 14.14 macros and lexical scoping
  • 14.15 dynamic scoping
  • 14.17 defvar, defparameter, defconstant

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用来声明常量，一旦声明之后不能对该变量的值进行修改，否则会出错