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/intmap.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


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

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

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