summaryrefslogtreecommitdiff
path: root/compiler/GHC/Utils/Monad/State.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Utils/Monad/State.hs')
-rw-r--r--compiler/GHC/Utils/Monad/State.hs46
1 files changed, 46 insertions, 0 deletions
diff --git a/compiler/GHC/Utils/Monad/State.hs b/compiler/GHC/Utils/Monad/State.hs
new file mode 100644
index 0000000000..c7b9e3f591
--- /dev/null
+++ b/compiler/GHC/Utils/Monad/State.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module GHC.Utils.Monad.State where
+
+import GHC.Prelude
+
+newtype State s a = State { runState' :: s -> (# a, s #) }
+ deriving (Functor)
+
+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
+ m >>= n = State $ \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' #)
+
+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, _ #) -> a
+
+
+execState :: State s 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')