Coll.st
author claus
Thu, 09 Mar 1995 00:40:27 +0100
changeset 302 1f76060d58a4
parent 293 31df3850e98c
child 308 f04744ef7b5d
permissions -rw-r--r--
*** empty log message ***

"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Object subclass:#Collection
       instanceVariableNames:''
       classVariableNames:'InvalidKeySignal EmptyCollectionSignal'
       poolDictionaries:''
       category:'Collections-Abstract'
!

Collection comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libbasic/Attic/Coll.st,v 1.26 1995-03-08 23:37:32 claus Exp $
'!

!Collection class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

version
"
$Header: /cvs/stx/stx/libbasic/Attic/Coll.st,v 1.26 1995-03-08 23:37:32 claus Exp $
"
!

documentation
"
    Abstract superclass for all collections.
    This abstract class provides functionality common to all collections,
    without knowing how the concrete class implements things. Thus, all
    methods found here depend on some basic mechanisms to be defined in the
    concrete class. 
    These basic methods are usually defined as #subclassResponsibility here.
    Some methods are also redefined for better performance.
"
! !

!Collection class methodsFor:'initialization'!

initialize
    "setup the signal"

    InvalidKeySignal isNil ifTrue:[
	ErrorSignal isNil ifTrue:[super initialize].

	InvalidKeySignal := ErrorSignal newSignalMayProceed:true.
	InvalidKeySignal nameClass:self message:#invalidKeySignal.
	InvalidKeySignal notifierString:'invalid key'.

	EmptyCollectionSignal := ErrorSignal newSignalMayProceed:true.
	EmptyCollectionSignal nameClass:self message:#emptyCollectionSignal.
	EmptyCollectionSignal notifierString:'operation not allowed for empty collections'.
    ]
! !

!Collection class methodsFor:'signal access'!

invalidKeySignal
    "return the signal used to report bad key usage"

    ^ InvalidKeySignal
! 

emptyCollectionSignal
    "return the signal used to report non-allowed operation on empty collections"

    ^ EmptyCollectionSignal
! !

!Collection class methodsFor:'queries'!

growIsCheap
    "return true, if this collection can easily grow
     (i.e. without a need for become:).
     Returns true here; this method is redefined in fix-size
     collections"

    ^ true
! !

!Collection class methodsFor:'instance creation'!

with:anObject
    "return a new Collection with one element:anObject"

    |newCollection|

    newCollection := self new.
    newCollection add:anObject.
    ^ newCollection
!

with:firstObject with:secondObject
    "return a new Collection with two elements:firstObject and secondObject"

    |newCollection|

    newCollection := self new.
    newCollection add:firstObject.
    newCollection add:secondObject.
    ^ newCollection
!

with:firstObject with:secondObject with:thirdObject
    "return a new Collection with three elements"

    |newCollection|

    newCollection := self new.
    newCollection add:firstObject.
    newCollection add:secondObject.
    newCollection add:thirdObject.
    ^ newCollection
!

with:firstObject with:secondObject with:thirdObject with:fourthObject
    "return a new Collection with four elements"

    |newCollection|

    newCollection := self new.
    newCollection add:firstObject.
    newCollection add:secondObject.
    newCollection add:thirdObject.
    newCollection add:fourthObject.
    ^ newCollection
!

new:size withAll:element
    "return a new COllection of size, where all elements are
     initialized to element"

    |newCollection|

    newCollection := self new:size.
    size timesRepeat:[newCollection add:element]
!

withAll:aCollection
    "return a new Collection with all elements taken from the argument,
     aCollection"

    |newCollection|

    newCollection := self new.
    newCollection addAll:aCollection.
    ^newCollection
! !

!Collection methodsFor:'error handling'!

errorNotKeyed
    "report an error that keyed access methods are not allowed"

    ^ self error:(self class name, 's do not respond to keyed accessing messages')
! 

errorInvalidKey
    "report an error that the given key was invalid"

    ^ InvalidKeySignal raise
