!=========================================================================
! Copyright (C) VMware, Inc. 1986-2011.  All Rights Reserved.
!
! $Id: BlockSorter.gs,v 1.8 2008-01-09 22:50:07 stever Exp $
!
! Superclass Hierarchy:
!   BlockSorter, Array, SequenceableCollection, Collection, Object.
!
!=========================================================================

expectvalue %String
run
| oldCls newCls |
oldCls := Globals at:#BlockSorter otherwise: nil .
oldCls == nil ifTrue:[
  Array _newKernelSubclass: #BlockSorter
    instVarNames: #( #sortBlock #sortNodes )
    classVars: #()
    classInstVars: #()
    poolDictionaries: #()
    inDictionary: Globals
    constraints: #[ #[ #sortNodes, Array] ]
    instancesInvariant: false
    isModifiable: false
    reservedOop: nil.
  newCls := (Globals at:#BlockSorter) .
  ^ 'created new class: ' + newCls definition
  ]
ifFalse:[
  ^ 'existing class: ' + oldCls definition
  ]
%

! Remove existing behavior from BlockSorter
removeallmethods BlockSorter 
removeallclassmethods BlockSorter 

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

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

txt := (GsDocText new) details:
'BlockSorter is a concrete class that along with the class SortBlockNode implements the 
 behavior used to sort collections efficiently. It is an interface to an algorithm based 
 on an efficient merge-sort.  

 To use BlockSorter explicitly outside of the indexing subsystem, 
 the recommended way is to send  sortWithBlock:  or  sortWithBlock:persistentRoot:
 to a kind of Collection .' .
doc documentClassWith: txt.

self description: doc.
%
! documentation edits to fix 37111 

! ------------------- Class methods for BlockSorter
category: 'Instance Creation'
classmethod: BlockSorter
on: anNsc with: sortBlock

 "Returns an initialized instance of BlockSorter.

 To use BlockSorter explicitly outside of the indexing subsystem, 
 the recommended way is to send  sortWithBlock:  or  sortWithBlock:persistentRoot:
 to a kind of Collection."

| new sortNode  |
new := self new.
new sortBlock: sortBlock.
sortNode := new sortNodeClassForSort new: anNsc size.
sortNode blockSorter: new.

new sortNodes: (SortNodeArray with: sortNode).
^ new
%
! ------------------- Instance methods for BlockSorter
category: 'Accessing'
method: BlockSorter
sortBlock

^sortBlock
%
category: 'Updating'
method: BlockSorter
sortBlock: aBlock

sortBlock := aBlock
%
category: 'Private'
method: BlockSorter
sortInto: anArray startingAt: index

"Returns anArray filled with objects that have been added to the receiver, in
 sorted order."
sortNodes size == 1
  ifTrue: [ (sortNodes at: 1) sortInto: anArray startingAt: index ]
  ifFalse: [
    sortNodes size == 2
      ifTrue: [ sortNodes binaryMergeAscendingInto: anArray startingAt: index  ]
      ifFalse: [  sortNodes nwayMergeAscendingInto: anArray startingAt: index ].
  ].
^ anArray
%
category: 'Accessing'
method: BlockSorter
sortNodeClassForSort

"Returns the class of SortBlockNode to use."
^ SortBlockNode
%
category: 'Accessing'
method: BlockSorter
sortNodes

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

^sortNodes
%
category: 'Updating'
method: BlockSorter
sortNodes: anArray

sortNodes := anArray
%
category: 'Updating'
method: BlockSorter
_addObject: anObject
inNodes: nodeArray

  | lastNode |
    lastNode := nodeArray at: nodeArray size.
    " if the last sort node is full, create a new one "
    lastNode isFull
      ifTrue: [
        lastNode := lastNode class new: lastNode numElements.
        lastNode blockSorter: self.
        nodeArray add: lastNode
      ].
  " add an entry to the sort node "
  lastNode _at: anObject
    put: anObject
    forBtree: false
%

category: 'Sorting'
method: Collection
sortWithBlock: sortBlock

"Returns an Array containing the elements of the receiver, sorted based on the
 sortBlock. The block must take two arguments, and it should return true if the 
 first argument should precede the second argument, and false if not. The 
 expressions within the block are expected to by symmetrical (i.e., if the first
 arg is _less_ than the second, then the block will return false when the arguments
 are reversed and if the first arg is _equal_ to the second arg, then the block 
 will return false regardless of argument order)."

^ self sortWithBlock: sortBlock  persistentRoot: nil
%

category: 'Sorting'
method: Collection
sortWithBlock: sortBlock  persistentRoot: persistentArrayOrNil

"Returns an Array containing the elements of the receiver, sorted based on the
 sortBlock. The block must take two arguments, and it should return true if the 
 first argument should precede the second argument, and false if not. The 
 expressions within the block are expected to by symmetrical (i.e., if the first
 arg is _less_ than the second, then the block will return false when the arguments
 are reversed and if the first arg is _equal_ to the second arg, then the block 
 will return false regardless of argument order).

 If persistentArrayOrNil is notNil, then it is expected to be an empty persistent array and
 the array will be used to persist large temporary data structures created during
 the sorting operation. IndexManager>>autoCommit must be true in order for periodic
 commits to  be made during the sorting operation. When the sort operation is complete
 the persistent array will be emptied and a final commit performed. The persistentArrayOrNil 
 and  IndexManager>>autoCommit should be used when a collection is so large that it 
 isn't practical to allocate enough temporary memory."

 | sorter aColl sortNodes |
sorter := BlockSorter on: self with: sortBlock.
sortNodes := sorter sortNodes.
aColl := self _asCollectionForSorting.
(IndexManager autoCommit _and: [ persistentArrayOrNil ~~ nil ])
  ifTrue: [
      | result obj |
    IndexManager current executeStartingIndexMaintenance: [
      persistentArrayOrNil add: sorter.
      persistentArrayOrNil add: aColl.
      IndexManager current _doCommit.
      1 to: aColl size do: [ :i |
        obj := aColl _at: i.
         sorter _addObject: obj
                  inNodes: sortNodes.
      ].
      result := sorter sortInto: (Array new: self size) startingAt: 1.
      persistentArrayOrNil size: 0.
      ^result
    ].
  ]
  ifFalse: [ | result obj |
    1 to: aColl size do: [ :i |
      obj := aColl _at: i.
       sorter _addObject: obj
                inNodes: sortNodes.
    ].
    result := sorter sortInto: (Array new: self size) startingAt: 1.
    ^ result
].
%

!install documentation
run
BlockSorter installDocumentation.
(BlockSorter class) removeCategory: 'For Documentation Installation only'.
^true
%
