Brainfuck

今更ながらにBrainfuckを実装してみた。
いつもどおりHaskellで…
http://www.muppetlabs.com/~breadbox/bf/

言語仕様的にどっちかと言うとコンパイラのほうが簡単である。

main = interact $ (header++).(++footer).(>>= cvt).(filter (`elem` "><+-.,[]")) where
  cvt '>' = "++p;"
  cvt '<' = "--p;"
  cvt '+' = "++*p;"
  cvt '-' = "--*p;"
  cvt '.' = "putchar(*p);"
  cvt ',' = "*p=getchar();"
  cvt '[' = "while(*p){"
  cvt ']' = "}"
  cvt _   = ""

  header = "#include \n"++
	   "int main(){ static char dat[30000],*p=dat; "
  footer = "}\n"

Cへのコンパイラ。
文字列の置換しかやっていない。
まぁ、こんなコードには何の面白みも無いのだが。

import Text.ParserCombinators.Parsec
import Data.Array.MArray
import Data.Array.IO
import Data.Word
import Data.Char
import Control.Monad
import System

type State = (IOUArray Int Word8,Int)

bfp :: Parser (State -> IO State)
bfp = many p >>= \pp -> return (\st -> foldM (flip ($)) st pp) where
  p   = (char '>' >> return (\(a,i) -> return (a,i+1)))
    <|> (char '<' >> return (\(a,i) -> return (a,i-1)))
    <|> (char '+' >> return (\(a,i) -> modifyArray i (+1) a >> return (a,i)))
    <|> (char '-' >> return (\(a,i) -> modifyArray i (flip (-)1) a >> return (a,i)))
    <|> (char '.' >> return (\(a,i) -> readArray a i >>= putChar.chr.fromEnum >> return (a,i)))
    <|> (char ',' >> return (\(a,i) -> getChar >>= writeArray a i.toEnum.ord >> return (a,i)))
    <|> (between (char '[') (char ']') bfp >>= return.while)
  while b (a,i) = do
    n <- readArray a i
    if (n/=0) then b (a,i) >>= while b else return (a,i)

modifyArray i f a = readArray a i >>= writeArray a i . f

main = do
  [f] <- getArgs
  c   <- readFile f
  case parse bfp "" (filter (`elem` "><+-.,[]") c) of
    Left err -> putStrLn "error at " >> print err
    Right f  -> newArray (0,29999) (0::Word8) >>= \a -> f (a,0) >> return ()

これがインタプリタ。
思ったより小さくない。
パーズにParsecを使ったから多少冗長になっている気もする。
パーザーが返すものが計算だというのがミソといえばミソか。
動作速度は、Unboxed Mutable Arrayを使って、
計算の構築も一回だけなはずなのにあまり速くない。
どうしたものか。