speculation 0.8.0.2 → 0.8.1.0

raw patch · 8 files changed

+432/−69 lines, 8 filesdep +ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +5/−0
• Control/Concurrent/Speculation.hs +21/−23
• Control/Concurrent/Speculation/Internal.hs +53/−0
• Data/Foldable/Speculation.hs +13/−44
• Data/List/Speculation.hs +173/−0
• Data/Traversable/Speculation.hs +117/−0
• ISSUES.markdown +32/−0
• speculation.cabal +18/−2

@@ -1,3 +1,8 @@+/0.8.1/:+ * Added Data.List.Foldable+ * Added Data.Traversable.Foldable+ * Fixed an off-by-one error in the arguments to the speculative fold estimators+ /0.8.0.2/:   * changed tests and benchmarks to not build by default to work around corruption in the hackage db

@@ -1,6 +1,6 @@ {-# LANGUAGE CPP, BangPatterns, DeriveDataTypeable #-} module Control.Concurrent.Speculation-    ( +    (     -- * Speculative application       spec     , spec'@@ -21,6 +21,7 @@     ) where  import Control.Concurrent.STM+import Control.Concurrent.Speculation.Internal (returning) import Control.Parallel (par) import Control.Monad (liftM2, unless) import Data.Function (on)@@ -30,8 +31,8 @@ import Foreign (sizeOf) import Unsafe.Coerce (unsafeCoerce) -- dynamic pointer tagging is present on this platform-#define TAGGED -#endif +#define TAGGED+#endif  -- * Basic speculation @@ -39,7 +40,7 @@ -- -- 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.@@ -51,7 +52,7 @@ -- > [---- f g ----] -- >    [----- a -----] -- > [-- spec g f a --]--- +-- -- The worst-case timeline looks like: -- -- > [---- f g ----]@@ -65,7 +66,7 @@ -- >              [---- f a ----]  spec :: Eq a => a -> (a -> b) -> a -> b-spec = specBy (==) +spec = specBy (==) {-# INLINE spec #-}  -- | Unlike 'spec', this version does not check to see if the argument has already been evaluated. This can save@@ -84,12 +85,12 @@  -- | 'spec'' with a user defined comparison function specBy' :: (a -> a -> Bool) -> a -> (a -> b) -> a -> b-specBy' cmp guess f a = -    speculation `par` +specBy' cmp guess f a =+    speculation `par`         if cmp guess a         then speculation         else f a-    where +    where         speculation = f guess {-# INLINE specBy' #-} @@ -105,12 +106,12 @@  -- * 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 +-- | @'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. +-- 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.@@ -125,10 +126,10 @@ -- -- The worst-case timeline looks like: ----- > [------ f g ------] +-- > [------ f g ------] -- >     [------- a -------] -- >                       [-- rollback --]--- >                                      [------ f a ------]     +-- >                                      [------ f a ------] -- > [------------------ spec g f a ------------------------] -- -- Compare these to the timeline of @f $! a@:@@ -148,8 +149,8 @@  -- | 'specSTM' using a user defined comparison function specBySTM :: (a -> a -> STM Bool) -> STM a -> (a -> STM b) -> a -> STM b-specBySTM cmp guess f a -    | unsafeIsEvaluated a = f a +specBySTM cmp guess f a+    | unsafeIsEvaluated a = f a     | otherwise   = specBySTM' cmp guess f a {-# INLINE specBySTM #-} @@ -159,11 +160,11 @@     guess <- mguess     result <- f guess     -- rendezvous with a-    matching <- cmp guess a -    unless matching retry +    matching <- cmp guess a+    unless matching retry     return result-  `orElse` -    f a +  `orElse`+    f a {-# INLINE specBySTM' #-}  -- | @'specBySTM' . 'on' (==)@@@ -193,6 +194,3 @@ unsafeIsEvaluated a = unsafeGetTagBits a /= 0 {-# INLINE unsafeIsEvaluated #-} -returning :: Monad m => (a -> b -> c) -> a -> b -> m c-returning f a b = return (f a b)-{-# INLINE returning #-}

@@ -0,0 +1,53 @@+module Control.Concurrent.Speculation.Internal +    ( Acc(..)+    , extractAcc+    , MaybeAcc(..)+    , fromMaybeAcc+    , errorEmptyStructure+    , returning+    ) where++import Data.Foldable+import Data.Traversable+import Control.Applicative++-- comonad!+data Acc a = Acc {-# UNPACK #-} !Int a++instance Functor Acc where+    fmap f (Acc n a) = Acc n (f a)++instance Foldable Acc where+    foldMap = foldMapDefault++instance Traversable Acc where+    traverse f (Acc n a) = Acc n <$> f a++extractAcc :: Acc a -> a+extractAcc (Acc _ a) = a+{-# INLINE extractAcc #-}++data MaybeAcc a = JustAcc {-# UNPACK #-} !Int a | NothingAcc++instance Functor MaybeAcc where+    fmap f (JustAcc n a) = JustAcc n (f a)+    fmap _ NothingAcc = NothingAcc++instance Foldable MaybeAcc where+    foldMap = foldMapDefault++instance Traversable MaybeAcc where+    traverse f (JustAcc n a) = JustAcc n <$> f a+    traverse _ NothingAcc    = pure 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"++returning :: Monad m => (a -> b -> c) -> a -> b -> m c+returning f a b = return (f a b)+{-# INLINE returning #-}

@@ -56,6 +56,7 @@ import qualified Data.Foldable as Foldable import Control.Concurrent.STM import Control.Concurrent.Speculation+import Control.Concurrent.Speculation.Internal import Control.Applicative import Control.Monad hiding (mapM_, msum, forM_, sequence_) @@ -104,7 +105,7 @@ 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)+    mf a (Acc n b) = Acc (n + 1) (specBy' cmp (g n) (f a) b) {-# INLINE foldrBy #-}  foldlM :: (Foldable f, Monad m, Eq (m b)) => (Int -> m b) -> (b -> a -> m b) -> m b -> f a -> m b@@ -116,9 +117,8 @@   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)) (return a)+      return (Acc (n + 1) a') {-# INLINE foldlByM #-}  foldrM :: (Foldable f, Monad m, Eq (m b)) => (Int -> m b) -> (a -> b -> m b) -> m b -> f a -> m b@@ -130,9 +130,8 @@   where     go a mib = do       Acc n b <- mib-      let !n' = n + 1-      b' <- specBy' cmp (g n') (>>= f a) (return b)-      return (Acc n' b')+      b' <- specBy' cmp (g n) (>>= f a) (return b)+      return (Acc (n + 1) b') {-# INLINE foldrByM #-}  foldlSTM :: (Foldable f, Eq a) => (Int -> STM a) -> (a -> b -> STM a) -> STM a -> f b -> STM a@@ -144,9 +143,8 @@   where     go mia b = do       Acc n a <- mia-      let !n' = n + 1-      a' <- specBySTM' cmp (g n') (`f` b) a-      return (Acc n' a')+      a' <- specBySTM' cmp (g n) (`f` b) a+      return (Acc (n + 1) a') {-# INLINE foldlBySTM #-}  foldrSTM :: (Foldable f, Eq b) => (Int -> STM b) -> (a -> b -> STM b) -> STM b -> f a -> STM b@@ -158,21 +156,10 @@   where     go a mib = do       Acc n b <- mib-      let !n' = n + 1-      b' <- specBySTM' cmp (g n') (f a) b-      return (Acc n' b')+      b' <- specBySTM' cmp (g n) (f a) b+      return (Acc (n + 1) b') {-# INLINE foldrBySTM #-} -{--foldrSTMBy cmp g f z xs = liftM extractAcc . Foldable.foldl mf return xs (Acc 0 z)-  where-    mf h t = do-        Acc n t' <- t-        let !n' = n + 1 -        specSTMBy' cmp (g n') (flip f h >=> t) -        ...--}- -- | 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.@@ -187,7 +174,7 @@ 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)+    mf (Acc n a) b = Acc (n + 1) (specBy' cmp (g n) (`f` b) a) {-# INLINE foldlBy #-}  foldr1 :: (Foldable f, Eq a) => (Int -> a) -> (a -> a -> a) -> f a -> a@@ -198,7 +185,7 @@ 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 (JustAcc n b) = JustAcc (n + 1) (specBy' cmp (g n) (f a) b)     mf a NothingAcc = JustAcc 1 a {-# INLINE foldr1By #-} @@ -210,7 +197,7 @@ 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 (JustAcc n a) b = JustAcc (n + 1) (specBy' cmp (g n) (`f` b) a)     mf NothingAcc b    = JustAcc 1 b {-# INLINE foldl1By #-} @@ -405,21 +392,3 @@ 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"--returning :: Monad m => (a -> b -> c) -> a -> b -> m c-returning f a b = return (f a b)

@@ -0,0 +1,173 @@+{-# LANGUAGE BangPatterns #-}+module Data.List.Speculation +    ( +    -- * Speculative scans+      scan, scanBy+    , scanMap, scanMapBy+    , scanr, scanrBy+    , scanl, scanlBy+    , scanr1, scanr1By+    , scanl1, scanl1By+    {-+    -- ** Speculative monadic scans+    , scanrM, scanrByM+    , scanlM, scanlByM+    -- * Speculative transactional monadic scans+    , scanrSTM, scanrBySTM+    , scanlSTM, scanlBySTM+    -}+    ) where+++import Prelude hiding +    (foldl, foldl1, foldr, foldr1+    , any, all, and, or, mapM_, sequence_+    , elem, notElem, sum, product+    , minimum, maximum, concat, concatMap+    , scanr, scanl, scanr1, scanl1+    )++import Data.Monoid+import qualified Data.List as List++import Control.Concurrent.Speculation+import Control.Concurrent.Speculation.Internal++scan :: (Monoid m, Eq m) => (Int -> m) -> [m] -> [m]+scan = scanBy (==)+{-# INLINE scan #-}++-- | 'scan' using 'specBy'+scanBy :: Monoid m => (m -> m -> Bool) -> (Int -> m) -> [m] -> [m]+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@.+-- +-- @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 scan, then this can+-- provide increased opportunities for parallelism.++scanMap :: (Monoid m, Eq m) => (Int -> m) -> (a -> m) -> [a] -> [m]+scanMap = scanMapBy (==)+{-# INLINE scanMap #-}++scanMapBy :: Monoid m => (m -> m -> Bool) -> (Int -> m) -> (a -> m) -> [a] -> [m]+scanMapBy cmp g f = scanrBy cmp g (mappend . f) mempty+{-# INLINE scanMapBy #-}++-- | Given a valid estimator @g@, @'scanr' g f z xs@ yields the same answer as @'scanr'' f z xs@.+--+-- @g n@ should supply an estimate of the value returned from scanning 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 scan, then this can+-- provide increased opportunities for parallelism.++scanr :: Eq b => (Int -> b) -> (a -> b -> b) -> b -> [a] -> [b]+scanr = scanrBy (==)+{-# INLINE scanr #-}++scanrBy :: (b -> b -> Bool) -> (Int -> b) -> (a -> b -> b) -> b -> [a] -> [b]+scanrBy cmp g f z = map extractAcc . List.scanr 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 scanrBy #-}++{-+scanlM :: (Monad m, Eq (m b)) => (Int -> m b) -> (b -> a -> m b) -> m 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  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')+{-# INLINE scanlByM #-}++scanrM :: (Monad m, Eq (m b)) => (Int -> m b) -> (a -> b -> m b) -> m b -> [a] -> m [b]+scanrM = scanrByM (==)+{-# INLINE scanrM #-}++scanrByM :: Monad m => (m b -> m b -> Bool) -> (Int -> m b) -> (a -> b -> m b) -> m b -> [a] -> m [b]+scanrByM cmp g f mz = liftM (map extractAcc) . List.scanr go (liftM (map (Acc 0)) mz) +  where+    go a mib = do+      Acc n b <- mib+      let !n' = n + 1+      b' <- specBy' cmp (g n') (>>= f a) (return b)+      return (Acc n' b')+{-# INLINE scanrByM #-}++scanlSTM :: Eq a => (Int -> STM a) -> (a -> b -> STM a) -> STM a -> [b] -> STM [a]+scanlSTM = scanlBySTM (returning (==))+{-# INLINE scanlSTM #-}++scanlBySTM :: (a -> a -> STM Bool) -> (Int -> STM a) -> (a -> b -> STM a) -> STM a -> [b] -> STM [a]+scanlBySTM cmp g f mz = liftM (map extractAcc) . List.scanl go (liftM (Acc 0) mz)+  where+    go mia b = do+      Acc n a <- mia+      let !n' = n + 1+      a' <- specBySTM' cmp (g n') (`f` b) a+      return (Acc n' a')+{-# INLINE scanlBySTM #-}++scanrSTM :: Eq b => (Int -> STM b) -> (a -> b -> STM b) -> STM b -> [a] -> STM [b]+scanrSTM = scanrBySTM (returning (==))+{-# INLINE scanrSTM #-}++scanrBySTM :: (b -> b -> STM Bool) -> (Int -> STM b) -> (a -> b -> STM b) -> STM b -> [a] -> STM [b]+scanrBySTM cmp g f mz = liftM (map extractAcc) . List.scanr go (liftM (Acc 0) mz)+  where+    go a mib = do+      Acc n b <- mib+      let !n' = n + 1+      b' <- specBySTM' cmp (g n') (f a) b+      return (Acc n' b')+{-# INLINE scanrBySTM #-}++-- | Given a valid estimator @g@, @'scanl' g f z xs@ yields the same answer as @'scanl'' f z xs@.+--+-- @g n@ should supply an estimate of the value returned from scaning 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.+-}++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 #-}+

@@ -0,0 +1,117 @@+{-# LANGUAGE MagicHash, Rank2Types, UnboxedTuples #-}+module Data.Traversable.Speculation+    ( mapAccumL, mapAccumLBy+    , mapAccumR, mapAccumRBy+    ) where++import GHC.Prim+import GHC.Types+import Data.Traversable (Traversable)+import qualified Data.Traversable as Traversable+import Control.Applicative+import Control.Concurrent.Speculation++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)++instance Functor (IntAccumL s) where+    fmap f (IntAccumL m) = IntAccumL  (\i s -> case m i s of+        (# i1, s1, a #) -> (# i1, s1, f a #))++instance Applicative (IntAccumL s) where+    pure a = IntAccumL (\i s -> (# i, s, a #))+    IntAccumL mf <*> IntAccumL ma = IntAccumL (\i s ->+        case mf i s of +            (# 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)++instance Functor (IntAccumR s) where+    fmap f (IntAccumR m) = IntAccumR  (\i s -> case m i s of+        (# i1, s1, a #) -> (# i1, s1, f a #))++instance Applicative (IntAccumR s) where+    pure a = IntAccumR (\i s -> (# i, s, a #))+    IntAccumR mf <*> IntAccumR ma = IntAccumR (\i s ->+        case ma i s of +            (# i1, s1, a #) ->+                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 +    ++        m (Acc (a -> b)) -> m (Acc a)+-}++{-+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)+-}+

@@ -0,0 +1,32 @@+sparking the right computation+------------------------------++Currently the computation of 'spec g f a' does exactly what I want+the computation of 'f g' happens in the spark queue through 'par'+while the computation of 'a' happens in the foreground, as well as+any (lazy) evaluation of 'f a'.++(TODO: flop the other of g and a in the cmp to force them in reverse order, to make g even lazier?)++However specSTM lacks this property. the 'par' has to launch the +computation of 'a' because 'f g' is in STM. Can we play games with par  +to retain ownership of the STM transaction and move it into the par block, +and rendezvous with it upon the completion of calculating 'a' ? Per Marlow,+apparently not. This leads to a fallback plan:++sparking only when it makes sense+---------------------------------++Another option (from talking with Simon Marlow) is to add a new primop:++    numSparks# :: State# s -> (# Int#, State# s #)++which computes dequeElements(cap->spark) and to not speculate when that is too high.++Sadly, the cap and spark machinery is marked private by GHC, so this needs to become+a ticket.++unboxed tag-checking+--------------------++For tag checking purposes, we should be able to unsafeCoerce# a :: Word#, but it isn't subkinded. Ticket?

@@ -1,5 +1,5 @@ name:           speculation-version:        0.8.0.2+version:        0.8.1.0 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett@@ -49,6 +49,7 @@ extra-source-files:      README.markdown     CHANGELOG.markdown+    ISSUES.markdown  source-repository head   type:     git@@ -58,6 +59,7 @@ flag lib   description: Build the library. Useful for speeding up the modify-build-test cycle.   default:     True+  manual:      True  flag tests   description: Build the tests@@ -75,7 +77,6 @@   description: Use HPC for tests   default:     True - library   if !flag(lib)     buildable: False@@ -86,12 +87,17 @@      build-depends:       base >= 4 && < 6,+      ghc-prim >= 0.2 && < 0.3,       parallel >= 2.2 && < 2.3,       stm >= 2.1 && < 2.2      exposed-modules:       Control.Concurrent.Speculation       Data.Foldable.Speculation+      Data.Traversable.Speculation+      Data.List.Speculation+    other-modules:+      Control.Concurrent.Speculation.Internal  executable test-speculation   main-is: Test.hs@@ -104,6 +110,8 @@     ghc-options: -Wall     build-depends:       base >= 4 && < 6, +      ghc-prim >= 0.2 && < 0.3,+      parallel >= 2.2 && < 2.3,       stm >= 2.1 && < 2.2,       containers >= 0.3.0 && < 0.4,       test-framework >= 0.2.4 && < 0.3,@@ -112,8 +120,11 @@       QuickCheck >= 1.2.0.0 && < 1.3,       HUnit >= 1.2.2.1 && < 1.3     other-modules:+      Control.Concurrent.Speculation.Internal       Control.Concurrent.Speculation       Data.Foldable.Speculation+      Data.Traversable.Speculation+      Data.List.Speculation  executable benchmark-speculation   main-is: Benchmark.hs@@ -125,9 +136,14 @@       ghc-options: -O2 -fspec-constr -funbox-strict-fields -fdicts-cheap     build-depends:       base >= 4 && < 6, +      ghc-prim >= 0.2 && < 0.3,+      parallel >= 2.2 && < 2.3,       stm >= 2.1 && < 2.2,       containers >= 0.3.0 && < 0.4,       criterion >= 0.5 && < 0.6     other-modules:+      Control.Concurrent.Speculation.Internal       Control.Concurrent.Speculation       Data.Foldable.Speculation+      Data.Traversable.Speculation+      Data.List.Speculation