{-# LANGUAGE UnboxedTuples #-}

module State where

import GhcPrelude

newtype State s a = State { State s a -> s -> (# a, s #)
runState' :: s -> (# a, s #) }

instance Functor (State s) where
    fmap :: (a -> b) -> State s a -> State s b
fmap f :: a -> b
f m :: State s a
m  = (s -> (# b, s #)) -> State s b
forall s a. (s -> (# a, s #)) -> State s a
State ((s -> (# b, s #)) -> State s b) -> (s -> (# b, s #)) -> State s b
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> case State s a -> s -> (# a, s #)
forall s a. State s a -> s -> (# a, s #)
runState' State s a
m s
s of
                              (# r :: a
r, s' :: s
s' #) -> (# a -> b
f a
r, s
s' #)

instance Applicative (State s) where
   pure :: a -> State s a
pure x :: a
x   = (s -> (# a, s #)) -> State s a
forall s a. (s -> (# a, s #)) -> State s a
State ((s -> (# a, s #)) -> State s a) -> (s -> (# a, s #)) -> State s a
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> (# a
x, s
s #)
   m :: State s (a -> b)
m <*> :: State s (a -> b) -> State s a -> State s b
<*> n :: State s a
n  = (s -> (# b, s #)) -> State s b
forall s a. (s -> (# a, s #)) -> State s a
State ((s -> (# b, s #)) -> State s b) -> (s -> (# b, s #)) -> State s b
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> case State s (a -> b) -> s -> (# a -> b, s #)
forall s a. State s a -> s -> (# a, s #)
runState' State s (a -> b)
m s
s of
                            (# f :: a -> b
f, s' :: s
s' #) -> case State s a -> s -> (# a, s #)
forall s a. State s a -> s -> (# a, s #)
runState' State s a
n s
s' of
                                           (# x :: a
x, s'' :: s
s'' #) -> (# a -> b
f a
x, s
s'' #)

instance Monad (State s) where
    m :: State s a
m >>= :: State s a -> (a -> State s b) -> State s b
>>= n :: a -> State s b
n  = (s -> (# b, s #)) -> State s b
forall s a. (s -> (# a, s #)) -> State s a
State ((s -> (# b, s #)) -> State s b) -> (s -> (# b, s #)) -> State s b
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> case State s a -> s -> (# a, s #)
forall s a. State s a -> s -> (# a, s #)
runState' State s a
m s
s of
                             (# r :: a
r, s' :: s
s' #) -> State s b -> s -> (# b, s #)
forall s a. State s a -> s -> (# a, s #)
runState' (a -> State s b
n a
r) s
s'

get :: State s s
get :: State s s
get = (s -> (# s, s #)) -> State s s
forall s a. (s -> (# a, s #)) -> State s a
State ((s -> (# s, s #)) -> State s s) -> (s -> (# s, s #)) -> State s s
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> (# s
s, s
s #)

gets :: (s -> a) -> State s a
gets :: (s -> a) -> State s a
gets f :: s -> a
f = (s -> (# a, s #)) -> State s a
forall s a. (s -> (# a, s #)) -> State s a
State ((s -> (# a, s #)) -> State s a) -> (s -> (# a, s #)) -> State s a
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> (# s -> a
f s
s, s
s #)

put :: s -> State s ()
put :: s -> State s ()
put s' :: s
s' = (s -> (# (), s #)) -> State s ()
forall s a. (s -> (# a, s #)) -> State s a
State ((s -> (# (), s #)) -> State s ())
-> (s -> (# (), s #)) -> State s ()
forall a b. (a -> b) -> a -> b
$ \_ -> (# (), s
s' #)

modify :: (s -> s) -> State s ()
modify :: (s -> s) -> State s ()
modify f :: s -> s
f = (s -> (# (), s #)) -> State s ()
forall s a. (s -> (# a, s #)) -> State s a
State ((s -> (# (), s #)) -> State s ())
-> (s -> (# (), s #)) -> State s ()
forall a b. (a -> b) -> a -> b
$ \s :: s
s -> (# (), s -> s
f s
s #)


evalState :: State s a -> s -> a
evalState :: State s a -> s -> a
evalState s :: State s a
s i :: s
i = case State s a -> s -> (# a, s #)
forall s a. State s a -> s -> (# a, s #)
runState' State s a
s s
i of
                (# a :: a
a, _ #) -> a
a


execState :: State s a -> s -> s
execState :: State s a -> s -> s
execState s :: State s a
s i :: s
i = case State s a -> s -> (# a, s #)
forall s a. State s a -> s -> (# a, s #)
runState' State s a
s s
i of
                (# _, s' :: s
s' #) -> s
s'


runState :: State s a -> s -> (a, s)
runState :: State s a -> s -> (a, s)
runState s :: State s a
s i :: s
i = case State s a -> s -> (# a, s #)
forall s a. State s a -> s -> (# a, s #)
runState' State s a
s s
i of
               (# a :: a
a, s' :: s
s' #) -> (a
a, s
s')