module ParFoldMap (parFoldMap) where
import Control.Parallel
import Control.DeepSeq
import GHC.Conc (numCapabilities)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Monoid
import Data.Foldable
-- Parallel folding of Seq a with respect to Monoid m
parFoldMap :: (NFData m, Monoid m) => (a -> m) -> Seq a -> m
parFoldMap = mapReduce depth
where
depth = round (log (fromIntegral numCapabilities) / log 2)
mapReduce :: (NFData m, Monoid m) => Int -> (a -> m) -> Seq a -> m
mapReduce _ _ xs | Seq.null xs = mempty
mapReduce 0 f xs = force $ foldMap f xs
mapReduce d f xs = ys `par` (zs `pseq` (ys `mappend` zs))
where
len = Seq.length xs
(ys', zs') = Seq.splitAt (len `div` 2) xs
ys = force $ mapReduce (d - 1) f ys'
zs = force $ mapReduce (d - 1) f zs'