!

emptyCollectionError
    "report an error that the operation is not allowed for
     empty collections"

    ^ EmptyCollectionSignal raise
! !

!Collection methodsFor:'copying'!

copyEmpty:size
    "return a copy of the receiver with no elements, but space for
     size elements. This is used by copying and enumertion methods
     to get a new instance which is similar to the receiver.
     This method should be redefined in subclasses with instance
     variables, which should be put into the copy too.
     For example, SortedCollection has to copy its sortBlock into the
     new collection."

    ^ self species new:size
!

copyEmpty
    "return a copy of the receiver with no elements.
     This is used by copying and enumertion methods
     to get a new instance which is similar to the receiver."

    ^ self species new
!

copyEmptyAndGrow:size
    "return a copy of the receiver with size nil elements.
     This is used by copying and enumertion methods
     to get a new instance which is similar to the receiver."

    ^ (self copyEmpty:size) grow:size
! !

!Collection methodsFor:'queries'!

isCollection
    "return true, if the receiver is some kind of collection;
     true is returned here - the method is redefined from Object."

    ^ true
! !

!Collection methodsFor:'accessing'!

first
    "return the first element of the collection.
     This should be redefined in subclasses."

    self do:[:e | ^ e].

    "error if collection is empty"
    ^ self emptyCollectionError
!

last
    "return the last element of the collection.
     This should be redefined in subclasses."

    |theLastOne any|

    any := false.
    self do:[:e | any := true. theLastOne := e].
    any ifTrue:[
	^ theLastOne
    ].

    "error if collection is empty"
    ^ self emptyCollectionError
!

anElement
    "return any element from the collection, or nil if there is none"

    self do: [:each | ^ each].
    ^ nil
! !

!Collection methodsFor:'adding & removing'!

add:anObject
    "add the argument, anObject to the receiver.
     If the receiver is ordered, the position of the new element is undefined
     (i.e. dont depend on where it will be put)."

    ^ self subclassResponsibility
!

addLast:anObject
    "add the argument, anObject to the receiver. 
     If the receiver is ordered, the new element will be added at the end."

    ^ self add:anObject
!

addFirst:anObject
    "add the argument, anObject to the receiver.
     If the receiver is ordered, the new element will be added at the beginning."

    ^ self subclassResponsibility
!

addAll:aCollection
    "add all elements of the argument, aCollection to the receiver."

    aCollection do:[:element |
	self add:element
    ].
    ^ aCollection

    "
     #(1 2 3 4) copy addAll:#(5 6 7 8)
     #(1 2 3 4) asOrderedCollection addAll:#(5 6 7 8)
    "
!

addAllLast:aCollection
    "add all elements of the argument, aCollection to the receiver"

    aCollection do:[:element | 
	self addLast:element 
    ].
    ^ aCollection

    "
     |c|
     c := #(4 3 2 1) asOrderedCollection.
     c addAllLast:#(9 8 7 6 5)
    "
!

addAllFirst:aCollection
    "insert all elements of the argument, aCollection at the beginning
     of the receiver"

    aCollection reverseDo:[:element | 
	self addFirst:element 
    ].
    ^ aCollection

    "
     |c|
     c := #(4 3 2 1) asOrderedCollection.
     c addAllFirst:#(9 8 7 6 5)
    "
!

remove:anObject ifAbsent:exceptionBlock
    "remove the argument, anObject from the receiver - if it was not
     in the collection returns the the value of the exceptionBlock"

    ^ self subclassResponsibility
!

remove:anObject
    "remove the argument, anObject from the receiver"

    self remove:anObject ifAbsent:[self errorNotFound]
!

removeAll
    "remove all elements from the receiver.
     This should be reimplemented in subclasses for better
     performance."

    [self notEmpty] whileTrue:[
	self removeFirst
    ].
!

removeAll:aCollection
    "remove all elements of the argument, aCollection from the receiver"

    aCollection do:[:element | self remove:element].
    ^ aCollection
