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/comp-lib/intstrmap.sml
ViewVC logotype

Annotation of /sml/trunk/src/comp-lib/intstrmap.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 411 - (view) (download)
Original Path: sml/branches/FLINT/src/comp-lib/intstrmap.sml

1 : monnier 245 (* Copyright 1989 by AT&T Bell Laboratories *)
2 :     structure IntStrMap : INTSTRMAP =
3 :     struct
4 :     open Array List
5 :     infix 9 sub
6 :     val itow = Word.fromInt
7 :     val wtoi = Word.toIntX
8 : monnier 411 datatype 'a bucket = NIL | B of (word * string * 'a * 'a bucket)
9 : monnier 245 datatype 'a intstrmap =
10 :     H of {table: 'a bucket array ref,elems: int ref,exn: exn,name: string option}
11 :     fun bucketapp f =
12 :     let fun loop NIL = ()
13 :     | loop(B(i,s,j,r)) = (f(i,s,j); loop r)
14 :     in loop
15 :     end
16 :     fun roundsize size =
17 :     let fun f x = if x >= size then x else f (x*2)
18 :     in f 1
19 :     end
20 :     fun namednew(name, size, exn) =
21 :     H {table=ref(array(roundsize size,NIL)),elems=ref 0,exn=exn,
22 :     name=SOME name}
23 :     fun new(size, exn) =
24 :     H {table=ref(array(roundsize size,NIL)),elems=ref 0,exn=exn,name=NONE}
25 :     val elems = fn (H{elems,...}) => !elems
26 : monnier 411 fun index(a, i) = wtoi (Word.andb(i, itow(Array.length a - 1)))
27 : monnier 245 fun map (H{table,exn,...}) =
28 :     let fun find(i,s,NIL) = raise exn
29 :     | find(i,s,B(i',s',j,r)) = if i=i' andalso s=s' then j else find(i,s,r)
30 :     fun map' (i,s) = let val ref a = table
31 :     in find (i,s,a sub (index(a, i)))
32 :     end
33 :     in map'
34 :     end
35 :     fun rmv (H{table=ref a,elems,...}) (i,s) =
36 :     let fun f(B(i',s',j,r)) =
37 :     if i=i' andalso s=s' then (elems := !elems-1; r) else B(i',s',j,f r)
38 :     | f x = x
39 :     val indx = index(a, i)
40 :     in update(a, indx, f(a sub indx))
41 :     end
42 :     fun app f (H{table=ref a,...}) =
43 :     let fun zap 0 = ()
44 :     | zap n = let val m = n-1 in bucketapp f (a sub m); zap m end
45 :     in zap(Array.length a)
46 :     end
47 :     fun add (m as H{table as ref a, elems, name, ...}) (v as (i,s,j)) =
48 :     let val size = Array.length a
49 :     in if !elems <> size
50 : monnier 411 then let val index = wtoi (Word.andb(i, itow(size-1)))
51 : monnier 245 fun f(B(i',s',j',r)) =
52 :     if i=i' andalso s=s' then B(i,s,j,r) else B(i',s',j',f r)
53 :     | f x = (elems := !elems+1; B(i,s,j,x))
54 :     in update(a,index,f(a sub index))
55 :     end
56 :     else let val newsize = size+size
57 :     val newsize1 = newsize-1
58 :     val new = array(newsize,NIL)
59 :     fun bucket n =
60 :     let fun add'(a,b,B(i,s,j,r)) =
61 : monnier 411 if wtoi (Word.andb(i, itow newsize1)) = n
62 : monnier 245 then add'(B(i,s,j,a),b,r)
63 :     else add'(a,B(i,s,j,b),r)
64 :     | add'(a,b,NIL) =
65 :     (update(new,n,a);
66 :     update(new,n+size,b);
67 :     bucket(n+1))
68 :     in add'(NIL,NIL,a sub n)
69 :     end
70 :     in
71 :     bucket 0 handle Subscript => ();
72 :     table := new;
73 :     add m v
74 :     end
75 :     end
76 :     fun intStrMapToList(H{table,...})=
77 :     let val a = !table;
78 :     val last = Array.length a - 1
79 :     fun loop (0, NIL, acc) = acc
80 :     | loop (n, B(i,s,j,r), acc) = loop(n, r, (i,s,j)::acc)
81 :     | loop (n, NIL, acc) = loop(n-1, a sub (n-1), acc)
82 :     in loop(last,a sub last,[])
83 :     end
84 :     fun transform (f:'a -> 'b) (H{table=ref a, elems=ref n, exn, name}) =
85 :     let val newa = array(Array.length a,NIL)
86 :     fun mapbucket NIL = NIL
87 :     | mapbucket(B(i,s,x,b)) = B(i,s,f x,mapbucket b)
88 :     fun loop i = (update(newa,i,mapbucket(a sub i)); loop(i+1))
89 :     in loop 0 handle Subscript => ();
90 :     H{table=ref newa, elems=ref n, exn=exn, name=name}
91 :     end
92 :     end
93 :    
94 :     (*
95 : monnier 411 * $Log: intstrmap.sml,v $
96 :     * Revision 1.1.1.1 1998/04/08 18:39:14 george
97 :     * Version 110.5
98 :     *
99 : monnier 245 *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0