Common Lispでリードマクロしてみた

common lispではマクロによって式を変形することでプログラムを柔軟に書くことができる．今回はリードマクロを使って，便利なデバッグプリントを実装したい．

柔軟なマクロ，それがリードマクロ

一般的なマクロは通常の関数呼び出しと同じように(マクロ名 引数 ...)といった形をとるが，より柔軟に式を表現したいときもあろう．リードマクロというものを使うと，ある特定の文字をトリガーとして，文字列を扱うように自由に式を書き換えることができる．

• 一般的なマクロ
  • S式を受け取ってS式を生成する
• リードマクロ
  • 入力ストリームを好きなだけ消費しながらS式を生成する

以下のコードを見てほしい．

#?x
; => (let ((a x)) (fresh-line *error-output*) (format *error-output* "DEBUG: ~S~%" a) a)

今回はこのような式変形を行いたい．formatによってデバッグプリントを行いつつ，式自体はその値を返すといったものだ． またここで敢えてxをaに代入するのは，xが二度評価されないようにするためである．マクロを作るときは，評価されていない生のシンボルを触っていることに注意する必要がある．

定義方法が2種類あります

Common Lispでリードマクロを定義するには，set-macro-characterとset-dispatch-macro-characterのどちらかを選ぶことができる．前者は特定の1文字をトリガーとすることができ，後者は特定の2文字(トリガー文字1つと，数字もしくは数字でない文字1つ)をトリガーにすることができる．

• set-macro-character
  • リードマクロを定義する
  • 1文字がトリガー
  • 例: 'x => (quote x)
  • 2引数の関数を割り当てる
    • stream, 割り当て文字が渡される
• set-dispatch-macro-character
  • ディスパッチング・リードマクロを定義する
  • 特殊な形式
    • 文字2つと中置パラメータ(数値のみ，オプショナル)1つをとる形式にできる
  • 3引数の関数を割り当てる
    • stream, 割り当て文字2, 中置パラメータ(ない場合はNIL)が渡される
  • 例: #P"foo" => (pathname "foo")．ここで1文字目は#\#，2文字目は#\P，中置パラメータはNIL．
  • 例2: #2A() => rank=2の配列．ここで1文字目は#\#，2文字目は#\A，中置パラメータは2．

今回は#?をトリガーにしたいので，2文字使うことができるset-dispatch-macro-characterを選ぼう．1文字目は#であり，2文字目は?である．中置パラメータは使わない． また，ここから先はディスパッチング・リードマクロを含む概念である広義のリードマクロと，ディスパッチング・リードマクロでない方の，という意味の，狭義のリードマクロという言葉を区別せずに使う． あまり混乱しないように書いているつもりだが，難しかったら教えてほしい．

リードマクロの動作を理解するためにも，実際にリードマクロを割り当てる前に，まずはリードマクロの割り当て先となる関数を定義しよう．

難しい引数の説明は以下の通りだが，まずは次節以降でひととおりリードマクロを作成してみると意味がわかるようになるだろう．

• set-macro-characterでリードマクロを定義するとき
  • (lambda (stream trigger-char) ...) の形式にする
  • 第一引数には，マクロがトリガされた地点より先のソースコードが格納されたstreamが渡される
  • 第二引数には，マクロをトリガした文字が渡される
• set-dispatch-macro-characterでディスパッチング・リードマクロを定義するとき
  • (lambda (stream trigger-char-2 n) ...) の形式にする
  • 第一引数には，set-macro-character同様にstreamが渡される
  • 第二引数として，マクロをトリガした2文字目が渡される
  • 第三引数として，中置パラメータが渡される．中置パラメータがないときは，NILが渡される．

普通の関数をマクロの本体に仕上げていこう

リードマクロの定義といっても怖いことはない．

まずは標準入力を読み込んで，そこからなんらかのS式を生成するような関数を考えてほしい．標準入力のかわりに文字列の入力ストリーム(input string stream)を使うように書き換えれば，それがそのままリードマクロとして動くようにできる．

まずは何も考えず，標準入力から式を読み込んで，意図した式に変形してくれる関数を考えてみよう．

(defun debug-print ()
  (let ((expression (read)))
    (fresh-line *error-output*)
    (format *error-output* "DEBUG: ~S~%" expression)
    expression))

実際に実行するとこういう感じだ．

* (debug-print)
12345 ; 入力
DEBUG: 12345 ; エラー出力

12345 ; 返り値

うまく動いている．これから，この関数をディスパッチング・リードマクロに適した形に変形していこう．

