There is an implementation already in Control.Monad.State
, but it is cumbersome for generality sake: one complication comes from MonadState class, and another from the fact that plain State
is implemented in terms of more general StateT
.
Here is an example of your task using that implementation. No mutability was used. Note that your example was pasted as is, just adding x
prefix:
import Control.Monad.State
import qualified Data.Map as M
type MyMap a = M.Map Int a
type MyState a b = State (MyMap a) b
type MyRef = Int
xrun :: MyState a b -> b
xrun x = evalState x (M.empty)
mget :: MyState a (MyMap a)
mget = get
mput :: MyMap a -> MyState a ()
mput = put
mmodify :: (MyMap a -> MyMap a) -> MyState a ()
mmodify x = modify x
xnew :: s -> MyState s MyRef
xnew val = do
s <- mget
let newRef = if M.null s then 0 else fst (M.findMax s) + 1
mput $ M.insert newRef val s
return newRef
xset :: MyRef -> a -> MyState a ()
xset ref val = modify $ M.insert ref val
xget :: MyRef -> MyState a a
xget ref = fmap (\s -> case M.lookup ref s of Just v -> v) get
test :: MyState Int Int
test = do
x1 <- xnew 2
xset x1 3
x2 <- xget x1
y1 <- xnew 10
xset y1 20
y2 <- xget y1
return (x2 + y2)
main = print $ xrun test
It is possible to implement all the functions in the module and >>=
/return
without using stock implementations from Control.Monad
preserving the signatures.
Here it is:
module MyState (State, get, put, modify, evalState) where
newtype State s a = State (s -> (a, s))
evalState :: State s a -> s -> a
evalState (State f) = fst . f
instance Monad (State s) where
return a = State $ \s -> (a, s)
State f >>= g = State $ \s ->
case f s of
(a', s') -> case g a' of
State h -> h s'
instance Functor (State s) where
fmap f (State g) = State $
\s -> case g s of (a, s) -> (f a, s)
get :: State s s
get = State (\s -> (s, s))
put :: s -> State s ()
put s = State $ \_ -> ((), s)
modify :: (s -> s) -> State s ()
modify f = get >>= put . f
Save it to MyState.hs
and replace import Control.Monad.State
with import MyState
.