Refactor dumping of register allocator statistics.

[ghc-hetmet.git] / compiler / utils / State.hs

diff --git a/compiler/utils/State.hs b/compiler/utils/State.hs
index faed566..8f89734 100644 (file)
--- a/compiler/utils/State.hs
+++ b/compiler/utils/State.hs
@@ -3,29 +3,55 @@ module State where
 
 newtype State s a
        = State
-       { runState :: s -> (# a, s #) }
+       { runState' :: s -> (# a, s #) }
 
 instance Monad (State s) where
     return x   = State $ \s -> (# x, s #)
     m >>= n    = State $ \s ->
-                       case runState m s of
-                         (# r, s' #)   -> runState (n r) s'
+                       case runState' m s of
+                         (# r, s' #)   -> runState' (n r) s'
 
 get :: State s s
 get    = State $ \s -> (# s, s #)
 
+gets :: (s -> a) -> State s a
+gets f         = State $ \s -> (# f s, s #)
+
 put ::         s -> State s ()
 put s' = State $ \s -> (# (), s' #)
 
 modify :: (s -> s) -> State s ()
 modify f = State $ \s -> (# (), f s #)
 
+
 evalState :: State s a -> s -> a
 evalState s i
-       = case runState s i of
+       = case runState' s i of
                (# a, s' #)     -> a
 
+
 execState :: State s a -> s -> s
 execState s i
-       = case runState s i of
+       = case runState' s i of
                (# a, s' #)     -> s'
+
+
+runState :: State s a -> s -> (a, s)
+runState s i
+       = case runState' s i of
+               (# a, s' #)     -> (a, s')
+
+
+mapAccumLM
+       :: Monad m
+       => (acc -> x -> m (acc, y))     -- ^ combining funcction
+       -> acc                          -- ^ initial state
+       -> [x]                          -- ^ inputs
+       -> m (acc, [y])                 -- ^ final state, outputs
+
+mapAccumLM _ s []      = return (s, [])
+mapAccumLM f s (x:xs)
+ = do
+       (s1, x')        <- f s x
+       (s2, xs')       <- mapAccumLM f s1 xs
+       return          (s2, x' : xs')