[Pkg] The Trunk: Collections.spur-ul.628.mcz

commits at source.squeak.org commits at source.squeak.org
Sat May 16 01:04:16 UTC 2015


Chris Muller uploaded a new version of Collections to project The Trunk:
http://source.squeak.org/trunk/Collections.spur-ul.628.mcz

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

Name: Collections.spur-ul.628
Author: eem
Time: 12 May 2015, 3:25:25.224 pm
UUID: 8bd59dd5-62cb-47bd-ae4f-214daa95aa07
Ancestors: Collections-ul.628, Collections.spur-ul.627

Collections-ul.628 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.267

Merged Collections-ul.625.

=============== Diff against Collections-mt.621 ===============

Item was changed:
  ----- Method: Array>>elementsExchangeIdentityWith: (in category 'converting') -----
  elementsExchangeIdentityWith: otherArray
+ 	"This primitive performs a bulk mutation, causing all pointers to the elements of the
+ 	 receiver to be replaced by pointers to the corresponding elements of otherArray.
+ 	 At the same time, all pointers to the elements of otherArray are replaced by
+ 	 pointers to the corresponding elements of this array.  The identityHashes remain
+ 	 with the pointers rather than with the objects so that objects in hashed structures
+ 	 should still be properly indexed after the mutation."
- 	"This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray.  At the same time, all pointers to the elements of otherArray are replaced by pointers to the corresponding elements of this array.  The identityHashes remain with the pointers rather than with the objects so that objects in hashed structures should still be properly indexed after the mutation."
  
