BrainfuckのインタプリタをHaskellで

Haskell アクション 超入門 - Qiita

BFはメモリの値を頻繁にいじるため参照透過性もクソもない言語なので、インタプリタも参照透過性なんて存在せず、副作用や状態を持たないとどうにもなりません

BFの世界は参照透過性の綺麗な海ではありませんが、変数の束縛(しがらみ)から解放された自由な言語だったのです。

ループの実装に思いの外手間取りました。少し言い訳をすると、昼のラーメンがあまりおいしくなかったのが原因かもしれません。

なお、getChar部分は手を付けていません。そういう実装が可能ならばいいんですが。

BFのインタプリタを実装したことがある人間なら分かると思いますが、ループはいつも実装が難しいです。

import Data.Array.IO
import Data.Word
import Data.Char
main = do
    let bf = ">+++++++++[<++++++++>-]<.>+++++++[<++++>" ++
             "-]<+.+++++++..+++.[-]>++++++++[<++++>-]<" ++
             ".>+++++++++++[<+++++>-]<.>++++++++[<+++>" ++
             "-]<.+++.------.--------.[-]>++++++++[<++" ++
             "++>-]<+.[-]++++++++++."
    -- let bf = "++++++++++++++++++++++++++++++" ++
    --          "++++++++++++++++++++++++++++++" ++
    --          "++++++++++++."
    -- let bf = "+++++++++[>++++++++<-]>."
    jmp <- newArray (0, length bf + 1) 0 :: IO (IOUArray Int Int)
    let loops = []

    let loop i loops | i < length bf = do
          case bf !! i of
            '[' -> do
              loop (i + 1) (i:loops)
            ']' -> do
              let (start:loops') = loops
              writeArray jmp start i
              writeArray jmp i start
              loop (i + 1) loops'
            _ -> do
              loop (i + 1) loops
        loop _ _ = return ()
    loop 0 []
    -- print =<< getElems jmp

    m <- newArray (0, 30000) 0 :: IO (IOUArray Int Word8)
    let scanbf pc r | pc < length bf = do
          -- print pc
          case bf !! pc of
            '+' -> do
              a <- readArray m r
              writeArray m r (a + 1)
              scanbf (pc + 1) r
            '-' -> do
              a <- readArray m r
              writeArray m r (a - 1)
              scanbf (pc + 1) r
            '>' -> do
              scanbf (pc + 1) (r + 1)
            '<' -> do
              scanbf (pc + 1) (r - 1)
            '.' -> do
              a <- readArray m r
              -- Word8を変換するためのfromIntegral
              putChar $ toEnum $ fromIntegral $ a
              -- putChar $ chr $ a
              scanbf (pc + 1) r
            '[' -> do
              a <- readArray m r
              if a == 0
              then do
                pc <- readArray jmp pc
                scanbf (pc + 1) r
              else do
                scanbf (pc + 1) r
            ']' -> do
              a <- readArray m r
              if a /= 0
              then do
                pc <- readArray jmp pc
                scanbf pc r
              else do
                scanbf (pc + 1) r
            _ -> do
              scanbf (pc + 1) r
        scanbf _ _ = return ()
    scanbf 0 0