packages feed

speculation 1.4.1.2 → 1.5

raw patch · 7 files changed

+32/−81 lines, 7 filesdep −tag-bits

Dependencies removed: tag-bits

Files

CHANGELOG.markdown view
@@ -1,3 +1,7 @@+/1.5/++ * Removed the use of `tag-bits`. This enables the API to be `Trustworthy`.+ /1.4/   * Simplified MonadSpec
Control/Concurrent/Speculation.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Control.Concurrent.Speculation@@ -14,23 +17,16 @@     (     -- * Speculative application       spec-    , spec'     , specBy-    , specBy'     , specOn-    , specOn'     -- * Speculative application with transactional rollback     , specSTM-    , specSTM'     , specOnSTM-    , specOnSTM'     , specBySTM-    , specBySTM'     ) where  import Control.Concurrent.STM import Control.Concurrent.Speculation.Internal (returning)-import Data.TagBits (unsafeIsEvaluated) import Control.Monad (liftM2, unless) import Data.Function (on) import GHC.Conc@@ -79,41 +75,22 @@ 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' = specBy' (==)-{-# INLINE spec' #-}- -- | 'spec' with a user defined comparison function specBy :: (a -> a -> Bool) -> a -> (a -> b) -> a -> b specBy cmp guess f a-    | unsafeIsEvaluated a = f a-    | otherwise = specBy' cmp guess 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   | numCapabilities == 1 = f $! a   | otherwise = speculation `par`     if cmp guess a     then speculation     else f a   where speculation = f guess-{-# INLINE specBy' #-}+{-# INLINE specBy #-}  -- | 'spec' comparing by projection onto another type specOn :: Eq c => (a -> c) -> a -> (a -> b) -> a -> b specOn = specBy . on (==) {-# INLINE specOn #-} --- | 'spec'' comparing by projection onto another type-specOn' :: Eq c => (a -> c) -> a -> (a -> b) -> a -> b-specOn' = specBy' . on (==)-{-# INLINE specOn' #-}- -- * 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. 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.@@ -160,22 +137,9 @@ specSTM = specBySTM (returning (==)) {-# INLINE specSTM #-} --- | Unlike 'specSTM', 'specSTM'' doesn't check if the argument has already been evaluated.--specSTM' :: Eq a => STM a -> (a -> STM b) -> a -> STM b-specSTM' = specBySTM' (returning (==))-{-# INLINE specSTM' #-}- -- | '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-    | otherwise   = specBySTM' cmp guess f a-{-# INLINE specBySTM #-}---- | '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 = do+specBySTM cmp mguess f a = do   sparks <- unsafeIOToSTM numSparks   if sparks < numCapabilities     then a `par` do@@ -188,16 +152,9 @@      `orElse`       f a     else f $! a-{-# INLINE specBySTM' #-}+{-# INLINE specBySTM #-}  -- | @'specBySTM' . 'on' (==)@ specOnSTM :: Eq c => (a -> STM c) -> STM a -> (a -> STM b) -> a -> STM b specOnSTM = specBySTM . on (liftM2 (==)) {-# INLINE specOnSTM #-}---- | @'specBySTM'' . 'on' (==)@-specOnSTM' :: Eq c => (a -> STM c) -> STM a -> (a -> STM b) -> a -> STM b-specOnSTM' = specBySTM' . on (liftM2 (==))-{-# INLINE specOnSTM' #-}--
Control/Concurrent/Speculation/Class.hs view
@@ -23,9 +23,6 @@   -- | @spec@ with a user supplied comparison function   specByM :: (a -> a -> Bool) -> a -> a -> m a -  -- | @spec'@ with a user supplied comparison function-  specByM' :: (a -> a -> Bool) -> a -> a -> m a- -- | 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@@ -33,21 +30,11 @@ specM :: (MonadSpec m, Eq a) => a -> a -> m a specM = specByM (==) --- | As per 'spec', without the check for whether or not the second argument--- is already evaluated.-specM' :: (MonadSpec m, Eq a) => a -> a -> m a-specM' = specByM' (==)- -- | @spec'@ with a user supplied comparison function specOnM :: (MonadSpec m, Eq c) => (a -> c) -> a -> a -> m a specOnM = specByM . on (==) --- | @spec'@ with a user supplied comparison function-specOnM' :: (MonadSpec m, Eq c) => (a -> c) -> a -> a -> m a-specOnM' = specByM . on (==)- -- * Basic speculation  instance Monad m => MonadSpec (ContT r m) where   specByM f g a = ContT $ \k -> specBy f g k a-  specByM' f g a = ContT $ \k -> specBy' f g k a
Control/Concurrent/Speculation/Foldable.hs view
@@ -105,8 +105,8 @@ -- provide increased opportunities for parallelism. 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)+  where+    mf a (Acc n b) = Acc (n + 1) (specBy cmp (g n) (f a) b) {-# INLINE foldrBy #-}  @@ -119,14 +119,14 @@ 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'))+    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')+    mf a b !i = let i' = i + 1 in specBy cmp (g i') (f a) (b i') {-# INLINE foldrBy #-} -} @@ -139,7 +139,7 @@   where     go mia b = do       Acc n a <- mia-      a' <- specBy' cmp (g n) (>>= (`f` b)) (return a)+      a' <- specBy cmp (g n) (>>= (`f` b)) (return a)       return (Acc (n + 1) a') {-# INLINE foldlByM #-} @@ -152,7 +152,7 @@   where     go a mib = do       Acc n b <- mib-      b' <- specBy' cmp (g n) (>>= f a) (return b)+      b' <- specBy cmp (g n) (>>= f a) (return b)       return (Acc (n + 1) b') {-# INLINE foldrByM #-} @@ -165,7 +165,7 @@   where     go mia b = do       Acc n a <- mia-      a' <- specBySTM' cmp (g n) (`f` b) a+      a' <- specBySTM cmp (g n) (`f` b) a       return (Acc (n + 1) a') {-# INLINE foldlBySTM #-} @@ -178,7 +178,7 @@   where     go a mib = do       Acc n b <- mib-      b' <- specBySTM' cmp (g n) (f a) b+      b' <- specBySTM cmp (g n) (f a) b       return (Acc (n + 1) b') {-# INLINE foldrBySTM #-} @@ -196,7 +196,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 = Acc (n + 1) (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@@ -207,7 +207,7 @@ foldr1By cmp g f xs = fromMaybeAcc (errorEmptyStructure "foldr1")                                    (Foldable.foldr mf NothingAcc xs)   where-    mf a (JustAcc n b) = JustAcc (n + 1) (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 #-} @@ -219,7 +219,7 @@ foldl1By cmp g f xs = fromMaybeAcc (errorEmptyStructure "foldl1")                                (Foldable.foldl mf NothingAcc xs)   where-    mf (JustAcc n a) b = JustAcc (n + 1) (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 #-}
Control/Concurrent/Speculation/List.hs view
@@ -90,7 +90,7 @@ 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)+    mf a (Acc n b) = let n' = n + 1 in Acc n' (specBy cmp (g n') (f a) b) {-# INLINE scanrBy #-}  @@ -101,7 +101,7 @@ 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)+    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]@@ -111,7 +111,7 @@ 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 (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 #-} @@ -122,6 +122,6 @@ 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 (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 #-}
Control/Concurrent/Speculation/Traversable.hs view
@@ -1,4 +1,8 @@ {-# LANGUAGE MagicHash, Rank2Types, UnboxedTuples, BangPatterns #-}+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Control.Concurrent.Speculation.Traversable@@ -47,7 +51,7 @@ 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+            let ~(a', c) = specBy cmp (g (I# n)) (`f` b) a             in (# n +# 1#, a', c #)) {-# INLINE mapAccumLBy #-} @@ -59,7 +63,7 @@ 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+            let ~(a', c) = specBy cmp (g (I# n)) (`f` b) a             in (# n +# 1#, a', c #)) {-# INLINE mapAccumRBy #-}
speculation.cabal view
@@ -1,5 +1,5 @@ name:           speculation-version:        1.4.1.2+version:        1.5 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett@@ -85,7 +85,6 @@    build-depends:     ghc-prim,-    tag-bits     >= 0.1 && < 0.2,     transformers >= 0.2.2.0 && < 0.4,     stm          >= 2.1 && < 2.5