+ 	<primitive: 128 error: ec>
+ 	ec == #'bad receiver' ifTrue:
+ 		[^self error: 'receiver must be of class Array'].
+ 	ec == #'bad argument' ifTrue:
+ 		[^self error: (otherArray class == Array
+ 						ifTrue: ['arg must be of class Array']
+ 						ifFalse: ['receiver and argument must have the same size'])].
+ 	ec == #'inappropriate operation' ifTrue:
+ 		[^self error: 'can''t become immediates such as SmallIntegers or Characters'].
+ 	ec == #'no modification' ifTrue:
+ 		[^self error: 'can''t become immutable objects'].
+ 	ec == #'object is pinned' ifTrue:
+ 		[^self error: 'can''t become pinned objects'].
+ 	ec == #'insufficient object memory' ifTrue:
+ 		[Smalltalk garbageCollect < 1048576 ifTrue:
+ 			[Smalltalk growMemoryByAtLeast: 1048576].
+ 		 ^self elementsExchangeIdentityWith: otherArray].
+ 	self primitiveFailed!
- 	<primitive: 128>
- 	otherArray class == Array ifFalse: [^ self error: 'arg must be array'].
- 	self size = otherArray size ifFalse: [^ self error: 'arrays must be same size'].
- 	(self anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers'].
- 	(otherArray anySatisfy: [:obj | obj class == SmallInteger]) ifTrue: [^ self error: 'can''t become SmallIntegers'].
- 	self with: otherArray do:[:a :b| a == b ifTrue:[^self error:'can''t become yourself']].
- 
- 	"Must have failed because not enough space in forwarding table (see ObjectMemory-prepareForwardingTableForBecoming:with:twoWay:).  Do GC and try again only once"
- 	(Smalltalk bytesLeft: true) = Smalltalk primitiveGarbageCollect
- 		ifTrue: [^ self primitiveFailed].
- 	^ self elementsExchangeIdentityWith: otherArray!

Item was changed:
  ----- Method: Array>>elementsForwardIdentityTo: (in category 'converting') -----
  elementsForwardIdentityTo: otherArray
+ 	"This primitive performs a bulk mutation, causing all pointers to the elements of the
+ 	 receiver to be replaced by pointers to the corresponding elements of otherArray.
+ 	 The identityHashes remain with the pointers rather than with the objects so that
+ 	 the objects in this array should still be properly indexed in any existing hashed
+ 	 structures after the mutation."
+ 	<primitive: 72 error: ec>
- 	"This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray.  The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation."
- 	<primitive: 72>
  	self primitiveFailed!

Item was changed:
  ----- Method: Array>>elementsForwardIdentityTo:copyHash: (in category 'converting') -----
  elementsForwardIdentityTo: otherArray copyHash: copyHash
+ 	"This primitive performs a bulk mutation, causing all pointers to the elements of the
+ 	 receiver to be replaced by pointers to the corresponding elements of otherArray.
+ 	 If copyHash is true, the identityHashes remain with the pointers rather than with the
+ 	 objects so that the objects in the receiver should still be properly indexed in any
+ 	 existing hashed structures after the mutation.  If copyHash is false, then the hashes
+ 	 of the objects in otherArray remain unchanged.  If you know what you're doing this
+ 	 may indeed be what you want."
+ 	<primitive: 249 error: ec>
- 	"This primitive performs a bulk mutation, causing all pointers to the elements of this array to be replaced by pointers to the corresponding elements of otherArray.  The identityHashes remain with the pointers rather than with the objects so that the objects in this array should still be properly indexed in any existing hashed structures after the mutation."
- 	<primitive: 249>
  	self primitiveFailed!

Item was removed:
- ----- Method: ByteString>>beginsWith: (in category 'testing') -----
- beginsWith: sequence
- 	"Answer whether the receiver begins with the given sequence. The comparison is case-sensitive. Overridden for better performance."
- 
- 	| sequenceSize |
- 	sequence class isBytes ifFalse: [ ^super beginsWith: sequence ].
- 	((sequenceSize := sequence size) = 0 or: [ self size < sequenceSize ]) ifTrue: [ ^false ].
- 	"The following method uses a suboptimal algorithm (brute force pattern matching with O(n^2) worst case runtime), but the primitive in C is so fast (assuming large alphabets), that it's still worth using it instead of linear time pure smalltalk implementation. There are some obvious cases when the brute force algorithm is suboptimal, e.g. when the first elements don't match, so let's compare them here before using the primitive."
- 	(self basicAt: 1) = (sequence basicAt: 1) ifFalse: [ ^false ].
- 	^(self findSubstring: sequence in: self startingAt: 1 matchTable: CaseSensitiveOrder) = 1!

Item was changed:
  ----- Method: ByteString>>findSubstring:in:startingAt:matchTable: (in category 'comparing') -----
  findSubstring: key in: body startingAt: start matchTable: matchTable
  	"Answer the index in the string body at which the substring key first occurs, at or beyond start.  The match is determined using matchTable, which can be used to effect, eg, case-insensitive matches.  If no match is found, zero will be returned.
  
  	The algorithm below is not optimum -- it is intended to be translated to C which will go so fast that it wont matter."
  	| index |
  	<primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'>
  	<var: #key declareC: 'unsigned char *key'>
  	<var: #body declareC: 'unsigned char *body'>
  	<var: #matchTable declareC: 'unsigned char *matchTable'>
  
  	key size = 0 ifTrue: [^ 0].
+ 	(start max: 1) to: body size - key size + 1 do:
- 	start to: body size - key size + 1 do:
  		[:startIndex |
  		index := 1.
  			[(matchTable at: (body at: startIndex+index-1) asciiValue + 1)
  				= (matchTable at: (key at: index) asciiValue + 1)]
  				whileTrue:
  				[index = key size ifTrue: [^ startIndex].
  				index := index+1]].
  	^ 0
  "
  ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 1 matchTable: CaseSensitiveOrder 1
  ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 2 matchTable: CaseSensitiveOrder 7
  ' ' findSubstring: 'abc' in: 'abcdefabcd' startingAt: 8 matchTable: CaseSensitiveOrder 0
  ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseSensitiveOrder 0
  ' ' findSubstring: 'abc' in: 'abcdefABcd' startingAt: 2 matchTable: CaseInsensitiveOrder 7
  "!

Item was removed:
- ----- Method: ByteSymbol>>beginsWith: (in category 'testing') -----
- beginsWith: sequence
- 	"Answer whether the receiver begins with the given sequence. The comparison is case-sensitive. Overridden for better performance."
- 
- 	| sequenceSize |
- 	sequence class isBytes ifFalse: [ ^super beginsWith: sequence ].
- 	((sequenceSize := sequence size) = 0 or: [ self size < sequenceSize ]) ifTrue: [ ^false ].
- 	"The following method uses a suboptimal algorithm (brute force pattern matching with O(n^2) worst case runtime), but the primitive in C is so fast (assuming large alphabets), that it's still worth using it instead of linear time pure smalltalk implementation. There are some obvious cases when the brute force algorithm is suboptimal, e.g. when the first elements don't match, so let's compare them here before using the primitive."
- 	(self basicAt: 1) = (sequence basicAt: 1) ifFalse: [ ^false ].
- 	^(self findSubstring: sequence in: self startingAt: 1 matchTable: CaseSensitiveOrder) = 1!

Item was changed:
+ Magnitude immediateSubclass: #Character
+ 	instanceVariableNames: ''
+ 	classVariableNames: 'AlphaNumericMask CharacterTable ClassificationTable DigitBit DigitValues LetterMask LowercaseBit UppercaseBit'
- Magnitude subclass: #Character
- 	instanceVariableNames: 'value'
- 	classVariableNames: 'CharacterTable ClassificationTable DigitValues LetterBits LowercaseBit UppercaseBit'
  	poolDictionaries: ''
  	category: 'Collections-Strings'!
  
+ !Character commentStamp: 'eem 8/12/2014 14:53' prior: 0!
+ I represent a character by storing its associated Unicode as an unsigned 30-bit value.  Characters are created uniquely, so that all instances of a particular Unicode are identical.  My instances are encoded in tagged pointers in the VM, so called immediates, and therefore are pure immutable values.
- !Character commentStamp: 'ar 4/9/2005 22:35' prior: 0!
- I represent a character by storing its associated Unicode. The first 256 characters are created uniquely, so that all instances of latin1 characters ($R, for example) are identical.
  
  	The code point is based on Unicode.  Since Unicode is 21-bit wide character set, we have several bits available for other information.  As the Unicode Standard  states, a Unicode code point doesn't carry the language information.  This is going to be a problem with the languages so called CJK (Chinese, Japanese, Korean.  Or often CJKV including Vietnamese).  Since the characters of those languages are unified and given the same code point, it is impossible to display a bare Unicode code point in an inspector or such tools.  To utilize the extra available bits, we use them for identifying the languages.  Since the old implementation uses the bits to identify the character encoding, the bits are sometimes called "encoding tag" or neutrally "leading char", but the bits rigidly denotes the concept of languages.
  
+ 	The other languages can have the language tag if you like.  This will help to break the large default font (font set) into separately loadable chunk of fonts.  However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false.!
- 	The other languages can have the language tag if you like.  This will help to break the large default font (font set) into separately loadable chunk of fonts.  However, it is open to the each native speakers and writers to decide how to define the character equality, since the same Unicode code point may have different language tag thus simple #= comparison may return false.
- 
- I represent a character by storing its associated ASCII code (extended to 256 codes). My instances are created uniquely, so that all instances of a character ($R, for example) are identical.!

Item was changed:
  ----- Method: Character class>>digitValue: (in category 'instance creation') -----
  digitValue: x 
+ 	"Answer the Character whose digit value is x. For example,
+ 	 answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35."
- 	"Answer the Character whose digit value is x. For example, answer $9 for 
- 	x=9, $0 for x=0, $A for x=10, $Z for x=35."
  
+ 	| n |
+ 	n := x asInteger.
+ 	^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])!
- 	| index |
- 	index := x asInteger.
- 	^CharacterTable at: 
- 		(index < 10
- 			ifTrue: [48 + index]
- 			ifFalse: [55 + index])
- 		+ 1!

