1 (* Copyright (C
) 2004-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
.
8 structure Equatable
: EQUATABLE
=
11 structure Set
= DisjointSet
15 | Uncomputed
of {compute
: unit
-> 'a
,
16 whenComputed
: ('a
-> unit
) AppendList
.t ref
}
18 datatype 'a t
= T
of 'a delay Set
.t
23 | Uncomputed _
=> Layout
.str
"<uncomputed>"
26 T (Set
.singleton (Uncomputed
{compute
= f
,
27 whenComputed
= ref AppendList
.empty
}))
29 fun new a
= T (Set
.singleton (Computed a
))
31 fun equals (T s
, T s
') = Set
.equals (s
, s
')
36 | Uncomputed
{compute
, whenComputed
} =>
39 val () = Set
.:= (s
, Computed a
)
40 val () = AppendList
.foreach (!whenComputed
, fn f
=> f a
)
45 fun equate (T s
, T s
', combine
) =
52 val () = Set
.union (s
, s
')
53 fun one (a
, {compute
= _
, whenComputed
}) =
54 (* Must set the value
before calling the whenComputed
, because
55 * those may look at the
value (which would cause it to be set
,
56 * which would
then be overwritten
).
58 (Set
.:= (s
, Computed a
)
59 ; AppendList
.foreach (!whenComputed
, fn f
=> f a
))
62 (Computed a
, Computed a
') =>
63 Set
.:= (s
, Computed (combine (a
, a
')))
64 |
(Computed a
, Uncomputed u
) => one (a
, u
)
65 |
(Uncomputed u
, Computed a
) => one (a
, u
)
66 |
(Uncomputed
{compute
, whenComputed
= w
},
67 Uncomputed
{whenComputed
= w
', ...}) =>
69 (s
, Uncomputed
{compute
= compute
,
70 whenComputed
= ref (AppendList
.append (!w
, !w
'))})
73 fun whenComputed (T s
, f
): unit
=
76 | Uncomputed
{whenComputed
= w
, ...} => AppendList
.push (w
, f
)