!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: sortedcollection.gs,v 1.12 2008-01-09 22:50:18 stever Exp $
!
! Superclass Hierarchy:
!   SortedCollection, OrderedCollection, SequenceableCollection,
!   Collection, Object.
!
!=========================================================================

expectvalue %String
run
OrderedCollection _newKernelSubclass: 'SortedCollection'
  instVarNames: #( #sortBlock )
  classVars: #( #DefaultSortBlock )
  classInstVars: #()
  poolDictionaries: #[]
  inDictionary: Globals
  constraints: #()
  instancesInvariant: false
  isModifiable: false
  reservedOop: 727
%

! remove existing behavior from SortedCollection
removeallmethods SortedCollection
removeallclassmethods SortedCollection

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

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

txt := (GsDocText new) details:
'A SortedCollection is an OrderedCollection that maintains the order of its
 elements based on a sort block.  In GemStone, SortedCollections are not fixed
 in length as in other Smalltalk systems.'.
doc documentClassWith: txt.

txt := (GsDocText new) details:
'An ExecutableBlock that defines the sorting criterion.  The block
 must take two arguments, and it should return true if the first
 argument should precede the second argument, and false if not.'.
doc documentInstVar: #sortBlock with: txt.

self description: doc.
%

! ------------------- Class methods for SortedCollection
category: 'Instance Creation'
classmethod: SortedCollection
new

"Returns a new instance of the receiver with the sort block
 [ :a :b | a <= b ]."

| inst |
inst := super new.
inst sortBlock: [ :a :b | a <= b ].
^inst
%

! initialize class variables.
category: 'Class initialization'
classmethod: SortedCollection
initDefaultSortblock

"Initialize a reference to the default sort block."

  SortedCollection _classVars at: #DefaultSortBlock put: 
    SortedCollection new sortBlock
%

! fixed bug 7435

category: 'Instance Creation'
classmethod: SortedCollection
new: size

"Returns a new instance of the receiver with size 0 and the sort block
 [ :a :b | a <= b ].  This method is synonymous with new and is provided for
 compatibility with other Smalltalk dialects that do not have objects that are
 truly variable in size."

^ self new 
%

category: 'Updating'
method: SortedCollection
size: anInteger

"If anInteger is less than the current size of the receiver, shrinks
 the receiver, otherwise has no effect."

"This implementation choice allows removal methods to be safely inherited 
 from SequenceableCollection."

anInteger < self size ifTrue:[ super size: anInteger ].
%

category: 'Instance Creation'
classmethod: SortedCollection
sortBlock: aBlock

"Returns a new instance of the receiver with the given sort block."

| inst |
inst := super new.
inst sortBlock: aBlock.
^inst
%

category: 'Instance Creation'
classmethod: SortedCollection
sortBlock: aBlock fromSortResult: sortArray

"Returns a new instance of the receiver with the given sort block and contents.
 The argument sortArray is assumed to be in the proper sort order and is
 installed as the presorted contents of the new instance."

| inst |
inst := super new.
inst sortBlock: aBlock.
1 to: sortArray size do: [:i |
  inst _basicAt: i put: (sortArray at: i)
].
^inst
%

category: 'Instance Creation'
classmethod: SortedCollection
withAll: collection sortBlock: block

"Returns a new instance of the receiver with the given sort block and
 contents."

| instance |
instance := self sortBlock: block.
instance addAll: collection.
^instance
%

category: 'Instance Creation'
classmethod: SortedCollection
withAll: aCollection

"Returns an instance of the receiver containing the elements of the argument."

| inst |
inst := self new .
inst addAll: aCollection.
^ inst
%

category: 'Instance Creation'
classmethod: SortedCollection
with: aValue

"Returns an instance of the receiver containing the argument."

| inst |
inst := self new .
inst add: aValue .
^ inst
%

category: 'Instance Creation'
classmethod: SortedCollection
with: aValue with: val2

"Returns an instance of the receiver containing the arguments."

| inst |
inst := self new .
inst add: aValue ; add: val2 .
^ inst
%

