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

commits at source.squeak.org commits at source.squeak.org
Thu Mar 10 15:42:02 UTC 2016


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

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

Name: Collections-ul.680
Author: ul
Time: 10 March 2016, 4:33:52.197801 pm
UUID: 0d7db6dd-bde1-40f0-919d-638fc4e8a9c7
Ancestors: Collections-ul.679

#includes: will return false if the receiver is some kind of character set and the argument is not a character. E.g. ['0' asCharacterSet includes: 48.123] won't evaluate to true anymore, nor will [ '' asCharacterSet includes: nil ] raise an error.

#occurrencesOf: revamp - round #2
- added optimized implementations to all Collection subclasses where it was sensible - as suggested by Nicolas.
- moved all implementations from testing to enumeration category, because this method doesn't answer a boolean value, but it's similar to #count:, which is in enumeration.

=============== Diff against Collections-ul.679 ===============

Item was changed:
+ ----- Method: ArrayedCollection>>occurrencesOf: (in category 'enumerating') -----
- ----- Method: ArrayedCollection>>occurrencesOf: (in category 'testing') -----
  occurrencesOf: anObject 
  	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
  
  	| tally |
  	tally := 0.
  	1 to: self size do: [ :index |
  		(self at: index) = anObject ifTrue: [ tally := tally + 1 ] ].
  	^tally!

Item was changed:
+ ----- Method: Bag>>occurrencesOf: (in category 'enumerating') -----
- ----- Method: Bag>>occurrencesOf: (in category 'testing') -----
  occurrencesOf: anObject
  	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
  
  	^contents at: anObject ifAbsent: 0!

Item was added:
+ ----- Method: Bitset>>occurrencesOf: (in category 'enumerating') -----
+ occurrencesOf: anObject
+ 	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
+ 
+ 	(self includes: anObject) ifTrue: [ ^1 ].
+ 	^0!

Item was changed:
+ ----- Method: ByteArray>>occurrencesOf: (in category 'enumerating') -----
- ----- Method: ByteArray>>occurrencesOf: (in category 'as yet unclassified') -----
  occurrencesOf: anObject 
  	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
  
  	| tally |
  	anObject isInteger ifFalse: [ ^0 ].
  	anObject negative ifTrue: [ ^0 ].
  	anObject > 255 ifTrue: [ ^0 ].
  	tally := 0.
  	1 to: self size do: [ :index |
  		(self at: index) = anObject ifTrue: [ tally := tally + 1 ] ].
  	^tally!

Item was added:
+ ----- Method: ByteString>>occurrencesOf: (in category 'enumerating') -----
+ occurrencesOf: anObject 
+ 	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
+ 
+ 	| tally |
+ 	anObject isCharacter ifFalse: [ ^0 ].
+ 	anObject asInteger > 255 ifTrue: [ ^0 ].
+ 	tally := 0.
+ 	1 to: self size do: [ :index |
+ 		(self at: index) == anObject ifTrue: [ tally := tally + 1 ] ].
+ 	^tally!

Item was added:
+ ----- Method: ByteSymbol>>occurrencesOf: (in category 'enumerating') -----
+ occurrencesOf: anObject 
+ 	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
+ 
+ 	| tally |
+ 	anObject isCharacter ifFalse: [ ^0 ].
+ 	anObject asInteger > 255 ifTrue: [ ^0 ].
+ 	tally := 0.
+ 	1 to: self size do: [ :index |
+ 		(self at: index) == anObject ifTrue: [ tally := tally + 1 ] ].
+ 	^tally!

Item was changed:
  ----- Method: CharacterSet>>includes: (in category 'collection ops') -----
+ includes: anObject
- includes: aCharacter
  
  	| index |
+ 	anObject isCharacter ifFalse: [ ^false ].
+ 	(index := anObject asInteger + 1) > 256 ifTrue: [ ^false ].
- 	(index := aCharacter asInteger + 1) > 256 ifTrue: [ ^false ].
  	^(map at: index) > 0!

