まずは第一回を読んでください。
- 第一回:ごりごり編
- 第二回:Stateモナド編←いまここ
- 第三回:パーサコンビネータ編
- 最終回:Operationalモナド編
Stateモナド
Stateモナドは状態s
を保持することができます。
newtype StateT s m a = StateT{runStateT :: s -> m (a,s)}
instance Functor m => Functor (StateT s m) where
fmap f x = StateT $ \s -> fmap (\(a,s') -> (f a,s')) runStateT x s
instance Monad m => Applicative (StateT s m) where
pure a = StateT $ \s -> return (a,s)
f <*> x = StateT $ \s -> do
(g,s1) <- runStateT f s
(a,s2) <- runStateT x s1
return (g a,s2)
instance Monad m => Monad (StateT s m) where
x >>= f = StateT $ \s -> do
(a,s1) <- runStateT x s
runStateT (f a) s1
-- 現在の状態を取得する
get :: Monad m => StateT s m s
get = StateT $ \s -> return (s,s)
-- 現在の状態を破棄して、引数を状態で置き換える
put :: Monad m => s -> StateT s m ()
put s = StateT $ \_ -> return ((),s)
-- 現在の状態を変化させる
modify :: Monad m => (s -> s) -> StateT s m ()
modify f = get >>= put.f
プログラムとは
Brainf*ck
のプログラムとは、メモリを変化させながらIO処理をおこなうものである。
type BFProgram a = StateT Memory IO a
Stateモナドで書き直し
BF
を実行するrunBF
を定義する
runBF :: BF -> BFProgram ()
runBF Inc = modify $ \(l,m,r) -> (l,succ m,r)
runBF Dec = modify $ \(l,m,r) -> (l,pred m,r)
runBF RShift = modify $ \(l,m,r) ->
if null l
then ([],toEnum 0,m:r)
else (tail l,head l,m:r)
runBF LShift = modify $ \(l,m,r) ->
if null r
then (m:l,toEnum 0,[])
else (m:l,head r,tail r)
runBF PutC = get >>= \(_,m,_) -> liftIO (putChar m)
runBF GetC = liftIO getChar >>= \c -> modify $ \(l,m,r) -> (l,c,r)
runBF (Loop code) = loop where
loop = do
(l,m,r) <- get
if m == toEnum 0
then return ()
else mapM_ runBF code >> loop
インタプリタはmapM_ :: Monad m => (a -> m b) -> [a] -> m ()
を使って以下のようになります。
interpreter :: Memory -> [BF] -> IO Memory
interpreter mem xs = execStateT (mapM_ runBF xs) mem
> interpreter initMemory $ parseBF "+++++++++[>++++++++>+++++++++++>+++++<<<-]>.>++.+++++++..+++.>-.------------.<++++++++.--------.+++.------.--------.>+."
< Hello, world!
ついでにWriterモナド
ついでにgetLoopString
をWriter
モナドを使って書き直します。
ループ内の文字は保持するための変数が見えなくなってちょっとスッキリ。
引数のString
も状態なので、State
モナドで引き回しができますが、
逆にコードが煩雑になるので、引数での状態保持のままにしています。
getLoopString :: String -> Writer String String
getLoopString (']':xs) = return xs
getLoopString ('[':xs) = tell ("["++w++"]") >> getLoopString xs' where
(xs',w) = runWriter (getLoopString xs )
getLoopString (c:xs) = tell [c] >> getLoopString xs
getLoopString [] = fail "Unexpected end of script"
-- ループの変換処理は以下のようになる
parseBF ('[':s) = Loop (parseBF cLoop) : parseBF s' where (s',cLoop) = runWriter (getLoopString s)
ちなみにState
とWriter
の両方が使いたい場合は、RWS
モナドがあります。
ReaderWriterState
の頭文字です。
newtype RWST r w s m a = RWST{runRWST :: r -> s -> m (a, s, w)}
get
,put
,tell
,ask
などが同じモナド内で使えます。
ReaderT r (WriterT w (StateT s m)) a
みたいなlift
地獄を回避できます。
次回
parseBF :: String -> [BF]
をパーサコンビネータを使って書き直します。