Having trouble with parallel Haskell

[Bryan O'Sullivan]

I intended to write a half chapter or so about parallel programming in
Haskell for the book I'm working on, but I've been coming to the
conclusion that the time is not yet ripe for this.  I hope it will be
helpful if I share my experiences here.

Specifically, I was planning to write about parallel programming in pure
code: use of "par" and programming with strategies.

The most substantial problem is that the threaded RTS in GHC 6.8.2 is
very crashy in the face of "par": about 90% of my runs fail with a
segfault or an assertion failure.  Simon Marlow mentioned that this bug
is fixed, but I've been unsuccessful in building a GHC 6.8.3 release
candidate snapshot so far, so I can't verify this.

When a run does go through, I have found it surprisingly difficult to
actually get both cores of a dual-core system to show activity.  As
there are no tools I can use to see what is happening, I am stumped.  It
is of course quite likely that I am doing something wrong that results
in unexpected dependencies, but I cannot find a means to gaining insight
into the problem.

As an example, I have a simple parallel quicksort that is very
conservative in its sparking, and I get no joy out of it on a dual-core
machine: it mostly sticks to a single core.  This wouldn't be a problem
if I had some way to spot the presumed data dependency that is
serialising the code, but no joy.

	<b
-------------- next part --------------
{-# LANGUAGE PatternSignatures #-}

module Main (main) where

import Control.Parallel (par, pseq)
import Control.Parallel.Strategies (NFData(..))
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import System.Environment (getArgs)
import System.Random (getStdGen, randoms)

sort :: (Ord a) => [a] -> [a]

sort (x:xs) = lesser ++ x:greater
    where lesser  = sort [y | y <- xs, y <  x]
          greater = sort [y | y <- xs, y >= x]
sort _ = []

parSort :: (NFData a, Ord a) => Int -> [a] -> [a]
parSort d list@(x:xs)
  | d <= 0     = sort list
  | otherwise = rnf lesser `par` (rnf greater `pseq`
                lesser ++ x:greater)
      where lesser      = parSort d' [y | y <- xs, y <  x]
            greater     = parSort d' [y | y <- xs, y >= x]
            d' = d - 1
parSort _ _              = []

main = do
  args <- getArgs
  let count | null args = 8192
            | otherwise = read (head args)
  input :: [Int] <- (take count . randoms) `fmap` getStdGen

  putStrLn $ "We have " ++ show (length input) ++ " elements to sort."
  start <- getCurrentTime
  let sorted = parSort 2 input
  putStrLn $ "Sorted all " ++ show (length sorted) ++ " elements."
  end <- getCurrentTime
  putStrLn $ show (end `diffUTCTime` start) ++ " elapsed."