--- a/Parser.st Wed Aug 24 01:05:44 1994 +0200
+++ b/Parser.st Sun Oct 02 23:01:25 1994 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -12,32 +12,33 @@
Scanner subclass:#Parser
instanceVariableNames:'classToCompileFor selfValue
- contextToEvaluateIn
- selector
- methodArgs methodArgNames
- methodVars methodVarNames
- tree
- currentBlock
- usedInstVars usedClassVars usedVars
- modifiedInstVars modifiedClassVars
- localVarDefPosition
- evalExitBlock
- selfNode superNode
- hasPrimitiveCode primitiveNr logged
- warnedUndefVars
- correctedSource'
+ contextToEvaluateIn
+ selector
+ methodArgs methodArgNames
+ methodVars methodVarNames
+ tree
+ currentBlock
+ usedInstVars usedClassVars usedVars
+ modifiedInstVars modifiedClassVars
+ usesSuper
+ localVarDefPosition
+ evalExitBlock
+ selfNode superNode
+ hasPrimitiveCode primitiveNr logged
+ warnedUndefVars
+ correctedSource'
classVariableNames:'PrevClass PrevInstVarNames
- PrevClassVarNames PrevClassInstVarNames
- LazyCompilation'
+ PrevClassVarNames PrevClassInstVarNames
+ LazyCompilation'
poolDictionaries:''
category:'System-Compiler'
!
Parser comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.14 1994-08-22 12:47:31 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.15 1994-10-02 22:01:25 claus Exp $
'!
!Parser class methodsFor:'documentation'!
@@ -45,7 +46,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -58,7 +59,7 @@
version
"
-$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.14 1994-08-22 12:47:31 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.15 1994-10-02 22:01:25 claus Exp $
"
!
@@ -70,11 +71,11 @@
the (planned) MachineCodeCompiler.
methods of main interrest are:
- Parser evaluateExpression:...
+ Parser evaluateExpression:...
and:
- Parser parseExpression:...
- Parser parseMethod:...
+ Parser parseExpression:...
+ Parser parseMethod:...
there is protocol to parse complete methods, selector specs, body only etc.
@@ -93,69 +94,69 @@
Instance variables:
- classToCompileFor <Class> the class (or nil) we are compiling for
+ classToCompileFor <Class> the class (or nil) we are compiling for
- selfValue <any> value to use as self when interpreting
+ selfValue <any> value to use as self when interpreting
- contextToEvaluateIn <Context> the context (or nil) when interpreting
+ contextToEvaluateIn <Context> the context (or nil) when interpreting
- selector <Symbol> the selector of the parsed method
- (valid after parseMethodSpecification)
- methodArgs internal
+ selector <Symbol> the selector of the parsed method
+ (valid after parseMethodSpecification)
+ methodArgs internal
- methodArgNames <Collection> the names of the arguments
- (valid after parseMethodSpecification)
+ methodArgNames <Collection> the names of the arguments
+ (valid after parseMethodSpecification)
- methodVars internal
+ methodVars internal
- methodVarNames <Collection> the names of the method locals
- (valid after parseMethodBodyVarSpec)
+ methodVarNames <Collection> the names of the method locals
+ (valid after parseMethodBodyVarSpec)
- tree <ParseTree> the parse tree - valid after parsing
+ tree <ParseTree> the parse tree - valid after parsing
- currentBlock if currently parsing for a block
+ currentBlock if currently parsing for a block
- usedInstVars set of all accessed instances variables
- (valid after parsing)
+ usedInstVars set of all accessed instances variables
+ (valid after parsing)
- usedClassVars same for classVars
+ usedClassVars same for classVars
- usedVars all used variables (inst, class & globals)
+ usedVars all used variables (inst, class & globals)
- modifiedInstVars set of all modified instance variables
+ modifiedInstVars set of all modified instance variables
- modifiedClassVars same for clasVars
+ modifiedClassVars same for clasVars
- localVarDefPosition <Integer> the character offset of the local variable
- def. (i.e. the first '|' if any)
- Not yet used - prepared for automatic add of
- undefined variables
+ localVarDefPosition <Integer> the character offset of the local variable
+ def. (i.e. the first '|' if any)
+ Not yet used - prepared for automatic add of
+ undefined variables
- evalExitBlock internal for interpretation
+ evalExitBlock internal for interpretation
- selfNode <Node> cached one-and-only 'self' node
- superNode <Node> cached one-and-only 'super' node
+ selfNode <Node> cached one-and-only 'self' node
+ superNode <Node> cached one-and-only 'super' node
- hasPrimitiveCode <Boolean> true, if it contains ST/X style primitive code
+ hasPrimitiveCode <Boolean> true, if it contains ST/X style primitive code
- primitiveNr <Integer> the parsed ST-80 type primitive number (or nil)
+ primitiveNr <Integer> the parsed ST-80 type primitive number (or nil)
- logged
+ logged
- warnedUndefVars <Set> set of all variables which the parser has
- already output a warning (to avoid multiple
- warnings about the same variable)
+ warnedUndefVars <Set> set of all variables which the parser has
+ already output a warning (to avoid multiple
+ warnings about the same variable)
Class variables:
- PrevClass <Class> class, of which properties are
- cached in:
+ PrevClass <Class> class, of which properties are
+ cached in:
- PrevInstVarNames <Collection> instance variablenames of cached class
- PrevClassVarNames <Collection> class variablenames of cached class
- PrevClassInstVarNames <Collection> class instance variablenames of cached class
+ PrevInstVarNames <Collection> instance variablenames of cached class
+ PrevClassVarNames <Collection> class variablenames of cached class
+ PrevClassInstVarNames <Collection> class instance variablenames of cached class
- LazyCompilation <Boolean> EXPERIMENTAL: lazy compilation
+ LazyCompilation <Boolean> EXPERIMENTAL: lazy compilation
"
! !
@@ -165,12 +166,12 @@
"return the result of evaluating an expression in aStringOrStream"
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:nil
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:nil
"
Compiler evaluate:'1 + 2'
@@ -184,12 +185,12 @@
In case of any syntax errors, return the value of failBlock."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:failBlock
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:failBlock
"
Compiler evaluate:'1 +' ifFail:['oops']
@@ -201,12 +202,12 @@
"return the result of evaluating an expression in aStringOrStream"
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:logged
- ifFail:nil
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:logged
+ ifFail:nil
!
evaluate:aStringOrStream notifying:requestor
@@ -214,12 +215,12 @@
errors are reported to requestor"
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:requestor
- logged:false
- ifFail:nil
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:requestor
+ logged:false
+ ifFail:nil
!
@@ -229,24 +230,24 @@
anObject as self and to its instVars (used in the inspector)"
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:anObject
- notifying:requestor
- logged:false
- ifFail:nil
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:requestor
+ logged:false
+ ifFail:nil
!
evaluate:aStringOrStream in:aContext receiver:anObject
- notifying:requestor
- ifFail:failBlock
+ notifying:requestor
+ ifFail:failBlock
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:anObject
- notifying:requestor
- logged:false
- ifFail:nil
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:requestor
+ logged:false
+ ifFail:nil
!
evaluate:aStringOrStream in:aContext receiver:anObject notifying:requestor logged:logged ifFail:failBlock
@@ -261,12 +262,12 @@
aStringOrStream isNil ifTrue:[^ nil].
aStringOrStream isStream ifTrue:[
- parser := self for:aStringOrStream.
- mustBackup := true
+ parser := self for:aStringOrStream.
+ mustBackup := true
] ifFalse:[
- loggedString := aStringOrStream.
- parser := self for:(ReadStream on:aStringOrStream).
- mustBackup := false
+ loggedString := aStringOrStream.
+ parser := self for:(ReadStream on:aStringOrStream).
+ mustBackup := false
].
parser setSelf:anObject.
parser setContext:aContext.
@@ -276,29 +277,29 @@
"if reading from a stream, backup for next expression"
mustBackup ifTrue:[
- parser backupPosition
+ parser backupPosition
].
(parser errorFlag or:[tree == #Error]) ifTrue:[
- failBlock notNil ifTrue:[
- ^ failBlock value
- ].
- ^ #Error
+ failBlock notNil ifTrue:[
+ ^ failBlock value
+ ].
+ ^ #Error
].
tree notNil ifTrue:[
- (logged
- and:[loggedString notNil
- and:[Smalltalk logDoits]]) ifTrue:[
- chgStream := Class changesStream.
- chgStream notNil ifTrue:[
- chgStream nextChunkPut:loggedString.
- chgStream cr.
- chgStream close
- ].
- ].
+ (logged
+ and:[loggedString notNil
+ and:[Smalltalk logDoits]]) ifTrue:[
+ chgStream := Class changesStream.
+ chgStream notNil ifTrue:[
+ chgStream nextChunkPut:loggedString.
+ chgStream cr.
+ chgStream close
+ ].
+ ].
- parser evalExitBlock:[:value | parser release. ^ value].
- value := tree evaluate
+ parser evalExitBlock:[:value | parser release. ^ value].
+ value := tree evaluate
].
parser release.
^ value
@@ -328,30 +329,30 @@
(aString isNil or:[aString isEmpty]) ifTrue:[^ nil].
tree := self withSelf:nil
- parseExpression:aString
- notifying:nil
- ignoreErrors:true
- ignoreWarnings:true.
+ parseExpression:aString
+ notifying:nil
+ ignoreErrors:true
+ ignoreWarnings:true.
"
special: take the expression of the right side, if its an
assignment or return
"
(tree notNil and:[tree ~~ #Error]) ifTrue:[
- tree isAssignment ifTrue:[
- tree expression isMessage ifTrue:[
- tree := tree expression
- ]
- ].
- tree isReturnNode ifTrue:[
- tree expression isMessage ifTrue:[
- tree := tree expression
- ]
- ].
+ tree isAssignment ifTrue:[
+ tree expression isMessage ifTrue:[
+ tree := tree expression
+ ]
+ ].
+ tree isReturnNode ifTrue:[
+ tree expression isMessage ifTrue:[
+ tree := tree expression
+ ]
+ ].
- tree isMessage ifTrue:[
- ^ tree selector
- ].
+ tree isMessage ifTrue:[
+ ^ tree selector
+ ].
].
"
@@ -378,10 +379,10 @@
or comment only) or #Error (syntactic error)."
^ self withSelf:nil
- parseExpression:aString
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
+ parseExpression:aString
+ notifying:nil
+ ignoreErrors:true "silence on Transcript"
+ ignoreWarnings:true
!
withSelf:anObject parseExpression:aString notifying:someOne
@@ -393,10 +394,10 @@
codeView) which can highlight it and show a popup box."
^ self withSelf:anObject
- parseExpression:aString
- notifying:someOne
- ignoreErrors:false
- ignoreWarnings:false
+ parseExpression:aString
+ notifying:someOne
+ ignoreErrors:false
+ ignoreWarnings:false
!
withSelf:anObject parseExpression:aString notifying:someOne ignoreErrors:ignore
@@ -408,10 +409,10 @@
codeView) which can highlight it and show a popup box."
^ self withSelf:anObject
- parseExpression:aString
- notifying:someOne
- ignoreErrors:ignore
- ignoreWarnings:ignore
+ parseExpression:aString
+ notifying:someOne
+ ignoreErrors:ignore
+ ignoreWarnings:ignore
!
withSelf:anObject parseExpression:aString notifying:someOne ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings
@@ -433,7 +434,7 @@
ignoreWarnings ifTrue:[parser ignoreWarnings].
token := parser nextToken.
(token == $^) ifTrue:[
- parser nextToken.
+ parser nextToken.
].
tree := parser expression.
(parser errorFlag or:[tree == #Error]) ifTrue:[^ #Error].
@@ -463,9 +464,9 @@
The parser can be queried for selector, receiver etc."
^ self parseMethodSpecification:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
!
parseMethodSpecification:aString in:aClass ignoreErrors:noErrors ignoreWarnings:noWarnings
@@ -480,10 +481,10 @@
aString isNil ifTrue:[^ nil].
parser := self for:(ReadStream on:aString) in:aClass.
noErrors ifTrue:[
- parser ignoreErrors
+ parser ignoreErrors
].
noWarnings ifTrue:[
- parser ignoreWarnings
+ parser ignoreWarnings
].
parser nextToken.
tree := parser parseMethodSpec.
@@ -502,9 +503,9 @@
|p|
p := Parser
- parseMethodArgAndVarSpecification:'
- foo:arg1 bar:arg2 baz:arg3
- |l1 l2|'.
+ parseMethodArgAndVarSpecification:'
+ foo:arg1 bar:arg2 baz:arg3
+ |l1 l2|'.
'nArgs: ' print. p numberOfMethodArgs printNL.
'args: ' print. p methodArgs printNL.
@@ -542,12 +543,12 @@
|p|
p := Parser
- parseMethod:'
- foo:arg1 bar:arg2 baz:arg3
- |l1 l2|
- l1 := 0.
- l2 := arg1.
- ^ self'.
+ parseMethod:'
+ foo:arg1 bar:arg2 baz:arg3
+ |l1 l2|
+ l1 := 0.
+ l2 := arg1.
+ ^ self'.
'nArgs: ' print. p numberOfMethodArgs printNL.
'args: ' print. p methodArgs printNL.
@@ -581,9 +582,9 @@
To be used for code generators"
^ self methodSpecificationForSelector:aSelector
- argNames:#('arg1' 'arg2' 'arg3' 'arg4' 'arg5' 'arg6'
- 'arg7' 'arg8' 'arg9' 'arg10' 'arg11' 'arg12'
- 'arg13' 'arg14' 'arg15')
+ argNames:#('arg1' 'arg2' 'arg3' 'arg4' 'arg5' 'arg6'
+ 'arg7' 'arg8' 'arg9' 'arg10' 'arg11' 'arg12'
+ 'arg13' 'arg14' 'arg15')
"
Parser methodSpecificationForSelector:#foo:bar:
Parser methodSpecificationForSelector:#+
@@ -599,15 +600,15 @@
|s nargs parts|
s := WriteStream on:String new.
- nargs := aSelector nArgsIfSelector.
+ nargs := aSelector numArgs.
nargs == 0 ifTrue:[
- s nextPutAll:aSelector
+ s nextPutAll:aSelector
] ifFalse:[
- parts := aSelector partsIfSelector.
- 1 to:nargs do:[:i |
- s nextPutAll:(parts at:i); space;
- nextPutAll:(argNames at:i); space.
- ]
+ parts := aSelector partsIfSelector.
+ 1 to:nargs do:[:i |
+ s nextPutAll:(parts at:i); space;
+ nextPutAll:(argNames at:i); space.
+ ]
].
^ s contents
@@ -650,8 +651,8 @@
parseTree := self parseMethodBody.
(errorFlag or:[tree == #Error]) ifTrue:[^ #Error].
parseTree notNil ifTrue:[
- self evalExitBlock:[:value | ^ failBlock value].
- value := parseTree evaluate
+ self evalExitBlock:[:value | ^ failBlock value].
+ value := parseTree evaluate
].
self release.
^ value
@@ -659,30 +660,28 @@
!Parser class methodsFor:'changes'!
-update:aClass
+update:something with:someArgument from:changedObject
"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
+ (changedObject == PrevClass) ifTrue:[
+ something == #definition ifTrue:[
+ self flushNameCache
+ ]
]
!
-flush
+flushNameCache
"unconditional flush name caches"
PrevClass notNil ifTrue:[
- PrevClass removeDependent:Parser
+ PrevClass removeDependent:Parser
].
PrevClass := nil.
PrevInstVarNames := nil.
PrevClassVarNames := nil.
PrevClassInstVarNames := nil.
- "Parser flush"
+ "Parser flushNameCache"
! !
!Parser methodsFor:'setup'!
@@ -696,7 +695,8 @@
initializeFor:aStringOrStream
super initializeFor:aStringOrStream.
- hasPrimitiveCode := false
+ hasPrimitiveCode := false.
+ usesSuper := false
!
setClassToCompileFor:aClass
@@ -704,9 +704,9 @@
classToCompileFor := aClass.
(classToCompileFor ~~ PrevClass) ifTrue:[
- PrevClass notNil ifTrue:[
- Parser update:PrevClass
- ]
+ PrevClass notNil ifTrue:[
+ Parser update:PrevClass
+ ]
]
!
@@ -716,9 +716,9 @@
selfValue := anObject.
classToCompileFor := anObject class.
(classToCompileFor ~~ PrevClass) ifTrue:[
- PrevClass notNil ifTrue:[
- Parser update:PrevClass
- ]
+ PrevClass notNil ifTrue:[
+ Parser update:PrevClass
+ ]
]
!
@@ -728,18 +728,12 @@
contextToEvaluateIn := aContext
! !
-!Parser methodsFor:'accessing'!
-
-tree
- "return the parsetree"
+!Parser methodsFor:'queries'!
- ^tree
-!
+usesSuper
+ "return true if the parsed method uses super (valid after parsing)"
-tree:aTree
- "private: set the tree - for internal use only"
-
- tree := aTree
+ ^ usesSuper
!
selector
@@ -748,10 +742,6 @@
^ selector
!
-correctedSource
- ^ correctedSource
-!
-
numberOfMethodArgs
"return the number of methodargs (valid after parsing spec)"
@@ -806,18 +796,36 @@
^ modifiedClassVars
!
+hasPrimitiveCode
+ "return true if there was any ST/X style primitive code (valid after parsing)"
+
+ ^ hasPrimitiveCode
+! !
+
+!Parser methodsFor:'accessing'!
+
+tree
+ "return the parsetree"
+
+ ^tree
+!
+
+tree:aTree
+ "private: set the tree - for internal use only"
+
+ tree := aTree
+!
+
+correctedSource
+ ^ correctedSource
+!
+
primitiveNumber
"return the ST-80 style primitiveNumber or nil (valid after parsing)"
^ primitiveNr
!
-hasPrimitiveCode
- "return true if there was any ST/X style primitive code (valid after parsing)"
-
- ^ hasPrimitiveCode
-!
-
errorFlag
"return true if there where any errors (valid after parsing)"
@@ -842,24 +850,24 @@
the class & selector where the error occured."
ignoreErrors ifFalse:[
- Smalltalk silentLoading == true ifFalse:[
- Transcript show:(pos printString).
- Transcript show:' '.
- selector notNil ifTrue:[
- Transcript show:aMessage.
- classToCompileFor notNil ifTrue:[
- Transcript showCr:(' in ' , classToCompileFor name , '>>' , selector)
- ] ifFalse:[
- Transcript showCr:(' in ' , selector)
- ]
- ] ifFalse:[
- classToCompileFor notNil ifTrue:[
- Transcript showCr:aMessage , ' (' , classToCompileFor name , ')'
- ] ifFalse:[
- Transcript showCr:aMessage
- ]
- ]
- ]
+ Smalltalk silentLoading == true ifFalse:[
+ Transcript show:(pos printString).
+ Transcript show:' '.
+ selector notNil ifTrue:[
+ Transcript show:aMessage.
+ classToCompileFor notNil ifTrue:[
+ Transcript showCr:(' in ' , classToCompileFor name , '>>' , selector)
+ ] ifFalse:[
+ Transcript showCr:(' in ' , selector)
+ ]
+ ] ifFalse:[
+ classToCompileFor notNil ifTrue:[
+ Transcript showCr:aMessage , ' (' , classToCompileFor name , ')'
+ ] ifFalse:[
+ Transcript showCr:aMessage
+ ]
+ ]
+ ]
]
!
@@ -894,13 +902,13 @@
|correctIt|
requestor isNil ifTrue:[
- self showErrorMessage:message position:pos1.
- correctIt := false
+ self showErrorMessage:message position:pos1.
+ correctIt := false
] ifFalse:[
- correctIt := requestor correctableError:message position:pos1 to:pos2
+ correctIt := requestor correctableError:message position:pos1 to:pos2
].
correctIt ifFalse:[
- exitBlock notNil ifTrue:[exitBlock value]
+ exitBlock notNil ifTrue:[exitBlock value]
].
^ correctIt
!
@@ -910,18 +918,18 @@
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
+ 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
@@ -948,7 +956,7 @@
(self parseMethodSpec == #Error) ifTrue:[^ #Error].
parseTree := self parseMethodBody.
(parseTree == #Error) ifFalse:[
- self tree:parseTree
+ self tree:parseTree
].
^ parseTree
!
@@ -959,55 +967,55 @@
Return the receiver or #Error.
methodSpec ::= { KEYWORD IDENTIFIER }
- | binaryOperator IDENTIFIER
- | IDENTIFIER
+ | binaryOperator IDENTIFIER
+ | IDENTIFIER
"
|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:[
- (methodArgNames includes:tokenName) ifTrue:[
- self syntaxError:'redefinition of ''' , tokenName , ''' in argument list.'
- position:tokenPosition
- to:(tokenPosition + tokenName size - 1)
- ].
- methodArgs := methodArgs copyWith:var.
- methodArgNames := methodArgNames copyWith:tokenName
- ].
- self nextToken
- ].
- selector := selector asSymbol.
- ^ self
+ 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:[
+ (methodArgNames includes:tokenName) ifTrue:[
+ self syntaxError:'redefinition of ''' , tokenName , ''' in argument list.'
+ position:tokenPosition
+ to:(tokenPosition + tokenName size - 1)
+ ].
+ methodArgs := methodArgs copyWith:var.
+ methodArgNames := methodArgNames copyWith:tokenName
+ ].
+ self nextToken
+ ].
+ selector := selector asSymbol.
+ ^ self
].
(tokenType == #Identifier) ifTrue:[
- selector := tokenName asSymbol.
- self nextToken.
- ^ self
+ selector := tokenName asSymbol.
+ self nextToken.
+ ^ self
].
(tokenType == #BinaryOperator) ifTrue:[
- selector := tokenName asSymbol.
- 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.
- ^ self
+ selector := tokenName asSymbol.
+ 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.
+ ^ self
].
^ #Error
!
@@ -1018,23 +1026,23 @@
Return a node-tree, or #Error
methodBody ::= '<' st80Primitive '>' #EOF
- | '<' st80Primitive '>' methodBodyVarSpec statementList #EOF
+ | '<' st80Primitive '>' methodBodyVarSpec statementList #EOF
"
|stats|
stats := self parseMethodBodyOrNil.
(stats == #Error) ifFalse:[
- (tokenType ~~ #EOF) ifTrue:[
- "/ just for the nicer error message
- (#(Self Nil True False Super) includes:tokenType) ifTrue:[
- self parseError:tokenName , ' unexpected (missing ''.'' before ' , tokenName , ' ?)'
- position:tokenPosition to:(tokenPosition + tokenName size - 1)
- ] ifFalse:[
- self parseError:(tokenType printString , ' unexpected').
- ].
- ^#Error
- ]
+ (tokenType ~~ #EOF) ifTrue:[
+ "/ just for the nicer error message
+ (#(Self Nil True False Super) includes:tokenType) ifTrue:[
+ self parseError:tokenName , ' unexpected (missing ''.'' before ' , tokenName , ' ?)'
+ position:tokenPosition to:(tokenPosition + tokenName size - 1)
+ ] ifFalse:[
+ self parseError:(tokenType printString , ' unexpected').
+ ].
+ ^#Error
+ ]
].
^ stats
!
@@ -1045,25 +1053,25 @@
empty (or comment only) input is accepted and returns nil.
methodBodyOrNil ::= '<' st80Primitive '>'
- | '<' st80Primitive '>' methodBodyVarSpec statementList
- | <empty>
+ | '<' st80Primitive '>' methodBodyVarSpec statementList
+ | <empty>
"
|stats|
((tokenType == #BinaryOperator) and:[tokenName = '<']) ifTrue:[
- "an ST-80 primitive - parsed but ignored"
- self nextToken.
- primitiveNr := self parseST80Primitive.
- (primitiveNr == #Error) ifTrue:[^ #Error].
+ "an ST-80 primitive - parsed but ignored"
+ self nextToken.
+ primitiveNr := self parseST80Primitive.
+ (primitiveNr == #Error) ifTrue:[^ #Error].
- self warning:'ST-80 primitives not supported - ignored'
+ self warning:'ST-80 primitives not supported - ignored'
].
(self parseMethodBodyVarSpec == #Error) ifTrue:[^ #Error].
(tokenType ~~ #EOF) ifTrue:[
- stats := self statementList
+ stats := self statementList
].
^ stats
!
@@ -1074,31 +1082,31 @@
Return #Error or nil.
methodBodyVarSpec ::= '|' { IDENTIFIER } '|'
- | <empty>
+ | <empty>
"
|var|
(tokenType == $|) ifTrue:[
- "memorize position for declaration in correction"
- localVarDefPosition := tokenPosition.
- self nextToken.
- [tokenType == #Identifier] whileTrue:[
- var := Variable name:tokenName.
- methodVars isNil ifTrue:[
- methodVars := Array with:var.
- methodVarNames := Array with:tokenName
- ] ifFalse:[
- methodVars := methodVars copyWith:var.
- methodVarNames := methodVarNames copyWith:tokenName
- ].
- self nextToken
- ].
- (tokenType ~~ $|) ifTrue:[
- self syntaxError:'error in local var specification; | expected.'.
- ^ #Error
- ].
- self nextToken
+ "memorize position for declaration in correction"
+ localVarDefPosition := tokenPosition.
+ self nextToken.
+ [tokenType == #Identifier] whileTrue:[
+ var := Variable name:tokenName.
+ methodVars isNil ifTrue:[
+ methodVars := Array with:var.
+ methodVarNames := Array with:tokenName
+ ] ifFalse:[
+ methodVars := methodVars copyWith:var.
+ methodVarNames := methodVarNames copyWith:tokenName
+ ].
+ self nextToken
+ ].
+ (tokenType ~~ $|) ifTrue:[
+ self syntaxError:'error in local var specification; | expected.'.
+ ^ #Error
+ ].
+ self nextToken
].
^ nil
!
@@ -1113,19 +1121,19 @@
|primNumber|
((tokenType == #Keyword) and:[tokenName = 'primitive:']) ifFalse:[
- self parseError:'bad primitive definition (primitive: expected)'.
- ^ #Error
+ self parseError:'bad primitive definition (primitive: expected)'.
+ ^ #Error
].
self nextToken.
(tokenType == #Integer) ifFalse:[
- self parseError:'primitive number expected'.
- ^ #Error
+ self parseError:'primitive number expected'.
+ ^ #Error
].
primNumber := tokenValue.
self nextToken.
((tokenType == #BinaryOperator) and:[tokenName = '>']) ifFalse:[
- self parseError:'bad primitive definition (> expected)'.
- ^ #Error
+ self parseError:'bad primitive definition (> expected)'.
+ ^ #Error
].
self nextToken.
^ primNumber
@@ -1141,68 +1149,68 @@
(thisStatement == #Error) ifTrue:[^ #Error].
firstStatement := thisStatement.
[tokenType == $.] whileTrue:[
- periodPos := tokenPosition.
- self nextToken.
- (tokenType == $]) ifTrue:[
- currentBlock isNil ifTrue:[
- self parseError:'block nesting error'.
- errorFlag := true
+ periodPos := tokenPosition.
+ self nextToken.
+ (tokenType == $]) ifTrue:[
+ currentBlock isNil ifTrue:[
+ self parseError:'block nesting error'.
+ errorFlag := true
"
- *** I had a warning here (since it was not defined
- *** in the blue-book; but PD-code contains a lot of
- *** code with periods at the end so that the warnings
- *** became annoying
+ *** I had a warning here (since it was not defined
+ *** in the blue-book; but PD-code contains a lot of
+ *** code with periods at the end so that the warnings
+ *** became annoying
- ] ifFalse:[
- self warning:'period after last statement' position:periodPos
+ ] ifFalse:[
+ self warning:'period after last statement' position:periodPos
"
- ].
- ^ firstStatement
- ].
- (tokenType == #EOF) ifTrue:[
- currentBlock notNil ifTrue:[
- self parseError:'block nesting error (expected '']'')'.
- errorFlag := true
+ ].
+ ^ firstStatement
+ ].
+ (tokenType == #EOF) ifTrue:[
+ currentBlock notNil ifTrue:[
+ self parseError:'block nesting error (expected '']'')'.
+ errorFlag := true
"
- *** I had a warning here (since it was not defined
- *** in the blue-book; but PD-code contains a lot of
- *** code with periods at the end so that the warnings
- *** became annoying
+ *** I had a warning here (since it was not defined
+ *** in the blue-book; but PD-code contains a lot of
+ *** code with periods at the end so that the warnings
+ *** became annoying
- ] ifFalse:[
- self warning:'period after last statement' position:periodPos
+ ] ifFalse:[
+ self warning:'period after last statement' position:periodPos
"
- ].
- ^ firstStatement
- ].
+ ].
+ ^ firstStatement
+ ].
- prevStatement := thisStatement.
- (prevStatement isKindOf:ReturnNode) ifTrue:[
- self warning:'statements after return' position:tokenPosition
- ].
+ prevStatement := thisStatement.
+ (prevStatement isKindOf:ReturnNode) ifTrue:[
+ self warning:'statements after return' position:tokenPosition
+ ].
"
- periodPos := tokenPosition.
- self nextToken.
+ periodPos := tokenPosition.
+ self nextToken.
"
- ((tokenType == $]) or:[tokenType == #EOF]) ifTrue:[
- (currentBlock isNil and:[tokenType == $]]) ifTrue:[
- self parseError:'block nesting error'.
- errorFlag := true
- ] ifFalse:[
- correctIt := self correctableError:'period after last statement in block'
- position:periodPos to:(periodPos + 1).
- correctIt ifTrue:[
- (self correctByDeleting == #Error) ifTrue:[
- errorFlag := true
- ]
- ]
- ].
- ^ firstStatement
- ].
- thisStatement := self statement.
- (thisStatement == #Error) ifTrue:[^ #Error].
- prevStatement nextStatement:thisStatement
+ ((tokenType == $]) or:[tokenType == #EOF]) ifTrue:[
+ (currentBlock isNil and:[tokenType == $]]) ifTrue:[
+ self parseError:'block nesting error'.
+ errorFlag := true
+ ] ifFalse:[
+ correctIt := self correctableError:'period after last statement in block'
+ position:periodPos to:(periodPos + 1).
+ correctIt ifTrue:[
+ (self correctByDeleting == #Error) ifTrue:[
+ errorFlag := true
+ ]
+ ]
+ ].
+ ^ firstStatement
+ ].
+ thisStatement := self statement.
+ (thisStatement == #Error) ifTrue:[^ #Error].
+ prevStatement nextStatement:thisStatement
].
^ firstStatement
!
@@ -1211,41 +1219,41 @@
"parse a statement; return a node-tree or #Error.
statement ::= '^' expression
- | PRIMITIVECODE
- | expression
+ | PRIMITIVECODE
+ | expression
"
|expr node|
(tokenType == $^) ifTrue:[
- self nextToken.
- expr := self expression.
- (expr == #Error) ifTrue:[^ #Error].
- node := ReturnNode expression:expr.
- node home:self blockHome:currentBlock.
- ^ node
+ self nextToken.
+ expr := self expression.
+ (expr == #Error) ifTrue:[^ #Error].
+ node := ReturnNode expression:expr.
+ node home:self blockHome:currentBlock.
+ ^ node
].
(tokenType == #Primitive) ifTrue:[
"
- self parseError:'cannot compile primitives (yet)'.
+ self parseError:'cannot compile primitives (yet)'.
"
- self nextToken.
- hasPrimitiveCode := true.
- ^ PrimitiveNode code:''
+ self nextToken.
+ hasPrimitiveCode := true.
+ ^ PrimitiveNode code:''
].
(tokenType == #EOF) ifTrue:[
- self syntaxError:'period after last statement'.
- ^ #Error
+ self syntaxError:'period after last statement'.
+ ^ #Error
].
expr := self expression.
(expr == #Error) ifTrue:[^ #Error].
"
classToCompileFor notNil ifTrue:[
- currentBlock isNil ifTrue:[
- (expr isKindOf:PrimaryNode) ifTrue:[
- self warning:'useless computation - missing ^ ?'
- ]
- ]
+ currentBlock isNil ifTrue:[
+ (expr isKindOf:PrimaryNode) ifTrue:[
+ self warning:'useless computation - missing ^ ?'
+ ]
+ ]
].
"
^ StatementNode expression:expr
@@ -1255,14 +1263,14 @@
"parse a cascade-expression; return a node-tree, nil or #Error.
expression ::= keywordExpression
- | keywordExpression cascade
+ | keywordExpression cascade
cascade ::= ';' expressionSendPart
- | cascade ';' expressionSendPart
+ | cascade ';' expressionSendPart
expressionSendPart ::= { KEYWORD binaryExpression }
- | BINARYOPERATOR unaryExpression
- | IDENTIFIER
+ | BINARYOPERATOR unaryExpression
+ | IDENTIFIER
"
|receiver arg sel args pos pos2 lno|
@@ -1271,78 +1279,78 @@
receiver := self keywordExpression.
(receiver == #Error) ifTrue:[^ #Error].
(tokenType == $;) ifTrue:[
- [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 := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
- receiver := CascadeNode receiver:receiver selector:sel.
- receiver lineNumber:tokenLineNr.
- self nextToken.
- ] ifFalse:[
- (tokenType == #BinaryOperator) ifTrue:[
- sel := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
- lno := tokenLineNr.
- self nextToken.
- arg := self unaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- receiver := CascadeNode receiver:receiver selector:sel arg:arg.
- receiver lineNumber:lno.
- ] ifFalse:[
- (tokenType == #Keyword) ifTrue:[
- pos := tokenPosition.
- lno := tokenLineNr.
- sel := tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := Array with:arg.
- [tokenType == #Keyword] whileTrue:[
- sel := sel , tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := args copyWith:arg.
- pos2 := tokenPosition
- ].
- sel := self selectorCheck:sel for:receiver position:pos to:pos2.
- receiver := CascadeNode receiver:receiver selector:sel args:args.
- receiver lineNumber:lno.
- ] ifFalse:[
- (tokenType == #Error) ifTrue:[^ #Error].
- self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
- position:tokenPosition to:source position - 1.
- ^ #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 := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
+ receiver := CascadeNode receiver:receiver selector:sel.
+ receiver lineNumber:tokenLineNr.
+ self nextToken.
+ ] ifFalse:[
+ (tokenType == #BinaryOperator) ifTrue:[
+ sel := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
+ lno := tokenLineNr.
+ self nextToken.
+ arg := self unaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ receiver := CascadeNode receiver:receiver selector:sel arg:arg.
+ receiver lineNumber:lno.
+ ] ifFalse:[
+ (tokenType == #Keyword) ifTrue:[
+ pos := tokenPosition.
+ lno := tokenLineNr.
+ sel := tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := Array with:arg.
+ [tokenType == #Keyword] whileTrue:[
+ sel := sel , tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := args copyWith:arg.
+ pos2 := tokenPosition
+ ].
+ sel := self selectorCheck:sel for:receiver position:pos to:pos2.
+ receiver := CascadeNode receiver:receiver selector:sel args:args.
+ receiver lineNumber:lno.
+ ] ifFalse:[
+ (tokenType == #Error) ifTrue:[^ #Error].
+ self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
+ position:tokenPosition to:source position - 1.
+ ^ #Error
+ ]
+ ]
+ ]
+ ].
- "obscure (uspecified ?) if selector follows; Question:
+ "obscure (uspecified ?) if selector follows; Question:
- is
- 'expr sel1; sel2 sel3'
+ is
+ 'expr sel1; sel2 sel3'
- to be parsed as:
- (t := expr.
- t sel1.
- t sel2) sel3
+ to be parsed as:
+ (t := expr.
+ t sel1.
+ t sel2) sel3
- or:
- (t := expr.
- t sel1.
- t sel2 sel3)
- "
- ((tokenType == #Identifier)
- or:[(tokenType == #BinaryOperator)
- or:[tokenType == #Keyword]]) ifTrue:[
- self syntaxError:'ambigous cascade - please group using ( ...)'
- position:tokenPosition to:source position - 1.
- ^ #Error
- ]
+ or:
+ (t := expr.
+ t sel1.
+ t sel2 sel3)
+ "
+ ((tokenType == #Identifier)
+ or:[(tokenType == #BinaryOperator)
+ or:[tokenType == #Keyword]]) ifTrue:[
+ self syntaxError:'ambigous cascade - please group using ( ...)'
+ position:tokenPosition to:source position - 1.
+ ^ #Error
+ ]
].
^ receiver
!
@@ -1355,34 +1363,34 @@
receiver := self binaryExpression.
(receiver == #Error) ifTrue:[^ #Error].
(tokenType == #Keyword) ifTrue:[
- pos1 := tokenPosition.
- sel := tokenName.
- lno := tokenLineNr.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := Array with:arg.
- [tokenType == #Keyword] whileTrue:[
- sel := sel , tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := args copyWith:arg.
- pos2 := tokenPosition
- ].
- sel := self selectorCheck:sel for:receiver position:pos1 to:pos2.
- try := MessageNode receiver:receiver selector:sel args:args.
- (try isMemberOf:String) ifTrue:[
- self parseError:try position:pos1 to:pos2.
- receiver := MessageNode receiver:receiver selector:sel args:args fold:false.
- note := receiver plausibilityCheck.
- note notNil ifTrue:[
- self warning:note position:pos1 to:pos2
- ].
- ] ifFalse:[
- receiver := try
- ].
- receiver lineNumber:lno
+ pos1 := tokenPosition.
+ sel := tokenName.
+ lno := tokenLineNr.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := Array with:arg.
+ [tokenType == #Keyword] whileTrue:[
+ sel := sel , tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := args copyWith:arg.
+ pos2 := tokenPosition
+ ].
+ sel := self selectorCheck:sel for:receiver position:pos1 to:pos2.
+ try := MessageNode receiver:receiver selector:sel args:args.
+ (try isMemberOf:String) ifTrue:[
+ self parseError:try position:pos1 to:pos2.
+ receiver := MessageNode receiver:receiver selector:sel args:args fold:false.
+ note := receiver plausibilityCheck.
+ note notNil ifTrue:[
+ self warning:note position:pos1 to:pos2
+ ].
+ ] ifFalse:[
+ receiver := try
+ ].
+ receiver lineNumber:lno
].
^ receiver
!
@@ -1394,17 +1402,17 @@
|sel arg|
(tokenType == #Keyword) ifTrue:[
- sel := tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ sel].
- [tokenType == #Keyword] whileTrue:[
- sel := sel , tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ sel].
- ].
- ^ sel
+ sel := tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ sel].
+ [tokenType == #Keyword] whileTrue:[
+ sel := sel , tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ sel].
+ ].
+ ^ sel
].
^ nil
!
@@ -1422,37 +1430,37 @@
[(tokenType == #BinaryOperator) or:[(tokenType == $|)
or:[(tokenType == #Integer) and:[tokenValue < 0]]]] whileTrue:[
- pos := tokenPosition.
+ pos := tokenPosition.
- lno := tokenLineNr.
+ lno := tokenLineNr.
- "kludge here: bar and minus are not scanned as binop "
- (tokenType == $|) ifTrue:[
- sel := '|'.
- self nextToken
- ] ifFalse:[
- (tokenType == #BinaryOperator) ifTrue:[
- sel := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
- self nextToken
- ] ifFalse:[
- sel := '-'.
- tokenValue := tokenValue negated
- ]
- ].
- arg := self unaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- try := BinaryNode receiver:receiver selector:sel arg:arg.
- (try isMemberOf:String) ifTrue:[
- self parseError:try position:pos to:tokenPosition.
- receiver := BinaryNode receiver:receiver selector:sel arg:arg fold:false.
- note := receiver plausibilityCheck.
- note notNil ifTrue:[
- self warning:note position:pos to:tokenPosition
- ].
- ] ifFalse:[
- receiver := try
- ].
- receiver lineNumber:lno.
+ "kludge here: bar and minus are not scanned as binop "
+ (tokenType == $|) ifTrue:[
+ sel := '|'.
+ self nextToken
+ ] ifFalse:[
+ (tokenType == #BinaryOperator) ifTrue:[
+ sel := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
+ self nextToken
+ ] ifFalse:[
+ sel := '-'.
+ tokenValue := tokenValue negated
+ ]
+ ].
+ arg := self unaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ try := BinaryNode receiver:receiver selector:sel arg:arg.
+ (try isMemberOf:String) ifTrue:[
+ self parseError:try position:pos to:tokenPosition.
+ receiver := BinaryNode receiver:receiver selector:sel arg:arg fold:false.
+ note := receiver plausibilityCheck.
+ note notNil ifTrue:[
+ self warning:note position:pos to:tokenPosition
+ ].
+ ] ifFalse:[
+ receiver := try
+ ].
+ receiver lineNumber:lno.
].
^ receiver
!
@@ -1465,18 +1473,18 @@
receiver := self primary.
(receiver == #Error) ifTrue:[^ #Error].
[tokenType == #Identifier] whileTrue:[
- pos := tokenPosition.
- pos2 := pos + tokenName size - 1.
- sel := self selectorCheck:tokenName for:receiver position:pos to:pos2.
- try := UnaryNode receiver:receiver selector:sel.
- (try isMemberOf:String) ifTrue:[
- self warning:try position:pos to:pos2.
- receiver := UnaryNode receiver:receiver selector:sel fold:false.
- ] ifFalse:[
- receiver := try
- ].
- receiver lineNumber:tokenLineNr.
- self nextToken.
+ pos := tokenPosition.
+ pos2 := pos + tokenName size - 1.
+ sel := self selectorCheck:tokenName for:receiver position:pos to:pos2.
+ try := UnaryNode receiver:receiver selector:sel.
+ (try isMemberOf:String) ifTrue:[
+ self warning:try position:pos to:pos2.
+ receiver := UnaryNode receiver:receiver selector:sel fold:false.
+ ] ifFalse:[
+ receiver := try
+ ].
+ receiver lineNumber:tokenLineNr.
+ self nextToken.
].
^ receiver
!
@@ -1484,187 +1492,200 @@
primary
"parse a primary-expression; return a node-tree, nil or #Error"
- |val var expr pos name|
+ |val var expr pos name t sym|
pos := tokenPosition.
+ (tokenType == #Self) ifTrue:[
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'assignment to self' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ selfNode isNil ifTrue:[
+ selfNode := SelfNode value:selfValue
+ ].
+ ^ selfNode
+ ].
(tokenType == #Identifier) ifTrue:[
- var := self variable.
- (var == #Error) ifTrue:[
- errorFlag := true
- ].
- self nextToken.
- (tokenType == $_) ifFalse:[
- ^ var
- ].
- (var ~~ #Error) ifTrue:[
- (var type == #MethodArg) ifTrue:[
- self parseError:'assignment to method argument' position:pos to:tokenPosition.
- errorFlag := true
- ].
- (var type == #BlockArg) ifTrue:[
- self parseError:'assignment to block argument' position:pos to:tokenPosition.
- errorFlag := true
- ].
-
- (var type == #InstanceVariable) ifTrue:[
- modifiedInstVars isNil ifTrue:[
- modifiedInstVars := OrderedCollection new
- ].
- name := PrevInstVarNames at:(var index).
- (modifiedInstVars includes:name) ifFalse:[
- modifiedInstVars add:name
- ]
- ] ifFalse:[
- (var type == #ClassVariable) ifTrue:[
- modifiedClassVars isNil ifTrue:[
- modifiedClassVars := OrderedCollection new
- ].
- name := var name.
- name := name copyFrom:((name indexOf:$:) + 1).
- (modifiedClassVars includes:name) ifFalse:[
- modifiedClassVars add:name
- ]
- ]
- ]
- ].
+ var := self variable.
+ (var == #Error) ifTrue:[
+ errorFlag := true
+ ].
+ self nextToken.
+ (tokenType == $_) ifFalse:[
+ ^ var
+ ].
+ (var ~~ #Error) ifTrue:[
+ t := var type.
+ (t == #MethodArg) ifTrue:[
+ self parseError:'assignment to method argument' position:pos to:tokenPosition.
+ errorFlag := true
+ ] ifFalse:[
+ (t == #BlockArg) ifTrue:[
+ self parseError:'assignment to block argument' position:pos to:tokenPosition.
+ errorFlag := true
+ ] ifFalse:[
+ (t == #InstanceVariable) ifTrue:[
+ modifiedInstVars isNil ifTrue:[
+ modifiedInstVars := OrderedCollection new
+ ].
+ name := PrevInstVarNames at:(var index).
+ (modifiedInstVars includes:name) ifFalse:[
+ modifiedInstVars add:name
+ ]
+ ] ifFalse:[
+ (t == #ClassVariable) ifTrue:[
+ modifiedClassVars isNil ifTrue:[
+ modifiedClassVars := OrderedCollection new
+ ].
+ name := var name.
+ name := name copyFrom:((name indexOf:$:) + 1).
+ (modifiedClassVars includes:name) ifFalse:[
+ modifiedClassVars add:name
+ ]
+ ] ifFalse:[
+ (t == #GlobalVariable) ifTrue:[
+ (Smalltalk classNamed:var name) notNil ifTrue:[
+ self warning:'assignment to global which contains class' position:pos to:tokenPosition.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
- self nextToken.
- expr := self expression.
- (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
- ^ AssignmentNode variable:var expression:expr
- ].
- ((tokenType == #Integer) or:
- [(tokenType == #Character) or:
- [tokenType == #Float]]) ifTrue:[
- val := ConstantNode type:tokenType value:tokenValue.
- self nextToken.
- (tokenType == $_) ifTrue:[
- self parseError:'assignment to a constant' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ val
+ self nextToken.
+ expr := self expression.
+ (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
+ ^ AssignmentNode variable:var expression:expr
].
- (tokenType == #Self) ifTrue:[
- self nextToken.
- (tokenType == $_) ifTrue:[
- self parseError:'assignment to self' position:pos to:tokenPosition.
- ^ #Error
- ].
- selfNode isNil ifTrue:[
- selfNode := SelfNode value:selfValue
- ].
- ^ selfNode
- ].
- (tokenType == #String) ifTrue:[
- val := ConstantNode type:tokenType value:tokenValue.
- self nextToken.
- (tokenType == $_) ifTrue:[
- self parseError:'assignment to a constant' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ val
- ].
- (tokenType == #Symbol) ifTrue:[
- val := ConstantNode type:tokenType value:tokenValue.
- self nextToken.
- (tokenType == $_) ifTrue:[
- self parseError:'assignment to a constant' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ val
+ ((tokenType == #Integer)
+ or:[(tokenType == #Character)
+ or:[(tokenType == #Float)
+ or:[(tokenType == #String)
+ or:[(tokenType == #Symbol)]]]]) ifTrue:[
+ val := ConstantNode type:tokenType value:tokenValue.
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'assignment to a constant' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ val
].
(tokenType == #Nil) ifTrue:[
- self nextToken.
- (tokenType == $_) ifTrue:[
- self parseError:'assignment to nil' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#Nil value:nil
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'assignment to nil' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#Nil value:nil
].
(tokenType == #True) ifTrue:[
- self nextToken.
- (tokenType == $_) ifTrue:[
- self parseError:'assignment to true' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#True value:true
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'assignment to true' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#True value:true
].
(tokenType == #False) ifTrue:[
- self nextToken.
- (tokenType == $_) ifTrue:[
- self parseError:'assignment to false' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#False value:false
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'assignment to false' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#False value:false
].
(tokenType == #Super) ifTrue:[
- self nextToken.
- (tokenType == $_) ifTrue:[
- self parseError:'assignment to super' position:pos to:tokenPosition.
- ^ #Error
- ].
- superNode isNil ifTrue:[
- superNode := SuperNode value:selfValue inClass:classToCompileFor
- ].
- ^ superNode
+ usesSuper := true.
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'assignment to super' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ (classToCompileFor isNil or:[classToCompileFor superclass isNil]) ifTrue:[
+ self warning:'superclass is (currently ?) nil'
+ position:pos to:(pos + 4).
+ ].
+ superNode isNil ifTrue:[
+ superNode := SuperNode value:selfValue inClass:classToCompileFor
+ ].
+ ^ superNode
].
(tokenType == #ThisContext) ifTrue:[
- self nextToken.
- (tokenType == $_) ifTrue:[
- self parseError:'assignment to thisContext' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ VariableNode type:#ThisContext
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'assignment to thisContext' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ VariableNode type:#ThisContext
].
(tokenType == #HashLeftParen) ifTrue:[
- self nextToken.
- val := self array.
- self nextToken.
- ^ ConstantNode type:#Array value:val
+ self nextToken.
+ val := self array.
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'assignment to a constant' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#Array value:val
].
(tokenType == #HashLeftBrack) ifTrue:[
- self nextToken.
- val := self byteArray.
- self nextToken.
- ^ ConstantNode type:#Array value:val
+ self nextToken.
+ val := self byteArray.
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'assignment to a constant' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#Array value:val
].
(tokenType == $() ifTrue:[
- self nextToken.
- val := self expression.
- (val == #Error) ifTrue:[^ #Error].
- (tokenType ~~ $) ) ifTrue:[
- (tokenType isMemberOf:Character) ifTrue:[
- self syntaxError:'missing '')'' (i.e. ''' , tokenType asString , ''' unexpected)' withCRs position:pos to:tokenPosition.
- ] ifFalse:[
- self syntaxError:'missing '')''' position:pos to:tokenPosition.
- ].
- ^ #Error
- ].
- self nextToken.
- val parenthized:true.
- ^ val
+ self nextToken.
+ val := self expression.
+ (val == #Error) ifTrue:[^ #Error].
+ (tokenType ~~ $) ) ifTrue:[
+ tokenType isCharacter ifTrue:[
+ self syntaxError:'missing '')'' (i.e. ''' , tokenType asString , ''' unexpected)' withCRs position:pos to:tokenPosition.
+ ] ifFalse:[
+ self syntaxError:'missing '')''' position:pos to:tokenPosition.
+ ].
+ ^ #Error
+ ].
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'invalid assignment' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ val parenthized:true.
+ ^ val
].
(tokenType == $[ ) ifTrue:[
- val := self block.
- self nextToken.
- ^ val
+ val := self block.
+ self nextToken.
+ (tokenType == $_) ifTrue:[
+ self parseError:'invalid assignment' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ val
].
(tokenType == #Error) ifTrue:[^ #Error].
- (tokenType isKindOf:Character) ifTrue:[
- self syntaxError:('error in primary; '
- , tokenType printString ,
- ' unexpected') position:tokenPosition to:tokenPosition
+ tokenType isCharacter ifTrue:[
+ self syntaxError:('error in primary; '
+ , tokenType printString ,
+ ' unexpected') position:tokenPosition to:tokenPosition
] ifFalse:[
- (#(BinaryOperator Keyword) includes:tokenType) ifTrue:[
- self syntaxError:('error in primary; '
- , tokenType printString , '(' , tokenName , ') ' ,
- ' unexpected')
- ] ifFalse:[
- self syntaxError:('error in primary; '
- , tokenType printString ,
- ' unexpected')
- ]
+ (#(BinaryOperator Keyword) includes:tokenType) ifTrue:[
+ self syntaxError:('error in primary; '
+ , tokenType printString , '(' , tokenName , ') ' ,
+ ' unexpected')
+ ] ifFalse:[
+ self syntaxError:('error in primary; '
+ , tokenType printString ,
+ ' unexpected')
+ ]
].
^ #Error
!
@@ -1684,170 +1705,170 @@
"is it a block-arg or block-var ?"
searchBlock := currentBlock.
[searchBlock notNil] whileTrue:[
- args := searchBlock arguments.
- args notNil ifTrue:[
- instIndex := args findFirst:[:aBlockArg | aBlockArg name = varName].
- instIndex ~~ 0 ifTrue:[
- ^ VariableNode type:#BlockArg
- name:varName
- token:(args at:instIndex)
- index:instIndex
- block:searchBlock
- ].
+ args := searchBlock arguments.
+ args notNil ifTrue:[
+ instIndex := args findFirst:[:aBlockArg | aBlockArg name = varName].
+ instIndex ~~ 0 ifTrue:[
+ ^ VariableNode type:#BlockArg
+ name:varName
+ token:(args at:instIndex)
+ index:instIndex
+ block:searchBlock
+ ].
- ].
+ ].
- vars := searchBlock variables.
- vars notNil ifTrue:[
- instIndex := vars findFirst:[:aBlockVar | aBlockVar name = varName].
- instIndex ~~ 0 ifTrue:[
- ^ VariableNode type:#BlockVariable
- name:varName
- token:(vars at:instIndex)
- index:instIndex
- block:searchBlock
- ].
- ].
- searchBlock := searchBlock home
+ vars := searchBlock variables.
+ vars notNil ifTrue:[
+ instIndex := vars findFirst:[:aBlockVar | aBlockVar name = varName].
+ instIndex ~~ 0 ifTrue:[
+ ^ VariableNode type:#BlockVariable
+ name:varName
+ token:(vars at:instIndex)
+ index:instIndex
+ block:searchBlock
+ ].
+ ].
+ searchBlock := searchBlock home
].
"is it a method-variable ?"
methodVars notNil ifTrue:[
- instIndex := methodVarNames indexOf:varName.
- instIndex ~~ 0 ifTrue:[
- var := methodVars at:instIndex.
- var used:true.
- ^ VariableNode type:#MethodVariable
- name:varName
- token:var
- index:instIndex
- ]
+ instIndex := methodVarNames indexOf:varName.
+ instIndex ~~ 0 ifTrue:[
+ var := methodVars at:instIndex.
+ var used:true.
+ ^ VariableNode type:#MethodVariable
+ name:varName
+ token:var
+ index:instIndex
+ ]
].
"is it a method-argument ?"
methodArgs notNil ifTrue:[
- instIndex := methodArgNames indexOf:varName.
- instIndex ~~ 0 ifTrue:[
- ^ VariableNode type:#MethodArg
- name:varName
- token:(methodArgs at:instIndex)
- index:instIndex
- ]
+ instIndex := methodArgNames indexOf:varName.
+ instIndex ~~ 0 ifTrue:[
+ ^ VariableNode type:#MethodArg
+ name:varName
+ token:(methodArgs at:instIndex)
+ index:instIndex
+ ]
].
"is it an instance-variable ?"
classToCompileFor notNil ifTrue:[
- "caching allInstVarNames for next compilation saves time ..."
+ "caching allInstVarNames for next compilation saves time ..."
- (PrevInstVarNames isNil or:[PrevClass ~~ classToCompileFor]) ifTrue:[
- PrevClass notNil ifTrue:[
- PrevClass removeDependent:Parser
- ].
- PrevClass := classToCompileFor.
- PrevInstVarNames := classToCompileFor allInstVarNames.
- PrevClassInstVarNames := nil.
- PrevClassVarNames := nil.
- PrevClass addDependent:Parser
- ].
+ (PrevInstVarNames isNil or:[PrevClass ~~ classToCompileFor]) ifTrue:[
+ PrevClass notNil ifTrue:[
+ PrevClass removeDependent:Parser
+ ].
+ PrevClass := classToCompileFor.
+ PrevInstVarNames := classToCompileFor allInstVarNames.
+ PrevClassInstVarNames := nil.
+ PrevClassVarNames := nil.
+ PrevClass addDependent:Parser
+ ].
- instIndex := PrevInstVarNames indexOf:varName startingAt:1.
- instIndex ~~ 0 ifTrue:[
- usedInstVars isNil ifTrue:[
- usedInstVars := OrderedCollection with:varName
- ] ifFalse:[
- (usedInstVars includes:varName) ifFalse:[
- usedInstVars add:varName
- ]
- ].
- usedVars isNil ifTrue:[
- usedVars := OrderedCollection with:varName
- ] ifFalse:[
- (usedVars includes:varName) ifFalse:[
- usedVars add:varName
- ]
- ].
- ^ VariableNode type:#InstanceVariable
- name:varName
- index:instIndex
- selfValue:selfValue
- ]
+ instIndex := PrevInstVarNames indexOf:varName startingAt:1.
+ instIndex ~~ 0 ifTrue:[
+ usedInstVars isNil ifTrue:[
+ usedInstVars := OrderedCollection with:varName
+ ] ifFalse:[
+ (usedInstVars includes:varName) ifFalse:[
+ usedInstVars add:varName
+ ]
+ ].
+ usedVars isNil ifTrue:[
+ usedVars := OrderedCollection with:varName
+ ] ifFalse:[
+ (usedVars includes:varName) ifFalse:[
+ usedVars add:varName
+ ]
+ ].
+ ^ VariableNode type:#InstanceVariable
+ name:varName
+ index:instIndex
+ selfValue:selfValue
+ ]
].
"is it a class-instance-variable ?"
classToCompileFor notNil ifTrue:[
- PrevClassInstVarNames isNil ifTrue:[
- PrevClassInstVarNames := classToCompileFor class allInstVarNames
- ].
+ PrevClassInstVarNames isNil ifTrue:[
+ PrevClassInstVarNames := classToCompileFor class allInstVarNames
+ ].
- instIndex := PrevClassInstVarNames indexOf:varName startingAt:1.
- instIndex ~~ 0 ifTrue:[
- aClass := self inWhichClassIsClassInstVar:varName.
- aClass notNil ifTrue:[
- usedVars isNil ifTrue:[
- usedVars := OrderedCollection with:varName
- ] ifFalse:[
- (usedVars includes:varName) ifFalse:[
- usedVars add:varName
- ]
- ].
- ^ VariableNode type:#ClassInstanceVariable
- name:varName
- index:instIndex
- selfClass:aClass
- ]
- ]
+ instIndex := PrevClassInstVarNames indexOf:varName startingAt:1.
+ instIndex ~~ 0 ifTrue:[
+ aClass := self inWhichClassIsClassInstVar:varName.
+ aClass notNil ifTrue:[
+ usedVars isNil ifTrue:[
+ usedVars := OrderedCollection with:varName
+ ] ifFalse:[
+ (usedVars includes:varName) ifFalse:[
+ usedVars add:varName
+ ]
+ ].
+ ^ VariableNode type:#ClassInstanceVariable
+ name:varName
+ index:instIndex
+ selfClass:aClass
+ ]
+ ]
].
"is it a class-variable ?"
classToCompileFor notNil ifTrue:[
- PrevClassVarNames isNil ifTrue:[
- aClass := classToCompileFor.
- classToCompileFor isMeta ifTrue:[
- className := aClass name.
- className := className copyTo:(className size - 5).
- aClass := Smalltalk at:(className asSymbol).
- aClass isNil ifTrue:[
- aClass := classToCompileFor
- ]
- ].
- PrevClassVarNames := aClass allClassVarNames
- ].
+ PrevClassVarNames isNil ifTrue:[
+ aClass := classToCompileFor.
+ classToCompileFor isMeta ifTrue:[
+ className := aClass name.
+ className := className copyTo:(className size - 5).
+ aClass := Smalltalk at:(className asSymbol).
+ aClass isNil ifTrue:[
+ aClass := classToCompileFor
+ ]
+ ].
+ PrevClassVarNames := aClass allClassVarNames
+ ].
- instIndex := PrevClassVarNames indexOf:varName startingAt:1.
- instIndex ~~ 0 ifTrue:[
- aClass := self inWhichClassIsClassVar:varName.
- aClass notNil ifTrue:[
- usedClassVars isNil ifTrue:[
- usedClassVars := OrderedCollection with:varName
- ] ifFalse:[
- (usedClassVars includes:varName) ifFalse:[
- usedClassVars add:varName
- ].
- ].
- usedVars isNil ifTrue:[
- usedVars := OrderedCollection with:varName
- ] ifFalse:[
- (usedVars includes:varName) ifFalse:[
- usedVars add:varName
- ].
- ].
- ^ VariableNode type:#ClassVariable
- name:(aClass name , ':' , varName) asSymbol
- ]
- ]
+ instIndex := PrevClassVarNames indexOf:varName startingAt:1.
+ instIndex ~~ 0 ifTrue:[
+ aClass := self inWhichClassIsClassVar:varName.
+ aClass notNil ifTrue:[
+ usedClassVars isNil ifTrue:[
+ usedClassVars := OrderedCollection with:varName
+ ] ifFalse:[
+ (usedClassVars includes:varName) ifFalse:[
+ usedClassVars add:varName
+ ].
+ ].
+ usedVars isNil ifTrue:[
+ usedVars := OrderedCollection with:varName
+ ] ifFalse:[
+ (usedVars includes:varName) ifFalse:[
+ usedVars add:varName
+ ].
+ ].
+ ^ VariableNode type:#ClassVariable
+ name:(aClass name , ':' , varName) asSymbol
+ ]
+ ]
].
"is it a global-variable ?"
tokenSymbol := varName asSymbol.
(Smalltalk includesKey:tokenSymbol) ifTrue:[
- usedVars isNil ifTrue:[
- usedVars := OrderedCollection with:varName
- ] ifFalse:[
- (usedVars includes:varName) ifFalse:[
- usedVars add:varName
- ]
- ].
- ^ VariableNode type:#GlobalVariable name:tokenSymbol
+ usedVars isNil ifTrue:[
+ usedVars := OrderedCollection with:varName
+ ] ifFalse:[
+ (usedVars includes:varName) ifFalse:[
+ usedVars add:varName
+ ]
+ ].
+ ^ VariableNode type:#GlobalVariable name:tokenSymbol
].
^ #Error
!
@@ -1872,16 +1893,16 @@
aClass := classToCompileFor.
aClass isMeta ifTrue:[
- className := aClass name.
- className := className copyTo:(className size - 5).
- baseClass := Smalltalk at:(className asSymbol).
- baseClass notNil ifTrue:[
- aClass := baseClass
- ]
+ className := aClass name.
+ className := className copyTo:(className size - 5).
+ baseClass := Smalltalk at:(className asSymbol).
+ baseClass notNil ifTrue:[
+ aClass := baseClass
+ ]
].
[aClass notNil] whileTrue:[
- (aClass classVarNames includes:aString) ifTrue:[ ^ aClass].
- aClass := aClass superclass
+ (aClass classVarNames includes:aString) ifTrue:[ ^ aClass].
+ aClass := aClass superclass
].
^ nil
!
@@ -1894,8 +1915,8 @@
aClass := classToCompileFor.
[aClass notNil] whileTrue:[
- (aClass class instVarNames includes:aString) ifTrue:[ ^ aClass].
- aClass := aClass superclass
+ (aClass class instVarNames includes:aString) ifTrue:[ ^ aClass].
+ aClass := aClass superclass
].
^ nil
!
@@ -1908,44 +1929,44 @@
lno := tokenLineNr.
self nextToken.
(tokenType == $: ) ifTrue:[
- [tokenType == $:] whileTrue:[
- pos := tokenPosition.
- self nextToken.
- (tokenType == #Identifier) ifFalse:[
- self syntaxError:'Identifier expected in block-arg declaration'
- position:pos to:tokenPosition-1.
- ^ #Error
- ].
- arg := Variable name:tokenName.
- args isNil ifTrue:[
- args := Array with:arg.
- argNames := Array with:tokenName.
- ] ifFalse:[
- (argNames includes:tokenName) ifTrue:[
- self syntaxError:'redefinition of ''' , tokenName , ''' in argument list.'
- position:tokenPosition
- to:(tokenPosition + tokenName size - 1)
- ].
- args := args copyWith:arg.
- argNames := argNames copyWith:tokenName.
- ].
- self nextToken
- ].
- (tokenType ~~ $| ) ifTrue:[
- "ST-80 allows [:arg ]"
- (tokenType == $] ) ifTrue:[
- node := BlockNode arguments:args home:currentBlock variables:nil.
- node lineNumber:lno.
- ^ node
- ].
- self syntaxError:'| expected after block-arg declaration'.
- ^ #Error
- ].
- self nextToken
+ [tokenType == $:] whileTrue:[
+ pos := tokenPosition.
+ self nextToken.
+ (tokenType == #Identifier) ifFalse:[
+ self syntaxError:'Identifier expected in block-arg declaration'
+ position:pos to:tokenPosition-1.
+ ^ #Error
+ ].
+ arg := Variable name:tokenName.
+ args isNil ifTrue:[
+ args := Array with:arg.
+ argNames := Array with:tokenName.
+ ] ifFalse:[
+ (argNames includes:tokenName) ifTrue:[
+ self syntaxError:'redefinition of ''' , tokenName , ''' in argument list.'
+ position:tokenPosition
+ to:(tokenPosition + tokenName size - 1)
+ ].
+ args := args copyWith:arg.
+ argNames := argNames copyWith:tokenName.
+ ].
+ self nextToken
+ ].
+ (tokenType ~~ $| ) ifTrue:[
+ "ST-80 allows [:arg ]"
+ (tokenType == $] ) ifTrue:[
+ node := BlockNode arguments:args home:currentBlock variables:nil.
+ node lineNumber:lno.
+ ^ node
+ ].
+ self syntaxError:'| expected after block-arg declaration'.
+ ^ #Error
+ ].
+ self nextToken
].
node := self blockBody:args.
(node notNil and:[node ~~ #Error]) ifTrue:[
- node lineNumber:lno.
+ node lineNumber:lno.
].
^ node
!
@@ -1957,22 +1978,22 @@
lno := tokenLineNr.
(tokenType == $| ) ifTrue:[
- self nextToken.
- pos := tokenPosition.
- [tokenType == $|] whileFalse:[
- (tokenType == #Identifier) ifFalse:[
- self syntaxError:'Identifier expected in block-var declaration' position:pos.
- ^ #Error
- ].
- var := Variable name:tokenName.
- vars isNil ifTrue:[
- vars := Array with:var
- ] ifFalse:[
- vars := vars copyWith:var
- ].
- self nextToken
- ].
- self nextToken
+ self nextToken.
+ pos := tokenPosition.
+ [tokenType == $|] whileFalse:[
+ (tokenType == #Identifier) ifFalse:[
+ self syntaxError:'Identifier expected in block-var declaration' position:pos.
+ ^ #Error
+ ].
+ var := Variable name:tokenName.
+ vars isNil ifTrue:[
+ vars := Array with:var
+ ] ifFalse:[
+ vars := vars copyWith:var
+ ].
+ self nextToken
+ ].
+ self nextToken
].
node := BlockNode arguments:args home:currentBlock variables:vars.
node lineNumber:lno.
@@ -1994,31 +2015,31 @@
(thisStatement == #Error) ifTrue:[^ #Error].
firstStatement := thisStatement.
[tokenType == $] ] whileFalse:[
- (tokenType == $.) ifFalse:[
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'missing '']'' in block'
- ] ifFalse:[
- self syntaxError:'missing ''.'' in block'
- ].
- ^ #Error
- ] ifTrue:[
- prevStatement := thisStatement.
- self nextToken.
- tokenType == $] ifTrue:[
+ (tokenType == $.) ifFalse:[
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'missing '']'' in block'
+ ] ifFalse:[
+ self syntaxError:'missing ''.'' in block'
+ ].
+ ^ #Error
+ ] ifTrue:[
+ prevStatement := thisStatement.
+ self nextToken.
+ tokenType == $] ifTrue:[
"
- *** I had a warning here (since it was not defined
- *** in the blue-book; but PD-code contains a lot of
- *** code with periods at the end so that the warnings
- *** became annoying
+ *** I had a warning here (since it was not defined
+ *** in the blue-book; but PD-code contains a lot of
+ *** code with periods at the end so that the warnings
+ *** became annoying
- self warning:'period after last statement in block'.
+ self warning:'period after last statement in block'.
"
- ^ firstStatement
- ].
- thisStatement := self statement.
- (thisStatement == #Error) ifTrue:[^ #Error].
- prevStatement nextStatement:thisStatement
- ]
+ ^ firstStatement
+ ].
+ thisStatement := self statement.
+ (thisStatement == #Error) ifTrue:[^ #Error].
+ prevStatement nextStatement:thisStatement
+ ]
].
^ firstStatement
!
@@ -2029,16 +2050,16 @@
pos1 := tokenPosition.
arr := OrderedCollection new:20.
[tokenType ~~ $) ] whileTrue:[
- elem := self arrayConstant.
- (elem == #Error) ifTrue:[
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'unterminated array-constant; '')'' expected'
- position:pos1 to:tokenPosition
- ].
- ^ #Error
- ].
- arr add:elem.
- self nextToken
+ elem := self arrayConstant.
+ (elem == #Error) ifTrue:[
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'unterminated array-constant; '')'' expected'
+ position:pos1 to:tokenPosition
+ ].
+ ^ #Error
+ ].
+ arr add:elem.
+ self nextToken
].
^ Array withAll:arr
!
@@ -2051,95 +2072,95 @@
pos1 := tokenPosition.
arr := OrderedCollection new:50.
[tokenType ~~ $] ] whileTrue:[
- pos2 := tokenPosition.
- elem := self arrayConstant.
- (elem == #Error) ifTrue:[
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'unterminated bytearray-constant; '']'' expected'
- position:pos1 to:tokenPosition
- ].
- ^ #Error
- ].
- ((elem isMemberOf:SmallInteger) and:
- [(elem >= 0) and:[elem <= 255]]) ifTrue:[
- arr add:elem
- ] ifFalse:[
- self parseError:'invalid ByteArray element' position:pos2 to:tokenPosition - 1
- ].
- self nextToken
+ pos2 := tokenPosition.
+ elem := self arrayConstant.
+ (elem == #Error) ifTrue:[
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'unterminated bytearray-constant; '']'' expected'
+ position:pos1 to:tokenPosition
+ ].
+ ^ #Error
+ ].
+ ((elem isMemberOf:SmallInteger) and:
+ [(elem >= 0) and:[elem <= 255]]) ifTrue:[
+ arr add:elem
+ ] ifFalse:[
+ self parseError:'invalid ByteArray element' position:pos2 to:tokenPosition - 1
+ ].
+ self nextToken
].
^ ByteArray withAll:arr
!
arrayConstant
(tokenType == #String) ifTrue:[
- ^ tokenValue
+ ^ tokenValue
].
(tokenType == #Nil) ifTrue:[
- ^ nil
+ ^ nil
].
(tokenType == #Integer) ifTrue:[
- ^ tokenValue
+ ^ tokenValue
].
(tokenType == #Character) ifTrue:[
- ^ tokenValue
+ ^ tokenValue
].
(tokenType == #Float) ifTrue:[
- ^ tokenValue
+ ^ tokenValue
].
(tokenType == #True) ifTrue:[
- ^ true
+ ^ true
].
(tokenType == #False) ifTrue:[
- ^ false
+ ^ false
].
(tokenType == #Error) ifTrue:[
- ^ #Error
+ ^ #Error
].
(tokenType == #BinaryOperator) ifTrue:[
- ^ tokenName asSymbol
+ ^ tokenName asSymbol
].
(tokenType == #Keyword) ifTrue:[
- ^ tokenName asSymbol
+ ^ tokenName asSymbol
].
(tokenType == #Identifier) ifTrue:[
- ^ tokenName asSymbol
+ ^ tokenName asSymbol
].
(tokenType == $() ifTrue:[
- self nextToken.
- ^ self array
+ self nextToken.
+ ^ self array
].
(tokenType == $[) ifTrue:[
- self nextToken.
- ^ self byteArray
+ self nextToken.
+ ^ self byteArray
].
(tokenType == #Symbol) ifTrue:[
"
- self warning:'no # for symbols within array-constants'.
+ self warning:'no # for symbols within array-constants'.
"
- ^ tokenValue
+ ^ tokenValue
].
(tokenType == #HashLeftParen) ifTrue:[
"
- self warning:'no # for arrays within array-constants'.
+ self warning:'no # for arrays within array-constants'.
"
- self nextToken.
- ^ self array
+ self nextToken.
+ ^ self array
].
(tokenType == #HashLeftBrack) ifTrue:[
"
- self warning:'no # for arrays within array-constants'.
+ self warning:'no # for arrays within array-constants'.
"
- self nextToken.
- ^ self byteArray
+ self nextToken.
+ ^ self byteArray
].
(tokenType == #EOF) ifTrue:[
- "just for the better error-hilight; let caller handle error"
- ^ #Error
+ "just for the better error-hilight; let caller handle error"
+ ^ #Error
].
self syntaxError:('error in array-constant; '
- , tokenType printString
- , ' unexpected').
+ , tokenType printString
+ , ' unexpected').
^ #Error
! !
@@ -2178,124 +2199,124 @@
"block arguments"
searchBlock := currentBlock.
[searchBlock notNil] whileTrue:[
- args := searchBlock arguments.
- args notNil ifTrue:[
- args do:[:aBlockArg |
- names add:(aBlockArg name).
- dists add:(aString spellAgainst: "levenshteinTo:"(aBlockArg name))
- ]
- ].
+ args := searchBlock arguments.
+ args notNil ifTrue:[
+ args do:[:aBlockArg |
+ names add:(aBlockArg name).
+ dists add:(aString spellAgainst: "levenshteinTo:"(aBlockArg name))
+ ]
+ ].
- vars := searchBlock variables.
- vars notNil ifTrue:[
- vars do:[:aBlockVar |
- names add:(aBlockVar name).
- dists add:(aString spellAgainst: "levenshteinTo:"(aBlockVar name))
- ]
- ].
- searchBlock := searchBlock home
+ vars := searchBlock variables.
+ vars notNil ifTrue:[
+ vars do:[:aBlockVar |
+ names add:(aBlockVar name).
+ dists add:(aString spellAgainst: "levenshteinTo:"(aBlockVar name))
+ ]
+ ].
+ searchBlock := searchBlock home
].
"method-variables"
methodVars notNil ifTrue:[
- methodVarNames do:[:methodVarName |
- names add:methodVarName.
- dists add:(aString spellAgainst: "levenshteinTo:"methodVarName)
- ]
+ methodVarNames do:[:methodVarName |
+ names add:methodVarName.
+ dists add:(aString spellAgainst: "levenshteinTo:"methodVarName)
+ ]
].
"method-arguments"
methodArgs notNil ifTrue:[
- methodArgNames do:[:methodArgName |
- names add:methodArgName.
- dists add:(aString spellAgainst: "levenshteinTo:"methodArgName)
- ]
+ methodArgNames do:[:methodArgName |
+ names add:methodArgName.
+ dists add:(aString spellAgainst: "levenshteinTo:"methodArgName)
+ ]
].
"instance-variables"
classToCompileFor notNil ifTrue:[
- PrevInstVarNames do:[:instVarName |
- names add:instVarName.
- dists add:(aString spellAgainst: "levenshteinTo:"instVarName)
- ]
+ PrevInstVarNames do:[:instVarName |
+ names add:instVarName.
+ dists add:(aString spellAgainst: "levenshteinTo:"instVarName)
+ ]
].
"class-variables"
classToCompileFor notNil ifTrue:[
- PrevClassVarNames do:[:classVarName |
- names add:classVarName.
- dists add:(aString spellAgainst: "levenshteinTo:"classVarName)
- ].
+ PrevClassVarNames do:[:classVarName |
+ names add:classVarName.
+ dists add:(aString spellAgainst: "levenshteinTo:"classVarName)
+ ].
false ifTrue:[
- aClass := classToCompileFor.
- aClass isMeta ifTrue:[
- className := aClass name.
- className := className copyTo:(className size - 5).
- baseClass := Smalltalk at:(className asSymbol).
- baseClass notNil ifTrue:[
- aClass := baseClass
- ]
- ].
- [aClass notNil] whileTrue:[
- (aClass classVarNames) do:[:classVarName |
- names add:classVarName.
- dists add:(aString spellAgainst: "levenshteinTo:"classVarName)
- ].
- aClass := aClass superclass
- ]
+ aClass := classToCompileFor.
+ aClass isMeta ifTrue:[
+ className := aClass name.
+ className := className copyTo:(className size - 5).
+ baseClass := Smalltalk at:(className asSymbol).
+ baseClass notNil ifTrue:[
+ aClass := baseClass
+ ]
+ ].
+ [aClass notNil] whileTrue:[
+ (aClass classVarNames) do:[:classVarName |
+ names add:classVarName.
+ dists add:(aString spellAgainst: "levenshteinTo:"classVarName)
+ ].
+ aClass := aClass superclass
+ ]
].
].
"globals"
Smalltalk allKeysDo:[:aKey |
- globalVarName := aKey asString.
- "only compare strings where length is about right"
- ((globalVarName size - aString size) abs < 3) ifTrue:[
- names add:globalVarName.
- dists add:(aString spellAgainst: "levenshteinTo:"globalVarName)
- ]
+ globalVarName := aKey asString.
+ "only compare strings where length is about right"
+ ((globalVarName size - aString size) abs < 3) ifTrue:[
+ names add:globalVarName.
+ dists add:(aString spellAgainst: "levenshteinTo:"globalVarName)
+ ]
].
"misc"
#('self' 'super' 'nil' 'thisContext') do:[:name |
- names add:name.
- dists add:(aString spellAgainst: "levenshteinTo:"name)
+ names add:name.
+ dists add:(aString spellAgainst: "levenshteinTo:"name)
].
(dists size ~~ 0) ifTrue:[
- dists sortWith:names.
- dists := dists reverse.
- names := names reverse.
- n := names size min:10.
- names := names copyTo:n.
+ dists sortWith:names.
+ dists := dists reverse.
+ names := names reverse.
+ n := names size min:10.
+ names := names copyTo:n.
- "if it starts with a lower case character, add all local & instvar names"
- (aString at:1) isLowercase ifTrue:[
- methodVarNames size > 0 ifTrue:[
- names add:'---- method locals ----'.
- methodVarNames do:[:methodVarName |
- names add:methodVarName.
- ].
- ].
+ "if it starts with a lower case character, add all local & instvar names"
+ (aString at:1) isLowercase ifTrue:[
+ methodVarNames size > 0 ifTrue:[
+ names add:'---- method locals ----'.
+ methodVarNames do:[:methodVarName |
+ names add:methodVarName.
+ ].
+ ].
- methodArgs notNil ifTrue:[
- names add:'---- method arguments ----'.
- methodArgNames do:[:methodArgName |
- names add:methodArgName.
- ]
- ].
+ methodArgs notNil ifTrue:[
+ names add:'---- method arguments ----'.
+ methodArgNames do:[:methodArgName |
+ names add:methodArgName.
+ ]
+ ].
- names add:'---- instance variables ----'.
- PrevInstVarNames do:[:instVarName |
- (names includes:instVarName) ifFalse:[
- names add:instVarName.
- ]
- ]
- ].
+ names add:'---- instance variables ----'.
+ PrevInstVarNames do:[:instVarName |
+ (names includes:instVarName) ifFalse:[
+ names add:instVarName.
+ ]
+ ]
+ ].
- ^ names
+ ^ names
].
^ nil
!
@@ -2313,36 +2334,36 @@
"OLD:
(varName at:1) isLowercase ifTrue:[
- correctIt := self undefError:varName position:pos1 to:pos2.
- correctIt ifFalse:[^ #Error]
+ correctIt := self undefError:varName position:pos1 to:pos2.
+ correctIt ifFalse:[^ #Error]
] ifFalse:[
- correctIt := self warning:(varName , ' is undefined') position:pos1 to:pos2.
- correctIt ifFalse:[
- ^ VariableNode type:#GlobalVariable name:(varName asSymbol)
- ]
+ correctIt := self warning:(varName , ' is undefined') position:pos1 to:pos2.
+ correctIt ifFalse:[
+ ^ VariableNode type:#GlobalVariable name:(varName asSymbol)
+ ]
].
"
correctIt := self undefError:varName position:pos1 to:pos2.
correctIt ifFalse:[
- (varName at:1) isLowercase ifTrue:[
- ^ #Error
- ] ifFalse:[
- ^ VariableNode type:#GlobalVariable name:(varName asSymbol)
- ]
+ (varName at:1) isLowercase ifTrue:[
+ ^ #Error
+ ] ifFalse:[
+ ^ VariableNode type:#GlobalVariable name:(varName asSymbol)
+ ]
].
suggestedNames := self findBestVariablesFor:varName.
suggestedNames notNil ifTrue:[
- newName := self askForCorrection:'correct variable to: ' fromList:suggestedNames.
- newName isNil ifTrue:[^ #Error].
+ newName := self askForCorrection:'correct variable to: ' fromList:suggestedNames.
+ newName isNil ifTrue:[^ #Error].
"
- newName := suggestedNames at:1.
- (self confirm:('confirm correction to: ' , newName)) ifFalse:[^ #Error]
+ newName := suggestedNames at:1.
+ (self confirm:('confirm correction to: ' , newName)) ifFalse:[^ #Error]
"
] ifFalse:[
- self notify:'no good correction found'.
- ^ #Error
+ self notify:'no good correction found'.
+ ^ #Error
].
"
@@ -2368,7 +2389,7 @@
|box|
ListSelectionBox isNil ifTrue:[
- ^ self confirm:aString
+ ^ self confirm:aString
].
box := ListSelectionBox new.
box title:aString.
@@ -2392,16 +2413,16 @@
n := 0.
Symbol allInstancesDo:[:sym |
- |dist|
+ |dist|
- dist := aString spellAgainst:sym.
- dist > 20 ifTrue:[
- info add:(sym -> dist).
- n := n + 1.
- n > 10 ifTrue:[
- info removeLast.
- ]
- ]
+ dist := aString spellAgainst:sym.
+ dist > 20 ifTrue:[
+ info add:(sym -> dist).
+ n := n + 1.
+ n > 10 ifTrue:[
+ info removeLast.
+ ]
+ ]
].
^ info asOrderedCollection collect:[:a | a key]
@@ -2423,8 +2444,8 @@
currently (too much work - maybe Ill do it later when everything else works :-)
"
(aSelectorString occurrencesOf:$:) > 1 ifTrue:[
- self warning:msg position:pos1 to:pos2.
- ^ aSelectorString
+ self warning:msg position:pos1 to:pos2.
+ ^ aSelectorString
].
correctIt := self correctableError:msg position:pos1 to:pos2.
@@ -2432,11 +2453,11 @@
suggestedNames := self findBestSelectorsFor:aSelectorString.
suggestedNames notNil ifTrue:[
- newSelector := self askForCorrection:'correct selector to: ' fromList:suggestedNames.
- newSelector isNil ifTrue:[^ aSelectorString].
+ newSelector := self askForCorrection:'correct selector to: ' fromList:suggestedNames.
+ newSelector isNil ifTrue:[^ aSelectorString].
] ifFalse:[
- self notify:'no good correction found'.
- ^ aSelectorString
+ self notify:'no good correction found'.
+ ^ aSelectorString
].
"
@@ -2471,55 +2492,55 @@
"
ok := aSelectorString knownAsSymbol.
ok ifTrue:[
- sym := aSelectorString asSymbol.
- receiver notNil ifTrue:[
- "
- if the receiver is a constant, we can check if it responds
- to this selector
- "
- receiver isConstant ifTrue:[
- ok := receiver evaluate respondsTo:sym.
- err := ' will not be understood here'.
- ] ifFalse:[
- "
- if the receiver is a global, we check it too ...
- "
- receiver type == #GlobalVariable ifTrue:[
- ok := receiver evaluate respondsTo:sym.
- err := ' may not be understood here'.
- ] ifFalse:[
- aSelectorString nArgsIfSelector == 0 ifTrue:[
- "
- if the (unary) selector is the name of a variable,
- check more (usually, there is a missing '.' somewhere)
- "
- err := ' is currently nowhere implemented (''.'' missing ?)'.
- node := self variableOrError:aSelectorString.
- node ~~ #Error ifTrue:[
- "
- ok, its known as variable too ...
- "
- ok := false.
- Smalltalk allClassesDo:[:aClass |
- ok := ok or:[aClass implements:sym]
- ].
- ]
- ]
- ]
- ]
- ]
+ sym := aSelectorString asSymbol.
+ receiver notNil ifTrue:[
+ "
+ if the receiver is a constant, we can check if it responds
+ to this selector
+ "
+ receiver isConstant ifTrue:[
+ ok := receiver evaluate respondsTo:sym.
+ err := ' will not be understood here'.
+ ] ifFalse:[
+ "
+ if the receiver is a global, we check it too ...
+ "
+ receiver type == #GlobalVariable ifTrue:[
+ ok := receiver evaluate respondsTo:sym.
+ err := ' may not be understood here'.
+ ] ifFalse:[
+ aSelectorString numArgs == 0 ifTrue:[
+ "
+ if the (unary) selector is the name of a variable,
+ check more (usually, there is a missing '.' somewhere)
+ "
+ err := ' is currently nowhere implemented (''.'' missing ?)'.
+ node := self variableOrError:aSelectorString.
+ node ~~ #Error ifTrue:[
+ "
+ ok, its known as variable too ...
+ "
+ ok := false.
+ Smalltalk allClassesDo:[:aClass |
+ ok := ok or:[aClass implements:sym]
+ ].
+ ]
+ ]
+ ]
+ ]
+ ]
].
ok ifFalse:[
"OLD: "
- self warning:('#' , aSelectorString , err) position:pos1 to:pos2
+ self warning:('#' , aSelectorString , err) position:pos1 to:pos2
" "
"NEW: - not finished - need more interfaces
(currently produces warning output on Transcript while filing in
- ^ self correctSelector:aSelectorString message:('#' , aSelectorString , err) position:pos1 to:pos2
+ ^ self correctSelector:aSelectorString message:('#' , aSelectorString , err) position:pos1 to:pos2
"
].
^ aSelectorString