
  0 | module BottomUpMergeSort
  1 | 
  2 | import Data.List
  3 | 
  4 | import Sortable
  5 | 
  6 | %default total
  7 | 
  8 | export
  9 | data MergeSort a = MS Int (Lazy (List (List a)))
 10 | 
 11 | mrg : Ord a => List a -> List a -> List a
 12 | mrg    []         ys            = ys
 13 | mrg xs               []         = xs
 14 | mrg xs@(x :: xs') ys@(y :: ys') =
 15 |   if x <= y then x :: mrg xs' ys else y :: mrg xs ys'
 16 | 
 17 | addSeg : Ord a => List a -> List (List a) -> Int -> List (List a)
 18 | addSeg seg segs size = let size' = size `div` 2
 19 |                            r     = size `mod` 2 in
 20 |   if 0 == r then seg :: segs
 21 |             else addSeg (mrg seg (head segs {ok = segsNonEmpty}))
 22 |                         (tail segs {ok = segsNonEmpty})
 23 |                         (assert_smaller size size')
 24 |  where
 25 |   segsNonEmpty : NonEmpty segs
 26 |   segsNonEmpty = believe_me "length segs = ceil lg size"
 27 | 
 28 | export
 29 | Sortable MergeSort where
 30 |   empty = MS 0 []
 31 |   add x (MS size segs) = MS (size + 1) (addSeg [x] segs size)
 32 |   sort (MS size segs) = foldl mrg [] segs
 33 |