リリカル☆Lisp開発日記

ChatonのCL部屋にてCL勉強会が復活されるとのことなので、
今回のテーマ『format』を使ったプログラムを書いてみました(コードはエントリの末尾)。

> (eval-brainf*ck "+++++++++
[>++++++++>+++++++++++>+++++<<<-]
>.>++.+++++++..+++.>-.------------.<
++++++++.--------.+++.------.--------.>+.")
Hello, world!
NIL

もともとは、shiroさんの
「~?で自分自身を読むことを許した場合、Turing completeになったりしないかなあ」
というアイディアをお借りして何か作れないかと思ったんですが、
formatだけで「何かを記憶する」という方法が思いつかず、
結局 ~/…/ に頼るプログラムになってしまいました。
(~/name/ 指定子を使うとformatの中で関数nameを呼び出せます。)
formatに直接brainf*ckのコードを文字列で渡すのではなく、
まず、コードを文字列からリストに変換するんですが、
このリスト、入れ子構造を持ってたり、循環構造まで持ってたりします。
本当はformatだけで頑張りたかったんですが、私の力不足で、
formatに渡す前に頑張るという変なプログラムになってしまいました。
見所は、循環リストの中で ~? を使って、ループを実現しているところくらいですかね。

(defvar *brainf*ck-evaluator* "~
~{~
~[~
~:*~/format-bf-mov/~;~
~:*~:/format-bf-mov/~;~
~:*~/format-bf-cal/~;~
~:*~:/format-bf-cal/~;~
~:*~/format-bf-io/~;~
~:*~:/format-bf-io/~;~
~/format-bf-loop/~:*~
~{~
~:[~
~*~;~
~:*~?~
~]~
~}~
~]~
~}")
(let ((pointer 0)
(array (make-array #1=10
:element-type 'fixnum
:initial-element 0
:adjustable t
:fill-pointer #1#)))
(defun bf-data-reset ()
(setf pointer 0)
(setf (fill-pointer array) 1)
(setf (aref array 0) 0))
(defun format-bf-mov (stream arg colon-p at-p &rest args)
(declare (ignore stream arg at-p args))
(incf pointer (if colon-p -1 1))
(when (>= pointer (fill-pointer array))
(vector-push-extend 0 array)))
(defun format-bf-cal (stream arg colon-p at-p &rest args)
(declare (ignore stream arg at-p args))
(incf (aref array pointer) (if colon-p -1 1)))
(defun format-bf-io (stream arg colon-p at-p &rest args)
(declare (ignore stream arg at-p args))
(if colon-p
(setf (aref array pointer) (char-code (read-char)))
(princ (code-char (aref array pointer)))))
(defun format-bf-loop (stream arg colon-p at-p &rest args)
(declare (ignore stream colon-p at-p args))
(if (= (aref array pointer) 0)
(setf (first arg) nil)
(setf (first arg) *brainf*ck-evaluator*))))
(defun decode-brainf*ck (char)
(case char
(#¥> 0)
(#¥< 1)
(#¥+ 2)
(#¥- 3)
(#¥. 4)
(#¥, 5)
(#¥[ 6)
(#¥] 7)))
(defun compile-brainf*ck (str &optional (start 0))
(do ((i start (1+ i))
acc)
((or (>= i (length str)) (char= (aref str i) #¥]))
(values (nreverse acc) i))
(push (decode-brainf*ck (aref str i)) acc)
(when (char= (aref str i) #¥[)
(multiple-value-bind (code new-i)
(compile-brainf*ck str (1+ i))
(let ((code1 (list nil (list (copy-list code))))
(code2 (list (decode-brainf*ck #¥[)
(list nil (list (copy-list code))))))
(nconc (car (second (second code2))) code2)
(nconc (car (second code1)) code2)
(push code1 acc)
(setf i new-i))))))
(defun eval-brainf*ck (str)
(bf-data-reset)
(format t
*brainf*ck-evaluator*
(compile-brainf*ck str)))

あんまり日記を書いてないけど、一応生きています。
大学が新型インフルエンザで休講になったけど、私は元気です。
MacPortsのSBCLが1.0.25からなかなか更新されないなと思っていたら、
いつの間にやら(3週間ほど前に？)一気に1.0.28になっていたようです。
一方、FreeBSDのportsのSBCLはまだ1.0.27のまま。
そんなことより、Mac Bookでxclannadを使ってCLANNADが動きました。
これで安心してMacを使っていくことができます。よかったよかった。

g000001さんの紹介されたパネル討論会 : Common Lispに
「Skef Wholeyの歌」というものが出てくるのですが、
Bob Dylanの”Maggie’s Farm”という歌の替え歌で、”Common Lisp”と名付けられています。
Lispの歌は「かっこー、かっこー、かっこかっこかっこー」だけじゃなかった！
この歌はCommon Lispのメーリングリスト
Common-lisp@SU-AI.ARPAに投稿されたもので、
全文は共立出版の「bit 85年6月号」で見ることができます。
偶然、大学にあったので読めました。
(ちなみに、それっぽいキーワードでググってみたら、ちゃんとネット上でも見つかりました。
ただ、公に公開している感じではなかったので、一応URLは伏せておきます。)

ホーアCSPモデルの理論という本を読みました。
この本は、前書きに
「実装例はLISPのサブセットで書かれている」
と書いてるんですが、いざ中身を見てみると

prefix(c,P)=λx. if x=c then P
else "BLEEP

M式のようなヘンテコなプログラムが出てきます。
関数定義が数式みたいに=で行われていたり、
lambdaがChurchのラムダ計算の記法みたいになっていたり、
ifが全く別の言語みたいに書かれていたり、
単引用符’が二重引用符”になっていたり、かなりフリーダムです。
一応、これにはフォローがあり、

LISP関数を定義するためにここで用いた表記法は，まったく正式なものではない．
したがって，これらは実際の各LISPシステム上で用いられている従来のS式型式に合わせて
変換する必要がある．

とかいてあります。「S式型式」って原文ではどうなってるんだろう…
そして、この後にLISPkitでの例が載っています。
(追記)
「S式型式」は原文では”S-expression form”となっていました。
これってどうなんだろう。「S式を使った形式」くらいのほうが分かりやすいような…

(prefix
lambda
(a p)
(lambda (x) (if (eq x a) p (quote BLEEP))))

LISPkitという実装は初めて聞きましたが、結構有名みたいです。
代入操作がなく、遅延評価の機構を持ってるとか。
せっかくこんな面白いものがあるのに、実装例は何故かM式モドキで書かれています。
ただ、この本に登場するプログラムは、関数が返した関数を呼び出して、
そこから、新たに関数が生成されて…
といったように、高階関数が多用されており、
S式でなくてもLISPっぽさが溢れていて楽しいです。
ちなみに、訳者あとがきには次のような一文があります。

ここではあの悪名高き括弧を多用したS式ではなく，
アルゴル風な表記法が用いられているため，
意味を汲み取るのにほとんど困難はないようになっています．

「悪名高き括弧を多用したS式」にワラタ。

去年に引き続き、今年も自転車で琵琶湖を走ってきました。
自転車は去年と同じくサイクロンゆのはな一号機です。
[コース紹介]
去年は時計回りだったので、今年は反時計回りに挑戦。
また、京都から琵琶湖までの道も、367号線で山を登っていくルートに変更
[Google Map]。
[午前3:30]
山に向かって自転車をこぎ始めました。
このときの気温は9度。結構肌寒いです。

しかし、山を登っていくにつれて気温は低下。
8度、7度、そして6度まで下がりました。寒いです。
おまけに暗いです。山道としてはかなり街灯が多いところですが、
街灯がない区間が続くと自転車のライトだけが頼りでした。
[午前4:30]
なかなか滋賀県にたどり着きません。
前に一度同じルートで県境まで行ったことがあるんですが、
もう2年も前なのでどれくらいの距離だったのか思い出せません。
実は滋賀県なんて存在しないんじゃないのか。
前に行ったときは狐耳の美少女にでもばかされたんじゃないのか。
坂の傾斜がきつくなってきて、そんな変なことを考え始めた頃、
ようやく県境に到着しました。

あたりは本当に真っ暗で何も写らなかったので、以前来たときの写真をのせときます。
県境のあとは有料トンネル(途中トンネル)があるのですが、
これは脇の細い道を通ればさけられます。知っててよかった。
などと思ったんですが、帰りに「24:00-6:00は無料」の文字を見つけました。
せっかくだから通ればよかったorz
そこから琵琶湖大橋まではずっと下りです。
[午前5:00]
琵琶湖大橋到着。
用もないのにちょっとだけ橋を渡ってみました。

琵琶湖大橋と言えばさびれた観覧車です。
暗い時間でもよく目立っています。

琵琶湖大橋を後にして、南に向かって出発。
いよいよ琵琶湖一周の始まりです。
[午前6:10]
琵琶湖の南の端、唐橋に到着しました。

なかなか順調なペースですが、早くも足に疲労が出始めました。
[午前6:30]
琵琶湖の東側は非常に通りやすい自転車道があります。
この道は親切なことに1km間隔ごとに標識が置いてあり、
場所によっては100m間隔で距離を教えてくれる区間もあります。

大体時速20kmちょっとを維持しながら走りました。
このあたりでお腹が減ってきたので朝食。
持参してきた「イカナゴの釘煮がちょっとはみ出しているおにぎり」を食べました。

[午前7:20]
琵琶湖大橋の東側に到着。

分かりにくいですが、写真の中央あたりに観覧車が薄らと写っています。
[午前9:30]
確か彦根のあたり。ひこにゃんには会えませんでしたが、桜がきれいに咲いていました。

京都では桜はすっかり散ってしまったというのに、滋賀ではまだ桜を見ることができるようです。
「滋賀ではアニメの放送が数週間遅れるのが標準」
というのを滋賀県民に聞いたことがあるので、きっと同じようなことでしょう。
それはともかく、太ももの疲労がかなり蓄積されてきました。
[午前11:15]
琵琶湖の北の果て。山道。

湖北と言えば去年は奥琵琶湖パークウェイに行って酷い目に遭いましたが、
今年はその道は避けることにしました。
べっ、別に延々と続く坂道が怖い訳じゃないんだからね!!!
奥琵琶湖パークウェイが一方通行だから避けるだけなんだからね!!!
(ちなみに「一方通行は「自転車を除く」とあるため行こうと思えば行けるらしいです。
ただし、車とバイクが猛スピードで正面からやってくるので、あまりにも恐ろしいです。)
奥琵琶湖パークウェイを避けた湖北は想像以上に楽でした。
山道も気合いを入れて上ろうと思ったものの、すぐにのぼりが終わってしまい、かなり拍子抜けした感じです。
[午後1:00]
桜咲き過ぎ。花見をしているひとも大勢いました。
私もそれにまぎれて昼食。「いかなご(略)」第二弾を食べました。
このあたりで、足の疲労がかなり大変なことになり、
ふとももから始まった痛みは膝の方まで下りてきて、かなり辛い状況に。
[午後1:30]
足の疲労からかなりペースダウン。
「このまま行くと、ゴールまで結構時間がかかるな…」
そんなことを考えながら前を走っていたマウンテンバイクにのった少年を抜くと、
その少年が突然ペースアップしてこっちを追い抜いてきました。
こちらも負けじとペースを上げ、再び追い抜き。
そんなことを繰り返しているといつの間にか元のペース(時速20kmちょっと)に。
せっかく元のペースに戻せたので、これを維持することに。
こちらがそれ以上ペースをあげようとしないのを見て少年は、
明らかに残念な顔をしながら去っていきました。
ごめんよ…
[午後3:20]
遠くに薄らと観覧車の姿。
足の痛みを堪えつつ更にペースアップ。
そして、ついにスタート地点である琵琶湖大橋に。

距離およそ200kmの琵琶湖一周の旅はおよそ10時間20分で終了しました。
休憩時間を考慮に入れると時速20kmちょうどで走り切ったことになります。
ママチャリとしてはかなりがんばった方かと思います。

[帰るまでが遠足です]
午後1:30から2時間に渡って結構無茶をしてペースをあげたため、
太ももと膝がヤバいことに。おまけにふくらはぎにまで疲労が。
この状態で山を上って京都にかえらなければ行けません。
幸いなことに、登りは7km程度しかなく、あとはずっと下りのようなので、
泣きながらトロトロと山道を上りました。
約1時間の戦いの末、なんとか坂を上り切り京都に。
あとはすべて下りだったんですが、足がまともに動かず、
下り切るのにまたもや1時間かかってしまいました。
朝、登った時と同じ所要時間とはかなり驚きです(主に悪い意味で)。
帰りの体力もちゃんと考慮に入れないと悲しいことになりますね。

Common LispでWikiエンジンを作る過程で 、
HTMLにS式を埋め込みたいという願望がありました。

<html>
<head><title>test</title></head>
<body>
現在時刻は<?lisp
(let ((time
(multiple-value-list
(decode-universal-time
(get-universal-time)))))
(echo (third time) "時" (second time) "分"
(first time) "秒"))
?>です。
</body>
</html>

しかし、ページを読み込むたびにこんなのを解釈してたら、
動作が遅くなるよな…ということでためらっていたのですが、
どうしてもやりたくなったので、ページ表示時に毎回処理するのではなく、
初めて表示するとき^(*)に普通の表示と組み込まれたLispの処理を行う
LAMBDA式(関数ではなくリスト!)を生成し、
それをコンパイルするという方針をとりました。
(*) もちろん、ファイルが更新されればコンパイルし直します。
上のテキストは次のようなLAMBDA式に変換されます。

(LAMBDA (#1=#:G1652 STREAM REQUEST LOGINED?)
(DECLARE (IGNORABLE STREAM REQUEST LOGINED?))
(MACROLET ((CHECK-LOGIN ()
'(UNLESS LOGINED? (SETF #2=#:G1651 :NOT-LOGIN)
(GO #3=#:G1650))))
(WITH-OPEN-FILE (#4=#:G1647 #1#
:EXTERNAL-FORMAT :UTF-8
:DIRECTION :INPUT)
(LET ((#2# T))
(TAGBODY
(SEND-TEMPLATE-LINES STREAM #4# 3 5)
(LET ((TIME
(MULTIPLE-VALUE-LIST
(DECODE-UNIVERSAL-TIME (GET-UNIVERSAL-TIME)))))
(ECHO (THIRD TIME) "時" (SECOND TIME) "分"
(FIRST TIME) "秒"))
(FILE-POSITION #4# 252)
(SEND-TEMPLATE-LINES STREAM #4# 3)
#3#)
#2#))))

これを (compile nil LAMBDA-SHIKI) という感じでコンパイルするだけ。
ね、簡単でしょ？
今回はサーバ自体をLispで作っているため、その関数を一度読み込ませたら、
ずっと持っておけばいいんですが、サーバを再起動すると関数が消えてしまうので、
LAMBDA式をファイルに書き出すということにしました。
そうすれば今後はLAMBDA式を書き出したファイルを読み込んで、
コンパイルするだけですみます(それでもコンパイルが必要なのが問題ですが…)。
上のLAMBDA式をみれば分かる通り、関数自体は表示すべきテキストを持っていません。
実行時に元のファイルから読み込ませるようにしています。
メモリに常駐させる以上、あまり大きな関数を作りたくないという考えからそうしました。
また、echoという見慣れないものを使っていますが、これはmacroletで定義してます。
ほかにもいろんなもののSyntax Sugarをmacroletで定義しています。
上のLAMBDA式のmacroletにはcheck-loginというものしかありませんが、
コンパイルする直前に(リスト操作で)いろいろと追加します。
(check-loginだけ先にあるのは変数を参照するためです)
ちなみに #n= と #n# を使っていますが、
これはファイルに書き出した後にリードしないといけないのに、
Uninterned symbolを使っていたことに、かなり最後の方になって気づき、
大慌てで *print-circle* を t にして出力するようにして誤摩化したためです(笑)

MacPortsから入れたCLISP 2.47でposix:file-statを使ったらCLISPが死んでしまった。

[1]> (posix:file-stat "test.lisp")
*** - handle_fault error2 ! address = 0x4 not in [0x19d9b000,0x19eefa34) !
SIGSEGV cannot be cured. Fault address = 0x4.
GC count: 0
Space collected by GC: 0 0
Run time: 0 24367
Real time: 14 942711
GC time: 0 0
Permanently allocated: 89888 bytes.
Currently in use: 1942408 bytes.
Free space: 504036 bytes.

WindowsやFreeBSDではちゃんと動いたのに…
Mac版特有のバグ？

MacBook買いました。
初めてのMacのためキー操作がなかなか慣れません。
でも初めてPCを触ったときに戻ったような感じで15歳ほど若返った気分です。
とりあえず、Emacs, SLIME, CLISP, SBCLを入れて、
Lisp開発環境は真っ先に整えておきました。
で、話は全く変わりますが、
Let Over Lmabdaを(大部分は)読み終えました。
7章はLispのプログラムは分かったものの、
ソーティングネットワークのアルゴリズムがいまいち分からず。
8章のForthを作る話はしんどくなってきたのでソースだけを追った程度。
でもまあ、面白そうなところは大体全部よんだつもりです。
Let Over Lambdaのなかで一番便利だと思ったマクロは、
かなり最初の方に出てきたdefmacro!でした。
今や私もこのマクロなしにはマクロが書けない体になってしまいました。
Let Over Lambdaで驚かされたのはCommon Lispのsetqの奇妙な動作。

(defvar v '(1 2 3)) => V
(setf (car v) 'a) => A
v => (A 2 3)

setfは第一引数に場所(place)を指定できるため、 (car v) などを指定できる。
一方、setqの第一引数は変数であり、setfの様な真似はできない。
(setq (car v) ‘a) などと書くとエラーになる。
ずっとそう信じていました。まあ、信じるも何もその通りなんですが、
symbol-macroletとsetqを組み合わせると面白いことになります。

(symbol-macrolet
((m (car v)))
(setq m 'z) => Z
v => (Z 2 3)

シンボルマクロmが展開されると、思いっきり (setq (car v) ‘z) になるんですが、
このプログラムは正しく動作します。
setqの第一引数がsymbol-macroletによって確立された束縛を参照すると、
setqの代わりにsetfが使われるとのことです。
確かにそう動作しても困ることは何一つないんですが、
どうしてこんな仕様にしたんだろう…
そして、それ以上に一番驚かされたのはSICPについての脚注。

Pronounced sick-pea.

SICPの発音って「しっくぴー」だったんだ…

Common Lispではdefvarを使ってグローバル変数を作ると、
その変数はスペシャル変数となり、無限スコープと動的エクステントを持つようになります。

(defvar *special* 99)
(defun f ()
(let ((*special* 1))
(g *special*)))
(defun g (x)
(+ x *special*))

上のプログラムから分かるように、*special*はどこからでも参照できます(無限スコープ)。
関数fのletにて、*special*に新たな値を設定すると、そのletを抜けるまでの間、
*special*の値は1に変わります(動的エクステント)。
よって、fのletがgにも影響して、 (f) => 2 となります。
しかし、これが正しく動作するのは*special*がスペシャル変数であるということを
処理系が知っているからです。関数fの定義だけを取り出してみると、
letで束縛している変数*special*が通常の変数なのかスペシャル変数なのか分かりません。
と、いうことでプログラムを次の様に書き換えてみました。

;;; test.lisp
(defun f ()
(let ((v 1))  ; この時点ではvがスペシャル変数であることが分からない
(g v)))
(defun f1 ()
(let ((v 1))
(declare (special v))  ; vはスペシャル変数だと明示的に宣言
(g v)))
(defvar v 99)  ; ここでvがスペシャル変数であることが分かる
(defun g (x)
(+ x v))  ; このvはスペシャル変数である
(defun h ()
(let ((v 1))  ; このvはスペシャル変数である
(g v)))

このプログラムをREPLで次の様に読み込ませて実行させます。

> (load "test.lisp") => T
> (f) => ???
> (f1) => ???
> (h) => ???

CLISP, CMUCL, SBCLでの結果は以下の通りでした。

SBCLの (f) だけ値が他と違います。
これは、SCBLがロードとともに式をコンパイルするため、
関数fをコンパイルする時点で最適化により、vという名前が消失してしまうからでしょう。
(すると、fは単にgに1を適用することになり、gはスペシャル変数vに1を足し、結果は100となります)
CLISP, CMUCLでもcompile-fileしたものをロードすると (f)の値は100となりました。
ちなみに、変数の名前を*special*からvに変更しましたが、
*special*のままにして、SBCLでプログラムをロードすると次のような警告がでます。

; caught STYLE-WARNING:
;   using the lexical binding of the symbol (*SPECIAL*), not the
;   dynamic binding, even though the name follows
;   the usual naming convention (names like *FOO*) for special variables

「レキシカル変数のくせして、目立つんじゃねーよ！」ということですね。
このメッセージを読むと、スペシャル変数を誤ってレキシカル変数として扱う可能性は減るでしょう。
Let Over Lambdaではスペシャル変数をアスタリスクで囲わない方針をとっていますが、
誤ってdefvarの登場場所より前でその変数を使ってしまうことを考えると、
スペシャル変数はアスタリスクで囲ったほうがいいとおもいます。

Common Lispのストリームは扱う型を指定する必要があり、
:element-typeにcharacterを指定してやると文字のみしか扱えず、
(unsigned-byte 8)を指定するとバイナリデータしか扱えません。
しかし、例えばHTTPの通信を行うプログラムを書いたりするときは、
ヘッダ部分を処理するときは文字列としてデータをやりとりしたいし、
データ本体を処理するときはバイナリデータをやりとりしたいので困ります。
CLISPではストリームが扱う型を動的に変更出きるので、
扱う型を変えたくなった時点で変更してやれば済みます。

#+clisp (setf (stream-element-type stream) '(unsigned-byte 8))

公式の説明
使い方
で、ここまでは知っていたんですが、これと同じことをSCBLではどうやるんだろうと調べてみたら、
Bivalent Streamというものがあり、これを使えば文字とバイナリの両方が使えるそうです。
作り方は:element-typeに:defaultを指定するだけ。

#+sbcl
(socket-make-stream
(socket-accept sock)
:input t :output t
:element-type :default
:buffering :full)

公式の説明
こりゃ便利です。
もう全部Bivalent Streamでいいと思いましたが、普通のストリームより遅いみたいです。