"

 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

		warnPossibleIncompatibilities warnDollarInIdentifier'

	classVariableNames:'TypeArray ActionArray AllowUnderscoreInIdentifier Warnings

		WarnSTXSpecials WarnOldStyleAssignment WarnUnderscoreInIdentifier

		WarnCommonMistakes WarnPossibleIncompatibilities

		WarnDollarInIdentifier AllowDollarInIdentifier'

	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

    Its main method is #nextToken, which reads and returns the next token

    Possibly placing additional information (such as tokenValue) into 

    instance variables as a side effect.

    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 is typically subclassed for parsing and #nextToken

        invoked via #self-sends.

        This should be changed and scanner ought to be an instance variable

        of Parser - this allows more flexible use of the scanner/parser

        framework (i.e. changing the scanner without affecting the parser).

    [author:]

        Claus Gittinger

    [see also:]

        Parser

"

! !

!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

    "initialize the classes defaults. Typically, these are changed

     later in the 'private.rc' file."

    Warnings := true.

    WarnSTXSpecials := true.

    WarnUnderscoreInIdentifier := true.

    WarnDollarInIdentifier := true.

    WarnOldStyleAssignment := true.

    WarnCommonMistakes := true.

    WarnPossibleIncompatibilities := false.

    AllowUnderscoreInIdentifier := false.

    AllowDollarInIdentifier := false.

    "

     self initialize

    "

    "Modified: 7.9.1997 / 01:37:57 / cg"

!

setupActions

    "initialize the scanners actionTables - these are used to dispatch

     into scanner methods as characters are read"

    |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

    "

    "Modified: 23.5.1997 / 12:07:55 / cg"

! !

!Scanner class methodsFor:'instance creation'!

for:aStringOrStream

    "create & return a new scanner reading from aStringOrStream"

    ^ (super new) initializeFor:aStringOrStream

    "Modified: 23.5.1997 / 12:08:42 / cg"

! !

!Scanner class methodsFor:'defaults'!

allowDollarInIdentifier

    "return true, if $-characters are allowed in identifiers.

     Notice, that dollars are NEVER allowed as the first character in an identifier."

    ^ AllowDollarInIdentifier

    "Created: 7.9.1997 / 01:32:18 / cg"

    "Modified: 7.9.1997 / 01:39:44 / cg"

!

allowDollarInIdentifier:aBoolean

    "this allows turning on/off $-characters in identifiers.

     Notice, that dollars are NEVER allowed as the first character in an identifier.

     If turned off (the default), dollars are not allowed in identifiers,

     but instead are scanned as character-constant prefix.

     If turned on, dollars are in identifiers are allowed, while extra

     dollars are still scanned as constant character prefix.

     If you have to fileIn old VW-Vsn2.x classes, turn this off

     before filing them in; i.e.:

        Compiler allowDollarInIdentifiers:false"

    AllowDollarInIdentifier := aBoolean.

    self setupActions

    "Created: 7.9.1997 / 01:34:49 / cg"

    "Modified: 7.9.1997 / 01:39:30 / cg"

!

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 old VW-Vsn2.x classes, 

     turn them off with:

        Compiler allowUnderscoreInIdentifiers:false"

    AllowUnderscoreInIdentifier := aBoolean.

    self setupActions

    "Modified: 7.9.1997 / 01:35:19 / cg"

!

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

!

warnDollarInIdentifier

    "return true, if $-characters in identifiers are to be warned about"

    ^ WarnDollarInIdentifier

    "Created: 7.9.1997 / 01:36:17 / cg"

!

warnDollarInIdentifier:aBoolean

    "this allows turning on/off warnings about $-characters in identifiers.

     You may find those warnings useful, to make certain that your code

     is portable to other smalltalk versions, which do not allow this

     (i.e. VW releases 2.x and maybe others).

     Notice, that dollars are NEVER allowed as the first character in an identifier.

     If you get bored by those warnings, turn them off by adding

     a line as:

        Compiler warnDollarInIdentifier:false

     in your 'private.rc' file"

    WarnDollarInIdentifier := aBoolean

    "Created: 7.9.1997 / 01:37:42 / cg"

    "Modified: 7.9.1997 / 01:40:02 / cg"

!

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

!

warnPossibleIncompatibilities

    "return true, if possible incompatibilities (with other ST systems)

     are to be warned about"

    ^ WarnPossibleIncompatibilities

    "Modified: 23.5.1997 / 12:02:02 / cg"

!

warnPossibleIncompatibilities:aBoolean

    "this turns warnings about possible incompatibilities (with other ST systems)

     on or off.

     If you get bored by those warnings, turn them off by adding

     a line as:

        Compiler warnPossibleIncompatibilities:false

     in your 'private.rc' file."

    WarnPossibleIncompatibilities := aBoolean

    "Created: 23.5.1997 / 12:02:45 / cg"

!

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.

     You may find those warnings useful, to make certain that your code

     is portable to other smalltalk versions, which do not allow this

     (i.e. VW releases 2.x).

     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

    "Modified: 7.9.1997 / 01:37:13 / cg"

!

warnings

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

    ^ Warnings

!

warnings:aBoolean

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

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

         Compiler warnings:false

    "

    Warnings := aBoolean

    "Modified: 23.5.1997 / 12:03:05 / cg"

! !

!Scanner methodsFor:'ST-80 compatibility'!

endOfLastToken

    "return the position of the token which was just read.

     This method was required by some PD program.

     It is not maintained and may be removed without notice."

    ^ source position

    "Modified: 23.5.1997 / 12:14:27 / cg"

!

scanTokens:aStringOrStream

    "return a collection of symbolic tokens from the passed input"

    |tokens|

    self initializeFor:aStringOrStream.

    tokens := OrderedCollection new.

    self nextToken.

    [token notNil] whileTrue:[

        tokens add:token.

        self nextToken

    ].

    ^ tokens

    "

     Scanner new

        scanTokens:'Boolean subclass:#True

                                instanceVariableNames:''''

                                classVariableNames:''''

                                poolDictionaries:''''

                                category:''Kernel-Objects''

        '

    "

    "Modified: 20.6.1997 / 18:22:58 / cg"

! !

!Scanner methodsFor:'accessing'!

comments

    "not yet implemented"

    ^ currentComments

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

    "Modified: 23.5.1997 / 12:14:45 / cg"

!

saveComments:aBoolean

    "not yet implemented"

    saveComments := aBoolean

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

    "Modified: 23.5.1997 / 12:14:49 / cg"

!

sourceStream

    ^ source

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

! !

!Scanner methodsFor:'directives'!

parseDirective

    "parse a directive - this is an ST/X special"

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