Package environments
[ghc.git] / compiler / utils / State.hs
1 {-# LANGUAGE UnboxedTuples, CPP #-}
2
3 module State where
4
5 #if __GLASGOW_HASKELL__ < 709
6 import Control.Applicative
7 #endif
8
9 newtype State s a = State { runState' :: s -> (# a, s #) }
10
11 instance Functor (State s) where
12 fmap f m = State $ \s -> case runState' m s of
13 (# r, s' #) -> (# f r, s' #)
14
15 instance Applicative (State s) where
16 pure x = State $ \s -> (# x, s #)
17 m <*> n = State $ \s -> case runState' m s of
18 (# f, s' #) -> case runState' n s' of
19 (# x, s'' #) -> (# f x, s'' #)
20
21 instance Monad (State s) where
22 return x = State $ \s -> (# x, s #)
23 m >>= n = State $ \s -> case runState' m s of
24 (# r, s' #) -> runState' (n r) s'
25
26 get :: State s s
27 get = State $ \s -> (# s, s #)
28
29 gets :: (s -> a) -> State s a
30 gets f = State $ \s -> (# f s, s #)
31
32 put :: s -> State s ()
33 put s' = State $ \_ -> (# (), s' #)
34
35 modify :: (s -> s) -> State s ()
36 modify f = State $ \s -> (# (), f s #)
37
38
39 evalState :: State s a -> s -> a
40 evalState s i = case runState' s i of
41 (# a, _ #) -> a
42
43
44 execState :: State s a -> s -> s
45 execState s i = case runState' s i of
46 (# _, s' #) -> s'
47
48
49 runState :: State s a -> s -> (a, s)
50 runState s i = case runState' s i of
51 (# a, s' #) -> (a, s')