"=====================================================================
|
|   Weak collections
|
|   $Revision: 1.7.5$
|   $Date: 2000/05/28 16:56:52$
|   $Author: pb$
|
 ======================================================================"

"======================================================================
|
| Copyright 1988-92, 1994-95, 1999, 2000 Free Software Foundation, Inc.
| Written by 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.LESSER.
| If not, write to the Free Software Foundation, 59 Temple Place - Suite
| 330, Boston, MA 02111-1307, USA.  
|
 ======================================================================"

Array subclass: #WeakArray
	instanceVariableNames: 'values nilValues'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Weak'!

Set subclass: #WeakSet
	instanceVariableNames: 'items'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Weak'!

LookupTable subclass: #WeakKeyLookupTable
	instanceVariableNames: 'keys'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Weak'!

LookupTable variableSubclass: #WeakValueLookupTable
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Weak'!

WeakSet subclass: #WeakIdentitySet
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Weak'!

WeakKeyLookupTable subclass: #WeakKeyIdentityDictionary
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Weak'!

WeakValueLookupTable variableSubclass: #WeakValueIdentityDictionary
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Collections-Weak'!


WeakArray comment: '
I am similar to a plain array, but my items are stored in a weak object,
so I track which of them are garbage collected.'.

WeakSet comment: '
I am similar to a plain set, but my items are stored in a weak array;
I track which of them are garbage collected and, as soon as I encounter
one of them, I swiftly remove all.'.

WeakKeyLookupTable comment: '
I am similar to a plain LookupTable, but my keys are stored
in a weak array; I track which of them are garbage collected and, as
soon as I encounter one of them, I swiftly remove all the associations
for the garbage collected keys'.

WeakValueLookupTable comment: '
I am similar to a plain LookupTable, but my values are stored
in a weak array; I track which of the values are garbage collected and,
as soon as one of them is accessed, I swiftly remove the associations
for the garbage collected values'.

WeakIdentitySet comment: '
I am similar to a plain identity set, but my keys are stored in a weak
array; I track which of them are garbage collected and, as soon as I
encounter one of them, I swiftly remove all the garbage collected keys'.

WeakKeyIdentityDictionary comment: '
I am similar to a plain identity dictionary, but my keys are stored
in a weak array; I track which of them are garbage collected and, as
soon as I encounter one of them, I swiftly remove all the associations
for the garbage collected keys'.

WeakValueIdentityDictionary comment: '
I am similar to a plain identity dictionary, but my values are stored
in a weak array; I track which of the values are garbage collected and,
as soon as one of them is accessed, I swiftly remove the associations
for the garbage collected values'!


!WeakArray class methodsFor: 'instance creation'!

new: size
    "Private - Initialize the values array; plus, make it weak and create
    the ByteArray used to track garbage collected values"
    ^self basicNew
        initialize: size
! !


!WeakArray methodsFor: 'loading'!

postLoad
    "Called after loading an object; must restore it to the state before
     `preStore' was called.  Make it weak again"
    values makeWeak
! !


!WeakArray methodsFor: 'private'!

initialize: size
    "Private - Initialize the values array; plus, make it weak and create
    the ByteArray used to track garbage collected values"
    values := Array new: size.
    values makeWeak.
    nilValues := ByteArray new: size withAll: 1.
!

values: anArray whichAreNil: nilArray
    "Private - Initialize the values array to anArray and make it weak;
    plus, set to a copy of nilArray the ByteArray used to track garbage
    collected values"
    values := anArray.
    values makeWeak.
    nilValues := ByteArray new: anArray size.
    nilValues replaceFrom: 1 to: anArray size with: nilArray startingAt: 1.
! !


!WeakArray methodsFor: 'accessing'!

at: index
    "Answer the index-th item of the receiver, or nil if it has been
     garbage collected."
    ^values at: index
!

atAll: indices put: object
    "Put object at every index contained in the indices collection"
    nilValues atAll: indices put: (object isNil ifTrue: [1] ifFalse: [0]).
    ^values atAll: indices put: object
!

atAllPut: object
    "Put object at every index in the receiver"
    nilValues atAllPut: (object isNil ifTrue: [1] ifFalse: [0]).
    ^values atAllPut: object
!

at: index put: object
    "Store the value associated to the given index; plus,
    store in nilValues whether the object is nil.  nil objects whose
    associated item of nilValues is 1 were touched by the garbage
    collector."
    nilValues at: index put: (object isNil ifTrue: [1] ifFalse: [0]).
    ^values at: index put: object
!

clearGCFlag: index
    "Clear the `object has been garbage collected' flag for the item
    at the given index"
    | object |
    object := values at: index.
    nilValues at: index put: (object isNil ifTrue: [1] ifFalse: [0]).