category: 'Instance Creation'
classmethod: SortedCollection
with: aValue with: val2 with: val3

"Returns an instance of the receiver containing the arguments."

| inst |
inst := self new .
inst add: aValue ; add: val2 ; add: val3 .
^ inst
%

! ------------------- Instance methods for SortedCollection

! deleted _addAll: which was unused

category: 'Private'
method: SortedCollection
_at: anIndex put: aValue

"Puts the given element into the receiver at the given index, without
 sorting."

^super at: anIndex put: aValue
%

category: 'Private'
method: SortedCollection
_findIndex: anObject

"Finds and returns the index for placing the given object into the receiver.
 A simple binary probe is used."

| obj lower upper half probe |

self size == 0 ifTrue: [ ^1 ].

lower := 1.
upper := self size.
[ half := upper - lower + 1 // 2.
  probe := lower + half.
  -1 < half _and: [ lower <= upper ] ] whileTrue: [
  obj := self at: probe.
  (sortBlock value: obj value: anObject) ifTrue: [
    "after this index - go to the next higher cell"
    lower := probe + 1.
  ]
  ifFalse: [
    "before this index - go to the next lower cell"
    upper := probe - 1
  ]
].
^probe
%

category: 'Private'
method: SortedCollection
resort

"Re-sorts the receiver according to its sortBlock."

| saveArray |
self size > 1 ifTrue: [
  saveArray := Array withAll: self.
  self _basicSize: 0 .
  self addAll: saveArray .
].
%

category: 'Adding'
method: SortedCollection
add: anObject

"Adds anObject to the receiver.  Increases the size of the receiver by one.
 Enforces the sorting order.  Returns anObject."

| idx |
idx := self _findIndex: anObject.
self _insertAll: #[ anObject] at: idx .
^ anObject
%

category: 'Adding'
method: SortedCollection
addAll: aCollection

"Adds the elements of aCollection to the receiver.  Increases the size of the
 receiver by the number of elements in aCollection.  Enforces the sorting order.
 Returns aCollection."

| collCopy |
aCollection == self ifTrue:[
  collCopy := Array withAll: self . 
  1 to: collCopy size do:[:j | self add: (collCopy at: j) ].
]
ifFalse:[
  (self size == 0 and:[ aCollection size > 2000]) ifTrue:[
    self _mergeSortAddAll: aCollection .
  ] ifFalse:[
    (aCollection isKindOf: SequenceableCollection) ifTrue:[
      1 to: aCollection size do:[:j |
        self add:( aCollection at: j )
      ].
    ] ifFalse:[
      aCollection do: [:each | self add: each] .
    ].
  ].
].
^ aCollection
%

category: 'Adding'
method: SortedCollection
addLast: anObject

"Disallowed.  Reports an error since SortedCollections have a sorting order
 that prohibits outside interference."

self shouldNotImplement: #addLast:
%

category: 'Updating'
method: SortedCollection
at: index put: anObject

"Disallowed.  Reports an error since SortedCollections have a sortBlock that
 determines the order of their contents."

^self shouldNotImplement: #at:put:
%

category: 'Updating'
method: SortedCollection
atAllPut: anObject

"Assigns anObject to each of the receiver's elements."

1 to: self size do: [:index |
   super at: index put: anObject
]
%

category: 'Copying'
method: SortedCollection
_mergeSortAddAll: aCollection 
 
"The receiver must be empty. Adds aCollection to the receiver
 using the merge-sort implementation provided by BlockSorter.
 Returns the receiver."

| arr |
self size == 0 ifFalse:[ self error:'not empty' ].
arr := aCollection sortWithBlock: sortBlock . "merge sort"
super insertAll:arr at: 1 .
^ self
%   

category: 'Copying'
method: SortedCollection
copyFrom: startIndex to: stopIndex

"Installs the receiver's sortBlock into the copy."

^(super copyFrom: startIndex to: stopIndex) sortBlock: sortBlock
%

category: 'Copying'
method: SortedCollection
copyWithout: anObject

