15. 構文の定義 (マクロ)

1. 初めに

今回は Lisp 語族に特徴的機能である、自前の構文を定義する方法（マクロ）について説明します。マクロが定義できるようになると、プログラムがさらに簡潔に書けるようになります。

マクロとは式の変換です。 式が評価される前に、または、コンパイル時に式が変換されます。そして、変換後の式が初めからソースコードに書いてあったかのように処理が行われます。

Common Lisp のマクロ定義はかなり複雑ですが、R⁵RS に準拠した Scheme では syntax-rules という形式によって比較的簡単に定義できます。 syntax-rules を使うと変数補足などのわずらわしいことを気にしないで、 ”この式をこういう式に変換しろ”ということを直接的に書くことができます。

ただし、syntax-rules で記述できないマクロを書くのは Common Lisp より複雑になります。

2. 簡単なマクロの例

簡単な例を示して説明しましょう。 [code 1] は変数に '() を代入するマクロです。

[code 1]

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

syntax-rules の 2 番目の引数は、もとの式 → 変換後の式を記述した組です。また、_ はマクロ名を表します。つまり、[code 1] の意味は、(nil! x) という式を (set! x '()) に変換しろということです。

これは関数で書くことはできません。関数で書くと、クロージャーの働きにより、関数の外の変数と内部の変数は別の変数になり、関数が自分の外の変数を変化させることはできないからです。試しに [code 1] の関数版を書いてどうなるか見てみましょう。

[code 1']

(define (f-nil! x)
   (set! x '()))

(define a 1)
;Value: a

(f-nil! 'a)
;Value: a

a
;Value: 1           ; a の値は変わらない

(nil! a)
;Value: 1

a
;Value: ()          ; a が '() になった。

もうひとつ簡単な例を示しましょう。predicate が満たされるとき複数の式が実行されるマクロ when を書いてみましょう。

[code 2]

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

[code 2] で出てきた ... は 0 個を含む任意個の式を表します。 [code 2] の意味は、

(when pred
  b1
  ...)

を

(if pred
  (begin
     b1
     ...))

に変換するということです。これも、特殊形式 if に変換されるマクロですから、関数で書くことはできません。使用例は以下のようになります。

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

簡単なマクロの実用的なものとして while と for を挙げておきます。while は predicate が成り立つ間本体を実行し、for は数を表す変数がある範囲内にある間処理を実行します。

[code 3]

(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

練習問題 1

ある条件が満たされないとき複数の式を評価するマクロを作ってください。(when の反対です。）

3. syntax-rules の高度な使い方

3.1. 複数のパターンを定義する。

syntax-rules には複数の変換パターンを定義することができます。例えば、変数の値を増加させるマクロ incf を考えて見ましょう。変数名だけ与えられたときは 1 増やし、変数名と増分が与えら得れたときには増分だけ増やすようにします。 [code 4] のように複数の変換パターンを記述することによって対応することができます。

[code 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

練習問題 2

変数から減少分を引くマクロ decf を作ってください。減少分が省略されて時は 1 を引いてください。

練習問題 3

[code 3] の for を改良して、ステップ幅を指定できるようにしてください。ステップ幅が省略されたときは 1 になるようにしてください。

3.2. マクロの再帰的な定義

or, and はマクロで、以下のように再帰的に定義されています。マクロ定義も再帰的に定義できるので、かなり複雑な構文を定義することができます。

[code 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 ...))))))

練習問題 4

let* を定義してください。

3.3. 予約語の使用

syntax-rules の最初の引数はマクロ内で使用する予約語のリストです。例えば、cond は [code 6] のように定義されます。[code 6] で else は予約語として働きます。

[code 6]

(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 ...)))))

4. 局所マクロ

Scheme では、let-syntax, letrec-syntax を使って局所的に構文を定義することができます。使い方は通常の define-syntax とほぼ同じです。

5. 複雑なマクロ

syntax-rules で全てのマクロが記述できるわけではありません。そのようなマクロを記述するための方法が処理系ごと用意されています。この節に書いてあることは処理系ごとに異なるので、興味のない方は飛ばして結構です。

MIT-Scheme では sc-macro-transformer などが用意されています。これを用いると Common Lisp 的な方法でマクロを書くことができます。 ` , ,@ などの使い方はテンプレートの使い方と展開形の確認を見てください。また、 sc-macro-transfomrer, make-syntactic-closure については MIT-Scheme のマニュアルを見てください。以下に簡単な例を挙げます。

[code 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-choise
  (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))))))

最初のマクロ 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) は以下のように展開されます。マクロは１つの式しか返せないので、２つ以上の式を返したいときは begin でくくります。

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

２番目の random-choise は複数の値や手続きのうちから１つをランダムに選ぶマクロです。使用例は以下の通りです。

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

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

これは以下のように展開されます。

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

３番目の aif は代名詞マクロです。predicate の結果を it として参照できます。 make-syntactic-closure の２番目の引数を '(it) とすることで代名詞 it を意図的に捕捉しています。使用例は以下の通りです。

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

展開形は以下の通りです。

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

6. 構造体の簡単な実装

構造体は [code 8] に示すようにマクロを使って簡単に定義することができます。ここで定義する構造体の実態はヴェクトルで、各要素にアクセスする関数群をマクロを使って自動生成させます。構造体が定義されていない実装を使うときは [code 8] を参考にして自分で実装する必要があります。

[code 8]

01:     ;;; simple structure difinition
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))    ; accessor
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)))))))))))))

以下の様に使います。スロット名だけを与えても良いし、スロット名とデフォルト値を与えることもできます。

;;; 3 つのスロット x, y, z (デフォルトは 0.0) がある構造体 point を定義する
(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

;;; インスタンスを作るとき指定されていない値はデフォルト値になる。
(define p2 (make-point 'z 20))
;Value: p2

(point-x p2)
;Value: 0.

(point-z p2)
;Value: 20

;;; スロットの値を変更する
(set-point-y! p2 12)
;Unspecified return value

;;; ここで定義した構造体の実態はヴェクトル
p2
;Value 14: #(point 0. 12 20)

;;; 構造体 book を定義する。初期値は与えない。
(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"

7. 終わりに

Scheme のマクロについて簡単に説明しました。マクロを使わなくてもプログラムは書けますが、マクロを使ったほうがエレガントなプログラムが書けます。

Common Lisp ではマクロを書くにはそれなりの熟練が必要ですが、 Scheme の syntax-rules を使うと比較的簡単にマクロを書くことができます。

練習問題の解答

練習問題 1

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

練習問題 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 ...)))))