Haskell : 모든 코어를 사용하지 않는 병렬 프로그램

Question

다음 코드는 -threaded과 함께 컴파일 되든 컴파일하지 않든간에 또는 단일 스레드 방식으로 코드를 작성할 때와 동일한 성능을가집니다. 두 블록 (par과 주석 달기 forkIO/forkOS/forkOn 사용)은 동일한 성능을 보입니다. 실제로 병렬 버전에서는 성능이 다소 저하됩니다 (아마도 병렬 GC의 오버 헤드로 인해). htop 같은 프로그램에서 CPU 사용률을 보면 단 한 개의 CPU가 단선되었음을 알 수 있습니다. 코드를 읽는 동안 대부분의 코어를 사용해야하기 때문에 꽤 혼란 스럽습니다.

forkOS는 더 많은 코어를 사용하지 않는 사실은 ghc/rts/posix/OSThreads.c:forkOS_createThread에서 관련 섹션은 pthread_create에게 전화를 강제 것을 의미하는 것 때문에 특히 혼란 스럽다. 내 .cabal 파일

ghc-options: 
    -threaded 
    -rtsopts 
    "-with-rtsopts=-N15 -qg1" 

플랫폼 정보

$ stack --version 
Version 1.2.0, Git revision 241cd07d576d9c0c0e712e83d947e3dd64541c42 (4054 commits) x86_64 hpack-0.14.0 
$ stack exec ghc -- --version 
The Glorious Glasgow Haskell Compilation System, version 7.10.3 
$ lsb_release -a 
No LSB modules are available. 
Distributor ID: Ubuntu 
Description: Ubuntu 16.04.1 LTS 
Release: 16.04 
Codename: xenial 
$ uname -r 
4.4.0-36-generic 

에서

-- (Apologies if I have missed an import or two) 

import Data.List 
import GHC.Conc 
import Control.Concurrent 
import Control.DeepSeq 
import qualified Data.HashMap.Lazy as HM 
main :: IO() 
main = do 
    let [one::Int, two] = [15, 1000000] 
{- 
    s <- numSparks 
    putStrLn $ "Num sparks " <> show s 
    n <- getNumCapabilities 
    putStrLn $ "Num capabilities " <> show n 
    m <- newEmptyMVar 
    forkIO $ void $ forM [(1::Int)..one] $ \cpu -> do 
    -- forkOn cpu $ void $ do 
    forkOS $ void $ do 
    -- forkIO $ void $ do 
    -- void $ do 
     putStrLn $ "core " <> show cpu 
     s <- return $ sort $ HM.keys $ HM.fromList $ zip [cpu..two + cpu] (repeat (0::Int)) 
     putStrLn $ "core " <> show cpu <> " done " <> show (sum s) 
     putMVar m() 
    forM [1..one] $ \i -> takeMVar m 
    let s :: String = "hey!" 
    putStrLn s 
-} 
    print one 
    print two 
    let __pmap__ f xs = case xs of 
     [] -> [] 
     x:xs -> let y = f x 
        ys = __pmap__ f xs 
        in (y `par` ys) `pseq` (y: ys) 
    n <- pure $ sum . concat $ flip __pmap__ [1..one] $ \i -> 
    force $ sort $ HM.keys $ HM.fromList $ zip [i..(two + i)] (repeat (0::Int)) 
    putStrLn $ "sum " <> show n 
    s <- numSparks 
    putStrLn $ "Num sparks " <> show s 

관련 부분은 왜 내 코드는 병렬 점점되지 않는 이유는 무엇입니까? 그것은 다음과 같은 보고서를

21,829,377,776 bytes allocated in the heap 
126,512,021,712 bytes copied during GC 
     86,659,312 bytes maximum residency (322 sample(s)) 
     6,958,976 bytes maximum slop 
      218 MB total memory in use (0 MB lost due to fragmentation) 

            Tot time (elapsed) Avg pause Max pause 
    Gen 0  41944 colls,  0 par 16.268s 17.272s  0.0004s 0.0011s 
    Gen 1  322 colls, 321 par 237.056s 23.822s  0.0740s 0.2514s 

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

    TASKS: 32 (1 bound, 31 peak workers (31 total), using -N15) 

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

    INIT time 0.004s ( 0.003s elapsed) 
    MUT  time 12.504s (13.301s elapsed) 
    GC  time 253.324s (41.094s elapsed) 
    EXIT time 0.000s ( 0.017s elapsed) 
    Total time 265.920s (54.413s elapsed) 

    Alloc rate 1,745,791,568 bytes per MUT second 

    Productivity 4.7% of total user, 23.1% of total elapsed 

gc_alloc_block_sync: 10725286 
whitehole_spin: 0 
gen[0].sync: 2171 
gen[1].sync: 1057315 

EDIT2을 -s 런타임 플래그를 생산하고 추가, 전혀 도움이 경우 :

편집은 경기장 크기 덤비는 상당히 도움이 보인다. RTS 옵션에 -H2G -A1G을 추가하면 시간이 43 초에서 5.2 초로 줄어 들었습니다. 상황에 대해 15 배 빠른 속도 향상을 위해 개선 할 수있는 것이 있습니까?

EDIT3는 : 피드백

Answer 1

문제가 __pmap__의 정의에 의해 발생을주고 두 사람이 제안 par, pseq 패턴을 반영하기 위해 코드를 편집. 특히이 다음과 같은 표현에 문제가 :

let y = f x 
in y `par` (y: __pmap__ f xs) 

당신은이 y 및 y: __pmap__ f xs 병렬로 평가되도록 할 것이라고 기대는하지만, 이것은 사실이 아니다. GHC는이를 병렬로 평가하려하지만 두 번째 하위 표현식은 첫 번째 하위 표현 인 y을 포함합니다. 이 때문에 두 번째 하위 표현식은 첫 번째 하위 표현식에 따라 다르므로 병렬로 평가할 수 없습니다. pseq가 ys가 y : ys 전에 평가되어야하고 y의 평가를 실행하는 동안, 따라서 제 표현식 평가 시작할 수 강제 때문에 상기 식을 작성하는 올바른 방법

let y = f x 
    ys = __pmap__ f xs 
in y `par` (ys `pseq` (y : ys)) 

이다. 이에 대한 약간의 논의는 thread을 참조하십시오.

그래서, 우리는 다음과 같은 얻을 모두 함께 넣어 : 내가 추가 한

main :: IO() 
main = do 
    let [one::Int, two] = [15, 1000000] 
    print one 
    print two 
    let __pmap__ f xs = case xs of 
     [] -> [] 
     x:xs -> let y = f x 
        ys = __pmap__ f xs 
       in y `par` ys `pseq` (y : ys) 
    n <- pure $ sum . concat $ flip __pmap__ [1..one] $ \i -> 
    traceShow i $ force $ sort $ HM.keys $ HM.fromList $ zip [i..(two + i)] (repeat (0::Int)) 
    putStrLn $ "sum " <> show n 
    s <- numSparks 
    putStrLn $ "Num sparks " <> show s 

유의 사항 traceShow (Debug.Trace에서)입니다.-N1을 rtsopts에 실행하면 목록은 한 번에 하나의 요소로 평가되는 반면, -N3을 사용하면 한 번에 3 개 요소로 평가됩니다. 이야기의

교훈은 par 및 pseq가 잘못 사용하기 쉬운 것입니다 그리고 당신은 그러므로 parallel에서 (당신의 __pmap__에 해당) 등 parMap rdeepseq와 같은 높은 수준의 솔루션을 선호한다.