1 (* Copyright (C) 2009 Matthew Fluet.
2 * Copyright (C) 1999-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh
3 * Jagannathan, and Stephen Weeks.
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
9 functor OrderedUniqueSet(Element : ORDER): SET =
12 structure Element = Element
14 datatype t = T of {elements: Element.t list,
22 ("OrderedUniqueSet, " ^ f,
26 => if Element.compare(h1, h2) = LESS
29 [Layout.toString (Element.layout h1),
31 Layout.toString (Element.layout h2),
33 Layout.toString (Relation.layout (Element.compare(h1, h2))),
35 Layout.toString (Relation.layout (Element.compare(h2, h1))),
41 (List.length elements = length)
45 handle exn => (print (Layout.toString (List.layout Element.layout elements));
53 val empty' = {elements = [], length = 0: int}
54 val empty = T' "empty'" empty'
55 fun singleton x = T' "singleton" {elements = [x], length = 1}
57 fun contains (T {elements = xs, ...}, x)
61 | h::t => if Element.<(h, x)
63 else if Element.>(h,x)
70 fun add (s as T s', x)
73 = fn ({elements = [], ...},
74 {elements = xsacc, length = nacc})
75 => {elements = List.appendRev(xsacc, [x]), length = nacc + 1}
76 | ({elements = xs as h::t, length = n},
77 {elements = xsacc, length = nacc})
79 then add' ({elements = t, length = n - 1},
80 {elements = h::xsacc, length = 1 + nacc})
81 else if Element.>(h,x)
82 then {elements = List.appendRev(xsacc, x::xs),
83 length = nacc + 1 + n}
84 else {elements = List.appendRev(xsacc, xs),
89 else T' "add" (add' (s', empty'))
92 fun areDisjoint (T {elements = xs1, ...}, T {elements = xs2, ...})
99 => if Element.<(h1, h2)
100 then areDisjoint'(t1, xs2)
101 else if Element.>(h1, h2)
102 then areDisjoint'(xs1, t2)
105 areDisjoint' (xs1, xs2)
108 fun difference (T s1', T s2')
111 = fn ({elements = [], ...},
113 {elements = xsacc, length = nacc})
114 => {elements = List.rev xsacc, length = nacc}
115 | ({elements = xs1, length = n1},
116 {elements = [], ...},
117 {elements = xsacc, length = nacc})
118 => {elements = List.appendRev(xsacc, xs1), length = nacc + n1}
119 | (s1 as {elements = h1::t1, length = n1},
120 s2 as {elements = h2::t2, length = n2},
121 sacc as {elements = xsacc, length = nacc})
122 => if Element.<(h1,h2)
123 then difference' ({elements = t1, length = n1 - 1},
125 {elements = h1::xsacc, length = 1 + nacc})
126 else if Element.>(h1,h2)
127 then difference' (s1,
128 {elements = t2, length = n2 - 1},
130 else difference' ({elements = t1, length = n1 - 1},
131 {elements = t2, length = n2 - 1},
134 T' "difference" (difference' (s1', s2', empty'))
137 fun equals (T {elements = xs1, length = n1},
138 T {elements = xs2, length = n2})
141 = fn ([], []) => true
144 | (h1::t1, h2::t2) => Element.equals(h1, h2)
153 fun exists (T {elements = xs, ...}, p) = List.exists(xs, p)
155 fun fold (T {elements = xs, ...}, b, f) = List.fold(xs, b, f)
157 fun forall (T {elements = xs, ...}, p) = List.forall(xs, p)
158 fun foreach (T {elements = xs, ...}, p) = List.foreach(xs, p)
160 fun fromList l = List.fold(l, empty, fn (x, s) => add(s, x))
162 fun intersect (T s1', T s2')
165 = fn ({elements = [], ...},
167 {elements = xsacc, length = nacc})
168 => {elements = List.rev xsacc, length = nacc}
170 {elements = [], ...},
171 {elements = xsacc, length = nacc})
172 => {elements = List.rev xsacc, length = nacc}
173 | (s1 as {elements = h1::t1, length = n1},
174 s2 as {elements = h2::t2, length = n2},
175 sacc as {elements = xsacc, length = nacc})
176 => if Element.<(h1,h2)
177 then intersect' ({elements = t1, length = n1 - 1},
180 else if Element.>(h1,h2)
182 {elements = t2, length = n2 - 1},
184 else intersect' ({elements = t1, length = n1 - 1},
185 {elements = t2, length = n2 - 1},
186 {elements = h1::xsacc, length = 1 + nacc})
188 T' "intersect" (intersect' (s1', s2', empty'))
191 fun layout (T {elements = xs, ...}) = List.layout Element.layout xs
192 fun map (T {elements = xs, ...}, f) = fromList(List.map(xs, f))
194 fun partition (T {elements = xs, ...}, p)
196 val {yes = {elements = yxs, length = yn},
197 no = {elements = nxs, length = nn}}
202 {yes as {elements = yxs, length = yn},
203 no as {elements = nxs, length = nn}})
205 then {yes = {elements = x::yxs, length = yn + 1},
208 no = {elements = x::nxs, length = nn + 1}})
210 {yes = T' "partition" {elements = List.rev yxs, length = yn},
211 no = T' "partition" {elements = List.rev nxs, length = nn}}
214 fun power (T {elements = xs, ...})
224 fn (T {elements = xs, length = n}, rest)
225 => (T' "power" {elements = h::xs, length = 1 + n})::rest)
234 = fn ({elements = [], ...},
235 {elements = xsacc, length = nacc})
236 => {elements = List.appendRev(xsacc, [x]), length = nacc + 1}
237 | ({elements = xs as h::t, length = n},
238 {elements = xsacc, length = nacc})
239 => if Element.<(h, x)
240 then remove' ({elements = t, length = n - 1},
241 {elements = h::xsacc, length = 1 + nacc})
242 else if Element.>(h, x)
243 then {elements = List.appendRev(xsacc, xs),
245 else {elements = List.appendRev(xsacc, t),
246 length = nacc + n - 1}
248 T' "remove" (remove' (s', empty'))
251 fun replace (T {elements = xs, ...}, f)
254 fn (x, s) => (case f x
256 | SOME x' => add(s, x')))
258 fun size (T {length = n, ...}) = n
260 fun subset (T {elements = xs, ...}, p)
262 val {elements = xs, length = n}
265 fn (x, s as {elements = xs, length = n})
267 then {elements = x::xs, length = n + 1}
270 T' "subset" {elements = List.rev xs, length = n}
273 fun subsets _ = Error.unimplemented "OrderedUniqueSet: subsets"
275 fun subsetSize (T {elements = xs, ...}, p)
276 = List.fold(xs, 0: int, fn (x, n) => if p x then n + 1 else n)
278 fun toList (T {elements = xs, ...}) = xs
280 fun union (T s1', T s2')
283 = fn ({elements = [], ...},
284 {elements = xs2, length = n2},
285 {elements = xsacc, length = nacc})
286 => {elements = List.appendRev(xsacc, xs2),
288 | ({elements = xs1, length = n1},
289 {elements = [], ...},
290 {elements = xsacc, length = nacc})
291 => {elements = List.appendRev(xsacc, xs1),
293 | (s1 as {elements = h1::t1, length = n1},
294 s2 as {elements = h2::t2, length = n2},
295 {elements = xsacc, length = nacc})
296 => if Element.<(h1,h2)
297 then union' ({elements = t1, length = n1 - 1},
299 {elements = h1::xsacc, length = 1 + nacc})
300 else if Element.>(h1,h2)
302 {elements = t2, length = n2 - 1},
303 {elements = h2::xsacc, length = 1 + nacc})
304 else union' ({elements = t1, length = n1 - 1},
305 {elements = t2, length = n2 - 1},
306 {elements = h1::xsacc, length = 1 + nacc})
308 T' "union" (union' (s1', s2', empty'))
311 fun unions ss = List.fold(ss, empty, union)
313 fun isEmpty s = size s = 0
314 fun isSubsetEq (s1, s2) = size (difference (s1, s2)) = 0
315 fun isSubset (s1, s2) = (size s1 <> size s2) andalso isSubsetEq(s1, s1)
316 fun isSupersetEq (s1, s2) = isSubsetEq(s2, s1)
317 fun isSuperset (s1, s2) = isSubset(s2, s1)
320 val op - = difference
322 val op <= = isSubsetEq
323 val op > = isSuperset
324 val op >= = isSupersetEq