streamをとるようにする

リードマクロは標準入力のかわりにstreamを受け取るので，任意のstreamで処理可能にしよう．ここでやるべきことは，関数が任意のstreamを受け取るようにし，readの引数を変更することだ．

(defun debug-print (stream)
  (let ((expression (read stream t nil t))) ; error-on-eof: t, eof-value: nil, recursive-p: t
    (fresh-line *error-output*)
    (format *error-output* "DEBUG: ~S~%" expression)
    expression))

今やこの関数は任意のstreamで動くようになった．いくつかreadの引数が増えているが，これは

• eofに到達したらエラーにする
• eofに到達した場合の値はnilにする(その前にエラーになるが)
• 再帰的なreadであることを表明する
  • ほとんどの処理系では無視されているようだ．
  • 動作確認を行うために単独で関数を実行するときは，ここをnilにしないとエラーになることがある．

という意味．

トリガー文字をとるようにする

リードマクロにはトリガーとなる文字が必要だが，リードマクロはそれ自体がどの文字をトリガーとして呼び出されたか，引数を通じて知ることができる． このため複雑な挙動をするリードマクロを考えたりできるが，今回はトリガーが1通りしかないので単に無視する． リードマクロの要求に対応するため，関数の引数を増やそう．

(defun debug-print (stream char2 n) ; 3引数に変化
  (declare (ignorable char2 n)) ; 使わないので無視するようにする
  (let ((expression (read stream t nil t))) ; error-on-eof: t, eof-value: nil, recursive-p: t
    (fresh-line *error-output*)
    (format *error-output* "DEBUG: ~S~%" expression)
    expression))

基本骨格はもうここで完成した．あとは，関数を呼び出したときに実際に動作するのではなく，動作するべきS式を返すようにすればよい．

S式を返すようにする

S式を返すという動作自体は一般的なマクロと同じなので，一般的なマクロの知識をここで使うことができる．ここでは，

• 読み取ったS式が二度評価されないように，評価結果を一時変数に束縛するような式を生成する
  • リードマクロはコンパイル前に動作する．リードマクロがreadしたS式はまだ評価されていない状態にある
  • リードマクロがreadしたS式をそのまま変換結果のS式に複数個埋め込むと，複数回評価される
  • 副作用が生じる関数だった場合危険！
• リードマクロがreadした式の内部と，一時変数のシンボル名が干渉しないように，安全なシンボルを動的に生成する
  • gensym関数を利用して，衝突しないことが保証されたシンボルを生成する

というテクニックを使っている．最終的にどのようなS式が欲しいかをイメージしながらマクロを書くとよい．

