[Pkg] The Trunk: Kernel-nice.393.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Feb 12 23:23:36 UTC 2010


Nicolas Cellier uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-nice.393.mcz

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

Name: Kernel-nice.393
Author: nice
Time: 13 February 2010, 12:22:56.113 am
UUID: c2f2a753-02ef-7740-ae98-db5aee561a21
Ancestors: Kernel-dtl.392

Separate NumberParser as abstract class and SqNumberParser as Squeak syntax special case.

Provide a hook for allowing plus sign before number and plus sign in exponent.

Provide a FORTRANNumberParser example to demonstrate how simple it is to subclass.
My goal is to not let this class in Kernel, but to replace it with an ExtendedNumberParser to handle String asNumber. We will have to agree on expectations first.

More subclasses can be found in VW public store SYSEXT-NumberParser

=============== Diff against Kernel-dtl.392 ===============

Item was added:
+ ----- Method: NumberParser>>failBlock: (in category 'accessing') -----
+ failBlock: aBlockOrNil
+ 	failBlock := aBlockOrNil!

Item was added:
+ ----- Method: FORTRANNumberParser>>allowPlusSign (in category 'accessing') -----
+ allowPlusSign
+ 	^true!

Item was added:
+ ----- Method: NumberParser>>peekSignIsMinus (in category 'parsing-private') -----
+ peekSignIsMinus
+ 	"Peek an optional sign from sourceStream.
+ 	Answer true if it is minus sign"
+ 
+ 	| isMinus |
+ 	isMinus := sourceStream peekFor: $-.
+ 	isMinus ifFalse: [self allowPlusSign ifTrue: [sourceStream peekFor: $+]].
+ 	^isMinus!

Item was added:
+ ----- Method: NumberParser>>nextIntegerBase: (in category 'parsing-public') -----
+ nextIntegerBase: aRadix
+ 	"Form an integer with following digits.
+ 	Fail if no digit found"
+ 	
+ 	| isNeg value |
+ 	isNeg := sourceStream peekFor: $-.
+ 	value := self nextUnsignedIntegerBase: aRadix.
+ 	^isNeg
+ 		ifTrue: [value negated]
+ 		ifFalse: [value]!

Item was added:
+ ----- Method: NumberParser>>readExponent (in category 'parsing-private') -----
+ readExponent
+ 	"read the exponent if any (stored in instVar).
+ 	Answer true if found, answer false if none.
+ 	If exponent letter is not followed by a digit,
+ 	this is not considered as an error.
+ 	Exponent are always read in base 10."
+ 	
+ 	| eneg epos |
+ 	exponent := 0.
+ 	sourceStream atEnd ifTrue: [^ false].
+ 	(self exponentLetters includes: sourceStream peek)
+ 		ifFalse: [^ false].
+ 	sourceStream next.
+ 	eneg := sourceStream peekFor: $-.
+ 	epos := eneg not and: [self allowPlusSignInExponent and: [sourceStream peekFor: $+]].
+ 	exponent := self nextUnsignedIntegerOrNilBase: 10.
+ 	exponent isNil ifTrue: ["Oops, there was no digit after the exponent letter.Ungobble the letter"
+ 		exponent := 0.
+ 		sourceStream
+ 						skip: ((eneg or: [epos])
+ 								ifTrue: [-2]
+ 								ifFalse: [-1]).
+ 					^ false].
+ 	eneg ifTrue: [exponent := exponent negated].
+ 	^true!

Item was added:
+ ----- Method: NumberParser classSide>>on: (in category 'instance creation') -----
+ on: aStringOrStream
+ 	^self new on: aStringOrStream!

Item was added:
+ ----- Method: NumberParser>>nextUnsignedIntegerBase:ifFail: (in category 'parsing-public') -----
+ nextUnsignedIntegerBase: aRadix ifFail: errorBlock
+ 	"Form an unsigned integer with incoming digits from sourceStream.
+ 	Answer this integer, or execute errorBlock if no digit found.
+ 	Count the number of digits and the position of lastNonZero digit and store them in instVar"
+ 	
+ 	| value |
+ 	value := self nextUnsignedIntegerOrNilBase: aRadix.
+ 	value ifNil: [^errorBlock value].
+ 	^value!

