compiler/utils/State.hs

   1
   2 module State where
   3
   4 newtype State s a
   5         = State
   6         { runState' :: s -> (# a, s #) }
   7
   8 instance Monad (State s) where
   9     return x    = State $ \s -> (# x, s #)
  10     m >>= n     = State $ \s ->
  11                         case runState' m s of
  12                           (# r, s' #)   -> runState' (n r) s'
  13
  14 get ::  State s s
  15 get     = State $ \s -> (# s, s #)
  16
  17 gets :: (s -> a) -> State s a
  18 gets f  = State $ \s -> (# f s, s #)
  19
  20 put ::  s -> State s ()
  21 put s'  = State $ \s -> (# (), s' #)
  22
  23 modify :: (s -> s) -> State s ()
  24 modify f = State $ \s -> (# (), f s #)
  25
  26
  27 evalState :: State s a -> s -> a
  28 evalState s i
  29         = case runState' s i of
  30                 (# a, s' #)     -> a
  31
  32
  33 execState :: State s a -> s -> s
  34 execState s i
  35         = case runState' s i of
  36                 (# a, s' #)     -> s'
  37
  38
  39 runState :: State s a -> s -> (a, s)
  40 runState s i
  41         = case runState' s i of
  42                 (# a, s' #)     -> (a, s')
  43
  44
  45 mapAccumLM
  46         :: Monad m
  47         => (acc -> x -> m (acc, y))     -- ^ combining funcction
  48         -> acc                          -- ^ initial state
  49         -> [x]                          -- ^ inputs
  50         -> m (acc, [y])                 -- ^ final state, outputs
  51
  52 mapAccumLM _ s []       = return (s, [])
  53 mapAccumLM f s (x:xs)
  54  = do
  55         (s1, x')        <- f s x
  56         (s2, xs')       <- mapAccumLM f s1 xs
  57         return          (s2, x' : xs')