compiler/utils/State.hs

   1
   2 module State (module State, mapAccumLM {- XXX hack -}) where
   3
   4 import MonadUtils
   5
   6 newtype State s a = State { runState' :: s -> (# a, s #) }
   7
   8 instance Functor (State s) where
   9     fmap f m  = State $ \s -> case runState' m s of
  10                               (# r, s' #) -> (# f r, s' #)
  11
  12 instance Applicative (State s) where
  13    pure x   = State $ \s -> (# x, s #)
  14    m <*> n  = State $ \s -> case runState' m s of
  15                             (# f, s' #) -> case runState' n s' of
  16                                            (# x, s'' #) -> (# f x, s'' #)
  17
  18 instance Monad (State s) where
  19     return x = State $ \s -> (# x, s #)
  20     m >>= n  = State $ \s -> case runState' m s of
  21                              (# r, s' #) -> runState' (n r) s'
  22
  23 get :: State s s
  24 get = State $ \s -> (# s, s #)
  25
  26 gets :: (s -> a) -> State s a
  27 gets f = State $ \s -> (# f s, s #)
  28
  29 put :: s -> State s ()
  30 put s' = State $ \_ -> (# (), s' #)
  31
  32 modify :: (s -> s) -> State s ()
  33 modify f = State $ \s -> (# (), f s #)
  34
  35
  36 evalState :: State s a -> s -> a
  37 evalState s i = case runState' s i of
  38                 (# a, _ #) -> a
  39
  40
  41 execState :: State s a -> s -> s
  42 execState s i = case runState' s i of
  43                 (# _, s' #) -> s'
  44
  45
  46 runState :: State s a -> s -> (a, s)
  47 runState s i = case runState' s i of
  48                (# a, s' #) -> (a, s')