"

 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

	classVariableNames:'TypeArray ActionArray AllowUnderscoreInIdentifier Warnings

		WarnSTXSpecials WarnOldStyleAssignment WarnUnderscoreInIdentifier

	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

"

! !

!Scanner class methodsFor:'initialization'!

binarySelectorCharacters

    "return a collection of characters which are allowed in

     binary selectors"

    ^ #( $& $- $+ $= $* $/ $\ $< $> $~ $@ $, $? $!! $|)

    "Created: 4.1.1997 / 14:13:24 / cg"

!

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

    self binarySelectorCharacters do:[:binop |

        TypeArray at:(binop asciiValue) put:#special.

        ActionArray at:(binop asciiValue) put:block

    ].

    "/ that one is a special case (both binarySelector AND syntax).

    TypeArray at:($| asciiValue) put:nil.

    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

    ^ (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

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

    "

    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'

             Package: packageId

            "

            directive = 'Package' ifTrue:[

                packageName := self parseDirectiveStringArg.

                packageName notNil ifTrue:[

                    (requestor respondsTo:#setPackage:) ifTrue:[

                        requestor setPackage:packageName

                    ].

                ] ifFalse:[

                    Transcript showCR:'unrecognized ''Package'' directive'.

                    ^ false

                ]

            ].

            "

             Namespace: 'nameSpaceIdentifier'

             Namespace: nameSpaceIdentifier

            "

            (directive = 'Namespace' 

            or:[directive = 'NameSpace']) ifTrue:[

                namespace := self parseDirectiveStringArg.

                namespace notNil ifTrue:[

                    (requestor respondsTo:#setNameSpace:) ifTrue:[

                        requestor setNameSpace:namespace 

                    ] ifFalse:[

                        self setNameSpace:namespace

                    ].

                ] ifFalse:[

                    Transcript showCR:'unrecognized ''NameSpace'' directive'.

                    ^ false

                ].

            ].

            "

             Uses: 'nameSpace1', ... , 'nameSpaceN'

             Uses: nameSpaceId1, ... , nameSpaceIdN

            "

            directive = 'Uses' ifTrue:[

                list := self parseDirectiveStringListArg.

                list notNil ifTrue:[

                    (requestor respondsTo:#addNameSpaces:) ifTrue:[

                        requestor addNameSpaces:list 

                    ]

                ] ifFalse:[

                    Transcript showCR:'unrecognized ''Uses'' directive'.

                    ^ false

                ]

            ].

            "

             Prerequisites: 'name-of-package', ... , 'name-of-package'

            "

            directive = 'Prerequisites' ifTrue:[

                list := self parseDirectiveStringListArg.

                list notNil ifTrue:[

                    (requestor respondsTo:#requirePackages:) ifTrue:[

                        requestor requirePackages:list 

                    ].

                ] ifFalse:[

                    Transcript showCR:'unrecognized ''Prerequisites'' directive'.

                    ^ false

                ]

            ].

        ]

    ].

    hereChar := source peek.

    ^ true.

!

parseDirectiveStringArg

    hereChar == $' ifTrue:[

        self nextString.

        tokenType == #String ifTrue:[

            ^ tokenValue

        ]

    ].

    (hereChar isLetter or:[hereChar == $_]) ifTrue:[

        self nextIdentifier.

        tokenType == #Identifier ifTrue:[

            ^ tokenName

        ]

    ].

    ^ nil

!

parseDirectiveStringListArg

    |list|

    list := OrderedCollection new.

    [hereChar == $'] whileTrue:[

    ].

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