"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

Object subclass:#Scanner
	instanceVariableNames:'source lineNr collectedSource token tokenType tokenPosition
		tokenValue tokenName tokenLineNr hereChar peekChar
		peekChar2 requestor exitBlock errorFlag ignoreErrors
		ignoreWarnings saveComments currentComments warnSTXSpecialComment
		warnUnderscoreInIdentifier warnOldStyleAssignment
		warnCommonMistakes outStream outCol warnSTXNameSpaceUse'
	classVariableNames:'TypeArray ActionArray AllowUnderscoreInIdentifier Warnings
		WarnSTXSpecials WarnOldStyleAssignment WarnUnderscoreInIdentifier
		WarnCommonMistakes'
	poolDictionaries:''
	category:'System-Compiler'
!

!Scanner class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    Scanner reads from a stream and returns individual smalltalk tokens

    TODO: some testers noticed, that ST-80's scanner methods are called
    xLetter, xDigit etc. For code using these (internals), the nextNumber,
    nextIdentifier etc. methods should be renamed.
    (to me, these seem to be internal private methods; their public use
     is not a good idea ..)
"
! !

!Scanner class methodsFor:'initialization'!

initialize
    Warnings := true.
    WarnSTXSpecials := true.
    WarnUnderscoreInIdentifier := true.
    WarnOldStyleAssignment := true.
    WarnCommonMistakes := true.
    AllowUnderscoreInIdentifier := false.
!