! !

!Collection methodsFor:'growing'!

growSize
    "return a suitable size increment for growing"

    ^ self size max:2
!

grow
    "make the receiver larger"

    self grow:(self size + self growSize)
!

grow:howBig
    "change the receivers size"

    ^ self subclassResponsibility
! !

!Collection methodsFor:'testing'!

isEmpty
    "return true, if the receiver is empty"

    ^ self size == 0
!

notEmpty
    "return true, if the receiver is not empty"

    ^ self isEmpty not
!

includes:anElement
    "return true, if the argument, anObject is in the list"

    self do:[:element |
	(anElement = element) ifTrue:[^ true].
    ].
    ^ false
!

includesAll:aCollection
    "return true, if the the receiver includes all elements of
     the argument, aCollection; false if any is missing"

    aCollection do:[:element |
	(self includes:element) ifFalse:[^ false].
    ].
    ^ true

    "
     #(1 2 3 4 5 6 7) includesAll:#(1 2 3)
     #('hello' 'there' 'world') includesAll:#('hello' 'world')
     #(1 2 3 4 5 6 7) includesAll:#(7 8 9)
    "
!

includesAny:aCollection
    "return true, if the the receiver includes any elements of
     the argument, aCollection; false if it includes none"

    aCollection do:[:element |
	(self includes:element) ifTrue:[^ true].
    ].
    ^ false

    "
     #(1 2 3 4 5 6 7) includesAny:#(1 2 3)
     #('hello' 'there' 'world') includesAny:#('hello' 'world')
     #(1 2 3 4 5 6 7) includesAny:#(7 8 9)
     #(1 2 3 4 5 6 7) includesAny:#(8 9 10)
    "
!

occurrencesOf:anElement
    "return the number of occurrences of the argument, anElement in
     the receiver"

    |count "{ Class: SmallInteger }" |

    count := 0.
    self do:[:element |
	(anElement = element) ifTrue:[
	    count := count + 1
	].
    ].
    ^ count
!

size
    "return the number of elements in the receiver.
     This is usually redefined in subclasses for more performance."

    |count "{ Class: SmallInteger }" |

    count := 0.
    self do:[:element |
	count := count + 1
    ].
    ^ count
!

max
    "return the maximum value in the receiver collection"

    ^ self inject:nil
	    into:[:maxSoFar :this | 
			(maxSoFar isNil 
			or:[this > maxSoFar]) ifTrue:[this]
			ifFalse:[maxSoFar]]

    "
     #(15 1 -9 10 5) max  
     (1 to:15) max  
    "
!

min
    "return the minimum value in the receiver collection"

    ^ self inject:nil
	    into:[:minSoFar :this | 
			(minSoFar isNil 
			or:[this < minSoFar]) ifTrue:[this]
			ifFalse:[minSoFar]]

    "
     #(15 1 -9 10 5) min 
     (1 to:15) min        
    "
! !

!Collection methodsFor:'enumerating'!

do:aBlock
    "evaluate the argument, aBlock for each element"

    ^ self subclassResponsibility
!

reverseDo:aBlock
    "evaluate the argument, aBlock for each element in reverse order."

    "it could be defined in terms of do: - but very inefficient.
     Better force programmer to define a better version ..."

    ^ self subclassResponsibility
!

keysAndValuesDo:aTwoArgBlock
    "evaluate the argument, aBlock for every element in the collection,
     passing both index and element as arguments."

    ^ self errorNotKeyed
!

with:aSequenceableCollection do:aTwoArgBlock
    "evaluate the argument, aBlock for successive elements from
     each the receiver and the argument, aSequenceableCollection.
     The second argument, aBlock must be a two-argument block.
     The receiver may be any enumeratable collection, while the other
     collection must implement access via a numeric key."

    |index  "{ Class: SmallInteger }" |

    index := 1.
    self do:[:element |
	aTwoArgBlock value:element value:(aSequenceableCollection at:index).
	index := index + 1
    ]

    "
     (1 to:3) with:#(one two three) do:[:num :sym |
	Transcript showCr:(num->sym)
     ]
    "