Item was changed:
  ----- Method: Character class>>initialize (in category 'class initialization') -----
  initialize
+ 	"Create the DigitsValues table."
+ 	"Character initialize"
- 	"Create the table of unique Characters, and DigitsValues."
- 	"Character initializeClassificationTable"
- 	
- 	CharacterTable ifNil: [
- 		"Initialize only once to ensure that byte characters are unique"
- 		CharacterTable := Array new: 256.
- 		1 to: 256 do: [:i | CharacterTable at: i put: (self basicNew setValue: i - 1)]].
  	self initializeDigitValues!

Item was changed:
  ----- Method: Character class>>initializeClassificationTable (in category 'class initialization') -----
  initializeClassificationTable
+ 	"Initialize the classification table.
+ 	The classification table is a compact encoding of upper and lower cases and digits of characters with
+ 		- bits 0-7: The lower case value of this character or 0, if its greater than 255.
+ 		- bits 8-15: The upper case value of this character or 0, if its greater than 255.
+ 		- bit 16: lowercase bit (isLowercase == true)
+ 		- bit 17: uppercase bit (isUppercase == true)
+ 		- bit 18: digit bit (isDigit == true)"
+ 	" self initializeClassificationTable "
- 	"
- 	Initialize the classification table. The classification table is a
- 	compact encoding of upper and lower cases of characters with
  
+ 	| encodedCharSet newClassificationTable |
+ 	"Base the table on the EncodedCharset of these characters' leadingChar - 0."
+ 	encodedCharSet := EncodedCharSet charsetAt: 0.
- 		- bits 0-7: The lower case value of this character.
- 		- bits 8-15: The upper case value of this character.
- 		- bit 16: lowercase bit (e.g., isLowercase == true)
- 		- bit 17: uppercase bit (e.g., isUppercase == true)
  
- 	"
- 	| ch1 |
- 
  	LowercaseBit := 1 bitShift: 16.
  	UppercaseBit := 1 bitShift: 17.
+ 	DigitBit := 1 bitShift: 18.
  
+ 	"Initialize the letter mask (e.g., isLetter == true)"
+ 	LetterMask := LowercaseBit bitOr: UppercaseBit.
- 	"Initialize the letter bits (e.g., isLetter == true)"
- 	LetterBits := LowercaseBit bitOr: UppercaseBit.
  
+ 	"Initialize the alphanumeric mask (e.g. isAlphaNumeric == true)"
+ 	AlphaNumericMask := LetterMask bitOr: DigitBit.
- 	ClassificationTable := Array new: 256.
- 	"Initialize the defaults (neither lower nor upper case)"
- 	0 to: 255 do:[:i|
- 		ClassificationTable at: i+1 put: (i bitShift: 8) + i.
- 	].
  
+ 	"Initialize the table based on encodedCharSet."
+ 	newClassificationTable := Array new: 256.
+ 	0 to: 255 do: [ :code |
+ 		| isLowercase isUppercase isDigit lowercaseCode uppercaseCode value |
+ 		isLowercase := encodedCharSet isLowercaseCode: code.
+ 		isUppercase := encodedCharSet isUppercaseCode: code.
+ 		isDigit := encodedCharSet isDigitCode: code.
+ 		lowercaseCode := encodedCharSet toLowercaseCode: code.
+ 		lowercaseCode > 255 ifTrue: [ lowercaseCode := 0 ].
+ 		uppercaseCode := encodedCharSet toUppercaseCode: code.
+ 		uppercaseCode > 255 ifTrue: [ uppercaseCode := 0 ].
+ 		value := (uppercaseCode bitShift: 8) + lowercaseCode.
+ 		isLowercase ifTrue: [ value := value bitOr: LowercaseBit ].
+ 		isUppercase ifTrue: [ value := value bitOr: UppercaseBit ].
+ 		isDigit ifTrue: [ value := value bitOr: DigitBit ].
+ 		newClassificationTable at: code + 1 put: value ].
+ 	ClassificationTable := newClassificationTable!
- 	"Initialize character pairs (upper-lower case)"
- 	#(
- 		"Basic roman"
- 		($A $a) 	($B $b) 	($C $c) 	($D $d) 
- 		($E $e) 	($F $f) 	($G $g) 	($H $h) 
- 		($I $i) 		($J $j) 		($K $k) 	($L $l) 
- 		($M $m)	($N $n)	($O $o)	($P $p) 
- 		($Q $q) 	($R $r) 	($S $s) 	($T $t) 
- 		($U $u)	($V $v)	($W $w)	($X $x)
- 		($Y $y)	($Z $z)
- 		"International"
- 		($Ä $ä)	($Å $å)	($Ç $ç)	($É $é)
- 		($Ñ $ñ)	($Ö $ö)	($Ü $ü)	($À $à)
- 		($à $ã)	($Õ $õ)	($Œ $œ)	($Æ $æ)
- 		"International - Spanish"
- 		($Á $á)	($Í $í)		($Ó $ó)	($Ú $ú)
- 		"International - PLEASE CHECK"
- 		($È $è)	($Ì $ì)		($Ò $ò)	($Ù $ù)
- 		($Ë $ë)	($Ï $ï)
- 		($Â $â)	($Ê $ê)	($Î $î)	($Ô $ô)	($Û $û)
- 	) do:[:pair| | ch2 |
- 		ch1 := pair first asciiValue.
- 		ch2 := pair last asciiValue.
- 		ClassificationTable at: ch1+1 put: (ch1 bitShift: 8) + ch2 + UppercaseBit.
- 		ClassificationTable at: ch2+1 put: (ch1 bitShift: 8) + ch2 + LowercaseBit.
- 	].
- 
- 	"Initialize a few others for which we only have lower case versions."
- 	#($ß $Ø $ø $ÿ) do:[:char|
- 		ch1 := char asciiValue.
- 		ClassificationTable at: ch1+1 put: (ch1 bitShift: 8) + ch1 + LowercaseBit.
- 	].
- !

