Check out the Pastebin Gadgets Shop. We have thousands of fun, geeky & affordable gadgets on sale :-)Want more features on Pastebin? Sign Up, it's FREE!
tweet

# parallel merge sort attempt 4

By: gatoatigrado on Jun 10th, 2011  |  syntax: None  |  size: 1.52 KB  |  views: 93  |  expires: Never
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
clone this paste RAW Paste Data
Top