!

collect:aBlock
    "for each element in the receiver, evaluate the argument, aBlock
     and return a new collection with the results"

    |newCollection|

    newCollection := self species new.
    self do:[:element | newCollection add:(aBlock value:element)].
    ^ newCollection

    "
     #(1 2 3 4) collect:[:n | n * 2]  
    "
!

with:aSequenceableCollection collect:aTwoArgBlock
    "evaluate the argument, aBlock for successive elements from
     each the receiver and the argument, aSequenceableCollection;
     The second argument, aBlock must be a two-argument block, which is
     evaluated for each element-pair.
     Collect the results and return a collection containing them.
     The receiver may be any enumeratable collection, while the other
     collection must implement access via a numeric key."

    |index  "{ Class: SmallInteger }" 
     newCollection|

    newCollection := self species new.
    index := 1.
    self do:[:element |
	newCollection add:(aTwoArgBlock value:element 
					value:(aSequenceableCollection at:index)).
	index := index + 1
    ].
    ^ newCollection

    "
     (1 to:3) with:#(one two three) collect:[:num :sym | (num->sym)]
     #(1 2 3) with:#(10 20 30) collect:[:x :y | (x@y)]
    "
!

detect:aBlock
    "evaluate the argument, aBlock for each element in the receiver until
     the block returns true; in this case return the element which caused
     the true evaluation.
     If none of the evaluations return true, report an error"

    ^ self detect:aBlock ifNone:[self errorNotFound]

    "
     #(1 2 3 4) detect:[:n | n odd]   
     #(2 4 6 8) detect:[:n | n odd]  
    "
!

detect:aBlock ifNone:exceptionBlock
    "evaluate the argument, aBlock for each element in the receiver until
     the block returns true; in this case return the element which caused
     the true evaluation.
     If none of the evaluations returns true, return the result of the
     evaluation of the exceptionBlock"

    self do:[:each | 
	(aBlock value:each) ifTrue:[^ each].
    ].
    ^ exceptionBlock value

    "
     #(1 2 3 4) detect:[:n | n odd] ifNone:['sorry']    
     #(2 4 6 8) detect:[:n | n odd] ifNone:['sorry']     
    "
!

inject:thisValue into:binaryBlock
    |nextValue|

    nextValue := thisValue.
    self do: [:each | nextValue := binaryBlock value:nextValue value:each].
    ^ nextValue

    "
     #(1 2 3 4) inject:0 into:[:accu :element | accu + element]   
     (1 to:10) inject:0 into:[:accu :element | accu + element]     
    "
!

reject:aBlock
    "return a new collection with all elements from the receiver, for which
     the argument aBlock evaluates to false"

    ^ self select:[:element | (aBlock value:element) == false]

    "
     #(1 2 3 4) reject:[:e | e odd]   
     (1 to:10) reject:[:e | e even]     
    "
!

select:aBlock
    "return a new collection with all elements from the receiver, for which
     the argument aBlock evaluates to true"

    |newCollection|

    newCollection := self species new.
    self do:[:each |
	(aBlock value:each) ifTrue:[newCollection add:each].
    ].
    ^ newCollection

    "
     #(1 2 3 4) select:[:e | e odd]   
     (1 to:10) select:[:e | e even]     
    "
!

select:aBlock ifNone:exceptionBlock
    "try a new collection with all elements from the receiver, for which
     the argument aBlock evaluates to true. If none of the elements passes
     the check of aBlock, return the result of evaluating exceptionBlock."

    |newCollection|

    newCollection := self select:aBlock.
    newCollection isEmpty ifTrue:[^ exceptionBlock value].
    ^ newCollection

    "
     #(1 2 3 4) select:[:e | e > 10] ifNone:['sorry']  
    "
!

addAllTo:aCollection
    "add all elements of the receiver, to aCollection.
     Return aCollection."

    self do:[:each | aCollection add:each].
    ^ aCollection
