speculation 0.0.2 → 0.1.0

raw patch · 3 files changed

+130/−40 lines, 3 filesdep +stm

Dependencies added: stm

Files

Control/Concurrent/STM/Speculation.hs +74/−0
Control/Concurrent/Speculation.hs +37/−29
speculation.cabal +19/−11

+ Control/Concurrent/STM/Speculation.hs view

@@ -0,0 +1,74 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Control.Concurrent.STM.Speculation +    ( specSTM+    , specSTM'+    ) where++import Control.Concurrent.STM+import Control.Concurrent.Speculation (evaluated)+import Control.Exception (Exception, throw, fromException)+import Control.Parallel (par)+import Data.Typeable (Typeable)+import System.IO.Unsafe (unsafePerformIO)++newtype Speculation = Speculation Int deriving (Show,Eq,Typeable)+instance Exception Speculation++-- | @'specSTM' g f a@ evaluates @f g@ while forcing @a@, if @g == a@ then @f g@ is returned. Otherwise the side-effects +-- of the current STM transaction are rolled back and @f a@ is evaluated.+--   +-- 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. +--+-- 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.+--+-- > specSTM a f a = f $! a+--+-- The best-case timeline looks like:+--+-- > [------ f g ------]+-- >     [------- a -------]+-- > [--- specSTM g f a ---]+--+-- The worst-case timeline looks like:+--+-- > [------ f g ------] +-- >     [------- a -------]+-- >                       [-- rollback --]+-- >                                      [------ f a ------]     +-- > [------------------ spec g f a ------------------------]+--+-- Compare these to the timeline of @f $! a@:+--+-- > [------- a -------]+-- >                   [------ 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++-- | 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+    exn <- freshSpeculation+    let try = do+            result <- f g +            if a /= g +                then throw exn+                else return result+    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++speculationSupply :: TVar Int+speculationSupply = unsafePerformIO $ newTVarIO 0++freshSpeculation :: STM Speculation+freshSpeculation = do+    n <- readTVar speculationSupply+    writeTVar speculationSupply $! n + 1+    return (Speculation n)

Control/Concurrent/Speculation.hs view

@@ -5,8 +5,6 @@     , evaluated     , specFoldr     , specFoldl---    , specFoldl'---    , specFoldr'     , Speculative(..)     , WrappedFoldable(..)     , WithoutSpeculation(..)@@ -52,7 +50,7 @@ -- 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 = a `seq` f a+-- > spec a f a = f $! a -- -- The best-case timeline looks like: --@@ -67,7 +65,7 @@ -- >                  [---- f a ----] -- > [------- spec g f a -----------] ----- Compared to the unspeculated timeline of+-- Compare these to the timeline of @f $! a@: -- -- > [---- a -----] -- >              [---- f a ----]@@ -76,17 +74,11 @@ spec g f a      | evaluated a = f a      | otherwise = spec' g f a+{-# INLINE spec #-} --- | @'spec'' g f a@ evaluates a function @f @ using a cheap guess @g@ at the argument in parallel with forcing the argument.------ This is one way to induce parallelism in an otherwise sequential task. --- Unlike `spec` this version--- does not check to see if the argument has already been evaluated before evaluating the speculated--- version. This is useful when you know 'evaluated' will always return False.------ The following identity holds:------ > spec' a f a = a `seq` f a+-- | 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 =      speculation `par` @@ -95,25 +87,49 @@         else f a     where          speculation = f guess-{-# INLINE spec #-}+{-# INLINE spec' #-} --- | Compute a right biased fold. The estimator function provides a guess at the value of the suffix+-- | 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+ specFoldr :: (Speculative f, Eq b) => (Int -> b) -> (a -> b -> b) -> b -> f a -> b specFoldr = specFoldrN 0 {-# INLINE specFoldr #-} --- | Compute a left-biased fold. The estimator function provides a guess at the value of the prefix+-- | 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  :: (Speculative f, Eq b) => (Int -> b) -> (b -> a -> b) -> b -> f a -> b specFoldl = specFoldlN 0 {-# INLINE specFoldl #-}  class Foldable f => Speculative f where-    -- | Compute a right-biased fold. The estimator function is a guess at the value of the prefix+    -- | 'specFoldr1' is to 'foldr1'' as 'specFoldr' is to 'foldr''     specFoldr1 :: Eq a => (Int -> a) -> (a -> a -> a) -> f a -> a++    -- | 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 :: Eq b => Int -> (Int -> b) -> (a -> b -> b) -> b -> f a -> b -    -- | Compute a left biased fold. the estimator function is a guess at the value of the prefix+    -- | 'specFoldl1' is to 'foldl1'' as 'specFoldl' is to 'foldl''     specFoldl1 :: Eq a => (Int -> a) -> (a -> a -> a) -> f a -> a++    -- | 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 :: Eq b => Int -> (Int -> b) -> (b -> a -> b) -> b -> f a -> b      specFoldr1 g f = specFoldr1 g f . toList@@ -159,16 +175,7 @@ instance Speculative IntMap instance Speculative Seq --- specFoldl' :: (Speculative f, Eq a) => (Int -> b) -> (b -> a -> b) -> b -> f a -> b--- specFoldl' g f z0 xs = specFoldr g' f' id xs z0 where---     f' x k z = k $! f z x---    g' = undefined -- n z = f (g n) z---- specFoldr' :: (Speculative f, Eq a) => (Int -> b) -> (a -> b -> b) -> b -> f a -> b--- specFoldr' g f z0 xs = specFoldl g' f' id xs z0 where---    f' x k z = k $! f x z---    g' = undefined -- n z = f (g n) z-+-- | Transform an arbitrary 'Foldable' into a 'Speculative' container newtype WrappedFoldable f a = WrappedFoldable { getWrappedFoldable :: f a }      deriving (Functor, Foldable, Traversable) @@ -200,6 +207,7 @@     dataTypeOf _ = wrappedDataType     dataCast1 f = gcast1 f +-- | Provides a 'Speculative' container that doesn't actually speculate. newtype WithoutSpeculation f a = WithoutSpeculation { getWithoutSpeculation :: f a }      deriving (Functor, Foldable, Traversable)

speculation.cabal view

@@ -1,5 +1,5 @@ name:           speculation-version:        0.0.2+version:        0.1.0 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett@@ -8,20 +8,20 @@ homepage:       http://github.com/ekmett/speculation category:       Concurrency synopsis:       A framework for safe, programmable, speculative parallelism-description:    +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. +    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 = a `seq` f a+    > spec a f a = f $! a     .     The best-case timeline looks like:     .@@ -36,18 +36,24 @@     >                  [---- f a ----]     > [------- spec g f a -----------]     .-    Compared to the unspeculated timeline of+    Compare these to the timeline of @f $! a@:     .     > [---- a -----]     >              [---- f a ----]     .-    Changes since 0.0.1+    '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 since 0.0.0+    /Changes in 0.0.1:/     .     * Added 'WithoutSpeculation' and 'WrappedFoldable' @@ -61,10 +67,12 @@   ghc-options: -Wall    build-depends:-    base >= 4 && < 6, +    base >= 4 && < 6,     containers >= 0.2.0.1,     array >= 0.2 && < 0.4,-    parallel >= 2.2 && < 2.3+    parallel >= 2.2 && < 2.3,+    stm >= 2.1 && < 2.2    exposed-modules:     Control.Concurrent.Speculation+    Control.Concurrent.STM.Speculation