module Control.Concurrent.Speculation.Internal
(
evaluated
, Codensity(..)
, liftCodensity
, lowerCodensity
) where
import Control.Applicative
import Control.Monad
import Data.Bits ((.&.))
import Foreign (sizeOf)
import Unsafe.Coerce (unsafeCoerce)
data Box a = Box a
tag :: a -> Int
tag a = unsafeCoerce (Box a) .&. (sizeOf (undefined :: Int) 1)
evaluated :: a -> Bool
evaluated a = tag a /= 0
newtype Codensity f a = Codensity { runCodensity :: forall r. (a -> f r) -> f r }
instance Functor (Codensity f) where
fmap f (Codensity m) = Codensity $ \k -> m (k . f)
instance Applicative (Codensity f) where
pure = return
(<*>) = ap
instance Monad (Codensity f) where
return x = Codensity (\k -> k x)
Codensity m >>= f = Codensity (\k -> m (\a -> runCodensity (f a) k))
liftCodensity :: Monad m => m a -> Codensity m a
liftCodensity m = Codensity (m >>=)
lowerCodensity :: Monad m => Codensity m a -> m a
lowerCodensity a = runCodensity a return