! !

!Collection methodsFor:'converting'!

asArray
    "return a new Array with the collections elements"

    |anArray 
     index "{ Class: SmallInteger }" |

    anArray := Array new:(self size).
    index := 1.
    self do:[:each |
	anArray at:index put:each.
	index := index + 1
    ].
    ^ anArray
!

asByteArray
    "return a new ByteArray with the collections elements
     (which must convert to integers in the range 0..255)."

    |aByteArray 
     index "{ Class: SmallInteger }" |

    aByteArray := ByteArray new:(self size).
    index := 1.
    self do:[:each |
	aByteArray at:index put:each asInteger.
	index := index + 1
    ].
    ^ aByteArray
!

asFloatArray
    "return a new FloatArray with the collections elements
     (which must convert to floats)."

    |aFloatArray
     index "{ Class: SmallInteger }" |

    aFloatArray := FloatArray new:(self size).
    index := 1.
    self do:[:each |
	aFloatArray at:index put:each asFloat.
	index := index + 1
    ].
    ^ aFloatArray
!

asDoubleArray
    "return a new DoubleArray with the collections elements
     (which must convert to floats)."

    |aDoubleArray
     index "{ Class: SmallInteger }" |

    aDoubleArray := DoubleArray new:(self size).
    index := 1.
    self do:[:each |
	aDoubleArray at:index put:each asFloat.
	index := index + 1
    ].
    ^ aDoubleArray
!

asString
    "return a String with the collections elements 
     (which must convert to characters)"

    |aString 
     index "{ Class: SmallInteger }" |

    aString := String new:(self size).
    index := 1.
    self do:[:each |
	aString at:index put:each asCharacter.
	index := index + 1
    ].
    ^ aString
!

asStringCollection
    "return a new Text-object (collection of lines) with the elements printstings"

    ^ self addAllTo:(StringCollection new)
!

asText
    "return a Text-object (collection of lines) from myself.
     BIG warning: asText is totally misnamed here 
     - ST/X's asText has nothing to do with PP's asText.
     Therefore it will be removed/renamed soon. 
     Please use #asStringCollection."

    self obsoleteMethodWarning.

    ^ self asStringCollection
!

asBag
    "return a new Bag with the receiver collections elements"

    ^ self addAllTo:(Bag new)
!

asOrderedCollection
    "return a new OrderedCollection with the receiver collections elements"

    ^ self addAllTo:(OrderedCollection new:self size)
!

asSet
    "return a new Set with the receiver collections elements"

    ^ self addAllTo:(Set new:self size)
!

asIdentitySet
    "return a new IdentitySet with the receiver collections elements"

    ^ self addAllTo:(IdentitySet new:self size)
!

asSortedCollection
    "return a new SortedCollection with the receiver collections elements"

    |aSortedCollection|

    aSortedCollection := SortedCollection new:self size.
    aSortedCollection addAll:self.
    ^ aSortedCollection
!

asSortedCollection:sortBlock
    "return a new SortedCollection with the receiver collections elements,
     using sortBlock for comparing"

    |aSortedCollection|

    aSortedCollection := SortedCollection sortBlock:sortBlock.
    aSortedCollection addAll:self.
    ^ aSortedCollection
!

writeStream
    "return a stream for writing onto the receiver"

    ^ WriteStream on:self

    "
     |s|

     s := #() copy writeStream.
     s nextPut:1.
     s nextPut:2.
     s nextPut:3.
     s contents inspect
    "

    "
     |s|

     s := OrderedCollection new writeStream.
     s nextPut:1.
     s nextPut:2.
     s nextPut:3.
     s contents inspect
    "
!

readStream
    "return a stream for reading from the receiver"

    ^ ReadStream on:self

    "
     |s|

     s := 'hello world' readStream.
     s next:5.
     s next.
     (s next:5) inspect
    "
! !

!Collection methodsFor:'printing & storing'!

