X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Futils%2FState.hs;h=0b6a2855627d76b7fb089d6586eeeb9e3660f8e3;hp=a0d21d68075d5993577a8bae56fa61a9a2ec6403;hb=b2524b3960999fffdb3767900f58825903f6560f;hpb=ad94d40948668032189ad22a0ad741ac1f645f50

diff --git a/compiler/utils/State.hs b/compiler/utils/State.hs
index a0d21d6..0b6a285 100644
--- a/compiler/utils/State.hs
+++ b/compiler/utils/State.hs
@@ -1,63 +1,48 @@
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
--- for details
 
-module State where
+module State (module State, mapAccumLM {- XXX hack -}) where
 
-newtype State s a
-	= State
-	{ runState' :: s -> (# a, s #) }
+import MonadUtils
+
+newtype State s a = State { runState' :: s -> (# a, s #) }
+
+instance Functor (State s) where
+    fmap f m  = State $ \s -> case runState' m s of
+                              (# r, s' #) -> (# f r, s' #)
+
+instance Applicative (State s) where
+   pure x   = State $ \s -> (# x, s #)
+   m <*> n  = State $ \s -> case runState' m s of
+                            (# f, s' #) -> case runState' n s' of
+                                           (# x, s'' #) -> (# f x, 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'
+    return x = State $ \s -> (# x, s #)
+    m >>= n  = State $ \s -> case runState' m s of
+                             (# r, s' #) -> runState' (n r) s'
 
-get ::	State s s
-get	= State $ \s -> (# s, s #)
+get :: State s s
+get = State $ \s -> (# s, s #)
 
 gets :: (s -> a) -> State s a
-gets f 	= State $ \s -> (# f s, s #)
+gets f = State $ \s -> (# f s, s #)
 
-put :: 	s -> State s ()
-put s'	= State $ \s -> (# (), s' #)
+put :: s -> State s ()
+put s' = State $ \_ -> (# (), 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
-		(# a, s' #)	-> a
+evalState s i = case runState' s i of
+                (# a, _ #) -> a
 
 
 execState :: State s a -> s -> s
-execState s i
-	= case runState' s i of
-		(# a, s' #) 	-> s'
+execState s i = case runState' s i of
+                (# _, 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')
+runState s i = case runState' s i of
+               (# a, s' #) -> (a, s')