はじめに
難読＆規格が極小，ついでに名前が卑猥で有名なBrainfuckという言語があります．命令が8つしかないので実装が簡単で様々な言語で実装してみたみたいな記事がゴロゴロしていますがこの記事もその一つです．だいぶ前にCやPythonで実装したのをふと思い出して今回Common Lispで実装してみました．ただ普通のやり方では面白くないのでリーダマクロを使って実装しました．リーダマクロをほとんど触ったことがなかったので勉強したかったと言うのもあります．探り探りでやったのでところどころ怪しいところがあるかも知れませんがご容赦ください．
以下Wikipediaより引用です．
処理系は次の要素から成る: Brainfuckプログラム、インストラクションポインタ（プログラム中のある文字を指す）、少なくとも30000個の要素を持つバイトの配列（各要素はゼロで初期化される）、データポインタ（前述の配列のどれかの要素を指す。最も左の要素を指すよう初期化される）、入力と出力の2つのバイトストリーム。
Brainfuckプログラムは、以下の8個の実行可能な命令から成る（他の文字は無視され、読み飛ばされる）。
> ポインタをインクリメントする。ポインタをptrとすると、C言語の「ptr++;」に相当する。
< ポインタをデクリメントする。C言語の「ptr--;」に相当。
- ポインタが指す値をインクリメントする。C言語の「(*ptr)++;」に相当。
- ポインタが指す値をデクリメントする。C言語の「(*ptr)--;」に相当。
. ポインタが指す値を出力に書き出す。C言語の「putchar(*ptr);」に相当。
, 入力から1バイト読み込んで、ポインタが指す先に代入する。C言語の「*ptr=getchar();」に相当。
[ ポインタが指す値が0なら、対応する ] の直後にジャンプする。C言語の「while(*ptr){」に相当。
] ポインタが指す値が0でないなら、対応する [ （の直後[1]）にジャンプする。C言語の「}」に相当[2]。
この他実装によりまちまちなのはポインタやポインタの値がオーバーフローまたはアンダーフローしたときの扱いです．
- エラーを吐く
- ループさせる
の二通りがありますが今回は前者とします．
流れ
出来上がりは以下のような流れになっています．
- 空のリードテーブルをbf用に用意する
- bfの各命令に対応するリーダマクロを定義する
- bf用のリードテーブルを使ってソースをロードする
先ず空のリードテーブルを用意してそのリードテーブルにbrainfuckの各命令に対応するCommon Lispのコードに展開されるリーダマクロを定義します．
これで例えば以下のような感じでbrainfuckのソースコードを実行できます．
(let ((*readtable* *bf-readtable*))
(load "hoge.bf"))
順に見ていきたいと思います．なお処理系はSBCLです．
1. 空のリードテーブル
通常リードテーブルを作るときにはcopy-readtableを用いるようです．
ただこれだと空のリードテーブルを作成できません．仮にcopy-readtableを使って作ったテーブル上にbrainfuck用のリーダマクロを定義したとしてもソース中に有効なCLの式が現れた場合CLとして処理してしまいます．
CLHSを見てもcopy-readtableを使えとしか書いていません．普通の使い途では空のリードテーブルなんて意味のないものは必要ないからだと思いますが以下のような形でできました．
(make-instance 'readtable)
本当にできているかテストしてみます．
* (read-from-string "(+ 1 2)")
(+ 1 2)
7
* (let ((*readtable* (make-instance 'readtable))) (read-from-string "(+ 1 2)"))
debugger invoked on a SB-INT:SIMPLE-READER-ERROR:
invalid constituent
Line: 1, Column: 2, File-Position: 2
Stream: #<SB-IMPL::STRING-INPUT-STREAM {50EF69C9}>
...
大丈夫そうなので以下のように定義しておきます．
(defvar *bf-readtable* (make-instance 'readtable))
2. 各命令に対応するリーダマクロ
肝心の部分です．なお先立ってポインタとメモリを以下のように定義しておきます．
(declaim ((simple-array (unsigned-byte 8) (*)) *memory*))
(defvar *memory* (make-array 30000 :element-type '(unsigned-byte 8)))
(defvar *pointer* 0)
+,-
単純には以下のようにして実装できます．
(defun plus-reader (stream char)
(declare (ignore steam char))
'(incf (aref *memory* *pointer*)))
(set-macro-char #\+ #'plus-reader nil *bf-readtable*)
ただしこれだと+が出てくるたびに配列へのアクセスが発生するため非効率です．なので連続する+と-を数え上げることで対処します．これは>と<でも使えるので数え上げの関数を別途用意します．
(defun count-positive-and-negative-chars (positive-char negative-char stream char)
(let ((chars (loop :for char := (read-char stream nil)
:while (find char `(,positive-char ,negative-char)) :collect char
:finally (unread-char char stream))))
(- (count positive-char chars)
(count negative-char chars)
(if (char= char negative-char) 1 -1))))
loopの:finally節で(unread-char char stream)としているのは余分に読んでしまった文字を一つ戻すためです．
(defun plus-minus-reader (stream char)
`(incf (aref *memory* *pointer*) ,(count-positive-and-negative-chars #\+ #\- stream char)))
(set-macro-char #\+ #'plus-minus-reader nil *bf-readtable*)
(set-macro-char #\- #'plus-minus-reader nil *bf-readtable*)
これで例えば++-+++は(incf (aref *memory* *pointer*) 4)に展開されます．
>,<
同様にcount-positive-and-negative-charsを使います．
(defun gt-lt-reader (stream char)
`(incf *pointer* ,(count-positive-and-negative-chars #\> #\< stream char)))
(set-macro-char #\> #'gt-lt-reader nil *bf-readtable*)
(set-macro-char #\< #'gt-lt-reader nil *bf-readtable*)
,,.
入出力です．これらは簡単なので特に説明はなしです．
(defun comma-reader (stream char)
(declare (ignore stream char))
'(setf (aref *memory* *pointer*) (char-code (read-char *standard-input*))))
(defun dot-reader (stream char)
(declare (ignore stream char))
'(princ (code-char (aref *memory* *pointer*))))
(set-macro-character #\, #'comma-reader nil *bf-readtable*)
(set-macro-character #\. #'dot-reader nil *bf-readtable*)
[, ]
ループです．現在のポインタの値が非0である限り処理を繰り返します．
例えば[処理...]なら以下のようなコードに展開されれば良さそうです．
(loop :until (zerop (aref *memory* *pointer*)
:do (progn 処理...))
閉じカッコが現れるまでreadして読み出した式のリストを上記の処理...の箇所に展開するようなマクロを開きカッコに設定します．
(defun openparen-reader (stream char)
(declare (ignore char))
(let ((body (loop :for form := (read stream t)
:until (eql form ']) :collect form)))
`(loop :until (zerop (aref *memory* *pointer*))
:do (progn ,@body))))
(set-macro-character #\[ #'openparen-reader nil *bf-readtable*)
readでEOFに当たったときのエラーを有効にしてあるので対応する閉じカッコがない場合エラーを吐きます．
閉じカッコは必要ないので先程のように読み戻しは必要ありません．
2018/03/19更新
閉じカッコが']に展開される必要がありました．入れ子のループを含むコードでエラーになったので気づきましたが入れ子じゃないループで動いていたので気づきませんでした．じゃあなんで入れ子じゃないループでちゃんと動くのかというと謎なんですがこの辺りは勉強不足でリーダマクロに関する理解が足りてないか間違っているのだと思います．どなたか詳しい方にご教示願いたいです…．
(defun closeparen-reader (stream char)
(declare (ignore stream char))
'])
(set-macro-character #\] #'closeparen-reader nil *bf-readtable*)
その他
このままだと改行が有効な文字として認識されないので非nilな適当なものに展開されるリーダマクロを設定しておきます．
(defun newline-reader (stream char)
(declare (ignore stream char))
't)
(set-macro-character #\newline #'newline-reader nil *bf-readtable*)
またコメントが使えないのは辛いので独自の拡張として;から行末までをコメントとします．
(set-macro-character #\; (get-macro-character #\;) nil *bf-readtable*)
3. ソースをロードする
最低限のエラーハンドラをつけて以下のような形になります．
(defmacro with-simple-handler (&body body)
`(handler-case
(let ((*error-output* (make-broadcast-stream))) ,@body)
(condition (c) (format t "~&~a~%" c))))
(defun execute-brainfuck (file)
(with-simple-handler
(let ((*readtable* *bf-readtable*))
(load file))))
試しにbrainfuckでHello world!しておきます．
; Hello World!
>+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]>++++++++[<++
++>-]<.>+++++++++++[<+++++>-]<.>++++++++[<+++>-]<.+++.------.--------.[-]>
++++++++[<++++>-]<+.[-]++++++++++.
* (execute-brainfuck "hello.bf")
Hello World!
T
ちゃんとロードされてHello World!が表示されました．
ついでにCommon Lispは実行ファイルも作れるので以下のような関数も作ってみました．
(defun compile-brainfuck (input output)
(let ((toplevel-forms))
(with-open-file (stream input :direction :input)
(let ((*readtable* *bf-readtable*))
(setf toplevel-forms
`(with-simple-handler ,@(loop :for form := (read stream nil)
:while form :collect form)))))
(save-lisp-and-die output
:toplevel (lambda () (eval toplevel-forms))
:executable t
:purify t)))
ソースコードを順にリードして読み込んだ内容を評価する関数を作成，それをsb-ext:save-lisp-and-dieの:toplevevlに渡して実行ファイルを作成しています．1
* (compile-brainfuck "hello.bf" "hello")
; helloが出力される
$ ./hello
Hello World!
おわりに
今回作成したものはここに上げてあります．sbcl --script brainfuck.lispで実行できます．リーダマクロは本当になんでもできてしまうのであまり積極的に使うものではないと思いますがおもちゃとしては楽しくて良いです．ここまでお読み頂きありがとうございました．