!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: newcanonstringdict.gs,v 1.13 2008-01-09 22:50:12 stever Exp $
!
!  New class in Gemstone64 1.0
!
! Superclass Hierarchy:
!   CanonStringDict, 
!   AbstractDictionary, Collection, Object.
!
!=========================================================================

expectvalue %String
run
AbstractDictionary _newKernelSubclass: #CanonStringDict 
  instVarNames: #(numElements tableSize)
  classVars: #()
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #[ #[ #numElements, SmallInteger],
                  #[ #tableSize, SmallInteger],
                  CanonStringBucket ]
  instancesInvariant: false
  isModifiable: false
  reservedOop: 933 
%

expectvalue true
run
CanonStringDict _disallowGciCreateStore .
^ true
%

removeallmethods CanonStringDict
removeallclassmethods CanonStringDict

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

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

txt := (GsDocText new) details:
'A CanonStringDict is a dictionary that provides
 protocol that is similar to Set in addition to its dictionary protocol.
 It uses sorted collision buckets, and stores only keys. Each slot in
 the dictionary object contains a references to a bucket, or nil  ' .
doc documentClassWith: txt.

self description: doc.
%


! ------------------- Class methods 

category: 'Instance Creation'
classmethod: CanonStringDict
new

"Creates an instance of CanonStringDict with a default table size."

^ self new: 20

%
category: 'Instance Creation'
classmethod: CanonStringDict
new: tableSize

"Creates an instance of CanonStringDict with the specified table size."

| aPrime |
aPrime := Integer _selectedPrimeGreaterThan: tableSize.
^ self _new: aPrime 
%

category: 'Instance Creation'
classmethod: CanonStringDict
_new: aPrime

"Private"

| newDict |
newDict := super _basicNew: aPrime .
newDict _initializeWithoutClear: aPrime .
^ newDict .
%

! ------------------- Instance methods 

category: 'Private'
method: CanonStringDict
_initializeWithoutClear: newSize

"Private. Initializes the instance variables of the receiver to be an empty
 KeyValueDictionary of the specified size. Does not clear the contents
 of the receiver - assumes they are all nil."

tableSize := newSize.
numElements := 0.

^self
%

category: 'Initializing'
method: CanonStringDict
initialize: itsSize

"Initializes the instance variables of the receiver to be an empty
 dictionary of the specified size."

| newSize |

newSize := itsSize .

(newSize <= 0)
  ifTrue: [
    newSize _error: #rtErrArgNotPositive.
    newSize := 3
    ].

self _basicSize: 0.  "Set size to 0 and restore to nil any entries"
self _basicSize: newSize .
self _initializeWithoutClear: newSize.
^self
%


category: 'Adding'
method: CanonStringDict
add: aString

"Adds aString if it is not already present in the receiver, and returns
 either aString or the canonical string already present."

<primitive: 478>
aString _validateClass: String . 
self _primitiveFailed: #add: .
self _uncontinuableError
%

category: 'Adding'
method: CanonStringDict
addKey: aString

"Adds aString if it is not already present in the receiver, and returns
 either aString or the canonical string already present."

^ self add: aString
%

category: 'Adding'
method: CanonStringDict
addAll: aCollection

"Adds elements of aCollection to the receiver. If aCollection is
 a Dictionary, adds only the keys to the receiver .
 Returns aCollection."

aCollection == self ifTrue:[ ^ aCollection ].
(aCollection isKindOf: AbstractDictionary)
  ifTrue:[ ^ aCollection doKeys:[:aKey | self add: aKey ] ].
aCollection do:[ :aString | self add: aString ].
^ aCollection
%

! associationsDo: not implemented  , CanonStringDict's do not hold assocations

category: 'Searching'
method: CanonStringDict
includesAssociation: anAssociation

"CanonStringDict's do not hold assocations"

^ self shouldNotImplement: #includesAssociation:
%

category: 'Searching'
method: CanonStringDict
includesIdenticalAssociation: anAssociation

"CanonStringDict's do not hold assocations"

^ self shouldNotImplement: #includesIdenticalAssociation:
%


category: 'Enumerating'
method: CanonStringDict
associationsDetect: aBlock ifNone: exceptionBlock

"CanonStringDict's do not hold assocations"

^ self shouldNotImplement: #associationsDetect:ifNone:
%

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

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

