'From Squeak3.9 of 7 November 2006 [latest update: #7067] on 28 March 2007 at 12:06:20 pm'!
"Change Set:		weakfix1
Date:			18 March 2007
Author:			Martin v. Loewis

Part 1 of WeakKeyDictionary rewrite.

Add all new selectors.
Add WeakKeyAssociation2, and rename it later to WeakKeyAssociation.
Add expired counter to WeakKeyDictionary, and set it to 0 later.
"!

Magnitude weakSubclass: #WeakKeyAssociation2
	instanceVariableNames: 'value'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Support'!

!WeakKeyAssociation2 commentStamp: 'mvl 3/11/2007 20:04' prior: 0!
I am an association holding only weakly on my key.!

Dictionary subclass: #WeakKeyDictionary
	instanceVariableNames: 'expired'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Weak'!

!WeakKeyDictionary commentStamp: 'mvl 3/18/2007 08:48' prior: 0!
I am a dictionary holding only weakly on my keys. This is a bit dangerous since at any time my keys can go away. Clients are responsible to register my instances by WeakArray such that the appropriate actions can be taken upon loss of any keys. As key may disappear at any time, my reported size may be greater than the number of keys encountered in iterations.

See WeakRegistry for an example of use.

Implementation notes:

I am a set of WeakAssociations. Each WeakAssociation can be in one of three states: a key is present, or the key has been garbage-collected, or the association is expired (meaning that the value has also been released). During finalization, associations with no key expire, but I still keep them to avoid rehashing the entire set. When adding a new entry, the new entry can either go into a slot that is nil, or one that has an expired association. I keep a count of expired associations and rehash when there are too many (currently, if they account for more than 25% of the space).!

ClassTestCase subclass: #WeakKeyDictionaryTest
	instanceVariableNames: 'keys dict'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'CollectionsTests-Weak'!

!WeakKeyAssociation2 methodsFor: 'comparing' stamp: 'mvl 3/11/2007 20:11'!
< aLookupKey 
	"Refer to the comment in Magnitude|<."

	^self key < aLookupKey key! !

!WeakKeyAssociation2 methodsFor: 'comparing' stamp: 'mvl 3/11/2007 20:55'!
= aLookupKey

	"XXX why doesn't this consider the value? mvl"

	self species = aLookupKey species
		ifTrue: [^self key = aLookupKey key]
		ifFalse: [^false]! !

!WeakKeyAssociation2 methodsFor: 'comparing' stamp: 'mvl 3/11/2007 20:54'!
hash
	"Hash is reimplemented because = is implemented."

	^self key hash! !

!WeakKeyAssociation2 methodsFor: 'accessing' stamp: 'mvl 3/16/2007 00:00'!
expire
    "Release the value if the key has gone. Return true if a modification was made."
	(self basicAt: 1) ifNil:[
		value == self ifTrue:[^false].
		value := self.
		^true
	].
	^false! !

!WeakKeyAssociation2 methodsFor: 'accessing' stamp: 'mvl 3/11/2007 22:44'!
expired
	^value == self! !

!WeakKeyAssociation2 methodsFor: 'accessing' stamp: 'mvl 3/11/2007 20:08'!
key
	"Answer the lookup key of the receiver."

	^self basicAt: 1! !

!WeakKeyAssociation2 methodsFor: 'accessing' stamp: 'mvl 3/11/2007 20:10'!
key: anObject 
	"Store the argument, anObject, as the lookup key of the receiver."

	self basicAt: 1 put:  anObject! !

!WeakKeyAssociation2 methodsFor: 'accessing' stamp: 'mvl 3/11/2007 20:32'!
key: aKey value: anObject 
	"Store the arguments as the variables of the receiver."

	self basicAt: 1 put: aKey.
	value _ anObject! !

!WeakKeyAssociation2 methodsFor: 'accessing' stamp: 'mvl 3/11/2007 20:10'!
name

	^ self key isString
		ifTrue: [self key]
		ifFalse: [self key printString]! !

!WeakKeyAssociation2 methodsFor: 'accessing' stamp: 'mvl 3/11/2007 22:32'!
value
	"Answer the value of the receiver."

	^ value == self ifTrue:[nil] ifFalse:[value]! !

!WeakKeyAssociation2 methodsFor: 'accessing' stamp: 'mvl 3/15/2007 23:31'!
value: anObject 
	"Store the argument, anObject, as the value of the receiver."

	anObject == self ifTrue: [self error: 'Using the WeakAssociation as its own value'].
	value _ anObject! !

!WeakKeyAssociation2 methodsFor: 'filter streaming' stamp: 'mvl 3/11/2007 20:37'!
byteEncode: aStream
	aStream writeAssocation:self.! !