setupActions
    |block|

    ActionArray := Array new:256.
    TypeArray := Array new:256.

    block := [:s :char | s nextNumber].
    ($0 asciiValue) to:($9 asciiValue) do:[:index |
	ActionArray at:index put:block
    ].

    block := [:s :char | s nextSpecial].
    #( $& $- $+ $= $* $/ $\ $< $> $~ $@ $, $? "new:" $!! ) do:[:binop |
	TypeArray at:(binop asciiValue) put:#special.
	ActionArray at:(binop asciiValue) put:block
    ].

    block := [:s :char | s nextToken:char].
    #( $; $. $( $) $[ $] "$!!" $^ $| $_ ) do:[:ch |
	ActionArray at:(ch asciiValue) put:block
    ].

    block := [:s :char | s nextIdentifier].
    ($a asciiValue) to:($z asciiValue) do:[:index |
	ActionArray at:index put:block
    ].
    ($A asciiValue) to:($Z asciiValue) do:[:index |
	ActionArray at:index put:block
    ].
    AllowUnderscoreInIdentifier ifTrue:[
	ActionArray at:$_ asciiValue put:block
    ].

    "kludge: action is characterToken, but type is special"
    TypeArray at:($| asciiValue) put:#special.

    "kludge: action is nextColonOrAssign, but type is special"
    TypeArray at:($: asciiValue) put:#special.

    ActionArray at:($' asciiValue) put:[:s :char | s nextString].
    ActionArray at:($$ asciiValue) put:[:s :char | s nextCharacter].
    ActionArray at:($# asciiValue) put:[:s :char | s nextHash].
    ActionArray at:($% asciiValue) put:[:s :char | s nextPrimitive].
    ActionArray at:($: asciiValue) put:[:s :char | s nextColonOrAssign]

    "
     Scanner setupActions
    "
! !

!Scanner class methodsFor:'instance creation'!

for:aStringOrStream
    "return a new scanner reading from aStringOrStream"

    ^ (super new) initializeFor:aStringOrStream
! !

!Scanner class methodsFor:'defaults'!

allowUnderscoreInIdentifier
    "return true, if underscores are allowed in identifiers"

    ^ AllowUnderscoreInIdentifier
!

allowUnderscoreInIdentifier:aBoolean
    "this allows turning on/off underscores in identifiers.
     If turned off (the default), underscores are not allowed in identifiers,
     but instead scanned as assignment character (old ST/80 syntax).
     If turned on, underscores are in identifiers are allowed, while extra
     underscores are still scanned as assignment.
     If you have to fileIn VV-Vsn2 classes, 
     add a line such as:
	Compiler allowUnderscoreInIdentifiers:false
     in your 'private.rc'/'smalltalk.rc' file"

    AllowUnderscoreInIdentifier := aBoolean.
    self setupActions
!

warnCommonMistakes
    "return true, if common beginners mistakes are to be warned about"

    ^ WarnCommonMistakes
!

warnCommonMistakes:aBoolean
    "this allows turning on/off warnings about common beginners mistakes.
     Those are not really errors in the strict sense, but often lead to
     run time errors later.
     Examples are: expr or:expr2, where expr2 is not a block.
     If you get bored by those warnings, turn them off by adding
     a line as:
	Compiler warnCommonMistakes:false
     in your 'private.rc' file"

    WarnCommonMistakes := aBoolean
!

warnOldStyleAssignment
    "return true, if underscore-assignment (pre ST-80v4 syntax) are to be warned about"

    ^ WarnOldStyleAssignment
!

warnOldStyleAssignment:aBoolean
    "this allows turning on/off warnings about underscore-assignment (pre ST-80v4 syntax).
     If you get bored by those warnings, turn them off by adding
     a line as:
	Compiler warnOldStyleAssignment:false
     in your 'private.rc' file"

    WarnOldStyleAssignment := aBoolean
!

warnSTXSpecials
    "return true, if ST/X specials are to be warned about"

    ^ WarnSTXSpecials
!

warnSTXSpecials:aBoolean
    "this allows turning on/off warnings about stx specials.
     If you get bored by those warnings, turn them off by adding
     a line as:
	Compiler warnSTXSpecials:false
     in your 'private.rc' file"

    WarnSTXSpecials := aBoolean
!

warnUnderscoreInIdentifier
    "return true, if underscores in identifiers are to be warned about"

    ^ WarnUnderscoreInIdentifier
!

warnUnderscoreInIdentifier:aBoolean
    "this allows turning on/off warnings about underscores in identifiers.
     If you get bored by those warnings, turn them off by adding
     a line as:
	Compiler warnUnderscoreInIdentifier:false
     in your 'private.rc' file"

    WarnUnderscoreInIdentifier := aBoolean
!

warnings
    "return true, if any warnings are to be shown"

    ^ Warnings
!

warnings:aBoolean
    "this allows turning on/off warnings; the default is on.
     You can turn off warnings in your 'private.rc' file with
	 Compiler warnings:false
    "

    Warnings := aBoolean
! !

!Scanner methodsFor:'ST-80 compatibility'!

endOfLastToken
    ^ source position
! !

!Scanner methodsFor:'accessing'!

comments
    ^ currentComments

    "Created: 20.4.1996 / 20:07:01 / cg"
!

saveComments:aBoolean
    saveComments := aBoolean

    "Created: 20.4.1996 / 20:03:56 / cg"
!

sourceStream
    ^ source

    "Created: 20.4.1996 / 19:59:58 / cg"
! !

!Scanner methodsFor:'directives'!

parseDirective
    |directive packageName namespace list|

    source next.
    source skipSeparatorsExceptCR.
    hereChar := source peek.
    hereChar isLetter ifTrue:[
        directive := source nextWord.
        source peek == $: ifTrue:[
            source next.
            source skipSeparatorsExceptCR.
            hereChar := source peek.

            "
             Package: 'name-of-package'
            "
            directive = 'Package' ifTrue:[
                packageName := self parseDirectiveStringArg.
                packageName notNil ifTrue:[
                    (requestor respondsTo:#setPackage:) ifTrue:[
                        requestor setPackage:packageName
                    ].
                ].
            ].

            "
             Namespace: 'name-of-package'
            "
            (directive = 'Namespace' 
            or:[directive = 'NameSpace']) ifTrue:[
                namespace := self parseDirectiveStringArg.
                namespace notNil ifTrue:[
                    (requestor respondsTo:#setNameSpace:) ifTrue:[
                        requestor setNameSpace:namespace 
                    ] ifFalse:[
                        self setNameSpace:namespace
                    ].
                ].
            ].

            "
             Uses: 'nameSpace1', ... , 'nameSpace2'
            "
            directive = 'Uses' ifTrue:[
                list := self parseDirectiveStringListArg.
                (requestor respondsTo:#useNameSpaces:) ifTrue:[
                    requestor useNameSpaces:list 
                ]
            ].

            "
             Prerequisites: 'name-of-package', ... , 'name-of-package'
            "
            directive = 'Prerequisites' ifTrue:[
                list := self parseDirectiveStringListArg.
                (requestor respondsTo:#requirePackages:) ifTrue:[
                    requestor requirePackages:list 
                ].
            ].
        ]
    ].
    hereChar := source peek.

    "Modified: 8.11.1996 / 13:33:18 / cg"
!

parseDirectiveStringArg
    hereChar == $' ifTrue:[
	self nextString.
	tokenType == #String ifTrue:[
	    ^ tokenValue
	]
    ].
    ^ nil
