1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
(*
* Sorting
*
* -- Allen
*)
signature SORTING =
sig
val sort : ('a * 'a -> bool) -> 'a list -> 'a list
val sort_uniq : ('a * 'a -> bool) ->
('a * 'a -> bool) -> 'a list -> 'a list
val merge : ('a * 'a -> bool) -> 'a list * 'a list -> 'a list
val merge_uniq : ('a * 'a -> bool) ->
('a * 'a -> bool) -> 'a list * 'a list -> 'a list
val merge_uniqs : ('a * 'a -> bool) ->
('a * 'a -> bool) -> 'a list list -> 'a list
val uniq : ('a * 'a -> bool) -> 'a list -> 'a list
end
structure Sorting : SORTING =
struct
infix ==
fun gensort merge op< l =
let fun sort [] = []
| sort (l as [x]) = l
| sort (l as [x,y]) = if x < y then l else [y,x]
| sort l =
let fun split([],a,b) = (a,b)
| split(x::xs,a,b) = split(xs,b,x::a)
val (a,b) = split(l,[],[])
in merge (sort a, sort b)
end
in sort l
end
fun merge op< (a,b) =
let fun m ([],a) = a
| m (a,[]) = a
| m (a as (u::v), b as (w::x)) =
if u < w then u::m(v,b) else w::m(a,x)
in m(a,b)
end
fun merge_uniq op< op== (a,b) =
let fun m ([],a) = uniq op== a
| m (a,[]) = uniq op== a
| m (a as (u::v), b as (w::x)) =
if u == w then m(a,x)
else if u < w then u::m(v,b)
else w::m(a,x)
in m(a,b)
end
and uniq op== l =
let fun f [] = []
| f (l as [x]) = l
| f (x::(l as (y::z))) = if x == y then f l else x::f l
in f l
end
fun sort op< l = gensort (merge op<) op< l
fun sort_uniq op< op== l = gensort (merge_uniq op< op==) op< l
fun merge_uniqs op< op== l = sort_uniq op< op== (List.concat l)
end
|
