Scanner.st
changeset 4637 1f1869c7b7ad
parent 4612 6e212516ccfc
child 4675 40b4f76e9d34
equal deleted inserted replaced
4636:dc08f5bcc04d 4637:1f1869c7b7ad
  3152 !
  3152 !
  3153 
  3153 
  3154 nextNumber
  3154 nextNumber
  3155     "scan a number; handles radix prefix, mantissa and exponent.
  3155     "scan a number; handles radix prefix, mantissa and exponent.
  3156      Allows for
  3156      Allows for
  3157 	e, d or q to be used as exponent limiter (for float or long float),
  3157         e, d or q to be used as exponent limiter (for float or long float),
  3158 	s for scaled fixpoint numbers,
  3158         s for scaled fixpoint numbers,
  3159 	f for single precision floats (controlled by parserFlags).
  3159         f for single precision floats (controlled by parserFlags).
  3160 
  3160 
  3161      i.e. 1e5 -> float (technically a double precision IEEE)
  3161      i.e. 1e5 -> float (technically a double precision IEEE)
  3162 	  1d5 -> float (also, a double precision IEEE)
  3162           1d5 -> float (also, a double precision IEEE)
  3163 	  1q5 -> long float (a c-long double / extended or quad precision IEEE, dep. on CPU)
  3163           1q5 -> long float (a c-long double / extended or quad precision IEEE, dep. on CPU)
  3164 	  1Q5 -> quad float (quad precision IEEE)
  3164           1Q5 -> quad float (quad precision IEEE)
  3165 	  1QD5 -> qDouble float (4*double precision)
  3165           1QD5 -> qDouble float (4*double precision)
  3166 	  1QL5 -> large float (arbitrary precision)
  3166           1QL5 -> large float (arbitrary precision)
  3167 	  1s  -> a fixed point with precision from number of digits given.
  3167           1s  -> a fixed point with precision from number of digits given.
  3168 	  1s5 -> a fixed point with 5 digits precision.
  3168           1s5 -> a fixed point with 5 digits precision.
  3169 	  1d  -> float (technically a double precision IEEE float).
  3169           1d  -> float (technically a double precision IEEE float).
  3170 	  1q  -> long float (technically a c-long double / extended or quad precision IEEE float, dep. on CPU).
  3170           1q  -> long float (technically a c-long double / extended or quad precision IEEE float, dep. on CPU).
  3171 	  1Q  -> quad float (quad precision IEEE)
  3171           1Q  -> quad float (quad precision IEEE)
  3172 
  3172 
  3173 	  1f5 -> shortFloat (technically a single precision IEEE float) or float, dep on parserFlags.
  3173           1f5 -> shortFloat (technically a single precision IEEE float) or float, dep on parserFlags.
  3174 	  1f  -> shortFloat (technically a single precision IEEE float) or float, dep on parserFlags.
  3174           1f  -> shortFloat (technically a single precision IEEE float) or float, dep on parserFlags.
  3175      support for scaled decimals can be disabled, if code needs to be read,
  3175      support for scaled decimals can be disabled, if code needs to be read,
  3176      which does not know about them (very unlikely).
  3176      which does not know about them (very unlikely).
  3177      support for single prec. floats with f/F is controlled by a parser flag"
  3177      support for single prec. floats with f/F is controlled by a parser flag"
  3178 
  3178 
  3179     |pos1 nextChar value integerPart sign
  3179     |pos1 nextChar value integerPart sign
  3184     sign := 1.
  3184     sign := 1.
  3185     type := #Integer.
  3185     type := #Integer.
  3186     pos1 := source position + 1.
  3186     pos1 := source position + 1.
  3187 
  3187 
  3188     parserFlags allowCIntegers ifTrue:[
  3188     parserFlags allowCIntegers ifTrue:[
  3189 	source peek == $0 ifTrue:[
  3189         source peek == $0 ifTrue:[
  3190 	    nextChar := source nextPeek.
  3190             nextChar := source nextPeek.
  3191 	    nextChar == $x ifTrue:[
  3191             nextChar == $x ifTrue:[
  3192 		source next.
  3192                 source next.
  3193 		((source peek ? $.) isDigitRadix:16) ifFalse:[
  3193                 ((source peek ? $.) isDigitRadix:16) ifFalse:[
  3194 		    self syntaxError:'invalid cStyle integer (hex digit expected)'
  3194                     self syntaxError:'invalid cStyle integer (hex digit expected)'
  3195 			 position:tokenPosition to:(source position).
  3195                          position:tokenPosition to:(source position).
  3196 		].
  3196                 ].
  3197 		value := Integer readFrom:source radix:16.
  3197                 value := Integer readFrom:source radix:16.
  3198 		sign < 0 ifTrue:[ value := value negated ].
  3198                 sign < 0 ifTrue:[ value := value negated ].
  3199 		tokenValue := token := value.
  3199                 tokenValue := token := value.
  3200 		tokenType := type.
  3200                 tokenType := type.
  3201 		^ tokenType
  3201                 ^ tokenType
  3202 	    ].
  3202             ].
  3203 	    nextChar == $o ifTrue:[
  3203             nextChar == $o ifTrue:[
  3204 		source next.
  3204                 source next.
  3205 		((source peek ? $.) isDigitRadix:8) ifFalse:[
  3205                 ((source peek ? $.) isDigitRadix:8) ifFalse:[
  3206 		    self syntaxError:'invalid cStyle integer (octal digit expected)'
  3206                     self syntaxError:'invalid cStyle integer (octal digit expected)'
  3207 			 position:tokenPosition to:(source position).
  3207                          position:tokenPosition to:(source position).
  3208 		].
  3208                 ].
  3209 		value := Integer readFrom:source radix:8.
  3209                 value := Integer readFrom:source radix:8.
  3210 		sign < 0 ifTrue:[ value := value negated ].
  3210                 sign < 0 ifTrue:[ value := value negated ].
  3211 		tokenValue := token := value.
  3211                 tokenValue := token := value.
  3212 		tokenType := type.
  3212                 tokenType := type.
  3213 		^ tokenType
  3213                 ^ tokenType
  3214 	    ].
  3214             ].
  3215 	    nextChar == $b ifTrue:[
  3215             nextChar == $b ifTrue:[
  3216 		source next.
  3216                 source next.
  3217 		((source peek ? $.) isDigitRadix:2) ifFalse:[
  3217                 ((source peek ? $.) isDigitRadix:2) ifFalse:[
  3218 		    self syntaxError:'invalid cStyle integer (binary digit expected)'
  3218                     self syntaxError:'invalid cStyle integer (binary digit expected)'
  3219 			 position:tokenPosition to:(source position).
  3219                          position:tokenPosition to:(source position).
  3220 		].
  3220                 ].
  3221 		value := Integer readFrom:source radix:2.
  3221                 value := Integer readFrom:source radix:2.
  3222 		sign < 0 ifTrue:[ value := value negated ].
  3222                 sign < 0 ifTrue:[ value := value negated ].
  3223 		tokenValue := token := value.
  3223                 tokenValue := token := value.
  3224 		tokenType := type.
  3224                 tokenType := type.
  3225 		^ tokenType
  3225                 ^ tokenType
  3226 	    ].
  3226             ].
  3227 	    (nextChar notNil
  3227             (nextChar notNil
  3228 	    and:[ nextChar isDigit or:[nextChar == $.]]) ifFalse:[
  3228             and:[ nextChar isDigit or:[nextChar == $.]]) ifFalse:[
  3229 		tokenValue := token := 0.
  3229                 tokenValue := token := 0.
  3230 		tokenType := type.
  3230                 tokenType := type.
  3231 		^ tokenType
  3231                 ^ tokenType
  3232 	    ].
  3232             ].
  3233 	    value := 0.
  3233             value := 0.
  3234 	].
  3234         ].
  3235     ].
  3235     ].
  3236     nextChar == $. ifFalse:[
  3236     nextChar == $. ifFalse:[
  3237 	value := Integer readFrom:source radix:tokenRadix.
  3237         value := Integer readFrom:source radix:tokenRadix.
  3238 	nextChar := source peekOrNil.
  3238         nextChar := source peekOrNil.
  3239 	(nextChar == $r) ifTrue:[
  3239         (nextChar == $r) ifTrue:[
  3240 	    tokenRadix := value.
  3240             tokenRadix := value.
  3241 	    source next.
  3241             source next.
  3242 	    (tokenRadix between:2 and:36) ifFalse:[
  3242             (tokenRadix between:2 and:36) ifFalse:[
  3243 		self syntaxError:'bad radix (must be 2 .. 36)'
  3243                 self syntaxError:'bad radix (must be 2 .. 36)'
  3244 			position:tokenPosition to:(source position).
  3244                         position:tokenPosition to:(source position).
  3245 	    ].
  3245             ].
  3246 	    source peekOrNil == $- ifTrue:[
  3246             source peekOrNil == $- ifTrue:[
  3247 		source next.
  3247                 source next.
  3248 		sign := -1
  3248                 sign := -1
  3249 	    ].
  3249             ].
  3250 	    pos1 := source position + 1.
  3250             pos1 := source position + 1.
  3251 	    value := Integer readFrom:source radix:tokenRadix.
  3251             value := Integer readFrom:source radix:tokenRadix.
  3252 	    nextChar := source peekOrNil.
  3252             nextChar := source peekOrNil.
  3253 	].
  3253         ].
  3254     ].
  3254     ].
  3255 
  3255 
  3256     (nextChar == $.) ifTrue:[
  3256     (nextChar == $.) ifTrue:[
  3257 	nextChar := source nextPeek.
  3257         nextChar := source nextPeek.
  3258 	(nextChar notNil and:[nextChar isDigitRadix:tokenRadix]) ifTrue:[
  3258         (nextChar notNil and:[nextChar isDigitRadix:tokenRadix]) ifTrue:[
  3259 	    (tokenRadix > 13) ifTrue:[
  3259             (tokenRadix > 13) ifTrue:[
  3260 		(nextChar == $d or:[nextChar == $D]) ifTrue:[
  3260                 (nextChar == $d or:[nextChar == $D]) ifTrue:[
  3261 		    self warning:'float with radix > 13 - (d/D are valid digits; not exponent-leaders)'
  3261                     self warning:'float with radix > 13 - (d/D are valid digits; not exponent-leaders)'
  3262 			 position:tokenPosition to:(source position).
  3262                          position:tokenPosition to:(source position).
  3263 		].
  3263                 ].
  3264 		(tokenRadix > 14) ifTrue:[
  3264                 (tokenRadix > 14) ifTrue:[
  3265 		    (nextChar == $e or:[nextChar == $E]) ifTrue:[
  3265                     (nextChar == $e or:[nextChar == $E]) ifTrue:[
  3266 			self warning:'float with radix > 14 - (e/E are valid digits; not exponent-leaders)'
  3266                         self warning:'float with radix > 14 - (e/E are valid digits; not exponent-leaders)'
  3267 			     position:tokenPosition to:(source position).
  3267                              position:tokenPosition to:(source position).
  3268 		    ].
  3268                     ].
  3269 		    (tokenRadix > 15) ifTrue:[
  3269                     (tokenRadix > 15) ifTrue:[
  3270 			(nextChar == $f or:[nextChar == $F]) ifTrue:[
  3270                         (nextChar == $f or:[nextChar == $F]) ifTrue:[
  3271 			    self warning:'float with radix > 15 - (f/F are valid digits; not exponent-leaders)'
  3271                             self warning:'float with radix > 15 - (f/F are valid digits; not exponent-leaders)'
  3272 				 position:tokenPosition to:(source position).
  3272                                  position:tokenPosition to:(source position).
  3273 			]
  3273                         ]
  3274 		    ]
  3274                     ]
  3275 		]
  3275                 ]
  3276 	    ].
  3276             ].
  3277 	    mantissaAndScaledPart := self nextMantissaAndScaledPartWithRadix:tokenRadix.
  3277             mantissaAndScaledPart := self nextMantissaAndScaledPartWithRadix:tokenRadix.
  3278 	    integerPart := value.
  3278             integerPart := value.
  3279 	    value := integerPart + (mantissaAndScaledPart first).  "could be a longFloat now"
  3279             value := integerPart + (mantissaAndScaledPart first).  "could be a longFloat now"
  3280 	    type := #Float.
  3280             type := #Float.
  3281 	    nextChar := source peekOrNil
  3281             nextChar := source peekOrNil
  3282 	] ifFalse:[
  3282         ] ifFalse:[
  3283 	    ('eEdDqQfF' includes:nextChar) ifTrue:[
  3283             ('eEdDqQfF' includes:nextChar) ifTrue:[
  3284 		"/ allow 5.e-3 - is this standard ?
  3284                 "/ allow 5.e-3 - is this standard ?
  3285 
  3285 
  3286 	    ] ifFalse:[
  3286             ] ifFalse:[
  3287 "/                nextChar == (Character cr) ifTrue:[
  3287 "/                nextChar == (Character cr) ifTrue:[
  3288 "/                    lineNr := lineNr + 1.
  3288 "/                    lineNr := lineNr + 1.
  3289 "/                ].
  3289 "/                ].
  3290 		nextChar := peekChar := $..
  3290                 nextChar := peekChar := $..
  3291 	    ]
  3291             ]
  3292 	]
  3292         ]
  3293     ].
  3293     ].
  3294 
  3294 
  3295     ('eEdDqQfF' includes:nextChar) ifTrue:[
  3295     ('eEdDqQfF' includes:nextChar) ifTrue:[
  3296 	kindClass := Float.
  3296         kindClass := Float.
  3297 	kindChar := nextChar.
  3297         kindChar := nextChar.
  3298 	nextChar := source nextPeek.
  3298         nextChar := source nextPeek.
  3299 	(kindChar == $q or:[kindChar == $Q]) ifTrue:[
  3299         (kindChar == $q or:[kindChar == $Q]) ifTrue:[
  3300 	    (kindChar == $Q) ifTrue:[
  3300             (kindChar == $Q) ifTrue:[
  3301 		nextChar == $D ifTrue:[
  3301                 nextChar == $D ifTrue:[
  3302 		    kindClass := QDouble.
  3302                     kindClass := QDouble.
  3303 		    value := value asQDouble.
  3303                     value := value asQDouble.
  3304 		    nextChar := source nextPeek.
  3304                     nextChar := source nextPeek.
  3305 		] ifFalse:[
  3305                 ] ifFalse:[
  3306 		    nextChar == $L ifTrue:[
  3306                     nextChar == $L ifTrue:[
  3307 			kindClass := LargeFloat.
  3307                         kindClass := LargeFloat.
  3308 			value := value asLargeFloat.
  3308                         value := value asLargeFloat.
  3309 			nextChar := source nextPeek.
  3309                         nextChar := source nextPeek.
  3310 		    ] ifFalse:[
  3310                     ] ifFalse:[
  3311 			kindClass := QuadFloat.
  3311                         kindClass := QuadFloat.
  3312 			value := value asQuadFloat
  3312                         value := value asQuadFloat
  3313 		    ].
  3313                     ].
  3314 		].
  3314                 ].
  3315 	    ] ifFalse:[
  3315             ] ifFalse:[
  3316 		kindClass := LongFloat.
  3316                 kindClass := LongFloat.
  3317 		value := value asLongFloat
  3317                 value := value asLongFloat
  3318 	    ].
  3318             ].
  3319 	] ifFalse:[
  3319         ] ifFalse:[
  3320 	    ((kindChar == $f or:[kindChar == $F]) and:[parserFlags singlePrecisionFloatF]) ifTrue:[
  3320             ((kindChar == $f or:[kindChar == $F]) and:[parserFlags singlePrecisionFloatF]) ifTrue:[
  3321 		kindClass := ShortFloat.
  3321                 kindClass := ShortFloat.
  3322 		value := value asShortFloat
  3322                 value := value asShortFloat
  3323 	    ] ifFalse:[
  3323             ] ifFalse:[
  3324 		value := value asFloat.
  3324                 value := value asFloat.
  3325 	    ].
  3325             ].
  3326 	].
  3326         ].
  3327 	type := #Float.
  3327         type := #Float.
  3328 	(nextChar notNil and:[(nextChar isDigit"Radix:tokenRadix") or:['+-' includes:nextChar]]) ifTrue:[
  3328         (nextChar notNil and:[(nextChar isDigit"Radix:tokenRadix") or:['+-' includes:nextChar]]) ifTrue:[
  3329 	    expSign := 1.
  3329             expSign := 1.
  3330 	    (nextChar == $+) ifTrue:[
  3330             (nextChar == $+) ifTrue:[
  3331 		nextChar := source nextPeek
  3331                 nextChar := source nextPeek
  3332 	    ] ifFalse:[
  3332             ] ifFalse:[
  3333 		(nextChar == $-) ifTrue:[
  3333                 (nextChar == $-) ifTrue:[
  3334 		    nextChar := source nextPeek.
  3334                     nextChar := source nextPeek.
  3335 		    expSign := -1
  3335                     expSign := -1
  3336 		]
  3336                 ]
  3337 	    ].
  3337             ].
  3338 	    exp := (Integer readFrom:source) * expSign.
  3338             exp := (Integer readFrom:source) * expSign.
  3339 	    value := value * ((value class unity * tokenRadix) raisedToInteger:exp).
  3339             value := value * ((value class unity * tokenRadix) raisedToInteger:exp).
  3340 
  3340 
  3341 	    nextChar := source peek.
  3341             nextChar := source peek.
  3342 
  3342 
  3343 	    "/ due to a strange overflow, we might get a Nan, although we
  3343             "/ due to a strange overflow, we might get a Nan, although we
  3344 	    "/ are actually still in the float range.
  3344             "/ are actually still in the float range.
  3345 	    "/ happens eg. for 1.7976931348623157e+308
  3345             "/ happens eg. for 1.7976931348623157e+308
  3346 
  3346 
  3347 	    "/ Also, the above raisedToInteger generates an additional error,
  3347             "/ Also, the above raisedToInteger generates an additional error,
  3348 	    "/ which is not present, if we use the strtox functions from the C-library.
  3348             "/ which is not present, if we use the strtox functions from the C-library.
  3349 	    "/ Therefore, always use the low level fastFromString: converter.
  3349             "/ Therefore, always use the low level fastFromString: converter.
  3350 
  3350 
  3351 	    "/ However: it only accepts decimal radix
  3351             "/ However: it only accepts decimal radix
  3352 	    tokenRadix = 10 ifTrue:[
  3352             tokenRadix = 10 ifTrue:[
  3353 		Error handle:[:ex |
  3353                 Error handle:[:ex |
  3354 		    "/ self halt.
  3354                     "/ self halt.
  3355 		] do:[
  3355                 ] do:[
  3356 		    chars := (source collection copyFrom:pos1 to:source position) string asSingleByteStringIfPossible.
  3356                     chars := (source collection copyFrom:pos1 to:source position) string asSingleByteStringIfPossible.
  3357 		    value := kindClass fastFromString:chars at:1.
  3357                     value := kindClass fastFromString:chars at:1.
  3358 		].
  3358                 ].
  3359 	    ].
  3359             ].
  3360 	].
  3360         ].
  3361     ] ifFalse:[
  3361     ] ifFalse:[
  3362 	value isLimitedPrecisionReal ifTrue:[
  3362         value isLimitedPrecisionReal ifTrue:[
  3363 	    "/ fastFromString only accepts decimal radix
  3363             "/ fastFromString only accepts decimal radix
  3364 	    tokenRadix = 10 ifTrue:[
  3364             tokenRadix = 10 ifTrue:[
  3365 		"/ no type specified - makes it a float
  3365                 "/ no type specified - makes it a float
  3366 		"/ value := value asFloat.
  3366                 "/ value := value asFloat.
  3367 		Error handle:[:ex |
  3367                 Error handle:[:ex |
  3368 		    value := value asFloat
  3368                     value := value asFloat
  3369 		] do:[
  3369                 ] do:[
  3370 		    chars := (source collection copyFrom:pos1 to:source position) asSingleByteStringIfPossible.
  3370                     chars := (source collection copyFrom:pos1 to:source position) asSingleByteStringIfPossible.
  3371 		    value := Float fastFromString:chars at:1.
  3371                     value := Float fastFromString:chars at:1.
  3372 		].
  3372                 ].
  3373 	    ].
  3373             ].
  3374 	].
  3374         ].
  3375 
  3375 
  3376 	parserFlags allowFixedPointLiterals == true ifTrue:[
  3376         parserFlags allowFixedPointLiterals ifTrue:[
  3377 	    "/ ScaledDecimal numbers
  3377             "/ ScaledDecimal numbers
  3378 	    ('s' includes:nextChar) ifTrue:[
  3378             ('s' includes:nextChar) ifTrue:[
  3379 		nextChar := source nextPeek.
  3379                 nextChar := source nextPeek.
  3380 
  3380 
  3381 		(nextChar notNil and:[(nextChar isDigit)]) ifTrue:[
  3381                 (nextChar notNil and:[(nextChar isDigit)]) ifTrue:[
  3382 		    scale := (Integer readFrom:source).
  3382                     scale := (Integer readFrom:source).
  3383 		].
  3383                 ].
  3384 
  3384 
  3385 		mantissaAndScaledPart isNil ifTrue:[
  3385                 mantissaAndScaledPart isNil ifTrue:[
  3386 		    value := value asFixedPoint:(scale ? 0)
  3386                     value := value asFixedPoint:(scale ? 0)
  3387 		] ifFalse:[
  3387                 ] ifFalse:[
  3388 		    d := 10 raisedTo:(mantissaAndScaledPart last).
  3388                     d := 10 raisedTo:(mantissaAndScaledPart last).
  3389 		    value := FixedPoint
  3389                     value := FixedPoint
  3390 			numerator:((integerPart * d) + mantissaAndScaledPart second)
  3390                         numerator:((integerPart * d) + mantissaAndScaledPart second)
  3391 			denominator:d
  3391                         denominator:d
  3392 			scale:(scale ? mantissaAndScaledPart last).
  3392                         scale:(scale ? mantissaAndScaledPart last).
  3393 		].
  3393                 ].
  3394 		type := #FixedPoint.
  3394                 type := #FixedPoint.
  3395 		self
  3395                 self
  3396 		    warnPossibleIncompatibility:'fixedPoint literal might be incompatibile with other systems'
  3396                     warnPossibleIncompatibility:'fixedPoint literal might be incompatibile with other systems'
  3397 		    position:pos1 to:source position + 1.
  3397                     position:pos1 to:source position + 1.
  3398 	    ].
  3398             ].
  3399 	].
  3399         ].
  3400     ].
  3400     ].
  3401 
  3401 
  3402     nextChar == $- ifTrue:[
  3402     nextChar == $- ifTrue:[
  3403 	self
  3403         self
  3404 	    warnPossibleIncompatibility:'add a space before ''-'' for compatibility with other systems'
  3404             warnPossibleIncompatibility:'add a space before ''-'' for compatibility with other systems'
  3405 	    position:(source position + 1) to:(source position + 1).
  3405             position:(source position + 1) to:(source position + 1).
  3406     ].
  3406     ].
  3407 
  3407 
  3408     tokenValue := token := (sign < 0) ifTrue:[value negated] ifFalse:[value].
  3408     tokenValue := token := (sign < 0) ifTrue:[value negated] ifFalse:[value].
  3409     tokenType := type.
  3409     tokenType := type.
  3410     (tokenValue isLimitedPrecisionReal) ~~ (tokenType == #Float) ifTrue:[
  3410     (tokenValue isLimitedPrecisionReal) ~~ (tokenType == #Float) ifTrue:[
  3411 	self shouldImplement.
  3411         self shouldImplement.
  3412     ].
  3412     ].
  3413 
  3413 
  3414 "/    self markConstantFrom:tokenPosition to:(source position - 1).
  3414 "/    self markConstantFrom:tokenPosition to:(source position - 1).
  3415     ^ tokenType
  3415     ^ tokenType
  3416 
  3416