Return to intstrmap.sml CVS log

Up to [Research Unix] / researchv10no / cmd / sml / src / util

Annotation of researchv10no/cmd/sml/src/util/intstrmap.sml, revision 1.1

1.1     ! root        1: (* Copyright 1989 by AT&T Bell Laboratories *)
        !             2: structure IntStrMap : INTSTRMAP =
        !             3: struct
        !             4:   datatype 'a bucket = NIL | B of (int * string * 'a * 'a bucket)
        !             5:   datatype 'a intstrmap =
        !             6:     H of {table: 'a bucket array ref,elems: int ref,exn: exn,name: string option}
        !             7:   fun bucketapp f =
        !             8:       let fun loop NIL = ()
        !             9:            | loop(B(i,s,j,r)) = (f(i,s,j); loop r)
        !            10:       in loop
        !            11:       end
        !            12:   fun namednew(name, size, exn) =
        !            13:       H {table=ref(array(size,NIL)),elems=ref 0,exn=exn,name=SOME name}
        !            14:   fun new(size, exn) =
        !            15:       H {table=ref(array(size,NIL)),elems=ref 0,exn=exn,name=NONE}
        !            16:   fun map (H{table,exn,...}) =
        !            17:       let fun find(i,s,NIL) = raise exn
        !            18:             | find(i,s,B(i',s',j,r)) = if i=i' andalso s=s' then j else find(i,s,r)
        !            19:          fun map' (i,s) = let val ref a = table
        !            20:                           in find (i,s,a sub Bits.andb(i,(Array.length a)-1))
        !            21:                           end
        !            22:       in map'
        !            23:       end
        !            24:   fun rem (H{table=ref a,elems,...}) (i,s) =
        !            25:       let fun f(B(i',s',j,r)) =
        !            26:                if i=i' andalso s=s' then (dec elems; r) else B(i',s',j,f r)
        !            27:            | f x = x
        !            28:          val index = Bits.andb(i,(Array.length a)-1)
        !            29:       in  update(a, index, f(a sub index))
        !            30:       end
        !            31:   fun app f (H{table=ref a,...}) =
        !            32:       let fun zap 0 = ()
        !            33:            | zap n = let val m = n-1 in bucketapp f (a sub m); zap m end
        !            34:       in  zap(Array.length a)
        !            35:       end
        !            36:   fun add (m as H{table as ref a, elems, name, ...}) (v as (i,s,j)) =
        !            37:       let val size = Array.length a
        !            38:        in if !elems <> size
        !            39:          then let val index = Bits.andb(i, size-1)
        !            40:                   fun f(B(i',s',j',r)) =
        !            41:                         if i=i' andalso s=s' then B(i,s,j,r) else B(i',s',j',f r)
        !            42:                     | f x = (inc elems; B(i,s,j,x))
        !            43:               in update(a,index,f(a sub index))
        !            44:               end
        !            45:          else let val newsize = size+size
        !            46:                   val newsize1 = newsize-1
        !            47:                   val new = array(newsize,NIL)
        !            48:                   fun bucket n =
        !            49:                       let fun add'(a,b,B(i,s,j,r)) =
        !            50:                               if Bits.andb(i,newsize1) = n
        !            51:                               then add'(B(i,s,j,a),b,r)
        !            52:                               else add'(a,B(i,s,j,b),r)
        !            53:                             | add'(a,b,NIL) = 
        !            54:                               (update(new,n,a);
        !            55:                                update(new,n+size,b);
        !            56:                                bucket(n+1))
        !            57:                       in add'(NIL,NIL,a sub n)
        !            58:                       end
        !            59:               in (case name of
        !            60:                     NONE => ()
        !            61:                   | SOME name =>
        !            62:                     (print("\nIncreasing size of intmap " ^ name ^ " to: ");
        !            63:                      print newsize; print "\n"; ()));
        !            64:                  bucket 0 handle Subscript => ();
        !            65:                  table := new;
        !            66:                  add m v
        !            67:               end
        !            68:       end
        !            69:   fun intStrMapToList(H{table,...})=
        !            70:       let val a = !table;
        !            71:          val last = Array.length a - 1
        !            72:          fun loop (0, NIL, acc) = acc
        !            73:          |   loop (n, B(i,s,j,r), acc) = loop(n, r, (i,s,j)::acc)
        !            74:          |   loop (n, NIL, acc) = loop(n-1, a sub (n-1), acc)
        !            75:        in loop(last,a sub last,[])
        !            76:       end
        !            77:   fun transform (f:'a -> '2b) (H{table=ref a, elems=ref n, exn, name}) =
        !            78:       let val newa = array(Array.length a,NIL)
        !            79:          fun mapbucket NIL = NIL
        !            80:            | mapbucket(B(i,s,x,b)) = B(i,s,f x,mapbucket b)
        !            81:          fun loop i = (update(newa,i,mapbucket(a sub i)); loop(i+1))
        !            82:        in loop 0 handle Subscript => ();
        !            83:          H{table=ref newa, elems=ref n, exn=exn, name=name}
        !            84:       end
        !            85: end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.