speculation 0.8.1.0 → 0.8.2.0

raw patch · 7 files changed

+347/−163 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Control/Concurrent/Speculation.hs +52/−36
• Control/Morphism/Speculation.hs +31/−0
• Data/Foldable/Speculation.hs +29/−7
• Data/List/Speculation.hs +49/−41
• Data/Traversable/Speculation.hs +145/−67
• ISSUES.markdown +8/−0
• speculation.cabal +33/−12

@@ -36,34 +36,43 @@  -- * 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.------ Furthermore, if the argument has already been evaluated, we avoid sparking the parallel computation at all.+-- | @'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'. ----- If a good guess at the value of @a@ is available, this is one way to induce parallelism in an otherwise sequential task.+--The best-case timeline looks like: ----- 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.+-- > foreground: [----- a -----]+-- > foreground:               [-]    (check g == a)+-- > spark:         [----- f g -----]+-- > overall:    [--- spec g f a ---] ----- > spec a f a = f $! a+-- The worst-case timeline looks like: ----- The best-case timeline looks like:+-- > foreground: [----- a -----]+-- > foreground:               [-]               (check g == a)+-- > foreground:                 [---- f a ----]+-- > spark:         [----- f g -----]+-- > overall:    [-------- spec g f a ---------] ----- > [---- f g ----]--- >    [----- a -----]--- > [-- spec g f a --]+-- Note that, if @f g@ takes longer than a to compute, in the HEAD release of GHC, @f g@ will be collected and killed during garbage collection. ----- The worst-case timeline looks like:+-- > foreground: [----- a -----]+-- > foreground:               [-]               (check g == a)+-- > foreground:                 [---- f a ----]+-- > spark:         [---- f g ----######         (#'s mark when this spark is collectable)+-- > overall:    [--------- spec g f a --------]+-- +-- Under high load: ----- > [---- f g ----]--- >    [----- a -----]--- >                  [---- f a ----]--- > [------- spec g f a -----------]+-- > foreground: [----- a -----]+-- > foreground:               [-]               (check g == a)+-- > foreground:                 [---- f a ----]+-- > overall:    [-------- spec g f a ---------] -- -- Compare these to the timeline of @f $! a@: ----- > [---- a -----]--- >              [---- f a ----]+-- > foreground: [----- a -----]+-- > foreground:               [---- f a ----]+-- > orverall:   [---------- f $! a ---------]  spec :: Eq a => a -> (a -> b) -> a -> b spec = specBy (==)@@ -106,36 +115,45 @@  -- * STM-based 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.+-- | @'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. ----- If the argument @a@ is already evaluated, we don\'t bother to perform @f g@ at all.+-- If the argument @a@ is already evaluated, we don\'t bother to perform @fg@ 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 ---]+-- > foreground: [--- g >>= f ---]+-- > spark:          [------- a -------]+-- > foreground:                       [-] (compare g' == a)+-- > overall:    [---- specSTM g f a ----] -- -- The worst-case timeline looks like: ----- > [------ f g ------]--- >     [------- a -------]--- >                       [-- rollback --]--- >                                      [------ f a ------]--- > [------------------ spec g f a ------------------------]+-- > foreground: [---- g >>= f ----]+-- > spark:         [------- a -------]+-- > foreground:                      [-] (check if g' == a)+-- > foreground:                        [--] (rollback)+-- > foreground:                           [------ f a ------]+-- > overall:    [------------ specSTM g f a ----------------] --+-- Under high load, 'specSTM' degrades less gracefully than 'spec':+--+-- > foreground: [---- g >>= f ----]+-- > spark:                        [------- a -------]+-- > foreground:                                     [-] (check if g' == a)+-- > foreground:                                       [--] (rollback)+-- > foreground:                                          [------ f a ------]+-- > overall:    [--------------------specSTM g f a ------------------------]+-- -- Compare these to the timeline of @f $! a@: ----- > [------- a -------]--- >                   [------ f a ------]+-- > foreground: [------- a -------]+-- > foreground:                   [------ f a ------]+--  specSTM :: Eq a => STM a -> (a -> STM b) -> a -> STM b specSTM = specBySTM (returning (==))@@ -177,8 +195,7 @@ 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 never give the wrong tag number if it returns a non-0 value.+-- | 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 -> Int {-# INLINE unsafeGetTagBits #-} #ifndef TAGGED@@ -193,4 +210,3 @@ unsafeIsEvaluated :: a -> Bool unsafeIsEvaluated a = unsafeGetTagBits a /= 0 {-# INLINE unsafeIsEvaluated #-}-

@@ -0,0 +1,31 @@+{-# LANGUAGE BangPatterns, MagicHash #-}+module Control.Morphism.Speculation+    ( hylo+    ) where++import GHC.Prim+import GHC.Types++import Control.Concurrent.Speculation++{-+newtype Mu f = In { out :: f (Mu f) } ++ana :: (Functor f, Eq a) => (Int -> a) -> (a -> f a) -> a -> Mu f+ana g psi = go 0# +  where+    go n = In . fmap (go (n +# 1#)) . spec (g (I# n)) psi++apo :: (Functor f, Eq a) => (Int -> a) -> (a -> f (Either (Mu f) a)) -> a -> Mu f+apo g psi = go 0#+    where+        go n = In . fmap (either id (go (n +# 1#))) . spec (g (I# n)) psi +-}+        +-- | @'hylo' g phi psi@ is a hylomorphism using a speculative anamorphism, where+-- @g n@ estimates the seed after n iterations of 'psi'.++hylo :: (Functor f, Eq a) => (Int -> a) -> (f b -> b) -> (a -> f a) -> a -> b+hylo g phi psi = go 0#+    where+        go n = phi . fmap (go (n +# 1#)) . spec (g (I# n)) psi

@@ -87,27 +87,49 @@ foldMap = foldMapBy (==) {-# INLINE foldMap #-} +-- | 'foldMap' using 'specBy' 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 #-} ++foldr :: (Foldable f, Eq b) => (Int -> b) -> (a -> b -> b) -> b -> f a -> b+foldr = foldrBy (==)+{-# INLINE foldr #-}+ -- | 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) = Acc (n + 1) (specBy' cmp (g n) (f a) b) {-# INLINE foldrBy #-} ++{-+-- Variations:+-- These variations are not used because the values ot the left shouldn't affect the intermediate state of a right fold.+--+-- this version receiveds both the number of values remaining and the number so far++foldrBy :: Foldable f => (b -> b -> Bool) -> (Int -> Int -> b) -> (a -> b -> b) -> b -> f a -> b+foldrBy cmp g f z xs = Foldable.foldr mf (Acc 0 (const z)) xs 0+  where +    mf a (Acc r b) !l = let l' = l + 1 in Acc (r + 1) (specBy' cmp (g l') (f a) (b l'))+{-# INLINE foldrBy #-}++-- this estimator receives the number of values to the left of the summation. +foldrBy :: Foldable f => (b -> b -> Bool) -> (Int -> b) -> (a -> b -> b) -> b -> f a -> b+foldrBy cmp g f z xs = Foldable.foldr mf (const z) xs 0+  where +    mf a b !i = let i' = i + 1 in specBy' cmp (g i') (f a) (b i')+{-# INLINE foldrBy #-}+-}+ foldlM :: (Foldable f, Monad m, Eq (m b)) => (Int -> m b) -> (b -> a -> m b) -> m b -> f a -> m b foldlM = foldlByM (==) {-# INLINE foldlM #-}@@ -240,12 +262,12 @@ -- | '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_#-}+{-# INLINE forM_ #-}  -- | 'for_' is 'mapM_' with its arguments flipped. forSTM_ :: Foldable t => STM Bool -> (Int -> STM c) -> t a -> (a -> STM b) -> STM () forSTM_ chk g = flip (mapSTM_ chk g)-{-# INLINE forSTM_#-}+{-# INLINE forSTM_ #-}  forByM_ :: (Foldable t, Monad m) => (m () -> m () -> Bool) -> (Int -> m c) -> t a -> (a -> m b) -> m () forByM_ cmp g = flip (mapByM_ cmp g)

@@ -29,10 +29,16 @@  import Data.Monoid import qualified Data.List as List- import Control.Concurrent.Speculation import Control.Concurrent.Speculation.Internal +-- | Given a valid estimator @g@, @'scan' g xs@ converts @xs@ into a list of the prefix sums.+-- +-- @g n@ should supply an estimate of the value of the monoidal summation 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 prefix sum, then this can+-- provide increased opportunities for parallelism.+ scan :: (Monoid m, Eq m) => (Int -> m) -> [m] -> [m] scan = scanBy (==) {-# INLINE scan #-}@@ -42,12 +48,15 @@ scanBy cmp g = scanrBy cmp g mappend mempty {-# INLINE scanBy #-} --- | Given a valid estimator @g@, @'scanMap' g f xs@ yields the same answer as @'scanMap' f xs@.+-- | Given a valid estimator @g@, @'scanMap' g f xs@ converts @xs@ into a list of the prefix sums. -- --- @g n@ should supply an estimate of the value of the monoidal summation over the last @n@ elements of the container.+-- @g n@ should supply an estimate of the value of the monoidal summation 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 scan, then this can -- provide increased opportunities for parallelism.+--+-- > scan = scanMap id+-- > scanMap = scanMapBy (==)  scanMap :: (Monoid m, Eq m) => (Int -> m) -> (a -> m) -> [a] -> [m] scanMap = scanMapBy (==)@@ -74,19 +83,51 @@     mf a (Acc n b) = let n' = n + 1 in Acc n' (specBy' cmp (g n') (f a) b) {-# INLINE scanrBy #-} ++scanl  :: Eq b => (Int -> b) -> (b -> a -> b) -> b -> [a] -> [b]+scanl = scanlBy (==) +{-# INLINE scanl #-}++scanlBy  :: (b -> b -> Bool) -> (Int -> b) -> (b -> a -> b) -> b -> [a] -> [b]+scanlBy cmp g f z = map extractAcc . List.scanl 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 scanlBy #-}++scanr1 :: Eq a => (Int -> a) -> (a -> a -> a) -> [a] -> [a]+scanr1 = scanr1By (==) +{-# INLINE scanr1 #-}++scanr1By :: (a -> a -> Bool) -> (Int -> a) -> (a -> a -> a) -> [a] -> [a]+scanr1By cmp g f xs = map (fromMaybeAcc undefined) $ List.scanr 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 scanr1By #-}++scanl1 :: Eq a => (Int -> a) -> (a -> a -> a) -> [a] -> [a]+scanl1 = scanl1By (==)+{-# INLINE scanl1 #-}++scanl1By :: (a -> a -> Bool) -> (Int -> a) -> (a -> a -> a) -> [a] -> [a]+scanl1By cmp g f xs = map (fromMaybeAcc undefined) $ List.scanl 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 scanl1By #-}+ {--scanlM :: (Monad m, Eq (m b)) => (Int -> m b) -> (b -> a -> m b) -> m b -> [a] -> m [b]+scanlM :: (Monad m, Eq b) => (Int -> b) -> (b -> a -> m b) -> b -> [a] -> m [b] scanlM = scanlByM (==) {-# INLINE scanlM #-} -scanlByM ::  Monad m => (m b -> m b -> Bool) -> (Int -> m b) -> (b -> a -> m b) -> m b -> [a] -> m [b]+scanlByM ::  Monad m => (b -> b -> Bool) -> (Int -> b) -> (b -> a -> m b) -> b -> [a] -> m [b] scanlByM  cmp g f mz = liftM (map extractAcc) . List.scanl go (liftM (map (Acc 0)) mz)    where     go mia b = do       Acc n a <- mia-      let !n' = n + 1-      a' <- specBy' cmp (g n') (>>= (`f` b)) (return a)-      return (Acc n' a')+      a' <- specBy' cmp (g n) (`f` b) a+      return (Acc (n + 1) a') {-# INLINE scanlByM #-}  scanrM :: (Monad m, Eq (m b)) => (Int -> m b) -> (a -> b -> m b) -> m b -> [a] -> m [b]@@ -138,36 +179,3 @@ -- If @g n@ is accurate a reasonable percentage of the time and faster to compute than the scan, then this can -- provide increased opportunities for parallelism. -}--scanl  :: Eq b => (Int -> b) -> (b -> a -> b) -> b -> [a] -> [b]-scanl = scanlBy (==) -{-# INLINE scanl #-}--scanlBy  :: (b -> b -> Bool) -> (Int -> b) -> (b -> a -> b) -> b -> [a] -> [b]-scanlBy cmp g f z = map extractAcc . List.scanl 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 scanlBy #-}--scanr1 :: Eq a => (Int -> a) -> (a -> a -> a) -> [a] -> [a]-scanr1 = scanr1By (==) -{-# INLINE scanr1 #-}--scanr1By :: (a -> a -> Bool) -> (Int -> a) -> (a -> a -> a) -> [a] -> [a]-scanr1By cmp g f xs = map (fromMaybeAcc undefined) $ List.scanr 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 scanr1By #-}--scanl1 :: Eq a => (Int -> a) -> (a -> a -> a) -> [a] -> [a]-scanl1 = scanl1By (==)-{-# INLINE scanl1 #-}--scanl1By :: (a -> a -> Bool) -> (Int -> a) -> (a -> a -> a) -> [a] -> [a]-scanl1By cmp g f xs = map (fromMaybeAcc undefined) $ List.scanl 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 scanl1By #-}-

@@ -1,21 +1,150 @@-{-# LANGUAGE MagicHash, Rank2Types, UnboxedTuples #-}+{-# LANGUAGE MagicHash, Rank2Types, UnboxedTuples, BangPatterns #-} module Data.Traversable.Speculation-    ( mapAccumL, mapAccumLBy+    (+    -- * Traversable+    -- ** Applicative Traversals+      traverse, traverseBy+    , for, forBy+    , sequenceA, sequenceByA+    -- ** Monadic traversals+    , mapM, mapByM+    , sequence, sequenceBy+    , forM, forByM+    -- ** STM-based traversals with transactional rollback+    , mapSTM, mapBySTM+    , forSTM, forBySTM+--    , sequenceSTM, sequenceBySTM+    -- * Accumulating parameters+    , mapAccumL, mapAccumLBy     , mapAccumR, mapAccumRBy     ) where +import Prelude hiding (mapM, sequence) import GHC.Prim import GHC.Types 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 +mapAccumL :: (Traversable t, Eq a) => (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)+mapAccumL = mapAccumLBy (==)+{-# INLINE mapAccumL #-}++mapAccumLBy :: Traversable t => (a -> a -> Bool) -> (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)+mapAccumLBy cmp g f z xs = runIntAccumL (Traversable.traverse go xs) 0 z+  where+    go b = IntAccumL (\n a -> +            let ~(a', c) = specBy' cmp (g (I# n)) (`f` b) a+            in (# n +# 1#, a', c #))+{-# INLINE mapAccumLBy #-}++mapAccumR :: (Traversable t, Eq a) => (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)+mapAccumR = mapAccumRBy (==)+{-# INLINE mapAccumR #-}++mapAccumRBy :: Traversable t => (a -> a -> Bool) -> (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)+mapAccumRBy cmp g f z xs = runIntAccumR (Traversable.traverse go xs) 0 z+  where+    go b = IntAccumR (\n a -> +            let ~(a', c) = specBy' cmp (g (I# n)) (`f` b) a+            in (# n +# 1#, a', c #))+{-# INLINE mapAccumRBy #-}++traverse  :: (Traversable t, Applicative f, Eq a) => (Int -> a) -> (a -> f b) -> t a -> f (t b)+traverse = traverseBy (==)+{-# INLINE traverse #-}++traverseBy :: (Traversable t, Applicative f) => (a -> a -> Bool) -> (Int -> a) -> (a -> f b) -> t a -> f (t b)+traverseBy cmp g f xs = runAccT (Traversable.traverse go xs) 0+  where+    -- go :: a -> AccT f a+    go a = AccT $ \i -> acc (i +# 1#) $ specBy cmp (g (I# i)) f a+{-# INLINE traverseBy #-}++mapM :: (Traversable t, Monad m, Eq a) => (Int -> a) -> (a -> m b) -> t a -> m (t b)+mapM = mapByM (==)+{-# INLINE mapM #-}++mapByM :: (Traversable t, Monad m) => (a -> a -> Bool) -> (Int -> a) -> (a -> m b) -> t a -> m (t b)+mapByM cmp g f = unwrapMonad . traverseBy cmp g (WrapMonad . f)+{-# INLINE mapByM #-}++mapSTM :: (Traversable t, Eq a) => (Int -> STM a) -> (a -> STM b) -> t a -> STM (t b)+mapSTM = mapBySTM (returning (==))+{-# INLINE mapSTM #-}++mapBySTM :: Traversable t => (a -> a -> STM Bool) -> (Int -> STM a) -> (a -> STM b) -> t a -> STM (t b)+mapBySTM cmp g f xs = unwrapMonad (runAccT (Traversable.traverse go xs) 0)+  where+    go a = AccT $ \i -> acc (i +# 1#) $ WrapMonad $ specBySTM cmp (g (I# i)) f a+{-# INLINE mapBySTM #-}++      +sequenceA :: (Traversable t, Applicative f, Eq (f a)) => (Int -> f a) -> t (f a) -> f (t a)+sequenceA g = traverse g id+{-# INLINE sequenceA #-}++sequenceByA :: (Traversable t, Applicative f) => (f a -> f a -> Bool) -> (Int -> f a) -> t (f a) -> f (t a)+sequenceByA cmp g = traverseBy cmp g id+{-# INLINE sequenceByA #-}++sequence   :: (Traversable t, Monad m, Eq (m a)) => (Int -> m a) -> t (m a) -> m (t a)+sequence g = mapM g id+{-# INLINE sequence #-}++sequenceBy :: (Traversable t, Monad m) => (m a -> m a -> Bool) -> (Int -> m a) -> t (m a) -> m (t a)+sequenceBy cmp g = mapByM cmp g id+{-# INLINE sequenceBy #-}++{-+sequenceSTM   :: (Traversable t, Eq a) => (Int -> STM a) -> t (STM a) -> STM (t a)+sequenceSTM g = mapSTM g id+{-# INLINE sequenceSTM #-}++sequenceBySTM :: Traversable t => (a -> a -> STM Bool) -> (Int -> STM a) -> t (STM a) -> STM (t a)+sequenceBySTM cmp g = mapBySTM cmp g id+{-# INLINE sequenceBySTM #-}+-}++for :: (Traversable t, Applicative f, Eq a) => (Int -> a) -> t a -> (a -> f b) -> f (t b)+for g = flip (traverse g)+{-# INLINE for #-}++forBy :: (Traversable t, Applicative f) => (a -> a -> Bool) -> (Int -> a) -> t a -> (a -> f b) -> f (t b)+forBy cmp g = flip (traverseBy cmp g)+{-# INLINE forBy #-}++forM :: (Traversable t, Monad m, Eq a) => (Int -> a) -> t a -> (a -> m b) -> m (t b)+forM g = flip (mapM g)+{-# INLINE forM #-}++forByM :: (Traversable t, Monad m) => (a -> a -> Bool) -> (Int -> a) -> t a -> (a -> m b) -> m (t b)+forByM cmp g = flip (mapByM cmp g)+{-# INLINE forByM #-}++forSTM :: (Traversable t, Eq a) => (Int -> STM a) -> t a -> (a -> STM b) -> STM (t b)+forSTM g = flip (mapSTM g)+{-# INLINE forSTM #-}++forBySTM :: Traversable t => (a -> a -> STM Bool) -> (Int -> STM a) -> t a -> (a -> STM b) -> STM (t b)+forBySTM cmp g = flip (mapBySTM cmp g)+{-# INLINE forBySTM #-}++-- Utilities++acc :: Int# -> a -> Acc a+acc i a = Acc (I# i) a+{-# INLINE acc #-}+ data IntAccumL s a = IntAccumL (Int# -> s -> (# Int#, s, a #))  runIntAccumL :: IntAccumL s a -> Int -> s -> (s, a) runIntAccumL (IntAccumL m) (I# i) s = case m i s of     (# _, s1, a #) -> (s1, a)+{-# INLINE runIntAccumL #-}  instance Functor (IntAccumL s) where     fmap f (IntAccumL m) = IntAccumL  (\i s -> case m i s of@@ -28,22 +157,13 @@             (# i1, s1, f #) ->                 case ma i1 s1 of                      (# i2, s2, a #) -> (# i2, s2, f a #))-    -mapAccumL :: (Traversable t, Eq a, Eq c) => (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)-mapAccumL = mapAccumLBy (==) -mapAccumLBy :: Traversable t => (a -> a -> Bool) -> (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)-mapAccumLBy cmp g f z xs = runIntAccumL (Traversable.traverse go xs) 0 z-  where-    go b = IntAccumL (\n a -> -            let ~(a', c) = specBy' cmp (g (I# n)) (`f` b) a-            in (# n +# 1#, a', c #))- data IntAccumR s a = IntAccumR (Int# -> s -> (# Int#, s, a #))  runIntAccumR :: IntAccumR s a -> Int -> s -> (s, a) runIntAccumR (IntAccumR m) (I# i) s = case m i s of     (# _, s1, a #) -> (s1, a)+{-# INLINE runIntAccumR #-}  instance Functor (IntAccumR s) where     fmap f (IntAccumR m) = IntAccumR  (\i s -> case m i s of@@ -57,61 +177,19 @@                 case mf i1 s1 of                      (# i2, s2, f #) -> (# i2, s2, f a #)) -mapAccumR :: (Traversable t, Eq a, Eq c) => (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)-mapAccumR = mapAccumRBy (==)--mapAccumRBy :: Traversable t => (a -> a -> Bool) -> (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)-mapAccumRBy cmp g f z xs = runIntAccumR (Traversable.traverse go xs) 0 z-  where-    go b = IntAccumR (\n a -> -            let ~(a', c) = specBy' cmp (g (I# n)) (`f` b) a-            in (# n +# 1#, a', c #))--{--traverse :: (Traversable t, Applicative f, Eq (f b)) => (Int -> f b) -> (a -> f b) -> t a -> f (t b)-traverse = traverseBy (==)--traverseBy :: (Traversable t, Applicative f) => (Int -> f b) -> (a -> f b) -> t a -> f (t b)--}---- note applicative composition doesn't give StateT--- There is a difference between StateT s m and State s (m a)--- -{--newtype AccT m a = AccT (Int# -> m (Acc a))--instance Functor f => Applicative (AccT s f) where-    fmap f (AccT m) = AccT (fmap (fmap f) . m)--instance Applicative m => Applicative (AccT s m) where-    pure a = AccT (\i -> return (Acc i a))-    AccT mf <*> AccT ma = AccT (\i -> -        let maccf = mf i -    +-- applicative composition with a strict integer state applicative+newtype AccT m a = AccT (Int# -> Acc (m a)) -        m (Acc (a -> b)) -> m (Acc a)--}+runAccT :: Applicative m => AccT m a -> Int -> m a+runAccT (AccT m) (I# i) = extractAcc (m i)+{-# INLINE runAccT #-} -{--traverseBy :: (Traversable t, Applicative f) => (f b -> f b -> Bool) -> (Int -> f b) -> (a -> f b) -> t a -> f (t b)-sequence   :: (Traversable t, Monad m, Eq (m a)) => (Int -> m a) -> t (m a) -> m (t a)-sequenceBy :: (Traversable t, Monad m) => (m a -> m a -> Bool) -> (Int -> m a) -> t (m a) -> m (t a)-sequenceA   :: (Traversable t, Applicative f, Eq (f a)) => (Int -> f a) -> t (f a) -> f (t a)-sequenceByA :: (Traversable t, Applicative f) => (f a -> f a -> Bool) -> (Int -> f a) -> t (f a) -> f (t a)-sequenceSTM   :: (Traversable t, Eq a) => (Int -> STM a) -> t (STM a) -> STM (t a)-sequenceBySTM :: Traversable t => (a -> a -> STM Bool) -> (Int -> STM a) -> t (STM a) -> STM (t a)-mapM :: (Traversable t, Monad m, Eq (m b)) => (Int -> m b) -> (a -> m b) -> t a -> m (t b)-mapByM :: (Traversable t, Monad m) => (m b -> m b -> Bool) -> (Int -> m b) -> (a -> m b) -> t a -> m (t b)-mapSTM :: (Traversable t, Eq b) => (Int -> STM b) -> (a -> STM b) -> t a -> STM (t b)-mapBySTM :: Traversable t => (b -> b -> STM Bool) -> (Int -> STM b) -> (a -> STM b) -> t a -> STM (t b)-mapAccumR :: (Traversable t, Eq a, Eq c) => (Int -> (a, c)) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)-mapAccumRBy :: Traversable t => ((a, c) -> (a, c) -> Bool) -> (Int -> (a, c)) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)-mapAccumLBy :: Traversable t => ((a, c) -> (a, c) -> Bool) -> (Int -> (a, c)) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)-for :: (Traversable t, Applicative f, Eq (f b)) => (Int -> f b) -> t a -> (a -> f b) -> f (t b)-forBy :: (Traversable t, Applicative f) => (f b -> f b -> Bool) -> (Int -> f b) -> t a -> (a -> f b) -> f (t b)-forM :: (Traversable t, Monad m, Eq (m b)) => (Int -> m b) -> t a -> (a -> m b) -> m (t b)-forByM :: (Traversable t, Monad m) => (m b -> m b -> Bool) -> (Int -> m b) -> t a -> (a -> m b) -> m (t b)-forSTM :: (Traversable t, Eq b) => (Int -> STM b) -> t a -> (a -> STM b) -> STM (t b)-forBySTM :: Traversable t => (b -> b -> STM Bool) -> (Int -> STM b) -> t a -> (a -> STM b) -> STM (t b)--}+instance Functor f => Functor (AccT f) where+    fmap f (AccT m) = AccT (\i# -> case m i# of Acc i a -> Acc i (fmap f a)) +instance Applicative f => Applicative (AccT f) where+    pure a = AccT (\i -> Acc (I# i) (pure a))+    AccT mf <*> AccT ma = AccT (\i0# -> +        let !(Acc !(I# i1#) f) = mf i0#+            !(Acc i2 a) = ma i1#+        in  Acc i2 (f <*> a))

@@ -30,3 +30,11 @@ --------------------  For tag checking purposes, we should be able to unsafeCoerce# a :: Word#, but it isn't subkinded. Ticket?++inconsistent use of the estimator function+------------------------------------------++It is tricky to know which direction the estimator counts. Perhaps we should left bias all of them?++But that would be less pleasant, because now the number of values you haven't looked at would determine the+guess at the value of the right fold.

@@ -1,5 +1,5 @@ name:           speculation-version:        0.8.1.0+version:        0.8.2.0 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett@@ -24,27 +24,45 @@  .  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. + @'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'.  .  The best-case timeline looks like:  .- > [---- f g ----]- >    [----- a -----]- > [-- spec g f a --]+ > foreground: [----- a -----]+ > foreground:               [-]    (check g == a)+ > spark:         [----- f g -----]+ > overall:    [--- spec g f a ---]  .  The worst-case timeline looks like:  .- > [---- f g ----]- >    [----- a -----]- >                  [---- f a ----]- > [------- spec g f a -----------]+ > foreground: [----- a -----]+ > foreground:               [-]               (check g == a)+ > foreground:                 [---- f a ----]+ > spark:         [----- f g -----]+ > overall:    [-------- spec g f a ---------]  .+ Note that, if @f g@ takes longer than a to compute, in the HEAD release of GHC, @f g@ will be collected and killed during garbage collection.+ .+ > foreground: [----- a -----]+ > foreground:               [-]               (check g == a)+ > foreground:                 [---- f a ----]+ > spark:         [---- f g ----######         (#'s mark when this spark is collectable)+ > overall:    [--------- spec g f a --------]+ . + Under high load:+ .+ > foreground: [----- a -----]+ > foreground:               [-]               (check g == a)+ > foreground:                 [---- f a ----]+ > overall:    [-------- spec g f a ---------]+ .  Compare these to the timeline of @f $! a@:  .- > [---- a -----]- >              [---- f a ----]+ > foreground: [----- a -----]+ > foreground:               [---- f a ----]+ > orverall:   [---------- f $! a ---------]  .- 'specSTM' provides a similar time table for STM actions, but also rolls back side-effects.+ 'specSTM' provides a similar time table for STM actions, but also rolls back side-effects. The one unfortunate operational distinction is that it is forced to compute 'a' in the background thread and therefore degrades slightly less gracefully under load.  extra-source-files:      README.markdown@@ -93,6 +111,7 @@      exposed-modules:       Control.Concurrent.Speculation+      Control.Morphism.Speculation       Data.Foldable.Speculation       Data.Traversable.Speculation       Data.List.Speculation@@ -122,6 +141,7 @@     other-modules:       Control.Concurrent.Speculation.Internal       Control.Concurrent.Speculation+      Control.Morphism.Speculation       Data.Foldable.Speculation       Data.Traversable.Speculation       Data.List.Speculation@@ -144,6 +164,7 @@     other-modules:       Control.Concurrent.Speculation.Internal       Control.Concurrent.Speculation+      Control.Morphism.Speculation       Data.Foldable.Speculation       Data.Traversable.Speculation       Data.List.Speculation