1 (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
3 * Copyright (C) 1997-2000 NEC Research Institute.
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
9 functor EquivalenceGraph (S: EQUIVALENCE_GRAPH_STRUCTS): EQUIVALENCE_GRAPH =
14 structure Set = DisjointSet
15 structure Plist = PropertyList
19 datatype t = T of {plist: Plist.t,
23 fun make sel (T s) = sel (Set.! s)
25 val plist = make #plist
26 val size = make (! o #size)
29 fun setSize (T s, n) = #size (Set.! s) := n
31 fun new (size: int): t =
32 T (Set.singleton {plist = Plist.new (),
35 fun == (c as T s, T s') =
40 val {size = ref n, ...} = Set.! s
41 val {size = ref n', ...} = Set.! s'
48 datatype t = T of {classes: Class.t list ref,
49 edges: (Class.t * Class.t) list ref}
51 fun new () = T {classes = ref [],
54 fun newClass (T {classes, ...}, {size}) =
56 val c = Class.new size
57 val _ = List.push (classes, c)
62 fun addEdge (T {edges, ...}, c, c') =
63 List.push (edges, (c, c'))
65 fun == (_, c, c') = Class.== (c, c')
67 fun coarsen (T {classes, edges, ...}, {maxClassSize}) =
69 (* Combine classes with an edge between them where possible. *)
71 List.foreach (!edges, fn (c, c') =>
72 if Class.size c + Class.size c' <= maxClassSize
75 (* Get a list of all classes without duplicates. *)
77 Property.get (Class.plist, Property.initFun (fn _ => ref false))
80 (!classes, [], fn (class, ac) =>
89 (* Sort classes in decreasing order of size. *)
91 QuickSort.sortList (classes, fn (c, c') =>
92 Class.size c >= Class.size c')
93 (* Combine classes where possible. *)
94 fun loop (cs: Class.t list): unit =
101 (cs, [], fn (c', ac) =>
102 if Class.size c + Class.size c' <= maxClassSize
103 then (Class.== (c, c')
113 structure EquivalenceGraph = EquivalenceGraph ()