1 (* Copyright (C
) 2009 Matthew Fluet
.
2 * Copyright (C
) 1999-2006, 2008 Henry Cejtin
, Matthew Fluet
, Suresh
3 * Jagannathan
, and Stephen Weeks
.
5 * MLton is released under a BSD
-style license
.
6 * See the file MLton
-LICENSE for details
.
9 structure HashSet
: HASH_SET
=
13 T
of {buckets
: 'a list array ref
,
18 fun 'a newWithBuckets
{hash
, numBuckets
: int}: 'a t
=
20 val mask
: word = Word.fromInt numBuckets
- 0w1
22 T
{buckets
= ref (Array
.new (numBuckets
, [])),
28 val initialSize
: int = Int.pow (2, 6)
30 fun new
{hash
} = newWithBuckets
{hash
= hash
,
31 numBuckets
= initialSize
}
33 fun newOfSize
{hash
, size
} =
34 newWithBuckets
{hash
= hash
,
35 numBuckets
= 4 * Int.roundUpToPowerOfTwo size
}
37 fun size (T
{numItems
, ...}) = !numItems
39 fun index (w
: word, mask
: word): int =
40 Word.toInt (Word.andb (w
, mask
))
42 val numPeeks
: Int64
.int ref
= ref
0
43 val numLinks
: Int64
.int ref
= ref
0
48 [seq
[str
"hash set numPeeks = ", str (Int64
.toString (!numPeeks
))],
49 (* seq
[str
"hash set numLinks = ", str (Int64
.toString (!numLinks
))], *)
50 seq
[str
"hash set average position = ",
52 val fromInt
= fromIntInf
o Int64
.toLarge
53 in format (fromInt (!numLinks
) / fromInt (!numPeeks
),
58 fun stats
' (T
{buckets
, numItems
, ...}) =
61 val numb
= Array
.length (!buckets
)
63 val avg
= let open Real in (fromInt numi
/ fromInt numb
) end
68 fn (l
,(min
,max
,total
))
71 val d
= (Real.fromInt n
) - avg
73 (SOME (Option
.fold(min
,n
,Int.min
)),
74 SOME (Option
.fold(max
,n
,Int.max
)),
77 val stdd
= let open Real in Math
.sqrt(total
/ (fromInt numb
')) end
78 val rfmt
= fn r
=> Real.format (r
, Real.Format
.fix (SOME
3))
80 [seq
[str
"numItems = ", Int.layout numi
],
81 seq
[str
"numBuckets = ", Int.layout numb
],
82 seq
[str
"avg = ", str (rfmt avg
),
83 str
" stdd = ", str (rfmt stdd
),
84 str
" min = ", Option
.layout
Int.layout min
,
85 str
" max = ", Option
.layout
Int.layout max
]]
88 fun resize (T
{buckets
, hash
, mask
, ...}, size
: int, newMask
: word): unit
=
90 val newBuckets
= Array
.new (size
, [])
91 in Array
.foreach (!buckets
, fn r
=>
92 List.foreach (r
, fn a
=>
93 let val j
= index (hash a
, newMask
)
96 a
:: Array
.sub (newBuckets
, j
))
98 ; buckets
:= newBuckets
102 fun maybeGrow (s
as T
{buckets
, mask
, numItems
, ...}): unit
=
104 val n
= Array
.length (!buckets
)
105 in if !numItems
* 4 > n
108 (* The new mask depends on growFactor being
2. *)
109 Word.orb (0w1
, Word.<< (!mask
, 0w1
)))
113 fun removeAll (T
{buckets
, numItems
, ...}, p
) =
114 Array
.modify (!buckets
, fn elts
=>
115 List.fold (elts
, [], fn (a
, ac
) =>
117 then (Int.dec numItems
; ac
)
120 fun remove (T
{buckets
, mask
, numItems
, ...}, w
, p
) =
122 val i
= index (w
, !mask
)
124 val _
= Array
.update (b
, i
, List.removeFirst (Array
.sub (b
, i
), p
))
125 val _
= Int.dec numItems
130 fun peekGen (T
{buckets
= ref buckets
, mask
, ...}, w
, p
, no
, yes
) =
133 numPeeks
:= 1 + !numPeeks
134 handle Overflow
=> Error
.bug
"HashSet: numPeeks overflow"
135 val j
= index (w
, !mask
)
136 val b
= Array
.sub (buckets
, j
)
138 numLinks
:= !numLinks
+ 1
139 handle Overflow
=> Error
.bug
"HashSet: numLinks overflow"
140 in case List.peek (b
, fn a
=> (update (); p a
)) of
145 fun peek (t
, w
, p
) = peekGen (t
, w
, p
, fn _
=> NONE
, SOME
)
147 (* fun update (T
{buckets
= ref buckets
, equals
, hash
, mask
, ...}, a
) =
149 * val j
= index (hash a
, !mask
)
151 * Array
.update (buckets
, j
,
152 * a
:: (List.remove (Array
.sub (buckets
, j
),
153 * fn a
' => equals (a
, a
'))))
158 fun insertIfNew (table
as T
{buckets
, numItems
, ...}, w
, p
, f
,
163 val _
= Int.inc numItems
164 val _
= Array
.update (!buckets
, j
, a
:: b
)
165 val _
= maybeGrow table
169 in peekGen (table
, w
, p
, no
, yes
)
172 fun lookupOrInsert (table
, w
, p
, f
) =
173 insertIfNew (table
, w
, p
, f
, ignore
)
175 fun fold (T
{buckets
, ...}, b
, f
) =
176 Array
.fold (!buckets
, b
, fn (r
, b
) => List.fold (r
, b
, f
))
179 structure F
= Fold (type 'a t
= 'a t
184 val foreach
= foreach
187 fun forall (T
{buckets
, ...}, f
) =
188 Array
.forall (!buckets
, fn r
=> List.forall (r
, f
))
190 fun toList t
= fold (t
, [], fn (a
, l
) => a
:: l
)
192 fun layout lay t
= List.layout
lay (toList t
)
194 fun fromList (l
, {hash
, equals
}) =
196 val s
= new
{hash
= hash
}
198 List.foreach (l
, fn a
=>
199 ignore (lookupOrInsert (s
, hash a
,
200 fn b
=> equals (a
, b
),