!

parseDirectiveStringListArg
    |list|

    list := OrderedCollection new.

    [hereChar == $'] whileTrue:[
	list addLast:self parseDirectiveStringArg.
	source skipSeparatorsExceptCR.
	hereChar := source peek.
	(hereChar == $,) ifTrue:[
	    source next.
	    source skipSeparatorsExceptCR.
	    hereChar := source peek.
	].
    ].
    ^ list
! !

!Scanner methodsFor:'error handling'!

lastTokenLineNumber
    ^ tokenLineNr

    "Created: 8.11.1996 / 18:46:36 / cg"
!

notifyError:aMessage position:position to:endPos
    "notify requestor of an error - if there is no requestor
     put it on the transcript. Requestor is typically the CodeView
     in which the accept/doIt was triggered, or the PositionableStream
     which does the fileIn. The requestor may decide how to highlight the
     error (and/or to abort the compile).
     Return the result passed back by the requestor."

    ignoreErrors ifFalse:[
	requestor isNil ifTrue:[
	    self showErrorMessage:aMessage position:position.
	    ^ false
	].
	^ requestor error:aMessage position:position to:endPos from:self 
    ].
    ^ false
!

notifyWarning:aMessage position:position to:endPos
    "notify requestor of an warning - if there is no requestor
     put it on the transcript.
     Return the result passed back by the requestor."

    ignoreWarnings ifFalse:[
	requestor isNil ifTrue:[
	    self showErrorMessage:aMessage position:position.
	    ^ false
	].
	^ requestor warning:aMessage position:position to:endPos from:self
    ].
    ^ false
!

showErrorMessage:aMessage position:pos
    "show an errormessage on the Transcript"

    ignoreErrors ifFalse:[
	Smalltalk silentLoading == true ifFalse:[
	    Transcript showCR:(pos printString , ' [line: ' , tokenLineNr printString , '] ' , aMessage)
	]
    ]

    "Modified: 18.5.1996 / 15:44:35 / cg"
!

syntaxError:aMessage
    "a syntax error happened - position is not known"

    ^ self syntaxError:aMessage position:tokenPosition
!

syntaxError:aMessage position:position
    "a syntax error happened - only start position is known"

    ^ self syntaxError:aMessage position:position to:nil
!

syntaxError:aMessage position:position to:endPos
    "a syntax error happened"

    self notifyError:('Error:' , aMessage) position:position to:endPos.
    exitBlock notNil ifTrue:[exitBlock value].
    ^ false
!

warnCommonMistake:msg at:position
    self warnCommonMistake:msg position:position to:position

    "Modified: 18.7.1996 / 10:28:53 / cg"
!

warnCommonMistake:msg position:pos1 to:pos2
    ignoreWarnings ifFalse:[
        warnCommonMistakes ifTrue:[
            self 
                warning:msg
                position:pos1 to:pos2.
        ]
    ]

    "Created: 18.7.1996 / 10:28:38 / cg"
!

warnOldStyleAssignmentAt:position
    ignoreWarnings ifFalse:[
	warnOldStyleAssignment ifTrue:[
	    self 
		warning:'old style assignment - please change to use '':='''
		position:position to:position.
	    "
	     only warn once (per method)
	    "
	    warnOldStyleAssignment := false
	]
    ]
!

warnUnderscoreAt:position
    ignoreWarnings ifFalse:[
	warnUnderscoreInIdentifier ifTrue:[
	    self 
		warning:'underscores in identifiers/symbols are nonportable' 
		position:position to:position.
	    "
	     only warn once (per method)
	    "
	    warnUnderscoreInIdentifier := false
	]
    ]
!

