Home My Page Projects Code Snippets Project Openings SML/NJ
 Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

# SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/MiscUtil/util/union.sml
 [smlnj] / sml / trunk / src / compiler / MiscUtil / util / union.sml

# Annotation of /sml/trunk/src/compiler/MiscUtil/util/union.sml

Original Path: sml/branches/SMLNJ/src/compiler/MiscUtil/util/union.sml

 1 : monnier 245 (* Copyright 1989 by AT&T Bell Laboratories *) 2 : signature UNIONFIND = 3 : sig 4 : exception Union 5 : val new : (int -> bool) -> 6 : {union: int * int -> int, 7 : find : int -> int} 8 : end 9 : 10 : 11 : structure Unionfind : UNIONFIND = 12 : struct 13 : exception Union 14 : fun new (fixed) = 15 : let open Intmap (* locally rebinding new, of course! *) 16 : exception UnionM and UnionN 17 : val m = new(32, UnionM) : int intmap 18 : fun find x = 19 : let val z = find(map m x) 20 : in add m (x,z); z 21 : end 22 : handle UnionM => x 23 : fun union (x,y) = 24 : let val x' = find x and y' = find y 25 : in if x' <> y' 26 : then if fixed(x') 27 : then if fixed(y') 28 : then raise Union 29 : else (add m (y', x'); x') 30 : else if fixed(y') 31 : then (add m (x', y'); y') 32 : else if y' < x' 33 : then (add m (x', y'); y') 34 : else (add m (y', x'); x') 35 : else x' 36 : end 37 : in {union=union, find=find} 38 : end 39 : end 40 : 41 : 42 : signature SIBLINGS = 43 : sig 44 : type 't siblingClass 45 : val new : (int -> bool) -> '1t siblingClass 46 : (* assoc(i,x) must be called for any element i before 47 : i is used as an argument to union or find or getassoc *) 48 : end 49 : 50 : 51 : structure Siblings : SIBLINGS = 52 : struct 53 : type 't siblingClass = 54 : {assoc : int * 't -> unit, 55 : union : int * int -> int, 56 : find : int -> int, 57 : getassoc : int -> 't list} 58 : fun new(fixed: int -> bool) : '1t siblingClass = 59 : let val {union = uni, find = find} = Unionfind.new(fixed) 60 : exception UnionA 61 : val a = Intmap.new(32, UnionA) : ('1t * int list) Intmap.intmap 62 : val add = Intmap.add a 63 : val map = Intmap.map a 64 : fun assoc (i,x) = 65 : let val (_,l) = map i handle UnionA => (x,nil) 66 : in add (i,(x,l)) 67 : end 68 : fun join(i,j) = 69 : let val (x,l) = map j 70 : in add (j,(x,i::l)); j 71 : end 72 : fun union (i,j) = 73 : let val i' = find i and j' = find j 74 : in if i' = j' then i' 75 : else let val k = uni(i',j') 76 : in if k=i' then join(j',k) else join(i',k) 77 : end 78 : end 79 : fun get(i,l) = 80 : let fun f (a::b) = get(a,f(b)) | f nil = l 81 : val (x,r) = map i 82 : in x::f(r) 83 : end 84 : fun getassoc i = get(find i,nil) 85 : in {assoc=assoc, union=union, find=find, getassoc=getassoc} 86 : end 87 : end (* structure Siblings *) 88 : 89 : 90 : (* 91 : * \$Log\$ 92 : *)