--- a/Parser.st Wed Oct 13 01:25:45 1993 +0100
+++ b/Parser.st Wed Oct 13 01:26:26 1993 +0100
@@ -18,11 +18,12 @@
methodVars methodVarNames
tree
currentBlock
- usedInstVars usedClassVars
+ usedInstVars usedClassVars usedVars
modifiedInstVars modifiedClassVars
localVarDefPosition
evalExitBlock
- selfNode superNode primNr logged'
+ selfNode superNode primNr logged
+ warnedUndefVars'
classVariableNames:'prevClass prevInstVarNames
prevClassVarNames prevClassInstVarNames'
poolDictionaries:''
@@ -42,7 +43,7 @@
a method - this is done by sending parseXXX message to a parser and asking
the parser for referencedXVars or modifiedXVars (see SystemBrowser).
-%W% %E%
+$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.2 1993-10-13 00:26:01 claus Exp $
'!
!Parser class methodsFor:'evaluating expressions'!
@@ -230,242 +231,6 @@
^ parser
! !
-!Parser class methodsFor:'explaining'!
-
-explain:someText in:source forClass:aClass
- "this is just a q&d implementation - there could be much more"
-
- |parser variables v c string sym list count tmp|
-
- string := someText withoutSeparators.
- parser := self parseMethod:source in:aClass.
- parser notNil ifTrue:[
- "look for variables"
-
- variables := parser methodVars.
- (variables notNil and:[variables includes:string]) ifTrue:[
- ^ string , ' is a method variable'
- ].
- variables := parser methodArgs.
- (variables notNil and:[variables includes:string]) ifTrue:[
- ^ string , ' is a method argument'
- ]
- ].
- parser isNil ifTrue:[
- parser := self for:(ReadStream on:source) in:aClass
- ].
-
- "instvars"
- variables := aClass allInstVarNames.
- (variables notNil and:[variables includes:string]) ifTrue:[
- "where is it"
- c := aClass.
- [c notNil] whileTrue:[
- v := c instVarNames.
- (v notNil and:[v includes:string]) ifTrue:[
- ^ string , ' is an instance variable in ' , c name
- ].
- c := c superclass
- ].
- self error:'oops'
- ].
- "class instvars"
- variables := aClass class allInstVarNames.
- (variables notNil and:[variables includes:string]) ifTrue:[
- "where is it"
- c := aClass.
- [c notNil] whileTrue:[
- v := c class instVarNames.
- (v notNil and:[v includes:string]) ifTrue:[
- ^ string , ' is a class instance variable in ' , c name
- ].
- c := c superclass
- ].
- self error:'oops'
- ].
- "classvars"
- c := parser inWhichClassIsClassVar:string.
- c notNil ifTrue:[
- ^ string , ' is a class variable in ' , c name
- ].
-
- string knownAsSymbol ifTrue:[
- "globals"
- sym := string asSymbol.
- (Smalltalk includesKey:sym) ifTrue:[
- (Smalltalk at:sym) isBehavior ifTrue:[
- ^ string , ' is a global variable.
-
-' , string , ' is a class in category ' , (Smalltalk at:sym) category , '.'
- ] ifFalse:[
- ^ string , ' is a global variable.
-
-Its current value is ' , (Smalltalk at:sym) classNameWithArticle , '.'
- ]
- ].
-
- list := OrderedCollection new.
- "selectors"
- Smalltalk allClassesDo:[:c|
- (c implements:sym) ifTrue:[
- list add:(c name)
- ].
- (c class implements:sym) ifTrue:[
- list add:(c name , 'class')
- ]
- ].
- count := list size.
- (count ~~ 0) ifTrue:[
- tmp := ' is a selector implemented in '.
- (count == 1) ifTrue:[
- ^ string , tmp , (list at:1) , '.'
- ].
- (count == 2) ifTrue:[
- ^ string , tmp , (list at:1) , ' and ' , (list at:2) , '.'
- ].
- (count == 3) ifTrue:[
- ^ string , tmp , '
-' , (list at:1) , ', ' , (list at:2) , ' and ' , (list at:3) , '.'
- ].
- (count == 4) ifTrue:[
- ^ string , tmp , '
-' , (list at:1) , ', ' , (list at:2) , ', ' , (list at:3), ' and ' , (list at:4) , '.'
- ].
- ^ string , tmp , count printString , ' classes.'
- ]
- ].
-
- "try for some obvious things"
- tmp := self explainPseudoVariable:string in:aClass.
- tmp notNil ifTrue:[ ^ tmp].
-
- "try syntax ..."
-
- ((string = ':=') or:[string = '_']) ifTrue:[
- ^ '<variable> := <expression>
-
-:= and _ (which is left-arrow in some fonts) mean assignment.
-The variable is bound to (i.e. points to) the value of <expression>.'
- ].
-
- (string = '^') ifTrue:[
- ^ '^ <expression>
-
-return the value of <expression> as value from the method.
-A return from within a block exits the method where the block is defined.'
- ].
-
- (string = '|') ifTrue:[
- ^ '| locals | or: [:arg | statements]
-
-| is used to mark a local variable declaration or separates arguments
-from the statements in a block. Notice, that in a block-argument declaration
-these must be prefixed by a colon character.
-| is also a selector understood by Booleans.'
- ].
-
- ((string startsWith:'(') or:[string endsWith:')']) ifTrue:[
- ^ '(<expression>)
-
-expression grouping.'
- ].
-
- ((string startsWith:'[') or:[string endsWith:']']) ifTrue:[
- ^ '[arguments | statements]
-
-defines a block.
-Blocks represent pieces of executable code. Definition of a block does
-not evaluate it. The block is evaluated by sending it a value/value:
-message.
-Blocks are often passed as arguments to Booleans (i.e. ifTrue:[...]) or
-collections (i.e. do:[...]).'
- ].
-
- string knownAsSymbol ifTrue:[
- ^ string , ' is known as a symbol.
-
-Symbols are unique strings, meaning that there exists
-exactly one instance of a given symbol. Therefore symbols can
-be compared using == (identity compare) instead of = (contents compare).'
- ].
-
- (string startsWith:'#' ) ifTrue:[
- (string startsWith:'#(' ) ifTrue:[
- ^ 'is a constant Array.
-
-The elements of a constant Array must be Number-constants, nil, true or false.
-(notice, that not all smalltalk implementations allow true, false and nil as
- constant-Array elements).'
- ].
-
- (string startsWith:'#[') ifTrue:[
- ^ 'is a constant ByteArray.
-
-The elements of a constant ByteArray must be Integer constants in the range
-0 .. 255.
-(notice, that not all smalltalk implementations support constant ByteArrays).'
- ].
-
- ^ 'is a symbol.
-
-Symbols are unique strings, meaning that there exists
-exactly one instance of a given symbol. Therefore symbols can
-be compared using == (identity compare) instead of = (contents compare).'
- ].
-
- parser isNil ifTrue:[
- ^ 'parse error -no explanation'
- ].
- ^ 'cannot explain this - select individual tokens for an explanation.'
-!
-
-explainPseudoVariable:string in:aClass
- "return explanation for the pseudoVariables self, super etc."
-
- (string = 'self') ifTrue:[
- ^ 'self refers to the object which received the message.
-
-In this case, it will be an instance of ' , aClass name , '
-or one of its subclasses.'
- ].
-
- (string = 'super') ifTrue:[
- ^ 'like self, super refers to the object which received the message.
-
-However, when sending a message to super the search for methods
-implementing this message will start in the superclass (' , aClass superclass name , ')
-instead of selfs class.'
- ].
-
- (string = 'true') ifTrue:[
- ^ 'true is a pseudo variable (i.e. it is built in).
-
-True represents logical truth. It is the one and only instance of class True.'
- ].
-
- (string = 'thisContext') ifTrue:[
- ^ 'thisContext is a pseudo variable (i.e. it is built in).
-
-ThisContext always refers to the context object for the currently executed Method or
-Block (an instance of Context or BlockContext respectively). The calling chain and calling
-selectors can be accessed via thisContext.'
- ].
-
- (string = 'false') ifTrue:[
- ^ 'false is a pseudo variable (i.e. it is built in).
-
-False represents logical falseness. It is the one and only instance of class False.'
- ].
-
- (string = 'nil') ifTrue:[
- ^ 'nil is a pseudo variable (i.e. it is built in).
-
-Nil is used for unitialized variables (among other uses).
-Nil is the one and only instance of class UndefinedObject.'
- ].
- ^ nil
-! !
-
!Parser methodsFor:'ST-80 compatibility'!
evaluate:aString in:aClass to:to notifying:aRequestor ifFail:failBlock
@@ -580,6 +345,12 @@
^ methodVarNames
!
+usedVars
+ "return a collection with variablenames refd by method"
+
+ ^ usedVars
+!
+
usedInstVars
"return a collection with instvariablenames refd by method"
@@ -659,7 +430,8 @@
!
correctableError:message position:pos1 to:pos2
- "report an error which can be corrected by compiler"
+ "report an error which can be corrected by compiler -
+ return true if correction is wanted"
|correctIt|
@@ -676,7 +448,23 @@
!
undefError:aName position:pos1 to:pos2
- "report an undefined variable error"
+ "report an undefined variable error - return true, if it should be
+ corrected"
+
+ requestor isNil ifTrue:[
+ warnedUndefVars notNil ifTrue:[
+ (warnedUndefVars includes:aName) ifTrue:[
+ "already warned about this one"
+ ^ false
+ ].
+ ].
+ self showErrorMessage:('Error: ' , aName , ' is undefined') position:pos1.
+ warnedUndefVars isNil ifTrue:[
+ warnedUndefVars := Set new.
+ ].
+ warnedUndefVars add:aName.
+ ^ false
+ ].
^ self correctableError:('Error: ' , aName , ' is undefined')
position:pos1 to:pos2
@@ -962,28 +750,28 @@
|receiver arg sel args pos pos2|
+ pos := tokenPosition.
receiver := self keywordExpression.
(receiver == #Error) ifTrue:[^ #Error].
[tokenType == $;] whileTrue:[
+ receiver isMessage ifFalse:[
+ self syntaxError:'left side of cascade must be a message expression'
+ position:pos to:tokenPosition
+ ].
self nextToken.
(tokenType == #Identifier) ifTrue:[
sel := tokenName.
- self selectorCheck:sel position:tokenPosition
- to:(tokenPosition + sel size - 1).
- receiver := CascadeNode receiver:receiver
- selector:sel.
+ self selectorCheck:sel position:tokenPosition to:(tokenPosition + sel size - 1).
+ receiver := CascadeNode receiver:receiver selector:sel.
self nextToken
] ifFalse:[
(tokenType == #BinaryOperator) ifTrue:[
sel := tokenName.
- self selectorCheck:sel position:tokenPosition
- to:(tokenPosition + sel size - 1).
+ self selectorCheck:sel position:tokenPosition to:(tokenPosition + sel size - 1).
self nextToken.
arg := self unaryExpression.
(arg == #Error) ifTrue:[^ #Error].
- receiver := CascadeNode receiver:receiver
- selector:sel
- arg:arg
+ receiver := CascadeNode receiver:receiver selector:sel arg:arg
] ifFalse:[
(tokenType == #Keyword) ifTrue:[
pos := tokenPosition.
@@ -1001,14 +789,11 @@
pos2 := tokenPosition
].
self selectorCheck:sel position:pos to:pos2.
- receiver := CascadeNode receiver:receiver
- selector:sel
- args:args
+ receiver := CascadeNode receiver:receiver selector:sel args:args
] ifFalse:[
(tokenType == #Error) ifTrue:[^ #Error].
- self syntaxError:('invalid cascade; '
- , tokenType printString
- , ' unexpected').
+ self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
+ position:tokenPosition to:source position - 1.
^ #Error
]
]
@@ -1020,7 +805,7 @@
keywordExpression
"parse a keyword-expression; return a node-tree, nil or #Error"
- |receiver sel arg args pos1 pos2 try lno|
+ |receiver sel arg args pos1 pos2 try lno note|
receiver := self binaryExpression.
(receiver == #Error) ifTrue:[^ #Error].
@@ -1049,6 +834,10 @@
] ifFalse:[
receiver := try
].
+ note := receiver plausibilityCheck.
+ note notNil ifTrue:[
+ self warning:note position:pos1 to:pos2
+ ].
receiver lineNumber:lno
].
^ receiver
@@ -1193,6 +982,17 @@
].
^ val
].
+ (tokenType == #Self) ifTrue:[
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'assignment to self' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ selfNode isNil ifTrue:[
+ selfNode := PrimaryNode type:#Self value:selfValue
+ ].
+ ^ selfNode
+ ].
(tokenType == #String) ifTrue:[
val := ConstantNode type:tokenType value:tokenValue.
self nextToken.
@@ -1235,17 +1035,6 @@
].
^ ConstantNode type:#False value:false
].
- (tokenType == #Self) ifTrue:[
- self nextToken.
- (tokenType == $_) ifTrue:[
- self parseError:'assignment to self' position:pos to:tokenPosition.
- ^ #Error
- ].
- selfNode isNil ifTrue:[
- selfNode := PrimaryNode type:#Self value:selfValue
- ].
- ^ selfNode
- ].
(tokenType == #Super) ifTrue:[
self nextToken.
(tokenType == $_) ifTrue:[
@@ -1412,6 +1201,12 @@
(usedInstVars includes:varName) ifFalse:[
usedInstVars add:varName
].
+ usedVars isNil ifTrue:[
+ usedVars := OrderedCollection new
+ ].
+ (usedVars includes:varName) ifFalse:[
+ usedVars add:varName
+ ].
^ PrimaryNode type:#InstanceVariable
name:varName
index:instIndex
@@ -1431,6 +1226,12 @@
instIndex notNil ifTrue:[
aClass := self inWhichClassIsClassInstVar:varName.
aClass notNil ifTrue:[
+ usedVars isNil ifTrue:[
+ usedVars := OrderedCollection new
+ ].
+ (usedVars includes:varName) ifFalse:[
+ usedVars add:varName
+ ].
^ PrimaryNode type:#ClassInstanceVariable
name:varName
index:instIndex
@@ -1466,6 +1267,12 @@
(usedClassVars includes:varName) ifFalse:[
usedClassVars add:varName
].
+ usedVars isNil ifTrue:[
+ usedVars := OrderedCollection new
+ ].
+ (usedVars includes:varName) ifFalse:[
+ usedVars add:varName
+ ].
^ PrimaryNode type:#ClassVariable
name:(aClass name , ':' , varName) asSymbol
]
@@ -1475,6 +1282,12 @@
"is it a global-variable ?"
tokenSymbol := varName asSymbol.
(Smalltalk includesKey:tokenSymbol) ifTrue:[
+ usedVars isNil ifTrue:[
+ usedVars := OrderedCollection new
+ ].
+ (usedVars includes:varName) ifFalse:[
+ usedVars add:varName
+ ].
^ PrimaryNode type:#GlobalVariable
name:tokenSymbol
].
@@ -1556,9 +1369,7 @@
(tokenType ~~ $| ) ifTrue:[
"ST-80 allows [:arg ]"
(tokenType == $] ) ifTrue:[
- node := BlockNode arguments:args.
- node home:currentBlock.
- ^ node
+ ^ BlockNode arguments:args home:currentBlock variables:nil.
].
self syntaxError:'| expected after block-arg declaration'.
^ #Error
@@ -1583,9 +1394,7 @@
].
self nextToken
].
- node := BlockNode arguments:args.
- node home:currentBlock.
- node variables:vars.
+ node := BlockNode arguments:args home:currentBlock variables:vars.
currentBlock := node.
stats := self blockStatementList.
node statements:stats.