"

 COPYRIGHT (c) 1989-93 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.

"

Scanner subclass:#Parser

       instanceVariableNames:'classToCompileFor selfValue

                              contextToEvaluateIn

                              selector

                              methodArgs methodArgNames 

                              methodVars methodVarNames 

                              tree

                              currentBlock

                              modifiedInstVars modifiedClassVars

                              localVarDefPosition

                              evalExitBlock

       classVariableNames:'prevClass prevInstVarNames 

                           prevClassVarNames prevClassInstVarNames'

       poolDictionaries:''

       category:'System-Compiler'

!

Parser comment:'

COPYRIGHT (c) 1989-93 by Claus Gittinger

             All Rights Reserved

Parser is used for both evaluating and compiling smalltalk expressions;

it first builds a parseTree which is then interpreted (evaluate) or

compiled. Compilation is done in the subclass BCompiler.

Parser is also used to find the referenced/modified inst/classvars of

a method - this is done by sending parseXXX message to a parser and asking

the parser for referencedXVars or modifiedXVars (see SystemBrowser).

'!

!Parser class methodsFor:'evaluating expressions'!

evaluate:aString

    "return the result of evaluating aString"

    ^ self evaluate:aString notifying:nil

!

evaluate:aStringOrStream notifying:requestor

    "return the result of evaluating aString, 

     errors are reported to requestor"

    |parser tree mustBackup|

    aStringOrStream isNil ifTrue:[^ nil].

    aStringOrStream isStream ifTrue:[

        parser := self for:aStringOrStream.

        mustBackup := true

    ] ifFalse:[

        parser := self for:(ReadStream on:aStringOrStream).

        mustBackup := false

    ].

    parser notifying:requestor.

    parser nextToken.

    tree := parser parseMethodBodyOrNil.

    "if reading from a stream, backup for next expression"

    mustBackup ifTrue:[

        parser backupPosition

    ].

    (parser errorFlag or:[tree == #Error]) ifTrue:[

        ^ #Error

    ].

    tree notNil ifTrue:[

        parser evalExitBlock:[:value | ^ value].

        ^ tree evaluate

    ].

    ^ nil

!

evaluate:aString receiver:anObject notifying:requestor

    "return the result of evaluating aString, 

     errors are reported to requestor. Allow access to

     anObject as self and to its instVars (used in the inspector)"

    ^ self evaluate:aString

                 in:nil

           receiver:anObject

          notifying:requestor

             ifFail:nil

!

evaluate:aStringOrStream in:aContext receiver:anObject 

                                    notifying:requestor

                                       ifFail:failBlock

    |parser tree mustBackup|

    aStringOrStream isNil ifTrue:[^ nil].

    aStringOrStream isStream ifTrue:[

        parser := self for:aStringOrStream.

        mustBackup := true

    ] ifFalse:[

        parser := self for:(ReadStream on:aStringOrStream).

        mustBackup := false

    ].

    parser setSelf:anObject.

    parser setContext:aContext.

    parser notifying:requestor.

    parser nextToken.

    tree := parser parseMethodBodyOrNil.

    "if reading from a stream, backup for next expression"

    mustBackup ifTrue:[

        parser backupPosition

    ].

    (parser errorFlag or:[tree == #Error]) ifTrue:[

        failBlock notNil ifTrue:[

            ^ failBlock value

        ].

        ^ #Error

    ].

    tree notNil ifTrue:[

        parser evalExitBlock:[:value | ^ value].

        ^ tree evaluate

    ].

    ^ nil

! !

!Parser class methodsFor:'instance creation'!

for:aStream in:aClass

    |parser|

    parser := self for:aStream.

    parser setClassToCompileFor:aClass.

    ^ parser

! !

!Parser class methodsFor:'parsing'!

parseExpression:aString

    "parse aString as an expression; return the parseTree"

    ^ self withSelf:nil parseExpression:aString notifying:nil

!

withSelf:anObject parseExpression:aString notifying:someOne

    "parse aString as an expression with self set to anObject;

     return the parseTree"

    |parser tree|

    aString isNil ifTrue:[^ nil].

    parser := self for:(ReadStream on:aString).

    parser setSelf:anObject.

    parser notifying:someOne.

    parser nextToken.

    tree := parser expression.

    (parser errorFlag or:[tree == #Error]) ifTrue:[^ #Error].

    ^ tree

!

parseMethodSpecification:aString

    "parse a methods selector & arg specification; 

     return the parser or nil on error"

    ^ self parseMethodSpecification:aString in:nil

!

parseMethodSpecification:aString in:aClass

    "parse a methods selector & arg spec for a given class;

     return the parser or nil on error"

    |parser tree|

    aString isNil ifTrue:[^ nil].

    parser := self for:(ReadStream on:aString) in:aClass.

    parser nextToken.

    tree := parser parseMethodSpec.

    (parser errorFlag or:[tree == #Error]) ifTrue:[^ #Error].

    ^ parser

!

parseMethodArgAndVarSpecification:aString

    "parse a methods selector, arg and var spec;

     return the parser or nil on error"

    ^ self parseMethodArgAndVarSpecification:aString in:nil

!

parseMethodArgAndVarSpecification:aString in:aClass

    "parse a methods selector, arg and var spec for a given class;

     return the parser or nil on error"

    |parser|

    aString isNil ifTrue:[^ nil].

    parser := self for:(ReadStream on:aString) in:aClass.

    parser nextToken.

    (parser parseMethodSpec == #Error) ifTrue:[^ nil].

    (parser parseMethodBodyVarSpec == #Error) ifTrue:[^ nil].

    parser errorFlag ifTrue:[^ nil].

    ^ parser

!

parseMethod:aString

    "parse a method; return parseTree"

    ^ self parseMethod:aString in:nil

!

parseMethod:aString in:aClass

    "parse a method for a given class; return parser or nil on error"

    |parser tree|

    aString isNil ifTrue:[^ nil].

    parser := self for:(ReadStream on:aString) in:aClass.

    tree := parser parseMethod.

    (parser errorFlag or:[tree == #Error]) ifTrue:[^ nil].

    ^ parser

! !

!Parser methodsFor:'ST-80 compatibility'!

evaluate:aString in:aClass to:to notifying:aRequestor ifFail:failBlock

    |parseTree|

    aString isNil ifTrue:[^ nil].

    self initializeFor:(ReadStream on:aString).

    self setClassToCompileFor:aClass.

    selfValue := nil.

    requestor := aRequestor.

    self nextToken.

    parseTree := self parseMethodBody.

    (errorFlag or:[tree == #Error]) ifTrue:[^ #Error].

    parseTree notNil ifTrue:[

        self evalExitBlock:[:value | ^ failBlock value].

        ^ parseTree evaluate

    ].

    ^ nil

! !

!Parser class methodsFor:'changes'!

update:aClass

    "aClass has changed its definition - flush name caches if we have to"

    (aClass == prevClass) ifTrue:[

        prevClass := nil.

        prevInstVarNames := nil.

        prevClassVarNames := nil.

        prevClassInstVarNames := nil.

        aClass removeDependent:Parser

    ]

! !

!Parser methodsFor:'setup'!

setClassToCompileFor:aClass

    "set the class to be used for parsing/evaluating"

    classToCompileFor := aClass.

    (classToCompileFor ~~ prevClass) ifTrue:[

        prevClass notNil ifTrue:[

            Parser update:prevClass

        ]

    ]

!

setSelf:anObject

    "set the value to be used for self while evaluating"

    selfValue := anObject.

    classToCompileFor := anObject class.

    (classToCompileFor ~~ prevClass) ifTrue:[

        prevClass notNil ifTrue:[

            Parser update:prevClass

        ]

    ]

!

setContext:aContext

    "set the context used while evaluating"

    contextToEvaluateIn := aContext

! !

!Parser methodsFor:'accessing'!

tree

    "return the parsetree"

    ^tree

!

tree:aTree

    tree := aTree

!

selector

    "return the selector"

    ^ selector

!

primitiveNumber

    "return the primitiveNumber"

    ^ primNr

!

numberOfMethodArgs

    "return the number of methodargs"

    ^ methodArgs size

!

methodArgs

    "return an array with methodarg names"

    ^ methodArgNames

!

numberOfMethodVars

    "return the number of method variables"

    ^ methodVars size

!

methodVars

    "return a collection with method variablenames"

    ^ methodVarNames

!

usedInstVars

    "return a collection with instvariablenames refd by method"

    ^ usedInstVars

!

usedClassVars

    "return a collection with classvariablenames refd by method"

    ^ usedClassVars

!

modifiedInstVars

    "return a collection with instvariablenames modified by method"

    ^ modifiedInstVars

!

modifiedClassVars

    "return a collection with classvariablenames modified by method"

    ^ modifiedClassVars

!

errorFlag

    ^ errorFlag

!

evalExitBlock:aBlock

    "when evaluating a return expression, this block is evaluated"

    evalExitBlock := aBlock

! !

!Parser methodsFor:'error handling'!

showErrorMessage:aMessage position:pos

    Transcript show:(pos printString).

    Transcript show:' '.

    selector notNil ifTrue:[

        Transcript show:aMessage.

        Transcript showCr:(' in ' , selector)

    ] ifFalse:[

        Transcript showCr:aMessage

    ]

!

parseError:aMessage position:position to:endPos

    "report a syntax error"

    |m|

    errorFlag := true.

    m := ' Error:' , aMessage.

    self notifyError:m position:position to:endPos.

    exitBlock notNil ifTrue:[exitBlock value].

    ^ false

!

parseError:aMessage position:position

    "report a syntax error"

    ^ self parseError:aMessage position:position to:nil

!

parseError:aMessage

    "report a syntax error"

    ^ self parseError:aMessage position:tokenPosition to:nil

!

selectorCheck:aSelectorString position:pos to:pos2

    aSelectorString knownAsSymbol ifFalse:[

        self warning:(aSelectorString , ' is currently nowhere implemented') 

            position:pos to:pos2

    ]

!

correctableError:message position:pos1 to:pos2

    |correctIt|

    requestor isNil ifTrue:[

        self showErrorMessage:message position:pos1.

        correctIt := false

    ] ifFalse:[

        correctIt := requestor correctableError:message position:pos1 to:pos2

    ].

    correctIt ifFalse:[

        exitBlock notNil ifTrue:[exitBlock value]

    ].

    ^ correctIt

!

undefError:aName position:pos1 to:pos2

    ^ self correctableError:('Error: ' , aName , ' is undefined') 

                   position:pos1 to:pos2

!

exitWith:something

    "this is the longjump out of evaluation via a return expression"

    evalExitBlock value:something

! !

!Parser methodsFor:'parsing'!

parseMethod

    "parse a method"

    |parseTree|

    self nextToken.

    (self parseMethodSpec == #Error) ifTrue:[^ #Error].

    parseTree := self parseMethodBody.

    (parseTree == #Error) ifFalse:[

        self tree:parseTree

    ].

    ^ parseTree

!

parseMethodSpec

    "parse a methods selector & arg specification;

     set selector and methodArgs as a side effect"

    |var|

    (tokenType == #Keyword) ifTrue:[

        selector := ''.

        [tokenType == #Keyword] whileTrue:[

            selector := selector , tokenName.

            self nextToken.

            (tokenType ~~ #Identifier) ifTrue:[^ #Error].

            var := Variable name:tokenName.

            methodArgs isNil ifTrue:[

                methodArgs := Array with:var.

                methodArgNames := Array with:tokenName

            ] ifFalse:[

                methodArgs := methodArgs copyWith:var.

                methodArgNames := methodArgNames copyWith:tokenName

            ].

            self nextToken

        ].

        selector := selector asSymbol.

        ^ self

    ].

    (tokenType == #Identifier) ifTrue:[

        selector := tokenName asSymbol.

        self nextToken.

        ^ self

    ].

    (tokenType == #BinaryOperator) ifTrue:[

        selector := tokenName asSymbol.