<primitive: 481>
aBlock _validateClass: BlockClosure.
^ aBlock value 
%


category: 'Accessing'
method: CanonStringDict
at: aKey ifAbsentPut: aBlock

"not implemented, key-value pairs not supported "

^ self shouldNotImplement: #at:ifAbsentPut:
%

category: 'Accessing'
method: CanonStringDict
at: aString otherwise: value

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

<primitive: 481>
aString _validateClass: String .
^ value 
%

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

"CanonStringDict's do not hold key-value pairs, use add: or addKey: "

^ self shouldNotImplement: #at:put:
%

category: 'Enumerating'
method: CanonStringDict
collect: aBlock

"CanonStringDict's do not hold key-value pairs."

^ self shouldNotImplement: #collect:
%

category: 'Enumerating'
method: CanonStringDict
collectAssociations: aBlock

"CanonStringDict's do not hold key-value pairs."

^ self shouldNotImplement: #collectAssociations:
%

category: 'Private'
method: CanonStringDict
tableSize

"Returns the size of hash table used for storing the entries."

^ tableSize 
%

category: 'Accessing'
method: CanonStringDict
size

"Returns the number of elements contained in the receiver."

^ numElements
%

category: 'Searching'
method: CanonStringDict
includes: aString

"Returns true if the receiver contains aString as a key, false otherwise."

| aValue |
aValue := self at: aString otherwise: nil .
^ aValue ~~ nil
%

category: 'Searching'
method: CanonStringDict
includesKey: aKey

"Returns true if the receiver contains an Association or a key-value pair whose
 key is equal to aKey.  Returns false otherwise."

^ self includes: aKey 
%

category: 'Searching'
method: CanonStringDict
includesIdentical: aString

"Returns true if the receiver contains an a String identical to the
 argument, false otherwise."

| elem |
elem := self at: aString otherwise: nil .
elem == nil ifFalse:[ ^ aString == elem ].
^ false .
%

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

"not implemented, CanonStringDict's do not hold key-value pairs."

^ self shouldNotImplement: #keyAtValue:ifAbsent: 
%

category: 'Accessing'
method: CanonStringDict
keys

"Returns a Set containing the receiver's keys."

| aSet |

aSet := IdentitySet new.
self keysDo: [ :key | aSet add: key ].
^ aSet
%

! fixed 31083, 31084
category: 'Enumerating'
method: CanonStringDict
keysDo: aBlock

"Iteratively evaluates the one argument block, aBlock, using each key of
 the receiver as the argument to the block. Returns the receiver."

| aBucket |
1 to: tableSize do:[:k |
  aBucket := self _at: k .
  aBucket ~~ nil ifTrue:[ aBucket keysDo: aBlock ].
  ].
%

category: 'Private'
method: CanonStringDict
_collisionBucketsDo: aBlock
"Private.  Executes the given one-argument block for each collision bucket
 in the receiver."

| aBucket |
1 to: tableSize do:[:k |
  aBucket := self _at: k .
  aBucket ~~ nil ifFalse:[ aBlock value: aBucket ].
  ].
%

category: 'Searching'
method: CanonStringDict
occurrencesOf: aValue

"key value pairs are not supported"

^ self shouldNotImplement: #occurrencesOf:
%

category: 'Searching'
method: CanonStringDict
occurrencesOfIdentical: aValue

"key value pairs are not supported"

^ self shouldNotImplement: #occurrencesOfIdentical:
%

category: 'Enumerating'
method: CanonStringDict
reject: aBlock

"key value pairs are not supported"

^ self shouldNotImplement: #reject
%

category: 'Removing'
method: CanonStringDict
remove: aString

"Removes aString if present in the receiver and returns the removed value.  If
 aString is not present, generates an error."

^ self removeKey: aString
%

category: 'Removing'
method: CanonStringDict
remove: aString ifAbsent: aBlock

"Removes aString if present in the receiver and returns the removed value.  If
 aString is not present, returns the result of evaluating the zero
 argument Block aBlock."

^ self removeKey: aString ifAbsent: aBlock
%

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

| elem hash aBucket |
elem := self at: aKey otherwise: nil .
elem ~~ nil ifTrue:[
  hash := self hashFunction: aKey .
  aBucket := self _at:  hash .
  aBucket removeKey: aKey ifAbsent: [ self _error:'inconsistent bucket'].
  ^ elem 
  ]
