once-onlyマクロの解読

実践Common Lisp p100にあるonce-onlyマクロの解読に挑戦．

　
　
　

マクロのコードは以下のとおり．

(defmacro onece-only ((&rest names) &body body)
  (let ((gensyms (loop for n in names collect (gensym))))
    `(let (,@ (loop for g in gensyms collect `(,g (gensym))))
       `(let (,,@ (loop for g in gensyms for n in names collect ``(,,g ,,n)))
          ,(let (,@ (loop for n in names for g in gensyms collect `(,n ,g)))
                ,@body)))))

一行ずつ解読していく

まずは

(let ((gensyms (loop for n in names collect (gensym))))

の部分から．
バッククォートがないので何がgensymsに束縛されるかをREPLで確かめる．

CL-USER> (let ((gensyms (loop for n in '(a b c) collect (gensym))))
           gensyms)
(#:G884 #:G885 #:G886)

namesの数と同じだけのユニークなシンボルを作成している． 　
　
次の行は

`(let (,@ (loop for g in gensyms collect `(,g (gensym))))

gensymsは一行目の処理でユニークなシンボルのリストになっている．
gensymsのそれぞれの要素と(gensym)をペアにしていく．
ここまでを実行してみる．

CL-USER> (let ((gensyms (loop for n in '(a b c) collect (gensym))))
           `(let (,@ (loop for g in gensyms collect `(,g (gensym))))))
(LET ((#:G887 (GENSYM)) (#:G888 (GENSYM)) (#:G889 (GENSYM)))
  )

　
三行目．

`(let (,,@ (loop for g in gensyms for n in names collect ``(,,g ,,n)))

とうとう`,が二重に．
１つずつ見ていく． 二行目の`(let　の式の中で `(letとなっているのでここは出力後の形が`(letとなってほしいはず．
,,@となっているのは二行目のバッククォート，三行目頭のバッククォートと二回バッククォートされているので 二度展開しなといloopが展開されない． これでloop内は展開されるようになった． 次は``(,,g ,,n)．二重にバッククォートするのは先ほどと同じように`(foo bar) という形のリストにしたいから．
(,,g ,,n)になっているのはloopでgensymsの要素をgに，namesの要素をnに対応付けているから．
`(,gensymsの要素 ,nameの要素)という形に変換しようとしている．
　　
ここまでを展開するとこうなる

CL-USER> (let ((names '(a b c)))
           (let ((gensyms (loop for n in names collect (gensym))))
             `(let (,@(loop for g in gensyms collect `(,g (gensym))))
                `(let (,,@ (loop for g in gensyms for n in names collect ``(,,g ,,n)))
                   ))))
(LET ((#:G937 (GENSYM)) (#:G938 (GENSYM)) (#:G939 (GENSYM)))
  `(LET (,`(,#:G937 ,A) ,`(,#:G938 ,B) ,`(,#:G939 ,C))
     ))

コンパイル時には新たに(gensym)で作られたユニークなシンボルにnamesの値が束縛されるようになる．
　
　
最後に４行目．

,(let (,@ (loop for n in names for g in gensyms collect `(,n ,g)))

二行目と三行目でバッククォートされてるので,先頭のカンマは展開されず(let ...という形になる．
,@の部分は既に先頭で一度カンマがあった後なのでそのまま展開出来る．
`(,n ,g)の部分で実際にAにAの値を束縛するという部分を作る．
なのでここではバッククォートが一つ．
ここのgには３行目で値に束縛したユニークなシンボルが入る．
実際に展開する．
最後なのですべて展開するとこうなる.

CL-USER> (let ((names '(a b c))
               (body '(body)))
           (let ((gensyms (loop for n in names collect (gensym))))
             `(let (,@(loop for g in gensyms collect `(,g (gensym))))
                `(let (,,@ (loop for g in gensyms for n in names collect ``(,,g ,,n)))
                   ,(let (,@ (loop for n in names for g in gensyms collect `(,n ,g)))
                         ,@body)))))
(LET ((#:G934 (GENSYM)) (#:G935 (GENSYM)) (#:G936 (GENSYM)))
  `(LET (,`(,#:G934 ,A) ,`(,#:G935 ,B) ,`(,#:G936 ,C))
     ,(LET ((A #:G934) (B #:G935) (C #:G936))
        BODY)))

まとめ

まずnamesと同じ数だけ(gensym)でユニークなシンボルを作り，それをgensymsというリストにする．
gensymsの各要素を新たに(gensym)に束縛するlet式を作る．
この(gensym)はonce-onlyを使うマクロの展開時に新しくユニークなシンボルを作る．
gensymsの各要素を評価すると新しく作られるユニークなシンボルを返すようになる． このユニークなシンボルにnamesの各値を束縛するようにする．
それが本体の三行目に当たる． 四行目ではnamesのシンボルにgensymsの各要素を対応付ける．
gensymsの各要素は新たに作られたユニークなシンボルに束縛され，そのユニークなシンボルはnameの値に束縛される．
以上で終わり． 　
　
高階マクロで名前の衝突を回避して，評価順序を保つのはこんなに大変なんですね．