1 (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
4 * MLton is released under a BSD-style license.
5 * See the file MLton-LICENSE for details.
7 (*-------------------------------------------------------------------*)
9 (*-------------------------------------------------------------------*)
11 functor UnorderedUniverse(B: T): UNIVERSE =
15 structure O = Outstream
16 structure L = ListSet.L
23 | Set of elt ListSet.t
27 fun makeEqual equalSet =
28 let fun equalElt(Base b, Base b') = B.equals(b, b')
29 | equalElt(Pair(x, y), Pair(x', y')) =
30 equalElt(x, x') andalso equalElt(y, y')
31 | equalElt(Set s, Set s') = equalSet(s, s')
36 fun makeOutput outputSet =
37 let fun outputElt(Base b, out) = B.output(b, out)
38 | outputElt(Pair(x, y), out) =
39 let val print = O.outputc out
46 | outputElt(Set s, out) = outputSet(s, out)
51 structure S = UnorderedSetMain(Rep)
55 fun toBase(Base b) = b
56 | toBase _ = Error.error "UnorderedUniverse.toBase"
57 fun toPair(Pair p) = p
58 | toPair _ = Error.error "UnorderedUniverse.toPair"
60 | toSet _ = Error.error "UnorderedUniverse.toSet"
63 let val ys = toList sy
66 fn (ps, x) => L.mapAppend(ys, fn y => Pair(x, y), ps)))
69 fun project1 s = replace(s,
70 fn Pair(x, _) => SOME x
71 | _ => Error.error "UnorderedUniverse.project1")
72 fun project2 s = replace(s,
73 fn Pair(_, y) => SOME y
74 | _ => Error.error "UnorderedUniverse.project2")
76 fun update (c, x, y) =
77 let fun update[] = [Pair(x, y)]
78 | update((Pair(x', y')) :: ps) =
79 if E.equals(x, x') then (Pair(x, y)) :: ps
80 else (Pair(x', y')) :: (update ps)
81 | update _ = Error.error "UnorderedUniverse.update"
82 in fromList(update(toList c))
85 fun updateSet(c, c') =
87 fn (c, Pair(x, y)) => update(c, x, y)
88 | _ => Error.error "UnorderedUniverse.updateSet")
91 let fun lookup [] = NONE
92 | lookup (Pair(x', y) :: ps) =
93 if E.equals(x, x') then SOME y else lookup ps
94 | lookup _ = Error.error "UnorderedUniverse.lookup"
98 fun Union s = L.foldl(toList s, empty,
99 fn (s', Set s) => s + s'
100 | _ => Error.error "UnorderedUniverse.Union")
101 val Union = Trace.trace("UnorderedUniverse.Union", output, output) Union
103 fun Cross s = listTo(L.map(L.cross(L.map(toList s,
104 toList o Elt.toSet)),