[Haskell-cafe] Parallel weirdness [code]

[Andrew Coppin]

Denis Bueno wrote:
> It would be much easier to draw sound conclusions if you would post your code.
>   

Erm... good point.

See attachments.

-------------- next part --------------
module Sort where

import Control.Parallel
import Control.Parallel.Strategies

split0 [] = []
split0 (x:xs) = x : split1 xs

split1 [] = []
split1 (x:xs) = split0 xs

merge xs [] = xs
merge [] ys = ys
merge (x:xs) (y:ys)
  | x < y     = x : merge xs (y:ys)
  | otherwise = y : merge (x:xs) ys

msort [] = []
msort [x] = [x]
msort xs =
  let
    xs0 = msort (split0 xs)
    xs1 = msort (split1 xs)
  in merge xs0 xs1

msortP [] = []
msortP [x] = [x]
msortP xs =
  let
    xs0 = msort (split0 xs)
    xs1 = msort (split1 xs)
  in seqList rwhnf xs0 `par` seqList rwhnf xs1 `seq` merge xs0 xs1

list = [5,4,6,3,7,2,8,1,9,0]
-------------- next part --------------
module Time where

import System.CPUTime

time :: IO () -> IO Integer
time fn = do
  t0 <- getCPUTime
  fn
  t1 <- getCPUTime
  return (t1 - t0)

ps_ms = 1000000000 :: Integer

ps_s  = ps_ms * 1000 :: Integer
-------------- next part --------------
module Main where

import Data.Word
import System.IO
import GHC.Conc (numCapabilities)

import Sort
import Time

type Test = (String,[Word32])

random = iterate (\x -> 1664525 * x + 1013904223) 7 :: [Word32]

test1m = ("1M",take 1000000 random)
test2m = ("2M",take 2000000 random)

type Algo = (String, [Word32] -> [Word32])

algo_seq_msort = ("MergeSortSeq", msort)
algo_par_msort = ("MergeSortPar", msortP)

dump :: [Word32] -> String
dump = unlines . map show

run_tests :: Algo -> Test -> IO ()
run_tests (name,fn) (title,xs) = do
  echo "\n"
  
  let f1 = name ++ "--" ++ title ++ "--In.txt"
  echo   $ "Writing '" ++ f1 ++ "'..."; hFlush stdout
  nullT <- time (writeFile f1 (dump xs))
  echo $ "  Took " ++ show (nullT `div` ps_ms) ++ " ms.\n"
  
  mapM_
    (\n -> do
      let f2 = name ++ "--" ++ title ++ "--Out" ++ show n ++ ".txt"
      echo   $ "Writing '" ++ f2 ++ "'..."; hFlush stdout
      sortT <- time (writeFile f2 (dump (fn xs)))
      echo $ "  Took " ++ show (sortT `div` ps_ms) ++ " ms.\n"
    )
    [1..8]

echo msg = do
  hPutStr stdout msg
  hPutStr stderr msg

main = do
  echo $ "CPU threads = " ++ show numCapabilities ++ ".\n"
  
  mapM_
    (\test ->
      mapM_
        (\algo -> run_tests algo test)
        [algo_seq_msort, algo_par_msort]
    )
    [test1m, test2m]