!WeakKeyAssociation2 methodsFor: 'filter streaming' stamp: 'mvl 3/11/2007 20:28'!
writeOnFilterStream: aStream

	aStream write: self key.! !

!WeakKeyAssociation2 methodsFor: 'printing' stamp: 'mvl 3/11/2007 20:45'!
printOn: aStream

	self key printOn: aStream.
	aStream nextPutAll: '->'.
	value printOn: aStream! !

!WeakKeyAssociation2 methodsFor: 'printing' stamp: 'mvl 3/11/2007 20:48'!
propertyListOn: aStream
	aStream write: self key; print:'='; write:value.
! !

!WeakKeyAssociation2 methodsFor: 'printing' stamp: 'mvl 3/18/2007 11:17'!
storeOn: aStream
	"Store in the format (key->value)"
	aStream 
		nextPut: $(;
		nextPutAll: self class name.
	self expired ifTrue:[
		aStream nextPutAll: ' expired'
	] ifFalse: [
		aStream nextPutAll:' key: '.
		self key storeOn: aStream.
		aStream nextPutAll: ' value:'.
		value storeOn: aStream.
	].
	aStream nextPut: $)! !

!WeakKeyAssociation2 methodsFor: 'testing' stamp: 'mvl 3/11/2007 20:51'!
isSpecialWriteBinding
	"Return true if this variable binding is write protected, e.g., should not be accessed primitively but rather by sending #value: messages"
	^false! !

!WeakKeyAssociation2 methodsFor: 'testing' stamp: 'mvl 3/11/2007 20:51'!
isVariableBinding
	"Return true if I represent a literal variable binding"
	^true! !

!WeakKeyAssociation2 methodsFor: 'objects from disk' stamp: 'mvl 3/11/2007 20:38'!
objectForDataStream: refStrm
	| dp |
	"I am about to be written on an object file.  If I am a known global, write a proxy that will hook up with the same resource in the destination system."

	^ (Smalltalk associationAt: self key ifAbsent: [nil]) == self 
		ifTrue: [dp _ DiskProxy global: #Smalltalk selector: #associationOrUndeclaredAt: 
							args: (Array with: self key).
			refStrm replace: self with: dp.
			dp]
		ifFalse: [self]! !


!WeakKeyAssociation2 class methodsFor: 'instance creation' stamp: 'mvl 3/18/2007 11:12'!
expired
	"Answer an object that is already expired. Used for printing"
	^(self key: nil value: nil)
		expire;
		yourself! !

!WeakKeyAssociation2 class methodsFor: 'instance creation' stamp: 'mvl 3/11/2007 20:07'!
key: newKey value: newValue
	"Answer an instance of me with the arguments as the key and value of 
	the association."

	^(self basicNew: 1) key: newKey value: newValue! !

!WeakKeyAssociation2 class methodsFor: 'as yet unclassified' stamp: 'mvl 3/16/2007 11:07'!
install
	| old new assoc k oldclass |
	
	WeakKeyAssociation2 setName: #WeakKeyAssociation.
	oldclass := WeakKeyAssociation.
	(Smalltalk associationAt: #WeakKeyAssociation) 
		key: #WeakKeyAssociation value: WeakKeyAssociation2.
	
	old := oldclass allInstances.
	[old size > 0] whileTrue:[
		new := Array new: old size.
		1 to: old size do:[:n|
			assoc := old at: n.
			k := assoc key. "Hold on to the key so it won't get collected.".
			new at: n put: (WeakKeyAssociation2 key: k value: assoc value).
		].
		old elementsForwardIdentityTo: new.
		old := nil.
		Smalltalk garbageCollect.
		old := oldclass allInstances.
	].
	! !


!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/16/2007 09:53'!
allAssociationsDo: aBlock
	self associationsDo: aBlock! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/16/2007 21:28'!
compare: object1 to: object2
	^object1 = object2! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/16/2007 21:21'!
startIndexFor: anObject
	"Return the index at which the scan for anObject should start."
	
	^(anObject hash \\ array size) + 1! !


!WeakIdentityKeyDictionary methodsFor: 'private' stamp: 'mvl 3/16/2007 21:27'!
compare: object1 to: object2
	^ object1 == object2! !

!WeakIdentityKeyDictionary methodsFor: 'private' stamp: 'mvl 3/16/2007 21:23'!
startIndexFor: anObject
	| finish hash |
	finish _ array size.
	finish > 4096
		ifTrue: [hash _ anObject identityHash * (finish // 4096)]
		ifFalse: [hash _ anObject identityHash].
	^ (hash \\ finish) + 1.! !


!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/11/2007 21:40'!
initialize: n
	expired _ 0.
	^super initialize: n! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/18/2007 08:03'!
noCheckAddForRehash: anAssociation
	^self noCheckAdd: anAssociation! !

!WeakKeyDictionary methodsFor: 'private' stamp: 'mvl 3/18/2007 09:45'!
scanForEmpty: anObject
	"Scan the key array for the first slot containing either a nil or an expired association (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found."
	| element start finish firstNil |
	finish _ array size.
	start _ self startIndexFor: anObject.
	firstNil _ nil.
	
	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element _ array at: index) == nil or: [self compare: element key to: anObject])
			ifTrue: [
				"If we found no match, and have an expired slot, use that one."
				(element isNil and: [firstNil notNil]) ifTrue:[^firstNil].
				^ index 
			].
			"If this slot is expired, and we haven't seen an earlier expired slot, record it"
			(element notNil and: [element expired] and: [firstNil isNil]) ifTrue: [firstNil _ index].
		].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element _ array at: index) == nil or: [self compare: element key to: anObject])
			ifTrue: [
				(element isNil and: [firstNil notNil]) ifTrue:[^firstNil].
				^ index 
			].
			(element notNil and: [element expired] and: [firstNil isNil]) ifTrue: [firstNil _ index].
		].

	"If there is no empty slot, but an expired one, return it."	
	firstNil notNil ifTrue:[^firstNil].

	^ 0  "No match AND no empty slot"! !

