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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 651 - (view) (download)

1 : monnier 411 (*
2 :     * Bag datatype that uses hashing
3 :     *
4 :     * -- Allen
5 :     *)
6 :    
7 : monnier 245 structure HashBag :> HASH_BAG =
8 :     struct
9 :    
10 :     structure S = HashMap
11 :    
12 :     type 'a bag = ('a,int) S.map * int ref
13 :    
14 :     fun create x n = (S.create x n, ref 0)
15 :    
16 :     fun insert (bag,c) i =
17 :     (S.update bag ((i,1),fn x => x + 1); c := !c + 1)
18 :    
19 :     fun insertN (bag,c) (i,n:int) =
20 :     (S.update bag ((i,n),fn x => x + n); c := !c + n)
21 :    
22 :     fun size (_,c) = !c
23 :    
24 :     fun bucketSize (bag,_) = S.bucketSize bag
25 :    
26 :     fun isEmpty (_,c) = !c = 0
27 :    
28 :     fun remove (bag,c) i =
29 :     let val x = S.lookupOrElse bag 0 i
30 :     in if x > 0 then (S.insert bag (i,x-1); c := !c - 1) else ()
31 :     end
32 :    
33 :     fun removeN (bag,c) (i,n) =
34 :     let val x = S.lookupOrElse bag 0 i
35 :     in if x > n then (S.insert bag (i,x-n); c := !c - n)
36 :     else (c := !c - Int.min(x,n); S.remove bag i)
37 :     end
38 :    
39 :     fun removeAll (bag,c) i = S.remove bag i
40 :    
41 :     fun toList (bag,_) = S.toList bag
42 :    
43 :     fun clear (bag,c) = (S.clear bag; c := 0)
44 :    
45 :     fun contains (bag,_) i = S.contains bag i
46 :    
47 :     fun count (bag,_) i = S.lookupOrElse bag 0 i
48 :    
49 :     fun app f (bag,_) = S.app f bag
50 :    
51 :     fun dupApp f (bag,_) =
52 :     let fun f' (x,0) = ()
53 :     | f' (x,n) = (f x; f'(x,n-1))
54 :     in
55 :     S.app f' bag
56 :     end
57 :    
58 :     fun fold f x (bag,_) = S.fold f x bag
59 :    
60 :     fun dupFold f x (bag,_) =
61 :     let fun f' ((x,0),l) = l
62 :     | f' ((x,n),l) = f'((x,n-1),f(x,l))
63 :     in S.fold f' x bag
64 :     end
65 :    
66 :     fun toDupList bag = dupFold (op::) [] bag
67 :    
68 :     fun toString str bag =
69 :     "{" ^ dupFold (fn (x,"") => str x
70 :     | (x,l) => str x ^ ", " ^ l) "" bag ^ "}"
71 :     end
72 :    

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