"

 COPYRIGHT (c) 1989 by Claus Gittinger

 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 

!

Scanner comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

'!

!Scanner class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

 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.

"

!

version

"

"

!

documentation

"

    Scanner reads from a stream and returns individual smalltalk tokens

"

! !

!Scanner class methodsFor:'instance creation'!

for:aStringOrStream

    "return a new scanner reading from aStringOrStream"

    ^ (super new) initializeFor:aStringOrStream

! !

!Scanner class methodsFor:'defaults'!

warnings:aBoolean

    "this allows turning on/off warnings; the default is on.

     You can turn off warnings in your 'private.rc' file with

    "

    Warnings := aBoolean

!

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:

     in your 'private.rc' file"

    WarnSTXSpecials := aBoolean

! !

!Scanner class methodsFor:'initialization'!

setupActions

    |block|

    ActionArray := Array new:256.

    TypeArray := Array new:256.

    block := [:s :char | s nextNumber].

    ($0 asciiValue) to:($9 asciiValue) do:[:index |

    ].

    block := [:s :char | s nextIdentifier].

    ($a asciiValue) to:($z asciiValue) do:[:index |

    ].

    ($A asciiValue) to:($Z asciiValue) do:[:index |

    ].

    block := [:s :char | s nextSpecial].

    #( $& $- $+ $= $* $/ $\ $< $> $~ $@ $, $? ) do:[:binop |

    ].

    block := [:s :char | s nextToken:char].

    #( $; $. $( $) $[ $] $!! $^ $| $_ ) do:[:ch |

    ].

    "kludge: action is characterToken, 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 methodsFor:'private'!

initializeFor:aStringOrStream

    "initialize -

     if this is the first time, setup character- and action tables"

    errorFlag := false.

    tokenLineNr := 1.

    aStringOrStream isStream ifFalse:[

    ] ifTrue:[

    ].

    currentComments := nil.

    saveComments := false.

    ignoreErrors := false.

    ignoreWarnings := Warnings not.

    warnSTXSpecialComment := WarnSTXSpecials.

    ActionArray isNil ifTrue:[

    ]

!

initialize

    "prepare a scan"

    errorFlag := false.

    tokenLineNr := 1.

    currentComments := nil.

    saveComments := false.

    ignoreErrors := false.

    ignoreWarnings := Warnings not.

    warnSTXSpecialComment := WarnSTXSpecials

!

notifying:anObject

    "set the requestor to be notified"

    requestor := anObject

!

ignoreErrors

    "turn off notification of errors"

    ignoreErrors := true

!

ignoreWarnings

    "turn off notification of warnings"

    ignoreWarnings := true

!

backupPosition

    "if reading from a stream, at the end we might have read

     one token too many"

    (tokenType == #EOF) ifFalse:[

    ]

!

beginComment

    ^ self

!

endComment:comment

    saveComments ifTrue:[

    ].

! !

!Scanner methodsFor:'error handling'!

showErrorMessage:aMessage position:pos

    "show an errormessage on the Transcript"

    ignoreErrors ifFalse:[

    ]

!

notifyError:aMessage position:position to:endPos

    "notify requestor of an error - if there is no requestor

     put it on the transcript.

     Return the result passed back by the requestor."

    requestor isNil ifTrue:[

    ].

    ^ requestor error:aMessage position:position to:endPos

!

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."

    requestor isNil ifTrue:[

    ].

    ^ requestor warning:aMessage position:position to:endPos

!

syntaxError:aMessage position:position to:endPos

    "a syntax error happened"

    self notifyError:(' Error:' , aMessage) position:position to:endPos.

    exitBlock notNil ifTrue:[exitBlock value].

    ^ false

!

syntaxError:aMessage position:position

    "a syntax error happened - only start position is known"

    ^ self syntaxError:aMessage position:position to:nil

!

syntaxError:aMessage

    "a syntax error happened - position is not known"

    ^ self syntaxError:aMessage position:tokenPosition

!

warning:aMessage position:position to:endPos

    "a warning"

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

!

warning:aMessage position:position

    "a warning - only start position is known"

    ^ self warning:aMessage position:position to:nil

!

warning:aMessage

    "a warning - position is not known"

    ^ self warning:aMessage position:tokenPosition

! !

!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:[

    ].

    ^ 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:'reading next token'!

skipComment

    |comment startPos|

    comment := ''.

    self beginComment.

    outStream notNil ifTrue:[

    ].

    startPos := source position.

    source next.

    thisChar := 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)"

    thisChar == $/ ifTrue:[

    ] ifFalse:[

    ].

    saveComments ifTrue:[

    ].

    "skip final dQuote or cr"

    source next.

    self endComment:comment.

!

nextToken

    "return the next token from the source-stream"

    |skipping actionBlock|

    peekChar notNil ifTrue:[

    ] ifFalse:[

    ].

    tokenPosition := source position.

    actionBlock := ActionArray at:(thisChar asciiValue).

    actionBlock notNil ifTrue:[

    ].

    self syntaxError:('invalid character: ''' , thisChar asString , ''' ',

    tokenType := #Error.

    ^ #Error

!

nextToken:aCharacter

    tokenType := aCharacter.

    source next.

    ^ tokenType

!

nextColonOrAssign

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

    (source nextPeek == $=) ifTrue:[

    ] ifFalse:[

    ].

    ^ tokenType