Item was changed:
  ----- Method: Character class>>value: (in category 'instance creation') -----
+ value: anInteger
- value: anInteger 
  	"Answer the Character whose value is anInteger."
+ 	<primitive: 170>
+ 	^self primitiveFailed!
- 
- 	anInteger > 255 ifTrue: [^self basicNew setValue: anInteger].
- 	^ CharacterTable at: anInteger + 1.
- !

Item was changed:
  ----- Method: Character>>< (in category 'comparing') -----
  < aCharacter 
  	"Answer true if the receiver's value < aCharacter's value."
  
+ 	^self asInteger < aCharacter asciiValue!
- 	^value < aCharacter asciiValue!

Item was changed:
  ----- Method: Character>><= (in category 'comparing') -----
  <= aCharacter 
  	"Answer true if the receiver's value <= aCharacter's value."
  
+ 	^self asInteger <= aCharacter asciiValue!
- 	^value <= aCharacter asciiValue!

Item was changed:
  ----- Method: Character>>= (in category 'comparing') -----
  = aCharacter 
+ 	"Primitive. Answer if the receiver and the argument are the
+ 	 same object (have the same object pointer). Optional. See
+ 	 Object documentation whatIsAPrimitive."
+ 	<primitive: 110>
+ 	^self == aCharacter!
- 
- 	^self == aCharacter or: [
- 		aCharacter isCharacter and: [ aCharacter asciiValue = value ] ]!

Item was changed:
  ----- Method: Character>>> (in category 'comparing') -----
  > aCharacter 
  	"Answer true if the receiver's value > aCharacter's value."
  
+ 	^self asInteger > aCharacter asciiValue!
- 	^value > aCharacter asciiValue!

Item was changed:
  ----- Method: Character>>>= (in category 'comparing') -----
  >= aCharacter 
  	"Answer true if the receiver's value >= aCharacter's value."
  
+ 	^self asInteger >= aCharacter asciiValue!
- 	^value >= aCharacter asciiValue!

Item was changed:
  ----- Method: Character>>asInteger (in category 'converting') -----
  asInteger
+ 	"Answer the receiver's character code."
+ 	<primitive: 171>
+ 	^self primitiveFailed!
- 	"Answer the value of the receiver."
- 
- 	^value!

Item was changed:
  ----- Method: Character>>asLowercase (in category 'converting') -----
  asLowercase
+ 	"Answer the receiver's matching lowercase Character."
+ 	
+ 	self asInteger > 255 ifFalse: [ 
+ 		| result |
+ 		(result := (ClassificationTable at: self asInteger + 1) bitAnd: 16rFF) > 0
+ 			ifTrue: [ ^self class value: result ] ].
+ 	^self class value: (self encodedCharSet toLowercaseCode: self asInteger)!
- 	"If the receiver is uppercase, answer its matching lowercase Character."
- 	"A tentative implementation.  Eventually this should consult the Unicode table."
- 
- 	| v |
- 	v := self charCode.
- 	(((8r101 <= v and: [v <= 8r132]) or: [16rC0 <= v and: [v <= 16rD6]]) or: [16rD8 <= v and: [v <= 16rDE]])
- 		ifTrue: [^ Character value: v + 8r40].
- 	v < 256 ifTrue: [^self].
- 	^self class value: ((value < 16r400000
- 		ifTrue: [Unicode]
- 		ifFalse: [self encodedCharSet charsetClass])
- 			toLowercaseCode: v)!

Item was changed:
  ----- Method: Character>>asUnicode (in category 'converting') -----
  asUnicode
  	"Answer the unicode encoding of the receiver"
+ 	self leadingChar = 0 ifTrue: [^ self asInteger].
- 	self leadingChar = 0 ifTrue: [^ value].
  	^self encodedCharSet charsetClass convertToUnicode: self charCode
  !

Item was changed:
  ----- Method: Character>>asUppercase (in category 'converting') -----
  asUppercase
+ 	"Answer the receiver's matching uppercase Character."
+ 	
+ 	self asInteger > 255 ifFalse: [ 
+ 		| result |
+ 		(result := ((ClassificationTable at: self asInteger + 1) bitShift: -8) bitAnd: 16rFF) > 0
+ 			ifTrue: [ ^self class value: result ] ].
+ 	^self class value: (self encodedCharSet toUppercaseCode: self asInteger)!
- 	"If the receiver is lowercase, answer its matching uppercase Character."
- 	"A tentative implementation.  Eventually this should consult the Unicode table."	
- 
- 	| v |
- 	v := self charCode.
- 	(((8r141 <= v and: [v <= 8r172]) or: [16rE0 <= v and: [v <= 16rF6]]) or: [16rF8 <= v and: [v <= 16rFE]])
- 		ifTrue: [^ Character value: v - 8r40].
- 	v < 256 ifTrue: [^self].
- 	^self class value: ((value < 16r400000
- 		ifTrue: [Unicode]
- 		ifFalse: [self encodedCharSet charsetClass])
- 			toUppercaseCode: v)!

Item was changed:
  ----- Method: Character>>asciiValue (in category 'accessing') -----
  asciiValue
+ 	"Answer the receiver's character code.
+ 	 This will be ascii for characters with value <= 127,
+ 	 and Unicode for those with higher values."
+ 	<primitive: 171>
+ 	^self primitiveFailed!
- 	"Answer the value of the receiver that represents its ascii encoding."
- 
- 	^value!

Item was changed:
  ----- Method: Character>>charCode (in category 'accessing') -----
  charCode
  
+ 	^ (self asInteger bitAnd: 16r3FFFFF).
- 	^ (value bitAnd: 16r3FFFFF).
  !

