!=========================================================================
! Copyright (C) by VMware, Inc. 1991-2011.  All Rights Reserved.
!
! $Id: identitydict.gs,v 1.9 2008-01-09 22:50:11 stever Exp $
!
! Superclass Hierarchy:
!    IdentityDictionary, IdentityKeyValueDictionary, 
!    KeyValueDictionary, AbstractDictionary, Collection, Object
!
!=========================================================================

removeallmethods IdentityDictionary
removeallclassmethods IdentityDictionary

! ------------------- Class methods for IdentityDictionary

category: 'For Documentation Installation only'
classmethod: IdentityDictionary
installDocumentation

| doc txt |
doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'IdentityDictionary is a Dictionary that is identity-based rather than 
 equality-based.

 IdentityDictionary implements key-value pairs by storing key-Association
 pairs.  Each Association contains a key-value pair, and the key is 
 duplicated in the dictionary or collision bucket for implementation reasons.

 As with other identity-based collections, in an IdentityDictionary two keys or
 two values are considered to be the same only if they are identical; equivalent
 objects are not the same.  Thus, if you add two key-value pairs to an
 IdentityDictionary and the keys are equivalent but not identical, then the
 result is that you have two pairs in the dictionary because the keys are not
 the same.

 IdentityDictionary exhibits better performance than Dictionary and is to be
 preferred where it is appropriate.' .
doc documentClassWith: txt.

self description: doc.
%
! ------------------- Instance methods for IdentityDictionary
category: 'Searching'
method: IdentityDictionary
_keysWithValue: aValue

"(R) Returns a (possibly empty) set of keys associated with the value, aValue."

| result |

result:= IdentitySet new.  "an IdentitySet: we should not have duplicate keys"
self keysAndValuesDo: [ :aKey :dictValue  |
  (aValue = dictValue) ifTrue: [result add: aKey ]
  ].
^ result
%

category: 'Searching'
method: IdentityDictionary
includesAssociation: anAssociation

"Returns true if the receiver contains an element identical to anAssociation.
 Returns false otherwise."

self associationsDo: [ :element |
  (anAssociation == element) ifTrue: [ ^ true ].
  ].

^ false.
%

category: 'Accessing'
method: IdentityDictionary
values

"Returns an OrderedCollection containing the receiver's values."

|result|
result:= OrderedCollection new. 
self valuesDo: [ :value | result add: value ].
^ result.
%

! remove unused duplicate implementation of hashFunction:

category: 'Accessing'
method: IdentityDictionary
associationAt: aKey

"Returns the Association with key aKey.  Generates an error if
 no such Association exists."

| anAssoc |
anAssoc := self _at: aKey otherwise: nil .
anAssoc == nil ifTrue:[ ^ self _errorKeyNotFound: aKey ].
^ anAssoc
%

category: 'Accessing'
method: IdentityDictionary
associationAt: aKey ifAbsent: aBlock

"Returns the Association with key aKey.  If no such Association exists, returns
 the result of evaluating the zero-argument block aBlock."

| anAssoc |

anAssoc := self _at: aKey otherwise: nil .
anAssoc == nil ifTrue:[ ^ aBlock value] .
^ anAssoc
%

category: 'Accessing'
method: IdentityDictionary
at: aKey

"Returns the value of the Association with key aKey.  Generates an error if no
 such Association exists."

| anAssoc |
anAssoc:= self _at: aKey otherwise: nil .
anAssoc == nil ifTrue:[ anAssoc := self _errorKeyNotFound: aKey ].
^anAssoc value
%

category: 'Searching'
method: IdentityDictionary
includesKey: aKey

"Reimplemented from KeyValueDictionary for efficiency."

^ ( super at: aKey otherwise: nil ) ~~ nil
%

category: 'Accessing'
method: IdentityDictionary
associationAt: aKey otherwise: defaultValue

"Returns the Association with key aKey.  If no such Association exists, returns
 the given default value."

| anAssoc |
anAssoc := self _at: aKey otherwise: nil .
anAssoc == nil ifTrue:[ ^ defaultValue ].
^ anAssoc
%

category: 'Accessing'
method: IdentityDictionary
at: aKey ifAbsent: aBlock

"Returns the value that corresponds to aKey.  If no such key/value pair
 exists, returns the result of evaluating the zero-argument block aBlock."