(defun debug-print (stream char2 n)
  (declare (ignorable char2 n))
  (let ((expression (read stream t nil t)) ; 入力から式を1つ読み取る．1や(quote 1 2 3)，(f x y)などが入っている(評価すると副作用を生じるかもしれない！)
         (expression-evaluated (gensym))) ; 変数名は衝突の危険があるので，gensym関数で安全に生成する．
     ;; ここから生成されるS式の記述が始まる．quasiquote(`)を使ってテンプレートライクに記述する．
    `(let ((,expression-evaluated ,expression)) ; expressionを何度も使うとその都度評価されるような式になってしまい危険なので，いちど内部で一時変数に束縛する．
      (fresh-line *error-output*)
      (format *error-output* "DEBUG: ~S~%" ,expression-evaluated) ; 一時変数をデバッグ出力する．
      ,expression-evaluated))) ; 一時変数を返す．

これが呼び出されると，以下のようなS式が構築される．

* (debug-print *standard-input* nil nil)
(f x) ; 標準入力

(LET ((#:G444 (F X)))
  (FRESH-LINE *ERROR-OUTPUT*)
  (FORMAT *ERROR-OUTPUT* "DEBUG: ~S~%" #:G444)
  #:G444)

生成されたコードは，

• まず(f x)を評価して#:G444というシンボルに束縛する
• *error-output*の行を改める
• エラー出力に#:G444の値を出力する
• #:G444を評価した値を返却する

といったものになっていることがわかる．これにより(f x)は1度だけ評価され，マクロを適用した式本来の動作を妨げない． もし一時変数への束縛を怠ると，以下のような式を使わなければならない．

(PROGN
  (FRESH-LINE *ERROR-OUTPUT*)
  (FORMAT *ERROR-OUTPUT* "DEBUG: ~S~%" (F X)) ; ここでいちど評価される
  (F X)) ; また評価される

このようなコードは，リードマクロが読み込んだS式が数値リテラルや純粋な関数なら問題ないが，副作用のある関数でこのようなことが発生すると不都合だし，純粋な関数でも計算コストが単純に二倍になって嬉しくないということがわかるはずだ．

ディスパッチング・リードマクロとして定義する

さて中身が完成したところで，実際にリードマクロとして使えるように定義しよう． set-dispatch-macro-characterは以下のようにして使う．

(set-dispatch-macro-character
  #\# ; 第一のトリガー文字
  #\? ; 第二のトリガー文字
  #'debug-print) ; 割り当てる関数

こうすると，トリガー文字# ?を読み取ったさいに#'debug-printを実行した結果で読み替えるべし，といったことが処理系のリードテーブルreadtableに格納される．

処理系は式を読み取る(パースする)さいにこのリードテーブルを利用している．この動作をカスタムしようというのがリードマクロが果たす機能である．

処理系のリードテーブルはスペシャル変数*readtable*に格納されている．これがいじられることで読み取り動作が変化するという仕掛けだ．

最終的な形を以下に示そう．

; これが評価されると，以降のコードは#?記法が有効化される．
(defun %enable-debug-print ()
  (setf *readtable* (copy-readtable))
  (set-dispatch-macro-character #\# #\? #'debug-print))

; (enable-debug-print)をコードに書いておくと，コンパイル時に#?記法が有効化される．
; いきなりリードマクロを有効化するのは行儀が悪い．
(defmacro enable-debug-print ()
  '(eval-when (:compile-toplevel :load-toplevel :execute)
    (%enable-debug-print)))

この形は id:m2ym さんの

github.com

を参考にさせていただきました．

なんで*read-table*を複製するのか

http://clhs.lisp.se/Body/f_cp_rdt.htm CLHSによれば，

(setq *readtable* (copy-readtable)) replaces the current readtable with a copy of itself. This is useful if you want to save a copy of a readtable for later use, protected from alteration in the meantime.

ちょっとよくわからなかったので，ここは宿題にしたい．

完成

(defun debug-print (stream char2 n)
  (declare (ignorable char2 n))
  (let ((expression (read stream t nil t))
         (expression-evaluated (gensym)))
    `(let ((,expression-evaluated ,expression))
      (fresh-line *error-output*)
      (format *error-output* "DEBUG: ~S~%" ,expression-evaluated)
      ,expression-evaluated)))

(defun %enable-debug-print ()
  (setf *readtable* (copy-readtable))
  (set-dispatch-macro-character #\# #\? #'debug-print))

(defmacro enable-debug-print ()
  '(eval-when (:compile-toplevel :load-toplevel :execute)
    (%enable-debug-print)))

これを使ったサンプルコードを以下に示す．

(defun factorial (n)
  (if (= #?n 0)
      1
      (* n (factorial (- n 1))) ) )

実行すると以下のようにデバッグメッセージを出力する．

* (factorial 10)
DEBUG: 10
DEBUG: 9
DEBUG: 8
DEBUG: 7
DEBUG: 6
DEBUG: 5
DEBUG: 4
DEBUG: 3
DEBUG: 2
DEBUG: 1
DEBUG: 0

3628800

ここから，デバッグプリント対象の式そのものも表示してあげる，などの改良ができそうだ．

(defun debug-print (stream char1 char2)
  (declare (ignorable char1 char2))
  (let ((expression (read stream t nil t))
         (expression-evaluated (gensym)))
    `(let ((,expression-evaluated ,expression))
      (fresh-line *error-output*)
      (format *error-output* "DEBUG: ~S => ~S~%" ',expression ,expression-evaluated)
      ,expression-evaluated)))

追記(2018/11/13)

set-dispatch-macro-characterについて誤解している旨の指摘があったため，修正します．

既出かもですが一応。
set-dispatch-macro-characterに渡す関数の引数を誤解してらっしゃる。
正しくは(stream char2 number)です。
二次元配列#2A((...))でいうと#\Aと２とを受け取ります。
詳細はリンク先の末尾を参照してください。https://t.co/nzhjCmKdqo

— sin (@hyotang666) November 13, 2018

set-dispatch-macro-characterは3引数の関数を取りますが，その関数には

• stream
• 2文字目のトリガ文字
• 中置パラメータもしくはnil

が渡されるのであって，「streamと1文字目と2文字目が渡される」という説明はまちがっていました．このため記述を修正しました．