Item was changed:
  ----- Method: Character>>clone (in category 'copying') -----
  clone
+ 	"Answer the receiver, because Characters are unique."
+ 	^self!
- 	"Characters from 0 to 255 are unique, copy only the rest."
- 		
- 	value < 256 ifTrue: [ ^self ].
- 	^super clone!

Item was changed:
  ----- Method: Character>>codePoint (in category 'accessing') -----
  codePoint
  	"Return the encoding value of the receiver."
  	#Fundmntl.
  
+ 	^self asInteger!
- 	^value!

Item was removed:
- ----- Method: Character>>comeFullyUpOnReload: (in category 'object fileIn') -----
- comeFullyUpOnReload: smartRefStream
- 	"Use existing an Character.  Don't use the new copy."
- 
- 	^ self class value: value!

Item was changed:
  ----- Method: Character>>copy (in category 'copying') -----
  copy
+ 	"Answer the receiver, because Characters are unique."
+ 	^self!
- 	"Characters from 0 to 255 are unique, copy only the rest."
- 	
- 	value < 256 ifTrue: [ ^self ].
- 	^super copy!

Item was changed:
  ----- Method: Character>>deepCopy (in category 'copying') -----
  deepCopy
+ 	"Answer the receiver, because Characters are unique."
+ 	^self!
- 	"Characters from 0 to 255 are unique, copy only the rest."
- 	
- 	value < 256 ifTrue: [ ^self ].
- 	^super deepCopy!

Item was changed:
  ----- Method: Character>>digitValue (in category 'accessing') -----
  digitValue
  	"Answer 0-9 if the receiver is $0-$9, 10-35 if it is $A-$Z, and < 0 
  	otherwise. This is used to parse literal numbers of radix 2-36."
  
+ 	self asInteger > 16rFF ifTrue: [^self encodedCharSet digitValueOf: self].
+ 	^DigitValues at: 1 + self asInteger!
- 	value > 16rFF ifTrue: [^self encodedCharSet digitValueOf: self].
- 	^DigitValues at: 1 + value!

Item was changed:
  ----- Method: Character>>encodedCharSet (in category 'accessing') -----
  encodedCharSet
+ 	
+ 	self asInteger < 16r400000 ifTrue: [ ^Unicode ]. "Shortcut"
- 
  	^EncodedCharSet charsetAt: self leadingChar
  !

Item was changed:
  ----- Method: Character>>hash (in category 'comparing') -----
  hash
+ 	"Hash is reimplemented because = is implemented.
+ 	 Answer the receiver's character code."
+ 	<primitive: 171>
+ 	^self primitiveFailed!
- 	"Hash is reimplemented because = is implemented."
- 
- 	^value!

Item was changed:
  ----- Method: Character>>hex (in category 'printing') -----
  hex
+ 	^self asInteger printStringBase: 16!
- 	^value printStringBase: 16!

Item was added:
+ ----- Method: Character>>identityHash (in category 'comparing') -----
+ identityHash
+ 	"Answer the receiver's character code."
+ 	<primitive: 171>
+ 	^self primitiveFailed!

Item was changed:
  ----- Method: Character>>isAlphaNumeric (in category 'testing') -----
  isAlphaNumeric
  	"Answer whether the receiver is a letter or a digit."
  
+ 	self asInteger > 255 ifFalse: [ ^((ClassificationTable at: self asInteger + 1) bitAnd: AlphaNumericMask) > 0 ].
  	^self encodedCharSet isAlphaNumeric: self!

Item was changed:
  ----- Method: Character>>isAscii (in category 'testing') -----
  isAscii
+ 	^ self asInteger between: 0 and: 127!
- 	^ value between: 0 and: 127!

Item was changed:
  ----- Method: Character>>isDigit (in category 'testing') -----
  isDigit
  
+ 	self asInteger > 255 ifFalse: [ ^((ClassificationTable at: self asInteger + 1) bitAnd: DigitBit) > 0 ].
  	^self encodedCharSet isDigit: self.
  !

Item was changed:
  ----- Method: Character>>isLetter (in category 'testing') -----
  isLetter
  
+ 	self asInteger > 255 ifFalse: [ ^((ClassificationTable at: self asInteger + 1) bitAnd: LetterMask) > 0 ].
+ 	^self encodedCharSet isLetter: self!
- 	^self encodedCharSet isLetter: self.
- !

Item was changed:
  ----- Method: Character>>isLowercase (in category 'testing') -----
  isLowercase
  
+ 	self asInteger > 255 ifFalse: [ ^((ClassificationTable at: self asInteger + 1) bitAnd: LowercaseBit) > 0 ].
  	^self encodedCharSet isLowercase: self.
  !

Item was changed:
  ----- Method: Character>>isOctetCharacter (in category 'testing') -----
  isOctetCharacter
  
+ 	^ self asInteger < 256.
- 	^ value < 256.
  !

Item was changed:
  ----- Method: Character>>isSeparator (in category 'testing') -----
  isSeparator
  	"Answer whether the receiver is one of the separator characters--space, 
  	cr, tab, line feed, or form feed."
  
+ 	self asInteger = 32 ifTrue: [^true].	"space"
+ 	self asInteger = 13 ifTrue: [^true].	"cr"
+ 	self asInteger = 9 ifTrue: [^true].	"tab"
+ 	self asInteger = 10 ifTrue: [^true].	"line feed"
+ 	self asInteger = 12 ifTrue: [^true].	"form feed"
- 	value = 32 ifTrue: [^true].	"space"
- 	value = 13 ifTrue: [^true].	"cr"
- 	value = 9 ifTrue: [^true].	"tab"
- 	value = 10 ifTrue: [^true].	"line feed"
- 	value = 12 ifTrue: [^true].	"form feed"
  	^false!

