(*
* The MergeSort structure provides the following funtions for sorting
* and merging lists:
*
* sort: Sort one unsorted list.
* merge: Merge two sorted lists.
*
* Profiling against large lists generated by a PRNG shows this
* structure to be slightly faster than SML/NJ's ListMergeSort when
* compiled with mlton.
*)
structure MergeSort = struct
(* Merge two sorted lists. *)
fun merge f lst1 len1 lst2 len2 = let
fun mergeRec lst1 len1 lst2 len2 acc =
(* If both lists are exhauted, return the result. If
* lst1 is exhausted, merge the remainder of lst2. If
* lst2 is exhausted, merge the remainder of lst1.
* Otherwise, perform a general merge of the next
* element. *)
case (len1, len2)
of (0, 0) => rev acc
| (0, _) => mergeRec lst1 len1 (tl lst2) (len2-1) ((hd lst2)::acc)
| (_, 0) => mergeRec (tl lst1) (len1-1) lst2 len2 ((hd lst1)::acc)
| (_, _) => let
val x1 = hd lst1
val x2 = hd lst2
in
case f (x1, x2)
of GREATER => mergeRec lst1 len1
(tl lst2) (len2 - 1) (x2::acc)
| _ => mergeRec (tl lst1) (len1 - 1)
lst2 len2 (x1::acc)
end
in
mergeRec lst1 len1 lst2 len2 []
end
(* Sort the list "lst" using the comparison function "f". *)
fun sort f lst = let
fun sortRec lst lstLength = let
(* Split the list into "top" and "bottom" halves. We
* could use List.take to exactly generate the "top" half,
* but it is expensive because it has to copy nodes. So
* rather than exactly create the "top" half, we bind
* "top" to "lst" and limit "merge" by passing in the
* length of the "top" list as "topLength." *)
val top = lst
val topLength = lstLength div 2
(* A different approach is taken with the "bottom" half
* because List.drop is not expensive because it does not
* copy nodes; rather List.drop just scans to the desired
* node and just uses it. The only thing a little tricky
* about "bottom" is that it could have one extra node
* relative to the "top" half because "div" is not exact. *)
val bottom = List.drop (lst, topLength)
val bottomLength = lstLength - topLength
in
case lstLength
of 0 => lst
| 1 => lst
| _ => merge f (sortRec top topLength) topLength
(sortRec bottom bottomLength) bottomLength
end
in
sortRec lst (length lst)
end
end