"Returns a copy of the receiver that does not contain the given object.
 Comparisons are by equality (not identity)."

| copy element sz |

copy := self species sortBlock: sortBlock.
sz := 0.
1 to: self size do: [:i |
  element := self at: i.
  element = anObject ifFalse: [
    sz := sz + 1.
    copy _at: sz put: element
  ]
].
		"no need to resort "
^ copy
%

category: 'Copying'
method: SortedCollection
insertAll: aCollection at: anIndex

"Disallowed.  Reports an error since SortedCollections have a sorting order
 that prohibits outside interference."

self shouldNotImplement: #insertAll:at:
%
category: 'Private'
method: SortedCollection
_insertAll: aCollection at: anIndex

"Inserts all the elements of aCollection into the receiver beginning at index
 anIndex.  Returns aCollection."

"The argument anIndex must be greater than or equal to one.  If anIndex is one
 greater than the size of the receiver, appends aCollection to the receiver.  If
 anIndex is more than one greater than the size of the receiver, generates an
 error."

<primitive: 606 >
( self _hasModificationTracking _and:
[ aCollection isKindOf: CharacterCollection ] )
  ifTrue: [ " primitive failed because aCollection is not an
             Array or OrderedCollection"
    ^ self insertAll: (Array withAll: aCollection) at: anIndex
  ].
self _primitiveFailed: #_insertAll:at:
%

category: 'Copying'
method: SortedCollection
insertObject: anObject at: anIndex

"Disallowed.  Reports an error since SortedCollections have a sorting order
 that prohibits outside interference."

self shouldNotImplement: #insertObject:at:
%

category: 'Searching'
method: SortedCollection
reject: aBlock

"Pass on the sort block."

|result mySize each |

result := self species sortBlock: sortBlock.
mySize := self size .
1 to: mySize do:[:j|
  each := self at: j .
  (aBlock value: each) ifFalse: [result _addLast: each]
  ].
^result
%

category: 'Private'
method: SortedCollection
_addLast: anObject

"Used when caller knows that appends to the receiver are being done in 
 sorted order."

^ super add: anObject
%

category: 'Searching'
method: SortedCollection
select: aBlock

"Returns an instance of the receiver's species that has the receiver's sort
 block."

| result mySize each |

result:= self species sortBlock: sortBlock.
mySize := self size .
1 to: mySize do:[:j|
  each := self at: j .
  (aBlock value: each) ifTrue: [result _addLast: each]
  ].
^result
%

category: 'Accessing'
method: SortedCollection
sortBlock

"Returns the value of the instance variable 'sortBlock'."

^sortBlock
%

category: 'Updating'
method: SortedCollection
sortBlock: newBlock

"Installs a new sort block in the receiver and forces a resort."

sortBlock := newBlock.
self size > 1 ifTrue: [
  self resort
]
%

category: 'Storing and Loading'
method: SortedCollection
loadFrom: passiveObj

"Reads from passiveObj the passive form of an object.  Converts the object to
 its active form by loading the information into the receiver."

super loadFrom: passiveObj.
sortBlock == nil ifTrue: [
  sortBlock := [:a:b | a<=b]
].
%

category: 'Searching'
method: SortedCollection
indexOf: anObject

"Returns the index of the first occurrence of anObject in the receiver.
 If the receiver does not contain anObject, this returns zero."

  ^ self _indexOfIdentical: anObject
%
category: 'Searching'
method: SortedCollection
indexOfValue: anObject

"Returns the index of the first occurrence of an object equal to anObject 
 in the receiver.  If the receiver does not contain such an object, this 
 returns zero."

| idx |
" _findIndex: returns where anObject would be inserted, so look at
surrounding slots to see if the object is present "
idx := self _findIndex: anObject.