Item was added:
+ ----- Method: CharacterSet>>occurrencesOf: (in category 'enumerating') -----
+ occurrencesOf: anObject
+ 	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
+ 
+ 	(self includes: anObject) ifTrue: [ ^1 ].
+ 	^0!

Item was changed:
  ----- Method: CharacterSetComplement>>includes: (in category 'collection ops') -----
+ includes: anObject
+ 
+ 	anObject isCharacter ifFalse: [ ^false ].
+ 	(absent includes: anObject) ifTrue: [ ^false ].
+ 	^true!
- includes: aCharacter
- 	^(absent includes: aCharacter) not!

Item was added:
+ ----- Method: CharacterSetComplement>>occurrencesOf: (in category 'enumerating') -----
+ occurrencesOf: anObject
+ 	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
+ 
+ 	(self includes: anObject) ifTrue: [ ^1 ].
+ 	^0!

Item was changed:
+ ----- Method: Collection>>occurrencesOf: (in category 'enumerating') -----
- ----- Method: Collection>>occurrencesOf: (in category 'testing') -----
  occurrencesOf: anObject 
  	"Answer how many of the receiver's elements are equal to anObject."
  
  	| tally |
  	tally := 0.
  	self do: [:each | anObject = each ifTrue: [tally := tally + 1]].
  	^tally!

Item was changed:
+ ----- Method: Matrix>>occurrencesOf: (in category 'enumerating') -----
- ----- Method: Matrix>>occurrencesOf: (in category 'testing') -----
  occurrencesOf: anObject
  	^contents occurrencesOf: anObject!

Item was added:
+ ----- Method: OrderedCollection>>occurrencesOf: (in category 'enumerating') -----
+ occurrencesOf: anObject 
+ 	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
+ 
+ 	| tally |
+ 	tally := 0.
+ 	firstIndex to: lastIndex do: [ :index |
+ 		(array at: index) = anObject ifTrue: [ tally := tally + 1 ] ].
+ 	^tally!

Item was added:
+ ----- Method: Set>>includes2: (in category 'testing') -----
+ includes2: anObject 
+ 	
+ 	^((array at: (self scanFor: anObject)) == nil) not!

Item was changed:
+ ----- Method: Set>>occurrencesOf: (in category 'enumerating') -----
+ occurrencesOf: anObject
+ 	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
+ 
+ 	(self includes: anObject) ifTrue: [ ^1 ].
+ 	^0!
- ----- Method: Set>>occurrencesOf: (in category 'testing') -----
- occurrencesOf: anObject 
- 	^ (self includes: anObject) ifTrue: [1] ifFalse: [0]!

Item was changed:
+ ----- Method: String>>occurrencesOf: (in category 'enumerating') -----
- ----- Method: String>>occurrencesOf: (in category 'testing') -----
  occurrencesOf: anObject 
  	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
  
  	| tally |
  	anObject isCharacter ifFalse: [ ^0 ].
  	tally := 0.
  	1 to: self size do: [ :index |
  		(self at: index) == anObject ifTrue: [ tally := tally + 1 ] ].
  	^tally!

Item was changed:
  ----- Method: WideCharacterSet>>includes: (in category 'collection ops') -----
+ includes: anObject 
- includes: aCharacter 
  
  	| value |
+ 	anObject isCharacter ifFalse: [ ^false ].
+ 	(value := anObject asInteger) < 256 ifTrue: [
- 	(value := aCharacter asInteger) < 256 ifTrue: [
  		^(byteArrayMap at: value + 1) ~= 0 ].
  	^((map at: (value bitShift: highBitsShift) ifAbsent: nil) ifNil: [ ^false ])
  		includes: (value bitAnd: lowBitsMask)!

Item was added:
+ ----- Method: WideCharacterSet>>occurrencesOf: (in category 'enumerating') -----
+ occurrencesOf: anObject
+ 	"Answer how many of the receiver's elements are equal to anObject. Optimized version."
+ 
+ 	(self includes: anObject) ifTrue: [ ^1 ].
+ 	^0!



More information about the Squeak-dev mailing list