maxPrint
    "the print-limit; printOn: will try to not produce more output
     than the limit defined here."

    ^ 5000
!

printOrDisplayStringUsing:aSelector
    "common code for printString and displayString; they only differ in
     the print-message sent to the elements"

    |thisString buffer count string noneYet total limit|

    thisContext isRecursive ifTrue:[
	Transcript showCr:'Error: print/storeString of self referencing collection.'.
	^ '#("recursive")'
    ].

    string := (self class name) , '('.
    noneYet := true.
    buffer := ''.
    count := 0.
    total := 0.
    limit := self maxPrint.

    self do: [:element |
	thisString := element perform:aSelector.
	noneYet ifTrue:[
	    noneYet := false.
	    buffer := buffer , thisString
	] ifFalse:[
	    buffer := buffer , (' ' , thisString)
	].
	count := count + 1.
	(count == 20) ifTrue:[
	    string := string , buffer.
	    buffer := ''.
	    count := 0
	].
	total := total + 1.
	(total > limit) ifTrue:[
	    string := string , buffer , '... )'.
	    ^ string
	]
    ].
    string := string , buffer , ')'.
    ^ string
!

displayString
    "return a printed representation of the receiver for display in inspectors etc."

    ^ self printOrDisplayStringUsing:#displayString 
!

printOn:aStream
    "append a user readable representation of the receiver to aStream.
     The text appended is not meant to be read back for reconstruction of
     the receiver. Also, this method limits the size of generated string.
    "

    |limit firstOne string|

    thisContext isRecursive ifTrue:[
	Transcript showCr:'Error: printOn: of self referencing collection.'.
	aStream nextPutAll:'#("recursive")'.
	^ self
    ].

    limit := self maxPrint.
    aStream nextPutAll:self class name.
    aStream nextPut:$(.
    firstOne := true.

    self do:[:element |
	firstOne ifFalse:[
	    aStream space
	] ifTrue:[
	    firstOne := false
	].
	(limit <= 0) ifTrue:[
	    aStream nextPutAll:'...etc...)'.
	    ^ self
	] ifFalse:[
"/ old code, worked only on positionable streams
"/
"/              pos1 := aStream position.
"/              element printOn:aStream.
"/              limit := limit - (aStream position - pos1)

	    string := element printString.
	    aStream nextPutAll:string.
	    limit := limit - string size.
	].
    ].
    aStream nextPut:$)

    "
     #(1 2 3 'hello' $a) printOn:Transcript
     (Array new:100000) printOn:Transcript
     (Array new:100000) printString size 
     (Dictionary new at:#hello put:'world'; yourself) printOn:Transcript
    "
    "
     |a| 
     a := Array new:3. 
     a at:2 put:a.
     a printOn:Transcript
    "
!

storeOn:aStream
    "output a printed representation onto the argument, aStream.
     The text can be re-read to reconstruct (a copy of) the receiver.
     Recursive (i.e. cyclic) collections cannot be stored correctly
     (use storeBinaryOn: to handle those)."

    |isEmpty|

    thisContext isRecursive ifTrue:[
	Transcript showCr:'Error: storeOn: of self referencing collection.'.
	aStream nextPutAll:'#recursive'.
	^ self
    ].

    aStream nextPutAll:'('.
    aStream nextPutAll:(self class name).
    aStream nextPutAll:' new'.
    isEmpty := true.
    self do:[:element |
	aStream nextPutAll:' add:'.
	element storeOn:aStream.
	aStream nextPutAll:';'.
	isEmpty := false
    ].
    isEmpty ifFalse:[aStream nextPutAll:' yourself'].
    aStream nextPut:$)

    "
     OrderedCollection new storeOn:Transcript
     (1 to:10) storeOn:Transcript
     (Set new add:1; add:'hello'; yourself) storeOn:Transcript
    "
    "
     |s|

     s := Set new.
     s add:1; add:'hello'; add:s.
     s storeOn:Transcript
    "
! !