SBCLで使用可能なexternal-formatの話の続き。
結局 SB-IMPL::*external-formats* を見ればわかるということで解決はしたのだが、SBCLはそれ自体がLispで書かれているので、関数readを使ってソースファイルからLispフォームを読み出し、内容を解析することでexternal-formatの定義を抽出することができるのではないか、と思いついた。
結論から言うと、一応は可能だった。しかし想像していたよりもはるかに面倒くさかった。以下はその苦労の記録である（完全なコードは最後に載せてある）。
基本的な戦略
まずfindとgrepによる下調べで次のようなことが判明した。
- external-formatは3種類のマクロで定義されている
- define-external-format
- define-external-format/variable-width
- define-multibyte-encoding
- その定義が含まれているのは以下のファイル群である
- src/code/fd-stream.lisp
- src/code/external-formats/*.lisp
よってこれらのファイルを read で読んで、該当するマクロフォームからexternal-formatの名前部分を取り出していけば良いはずである。
(defun external-format-definition-p (form)
(when (listp form)
(case (first form)
((define-external-format define-external-format/variable-width) (second form))
(define-multibyte-encoding (third form))
(otherwise (apply #'append (mapcar #'external-format-definition-p form))))))障害1.リーダーマクロ
対象となるソースファイルの中には #! で始まる独自のリーダーマクロを使ったコードが含まれており、そのままではreadで読み込めなかった。このマクロの正体が分からず随分苦労したのだが、どうやら既存の処理系でSBCL自体をコンパイルするときに、#!+ および #!- という形式で、それぞれ #+ と #- に類似する機能を提供するためのものらしい（参考）。そういう特殊な役割を持ったマクロであるために、実行時に使うことはできないようだ（実装は src/cold/shebang.lisp の中にある sb-cold::shebang-reader だが、実行時には sb-cold パッケージは存在しない）。
単純に #! を無視するだけのリーダーマクロでは現在の環境で動かないコードまで読まれてエラーになったので、#+ および #- の実装に処理を転送することにして、どうにか動くようにした。
(defun shebang-reader (stream sub-character infix-parameter)
(let ((next-char (read-char stream)))
(funcall (if (char= next-char #\+) #'sb-impl::sharp-plus #'sb-impl::sharp-minus)
stream sub-character infix-parameter))
(values))障害2.パッケージ参照
read は、読み出したLispフォームに存在しないパッケージへの参照が含まれているとエラーを起こす。
ところがSBCLのソース中には、ソース中の表記（SBCLのコンパイル中に使われる名前？）と実行時の名前が異なるというパッケージが存在することが分かった。例えばSB!IMPL（動作中はSB-IMPL）、SB!THREAD（動作中はSB-THREAD）などである。
ソースを注意深く読み、試行錯誤を繰り返した結果、sb-impl::bootstrap-package-not-found エラーに対し sb-impl::debootstrap-package 再起動を行ってやれば、これらのパッケージをソース中に表記された名前で参照できるということが分かった。
(defmacro with-debootstrap-package (&body body)
`(handler-bind ((sb-impl::bootstrap-package-not-found
#'sb-impl::debootstrap-package))
,@body))例：
(with-debootstrap-package (find-package "SB!IMPL"))
; => #<package "SB-IMPL">
</package>
……
以上の障害（本当はもっといろいろあるが）を乗り越え、ようやく意図通りの動作をするようになった。以下に全コードを載せておく。しかしexportされていないシンボルを使いまくっているので、バージョンが違うと動かない可能性がある（sbcl-1.0.23-x86-darwin で動作確認）。もちろん、SBCLでしか動かない。
(続きを読む…)
マニュアルに載ってなくて悩んでいたが、ソースを読めば良いだけだと気が付いた。external-format 関連のコードは src/code/fd-stream.lisp にあり、*external-formats* 変数に必要なデータが収められている。sbcl-1.0.30で全ての名前を表示すると次のようになる。
(mapcar #'caar SB-IMPL::*external-formats*)
;; =>
(:UCS-2BE :UCS-2LE :SHIFT_JIS :EUC-JP :GBK :CP1258 :CP1257 :CP1256 :CP1255
:CP1254 :CP1253 :CP1252 :CP1251 :CP1250 :ISO-8859-14 :ISO-8859-13 :ISO-8859-11
:ISO-8859-10 :ISO-8859-9 :ISO-8859-8 :ISO-8859-7 :ISO-8859-6 :ISO-8859-5
:ISO-8859-4 :ISO-8859-3 :ISO-8859-2 :CP874 :CP869 :CP866 :CP865 :CP864 :CP863
:CP862 :CP861 :CP860 :CP857 :CP855 :CP852 :CP850 :CP437 :X-MAC-CYRILLIC
:KOI8-U :KOI8-R :UTF-8 :LATIN-9 :EBCDIC-US :ASCII :LATIN-1)
別名も含め一覧表示する場合は
(mapcar #'first SB-IMPL::*external-formats*)
;; =>
((:UCS-2BE :UCS2BE) (:UCS-2LE :UCS2LE) (:SHIFT_JIS :SJIS :|Shift_JIS| :CP932)
(:EUC-JP :EUCJP :|eucJP|) (:GBK :CP936)
(:CP1258 :|cp1258| :WINDOWS-1258 :|windows-1258|)
(:CP1257 :|cp1257| :WINDOWS-1257 :|windows-1257|) (:CP1256 :|cp1256|)
(:CP1255 :|cp1255| :WINDOWS-1255 :|windows-1255|) (:CP1254 :|cp1254|)
;... 長くなるので省略 ...
293ページ脚注に載っているURLはリンク切れになっている。SpamAssassinが提供するSPAMとHAMのコーパスはここ。
ただし本に載っている通りのコードでは start-of-file でエラーが出た。環境はSBCL@MacOS X。コーパスの中にiso-8859-1でエンコードされたファイルが混じっているのが原因らしい。with-open-file に :external-format を指定したら動作した。
(defun start-of-file (file max-chars)
(with-open-file (in file :external-format :latin1)
(let* ((length (min (file-length in) max-chars))
(text (make-string length))
(read (read-sequence text in)))
(if (< read length)
(subseq text 0 read)
text))))SBCLで使用可能な :exteral-format の一覧を探しているのだが、マニュアルのどこに書いてあるのか分からない…。
『実践Common Lisp』286ページの脚注8、リスト指示子についての説明（翻訳）が完全に混乱していて、全く理解できない。
HyperSpecを参照しながら、自分なりに読み解いてみた。
1.4.1.5 Designators
本書で「指示子」と訳されている designator とは、別のオブジェクトを意味する/指し示すオブジェクトである。例えば format 関数の最初のパラメータに t を与えると *terminal-io* を与えたのと同じことになるが、これは t というシンボル・オブジェクトが *terminal-io* に保持されるストリーム・オブジェクトを意味する/指し示すからだ、と言うことができる。
あるオブジェクトがどのオブジェクトを指し示すかというルールは、指示子の型によって決められている。だから指示子は普通、型名を伴って
- <<type>> designator : 〜型の指示子
- designator for a <<type>> : 〜型に対する指示子
とかいう呼び方をする（訳語は私による）。例えばシンボル t が *terminal-io* を指し示すというルールは stream desinator によって決められている。
……
『実践Common Lisp』286ページ脚注に戻ると、ecase のキーは “designator for a list of objects” と定義されている。そこでHyperSpecの用語集で list designator のところを読むと、次のようなルールが書いてある。
- nilではないアトム -> そのアトムを唯一の要素として持つリストを指し示す
- 普通のリスト -> そのリスト自身を指し示す
つまり指定できるのは「nilではないアトム」か「リスト」のどちらかで、どちらを指定したとしてもリストと見なされる。
よって ecase の動作もキーがリストであることを前提として説明される。
If the test-key is the same as any key for that clause, the forms in that clause are evaluated as an implicit progn, and the values it returns are returned as the value of the case, ccase, or ecase form.
（そもそもこの短い脚注で指定子の概念にまで言及したせいで、翻訳も混乱してしまったのではないかと思う。『ecaseのキーにはリストも指定できる。リストを指定した場合はいずれかの要素が一致する場合にマッチしたと見なされる』くらいの言い方で良かったのではなかろうか…）
シンボルはパッケージや「名前」に従属する存在ではなく、独立した実体を備えたオブジェクトである。
例えば以下のコードでは同じ名前を持つ2つの異なるシンボルを作っている。
(let ((sym1 (make-symbol "name"))
(sym2 (make-symbol "name")))
(values (string= (symbol-name sym1) (symbol-name sym2))
(eq sym1 sym2)))
;; => T NILこれは他のオブジェクト、例えば文字列を make-array で作る場合と、質的には何ら変わりない。
(let ((str1 (make-array 4 :element-type 'character :initial-element #\a))
(str2 (make-array 4 :element-type 'character :initial-element #\a)))
(values (string= str1 str2)
(eq str1 str2)))
;; => T NILパッケージによるオブジェクト同一性の保証
シンボルは単なるオブジェクトなので、「『同じ名前』に対しては常に同じオブジェクトが割り当てられる」という、まさにシンボルがシンボルたる性質は、実はパッケージ・システムによって実現されている。
(let ((sym1 'foo)
(sym2 'foo))
(values (string= (symbol-name sym1) (symbol-name sym2))
(eq sym1 sym2)))
;; => T Tマクロにおけるオブジェクト同一性の保証
gensym を使ったマクロを書く場合などは、パッケージ・システムに頼らず自分でシンボル・オブジェクトの同一性を保証していることになる。
(defmacro sym-test ()
(let ((sym (gensym)))
`(eq ',sym ',sym)))
;; => T上のコードにおいて sym はシンボル・オブジェクトに展開される（シンボルの「名前」ではない）ので、インターンされないシンボルを使っても、オブジェクトの同一性が保たれる。
つまり展開後のコードは、下のコードと等価では無い。
(eq '#:G762 '#:G762)
;; => NIL
展開後のコードに含まれているのは、あくまでもシンボル・オブジェクトである。
(mapcar #'(lambda (c) (class-of (cadr c))) (rest (macroexpand-1 '(sym-test))))
;; => (#<BUILT-IN-CLASS SYMBOL> #<BUILT-IN-CLASS SYMBOL>)
「20.6 EVAL-WHEN」に書いてある内容がどう考えてもおかしくて、これは翻訳のミスじゃないかと思って調べてみたら、やはり正誤表に載っていた。とはいえ多分、そもそも原文も分かりにくいのだろうと思う。HyperSpecの説明の方がずっと分かりやすい。
:compile-toplevel と :load-toplevel が意味を持つのは、次の2つの条件が揃ったときだけだ。
- COMPILE-FILE でlispファイルをコンパイルするとき
- EVAL-WHEN がトップレベルフォームとして現れる場合
:comile-toplevel が指定されていれば、コンパイル時に評価される。:load-toplevel が指定されていれば、faslファイルを LOAD したときに評価される。
上の2条件が揃わない場合は、「:execute が指定されていれば評価される」「:execute が指定されていないと評価されない」という、ごく単純な動作になる。
HyperSpecに載っている例よりも、さらに直接的な例を考えてみた。
(eval-when (:execute)
(defun foo ()
"foo-execute"))
(eval-when (:compile-toplevel)
(defun foo ()
"foo-compile-toplevel"))
(eval-when (:load-toplevel)
(defun foo ()
"foo-load-toplevel"))
(defmacro foo-macro()
(foo))
(defun main()
(format t "~a~%" (foo))
(format t "~a~%" (foo-macro)))LOAD でlispファイルを読み込めば、
foo-execute
foo-execute
と表示される。COMPILE-FILEでコンパイルしたfaslファイルを読み込めば、
foo-load-toplevel
foo-compile-toplevel
と表示される。
コンディションの練習のために、Fizz-Buzz問題をコンディションを使って解いてみた。「15で割り切れる」「3で割り切れる」「5で割り切れる」といった事態をそれぞれエラーと見なし、別の値を使うという選択肢（use-value）を用意した上で、loop時にFizz,Buzz,FizzBuzzという文字列を割り当てている。
(define-condition multiple-of-15 (error) ())
(define-condition multiple-of-3 (error) ())
(define-condition multiple-of-5 (error) ())
(defun fizz-buzz-cond (n)
(restart-case
(cond ((zerop (mod n 15)) (error 'multiple-of-15))
((zerop (mod n 3)) (error 'multiple-of-3))
((zerop (mod n 5)) (error 'multiple-of-5))
(t n))
(use-value (value) value)))
(defun use-value-fn (value)
#'(lambda (c)
(declare (ignore c))
(invoke-restart 'use-value value)))
(defun run-fizz-buzz ()
(handler-bind ((multiple-of-15 (use-value-fn "FizzBuzz"))
(multiple-of-3 (use-value-fn "Fizz"))
(multiple-of-5 (use-value-fn "Buzz")))
(loop for n from 1 to 100 do (format t "~a~%" (fizz-buzz-cond n)))))
総称関数の練習のために、Fizz-Buzz問題を総称関数を使って解いてみた。独自のメソッド結合まで使った、無駄に大掛かりな物になっている。
(defun strcat (&rest strings)
(apply 'concatenate `(string ,@strings)))
(define-method-combination strcat :identity-with-one-argument t)
(defgeneric fizz-buzz-method (mod3 mod5)
(:documentation "mod3が0ならFizz, mod5が0ならBuzz")
(:method-combination strcat))
(defmethod fizz-buzz-method strcat ((mod3 (eql 0)) mod5)
"Fizz")
(defmethod fizz-buzz-method strcat (mod3 (mod5 (eql 0)))
"Buzz")
(defmethod fizz-buzz-method strcat (mod3 mod5)
"")
(defun empty-p (seq)
(if (= 0 (length seq)) nil seq))
(defun fizz-buzz (n)
(format t "~a~%" (or (empty-p (fizz-buzz-method (mod n 3) (mod n 5))) n)))
総称関数の使い勝手はHaskellやErlangのパターンマッチと似たところがあるが、マッチするメソッドが一度に全部手に入り、それらを結合できるところが決定的に違う。
『実践Common Lisp』18章を読んで、さらに別の書き方を思いついた。format関数の条件制御構文を使用する。
(defun fizz-buzz-format (n)
(let ((s (format nil "~[Fizz~;~]~[Buzz~;~]" (mod n 3) (mod n 5))))
(format t "~a~%" (if (string= "" s) n s))))2つのformat関数を１つにまとめるのは…無理かな？
追記:思いついた
(defun fizz-buzz-format2 (n)
(format t "~[Fizz~;~]~[Buzz~;~]~@*~[~:;~[~:;~a~]~]~%" (mod n 3) (mod n 5) n))
わずか一行に収まるとは。
ベタに書けばこんな感じか。
(defun fizz-buzz-normal (num)
(format t "~a~%" (cond
((zerop (mod num 15)) "FizzBuzz")
((zerop (mod num 3)) "Fizz")
((zerop (mod num 5)) "Buzz")
(t num))))with-output-to-string を使うとよりエレガント、かも知れない。
(defun fizz-buzz (num)
(let ((r (with-output-to-string (s)
(when (zerop (mod num 3)) (format s "Fizz"))
(when (zerop (mod num 5)) (format s "Buzz")))))
(format t "~a~%" (if (string= "" r) num r))))一般化バージョン。
(defun gen-fizz-buzz (rules)
(lambda (num)
(let ((r (with-output-to-string (s)
(loop for (b w) in rules do
(when (zerop (mod num b)) (format s "~a" w))))))
(format t "~a~%" (if (string= "" r) num r)))))実行。
(loop for n from 1 to 100 do (fizz-buzz n))
;; 3,5,7の倍数の時、それぞれFizz,Buzz,Kozz
(let ((fizz-buzz-kozz (gen-fizz-buzz '((3 "Fizz") (5 "Buzz") (7 "Kozz")))))
(loop for n from 1 to 100 do (funcall fizz-buzz-kozz n)))
