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/MLRISC/library/hashMultimap.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/library/hashMultimap.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 411 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/library/hashMultimap.sml

1 : monnier 411 (*
2 :     * Multimap datatype that uses hashing.
3 :     *
4 :     * -- allen
5 :     *)
6 :    
7 : monnier 245 structure HashMultimap :> HASH_MULTIMAP =
8 :     struct
9 :    
10 :     structure S = HashMap
11 :    
12 :     type ('a,'b) multimap = ('a,'b list) S.map * int ref
13 :    
14 :    
15 :     fun create x n = (S.create x n, ref 0)
16 :    
17 :     fun size (_,c) = !c
18 :     fun bucketSize (m,_) = S.bucketSize m
19 :     fun isEmpty (_,c) = !c = 0
20 :    
21 :     fun insert (m,c) (e as (x,y)) =
22 :     (S.update m ((x,[y]),fn ys => y::ys); c := !c + 1)
23 :    
24 :     fun removeAll (m,c) i =
25 :     let val stuff = S.lookup m i
26 :     in S.remove m i; c := !c - length stuff
27 :     end handle _ => ()
28 :    
29 :     fun update (m,c) (e as (x,ys)) =
30 :     let val stuff = S.lookupOrElse m [] x
31 :     in S.insert m e; c := !c - length stuff + length ys
32 :     end
33 :    
34 :     fun lookup (m,_) i = S.lookup m i
35 :    
36 :     fun contains (m,_) i = S.contains m i
37 :    
38 :     fun count (m,_) i = length(S.lookupOrElse m [] i)
39 :    
40 :     fun toList (m,_) = S.toList m
41 :    
42 :     fun toDupList (m,_) =
43 :     let fun collect (x,[],l) = l
44 :     | collect (x,h::t,l) = (x,h)::collect(x,t,l)
45 :     in
46 :     S.fold (fn ((x,ys),l) => collect (x,ys,l)) [] m
47 :     end
48 :    
49 :     fun clear (m,c) = (S.clear m; c := 0)
50 :    
51 :     fun dupApp f (m,_) =
52 :     let fun call (x,[]) = ()
53 :     | call (x,h::t) = (f(x,h); call(x,t))
54 :     in
55 :     S.app call m
56 :     end
57 :    
58 :     fun app f (m,_) = S.app f m
59 :    
60 :     fun dupFold f x (m,_) =
61 :     let fun collect((x,[]),l) = l
62 :     | collect((x,h::t),l) = collect((x,t),f((x,h),l))
63 :     in
64 :     S.fold collect x m
65 :     end
66 :    
67 :     fun fold f x (m,_) = S.fold f x m
68 :    
69 :     fun toString (f,g) m =
70 :     "{" ^
71 :     dupFold (fn ((x,y),"") => "(" ^ f x ^ ", " ^ g y ^ ")"
72 :     | ((x,y),l) => "(" ^ f x ^ ", " ^ g y ^ "), " ^ l)
73 :     "" m ^ "}"
74 :    
75 :     end
76 :    

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