never executed always true always false

    1 {-# LANGUAGE DeriveFunctor #-}
    2 {-# LANGUAGE UnboxedTuples #-}
    3 {-# LANGUAGE PatternSynonyms #-}
    4 
    5 -- | A state monad which is strict in its state.
    6 module GHC.Utils.Monad.State.Strict
    7   ( -- * The State monad
    8     State(State)
    9   , state
   10   , evalState
   11   , execState
   12   , runState
   13     -- * Operations
   14   , get
   15   , gets
   16   , put
   17   , modify
   18   ) where
   19 
   20 import GHC.Prelude
   21 
   22 import GHC.Exts (oneShot)
   23 
   24 -- | A state monad which is strict in the state.
   25 newtype State s a = State' { runState' :: s -> (# a, s #) }
   26     deriving (Functor)
   27 
   28 pattern State :: (s -> (# a, s #))
   29               -> State s a
   30 
   31 -- This pattern synonym makes the monad eta-expand,
   32 -- which as a very beneficial effect on compiler performance
   33 -- See #18202.
   34 -- See Note [The one-shot state monad trick] in GHC.Utils.Monad
   35 pattern State m <- State' m
   36   where
   37     State m = State' (oneShot $ \s -> m s)
   38 
   39 instance Applicative (State s) where
   40    pure x   = State $ \s -> (# x, s #)
   41    m <*> n  = State $ \s -> case runState' m s of
   42                             (# f, !s' #) -> case runState' n s' of
   43                                             (# x, s'' #) -> (# f x, s'' #)
   44 
   45 instance Monad (State s) where
   46     m >>= n  = State $ \s -> case runState' m s of
   47                              (# r, !s' #) -> runState' (n r) s'
   48 
   49 state :: (s -> (a, s)) -> State s a
   50 state f = State $ \s -> case f s of
   51                         (r, s') -> (# r, s' #)
   52 
   53 get :: State s s
   54 get = State $ \s -> (# s, s #)
   55 
   56 gets :: (s -> a) -> State s a
   57 gets f = State $ \s -> (# f s, s #)
   58 
   59 put :: s -> State s ()
   60 put s' = State $ \_ -> (# (), s' #)
   61 
   62 modify :: (s -> s) -> State s ()
   63 modify f = State $ \s -> (# (), f s #)
   64 
   65 
   66 evalState :: State s a -> s -> a
   67 evalState s i = case runState' s i of
   68                 (# a, _ #) -> a
   69 
   70 
   71 execState :: State s a -> s -> s
   72 execState s i = case runState' s i of
   73                 (# _, s' #) -> s'
   74 
   75 
   76 runState :: State s a -> s -> (a, s)
   77 runState s i = case runState' s i of
   78                (# a, s' #) -> (a, s')