Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * | |
4 | * MLton is released under a BSD-style license. | |
5 | * See the file MLton-LICENSE for details. | |
6 | *) | |
7 | ||
8 | functor PolyUnorderedSet(): POLY_SET = | |
9 | struct | |
10 | ||
11 | structure I = Int | |
12 | structure L = List | |
13 | ||
14 | type 'a info = {equal: 'a * 'a -> bool, | |
15 | output: 'a * Out.t -> unit} | |
16 | ||
17 | datatype 'a t = T of 'a List.t * 'a info | |
18 | ||
19 | fun elts(T(xs, _)) = xs | |
20 | ||
21 | fun empty info = T([], info) | |
22 | ||
23 | fun isEmpty s = List.isEmpty(elts s) | |
24 | ||
25 | fun forall(s, f) = L.forall(elts s, f) | |
26 | fun exists(s, f) = L.exists(elts s, f) | |
27 | fun foreach(s, f) = L.foreach(elts s, f) | |
28 | ||
29 | fun contains(T(elts, {equal, ...}), x) = | |
30 | L.exists(elts, fn x' => equal(x, x')) | |
31 | ||
32 | fun s <= s' = forall(s, fn x => contains(s', x)) | |
33 | ||
34 | fun equal(s, s') = s <= s' andalso s' <= s | |
35 | ||
36 | fun s >= s' = s' <= s | |
37 | ||
38 | val equals = equal | |
39 | ||
40 | fun s < s' = s <= s' andalso exists(s', fn x => not(contains(s, x))) | |
41 | ||
42 | fun s > s' = s' < s | |
43 | ||
44 | fun add(s as T(elts, info), x) = | |
45 | if contains(s, x) then s | |
46 | else T(x :: elts, info) | |
47 | ||
48 | fun subset(T(elts, info), f) = | |
49 | T(L.keepAll(elts, f), info) | |
50 | ||
51 | fun s1 - s2 = subset(s1, fn x => not(contains(s2, x))) | |
52 | ||
53 | fun s1 + (s2 as T(x2s, _)) = let val T(x1s, info) = s1 - s2 | |
54 | in T(L.append(x1s, x2s), info) | |
55 | end | |
56 | ||
57 | (*fun union ss = L.foldl(ss, empty, op +)*) | |
58 | ||
59 | fun intersect(s, s') = subset(s, fn x => contains(s', x)) | |
60 | ||
61 | fun toList(T(xs, _)) = xs | |
62 | ||
63 | fun remove(T(xs, info as {equal, ...}), x) = | |
64 | T(L.remove(xs, fn x' => equal(x, x')), | |
65 | info) | |
66 | ||
67 | fun size(T(xs, _)) = L.length xs | |
68 | (* | |
69 | fun output(T(elts, {output, ...}), out) = | |
70 | let val print = Outstream.outputc out | |
71 | in (print "{" ; | |
72 | L.output(", ", output) (elts, out) ; | |
73 | print "}") | |
74 | end | |
75 | *) | |
76 | end | |
77 | ||
78 | structure PolySet = PolyUnorderedSet() |