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

diff --git a/compiler/utils/State.hs b/compiler/utils/State.hs
index bf5b3a0..0b6a285 100644
--- a/compiler/utils/State.hs
+++ b/compiler/utils/State.hs
@@ -1,8 +1,20 @@
 
-module State where
+module State (module State, mapAccumLM {- XXX hack -}) where
+
+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
@@ -34,18 +46,3 @@ execState s i = case runState' s i of
 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')
-