Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# LANGUAGE NoMonomorphismRestriction,
- ScopedTypeVariables #-}
- import Control.Arrow
- import Control.Parallel.Strategies
- import Control.DeepSeq
- import System.IO
- import Data.Time.Clock
- import Text.Printf
- -- wish there was a library.....
- printTime name start = do
- ct <- getCurrentTime
- putStrLn $ printf "%s: %s sec." name (show $ diffUTCTime ct start)
- data Tree a = Leaf a | Node (Tree a) (Tree a) deriving (Show)
- instance NFData a => NFData (Tree a) where
- rnf (Leaf v) = deepseq v ()
- rnf (Node x y) = deepseq (x, y) ()
- listToTree [] = error "listToTree -- empty list"
- listToTree [x] = Leaf x
- listToTree xs = uncurry Node $ listToTree *** listToTree $
- splitAt (length xs `div` 2) xs
- -- mergeSort' :: Ord a => Tree a -> Eval [a]
- mergeSort' l (Leaf v) = return [v]
- mergeSort' l (Node x y) = do
- xr <- strat $ runEval $ mergeSort' (l - 1) x
- yr <- rseq $ runEval $ mergeSort' (l - 1) y
- rdeepseq (merge xr yr)
- where
- merge [] y = y
- merge x [] = x
- merge (x:xs) (y:ys) | x < y = x : merge xs (y:ys)
- | otherwise = y : merge (x:xs) ys
- strat | l > 0 = rpar
- | otherwise = rseq
- mergeSort = runEval . mergeSort' 10
- main = do
- ct <- getCurrentTime
- tree :: Tree Int <- return $ listToTree [10000000,9999999..1]
- deepseq tree $ return ()
- printTime "initialization" ct
- hFlush stdout
- ct <- getCurrentTime
- deepseq (mergeSort tree) $ return ()
- printTime "sorting" ct
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement