File: sorting.sml

package info (click to toggle)
mlton 20210117%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 58,464 kB
  • sloc: ansic: 27,682; sh: 4,455; asm: 3,569; lisp: 2,879; makefile: 2,347; perl: 1,169; python: 191; pascal: 68; javascript: 7
file content (72 lines) | stat: -rw-r--r-- 1,840 bytes parent folder | download | duplicates (5)
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