home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / 93src.lha / src / util / intmap.sml < prev    next >
Encoding:
Text File  |  1993-01-27  |  2.7 KB  |  83 lines
  1. (* Copyright 1989 by AT&T Bell Laboratories *)
  2. structure Intmap : INTMAP =
  3. struct
  4.   open Array List
  5.   infix 9 sub
  6.   datatype 'a bucket = NIL | B of (int * 'a * 'a bucket)
  7.   datatype 'a intmap =
  8.     H of {table: 'a bucket array ref,elems: int ref,exn: exn,name: string option}
  9.   fun clear(H{table,elems,...}) = (table := array(32,NIL); elems := 0)
  10.   fun bucketapp f =
  11.       let fun loop NIL = ()
  12.         | loop(B(i,j,r)) = (f(i,j); loop r)
  13.       in loop
  14.       end
  15.   fun roundsize size = 
  16.       let fun f x = if x >= size then x else f (x*2)
  17.       in f 1
  18.       end
  19.   fun namednew(name, size, exn) =
  20.       H {table=ref(array(roundsize size,NIL)),elems=ref 0,exn=exn,name=SOME name}
  21.   fun new(size, exn) =
  22.       H {table=ref(array(roundsize size,NIL)),elems=ref 0,exn=exn,name=NONE}
  23.   val elems = fn (H{elems,...}) => !elems
  24.   fun map (H{table,exn,...}) =
  25.       (fn i => let fun find NIL = raise exn
  26.              | find(B(i',j,r)) = if i=i' then j else find r
  27.            val ref a = table
  28.            in find(a sub Bits.andb(i,(Array.length a)-1))
  29.            end)
  30.   fun rmv (H{table=ref a,elems,...}) i =
  31.       let fun f(B(i',j,r)) = if i=i' then (dec elems; r) else B(i',j,f r)
  32.         | f x = x
  33.       val index = Bits.andb(i,(Array.length a)-1)
  34.       in update(a, index, f(a sub index))
  35.       end
  36.   fun app f (H{table=ref a,...}) =
  37.       let fun zap 0 = ()
  38.         | zap n = let val m = n-1 in bucketapp f (a sub m); zap m end
  39.       in  zap(Array.length a)
  40.       end
  41.   fun add (m as H{table as ref a, elems, name, ...}) (v as (i,j)) =
  42.     let val size = Array.length a
  43.     in if !elems <> size
  44.        then let val index = Bits.andb(i, size-1)
  45.             fun f(B(i',j',r)) = if i=i' then B(i,j,r) else B(i',j',f r)
  46.           | f x = (inc elems; B(i,j,x))
  47.         in update(a,index,f(a sub index))
  48.         end
  49.        else let val newsize = size+size
  50.             val newsize1 = newsize-1
  51.             val new = array(newsize,NIL)
  52.         fun bucket n =
  53.             let fun add'(a,b,B(i,j,r)) =
  54.                     if Bits.andb(i,newsize1) = n
  55.                     then add'(B(i,j,a),b,r)
  56.                     else add'(a,B(i,j,b),r)
  57.                   | add'(a,b,NIL) = 
  58.                     (update(new,n,a);
  59.                  update(new,n+size,b);
  60.                  bucket(n+1))
  61.             in add'(NIL,NIL,a sub n)
  62.             end
  63.         in (case name
  64.          of NONE => ()
  65.               | SOME name =>
  66.               List.app System.Print.say
  67.                 ["\nIncreasing size of intmap ", name, " to: ",
  68.                  makestring newsize, "\n"]);
  69.            bucket 0 handle Subscript => ();
  70.            table := new;
  71.            add m v
  72.         end
  73.     end
  74.   fun intMapToList(H{table,...})=
  75.      let val a = !table;
  76.      val last = Array.length a - 1
  77.          fun loop (0, NIL, acc) = acc
  78.          |   loop (n, B(i,j,r), acc) = loop(n, r, (i,j)::acc)
  79.          |   loop (n, NIL, acc) = loop(n-1, a sub (n-1), acc)
  80.       in loop(last,a sub last,[])
  81.      end
  82. end
  83.