mirror of
https://github.com/ekmett/speculation.git
synced 2024-11-26 11:44:15 +03:00
refactored out knowledge of tag-bits into separate package
This commit is contained in:
parent
d58442e1d0
commit
711e744dc0
@ -15,28 +15,15 @@ module Control.Concurrent.Speculation
|
||||
, specOnSTM'
|
||||
, specBySTM
|
||||
, specBySTM'
|
||||
-- * Determining if a closure is evaluated
|
||||
, unsafeGetTagBits
|
||||
, unsafeIsEvaluated
|
||||
) where
|
||||
|
||||
import Control.Concurrent.STM
|
||||
import Control.Concurrent.Speculation.Internal (returning)
|
||||
import Data.TagBits (unsafeIsEvaluated)
|
||||
import Control.Parallel (par)
|
||||
import Control.Monad (liftM2, unless)
|
||||
import Data.Function (on)
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 608
|
||||
-- import Data.Bits ((.&.))
|
||||
-- import Unsafe.Coerce (unsafeCoerce)
|
||||
import Foreign (sizeOf)
|
||||
import GHC.Prim
|
||||
import GHC.Types
|
||||
import GHC.Word
|
||||
-- dynamic pointer tagging is present on this platform
|
||||
#define TAGGED
|
||||
#endif
|
||||
|
||||
-- * Basic speculation
|
||||
|
||||
-- | @'spec' g f a@ evaluates @f g@ while forcing @a@, if @g == a@ then @f g@ is returned, otherwise @f a@ is evaluated and returned. Furthermore, if the argument has already been evaluated, we skip the @f g@ computation entirely. If a good guess at the value of @a@ is available, this is one way to induce parallelism in an otherwise sequential task. However, if the guess isn\'t available more cheaply than the actual answer, then this saves no work and if the guess is wrong, you risk evaluating the function twice. Under high load, since 'f g' is computed via the spark queue, the speculation will be skipped and you will obtain the same answer as 'f $! a'.
|
||||
@ -197,24 +184,3 @@ specOnSTM = specBySTM . on (liftM2 (==))
|
||||
specOnSTM' :: Eq c => (a -> STM c) -> STM a -> (a -> STM b) -> a -> STM b
|
||||
specOnSTM' = specBySTM' . on (liftM2 (==))
|
||||
{-# INLINE specOnSTM' #-}
|
||||
|
||||
-- | Inspect the dynamic pointer tagging bits of a closure. This is an impure function that relies on GHC internals and may falsely return 0, but should never give the wrong tag number if it returns a non-0 value.
|
||||
unsafeGetTagBits :: a -> Word
|
||||
{-# INLINE unsafeGetTagBits #-}
|
||||
#ifndef TAGGED
|
||||
unsafeGetTagBits _ = 0
|
||||
#else
|
||||
unsafeGetTagBits a = W# (and# (unsafeCoerce# a) (int2Word# mask#))
|
||||
where
|
||||
!(I# mask#) = sizeOf (undefined :: Int) - 1
|
||||
|
||||
-- unsafeGetTagBits a = unsafeCoerce (Box a) .&. (sizeOf (undefined :: Word) - 1)
|
||||
-- data Box a = Box a
|
||||
#endif
|
||||
|
||||
-- | Returns a guess as to whether or not a value has been evaluated. This is an impure function that relies on GHC internals and will return false negatives, but no false positives. This is unsafe as the value of this function will vary (from False to True) over the course of otherwise pure invocations!
|
||||
unsafeIsEvaluated :: a -> Bool
|
||||
unsafeIsEvaluated a = and# (unsafeCoerce# a) (int2Word# mask#) `gtWord#` int2Word# 0#
|
||||
where
|
||||
!(I# mask#) = sizeOf (undefined :: Int) - 1
|
||||
{-# INLINE unsafeIsEvaluated #-}
|
||||
|
@ -1,5 +1,5 @@
|
||||
name: speculation
|
||||
version: 0.9.0.0
|
||||
version: 1.0.0.0
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Edward A. Kmett
|
||||
@ -106,6 +106,7 @@ library
|
||||
build-depends:
|
||||
base >= 4 && < 6,
|
||||
ghc-prim >= 0.2 && < 0.3,
|
||||
tag-bits >= 0.1 && < 0.2,
|
||||
parallel >= 2.2 && < 2.3,
|
||||
stm >= 2.1 && < 2.2
|
||||
|
||||
@ -130,6 +131,7 @@ executable test-speculation
|
||||
build-depends:
|
||||
base >= 4 && < 6,
|
||||
ghc-prim >= 0.2 && < 0.3,
|
||||
tag-bits >= 0.1 && < 0.2,
|
||||
parallel >= 2.2 && < 2.3,
|
||||
stm >= 2.1 && < 2.2,
|
||||
containers >= 0.3.0 && < 0.4,
|
||||
@ -157,6 +159,7 @@ executable benchmark-speculation
|
||||
build-depends:
|
||||
base >= 4 && < 6,
|
||||
ghc-prim >= 0.2 && < 0.3,
|
||||
tag-bits >= 0.1 && < 0.2,
|
||||
parallel >= 2.2 && < 2.3,
|
||||
stm >= 2.1 && < 2.2,
|
||||
containers >= 0.3.0 && < 0.4,
|
||||
|
Loading…
Reference in New Issue
Block a user