| 
1 | 1 | {-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}  | 
2 | 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-}  | 
 | 3 | +{-# LANGUAGE RecursiveDo #-}  | 
3 | 4 | -----------------------------------------------------------------------------  | 
4 | 5 | -- |  | 
5 | 6 | -- Module      :  Control.Parallel.Strategies  | 
@@ -592,20 +593,35 @@ parListNth n strat = evalListNth n (rparWith strat)  | 
592 | 593 | -- | Divides a list into chunks, and applies the strategy  | 
593 | 594 | -- @'evalList' strat@ to each chunk in parallel.  | 
594 | 595 | --  | 
595 |  | --- It is expected that this function will be replaced by a more  | 
596 |  | --- generic clustering infrastructure in the future.  | 
597 |  | ---  | 
598 | 596 | -- If the chunk size is 1 or less, 'parListChunk' is equivalent to  | 
599 | 597 | -- 'parList'  | 
600 | 598 | --  | 
 | 599 | +-- This function may be replaced by a more  | 
 | 600 | +-- generic clustering infrastructure in the future.  | 
601 | 601 | parListChunk :: Int -> Strategy a -> Strategy [a]  | 
602 |  | -parListChunk n strat xs  | 
603 |  | -  | n <= 1    = parList strat xs  | 
604 |  | -  | otherwise = concat `fmap` parList (evalList strat) (chunk n xs)  | 
605 |  | - | 
606 |  | -chunk :: Int -> [a] -> [[a]]  | 
607 |  | -chunk _ [] = []  | 
608 |  | -chunk n xs = as : chunk n bs where (as,bs) = splitAt n xs  | 
 | 602 | +parListChunk n strat  | 
 | 603 | +  | n <= 1 = parList strat  | 
 | 604 | +  | otherwise = go  | 
 | 605 | +  where  | 
 | 606 | +    go [] = pure []  | 
 | 607 | +    go as = mdo  | 
 | 608 | +      -- Calculate the first chunk in parallel, passing it the result  | 
 | 609 | +      -- of calculating the rest  | 
 | 610 | +      bs <- rpar $ runEval $ evalChunk strat more n as  | 
 | 611 | + | 
 | 612 | +      -- Calculate the rest  | 
 | 613 | +      more <- go (drop n as)  | 
 | 614 | +      return bs  | 
 | 615 | + | 
 | 616 | +-- | @evalChunk strat end n as@ uses @strat@ to evaluate the first @n@  | 
 | 617 | +-- elements of @as@ (ignoring the rest) and appends @end@ to the result.  | 
 | 618 | +evalChunk :: Strategy a -> [a] -> Int -> Strategy [a]  | 
 | 619 | +evalChunk strat = \end ->  | 
 | 620 | +  let  | 
 | 621 | +    go !_n [] = pure end  | 
 | 622 | +    go 0 _ = pure end  | 
 | 623 | +    go n (a:as) = (:) <$> strat a <*> go (n - 1) as  | 
 | 624 | +  in go  | 
609 | 625 | 
 
  | 
610 | 626 | -- --------------------------------------------------------------------------  | 
611 | 627 | -- Convenience  | 
 | 
0 commit comments