[squeak-dev] The Trunk: Collections-ul.338.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Mar 15 04:04:42 UTC 2010


Levente Uzonyi uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections-ul.338.mcz

==================== Summary ====================

Name: Collections-ul.338
Author: ul
Time: 15 March 2010, 4:04:29.921 am
UUID: 4a2c5a00-a82e-f14e-a6db-ef2a25b8b0f3
Ancestors: Collections-nice.337

Lint:
- removed supersends where we can be sure that no superclass implements the method
- implemented missing Collection >> #atRandom:, removed the implementation from HashedCollection, because it's the same
- removed double indexing from SequenceableCollection >> #collect:from:to: while kept the same number of bytecodes inside the loop
- unified categorization of several methods in the hierarchy

=============== Diff against Collections-nice.337 ===============

Item was changed:
  ----- Method: ArrayedCollection>>writeOnGZIPByteStream: (in category 'objects from disk') -----
  writeOnGZIPByteStream: aStream 
  	"We only intend this for non-pointer arrays.  Do nothing if I contain pointers."
  
+ 	(self class isPointers or: [ self class isWords not ]) ifTrue: [ ^self ].
- 	self class isPointers | self class isWords not ifTrue: [^ super writeOnGZIPByteStream: aStream].
- 		"super may cause an error, but will not be called."
- 	
  	aStream nextPutAllWordArray: self!

Item was changed:
+ ----- Method: PluggableSet class>>integerSet (in category 'instance creation') -----
- ----- Method: PluggableSet class>>integerSet (in category 'as yet unclassified') -----
  integerSet
  	^self new hashBlock: [:integer | integer hash \\ 1064164 * 1009]!

Item was changed:
+ ----- Method: ArrayedCollection>>asSortedArray (in category 'converting') -----
- ----- Method: ArrayedCollection>>asSortedArray (in category 'sorting') -----
  asSortedArray
  	self isSorted ifTrue: [^ self asArray].
  	^ super asSortedArray!

Item was changed:
+ ----- Method: WeakRegistry>>species (in category 'private') -----
- ----- Method: WeakRegistry>>species (in category 'accessing') -----
  species
  	^Set!

Item was changed:
+ ----- Method: Collection class>>initialize (in category 'class initialization') -----
- ----- Method: Collection class>>initialize (in category 'private') -----
  initialize
  	"Set up a Random number generator to be used by atRandom when the 
  	user does not feel like creating his own Random generator."
  
  	RandomForPicking := Random new.
  	MutexForPicking := Semaphore forMutualExclusion!

Item was changed:
  ----- Method: SequenceableCollection>>collect:from:to: (in category 'enumerating') -----
  collect: aBlock from: firstIndex to: lastIndex
  	"Refer to the comment in Collection|collect:."
  
+ 	| size result |
- 	| size result j |
  	size := lastIndex - firstIndex + 1.
  	result := self species new: size.
+ 	1 to: size do: [ :index |
+ 		result at: index put: (aBlock value: (self at: index + firstIndex - 1)) ].
+ 	^result!
- 	j := firstIndex.
- 	1 to: size do: [:i | result at: i put: (aBlock value: (self at: j)). j := j + 1].
- 	^ result!

Item was changed:
  ----- Method: ArrayedCollection class>>newFromStream: (in category 'instance creation') -----
  newFromStream: s
  	"Only meant for my subclasses that are raw bits and word-like.  For quick unpack form the disk."
+ 	
  	| len |
+ 	(self isPointers or: [ self isWords ]) ifTrue: [ ^self ].
+ 	s next = 16r80 ifTrue: [
+ 		"A compressed format.  Could copy what BitMap does, or use a 
- 
- 	self isPointers | self isWords not ifTrue: [^ super newFromStream: s].
- 		"super may cause an error, but will not be called."
- 
- 	s next = 16r80 ifTrue:
- 		["A compressed format.  Could copy what BitMap does, or use a 
  		special sound compression format.  Callers normally compress their own way."
+ 		^self error: 'not implemented' ].
- 		^ self error: 'not implemented'].
  	s skip: -1.
  	len := s nextInt32.
+ 	^s nextWordsInto: (self basicNew: len)!
- 	^ s nextWordsInto: (self basicNew: len)!

Item was changed:
+ ----- Method: WeakKeyDictionary>>keysDo: (in category 'enumerating') -----
- ----- Method: WeakKeyDictionary>>keysDo: (in category 'accessing') -----
  keysDo: aBlock 
  	"Evaluate aBlock for each of the receiver's keys."
  	
  	self associationsDo: [ :association |
  		association key ifNotNil: [ :key | "Don't let the key go away"
  			aBlock value: key ] ].!

Item was changed:
+ ----- Method: HashedCollection class>>cleanUp: (in category 'initialize-release') -----
- ----- Method: HashedCollection class>>cleanUp: (in category 'initialization') -----
  cleanUp: aggressive
  	"Rehash all instances when cleaning aggressively"
  
  	aggressive ifTrue:[self rehashAll].
  !

Item was changed:
+ ----- Method: PluggableDictionary class>>integerDictionary (in category 'instance creation') -----
- ----- Method: PluggableDictionary class>>integerDictionary (in category 'as yet unclassified') -----
  integerDictionary
  	^ self new hashBlock: [:integer | integer hash \\ 1064164 * 1009]!

