Haskell 内で DSL として Brainfuck を書きたくなる機会があったためモナドとして実装しました。
BrainFuck.hs
BrainFuck.hs
{-# LANGUAGE GADTs #-}
module BrainFuck where
import Control.Monad.Operational
import Data.Word
data BFInst a where
Forward :: BFInst ()
Backward :: BFInst ()
Incr :: BFInst ()
Decr :: BFInst ()
Print :: BFInst ()
Get :: BFInst ()
Repeat :: BrainFuck () -> BFInst ()
type BrainFuck a = Program BFInst a
data Memory = Memory {left :: [Word8], point :: Word8, right :: [Word8]}
forward_ :: Memory -> Memory
forward_ (Memory l p (r:rs)) = Memory (p:l) r rs
backward_ :: Memory -> Memory
backward_ (Memory (l:ls) p r) = Memory ls l (p:r)
incr_ :: Memory -> Memory
incr_ m = m{point = point m + 1}
decr_ :: Memory -> Memory
decr_ m = m{point = point m - 1}
runBF :: BrainFuck a -> Memory -> IO (a, Memory)
runBF m = case view m of
Return a -> (\st -> return (a, st))
Forward :>>= k -> \st -> runBF (k ()) $ forward_ st
Backward :>>= k -> \st -> runBF (k ()) $ backward_ st
Incr :>>= k -> \st -> runBF (k ()) $ incr_ st
Decr :>>= k -> \st -> runBF (k ()) $ decr_ st
Print :>>= k -> \st -> putWord8 (point st) >> runBF (k ()) st
Get :>>= k -> \st -> do
w <- getWord8
runBF (k ()) st{point = w}
Repeat bf :>>= k -> \st -> do
let loop st' = do
if point st' == 0 then
return st'
else do
(_, st'') <- runBF bf st'
loop st''
st' <- loop st
runBF (k ()) st'
executeBF :: BrainFuck a -> IO (a, Memory)
executeBF bf = runBF bf emptyMemory
emptyMemory :: Memory
emptyMemory = Memory (repeat 0) 0 (repeat 0)
putWord8 :: Word8 -> IO ()
putWord8 = putChar . toEnum . fromEnum
getWord8 :: IO Word8
getWord8 = fmap (toEnum . fromEnum) getChar
fwd :: BrainFuck ()
fwd = singleton Forward
bwd :: BrainFuck ()
bwd = singleton Backward
inc :: BrainFuck ()
inc = singleton Incr
dec :: BrainFuck ()
dec = singleton Decr
prt :: BrainFuck ()
prt = singleton Print
get :: BrainFuck ()
get = singleton Get
rpt :: BrainFuck () -> BrainFuck ()
rpt bf = singleton $ Repeat bf
サンプルコード
| Brainfuck | BrainFuckモナド |
|---|---|
| + | inc |
| - | dec |
| > | fwd |
| < | bwd |
| . | prt |
| , | get |
| [] | rpt |
元のコード
+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+.
Main.hs
module Main where
import BrainFuck
main :: IO ()
main = do
executeBF hello
return ()
hello :: BrainFuck ()
hello = do
inc
inc
inc
inc
inc
inc
inc
inc
inc
rpt $ do
fwd
inc
inc
inc
inc
inc
inc
inc
inc
fwd
inc
inc
inc
inc
inc
inc
inc
inc
inc
inc
inc
fwd
inc
inc
inc
inc
inc
bwd
bwd
bwd
dec
fwd
prt
fwd
inc
inc
prt
inc
inc
inc
inc
inc
inc
inc
prt
prt
inc
inc
inc
prt
fwd
dec
prt
dec
dec
dec
dec
dec
dec
dec
dec
dec
dec
dec
dec
prt
bwd
inc
inc
inc
inc
inc
inc
inc
inc
prt
dec
dec
dec
dec
dec
dec
dec
dec
prt
inc
inc
inc
prt
dec
dec
dec
dec
dec
dec
prt
dec
dec
dec
dec
dec
dec
dec
dec
prt
fwd
inc
prt
出力
Hello, world!
やはり、元のコードに比べてインデントのおかげで内容が見やすくなっていますね。
Brainfuck でありながら Haskell の厳格な型チェックが得られるという点も非常に大きな魅力なのではないでしょうか。
皆様も Haskell 内で Brainfuck が書きたくなったときはご活用ください。