mergesort.hs

{-
GHC's mergesort replaced by a better implementation, 24/12/2009.
This code originally contributed to the nhc12 compiler by Thomas Nordin
in 2002.  Rumoured to have been based on code by Lennart Augustsson, e.g.
    http://www.mail-archive.com/haskell@haskell.org/msg01822.html
and possibly to bear similarities to a 1982 paper by Richard O'Keefe:
"A smooth applicative merge sort".

Benchmarks show it to be often 2x the speed of the previous implementation.
Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/2143
-}

sort = sortBy compare
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 (\ys -> as (a:ys)) bs
    ascending a as bs   = as [a]: 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

mergesort.rs

/// Sort a list using a comparator function.
pub fn sort_by(&self, cmp: &Fn(&A, &A) -> Ordering) -> List<A> {
    fn merge<A>(la: &List<A>, lb: &List<A>, cmp: &Fn(&A, &A) -> Ordering) -> List<A>
        where A: Clone
    {
        match (la.uncons(), lb.uncons()) {
            (Some((a, _)), Some((b, ref lb1))) if cmp(a, b) == Ordering::Greater => {
                cons(b.clone(), &merge(la, &lb1, cmp))
            }
            (Some((a, la1)), Some((_, _))) => cons(a.clone(), &merge(&la1, lb, cmp)),
            (None, _) => lb.clone(),
            (_, None) => la.clone(),
        }
    }

    fn merge_pairs<A>(l: &List<List<A>>, cmp: &Fn(&A, &A) -> Ordering) -> List<List<A>>
        where A: Clone
    {
        match l.uncons2() {
            Some((a, b, rest)) => cons(merge(a, b, cmp), &merge_pairs(&rest, cmp)),
            _ => l.clone(),
        }
    }

    fn merge_all<A>(l: &List<List<A>>, cmp: &Fn(&A, &A) -> Ordering) -> List<A>
        where A: Clone
    {
        match l.uncons() {
            None => list![],
            Some((a, ref d)) if d.null() => a.clone(),
            _ => merge_all(&merge_pairs(l, cmp), cmp),
        }
    }

    fn ascending<A>(a: &A,
                    f: &Fn(List<A>) -> List<A>,
                    l: &List<A>,
                    cmp: &Fn(&A, &A) -> Ordering)
                    -> List<List<A>>
        where A: Clone
    {
        match l.uncons() {
            Some((b, ref lb)) if cmp(a, b) != Ordering::Greater => {
                ascending(b, &|ys| f(cons(a.clone(), &ys)), &lb, cmp)
            }
            _ => cons(f(list![a.clone()]), &sequences(l, cmp)),
        }
    }

    fn descending<A>(a: &A,
                     la: &List<A>,
                     lb: &List<A>,
                     cmp: &Fn(&A, &A) -> Ordering)
                     -> List<List<A>>
        where A: Clone
    {
        match lb.uncons() {
            Some((b, ref bs)) if cmp(a, b) == Ordering::Greater => {
                descending(b, &cons(a.clone(), &la), bs, cmp)
            }
            _ => cons(cons(a.clone(), &la), &sequences(&lb, cmp)),
        }
    }

    fn sequences<A>(l: &List<A>, cmp: &Fn(&A, &A) -> Ordering) -> List<List<A>>
        where A: Clone
    {
        match l.uncons2() {
            Some((a, b, ref xs)) if cmp(a, b) == Ordering::Greater => {
                descending(b, &list![a.clone()], xs, cmp)
            }
            Some((a, b, ref xs)) => ascending(b, &|l| cons(a.clone(), &l), &xs, cmp),
            None => list![l.clone()],
        }
    }

    merge_all(&sequences(self, cmp), cmp)
}