warning:aMessage
    "a warning - position is not known"

    ^ self warning:aMessage position:tokenPosition
!

warning:aMessage position:position
    "a warning - only start position is known"

    ^ self warning:aMessage position:position to:nil
!

warning:aMessage position:position to:endPos
    "a warning"

    ^ self notifyWarning:('Warning: ' , aMessage) position:position to:endPos
! !

!Scanner methodsFor:'general scanning'!

scanPositionsFor:aTokenString inString:aSourceString
    "scan aSourceString for occurrances of aTokenString.
     Return a collection of start positions.
     Added for VW compatibility (to support syntax-highlight)."

    |searchType searchName searchValue positions t|

    "
     first, look what kind of token we have to search for
    "
    self initializeFor:(ReadStream on:aTokenString).
    self nextToken.
    searchType := tokenType.
    searchName := tokenName.
    searchValue := tokenValue.

    "
     start the real work ...
    "
    self initializeFor:(ReadStream on:aSourceString).
    positions := OrderedCollection new.

    [(t := self nextToken) ~~ #EOF] whileTrue:[
	searchType == t ifTrue:[
	    (searchName isNil or:[tokenName = searchName]) ifTrue:[
		(searchValue isNil or:[tokenValue = searchValue]) ifTrue:[
		    positions add:tokenPosition.
		]
	    ]
	]
    ].

    ^ positions

    "
     Scanner new scanPositionsFor:'hello' inString:'foo bar hello baz hello' 
     Scanner new scanPositionsFor:'3.14' inString:'foo 3.145 bar hello 3.14 baz hello 3.14' 
     Scanner new scanPositionsFor:'16' inString:'foo 16 bar hello 16r10 baz hello 2r10000' 
    "
! !

!Scanner methodsFor:'private'!

backupPosition
    "if reading from a stream, at the end we might have read
     one token too many"

    (tokenType == #EOF) ifFalse:[
	source position:tokenPosition
    ]
!

beginComment
    ^ self
!

collectedSource
    ^ collectedSource
!

endComment:comment
    saveComments ifTrue:[
	currentComments isNil ifTrue:[
	    currentComments := OrderedCollection with:comment
	] ifFalse:[
	    currentComments add:comment
	]
    ].
!

ignoreErrors
    "turn off notification of errors"

    ignoreErrors := true
!

ignoreWarnings
    "turn off notification of warnings"

    ignoreWarnings := true
!

initialize
    "prepare a scan"

    errorFlag := false.
    tokenPosition := 1.
    tokenLineNr := 1.
    currentComments := nil.
    saveComments := false.
    ignoreErrors := false.
    ignoreWarnings := Warnings not.
    warnSTXSpecialComment := WarnSTXSpecials.
    warnSTXNameSpaceUse := WarnSTXSpecials.
    warnUnderscoreInIdentifier := WarnUnderscoreInIdentifier.
    warnOldStyleAssignment := WarnOldStyleAssignment.
    warnCommonMistakes := WarnCommonMistakes.
    ActionArray isNil ifTrue:[
        self class setupActions
    ]

    "Modified: 14.10.1996 / 19:08:22 / cg"
!

initializeFor:aStringOrStream
    "initialize -
     if this is the first time, setup character- and action tables"

    self initialize.

    aStringOrStream isStream ifFalse:[
	source := ReadStream on:aStringOrStream
    ] ifTrue:[
	source := aStringOrStream.
    ].
!

notifying:anObject
    "set the requestor to be notified"

    requestor := anObject
!

setNameSpace:aNameSpace
    "/ ignored here

    "Created: 8.11.1996 / 13:33:10 / cg"
! !

!Scanner methodsFor:'reading next token'!

nextCharacter
    "a $ has been read - return a character token"

    |nextChar|

    source next.
    nextChar := source next.
    nextChar notNil ifTrue:[
	tokenValue := nextChar.
	tokenType := #Character
    ] ifFalse:[
	tokenType := #EOF
    ].
    ^ tokenType
!

