X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Futils%2FState.hs;h=8f8973453b1e5dcdcb3e59df5edae17fc4ba16a7;hp=faed566e3e01734b0e8be3237c7aa0d7bd8a78e5;hb=f0d0e9d63ee27a12e80b6f069be5e9d4b55ca545;hpb=ca9e6d1e1d759fd20f23e6ab24859b812991fca7

diff --git a/compiler/utils/State.hs b/compiler/utils/State.hs
index faed566..8f89734 100644
--- 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')