!

do: aBlock
    "Evaluate aBlock for all the elements in the array, including the 
     garbage collected ones (pass nil for those)."
    values do: aBlock
!

aliveObjectsDo: aBlock
    "Evaluate aBlock for all the elements in the array, excluding the 
     garbage collected ones. Note: a finalized object stays alive until
     the next collection (the collector has no means to see whether it was
     resuscitated by the finalizer), so an object being alive does not mean
     that it is usable."
    | value |
    1 to: self size do: [ :i |
	(value := values at: i) isNil
	    ifFalse: [ aBlock value: value ]
	    ifTrue: [ (nilValues at: i) = 0 ifFalse: [ aBlock value: value ] ]
    ].
!

isAlive: index
    "Answer whether the item at the given index is still alive or has been
     garbage collected. Note: a finalized object stays alive until the next
     collection (the collector has no means to see whether it was resuscitated
     by the finalizer), so an object being alive does not mean that it is
     usable."
    ^(values at: index) notNil or: [ (nilValues at: index) = 1 ]
!

size
    "Answer the number of items in the receiver"
    ^values size
! !


!WeakArray methodsFor: 'conversion'!

asArray
    "Answer a non-weak version of the receiver"
    ^values copy
!

deepCopy
    "Returns a deep copy of the receiver (the instance variables are
     copies of the receiver's instance variables)"
    ^self class basicNew
        values: values deepCopy whichAreNil: nilValues
!

shallowCopy
    "Returns a shallow copy of the receiver (the instance variables are
     not copied)"
    ^self class basicNew
        values: values shallowCopy whichAreNil: nilValues
!

species
    "Answer Array; this method is used in the #copyEmpty: message, which in
     turn is used by all collection-returning methods (collect:, select:,
     reject:, etc.)."
    ^Array
! !


!WeakSet class methodsFor: 'instance creation'!

new: anInteger
    "Answer a new instance of the receiver with the given size"
    ^self basicNew initialize: (5 max: anInteger)
! !


!WeakSet methodsFor: 'private'!

initialize: size
    "Instance variable initialization."
    super initialize: size.
    items := WeakArray new: size.
!

findIndex: anObject
    "Private - 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.
     If we find a key that the garbage collector nil-ed out, we rehash the
     receiver and restart the search."
    | index startIndex size element |
    size := self primSize.
    index := startIndex := (self hashFor: anObject) \\ size + 1.
    [
	(element := self primAt: index) isNil
	    ifTrue: [
		(items isAlive: index)
		    ifFalse: [ self rehash. index := startIndex ]
		    ifTrue: [ ^index ]
	    ]
	    ifFalse: [
		(self is: element sameAs: anObject)
		     ifTrue: [ ^index ]
	    ].

	index := (index = self primSize) ifTrue: [ 1 ] ifFalse: [ index + 1 ].
    ] repeat
!

primAt: index
    "Private - Read the key from the keys array"
    ^items at: index
!

primAt: index put: object
    "Private - Write the key from the keys array"
    ^items at: index put: object
!

primSize
    "Private - Our size is the same as the keys array's"
    ^items size
! !


!WeakSet methodsFor: 'rehashing'!

rehash
    "Rehash the receiver"
    | items |
    items := Array new: self primSize.
    self resetTally.

    1 to: self primSize do: [:i |
	items at: i put: (self primAt: i).
	self primAt: i put: nil ].

    items do: [:each |
	each isNil ifFalse: [ self whileGrowingAdd: each ]
    ].
! !



!WeakKeyLookupTable class methodsFor: 'instance creation'!

new: anInteger
    "Answer a new instance of the receiver with the given size"
    ^self basicNew initialize: (5 max: anInteger)
! !


!WeakKeyLookupTable methodsFor: 'private'!

findIndex: anObject
    "Private - 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.
     If we find a key that the garbage collector nil-ed out, we rehash the
     receiver and restart the search."
    | index startIndex size element |
    size := self primSize.
    index := startIndex := (self hashFor: anObject) \\ size + 1.
    [
	(element := self primAt: index) isNil
	    ifTrue: [
		(keys isAlive: index)
		    ifFalse: [ self rehash. index := startIndex ]
		    ifTrue: [ ^index ]
	    ]
	    ifFalse: [
		(self is: element sameAs: anObject)
		     ifTrue: [ ^index ]
	    ].

	index := (index = self primSize) ifTrue: [ 1 ] ifFalse: [ index + 1 ].
    ] repeat
