!=========================================================================
! Copyright (C) by VMware, Inc. 1991-2011.  All Rights Reserved
!
! $Id: bag.gs,v 1.14 2008-01-09 22:50:08 stever Exp $
!
! Superclass Hierarchy
!   Bag, UnorderedCollection, Collection, Object
!
!=========================================================================

expectvalue %String
run
^ UnorderedCollection _newKernelSubclass: 'Bag'
        instVarNames: #( 'dict' 'size' )
        classVars: #()
        classInstVars: #()
        poolDictionaries: #[]
        inDictionary: Globals
        constraints: #[ #[ #dict, KeyValueDictionary ],
		        #[ #size, Integer] ]
        instancesInvariant: false
        isModifiable: false
        reservedOop: 803
%
run
Bag _disallowGciCreateStore .
^ true
%

removeallmethods Bag 
removeallclassmethods Bag

! ------------------- Class methods for Bag

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

| doc txt |

doc := GsClassDocumentation newForClass: self.

txt := (GsDocText new) details:
'A Bag is an UnorderedCollection in which any distinct object can occur any
 number of times.  Adding the same (identical) object to a Bag multiple times
 simply causes it to occur multiple times in the Bag.

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

 You can create subclasses of Bag to restrict the kind of elements it contains.
 When creating a subclass of Bag, 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
 Bag.' .
doc documentInstVar: #dict with: txt.

txt := (GsDocText new) details:
'For GemStone internal use.' .
doc documentInstVar: #size with: txt.

self description: doc.
%

category: 'Instance Creation'
classmethod: Bag
new

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

^ (self basicNew) initialize: 0
%

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

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

^ (self basicNew) initialize: initialSize.
%

category: 'Accessing the Class Format'
classmethod: Bag
firstPublicInstVar

^ 7
%

! ------------------- Instance methods for Bag

category: 'Adding'
method: Bag
add: newObject

"Makes newObject one of the receiver's elements and returns newObject."

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

| constr |

"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]
    ]
  ].

^self _addConstrained: newObject withOccurrences: 1
%
category: 'Private'
method: Bag
_addConstrained: anObject withOccurrences: anInteger
    "Like #add: and add:withOccurrences: except assumes anObject is
    not nil and does meet the constraints, and that anInteger is a
    non-negative integer."

    | originalObject numOccurrences |

    "Because a Bag is equality based but the indexing objects are
    identity based, ensure the original object is used for index
    maintenance when an equal object is added more than once."

    originalObject := dict keyAt: anObject otherwise: anObject.

    _indexedPaths ~~ nil ifTrue:
        [| idxRes |
         anInteger timesRepeat:
             [idxRes := self _updateIndexesForAdditionOf: originalObject logging: true.
              idxRes == true ifFalse: 
                  [^self _raiseIndexingError: idxRes]]].

    numOccurrences := dict at: originalObject otherwise: 0.
    dict at: originalObject put: (numOccurrences + anInteger).
    size := size + anInteger.
    ^anObject.
%
category: 'Private'
method: Bag
_removeConstrained: anObject withOccurrences: anInteger

    "Like #remove: and remove:withOccurrences: except assumes anObject is
    not nil and does meet the constraints, and that anInteger is a
    non-negative integer."

    | originalObject numOccurrences finalCount |

    "Because a Bag is equality based but the indexing objects are
    identity based, ensure the original object is used for index
    maintenance when an equal object is removed more than once."

    originalObject := dict keyAt: anObject otherwise: nil.
    originalObject == nil ifTrue: [^self _errorNotFound: anObject ].

    numOccurrences := dict at: originalObject otherwise: 0.
    anInteger > numOccurrences ifTrue: [^self _errorNotFound: anObject ].

    _indexedPaths ~~ nil ifTrue: [
        anInteger timesRepeat:
            [ self _updateIndexesForRemovalOf: originalObject ] ].

    ((finalCount := numOccurrences - anInteger) > 0)
        ifTrue: [ dict at: originalObject put: finalCount ]
        ifFalse: [ dict removeKey: originalObject ].
    size := size - anInteger.
    ^anObject.
