注意: Haskellerの方は, 私のコードを見る前に自分で実装したほうが, 気持ちがよく分かると思います. 頑張って下さい. 自分で実装したのと, 私のコードを比べてみてください!!!
HaskellでBrainfuckインタープリタ書きました.
-- Brainfuck interpreter in Haskell import Data.Char (chr, ord) import Control.Monad (void) import Control.Arrow (first, app, (***), (>>>)) data BF = Incr | Decr | Next | Prev | Put | Get | While [BF] type State = ([Int], Int, [Int]) (<>>) :: a -> ([a], b) -> ([a], b) (<>>) = first . (:) parse :: String -> [BF] parse = fst . parse' where parse' :: String -> ([BF], String) parse' ('+':bs) = Incr <>> parse' bs parse' ('-':bs) = Decr <>> parse' bs parse' ('>':bs) = Next <>> parse' bs parse' ('<':bs) = Prev <>> parse' bs parse' ('.':bs) = Put <>> parse' bs parse' (',':bs) = Get <>> parse' bs parse' ('[':bs) = app $ ((<>>) . While *** parse') (parse' bs) parse' (']':bs) = ([], bs) parse' (_:bs) = parse' bs parse' [] = ([], []) run :: [BF] -> IO () run = void . flip run' ([], 0, []) where run' :: [BF] -> State -> IO State run' (Incr:bs) (xs, x, ys) = run' bs (xs, x + 1, ys) run' (Decr:bs) (xs, x, ys) = run' bs (xs, x - 1, ys) run' (Next:bs) (xs, x, []) = run' bs (x:xs, 0, []) run' (Next:bs) (xs, x, y:ys) = run' bs (x:xs, y, ys) run' (Prev:bs) s@([] , _, _) = run' bs s run' (Prev:bs) (x:xs, y, ys) = run' bs (xs, x, y:ys) run' (While _:bs) s@(_, 0, _) = run' bs s run' bbs@(While bs:_) s = run' bs s >>= run' bbs run' (Put:bs) s@(_, x, _) = putChar (chr x) >> run' bs s run' (Get:bs) (xs, _, ys) = getChar >>= \x -> run' bs (xs, ord x, ys) run' [] s = return s main :: IO () main = readFile "hello.bf" >>= (parse >>> run)
~$ echo "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+." > hello.bf ~$ runhaskell bf.hs Hello, world!% ~$
(%記号は改行なしのアレ)
自分で言うのもなんだけど, コードが美しい...
「ifなしletなしswitchなし」は基本ですね.
これ以上に美しいコードが書けた人は, 勉強したいので教えてほしいです.
解説
main :: IO () main = readFile "hello.bf" >>= (parse >>> run)
これは, 次のコードと同じです.
main :: IO () main = do code <- readFile "hello.bf" run (parse code)
(>>>)は, (<<<)の逆で, (<<<)は(.)と同じです.
Control.Categoryの中で定義されていますが, Control.Arrowで再エクスポートされています.
上のコードのように, (>>=)と親和性がいいと思います.
data BF = Incr | Decr | Next | Prev | Put | Get | While [BF] -- + - > < . , [ ]
Brainfuckのコードの「素」を定義します.
data BF = Incr | Decr | Next | Prev | Put | Get | WhileStart | WhileEnd -- + - > < . , [ ]
という方法もあります.
こちらはコードに近くてパースはしやすいのですが, 実行しにくい形です.
type State = ([Int], Int, [Int])
ポインターの状態を表します.
(左, 今, 右)としました.
ポインター全体は, (reverse 左 ++ [今] ++ 右)となります.
data State = State { tape :: [Word8], pos :: Int }
みたいにすることもできますが, リストだとアクセスが遅い→Arrayにするか→めんどくさ...
的な, いつものあれなので.
あと, (左, 今, 右)とできるのは, Brainfuckで突然「絶対位置10の場所にジャンプ」とかが無く, 必ずすぐ左かすぐ右にしか動かないからですね.
(<>>) :: a -> ([a], b) -> ([a], b) (<>>) = first . (:) parse :: String -> [BF] parse = fst . parse' where parse' :: String -> ([BF], String) parse' ('+':bs) = Incr <>> parse' bs parse' ('-':bs) = Decr <>> parse' bs parse' ('>':bs) = Next <>> parse' bs parse' ('<':bs) = Prev <>> parse' bs parse' ('.':bs) = Put <>> parse' bs parse' (',':bs) = Get <>> parse' bs parse' ('[':bs) = app $ ((<>>) . While *** parse') (parse' bs) parse' (']':bs) = ([], bs) parse' (_:bs) = parse' bs parse' [] = ([], [])
Haskellの特徴である, 演算子を定義できるのを使ってみました.
例えば,
parse' ('+':bs) = Incr <>> parse' bs
は
parse' ('+':bs) = first (Incr:) $ parse' bs
と, さらに,
parse' ('+':bs) = let (b, s) = parse' bs in (Incr:b, s)
と同じです.
'['のコードも, Arrowに慣れていないと意味不明ですよね.
parse' ('[':bs) = app $ ((<>>) . While *** parse') (parse' bs)
は, 元に戻すと
parse' ('[':bs) = let (b, s) = parse' bs in While b <>> parse' s
と同じで, 更に
parse' ('[':bs) = let (b, s) = parse' bs (b', s') = parse' s in (While b:b', s')
と同じです.
parse' (_:bs) = parse' bs
変な文字が入っていたら, それをスキップします.
スペースとか改行とかよく入っているので...
parse' [] = ([], [])
終了条件. 大事.
次はrunを見てみましょう.
run :: [BF] -> IO () run = void . flip run' ([], 0, [])
これは,
run code = run' code ([], 0, []) >> return ()
と同じですね. ただ, ghc-modに怒られてしまうので, voidを使ってみました.
run' :: [BF] -> State -> IO State run' (Incr:bs) (xs, x, ys) = run' bs (xs, x + 1, ys) run' (Decr:bs) (xs, x, ys) = run' bs (xs, x - 1, ys)
テープの現在の値に, 足したり引いたりします.
run' (Next:bs) (xs, x, []) = run' bs (x:xs, 0, []) run' (Next:bs) (xs, x, y:ys) = run' bs (x:xs, y, ys) run' (Prev:bs) s@([] , _, _) = run' bs s run' (Prev:bs) (x:xs, y, ys) = run' bs (xs, x, y:ys)
ポインターを動かします.
ここでは, テープの長さは決め打ちせずに, 必要に応じて長くなるようになっています.
また, 本当なら負の領域にアクセスしたらダメなんですが, そういうことをやりだすとコードが汚くなっていくので, 左端に壁があるものとしました.
run' (While _:bs) s@(_, 0, _) = run' bs s run' bbs@(While bs:_) s = run' bs s >>= run' bbs
Whileループの実行です.
メモリーの今の位置の値が0なら, Whileをすっぽかして次のコードを実行します.
そうでなければ, Whileループの中を一回実行して, その結果の状態をまた判定します.
run' (Put:bs) s@(_, x, _) = putChar (chr x) >> run' bs s run' (Get:bs) (xs, _, ys) = getChar >>= \x -> run' bs (xs, ord x, ys)
Putは出力, Getは入力ですね.
それぞれchr, ordを使ってIntと変換します.
run' [] s = return s
終了条件. 大事.
改めてコードを見てみると, やはりコード全体が引き締まって見えますね.
ああ美しい.
インタープリタならデータ構造作らなくていいんじゃ
という説もありますが, やはりコードの上を行ったり来たりするのはアホらしいです.
特に, [ と ] の間は, いちいち「対応するカッコに(進む|戻る)」関数を書かなくてはならないので...
まぁ実際書いてみたら, 40行を切って, 一番上のコードより短くなったんですけどね.
でも汚いです.
ループのパースをどうやるか
上記のコードにたどり着くまで, ちょっとだけ時間がかかりました.
イメージしてください. Brainfuckのコードから, 再帰的な構造 While [BF] を作るタスクです.
パースする関数は, おそらく
parse :: String -> [BF]
でしょう.
完璧なコードしか入ってこないものとし, parse error, invalid codeとかは無いとします*1.
最初に思いつくのはこんな感じではないでしょうか.
parse ('[':bs) = let s = takeToMatchBracket bs in While (parse s) : opps..... takeToMatchBracket :: String -> String
対応するカッコまでの文字を持ってくる... あ, 残りも要りますがな...
parse ('[':bs) = let (l, r) = splitToMatchBracket bs in While (parse l) : parse r splitToMatchBracket :: String -> (String, String)
これに満足して, 実装しだしたら, 泥沼ですね. 最悪です.
何がダメかというと, コードの上を何度も舐めることになるからです.
もし, Brainfuckのコードが
+[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[-]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]
みたいなのだったらどうなるか, 想像付きますね?
splitToMatchBracket関数で最後まで舐めて, splitして, 更に切り出したものをparseに掛けます.
こんなアホらしいことやる人いませんね.
コードの上は一回舐めればいいはずです.
一回舐めたらBFの再帰的構造
data BF = Incr | Decr | Next | Prev | Put | Get | While [BF]
を作れるはずです.
どうすればいいのでしょうか.
ひとつの答えが, (結果, 未処理文字列)です.
-- コード -> (結果, 未処理) parse' :: String -> ([BF], String)
こうしておくと, トップレベルのparse関数は
parse code = let (result, rest) = parse' code in result
で,
parse code = fst (parse' code)
となり,
parse = fst . parse'
となることが分かりますね. (ただし, 入力がすべてvalidなコードとします)
では, parse'関数を書いてみましょう.
やはり, よくある再帰処理になります.
parse' ('+':bs) = let (result, rest) = parse' bs in (Incr : result, rest)
こんな感じですね.
しかし, 同様に書いていくと
parse' ('+':bs) = let (result, rest) = parse' bs in (Incr : result, rest) parse' ('-':bs) = let (result, rest) = parse' bs in (Decr : result, rest) parse' ('>':bs) = let (result, rest) = parse' bs in (Next : result, rest) parse' ('<':bs) = let (result, rest) = parse' bs in (Prev : result, rest) parse' ('.':bs) = let (result, rest) = parse' bs in (Put : result, rest) parse' (',':bs) = let (result, rest) = parse' bs in (Get : result, rest)
とかなって, なんか嫌です.
同じ部分は関数にしましょう.
parse' ('+':bs) = f Incr bs parse' ('-':bs) = f Decr bs parse' ('>':bs) = f Next bs parse' ('<':bs) = f Prev bs parse' ('.':bs) = f Put bs parse' (',':bs) = f Get bs f b bs = let (result, rest) = parse' bs in (b : result, rest)
ええ, ましになりました.
ただ, Arrowを一度知った身としては, 「, rest)」のあたりが気になってしょうがありません.
まず, fからlet inを取り除きます.
f b bs = first (b:) $ parse' bs
ここで, 一歩立ち止まります.
「fを演算子にしたらもっとかっこよくなるんじゃ?」
「でもparse'なんてものが入っているのを演算子とかにしたくないなぁ...」
「もっと一般的な部分を取り出して...」
というわけで, 一歩戻ります.
parse' ('+':bs) = f Incr bs f b bs = let (result, rest) = parse' bs in (b : result, rest)
要は, bをfstに入れ込むことがしたいのです.
parse' ('+':bs) = f Incr bs f b bs = (\(l, r) -> (b:l, r)) (parse' bs)
そうか, parse'までfに入れなくていいんだ.
parse' ('+':bs) = f Incr (parse' bs) f b bs = (\(l, r) -> (b:l, r)) bs
fを演算子にして
(<>>) :: a -> ([a], b) -> ([a], b) (<>>) b (l, r) = (b:l, r) parse' ('+':bs) = Incr <>> parse' bs
おお, カッコいい!!!
記号は基本的になんでもいいので, 「右のタプルに入れ込む」みたいな気持ちを込めて(<>>)にしてみました.
ここで, 悪魔がささやきます.
「これ, Arrowで書いたらモテるんじゃね?」
firstを使って
(<>>) b (l, r) = first (b:) (l, r)
η変換して
(<>>) b = first (b:)
或いは
(<>>) b = first $ ((:) b)
($) を (.) に置き換えて
(<>>) b = first . (:) $ (b)
η変換して
(<>>) = first . (:)
完成.
バッチリです.
これで気になるあの娘も落とせそうですね.
さて,
-- コード -> (結果, 未処理) parse' :: String -> ([BF], String)
の形にしたのは, ループのパースのためでした.
取り敢えず, ループの最後は
parse' (']':bs) = ([], bs)
と書くことができます.
ループの最後に到達したら, 取り敢えずそれまでも[BF]の結果を返してあげて, 残りのコードは未処理とするのです.
ではループの最初はどうするかというと,
parse' ('[':bs) = let (result, rest) = parse' bs in ...
この段階で, resultには括弧中の結果が, restには未処理のコードが入ります.
従って, restをまたparse'で処理して
parse' ('[':bs) = let (result, rest) = parse' bs (result', rest') = parse' rest in (While result : result', rest')
が正解ですね.
すぐ分かるように, While result : の部分は, さっきも見た「タプルのfstの要素の最初に追加する系」です.
従って,
parse' ('[':bs) = let (result, rest) = parse' bs in While result <>> parse' rest
となります.
しかし, Arrow病を発病すると, こんなタプルでさえ耐えられなくなってきます.
とにかく変換します.
parse' ('[':bs) = let (result, rest) = parse' bs in (((<>>) . While) result) (parse' rest)
(result, rest)が引数となるような関数をArrowで作ります. (f a) (g b) == app $ (f *** g) (a, b)ですね. (app :: (b -> c, b) -> c ですよ!)
parse' ('[':bs) = let (result, rest) = parse' bs in app $ (((<>>) . While) *** parse') (result, rest)
そうするとlet inを消すことができて
parse' ('[':bs) = app $ (((<>>) . While) *** parse') (parse' bs)
さらに, (.)の優先度は9, (***)の優先度は3なので, 括弧がひとつ不要です.
parse' ('[':bs) = app $ ((<>>) . While *** parse') (parse' bs)
こうやって一番最初のコードにたどり着いたのです.
Arrowを知ってたらコードの流れがよく分かりますね.
「appで適用して... *** は上と下に並行して適用して...」
まとめ
言いたいことは, Arrowバンザイではなくて, 妥協して効率の悪いプログラムを書くな, ですね.
Whileのために, 入力のコードの上を何度も行ったり来たりするのなんて馬鹿げてますよね.
そんな効率の悪いコード, C言語じゃ書かないでしょう?
Haskellだから許される, ではありません.
型を考えなさい, それが良い処方箋ですね.
ところで, Brainfuckのインタープリタは, なんかいつ書いても飽きないですね.
あと, parse'やrun'をfoldrか何かを使って書こうとしたけど失敗したので, 誰かやっておいてください. できるかどうかしらんけど.
追記(2012/12/24)
最近fmapの有用性に気がついたのですが, 上に書いた(<>>)は, (<$>)で書けることに気が付きました.
Functor ((,) a)なので, タプルを逆にしなきゃいけないんですけどね.
import Data.Functor ((<$>)) import Control.Monad.Instances parse :: String -> [BF] parse = snd . parse' where parse' :: String -> (String, [BF]) parse' ('+':bs) = (Incr:) <$> parse' bs parse' ('-':bs) = (Decr:) <$> parse' bs parse' ('>':bs) = (Next:) <$> parse' bs parse' ('<':bs) = (Prev:) <$> parse' bs parse' ('.':bs) = (Put:) <$> parse' bs parse' (',':bs) = (Get:) <$> parse' bs parse' ('[':bs) = app $ (flip (<$>) . parse' *** (:) . While) (parse' bs) parse' (']':bs) = (bs, []) parse' (_:bs) = parse' bs parse' [] = ([], [])
*1:つまりパーサー的な失敗系にする必要がない. [なしの]は, そこで打ち切り, ]なしの[は, 最後にマッチする]を加えたのと同様に動きます.