{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
module Control.Prim.Eval
(
touch
, touch#
, keepAlive
, keepAlive#
, seq
, eval
, evalM
, deepeval
, deepevalM
, module Control.DeepSeq
, BNF(..)
) where
import Control.DeepSeq
import Control.Prim.Monad.Internal
import qualified GHC.Exts as GHC
touch# :: a -> GHC.State# s -> GHC.State# s
touch# :: a -> State# s -> State# s
touch# a
a = (State# RealWorld -> State# RealWorld) -> State# s -> State# s
GHC.unsafeCoerce# (a -> State# RealWorld -> State# RealWorld
forall k1. k1 -> State# RealWorld -> State# RealWorld
GHC.touch# a
a)
{-# INLINE touch# #-}
touch :: MonadPrim s m => a -> m ()
touch :: a -> m ()
touch a
x = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (a -> State# s -> State# s
forall a s. a -> State# s -> State# s
touch# a
x)
{-# INLINE touch #-}
keepAlive# ::
a
-> (GHC.State# s -> (# GHC.State# s, r #))
-> GHC.State# s
-> (# GHC.State# s, r #)
keepAlive# :: a
-> (State# s -> (# State# s, r #)) -> State# s -> (# State# s, r #)
keepAlive# a
a State# s -> (# State# s, r #)
m State# s
s =
case State# s -> (# State# s, r #)
m State# s
s of
(# State# s
s', r
r #) -> (# a -> State# s -> State# s
forall a s. a -> State# s -> State# s
touch# a
a State# s
s', r
r #)
{-# NOINLINE keepAlive# #-}
keepAlive ::
MonadUnliftPrim s m
=> a
-> m b
-> m b
keepAlive :: a -> m b -> m b
keepAlive a
a m b
m = m b
-> ((State# s -> (# State# s, b #))
-> State# s -> (# State# s, b #))
-> m b
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
m a
-> ((State# s -> (# State# s, a #))
-> State# s -> (# State# s, b #))
-> m b
runInPrimBase m b
m (a
-> (State# s -> (# State# s, b #)) -> State# s -> (# State# s, b #)
forall a s r.
a
-> (State# s -> (# State# s, r #)) -> State# s -> (# State# s, r #)
keepAlive# a
a)
{-# INLINE keepAlive #-}
eval :: MonadPrim s m => a -> m a
eval :: a -> m a
eval a
a = (State# s -> (# State# s, a #)) -> m a
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim (a -> State# s -> (# State# s, a #)
forall k1 d. k1 -> State# d -> (# State# d, k1 #)
GHC.seq# a
a)
{-# INLINE eval #-}
evalM :: MonadPrim s m => m a -> m a
evalM :: m a -> m a
evalM m a
m = a -> m a
forall s (m :: * -> *) a. MonadPrim s m => a -> m a
eval (a -> m a) -> m a -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a
m
{-# INLINE evalM #-}
deepeval :: (MonadPrim s m, NFData a) => a -> m a
deepeval :: a -> m a
deepeval = a -> m a
forall s (m :: * -> *) a. MonadPrim s m => a -> m a
eval (a -> m a) -> (a -> a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. NFData a => a -> a
force
{-# INLINE deepeval #-}
deepevalM :: (MonadPrim s m, NFData a) => m a -> m a
deepevalM :: m a -> m a
deepevalM m a
m = a -> m a
forall s (m :: * -> *) a. MonadPrim s m => a -> m a
eval (a -> m a) -> (a -> a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall a. NFData a => a -> a
force (a -> m a) -> m a -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a
m
{-# INLINE deepevalM #-}
newtype BNF a = BNF a
instance NFData (BNF a) where
rnf :: BNF a -> ()
rnf (BNF a
a) = a
a a -> () -> ()
`seq` ()