并行Haskell-GHC GC'；火花

我有一个我正在尝试并行化的程序（用可运行代码完全粘贴）

我分析并发现，大部分时间都花在

findNearest

上，这本质上是一个简单的

foldr

，覆盖了大量

Data.Map

findNearest :: RGB -> M.Map k RGB -> (k, Word32)
findNearest rgb m0 =
    M.foldrWithKey' minDistance (k0, distance rgb r0) m0
    where (k0, r0) = M.findMin m0
          minDistance k r x@(_, d1) =
            -- Euclidean distance in RGB-space
            let d0 = distance rgb r
            in if d0 < d1 then (k, d0) else x

不幸的是，GHC GC在转换成有用的并行性之前，它的大部分都是我的火花

下面是使用

ghc-O2-threaded

编译并使用

+RTS-s-N2

 839,892,616 bytes allocated in the heap
 123,999,464 bytes copied during GC
   5,320,184 bytes maximum residency (19 sample(s))
   3,214,200 bytes maximum slop
          16 MB total memory in use (0 MB lost due to fragmentation)

                                    Tot time (elapsed)  Avg pause  Max pause
  Gen  0      1550 colls,  1550 par    0.23s    0.11s     0.0001s    0.0004s
  Gen  1        19 colls,    18 par    0.11s    0.06s     0.0030s    0.0052s

  Parallel GC work balance: 16.48% (serial 0%, perfect 100%)

  TASKS: 6 (1 bound, 5 peak workers (5 total), using -N2)

  SPARKS: 215623 (1318 converted, 0 overflowed, 0 dud, 198111 GC'd, 16194 fizzled)

  INIT    time    0.00s  (  0.00s elapsed)
  MUT     time    3.72s  (  3.66s elapsed)
  GC      time    0.34s  (  0.17s elapsed)
  EXIT    time    0.00s  (  0.00s elapsed)
  Total   time    4.07s  (  3.84s elapsed)

  Alloc rate    225,726,318 bytes per MUT second

  Productivity  91.6% of total user, 97.1% of total elapsed

gc_alloc_block_sync: 9862
whitehole_spin: 0
gen[0].sync: 0
gen[1].sync: 2103

正如你所看到的，大多数火花在被转换之前都是气相色谱或化脓的。我尝试了不同的严格性，让

findNearest

返回一个自定义的严格对数据类型，而不是元组 ，或者使用

Control.Parallel.Strategies

中的rdeepseq，但我的火花仍然是GC的

我想知道

• 为什么我的火花会在转换前被GC清除
• 如何更改程序以利用并行性

---

我不擅长并行策略，所以我可能完全错了。但是：
如果您通过设置足够大的分配区域（例如使用

-A20M

运行时选项）禁用GC，您将看到大多数火花都已熄灭，而不是GC已熄灭。这意味着在相应的spark完成之前，它们通过普通程序流进行评估

minimumBy

立即强制

parMap

结果，并开始评估它们。与此同时，sparks已被安排并执行，但为时已晚。火花完成后，该值已由主线程计算。如果没有

-A20M

，火花将被GC'd，因为在计划火花之前，该值已被计算并被GC'd
下面是一个简化的测试用例：

import Control.Parallel.Strategies

f :: Integer -> Integer
f 0 = 1
f n = n * f (n - 1)

main :: IO ()
main = do
  let l = [n..n+10]
      n = 1
      res = parMap rdeepseq f l
  print res

在这种情况下，所有火花都会熄灭：

 SPARKS: 11 (0 converted, 0 overflowed, 0 dud, 0 GC'd, 11 fizzled)

（有时它们是GC'd）
但如果我在打印结果之前生成主线程

import Control.Parallel.Strategies
import Control.Concurrent

f :: Integer -> Integer
f 0 = 1
f n = n * f (n - 1)

main :: IO ()
main = do
  let l = [n..n+10]
      n = 1
      res = parMap rdeepseq f l
  res `seq` threadDelay 1
  print res

然后将所有火花转换为：

SPARKS: 11 (11 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)

---

因此，看起来您没有足够的火花（在我的示例中尝试设置

l=[n..n+1000]

），而且火花不够重（在我的示例中尝试设置

n=1000

。
可能会有所帮助。1

splitRoot

通常生成一个包含三个元素的列表：左树、根树和右树。因此，您在一个非常小的列表上使用了

parMap

。元素本身相当大，但同样地，

findNearest

本身并不是并行的。2.如果未使用，则触发的表达式将被GC'd。也许你根本没有使用结果？@Zeta：是的，列表的大小很小（只有3个元素），但是

映射的大小很大（65k~250k个元素），所以即使将其拆分为两个相当大的子树，也应该提供一些有用的并行性。我相信这就是火花被GC化的原因。主线程正在
parMap
中评估thunks，然后计划的火花才有机会完成。这就回答了我的第一个问题，但第二个问题仍然存在：我怎样才能有效地将其并行化？我认为这是不可能的。您的并行性太细粒度了，因此必须重新考虑您的算法。
SPARKS: 11 (11 converted, 0 overflowed, 0 dud, 0 GC'd, 0 fizzled)