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