『実践Common Lisp』13.1のSUBST-IFについての説明は間違っている。
SUBST-IFは、古いアイテムを1つ受け取る代わりに、1引数関数を受け取る。この関数は木に含まれる各アトミックな値に対して呼び出され、その結果が真になった箇所をすべて新しい値で置き換えた新しい木を返す。
「各アトミックな値に対して呼び出され」とあるが、実際にはコンスセルも含む(木自体も含む)全ての要素に対して呼び出される。SUBST-IF-NOTなども同様。
(subst-if 10 #'consp '(1 3 2 (1 2) (3 4) (5 6)))
;; => 10
(subst-if 10 #'atom '(1 3 2 (1 2) (3 4) (5 6)))
;; => (10 10 10 (10 10 . 10) (10 10 . 10) (10 10 . 10) . 10)
(subst-if 10 #'evenp '(1 3 2 (1 2) (3 4) (5 6)))
;; => エラー
;; The value (1 3 2 (1 2) (3 4) (5 6)) is not of type INTEGER.
(subst-if 10 #'(lambda (x) (and (integerp x) (evenp x)))
'(1 3 2 (1 2) (3 4) (5 6)))
;; => (1 3 10 (1 10) (3 10) (5 10))
そもそもアトミックな値も定義上は木である。
(subst-if 10 #'evenp 2)
;; => 10
組み込みの merge を使ってマージソートを実装してみた。
(defun merge-sort (result-type seq pred &key key)
(let* ((len (length seq))
(mid (floor (/ len 2))))
(if (> 2 len)
seq
(merge result-type
(merge-sort result-type (subseq seq 0 mid) pred :key key)
(merge-sort result-type (subseq seq mid) pred :key key)
pred
:key key))))
動作確認
(merge-sort 'list '("Wii" "DS" "PSP" "PS3" "Xbox360") #'string<)
;; => ("DS" "PS3" "PSP" "Wii" "Xbox360")
(merge-sort 'list '("Wii" "DS" "PSP" "PS3" "Xbox360") #'char<
:key #'(lambda (x) (elt x 0)))
;; => ("DS" "PSP" "PS3" "Wii" "Xbox360")
11章途中まで読んだ。
他言語のプログラマに向けたLisp本。リストがどうしたコンスセルがどうしたという定番の説明をすっ飛ばして、とにかくまずはCommon Lispの凄さを見ろと言わんばかりに、最短距離でマクロの実演に突き進む。その姿勢は正しいと思う。ある程度経験のあるプログラマならリストやコンスセルの基礎くらいは知っているものだし、その上で「Lispって、結局何がどう凄いのかよくワカンネ」という人がこの本のターゲットだろう。
実際途中まで読んだだけでも、マクロの凄さはひしひしと伝わってくる。他言語での経験を振り返って、果たしてプログラムを書くということはどういうことだっただろうかと、改めて考え直してしまうくらい示唆に富んだ内容を含んでいる……。
ところでマクロのイディオムとして、次のように処理の”本体”となるコードを埋め込む形が多用されている。
(defmacro foo (a b &body body)
`(bar (baz ,@body))
これはRubyのブロックによく似ている。一般にRubyのブロックは無名関数に対するシンタックスシュガーと見なされることが多いのだが、むしろLispのマクロを意識した部分も大きいのかも知れない。
…検索してみるとやはりLispのマクロとRubyのブロックを比較する視点は存在するようだ。Ruby作者のまつもとさん自身も取り上げている:
頭が混乱したときのためにメモ。
同等なlistによる表現に書き直す
内側のバッククォートから順に書き直していく。例えば
に対するlistによる表現は
となる。同様に
なら
である。
評価した結果を求める
右側のアンクォートから評価していく。例えば a=c, b=1 という束縛が存在する環境で
を評価すると
になる。また’によるクォートと併用する場合も右から順に考えれば分かりやすい。例えば
を評価すれば
を得る(クォートとアンクォートは打ち消し合う)。
自分で考えて書いてみた。本に載っている例とは少しだけロジックが異なるが、同様に動作する。
(defmacro once-only ((&rest names) &body body)
(let ((gensyms (loop for n in names collect (gensym))))
`(let (,@(loop for n in names for g in gensyms collect `(,g ,n)))
(let (,@(loop for n in names collect `(,n (gensym))))
`(let (,,@(loop for n in names for g in gensyms collect ``(,,n ,,g)))
,,@body)))))
ところでこの中の (,@(loop …)) となっている部分を、次のように ,(loop …) に置き換えると、
(defmacro once-only ((&rest names) &body body)
(let ((gensyms (loop for n in names collect (gensym))))
`(let ,(loop for n in names for g in gensyms collect `(,g ,n))
(let ,(loop for n in names collect `(,n (gensym)))
`(let ,,(loop for n in names for g in gensyms collect ``(,,n ,,g))
,,@body)))))
なぜか動作しなくなる(do-primesのコンパイルでエラー)。理由がよく分からない。with-gensyms は後者の形で動いているのに…。
マクロで実装された where を他の言語的な発想で、つまり関数(クロージャ)を使って実装したらどうなるか、考えてみた。
(defun make-comparison-fun (field value)
(lambda (cd) (equal (getf cd field) value)))
(defun all (fun lst)
(cond ((not lst) t)
((not (funcall fun (car lst))) nil)
(t (all fun (cdr lst)))))
(defun where-fun (&rest clauses)
#'(lambda (cd)
(all #'(lambda (comp-fun) (funcall comp-fun cd))
(loop while clauses
collecting (make-comparison-fun (pop clauses) (pop clauses))))))
こうして書き比べてみると、関数という単位でしか処理を分割できないのはとても不自由で、不自然だとすら感じてしまう(そう感じてしまう自分に驚く)。make-comparison-fun の本当の意図は「今すぐには評価しない、後で評価するためのコードブロックを作る」ことであって、関数という形式にはあまり意味がない。all や where-fun の中で funcall を呼ぶのも煩わしい。
実際、普通は上のようなコードは書かないだろう。不自然で不自由で、抽象化過剰のように感じられるからだ。この程度の内容ならば、一切の抽象化を放棄して単純なループで書いてしまう気がする。
function where() {
var fields = arguments;
return function(cd) {
for(var i=0; i<fields.length; i+=2) {
if(cd[fields[i]] != fields[i+1])
return false;
}
return true;
}
}
しかしこの手の妥協を繰り返していると、やがてテストするのがしんどくなってくる。どこまで抽象化すべきか、どこで抽象化を諦めるか、特に再利用可能なライブラリを作っているときにはかなり悩ましい問題となる。
Lispではそういう妥協は不要ということだろうか。今後の内容に期待しよう。
少しずつだが『実践Common Lisp』を読み始めた。3章の where の例で早くも感動。Lispのマクロはとにかく凄いのだと、著者がくどいくらいに主張する理由が分かってきた。確かにこれは凄い。
練習のために update のマクロ版も書いてみた。後の章で出てくるのかも知れないが。
(defun make-update-expr (field value)
`(setf (getf cd ,field) ,value))
(defmacro update (selector-fn &rest clauses)
`(setf *db*
(mapcar
#'(lambda (cd)
(when (funcall ,selector-fn cd)
,@(make-expr-list #'make-update-expr clauses))
cd)
*db*)))
make-expr-list は make-comparison-list を一般化したもので、次の通り。
(defun make-expr-list (make-expr-fn fields)
(loop while fields
collecting (funcall make-expr-fn (pop fields) (pop fields))))