!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: symboldictionary.gs,v 1.17.2.4 2008-03-04 19:03:19 dhenrich Exp $
!
! Superclass Hierarchy:
!    SymbolDictionary, IdentityDictionary, IdentityKeyValueDictionary, 
!    KeyValueDictionary, AbstractDictionary, Collection, Object
!
!=========================================================================

removeallmethods SymbolDictionary
removeallclassmethods SymbolDictionary

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

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

txt := (GsDocText new) details:
'A SymbolDictionary is an IdentityDictionary in which the keys are canonical
 symbols (Symbols or DoubleByteSymbols) and the values are SymbolAssociations.
 The key of each SymbolAssociation is also the key used by the SymbolDictionary
 to access that SymbolAssociation.

 Only SymbolDictionaries can be used in symbol lists.' .
doc documentClassWith: txt.

txt := (GsDocText new) details:
'Methods in this category are obsolete and are provided only for compatibility
 with earlier releases of GemStone.  They will be removed in a future release.'.
doc documentCategory: #'Backward Compatibility' with: txt.

self description: doc.
%

category: 'Browser Methods'
classmethod: SymbolDictionary
_listClassesIn: aDict

"Returns a String describing the classes contained in the argument.  If aDict
 is not a kind of SymbolDictionary, returns false."

"Used by Topaz."

| result aSet sortedNames lf |
(aDict isKindOf: self) ifFalse:[ ^ false ].
aSet := SymbolSet new .
aDict associationsDo:[:assoc |
  (assoc value isKindOf:Class) ifTrue:[ aSet add: assoc key ]. 
  ].
lf := Character lf .
aSet size == 0 ifTrue:[ 
  ^ 'The dictionary contains no classes.
' 
  ].
sortedNames := aSet sortAscending:'' .
result := String new .
1 to: sortedNames size do:[:j |
  result addAll: (sortedNames at: j); add: lf .
  ].
^ result
%

! removed reimplementation of new . default table size of 503
!  caused bug 31421

category: 'Accessing'
method: SymbolDictionary
associationAt: aKey

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

| anAssoc |

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

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

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

<primitive: 57>
| aSym |
aKey _isSymbol ifFalse:[
  aSym := Symbol _existingWithAll: aKey .
  aSym ~~ nil ifTrue:[
    ^ self associationAt: aSym ifAbsent: aBlock .
    ]
  ].
aBlock == nil ifTrue:[ ^ nil ] .
^ aBlock value
%

! inherited:
! at: aKey 

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

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

<primitive: 240>
| aSym |
aKey _isSymbol ifFalse:[
  aSym := Symbol _existingWithAll: aKey .
  aSym ~~ nil ifTrue:[
    ^ self at: aSym ifAbsent: aBlock .
    ]
  ].
aBlock == nil ifTrue:[ ^ nil ] .
^ aBlock value
%

category: 'Searching'
method: SymbolDictionary
includesKey: aKey

"Reimplemented from KeyValueDictionary for efficiency."

^ (self associationAt: aKey otherwise: nil ) ~~ nil
%

category: 'Backward Compatibility'
method: SymbolDictionary
detectValues: aBlock ifNone: exceptionBlock

"Obsolete in GemStone 5.0.  Use the keysAndValuesDo: method instead."

"Evaluates aBlock repeatedly, with values of the receiver as the argument.
 Returns the first key for which aBlock evaluates to true.  If none of the
 receiver's values evaluates to true, evaluates the argument exceptionBlock and
 returns its value.  The argument aBlock must be a one-argument block, and
 exceptionBlock must be a zero-argument block."

self keysAndValuesDo: [ :aKey :aValue |
  (aBlock value: aValue) ifTrue: [ ^ aKey ].
  ].
^ exceptionBlock value.
%

category: 'Accessing'
method: SymbolDictionary
at: aKey

"Returns the value at the given key.  Generates an error if aKey not found."

