リリカル☆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は伏せておきます。)