Item was added:
+ ----- Method: NumberParser>>allowPlusSign (in category 'accessing') -----
+ allowPlusSign
+ 	"return a boolean indicating if plus sign is allowed or not"
+ 
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: NumberParser>>nextElementaryLargeIntegerBase: (in category 'parsing-large int') -----
+ nextElementaryLargeIntegerBase: aRadix
+ 	"Form an unsigned integer with incoming digits from sourceStream.
+ 	Return this integer, or zero if no digits found.
+ 	Stop reading if end of digits or if a LargeInteger is formed.
+ 	Count the number of digits and the position of lastNonZero digit and store them in instVar"
+ 
+ 	| value digit |
+ 	value := 0.
+ 	nDigits := 0.
+ 	lastNonZero := 0.
+ 	aRadix <= 10
+ 		ifTrue: ["Avoid using digitValue which is awfully slow"
+ 			[value isLarge or: [sourceStream atEnd
+ 				or: [digit := sourceStream next charCode - 48.
+ 					(0 > digit
+ 							or: [digit >= aRadix])
+ 						and: [sourceStream skip: -1.
+ 							true]]]]
+ 				whileFalse: [nDigits := nDigits + 1.
+ 					0 = digit
+ 						ifFalse: [lastNonZero := nDigits].
+ 					value := value * aRadix + digit]]
+ 		ifFalse: [
+ 			[value isLarge or: [sourceStream atEnd
+ 				or: [digit := sourceStream next digitValue.
+ 					(0 > digit
+ 							or: [digit >= aRadix])
+ 						and: [sourceStream skip: -1.
+ 							true]]]]
+ 				whileFalse: [nDigits := nDigits + 1.
+ 					0 = digit
+ 						ifFalse: [lastNonZero := nDigits].
+ 					value := value * aRadix + digit]].
+ 	^value!

Item was added:
+ ----- Method: NumberParser classSide>>parse:onError: (in category 'instance creation') -----
+ parse: aStringOrStream onError: failBlock 
+ 	^(self new)
+ 		on: aStringOrStream;
+ 		failBlock: failBlock;
+ 		nextNumber!

Item was added:
+ NumberParser subclass: #FORTRANNumberParser
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Kernel-Numbers'!

Item was added:
+ ----- Method: FORTRANNumberParser>>exponentLetters (in category 'accessing') -----
+ exponentLetters
+ 	"answer the list of possible exponents for Numbers.
+ 	Note: this parser will not honour precision attached to the exponent.
+ 	different exponent do not lead to different precisions.
+ 	only IEEE 754 double precision floating point numbers will be created"
+ 
+ 	^'ED'!

Item was added:
+ ----- Method: NumberParser>>makeFloatFromMantissa:exponent:base: (in category 'parsing-private') -----
+ makeFloatFromMantissa: m exponent: k base: aRadix 
+ 	"Convert infinite precision arithmetic into Floating point.
+ 	This alogrithm rely on correct IEEE rounding mode
+ 	being implemented in Integer>>asFloat and Fraction>>asFloat"
+ 
+ 	^(k positive
+ 		ifTrue: [m * (aRadix raisedToInteger: k)]
+ 		ifFalse: [Fraction numerator: m denominator: (aRadix raisedToInteger: k negated)]) asFloat!