| assoc |
assoc := self associationAt: aKey otherwise: nil .
assoc == nil ifTrue:[ ^ self _errorKeyNotFound: aKey ].
^ assoc value
%

category: 'Accessing'
method: SymbolDictionary
at: aKey otherwise: defaultValue

"Returns the value at the given key.  If aKey is not found, returns
 defaultValue."

| assoc |
assoc := self associationAt: aKey otherwise: nil .
assoc == nil ifTrue:[ ^ defaultValue ].
^ assoc value
%

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

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

<primitive: 57>

| aSym |
aKey _isSymbol ifFalse:[
  aSym := Symbol _existingWithAll: aKey .
  aSym ~~ nil ifTrue:[
    ^ self associationAt: aSym otherwise: defaultValue
    ]
  ].
^defaultValue
%

!inherited: at: aKey otherwise: aValue

category: 'Accessing'
method: SymbolDictionary
name

"Returns the key of a SymbolAssociation whose value is the receiver.  If the
 receiver contains no such SymbolAssociation, returns nil."

^self keyAtValue: self ifAbsent: [^nil]
%

category: 'Accessing'
method: SymbolDictionary
names

"Returns an Array that contains all the keys of entries in the receiver whose
 value is the receiver itself.  The order of the elements in the result is
 arbitrary.  If no such keys are found, returns an empty Array."

| result |
result := Array new .
self keysAndValuesDo:[:aKey :aValue | 
  aValue == self ifTrue:[ result add: aKey ].
  ].
^ result
%

category: 'Accessing'
method: SymbolDictionary
name: aSymbol

"Equivalent to self at: aSymbol put: self."

^ self at: aSymbol put: self
%

category: 'Accessing'
method: SymbolDictionary
keys

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

| result |
result := SymbolSet new .
self keysAndValuesDo:[ :aKey :aValue | result add: aKey ].
^ result
%

! add inherited
! rebuildTable: newSize
! removeAssociation: aSymAssoc
! removeAssociation: aSymAssoc ifAbsent: aBlock
! removeKey: aKey
! removeKey: aKey ifAbsent: aBlock
! select: aBlock
! detect: aBlock
! reject: aBlock
! selectValues: aBlock
! detectValues: aBlock ifNone: exceptionBlock
! inherited
! rejectValues: aBlock

category: 'Updating'
method: SymbolDictionary
atHash: hashIndex putKey: aKey

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

aKey _isSymbol ifFalse:[ 
  aKey == nil ifFalse:[ aKey _errorExpectedClass: Symbol ].
  ].
self _validatePrivilegeOld: (self keyAtHash: hashIndex) new: aKey.
^super atHash: hashIndex putKey: aKey.
%

category: 'Updating'
method: SymbolDictionary
atHash: hashIndex putValue: aValue

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

| valueCls |

self _validatePrivilegeOld: (self valueAtHash: hashIndex) new: aValue.
valueCls := aValue _class .
(valueCls == SymbolAssociation) ifFalse:[
  (valueCls == CollisionBucket) ifFalse:[
    aValue ~~ nil ifTrue:[
      (aValue isKindOf: SymbolAssociation) ifFalse:[ 
        (aValue isKindOf: CollisionBucket) ifFalse:[
          aValue _error: #rtErrInvalidArgClass args: 
              #[ SymbolAssociation, CollisionBucket, UndefinedObject ]
          ]
        ]
      ].
    ].
  ].
^super atHash: hashIndex putValue: aValue.
%

category: 'Updating'
method: SymbolDictionary
addAssociation: aSymbolAssociation

"Add the argument to the receiver."

aSymbolAssociation _class == SymbolAssociation ifFalse:[
  aSymbolAssociation _validateClass: SymbolAssociation
  ].
self _validatePrivilegeOld: (self at: aSymbolAssociation key otherwise: nil)
                       new: aSymbolAssociation value.
^ self _at: aSymbolAssociation key put: aSymbolAssociation
%

