BrainF*ckインタプリタを作る(4)

今日で最後だ。のこりの命令「[」と「]」を実装した。

「[」と「]」を実装するには命令の列を行ったり来たりできなきゃいけない。はじめに考えたのは BrainF_ck と同じように,命令のリストと現在位置を示すポインタを持ったデータ型を定義することだった。
けど,考え直して文字列のペアで代用することにした。これを次のように操作する。

  • 初期状態では,1番目の文字列は空。全て2番目に入っている。
  • 1つ命令を実行するごとに,2番目の文字列から1番目の文字列へ1文字移動する。スキップするには必要な数だけ移動。
  • 2番目の文字列が空になったらプログラム終了。
  • ループで戻るときには,2番目から1番目へ文字を移動する。

で,実装はこのとおり。

type Program = ([Char], [Char])

progNew :: String -> Program
progNew str = ([], str)

progFetch :: Program -> [Char]
progFetch prog = snd prog

progShift :: Program -> Program
progShift (l, (r:rs)) = (l ++ [r], rs)

progUnshift :: Program -> Program
progUnshift (l, r) = (take ((length l) -1) l, (last l):r)

progSkip :: BrainF_ck -> Program -> Program
progSkip bf prog = if bfValue bf == 0 then skip prog else progShift prog
  where skip p = if (head $ progFetch next) == ']' then next else skip next
          where next = progShift p

progBack :: BrainF_ck -> Program -> Program
progBack bf prog = if bfValue bf == 0 then progShift prog else back prog
  where back p = if (head $ progFetch prev) == '[' then prev else back prev
          where prev = progUnshift p

でもって,プログラムを走らせる関数 bfRun を導入(前回までは foldM を使っていた)して,main も書き換えた。

bfRun :: BrainF_ck -> Program -> IO BrainF_ck
bfRun bf prog = run $ progFetch prog
  where run [] = return bf
        run (c:cs) | c == '[' = bfRun bf (progSkip bf prog)
                   | c == ']' = bfRun bf (progBack bf prog)
                   | otherwise = do next <- bfEvaluate bf c
bfRun next (progShift prog)

main :: IO BrainF_ck
main = do filename <- getArgs >>= return . head
          prog <- readFile filename >>= ((return . progNew) . concat) . lines
          bfRun bfInitial prog

さらに。いままで入出力を整数でやっていたけど,これを文字に変更する。まぁ文字<->整数(文字コード)の変換だけだけど。

import Data.Char

bfInput :: BrainF_ck -> IO BrainF_ck
bfInput bf = do let p = bfPointer bf
                let r = bfRegister bf
                putStr "\ninput? ";
                c <- getChar
                return $ BF p ((take p r) ++ [ord c] ++ (tail $ drop p r))

bfPrint :: BrainF_ck -> IO BrainF_ck
bfPrint bf = do putChar $ chr $ bfValue bf
                return bf

これでできあがりのはずだ。さっそく試してみよう。
実行するプログラムは当初の目標,HelloWorld。

>type hello.bf
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<
+++++++++++++++.>.+++.------.--------.>+.>.
>runghc hbf.hs hello.bf
Hello World!

OK!!!!!!!!!!!!!!!!

いろいろと制限もあるけど,とにかく目標は達成。これ以上はまた気が向いたらってことで。
以下,全体を示しておく。

module Main where

import System
import Monad
import Data.Char

data BrainF_ck = BF { bfPointer :: Int, bfRegister :: [Int] } deriving (Show)

type Program = ([Char], [Char])

bfInitial :: BrainF_ck
bfInitial = BF { bfPointer = 0, bfRegister = [0,0,0,0,0,0,0,0,0,0] }

bfValue :: BrainF_ck -> Int
bfValue bf = (bfRegister bf) !! (bfPointer bf)

bfIncrement :: BrainF_ck -> BrainF_ck
bfIncrement (BF p v) = BF p ((take p v) ++ [(v !! p) + 1] ++ (tail $ drop p v))

bfDecrement :: BrainF_ck -> BrainF_ck
bfDecrement (BF p v) = BF p ((take p v) ++ [(v !! p) - 1] ++ (tail $ drop p v))

bfShift :: BrainF_ck -> BrainF_ck
bfShift (BF p v) = BF (p+1) v

bfUnshift :: BrainF_ck -> BrainF_ck
bfUnshift (BF p v) = BF (p-1) v

bfInput :: BrainF_ck -> IO BrainF_ck
bfInput bf = do let p = bfPointer bf
                let r = bfRegister bf
                putStr "\ninput? "
                c <- getChar
                return $ BF p ((take p r) ++ [ord c] ++ (tail $ drop p r))

bfPrint :: BrainF_ck -> IO BrainF_ck
bfPrint bf = do putChar $ chr $ bfValue bf
                return bf

bfEvaluate :: BrainF_ck -> Char -> IO BrainF_ck
bfEvaluate bf '+' = return $ bfIncrement bf
bfEvaluate bf '-' = return $ bfDecrement bf
bfEvaluate bf '>' = return $ bfShift bf
bfEvaluate bf '<' = return $ bfUnshift bf
bfEvaluate bf '.' = bfPrint bf
bfEvaluate bf ',' = bfInput bf

progNew :: String -> Program
progNew str = ([], str)

progFetch :: Program -> [Char]
progFetch prog = snd prog

progShift :: Program -> Program
progShift (l, (r:rs)) = (l ++ [r], rs)

progUnshift :: Program -> Program
progUnshift (l, r) = (take ((length l) -1) l, (last l):r)

progSkip :: BrainF_ck -> Program -> Program
progSkip bf prog = if bfValue bf == 0 then skip prog else progShift prog
  where skip p = if (head $ progFetch next) == ']' then next else skip next
          where next = progShift p

progBack :: BrainF_ck -> Program -> Program
progBack bf prog = if bfValue bf == 0 then progShift prog else back prog
  where back p = if (head $ progFetch prev) == '[' then prev else back prev
          where prev = progUnshift p

bfRun :: BrainF_ck -> Program -> IO BrainF_ck
bfRun bf prog = run $ progFetch prog
  where run [] = return bf
        run (c:cs) | c == '[' = bfRun bf (progSkip bf prog)
                   | c == ']' = bfRun bf (progBack bf prog)
                   | otherwise = do next <- bfEvaluate bf c
                                    bfRun next (progShift prog)

main :: IO BrainF_ck
main = do filename <- getArgs >>= return . head
          prog <- readFile filename >>= ((return . progNew) . concat) . lines
          bfRun bfInitial prog

カテゴリー: Haskell パーマリンク

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください