! ========================================================================
! Copyright (C) by VMware, Inc. 1991-2011.  All Rights Reserved
!
! $Id: set.gs,v 1.11 2008-01-09 22:50:15 stever Exp $
!
! Superclass Hierarchy
!   Set, UnorderedCollection, Collection, Object
!
! ========================================================================
expectvalue %String
run
^ UnorderedCollection _newKernelSubclass: 'Set'
        instVarNames: #( 'dict' )
        classVars: #()
        classInstVars: #()
        poolDictionaries: #[]
        inDictionary: Globals
        constraints: #[ #[ #dict, KeyValueDictionary ] ]
        instancesInvariant: false
        isModifiable: false
        reservedOop: 801
%
run
Set _disallowGciCreateStore .
^ true
%

removeallmethods Set
removeallclassmethods Set

! ------------------- Class methods for Set

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

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

txt := (GsDocText new) details:
'A Set is an UnorderedCollection in which any distinct object can occur only
 once.  Adding the same (identical) object to a Set multiple times is redundant.
 The result is the same as adding it once.

 Since a Set is an equality-based collection, different (non-identical) but
 equivalent (equal) objects are not treated as distinct from each other.  In
 IdentitySets, they are distinct.  Adding multiple equivalent objects to a Set
 yields a Set with the object that was added last.  In short, two different
 elements of a Set are neither identical nor equivalent.

 You can create subclasses of Set to restrict the kind of elements it contains.
 When creating a subclass of Set, you must specify a class as the aConstraint
 argument.  This class is called the element kind of the new subclass.  For each
 instance of the new subclass, the class of each element must be of the element
 kind.' .
doc documentClassWith: txt.

txt := (GsDocText new) details:
'A KeyValueDictionary that organizes the elements and element counts for the
 Set.' .
doc documentInstVar: #dict with: txt.

self description: doc.
%

category: 'Instance Creation'
classmethod: Set
new

"Returns an instance of the receiver whose contents are empty."

^ (self basicNew) initialize: 0
%

category: 'Instance Creation'
classmethod: Set
new: initialSize

"Returns an instance of the receiver whose contents are empty."

^ (self basicNew) initialize: initialSize.
%
category: 'Accessing the Class Format'
classmethod: Set
firstPublicInstVar

^ 6
%

! ------------------- Instance methods for Set
category: 'Adding'
method: Set
add: newObject

"Makes newObject one of the receiver's elements and returns newObject. 
 If an equivalent element is already present in the receiver, the 
 receiver is not modified.  A set can have only one occurrence of 
 equivalent objects."

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

| constr idxRes |

"assign _levels  so that authorization and concurrency conflicts on the
 root object can be detected."
_levels := _levels .

newObject == nil ifTrue: [ ^newObject ].

(constr := self class varyingConstraint) == Object ifFalse:[
  (newObject isKindOf: constr) ifFalse:[ 
    ^ self _error: #objErrDictConstraintViolation
	     args: #[newObject, constr, newObject class]
    ]
  ].

(dict includesKey: newObject) ifFalse:[
  _indexedPaths ~~ nil ifTrue:[
    idxRes := self _updateIndexesForAdditionOf: newObject logging: true. 
    idxRes == true
      ifFalse: [ ^ self _raiseIndexingError: idxRes ]
    ].
  dict at: newObject put: newObject .
  ].
^ newObject.
%

category: 'Adding'
method: Set
add: anObject withOccurrences: anInteger

"Disallowed.  Each element of a Set must be unique."

self shouldNotImplement: #add:withOccurrences:
%

category: 'Accessing'
method: Set
at: anIndex

"Disallowed."

^ self shouldNotImplement: #at:
%

category: 'Updating'
method: Set
at: anIndex put: anObject

"Disallowed."

^ self shouldNotImplement: #at:put:
%

category: 'Enumerating'
method: Set
do: aBlock

"(R) Evaluates the one-argument block aBlock using each element of the
 receiver.  Returns the receiver."

| tmp |
"read _levels so that authorization and concurrency conflicts on the
 root object can be detected."
tmp := _levels.

dict keysDo: [ :aKey | aBlock value: aKey ].
^ self.
%

category: 'Searching'
method: Set
includesValue: anObject

"(R) Returns true if anObject is equal to one of the elements of the receiver. 
 Returns false otherwise."

| tmp |
"read _levels so that authorization and concurrency conflicts on the
 root object can be detected."
tmp := _levels.

^ dict includesKey: anObject 

%
category: 'Searching'
method: Set
includes: anObject

"(R) Returns true if anObject is equal to one of the elements of the receiver. 
 Returns false otherwise."

"Note: In GemStone 4.1, this method returned true only if one of the elements of
 the receiver was identical to anObject.  For functionality similar to that 
 provided by GemStone 4.1, use #includesIdentical:."

| tmp |
"read _levels so that authorization and concurrency conflicts on the
 root object can be detected."
tmp := _levels.

^ dict includesKey: anObject.
%

category: 'Searching'
method: Set
includesIdentical: anObject

"Returns true if anObject is identical to one of the elements of the receiver.
 Returns false otherwise."