| anAssoc |
anAssoc := self _at: aKey otherwise: nil .
anAssoc == nil ifTrue:[ ^ aBlock value ] .
^ anAssoc value
%

category: 'Accessing'
method: IdentityDictionary
at: aKey otherwise: aValue

"Returns the value that corresponds to aKey.  If no such key/value pair exists,
 returns the given alternate value."

| anAssoc |
anAssoc := self _at: aKey otherwise: nil .
anAssoc == nil ifTrue:[ ^ aValue] .
^ anAssoc value
%

category: 'Accessing'
method: IdentityDictionary
keys

"Returns an IdentitySet containing the receiver's keys."

| result |
result := IdentitySet new .
self keysAndAssociationsDo:[ :aKey :anAssoc | result add: aKey ].
^ result
%

category: 'Adding'
method: IdentityDictionary
add: anAssociation

"Requires an Association as the argument.  If the receiver already includes an
 Association whose key is equal to that of anAssociation, this method redefines
 the value portion of that Association."

^ self addAssociation: anAssociation
%

category: 'Hashing'
method: IdentityDictionary
rebuildTable: newSize

"Rebuilds the hash table by saving the current state, initializing and
 changing the size of the table, and adding the key value pairs saved
 back to the dictionary."

|saveTable index saveCollLimit|

collisionLimit == 536870911 ifTrue:[
  ^ self  "avoid recursive rebuild"
  ].

saveTable := Array new: (self size * 2).
index := 0.
self keysAndAssociationsDo: [ :aKey :anAssoc |  
  index := index + 1.
  saveTable at: index put: aKey.
  index := index + 1.
  saveTable at: index put: anAssoc  
  ].
self tableSize: newSize.
saveCollLimit := collisionLimit .
collisionLimit := 536870911 . "prevent recursive rebuild"
1 to: index by: 2 do: [ :i |
  self _at: (saveTable at: i) put: (saveTable at: i + 1) 
  ].
collisionLimit := saveCollLimit .
				"deleted   'reduce garbage' code"
^self
%

category: 'Removing'
method: IdentityDictionary
removeAssociation: anAssocation

"Removes an element from the receiver equal to anAssociation and returns
 anAssociation.  If no such element is present, this method generates an error."

"Note: In GemStone 4.1, this method returned the receiver."

^self removeAssociation: anAssocation ifAbsent: [
  ^ self _errorNotFound: anAssocation
].
%

category: 'Removing'
method: IdentityDictionary
removeAssociation: anAssocation ifAbsent: aBlock

"Removes anAssocation from the receiver.  If no such element is present, 
 evaluates the zero-argument block aBlock and returns the result of that
 evaluation."

"We must remove this particular Association (anAssocation), not
 just any Association with the same key as anAssocation."

^ self _removeKey: anAssocation key ifAbsent: aBlock
%

category: 'Removing'
method: IdentityDictionary
removeKey: aKey

"Removes the Association with key identical to aKey from the receiver and
 returns the value portion of that Association.  If no Association is present
 with key identical to aKey, reports an error."

|anAssoc|
anAssoc:= self _removeKey: aKey ifAbsent: nil.
^anAssoc value
%

category: 'Removing'
method: IdentityDictionary
removeKey: aKey ifAbsent: aBlock

"Removes the key/value pair with key aKey from the receiver and returns
 the value.  If no key/value pair is present with key aKey, evaluates
 the zero-argument block aBlock and returns the result of that evaluation."

|anAssoc|
anAssoc:= self _removeKey: aKey ifAbsent: [^aBlock value].
^anAssoc value
%


category: 'Private'
method: IdentityDictionary
atHash: hashIndex putValue: aValue

"Updates the hash table by storing aValue at the specified hashIndex."

aValue == nil ifFalse:[ (aValue isKindOf: Association) ifFalse:[ 
    (aValue isKindOf: CollisionBucket) ifFalse:[
       aValue _error: #rtErrInvalidArgClass args: 
         #[ Association, CollisionBucket, UndefinedObject ]
      ].
    ].
  ].
^super atHash: hashIndex putValue: aValue.
%

category: 'Updating'
method: IdentityDictionary
addAssociation: anAssociation

"Adds the argument to the receiver."

anAssociation _class == Association ifFalse:[
  anAssociation _validateClass: Association
  ].