Item was changed:
  ----- Method: Character>>isUppercase (in category 'testing') -----
  isUppercase
  
+ 	self asInteger > 255 ifFalse: [ ^((ClassificationTable at: self asInteger + 1) bitAnd: UppercaseBit) > 0 ].
  	^self encodedCharSet isUppercase: self.
  !

Item was changed:
  ----- Method: Character>>leadingChar (in category 'accessing') -----
  leadingChar
  	"Answer the value of the 8 highest bits which is used to identify the language.
  	This is mostly used for east asian languages CJKV as a workaround against unicode han-unification."
+ 	^ self asInteger bitShift: -22!
- 	^ value bitShift: -22!

Item was changed:
  ----- Method: Character>>macToSqueak (in category 'converting') -----
  macToSqueak
  	"Convert the receiver from MacRoman to Squeak encoding"
  	| asciiValue |
+ 	self asInteger < 128 ifTrue: [^ self].
+ 	self asInteger > 255 ifTrue: [^ self].
- 	value < 128 ifTrue: [^ self].
- 	value > 255 ifTrue: [^ self].
  	asciiValue := #[
  		196 197 199 201 209 214 220 225 224 226 228 227 229 231 233 232	"80-8F"
  		234 235 237 236 238 239 241 243 242 244 246 245 250 249 251 252	"90-9F"
  		134 176 162 163 167 149 182 223 174 169 153 180 168 128 198 216	"A0-AF"
  		129 177 138 141 165 181 142 143 144 154 157 170 186 158 230 248	"B0-BF"
  		191 161 172 166 131 173 178 171 187 133 160 192 195 213 140 156	"C0-CF"
  		150 151 147 148 145 146 247 179 255 159 185 164 139 155 188 189	"D0-DF"
  		135 183 130 132 137 194 202 193 203 200 205 206 207 204 211 212	"E0-EF"
  		190 210 218 219 217 208 136 152 175 215 221 222 184 240 253 254 ]	"F0-FF"
+ 			at: self asInteger - 127.
- 			at: value - 127.
  	^ Character value: asciiValue.!

Item was changed:
  ----- Method: Character>>printOn: (in category 'printing') -----
  printOn: aStream
  	| name |
+ 	(self asInteger > 32 and: [self asInteger ~= 127])
- 	(value > 32 and: [value ~= 127])
  		ifTrue: [ aStream nextPut: $$; nextPut: self ]
  		ifFalse: [
  			name := self class constantNameFor: self.
  			name notNil
  				ifTrue: [ aStream nextPutAll: self class name; space; nextPutAll: name ]
+ 				ifFalse: [ aStream nextPutAll: self class name; nextPutAll: ' value: '; print: self asInteger ] ].!
- 				ifFalse: [ aStream nextPutAll: self class name; nextPutAll: ' value: '; print: value ] ].!

Item was removed:
- ----- Method: Character>>setValue: (in category 'private') -----
- setValue: newValue
- 	value ifNotNil:[^self error:'Characters are immutable'].
- 	value := newValue.!

Item was changed:
  ----- Method: Character>>shallowCopy (in category 'copying') -----
  shallowCopy
+ 	"Answer the receiver, because Characters are unique."
+ 	^self!
- 	"Characters from 0 to 255 are unique, copy only the rest."
- 		
- 	value < 256 ifTrue: [ ^self ].
- 	^super shallowCopy!

Item was changed:
  ----- Method: Character>>shouldBePrintedAsLiteral (in category 'testing') -----
  shouldBePrintedAsLiteral
  
+ 	^(self asInteger between: 33 and: 255) and: [self asInteger ~= 127]!
- 	^(value between: 33 and: 255) and: [value ~= 127]!

Item was changed:
  ----- Method: Character>>squeakToMac (in category 'converting') -----
  squeakToMac
  	"Convert the receiver from Squeak to MacRoman encoding."
+ 	self asInteger < 128 ifTrue: [^ self].
+ 	self asInteger > 255 ifTrue: [^ self].
- 	value < 128 ifTrue: [^ self].
- 	value > 255 ifTrue: [^ self].
  	^ Character value: (#[
  		173 176 226 196 227 201 160 224 246 228 178 220 206 179 182 183	"80-8F"
  		184 212 213 210 211 165 208 209 247 170 185 221 207 186 189 217	"90-9F"
  		202 193 162 163 219 180 195 164 172 169 187 199 194 197 168 248	"A0-AF"
  		161 177 198 215 171 181 166 225 252 218 188 200 222 223 240 192 	"B0-BF"
  		203 231 229 204 128 129 174 130 233 131 230 232 237 234 235 236 	"C0-CF"
  		245 132 241 238 239 205 133 249 175 244 242 243 134 250 251 167	"D0-DF"
  		136 135 137 139 138 140 190 141 143 142 144 145 147 146 148 149	"E0-EF"
  		253 150 152 151 153 155 154 214 191 157 156 158 159 254 255 216	"F0-FF"
+ 	] at: self asInteger - 127)
- 	] at: value - 127)
  !

Item was changed:
  ----- Method: Character>>storeBinaryOn: (in category 'printing') -----
  storeBinaryOn: aStream
  	"Store the receiver on a binary (file) stream"
  	
+ 	self asInteger < 256 
- 	value < 256 
  		ifTrue: [ aStream basicNextPut: self ]
+ 		ifFalse: [ aStream nextInt32Put: self asInteger ]!
- 		ifFalse: [ aStream nextInt32Put: value ]!

