ふと思い立って Haskell で brainfuck を書いてみた。そんな事やってる人は沢山いると思うので、一つ制限をつけた。モナドは main 関数の中だけしか使わない。つまり、後は全部副作用なしでやる。
それから、大体の方針を立てた。brainfuck の文法はとても単純なので、もしかしてパーサすらいらないんじゃ無いかと思ったのだけど、ループがある関係上やっぱり最初に構文木を作ったほうがやりやすい。という事でオーソドックスに、ソースコード -> 構文木 -> 実行、と言う順序で進める事にした。
-- Parser data Command = Inc | Dec | Next | Prev | Put | Get | While [Command] deriving (Show, Eq) type Program = [Command] parse :: String -> Program parse s = program where (program, "") = parse1 s parse1 :: String -> (Program, String) parse1 "" = ([], "") parse1 (']':xs) = ([], xs) parse1 ('[':xs) = (While cmds1 : cmds2, rest2) where (cmds1, rest1) = parse1 xs (cmds2, rest2) = parse1 rest1 parse1 (x:xs) = (parse2 x, rest) where (cmds, rest) = parse1 xs parse2 :: Char -> Program parse2 '>' = Next : cmds parse2 '<' = Prev : cmds parse2 '+' = Inc : cmds parse2 '-' = Dec : cmds parse2 '.' = Put : cmds parse2 ',' = Get : cmds parse2 _ = cmds
パーサはこんな感じ。例えば "+[,.+]" をパースするとこうなる。
Main> parse "+[,.+]" [Inc,While [Get,Put,Inc]]
While のところ以外は単純。その副作用無しで While の木を作るのに無茶苦茶悩んだ。結局 "]" をパースする時にまだパースしていない文字列も返すようにして、"[" の部分に上手く継ぎ足す形にした。もっと美しい方法ないかな。
-- Tape type Tape = ([Char], Int) tape0 = (['\NUL', '\NUL'..], 0) :: Tape getCell :: Tape -> Char getCell (cs, i) = cs !! i setCell :: Tape -> Char -> Tape setCell (cs, i) c = (take i cs ++ (c : drop (i + 1) cs), i) inc, dec, next, prev :: Tape -> Tape inc t = setCell t (succ $ getCell t) dec t = setCell t (pred $ getCell t) next (cs, i) = (cs, i + 1) prev (cs, i) = (cs, i - 1)
次は brainfuck で使うメモリテープ。単に無限リストと現在の位置を表す数字だけなのでこれも単純。初期値として、tape0 というヌル文字の無限リストを提供する。遅延評価により、自動的に必要な分だけリストが作られる。
あとで便利なように getCell、setCell という二つのアクセッサを作る。そして、inc, dec, next, prev は brainfuck の "+-><" に対応する操作。この操作には IO が関係しないので、簡単にテープの関数として書ける。
-- Evaluator type Status = (Program, Tape, [Char], [Char]) step :: (Tape -> Tape) -> Status -> Status step f (c:cs, tape, inp, outp) = eval (cs, f tape, inp, outp) eval :: Status -> Status eval (Get : cmds, tape, (i:inp), outp) = eval (cmds, setCell tape i, inp, outp) eval (Get : _, _, "", _) = error "EOF" eval s @ (Put : _, tape, _, _) = (cmds, tape1, inp, getCell tape : outp) where (cmds, tape1, inp, outp) = step id s eval s @ (Inc : _, _, _, _) = step inc s eval s @ (Dec : _, _, _, _) = step dec s eval s @ (Next : _, _, _, _) = step next s eval s @ (Prev : _, _, _, _) = step prev s eval s @ (While cmds : cmds1, tape, inp, outp) = while (getCell tape) where while '\NUL' = step id s while _ = (cmds2, tape2, inp2, outp1 ++ outp2) where (_ , tape1, inp1, outp1) = eval (cmds, tape, inp, outp) (cmds2, tape2, inp2, outp2) = eval (While cmds : cmds1, tape1, inp1, outp1) eval ([], t, i, _) = ([], t, i, "")
次にいよいよ実行機構。ある瞬間の機械の状態を (Program, Tape, [Char], [Char]) という風にする。つまり、命令の列(これはだんだん頭から減って行くので、プログラムカウンタの意味も持つ)、メモリテープ、入力、出力。入力と出力は単なる文字列だが、心のなかで『これはストリーム！』と叫びながら使う。特に、出来るだけ ++ を使わないようにする。
step は便利関数で、命令を一つ削除し(つまり一つ前に進んで)、テープの状態を変化させる。Put で使っているように step id s のように使うと、テープの状態は変わらないで時間だけが進む(id は何もしない関数)。
eval は命令を全部実行する関数。引数に現在の状態を受け取り、実行結果を返す。典型的には、eval は内部で eval 自体を呼び出し、再帰的に次々実行して行く。ざっと説明するとこうなっている。
- eval 今の状態 = (命令, テープ, 入力, 今回の答え : eval (次の状態))
コロンはアトムとリストを連結する演算子なので、出力結果は (今回の答え：eval (次の状態))。ポイントは、Haskell は遅延評価を行うので、必要な分しか eval (次の状態) を計算しない所。
-- Environment run :: Program -> [Char] -> [Char] run cmds inp = outp where (_,_,_, outp) = eval (cmds, tape0, inp, "") main :: IO () main = do cs <- getContents args <- getArgs source <- readFile (head args) putStr $ run (parse source) cs
最後に実行環境の設定。do 文は引数を読み込むのと標準入出力用だけに使っている。実行は runhaskell.exe bf.hs file.bf のようにするか、haskell インタプリタで、
Main> run (parse ",+.,+.,+.") "HAL" "IBM"
のようにするのも乙。なんで思い立ったか書こうと思ったけど眠くなったので今度にします。