anAssociation assignToSegment: self segment.
^ self _at: anAssociation key put: anAssociation
%

category: 'Updating'
method: IdentityDictionary
at: aKey put: aValue 

"If the receiver already contains a Association with the given key, this
 method makes aValue the value of that Association.  Otherwise, it creates a
 new Association with the given key and value and adds it to the receiver.
 Returns aValue."

| anAssoc |

anAssoc := self _at: aKey otherwise: nil .
anAssoc == nil 
  ifTrue:[ | newAssoc |
    newAssoc := Association newWithKey: aKey value: aValue.
    newAssoc assignToSegment: self segment.
    self _at: aKey put: newAssoc.
    ^aValue
    ].

anAssoc value: aValue.
^aValue
%

category: 'Searching'
method: IdentityDictionary
collectAssociations: aBlock

"Evaluates aBlock with each of the receiver's Associations as the argument.
 Collects the resulting values into a new dictionary and returns that
 dictionary.  The argument aBlock must be a one-argument block."

|result|

result:= self speciesForCollect new: self tableSize.
self associationsDo: [ :anAssoc |
  result at: (anAssoc key) put: ( aBlock value: anAssoc )
  ] .
^ result
%

! inherit detectAssociations:, associationsDetect:

category: 'Locking Support'
method: IdentityDictionary
_lockableValues

"Returns an Array of the receiver's Associations."

| result |

result := Array new .
self associationsDo: [ :anAssoc | result add: anAssoc] .
^ result
%

category: 'Accessing'
method: IdentityDictionary
keyAtValue: anObject ifAbsent: aBlock

"Returns the key of the first Association whose value matches the given object,
 anObject.  If no match is found, this method evaluates the block aBlock and
 returns its result."

| aKey collisionBkt |

1 to: tableSize * 2 by: 2 do: [ :tableIndex |
  (aKey := self _at: tableIndex) == nil ifTrue: [
    (collisionBkt := self _at: (tableIndex + 1)) == nil ifFalse: [
      1 to: collisionBkt _basicSize by: 2 do: [ :j |
        (aKey := collisionBkt _at: j) == nil ifFalse: [
          anObject == (collisionBkt _at: j + 1) value ifTrue: [
            ^ aKey
            ].
          ].
        ].
      ].
    ]
  ifFalse: [
    anObject == (self _at: tableIndex + 1) value ifTrue: [
      ^ aKey
      ].
    ].
  ].

^aBlock value.
%

category: 'Private'
method: IdentityDictionary
compareKey: key1 with: key2

"Returns true if key1 is equivalent to key2; returns false otherwise."

^ key1 == key2
%

category: 'Hashing'
method: IdentityDictionary
hashFunction: aKey

"The hash function should perform some operation on the value of the
 key (aKey) which returns a value in the range 1..tableSize."

^ (aKey identityHash \\ self tableSize) + 1
%

category: 'Enumerating'
method: IdentityDictionary
keysAndAssociationsDo: aBlock

"Evaluates aBlock with each of the receiver's key/Association pairs as the
 arguments.  The argument aBlock must be a two-argument block.  The
 first argument is the key and the second argument is the Association of
 each pair.  Returns the receiver."

| aKey collisionBkt |

1 to: tableSize * 2 by: 2 do: [ :tableIndex |
  nil == (aKey := self _at: tableIndex) ifTrue: [
    nil == (collisionBkt := self _at: (tableIndex + 1)) ifFalse: [
      1 to: collisionBkt _basicSize by: 2 do: [ :j |
        nil == (aKey := collisionBkt _at: j) ifFalse: [
          aBlock value: aKey value: (collisionBkt _at: j + 1) .
          ].
        ].
      ].
    ]
  ifFalse: [
    aBlock value: aKey value: (self _at: tableIndex + 1) .
    ].
  ].
%

category: 'Enumerating'
method: IdentityDictionary
keysAndValuesDo: aBlock

"Evaluates aBlock with each of the receiver's key/value pairs as the
 arguments.  The argument aBlock must be a two-argument block.  The
 first argument is the key and the second argument is the value of
 each key/value pair.  Returns the receiver."

"Reimplemented to send value to each Association."

| aKey collisionBkt |

