定义语法

简介

本章中，我会讲解如何自定义语法。用户定义语法称作宏（Macro）。Lisp/Scheme中的宏比C语言中的宏更加强大。宏可以使你的程序优美而紧凑。

宏是代码的变换。代码在被求值或编译前进行变换，程序会继续执行就像变换后的代码一开始就写好了一样。

你可以在Scheme中通过用符合R5RS规范的syntax-rules轻易地定义简单宏，相比之下，在Common Lisp中自定义语法就复杂多了。使用syntax-rules可以直接定义宏而不用担心变量捕获（Variable Capture）。另一方面，Scheme中定义那些无法用syntax-rules定义的复杂的宏就比Common Lisp要困难。

简单宏的实例

我将以一个简单的宏作为例子。

[代码1]一个将变量赋值为'()的宏。

[代码1]

  1. (define-syntax nil!
  2.   (syntax-rules ()
  3.     ((_ x)
  4.      (set! x '()))))

syntax-reuls的第二个参数是变换前和变化后的表达式的序对所构成的表。_代表宏的名字。简言之，[代码1]表示表达式(nil! x)会变换为(set! x '()).

这类程序不能通过函数来实现，这是因为由于闭包性，函数不能影响外部变量。让我们来用函数版本来实现[代码1]，并观察效果。

[代码’1]

  1. (define (f-nil! x)
  2.    (set! x '()))
  1. (define a 1)
  2. ;Value: a
  4. (f-nil! a)
  5. ;Value: 1
  7. a
  8. ;Value: 1           ; the value of a dose not change
  10. (nil! a)
  11. ;Value: 1
  13. a
  14. ;Value: ()          ; a becomes '()

我会演示另外一个例子。我们编写宏when，其语义为：当谓词求值为真时，求值相应语句。

[代码2]

  1. (define-syntax when
  2.   (syntax-rules ()
  3.     ((_ pred b1 ...)
  4.      (if pred (begin b1 ...)))))

[代码2]中的...代表了任意多个数的表达式（包括0个表达式）。[代码2]揭示了表达式(when pred b1 ...)变换为(if pred (begin b1 ...))。

由于这个宏是将表达式变换为if特殊形式，因此它不能使用函数来实现。下面的例子演示了如何使用when。

  1. (let ((i 0))
  2.   (when (= i 0)
  3.     (display "i == 0")
  4.     (newline)))
  5. i == 0
  6. ;Unspecified return value

我会演示两个实际的宏：while和for（已在Scheme中实现）。只要谓词部分求值为真，while就会对语句体求值。而数字在指定的范围中，for就会对语句体求值。

  1. (define-syntax while
  2.   (syntax-rules ()
  3.     ((_ pred b1 ...)
  4.      (let loop () (when pred b1 ... (loop))))))
  7. (define-syntax for
  8.   (syntax-rules ()
  9.     ((_ (i from to) b1 ...)
  10.      (let loop((i from))
  11.        (when (< i to)
  12.       b1 ...
  13.       (loop (1+ i)))))))

下面演示了如何使用它们：

  1. (let ((i 0))
  2.   (while (< i 10)
  3.     (display i)
  4.     (display #\Space)
  5.     (set! i (+ i 1))))
  6. 0 1 2 3 4 5 6 7 8 9 
  7. ;Unspecified return value
  9. (for (i 0 10)
  10.   (display i)
  11.   (display #\Space))
  12. 0 1 2 3 4 5 6 7 8 9 
  13. ;Unspecified return value

练习1

编写一个宏，其语义为：当谓词求值为假时执行相应的表达式。（语义与when相反。）

syntax-rule的更多细节

多个定义模式

syntax-rule可以定义一系列模式。比如，一个让变量增加的宏，如果给定了变量名，那么宏incf使该变量增加1。可以通过编写如[代码4]这样的模式转换来实现宏incf。

[代码4]

  1. (define-syntax incf
  2.   (syntax-rules ()
  3.     ((_ x) (begin (set! x (+ x 1)) x))
  4.     ((_ x i) (begin (set! x (+ x i)) x))))
  1. (let ((i 0) (j 0))
  2.   (incf i)
  3.   (incf j 3)
  4.   (display (list 'i '= i))
  5.   (newline)
  6.   (display (list 'j '= j)))
  7. (i = 1)
  8. (j = 3)
  9. ;Unspecified return value

练习2

编写用于从变量中减去一个数的宏decf。如果减量省略了，则从变量中减1。

练习3

改进[代码3]中的宏for，使得它可以接受一个参数作为步长。如果省略了步长，则默认为1。

宏的递归定义

代码形式or和and是通过像下面这样递归定义的宏：

[代码5]

  1. (define-syntax my-and
  2.   (syntax-rules ()
  3.     ((_) #t)
  4.     ((_ e) e)
  5.     ((_ e1 e2 ...)
  6.      (if e1
  7.      (my-and e2 ...)
  8.      #f))))
  10. (define-syntax my-or
  11.   (syntax-rules ()
  12.     ((_) #f)
  13.     ((_ e) e)
  14.     ((_ e1 e2 ...)
  15.      (let ((t e1))
  16.        (if t t (my-or e2 ...))))))

可以使用递归定义来编写复杂的宏。

练习4

请自己实现let*。

使用保留字

syntax-rule的第一个参数是保留字的表。比如，cond的定义如[代码6]所示，其中，else是保留字。

  1. (define-syntax my-cond
  2.   (syntax-rules (else)
  3.     ((_ (else e1 ...))
  4.      (begin e1 ...))
  5.     ((_ (e1 e2 ...))
  6.      (when e1 e2 ...))
  7.     ((_ (e1 e2 ...) c1 ...)
  8.      (if e1 
  9.      (begin e2 ...)
  10.      (cond c1 ...)))))

局部语法

在Scheme中，可以使用let-syntax和letrec-syntax来定义局部语法（Local Syntax）。这种形式的用法和define-syntax是相似的。

取决于宏定义的实现

有些宏无法使用syntax-rules来定义。定义这些宏的实现方法已经在Scheme实现中准备好了。由于这种行为严重依赖于实现，因此你可以跳过此节。

在MIT-Scheme中，sc-macro-transformer就可用于这种情况，它允许用户用与Common Lisp中相似的方式来编写宏。关于,、,@的介绍，请参见The Common Lisp HyperSpec。关于sc-macro-transformer和make-syntactic-closuer请参见MIT-Scheme手册。[代码7]演示了一个简单的例子。

[代码 7]

  1. (define-syntax show-vars
  2.   (sc-macro-transformer
  3.     (lambda (exp env)
  4.       (let ((vars (cdr exp)))
  5.            `(begin
  6.               (display
  7.                 (list
  8.                   ,@(map (lambda (v)
  9.                             (let ((w (make-syntactic-closure env '() v)))
  10.                                  `(list ',w ,w)))
  11.                           vars)))
  12.       (newline))))))
  14. (define-syntax random-choice
  15.   (sc-macro-transformer
  16.    (lambda (exp env)
  17.      (let ((i -1))
  18.        `(case (random ,(length (cdr exp)))
  19.       ,@(map (lambda (x)
  20.            `((,(incf i)) ,(make-syntactic-closure env '() x)))
  21.          (cdr exp)))))))
  23. (define-syntax aif
  24.   (sc-macro-transformer
  25.    (lambda (exp env)
  26.      (let ((test (make-syntactic-closure env '(it) (second exp)))
  27.        (cthen (make-syntactic-closure env '(it) (third exp)))
  28.        (celse (if (pair? (cdddr exp))
  29.               (make-syntactic-closure env '(it) (fourth exp))
  30.               #f)))
  31.        `(let ((it ,test))
  32.       (if it ,cthen ,celse))))))

第一个宏show-vars用于显示变量的值。

  1. (let ((i 1) (j 3) (k 7))
  2.   (show-vars i j k))
  3. ((i 1) (j 3) (k 7))
  4. ;Unspecified return value

代码形式(show-vars i j k)被展开成下面这样。因为宏只能返回一个表达式，所以需要用begin返回表达式的集合。

  1. (begin
  2.   (display
  3.    (list
  4.     (list 'i i) (list 'j j) (list 'k k)))
  5.   (newline))

第二个宏random-choice被用于从参数中随机选择一个值或者过程。

  1. (define (turn-right) 'right)
  2. (define (turn-left) 'left)
  3. (define (go-ahead) 'straight)
  4. (define (stop) 'stop)
  6. (random-choice (turn-right) (turn-left) (go-ahead) (stop))
  7. ;Value: right

代码形式被展开如下：

  1. (case (random 4)
  2.   ((0) (turn-right))
  3.   ((1) (turn-left))
  4.   ((2) (go-ahead))
  5.   ((3) (stop)))

第三个宏aif是一个回指宏（ anaphoric macro）。谓词的结果可以被指为it。变量it被捕获，以使得第二个参数make-syntactic-closure变为'(it)。

  1. (let ((i 4))
  2.   (aif (memv i '(2 4 6 8))
  3.        (car it)))
  4. ;Value: 4

下面显示了扩展结果。

  1. (let ((it (memv i '(2 4 6 8))))
  2.   (if it
  3.       (car it)
  4.       #f))

结构体的原始实现

结构体（structure）可以通过[代码8]中的简单宏实现。这里定义的结构体的本质是一个向量（vector）和由宏自动创建的取值以及赋值函数。如果你喜欢的Scheme版本没有结构体的实现，你可以自己实现它们。

[代码8]

  1. 01:     ;;; simple structure definition
  2. 02:     
  3. 03:     ;;; lists of symbols -> string
  4. 04:     (define (append-symbol . ls)
  5. 05:       (let loop ((ls (cdr ls)) (str (symbol->string (car ls))))
  6. 06:         (if (null? ls)
  7. 07:         str
  8. 08:         (loop (cdr ls) (string-append str "-" (symbol->string (car ls)))))))
  9. 09:     
  10. 10:     ;;; obj -> ls -> integer
  11. 11:     ;;; returns position of obj in ls
  12. 12:     (define (position obj ls)
  13. 13:       (letrec ((iter (lambda (i ls)
  14. 14:                (cond
  15. 15:                 ((null? ls) #f)
  16. 16:                 ((eq? obj (car ls)) i)
  17. 17:                 (else (iter (1+ i) (cdr ls)))))))
  18. 18:         (iter 0 ls)))
  19. 19:                          
  20. 20:     
  21. 21:     ;;; list -> integer -> list
  22. 22:     ;;; enumerate list items
  23. 23:     (define (slot-enumerate ls i)
  24. 24:       (if (null? ls)
  25. 25:           '()
  26. 26:         (cons `((,(car ls)) ,i) (slot-enumerate (cdr ls) (1+ i)))))
  27. 27:     
  28. 28:     ;;; define simple structure 
  29. 29:     (define-syntax defstruct
  30. 30:       (sc-macro-transformer
  31. 31:        (lambda (exp env)
  32. 32:          (let ((struct (second exp))
  33. 33:                (slots  (map (lambda (x) (if (pair? x) (car x) x)) (cddr exp)))
  34. 34:            (veclen (- (length exp) 1)))
  35. 35:            
  36. 36:            `(begin   
  37. 37:           (define ,(string->symbol (append-symbol 'make struct))   ; making instance
  38. 38:             (lambda ls
  39. 39:                   (let ((vec (vector ',struct ,@(map (lambda (x) (if (pair? x) (second x) #f)) (cddr exp)))))
  40. 40:             (let loop ((ls ls))
  41. 41:               (if (null? ls)
  42. 42:                   vec
  43. 43:                   (begin
  44. 44:                            (vector-set! vec (case (first ls) ,@(slot-enumerate slots 1)) (second ls))
  45. 45:                 (loop (cddr ls))))))))
  46. 46:     
  47. 47:           (define ,(string->symbol (string-append (symbol->string struct) "?"))  ; predicate
  48. 48:             (lambda (obj)
  49. 49:               (and
  50. 50:                (vector? obj)
  51. 51:                (eq? (vector-ref obj 0) ',struct))))
  52. 52:     
  53. 53:           ,@(map
  54. 54:              (lambda (slot)
  55. 55:                (let ((p (1+ (position slot slots))))
  56. 56:              `(begin
  57. 57:                 (define ,(string->symbol (append-symbol struct slot))    ; accessors
  58. 58:                   (lambda (vec)
  59. 59:                 (vector-ref vec ,p)))
  60. 60:     
  61. 61:                 (define-syntax ,(string->symbol                           ; modifier
  62. 62:                          (string-append
  63. 63:                           (append-symbol 'set struct slot) "!"))
  64. 64:                   (syntax-rules ()
  65. 65:                 ((_ s v) (vector-set! s ,p v)))))))
  66. 66:              slots)
  67. 67:     
  68. 68:           (define ,(string->symbol (append-symbol 'copy struct))      ; copier
  69. 69:             (lambda (vec)
  70. 70:               (let ((vec1 (make-vector ,veclen)))
  71. 71:             (let loop ((i 0))
  72. 72:               (if (= i ,veclen)
  73. 73:                   vec1
  74. 74:                   (begin
  75. 75:                 (vector-set! vec1 i (vector-ref vec i))
  76. 76:                 (loop (1+ i)))))))))))))

下面演示了如何使用：

你可以定义一个结构体，要么只给出槽（slot）的名字，要么给出槽（slot）的名字和缺省值。

  1. ;;; Defining a structure point having 3 slots whose defaults are 0.0.
  2. (defstruct point (x 0.0) (y 0.0) (z 0.0))
  3. ;Unspecified return value
  5. (define p1 (make-point 'x 10 'y 20 'z 30))
  6. ;Value: p1
  8. (point? p1)
  9. ;Value: #t
  11. (point-x p1)
  12. ;Value: 10
  14. ;;; Default values are used for unspecified values when an instance is made.
  15. (define p2 (make-point 'z 20))
  16. ;Value: p2
  18. (point-x p2)
  19. ;Value: 0.
  21. (point-z p2)
  22. ;Value: 20
  24. ;;; Changing a slot value
  25. (set-point-y! p2 12)
  26. ;Unspecified return value
  28. ;;; The reality of the structure definde by [code 8] is a vector
  29. p2
  30. ;Value 14: #(point 0. 12 20)
  32. ;;; Defining a structure 'book' with no default values.
  33. (defstruct book title authors publisher year isbn)
  34. ;Unspecified return value
  36. (define mon-month 
  37.   (make-book 'title  
  38.          "The Mythical Man-Month: Essays on Software Engineering"
  39.          'authors
  40.          "F.Brooks"
  41.          'publisher
  42.          "Addison-Wesley"
  43.          'year
  44.          1995
  45.          'isbn
  46.          0201835959))
  47. ;Value: mon-month
  49. mon-month
  50. ;Value 15: #(book 
  51. "The Mythical Man-Month: Essays on Software Engineering" 
  52. "F.Brooks" 
  53. "Addison-Wesley" 
  54. 1995 
  55. 201835959)
  57. (book-title mon-month)
  58. ;Value 13: "The Mythical Man-Month: Essays on Software Engineering"

小结

我简要介绍了Scheme里的宏。宏可以使你的代码更优雅。

syntax-rules使得编写宏很容易。另一方面，编写Common Lisp的宏，则要求特点的技巧。

习题解答

答案1

  1. (define-syntax unless
  2.   (syntax-rules ()
  3.     ((_ pred b1 ...)
  4.      (if (not pred)
  5.      (begin
  6.        b1 ...)))))

第二个

答案2

  1. (define-syntax decf
  2.   (syntax-rules ()
  3.     ((_ x) (begin (set! x (- x 1)) x))
  4.     ((_ x i) (begin (set! x (- x i)) x))))

答案3

  1. (define-syntax for
  2.   (syntax-rules ()
  3.     ((_ (i from to) b1 ...)
  4.      (let loop((i from))
  5.        (when (< i to)
  6.       b1 ...
  7.       (loop (1+ i)))))
  8.     ((_ (i from to step) b1 ...)
  9.      (let loop ((i from))
  10.        (when (< i to)
  11.       b1 ...
  12.       (loop (+ i step)))))))

答案4

  1. (define-syntax my-let*
  2.   (syntax-rules ()
  3.     ((_ ((p v)) b ...)
  4.      (let ((p v)) b ...))
  5.     ((_ ((p1 v1) (p2 v2) ...) b ...)
  6.      (let ((p1 v1))
  7.        (my-let* ((p2 v2) ...)
  8.         b ...)))))