Item was added:
+ ----- Method: FORTRANNumberParser>>nextNumber (in category 'parsing-public') -----
+ nextNumber
+ 	"main method for reading a number with FORTRAN syntax.
+ 	This one can read Real and Integer (not complex)"
+ 
+ 	| numberOfTrailingZeroInIntegerPart numberOfNonZeroFractionDigits mantissa value numberOfTrailingZeroInFractionPart noInt |
+ 	base := 10.
+ 	(self nextMatchAll: 'NaN') ifTrue: [^Float nan].
+ 	neg := self peekSignIsMinus.
+ 	(self nextMatchAll: 'Infinity') 
+ 		ifTrue: [^neg ifTrue: [Float infinity negated] ifFalse: [Float infinity]].
+ 	(noInt := sourceStream peekFor: $.) 
+ 		ifTrue: 
+ 			[integerPart := 0.
+ 			numberOfTrailingZeroInIntegerPart := 0]
+ 		ifFalse: 
+ 			[integerPart := self nextUnsignedIntegerBase: base.
+ 			numberOfTrailingZeroInIntegerPart := nDigits - lastNonZero].
+ 	(noInt or: [sourceStream peekFor: $.]) 
+ 		ifTrue: 
+ 			[fractionPart := self nextUnsignedIntegerBase: base ifFail: [nil].
+ 			fractionPart isNil 
+ 				ifTrue: 
+ 					[noInt 
+ 						ifTrue: 
+ 							["no interger part, no fraction part..."
+ 							self expected: 'a digit 0 to 9'.
+ 							^nil].
+ 					fractionPart := 0]
+ 				ifFalse: 
+ 					[numberOfNonZeroFractionDigits := lastNonZero.
+ 					numberOfTrailingZeroInFractionPart := nDigits - lastNonZero].
+ 			self readExponent]
+ 		ifFalse: 
+ 			[self readExponent ifFalse: [^neg ifTrue: [integerPart negated] ifFalse: [integerPart]].
+ 			fractionPart := 0].
+ 	fractionPart isZero 
+ 		ifTrue: 
+ 			[mantissa := integerPart // (base raisedTo: numberOfTrailingZeroInIntegerPart).
+ 			exponent := exponent + numberOfTrailingZeroInIntegerPart]
+ 		ifFalse: 
+ 			[mantissa := integerPart * (base raisedTo: numberOfNonZeroFractionDigits) 
+ 						+ (fractionPart // (base raisedTo: numberOfTrailingZeroInFractionPart)).
+ 			exponent := exponent - numberOfNonZeroFractionDigits].
+ 	value := self 
+ 				makeFloatFromMantissa: mantissa
+ 				exponent: exponent
+ 				base: base.
+ 	^neg ifTrue: [value isZero ifTrue: [Float negativeZero] ifFalse: [value negated]] ifFalse: [value]!

Item was added:
+ ----- Method: NumberParser>>expected: (in category 'error') -----
+ expected: errorString 
+ 	requestor isNil
+ 		ifFalse: [requestor
+ 				notify: errorString , ' ->'
+ 				at: sourceStream position
+ 				in: sourceStream].
+ 	self fail!

Item was added:
+ ----- Method: NumberParser>>nextUnsignedIntegerOrNilBase: (in category 'parsing-public') -----
+ nextUnsignedIntegerOrNilBase: aRadix
+ 	"Form an unsigned integer with incoming digits from sourceStream.
+ 	Answer this integer, or nil if no digit found.
+ 	Count the number of digits and the position of lastNonZero digit and store them in instVar"
+ 	
+ 	| nPackets high nDigitsHigh lastNonZeroHigh low |
+ 	"read no more digits than one elementary LargeInteger"
+ 	high :=  self nextElementaryLargeIntegerBase: aRadix.
+ 	nDigits = 0 ifTrue: [^nil].
+ 	
+ 	"Not enough digits to form a LargeInteger, stop iteration"
+ 	high isLarge ifFalse: [^high].
+ 
+ 	"We now have to engage arithmetic with LargeInteger
+ 	Decompose the integer in a high and low packets of growing size:"
+ 	nPackets := 1.
+ 	nDigitsHigh := nDigits.
+ 	lastNonZeroHigh := lastNonZero.
+ 	[
+ 	low := self nextLargeIntegerBase: aRadix nPackets: nPackets .
+ 	high := high * (aRadix raisedToInteger: nDigits) + low.
+ 	lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh].
+ 	nDigitsHigh := nDigitsHigh + nDigits.
+ 	low isLarge]
+ 		whileTrue: [nPackets := nPackets * 2].
+ 
+ 	nDigits := nDigitsHigh.
+ 	lastNonZero := lastNonZeroHigh.
+ 	^high!

Item was changed:
+ NumberParser subclass: #SqNumberParser
+ 	instanceVariableNames: ''
- Object subclass: #SqNumberParser
- 	instanceVariableNames: 'sourceStream base neg integerPart fractionPart exponent scale nDigits lastNonZero requestor failBlock'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Kernel-Numbers'!
  
  !SqNumberParser commentStamp: 'nice 7/26/2009 01:06' prior: 0!
  This is a class specialized in parsing and building numbers.
  Number syntax should follow Smalltalk syntax with 'NaN' and 'Infinity' extensions.
  
  If you have to read foreign number syntax, create a subclass.
  
  Instance variables:
  sourceStream <Stream> the stream of characters from which the number is read
  base <Integer> the radix in which to interpret digits
  neg <Boolean> true in case of minus sign
  integerPart <Integer> the integer part of the number
  fractionPart <Integer> the fraction part of the number if any
  exponent <Integer> the exponent used in scientific notation if any
  scale <Integer> the scale used in case of ScaledDecimal number if any
  nDigits <Integer> number of digits read to form an Integer
  lasNonZero <Integer> position of last non zero digit, starting at 1 from left, 0 if all digits are zero
  requestor <?> could eventually be used to insert an error message in a text editor
  failBlock <BlockClosure> Block to execute whenever an error occurs!