category: 'Updating'
method: SymbolDictionary
renameAssociationFrom: key1 to: key2 

"Look up the Association in the receiver that has key1, and change its
 key to key2.  Raises an error if key1 is not found, or if key2 already
 exists.  key1 and key2 must be Symbols."

| assoc |
key1 _validateClass: Symbol.
key2 _validateClass: Symbol.
assoc := self associationAt: key1 .
self _validatePrivilegeOld: assoc value new: assoc value.
self removeKey: key1 .
(self associationAt: key2 otherwise: nil) ~~ nil ifTrue:[
  ^ self _error: #rtErrDuplicateKey args: #[ key2 ]. 
  ].
assoc key: key2 .
self addAssociation: assoc .
%

category: 'Updating'
method: SymbolDictionary
swapKey: key1 with: key2

"In the receiver, look up the Associations for key1 and key2 and
 swap the keys of the two Associations.  Returns the receiver.
 If either key1 or key2 is not found in the receiver, raises an error."

| assoc1 assoc2 |

key1 _validateClass: Symbol.
key2 _validateClass: Symbol.
assoc1 := self associationAt: key1 .
assoc2 := self associationAt: key2 .
self _validatePrivilegeOld: assoc1 value new: assoc1 value.
self _validatePrivilegeOld: assoc2 value new: assoc2 value.
self removeKey: key1 .
self removeKey: key2 .
assoc1 key: key2 .
assoc2 key: key1 .
self addAssociation: assoc1 .
self addAssociation: assoc2
%

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

"If the receiver already contains a SymbolAssociation with the given key, this
 makes aValue the value of that SymbolAssociation.  Otherwise, this creates a
 new SymbolAssociation with the given key and value and adds it to the
 receiver.  aKey must be a Symbol.   Returns aValue."

| anAssoc |
self _validatePrivilegeOld: (self at: aKey otherwise: nil) new: aValue.
anAssoc:= self associationAt: aKey otherwise: nil .
anAssoc == nil ifTrue:[
     self _at: aKey put:
     (SymbolAssociation newWithKey: aKey value: aValue).
     ^aValue
].
anAssoc value: aValue.
^aValue
%

! doAssociations removed; inherit from KeyValueDictionary
! collectAssociations: aBlock
! detectAssociations: aBlock
! detectAssociations: aBlock ifNone: exceptionBlock
! rejectAssociations: aBlock
! selectAssociations: aBlock
! Inherited: _lockableValues
! inherited:
! keyAtValue: anObject ifAbsent: aBlock

category: 'Accessing'
method: SymbolDictionary
_behaviorKeys

"Returns a SymbolSet containing keys in the receiver whose values are
 Behaviors."

"This is used as an optimization by the GemBuilder for Smalltalk browser."

| result |
result := SymbolSet new .
self keysAndValuesDo:[ :aKey :aValue |
  aValue isBehavior ifTrue: [ result add: aKey ]].
^ result
%

category: 'Browser Methods'
method: SymbolDictionary
_classAndVersionStrings

"For all Behaviors in the receiver, returns an OrderedCollection of Strings
 showing the class name and version.  This method is used as an optimization by
 the GemBuilder for Smalltalk browser."

| result |
result := OrderedCollection new .
self associationsDo: [ :anAssoc | | each |
  each := anAssoc value.
  each isBehavior
  ifTrue: [ result add: 
              ( each classHistory size == 1
                 ifTrue: [ each name asString ]
                 ifFalse: [ each name , ' [ ' ,  
                      ( each classHistory indexOf: each ) printString , ' ]' ]
               )
    ] 
  ].
^result
%

category: 'Formatting'
method: SymbolDictionary
printOn: aStream

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

