Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

parallel merge sort attempt 4

By: gatoatigrado on Jun 10th, 2011  |  syntax: None  |  size: 1.52 KB  |  views: 90  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. {-# LANGUAGE NoMonomorphismRestriction,
  2.              ScopedTypeVariables #-}
  3.  
  4. import Control.Arrow
  5. import Control.Parallel.Strategies
  6. import Control.DeepSeq
  7. import System.IO
  8. import Data.Time.Clock
  9. import Text.Printf
  10.  
  11. -- wish there was a library.....
  12. printTime name start = do
  13.     ct <- getCurrentTime
  14.     putStrLn $ printf "%s: %s sec." name (show $ diffUTCTime ct start)
  15.  
  16. data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Show)
  17.  
  18. instance NFData a => NFData (Tree a) where
  19.     rnf (Leaf v) = deepseq v ()
  20.     rnf (Node x y) = deepseq (x, y) ()
  21.  
  22. listToTree [] = error "listToTree -- empty list"
  23. listToTree [x] = Leaf x
  24. listToTree xs = uncurry Node $ listToTree *** listToTree $
  25.     splitAt (length xs `div` 2) xs
  26.  
  27. -- mergeSort' :: Ord a => Tree a -> Eval [a]
  28. mergeSort' l (Leaf v) = return [v]
  29. mergeSort' l (Node x y) = do
  30.     xr <- strat $ runEval $ mergeSort' (l - 1) x
  31.     yr <- rseq $ runEval $ mergeSort' (l - 1) y
  32.     rdeepseq (merge xr yr)
  33.     where
  34.         merge [] y = y
  35.         merge x [] = x
  36.         merge (x:xs) (y:ys) | x < y = x : merge xs (y:ys)
  37.                             | otherwise = y : merge (x:xs) ys
  38.         strat | l > 0 = rpar
  39.               | otherwise = rseq
  40.  
  41. mergeSort = runEval . mergeSort' 10
  42.  
  43. main = do
  44.     ct <- getCurrentTime
  45.     tree :: Tree Int <- return $ listToTree [10000000,9999999..1]
  46.     deepseq tree $ return ()
  47.     printTime "initialization" ct
  48.     hFlush stdout
  49.     ct <- getCurrentTime
  50.     deepseq (mergeSort tree) $ return ()
  51.     printTime "sorting" ct