nextColonOrAssign
    "colon has been read - look for = to make it an assign"

    "/ special kludge for identifier:= (without spaces inbetween)
    "/ here we needed two characters lookahead after the identifier ...

    peekChar == $= ifTrue:[
        source next.
        peekChar := nil.
        tokenType := #':='.
        ^ tokenType
    ].

    "/ special kludge for nameSpace:: (without spaces inbetween)
    "/ here we needed two characters lookahead after the identifier ...

    peekChar == $: ifTrue:[
        source next.
        peekChar := nil.
        tokenType := #'::'.
        ^ tokenType
    ].

    (source nextPeek == $=) ifTrue:[
        source next.
        tokenType := $_
    ] ifFalse:[
        tokenType := $:
    ].
    ^ tokenType

    "Modified: 14.10.1996 / 18:49:29 / cg"
!

nextHash
    |nextChar string|

    nextChar := source nextPeek.
    nextChar notNil ifTrue:[
	nextChar isLetterOrDigit ifTrue:[
	    string := ''.
	    [nextChar notNil and:[nextChar isLetterOrDigit]] whileTrue:[
		string := string , (source nextAlphaNumericWord "self nextId").
		nextChar := source peek.
		AllowUnderscoreInIdentifier == true ifTrue:[
		    nextChar == $_ ifTrue:[
			self warnUnderscoreAt:source position.
		    ].
		    [nextChar == $_] whileTrue:[
			string := string copyWith:nextChar.
			nextChar := source nextPeek.
			(nextChar isAlphaNumeric) ifTrue:[
			    string := string , source nextAlphaNumericWord.
			    nextChar := source peek.
			]
		    ].
		].
		(nextChar == $:) ifFalse:[
		    tokenValue := string asSymbol.
		    tokenType := #Symbol.
		    ^ tokenType
		].
		string := string copyWith:nextChar.
		nextChar := source nextPeek
	    ].
	    tokenValue := string asSymbol.
	    tokenType := #Symbol.
	    ^ tokenType
	].
	(nextChar == $( ) ifTrue:[
	    source next.
	    tokenType := #HashLeftParen.
	    ^ tokenType
	].
	(nextChar == $[ ) ifTrue:[
	    "it seems that ST-80 supports Constant ByteArrays as #[...]
	     (seen in a PD program)"
	    source next.
	    tokenType := #HashLeftBrack.
	    ^ tokenType
	].
	(nextChar == $' ) ifTrue:[
	    "it seems that ST-80 supports arbitrary symbols as #'...'
	     (seen in a PD program)"
	    self nextString.
	    tokenValue := tokenValue asSymbol.
	    tokenType := #Symbol.
	    ^ tokenType
	].
	((TypeArray at:(nextChar asciiValue)) == #special) ifTrue:[
	    string := source next asString.
	    nextChar := source peek.
	    nextChar notNil ifTrue:[
		((TypeArray at:(nextChar asciiValue)) == #special) ifTrue:[
		    source next.
		    string := string copyWith:nextChar
		]
	    ].
	    tokenValue := string asSymbol.
	    tokenType := #Symbol.
	    ^ tokenType
	]
    ].
    "this allows hash to be used as binop -
     I dont know, if this is correct ..."

    tokenName := '#'.
    tokenType := #BinaryOperator.
    ^ tokenType
"
    self syntaxError:'unexpected end-of-input in Symbol'
	    position:tokenPosition to:(tokenPosition + 1).
    ^ #Error
"
!

nextId
    |nextChar string oldString 
     index "{ Class: SmallInteger }"
     max   "{ Class: SmallInteger }" |

    nextChar := source peek.
    string := String basicNew:20.
    index := 0.
    max := 10.
    [true] whileTrue:[
	(nextChar notNil and:[nextChar isLetterOrDigit]) ifFalse:[
	    ^ string copyTo:index
	].
	(index == max) ifTrue:[
	    oldString := string.
	    string := String basicNew:(max * 2).
	    string replaceFrom:1 to:max with:oldString.
	    max := max * 2
	].
	index := index + 1.
	string at:index put:nextChar.
	nextChar := source nextPeek
    ]
!

nextIdentifier
    |nextChar string firstChar|

    hereChar == $_ ifTrue:[
        "/
        "/ no need to check for AllowUnderscoreInIdentifier here;
        "/ could not arrive here if it was off
        "/
        nextChar := source nextPeek.
        (nextChar isAlphaNumeric or:[nextChar == $_]) ifFalse:[
            "oops: a single underscore is an old-style assignement"
            self warnOldStyleAssignmentAt:tokenPosition.
            source next.
            tokenType := $_.
            ^ tokenType
        ].
        string := '_'.
        self warnUnderscoreAt:tokenPosition.
        [nextChar == $_] whileTrue:[
            string := string copyWith:$_.
            nextChar := source nextPeek.
        ].
        string := string , source nextAlphaNumericWord.
    ] ifFalse:[
        string := source nextAlphaNumericWord "self nextId".
    ].
    nextChar := source peek.

    AllowUnderscoreInIdentifier ifTrue:[
        nextChar == $_ ifTrue:[
            self warnUnderscoreAt:(source position).
        ].
        [nextChar == $_] whileTrue:[
            string := string copyWith:nextChar.
            nextChar := source nextPeek.
            (nextChar isAlphaNumeric) ifTrue:[
                string := string , source nextAlphaNumericWord.
                nextChar := source peek.
            ]
        ].
    ].

    (nextChar == $:) ifTrue:[
        source next.
        (source peek == $=) ifFalse:[
            (source peek == $:) ifFalse:[
                tokenName := string copyWith:nextChar.
                tokenType := #Keyword.
                ^ self
            ].
            peekChar := $:.
            peekChar2 := $:.
        ] ifTrue:[
            peekChar := $:.
            peekChar2 := $=.
        ]
    ].
    tokenName := string.
    firstChar := string at:1.
    (firstChar == $s) ifTrue:[
        (string = 'self') ifTrue:[tokenType := #Self. ^self].
        (string = 'super') ifTrue:[tokenType := #Super. ^self]
    ].
    (firstChar == $n) ifTrue:[
        (string = 'nil') ifTrue:[tokenType := #Nil. ^self]
    ].
    (firstChar == $t) ifTrue:[
        (string = 'true') ifTrue:[tokenType := #True. ^self].
        (string = 'thisContext') ifTrue:[tokenType := #ThisContext. ^self]
    ].
    (firstChar == $f) ifTrue:[
        (string = 'false') ifTrue:[tokenType := #False. ^self]
    ].
    tokenType := #Identifier.
    ^ tokenType

    "Created: 13.9.1995 / 12:56:42 / claus"
    "Modified: 14.10.1996 / 18:50:45 / cg"
!

nextMantissa:radix
    |nextChar value factor|

    value := 0.
    factor := 1.0 / radix.
    nextChar := source peek.
    [(nextChar notNil and:[nextChar isDigitRadix:radix])] whileTrue:[
	value := value + (nextChar digitValue * factor).
	factor := factor / radix.
	nextChar := source nextPeek
    ].
    ^ value
!

nextNumber
    |nextChar value s tokenRadix|

    tokenRadix := 10.
    value := Integer readFrom:source radix:tokenRadix.
    nextChar := source peek.
    (nextChar == $r) ifTrue:[
        tokenRadix := value.
        source next.
        s := 1.
        source peek == $- ifTrue:[
            source next.
            s := -1
        ].
        value := Integer readFrom:source radix:tokenRadix.
        value := value * s.
        nextChar := source peek
    ].
    (nextChar == $.) ifTrue:[
        nextChar := source nextPeek.
        (nextChar notNil and:[nextChar isDigitRadix:tokenRadix]) ifTrue:[
            value := value asFloat + (self nextMantissa:tokenRadix).
            nextChar := source peek
        ] ifFalse:[
            nextChar == (Character cr) ifTrue:[
                tokenLineNr := tokenLineNr + 1.
            ].
            peekChar := $.
        ]
    ].
    ((nextChar == $e) or:[nextChar == $E]) ifTrue:[
        nextChar := source nextPeek.
        (nextChar notNil and:[(nextChar isDigitRadix:tokenRadix) or:['+-' includes:nextChar]]) ifTrue:[
            s := 1.
            (nextChar == $+) ifTrue:[
                nextChar := source nextPeek
            ] ifFalse:[
                (nextChar == $-) ifTrue:[
                    nextChar := source nextPeek.
                    s := s negated
                ]
            ].
            value := value asFloat
                     * (10.0 raisedToInteger:((Integer readFrom:source radix:tokenRadix) * s))
        ]
    ].
    tokenValue := value.
    (value isMemberOf:Float) ifTrue:[
        (nextChar == $d) ifTrue:[
            source next
        ].
        tokenType := #Float
    ] ifFalse:[
        tokenType := #Integer
    ].
    ^ tokenType

    "Modified: 19.7.1996 / 12:23:38 / cg"
!

nextPrimitive
    |nextChar inPrimitive string 
     index "{ Class: SmallInteger }"
     len   "{ Class: SmallInteger }" |

    nextChar := source nextPeek.
    string := String new:500.
    len := 500.
    index := 1.
    (nextChar == ${) ifTrue:[
	nextChar := source nextPeek.
	inPrimitive := true.
	[inPrimitive] whileTrue:[
	    [nextChar == $%] whileFalse:[
		string at:index put:nextChar.
		(index == len) ifTrue:[
		    string := string , (String new:len).
		    len := len * 2
		].
		index := index + 1.
		nextChar := source next
	    ].
	    (source peek == $}) ifTrue:[
		inPrimitive := false
	    ] ifFalse:[
		string at:index put:nextChar.
		(index == len) ifTrue:[
		    string := string , (String new:len).
		    len := len * 2
		].
		index := index + 1.
		nextChar := source next
	    ]
	].
	source next.
	tokenValue := string copyTo:(index - 1).
	tokenType := #Primitive.
	tokenLineNr := tokenLineNr + (tokenValue occurrencesOf:(Character cr)).
	^ tokenType
    ].

    "a % alone is a binary operator"
    tokenName := '%'.
    tokenType := #BinaryOperator.
    ^ tokenType.
"
    self syntaxError:('invalid character: ''' , nextChar asString , '''')
	    position:tokenPosition to:(tokenPosition + 1).
    ^ #Error
"
!

nextSpecial
    "a special character has been read, look for another one.
     also -number is handled here"

    |firstChar secondChar thirdChar string p|

    firstChar := source next.
    secondChar := source peek.
    ((firstChar == $-) and:[secondChar notNil]) ifTrue:[
	secondChar isDigit ifTrue:[
	    self nextNumber.
	    tokenValue := tokenValue negated.
	    ^ tokenType
	]
    ].
    string := firstChar asString.
    secondChar notNil ifTrue:[
	((TypeArray at:(secondChar asciiValue)) == #special) ifTrue:[
	    (secondChar == $-) ifTrue:[
		"special- look if minus belongs to number following"
		p := source position.
		source next.
		thirdChar := source peek.
		source position:p.
		thirdChar isDigit ifTrue:[
		    tokenName := string.
		    tokenType := #BinaryOperator.
		    ^ tokenType
		]
	    ].
	    source next.
	    string := string copyWith:secondChar
	].
    ].
    tokenName := string.
    tokenType := #BinaryOperator.
    ^ tokenType

    "Modified: 12.4.1996 / 15:05:19 / cg"
!

nextString
    |nextChar string pos
     index "{ Class: SmallInteger }"
     len   "{ Class: SmallInteger }"
     inString|

    string := String basicNew:20.
    len := 20.
    index := 1.
    pos := source position.
    source next.
    nextChar := source next.
    inString := true.

    [inString] whileTrue:[
	nextChar isNil ifTrue:[
	    self syntaxError:'unexpected end-of-input in String'
		    position:pos to:(source position - 1).
	    tokenType := #EOF.
	    ^ tokenType
	].
	(nextChar == Character cr) ifTrue:[
	    tokenLineNr := tokenLineNr + 1
	].
	(nextChar == Character quote) ifTrue:[
	    (source peek == Character quote) ifTrue:[
		source next
	    ] ifFalse:[
		inString := false
	    ]
	].
	inString ifTrue:[
	    string at:index put:nextChar.
	    (index == len) ifTrue:[
		string := string , (String new:len).
		len := len * 2
	    ].
	    index := index + 1.
	    nextChar := source next
	]
    ].
    tokenValue := string copyTo:(index - 1).
    tokenType := #String.
    ^ tokenType
!

nextToken
    "return the next token from the source-stream"

    |skipping actionBlock|

    peekChar notNil ifTrue:[
	hereChar := peekChar.
	peekChar := peekChar2.
	peekChar2 := nil
    ] ifFalse:[
	skipping := true.
	[skipping] whileTrue:[
	    outStream notNil ifTrue:[
		[(hereChar := source peek) == Character space] whileTrue:[
		    source next.
		    outStream space. 
		    outCol := outCol + 1.
		]
	    ] ifFalse:[
		hereChar := source skipSeparatorsExceptCR.
	    ].
	    hereChar == (Character cr) ifTrue:[
		tokenLineNr := tokenLineNr + 1.
		source next.
		outStream notNil ifTrue:[
		    outStream cr.
		    outCol := 1
		]
	    ] ifFalse:[
		hereChar == (Character doubleQuote) ifTrue:[
		    "start of a comment"

		    self skipComment.
		    hereChar := source peek.
		] ifFalse:[
		    skipping := false
		]
	    ]
	].
	hereChar isNil ifTrue:[
	    tokenType := #EOF.
	    ^ tokenType
	]
    ].
    tokenPosition := source position.

    actionBlock := ActionArray at:(hereChar asciiValue).
    actionBlock notNil ifTrue:[
	^ actionBlock value:self value:hereChar
    ].

    self syntaxError:('invalid character: ''' , hereChar asString , ''' ',
		      '(' , hereChar asciiValue printString , ')')
	    position:tokenPosition to:tokenPosition.
    tokenType := #Error.
    ^ #Error

    "Modified: 13.9.1995 / 12:56:14 / claus"
!

nextToken:aCharacter
    tokenType := aCharacter.
    source next.
    ^ tokenType
!

skipComment
    |commentStream startPos|

    saveComments ifTrue:[
	commentStream := WriteStream on:''.
	self beginComment.
    ].

    outStream notNil ifTrue:[
	outStream nextPut:Character doubleQuote.
	outCol := outCol + 1
    ].

    startPos := source position.
    source next.
    hereChar := source peek.

    "
     special ST/X addition:
     a $/ right after the initial double quote makes it an up-to-end-of-line comment,
     which is very useful to comment out parts of filed-in source code.
     Since this is non-standard, use it in very rare cases only. 
     (maybe the upcoming ansi-standard adds something similar - in this case, I will
      change it without notice)"

    hereChar == $/ ifTrue:[
	[hereChar notNil and:[hereChar ~~ Character cr]] whileTrue:[
	    saveComments ifTrue:[
		commentStream nextPut:hereChar
	    ].
	    outStream notNil ifTrue:[
		outStream nextPut:hereChar.
		outCol := outCol + 1
	    ].
	    hereChar := source nextPeek.
	].
	tokenLineNr := tokenLineNr + 1.
	ignoreWarnings ifFalse:[
	    warnSTXSpecialComment ifTrue:[
		self warning:'end-of-line comments are a nonstandard feature of ST/X' 
		     position:startPos to:(source position).
		"
		 only warn once
		"
		warnSTXSpecialComment := false
	    ]
	].
	outStream notNil ifTrue:[
	    outStream cr.
	    outCol := 1
	].
    ] ifFalse:[
	hereChar == ${ ifTrue:[
	    "
	     special ST/X addition:
	     a ${ right after the initial double quote starts a directive
	    "
	    self parseDirective
	].

	[hereChar notNil and:[hereChar ~~ (Character doubleQuote)]] whileTrue:[
	    hereChar == (Character cr) ifTrue:[
		tokenLineNr := tokenLineNr + 1.
	    ].
	    saveComments ifTrue:[
		commentStream nextPut:hereChar
	    ].
	    outStream notNil ifTrue:[
		outStream nextPut:hereChar.
		outCol := outCol + 1
	    ].
	    hereChar := source nextPeek
	].
	hereChar isNil ifTrue:[
	    self warning:'unclosed comment' position:startPos to:(source position)
	] ifFalse:[
	    outStream notNil ifTrue:[
		outStream nextPut:(Character doubleQuote).
		outCol := outCol + 1
	    ].
	]
    ].

    "skip final dQuote or cr"
    source next.

    saveComments ifTrue:[
	self endComment:commentStream contents.
    ].
! !

!Scanner class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.55 1996-11-12 12:18:57 cg Exp $'
! !
Scanner initialize!