%
category: 'Private'
method: Bag
_removeConstrainedIfPresent: anObject withOccurrences: anInteger

    "Similar to _removeConstrained:withOccurrences:, but does not
     raise an error on a bag not containing (or containing too few)
     anObject."

    | originalObject numOccurrences countToRemove finalCount |

    "Because a Bag is equality based but the indexing objects are
    identity based, ensure the original object is used for index
    maintenance when an equal object is removed more than once."

    originalObject := dict keyAt: anObject otherwise: nil.
    originalObject == nil ifTrue: [^ nil ].

    numOccurrences := dict at: originalObject otherwise: 0.
    anInteger > numOccurrences
        ifTrue: [ countToRemove := numOccurrences ]
        ifFalse: [ countToRemove := anInteger ].

    _indexedPaths ~~ nil ifTrue: [
        countToRemove timesRepeat: [
            self _updateIndexesForRemovalOf: originalObject ] ].

    ((finalCount := numOccurrences - countToRemove) > 0)
        ifTrue: [ dict at: originalObject put: finalCount ]
        ifFalse: [ dict removeKey: originalObject ].
    size := size - countToRemove.
    ^anObject.
%

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

"Adds anObject anInteger number of times to the receiver and returns anObject."

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

| constr |

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

anObject == nil ifTrue: [ ^ nil ].

((anInteger _isInteger) _and: [anInteger >= 0]) ifFalse:[
   ^ anInteger _error: #rtErrInvalidArgument 
		args:#[ 'must be a non-negative Integer'].
   ]. 

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

^self _addConstrained: anObject withOccurrences: anInteger
%

category: 'Removing'
method: Bag
remove: anObject withOccurrences: anInteger

"Remove anObject anInteger number of times to the receiver and returns anObject."

| constr |

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

anObject == nil ifTrue: [ ^ nil ].

((anInteger _isInteger) _and: [anInteger >= 0]) ifFalse:[
   ^ anInteger _error: #rtErrInvalidArgument
      args:#[ 'must be a non-negative Integer'].
   ].

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

^self _removeConstrained: anObject withOccurrences: anInteger
%
category: 'Removing'
method: Bag
removeIfPresent: anObject withOccurrences: anInteger

"Remove anObject anInteger number of times to the receiver and returns anObject.
 Does not generate an error if anObject is not present (or there are not
 enough occurrences)."

| constr |

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

anObject == nil ifTrue: [ ^ nil ].

((anInteger _isInteger) _and: [anInteger >= 0]) ifFalse:[
   ^ anInteger _error: #rtErrInvalidArgument
      args:#[ 'must be a non-negative Integer'].
   ].

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

^self _removeConstrainedIfPresent: anObject withOccurrences: anInteger
%
category: 'Adding'
method: Bag
addAll: aCollection

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

(aCollection isKindOf: Bag)
ifFalse: [ super addAll: aCollection ]
ifTrue: [
    aCollection __dict keysAndValuesDo: [ :each :count |
        self add: each withOccurrences: count 
    ]
].
^ aCollection
%

category: 'Accessing'
method: Bag
at: anIndex

"Disallowed."

^ self shouldNotImplement: #at:
%

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

"Disallowed."

^ self shouldNotImplement: #at:put:
%

category: 'Enumerating'
method: Bag
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 keysAndValuesDo: [ :aKey :aValue |
  aValue timesRepeat: [ aBlock value: aKey ]
  ].

^ self.
%

category: 'Searching'
method: Bag
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: Bag
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: Bag
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: Bag
initialize: initialSize

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

_indexedPaths ~~ nil ifTrue:[
   dict keysAndValuesDo:[:anObj :numOcc|
      numOcc timesRepeat: [ self _updateIndexesForRemovalOf: anObj ]
      ] 
   ].
dict := KeyValueDictionary new: initialSize.
size := 0.
%

category: 'Searching'
method: Bag
occurrencesOf: anObject

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

"Note: In GemStone 4.1, this method returned the number of elements that were
 identical to anObject. For functionality similar to that provided in 
 GemStone 4.1, use #identicalOccurrencesOf:"

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

^ dict at: anObject otherwise: 0 .
%

category: 'Searching'
method: Bag
_detect: aBlock

