/usr/share/gnu-smalltalk/kernel/LookupTable.st is in gnu-smalltalk-common 3.2.5-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 | "======================================================================
|
| LookupTable Method Definitions
|
|
======================================================================"
"======================================================================
|
| Copyright 1999, 2000, 2001, 2002, 2007, 2008
| Free Software Foundation, Inc.
| Written by Steve Byrne and Paolo Bonzini.
|
| This file is part of the GNU Smalltalk class library.
|
| The GNU Smalltalk class library is free software; you can redistribute it
| and/or modify it under the terms of the GNU Lesser General Public License
| as published by the Free Software Foundation; either version 2.1, or (at
| your option) any later version.
|
| The GNU Smalltalk class library is distributed in the hope that it will be
| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
| General Public License for more details.
|
| You should have received a copy of the GNU Lesser General Public License
| along with the GNU Smalltalk class library; see the file COPYING.LIB.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02110-1301, USA.
|
======================================================================"
Dictionary subclass: LookupTable [
<shape: #pointer>
<category: 'Collections-Keyed'>
<comment: 'I am a more efficient variant of Dictionary that cannot be used as a
pool dictionary of variables, as I don''t use Associations to store
key-value pairs. I also cannot have nil as a key; if you need to be
able to store nil as a key, use Dictionary instead. I use the object
equality comparison message #= to determine equivalence of indices.'>
LookupTable class >> primNew: realSize [
<category: 'private-instance creation'>
^self basicNew: realSize * 2
]
LookupTable class >> new [
"Create a new LookupTable with a default size"
<category: 'instance creation'>
^self new: 5
]
add: anAssociation [
"Add the anAssociation key to the receiver"
<category: 'accessing'>
self at: anAssociation key put: anAssociation value.
^anAssociation
]
at: key put: value [
"Store value as associated to the given key"
<category: 'accessing'>
| index |
index := self findIndex: key.
(self primAt: index) isNil
ifTrue:
[self incrementTally ifTrue: [index := self findIndex: key].
self primAt: index put: key].
self valueAt: index put: value.
^value
]
at: key ifAbsent: aBlock [
"Answer the value associated to the given key, or the result of evaluating
aBlock if the key is not found"
<category: 'accessing'>
| index |
index := self findIndexOrNil: key.
^index isNil ifTrue: [aBlock value] ifFalse: [self valueAt: index]
]
at: aKey ifPresent: aBlock [
"If aKey is absent, answer nil. Else, evaluate aBlock passing the
associated value and answer the result of the invocation"
<category: 'accessing'>
| index |
index := self findIndexOrNil: aKey.
^index isNil ifTrue: [nil] ifFalse: [aBlock value: (self valueAt: index)]
]
associationAt: key ifAbsent: aBlock [
"Answer the key/value Association for the given key. Evaluate aBlock
(answering the result) if the key is not found"
<category: 'accessing'>
| index |
index := self findIndexOrNil: key.
^index isNil
ifTrue: [aBlock value]
ifFalse: [Association key: key value: (self valueAt: index)]
]
remove: anAssociation [
"Remove anAssociation's key from the dictionary"
<category: 'removing'>
^anAssociation key -> (self removeKey: anAssociation key)
]
remove: anAssociation ifAbsent: aBlock [
"Remove anAssociation's key from the dictionary"
"Inefficient (has a full block) but it is rarely used."
<category: 'removing'>
^anAssociation key
-> (self removeKey: anAssociation key ifAbsent: [^aBlock value])
]
removeKey: key ifAbsent: aBlock [
"Remove the passed key from the LookupTable, answer the result of
evaluating aBlock if it is not found"
<category: 'removing'>
| index value |
index := self findIndexOrNil: key.
index isNil ifTrue: [^aBlock value].
value := self valueAt: index.
self primAt: index put: nil.
self valueAt: index put: nil.
self decrementTally.
self rehashObjectsAfter: index.
^value
]
associationsDo: aBlock [
"Pass each association in the LookupTable to aBlock."
<category: 'enumerating'>
self
keysAndValuesDo: [:key :val | aBlock value: (Association key: key value: val)]
]
keysDo: aBlock [
"Pass each key in the LookupTable to aBlock."
<category: 'enumerating'>
self beConsistent.
1 to: self primSize
do: [:i | (self primAt: i) notNil ifTrue: [aBlock value: (self primAt: i)]]
]
do: aBlock [
"Pass each value in the LookupTable to aBlock."
<category: 'enumerating'>
self beConsistent.
1 to: self primSize
do: [:i | (self primAt: i) notNil ifTrue: [aBlock value: (self valueAt: i)]]
]
keysAndValuesDo: aBlock [
"Pass each key/value pair in the LookupTable as two distinct parameters
to aBlock."
<category: 'enumerating'>
1 to: self primSize
do:
[:i |
(self primAt: i) notNil
ifTrue: [aBlock value: (self primAt: i) value: (self valueAt: i)]]
]
rehash [
"Rehash the receiver"
<category: 'rehashing'>
| keys values n key |
keys := Array new: self size.
values := Array new: self size.
self resetTally.
n := 0.
1 to: self primSize
do:
[:i |
(key := self primAt: i) isNil
ifFalse:
[keys at: (n := n + 1) put: key.
values at: n put: (self valueAt: i).
self primAt: i put: nil.
self valueAt: i put: nil]].
keys
keysAndValuesDo: [:i :key | self whileGrowingAt: key put: (values at: i)]
]
hash [
"Answer the hash value for the receiver"
<category: 'hashing'>
| hashValue |
hashValue := tally.
self keysAndValuesDo:
[:key :val |
hashValue := hashValue bitXor: (self hashFor: key) scramble.
"hack needed because the Smalltalk dictionary contains itself"
val == self ifFalse: [hashValue := hashValue bitXor: val hash scramble]].
^hashValue
]
storeOn: aStream [
"Print Smalltalk code compiling to the receiver on aStream"
<category: 'storing'>
| hasElements |
aStream nextPutAll: '(' , self class name , ' new'.
hasElements := false.
self keysAndValuesDo:
[:key :value |
aStream
nextPutAll: ' at: ';
store: key;
nextPutAll: ' put: ';
store: value;
nextPut: $;.
hasElements := true].
hasElements ifTrue: [aStream nextPutAll: ' yourself'].
aStream nextPut: $)
]
rehashObjectsAfter: index [
"Rehashes all the objects in the collection after index to see if any of
them hash to index. If so, that object is copied to index, and the
process repeats with that object's index, until a nil is encountered."
<category: 'private methods'>
| i j size count key |
i := index.
size := self primSize.
[i = size ifTrue: [i := 1] ifFalse: [i := i + 1].
key := self primAt: i.
key notNil]
whileTrue:
[self primAt: i put: nil.
j := self findElementIndex: key.
self primAt: j put: key.
j = i ifFalse: [
self valueAt: j put: (self valueAt: i).
self valueAt: i put: nil]]
]
copyAllFrom: aDictionary [
<category: 'private methods'>
| key |
1 to: aDictionary primSize
do:
[:index |
key := aDictionary primAt: index.
key isNil
ifFalse: [self whileGrowingAt: key put: (aDictionary valueAt: index)]].
^self
]
addWhileGrowing: association [
<category: 'private methods'>
self whileGrowingAt: association key put: association value
]
whileGrowingAt: key put: value [
"Private - Add the given key/value pair to the receiver. Don't check for
the LookupTable to be full nor for the key's presence - we want SPEED!"
<category: 'private methods'>
| index |
self primAt: (index := self findElementIndex: key) put: key.
self valueAt: index put: value.
tally := tally + 1.
^value
]
primSize [
<category: 'private methods'>
^self basicSize // 2
]
primAt: index [
<category: 'private methods'>
^self basicAt: index + index - 1
]
primAt: index put: object [
<category: 'private methods'>
^self basicAt: index + index - 1 put: object
]
valueAt: index [
<category: 'private methods'>
^self basicAt: index + index
]
valueAt: index put: object [
<category: 'private methods'>
^self basicAt: index + index put: object
]
hashFor: anObject [
"Return an hash value for the item, anObject"
<category: 'private methods'>
^anObject hash
]
findElementIndex: anObject [
"Tries to see where anObject can be placed as an indexed variable.
As soon as nil is found, the index of that slot is answered.
anObject also comes from an indexed variable."
<category: 'private methods'>
| index size element |
self beConsistent.
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject hash scramble bitAnd: (size := self primSize) - 1) + 1.
[(element := self primAt: index) isNil
ifTrue: [^index].
index == size ifTrue: [index := 1] ifFalse: [index := index + 1]]
repeat
]
findIndex: anObject [
"Tries to see if anObject exists as an indexed variable. As soon as nil
or anObject is found, the index of that slot is answered"
<category: 'private methods'>
| index size element |
self beConsistent.
"Sorry for the lack of readability, but I want speed... :-)"
index := (anObject hash scramble bitAnd: (size := self primSize) - 1) + 1.
[((element := self primAt: index) isNil or: [element = anObject])
ifTrue: [^index].
index == size ifTrue: [index := 1] ifFalse: [index := index + 1]]
repeat
]
]
|