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

SCM Repository

[smlnj] View of /sml/trunk/src/compiler/MiscUtil/util/union.sml
ViewVC logotype

View of /sml/trunk/src/compiler/MiscUtil/util/union.sml

Parent Directory Parent Directory | Revision Log Revision Log

Revision 246 - (download) (annotate)
Sat Apr 17 18:47:12 1999 UTC (21 years, 5 months ago) by monnier
File size: 2266 byte(s)
This commit was generated by cvs2svn to compensate for changes in r245,
which included commits to RCS files with non-trunk default branches.
(* Copyright 1989 by AT&T Bell Laboratories *)
signature UNIONFIND =
    exception Union
    val new : (int -> bool) ->
	      {union: int * int -> int,
	       find : int -> int}

structure Unionfind : UNIONFIND =
    exception Union
    fun new (fixed) =
	let open Intmap (* locally rebinding new, of course! *)
	    exception UnionM and UnionN
	    val m = new(32, UnionM) : int intmap
	    fun find x = 
		 let val z = find(map m x)
		  in add m (x,z); z
		 handle UnionM => x
	    fun union (x,y) =
		let val x' = find x and y' = find y
		 in if x' <> y'
		    then if fixed(x')
			 then if fixed(y')
			      then raise Union
			      else (add m (y', x'); x')
			 else if fixed(y')
			      then (add m (x', y'); y')
			      else if y' < x'			      
			      then (add m (x', y'); y')
			      else (add m (y', x'); x')
		    else x'
	 in {union=union, find=find}

signature SIBLINGS =
    type 't siblingClass
    val new : (int -> bool) -> '1t siblingClass
     (* assoc(i,x) must be called for any element i before 
        i is used as an argument to union or find or getassoc *)

structure Siblings : SIBLINGS =
    type 't siblingClass =
	      {assoc : int * 't -> unit,
	       union : int * int -> int,
               find : int -> int,
	       getassoc : int -> 't list}
    fun new(fixed: int -> bool) : '1t siblingClass =
	let val {union = uni, find = find} = Unionfind.new(fixed)
	    exception UnionA
	    val a = Intmap.new(32, UnionA) : ('1t * int list) Intmap.intmap
	    val add = Intmap.add a
	    val map = Intmap.map a
	    fun assoc (i,x) = 
		let val (_,l) = map i handle UnionA => (x,nil)
		 in add (i,(x,l))
	    fun join(i,j) =
	      let val (x,l) = map j
	       in add (j,(x,i::l)); j
	    fun union (i,j) = 
		let val i' = find i and j' = find j
		 in if i' = j' then i'
		    else let val k = uni(i',j')
			  in if k=i' then join(j',k) else join(i',k)
	    fun get(i,l) = 
	       let fun f (a::b) = get(a,f(b)) | f nil = l
		   val (x,r) = map i
		in x::f(r)
	    fun getassoc i = get(find i,nil)
	 in {assoc=assoc, union=union, find=find, getassoc=getassoc}
  end (* structure Siblings *)

 * $Log$

ViewVC Help
Powered by ViewVC 1.0.0