dict keysDo: [:each |
    (aBlock value: each)
        ifTrue:[ ^ each ].
].
^ self _error: #assocErrNoElementsDetected args: #[aBlock] .
%

category: 'Searching'
method: Bag
_detect: aBlock ifNone: exceptionBlock

dict keysDo: [:each |
    (aBlock value: each)
        ifTrue:[ ^ each ].
].
^ exceptionBlock value
%

category: 'Searching'
method: Bag
_reject: aBlock

| result |
result:= self speciesForSelect new.
dict keysAndValuesDo: [:each :count |
    (aBlock value: each)
        ifFalse: [ result add: each withOccurrences: count ] 
].
^ result
%

category: 'Searching'
method: Bag
_select: aBlock

| result |
result:= self speciesForSelect new.
dict keysAndValuesDo: [:each :count |
    (aBlock value: each)
        ifTrue: [ result add: each withOccurrences: count ]
].
^ result
%

category: 'Hashing'
method: Bag
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: Bag
remove: anObject ifAbsent: anExceptionBlock

"(R) Removes an object that is equivalent to anObject from the receiver and 
 returns anObject.  If several elements of the receiver are equivalent to 
 anObject, only one instance is removed.  If anObject has no equivalent 
 elements in the receiver, this method 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."

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

| count |
_levels := _levels .
count := dict at: anObject otherwise: 0.
count == 0 ifTrue:
    [^anExceptionBlock value].
_indexedPaths == nil ifFalse:
    [| originalObject |

     "Since a Bag is equality based, use the originally added object
     for index maintenance. Index objects have identity based
     methods."

     originalObject := dict keyAt: anObject otherwise: nil.
     originalObject == nil ifTrue:
         [self error: 'Internal Gemstone error, a Bag''s contents are suspect.'].
     self _updateIndexesForRemovalOf: originalObject].
count > 1
    ifTrue: [dict at: anObject put: count - 1]
    ifFalse: [dict removeKey: anObject].
size := size - 1.
^anObject
%

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

"(R) Removes an object that is Identical to anObject from the receiver and 
 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, this method 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: 'Accessing'
method: Bag
size

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

^ size .
%

category: 'Converting'
method: Bag
asBag

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

^ Bag withAll: self
%

category: 'Converting'
method: Bag
_asIdentityBag

"Returns an IdentityBag that contains 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 := IdentityBag new .
dict keysAndValuesDo:[:aKey :numOcc| 
  numOcc timesRepeat:[ result add: aKey ].
  ].
^ result
%

category: 'Converting'
method: Bag
asSet

"Returns a Set"

^ Set withAll: dict keys
%
category: 'Converting'
method: Bag
asIdentitySet

"Returns a Set"

^ IdentitySet withAll: dict keys
%


category: 'Removing'
method: Bag
removeAll: aCollection

"Removes one occurrence of 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 isKindOf: Bag)
  ifFalse: [ aCollection do: [:anObject | self remove: anObject ] ]
  ifTrue: [
      aCollection __dict keysAndValuesDo: [:each :count |
	  self remove: each withOccurrences: count 
      ] 
  ] 
].
%
category: 'Removing'
method: Bag
removeAllPresent: aCollection

"Removes one occurrence of each element of aCollection from the
 receiver and returns the receiver.  Does not generate 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 isKindOf: Bag)
    ifFalse: [ ^super removeAllPresent: aCollection ]
    ifTrue: [
        aCollection __dict keysAndValuesDo: [:each :count |
            self removeIfPresent: each withOccurrences: count 
            ] 
    ] 
].
%


category: 'Private'
method: Bag
_deferredGciUpdateWith: valueArray

"Private."

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

category: 'Instance Initialization'
method: Bag
_gciInitialize

"Private."

self initialize: 0
%

category: 'Private'
method: Bag
_finishShallowCopy

 super _finishShallowCopy .
 dict := dict copy .
%

category: 'Enumerating'
method: Bag
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: 'Private'
method: Bag
__dict

^ dict
%
! delete reimplementation of assignToSegment:

category: 'Updating'
method: Bag
changeToSegment: segment

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

self assignToSegment: segment.
dict changeToSegment: segment .
%

