この章では，一番よく使われる種類のマクロを定義する方法を示す． それらは ---かなり重複が生じるが--- 3種類に分けられる． 1種類目はコンテキストを作るマクロだ． オペレータが引数を新しいコンテキスト内で評価するものなら， おそらくマクロとして定義されなければならないだろう． 始めの2節は基本的な2種類のコンテキストについて説明し， それぞれに対してマクロを定義する方法を示す．
続く3節は条件付き評価と反復評価のためのマクロについて説明する． オペレータが引数を1回より少なく，または複数回評価するものなら， やはりマクロとして定義されなければならない． 条件付き評価のためのマクロと反復評価のためのマクロとの間には明確な区別はない． この章で示した例の幾つかは両方を兼ねる（束縛と同様に）． 最後の節は条件付き評価のためのマクロと反復評価のためのマクロとの間のもう1つの類似性について説明する． 場合によっては，どちらも関数によって実現できるのだ．
コンテキストには2つの意味がある．
1種類目のコンテキストとはレキシカルな環境だ．
特殊式letは新しいレキシカル環境を作る．
letの本体内の式は新しい変数を含んでいるかも知れないような環境内で評価される．
xがトップレベル内でaに設定されたとする．
しかし次の式は(b)を返す．
(let ((x 'b)) (list x))
これは値がbである新しい変数xを含む環境内でlistが呼ばれたからだ．
式を実行本体として取るオペレータは普通はマクロとして定義されなければならない．
prog1やprognなどの場合を除けば，
そのようなオペレータの目的は普通は本体部を何か新しいコンテキスト内で評価させることだろう．
コンテキストを生成するコードで本体部の外を覆うためには，
コンテキストが新しいレキシカル変数を含まないときであっても，マクロが必要になる．
(defmacro our-let (binds &body body)
`((lambda ,(mapcar #'(lambda (x)
(if (consp x) (car x) x))
binds)
,@body)
,@(mapcar #'(lambda (x)
(if (consp x) (cadr x) nil))
binds)))
\caption{letのマクロによる実装．}
\label{fig:MacroLet}
第\ref{fig:MacroLet}図にはletがどのようにlambda上のマクロとして定義できるかを示した．
our-letは関数アプリケーションに展開される---
(our-let ((x 1) (y 2)) (+ x y))
これは次のようになる．
((lambda (x y) (+ x y)) 1 2)
(defmacro when-bind ((var expr) &body body)
`(let ((,var ,expr))
(when ,var
,@body)))
(defmacro when-bind* (binds &body body)
(if (null binds)
`(progn ,@body)
`(let (,(car binds))
(if ,(caar binds)
(when-bind* ,(cdr binds) ,@body)))))
(defmacro with-gensyms (syms &body body)
`(let ,(mapcar #'(lambda (s)
`(,s (gensym)))
syms)
,@body))
\caption{変数を束縛するマクロの例．}
\label{fig:MacroBindsVar}
第\ref{fig:MacroBindsVar}図にはレキシカル環境を作り出す新マクロを3個載せた．
第7.5節ではwhen-bindを引数リストの構造化代入の例として扱ったので，
このマクロはすでにchingページに説明されている．
更に一般的なwhen-bind*は(\emph{symbol expression})の形のペアから成るリストを取る
---letの引数と同じ形式だ．
どれかの式がnilを返したら，式when-bind*全体の値としてnilが返される．
そうでなければそれぞれのシンボルがlet*と同様に束縛された状態で本体部が評価される：
> (when-bind* ((x (find-if #'consp '(a (1 2) b)))
(y (find-if #'oddp x)))
(+ y 10))
11
最後に，マクロwith-gensymsはそれ自身がマクロを書くために使われる．
多くのマクロ定義はgensymの生成から始まるが，それは時としてかなりの数に昇る．
マクロwith-redraw (p. 115)では5個だった．
(defmacro with-redraw ((var objs) &body body)
(let ((gob (gensym))
(x0 (gensym)) (y0 (gensym))
(x1 (gensym)) (y1 (gensym)))
...))
このようなマクロ定義は，with-gensymsによって簡潔になる．
これはリスト内の変数を全てgensymに束縛するものだ．
このマクロを使えば，ただ次のように書けばよい．
(defmacro with-redraw ((var objs) &body body)
(with-gensyms (gob x0 y0 x1 y1)
...))
この新マクロは以降の章を通じて使われる．
幾つかの変数を束縛し，その後何かの条件に基づいて式の組の中の1つを評価したいとき，
let内でただ条件判断を使っていた．
(let ((sun-place 'park) (rain-place 'library))
(if (sunny)
(visit sun-place)
(visit rain-place)))
残念なことに，逆の状況には便利な慣用法が存在しない． つまり実行したいコードは常に同じだが，束縛が何かの条件によって変化するときだ．
(defmacro condlet (clauses &body body)
(let ((bodfn (gensym))
(vars (mapcar #'(lambda (v) (cons v (gensym)))
(remove-duplicates
(mapcar #'car
(mappend #'cdr clauses))))))
`(labels ((,bodfn ,(mapcar #'car vars)
,@body))
(cond ,@(mapcar #'(lambda (cl)
(condlet-clause vars cl bodfn))
clauses)))))
(defun condlet-clause (vars cl bodfn)
`(,(car cl) (let ,(mapcar #'cdr vars)
(let ,(condlet-binds vars cl)
(,bodfn ,@(mapcar #'cdr vars))))))
(defun condlet-binds (vars cl)
(mapcar #'(lambda (bindform)
(if (consp bindform)
(cons (cdr (assoc (car bindform) vars))
(cdr bindform))))
(cdr cl)))
\caption{condとletとの組み合せ．}
\label{fig:CondLet}
第\ref{fig:CondLet}図にはそのような状況のためのマクロを示した．
名前から分かるように，condletはcondとletとの合の子のような働きをする．
これは束縛指定の節と，その次の実行本体部を引数に取る．
それぞれの束縛節はテスト式によって守られている．
コード本体部はテスト式が真を返した最初の節に指定された束縛の下で評価される．
一部の節にのみ含まれる変数は，真となった節が束縛を指定していなければnilに束縛される．
> (condlet (((= 1 2) (x (princ 'a)) (y (princ 'b)))
((= 1 1) (y (princ 'c)) (x (princ 'd)))
(t (x (princ 'e)) (z (princ 'f))))
(list x y z))
CD
(D C NIL)
condletの定義はour-letの定義の一般化として捉えられる．
後者は本体部を関数に変え，その関数が初期値を決める式の評価結果に適用されるようにする．
condletはlabelsを使ってローカルな関数を定義しているコードに展開される．
その中では初期値を決める式のどの組が評価されて関数に渡されるかをcond節が決めるようになっている．
展開コードは束縛指定節から変数名を抽出するために
mapcanでなくmappendを使っていることに注意しよう．
これはmapcanが破壊的であって，第10.3章で警告したように，
引数のリスト構造に変更を加えることは危険だからだ．
with-系マクロレキシカル環境の他に，もう1種のコンテキストがある． そのコンテキストとは，広い意味で世界の状態のことを指す． これはスペシャル変数の値，データ構造体の内容，Lisp外部の事物の状態を含む． この種のコンテキストを作り出すオペレータも， コード本体がクロージャとしてまとめられていない限り，やはりマクロとして定義されなければならない．
コンテキスト生成マクロの名前はしばしばwith-で始まる．
この種のマクロの中で一番よく使われるのは多分with-open-fileだろう．
その本体は新しく開かれたファイルが指定の変数に束縛された状態で評価される．
(with-open-file (s "dump" :direction :output) (princ 99 s))
この式の評価後にはファイル「dump」は自動的に閉じられ，中身は2文字「99」となっているだろう．
このオペレータはsを束縛するので，明らかにマクロとして定義されなければならない．
しかし式を新しいコンテキスト内で評価させるようなオペレータは，
とにかくマクロとして定義されなければならないのだ．
マクロignore-errorsはCLtL2で新たに追加されたものだが，
これはその引数がprogn内にあるかのように評価されるようにする．
いずれかの時点でエラーが発生すると，式ignore-errors全体がnilを返す．
(これは，例えばユーザの入力したテキストを読み込む際などに便利だ．)
ignore-errorsは変数を作る訳ではないが，マクロとして定義されなければならない．
その引数が新しいコンテキスト内で評価されるからだ．
一般的に言って，コンテキストを生成するマクロはコードのブロックに展開される．
本体の前，後，または両方に式が付加されるかもしれない．
そのコードが本体の前に来たときは，その目的はシステムを定常状態に保つことかも知れない
---つまり何らかの後始末だ．
例えばwith-open-fileは，自分が開いたファイルを閉じなければならない．
そのような状況下では，unwind-protectに展開されるコンテキスト生成マクロを作るのが定石だ．
unwind-protectの目的は，プログラムの実行が割り込みされたときであっても，
ある式が必ず評価されるようにすることだ．
それは1個以上の引数を取り，それらが順に評価される．
何事もなければprog1と同様に第1引数の値を返す．
それとの違いは，第1引数の評価がエラーやthrowによって中断されたときでさえも，
残りの引数が評価される点だ．
> (setq x 'a)
A
> (unwind-protect
(progn (princ "What error?")
(error "This error."))
(setq x 'b))
What error?
>>Error: This error.
式unwind-protect全体としてはエラーを返す．
しかしトップレベルに戻った後には，第2引数も評価されていたことに気が付く：
> x B
これはwith-open-fileがunwind-protectに展開されたことで，
本体の評価中にエラーが起きても普通なら開かれたファイルが閉じられるからだ．
コンテキスト生成マクロは，大抵は特定の用途のために作られる．
例として，複数の遠隔データベースを扱うプログラムを書いているとしよう．
プログラムはグローバル変数*db*で指定されるデータベース1個ずつに命令する．
データベースの使用前には，他人が同時に使うことがないようにそれをロックしなければならない．
また作業が済んだらロックを解除しなければならない．
データベースdbのクエリqの値が欲しいときは，次のようにするだろう．
(let ((temp *db*))
(setq *db* db)
(lock *db*)
(prog1 (eval-query q)
(release *db*)
(setq *db* temp)))
マクロを使えば煩わしい作業を全て隠蔽できる．
第\ref{fig:TypicalWithMacro}図では，
高い抽象化レベルでデータベースを扱えるようにしてくれるマクロを定義した．
with-dbを使えば，ただこうするだけでよい．
(with-db db (eval-query q))
with-dbは単なるprog1でなくunwind-protectに展開されるので，
安全に呼び出せる．
(defmacro with-db (db &body body)
(let ((temp (gensym)))
`(let ((,temp *db*))
(unwind-protect
(progn
(setq *db* ,db)
(lock *db*)
,@body)
(progn
(release *db*)
(setq *db* ,temp))))))
マクロと関数との組合せ：
(defmacro with-db (db &body body)
(let ((gbod (gensym)))
`(let ((,gbod \#'(lambda () ,@body)))
(declare (dynamic-extent ,gbod))
(with-db-fn *db* ,db ,gbod))))
(defun with-db-fn (old-db new-db body)
(unwind-protect
(progn
(setq *db* new-db)
(lock *db*)
(funcall body))
(progn
(release *db*)
(setq *db* old-db))))
\caption{典型的なwith-系マクロ．}
\label{fig:TypicalWithMacro}
第\ref{fig:TypicalWithMacro}図内の2つのwith-dbの定義は，
この種のマクロの2通りの書き方の可能性を示している．
1番目は純粋なマクロで，2番目は関数とマクロとの組み合わせだ．
実現したいwith-系マクロが複雑になるに連れ，2番目の手法の方が実用的になる．
CLtL2準拠のCommon Lisp処理系では，
宣言dynamic-extentによって本体部を括るクロージャが効率的に割り当てられるようにできる
（CLtL1準拠の処理系では無視される）．
このクロージャはwith-db-fnを呼んでいる間だけ必要なので，その通りのことを宣言すれば，
必要なメモリ空間をコンパイラにスタック上に割り当てさせることができる．
この空間は後でガーベジ・コレクタに回収されるのではなく，式から出るときに自動的に回収される．
マクロ呼び出し内の引数を，ある条件が成立するときだけ評価したいことがある．
これは，引数を必ず評価することになっている関数にはできないことだ．
if，andやcondのような組込みオペレータは引数の幾つかを保護していて，
他の引数がある値を返さない限り評価しない．
例えば次の式では，
(if t 'phew
(/ x 0))
第3引数は評価されると「ゼロ除算」エラーを引き起こす．
しかし1，2番目の引数だけが評価されることになるので，if全体としては常に安全にphewを返す．
(defmacro if3 (test t-case nil-case ?-case)
`(case ,test
((nil) ,nil-case)
(? ,?-case)
(t ,t-case)))
(defmacro nif (expr pos zero neg)
(let ((g (gensym)))
`(let ((,g ,expr))
(cond ((plusp ,g) ,pos)
((zerop ,g) ,zero)
(t ,neg)))))
\caption{条件付き評価のためのマクロ．}
\label{fig:MacrosForCondEval}
このようなオペレータを新しく書くには，既存のこのようなオペレータに展開されるようなマクロを書けばよい．
第\ref{fig:MacrosForCondEval}には，ifの考え得る多くの変種のうち2つを示した．
if3の定義は，三値論理のための条件判断を定義する方法を示している．
nilを偽，そのほか全てを真とするのではなく，
このマクロは真理の3種類の度合を考慮する：
真，偽，そして ? で表される可能だ．
これは5歳の子供を描写する際に次のように使えるかも知れない．
(while (not sick)
(if3 (cake-permitted)
(eat-cake)
(throw 'tantrum nil)
(plead-insistently)))
この新しい条件判断オペレータはcaseに展開される．
(キーnilはリストに括らなければならない．
nil単独では意味があいまいになるからだ．)
最後の3つの引数は，第1引数の値に従ってどれか1つだけが評価される．
nifという名前は「numeric if（数値的if）」から来ている．
別の実装方法はbnmページに示した．
これは数値の式を第1引数に取り，その符号に従って残り3つの引数のどれかを評価する．
> (mapcar #'(lambda (x)
(nif x 'p 'z 'n))
'(0 1 -1))
(Z P N)
(defmacro in (obj &rest choices)
(let ((insym (gensym)))
`(let ((,insym ,obj))
(or ,@(mapcar #'(lambda (c) `(eql ,insym ,c))
choices)))))
(defmacro inq (obj &rest args)
`(in ,obj ,@(mapcar #'(lambda (a)
`',a)
args)))
(defmacro in-if (fn &rest choices)
(let ((fnsym (gensym)))
`(let ((,fnsym ,fn))
(or ,@(mapcar #'(lambda (c)
`(funcall ,fnsym ,c))
choices)))))
(defmacro >case (expr &rest clauses)
(let ((g (gensym)))
`(let ((,g ,expr))
(cond ,@(mapcar #'(lambda (cl) (>casex g cl))
clauses)))))
(defun >casex (g cl)
(let ((key (car cl)) (rest (cdr cl)))
(cond ((consp key) `((in ,g ,@key) ,@rest))
((inq key t otherwise) `(t ,@rest))
(t (error "bad >case clause")))))
\caption{条件付き評価のためのマクロ．}
\label{fig:MacrosForCondEval2}
第\ref{fig:MacrosForCondEval2}図には，条件付き評価の利点を生かしたマクロを更に幾つか示した．
マクロinは集合への所属関係を効率的に調べるものだ．
あるオブジェクトが幾つかのオブジェクトの中のどれかと同じものか調べたいとき，
その問は選言（訳注：いわゆるor）として表現できる．
(let ((x (foo))) (or (eql x (bar)) (eql x (baz))))
または同じ事を集合への所属関係としても表現できる．
(member (foo) (list (bar) (baz)))
後者の方が抽象的だが，非効率的だ．
memberを使った式には2つの理由で不必要なコストがかかる．
これはオブジェクトの集合をmemberが調べるためにリストに括らなければならないので，
コンシングを起こす．
そしてオブジェクトの集合をリストに括るためにはそれらを全て評価しなければならないが，
中には全く必要でない値もある．
(foo)の値が(bar)の値に等しければ，(baz)を評価する必要はない．
概念としてはどれ程優れていても，このようにmemberを使うのはよい方法ではない．
同様な抽象化はマクロによればより効率的に実現できる．
inはmemberの抽象性とorの効率性を併せ持ったものだ．
inを使った等価な式はmemberの式と同じ形をしている．
(in (foo) (bar) (baz))
しかしこれは次のように展開される．
(let ((#:g25 (foo)))
(or (eql #:g25 (bar))
(eql #:g25 (baz))))
よくあることだが，慣用法の明確なものと効率的なものとの間の選択に直面したときは， 前者を後者に変換するマクロを書くことでディレンマの角を抜けることができる （訳注：「どちらかの選択」に実は第3の道があること）．
inqは"in queue"と発音するが，これはクォートを使うinの変種で，
これを使うのはsetの代わりにsetqを使うようなものだ．
次の式は，
(inq operator + - *)
次のように展開される．
(in operator '+ '- '*)
memberのデフォルト動作と同様に，inとinqは同一性の判断にeqlを使う．
判断に他のオペレータを使いたいなら ---1個の引数を取る関数なら何でもよいが---
更に一般的なin-ifを使うとよい．
in-ifとsomeとの関係はちょうどinとmemberとの関係と同じだ．
次の式は，
(member x (list a b) :test #'equal)
次のように書き換えられる．
(in-if #'(lambda (y) (equal x y)) a b)
同様に次の式は，
(some #'oddp (list a b))
次のようになる．
(in-if #'oddp a b)
condとinを組み合わせることで，caseの便利な変種が定義できる．
Common Lispのマクロcaseのキーが定数であることを前提にしている．
しかしcaseの動作が欲しいが，キーを評価して欲しいときもある．
>caseはそのような場合のために作られた．
これはcaseと似ているが，それぞれの節を保護するキーが比較前に評価されるようになっている．
(名前の「 > 」は矢印が評価を表すつもりで付けられた．)
>caseはinを使っているので，必要以上のキーは評価しない．
キーはLispの式であってもよいので，
(x y)が関数やマクロの呼び出しなのか2つのキーから成るリストなのか判断が付かない．
曖昧さをなくすため，（t以外の）キーは，
1つしかない場合でも必ずリストに括られていなければならない．
caseの場合，曖昧であるためにnilは節のcar部になってはいけなかった．
>caseでは，nilは節のcar部として曖昧ではない．
しかしそうすると節の残りが決して評価されないことになる．
明確さのため，
それぞれの>case節の展開形を生成するコードは独立した関数>casexとして定義された．
>casex自身もinqを使っていることに注意しよう．
関数にまつわる問題が，引数が必ず評価されることではなく，引数が1回しか評価されないことであるときもある． 関数の引数はどれもきっかり1回だけ評価されるので， 本体となる式を取ってそれを反復評価するオペレータを定義したければ， それをマクロとして定義するしかない．
一番単純な例は，引数を順番に永遠に評価し続けるマクロだろう．
(defmacro forever (&body body)
`(do ()
(nil)
,@body))
これはちょうど組込みマクロloopにキーワードを与えなかったときの動作だ．
永遠の繰り返しには大した将来性はないように思える（むしろ将来に渡って続き過ぎる）．
しかしblockやreturn-fromと組み合わせれば，
この種のマクロが，中断は緊急時のみであるようなループを表現するための一番自然な方法になる．
(defmacro while (test &body body)
`(do ()
((not ,test))
,@body))
(defmacro till (test &body body)
`(do ()
(,test)
,@body))
(defmacro for ((var start stop) &body body)
(let ((gstop (gensym)))
`(do ((,var ,start (1+ ,var))
(,gstop ,stop))
((> ,var ,gstop))
,@body)))
\caption{単純な反復用マクロ．}
\label{fig:SimpleIterMacro}
反復のためのマクロの単純な例を幾つか第\ref{fig:SimpleIterMacro}に示した．
whileはすでに見たものだ(p. vom)．
この本体部はテスト式が真を返す間中評価され続ける．
tillはそれと対をなすもので，テスト式が偽を返す間評価を繰り返す．
最後のforもすでに見た(p. qwe)もので，ある範囲の数に対して反復を行う．
これらのマクロをdoに展開するようにすることで，
その本体部の中でgoやreturnが使えるようになる．
doの持つこの性質はblockとtagbodyから引き継いだものだから，
while，tillとforはdoからやはり引き継ぐことになる．
zxcページで説明したように，
doを囲む暗黙のブロックのタグnilは第\ref{fig:SimpleIterMacro}図のマクロに捕捉される．
この点はバグというより仕様だが，最低でも明記しておくべきだ．
(defmacro do-tuples/o (parms source &body body)
(if parms
(let ((src (gensym)))
`(prog ((,src ,source))
(mapc #'(lambda ,parms ,@body)
,@(map0-n #'(lambda (n)
`(nthcdr ,n ,src))
(1- (length parms))))))))
(defmacro do-tuples/c (parms source &body body)
(if parms
(with-gensyms (src rest bodfn)
(let ((len (length parms)))
`(let ((,src ,source))
(when (nthcdr ,(1- len) ,src)
(labels ((,bodfn ,parms ,@body))
(do ((,rest ,src (cdr ,rest)))
((not (nthcdr ,(1- len) ,rest))
,@(mapcar #'(lambda (args)
`(,bodfn ,@args))
(dt-args len rest src))
nil)
(,bodfn ,@(map1-n #'(lambda (n)
`(nth ,(1- n)
,rest))
len))))))))))
(defun dt-args (len rest src)
(map0-n #'(lambda (m)
(map1-n #'(lambda (n)
(let ((x (+ m n)))
(if (>= x len)
`(nth ,(- x len) ,src)
`(nth ,(1- x) ,rest))))
len))
(- len 2)))
\caption{部分リストに渡る再帰のためのマクロ．}
\label{fig:MacroForIterBySubSeq}
さらに強力な反復構造を定義する必要があるときにはマクロは必要不可欠だ．
第\ref{fig:MacroForIterBySubSeq}図にはdolistの一般化を2つ示した．
両方とも変数の組をリストの隣り合った部分リストに束縛した状態で本体部を評価する．
例えばdo-tuples/oは引数を2つ取り，リストの要素に渡って反復を行う．
> (do-tuples/o (x y) '(a b c d)
(princ (list x y)))
(a b)(b c)(c d)
nil
同じ引数に対してはdo-tuples/cも同じ動作をするが，こちらはリスト末尾で先頭につながる．
> (do-tuples/c (x y) '(a b c d)
(princ (list x y)))
(a b)(b c)(c d)(d a)
nil
どちらのマクロも本体内で陽にreturnが使われない限りnilを返す．
この種の反復は経路の概念を何らかの形で扱うプログラムでしばしば必要になる．
名前の末尾の/oと/cは，
それぞれが開いた(open)経路と閉じた(closed)経路を探索することを表すつもりで付けられた．
例えばpointsが点のリストで，(drawline x y)がxとyとの間に線分を描くものとしよう．
最初の点から最後の点まで折れ線を描くにはこうすればよい．
(do-tuples/o (x y) points (drawline x y))
しかしpointsが多角形の頂点のリストだったら，その外周を描くにはこうすればよい．
(do-tuples/c (x y) points (drawline x y))
第1引数として渡された引数のリストは任意の長さでよく，反復はその長さと同数の変数の組に渡って行われる．
引数が1個だけのときは，共にdolistに縮退する．
> (do-tuples/o (x) '(a b c) (princ x)) abc NIL > (do-tuples/c (x) '(a b c) (princ x)) ABC NIL
do-tuples/cの定義はdo-tuples/oより複雑になっている．
これはリスト末尾に届いたときに先頭につながるようにしているせいだ．
$n$個の引数があれば，do-tuples/cは値を返す前に$n-1$回余計に反復を行わなければならない．
> (do-tuples/c (x y z) '(abcd)
(princ (list x y z)))
(A B C)(B C D)(C D A)(D A B)
NIL
> (do-tuples/c (wxyz)'(abcd)
(princ (list w x y z)))
(A B C D)(B C D A)(C D A B)(D A B C)
NIL
do-tuples/cの呼び出しの1つ目の展開形は第\ref{fig:Expansiondo-tuples/c}に示した．
生成し辛いのは，リスト先頭へつながることを表す呼び出しの連続だ．
これらの呼び出しは（この場合はそれらのうち2つ）dt-argsによって生成される．
(do-tuples/c (x y z) '(a b c d)
(princ (list x y z)))
は次のように展開される：
(let ((\#:g2 '(a b c d)))
(when (nthcdr 2 \#:g2)
(labels ((\#:g4 (x y z)
(princ (list x y z))))
(do ((\#:g3 \#:g2 (cdr \#:g3)))
((not (nthcdr 2 \#:g3))
(\#:g4 (nth 0 \#:g3)
(nth 1 \#:g3)
(nth 0 \#:g2))
(\#:g4 (nth 1 \#:g3)
(nth 0 \#:g2)
(nth 1 \#:g2))
nil)
(\#:g4 (nth 0 \#:g3)
(nth 1 \#:g3)
(nth 2 \#:g3))))))
\caption{do-tuples/cの呼び出しの展開形．}
\label{fig:Expansiondo-tuples/c}
(defmacro mvdo* (parm-cl test-cl &body body)
(mvdo-gen parm-cl parm-cl test-cl body))
(defun mvdo-gen (binds rebinds test body)
(if (null binds)
(let ((label (gensym)))
`(prog nil
,label
(if ,(car test)
(return (progn ,@(cdr test))))
,@body
,@(mvdo-rebind-gen rebinds)
(go ,label)))
(let ((rec (mvdo-gen (cdr binds) rebinds test body)))
(let ((var/s (caar binds)) (expr (cadar binds)))
(if (atom var/s)
`(let ((,var/s ,expr)) ,rec)
`(multiple-value-bind ,var/s ,expr ,rec))))))
(defun mvdo-rebind-gen (rebinds)
(cond ((null rebinds) nil)
((< (length (car rebinds)) 3)
(mvdo-rebind-gen (cdr rebinds)))
(t(cons (list (if (atom (caar rebinds))
'setq
'multiple-value-setq)
(caar rebinds)
(third (car rebinds)))
(mvdo-rebind-gen (cdr rebinds))))))
\caption{多値に対応したdo*．}
\label{fig:MultiValBindDostar}
組込みマクロdoの歴史は多値よりも古い．
幸いdoは新しい状況に適応するように進化することができる．
Lispの進化はプログラマの手の中にあるからだ．
第\ref{fig:MultiValBindDostar}には多値に対応したdo*の変種を示した．
mvdo*を使えば，始めの節は複数個の変数を束縛できる．
> (mvdo* ((x 1 (1+ x))
((y z) (values 0 0) (values z x)))
((> x 5) (list x y z))
(princ (list x y z)))
(1 0 0)(2 0 2)(3 2 3)(4 3 4)(5 4 5)
(6 5 6)
この種の反復は，例えばインタラクティブなグラフィックス・プログラムで便利になる． それにはしばしば座標や領域などの複数の数量を扱う必要があるからだ．
単純なインタラクティブ・ゲームを書きたいとしよう．
目的は追ってくる2個の敵に挟まれるのを避けることだ．
敵が同時にぶつかってきたら，ゲームは負け．
それぞれ単独でぶつかると，勝ちになる．
第\ref{fig:GameSquash}図には，このゲームのメイン・ループをmvdo*を使って書く方法を示した．
(mvdo* (((px py) (pos player) (move player mx my))
((x1 y1) (pos obj1) (move obj1 (- px x1)
(- py y1)))
((x2 y2) (pos obj2) (move obj2 (- px x2)
(- py y2)))
((mx my) (mouse-vector) (mouse-vector))
(win nil (touch obj1 obj2))
(lose nil (and (touch obj1 player)
(touch obj2 player))))
((or win lose) (if win 'win 'lose))
(clear)
(draw obj1)
(draw obj2)
(draw player))
(pos obj)は2つの値xとyを返す．
これらはobjの位置を示す．
最初は，3つの物体はランダムな位置に置かれる．
(move obj dx dy)は
オブジェクトobjの型とヴェクタdx, dyに従って
objを移動させる．
新しい位置を示す2つの値xとyを返す．
(mouse-vector)はマウスの現在の位置を示す2つの値dxとdyを返す．
(touch obj1 obj2)は，obj1とobj2が接触しているならば真を返す．
(clear)はゲーム領域を消去する．
(draw obj)はobjを現在位置に従って描画する．
またローカル変数を並列して束縛するmvdoを書くこともできる．
> (mvdo ((x 1 (1+ x))
((y z) (values 0 0) (values z x)))
((> x 5) (list x y z))
(princ (list x y z)))
(1 0 0)(2 0 1)(3 1 2)(4 2 3)(5 3 4)
(6 4 5)
(defmacro mvpsetq (&rest args)
(let* ((pairs (group args 2))
(syms (mapcar #'(lambda (p)
(mapcar #'(lambda (x) (gensym))
(mklist (car p))))
pairs)))
(labels ((rec (ps ss)
(if (null ps)
`(setq
,@(mapcan #'(lambda (p s)
(shuffle (mklist (car p))
s))
pairs syms))
(let ((body (rec (cdr ps) (cdr ss))))
(let ((var/s (caar ps))
(expr (cadar ps)))
(if (consp var/s)
`(multiple-value-bind ,(car ss)
,expr
,body)
`(let ((,@(car ss) ,expr))
,body)))))))
(rec pairs syms))))
(defun shuffle (x y)
(cond ((null x) y)
((null y) x)
(t (list* (car x) (car y)
(shuffle (cdr x) (cdr y))))))
\caption{多値に対応したpsetq．}
\label{fig:MultiValPsetq}
doの定義にpsetqが必要な点についてはasdページで説明した．
mvdoを定義するには，多値に対応したpsetqが必要だ．
そういうものはCommon Lispにはないので，自分で書かなければならない．
それを第\ref{fig:MultiValPsetq}に示した．
この新しいマクロは次のように動作する．
> (let ((w 0) (x 1) (y 2) (z 3))
(mvpsetq (w x) (values 'a 'b) (y z) (values w x))
(list wxyz))
(A B 0 1)
mvpsetqの定義は3つのユーティリティ関数に依存している：
mklist (p. sdf)，group (p. dfg)に，ここで定義したshuffleだ．
それは2つのリストを交互に組み合わせる働きをする．
> (shuffle '(a b c) '(1 2 3 4)) (A 1 B 2 C 3 4)
(defmacro mvdo (binds (test &rest result) &body body)
(let ((label (gensym))
(temps (mapcar #'(lambda (b)
(if (listp (car b))
(mapcar #'(lambda (x)
(gensym))
(car b))
(gensym)))
binds)))
`(let ,(mappend #'mklist temps)
(mvpsetq ,@(mapcan #'(lambda (b var)
(list var (cadr b)))
binds
temps))
(prog ,(mapcar #'(lambda (b var) (list b var))
(mappend #'mklist (mapcar #'car binds))
(mappend #'mklist temps))
,label
(if ,test
(return (progn ,@result)))
,@body
(mvpsetq ,@(mapcan #'(lambda (b)
(if (third b)
(list (car b)
(third b))))
binds))
(go ,label)))))
\caption{多値の束縛に対応したdo．}
\label{fig:MultiBindDo}
mvpsetqを使い，mvdoは第\ref{fig:MultiBindDo}図のように書ける．
condletと同様，元のマクロ呼び出しに変更を加えるのを避けるため，
このマクロはmapcarではなくmappendを使っている．
慣用法mappend-mklistはツリーを1段階だけ平たくする．
> (mappend #'mklist '((a b c) d (e (f g) h) ((i)) j)) (ABCDE(FG)H(I)J)
このかなり大きなマクロの理解を助けるため，第\ref{fig:ExpansionOfMvdo}図には展開形の例も示した．
(mvdo ((x 1 (1+ x))
((y z) (values 0 0) (values z x)))
((> x 5) (list x y z))
(princ (list x y z)))
これは次のように展開される：
(let (#:g2 #:g3 #:g4)
(mvpsetq #:g2 1
(#:g3 #:g4) (values 0 0))
(prog ((x #:g2) (y #:g3) (z #:g4))
#:g1
(if (> x 5)
(return (progn (list x y z))))
(princ (list x y z))
(mvpsetq x (1+ x)
(y z) (values z x))
(go #:g1)))
\caption{mvdoの呼び出しの展開形．}
\label{fig:ExpansionOfMvdo}
引数を評価から保護する方法はマクロだけではない．
引数をクロージャで括る方法もある．
条件付き評価と反復評価は，どちらも本質的にマクロが必要な訳ではないので，似たようなものだ．
例えばifを関数として書くことができる．
(defun fnif (test then &optional else)
(if test
(funcall then)
(if else (funcall else))))
then部とelse部に当たる引数はクロージャとして表現することで保護できる． だから次のようにはせず，
(if (rich) (go-sailing) (rob-bank))
代わりに次のようにすることになる．
(fnif (rich)
#'(lambda () (go-sailing))
#'(lambda () (rob-bank)))
ただ条件付き評価だけを実現したいなら，マクロが絶対必要というわけではない． マクロはプログラムを明確にしてくれるだけだ． しかし引数の式の中身を切り分けたり，引数として渡された変数を束縛するためにはマクロが必要になる．
同じことが反復用のマクロにも当てはまる．
マクロは本体部の式の前に反復構造を定義する唯一の方法だが，
ループ本体が関数そのもので括られている限り，関数で反復を実現できる
\footnote{引数を関数に括る必要のない反復用関数を書くのは不可能ではない．
引数として渡された式でevalを呼ぶ関数が定義できる．
それがevalの使いかたとして良くないことの説明には，werページを参照．}．
例えば組込み関数mapcはdolistの関数版だ．
(dolist (b bananas) (peel b) (eat b))
この式は次と同じ副作用を持つ．
(mapc #'(lambda (b)
(peel b)
(eat b))
bananas)
(ただし前者はnilを，後者はリストbananasを返すが．)
同様にforeverも，
式本体をクロージャとして渡すようにすれば関数として実装できる．
(defun forever (fn)
(do ()
(nil)
(funcall fn)))
しかしforeverでもそうだが，反復構造は普通は反復だけが目的なのではない．
束縛と反復の組み合わせが目的なのが普通だ．
関数を使うと，束縛の方の見込みは限られる．
変数をリストの隣り合う要素にそれぞれ束縛したいときには，対応関数のどれかを使えばよい．
しかし要求されることがずっと込み入ってくると，マクロを書かざるを得ないだろう．