(sortBlock value: anObject value: anObject) ifTrue: [
  "Need to look at the slots less than idx"
  | foundIdx | "We need to find the first one that is equal"
  foundIdx := 0.
  (idx-1) downTo: 1 do: [ :i | 
    (anObject = (self at: i)) ifTrue: [foundIdx := i].
    (i > 1) ifTrue: [
      "Check to see if the next element might be equal to the current element
       according to the sort block."
      (sortBlock value: (self at: i) value: (self at: i-1)) ifFalse: [
        "We don't need to look at any more because i-1 can't be equal
         to i."
        ^foundIdx
      ].
    ].
  ].
  ^foundIdx
] ifFalse: [
  "Need to look at the slots greater than idx"
  | lastIdx |
  lastIdx := self size.
  idx to: lastIdx do: [ :i |
    (anObject = (self at: i)) ifTrue: [^i].
    (i < lastIdx) ifTrue: [
      "Check to see if the next element might be equal to the current element
       according to the sort block."
      (sortBlock value: (self at: i) value: (self at: i+1)) ifTrue: [
        "We don't need to look at any more because i+1 can't be equal
         to i."
        ^0
      ].
    ].
  ].
  ^0.
].
%

category: 'Searching'
method: SortedCollection
_indexOfIdentical: anObject

"Private.  Returns the index of the first element in the receiver that is
 identical to the argument.  If the receiver does not have any elements that are
 identical to the argument, returns zero."

| idx |

(self size <= 2000) ifTrue: [
  "OrderedCollection's _indexOfIdentical: uses a primitive and is
   faster for smaller SortedCollections"
  ^super _indexOfIdentical: anObject.
].

" _findIndex: returns where anObject would be inserted, so look at
surrounding slots to see if the object is present "
idx := self _findIndex: anObject.

(sortBlock value: anObject value: anObject) ifTrue: [
  "Need to look at the slots less than idx"
  | foundIdx | "We need to find the first one that is equal"
  foundIdx := 0.
  (idx-1) downTo: 1 do: [ :i | 
    (anObject == (self at: i)) ifTrue: [foundIdx := i].
    (i > 1) ifTrue: [
      "Check to see if the next element might be equal to the current element
       according to the sort block."
      (sortBlock value: (self at: i) value: (self at: i-1)) ifFalse: [
        "We don't need to look at any more because i-1 can't be equal
         to i."
        ^foundIdx
      ].
    ].
  ].
  ^foundIdx
] ifFalse: [
  "Need to look at the slots greater than or equal to idx"
  | lastIdx |
  lastIdx := self size.
  idx to: lastIdx do: [ :i |
    (anObject == (self at: i)) ifTrue: [
      ^i
    ].
    (i < lastIdx) ifTrue: [
      "Check to see if the next element might be equal to the current element
       according to the sort block."
      (sortBlock value: (self at: i) value: (self at: i+1)) ifTrue: [
        "We don't need to look at any more because i+1 can't be equal
         to i."
        ^0
      ].
    ].
  ].
  ^0.
].
%

method: SortedCollection
includes: anObject

"Returns true if the argument anObject is equal to an element of the receiver.
 Returns false otherwise."

^ (self indexOfValue: anObject) > 0
%

! initialize the class variables.
run
SortedCollection initDefaultSortblock .
^ true
%

category: 'Enumerating'
method: SortedCollection
speciesForCollect

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

^ OrderedCollection
%

category: 'Private'
method: SortedCollection
_unscheduleProcess: aGsProcess
  "Used by ProcessorScheduler to unschedule from the readyQueue."
  self removeIdentical: aGsProcess ifAbsent: [].
%

category: 'Private'
method: SortedCollection
_changePriority: aGsProcess from: oldPriority
  "Used by GsProcess to change the priority of a GsProcess in the receiver."
  self removeIdentical: aGsProcess ifAbsent: [^self].
  self add: aGsProcess.
%

! added for 36675
category: 'Removing'
method: SortedCollection
removeIdentical: anObject otherwise: notFoundValue

"Remove anObject from the receiver it is found.  Do not 
 throw an exception if anObject is not found.
 Return anObject if found; else return nil if anObject is not found"
| i |
i := self _indexOfIdentical: anObject.
i ~~ 0 ifTrue: [
   self removeFrom: i to: i.
   ^ anObject 
] ifFalse: [ 
  ^ notFoundValue 
]
%