1 to: tableSize * 2 by: 2 do: [ :tableIndex |
  nil == (aKey := self _at: tableIndex) ifTrue: [
    nil == (collisionBkt := self _at: (tableIndex + 1)) ifFalse: [
      1 to: collisionBkt _basicSize by: 2 do: [ :j |
        nil == (aKey := collisionBkt _at: j) ifFalse: [
          aBlock value: aKey value: (collisionBkt _at: j + 1) value .
          ].
        ].
      ].
    ]
  ifFalse: [
    aBlock value: aKey value: (self _at: tableIndex + 1) value .
    ].
  ].
%

! added for 36675
category: 'Enumerating'
method: IdentityDictionary
inject: anObj keysAndValuesInto: aBlock

"Evaluates aBlock with each of the receiver's key/value pairs as the
 2nd and 3rd arguments.
 aBlock must be a 3 argument block, with arguments anObj, key value ."

| aKey collisionBkt |
1 to: tableSize * 2 by: 2 do: [ :tableIndex |
  nil == (aKey := self _at: tableIndex) ifTrue: [
    nil == (collisionBkt := self _at: (tableIndex + 1)) ifFalse: [
      1 to: collisionBkt _basicSize by: 2 do: [ :j |
        nil == (aKey := collisionBkt _at: j) ifFalse: [
          aBlock value: anObj value: aKey value: (collisionBkt _at: j + 1) value .
          ].
        ].
      ].
    ]
  ifFalse: [
    aBlock value: anObj value: aKey value: (self _at: tableIndex + 1) value .
    ].
  ].
%


category: 'Enumerating'
method: IdentityDictionary
associationsDo: aBlock

"Evaluates aBlock with each of the receiver's key/value pairs as the
 argument by creating an Association for each key/value pair.  The
 argument aBlock must be a one-argument block.  Returns the receiver."

| collisionBkt |

1 to: tableSize * 2 by: 2 do: [ :tableIndex |
  nil == (self _at: tableIndex) ifTrue: [
    nil == (collisionBkt := self _at: (tableIndex + 1)) ifFalse: [
      1 to: collisionBkt _basicSize by: 2 do: [ :j |
        nil == (collisionBkt _at: j) ifFalse: [
          aBlock value: (collisionBkt _at: j + 1) .
          ].
        ].
      ].
    ]
  ifFalse: [
    aBlock value: (self _at: tableIndex + 1) .
    ].
  ].
%
category: 'Storing and Loading'
method: IdentityDictionary
loadVaryingFrom: passiveObj size: varyingSize

"Reads the varying part of the receiver from the given passive object.
 Does not record the receiver as having been read.  Does not read the
 receiver's named instance variables, if any."

1 to: varyingSize do: [:i |
  self add: passiveObj readObject"anAssociation"
].
%

category: 'Storing and Loading'
method: IdentityDictionary
basicWriteTo: passiveObj

"Converts the receiver to its passive form and writes that information on
 passiveObj."

| s cls ivs c |
  cls := self class.
  passiveObj writeClass: cls.

  ivs := cls _instVarNames .

  passiveObj writeSize: (s := self size) .

  cls firstPublicInstVar to: cls instSize do: [:i |
    (self shouldWriteInstVar: (ivs at: i)) ifTrue: [
      passiveObj writeObject: (self instVarAt: i) named: (ivs at: i)
    ].
  ].

  passiveObj endNamedInstVars.

  c := 0.
  self associationsDo:[ :anAssoc | 
    passiveObj writeObject: anAssoc .
    c := c + 1.
    c > 99 ifTrue: [
      passiveObj lf.
      c := 0.
      ].
    ].

  passiveObj cr
%

category: 'Private'
method: IdentityDictionary
_deferredGciUpdateWith: valueArray

"Private."

1 to: valueArray size do:[:j | self add: (valueArray at: j) ].
%

category: 'Searching'
method: IdentityDictionary
includesIdenticalAssociation: anAssociation

"(R) Returns true if anAssociation is identical to one of the Associations of 
 the receiver.  Returns false otherwise."

self associationsDo: [ :assoc | (anAssociation == assoc) ifTrue: [ ^true ]].
^false
%

category: 'Updating'
method: IdentityDictionary
changeToSegment: segment

"(R) Assigns the receiver and all its components to the given segment. Returns
 the receiver."

super changeToSegment: segment.
self associationsDo: [ :anAssoc |
  anAssoc assignToSegment: segment
  ].

^ self.
%