| tmp |
"read _levels so that authorization and concurrency conflicts on the
 root object can be detected."
tmp := _levels.

anObject == nil ifTrue:[ ^ false ].
^ anObject == (dict keyAt: anObject otherwise: nil) 
%

category: 'Private'
method: Set
initialize: initialSize

"Initializes the receiver immediately after creation.  Returns the receiver."

_indexedPaths ~~ nil ifTrue:[
   dict keysDo:[:anObj | self _updateIndexesForRemovalOf: anObj ] 
   ].
dict := KeyValueDictionary new: initialSize.
%

category: 'Searching'
method: Set
occurrencesOf: anObject

"(R) Returns the number of the receiver's elements that are equal to anObject."

| tmp |
"read _levels so that authorization and concurrency conflicts on the
 root object can be detected."
tmp := _levels.

(dict includesKey: anObject)
  ifTrue: [ ^ 1 ].

^ 0.
%

category: 'Hashing'
method: Set
rehash

"(R) Rebuilds the receiver to ensure its consistency.  Returns the receiver."

"assign _levels  so that authorization and concurrency conflicts on the
 root object can be detected."
_levels := _levels .

dict _rebuild.
^self
%

category: 'Removing'
method: Set
remove: anObject 

"(R) Removes from the receiver one object that is equivalent to anObject and 
 returns anObject.  Generates an error if anObject has no equivalent element
 in the receiver."

"Note: In GemStone 4.1, this method returned the receiver if an object
 equivalent to anObject was found in the receiver."

^ self remove: anObject ifAbsent:[ self _errorNotFound: anObject ]
%

category: 'Removing'
method: Set
remove: anObject ifAbsent: anExceptionBlock

"(R) Removes from the receiver one object that is equivalent to anObject and 
 returns anObject. If anObject has no equivalent elements in the receiver,
 evaluates anExceptionBlock and returns the result."

"Note: In GemStone 4.1, this method returned the receiver if an object
 equivalent to anObject was found in the receiver."

| removedObj |

"assign _levels  so that authorization and concurrency conflicts on the
 root object can be detected."
_levels := _levels .

_indexedPaths ~~ nil ifTrue:[
  removedObj := dict at: anObject otherwise: nil .
  removedObj ~~ nil ifTrue:[
    self _updateIndexesForRemovalOf: removedObj .
    dict removeKey: removedObj ifAbsent:[ self _halt:'Set remove failed' ].
    ]
  ifFalse:[ ^ anExceptionBlock value ].
  ]
ifFalse:[
  dict removeKey: anObject ifAbsent:[ ^ anExceptionBlock value].
  ].  
^ anObject.
%

category: 'Removing'
method: Set
removeAll: aCollection

"Removes each element of aCollection from the receiver and returns the receiver.
 Generates an error if any element of aCollection is not present in the
 receiver."

"assign _levels  so that authorization and concurrency conflicts on the
 root object can be detected."
_levels := _levels .

aCollection == self ifTrue:[
   self initialize: 0 .
   ]
ifFalse:[
  aCollection do:[:anObject | self remove: anObject ].
  ].
%

category: 'Accessing'
method: Set
size

"(R) Returns the number of elements contained in the receiver."

| tmp |
"read _levels so that authorization and concurrency conflicts on the
 root object can be detected."
tmp := _levels.

^ dict size
%

category: 'Converting'
method: Set
asSet

"(R) Returns a Set with the contents of the receiver."

^ self
%

category: 'Converting'
method: Set
_asIdentityBag

"Private.  Returns an IdentitySet containing all of the elements of the
 receiver."

"Used by index creation."

| result  tmp |
"read _levels so that authorization and concurrency conflicts on the
 root object can be detected."
tmp := _levels.

result := IdentitySet new .
dict keysAndValuesDo:[:aKey :aValue| result add: aKey ].
^ result
%

category: 'Private'
method: Set
_deferredGciUpdateWith: valueArray

"Private."

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

category: 'Instance Initialization'
method: Set
_gciInitialize

"Private."

self initialize: 0 .
%

category: 'Private'
method: Set
_finishShallowCopy

"Private."

 super _finishShallowCopy .
 dict := dict copy .
%

category: 'Removing'
method: Set
removeIdentical: anObject ifAbsent: anExceptionBlock

"(R) Removes from the receiver an object that is identical to anObject.
 Returns anObject.  If several elements of the receiver are identical to 
 anObject, only one instance is removed.  If anObject has no equivalent 
 elements in the receiver, evaluates anExceptionBlock and returns the result."

"assign _levels  so that authorization and concurrency conflicts on the
 root object can be detected."

_levels := _levels .
(self includesIdentical: anObject) ifFalse: 
    [^anExceptionBlock value].
^self remove: anObject
%
category: 'Enumerating'
method: Set
speciesForCollect

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

^ Bag
%

category: 'Updating'
method: Set
changeToSegment: segment

"Assigns the receiver and its private objects to the given segment."

super changeToSegment: segment.
dict == nil ifFalse:[ dict changeToSegment: segment ]
%

! delete assignToSegment:


