我有一个简单的例程，该例程采用 Double的向量的乘积。我试图使此代码并行，但是许多火花最终都在发动。这是一个独立的基准，也可以作为要点提供：
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# OPTIONS_GHC -O2 -Wall -threaded -fforce-recomp #-}
import Criterion.Main
import Control.Monad (when)
import Control.Parallel.Strategies (runEval,rpar,rseq)
import qualified Data.Vector.Primitive as PV
main :: IO ()
main = do
let expected = PV.product numbers
when (not (serialProduct numbers == expected)) $ do
fail "serialProduct implementation incorrect"
defaultMain
[ bgroup "product"
[ bench "serial" $ whnf serialProduct numbers
, bench "parallel" $ whnf parallelProduct numbers
]
]
numbers :: PV.Vector Double
numbers = PV.replicate 10000000 1.00000001
{-# NOINLINE numbers #-}
serialProduct :: PV.Vector Double -> Double
serialProduct v =
let !len = PV.length v
go :: Double -> Int -> Double
go !d !ix = if ix < len then go (d * PV.unsafeIndex v ix) (ix + 1) else d
in go 1.0 0
-- | This only works when the vector length is a multiple of 8.
parallelProduct :: PV.Vector Double -> Double
parallelProduct v = runEval $ do
let chunk = div (PV.length v) 8
p2 <- rpar (serialProduct (PV.slice (chunk * 6) chunk v))
p3 <- rpar (serialProduct (PV.slice (chunk * 7) chunk v))
p1 <- rseq (serialProduct (PV.slice (chunk * 0) (chunk * 6) v))
return (p1 * p2 * p3)
可以用：
来构建和运行。ghc -threaded parallel_compute.hs
./parallel_compute +RTS -N4 -s
我有一个八核盒子，所以给运行时四个功能应该很好。基准结果并不重要，但是在这里是：
benchmarking product/serial
time 11.40 ms (11.30 ms .. 11.53 ms)
0.999 R² (0.998 R² .. 1.000 R²)
mean 11.43 ms (11.37 ms .. 11.50 ms)
std dev 167.2 μs (120.4 μs .. 210.1 μs)
benchmarking product/parallel
time 10.03 ms (9.949 ms .. 10.15 ms)
0.999 R² (0.999 R² .. 1.000 R²)
mean 10.17 ms (10.11 ms .. 10.31 ms)
std dev 235.7 μs (133.4 μs .. 426.2 μs)
现在，运行时统计信息。这是我困惑的地方：
124,508,840 bytes allocated in the heap
529,843,176 bytes copied during GC
80,232,008 bytes maximum residency (8344 sample(s))
901,272 bytes maximum slop
83 MB total memory in use (0 MB lost due to fragmentation)
Tot time (elapsed) Avg pause Max pause
Gen 0 19 colls, 19 par 0.008s 0.001s 0.0001s 0.0003s
Gen 1 8344 colls, 8343 par 2.916s 1.388s 0.0002s 0.0008s
Parallel GC work balance: 76.45% (serial 0%, perfect 100%)
TASKS: 13 (1 bound, 12 peak workers (12 total), using -N4)
SPARKS: 1024 (502 converted, 0 overflowed, 0 dud, 28 GC'd, 494 fizzled)
INIT time 0.000s ( 0.002s elapsed)
MUT time 11.480s ( 10.414s elapsed)
GC time 2.924s ( 1.389s elapsed)
EXIT time 0.004s ( 0.005s elapsed)
Total time 14.408s ( 11.811s elapsed)
Alloc rate 10,845,717 bytes per MUT second
Productivity 79.7% of total user, 88.2% of total elapsed
在涉及火花的部分中，我们可以看到其中大约一半的嘶嘶声。这对我来说似乎令人难以置信。在parallelProduct中，我们在任务上的主线程工作比任何一个火花都要大6倍。但是，这些火花似乎总是会变得肥胖（或GCED）。而且这也不是一件小事。我们正在谈论的是一毫秒的计算，因此在其他thunk发出之前，主线程可以完成似乎令人难以置信。
我的理解（这可能是完全错误的）是，这种计算应该是并发运行时的理想选择。垃圾收集似乎是GHC中并发应用程序的最大问题，但是我在这里所做的任务并没有产生任何几乎垃圾，因为GHC将serialProduct的内在变成了一个紧密的环路。
在上行方面，我们 do 在基准测试中查看并行版本的速度为11％。因此，成功引发的工作的第八部分确实产生了可衡量的影响。我只是想知道为什么其他火花无法正常工作。
任何帮助理解这一点的帮助将不胜感激。
编辑
我已经更新了要点以包括另一个实现：
-- | This only works when the vector length is a multiple of 4.
parallelProductFork :: PV.Vector Double -> Double
parallelProductFork v = unsafePerformIO $ do
let chunk = div (PV.length v) 4
var <- newEmptyMVar
_ <- forkIO $ evaluate (serialProduct (PV.slice (chunk * 0) chunk v)) >>= putMVar var
_ <- forkIO $ evaluate (serialProduct (PV.slice (chunk * 1) chunk v)) >>= putMVar var
_ <- forkIO $ evaluate (serialProduct (PV.slice (chunk * 2) chunk v)) >>= putMVar var
_ <- forkIO $ evaluate (serialProduct (PV.slice (chunk * 3) chunk v)) >>= putMVar var
a <- takeMVar var
b <- takeMVar var
c <- takeMVar var
d <- takeMVar var
return (a * b * c * d)
这个表现出色：
benchmarking product/parallel mvar
time 3.814 ms (3.669 ms .. 3.946 ms)
0.986 R² (0.977 R² .. 0.992 R²)
mean 3.818 ms (3.708 ms .. 3.964 ms)
std dev 385.6 μs (317.1 μs .. 439.8 μs)
variance introduced by outliers: 64% (severely inflated)
但是，它落在常规的并发原始图上，而不是使用火花。我不喜欢这种解决方案，但我将其作为证据表明，应该通过基于火花的方法实现相同的性能。
这里的问题是，创建火花不会立即唤醒空闲功能，请参见此处。默认情况下，调度间隔为20ms，因此，当您创建火花时，最多需要20毫秒才能将其转换为真实线程。到那时，通话线程很可能已经评估了thunk，并且火花将是gc'd或fizz的。
相比之下，如果有的话，forkIO将立即唤醒空闲功能。这就是为什么显式并发比并行策略更可靠的原因。
您可以使用-C选项（DOCS）减少调度间隔来解决问题。例如。+RTS -C0.01似乎就足够了。