| count sz |
aStream nextPutAll: self asString.
aStream nextPutAll: '( ' .
count := 1 .
sz := self size .
self associationsDo: [ :anElement|
  aStream position > 700 ifTrue:[
    "prevent infinite recursion when printing cyclic structures, and
     limit the size of result when printing large collections."
    aStream nextPutAll: '...)' .
    ^ self
    ] .
  self == anElement value
    ifTrue: [ aStream nextPutAll: self asString ]
    ifFalse: [ anElement printOn: aStream ].
  count < sz ifTrue:[ aStream nextPutAll: ', ' ].
  count := count + 1 .
  ].
aStream nextPut: $) .
%

! edited to fix 37218
category: 'Evaluation'
method: SymbolDictionary
textForError: aNumber args: anArray

"Returns a String representing the given error."

| messagesDict errDescriptor myLanguage result anException |

anException:= Exception category: nil number: nil do:
   [:ex :cat :num :args | anException remove .
   "no recursive errors, please"
   ^ 'Error building error string for ' , cat asString , ':' , num asString
   ].

myLanguage := System myUserProfile nativeLanguage.
messagesDict := self at: myLanguage 
                     ifAbsent: [^ self _errorKeyNotFound: myLanguage].
errDescriptor := messagesDict at: aNumber .

result := String new.

errDescriptor do: [ :arg |
  (arg isKindOf: String) ifTrue: [
      result addAll: arg
    ] ifFalse: [
      (arg _isSmallInteger) ifTrue: [
	  result addAll:  (anArray at: arg) asString
      ] ifFalse: [
	  result addAll: '???'.  "peculiar error list"
      ]
    ]
  ].
^ result
%

category: 'Repository Conversion'
method: SymbolDictionary
conversionRebuild

"Private."

^ self.
%

category: 'Repository Conversion'
method: SymbolDictionary
convertClassesTo5

"Private.  Recompiles all the classes in the dictionary."

| classList aClass |

"First fix up all the Metaclasses"
classList := IdentitySet new .
self valuesDo: [ :aValue |
  (aValue isKindOf: Class) ifTrue:[ classList add: aValue ].
  ].
classList := classList asArray .
    

"Now fix up all Metaclasses in the class histories"
1 to: classList size do:[:j | | aClassHist classHistSize |
  aClass := classList at: j .
  aClass _class convertTo5 .
  aClassHist := aClass classHistory.
  classHistSize := aClassHist _basicSize.
  1 to: classHistSize do: [ :i | |oldClass|
    oldClass := aClassHist at: i.
    aClass == oldClass ifFalse:[ oldClass _class convertTo5 ].
    ].
  ].

"Now fix up all the classes"
1 to: classList size do:[:j | 
  aClass := classList at: j .
  aClass convertTo5 .
  ].

"Now fix up all classes in the class histories"
1 to: classList size do:[:j | | aClassHist classHistSize |
  aClass := classList at: j .
  aClassHist := aClass classHistory.
  classHistSize := aClassHist _basicSize.
  1 to: classHistSize do: [ :i | |oldClass|
    oldClass := aClassHist at: i.
    oldClass == aClass ifFalse:[ oldClass convertTo5 ].
    ].
  ].
%

! deleted convRecompileAllClassesWith:

category: 'Repository Conversion'
method: SymbolDictionary
convertPoolDictionary

"Returns self.  There is no need to convert a SymbolDictionary."

^self
%

category: 'Repository Conversion'
method: SymbolDictionary
rehashForConversion

"(R) Private. Rehashes the receiver because the hash values of some of its keys
 may have changed.  Returns true if the rehashing is successful.  Returns false
 otherwise. 
 
 Nothing needs to be done for SymbolDictionary because the class 
 SymbolDictionary is new in 5.0. The 4.1 instances of SymbolDictionary get
 converted to instances of ObsoleteSymbolDictionary at the time of restore."

^ true.
%

! fixed 32112
category: 'CodeModification Override'
method: SymbolDictionary
addAll:  aCollection