Item was added:
+ Object subclass: #NumberParser
+ 	instanceVariableNames: 'sourceStream base neg integerPart fractionPart exponent scale nDigits lastNonZero requestor failBlock'
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Kernel-Numbers'!
+ 
+ !NumberParser commentStamp: 'nice 7/26/2009 01:06' prior: 0!
+ This is a class specialized in parsing and building numbers.
+ Number syntax should follow Smalltalk syntax with 'NaN' and 'Infinity' extensions.
+ 
+ If you have to read foreign number syntax, create a subclass.
+ 
+ Instance variables:
+ sourceStream <Stream> the stream of characters from which the number is read
+ base <Integer> the radix in which to interpret digits
+ neg <Boolean> true in case of minus sign
+ integerPart <Integer> the integer part of the number
+ fractionPart <Integer> the fraction part of the number if any
+ exponent <Integer> the exponent used in scientific notation if any
+ scale <Integer> the scale used in case of ScaledDecimal number if any
+ nDigits <Integer> number of digits read to form an Integer
+ lasNonZero <Integer> position of last non zero digit, starting at 1 from left, 0 if all digits are zero
+ requestor <?> could eventually be used to insert an error message in a text editor
+ failBlock <BlockClosure> Block to execute whenever an error occurs!

Item was added:
+ ----- Method: NumberParser>>makeScaledDecimalWithNumberOfNonZeroFractionDigits:andNumberOfTrailingZeroInFractionPart: (in category 'parsing-private') -----
+ makeScaledDecimalWithNumberOfNonZeroFractionDigits: numberOfNonZeroFractionDigits andNumberOfTrailingZeroInFractionPart: numberOfTrailingZeroInFractionPart
+ 	"at this point integerPart fractionPart and scale have been read out (in inst var).
+ 	Form a ScaledDecimal.
+ 	Care of eliminating trailing zeroes from the fractionPart"
+ 	
+ 	| decimalMultiplier decimalFraction |
+ 	decimalMultiplier := base raisedToInteger: numberOfNonZeroFractionDigits.
+ 	decimalFraction := integerPart * decimalMultiplier + (fractionPart // (base raisedTo: numberOfTrailingZeroInFractionPart)) / decimalMultiplier.
+ 	^ ScaledDecimal
+ 		newFromNumber: (neg
+ 			ifTrue: [decimalFraction negated]
+ 			ifFalse: [decimalFraction])
+ 		scale: scale!

Item was added:
+ ----- Method: NumberParser classSide>>parse: (in category 'instance creation') -----
+ parse: aStringOrStream 
+ 	^(self new)
+ 		on: aStringOrStream;
+ 		nextNumber!

Item was added:
+ ----- Method: NumberParser>>requestor: (in category 'accessing') -----
+ requestor: anObjectOrNil
+ 	requestor := anObjectOrNil!

Item was added:
+ ----- Method: NumberParser>>nextLargeIntegerBase:nPackets: (in category 'parsing-large int') -----
+ nextLargeIntegerBase: aRadix nPackets: nPackets 
+ 	"Form a Large integer with incoming digits from sourceStream.
+ 	Return this integer, or zero if no digits found.
+ 	Stop reading when no more digits or when nPackets elementary LargeInteger have been encountered.
+ 	Count the number of digits and the lastNonZero digit and store them in instVar"
+ 	
+ 	| high nDigitsHigh low nDigitsLow halfPackets |
+ 	halfPackets := nPackets bitShift: -1.
+ 	halfPackets = 0 ifTrue: [^self nextElementaryLargeIntegerBase: aRadix].
+ 	high := self nextLargeIntegerBase: aRadix nPackets: halfPackets.
+ 	high isLarge ifFalse: [^high].
+ 	nDigitsHigh := nDigits.
+ 	low := self nextLargeIntegerBase: aRadix nPackets: halfPackets.
+ 	nDigitsLow := nDigits.
+ 	nDigits := nDigitsHigh + nDigitsLow.
+ 	lastNonZero = 0 ifFalse: [lastNonZero := lastNonZero + nDigitsHigh].
+ 	^high * (aRadix raisedToInteger: nDigitsLow) + low!

Item was added:
+ ----- Method: NumberParser>>on: (in category 'initialize-release') -----
+ on: aStringOrStream
+ 	sourceStream := aStringOrStream isString
+ 		ifTrue: [ReadStream on: aStringOrStream]
+ 		ifFalse: [aStringOrStream].
+ 	base := 10.
+ 	neg := false.
+ 	integerPart := fractionPart := exponent := scale := 0.
+ 	requestor := failBlock := nil.!

Item was added:
+ ----- Method: FORTRANNumberParser>>nextFloat (in category 'parsing-public') -----
+ nextFloat
+ 	^self nextNumber asFloat!

Item was added:
+ ----- Method: NumberParser>>nextIntegerBase:ifFail: (in category 'parsing-public') -----
+ nextIntegerBase: aRadix ifFail: aBlock
+ 	"Form an integer with following digits"
+ 	
+ 	| isNeg value |
+ 	isNeg := sourceStream peekFor: $-.
+ 	value := self nextUnsignedIntegerOrNilBase: aRadix.
+ 	value isNil ifTrue: [^aBlock value].
+ 	^isNeg
+ 		ifTrue: [value negated]
+ 		ifFalse: [value]!

Item was added:
+ ----- Method: NumberParser>>allowPlusSignInExponent (in category 'accessing') -----
+ allowPlusSignInExponent
+ 	"return a boolean indicating if plus sign is allowed or not in exponent"
+ 
+ 	^self allowPlusSign!

Item was added:
+ ----- Method: NumberParser>>exponentLetters (in category 'accessing') -----
+ exponentLetters
+ 	"answer the list of possible exponents for Numbers."
+ 
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: NumberParser>>nextNumber (in category 'parsing-public') -----
+ nextNumber
+ 	"read next number from sourceStream contents"
+ 
+ 	^self subclassResponsibility!

Item was added:
+ ----- Method: SqNumberParser>>allowPlusSign (in category 'accessing') -----
+ allowPlusSign
+ 	"return a boolean indicating if plus sign is allowed or not"
+ 
+ 	^false!

Item was added:
+ ----- Method: NumberParser>>fail (in category 'error') -----
+ fail
+ 	failBlock isNil ifFalse: [^failBlock value].
+ 	self error: 'Reading a number failed'!

Item was added:
+ ----- Method: NumberParser>>nextUnsignedIntegerBase: (in category 'parsing-public') -----
+ nextUnsignedIntegerBase: aRadix 
+ 	"Form an unsigned integer with incoming digits from sourceStream.
+ 	Fail if no digit found.
+ 	Count the number of digits and the lastNonZero digit and store int in instVar "
+ 	
+ 	| value |
+ 	value := self nextUnsignedIntegerOrNilBase: aRadix.
+ 	value ifNil: [^self expected: ('a digit between 0 and ' copyWith: (Character digitValue: aRadix - 1))].
+ 	^value!

Item was removed:
- ----- Method: SqNumberParser>>makeFloatFromMantissa:exponent:base: (in category 'parsing-private') -----
- makeFloatFromMantissa: m exponent: k base: aRadix 
- 	"Convert infinite precision arithmetic into Floating point.
- 	This alogrithm rely on correct IEEE rounding mode
- 	being implemented in Integer>>asFloat and Fraction>>asFloat"
- 
- 	^(k positive
- 		ifTrue: [m * (aRadix raisedToInteger: k)]
- 		ifFalse: [Fraction numerator: m denominator: (aRadix raisedToInteger: k negated)]) asFloat!

Item was removed:
- ----- Method: SqNumberParser>>expected: (in category 'error') -----
- expected: errorString 
- 	requestor isNil
- 		ifFalse: [requestor
- 				notify: errorString , ' ->'
- 				at: sourceStream position
- 				in: sourceStream].
- 	self fail!

Item was removed:
- ----- Method: SqNumberParser>>nextUnsignedIntegerOrNilBase: (in category 'parsing-public') -----
- nextUnsignedIntegerOrNilBase: aRadix
- 	"Form an unsigned integer with incoming digits from sourceStream.
- 	Answer this integer, or nil if no digit found.
- 	Count the number of digits and the position of lastNonZero digit and store them in instVar"
- 	
- 	| nPackets high nDigitsHigh lastNonZeroHigh low |
- 	"read no more digits than one elementary LargeInteger"
- 	high :=  self nextElementaryLargeIntegerBase: aRadix.
- 	nDigits = 0 ifTrue: [^nil].
- 	
- 	"Not enough digits to form a LargeInteger, stop iteration"
- 	high isLarge ifFalse: [^high].
- 
- 	"We now have to engage arithmetic with LargeInteger
- 	Decompose the integer in a high and low packets of growing size:"
- 	nPackets := 1.
- 	nDigitsHigh := nDigits.
- 	lastNonZeroHigh := lastNonZero.
- 	[
- 	low := self nextLargeIntegerBase: aRadix nPackets: nPackets .
- 	high := high * (aRadix raisedToInteger: nDigits) + low.
- 	lastNonZero = 0 ifFalse: [lastNonZeroHigh := lastNonZero + nDigitsHigh].
- 	nDigitsHigh := nDigitsHigh + nDigits.
- 	low isLarge]
- 		whileTrue: [nPackets := nPackets * 2].
- 
- 	nDigits := nDigitsHigh.
- 	lastNonZero := lastNonZeroHigh.
- 	^high!

Item was removed:
- ----- Method: SqNumberParser>>requestor: (in category 'accessing') -----
- requestor: anObjectOrNil
- 	requestor := anObjectOrNil!

Item was removed:
- ----- Method: SqNumberParser>>on: (in category 'initialize-release') -----
- on: aStringOrStream
- 	sourceStream := aStringOrStream isString
- 		ifTrue: [ReadStream on: aStringOrStream]
- 		ifFalse: [aStringOrStream].
- 	base := 10.
- 	neg := false.
- 	integerPart := fractionPart := exponent := scale := 0.
- 	requestor := failBlock := nil.!

Item was removed:
- ----- Method: SqNumberParser>>nextLargeIntegerBase:nPackets: (in category 'parsing-large int') -----
- nextLargeIntegerBase: aRadix nPackets: nPackets 
- 	"Form a Large integer with incoming digits from sourceStream.
- 	Return this integer, or zero if no digits found.
- 	Stop reading when no more digits or when nPackets elementary LargeInteger have been encountered.
- 	Count the number of digits and the lastNonZero digit and store them in instVar"
- 	
- 	| high nDigitsHigh low nDigitsLow halfPackets |
- 	halfPackets := nPackets bitShift: -1.
- 	halfPackets = 0 ifTrue: [^self nextElementaryLargeIntegerBase: aRadix].
- 	high := self nextLargeIntegerBase: aRadix nPackets: halfPackets.
- 	high isLarge ifFalse: [^high].
- 	nDigitsHigh := nDigits.
- 	low := self nextLargeIntegerBase: aRadix nPackets: halfPackets.
- 	nDigitsLow := nDigits.
- 	nDigits := nDigitsHigh + nDigitsLow.
- 	lastNonZero = 0 ifFalse: [lastNonZero := lastNonZero + nDigitsHigh].
- 	^high * (aRadix raisedToInteger: nDigitsLow) + low!

Item was removed:
- ----- Method: SqNumberParser>>nextIntegerBase:ifFail: (in category 'parsing-public') -----
- nextIntegerBase: aRadix ifFail: aBlock
- 	"Form an integer with following digits"
- 	
- 	| isNeg value |
- 	isNeg := sourceStream peekFor: $-.
- 	value := self nextUnsignedIntegerOrNilBase: aRadix.
- 	value isNil ifTrue: [^aBlock value].
- 	^isNeg
- 		ifTrue: [value negated]
- 		ifFalse: [value]!

Item was removed:
- ----- Method: SqNumberParser>>fail (in category 'error') -----
- fail
- 	failBlock isNil ifFalse: [^failBlock value].
- 	self error: 'Reading a number failed'!

Item was removed:
- ----- Method: SqNumberParser>>nextUnsignedIntegerBase: (in category 'parsing-public') -----
- nextUnsignedIntegerBase: aRadix 
- 	"Form an unsigned integer with incoming digits from sourceStream.
- 	Fail if no digit found.
- 	Count the number of digits and the lastNonZero digit and store int in instVar "
- 	
- 	| value |
- 	value := self nextUnsignedIntegerOrNilBase: aRadix.
- 	value ifNil: [^self expected: ('a digit between 0 and ' copyWith: (Character digitValue: aRadix - 1))].
- 	^value!

Item was removed:
- ----- Method: SqNumberParser>>failBlock: (in category 'accessing') -----
- failBlock: aBlockOrNil
- 	failBlock := aBlockOrNil!

Item was removed:
- ----- Method: SqNumberParser>>nextIntegerBase: (in category 'parsing-public') -----
- nextIntegerBase: aRadix
- 	"Form an integer with following digits.
- 	Fail if no digit found"
- 	
- 	| isNeg value |
- 	isNeg := sourceStream peekFor: $-.
- 	value := self nextUnsignedIntegerBase: aRadix.
- 	^isNeg
- 		ifTrue: [value negated]
- 		ifFalse: [value]!

Item was removed:
- ----- Method: SqNumberParser>>readExponent (in category 'parsing-private') -----
- readExponent
- 	"read the exponent if any (stored in instVar).
- 	Answer true if found, answer false if none.
- 	If exponent letter is not followed by a digit,
- 	this is not considered as an error.
- 	Exponent are always read in base 10."
- 	
- 	| eneg |
- 	exponent := 0.
- 	sourceStream atEnd ifTrue: [^ false].
- 	(self exponentLetters includes: sourceStream peek)
- 		ifFalse: [^ false].
- 	sourceStream next.
- 	eneg := sourceStream peekFor: $-.
- 	exponent := self nextUnsignedIntegerOrNilBase: 10.
- 	exponent ifNil: ["Oops, there was no digit after the exponent letter.Ungobble the letter"
- 		exponent := 0.
- 		sourceStream
- 						skip: (eneg
- 								ifTrue: [-2]
- 								ifFalse: [-1]).
- 					^ false].
- 	eneg
- 		ifTrue: [exponent := exponent negated].
- 	^ true!

Item was removed:
- ----- Method: SqNumberParser>>nextUnsignedIntegerBase:ifFail: (in category 'parsing-public') -----
- nextUnsignedIntegerBase: aRadix ifFail: errorBlock
- 	"Form an unsigned integer with incoming digits from sourceStream.
- 	Answer this integer, or execute errorBlock if no digit found.
- 	Count the number of digits and the position of lastNonZero digit and store them in instVar"
- 	
- 	| value |
- 	value := self nextUnsignedIntegerOrNilBase: aRadix.
- 	value ifNil: [^errorBlock value].
- 	^value!

Item was removed:
- ----- Method: SqNumberParser>>nextElementaryLargeIntegerBase: (in category 'parsing-large int') -----
- nextElementaryLargeIntegerBase: aRadix
- 	"Form an unsigned integer with incoming digits from sourceStream.
- 	Return this integer, or zero if no digits found.
- 	Stop reading if end of digits or if a LargeInteger is formed.
- 	Count the number of digits and the position of lastNonZero digit and store them in instVar"
- 
- 	| value digit |
- 	value := 0.
- 	nDigits := 0.
- 	lastNonZero := 0.
- 	aRadix <= 10
- 		ifTrue: ["Avoid using digitValue which is awfully slow"
- 			[value isLarge or: [sourceStream atEnd
- 				or: [digit := sourceStream next charCode - 48.
- 					(0 > digit
- 							or: [digit >= aRadix])
- 						and: [sourceStream skip: -1.
- 							true]]]]
- 				whileFalse: [nDigits := nDigits + 1.
- 					0 = digit
- 						ifFalse: [lastNonZero := nDigits].
- 					value := value * aRadix + digit]]
- 		ifFalse: [
- 			[value isLarge or: [sourceStream atEnd
- 				or: [digit := sourceStream next digitValue.
- 					(0 > digit
- 							or: [digit >= aRadix])
- 						and: [sourceStream skip: -1.
- 							true]]]]
- 				whileFalse: [nDigits := nDigits + 1.
- 					0 = digit
- 						ifFalse: [lastNonZero := nDigits].
- 					value := value * aRadix + digit]].
- 	^value!



More information about the Packages mailing list