Common Lispで遅延評価を作って遊ぶ（4, 完） － 数列生成リードマクロ
今回の目的
第3回（その1、その2）では、作成した数列生成リードマクロでひとしきり遊んでみたわけですが、今回はそのリードマクロの話を書きます。なお、リードマクロそのものについて（浅く）理解した内容については別記事「リードマクロ入門、の10分の1歩ぐらい後か前 - eshamster’s diary」にまとめたので、この記事では淡々と書いていきます。
そろそろ遅延評価関係ないですが…。
作成したリードマクロの目標
目標は次のような数学的な数式の定義に近づけることでした。例によって"amp;"は読み飛ばしてください。
完成形はこんな感じです。
; 関数版でのフィボナッチ数列作成 CL-USER> (make-series '(0 1) (lambda (a n) (+ (lnth (- n 1) a) (lnth (- n 2) a)))) ; 関数版にリードマクロを被せてみた版 CL-USER> #<a[n] = 0, 1, (+ a[n-1] a[n-2])>
はじめからこの形を目指していたわけではなく、次のようにいまいちな部分を順に直していったところこのようになりました。
; スタート (make-series '(0 1) (lambda (a n) (+ (lnth (- n 1) a) (lnth (- n 2) a)))) ; 実装（遅延評価, lnth）が見えてるのはいまいち ; ついでにaとnの順番も数式に合わせる (make-series '(0 1) (lambda (a n) (+ #{a (- n 1)} #{a (- n 2)}))) ; (- n 1)は空白が多くて書きづらい、見づらい (make-series '(0 1) (lambda (a n) (+ #{a #[n-1]} #{a #[n-2]}))) ; なんか#が多くて思ったほど映えない… (make-series '(0 1) (lambda (a n) (+ #{a[n-1]} #{a[n-2]}))) ; 左辺(a n)と右辺a[n-1]で形が違って気持ち悪い ; lambdaキーワードごと変換（※今は動かないコード） (make-series '(0 1) #<a[n] = (+ #{a[n-1]} #{a[n-2]})>) ; 初期値の定義も入れてしまえばいいよね ; そうなるとmake-seriesもいらないか #<a[n] = 0, 1, (+ #{a[n-1]} #{a[n-2]})> ; これはなかなｋ…いや、なんか思ったほどでも… ; あ、やっぱり#が多い #<a[n] = 0, 1, (+ {a[n-1]} {a[n-2]})> ; 今度は{}がジャマな気がする… ; これだ（完成） #<a[n] = 0, 1, (+ a[n-1] a[n-2])>
最後の足し算はS式がむきだしです。a[n-1] + a[n-2]の実現が単に面倒だったということもありますが、S式そのままの方が柔軟に使えるだろうという選択の結果でもあります。第3回で色々遊べたので間違った選択ではなかったように思います。
[]リードマクロ
まずは#[n-1]のような中置記法もどきを可能にしている部分ですが…下記の通り謝罪を要求されるレベルのひどい実装だったりします。こんなでも以前見たように意外と不自由なく遊べましたし、もっとまじめな中置記法の実装はすでに例がある（シンタックスが無ければ作ればいいじゃない[PDF]）のでここは頑張りどころではないか、と思ったので放置しています…。
(defun [-reader (stream &rest rest) (declare (ignore rest)) (let ((lst nil) (*readtable* (copy-readtable *readtable*))) (set-separate-character #\-) (set-separate-character #\*) (set-separate-character #\+) (set-separate-character #\/) (set-macro-character #\] (get-macro-character #\))) (setf lst (read-delimited-list #\] stream t)) (case (length lst) (1 (car lst)) (3 (case (cadr lst) (#\- `(- ,(car lst) ,(caddr lst))) (#\+ `(+ ,(car lst) ,(caddr lst))) (#\/ `(/ ,(car lst) ,(caddr lst))) (#\* `(* ,(car lst) ,(caddr lst))))) (t (error 'simple-error))))) (defun set-separate-character (char) (set-macro-character char #'(lambda (s c) (declare (ignore s c)) char)))
一応解説。#[n]のように要素が一つの場合は、read-delimited-listで(n)を受け取ってnを返します。
要素が三つの場合。まず、set-separate-character関数を使って、-, +, *, /は同名のcharを返すようになっています。例えば、#[n-1]の場合はread-delimited-listから(n #\- 1)というリストが返されます。真ん中の"#\-"をcase文で見て(- n 1)と並べ替えて返します。…以上です。
実装的な部分を見ると、set-separate-characterと対応した処理が分離しているのが気持ち悪いところで、マクロを使ってもっときれいに書けそうですね。
{}リードマクロ
(lnth 1 a)を#{a 1}や#{a[1]}と書いたり、(lnth 1 (lnth (- n 2) b))を#{b[1][n-2]}と書いたりするためのリードマクロです。
(defun {-reader (stream &rest rest) (declare (ignore rest)) (let ((*readtable* (copy-readtable *readtable*)) (pair nil)) (set-macro-character #\} (get-macro-character #\))) (set-macro-character #\[ #'[-reader) (setf pair (read-delimited-list #\} stream t)) (labels ((recursive-lnth (lst) (if (null (cdr lst)) (car lst) `(lnth ,(car lst) ,(recursive-lnth (cdr lst)))))) (recursive-lnth (reverse pair)))))
初めて書いたリードマクロ（[]リードマクロや再帰なしバージョンが）だけあってやっていることは単純です。例えば、#{a 1}の場合、read-delimited-listが(a 1)というリストを返すので、並び替えて頭にlnthをつけて(lnth 1 a)とするだけです。あとはこれに再帰処理を加えて#{a 1 2}を(lnth 1 (lnth 2 a))とできるようにしたり、char文字'['に前述の"[-reader"を設定して#{a[1]}や#{a[n-1]}と書けるようにしたらできあがりです。
こういった再帰や他のリードマクロとの組み合わせが簡単にできるのは素敵です。
<>リードマクロ
未処理のTODOが残っていたりしますが…中身の割に長いコードが以下になります。
(defun <-reader (stream &rest rest) (declare (ignore rest)) (let ((*readtable* (copy-readtable *readtable*)) (buf) (a) (n)) (set-separate-character #\>) (set-separate-character #\=) (set-separate-character #\[) (set-separate-character #\]) (setf buf (read-delimited-list #\= stream t)) ; TODO: check #\[ #\] (setf a (car buf)) (setf n (caddr buf)) (set-macro-character #\[ #'(lambda (s c) (list #\[ (funcall #'[-reader s c)))) (set-separate-character #\,) (setf buf (read-delimited-list #\> stream t)) (labels ((sort-ref-series (buf) ; Basically this function traces the list recursively ; and only reconstructs the same list. ; But if finds (a (#\[ b)), sorts this to (lnth b a). (let ((res nil)) (dolist (elem buf) (if (listp elem) (let ((child (sort-ref-series elem))) (when (eq (car child) #\[) (setf child `(lnth ,(cadr child) ,(car res))) (setf res (cdr res))) (setf res (cons child res))) (setf res (cons elem res)))) (reverse res)))) (let* ((splitted (split-by-last buf #\,)) (init-list (remove #\, (car splitted))) (body-list (cadr splitted))) `(make-series ,(if (null init-list) nil `(list ,@(sort-ref-series init-list))) #'(lambda (,a ,n) (declare (ignorable ,a ,n)) ,@(sort-ref-series body-list))))))) (defun split-list (lst index) (let ((target (if (null index) 0 (1+ index)))) (list (subseq lst 0 target) (nthcdr target lst)))) (defun split-by-last (lst delimiter) (split-list lst (position delimiter lst :from-end t)))
まずは定義よりmacroexpandということで、フィボナッチ数列の展開例を。sort-ref-series関数でゴチャゴチャと処理はしていますが、"`(make-series..."に始まる出力部分が素直に出ています。なお、コード中のa, nと紛らわしいので、b[k]=...の形で書いています。
CL-USER> (macroexpand '#<b[k] = 0, 1, (+ b[k-1] b[k-2])>) (MAKE-SERIES (LIST 0 1) #'(LAMBDA (B K) (DECLARE (IGNORABLE B K)) (+ (LNTH (- K 1) B) (LNTH (- K 2) B))))
コード全体を見ると、"="の左辺を読むパート、右辺を読むパートで大きく2つに分かれます。
左辺パートの目的は、lambda式の引数に利用する配列名（aに束縛）とインデックス名（nに束縛）を取得することです。"(setf n (caddr buf))"の行までがこのパートになります。ここでは単に"="までの4要素をread-delimited-listからリスト、例えば"(a #[ n #])"として受け取って、第1要素を配列名として、第3要素をインデックス名として受け取っています*1。
右辺パートの目的は、make-seriesの引数として必要な、初期化リストとlambda式内の処理本体を取得することです。"["の処理やsort-ref-series関数周りはいったん飛ばして見てみます。まずは、read-delimited-listから(0 #\, 1 #\, (+ a[n-1] a[n-2])のようなカンマ区切り？のリスト*2を受け取ります。最終要素が処理本体、その手前が初期値リストになるので、この2つを"(splitted (split-by-last buf #\,)"で分離します*3。初期値側は"(init-list (remove #\, (car splitted))"として不要なカンマを削除して先頭に"list"をつけて完成です。本体側はそのままです、"(body-list (cadr splitted))"。
最後に、ここまで飛ばしてきたsort-ref-series関数ですが、目的は、例えば"a[n]"を"(lnth n a)"の形に変換することになります。当初は（read-delimited-list関数ではなく）read関数を直接使うことで、"["を見つけたら前を見て…ということを考えていたのですが、ストリームなので前方参照ができない*4ことに気づいて詰まりました。
そこで、いったんマーク付きで全部リストに出力してから、マークを読み取って一部を書き換えるという力業に出てみました。このマークをつけているのが"#\["のリーダマクロで、マークを読み取っているのがsort-ref-series関数です。前者は"[-reader"関数のリード結果に"#\["というゴミ…もといマークをつけています。後者は（ソースの怪しげな英文コメントにある通り）、基本的には受け取ったリストをそのまま返すだけですが、マーク、例えば"(a (#\[ n))"を発見するとその部分を"(lnth n a)"というリストに置き換えて返します*5。
実際、変換前のリストである(car body-list)をprintすると次のような結果が得られます。
(+ A (#\[ (- N 1)) A (#\[ (- N 2)))
ちなみに、このリードマクロを作ったときは何もいっぺんに作ったわけではなく、まずは左辺の処理を作って"(LAMBDA (A N))"だけ出力してみて、次に初期値（カンマ区切り）なしで内部の処理を読んでみて"(LAMBDA (A N)(+ (LNTH (- N 1) A) (LNTH (- N 2) A))))"を出力して、、、と順々に積み重ねて上の形になりました。
感想
深く考えたことがなかったですが、あんなものでも四則演算のリードマクロを書くと「だから多くの言語では変数名にハイフン許可していないのか」と気づいたりします（"#[a-b]"とした時に「a引くb」なのか「"a-b"という変数名」なのか一意に決まらない）。Cを勉強するとポインタレベルの動きに敏感になるように、Lispを触っているとコンパイラレベルの動きに敏感になるようです*6。
便利な文法を作ろうとすると実装の都合による制約というのが容易に入り込むという感想も持ちました（今回のようなサボり実装で悟ったようなことを言うと怒られそうですが）。問題は影響範囲が大きいことで、例えば#[]リードマクロの中ではどうあがいてもハイフンつきの変数名は許可されません。そういった実装の都合を最小化する意味で、S式で一貫しているLispの選択はありだと感じます。
余談ですが、こうした実装都合による制約で度肝を抜かれたのがRuby（バージョン2.0.0で確認）で、2変数以上の関数で引数にカッコをつけて呼び出す場合、関数とカッコの間にスペースがあると文法エラーをはくというものです。あえて「2変数以上」と書いたのはそのままの意味で、1変数のときはスペースの有無によらずエラーになりません。また、2変数以上でも関数定義部分ではスペースがあってもOKでした。まったく意味が分かりませんが、様々な便利文法を提供する過程でやむにやまれず諦めた部分だろうと想像すると多少納得がいきます。
また、通常の関数などと比べて完全性を確保するのが難しいと感じました。これは再帰性に起因するところだと思いますが、内部でどのようなS式でも受け入れてしまうので、何が動いて何が動かないかを予測することができなかったです（第三回の2次元数列なんてよく動いたなと他人事のような印象でした）。逆に、何もしなければS式として解釈されるので、全部作る必要がない点は実装の労力や柔軟性という面でよかったです。
シリーズ完
思いついたことは何でも書くという方針のため無駄に長かった「Common Lispで遅延評価を作って遊ぶ」シリーズですがこれで完です。終わると記事のネタがなくなるかもしれないので吸えるだけ吸い尽くしておこうという不純な動機もあったりしましたが、現状まだ2，3個はネタがありそうです。こう詰まらないものでも定期的にアウトプットしていける状態を維持したいものです。
シリーズリンク
- 第一回：Common Lispで遅延評価を作って遊ぶ（1） - eshamster’s diary
- 第二回：Common Lispで遅延評価を作って遊ぶ（2） － 数列生成マクロ - eshamster’s diary
- 第三回
- 付録：リードマクロ入門、の10分の1歩ぐらい後か前 - eshamster’s diary
- 第四回：Common Lispで遅延評価を作って遊ぶ － 数列生成リードマクロ - eshamster’s diary
*1:TODOにある通り最低限のエラー処理もサボってますが…
*2:実際には、最終要素はリーダマクロで処理済みのものになりますが
*3:最初に(remove #\, ...)してから分ければいいだけのような…と記事を書いてて思いました。なんかアホなことをした気がしてきました
*4:恐ろしいことに、リーダ自体の動作を上書きして前方参照を可能にしている方もいますが…：SBCLのリーダを上書きして"超リードマクロ"を実装 - 八発白中
*5:sort-ref-series関数はコメントの必要性を感じるレベルで汚い実装になっているので、もう少しきれいに書ければいいのですが…。リストを再帰的に探索して条件に合ったリストを置き換える汎用関数を書いたら少しはきれいになるでしょうか。
*6:参考：「あなたがLispを無視することができない理由 - 八発白中」での「Lispの進化（The Evolution of Lisp）」の引用