(aCollection isKindOf: AbstractDictionary)
ifTrue: [
    aCollection associationsDo: [:x |
        self _validatePrivilegeOld: (self at: x key otherwise: nil)
                               new: x value ] ]
ifFalse: [
    aCollection do: [:x | 
        x _validateClass: Association.
        self _validatePrivilegeOld: (self at: x key otherwise: nil)
                               new: x value ] ].
^ super addAll: aCollection
%

category: 'CodeModification Override'
method: SymbolDictionary
removeAssociation: anAssociation

self _validatePrivilegeOld: (self at: anAssociation key otherwise: nil)
                       new: anAssociation value.
^ super removeAssociation: anAssociation
%

category: 'CodeModification Override'
method: SymbolDictionary
removeAssociation: anAssociation ifAbsent: aBlock

self _validatePrivilegeOld: (self at: anAssociation key otherwise: nil)
                       new: anAssociation value.
^ super removeAssociation: anAssociation ifAbsent: aBlock
%

category: 'CodeModification Override'
method: SymbolDictionary
removeKey: aKey

self _validatePrivilegeOld: ( self at: aKey otherwise: nil )
                       new: ( self at: aKey otherwise: nil ).
^ super removeKey: aKey
%

category: 'CodeModification Override'
method: SymbolDictionary
removeKey: aKey ifAbsent: aBlock

self _validatePrivilegeOld: ( self at: aKey otherwise: nil )
                       new: ( self at: aKey otherwise: nil ).
^ super removeKey: aKey ifAbsent: aBlock
%

category: 'CodeModification Override'
method: SymbolDictionary
_at: aKey put: anObject

self _validatePrivilegeGeneric: anObject.
^ super _at: aKey put: anObject
%

category: 'CodeModification Override'
method: SymbolDictionary
_basicAt: anInteger put: anObject

self _validatePrivilegeGeneric: anObject.
^ super _basicAt: anInteger put: anObject
%

category: 'CodeModification Override'
method: SymbolDictionary
_primitiveAt: anInteger put: anObject

self _validatePrivilegeGeneric: anObject.
^ super _primitiveAt: anInteger put: anObject
%

category: 'CodeModification Override'
method: SymbolDictionary
_unsafeAt: anInteger put: anObject

self _validatePrivilegeGeneric: anObject.
^ super _unsafeAt: anInteger put: anObject
%

category: 'CodeModification Override'
method: SymbolDictionary
_validatePrivilegeOld: oldValue new: newValue

( oldValue isKindOf: Behavior ) ifTrue: [
  System myUserProfile _validateCodeModificationPrivilege
  ].
( newValue isKindOf: Behavior ) ifTrue: [
  System myUserProfile _validateCodeModificationPrivilege
  ].
%

category: 'CodeModification Override'
method: SymbolDictionary
_validatePrivilegeGeneric: newValue

" This version covers any weird arguments being passed 
  in primitive _at:put: methods and variations "

System _protectedMode 
    ifTrue: [ 
      "We go into protected mode when we rebuildTable:, do we don't need to worry about privileges"
      ^self 
    ].

( newValue isKindOf: Behavior ) ifTrue: [
   ^ System myUserProfile _validateCodeModificationPrivilege
   ].

( newValue isKindOf: Association ) ifTrue: [ 
    ( newValue value isKindOf: Behavior ) ifTrue: [
        ^ System myUserProfile _validateCodeModificationPrivilege
       ] 
    ].

( newValue isKindOf: AbstractCollisionBucket ) ifTrue: [
    1 to: newValue size do: [ :i |
      (( newValue valueAt: i ) isKindOf: Behavior ) ifTrue: [
	^ System myUserProfile _validateCodeModificationPrivilege
	].
      ].
    ].
%

category: 'CodeModification Override'
method: SymbolDictionary
rebuildTable: newSize

<primitive: 901>  "enter protected mode, to disable CodeModification checks"

super rebuildTable: newSize.

System _disableProtectedMode. " exit protected mode "
%