Item was changed:
  ----- Method: Character>>storeOn: (in category 'printing') -----
  storeOn: aStream
  	"Common character literals are preceded by '$', however special need to be encoded differently: for some this might be done by using one of the shortcut constructor methods for the rest we have to create them by ascii-value."
  
  	| name |
  	self shouldBePrintedAsLiteral
  		ifTrue: [ aStream nextPut: $$; nextPut: self ]
  		ifFalse: [
  			name := self class constantNameFor: self.
  			name notNil
  				ifTrue: [ aStream nextPutAll: self class name; space; nextPutAll: name ]
  				ifFalse: [
  					aStream 
  						nextPut: $(; nextPutAll: self class name; 
+ 						nextPutAll: ' value: '; print: self asInteger; nextPut: $) ] ].!
- 						nextPutAll: ' value: '; print: value; nextPut: $) ] ].!

Item was changed:
  ----- Method: Character>>to: (in category 'converting') -----
  to: other
  	"Answer with a collection in ascii order -- $a to: $z"
+ 	^ (self asInteger to: other asciiValue)
- 	^ (value to: other asciiValue)
  		collect:	[:ascii | Character value: ascii]
  		as: String!

Item was changed:
  ----- Method: Character>>tokenish (in category 'testing') -----
  tokenish
+ 	"Answer whether the receiver is a valid token-character--letter, digit, or colon."
- 	"Answer whether the receiver is a valid token-character--letter, digit, or 
- 	colon."
  
+ 	self == $_ ifTrue: [ ^Scanner prefAllowUnderscoreSelectors ].
+ 	^self == $: or: [ self isAlphaNumeric ]!
- 	^ self == $_
-  		ifTrue: [ Scanner prefAllowUnderscoreSelectors ]
-  		ifFalse: [ self == $: or: [ self isLetter or: [ self isDigit ] ] ]!

Item was changed:
  ----- Method: Character>>veryDeepCopyWith: (in category 'copying') -----
  veryDeepCopyWith: deepCopier
+ 	"Answer the receiver, because Characters are unique."
+ 	^self!
- 	"Characters from 0 to 255 are unique, copy only the rest."
- 	
- 	value < 256 ifTrue: [ ^self ].
- 	^super veryDeepCopyWith: deepCopier!

Item was removed:
- ----- Method: Collection>>toBraceStack: (in category 'private') -----
- toBraceStack: itsSize 
- 	"Push receiver's elements onto the stack of thisContext sender.  Error if receiver does
- 	 not have itsSize elements or if receiver is unordered.
- 	 Do not call directly: this is called by {a. b} := ... constructs."
- 
- 	self size ~= itsSize ifTrue:
- 		[self error: 'Trying to store ', self size printString,
- 					' values into ', itsSize printString, ' variables.'].
- 	thisContext sender push: itsSize fromIndexable: self!

Item was changed:
  ----- Method: String>>endsWith: (in category 'testing') -----
+ endsWith: sequence
+ 	"Answer true if the receiver ends with the argument collection. The comparison is case-sensitive."
- endsWith: suffix
- 	"Answer true if the receiver ends with the argument collection. The comparison is case-sensitive. Overridden for better performance."
  	
+ 	| sequenceSize offset |
+ 	sequence isString ifFalse: [ ^ super endsWith: sequence ].
+ 	((sequenceSize := sequence size) = 0 or: [ (offset := self size - sequence size) < 0 ]) ifTrue: [ ^false ].
+ 	1 to: sequenceSize do: [ :index |
+ 		(sequence basicAt: index) = (self basicAt: index + offset) ifFalse: [ ^false ] ].
+ 	^true!
- 	| offset |
- 	(offset := self size - suffix size) < 0 ifTrue: [ ^false ].
- 	^(self findString: suffix startingAt: offset + 1) ~= 0!

Item was changed:
  ----- Method: String>>withoutLineEndings (in category 'converting') -----
  withoutLineEndings
  
+ 	^self withLineEndings: ' '!
- 	^ self withSqueakLineEndings
- 		copyReplaceAll: String cr
- 		with: ' '
- 		asTokens: false!

Item was changed:
  ----- Method: Symbol>>numArgs: (in category 'system primitives') -----
  numArgs: n
  	"Answer a string that can be used as a selector with n arguments.
  	 TODO: need to be extended to support shrinking and for selectors like #+ " 
  
+ 	| numArgs offset |.
+ 	(numArgs := self numArgs) >= n ifTrue: [ ^self ].
+ 	numArgs = 0
+ 		ifTrue: [ offset := 1 ]
+ 		ifFalse: [ offset := 0 ].
+ 	^(String new: n - numArgs + offset * 5 + offset + self size streamContents: [ :stream |
+ 		stream nextPutAll: self.
+ 		numArgs = 0 ifTrue: [ stream nextPut: $:. ].
+ 		numArgs + offset + 1 to: n do: [ :i | stream nextPutAll: 'with:' ] ]) asSymbol!
- 	| selector numArgs aStream offs |
- 	
- 	selector := self.
- 	(numArgs := selector numArgs) >= n ifTrue: [^self].	
- 	aStream := WriteStream on: (String new: 16).
- 	aStream nextPutAll: self.
- 	
- 	(numArgs = 0) ifTrue: [aStream nextPutAll: ':'. offs := 0] ifFalse: [offs := 1].
- 	2 to: n - numArgs + offs do: [:i | aStream nextPutAll: 'with:'].	
- 	^aStream contents asSymbol
- 	
- !

Item was changed:
  WriteStream subclass: #TranscriptStream
  	instanceVariableNames: 'lastChar'
+ 	classVariableNames: 'AccessSema ForceUpdate RedirectToStdOut'
- 	classVariableNames: 'AccessSema'
  	poolDictionaries: ''
  	category: 'Collections-Streams'!
  
  !TranscriptStream commentStamp: 'fbs 12/30/2013 09:53' prior: 0!
  This class is a much simpler implementation of Transcript protocol that supports multiple views and very simple conversion to morphic.  Because it inherits from Stream, it is automatically compatible with code that is designed to write to streams.!