!WeakKeyDictionary methodsFor: 'enumerating' stamp: 'mvl 3/16/2007 09:55'!
allAssociationsDo: aBlock 
	"Evaluate aBlock for each of the receiver's elements (key/value 
	associations). This includes associations with nil keys, except for
	the expired ones."

	super associationsDo: [:association | 
		association expired ifFalse:[aBlock value: association]].! !


!WeakKeyDictionaryTest methodsFor: 'as yet unclassified' stamp: 'mvl 3/15/2007 15:08'!
setUp
	keys := (1 to: 1000) collect:[:n| 'key', n asString].
	dict := WeakKeyDictionary new.
	keys do:[:n| dict at: n put: n,n].! !

!WeakKeyDictionaryTest methodsFor: 'as yet unclassified' stamp: 'mvl 3/15/2007 16:45'!
size
	"Answer the number of keys that should be used in testing."
	^1000! !

!WeakKeyDictionaryTest methodsFor: 'as yet unclassified' stamp: 'mvl 3/15/2007 16:47'!
testClearing
	keys := nil.
	dict at: self put: nil.
	self assert: dict size == (self size + 1).

	Smalltalk garbageCollect.

	"Keys are gone but not yet finalized."
	self assert: dict size == (self size + 1).
	self assert: dict keys size == 1.
	
	dict finalizeValues.
	
	"Now the size should be adjusted."
	self assert: dict size == 1.
	! !

!WeakKeyDictionaryTest methodsFor: 'as yet unclassified' stamp: 'mvl 3/28/2007 12:00'!
testGrow
	keys := nil.
	dict at: self put: nil.
	Smalltalk garbageCollect.

	"Keys are gone but not yet finalized."
	dict grow.! !


!WeakKeyToCollectionDictionary methodsFor: 'as yet unclassified' stamp: 'mvl 3/18/2007 08:09'!
noCheckAddForRehash: anAssociation
	| cleanedValue |
	anAssociation key ifNil:[^self].
	cleanedValue := anAssociation value copyWithout: nil.
	cleanedValue notEmpty ifTrue:[
		anAssociation value: cleanedValue.
		super noCheckAddForRehash: anAssociation.
	].! !


!WeakKeyDictionary reorganize!
('accessing' at:put:)
('adding' add:)
('finalization' finalizeValues finalizeValues:)
('private' compare:to: copy fixCollisionsFrom: fullCheck grow initialize: noCheckAdd: noCheckAddForRehash: rehash scanFor: scanForEmpty: startIndexFor: valueAtNewKey:put:atIndex:declareFrom:)
('enumerating' allAssociationsDo: associationsDo:)
('removing' removeKey:ifAbsent:)
!


!WeakKeyAssociation2 class reorganize!
('instance creation' expired key:value:)
('as yet unclassified' install)
!


!WeakKeyAssociation2 reorganize!
('comparing' < = hash)
('accessing' expire expired key key: key:value: name value value:)
('filter streaming' byteEncode: writeOnFilterStream:)
('printing' printOn: propertyListOn: storeOn:)
('testing' isSpecialWriteBinding isVariableBinding)
('objects from disk' objectForDataStream:)
!

"Postscript:
Replace WeakKeyAssociation with WeakKeyAssociation2"

WeakKeyAssociation2 install.
(Smalltalk at: #WeakKeyAssociation) class removeSelector: #install.

"Set expired to 0 for all instances."

WeakKeyDictionary withAllSubclasses do:[:cl|
	cl allInstances do:[:ea|
		ea instVarNamed: #expired put: 0.
	].
].!