"

 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 

			      token tokenType tokenPosition tokenValue

			      tokenName tokenLineNr tokenRadix

			      hereChar peekChar

			      requestor exitBlock

			      errorFlag 

			      ignoreErrors ignoreWarnings

			      saveComments currentComments

			      warnSTXSpecialComment warnUnderscoreInIdentifier

			      outStream outCol'

	  classVariableNames:'TypeArray ActionArray 

			      AllowUnderscoreInIdentifier

			      Warnings WarnSTXSpecials

			      WarnUnderscoreInIdentifier'

	    poolDictionaries:''

		    category:'System-Compiler'

!

Scanner comment:'

COPYRIGHT (c) 1989 by Claus Gittinger

	     All Rights Reserved

'!

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

"

!

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

	 Compiler warnings:false

    "

    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:

	Compiler warnSTXSpecials:false

     in your 'private.rc' file"

    WarnSTXSpecials := aBoolean

!

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

!

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

! !

!Scanner class methodsFor:'initialization'!

initialize

    Warnings := true.

    WarnSTXSpecials := true.

    WarnUnderscoreInIdentifier := 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 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

    ].

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

    #( $& $- $+ $= $* $/ $\ $< $> $~ $@ $, $? ) 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

    ].

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

    self initialize.

    aStringOrStream isStream ifFalse:[

	source := ReadStream on:aStringOrStream

    ] ifTrue:[

	source := aStringOrStream.

    ].

!

initialize

    "prepare a scan"

    errorFlag := false.

    tokenLineNr := 1.

    currentComments := nil.

    saveComments := false.

    ignoreErrors := false.

    ignoreWarnings := Warnings not.

    warnSTXSpecialComment := WarnSTXSpecials.

    warnUnderscoreInIdentifier := WarnUnderscoreInIdentifier.

    ActionArray isNil ifTrue:[

	self class setupActions

    ]

!

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

	source position:tokenPosition

    ]

!

beginComment

    ^ self

!

endComment:comment

    saveComments ifTrue:[

	currentComments isNil ifTrue:[

	    currentComments := OrderedCollection with:comment

	] ifFalse:[

	    currentComments add:comment

	]

    ].

! !

!Scanner methodsFor:'error handling'!

showErrorMessage:aMessage position:pos

    "show an errormessage on the Transcript"

    ignoreErrors ifFalse:[

	Smalltalk silentLoading == true ifFalse:[

	    Transcript showCr:(pos printString , ' ' , aMessage)

	]

    ]

!

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

    ].

    ^ 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

    ].

    ^ false

!

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

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

skipComment

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

	    ].

	    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 notNil and:[hereChar ~~ (Character doubleQuote)]] whileTrue:[

	    hereChar == (Character cr) ifTrue:[

		tokenLineNr := tokenLineNr + 1.

	    ].

	    saveComments ifTrue:[

	    ].

	    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.

!

nextToken

    "return the next token from the source-stream"

    |skipping actionBlock|

    peekChar notNil ifTrue:[

	hereChar := peekChar.

	peekChar := 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

		]

	    ]

	].