{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Control.Prim.Eval
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Control.Prim.Eval
  ( -- * Liveness
    touch
  , touch#
  , keepAlive
  , keepAlive#
    -- * Weak-Head Normal Form
  , seq
  , eval
  , evalM
    -- * Normal Form
  , deepeval
  , deepevalM
  , module Control.DeepSeq
  , BNF(..)
  ) where

import Control.DeepSeq
import Control.Prim.Monad.Internal
import qualified GHC.Exts as GHC


-- | Same as `GHC.Exts.touch#`, except it is not restricted to `RealWorld` state token.
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# #-}


------- Evaluation


-- | This is an action that ensures that the value is still available and garbage
-- collector has not cleaned it up.
--
-- Make sure not to use it after some computation that doesn't return, like after
-- `forever` for example, otherwise touch will simply be removed by ghc and bad things
-- will happen. If you have a case like that, make sure to use `withAlivePrimBase` or
-- `keepAlive` instead.
--
-- @since 0.1.0
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 #-}


-- | Forward compatible operator that might be introduced in some future ghc version.
--
-- See: [#17760](https://gitlab.haskell.org/ghc/ghc/-/issues/17760)
--
-- Current version is not as efficient as the version that will be introduced in the
-- future, because it works around the ghc bug by simply preventing inlining and relying
-- on the `touch` function.
--
-- @since 0.1.0
keepAlive# ::
     a
  -- ^ The value to preserve
  -> (GHC.State# s -> (# GHC.State# s, r #))
  -- ^ The continuation in which the value will be preserved
  -> 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# #-}


-- | Similar to `touch`. See `withAlive#` for more info.
--
-- @since 0.3.0
keepAlive ::
     MonadUnliftPrim s m
  => a
  -- ^ The value to preserve
  -> m b
  -- ^ Action to run in which the value will be preserved
  -> 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 #-}



-- | An action that evaluates a value to Weak Head Normal Form (WHNF). Same as
-- `Control.Exception.evaluate`, except it works in `MonadPrim`. This function provides
-- stronger guarantees than `seq` with respect to ordering of operations, but it does have a
-- slightly higher overhead.
--
-- @since 0.3.0
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 #-}

-- | Run the action and then use `eval` to ensure its result is evaluated to Weak Head
-- Normal Form (WHNF)
--
-- @since 0.3.0
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 #-}


-- Normal Form


-- | An action that evaluates a value to Normal Form (NF). This function provides stronger
-- guarantees than `deepseq` with respect to ordering of operations.
--
-- @since 0.3.0
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 #-}

-- | Run the action and the using `deepeval` ensure its result is evaluated to Normal Form
-- (NF)
--
-- @since 0.3.0
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 #-}


-- | Bogus Normal Form. This is useful in places where `NFData` constraint is required,
-- but an instance can't really be created in any meaningful way for the type at
-- hand. Creating environment in benchmarks is one such place where it may come in handy.
--
-- @since 0.3.0
newtype BNF a = BNF a

-- | Unlawful instance that only evaluates its contents to WHNF
--
-- @since 0.3.0
instance NFData (BNF a) where
  rnf :: BNF a -> ()
rnf (BNF a
a) = a
a a -> () -> ()
`seq` ()