Investigating whether Data.List.sort gets faster when we replace the DList usage with plain reversing.

Sort.hs

import qualified Criterion.Main   as Crit

import qualified Test.Tasty.QuickCheck as QC
import qualified Test.Tasty as Tasty	

import Data.List 
import Data.List.Split
import System.Random	   


sort' :: (Ord a) => [a] -> [a]
sort' = sortBy' compare

sortBy' :: (a -> a -> Ordering) -> [a] -> [a]
sortBy' cmp = mergeAll . sequences
  where
    sequences (a:b:xs)
      | a `cmp` b == GT = descending b [a] xs
      | otherwise       = ascending  b [a] xs
    sequences xs = [xs]

    descending a as (b:bs)
      | a `cmp` b == GT = descending b (a:as) bs
    descending a as bs  = (a:as): sequences bs

    ascending a as (b:bs)
      | a `cmp` b /= GT = ascending b (a:as) bs
    ascending a as bs   = reverse (a:as) : sequences bs

    mergeAll [x] = x
    mergeAll xs  = mergeAll (mergePairs xs)

    mergePairs (a:b:xs) = merge a b: mergePairs xs
    mergePairs xs       = xs

    merge as@(a:as') bs@(b:bs')
      | a `cmp` b == GT = b:merge as  bs'
      | otherwise       = a:merge as' bs
    merge [] bs         = bs
    merge as []         = as


-- Passes when run, of course. 
test = 
	Tasty.defaultMain $ 
	Tasty.testGroup "QC test:" [
		QC.testProperty "sort == sort'" $
			\xs -> sort (xs :: [Int]) == sort' xs]


bounds :: [Int]
bounds = take 5 $ scanl1 (*) $ repeat 10 -- [10, 100, 1000, 10000, 100000]

rlists       = [(show n, take n $ randoms (mkStdGen 0) :: [Int]) | n <- bounds]
asclists     = [(show n, [1..n]) | n <- bounds]
desclists    = [(show n, [n, n - 1 .. 1]) | n <- bounds]
asc10lists   = [(show $ n * 10,  concat $ replicate n [1..10::Int])     | n <- map (`div` 10) bounds]
asc100lists  = [(show $ n * 100, concat $ replicate n [1..100::Int])    | n <- map (`div` 100) $ tail bounds]
desc10lists  = [(show $ n * 10,  concat $ replicate n [10, 9..1::Int])  | n <- map (`div` 10) bounds]
desc100lists = [(show $ n * 100, concat $ replicate n [100,99..1::Int]) | n <- map (`div` 100) $ tail bounds]


benchLists label lists = 
	Crit.bgroup label [
		Crit.bgroup ("size: " ++ size) [
			Crit.bench "sort:"  $ Crit.nf sort list, 
			Crit.bench "sort':" $ Crit.nf sort' list
		] | (size, list) <- lists ] 

main = do
	Crit.defaultMain [
		benchLists "pseudorandom lists" rlists,
		benchLists "ascending lists" asclists,
		benchLists "descending lists" desclists,
		benchLists "asc lists, chunks of 10" asc10lists,
		benchLists "desc lists, chunks of 10" desc10lists,
		benchLists "asc lists, chunks of 100" asc100lists,
		benchLists "desc lists, chunks of 100" desc100lists]