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 /MLRISC/releases/release-110.60/library/hashBag.sml
ViewVC logotype

Annotation of /MLRISC/releases/release-110.60/library/hashBag.sml

Parent Directory Parent Directory | Revision Log Revision Log


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

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

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