From dc5e7102563b9c0714391f86b6dcf852445ee192 Mon Sep 17 00:00:00 2001
From: Ziv Scully <ziv@mit.edu>
Date: Mon, 10 Nov 2014 22:04:40 -0500
Subject: Progress towards invalidation based on equalities of fields.

---
 src/union_find_fn.sml | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 47 insertions(+)
 create mode 100644 src/union_find_fn.sml

(limited to 'src/union_find_fn.sml')

diff --git a/src/union_find_fn.sml b/src/union_find_fn.sml
new file mode 100644
index 00000000..42b2d4d7
--- /dev/null
+++ b/src/union_find_fn.sml
@@ -0,0 +1,47 @@
+functor UnionFindFn(K : ORD_KEY) = struct
+
+structure M = BinaryMapFn(K)
+structure S = BinarySetFn(K)
+
+datatype entry =
+         Set of S.set
+       | Pointer of K.ord_key
+
+(* First map is the union-find tree, second stores equivalence classes. *)
+type unionFind = entry M.map ref * S.set M.map
+
+val empty : unionFind = (ref M.empty, M.empty)
+
+fun findPair (uf, x) =
+    case M.find (!uf, x) of
+        NONE => (S.singleton x, x)
+      | SOME (Set set) => (set, x)
+      | SOME (Pointer parent) =>
+        let
+            val (set, rep) = findPair (uf, parent)
+        in
+            uf := M.insert (!uf, x, Pointer rep);
+            (set, rep)
+        end
+
+fun find ((uf, _), x) = (S.listItems o #1 o findPair) (uf, x)
+
+fun classes (_, cs) = (map S.listItems o M.listItems) cs
+
+fun union ((uf, cs), x, y) =
+    let
+        val (xSet, xRep) = findPair (uf, x)
+        val (ySet, yRep) = findPair (uf, y)
+        val xySet = S.union (xSet, ySet)
+    in
+        (ref (M.insert (M.insert (!uf, yRep, Pointer xRep),
+                        xRep, Set xySet)),
+         M.insert (case M.find (cs, yRep) of
+                       NONE => cs
+                     | SOME _ => #1 (M.remove (cs, yRep)),
+                   xRep, xySet))
+    end
+
+fun union' ((x, y), uf) = union (uf, x, y)
+
+end
-- 
cgit v1.2.3