mirror of
https://github.com/ekmett/speculation.git
synced 2024-11-26 11:44:15 +03:00
more folds
This commit is contained in:
ekmett
parent
9008f1c05c
commit
5a8a98d2f2
@ -36,34 +36,43 @@ import Unsafe.Coerce (unsafeCoerce)
|
||||
|
||||
-- * 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.
|
||||
-- | @'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'.
|
||||
--
|
||||
-- Furthermore, if the argument has already been evaluated, we avoid sparking the parallel computation at all.
|
||||
--The best-case timeline looks like:
|
||||
--
|
||||
-- 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 = 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 ---------]
|
||||
|
||||
spec :: Eq a => a -> (a -> b) -> a -> b
|
||||
spec = specBy (==)
|
||||
@ -106,36 +115,45 @@ specOn' = specBy' . on (==)
|
||||
|
||||
-- * 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' :: Eq c => (a -> STM c) -> STM a -> (a -> STM b) -> a -> STM b
|
||||
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 @@ data Box a = Box a
|
||||
unsafeIsEvaluated :: a -> Bool
|
||||
unsafeIsEvaluated a = unsafeGetTagBits a /= 0
|
||||
{-# INLINE unsafeIsEvaluated #-}
|
||||
|
||||
|
||||
31
Control/Morphism/Speculation.hs
Normal file
31
Control/Morphism/Speculation.hs
Normal file
@ -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 :: (Foldable f, Monoid m, Eq m) => (Int -> m) -> (a -> m) -> f a -> m
|
||||
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 @@ mapByM_ cmp g f = foldrBy cmp (\n -> g n >> return ()) ((>>) . f) (return ())
|
||||
-- | '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 Prelude hiding
|
||||
|
||||
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 :: 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@.
|
||||
-- | 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 @@ scanrBy cmp g f z = map extractAcc . List.scanr mf (Acc 0 z)
|
||||
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 @@ scanrBySTM cmp g f mz = liftM (map extractAcc) . List.scanr go (liftM (Acc 0) mz
|
||||
-- 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 #-}
|
||||
|
||||
|
||||
@ -29,29 +29,6 @@ import Control.Concurrent.STM
|
||||
import Control.Concurrent.Speculation
|
||||
import Control.Concurrent.Speculation.Internal
|
||||
|
||||
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
|
||||
(# 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) => (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)
|
||||
mapAccumL = mapAccumLBy (==)
|
||||
{-# INLINE mapAccumL #-}
|
||||
@ -64,25 +41,6 @@ mapAccumLBy cmp g f z xs = runIntAccumL (Traversable.traverse go xs) 0 z
|
||||
in (# n +# 1#, a', c #))
|
||||
{-# INLINE mapAccumLBy #-}
|
||||
|
||||
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
|
||||
(# 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) => (Int -> a) -> (a -> b -> (a, c)) -> a -> t b -> (a, t c)
|
||||
mapAccumR = mapAccumRBy (==)
|
||||
{-# INLINE mapAccumR #-}
|
||||
@ -95,31 +53,6 @@ mapAccumRBy cmp g f z xs = runIntAccumR (Traversable.traverse go xs) 0 z
|
||||
in (# n +# 1#, a', c #))
|
||||
{-# INLINE mapAccumRBy #-}
|
||||
|
||||
-- applicative composition with a strict integer state applicative
|
||||
newtype AccT m a = AccT (Int# -> Acc (m a))
|
||||
|
||||
runAccT :: Applicative m => AccT m a -> Int -> m a
|
||||
runAccT (AccT m) (I# i) = extractAcc (m i)
|
||||
{-# INLINE runAccT #-}
|
||||
|
||||
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))
|
||||
|
||||
newtype IntStateT m a = IntStateT { runIntStateT :: Int# -> m (Acc a) }
|
||||
|
||||
instance Monad m => Monad (IntStateT m) where
|
||||
return a = IntStateT (\i -> return (acc i a))
|
||||
IntStateT mm >>= k = IntStateT $ \i0 -> do
|
||||
Acc (I# i1) m <- mm i0
|
||||
runIntStateT (k m) i1
|
||||
|
||||
traverse :: (Traversable t, Applicative f, Eq a) => (Int -> a) -> (a -> f b) -> t a -> f (t b)
|
||||
traverse = traverseBy (==)
|
||||
{-# INLINE traverse #-}
|
||||
@ -199,3 +132,64 @@ forSTM g = flip (mapSTM g)
|
||||
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
|
||||
(# 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 #))
|
||||
|
||||
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
|
||||
(# 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 #))
|
||||
|
||||
-- applicative composition with a strict integer state applicative
|
||||
newtype AccT m a = AccT (Int# -> Acc (m a))
|
||||
|
||||
runAccT :: Applicative m => AccT m a -> Int -> m a
|
||||
runAccT (AccT m) (I# i) = extractAcc (m i)
|
||||
{-# INLINE runAccT #-}
|
||||
|
||||
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 @@ unboxed tag-checking
|
||||
--------------------
|
||||
|
||||
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.
|
||||
|
||||
@ -24,27 +24,45 @@ description:
|
||||
.
|
||||
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 @@ library
|
||||
|
||||
exposed-modules:
|
||||
Control.Concurrent.Speculation
|
||||
Control.Morphism.Speculation
|
||||
Data.Foldable.Speculation
|
||||
Data.Traversable.Speculation
|
||||
Data.List.Speculation
|
||||
@ -122,6 +141,7 @@ executable test-speculation
|
||||
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 @@ executable benchmark-speculation
|
||||
other-modules:
|
||||
Control.Concurrent.Speculation.Internal
|
||||
Control.Concurrent.Speculation
|
||||
Control.Morphism.Speculation
|
||||
Data.Foldable.Speculation
|
||||
Data.Traversable.Speculation
|
||||
Data.List.Speculation
|
||||
|
||||
Loading…
Reference in New Issue
Block a user