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

commits at source.squeak.org commits at source.squeak.org
Tue Aug 16 10:07:44 UTC 2011


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

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

Name: Collections-ul.454
Author: ul
Time: 9 August 2011, 1:58:09.614 pm
UUID: 84c5cf1a-89c4-f643-a3ba-525df170e492
Ancestors: Collections-ul.453

- improved performance of String >> #unescapedPercents
- improved performance of RWBinaryOrTextStream >> #upTo:
- categorized most uncategorized methods of RWBinaryOrTextStream

=============== Diff against Collections-ul.453 ===============

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>asBinaryOrTextStream (in category 'converting') -----
- ----- Method: RWBinaryOrTextStream>>asBinaryOrTextStream (in category 'as yet unclassified') -----
  asBinaryOrTextStream
  
  	^ self!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>ascii (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>ascii (in category 'as yet unclassified') -----
  ascii
  	isBinary := false!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>binary (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>binary (in category 'as yet unclassified') -----
  binary
  	isBinary := true!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>contents (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>contents (in category 'as yet unclassified') -----
  contents
  	"Answer with a copy of my collection from 1 to readLimit."
  
  	| newArray |
  	isBinary ifFalse: [^ super contents].	"String"
  	readLimit := readLimit max: position.
  	newArray := ByteArray new: readLimit.
  	^ newArray replaceFrom: 1
  		to: readLimit
  		with: collection
  		startingAt: 1.!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>contentsOfEntireFile (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>contentsOfEntireFile (in category 'as yet unclassified') -----
  contentsOfEntireFile
  	"For compatibility with file streams."
  
  	^ self contents!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>isBinary (in category 'testing') -----
- ----- Method: RWBinaryOrTextStream>>isBinary (in category 'as yet unclassified') -----
  isBinary
  	^ isBinary!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>next (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>next (in category 'as yet unclassified') -----
  next
  
  	| byte |
  	^ isBinary 
  			ifTrue: [byte := super next.
  				 byte ifNil: [nil] ifNotNil: [byte asciiValue]]
  			ifFalse: [super next].
  !

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>next: (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>next: (in category 'as yet unclassified') -----
  next: anInteger 
  	"Answer the next anInteger elements of my collection. Must override to get class right."
  
  	| newArray |
  	newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: anInteger.
  	^ self nextInto: newArray!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>next:into:startingAt: (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>next:into:startingAt: (in category 'as yet unclassified') -----
  next: n into: aCollection startingAt: startIndex
  	"Read n objects into the given collection. 
  	Return aCollection or a partial copy if less than n elements have been read."
  	"Overriden for efficiency"
  	| max |
  	max := (readLimit - position) min: n.
  	aCollection 
  		replaceFrom: startIndex 
  		to: startIndex+max-1
  		with: collection
  		startingAt: position+1.
  	position := position + max.
  	max = n
  		ifTrue:[^aCollection]
  		ifFalse:[^aCollection copyFrom: 1 to: startIndex+max-1]!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>nextPut: (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>nextPut: (in category 'as yet unclassified') -----
  nextPut: charOrByte
  
  	^super nextPut: charOrByte asCharacter!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>readInto:startingAt:count: (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>readInto:startingAt:count: (in category 'as yet unclassified') -----
  readInto: aCollection startingAt: startIndex count: n
  	"Read n objects into the given collection. 
  	Return number of elements that have been read."
  	"Overriden for efficiency"
  	| max |
  	max := (readLimit - position) min: n.
  	aCollection 
  		replaceFrom: startIndex 
  		to: startIndex+max-1
  		with: collection
  		startingAt: position+1.
  	position := position + max.
  	^max!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>reset (in category 'positioning') -----
- ----- Method: RWBinaryOrTextStream>>reset (in category 'as yet unclassified') -----
  reset
  	"Set the receiver's position to the beginning of the sequence of objects."
  
  	super reset.
  	isBinary ifNil: [isBinary := false].
  	collection class == ByteArray ifTrue: ["Store as String and convert as needed."
  		collection := collection asString.
  		isBinary := true].
  !

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>text (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>text (in category 'as yet unclassified') -----
  text
  	isBinary := false!

Item was changed:
  ----- Method: RWBinaryOrTextStream>>upTo: (in category 'accessing') -----
+ upTo: anObject
+ 	"fast version using indexOf:"
+ 
+ 	| start end |
+ 	start := position+1.
+ 	isBinary
+ 		ifTrue: [ anObject isInteger ifFalse: [ ^self upToEnd ] ]
+ 		ifFalse: [ anObject isCharacter ifFalse: [ ^self upToEnd ] ].
+ 	end := collection indexOf: anObject asCharacter startingAt: start ifAbsent: [ 0 ].
+ 	"not present--return rest of the collection"	
+ 	(end = 0 or: [end > readLimit]) ifTrue: [ ^self upToEnd ].
+ 	"skip to the end and return the data passed over"
+ 	position := end.
+ 	^((isBinary ifTrue: [ ByteArray ] ifFalse: [ String ]) new: end - start)
+ 		replaceFrom: 1
+ 		to: end - start
+ 		with: collection
+ 		startingAt: start!
- upTo: anObject 
- 	"Answer a subcollection from the current access position to the 
- 	occurrence (if any, but not inclusive) of anObject in the receiver. If 
- 	anObject is not in the collection, answer the entire rest of the receiver."
- 	| newStream element species |
- 	species := isBinary ifTrue:[ByteArray] ifFalse:[String].
- 	newStream := WriteStream on: (species new: 100).
- 	[self atEnd or: [(element := self next) = anObject]]
- 		whileFalse: [newStream nextPut: element].
- 	^newStream contents!

Item was changed:
+ ----- Method: RWBinaryOrTextStream>>upToEnd (in category 'accessing') -----
- ----- Method: RWBinaryOrTextStream>>upToEnd (in category 'as yet unclassified') -----
  upToEnd
  	"Must override to get class right."
  	| newArray |
  	newArray := (isBinary ifTrue: [ByteArray] ifFalse: [ByteString]) new: self size - self position.
  	^ self nextInto: newArray!

Item was changed:
  ----- Method: String>>unescapePercents (in category 'converting') -----
  unescapePercents
+ 	"decode %xx form.  This is the opposite of #encodeForHTTP. Assume UTF-8 encoding by default."
+ 	
+ 	| unescaped |
+ 	unescaped := self unescapePercentsRaw.
+ 	^[ unescaped utf8ToSqueak ]
+ 		on: Error
+ 		do: [ unescaped ]!
- 	"decode %xx form.  This is the opposite of #encodeForHTTP"
- 	^ self unescapePercentsWithTextEncoding: 'utf-8'.!

Item was added:
+ ----- Method: String>>unescapePercentsRaw (in category 'converting') -----
+ unescapePercentsRaw
+ 	"decode string including %XX form"
+ 	
+ 	| unescaped char asciiVal specialChars oldPos pos |
+ 	unescaped := ReadWriteStream on: String new.
+ 	specialChars := '+%' asCharacterSet.
+ 	oldPos := 1.
+ 	[pos := self indexOfAnyOf: specialChars startingAt: oldPos.
+ 	pos > 0]
+ 		whileTrue: [unescaped
+ 				nextPutAll: (self copyFrom: oldPos to: pos - 1).
+ 			char := self at: pos.
+ 			(char = $%
+ 					and: [pos + 2 <= self size])
+ 				ifTrue: [asciiVal := (self at: pos + 1) asUppercase digitValue * 16 + (self at: pos + 2) asUppercase digitValue.
+ 					asciiVal > 255
+ 						ifTrue: [^ self].
+ 					unescaped
+ 						nextPut: (Character value: asciiVal).
+ 					pos := pos + 3.
+ 					pos <= self size
+ 						ifFalse: [char := nil].
+ 					oldPos := pos]
+ 				ifFalse: [char = $+
+ 						ifTrue: [unescaped nextPut: Character space]
+ 						ifFalse: [unescaped nextPut: char].
+ 					oldPos := pos + 1]].
+ 	oldPos <= self size
+ 		ifTrue: [unescaped
+ 				nextPutAll: (self copyFrom: oldPos to: self size)].
+ 	^unescaped contents!

Item was added:
+ ----- Method: String>>unescapePercentsWithTextConverter: (in category 'converting') -----
+ unescapePercentsWithTextConverter: aTextConverter
+ 	"decode string including %XX form"
+ 
+ 	| unescaped |
+ 	unescaped := self unescapePercentsRaw.
+ 	^[ unescaped convertFromWithConverter: aTextConverter ]
+ 		on: Error
+ 		do: ["the contents may be squeak-encoded"
+ 			unescaped ]!

Item was changed:
  ----- Method: String>>unescapePercentsWithTextEncoding: (in category 'converting') -----
  unescapePercentsWithTextEncoding: encodingName 
  	"decode string including %XX form"
+ 	
+ 	| converter |
- 	| unescaped char asciiVal specialChars oldPos pos converter |
- 	unescaped := ReadWriteStream on: String new.
- 	specialChars := '+%' asCharacterSet.
- 	oldPos := 1.
- 	[pos := self indexOfAnyOf: specialChars startingAt: oldPos.
- 	pos > 0]
- 		whileTrue: [unescaped
- 				nextPutAll: (self copyFrom: oldPos to: pos - 1).
- 			char := self at: pos.
- 			(char = $%
- 					and: [pos + 2 <= self size])
- 				ifTrue: [asciiVal := (self at: pos + 1) asUppercase digitValue * 16 + (self at: pos + 2) asUppercase digitValue.
- 					asciiVal > 255
- 						ifTrue: [^ self].
- 					unescaped
- 						nextPut: (Character value: asciiVal).
- 					pos := pos + 3.
- 					pos <= self size
- 						ifFalse: [char := nil].
- 					oldPos := pos]
- 				ifFalse: [char = $+
- 						ifTrue: [unescaped nextPut: Character space]
- 						ifFalse: [unescaped nextPut: char].
- 					oldPos := pos + 1]].
- 	oldPos <= self size
- 		ifTrue: [unescaped
- 				nextPutAll: (self copyFrom: oldPos to: self size)].
  	converter := (TextConverter newForEncoding: encodingName)
+ 		ifNil: [ TextConverter newForEncoding: nil ].
+ 	^self unescapePercentsWithTextConverter: converter!
- 				ifNil: [TextConverter newForEncoding: nil].
- 	^ [unescaped contents convertFromWithConverter: converter]
- 		on: Error
- 		do: ["the contents may be squeak-encoded"
- 			unescaped contents]!




More information about the Squeak-dev mailing list