packages feed

speculation 0.4.0 → 0.5.0

raw patch · 4 files changed

+128/−128 lines, 4 files

Files

Control/Concurrent/Speculation.hs view
@@ -15,31 +15,15 @@     , specOnSTM'     , specBySTM     , specBySTM'-    -- * Codensity STM speculation-    , specCSTM-    , specCSTM'-    , specOnCSTM-    , specOnCSTM'-    , specByCSTM-    , specByCSTM'-    , CSTM-    -- * Codensity-    , Codensity(..)-    , liftCodensity-    , lowerCodensity     ) where  import Control.Concurrent.STM-import Control.Concurrent.Speculation.Internal -    (Codensity(..), liftCodensity, lowerCodensity, evaluated)+import Control.Concurrent.Speculation.Internal (evaluated) import Control.Exception (Exception, throw, fromException) import Control.Parallel (par) import Data.Typeable (Typeable) import Data.Function (on)-import System.IO.Unsafe (unsafePerformIO) -type CSTM = Codensity STM- -- * 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.@@ -143,106 +127,48 @@ -- > [------- a -------] -- >                   [------ f a ------] --specSTM :: Eq a => a -> (a -> STM b) -> a -> STM b+specSTM :: Eq a => STM a -> (a -> STM b) -> a -> STM b specSTM = specBySTM (==) {-# INLINE specSTM #-}  -- | Unlike 'specSTM', 'specSTM'' doesn't check if the argument has already been evaluated. -specSTM' :: Eq a => a -> (a -> STM b) -> a -> STM b+specSTM' :: Eq a => STM a -> (a -> STM b) -> a -> STM b specSTM' = specBySTM' (==) {-# INLINE specSTM' #-}  -- | 'specSTM' using a user defined comparison function-specBySTM :: (a -> a -> Bool) -> a -> (a -> STM b) -> a -> STM b+specBySTM :: (a -> a -> Bool) -> STM 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+specBySTM' :: (a -> a -> Bool) -> STM a -> (a -> STM b) -> a -> STM b+specBySTM' cmp g f a = a `par`      let        try = do-        result <- f g -        if cmp g a+        g' <- g+        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-+          else throw Speculation+    in +      try `catchSTM` \e -> case fromException e of+        Just Speculation -> f a -- rerun with alternative input+        _ -> throw e            -- this is a bigger problem {-# INLINE specBySTM' #-}  -- | 'specBySTM' . 'on' (==)'-specOnSTM :: Eq c => (a -> c) -> a -> (a -> STM b) -> a -> STM b+specOnSTM :: Eq c => (a -> c) -> STM a -> (a -> STM b) -> a -> STM b specOnSTM = specBySTM . on (==) {-# INLINE specOnSTM #-}  -- | 'specBySTM'' . 'on' (==)'-specOnSTM' :: Eq c => (a -> c) -> a -> (a -> STM b) -> a -> STM b+specOnSTM' :: Eq c => (a -> c) -> STM a -> (a -> STM b) -> a -> STM b specOnSTM' = specBySTM' . on (==) {-# INLINE specOnSTM' #-} --- ** Codensity STM speculation--specCSTM :: Eq a => a -> (a -> CSTM b) -> a -> CSTM b-specCSTM = specByCSTM (==)-{-# INLINE specCSTM #-}---- | Unlike 'specSTM', 'specSTM'' doesn't check if the argument has already been evaluated.--specCSTM' :: Eq a => a -> (a -> CSTM b) -> a -> CSTM b-specCSTM' = specByCSTM' (==)-{-# INLINE specCSTM' #-}---- | 'specSTM' using a user defined comparison function-specByCSTM :: (a -> a -> Bool) -> a -> (a -> CSTM b) -> a -> CSTM b-specByCSTM cmp g f a -    | evaluated a = f a -    | otherwise   = specByCSTM' cmp g f a-{-# INLINE specByCSTM #-}---- | 'specCSTM'' using a user defined comparison function-specByCSTM' :: (a -> a -> Bool) -> a -> (a -> CSTM b) -> a -> CSTM b-specByCSTM' cmp g f a = a `par` Codensity $ \k -> do-    exn <- freshSpeculation-    let -      try = do-        result <- lowerCodensity (f g)-        if cmp g a-          then k result-          else throw exn-    try `catchSTM` \e -> case fromException e of-        Just exn' | exn == exn' -> lowerCodensity (f a) >>= k -- rerun with alternative inputs-        _ -> throw e                         -- this is somebody else's problem--{-# INLINE specByCSTM' #-}---- | 'specByCSTM' . 'on' (==)'-specOnCSTM :: Eq c => (a -> c) -> a -> (a -> CSTM b) -> a -> CSTM b-specOnCSTM = specByCSTM . on (==)-{-# INLINE specOnCSTM #-}---- | 'specByCSTM'' . 'on' (==)'-specOnCSTM' :: Eq c => (a -> c) -> a -> (a -> CSTM b) -> a -> CSTM b-specOnCSTM' = specByCSTM' . on (==)-{-# INLINE specOnCSTM' #-}---- | TVar used to allocate speculation exceptions-speculationSupply :: TVar Int-speculationSupply = unsafePerformIO $ newTVarIO 0-{-# NOINLINE speculationSupply #-}--freshSpeculation :: STM Speculation-freshSpeculation = do-    n <- readTVar speculationSupply-    writeTVar speculationSupply $! n + 1-    return (Speculation n)-{-# INLINE freshSpeculation #-}--newtype Speculation = Speculation Int deriving (Show,Eq,Typeable)+data Speculation = Speculation deriving (Show,Eq,Typeable) instance Exception Speculation
Data/Foldable/Speculation.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-} module Data.Foldable.Speculation     (      -- * Speculative folds@@ -8,14 +8,26 @@     , foldl, foldlBy     , foldr1, foldr1By     , foldl1, foldl1By+    -- ** Speculative monadic folds+    , foldrM, foldrByM+    , foldlM, foldlByM+    -- * Speculative transactional monadic folds+    , foldrSTM, foldrBySTM+    , foldlSTM, foldlBySTM+    -- * Folding actions+    -- ** Applicative actions     , traverse_, traverseBy_     , for_, forBy_-    , mapM_, mapMBy_-    , forM_, forMBy_-    , sequenceA_, sequenceABy_-    , sequence_, sequenceBy_+    , sequenceA_, sequenceByA_     , asum, asumBy+    -- ** Monadic actions+    , mapM_, mapByM_+    , forM_, forByM_+    , sequence_, sequenceBy_     , msum, msumBy+    -- ** Speculative transactional monadic actions+    , mapSTM_, forSTM_, sequenceSTM_+    -- * Specialized folds     , toList, toListBy     , concat, concatBy     , concatMap, concatMapBy@@ -24,6 +36,7 @@     , product, productBy     , maximum, maximumBy     , minimum, minimumBy+    -- * Searches     , elem, elemBy     , notElem, notElemBy     , find, findBy@@ -40,9 +53,8 @@ import Data.Function (on) import Data.Foldable (Foldable) import qualified Data.Foldable as Foldable--- import Control.Concurrent.STM+import Control.Concurrent.STM import Control.Concurrent.Speculation--- import Control.Concurrent.Speculation.Internal (Codensity(..)) import Control.Applicative import Control.Monad hiding (mapM_, msum, forM_, sequence_) @@ -94,15 +106,61 @@     mf a (Acc n b) = let n' = n + 1 in Acc n' (specBy' cmp (g n') (f a) b) {-# INLINE foldrBy #-} -{--foldrSTM :: (Foldable f, Eq b) => (Int -> STM b) -> (a -> b -> STM b) -> b -> f a -> STM b-foldrSTM = foldrSTMBy (==)+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 #-}++foldlByM ::  (Foldable f, Monad m) => (m b -> m b -> Bool) -> (Int -> m b) -> (b -> a -> m b) -> m b -> f a -> m b+foldlByM  cmp g f mz = liftM extractAcc . Foldable.foldl go (liftM (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 foldlByM #-}++foldrM :: (Foldable f, Monad m, Eq (m b)) => (Int -> m b) -> (a -> b -> m b) -> m b -> f a -> m b+foldrM = foldrByM (==)+{-# INLINE foldrM #-}++foldrByM :: (Foldable f, Monad m) => (m b -> m b -> Bool) -> (Int -> m b) -> (a -> b -> m b) -> m b -> f a -> m b+foldrByM cmp g f mz = liftM extractAcc . Foldable.foldr go (liftM (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 foldrByM #-}++foldlSTM :: (Foldable f, Eq a) => (Int -> STM a) -> (a -> b -> STM a) -> STM a -> f b -> STM a+foldlSTM = foldlBySTM (==)+{-# INLINE foldlSTM #-}++foldlBySTM :: Foldable f => (a -> a -> Bool) -> (Int -> STM a) -> (a -> b -> STM a) -> STM a -> f b -> STM a+foldlBySTM cmp g f mz = liftM extractAcc . Foldable.foldl 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 foldlBySTM #-}++foldrSTM :: (Foldable f, Eq b) => (Int -> STM b) -> (a -> b -> STM b) -> STM b -> f a -> STM b+foldrSTM = foldrBySTM (==) {-# INLINE foldrSTM #-} -foldrSTMBy :: Foldable f => (b -> b -> Bool) -> (Int -> STM b) -> (a -> b -> STM b) -> b -> f a -> STM b-foldrSTMBy = undefined-{-# INLINE foldrSTMBy #-}--}+foldrBySTM :: Foldable f => (b -> b -> Bool) -> (Int -> STM b) -> (a -> b -> STM b) -> STM b -> f a -> STM b+foldrBySTM cmp g f mz = liftM extractAcc . Foldable.foldr 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 foldrBySTM #-}  {- foldrSTMBy cmp g f z xs = liftM extractAcc . Foldable.foldl mf return xs (Acc 0 z)@@ -175,38 +233,54 @@ {-# INLINE forBy_ #-}  -- | Map each element of the structure to a monadic action, evaluating these actions--- from left to right and ignore the results.+-- from left to right and ignoring the results. mapM_ :: (Foldable t, Monad m, Eq (m ())) => (Int -> m c) -> (a -> m b) -> t a -> m ()-mapM_ = mapMBy_ (==)+mapM_ = mapByM_ (==) {-# 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_ #-}+-- | Map each element of the structure to a monadic action, evaluating these actions+-- from left to right and ignoring the results, while transactional side-effects from +-- mis-speculated actions are rolled back.+mapSTM_ :: Foldable t => (Int -> STM c) -> (a -> STM b) -> t a -> STM ()+mapSTM_ g f = foldrSTM (\n -> () <$ g n) (\a _ -> () <$ f a) (return ())+{-# INLINE mapSTM_ #-} +mapByM_ :: (Foldable t, Monad m) => (m () -> m () -> Bool) -> (Int -> m c) -> (a -> m b) -> t a -> m ()+mapByM_ cmp g f = foldrBy cmp (\n -> g n >> return ()) ((>>) . f) (return ())+{-# INLINE mapByM_ #-}+ -- | '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_ #-}+-- | 'for_' is 'mapM_' with its arguments flipped.+forSTM_ :: Foldable t => (Int -> STM c) -> t a -> (a -> STM b) -> STM ()+forSTM_ g = flip (mapSTM_ g)+{-# 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)+{-# INLINE forByM_ #-}+ sequenceA_ :: (Foldable t, Applicative f, Eq (f ())) => (Int -> f b) -> t (f a) -> f ()-sequenceA_ = sequenceABy_ (==)+sequenceA_ = sequenceByA_ (==) {-# 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_ #-}+sequenceByA_ :: (Foldable t, Applicative f, Eq (f ())) => (f () -> f () -> Bool) -> (Int -> f b) -> t (f a) -> f ()+sequenceByA_ cmp g = foldrBy cmp ((()<$) . g) (*>) (pure ())+{-# INLINE sequenceByA_ #-}  sequence_ :: (Foldable t, Monad m, Eq (m ())) => (Int -> m b) -> t (m a) -> m () sequence_ = sequenceBy_ (==)  {-# INLINE sequence_ #-} +sequenceSTM_:: Foldable t => (Int -> STM a) -> t (STM b) -> STM ()+sequenceSTM_ g = foldrSTM (\n -> () <$ g n) (\a _ -> () <$ a) (return ())+{-# INLINE sequenceSTM_ #-}+ 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 ())+sequenceBy_ cmp g = foldrBy cmp (\n -> g n >> return ()) (>>) (return ()) {-# INLINE sequenceBy_ #-}  asum :: (Foldable t, Alternative f, Eq (f a)) => (Int -> f a) -> t (f a) -> f a
README.markdown view
@@ -6,9 +6,11 @@  <http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.19.4622> +You can download it using 'cabal install speculation', if you have the Haskell Platform installed.+ ## Combinators -### speculative function application+### Speculative Function Application  Various speculative function application combinators are provided. Two fairly canonical samples are described here. @@ -44,7 +46,7 @@  `specSTM` provides a similar compressed timeline for speculated STM actions, but also rolls back side-effects. -### speculative folds+### Speculative Folds  A speculative version of Data.Foldable is provided as Data.Foldable.Speculation.     @@ -56,7 +58,7 @@  Given a valid estimator `g`, `'foldr g f z xs` yields the same answer as `Foldable.foldr' f z xs`. -`g n` should supply an estimate of the value returned from folding over the /last/ `n` elements of the container.+`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. @@ -64,9 +66,9 @@      foldl :: (Foldable f, Eq b) => (Int -> b) -> (b -> a -> b) -> b -> f a -> b -`foldl` works similarly to `Foldable.foldl'`, except that `g n` should provide an estimate for the /first/ `n` elements.+`foldl` works similarly to `Foldable.foldl'`, except that `g n` should provide an estimate for the **first** `n` elements. -contact information+Contact Information -------------------  I can be reached through the user ekmett on github, as edwardk on irc.freenode.net #haskell channel, or by email to <ekmett@gmail.com>.
speculation.cabal view
@@ -1,5 +1,5 @@ name:           speculation-version:        0.4.0+version:        0.5.0 license:        BSD3 license-file:   LICENSE author:         Edward A. Kmett@@ -39,11 +39,9 @@  .  'specSTM' provides a similar time table for STM actions, but also rolls back side-effects.  . - /Changes in 0.3.0:/+ /Changes in 0.5.0:/  . - * Speculative folds moved to 'Data.Foldable.Speculation' and expanded to cover all of the -   'Data.Foldable' combinators.- * specBy and specOn variants added.+ * Added monadic and transactional folds to Data.Foldable.Speculation.   copyright:          (c) 2010 Edward A. Kmett build-type:         Simple