Permalink
Browse files

reshuffled module hierarchy

  • Loading branch information...
1 parent 711e744 commit a0196b232a0b86dda97c625c0cdd016ee2d84605 @ekmett committed Jan 19, 2011
@@ -1,5 +1,5 @@
{-# LANGUAGE CPP, BangPatterns, DeriveDataTypeable, MagicHash #-}
-module Control.Concurrent.Speculation
+module Data.Speculation
(
-- * Speculative application
spec
@@ -18,15 +18,15 @@ module Control.Concurrent.Speculation
) where
import Control.Concurrent.STM
-import Control.Concurrent.Speculation.Internal (returning)
+import Data.Speculation.Internal (returning)
import Data.TagBits (unsafeIsEvaluated)
-import Control.Parallel (par)
import Control.Monad (liftM2, unless)
import Data.Function (on)
+import GHC.Conc
-- * 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'.
+-- | @'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 or are not running on the threaded runtime, 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 or in a runtime with access to a single capability, since 'f g' is computed via the spark queue, the speculation will be skipped and you will obtain the same answer as 'f $! a'.
--
--The best-case timeline looks like:
--
@@ -84,13 +84,13 @@ specBy cmp guess f a
-- | 'spec'' with a user defined comparison function
specBy' :: (a -> a -> Bool) -> a -> (a -> b) -> a -> b
-specBy' cmp guess f a =
- speculation `par`
- if cmp guess a
- then speculation
- else f a
- where
- speculation = f guess
+specBy' cmp guess f a
+ | numCapabilities == 1 = f $! a
+ | otherwise = speculation `par`
+ if cmp guess a
+ then speculation
+ else f a
+ where speculation = f guess
{-# INLINE specBy' #-}
-- | 'spec' comparing by projection onto another type
@@ -105,9 +105,9 @@ specOn' = specBy' . on (==)
-- * STM-based speculation
--- | @'specSTM' g f a@ evaluates @fg = do g' <- g; f g'@, while forcing @a@, then if @g' == a@ then @fg@ is returned. Otherwise the side-effects of @fg@ are rolled back and @f a@ is evaluated. @g@ is allowed to be a monadic action, so that we can kickstart the computation of @a@ earlier.
+-- | @'specSTM' g f a@ evaluates @fg = do g' <- g; f g'@, while forcing @a@, then if @g' == a@ then @fg@ is returned. Otherwise the side-effects of @fg@ are rolled back and @f a@ is evaluated. @g@ is allowed to be a monadic action, so that we can kickstart the computation of @a@ earlier. Under high load, or when we are not using the parallel runtime, the speculation is avoided, to enable this to more closely approximate the runtime profile of spec.
--
--- If the argument @a@ is already evaluated, we don\'t bother to perform @fg@ at all.
+-- If the argument @a@ is already evaluated, we don\'t bother to perform @f g@ at all.
--
-- If a good guess at the value of @a@ is available, this is one way to induce parallelism in an otherwise sequential task.
--
@@ -162,17 +162,26 @@ specBySTM cmp guess f a
| otherwise = specBySTM' cmp guess f a
{-# INLINE specBySTM #-}
+#ifndef HAS_NUM_SPARKS
+numSparks :: IO Int
+numSparks = return 0
+#endif
+
-- | 'specSTM'' using a user defined comparison function
specBySTM' :: (a -> a -> STM Bool) -> STM a -> (a -> STM b) -> a -> STM b
-specBySTM' cmp mguess f a = a `par` do
- guess <- mguess
- result <- f guess
- -- rendezvous with a
- matching <- cmp guess a
- unless matching retry
- return result
- `orElse`
- f a
+specBySTM' cmp mguess f a = do
+ sparks <- unsafeIOToSTM numSparks
+ if sparks < numCapabilities
+ then a `par` do
+ guess <- mguess
+ result <- f guess
+ -- rendezvous with a
+ matching <- cmp guess a
+ unless matching retry
+ return result
+ `orElse`
+ f a
+ else f $! a
{-# INLINE specBySTM' #-}
-- | @'specBySTM' . 'on' (==)@
View
@@ -0,0 +1,70 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Data.Speculation.Cont
+-- Copyright : (C) 2011 Edward Kmett, Jake McArthur
+-- License : BSD-style (see the file LICENSE)
+--
+-- Maintainer : Edward Kmett <ekmett@gmail.com>
+-- Stability : provisional
+-- Portability : portable
+--
+-- Versions of the combinators from the 'speculation' package
+-- with the signature rearranged to enable them to be used
+-- directly as actions in the 'Cont' and 'ContT' monads.
+----------------------------------------------------------------------------
+module Data.Speculation.Cont where
+
+import Control.Monad.Trans.Cont
+import qualified Data.Speculation as Prim
+import Control.Concurrent.STM
+
+-- * Basic speculation
+
+-- | When a is unevaluated, @'spec' g a@ evaluates the current continuation
+-- with @g@ while testing if @g@ '==' @a@, if they differ, it re-evalutes the
+-- continuation with @a@. If @a@ was already evaluated, the continuation is
+-- just directly applied to @a@ instead.
+spec :: Eq a => a -> a -> ContT r m a
+spec g a = ContT $ \k -> Prim.spec g k a
+
+-- | As per 'spec', without the check for whether or not the second argument
+-- is already evaluated.
+spec' :: Eq a => a -> a -> ContT r m a
+spec' g a = ContT $ \k -> Prim.spec' g k a
+
+-- | @spec@ with a user supplied comparison function
+specBy :: (a -> a -> Bool) -> a -> a -> ContT r m a
+specBy f g a = ContT $ \k -> Prim.specBy f g k a
+
+-- | @spec'@ with a user supplied comparison function
+specBy' :: (a -> a -> Bool) -> a -> a -> ContT r m a
+specBy' f g a = ContT $ \k -> Prim.specBy' f g k a
+
+-- | @spec'@ with a user supplied comparison function
+specOn :: Eq c => (a -> c) -> a -> a -> ContT r m a
+specOn f g a = ContT $ \k -> Prim.specOn f g k a
+
+-- | @spec'@ with a user supplied comparison function
+specOn' :: Eq c => (a -> c) -> a -> a -> ContT r m a
+specOn' f g a = ContT $ \k -> Prim.specOn' f g k a
+
+-- * STM-based speculation
+
+specSTM :: Eq a => STM a -> a -> ContT r STM a
+specSTM g a = ContT $ \k -> Prim.specSTM g k a
+
+specSTM' :: Eq a => STM a -> a -> ContT r STM a
+specSTM' g a = ContT $ \k -> Prim.specSTM' g k a
+
+specOnSTM :: Eq c => (a -> STM c) -> STM a -> a -> ContT r STM a
+specOnSTM f g a = ContT $ \k -> Prim.specOnSTM f g k a
+
+specOnSTM' :: Eq c => (a -> STM c) -> STM a -> a -> ContT r STM a
+specOnSTM' f g a = ContT $ \k -> Prim.specOnSTM' f g k a
+
+specBySTM :: (a -> a -> STM Bool) -> STM a -> a -> ContT r STM a
+specBySTM f g a = ContT $ \k -> Prim.specBySTM f g k a
+
+specBySTM' :: (a -> a -> STM Bool) -> STM a -> a -> ContT r STM a
+specBySTM' f g a = ContT $ \k -> Prim.specBySTM' f g k a
+
@@ -1,5 +1,5 @@
{-# LANGUAGE BangPatterns #-}
-module Data.Foldable.Speculation
+module Data.Speculation.Foldable
(
-- * Speculative folds
fold, foldBy
@@ -55,8 +55,8 @@ import Data.Function (on)
import Data.Foldable (Foldable)
import qualified Data.Foldable as Foldable
import Control.Concurrent.STM
-import Control.Concurrent.Speculation
-import Control.Concurrent.Speculation.Internal
+import Data.Speculation
+import Data.Speculation.Internal
import Control.Applicative
import Control.Monad hiding (mapM_, msum, forM_, sequence_)
@@ -1,4 +1,4 @@
-module Control.Concurrent.Speculation.Internal
+module Data.Speculation.Internal
( Acc(..)
, extractAcc
, MaybeAcc(..)
@@ -1,5 +1,5 @@
{-# LANGUAGE BangPatterns #-}
-module Data.List.Speculation
+module Data.Speculation.List
(
-- * Speculative scans
scan, scanBy
@@ -29,8 +29,8 @@ import Prelude hiding
import Data.Monoid
import qualified Data.List as List
-import Control.Concurrent.Speculation
-import Control.Concurrent.Speculation.Internal
+import Data.Speculation
+import Data.Speculation.Internal
-- | Given a valid estimator @g@, @'scan' g xs@ converts @xs@ into a list of the prefix sums.
--
@@ -1,12 +1,12 @@
{-# LANGUAGE BangPatterns, MagicHash #-}
-module Control.Morphism.Speculation
+module Data.Speculation.Morphism
( hylo
) where
import GHC.Prim
import GHC.Types
-import Control.Concurrent.Speculation
+import Data.Speculation
{-
newtype Mu f = In { out :: f (Mu f) }
@@ -1,5 +1,5 @@
{-# LANGUAGE MagicHash, Rank2Types, UnboxedTuples, BangPatterns #-}
-module Data.Traversable.Speculation
+module Data.Speculation.Traversable
(
-- * Traversable
-- ** Applicative Traversals
@@ -26,8 +26,8 @@ import Data.Traversable (Traversable)
import qualified Data.Traversable as Traversable
import Control.Applicative
import Control.Concurrent.STM
-import Control.Concurrent.Speculation
-import Control.Concurrent.Speculation.Internal
+import Data.Speculation
+import Data.Speculation.Internal
mapAccumL :: (Traversable t, Eq a) => (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL = mapAccumLBy (==)
View
@@ -8,7 +8,7 @@ import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck (testProperty)
import Test.QuickCheck hiding ((==>))
-- import Test.HUnit hiding (Test)
-import Control.Concurrent.Speculation
+import Data.Speculation
main :: IO ()
main = defaultMain tests
Oops, something went wrong.

0 comments on commit a0196b2

Please sign in to comment.