ifFalse:[ ^ aBlock value ].
%

category: 'Hashing'
method: CanonStringDict
hashFunction: aString

^ ((self _basicHash: aString) \\ self tableSize) + 1

%

category: 'Hashing'
method: CanonStringDict
_basicHash: aString

"Private. The hash value is a case-sensitive hash value of the bytes of a
 string without regard to whether the string contains single or
 double byte characters.  The strings are canonicalized so that
 a DoubleByteString with all-ascii characters is converted to
 a String before computing the hash."
<primitive: 519>
aString _validateClass: String . 
self _primitiveFailed: #_basicHash: .
self _uncontinuableError
%

category: 'Formatting'
method: CanonStringDict
printOn: aStream

"Puts a displayable representation of the receiver on the given stream."

| count sz myCls |

myCls := self class .
aStream nextPutAll: myCls name describeClassName .
aStream nextPutAll: '( ' .
count := 1 .
sz := self size .
self keysDo:[:aKey | 
  aStream position > 700 ifTrue:[
    "prevent infinite recursion when printing cyclic structures, and 
     limit the size of result when printing large collections."
    aStream nextPutAll: '...)' .
    ^ self 
    ] .
  aKey printOn: aStream .
  count < sz ifTrue:[ aStream nextPutAll: ', ' ].
  count := count + 1 .
  ].
aStream nextPut: $) .
%

category: 'Comparing'
method: CanonStringDict
= anCanonStringDict

"Returns true if all of the following conditions are true:

 1.  The receiver and anCanonStringDict are of the same class.
 2.  The two dictionaries are of the same size.
 3.  The corresponding keys and values of the receiver and anCanonStringDict
     are equal."

(self == anCanonStringDict)
  ifTrue: [ ^ true ].

(self _class == anCanonStringDict _class)
  ifFalse: [ ^ false ].

(self size == anCanonStringDict size)
  ifFalse: [ ^ false ].

self keysDo: [ :aKey |
  (aKey = (anCanonStringDict at: aKey otherwise: nil))
    ifFalse: [ ^ false ]
  ].

^ true.
%

! fixed 31127
category: 'Printing'
method: CanonStringDict
asReportString

"Returns a String that lists the keys, one on each line."

| result |
result := String new.
self keysDo: [ :key |
  result add: key printString; 
    add: Character lf 
  ].
^ result
%

! deleted _canonicalizeSymbolAt: offset oldSymbol: oldSym newSymbol: newSym

category: 'Private'
method: CanonStringDict
_resetParentRef

"Private. After a become:, the parent refs of the collisionBuckets must
 be reset to point to the correct parent."

self _collisionBucketsDo: [:collisionBkt |
  collisionBkt keyValueDictionary: self].
%

! added to fix 31544  speciesForCollect, speciesForSelect, keysAndValuesDo:
category: 'Enumerating'
method: CanonStringDict
speciesForCollect

"Returns a Class, an instance of which should be used as the result of
 collect: or other projections applied to the receiver."

^ StringKeyValueDictionary
%
category: 'Enumerating'
method: CanonStringDict
speciesForSelect

"Returns a class, an instance of which should be used as the result of
 select: or other projections applied to the receiver."

^ StringKeyValueDictionary
%
category: 'Enumerating'
method: CanonStringDict
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."

1 to: tableSize do:[ :tableIndex | | collisionBkt |
  collisionBkt := self _at: tableIndex .
  collisionBkt ~~ nil ifTrue:[ collisionBkt keysAndValuesDo: aBlock ].
  ]
%

! added for 36675
method: CanonStringDict
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 ."

1 to: tableSize do:[ :tableIndex | | collisionBkt |
  collisionBkt := self _at: tableIndex .
  collisionBkt ~~ nil ifTrue:[
      collisionBkt inject: anObj keysAndValuesInto: aBlock
  ].
].
%

category: 'Updating'
method: CanonStringDict
changeToSegment: aSegment

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

| collisionBkt |

self assignToSegment: aSegment.
1 to: tableSize do: [ :tableIndex |
  collisionBkt := self _at: tableIndex .
  collisionBkt ~~ nil ifTrue:[ collisionBkt assignToSegment: aSegment ].
].
^ self.
%