Item was changed:
+ ----- Method: SequenceableCollection>>putOn: (in category 'filter streaming') -----
- ----- Method: SequenceableCollection>>putOn: (in category 'streaming') -----
  putOn: aStream
  
  	self do: [ :each | each putOn: aStream ]!

Item was added:
+ ----- Method: Collection>>atRandom: (in category 'accessing') -----
+ atRandom: aGenerator
+ 	"Answer a random element of the receiver. Uses aGenerator which
+ 	should be kept by the user in a variable and used every time. Use
+ 	this instead of #atRandom for better uniformity of random numbers because 
+ 	only you use the generator. Causes an error if self has no elements."
+ 
+ 	| randomIndex index |
+ 	self emptyCheck.
+ 	randomIndex := aGenerator nextInt: self size.
+ 	index := 1.
+ 	self do: [ :each |
+ 		index = randomIndex ifTrue: [ ^each ].
+ 		index := index + 1 ]!

Item was changed:
+ ----- Method: Dictionary>>flattenOnStream: (in category 'filter streaming') -----
- ----- Method: Dictionary>>flattenOnStream: (in category 'printing') -----
  flattenOnStream:aStream
  	^aStream writeDictionary:self.
  !

Item was changed:
+ ----- Method: Set>>= (in category 'comparing') -----
- ----- Method: Set>>= (in category 'testing') -----
  = aSet
  	self == aSet ifTrue: [^ true].	"stop recursion"
  	(aSet isKindOf: Set) ifFalse: [^ false].
  	self size = aSet size ifFalse: [^ false].
  	self do: [:each | (aSet includes: each) ifFalse: [^ false]].
  	^ true!

Item was changed:
+ ----- Method: Set>>copyWithout: (in category 'copying') -----
- ----- Method: Set>>copyWithout: (in category 'removing') -----
  copyWithout: oldElement 
  	"Answer a copy of the receiver that does not contain any
  	elements equal to oldElement."
  
  	^ self copy
  		remove: oldElement ifAbsent: [];
  		yourself!

Item was changed:
+ ----- Method: WeakKeyToCollectionDictionary>>noCheckNoGrowFillFrom: (in category 'private') -----
- ----- Method: WeakKeyToCollectionDictionary>>noCheckNoGrowFillFrom: (in category 'as yet unclassified') -----
  noCheckNoGrowFillFrom: anArray
  	"Add the elements of anArray except nils and associations with empty collections (or with only nils) to me assuming that I don't contain any of them, they are unique and I have more free space than they require."
  
  	tally := 0.
  	1 to: anArray size do: [ :index |
  		(anArray at: index) ifNotNil: [ :association |
  			association key ifNotNil: [ :key | "Don't let the key go away"
  				| cleanedValue |
  				(cleanedValue := association value copyWithout: nil) isEmpty 
  					ifFalse: [
  						association value: cleanedValue.
  						array
  							at: (self scanForEmptySlotFor: key)
  							put: association.
  						tally := tally + 1 ] ] ] ]!

Item was changed:
+ ----- Method: HashedCollection class>>rehashAll (in category 'initialize-release') -----
- ----- Method: HashedCollection class>>rehashAll (in category 'initialization') -----
  rehashAll
  	"HashedCollection rehashAll"	
  		
  	self allSubclassesDo: #rehashAllInstances!

Item was changed:
+ ----- Method: SequenceableCollection>>isSequenceable (in category 'testing') -----
- ----- Method: SequenceableCollection>>isSequenceable (in category 'converting') -----
  isSequenceable
  	^ true!

Item was changed:
+ ----- Method: HashedCollection class>>rehashAllInstances (in category 'initialize-release') -----
- ----- Method: HashedCollection class>>rehashAllInstances (in category 'initialization') -----
  rehashAllInstances
  	"Do not use #allInstancesDo: because rehash may create new instances."
  
  	self allInstances do: #rehash!

Item was changed:
  ----- Method: ArrayedCollection>>writeOn: (in category 'objects from disk') -----
  writeOn: aStream 
  	"Store the array of bits onto the argument, aStream.  (leading byte ~= 16r80) identifies this as raw bits (uncompressed).  Always store in Big Endian (Mac) byte order.  Do the writing at BitBlt speeds. We only intend this for non-pointer arrays.  Do nothing if I contain pointers."
+ 
+ 	(self class isPointers or: [ self class isWords not ]) ifTrue: [ ^self ].
- 	self class isPointers | self class isWords not ifTrue: [^ super writeOn: aStream].
- 				"super may cause an error, but will not be called."
  	aStream nextInt32Put: self basicSize.
  	aStream nextWordsPutAll: self.!

Item was removed:
- ----- Method: HashedCollection>>atRandom: (in category 'accessing') -----
- atRandom: aGenerator
- 	"Answer a random element of the receiver. Uses aGenerator which
- 	should be kept by the user in a variable and used every time. Use
- 	this instead of #atRandom for better uniformity of random numbers because 
- 	only you use the generator. Causes an error if self has no elements."
- 	
- 	| rand |
- 	self emptyCheck.
- 	rand := aGenerator nextInt: self size.
- 	self doWithIndex: [ :each :index |
- 		index = rand ifTrue: [ ^each ] ]!




More information about the Squeak-dev mailing list