Haskell中用par/pseq实现并行快排无性能提升的问题排查

你的并行快排没有获得预期性能提升，核心问题出在这几点：

• 强制求值完全破坏并行机会：forceList'会遍历并强制整个子列表完成求值。当losort = forceList' $ quicksort ...被绑定的瞬间，左半部分的排序结果已经计算完毕，losort par ...里的par成了空操作——它本来的作用是告知运行时“这个表达式可以并行计算”，但任务已经提前做完了。
• 无差别并行带来调度开销：对所有子列表都尝试并行，哪怕是极小的列表，会产生大量轻量任务，线程调度的额外成本直接抵消了并行收益。
• 列表拼接的固有开销：++操作是O(n)复杂度，单线程下的拼接开销，加上并行调度成本，会让并行版本的优势被抹平，甚至比单线程更慢。

针对上述问题，调整代码如下，可实现接近2倍的性能提升：

import Control.Parallel
import System.Random

quicksort :: Ord a => [a] -> [a]
quicksort [] = []
quicksort (x : xs) = losort ++ x : hisort
  where
    losort = quicksort [y | y <- xs, y < x]
    hisort = quicksort [y | y <- xs, y >= x]

-- 加入粒度控制，仅对大列表启用并行
parallelQuicksort :: Ord a => [a] -> [a]
parallelQuicksort [] = []
parallelQuicksort xs@(x : rest)
  | length xs < 1000 = quicksort xs  -- 小列表用单线程快排，避免调度开销
  | otherwise = losort `par` (hisort `pseq` (losort ++ x : hisort))
  where
    losort = parallelQuicksort [y | y <- rest, y < x]
    hisort = parallelQuicksort [y | y <- rest, y >= x]

main :: IO ()
main = do
  let input = take 3000000 (randomRs (0, 10000) (mkStdGen 42)) :: [Int]
  print $ last $ parallelQuicksort input

关键调整说明 #

1. 移除全列表强制求值：让losort保持延迟计算状态，确保par能真正将左半部分的排序任务分发到另一个线程。
2. 加入并行粒度阈值：当子列表长度小于1000时，用单线程快排处理，避免小任务的调度开销。你可以根据自己的机器性能调整这个阈值（比如500或2000）。
3. 开启编译优化：必须用cabal build -O2或ghc -O2编译代码，Haskell的并行机制在无优化的情况下无法发挥作用。

内容的提问来源于stack exchange，提问作者Fernando Chu