1structure Listsort :> Listsort =
2struct
3(* Listsort *)
4
5(** Smooth Applicative Merge Sort, Richard O'Keefe 1982        **)
6(** From L.C. Paulson: ML for the Working Programmer, CUP 1991 **)
7(** Optimized for Moscow ML **)
8
9fun sort ordr []          = []
10  | sort ordr (xs as [_]) = xs
11  | sort ordr (xs as [x1, x2]) =
12    (case ordr(x1, x2) of
13	 GREATER => [x2, x1]
14       | _       => xs)
15  | sort ordr xs =
16    let fun merge []      ys = ys
17          | merge xs      [] = xs
18          | merge (x::xs) (y::ys) =
19            if ordr(x, y) <> GREATER then x :: merge xs (y::ys)
20            else y :: merge (x::xs) ys
21        fun mergepairs l1  []              k = [l1]
22          | mergepairs l1 (ls as (l2::lr)) k =
23            if k mod 2 = 1 then l1::ls
24            else mergepairs (merge l1 l2) lr (k div 2)
25	fun nextrun run []      = (run, [])
26	  | nextrun run (xs as (x::xr)) =
27	    if ordr(x, List.hd run) = LESS then (run, xs)
28	    else nextrun (x::run) xr
29        fun sorting []      ls r = List.hd(mergepairs [] ls 0)
30          | sorting (x::xs) ls r =
31	    let val (revrun, tail) = nextrun [x] xs
32	    in sorting tail (mergepairs (List.rev revrun) ls (r+1)) (r+1) end
33    in sorting xs [] 0 end;
34
35fun sorted ordr []         = true
36  | sorted ordr (y1 :: yr) =
37    let fun h x0 []       = true
38	  | h x0 (x1::xr) = ordr(x0, x1) <> GREATER andalso h x1 xr
39    in h y1 yr end;
40
41end;
42