!

initialize: anInteger
    "Private - Instance variable initialization."
    keys := WeakArray new: anInteger.
    super initialize: anInteger.
!

primAt: index
    "Private - Read the key from the keys array"
    ^keys at: index
!

primAt: index put: object
    "Private - Write the key from the keys array"
    ^keys at: index put: object
!

primSize
    "Private - Our size is the same as the keys array's"
    ^keys size
! !


!WeakKeyLookupTable methodsFor: 'rehashing'!

rehash
    "Rehash the receiver"
    | key val |
    key := Array new: self primSize.
    val := Array new: values size.
    self resetTally.

    1 to: self primSize do: [ :i |
	(keys isAlive: i) ifTrue: [
	    key at: i put: (self primAt: i).
	    val at: i put: (self valueAt: i).
	].

	self primAt: i put: nil.
	self valueAt: i put: nil.
    ].

    1 to: self primSize do: [:i |
	(key at: i) isNil ifFalse: [
	    self whileGrowingAt: (key at: i) put: (val at: i)
	]
    ].
! !


!WeakValueLookupTable methodsFor: 'hacks'!

at: key ifAbsent: aBlock
    "Answer the value associated to the given key, or the result of evaluating
    aBlock if the key is not found"

    | result |
    result := super at: key ifAbsent: [ ^aBlock value ].
    result isNil ifFalse: [ ^result ].
    self cleanup.
    ^super at: key ifAbsent: aBlock
!

at: key ifPresent: aBlock
    "If aKey is absent, answer nil. Else, evaluate aBlock passing the
    associated value and answer the result of the invocation"

    ^aBlock value: (self at: key ifAbsent: [ ^nil ])
!

includesKey: key
    "Answer whether the receiver contains the given key."

    self at: key ifAbsent: [ ^false ].
    ^true
!


!WeakValueLookupTable methodsFor: 'private'!

cleanup
     "Private - Clean the dictionary of key->(finalized value) pairs"
     | keys key |
     keys := WriteStream on: (Array new: self size // 3 + 1).
     1 to: self primSize do: [ :index |
	"Find values that are nil and should not be"
	(keys isAlive: index) ifTrue: [
	    keys nextPut: key.
	    values clearGCFlag: index
	]
     ].

     self removeAllKeys: keys contents ifAbsent: [:key |]
!

initValues
    "Private - Initialize the values array; plus, make it weak and create
    the ByteArray used to track garbage collected values"

    values := WeakArray new: self primSize.
! !


!WeakValueLookupTable methodsFor: 'rehashing'!

rehash
    "Rehash the receiver"
    | key val |
    key := Array new: self primSize.
    val := Array new: values size.
    self resetTally.

    1 to: self primSize do: [ :i |
	"Find values that are nil and should not be"
	(key := self primAt: i) notNil ifTrue: [
	     (values isAlive: i) ifTrue: [
		key at: i put: (self primAt: i).
		val at: i put: (self valueAt: i).
	     ]
	].
	self primAt: i put: nil.
	self valueAt: i put: nil.
    ].

    1 to: self primSize do: [:i |
	(key at: i) isNil ifFalse: [
	    self whileGrowingAt: (key at: i) put: (val at: i)
	]
    ].
! !


!WeakIdentitySet methodsFor: 'private methods'!

hashFor: anElement

    "Answer the hash value for anElement"

    ^anElement identityHash
!

is: anElement sameAs: searchedObject

    "Answer whether findIndex: should stop scanning the receiver: anElement has
     been found and findIndex:'s parameter was searchedObject"

    ^anElement == searchedObject
! !


!WeakKeyIdentityDictionary methodsFor: 'private methods'!

hashFor: anElement

    "Answer the hash value for anElement"

    ^anElement identityHash
!

keysClass
    "Answer the class answered by #keys"
    ^IdentitySet
!

is: anElement sameAs: searchedObject

    "Answer whether findIndex: should stop scanning the receiver: anElement has
     been found and findIndex:'s parameter was searchedObject"

    ^anElement == searchedObject
! !


!WeakValueIdentityDictionary methodsFor: 'private methods'!

hashFor: anElement

    "Answer the hash value for anElement"

    ^anElement identityHash
!

keysClass
    "Answer the class answered by #keys"
    ^IdentitySet
!

is: anElement sameAs: searchedObject

    "Answer whether findIndex: should stop scanning the receiver: anElement has
     been found and findIndex:'s parameter was searchedObject"

    ^anElement == searchedObject
! !
