HaskellでBrainfuckの処理系を実装する

Brainfuckとは

• http://ja.wikipedia.org/wiki/Brainfuck

プログラムの動かし方

• runghc Brainfuck.hs < [Brainfuckのソースコード]

課題

'.' ポインタが指す値を出力に書き出す。C言語の「putchar(*ptr);」に相当。

IOモナドを使いたくない(使えない）のでマシン状態の中にディスプレイを作って処理した。

',' 入力から1バイト読み込んで、ポインタが指す先に代入する。C言語の「*ptr=getchar();」に相当。

複雑になりそうだったので実装しなかった。

-- Brainfuck.hs
import Data.Char

main = do 
    cs <- getContents
    putStrLn $ runBrainfuck cs
runBrainfuck p = display $ runOneStep $ Machine p 0 [0,0..] 0 ""
runOneStep (Machine a b c d e) = if (length a) == b then Machine a b c d e
                                                    else runOneStep $ incrementProgramPointer func
    where func = case (a!!b) of
                    '>' -> incrementPointer (Machine a b c d e)
                    '<' -> decrementPointer (Machine a b c d e)
                    '+' -> incrementMemory (Machine a b c d e)
                    '-' -> decrementMemory (Machine a b c d e)
                    '.' -> putCharToDisplay (Machine a b c d e)
                    ']' -> jumpEnd (Machine a b c d e)
                    '[' -> jumpStart (Machine a b c d e)
                    otherwise -> (Machine a b c d e)
incrementProgramPointer (Machine a b c d e) = Machine a (b+1) c d e
data Machine = Machine { program::String,programPointer::Int,memory::[Int],memoryPointer::Int,display::String   }
    deriving Show 
incrementPointer (Machine a b c d e) = Machine a b c (d+1) e
decrementPointer (Machine a b c d e) = Machine a b c (d-1) e
putCharToDisplay (Machine a b c d e) = Machine a b c d (e++[chr (c!!d)])
incrementMemory (Machine a b c d e) = Machine a b (changeMemory c 0 d (+ 1))d e
decrementMemory (Machine a b c d e) = Machine a b (changeMemory c 0 d (subtract 1))d e
jumpStart (Machine a b c d e) = if (c!!d)==0 then Machine a (func 0 b) c d e
                                             else Machine a b c d e 
    where func depth pos = case (a!!pos) of
                            '[' ->  func (depth+1) (pos+1)
                            ']' ->  if depth==1 then pos
                                                else func (depth-1) (pos+1)
                            otherwise   -> func depth (pos+1)
jumpEnd (Machine a b c d e) = if(c!!d)==0 then Machine a b c d e
                                          else Machine a (func 0 b) c d e
    where func depth pos = case (a!!pos) of
                            '[' ->  if depth==1 then pos
                                                else func (depth-1) (pos-1)
                            ']' -> func (depth+1) (pos-1)
                            otherwise   -> func depth (pos-1)
changeMemory [] i k f = []
changeMemory (x:mem) i k f = if i==k    then f x:mem
                                        else x:changeMemory mem (i+1) k f