--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Sort/SortMain.hs	Tue Jul 16 15:45:09 2013 +0900
@@ -0,0 +1,28 @@
+module Main where
+
+import Data.Time.Clock (diffUTCTime, getCurrentTime)
+import System.Environment (getArgs)
+import System.Random (StdGen, getStdGen, randoms)
+
+import Sorting
+
+testFunction = sort
+-- testFunction = seqSort
+-- testFunction = parSort
+-- testFunction = parSort2 2
+
+randomInts :: Int -> StdGen -> [Int]
+randomInts k g = let result = take k (randoms g)
+                 in force result `seq` result
+
+main = do
+  args <- getArgs
+  let count | null args = 500000
+            | otherwise = read (head args)
+  input <- randomInts count `fmap` getStdGen
+  putStrLn $ "We have " ++ show (length input) ++ " elements to sort."
+  start <- getCurrentTime
+  let sorted = testFunction input
+  putStrLn $ "Sorted all " ++ show (length sorted) ++ " elements."
+  end <- getCurrentTime
+  putStrLn $ show (end `diffUTCTime` start) ++ " elapsed."

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Sort/Sorting.hs	Tue Jul 16 15:45:09 2013 +0900
@@ -0,0 +1,44 @@
+module Sorting where
+
+import Control.Parallel (par, pseq)
+
+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 :: (Ord a) => [a] -> [a]
+parSort (x:xs)    = force greater `par` (force lesser `pseq`
+                                         (lesser ++ x:greater))
+    where lesser  = parSort [y | y <- xs, y <  x]
+          greater = parSort [y | y <- xs, y >= x]
+parSort _         = []
+
+sillySort (x:xs) = greater `par` (lesser `pseq`
+                                  (lesser ++ x:greater))
+    where lesser   = sillySort [y | y <- xs, y <  x]
+          greater  = sillySort [y | y <- xs, y >= x]
+sillySort _        = []
+
+force :: [a] -> ()
+force xs = go xs `pseq` ()
+    where go (_:xs) = go xs
+          go [] = 1
+
+seqSort :: (Ord a) => [a] -> [a]
+seqSort (x:xs) = lesser `pseq` (greater `pseq`
+                                (lesser ++ x:greater))
+    where lesser  = seqSort [y | y <- xs, y <  x]
+          greater = seqSort [y | y <- xs, y >= x]
+seqSort _ = []
+
+parSort2 :: (Ord a) => Int -> [a] -> [a]
+parSort2 d list@(x:xs)
+  | d <= 0     = sort list
+  | otherwise = force greater `par` (force lesser `pseq`
+                                     (lesser ++ x:greater))
+      where lesser      = parSort2 d' [y | y <- xs, y <  x]
+            greater     = parSort2 d' [y | y <- xs, y >= x]
+            d' = d - 1
+parSort2 _ _              = []