SnowClust Haskell: ParsecのParsecによるBrainfuck

スポンサーサイト

上記の広告は１ヶ月以上更新のないブログに表示されています。新しい記事を書く事で広告が消せます。

--------(--:--) :
スポンサー広告 :

このページのトップへ

Haskell: ParsecのParsecによるBrainfuck

コンパイラ屋にとってのFizzBuzzであるbrainfuckを(今更)Haskellで実装してみる。
Haskell実装は型レベルで書いたりピュアに書いたり色々だけど、ここではParsec3の機能を使ってパースと評価を同時にやってみる。

参考サイト

Haskell で Brainf*ck interpreter
Brainfuck - Wikipedia
Parsec 3活用事例: Keepalived構文チェッカ

ソース (BrainFuck.hs)

module BrainFuck where
import Text.Parsec
import Control.Applicative hiding ((<|>),many,optional)
import Control.Monad.Trans (liftIO)
import Control.Arrow (first, second)
import Control.Monad (when)
import Data.Char (ord,chr)
import Data.Word (Word8) 

type UState = ([Word8],Int)
initialUState = (replicate 3000000 0,0) :: UState 

expr :: Bool ->  ParsecT String UState IO [()]
expr b =  many $ (when b . doAction =<< oneOf "<>+-.,") <|> whileExpr
  where whileExpr = do 
          inp <- getInput
          pos <- getPosition
          getState >>= between (char '[' ) (char ']') . expr . loopCond 
          getState >>= flip when (setInput inp >> setPosition pos) . loopCond
          where  loopCond  =  (b &&) . (0 /=) . uncurry (!!)
        doAction o = case o of
          '.' -> liftIO . putChar . chr . fromIntegral . uncurry (!!)  =<< getState 
          ',' -> modifyState . update . const .  fromIntegral . ord =<< liftIO getChar 
          '>' -> modifyState (second succ)
          '<' -> modifyState (second pred)
          '+' -> modifyState (update (1+))
          '-' -> modifyState (update (-1+))
          where update f (a,b)  = (upd a b,b)
                  where upd (l:ls) 0 = f l : ls
                        upd (l:ls) i = l : upd ls (i-1)

brainFuck :: String -> IO ()
brainFuck input = do
  res <- runParserT (expr True >> eof) initialUState "BRAINFUCK" (filter (' ' /=) input)
  case res of
    Left err -> print err
    otherwise -> return ()

fromFile :: FilePath -> IO ()
fromFile p = readFile p >>= brainFuck

-- sample program
helloWorld = "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+."

sierpinski = ">++++++++[-<++++>>++++>+<<]>>++>++<<<<[-[->+<]>[->.<<+>]>>>[-[->+<]+>[<+>+++++++[->++++++<]>-.-[-<++>]<.[-]]++<[->-<]++>[<->+++++++[->++++<]>..[-]<]>>]+<<<[-[->+<]+>[-<+>>>-[->+<]++>[-<->]<<<]<<<<]>>.<<<]"

動作

GHCi, version 6.10.4: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer ... linking ... done.
Loading package base ... linking ... done.
[1 of 1] Compiling BrainFuck        ( BrainFuck.hs, interpreted )
Ok, modules loaded: BrainFuck.
*BrainFuck> brainFuck helloWorld 
Loading package syb ... linking ... done.
Loading package bytestring-0.9.1.4 ... linking ... done.
Loading package mtl-1.1.0.2 ... linking ... done.
Loading package parsec-3.0.1 ... linking ... done.
Hello, world!*BrainFuck> brainFuck sierpinski 
                               /\
                              /\/\
                             /\  /\
                            /\/\/\/\
                           /\      /\
                          /\/\    /\/\
                         /\  /\  /\  /\
                        /\/\/\/\/\/\/\/\
                       /\              /\
                      /\/\            /\/\
                     /\  /\          /\  /\
                    /\/\/\/\        /\/\/\/\
                   /\      /\      /\      /\
                  /\/\    /\/\    /\/\^C  Interrupted.
*BrainFuck>

解説

Parsec3の目玉はモナド変換に対応した事と、デフォルトでApplicativeのインスタンスになったことらしい。
しかし、元々Parsecの便利機能としてユーザーステートなるものが用意されているのはあまり知られていないんじゃないかと思う。
今回はモナド変換とユーザーステートを使って評価器も作ってみる。

パーサーの型

expr :: Bool ->  ParsecT String UState IO [()]

モナド変換の受け皿にIOを入れてある。
今回はデータ構造を作らずに評価だけして捨てるので、戻り値に意味は無い。
評価のアクションを行うか否かはフラグで管理する。
UStateはテープとポインタの対。

type UState = ([Word8],Int)

ちなみにこの形だとuncurry (!!) で要素が取れるのでちょっと気持ち良い。

パーサー＋評価器

expr b =  many ((when b . doAction =<< oneOf "<>+-.,") <|> whileExpr b)

<|>の一つ目のパーサーではトークンを消費してフラグbがTrueのときに限りdoActionを行う。
こうやってパースした結果を別の処理に投げて何か悪いことをした後に何食わぬ顔で結果を返すテクニックはパース時に小細工をするときに割と便利なのでよく使う。
doActionではmodifyStateで状態遷移を行う。ここ(.)と(,)の入出力に積み込んだIOモナドを使う。

        doAction o = case o of
          '.' -> liftIO . putChar . chr . fromIntegral . uncurry (!!)  =<< getState 
          ',' -> modifyState . update . const .  fromIntegral . ord =<< liftIO getChar 
          '>' -> modifyState (second succ)
          '<' -> modifyState (second pred)
          '+' -> modifyState (update ((+) 1))
          '-' -> modifyState (update (flip (-) 1))

(+)と(-)によるオーバー・アンダーフローはテープの要素の型がWord8なので循環する。

繰り返し処理

ループ([…])の処理のやり方は色々あるのだけど、ここではループ条件が偽の時はパースだけして評価を行わず条件ジャンプはパーサーの読み込み文字列を巻戻すことで実現する。

  where whileExpr b = do 
          inp <- getInput
          pos <- getPosition
          getState >>= between (char '[' ) (char ']') . expr . loopCond 
          getState >>= flip when (setInput inp >> setPosition pos) . loopCond
          where  loopCond (ls,p) =  (b && 0 /= (ls !! p))

入力と位置をいじくる関数はオフサイドルールを組み込んだ構文を作る時にも使ったりする。

パーサーの起動

exprはモナド変換を組み込んだパーサーなのでrunParserTを使う。
ここでinitialUStateでマシンの状態を初期化して、プリプロセスした入力文字列をパースした結果がEitherモナドで得られる。
パーサーの最後でeofをパースさせるようにしないと入力を残してもエラーにならないので注意。
パースに失敗した時はerrから失敗した位置の情報が得られる。
プリプロセスしてるのでスペースが入ってると位置情報がずれてしまう。ので本当はlexeme使ったりしっかりコメントアウト構文をしないといけない。

その他

今回使ったやり方を応用すると、例えば未定義変数の使用を検出したり型検査を走らせたりするパーサーがアクションの合成で出来るようになる。
モナド変換にIOを組み込むとパーサーが強力になりすぎるので濫用はおすすめしない。
ユーザーステートがあるのでよほどの事が無い限りStateモナドを合成する必要は無い。
Brainfuck自体も少し手を加えるだけでジョーク言語に早変わりするし、評価器としてターゲットにすることも出来るぞ。

このページのトップへ

トラックバック

この記事にトラックバックする(FC2ブログユーザー)

このページのトップへ

コメントの投稿

このページのトップへ