第十五章 定義語(yǔ)法

15.1 簡(jiǎn)介

本章中，我會(huì)講解如何自定義語(yǔ)法。用戶定義語(yǔ)法稱作宏（Macro）。Lisp/Scheme中的宏比C語(yǔ)言中的宏更加強(qiáng)大。宏可以使你的程序優(yōu)美而緊湊。

宏是代碼的變換。代碼在被求值或編譯前進(jìn)行變換，and the procedure continues as if the transformed codes are written from the beginning.

你可以在Scheme中通過(guò)用符合R5RS規(guī)范的syntax-rules輕易地定義簡(jiǎn)單宏，相比之下，在Common Lisp中自定義語(yǔ)法就復(fù)雜多了。使用syntax-rules可以直接定義宏而不用擔(dān)心變量的捕獲（Variable Capture）。On the other hand, defining complicated macros that cannot be defined using the syntax-rules is more difficult than that of the Common Lisp.

15.2 實(shí)例：簡(jiǎn)單宏

我將以一個(gè)簡(jiǎn)單的宏作為例子。

[代碼片段 1] 一個(gè)將變量賦值為’()的宏

(define-syntax nil!
  (syntax-rules ()
    ((_ x)
     (set! x '()))))

syntax-reuls的第二個(gè)參數(shù)由是變換前表達(dá)式構(gòu)成的表。_代表宏的名字。簡(jiǎn)言之，代碼片段1表示表達(dá)式(nil! x)會(huì)變換為(set! x '()).

這類過(guò)程不能通過(guò)函數(shù)來(lái)實(shí)現(xiàn)，這是因?yàn)楹瘮?shù)的閉包性質(zhì)限制它不能影響外部變量。讓我們來(lái)用函數(shù)實(shí)現(xiàn)代碼片段1，并觀察效果。

(define (f-nil! x)
   (set! x '()))
(define a 1)
;Value: a

(f-nil! a)
;Value: 1

a
;Value: 1           ; the value of a dose not change

(nil! a)
;Value: 1

a
;Value: ()          ; a becomes '()

我會(huì)演示另外一個(gè)例子。我們編寫宏when，其語(yǔ)義為：當(dāng)謂詞求值為真時(shí)，求值相應(yīng)語(yǔ)句。

(define-syntax when
  (syntax-rules ()
    ((_ pred b1 ...)
     (if pred (begin b1 ...)))))

代碼片段2中的...代表了任意多個(gè)數(shù)的表達(dá)式（包括0個(gè)表達(dá)式）。代碼片段2揭示了諸如表達(dá)式(when pred b1 ...)會(huì)變換為(if pred (begin b1 ...))。

由于這個(gè)宏是將表達(dá)式變換為if特殊形式，因此它不能使用函數(shù)來(lái)實(shí)現(xiàn)。下面的例子演示了如何使用when。

(let ((i 0))
  (when (= i 0)
    (display "i == 0")
    (newline)))
i == 0
;Unspecified return value

我會(huì)演示兩個(gè)實(shí)宏：while和for。只要謂詞部分求值為真，while就會(huì)對(duì)語(yǔ)句體求值。而數(shù)字在指定的范圍中，for就會(huì)對(duì)語(yǔ)句體求值。

(define-syntax while
  (syntax-rules ()
    ((_ pred b1 ...)
     (let loop () (when pred b1 ... (loop))))))

(define-syntax for
  (syntax-rules ()
    ((_ (i from to) b1 ...)
     (let loop((i from))
       (when (< i to)
      b1 ...
      (loop (1+ i)))))))

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

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

(for (i 0 10)
  (display i)
  (display #\Space))
0 1 2 3 4 5 6 7 8 9 
;Unspecified return value

練習(xí)1

編寫一個(gè)宏，其語(yǔ)義為：當(dāng)謂詞求值為假時(shí)執(zhí)行相應(yīng)的表達(dá)式。（語(yǔ)義與when相對(duì)）

15.3 syntax-rule的更多細(xì)節(jié)

多個(gè)定義模式

syntax-rule可以定義一系列模式。比如，一個(gè)讓變量增加的宏，如果給定了變量名，那么宏incf使該變量增加1?？梢酝ㄟ^(guò)編寫如[代碼4]這樣的模式轉(zhuǎn)換來(lái)實(shí)現(xiàn)宏incf。

[代碼4]

(define-syntax incf
  (syntax-rules ()
    ((_ x) (begin (set! x (+ x 1)) x))
    ((_ x i) (begin (set! x (+ x i)) x))))

(let ((i 0) (j 0))
  (incf i)
  (incf j 3)
  (display (list 'i '= i))
  (newline)
  (display (list 'j '= j)))
(i = 1)
(j = 3)
;Unspecified return value

練習(xí)2編寫用于從變量中減去一個(gè)數(shù)的宏decf。如果減量省略了，則從變量中減1。練習(xí)3改進(jìn)[代碼3]中的宏for，使得它可以接受一個(gè)參數(shù)作為步長(zhǎng)。如果省略了步長(zhǎng)，則默認(rèn)為1。

宏的遞歸定義

代碼形式or和and是通過(guò)像下面這樣遞歸定義的宏：

[代碼5]

(define-syntax my-and
  (syntax-rules ()
    ((_) #t)
    ((_ e) e)
    ((_ e1 e2 ...)
     (if e1
     (my-and e2 ...)
     #f))))

(define-syntax my-or
  (syntax-rules ()
    ((_) #f)
    ((_ e) e)
    ((_ e1 e2 ...)
     (let ((t e1))
       (if t t (my-or e2 ...))))))

可以使用遞歸定義來(lái)編寫復(fù)雜的宏。

練習(xí)4請(qǐng)自己實(shí)現(xiàn)let*。

使用保留字

syntax-rule的第一個(gè)參數(shù)是保留字的表。比如，cond的定義如[代碼6]所示，其中，else是保留字。

(define-syntax my-cond
  (syntax-rules (else)
    ((_ (else e1 ...))
     (begin e1 ...))
    ((_ (e1 e2 ...))
     (when e1 e2 ...))
    ((_ (e1 e2 ...) c1 ...)
     (if e1 
     (begin e2 ...)
     (cond c1 ...)))))

局部語(yǔ)法

在Scheme中，可以使用let-syntax和letrec-syntax來(lái)定義局部語(yǔ)法（Local Syntax）。這種形式的用法和define-syntax是相似的。

取決于宏定義的實(shí)現(xiàn)

有些宏無(wú)法使用syntax-rules來(lái)定義。定義這些宏的實(shí)現(xiàn)方法已經(jīng)在Scheme實(shí)現(xiàn)中準(zhǔn)備好了。由于這種行為嚴(yán)重依賴于實(shí)現(xiàn)，因此你可以跳過(guò)此節(jié)。

在MIT-Scheme中，sc-macro-transformer就可用于這種情況，它允許用戶用與Common Lisp中相似的方式來(lái)編寫宏。關(guān)于,、,@的介紹，請(qǐng)參見(jiàn)The Common Lisp HyperSpec。關(guān)于sc-macro-transformer和make-syntactic-closuer請(qǐng)參見(jiàn)MIT-Scheme手冊(cè)。[代碼7]演示了一個(gè)簡(jiǎn)單的例子。

[代碼 7]

(define-syntax show-vars
  (sc-macro-transformer
    (lambda (exp env)
      (let ((vars (cdr exp)))
           `(begin
              (display
                (list
                  ,@(map (lambda (v)
                            (let ((w (make-syntactic-closure env '() v)))
                                 `(list ',w ,w)))
                          vars)))
      (newline))))))

(define-syntax random-choice
  (sc-macro-transformer
   (lambda (exp env)
     (let ((i -1))
       `(case (random ,(length (cdr exp)))
      ,@(map (lambda (x)
           `((,(incf i)) ,(make-syntactic-closure env '() x)))
         (cdr exp)))))))

(define-syntax aif
  (sc-macro-transformer
   (lambda (exp env)
     (let ((test (make-syntactic-closure env '(it) (second exp)))
       (cthen (make-syntactic-closure env '(it) (third exp)))
       (celse (if (pair? (cdddr exp))
              (make-syntactic-closure env '(it) (fourth exp))
              #f)))
       `(let ((it ,test))
      (if it ,cthen ,celse))))))

第一個(gè)宏show-vars用于顯示變量的值。

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

代碼形式(show-vars i j k)被展開(kāi)成下面這樣。因?yàn)楹曛荒芊祷匾粋€(gè)表達(dá)式，所以需要用begin返回表達(dá)式的集合。

(begin
  (display
   (list
    (list 'i i) (list 'j j) (list 'k k)))
  (newline))

第二個(gè)宏random-choice被用于從參數(shù)中隨機(jī)選擇一個(gè)值或者過(guò)程。

(define (turn-right) 'right)
(define (turn-left) 'left)
(define (go-ahead) 'straight)
(define (stop) 'stop)

(random-choice (turn-right) (turn-left) (go-ahead) (stop))
;Value: right

代碼形式被展開(kāi)如下：

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

第三個(gè)宏aif是一個(gè)回指宏（ anaphoric macro）。謂詞的結(jié)果可以被指為it。變量it被捕獲，以使得第二個(gè)參數(shù)make-syntactic-closure變?yōu)?#39;(it)。

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

下面顯示了擴(kuò)展結(jié)果。

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

結(jié)構(gòu)體的原始實(shí)現(xiàn)

結(jié)構(gòu)體（structure）可以通過(guò)[代碼8]中的簡(jiǎn)單宏實(shí)現(xiàn)。這里定義的結(jié)構(gòu)體的本質(zhì)是一個(gè)向量（vector）和由宏自動(dòng)創(chuàng)建的取值以及賦值函數(shù)。如果你喜歡的Scheme版本沒(méi)有結(jié)構(gòu)體的實(shí)現(xiàn)，你可以自己實(shí)現(xiàn)它們。

[代碼8]

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

下面演示了如何使用：

你可以定義一個(gè)結(jié)構(gòu)體，要么只給出槽（slot）的名字，要么給出槽（slot）的名字和缺省值。

;;; Defining a structure point having 3 slots whose defaults are 0.0.
(defstruct point (x 0.0) (y 0.0) (z 0.0))
;Unspecified return value

(define p1 (make-point 'x 10 'y 20 'z 30))
;Value: p1

(point? p1)
;Value: #t

(point-x p1)
;Value: 10

;;; Default values are used for unspecified values when an instance is made.
(define p2 (make-point 'z 20))
;Value: p2

(point-x p2)
;Value: 0.

(point-z p2)
;Value: 20

;;; Changing a slot value
(set-point-y! p2 12)
;Unspecified return value

;;; The reality of the structure definde by [code 8] is a vector
p2
;Value 14: #(point 0. 12 20)

;;; Defining a structure 'book' with no default values.
(defstruct book title authors publisher year isbn)
;Unspecified return value

(define mon-month 
  (make-book 'title  
         "The Mythical Man-Month: Essays on Software Engineering"
         'authors
         "F.Brooks"
         'publisher
         "Addison-Wesley"
         'year
         1995
         'isbn
         0201835959))
;Value: mon-month

mon-month
;Value 15: #(book 
"The Mythical Man-Month: Essays on Software Engineering" 
"F.Brooks" 
"Addison-Wesley" 
1995 
201835959)

(book-title mon-month)
;Value 13: "The Mythical Man-Month: Essays on Software Engineering"

小結(jié)

我簡(jiǎn)要介紹了Scheme里的宏。宏可以使你的代碼更優(yōu)雅。

syntax-rules使得編寫宏很容易。另一方面，編寫Common Lisp的宏，則要求特點(diǎn)的技巧。

習(xí)題解答

答案1

(define-syntax unless
  (syntax-rules ()
    ((_ pred b1 ...)
     (if (not pred)
     (begin
       b1 ...)))))

第二個(gè)

答案2

(define-syntax decf
  (syntax-rules ()
    ((_ x) (begin (set! x (- x 1)) x))
    ((_ x i) (begin (set! x (- x i)) x))))

答案3

(define-syntax for
  (syntax-rules ()
    ((_ (i from to) b1 ...)
     (let loop((i from))
       (when (< i to)
      b1 ...
      (loop (1+ i)))))
    ((_ (i from to step) b1 ...)
     (let loop ((i from))
       (when (< i to)
      b1 ...
      (loop (+ i step)))))))

答案4

(define-syntax my-let*
  (syntax-rules ()
    ((_ ((p v)) b ...)
     (let ((p v)) b ...))
    ((_ ((p1 v1) (p2 v2) ...) b ...)
     (let ((p1 v1))
       (my-let* ((p2 v2) ...)
        b ...)))))