ekmett/speculation
1
1
Fork 0
mirror of https://github.com/ekmett/speculation.git synced 2024-11-23 10:59:33 +03:00
Code Issues Projects Releases Wiki Activity

added specOn and specBy, and separated out Data.Foldable.Speculation

Browse Source
This commit is contained in:
ekmett 2010-06-27 08:02:55 -07:00
parent ea28588e08
commit 4378fc4e6b
5 changed files with 489 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
Control/Concurrent/STM/Speculation.hs
View File

@ -2,6 +2,10 @@
module Control.Concurrent.STM.Speculation
( specSTM
, specSTM'
, specOnSTM
, specOnSTM'
, specBySTM
, specBySTM'
) where
import Control.Concurrent.STM
@ -9,6 +13,7 @@ import Control.Concurrent.Speculation (evaluated)
import Control.Exception (Exception, throw, fromException)
import Control.Parallel (par)
import Data.Typeable (Typeable)
import Data.Function (on)
import System.IO.Unsafe (unsafePerformIO)
newtype Speculation = Speculation Int deriving (Show,Eq,Typeable)
@ -46,25 +51,47 @@ instance Exception Speculation
-- > [------ f a ------]
specSTM :: Eq a => a -> (a -> STM b) -> a -> STM b
specSTM g f a
| evaluated a = f a
| otherwise = specSTM' g f a
specSTM = specBySTM (==)
{-# INLINE specSTM #-}
-- | Unlike @specSTM@, @specSTM'@ doesn't check if the argument has already been evaluated.
-- | Unlike 'specSTM', 'specSTM'' doesn't check if the argument has already been evaluated.
specSTM' :: Eq a => a -> (a -> STM b) -> a -> STM b
specSTM' g f a = a `par` do
specSTM' = specBySTM' (==)
{-# INLINE specSTM' #-}
-- | 'specSTM' using a user defined comparison function
specBySTM :: (a -> a -> Bool) -> a -> (a -> STM b) -> a -> STM b
specBySTM cmp g f a
| evaluated a = f a
| otherwise = specBySTM' cmp g f a
{-# INLINE specBySTM #-}
-- | 'specSTM'' using a user defined comparison function
specBySTM' :: (a -> a -> Bool) -> a -> (a -> STM b) -> a -> STM b
specBySTM' cmp g f a = a `par` do
exn <- freshSpeculation
let try = do
result <- f g
if a /= g
then throw exn
else return result
let
try = do
result <- f g
if cmp g a
then return result
else throw exn
try `catchSTM` \e -> case fromException e of
Just exn' | exn == exn' -> f a -- rerun with alternative inputs
_ -> throw e -- this is somebody else's problem
{-# INLINE specSTM' #-}
{-# INLINE specBySTM' #-}
-- | 'specOnSTM' . 'on' (==)'
specOnSTM :: Eq c => (a -> c) -> a -> (a -> STM b) -> a -> STM b
specOnSTM = specBySTM . on (==)
{-# INLINE specOnSTM #-}
-- | 'specOnSTM'' . 'on' (==)'
specOnSTM' :: Eq c => (a -> c) -> a -> (a -> STM b) -> a -> STM b
specOnSTM' = specBySTM' . on (==)
{-# INLINE specOnSTM' #-}
speculationSupply :: TVar Int
speculationSupply = unsafePerformIO $ newTVarIO 0
@ -76,3 +103,4 @@ freshSpeculation = do
writeTVar speculationSupply $! n + 1
return (Speculation n)
{-# INLINE freshSpeculation #-}

132
Control/Concurrent/Speculation.hs
View File

@ -1,24 +1,22 @@
{-# LANGUAGE BangPatterns #-}
module Control.Concurrent.Speculation
( spec
(
-- * Speculative application
spec
, spec'
, specBy
, specBy'
, specOn
, specOn'
-- * Detecting closure evaluation
, evaluated
, specFoldr
, specFoldl
, specFoldr1
, specFoldl1
, specFoldrN
, specFoldlN
) where
import Prelude hiding (foldl, foldl1, foldr, foldr1)
import Data.Ix ()
import Data.Foldable
import Control.Parallel (par)
import Data.Bits
import Foreign
import Unsafe.Coerce
import Data.Function (on)
import Data.Bits ((.&.))
import Foreign (sizeOf)
import Unsafe.Coerce (unsafeCoerce)
data Box a = Box a
@ -65,98 +63,40 @@ evaluated a = tag a /= 0
-- > [---- f a ----]
spec :: Eq a => a -> (a -> b) -> a -> b
spec g f a
| evaluated a = f a
| otherwise = spec' g f a
spec = specBy (==)
{-# INLINE spec #-}
-- | Unlike 'spec', this version does not check to see if the argument has already been evaluated. This can save
-- a small amount of work when you know the argument will always require computation.
spec' :: Eq a => a -> (a -> b) -> a -> b
spec' guess f a =
spec' = specBy' (==)
{-# INLINE spec' #-}
-- | 'spec' with a user defined comparison function
specBy :: (a -> a -> Bool) -> a -> (a -> b) -> a -> b
specBy cmp g f a
| evaluated a = f a
| otherwise = specBy' cmp g f a
{-# INLINE specBy #-}
-- | 'spec'' with a user defined comparison function
specBy' :: (a -> a -> Bool) -> a -> (a -> b) -> a -> b
specBy' cmp guess f a =
speculation `par`
if guess == a
if cmp guess a
then speculation
else f a
where
speculation = f guess
{-# INLINE spec' #-}
{-# INLINE specBy' #-}
-- | Given a valid estimator @g@, @'specFoldr' g f z xs@ yields the same answer as @'foldr'' f z xs@.
--
-- @g n@ should supply an estimate of the value returned from folding over the last @n@ elements of the container.
--
-- If @g n@ is accurate a reasonable percentage of the time and faster to compute than the fold, then this can
-- provide increased opportunities for parallelism.
--
-- > specFoldr = specFoldrN 0
-- | 'spec' comparing by projection onto another type
specOn :: Eq c => (a -> c) -> a -> (a -> b) -> a -> b
specOn = specBy . on (==)
{-# INLINE specOn #-}
specFoldr :: (Foldable f, Eq b) => (Int -> b) -> (a -> b -> b) -> b -> f a -> b
specFoldr = specFoldrN 0
{-# INLINE specFoldr #-}
-- | Given a valid estimator @g@, @'specFoldl' g f z xs@ yields the same answer as @'foldl'' f z xs@.
--
-- @g n@ should supply an estimate of the value returned from folding over the first @n@ elements of the container.
--
-- If @g n@ is accurate a reasonable percentage of the time and faster to compute than the fold, then this can
-- provide increased opportunities for parallelism.
--
-- > specFoldl = specFoldlN 0
specFoldl :: (Foldable f, Eq b) => (Int -> b) -> (b -> a -> b) -> b -> f a -> b
specFoldl = specFoldlN 0
{-# INLINE specFoldl #-}
-- | 'specFoldr1' is to 'foldr1'' as 'specFoldr' is to 'foldr''
specFoldr1 :: (Foldable f, Eq a) => (Int -> a) -> (a -> a -> a) -> f a -> a
specFoldr1 g f = specFoldr1List g f . toList
{-# INLINE specFoldr1 #-}
specFoldr1List :: Eq a => (Int -> a) -> (a -> a -> a) -> [a] -> a
specFoldr1List g f = go 0
where
go _ [] = errorEmptyStructure "specFoldr1"
go _ [x] = x
go !n (x:xs) = n' `seq` spec' (g n') (f x) (go n' xs)
where
n' = n + 1
{-# INLINE specFoldr1List #-}
-- | Given a valid estimator @g@, @'specFoldrN' n g f z xs@ yields the same answer as @'foldr' f z xs@.
--
-- @g m@ should supply an estimate of the value returned from folding over the last @m - n@ elements of the container.
specFoldrN :: (Foldable f, Eq b) => Int -> (Int -> b) -> (a -> b -> b) -> b -> f a -> b
specFoldrN n0 g f z = go n0 . toList
where
go _ [] = z
go !n (x:xs) = n' `seq` spec' (g n') (f x) (go n' xs)
where
n' = n + 1
{-# INLINE specFoldrN #-}
-- | 'specFoldl1' is to 'foldl1'' as 'specFoldl' is to 'foldl''
specFoldl1 :: (Foldable f, Eq a) => (Int -> a) -> (a -> a -> a) -> f a -> a
specFoldl1 g f = specFoldl1List g f . toList
{-# INLINE specFoldl1 #-}
specFoldl1List :: Eq a => (Int -> a) -> (a -> a -> a) -> [a] -> a
specFoldl1List _ _ [] = errorEmptyStructure "specFoldl1"
specFoldl1List g f (x:xs) = specFoldlN 1 g f x xs
{-# INLINE specFoldl1List #-}
-- | Given a valid estimator @g@, @'specFoldlN' n g f z xs@ yields the same answer as @'foldl' f z xs@.
--
-- @g m@ should supply an estimate of the value returned from folding over the first @m - n@ elements of the container.
specFoldlN :: (Foldable f, Eq b) => Int -> (Int -> b) -> (b -> a -> b) -> b -> f a -> b
specFoldlN n0 g f z0 = go n0 z0 . toList
where
go _ z [] = z
go !n z (x:xs) = n' `seq` spec' (g n') (\z' -> go n' z' xs) (f z x)
where
n' = n + 1
{-# INLINE specFoldlN #-}
errorEmptyStructure :: String -> a
errorEmptyStructure f = error $ f ++ ": error empty structure"
-- | 'spec'' comparing by projection onto another type
specOn' :: Eq c => (a -> c) -> a -> (a -> b) -> a -> b
specOn' = specBy' . on (==)
{-# INLINE specOn' #-}

325
Data/Foldable/Speculation.hs Normal file
View File

@ -0,0 +1,325 @@
{-# LANGUAGE BangPatterns #-}
module Data.Foldable.Speculation
(
-- * Speculative folds
fold, foldBy
, foldMap, foldMapBy
, foldr, foldrBy
, foldl, foldlBy
, foldr1, foldr1By
, foldl1, foldl1By
, traverse_, traverseBy_
, for_, forBy_
, mapM_, mapMBy_
, forM_, forMBy_
, sequenceA_, sequenceABy_
, sequence_, sequenceBy_
, asum, asumBy
, msum, msumBy
, toList, toListBy
, concat, concatBy
, concatMap, concatMapBy
, all, any, and, or
, sum, sumBy
, product, productBy
, maximum, maximumBy
, minimum, minimumBy
, elem, elemBy
, notElem, notElemBy
, find, findBy
) where
import Prelude hiding
(foldl, foldl1, foldr, foldr1
, any, all, and, or, mapM_, sequence_
, elem, notElem, sum, product
, minimum, maximum, concat, concatMap
)
import Data.Monoid
import Data.Ix ()
import Data.Function (on)
import Data.Foldable (Foldable)
import qualified Data.Foldable as Foldable
import Control.Applicative
import Control.Concurrent.Speculation
import Control.Monad hiding (mapM_, msum, forM_, sequence_)
-- | Given a valid estimate @g@, @'fold' g f xs@ yields the same answer as @'fold' f xs@.
--
-- @g n@ should supply an estimate of the value of the monoidal summation over the last @n@ elements of the container.
--
-- If @g n@ is accurate a reasonable percentage of the time and faster to compute than the fold, then this can
-- provide increased opportunities for parallelism.
fold :: (Foldable f, Monoid m, Eq m) => (Int -> m) -> f m -> m
fold = foldBy (==)
{-# INLINE fold #-}
-- | 'fold' using 'specBy'
foldBy :: (Foldable f, Monoid m) => (m -> m -> Bool) -> (Int -> m) -> f m -> m
foldBy cmp g = foldrBy cmp g mappend mempty
{-# INLINE foldBy #-}
-- | Given a valid estimate @g@, @'foldMap' g f xs@ yields the same answer as @'foldMap' f xs@.
--
-- @g n@ should supply an estimate of the value of the monoidal summation over the last @n@ elements of the container.
--
-- If @g n@ is accurate a reasonable percentage of the time and faster to compute than the fold, then this can
-- provide increased opportunities for parallelism.
foldMap :: (Foldable f, Monoid m, Eq m) => (Int -> m) -> (a -> m) -> f a -> m
foldMap = foldMapBy (==)
{-# INLINE foldMap #-}
foldMapBy :: (Foldable f, Monoid m) => (m -> m -> Bool) -> (Int -> m) -> (a -> m) -> f a -> m
foldMapBy cmp g f = foldrBy cmp g (mappend . f) mempty
{-# INLINE foldMapBy #-}
-- | Given a valid estimator @g@, @'foldr' g f z xs@ yields the same answer as @'foldr'' f z xs@.
--
-- @g n@ should supply an estimate of the value returned from folding over the last @n@ elements of the container.
--
-- If @g n@ is accurate a reasonable percentage of the time and faster to compute than the fold, then this can
-- provide increased opportunities for parallelism.
foldr :: (Foldable f, Eq b) => (Int -> b) -> (a -> b -> b) -> b -> f a -> b
foldr = foldrBy (==)
{-# INLINE foldr #-}
foldrBy :: Foldable f => (b -> b -> Bool) -> (Int -> b) -> (a -> b -> b) -> b -> f a -> b
foldrBy cmp g f z = extractAcc . Foldable.foldr mf (Acc 0 z)
where
mf a (Acc n b) = let n' = n + 1 in Acc n' (specBy' cmp (g n') (f a) b)
{-# INLINE foldrBy #-}
-- | Given a valid estimator @g@, @'foldl' g f z xs@ yields the same answer as @'foldl'' f z xs@.
--
-- @g n@ should supply an estimate of the value returned from folding over the first @n@ elements of the container.
--
-- If @g n@ is accurate a reasonable percentage of the time and faster to compute than the fold, then this can
-- provide increased opportunities for parallelism.
foldl :: (Foldable f, Eq b) => (Int -> b) -> (b -> a -> b) -> b -> f a -> b
foldl = foldlBy (==)
{-# INLINE foldl #-}
foldlBy :: Foldable f => (b -> b -> Bool) -> (Int -> b) -> (b -> a -> b) -> b -> f a -> b
foldlBy cmp g f z = extractAcc . Foldable.foldl mf (Acc 0 z)
where
mf (Acc n a) b = let n' = n + 1 in Acc n' (specBy' cmp (g n') (`f` b) a)
{-# INLINE foldlBy #-}
foldr1 :: (Foldable f, Eq a) => (Int -> a) -> (a -> a -> a) -> f a -> a
foldr1 = foldr1By (==)
{-# INLINE foldr1 #-}
foldr1By :: Foldable f => (a -> a -> Bool) -> (Int -> a) -> (a -> a -> a) -> f a -> a
foldr1By cmp g f xs = fromMaybeAcc (errorEmptyStructure "foldr1")
(Foldable.foldr mf NothingAcc xs)
where
mf a (JustAcc n b) = let n' = n + 1 in JustAcc n' (specBy' cmp (g n') (f a) b)
mf a NothingAcc = JustAcc 1 a
{-# INLINE foldr1By #-}
foldl1 :: (Foldable f, Eq a) => (Int -> a) -> (a -> a -> a) -> f a -> a
foldl1 = foldl1By (==)
{-# INLINE foldl1 #-}
foldl1By :: Foldable f => (a -> a -> Bool) -> (Int -> a) -> (a -> a -> a) -> f a -> a
foldl1By cmp g f xs = fromMaybeAcc (errorEmptyStructure "foldl1")
(Foldable.foldl mf NothingAcc xs)
where
mf (JustAcc n a) b = let n' = n + 1 in JustAcc n' (specBy' cmp (g n') (`f` b) a)
mf NothingAcc b = JustAcc 1 b
{-# INLINE foldl1By #-}
-- | Map each element of a structure to an action, evaluate these actions
-- from left to right and ignore the results.
traverse_ :: (Foldable t, Applicative f, Eq (f ())) => (Int -> f c) -> (a -> f b) -> t a -> f ()
traverse_ = traverseBy_ (==)
{-# INLINE traverse_ #-}
traverseBy_ :: (Foldable t, Applicative f) => (f () -> f () -> Bool) -> (Int -> f c) -> (a -> f b) -> t a -> f ()
traverseBy_ cmp g f = foldrBy cmp ((() <$) . g) ((*>) . f) (pure ())
{-# INLINE traverseBy_ #-}
-- | 'for_' is 'traverse_' with its arguments flipped.
for_ :: (Foldable t, Applicative f, Eq (f ())) => (Int -> f c) -> t a -> (a -> f b) -> f ()
for_ g = flip (traverse_ g)
{-# INLINE for_ #-}
forBy_ :: (Foldable t, Applicative f) => (f () -> f () -> Bool) -> (Int -> f c) -> t a -> (a -> f b) -> f ()
forBy_ cmp g = flip (traverseBy_ cmp g)
{-# INLINE forBy_ #-}
-- | Map each element of the structure to a monadic action, evaluating these actions
-- from left to right and ignore the results.
mapM_ :: (Foldable t, Monad m, Eq (m ())) => (Int -> m c) -> (a -> m b) -> t a -> m ()
mapM_ = mapMBy_ (==)
{-# INLINE mapM_ #-}
mapMBy_ :: (Foldable t, Monad m) => (m () -> m () -> Bool) -> (Int -> m c) -> (a -> m b) -> t a -> m ()
mapMBy_ cmp g f = foldrBy cmp (\a -> g a >> return ()) ((>>) . f) (return ())
{-# INLINE mapMBy_ #-}
-- | 'for_' is 'mapM_' with its arguments flipped.
forM_ :: (Foldable t, Monad m, Eq (m ())) => (Int -> m c) -> t a -> (a -> m b) -> m ()
forM_ g = flip (mapM_ g)
{-# INLINE forM_#-}
forMBy_ :: (Foldable t, Monad m) => (m () -> m () -> Bool) -> (Int -> m c) -> t a -> (a -> m b) -> m ()
forMBy_ cmp g = flip (mapMBy_ cmp g)
{-# INLINE forMBy_ #-}
sequenceA_ :: (Foldable t, Applicative f, Eq (f ())) => (Int -> f b) -> t (f a) -> f ()
sequenceA_ = sequenceABy_ (==)
{-# INLINE sequenceA_ #-}
sequenceABy_ :: (Foldable t, Applicative f, Eq (f ())) => (f () -> f () -> Bool) -> (Int -> f b) -> t (f a) -> f ()
sequenceABy_ cmp g = foldrBy cmp ((()<$) . g) (*>) (pure ())
{-# INLINE sequenceABy_ #-}
sequence_ :: (Foldable t, Monad m, Eq (m ())) => (Int -> m b) -> t (m a) -> m ()
sequence_ = sequenceBy_ (==)
{-# INLINE sequence_ #-}
sequenceBy_ :: (Foldable t, Monad m) => (m () -> m () -> Bool) -> (Int -> m b) -> t (m a) -> m ()
sequenceBy_ cmp g = foldrBy cmp (\a -> g a >> return ()) (>>) (return ())
{-# INLINE sequenceBy_ #-}
asum :: (Foldable t, Alternative f, Eq (f a)) => (Int -> f a) -> t (f a) -> f a
asum = asumBy (==)
{-# INLINE asum #-}
asumBy :: (Foldable t, Alternative f) => (f a -> f a -> Bool) -> (Int -> f a) -> t (f a) -> f a
asumBy cmp g = foldrBy cmp g (<|>) empty
{-# INLINE asumBy #-}
msum :: (Foldable t, MonadPlus m, Eq (m a)) => (Int -> m a) -> t (m a) -> m a
msum = msumBy (==)
{-# INLINE msum #-}
msumBy :: (Foldable t, MonadPlus m) => (m a -> m a -> Bool) -> (Int -> m a) -> t (m a) -> m a
msumBy cmp g = foldrBy cmp g mplus mzero
{-# INLINE msumBy #-}
toList :: (Foldable t, Eq a) => (Int -> [a]) -> t a -> [a]
toList = toListBy (==)
{-# INLINE toList #-}
toListBy :: Foldable t => ([a] -> [a] -> Bool) -> (Int -> [a]) -> t a -> [a]
toListBy cmp g = foldrBy cmp g (:) []
{-# INLINE toListBy #-}
concat :: (Foldable t, Eq a) => (Int -> [a]) -> t [a] -> [a]
concat = fold
{-# INLINE concat #-}
concatBy :: Foldable t => ([a] -> [a] -> Bool) -> (Int -> [a]) -> t [a] -> [a]
concatBy = foldBy
{-# INLINE concatBy #-}
concatMap :: (Foldable t, Eq b) => (Int -> [b]) -> (a -> [b]) -> t a -> [b]
concatMap = foldMap
{-# INLINE concatMap #-}
concatMapBy :: (Foldable t) => ([b] -> [b] -> Bool) -> (Int -> [b]) -> (a -> [b]) -> t a -> [b]
concatMapBy = foldMapBy
{-# INLINE concatMapBy #-}
and :: Foldable t => (Int -> Bool) -> t Bool -> Bool
and g = getAll . foldMap (All . g) All
{-# INLINE and #-}
or :: Foldable t => (Int -> Bool) -> t Bool -> Bool
or g = getAny . foldMap (Any . g) Any
{-# INLINE or #-}
all :: Foldable t => (Int -> Bool) -> (a -> Bool) -> t a -> Bool
all g p = getAll . foldMap (All . g) (All . p)
{-# INLINE all #-}
any :: Foldable t => (Int -> Bool) -> (a -> Bool) -> t a -> Bool
any g p = getAny . foldMap (Any . g) (Any . p)
{-# INLINE any #-}
sum :: (Foldable t, Num a) => (Int -> a) -> t a -> a
sum = sumBy (==)
{-# INLINE sum #-}
sumBy :: (Foldable t, Num a) => (a -> a -> Bool) -> (Int -> a) -> t a -> a
sumBy cmp g = getSum . foldMapBy (on cmp getSum) (Sum . g) Sum
{-# INLINE sumBy #-}
product :: (Foldable t, Num a) => (Int -> a) -> t a -> a
product = productBy (==)
{-# INLINE product #-}
productBy :: (Foldable t, Num a) => (a -> a -> Bool) -> (Int -> a) -> t a -> a
productBy cmp g = getProduct . foldMapBy (on cmp getProduct) (Product . g) Product
{-# INLINE productBy #-}
maximum :: (Foldable t, Ord a) => (Int -> a) -> t a -> a
maximum g = foldr1 g max
{-# INLINE maximum #-}
-- TODO: allow for patching?
maximumBy :: Foldable t => (a -> a -> Ordering) -> (Int -> a) -> t a -> a
maximumBy cmp g = foldr1By cmp' g max'
where
max' x y = case cmp x y of
GT -> x
_ -> y
cmp' x y = cmp x y == EQ
{-# INLINE maximumBy #-}
minimum :: (Foldable t, Ord a) => (Int -> a) -> t a -> a
minimum g = foldr1 g min
{-# INLINE minimum #-}
minimumBy :: Foldable t => (a -> a -> Ordering) -> (Int -> a) -> t a -> a
minimumBy cmp g = foldr1By cmp' g min'
where
min' x y = case cmp x y of
GT -> x
_ -> y
cmp' x y = cmp x y == EQ
{-# INLINE minimumBy #-}
elem :: (Foldable t, Eq a) => (Int -> Bool) -> a -> t a -> Bool
elem g = any g . (==)
{-# INLINE elem #-}
elemBy :: Foldable t => (a -> a -> Bool) -> (Int -> Bool) -> a -> t a -> Bool
elemBy cmp g = any g . cmp
{-# INLINE elemBy #-}
notElem :: (Foldable t, Eq a) => (Int -> Bool) -> a -> t a -> Bool
notElem g a = not . elem g a
{-# INLINE notElem #-}
notElemBy :: Foldable t => (a -> a -> Bool) -> (Int -> Bool) -> a -> t a -> Bool
notElemBy cmp g a = not . elemBy cmp g a
{-# INLINE notElemBy #-}
find :: (Foldable t, Eq a) => (Int -> Maybe a) -> (a -> Bool) -> t a -> Maybe a
find = findBy (==)
findBy :: Foldable t => (Maybe a -> Maybe a -> Bool) -> (Int -> Maybe a) -> (a -> Bool) -> t a -> Maybe a
findBy cmp g p = getFirst . foldMapBy (on cmp getFirst) (First . g) (\x -> if p x then First (Just x) else First (Nothing))
data Acc a = Acc {-# UNPACK #-} !Int a
extractAcc :: Acc a -> a
extractAcc (Acc _ a) = a
{-# INLINE extractAcc #-}
data MaybeAcc a = JustAcc {-# UNPACK #-} !Int a | NothingAcc
fromMaybeAcc :: a -> MaybeAcc a -> a
fromMaybeAcc _ (JustAcc _ a) = a
fromMaybeAcc a _ = a
{-# INLINE fromMaybeAcc #-}
errorEmptyStructure :: String -> a
errorEmptyStructure f = error $ f ++ ": error empty structure"

66
README.markdown
View File

@ -1,35 +1,65 @@
speculation
===========
Speculative evaluation primitives for Haskell, very loosely based on the paper "Safe Programmable Speculative Parallelism" by
Prabhu, Ramalingam, and Vaswani. <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.19.4622>
This package provides speculative evaluation primitives for Haskell, very loosely based on the paper
"Safe Programmable Speculative Parallelism" by Prabhu, Ramalingam, and Vaswani.
spec
----
<http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.19.4622>
## Combinators
### speculative function application
#### spec
spec :: Eq a => a -> (a -> b) -> a -> b
`spec` takes three arguments: An initial guess as to what the argument to the function will be when it is evaluated, a function to evaluate, and the actual argument to the function.
`spec g f a` evaluates `f g` while forcing `a`, if `g == a` then `f g` is returned. Otherwise `f a` is evaluated.
Spec checks to see if its actual argument has been evaluated, if so it just applies the function to the argument.
Furthermore, if the argument has already been evaluated, we avoid sparking the parallel computation at all.
Otherwise, it begins evaluating the function with the guessed argument in parallel with evaluating the argument.
If `g` is a good guess at the value of `a`, this is one way to induce parallelism in an otherwise sequential task.
If you guessed right, then the result of applying the function to your guess is returned.
However, if `g` isn\'t available more cheaply than `a`, then this saves no work, and if `g` is wrong, you risk evaluating the function twice.
spec a f a = f $! a
The best-case timeline looks like:
[---- f g ----]
[----- a -----]
[-- spec g f a --]
Otherwise, it then evaluates the function with the correct argument.
The worst-case timeline looks like:
[---- f g ----]
[----- a -----]
[---- f a ----]
[------- spec g f a -----------]
Compare these to the timeline of @f $! a@:
[---- a -----]
[---- f a ----]
If a good guess is available, this permits us to increase parallelism in the resulting program.
#### specSTM
It is subject to the following identity:
`specSTM` provides a similar compressed timeline for speculated STM actions, but also rolls back side-effects.
spec a f a = a `seq` f a
speculative folds
-----------------
A number of speculative folds are also provided via the Speculative class.
### folds
A number of speculative folds are also provided.
These take an extra argument which is a function that guesses the result of of the fold up to a given point.
A minimal definition for Speculative can be derived automatically for any Foldable container.
#### specFoldr
specFoldr :: (Foldable f, Eq b) => (Int -> b) -> (a -> b -> b) -> b -> f a -> b
Given a valid estimator `g`, `'specFoldr g f z xs` yields the same answer as `foldr' f z xs`.
`g n` should supply an estimate of the value returned from folding over the /last/ `n` elements of the container.
As with `spec`, if the guess `g n` is accurate a reasonable percentage of the time and faster to compute than the fold, then this can provide increased opportunities for parallelism.
#### specFoldl
specFoldl :: (Foldable f, Eq b) => (Int -> b) -> (b -> a -> b) -> b -> f a -> b
`specFoldl` works similarly to `foldl'`, except that `g n` should provide an estimate for the /first/ `n` elements.

93
speculation.cabal
View File

@ -1,5 +1,5 @@
name: speculation
version: 0.2.1
version: 0.3.0
license: BSD3
license-file: LICENSE
author: Edward A. Kmett
@ -9,58 +9,46 @@ homepage: http://github.com/ekmett/speculation
category: Concurrency
synopsis: A framework for safe, programmable, speculative parallelism
description:
A framework for safe, programmable, speculative parallelism, loosely based on
<http://research.microsoft.com/pubs/118795/pldi026-vaswani.pdf>
.
@'spec' g f a@ evaluates @f g@ while forcing @a@, if @g == a@ then @f g@ is returned. Otherwise @f a@ is evaluated.
.
Furthermore, if the argument has already been evaluated, we avoid sparking the parallel computation 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.
.
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.
.
> spec a f a = f $! a
.
The best-case timeline looks like:
.
> [---- f g ----]
> [----- a -----]
> [-- spec g f a --]
.
The worst-case timeline looks like:
.
> [---- f g ----]
> [----- a -----]
> [---- f a ----]
> [------- spec g f a -----------]
.
Compare these to the timeline of @f $! a@:
.
> [---- a -----]
> [---- f a ----]
.
'specSTM' provides a similar time table for STM actions, but also rolls back side-effects.
.
/Changes in 0.1.0:/
.
* Added @Control.Concurrent.STM.Speculation@ with 'specSTM', and 'specSTM''
.
/Changes in 0.0.2:/
.
* 'specFoldr1' bug fix
.
* Added 'spec'' combinator
.
/Changes in 0.0.1:/
.
* Added 'WithoutSpeculation' and 'WrappedFoldable'
A framework for safe, programmable, speculative parallelism, loosely based on
<http://research.microsoft.com/pubs/118795/pldi026-vaswani.pdf>
.
This package provides speculative function application and speculative folds. And speculative STM actions take the place
of the transactional rollback machinery from the paper.
.
For example:
.
@'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.
.
The best-case timeline looks like:
.
> [---- f g ----]
> [----- a -----]
> [-- spec g f a --]
.
The worst-case timeline looks like:
.
> [---- f g ----]
> [----- a -----]
> [---- f a ----]
> [------- spec g f a -----------]
.
Compare these to the timeline of @f $! a@:
.
> [---- a -----]
> [---- f a ----]
.
'specSTM' provides a similar time table for STM actions, but also rolls back side-effects.
.
/Changes in 0.3.0:/
.
* Speculative folds moved to 'Data.Foldable.Speculation' and expanded to cover all of the
'Data.Foldable' combinators.
* specBy and specOn variants added.
copyright: (c) 2010 Edward A. Kmett
build-type: Simple
cabal-version: >=1.2
tested-with: GHC==6.12.1
copyright: (c) 2010 Edward A. Kmett
build-type: Simple
cabal-version: >=1.2
tested-with: GHC==6.12.1
extra-source-files: README.markdown
library
@ -74,3 +62,4 @@ library
exposed-modules:
Control.Concurrent.Speculation
Control.Concurrent.STM.Speculation
Data.Foldable.Speculation