Item was added:
+ ----- Method: TranscriptStream class>>forceUpdate (in category 'preferences') -----
+ forceUpdate
+ 
+ 	<preference: 'Force transcript updates to screen'
+ 		categoryList: #(printing morphic debug)
+ 		description: 'When enabled, transcript updates will immediately shown in the screen no matter how busy the UI process is.'
+ 		type: #Boolean>
+ 	^ ForceUpdate ifNil: [true]!

Item was added:
+ ----- Method: TranscriptStream class>>forceUpdate: (in category 'preferences') -----
+ forceUpdate: aBoolean
+ 
+ 	ForceUpdate := aBoolean.!

Item was changed:
+ ----- Method: TranscriptStream class>>new (in category 'instance creation') -----
- ----- Method: TranscriptStream class>>new (in category 'as yet unclassified') -----
  new
  	^ self on: (String new: 1000)
  "
  INSTALLING:
  TextCollector allInstances do:
  	[:t | t breakDependents.
  	t become: TranscriptStream new].
  
  TESTING: (Execute this text in a workspace)
  Do this first...
  	tt := TranscriptStream new.
  	tt openLabel: 'Transcript test 1'.
  Then this will open a second view -- ooooh...
  	tt openLabel: 'Transcript test 2'.
  And finally make them do something...
  	tt clear.
  	[Sensor anyButtonPressed] whileFalse:
  		[1 to: 20 do: [:i | tt print: (2 raisedTo: i-1); cr; endEntry]].
  "!

Item was changed:
+ ----- Method: TranscriptStream class>>newTranscript: (in category 'instance creation') -----
- ----- Method: TranscriptStream class>>newTranscript: (in category 'as yet unclassified') -----
  newTranscript: aTextCollector 
  	"Store aTextCollector as the value of the system global Transcript."
  	Smalltalk at: #Transcript put: aTextCollector!

Item was added:
+ ----- Method: TranscriptStream class>>redirectToStdOut (in category 'preferences') -----
+ redirectToStdOut
+ 	<preference: 'Redirect transcript to stdout'
+ 		categoryList: #(printing morphic debug)
+ 		description: 'When enabled, no Morphic is needed when using the transcript interface to debug.'
+ 		type: #Boolean>
+ 	^ RedirectToStdOut ifNil: [false]!

Item was added:
+ ----- Method: TranscriptStream class>>redirectToStdOut: (in category 'preferences') -----
+ redirectToStdOut: aBoolean
+ 
+ 	RedirectToStdOut := aBoolean.!

Item was changed:
  ----- Method: TranscriptStream>>endEntry (in category 'stream extensions') -----
  endEntry
  	"Display all the characters since the last endEntry, and reset the stream"
  	self semaphore critical:[
+ 		self class forceUpdate
+ 			ifTrue: [self changed: #appendEntry]
+ 			ifFalse: [self changed: #appendEntryLater].
- 		self changed: #appendEntry.
  		self reset.
  	].!

Item was changed:
  ----- Method: TranscriptStream>>show: (in category 'stream extensions') -----
+ show: anObject
+ 	"TextCollector compatibility"
+ 	
+ 	[
+ 		self target nextPutAll: anObject asString.
+ 		self endEntry
+ 	] on: FileWriteError do: [self class redirectToStdOut: false].!
- show: anObject  "TextCollector compatibility"
- 	self nextPutAll: anObject asString; endEntry!

Item was changed:
  ----- Method: TranscriptStream>>showln: (in category 'stream extensions') -----
+ showln: anObject
+ 	"TextCollector compatibility. Ensure a new line before inserting a message."
+ 	
+ 	[
+ 		self target
+ 			cr;
+ 			nextPutAll: anObject asString.
+ 		self endEntry.
+ 	] on: FileWriteError do: [self class redirectToStdOut: false].!
- showln: anObject  "TextCollector compatibility"
- 	self nextPutAll: anObject asString; cr ;  endEntry!

Item was added:
+ ----- Method: TranscriptStream>>target (in category 'stream extensions') -----
+ target
+ 
+ 	^ self class redirectToStdOut
+ 		ifTrue: [FileStream stdout]
+ 		ifFalse: [self]!

Item was changed:
  ----- Method: WideString>>at: (in category 'accessing') -----
+ at: index
+ 	"Answer the Character stored in the field of the receiver indexed by the
+ 	 argument.  Primitive.  Fail if the index argument is not an Integer or is out
+ 	 of bounds.  Essential.  See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 63>
+ 	^index isInteger
+ 		ifTrue:
+ 			[self errorSubscriptBounds: index]
+ 		ifFalse:
+ 			[index isNumber
+ 				ifTrue: [self at: index asInteger]
+ 				ifFalse: [self errorNonIntegerIndex]]!
- at: index 
- 	"Answer the Character stored in the field of the receiver indexed by the argument."
- 	^ Character value: (self wordAt: index).
- !

Item was changed:
  ----- Method: WideString>>at:put: (in category 'accessing') -----
+ at: index put: aCharacter
+ 	"Store the Character into the field of the receiver indicated by the index.
+ 	 Primitive.  Fail if the index is not an Integer or is out of bounds, or if the
+ 	 argument is not a Character.  Essential.  See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 64>
+ 	^aCharacter isCharacter
+ 		ifTrue:
+ 			[index isInteger
+ 				ifTrue: [self errorSubscriptBounds: index]
+ 				ifFalse: [self errorNonIntegerIndex]]
+ 		ifFalse:
+ 			[self errorImproperStore]!
- at: index put: aCharacter 
- 	"Store the Character in the field of the receiver indicated by the index."
- 	aCharacter isCharacter ifFalse:[self errorImproperStore].
- 	self wordAt: index put: aCharacter asInteger.
- 	^aCharacter!

Item was changed:
+ (PackageInfo named: 'Collections') postscript: 'Character initializeClassificationTable.
+ String initialize'!
- (PackageInfo named: 'Collections') postscript: 'LRUCache allInstances do: [ :each | each reset ]'!



More information about the Packages mailing list