--- a/Parser.st Wed Oct 15 13:14:37 1997 +0200
+++ b/Parser.st Wed Oct 15 13:14:50 1997 +0200
@@ -10,7 +10,7 @@
hereby transferred.
"
-'From Smalltalk/X, Version:3.1.9 on 7-sep-1997 at 2:21:11 pm' !
+'From Smalltalk/X, Version:3.2.1 on 14-oct-1997 at 11:12:53 pm' !
Scanner subclass:#Parser
instanceVariableNames:'classToCompileFor selfValue contextToEvaluateIn selector
@@ -26,7 +26,7 @@
classVariableNames:'PrevClass PrevInstVarNames PrevClassVarNames
PrevClassInstVarNames LazyCompilation ArraysAreImmutable
ImplicitSelfSends WarnST80Directives FoldConstants LineNumberInfo
- SuppressDoItCompilation'
+ SuppressDoItCompilation EmptySourceNotificationSignal'
poolDictionaries:''
category:'System-Compiler'
!
@@ -55,11 +55,11 @@
the (planned) MachineCodeCompiler.
methods of main interest 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.
@@ -109,108 +109,108 @@
[Instance variables:]
- classToCompileFor <Class> the class (or nil) we are compiling for
-
- selfValue <any> value to use as self when interpreting
-
- contextToEvaluateIn <Context> the context (or nil) when interpreting
-
- selector <Symbol> the selector of the parsed method
- (valid after parseMethodSpecification)
- methodArgs internal
-
- methodArgNames <Collection> the names of the arguments
- (valid after parseMethodSpecification)
-
- methodVars internal
-
- methodVarNames <Collection> the names of the method locals
- (valid after parseMethodBodyVarSpec)
-
- tree <ParseTree> the parse tree - valid after parsing
-
- currentBlock if currently parsing for a block
-
- usedInstVars set of all accessed instances variables
- (valid after parsing)
-
- usedClassVars same for classVars
-
- usedVars all used variables (inst, class & globals)
-
- modifiedInstVars set of all modified instance variables
-
- 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
-
- evalExitBlock internal for interpretation
-
- 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
- hasNonOptionalPrimitiveCode
- <Boolean> true, if it contains ST/X style primitive code
- which is NOT flagged by the OPTIONAL directive.
-
- primitiveNr <Integer> the parsed ST-80 type primitive number (or nil)
-
- logged
-
- warnedUndefVars <Set> set of all variables which the parser has
- already output a warning (to avoid multiple
- warnings about the same variable)
+ classToCompileFor <Class> the class (or nil) we are compiling for
+
+ selfValue <any> value to use as self when interpreting
+
+ contextToEvaluateIn <Context> the context (or nil) when interpreting
+
+ selector <Symbol> the selector of the parsed method
+ (valid after parseMethodSpecification)
+ methodArgs internal
+
+ methodArgNames <Collection> the names of the arguments
+ (valid after parseMethodSpecification)
+
+ methodVars internal
+
+ methodVarNames <Collection> the names of the method locals
+ (valid after parseMethodBodyVarSpec)
+
+ tree <ParseTree> the parse tree - valid after parsing
+
+ currentBlock if currently parsing for a block
+
+ usedInstVars set of all accessed instances variables
+ (valid after parsing)
+
+ usedClassVars same for classVars
+
+ usedVars all used variables (inst, class & globals)
+
+ modifiedInstVars set of all modified instance variables
+
+ 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
+
+ evalExitBlock internal for interpretation
+
+ 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
+ hasNonOptionalPrimitiveCode
+ <Boolean> true, if it contains ST/X style primitive code
+ which is NOT flagged by the OPTIONAL directive.
+
+ primitiveNr <Integer> the parsed ST-80 type primitive number (or nil)
+
+ logged
+
+ 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:
-
- 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
-
- ArraysAreImmutable <Boolean> if true, create array literals
- as instances of ImmutableArray,
- which cannot be stored into.
- Default is false, for compatibility.
- Can be turned on while developping
- new code to make certain that side
- effects are avoided.
-
- WarnST80Directives <Boolean> if true, give warnings about
- ST-80 directives (resource defs)
- which are ignored in st/x.
- defaults to false.
-
- FoldConstants <Symbol> controls how constant folding should be
- done.
- Can be one of:
- nil - no constant folding
- #level1 - numeric optimizations only
- #level2 - secure optimizations only
- #full - full folding
-
- level1: arithmetic on constant numbers
-
- level2: above PLUS array conversions with #asFloatArray,
- #asDoubleArray, string concatenation
-
- full: constant points.
+ 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
+
+ LazyCompilation <Boolean> EXPERIMENTAL: lazy compilation
+
+ ArraysAreImmutable <Boolean> if true, create array literals
+ as instances of ImmutableArray,
+ which cannot be stored into.
+ Default is false, for compatibility.
+ Can be turned on while developping
+ new code to make certain that side
+ effects are avoided.
+
+ WarnST80Directives <Boolean> if true, give warnings about
+ ST-80 directives (resource defs)
+ which are ignored in st/x.
+ defaults to false.
+
+ FoldConstants <Symbol> controls how constant folding should be
+ done.
+ Can be one of:
+ nil - no constant folding
+ #level1 - numeric optimizations only
+ #level2 - secure optimizations only
+ #full - full folding
+
+ level1: arithmetic on constant numbers
+
+ level2: above PLUS array conversions with #asFloatArray,
+ #asDoubleArray, string concatenation
+
+ full: constant points.
[see also:]
- ByteCodeCompiler Scanner ObjectFileLoader
- Workspace
- SystemBrowser
+ ByteCodeCompiler Scanner ObjectFileLoader
+ Workspace
+ SystemBrowser
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
@@ -240,6 +240,14 @@
"Modified: 19.6.1997 / 16:34:57 / cg"
! !
+!Parser class methodsFor:'Signal constants'!
+
+emptySourceNotificationSignal
+ ^ EmptySourceNotificationSignal
+
+ "Created: 14.10.1997 / 17:03:31 / cg"
+! !
+
!Parser class methodsFor:'changes'!
flushNameCache
@@ -324,10 +332,10 @@
foldConstants:aSymbol
"set the symbol describing how constants are to be folded.
It can be:
- nil - no constant folding
- #level1 - numeric constants only
- #level2 - level1 PLUS array conversions PLUS string concatenation
- #full - level2 PLUS constant points, constant rectangles (dangerous)"
+ nil - no constant folding
+ #level1 - numeric constants only
+ #level2 - level1 PLUS array conversions PLUS string concatenation
+ #full - level2 PLUS constant points, constant rectangles (dangerous)"
FoldConstants := aSymbol
@@ -481,12 +489,15 @@
|parser tree mustBackup loggedString chgStream value s sReal spc|
- aStringOrStream isNil ifTrue:[^ nil].
+ aStringOrStream isNil ifTrue:[
+ EmptySourceNotificationSignal raise.
+ ^ nil
+ ].
(mustBackup := aStringOrStream isStream) ifTrue:[
- s := aStringOrStream.
+ s := aStringOrStream.
] ifFalse:[
- loggedString := aStringOrStream.
- s := ReadStream on:aStringOrStream.
+ loggedString := aStringOrStream.
+ s := ReadStream on:aStringOrStream.
].
parser := self for:s.
parser parseForCode.
@@ -499,131 +510,134 @@
"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 isNil ifTrue:[
+ EmptySourceNotificationSignal raise.
+ ^ nil
+ ].
+
+ (logged
+ and:[loggedString notNil
+ and:[Smalltalk logDoits]]) ifTrue:[
+ Class updateChangeFileQuerySignal raise ifTrue:[
+ chgStream := Class changesStream.
+ chgStream notNil ifTrue:[
+ chgStream nextChunkPut:loggedString.
+ chgStream cr.
+ chgStream close
+ ]
+ ].
+ ].
+
+ "
+ during the evaluation, handle nameSpace queries
+ from the value as defined by any namespace directive.
+ This, if its a class definition expression, the class will
+ be installed there.
+ "
+ spc := parser getNameSpace.
+ spc isNil ifTrue:[
+ (requestor respondsTo:#currentNameSpace) ifTrue:[
+ spc := requestor currentNameSpace
+ ] ifFalse:[
+ spc := Class nameSpaceQuerySignal raise.
+ ]
].
- tree notNil ifTrue:[
- (logged
- and:[loggedString notNil
- and:[Smalltalk logDoits]]) ifTrue:[
- Class updateChangeFileQuerySignal raise ifTrue:[
- chgStream := Class changesStream.
- chgStream notNil ifTrue:[
- chgStream nextChunkPut:loggedString.
- chgStream cr.
- chgStream close
- ]
- ].
- ].
-
- "
- during the evaluation, handle nameSpace queries
- from the value as defined by any namespace directive.
- This, if its a class definition expression, the class will
- be installed there.
- "
- spc := parser getNameSpace.
- spc isNil ifTrue:[
- (requestor respondsTo:#currentNameSpace) ifTrue:[
- spc := requestor currentNameSpace
- ] ifFalse:[
- spc := Class nameSpaceQuerySignal raise.
- ]
- ].
-
- Class nameSpaceQuerySignal answer:spc
- do:[
- |method|
-
- "
- if compile is false, or the parse tree is that of a constant,
- or a variable, quickly return its value.
- This is used for example, when reading simple objects
- via #readFrom:.
- The overhead of compiling a method is avoided in this case.
- "
- ((SuppressDoItCompilation == true)
- or:[compile not
- or:[tree isConstant
- or:[tree isVariable
- or:[aStringOrStream isStream]]]]) ifTrue:[
- ^ tree evaluate
- ].
-
- "
- if I am the ByteCodeCompiler,
- generate a dummy method, execute it and return the value.
- otherwise, just evaluate the tree; slower, but not too bad ...
-
- This allows systems to be delivered without the ByteCodeCompiler,
- and still evaluate expressions
- (needed to read resource files or to process .rc files).
- "
- self == Parser ifTrue:[
- parser evalExitBlock:[:value | parser release. ^ value].
- value := tree evaluate.
- parser evalExitBlock:nil.
- ] ifFalse:[
- aStringOrStream isStream ifTrue:[
- s := parser collectedSource. "/ does not work yet ...
- ] ifFalse:[
- s := aStringOrStream
- ].
-
- "/ actually, its a block, to allow
- "/ easy return ...
-
- sReal := 'doIt ^[\' withCRs , s , '\] value' withCRs.
-
- method := self
- compile:sReal
- forClass:anObject class
- inCategory:'_temporary_'
- notifying:requestor
- install:false
- skipIfSame:false
- silent:true
- foldConstants:false.
-
- method notNil ifTrue:[
- method ~~ #Error ifTrue:[
- "
- fake: patch the source string, to what the user expects
- in the browser
- "
- method source:' \' withCRs , s .
- "
- dont do any just-in-time compilation on it.
- "
- method checked:true.
-
- value := method
- valueWithReceiver:anObject
- arguments:nil "/ (Array with:m)
- selector:#doIt "/ #doIt:
- search:nil
- sender:nil.
- ] ifFalse:[
- parser evalExitBlock:[:value | parser release. ^ value].
- value := tree evaluate.
- parser evalExitBlock:nil.
- ]
- ].
- ]
- ]
+ Class nameSpaceQuerySignal answer:spc
+ do:[
+ |method|
+
+ "
+ if compile is false, or the parse tree is that of a constant,
+ or a variable, quickly return its value.
+ This is used for example, when reading simple objects
+ via #readFrom:.
+ The overhead of compiling a method is avoided in this case.
+ "
+ ((SuppressDoItCompilation == true)
+ or:[compile not
+ or:[tree isConstant
+ or:[tree isVariable
+ or:[aStringOrStream isStream]]]]) ifTrue:[
+ ^ tree evaluate
+ ].
+
+ "
+ if I am the ByteCodeCompiler,
+ generate a dummy method, execute it and return the value.
+ otherwise, just evaluate the tree; slower, but not too bad ...
+
+ This allows systems to be delivered without the ByteCodeCompiler,
+ and still evaluate expressions
+ (needed to read resource files or to process .rc files).
+ "
+ self == Parser ifTrue:[
+ parser evalExitBlock:[:value | parser release. ^ value].
+ value := tree evaluate.
+ parser evalExitBlock:nil.
+ ] ifFalse:[
+ aStringOrStream isStream ifTrue:[
+ s := parser collectedSource. "/ does not work yet ...
+ ] ifFalse:[
+ s := aStringOrStream
+ ].
+
+ "/ actually, its a block, to allow
+ "/ easy return ...
+
+ sReal := 'doIt ^[\' withCRs , s , '\] value' withCRs.
+
+ method := self
+ compile:sReal
+ forClass:anObject class
+ inCategory:'_temporary_'
+ notifying:requestor
+ install:false
+ skipIfSame:false
+ silent:true
+ foldConstants:false.
+
+ method notNil ifTrue:[
+ method ~~ #Error ifTrue:[
+ "
+ fake: patch the source string, to what the user expects
+ in the browser
+ "
+ method source:' \' withCRs , s .
+ "
+ dont do any just-in-time compilation on it.
+ "
+ method checked:true.
+
+ value := method
+ valueWithReceiver:anObject
+ arguments:nil "/ (Array with:m)
+ selector:#doIt "/ #doIt:
+ search:nil
+ sender:nil.
+ ] ifFalse:[
+ parser evalExitBlock:[:value | parser release. ^ value].
+ value := tree evaluate.
+ parser evalExitBlock:nil.
+ ]
+ ].
+ ]
].
parser release.
^ value
"Created: 8.2.1997 / 19:34:44 / cg"
- "Modified: 31.8.1997 / 08:03:56 / cg"
+ "Modified: 14.10.1997 / 17:03:08 / cg"
!
evaluate:aStringOrStream logged:logged
@@ -685,13 +699,13 @@
anObject as self and to its instVars "
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:anObject
- notifying:nil
- logged:false
- ifFail:nil
- compile:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:nil
+ logged:false
+ ifFail:nil
+ compile:true
"
Compiler evaluate:'self x' receiver:(1 @ 2)
@@ -752,9 +766,17 @@
FoldConstants := #level1.
LineNumberInfo := false.
+ EmptySourceNotificationSignal isNil ifTrue:[
+ EmptySourceNotificationSignal := QuerySignal new mayProceed:true.
+ EmptySourceNotificationSignal notifierString:'empty source given to evaluate'.
+ EmptySourceNotificationSignal nameClass:self message:#emptySourceNotificationSignal.
+ ]
+
"
self initialize
"
+
+ "Modified: 14.10.1997 / 17:01:09 / cg"
! !
!Parser class methodsFor:'parsing'!
@@ -772,34 +794,34 @@
maxSoFar innerBlock m|
(line isNil or:[line == self maxLineNumber]) ifTrue:[
- ^ nil
+ ^ nil
].
aMethod notNil ifTrue:[
- m := aMethod.
- who := m who.
- who isNil ifTrue:[
- m isWrapped ifTrue:[
- m := m wrapper.
- m notNil ifTrue:[
- who := m who.
- ]
- ]
- ].
- who notNil ifTrue:[
- mClass := who methodClass.
- mClass isNil ifTrue:[ ^ nil].
- ].
-
- mSource := m source.
- mSource isNil ifTrue:[^ nil].
+ m := aMethod.
+ who := m who.
+ who isNil ifTrue:[
+ m isWrapped ifTrue:[
+ m := m wrapper.
+ m notNil ifTrue:[
+ who := m who.
+ ]
+ ]
+ ].
+ who notNil ifTrue:[
+ mClass := who methodClass.
+ mClass isNil ifTrue:[ ^ nil].
+ ].
+
+ mSource := m source.
+ mSource isNil ifTrue:[^ nil].
] ifFalse:[
- aString notNil ifTrue:[
- mSource := aString.
- mClass := UndefinedObject
- ] ifFalse:[
- ^ nil
- ]
+ aString notNil ifTrue:[
+ mSource := aString.
+ mClass := UndefinedObject
+ ] ifFalse:[
+ ^ nil
+ ]
].
"create a compiler, let it parse and create the parsetree"
@@ -812,61 +834,61 @@
compiler lineNumberInfo:#full.
aMethod notNil ifTrue:[
- (compiler parseMethodSpec == #Error) ifTrue:[
- ^ nil.
- ].
-
- who notNil ifTrue:[
- compiler selector ~~ (who methodSelector) ifTrue:[
- ^ nil
- ]
- ].
+ (compiler parseMethodSpec == #Error) ifTrue:[
+ ^ nil.
+ ].
+
+ who notNil ifTrue:[
+ compiler selector ~~ (who methodSelector) ifTrue:[
+ ^ nil
+ ]
+ ].
] ifFalse:[
- compiler nextToken.
+ compiler nextToken.
].
tree := compiler parseMethodBody.
(compiler errorFlag or:[tree == #Error]) ifTrue:[
- ^ nil
+ ^ nil
].
blocks := OrderedCollection new.
tree collectBlocksInto:blocks.
blocks := blocks select:[:aBlock |
- line between: aBlock lineNumber and:aBlock endLineNumber
-
- ].
+ line between: aBlock lineNumber and:aBlock endLineNumber
+
+ ].
blocks size == 1 ifTrue:[
- ^ blocks at:1
+ ^ blocks at:1
].
nA notNil ifTrue:[
- blocks := blocks select:[:aBlock |
- aBlock numArgs == nA
- ].
- blocks size == 1 ifTrue:[
- ^ blocks at:1
- ].
+ blocks := blocks select:[:aBlock |
+ aBlock numArgs == nA
+ ].
+ blocks size == 1 ifTrue:[
+ ^ blocks at:1
+ ].
].
nV notNil ifTrue:[
- blocks := blocks select:[:aBlock |
- aBlock numVars == nV
- ].
- blocks size == 1 ifTrue:[
- ^ blocks at:1
- ].
+ blocks := blocks select:[:aBlock |
+ aBlock numVars == nV
+ ].
+ blocks size == 1 ifTrue:[
+ ^ blocks at:1
+ ].
].
"/ look for the inner one
maxSoFar := 0.
blocks do:[:aBlock |
- aBlock lineNumber > maxSoFar ifTrue:[
- innerBlock := aBlock.
- maxSoFar := aBlock lineNumber
- ]
+ aBlock lineNumber > maxSoFar ifTrue:[
+ innerBlock := aBlock.
+ maxSoFar := aBlock lineNumber
+ ]
].
^ innerBlock.
@@ -881,12 +903,12 @@
Error and warning messages are suppressed."
^ self
- withSelf:nil
- parseExpression:aString
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
- inNameSpace:nil
+ withSelf:nil
+ parseExpression:aString
+ notifying:nil
+ ignoreErrors:true "silence on Transcript"
+ ignoreWarnings:true
+ inNameSpace:nil
"Modified: 24.6.1997 / 16:44:00 / cg"
!
@@ -898,12 +920,12 @@
Error and warning messages are suppressed."
^ self
- withSelf:nil
- parseExpression:aString
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
- inNameSpace:aNameSpaceOrNil
+ withSelf:nil
+ parseExpression:aString
+ notifying:nil
+ ignoreErrors:true "silence on Transcript"
+ ignoreWarnings:true
+ inNameSpace:aNameSpaceOrNil
"Modified: 24.6.1997 / 16:44:00 / cg"
"Created: 24.6.1997 / 16:44:26 / cg"
@@ -922,12 +944,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.
@@ -948,10 +970,10 @@
Error and warning messages are sent to the Transcript."
^ self
- parseMethod:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
+ parseMethod:aString
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
"Modified: 24.4.1996 / 13:18:34 / cg"
!
@@ -969,10 +991,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
].
tree := parser parseMethod.
(parser errorFlag or:[tree == #Error]) ifTrue:[^ nil].
@@ -993,10 +1015,10 @@
self obsoleteMethodWarning.
^ self
- parseMethod:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:warnBoolean not
+ parseMethod:aString
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:warnBoolean not
"Modified: 24.4.1996 / 13:28:05 / cg"
!
@@ -1015,9 +1037,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.
@@ -1038,10 +1060,10 @@
self obsoleteMethodWarning.
^ self parseMethodArgAndVarSpecification:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
- parseBody:false
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
+ parseBody:false
"Modified: 24.4.1996 / 13:30:03 / cg"
!
@@ -1061,10 +1083,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.
(parser parseMethodSpec == #Error) ifTrue:[^ nil].
@@ -1073,9 +1095,9 @@
"/ - now, alternatively parse body for resource & primitive specs ..
"/
body ifTrue:[
- (parser parseMethodBodyOrEmpty == #Error) ifTrue:[^ nil].
+ (parser parseMethodBodyOrEmpty == #Error) ifTrue:[^ nil].
] ifFalse:[
- (parser parseMethodBodyVarSpec == #Error) ifTrue:[^ nil].
+ (parser parseMethodBodyVarSpec == #Error) ifTrue:[^ nil].
].
parser errorFlag ifTrue:[^ nil].
^ parser
@@ -1104,10 +1126,10 @@
display error/warning messages on the transcript."
^ self parseMethodArgAndVarSpecification:aString
- in:aClass
- ignoreErrors:true
- ignoreWarnings:true
- parseBody:false
+ in:aClass
+ ignoreErrors:true
+ ignoreWarnings:true
+ parseBody:false
"Modified: 24.4.1996 / 13:14:27 / cg"
!
@@ -1132,10 +1154,10 @@
Like #parseMethod:in:, but warning/error messages are suppressed."
^ self
- parseMethod:aString
- in:aClass
- ignoreErrors:true
- ignoreWarnings:true
+ parseMethod:aString
+ in:aClass
+ ignoreErrors:true
+ ignoreWarnings:true
"Modified: 24.4.1996 / 13:32:57 / cg"
!
@@ -1180,10 +1202,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.
@@ -1227,26 +1249,26 @@
(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
- or:[tree isReturnNode]) ifTrue:[
- tree expression isMessage ifTrue:[
- tree := tree expression
- ]
- ].
-
- tree isMessage ifTrue:[
- ^ tree selector
- ].
+ (tree isAssignment
+ or:[tree isReturnNode]) ifTrue:[
+ tree expression isMessage ifTrue:[
+ tree := tree expression
+ ]
+ ].
+
+ tree isMessage ifTrue:[
+ ^ tree selector
+ ].
].
"
@@ -1281,12 +1303,12 @@
codeView) which can highlight it and show a popup box."
^ self
- withSelf:anObject
- parseExpression:aString
- notifying:someOne
- ignoreErrors:false
- ignoreWarnings:false
- inNameSpace:nil
+ withSelf:anObject
+ parseExpression:aString
+ notifying:someOne
+ ignoreErrors:false
+ ignoreWarnings:false
+ inNameSpace:nil
"Modified: 24.6.1997 / 16:43:37 / cg"
!
@@ -1300,12 +1322,12 @@
codeView) which can highlight it and show a popup box."
^ self
- withSelf:anObject
- parseExpression:aString
- notifying:someOne
- ignoreErrors:ignore
- ignoreWarnings:ignore
- inNameSpace:nil
+ withSelf:anObject
+ parseExpression:aString
+ notifying:someOne
+ ignoreErrors:ignore
+ ignoreWarnings:ignore
+ inNameSpace:nil
"Modified: 24.6.1997 / 16:43:26 / cg"
!
@@ -1320,12 +1342,12 @@
iff ignoreErrors/ignoreWarnings is true respectively."
^ self
- withSelf:anObject
- parseExpression:aString
- notifying:someOne
- ignoreErrors:ignoreErrors
- ignoreWarnings:ignoreWarnings
- inNameSpace:nil
+ withSelf:anObject
+ parseExpression:aString
+ notifying:someOne
+ ignoreErrors:ignoreErrors
+ ignoreWarnings:ignoreWarnings
+ inNameSpace:nil
"Modified: 24.6.1997 / 16:43:12 / cg"
!
@@ -1345,7 +1367,7 @@
parser := self for:(ReadStream on:aString).
aNameSpaceOrNil notNil ifTrue:[
- parser currentNameSpace:aNameSpaceOrNil
+ parser currentNameSpace:aNameSpaceOrNil
].
parser setSelf:anObject.
parser notifying:someOne.
@@ -1353,7 +1375,7 @@
ignoreWarnings ifTrue:[parser ignoreWarnings].
token := parser nextToken.
(token == $^) ifTrue:[
- parser nextToken.
+ parser nextToken.
].
tree := parser expression.
(parser errorFlag or:[tree == #Error]) ifTrue:[^ #Error].
@@ -1436,7 +1458,7 @@
"
Parser new
- parseSelector:'
+ parseSelector:'
parseSelector:aStringOrStream
self initializeFor:aStringOrStream.
self parseMethodSpec.
@@ -1616,38 +1638,38 @@
"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:[
- self warning:('adding ''' , varName , ''' as Undeclared.\\Remember to fix that later.') withCRs position:pos1 to:pos2.
-
- ^ self defineAsUndeclaredVariable:varName
- ] ifFalse:[
- ^ VariableNode type:#GlobalVariable name:(varName asSymbol)
- ]
+ (varName at:1) isLowercase ifTrue:[
+ self warning:('adding ''' , varName , ''' as Undeclared.\\Remember to fix that later.') withCRs position:pos1 to:pos2.
+
+ ^ self defineAsUndeclaredVariable:varName
+ ] 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 information:'no good correction found'.
- ^ #Error
+ self information:'no good correction found'.
+ ^ #Error
].
"
@@ -1667,9 +1689,9 @@
"/ failed again ?
rslt == #Error ifTrue:[
- "/ install as Undeclared:<name>, remember in #undeclared
-
- rslt := self defineAsUndeclaredVariable:varName
+ "/ install as Undeclared:<name>, remember in #undeclared
+
+ rslt := self defineAsUndeclaredVariable:varName
].
^ rslt
@@ -1689,7 +1711,7 @@
"/ install as Undeclared:<name>, remember in Undeclared
(Smalltalk includesKey:#Undeclared) ifFalse:[
- Smalltalk at:#Undeclared put:(IdentitySet new).
+ Smalltalk at:#Undeclared put:(IdentitySet new).
].
(Smalltalk at:#Undeclared) add:tokenName asSymbol.
varName := 'Undeclared:' , tokenName.
@@ -1747,54 +1769,54 @@
"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))
- ]
- ].
-
- vars := searchBlock variables.
- vars notNil ifTrue:[
- vars do:[:aBlockVar |
- names add:(aBlockVar name).
- dists add:(aString spellAgainst: "levenshteinTo:"(aBlockVar name))
- ]
- ].
- searchBlock := searchBlock home
+ 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
].
"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:[
- self classesInstVarNames do:[:instVarName |
- names add:instVarName.
- dists add:(aString spellAgainst: "levenshteinTo:"instVarName)
- ]
+ self classesInstVarNames do:[:instVarName |
+ names add:instVarName.
+ dists add:(aString spellAgainst: "levenshteinTo:"instVarName)
+ ]
].
"class-variables"
classToCompileFor notNil ifTrue:[
- self classesClassVarNames do:[:classVarName |
- names add:classVarName.
- dists add:(aString spellAgainst: "levenshteinTo:"classVarName)
- ].
+ self classesClassVarNames do:[:classVarName |
+ names add:classVarName.
+ dists add:(aString spellAgainst: "levenshteinTo:"classVarName)
+ ].
"/ aClass := classToCompileFor.
"/ aClass isMeta ifTrue:[
@@ -1817,62 +1839,62 @@
"globals"
Smalltalk keysDo:[: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.
-
- "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 asSortedCollection do:[:methodVarName |
- names add:methodVarName.
- ].
- ].
-
-
- methodArgs size > 0 ifTrue:[
- names add:'---- method arguments ----'.
- methodArgNames asSortedCollection do:[:methodArgName |
- names add:methodArgName.
- ]
- ].
-
- instVarNames := OrderedCollection new.
- self classesInstVarNames asSortedCollection do:[:instVarName |
- (instVarNames includes:instVarName) ifFalse:[
- instVarNames add:instVarName.
- ]
- ].
-
- instVarNames size > 0 ifTrue:[
- names add:'---- instance variables ----'.
- instVarNames do:[:instVarName |
- (names includes:instVarName) ifFalse:[
- names add:instVarName.
- ]
- ]
- ]
- ].
-
- ^ names
+ 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 asSortedCollection do:[:methodVarName |
+ names add:methodVarName.
+ ].
+ ].
+
+
+ methodArgs size > 0 ifTrue:[
+ names add:'---- method arguments ----'.
+ methodArgNames asSortedCollection do:[:methodArgName |
+ names add:methodArgName.
+ ]
+ ].
+
+ instVarNames := OrderedCollection new.
+ self classesInstVarNames asSortedCollection do:[:instVarName |
+ (instVarNames includes:instVarName) ifFalse:[
+ instVarNames add:instVarName.
+ ]
+ ].
+
+ instVarNames size > 0 ifTrue:[
+ names add:'---- instance variables ----'.
+ instVarNames do:[:instVarName |
+ (names includes:instVarName) ifFalse:[
+ names add:instVarName.
+ ]
+ ]
+ ]
+ ].
+
+ ^ names
].
^ nil
@@ -1903,7 +1925,7 @@
or:[((names := self classesInstVarNames) notNil and:[names includes:aSelectorString])
or:[((names := self classesClassInstVarNames) notNil and:[names includes:aSelectorString])
or:[((names := self classesClassVarNames) notNil and:[names includes:aSelectorString])]]]]) ifTrue:[
- err := ' is currently nowhere implemented ..
+ err := ' is currently nowhere implemented ..
.. but a variable with that name is defined.
Missing ''.'' after the previous expression
@@ -1917,107 +1939,107 @@
ok := false.
sym := aSelectorString asSymbolIfInterned.
sym notNil ifTrue:[
- ok := true.
- receiver notNil ifTrue:[
- "
- if the receiver is a constant, we can check if it responds
- to this selector
- "
- receiver isConstant ifTrue:[
- rec := receiver evaluate.
- ok := rec respondsTo:sym.
- err := ' will not be understood here (message to ' , rec classNameWithArticle , ')'.
- ] ifFalse:[
- receiver isBlock ifTrue:[
- "/ this should help with typos, sending #ifTrue to blocks ...
- ok := [] respondsTo:sym.
- err := ' will not be understood here (message to a Block)'.
- ] ifFalse:[
- "
- if the receiver is a global, we check it too ...
- "
- (((recType := receiver type) == #GlobalVariable)
- or:[recType == #PrivateClass]) ifTrue:[
- "/ dont check autoloaded classes
- "/ - it may work after loading"
-
- rec := receiver evaluate.
- (rec notNil
- and:[rec isBehavior
- and:[rec isLoaded not]]) ifTrue:[
- ^ aSelectorString
- ].
-
- ok := rec respondsTo:sym.
- ok ifFalse:[
- "if it implements #doesNotUnderstand, assume its ok"
- (rec class implements:#doesNotUnderstand:) ifTrue:[
- ^ aSelectorString
- ]
- ].
-
- err := ' may not be understood here (is currently ' , rec classNameWithArticle , ')'.
- ] ifFalse:[
- "if its a super send, we can do more checking"
- receiver isSuper ifTrue:[
- receiver isHere ifFalse:[
- ((superCls := classToCompileFor superclass) notNil
- and:[(superCls whichClassIncludesSelector:sym) isNil]) ifTrue:[
- err := ' is currently not implemented in any superclass'.
- ok := false
- ]
- ] ifTrue:[
- (classToCompileFor whichClassIncludesSelector:sym) isNil ifTrue:[
- err := ' is currently not implemented in this class'.
- ok := false
- ]
- ]
- ].
-
- (receiver isUnaryMessage
- and:[receiver selector == #class
- and:[receiver receiver type == #Self]]) ifTrue:[
- "its a message to self class - can check this too ..."
- (classToCompileFor class whichClassIncludesSelector:sym) isNil ifTrue:[
- ok := false.
- classToCompileFor allSubclasses do:[:subclass |
- (subclass class implements:sym) ifTrue:[
- ok := true
- ]
- ].
- err := ' is currently not implemented in the class'.
- ]
- ]
- ]
- ]
- ]
- ]
+ ok := true.
+ receiver notNil ifTrue:[
+ "
+ if the receiver is a constant, we can check if it responds
+ to this selector
+ "
+ receiver isConstant ifTrue:[
+ rec := receiver evaluate.
+ ok := rec respondsTo:sym.
+ err := ' will not be understood here (message to ' , rec classNameWithArticle , ')'.
+ ] ifFalse:[
+ receiver isBlock ifTrue:[
+ "/ this should help with typos, sending #ifTrue to blocks ...
+ ok := [] respondsTo:sym.
+ err := ' will not be understood here (message to a Block)'.
+ ] ifFalse:[
+ "
+ if the receiver is a global, we check it too ...
+ "
+ (((recType := receiver type) == #GlobalVariable)
+ or:[recType == #PrivateClass]) ifTrue:[
+ "/ dont check autoloaded classes
+ "/ - it may work after loading"
+
+ rec := receiver evaluate.
+ (rec notNil
+ and:[rec isBehavior
+ and:[rec isLoaded not]]) ifTrue:[
+ ^ aSelectorString
+ ].
+
+ ok := rec respondsTo:sym.
+ ok ifFalse:[
+ "if it implements #doesNotUnderstand, assume its ok"
+ (rec class implements:#doesNotUnderstand:) ifTrue:[
+ ^ aSelectorString
+ ]
+ ].
+
+ err := ' may not be understood here (is currently ' , rec classNameWithArticle , ')'.
+ ] ifFalse:[
+ "if its a super send, we can do more checking"
+ receiver isSuper ifTrue:[
+ receiver isHere ifFalse:[
+ ((superCls := classToCompileFor superclass) notNil
+ and:[(superCls whichClassIncludesSelector:sym) isNil]) ifTrue:[
+ err := ' is currently not implemented in any superclass'.
+ ok := false
+ ]
+ ] ifTrue:[
+ (classToCompileFor whichClassIncludesSelector:sym) isNil ifTrue:[
+ err := ' is currently not implemented in this class'.
+ ok := false
+ ]
+ ]
+ ].
+
+ (receiver isUnaryMessage
+ and:[receiver selector == #class
+ and:[receiver receiver type == #Self]]) ifTrue:[
+ "its a message to self class - can check this too ..."
+ (classToCompileFor class whichClassIncludesSelector:sym) isNil ifTrue:[
+ ok := false.
+ classToCompileFor allSubclasses do:[:subclass |
+ (subclass class implements:sym) ifTrue:[
+ ok := true
+ ]
+ ].
+ err := ' is currently not implemented in the class'.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
].
ok ifFalse:[
- (receiver notNil
- and:[((recType := receiver type) == #GlobalVariable)
- or:[recType == #PrivateClass]]) ifTrue:[
- "/ dont check autoloaded classes
- "/ - it may work after loading
-
- rec := receiver evaluate.
- (rec notNil
- and:[rec isBehavior
- and:[rec isLoaded not]]) ifTrue:[
- ^ aSelectorString
- ].
- ].
+ (receiver notNil
+ and:[((recType := receiver type) == #GlobalVariable)
+ or:[recType == #PrivateClass]]) ifTrue:[
+ "/ dont check autoloaded classes
+ "/ - it may work after loading
+
+ rec := receiver evaluate.
+ (rec notNil
+ and:[rec isBehavior
+ and:[rec isLoaded not]]) ifTrue:[
+ ^ aSelectorString
+ ].
+ ].
"OLD: "
- self warning:('#' , aSelectorString , '\\' , err) withCRs position:pos1 to:pos2
+ self warning:('#' , aSelectorString , '\\' , err) withCRs 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
@@ -2095,25 +2117,25 @@
|text|
ignoreErrors ifFalse:[
- Smalltalk silentLoading == true ifFalse:[
- Transcript show:(pos printString).
- Transcript show:' '.
- selector notNil ifTrue:[
- Transcript show:aMessage.
- classToCompileFor notNil ifTrue:[
- text := ' in ' , classToCompileFor name , '>>' , selector
- ] ifFalse:[
- text := ' in ' , selector
- ]
- ] ifFalse:[
- classToCompileFor notNil ifTrue:[
- text := aMessage , ' (' , classToCompileFor name , ')'
- ] ifFalse:[
- text := aMessage
- ]
- ].
- Transcript showCR:text.
- ]
+ Smalltalk silentLoading == true ifFalse:[
+ Transcript show:(pos printString).
+ Transcript show:' '.
+ selector notNil ifTrue:[
+ Transcript show:aMessage.
+ classToCompileFor notNil ifTrue:[
+ text := ' in ' , classToCompileFor name , '>>' , selector
+ ] ifFalse:[
+ text := ' in ' , selector
+ ]
+ ] ifFalse:[
+ classToCompileFor notNil ifTrue:[
+ text := aMessage , ' (' , classToCompileFor name , ')'
+ ] ifFalse:[
+ text := aMessage
+ ]
+ ].
+ Transcript showCR:text.
+ ]
]
"Modified: 18.5.1996 / 15:44:15 / cg"
@@ -2123,10 +2145,10 @@
"/ compiler parseError:'syntax error'.
Transcript show:' '.
aClass notNil ifTrue:[
- Transcript show:aClass name , '>>'
+ Transcript show:aClass name , '>>'
].
selector notNil ifTrue:[
- Transcript show:(selector)
+ Transcript show:(selector)
].
Transcript showCR:' -> Error'.
@@ -2147,10 +2169,10 @@
alredy warned about this one ?
"
warnedUndefVars notNil ifTrue:[
- (warnedUndefVars includes:aName) ifTrue:[
- "already warned about this one"
- ^ false
- ].
+ (warnedUndefVars includes:aName) ifTrue:[
+ "already warned about this one"
+ ^ false
+ ].
].
"/ (classToCompileFor notNil
@@ -2161,34 +2183,34 @@
"/ ].
(requestor isNil or:[requestor isStream]) ifTrue:[
- aName first isUppercase ifFalse:[
- self showErrorMessage:('Error: ''' , aName , ''' is undefined') position:pos1.
- ].
- doCorrect := false.
+ aName first isUppercase ifFalse:[
+ self showErrorMessage:('Error: ''' , aName , ''' is undefined') position:pos1.
+ ].
+ doCorrect := false.
] ifFalse:[
- "
- ask requestor for correct/continue/abort ...
- it is supposed to raise abort or return true/false.
- True return means that correction is wanted.
- "
- msg := 'Warning: ''' , aName , ''' is undefined'.
- classToCompileFor notNil ifTrue:[
- "is it an instance-variable marked inaccessable ?"
-
- idx := (self classesInstVarNames) indexOf:(aName , '*') startingAt:1.
- idx ~~ 0 ifTrue:[
- msg := 'Warning: ' , aName , ' is a hidden instvar (not accessable from ST-code)'.
- ]
- ].
-
- doCorrect := self correctableError:msg position:pos1 to:pos2
+ "
+ ask requestor for correct/continue/abort ...
+ it is supposed to raise abort or return true/false.
+ True return means that correction is wanted.
+ "
+ msg := 'Warning: ''' , aName , ''' is undefined'.
+ classToCompileFor notNil ifTrue:[
+ "is it an instance-variable marked inaccessable ?"
+
+ idx := (self classesInstVarNames) indexOf:(aName , '*') startingAt:1.
+ idx ~~ 0 ifTrue:[
+ msg := 'Warning: ' , aName , ' is a hidden instvar (not accessable from ST-code)'.
+ ]
+ ].
+
+ doCorrect := self correctableError:msg position:pos1 to:pos2
].
doCorrect ifFalse:[
- warnedUndefVars isNil ifTrue:[
- warnedUndefVars := Set new.
- ].
- warnedUndefVars add:aName.
+ warnedUndefVars isNil ifTrue:[
+ warnedUndefVars := Set new.
+ ].
+ warnedUndefVars add:aName.
].
^ doCorrect
@@ -2251,6 +2273,24 @@
(tokenType == #BinaryOperator) ifTrue:[
^ tokenName asSymbol
].
+
+ "/ some more special symbol consts ...
+ (tokenType == $| ) ifTrue:[
+ ^ #|
+ ].
+ (tokenType == #Self ) ifTrue:[
+ ^ #'self'
+ ].
+ (tokenType == #Super ) ifTrue:[
+ ^ #'super'
+ ].
+ (tokenType == #Here ) ifTrue:[
+ ^ #'here'
+ ].
+ (tokenType == #ThisContext ) ifTrue:[
+ ^ #'thisContext'
+ ].
+
(tokenType == #Keyword) ifTrue:[
^ tokenName asSymbol
].
@@ -2293,6 +2333,8 @@
, tokenType printString
, ' unexpected').
^ #Error
+
+ "Modified: 14.10.1997 / 16:31:57 / cg"
!
binaryExpression
@@ -2308,40 +2350,40 @@
[(tokenType == #BinaryOperator) or:[(tokenType == $|)
or:[(tokenType == #Integer) and:[tokenValue < 0]]]] whileTrue:[
- pos := tokenPosition.
-
- 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 fold:foldConstants.
- (try isMemberOf:String) ifTrue:[
- self parseError:try position:pos to:tokenPosition.
- errorFlag := false. "ok, user wants it - so he'll get it"
- receiver := BinaryNode receiver:receiver selector:sel arg:arg fold:nil.
- note := receiver plausibilityCheck.
- note notNil ifTrue:[
- self warning:note position:pos to:tokenPosition
- ].
- ] ifFalse:[
- receiver := try
- ].
- receiver lineNumber:lno.
- receiver selectorPosition:pos.
- parseForCode ifFalse:[self rememberSelectorUsed:sel].
+ pos := tokenPosition.
+
+ 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 fold:foldConstants.
+ (try isMemberOf:String) ifTrue:[
+ self parseError:try position:pos to:tokenPosition.
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ receiver := BinaryNode receiver:receiver selector:sel arg:arg fold:nil.
+ note := receiver plausibilityCheck.
+ note notNil ifTrue:[
+ self warning:note position:pos to:tokenPosition
+ ].
+ ] ifFalse:[
+ receiver := try
+ ].
+ receiver lineNumber:lno.
+ receiver selectorPosition:pos.
+ parseForCode ifFalse:[self rememberSelectorUsed:sel].
].
^ receiver
@@ -2356,42 +2398,42 @@
lno := tokenLineNr.
self nextToken.
(tokenType == $: ) ifTrue:[
- [tokenType == $:] whileTrue:[
- pos := tokenPosition.
- self nextToken.
- (tokenType == #Identifier) ifFalse:[
- ^ self identifierExpectedIn:'block-arg declaration'
- ].
- 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 identifierExpectedIn:'block-arg declaration'
+ ].
+ 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
!
@@ -2403,27 +2445,27 @@
lno := tokenLineNr.
(tokenType == $| ) ifTrue:[
- self nextToken.
- [tokenType == $|] whileFalse:[
- (tokenType == #Identifier) ifFalse:[
- ^ self identifierExpectedIn:'block-var declaration'
- ].
- var := Variable name:tokenName.
- vars isNil ifTrue:[
- vars := Array with:var.
- names := Array with:tokenName
- ] ifFalse:[
- (names includes:tokenName) ifTrue:[
- self parseError:'redefinition of ''' , tokenName , ''' in local variables'
- position:tokenPosition to:tokenPosition + tokenName size -1.
- ] ifFalse:[
- vars := vars copyWith:var.
- names := names copyWith:tokenName
- ]
- ].
- self nextToken.
- ].
- self nextToken
+ self nextToken.
+ [tokenType == $|] whileFalse:[
+ (tokenType == #Identifier) ifFalse:[
+ ^ self identifierExpectedIn:'block-var declaration'
+ ].
+ var := Variable name:tokenName.
+ vars isNil ifTrue:[
+ vars := Array with:var.
+ names := Array with:tokenName
+ ] ifFalse:[
+ (names includes:tokenName) ifTrue:[
+ self parseError:'redefinition of ''' , tokenName , ''' in local variables'
+ position:tokenPosition to:tokenPosition + tokenName size -1.
+ ] ifFalse:[
+ vars := vars copyWith:var.
+ names := names copyWith:tokenName
+ ]
+ ].
+ self nextToken.
+ ].
+ self nextToken
].
node := BlockNode arguments:args home:currentBlock variables:vars.
@@ -2431,7 +2473,7 @@
currentBlock := node.
stats := self blockStatementList.
lineNumberInfo == #full ifTrue:[
- node endLineNumber:tokenLineNr
+ node endLineNumber:tokenLineNr
].
node statements:stats.
currentBlock := node home.
@@ -2682,8 +2724,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
@@ -2698,11 +2740,11 @@
aClass := classToCompileFor.
aClass isMeta ifTrue:[
- className := aClass name copyWithoutLast:6.
- baseClass := Smalltalk at:(className asSymbol).
- baseClass notNil ifTrue:[
- aClass := baseClass
- ]
+ className := aClass name copyWithoutLast:6.
+ baseClass := Smalltalk at:(className asSymbol).
+ baseClass notNil ifTrue:[
+ aClass := baseClass
+ ]
].
^ aClass whichClassDefinesClassVar:aString
@@ -2720,7 +2762,7 @@
"parse a keyword-expression; return a node-tree, nil or #Error.
keywordExpression ::= binaryexpression
- | { KEYWORD-PART binaryExpression }
+ | { KEYWORD-PART binaryExpression }
"
|receiver sel arg args posR1 posR2 pos1 pos2 try lno note|
@@ -2729,52 +2771,52 @@
receiver := self binaryExpression.
(receiver == #Error) ifTrue:[^ #Error].
(tokenType == #Keyword) ifTrue:[
- pos1 := posR2 := tokenPosition.
- pos2 := tokenPosition + tokenName size - 1.
- sel := tokenName.
- lno := tokenLineNr.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := Array with:arg.
- [tokenType == #Keyword] whileTrue:[
- sel := sel , tokenName.
- pos2 := tokenPosition + tokenName size - 1.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := args copyWith:arg.
- ].
- sel := self selectorCheck:sel for:receiver position:pos1 to:pos2.
- try := MessageNode receiver:receiver selector:sel args:args fold:foldConstants.
- (try isMemberOf:String) ifTrue:[
- self parseError:try position:pos1 to:pos2.
- errorFlag := false. "ok, user wants it - so he'll get it"
- receiver := MessageNode receiver:receiver selector:sel args:args fold:nil.
- note := receiver plausibilityCheck.
- note notNil ifTrue:[
- self warning:note position:pos1 to:pos2
- ].
- ] ifFalse:[
- receiver := try
- ].
- receiver lineNumber:lno.
- parseForCode ifFalse:[self rememberSelectorUsed:sel].
-
- (sel = #and:
- or:[sel = #or:]) ifTrue:[
- receiver arg1 isBlock ifFalse:[
- self warnCommonMistake:'(possible common mistake) missing block brackets ?'
- position:pos2+1 to:tokenPosition-1
- ]
- ].
- (sel = #whileTrue:
- or:[sel = #whileFalse:]) ifTrue:[
- receiver receiver isBlock ifFalse:[
- self warnCommonMistake:'(possible common mistake) missing block brackets ?'
- position:posR1 to:posR2-1
- ]
- ].
+ pos1 := posR2 := tokenPosition.
+ pos2 := tokenPosition + tokenName size - 1.
+ sel := tokenName.
+ lno := tokenLineNr.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := Array with:arg.
+ [tokenType == #Keyword] whileTrue:[
+ sel := sel , tokenName.
+ pos2 := tokenPosition + tokenName size - 1.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := args copyWith:arg.
+ ].
+ sel := self selectorCheck:sel for:receiver position:pos1 to:pos2.
+ try := MessageNode receiver:receiver selector:sel args:args fold:foldConstants.
+ (try isMemberOf:String) ifTrue:[
+ self parseError:try position:pos1 to:pos2.
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ receiver := MessageNode receiver:receiver selector:sel args:args fold:nil.
+ note := receiver plausibilityCheck.
+ note notNil ifTrue:[
+ self warning:note position:pos1 to:pos2
+ ].
+ ] ifFalse:[
+ receiver := try
+ ].
+ receiver lineNumber:lno.
+ parseForCode ifFalse:[self rememberSelectorUsed:sel].
+
+ (sel = #and:
+ or:[sel = #or:]) ifTrue:[
+ receiver arg1 isBlock ifFalse:[
+ self warnCommonMistake:'(possible common mistake) missing block brackets ?'
+ position:pos2+1 to:tokenPosition-1
+ ]
+ ].
+ (sel = #whileTrue:
+ or:[sel = #whileFalse:]) ifTrue:[
+ receiver receiver isBlock ifFalse:[
+ self warnCommonMistake:'(possible common mistake) missing block brackets ?'
+ position:posR1 to:posR2-1
+ ]
+ ].
].
^ receiver
@@ -2794,7 +2836,7 @@
(self parseMethodSpec == #Error) ifTrue:[^ #Error].
parseTree := self parseMethodBody.
(parseTree == #Error) ifFalse:[
- self tree:parseTree
+ self tree:parseTree
].
^ parseTree
@@ -2812,7 +2854,11 @@
"
|stats|
- stats := self parseMethodBodyOrEmpty.
+ classToCompileFor notNil ifTrue:[
+ stats := self parseMethodBodyOrEmpty.
+ ] ifFalse:[
+ stats := self parseMethodBodyOrEmpty.
+ ].
(stats == #Error) ifFalse:[
(tokenType ~~ #EOF) ifTrue:[
"/ just for the nicer error message
@@ -2828,7 +2874,7 @@
].
^ stats
- "Modified: 12.12.1995 / 19:40:58 / cg"
+ "Modified: 14.10.1997 / 20:53:17 / cg"
!
parseMethodBodyOrEmpty
@@ -2837,8 +2883,8 @@
empty (or comment only) input is accepted and returns nil.
methodBodyOrNil ::= '<' st80Primitive '>'
- | '<' st80Primitive '>' methodBodyVarSpec statementList
- | <empty>
+ | '<' st80Primitive '>' methodBodyVarSpec statementList
+ | <empty>
"
|stats|
@@ -2846,7 +2892,7 @@
(self parseMethodBodyVarSpec == #Error) ifTrue:[^ #Error].
(tokenType ~~ #EOF) ifTrue:[
- stats := self statementList
+ stats := self statementList
].
^ stats
@@ -2861,54 +2907,54 @@
Return #Error or nil.
methodBodyVarSpec ::= '|' { IDENTIFIER } '|'
- | <empty>
+ | <empty>
"
|var pos msg|
((tokenType == #BinaryOperator) and:[tokenName = '<']) ifTrue:[
- self parsePrimitiveOrResourceSpecOrEmpty.
+ self parsePrimitiveOrResourceSpecOrEmpty.
].
(tokenType == $|) ifTrue:[
- "memorize position for declaration in correction"
- localVarDefPosition := tokenPosition.
- self nextToken.
- pos := tokenPosition.
- [tokenType == #Identifier] whileTrue:[
- var := Variable name:tokenName.
- methodVars isNil ifTrue:[
- methodVars := OrderedCollection with:var.
- methodVarNames := OrderedCollection with:tokenName
- ] ifFalse:[
- (methodVarNames includes:tokenName) ifTrue:[
- self parseError:'redefinition of ''' , tokenName , ''' in local variables'
- position:tokenPosition to:tokenPosition + tokenName size -1.
- ] ifFalse:[
- methodVars add:var.
- methodVarNames add:tokenName
- ]
- ].
- methodArgNames notNil ifTrue:[
- (methodArgNames includes:tokenName) ifTrue:[
- self warning:'local variable ''' , tokenName , ''' hides argument.'
- position:tokenPosition
- to:(tokenPosition + tokenName size - 1)
- ]
- ].
- self nextToken.
- pos := tokenPosition
- ].
- (tokenType ~~ $|) ifTrue:[
- (#(True False Self Nil Super ThisContext) includes:tokenType) ifTrue:[
- msg := 'Reserved keyword in local var declaration'
- ] ifFalse:[
- msg := 'Identifier or | expected in local var declaration'
- ].
- self syntaxError:msg position:tokenPosition to:source position-1.
- ^ #Error
- ].
- self nextToken
+ "memorize position for declaration in correction"
+ localVarDefPosition := tokenPosition.
+ self nextToken.
+ pos := tokenPosition.
+ [tokenType == #Identifier] whileTrue:[
+ var := Variable name:tokenName.
+ methodVars isNil ifTrue:[
+ methodVars := OrderedCollection with:var.
+ methodVarNames := OrderedCollection with:tokenName
+ ] ifFalse:[
+ (methodVarNames includes:tokenName) ifTrue:[
+ self parseError:'redefinition of ''' , tokenName , ''' in local variables'
+ position:tokenPosition to:tokenPosition + tokenName size -1.
+ ] ifFalse:[
+ methodVars add:var.
+ methodVarNames add:tokenName
+ ]
+ ].
+ methodArgNames notNil ifTrue:[
+ (methodArgNames includes:tokenName) ifTrue:[
+ self warning:'local variable ''' , tokenName , ''' hides argument.'
+ position:tokenPosition
+ to:(tokenPosition + tokenName size - 1)
+ ]
+ ].
+ self nextToken.
+ pos := tokenPosition
+ ].
+ (tokenType ~~ $|) ifTrue:[
+ (#(True False Self Nil Super ThisContext) includes:tokenType) ifTrue:[
+ msg := 'Reserved keyword in local var declaration'
+ ] ifFalse:[
+ msg := 'Identifier or | expected in local var declaration'
+ ].
+ self syntaxError:msg position:tokenPosition to:source position-1.
+ ^ #Error
+ ].
+ self nextToken
].
^ nil
@@ -2921,66 +2967,66 @@
Return the receiver or #Error.
methodSpec ::= { KEYWORD IDENTIFIER }
- | binaryOperator IDENTIFIER
- | IDENTIFIER
+ | binaryOperator IDENTIFIER
+ | IDENTIFIER
"
|var|
tokenType isNil ifTrue:[
- self nextToken.
+ self nextToken.
].
(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
].
"/ special handling for |, which is also a lexical token
tokenType == $| ifTrue:[
- tokenType := #BinaryOperator.
- tokenName := '|'
+ tokenType := #BinaryOperator.
+ tokenName := '|'
].
(tokenType == #BinaryOperator) ifTrue:[
- selector := tokenName asSymbol.
- self nextToken.
- (tokenType ~~ #Identifier) ifTrue:[^ #Error].
- var := Variable name:tokenName.
+ selector := tokenName asSymbol.
+ self nextToken.
+ (tokenType ~~ #Identifier) ifTrue:[^ #Error].
+ var := Variable name:tokenName.
"/ methodArgs isNil ifTrue:[
- methodArgs := Array with:var.
- methodArgNames := Array with:tokenName.
+ methodArgs := Array with:var.
+ methodArgNames := Array with:tokenName.
"/ ] ifFalse:[
"/ methodArgs := methodArgs copyWith:var.
"/ methodArgNames := methodArgNames copyWith:tokenName
"/ ].
- self nextToken.
- ^ self
+ self nextToken.
+ ^ self
].
^ #Error
@@ -2994,24 +3040,24 @@
|pos wmsg primNr|
[(tokenType == #BinaryOperator) and:[tokenName = '<']] whileTrue:[
- "/ an ST-80 primitive or resourceSpec - parsed but ignored
-
- pos := tokenPosition.
- self nextToken.
- primNr := self parseST80Primitive.
-
- (primNr == #Error) ifTrue:[^ #Error].
- wmsg := nil.
-
- primNr < 0 ifTrue:[
- WarnST80Directives == true ifTrue:[
- wmsg := 'ST-80 directive ignored'.
- ].
- ] ifFalse:[
- primitiveNr := primNr.
- wmsg := 'ST-80 primitive may not work'
- ].
- wmsg notNil ifTrue:[self warning:wmsg position:pos]
+ "/ an ST-80 primitive or resourceSpec - parsed but ignored
+
+ pos := tokenPosition.
+ self nextToken.
+ primNr := self parseST80Primitive.
+
+ (primNr == #Error) ifTrue:[^ #Error].
+ wmsg := nil.
+
+ primNr < 0 ifTrue:[
+ WarnST80Directives == true ifTrue:[
+ wmsg := 'ST-80 directive ignored'.
+ ].
+ ] ifFalse:[
+ primitiveNr := primNr.
+ wmsg := 'ST-80 primitive may not work'
+ ].
+ wmsg notNil ifTrue:[self warning:wmsg position:pos]
].
"Created: 27.4.1996 / 16:55:55 / cg"
@@ -3037,60 +3083,60 @@
|primNumber keys resource resourceValue|
(tokenType ~~ #Keyword) ifTrue:[
- self parseError:'bad primitive definition (keyword expected)'.
- ^ #Error
+ self parseError:'bad primitive definition (keyword expected)'.
+ ^ #Error
].
(tokenName = 'primitive:') ifTrue:[
- self nextToken.
- (tokenType == #Integer) ifFalse:[
- self parseError:'primitive number expected'.
- ^ #Error
- ].
- primitiveNr notNil ifTrue:[
- self parseError:'only one primitive spec allowed'.
- primNumber := -1.
- ] ifFalse:[
- primNumber := tokenValue.
- ].
- self nextToken.
+ self nextToken.
+ (tokenType == #Integer) ifFalse:[
+ self parseError:'primitive number expected'.
+ ^ #Error
+ ].
+ primitiveNr notNil ifTrue:[
+ self parseError:'only one primitive spec allowed'.
+ primNumber := -1.
+ ] ifFalse:[
+ primNumber := tokenValue.
+ ].
+ self nextToken.
] ifFalse:[
- (tokenName = 'resource:') ifTrue:[
- self nextToken.
- (tokenType ~~ #Symbol) ifTrue:[
- self parseError:'symbol expected'.
- ^ #Error
- ].
- primNumber := -1.
- resource := tokenValue.
- resourceValue := true.
-
- self nextToken.
-
- tokenType == $( ifTrue:[
- self nextToken.
- keys := OrderedCollection new.
- [tokenType == $) ] whileFalse:[
- keys add:tokenValue.
- self nextToken.
- ].
- resourceValue := keys.
- self nextToken.
- ].
-
- primitiveResource isNil ifTrue:[
- primitiveResource := IdentityDictionary new.
- ].
- primitiveResource at:(resource asSymbol) put:resourceValue.
- ] ifFalse:[
- self parseError:'unrecognized primitive'.
- ^ #Error
- ].
+ (tokenName = 'resource:') ifTrue:[
+ self nextToken.
+ (tokenType ~~ #Symbol) ifTrue:[
+ self parseError:'symbol expected'.
+ ^ #Error
+ ].
+ primNumber := -1.
+ resource := tokenValue.
+ resourceValue := true.
+
+ self nextToken.
+
+ tokenType == $( ifTrue:[
+ self nextToken.
+ keys := OrderedCollection new.
+ [tokenType == $) ] whileFalse:[
+ keys add:tokenValue.
+ self nextToken.
+ ].
+ resourceValue := keys.
+ self nextToken.
+ ].
+
+ primitiveResource isNil ifTrue:[
+ primitiveResource := IdentityDictionary new.
+ ].
+ primitiveResource at:(resource asSymbol) put:resourceValue.
+ ] ifFalse:[
+ self parseError:'unrecognized primitive'.
+ ^ #Error
+ ].
].
((tokenType == #BinaryOperator) and:[tokenName = '>']) ifFalse:[
- self parseError:'bad primitive definition (> expected)'.
- ^ #Error
+ self parseError:'bad primitive definition (> expected)'.
+ ^ #Error
].
self nextToken.
^ primNumber
@@ -3106,219 +3152,219 @@
pos := tokenPosition.
(tokenType == #Self) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to self' position:pos to:tokenPosition.
- ^ #Error
- ].
- selfNode isNil ifTrue:[
- selfNode := SelfNode value:selfValue
- ].
- ^ selfNode
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to self' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ selfNode isNil ifTrue:[
+ selfNode := SelfNode value:selfValue
+ ].
+ ^ selfNode
].
(tokenType == #Identifier) ifTrue:[
- "
- must check for variable first, to be backward compatible
- with other smalltalks.
- "
- tokenName = 'here' ifTrue:[
- (self variableOrError:tokenName) == #Error ifTrue:[
- tokenType := #Here.
- warnSTXHereExtensionUsed ifTrue:[
- self warning:'here-sends are a nonstandard feature of ST/X'
- position:pos to:pos+3.
- "
- only warn once
- "
- warnSTXHereExtensionUsed := false
- ]
- ]
- ]
+ "
+ must check for variable first, to be backward compatible
+ with other smalltalks.
+ "
+ tokenName = 'here' ifTrue:[
+ (self variableOrError:tokenName) == #Error ifTrue:[
+ tokenType := #Here.
+ warnSTXHereExtensionUsed ifTrue:[
+ self warning:'here-sends are a nonstandard feature of ST/X'
+ position:pos to:pos+3.
+ "
+ only warn once
+ "
+ warnSTXHereExtensionUsed := false
+ ]
+ ]
+ ]
].
(tokenType == #Identifier) ifTrue:[
- name := tokenName.
-
- var := self variable.
- (var == #Error) ifTrue:[
- errorFlag := true
- ].
- self nextToken.
-
- (tokenType == #'::') ifTrue:[
- globlName := name.
-
- "is it in a namespace ?"
- nameSpace := self findNameSpaceWith:globlName.
- nameSpace notNil ifTrue:[
- globlName := nameSpace name , '::' , globlName
- ].
-
- [tokenType == #'::'] whileTrue:[
- nameSpace := globlName.
-
- self nextToken.
- (tokenType == #Identifier) ifTrue:[
- ignoreWarnings ifFalse:[
- warnSTXNameSpaceUse ifTrue:[
- self warning:'nameSpaces are a nonstandard feature of ST/X'
- position:pos to:(source position).
- "
- only warn once
- "
- warnSTXNameSpaceUse := false
- ]
- ].
- name := tokenName.
-
- globlName := (nameSpace , '::' , name).
-
- nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
- nameSpaceGlobal isNil ifTrue:[
- self parseError:('unknown nameSpace: ', nameSpace) position:pos to:tokenPosition-1.
- errorFlag := true
- ] ifFalse:[
- nameSpaceGlobal isNamespace ifTrue:[
- "/ for now: only Smalltalk is allowed
- nameSpaceGlobal ~~ Smalltalk ifTrue:[
+ name := tokenName.
+
+ var := self variable.
+ (var == #Error) ifTrue:[
+ errorFlag := true
+ ].
+ self nextToken.
+
+ (tokenType == #'::') ifTrue:[
+ globlName := name.
+
+ "is it in a namespace ?"
+ nameSpace := self findNameSpaceWith:globlName.
+ nameSpace notNil ifTrue:[
+ globlName := nameSpace name , '::' , globlName
+ ].
+
+ [tokenType == #'::'] whileTrue:[
+ nameSpace := globlName.
+
+ self nextToken.
+ (tokenType == #Identifier) ifTrue:[
+ ignoreWarnings ifFalse:[
+ warnSTXNameSpaceUse ifTrue:[
+ self warning:'nameSpaces are a nonstandard feature of ST/X'
+ position:pos to:(source position).
+ "
+ only warn once
+ "
+ warnSTXNameSpaceUse := false
+ ]
+ ].
+ name := tokenName.
+
+ globlName := (nameSpace , '::' , name).
+
+ nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
+ nameSpaceGlobal isNil ifTrue:[
+ self parseError:('unknown nameSpace: ', nameSpace) position:pos to:tokenPosition-1.
+ errorFlag := true
+ ] ifFalse:[
+ nameSpaceGlobal isNamespace ifTrue:[
+ "/ for now: only Smalltalk is allowed
+ nameSpaceGlobal ~~ Smalltalk ifTrue:[
"/ self parseError:('(currently) the only valid nameSpace is `Smalltalk''') position:pos to:tokenPosition-1.
"/ errorFlag := true
- ] ifFalse:[
- globlName := name
- ].
- ] ifFalse:[
- nameSpaceGlobal isBehavior ifFalse:[
- self parseError:('invalid nameSpace: ' , nameSpace) position:pos to:tokenPosition-1.
- errorFlag := true
- ] ifTrue:[
- (nameSpaceGlobal privateClassesAt:name asSymbol) isNil ifTrue:[
- self parseError:('no private class: ' , name , ' in class: ' , nameSpace) position:pos to:tokenPosition-1.
- errorFlag := true
- ]
- ]
- ].
- ].
- self nextToken.
- ].
- var := VariableNode
- type:#GlobalVariable
- name:globlName asSymbol.
- parseForCode ifFalse:[self rememberGlobalUsed:globlName].
- ]
- ].
-
- ((tokenType == $_) or:[tokenType == #':=']) ifFalse:[
- ^ var
- ].
-
- "/ careful: it could already be an implicit self send
- ImplicitSelfSends ifTrue:[
- var isMessage ifTrue:[
- self nextToken.
- expr := self expression.
- (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
- selfNode isNil ifTrue:[
- selfNode := SelfNode value:selfValue
- ].
- ^ MessageNode receiver:selfNode selector:('implicit_' , name , ':') asSymbol arg:expr.
- ].
- ].
-
- (var ~~ #Error) ifTrue:[
- t := var type.
- (t ~~ #MethodVar) ifTrue:[
- (t == #PrivateClass) ifTrue:[
- self parseError:'assignment to private class' position:pos to:tokenPosition.
- errorFlag := true
- ] ifFalse:[
- (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:[
- name := self classesInstVarNames at:(var index).
-
- "/ ca once did this to `name' and wondered what happened to his class ...
- "/ (not really a beginners bug, but may happen as a typo or missing local variable;
- "/ and is hard to track down later)
-
- warnCommonMistakes ifTrue:[
- classToCompileFor isMeta ifTrue:[
- (classToCompileFor isSubclassOf:Class) ifTrue:[
- (Class allInstVarNames includes:(var name)) ifTrue:[
- self warning:'assignment to a classInstanceVariable\(see hierarchy of `Class'')' withCRs position:pos to:tokenPosition+1.
- ]
- ]
- ]
- ].
- parseForCode ifFalse:[
- modifiedInstVars isNil ifTrue:[
- modifiedInstVars := Set new
- ].
- modifiedInstVars add:name
- ]
- ] ifFalse:[
- (t == #ClassVariable) ifTrue:[
- name := var name.
- name := name copyFrom:((name indexOf:$:) + 1).
- parseForCode ifFalse:[
- modifiedClassVars isNil ifTrue:[
- modifiedClassVars := Set new
- ].
- modifiedClassVars add:name
- ]
- ] ifFalse:[
- (t == #GlobalVariable) ifTrue:[
- (cls := Smalltalk classNamed:var name) notNil ifTrue:[
- cls name = var name ifTrue:[
- self warning:'assignment to global which refers to a class' position:pos to:tokenPosition.
- ]
- ].
- parseForCode ifFalse:[
- modifiedGlobals isNil ifTrue:[
- modifiedGlobals := Set new
- ].
- modifiedGlobals add:var name
- ]
- ]
- ]
- ]
- ]
- ]
- ]
- ].
- ].
-
- lnr := tokenLineNr.
-
- self nextToken.
- pos2 := tokenPosition.
- expr := self expression.
-
- "/ a typical beginner error:
- "/ expr ifTrue:[
- "/ var := super
- "/ ] ifFalse:[
- "/ var := something-else
- "/ ].
- "/ var messageSend
- "/
- "/ does not what a beginner might think.
-
- warnCommonMistakes ifTrue:[
- (expr ~~ #Error and:[expr isSuper]) ifTrue:[
- self warning:'followup messageSends to `' , var name , ''' will have normal send semantics\(i.e. NO super- or here-sends). Use self to avoid confusion.' withCRs position:pos to:pos2.
- ].
- ].
-
- (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
- node := AssignmentNode variable:var expression:expr.
- (lineNumberInfo == #full) ifTrue:[node lineNr:lnr].
- ^ node
+ ] ifFalse:[
+ globlName := name
+ ].
+ ] ifFalse:[
+ nameSpaceGlobal isBehavior ifFalse:[
+ self parseError:('invalid nameSpace: ' , nameSpace) position:pos to:tokenPosition-1.
+ errorFlag := true
+ ] ifTrue:[
+ (nameSpaceGlobal privateClassesAt:name asSymbol) isNil ifTrue:[
+ self parseError:('no private class: ' , name , ' in class: ' , nameSpace) position:pos to:tokenPosition-1.
+ errorFlag := true
+ ]
+ ]
+ ].
+ ].
+ self nextToken.
+ ].
+ var := VariableNode
+ type:#GlobalVariable
+ name:globlName asSymbol.
+ parseForCode ifFalse:[self rememberGlobalUsed:globlName].
+ ]
+ ].
+
+ ((tokenType == $_) or:[tokenType == #':=']) ifFalse:[
+ ^ var
+ ].
+
+ "/ careful: it could already be an implicit self send
+ ImplicitSelfSends ifTrue:[
+ var isMessage ifTrue:[
+ self nextToken.
+ expr := self expression.
+ (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
+ selfNode isNil ifTrue:[
+ selfNode := SelfNode value:selfValue
+ ].
+ ^ MessageNode receiver:selfNode selector:('implicit_' , name , ':') asSymbol arg:expr.
+ ].
+ ].
+
+ (var ~~ #Error) ifTrue:[
+ t := var type.
+ (t ~~ #MethodVar) ifTrue:[
+ (t == #PrivateClass) ifTrue:[
+ self parseError:'assignment to private class' position:pos to:tokenPosition.
+ errorFlag := true
+ ] ifFalse:[
+ (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:[
+ name := self classesInstVarNames at:(var index).
+
+ "/ ca once did this to `name' and wondered what happened to his class ...
+ "/ (not really a beginners bug, but may happen as a typo or missing local variable;
+ "/ and is hard to track down later)
+
+ warnCommonMistakes ifTrue:[
+ classToCompileFor isMeta ifTrue:[
+ (classToCompileFor isSubclassOf:Class) ifTrue:[
+ (Class allInstVarNames includes:(var name)) ifTrue:[
+ self warning:'assignment to a classInstanceVariable\(see hierarchy of `Class'')' withCRs position:pos to:tokenPosition+1.
+ ]
+ ]
+ ]
+ ].
+ parseForCode ifFalse:[
+ modifiedInstVars isNil ifTrue:[
+ modifiedInstVars := Set new
+ ].
+ modifiedInstVars add:name
+ ]
+ ] ifFalse:[
+ (t == #ClassVariable) ifTrue:[
+ name := var name.
+ name := name copyFrom:((name indexOf:$:) + 1).
+ parseForCode ifFalse:[
+ modifiedClassVars isNil ifTrue:[
+ modifiedClassVars := Set new
+ ].
+ modifiedClassVars add:name
+ ]
+ ] ifFalse:[
+ (t == #GlobalVariable) ifTrue:[
+ (cls := Smalltalk classNamed:var name) notNil ifTrue:[
+ cls name = var name ifTrue:[
+ self warning:'assignment to global which refers to a class' position:pos to:tokenPosition.
+ ]
+ ].
+ parseForCode ifFalse:[
+ modifiedGlobals isNil ifTrue:[
+ modifiedGlobals := Set new
+ ].
+ modifiedGlobals add:var name
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ ].
+
+ lnr := tokenLineNr.
+
+ self nextToken.
+ pos2 := tokenPosition.
+ expr := self expression.
+
+ "/ a typical beginner error:
+ "/ expr ifTrue:[
+ "/ var := super
+ "/ ] ifFalse:[
+ "/ var := something-else
+ "/ ].
+ "/ var messageSend
+ "/
+ "/ does not what a beginner might think.
+
+ warnCommonMistakes ifTrue:[
+ (expr ~~ #Error and:[expr isSuper]) ifTrue:[
+ self warning:'followup messageSends to `' , var name , ''' will have normal send semantics\(i.e. NO super- or here-sends). Use self to avoid confusion.' withCRs position:pos to:pos2.
+ ].
+ ].
+
+ (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
+ node := AssignmentNode variable:var expression:expr.
+ (lineNumberInfo == #full) ifTrue:[node lineNr:lnr].
+ ^ node
].
((tokenType == #Integer)
@@ -3326,148 +3372,148 @@
or:[(tokenType == #Character)
or:[(tokenType == #Float)
or:[(tokenType == #Symbol)]]]]) ifTrue:[
- val := ConstantNode type:tokenType value:tokenValue.
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to a constant' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ val
+ val := ConstantNode type:tokenType value:tokenValue.
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to a constant' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ val
].
(tokenType == #Nil) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to nil' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#Nil value:nil
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to nil' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#Nil value:nil
].
(tokenType == #True) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to true' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#True value:true
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to true' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#True value:true
].
(tokenType == #False) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to false' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#False value:false
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to false' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#False value:false
].
(tokenType == #Super) ifTrue:[
- usesSuper := true.
- self nextToken.
- ((tokenType == $_) or:[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
+ usesSuper := true.
+ self nextToken.
+ ((tokenType == $_) or:[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 == #Here) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to here' position:pos to:tokenPosition.
- ^ #Error
- ].
- classToCompileFor isNil ifTrue:[
- self warning:'in which class are you ?' position:pos to:(pos + 3).
- ].
- ^ SuperNode value:selfValue inClass:classToCompileFor here:true
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to here' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ classToCompileFor isNil ifTrue:[
+ self warning:'in which class are you ?' position:pos to:(pos + 3).
+ ].
+ ^ SuperNode value:selfValue inClass:classToCompileFor here:true
].
(tokenType == #ThisContext) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to thisContext' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ VariableNode type:#ThisContext
+ self nextToken.
+ ((tokenType == $_) or:[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.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to a constant' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#Array value:val
+ self nextToken.
+ val := self array.
+ self nextToken.
+ ((tokenType == $_) or:[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.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to a constant' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#Array value:val
+ self nextToken.
+ val := self byteArray.
+ self nextToken.
+ ((tokenType == $_) or:[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 isCharacter ifTrue:[
- eMsg := 'missing '')'' (i.e. ''' , tokenType asString , ''' unexpected)'.
- ] ifFalse:[
- eMsg := 'missing '')'''.
- ].
- self syntaxError:eMsg withCRs position:pos to:tokenPosition.
- ^ #Error
- ].
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'invalid assignment' position:pos to:tokenPosition.
- ^ #Error
- ].
- val parenthized:true.
- ^ val
+ self nextToken.
+ val := self expression.
+ (val == #Error) ifTrue:[^ #Error].
+ (tokenType ~~ $) ) ifTrue:[
+ tokenType isCharacter ifTrue:[
+ eMsg := 'missing '')'' (i.e. ''' , tokenType asString , ''' unexpected)'.
+ ] ifFalse:[
+ eMsg := 'missing '')'''.
+ ].
+ self syntaxError:eMsg withCRs position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'invalid assignment' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ val parenthized:true.
+ ^ val
].
(tokenType == $[ ) ifTrue:[
- val := self block.
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'invalid assignment' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ val
+ val := self block.
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'invalid assignment' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ val
].
(tokenType == #Primitive) ifTrue:[
- self nextToken.
- node := PrimitiveNode code:tokenValue.
- hasNonOptionalPrimitiveCode := true.
- hasPrimitiveCode := true.
- ^ node
+ self nextToken.
+ node := PrimitiveNode code:tokenValue.
+ hasNonOptionalPrimitiveCode := true.
+ hasPrimitiveCode := true.
+ ^ node
].
(tokenType == #Error) ifTrue:[^ #Error].
tokenType isCharacter ifTrue:[
- self syntaxError:('error in primary; '
- , tokenType printString ,
- ' unexpected') position:tokenPosition to:tokenPosition
+ self syntaxError:('error in primary; '
+ , tokenType printString ,
+ ' unexpected') position:tokenPosition to:tokenPosition
] ifFalse:[
- (#(BinaryOperator Keyword) includes:tokenType) ifTrue:[
- eMsg := ('error in primary; '
- , tokenType printString , '(' , tokenName , ') ' ,
- ' unexpected')
- ] ifFalse:[
- eMsg := ('error in primary; '
- , tokenType printString ,
- ' unexpected')
- ].
- self syntaxError:eMsg
+ (#(BinaryOperator Keyword) includes:tokenType) ifTrue:[
+ eMsg := ('error in primary; '
+ , tokenType printString , '(' , tokenName , ') ' ,
+ ' unexpected')
+ ] ifFalse:[
+ eMsg := ('error in primary; '
+ , tokenType printString ,
+ ' unexpected')
+ ].
+ self syntaxError:eMsg
].
^ #Error
@@ -3479,36 +3525,36 @@
"parse a statement; return a node-tree or #Error.
statement ::= '^' expression
- | PRIMITIVECODE
- | expression
+ | PRIMITIVECODE
+ | expression
"
|expr node lnr|
(tokenType == $^) ifTrue:[
- lnr := tokenLineNr.
- self nextToken.
- expr := self expression.
- (expr == #Error) ifTrue:[^ #Error].
- node := ReturnNode expression:expr.
- node home:self blockHome:currentBlock.
- (lineNumberInfo == #full) ifTrue:[node lineNr:lnr].
- ^ node
+ lnr := tokenLineNr.
+ self nextToken.
+ expr := self expression.
+ (expr == #Error) ifTrue:[^ #Error].
+ node := ReturnNode expression:expr.
+ node home:self blockHome:currentBlock.
+ (lineNumberInfo == #full) ifTrue:[node lineNr:lnr].
+ ^ node
].
(tokenType == #Primitive) ifTrue:[
- self nextToken.
- node := PrimitiveNode code:tokenValue.
- node isOptional ifFalse:[
- hasNonOptionalPrimitiveCode := true
- ].
- hasPrimitiveCode := true.
- ^ node
+ self nextToken.
+ node := PrimitiveNode code:tokenValue.
+ node isOptional ifFalse:[
+ hasNonOptionalPrimitiveCode := true
+ ].
+ hasPrimitiveCode := true.
+ ^ node
].
(tokenType == #EOF) ifTrue:[
- self syntaxError:'period after last statement'.
- ^ #Error
+ self syntaxError:'period after last statement'.
+ ^ #Error
].
expr := self expression.
@@ -3534,7 +3580,7 @@
Statements must be separated by periods.
statementList ::= <statement>
- | <statementList> . <statement>
+ | <statementList> . <statement>
"
|thisStatement prevStatement firstStatement correctIt periodPos
@@ -3544,75 +3590,75 @@
(thisStatement == #Error) ifTrue:[^ #Error].
firstStatement := thisStatement.
[tokenType == $.] whileTrue:[
- prevExpr := thisStatement expression.
- (prevExpr notNil and:[prevExpr isMessage]) ifTrue:[
- (#(#'=' #'==') includes:prevExpr selector) ifTrue:[
- self warning:'useless computation - mistyped assignment ?'
- ].
- ].
-
- periodPos := tokenPosition.
- self nextToken.
- (tokenType == $]) ifTrue:[
- currentBlock isNil ifTrue:[
- self parseError:'block nesting error'.
- errorFlag := true
+ prevExpr := thisStatement expression.
+ (prevExpr notNil and:[prevExpr isMessage]) ifTrue:[
+ (#(#'=' #'==') includes:prevExpr selector) ifTrue:[
+ self warning:'useless computation - mistyped assignment ?'
+ ].
+ ].
+
+ 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
-
- ] ifFalse:[
- self warning:'period after last statement' position:periodPos
+ *** 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
"
- ].
- ^ 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
-
- ] ifFalse:[
- self warning:'period after last statement' position:periodPos
+ *** 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
"
- ].
- ^ firstStatement
- ].
-
- prevStatement := thisStatement.
- prevStatement isReturnNode ifTrue:[
- self warning:'statements after return' position:tokenPosition
- ].
+ ].
+ ^ firstStatement
+ ].
+
+ prevStatement := thisStatement.
+ prevStatement isReturnNode 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
@@ -3627,20 +3673,20 @@
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 fold:foldConstants.
- (try isMemberOf:String) ifTrue:[
- self parseError:try position:pos to:pos2.
- errorFlag := false. "ok, user wants it - so he'll get it"
- receiver := UnaryNode receiver:receiver selector:sel fold:nil.
- ] ifFalse:[
- receiver := try
- ].
- receiver lineNumber:tokenLineNr.
- parseForCode ifFalse:[self rememberSelectorUsed:sel].
- 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 fold:foldConstants.
+ (try isMemberOf:String) ifTrue:[
+ self parseError:try position:pos to:pos2.
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ receiver := UnaryNode receiver:receiver selector:sel fold:nil.
+ ] ifFalse:[
+ receiver := try
+ ].
+ receiver lineNumber:tokenLineNr.
+ parseForCode ifFalse:[self rememberSelectorUsed:sel].
+ self nextToken.
].
^ receiver
@@ -3657,17 +3703,17 @@
v := self correctVariable.
(v == #Error) ifFalse:[^ v].
parseForCode ifFalse:[
- self rememberGlobalUsed:tokenName
+ self rememberGlobalUsed:tokenName
] ifTrue:[
- tokenName first isLowercase ifTrue:[
- ImplicitSelfSends ifTrue:[
- selfNode isNil ifTrue:[
- selfNode := SelfNode value:selfValue
- ].
- ^ UnaryNode receiver:selfNode selector:('implicit_' , tokenName) asSymbol.
- ].
- ^ #Error
- ]
+ tokenName first isLowercase ifTrue:[
+ ImplicitSelfSends ifTrue:[
+ selfNode isNil ifTrue:[
+ selfNode := SelfNode value:selfValue
+ ].
+ ^ UnaryNode receiver:selfNode selector:('implicit_' , tokenName) asSymbol.
+ ].
+ ^ #Error
+ ]
].
^ VariableNode type:#GlobalVariable name:tokenName asSymbol
@@ -3689,132 +3735,132 @@
"is it a block-arg or block-var ?"
searchBlock := currentBlock.
[searchBlock notNil] whileTrue:[
- 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
- from:currentBlock
- ].
- ].
-
- 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
- from:currentBlock
- ].
-
- ].
-
- 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
+ from:currentBlock
+ ].
+ ].
+
+ 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
+ from:currentBlock
+ ].
+
+ ].
+
+ 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
+ ]
].
classToCompileFor notNil ifTrue:[
- "is it an instance-variable ?"
-
- instIndex := (self classesInstVarNames) lastIndexOf:varName.
- instIndex ~~ 0 ifTrue:[
- parseForCode ifFalse:[self rememberInstVarUsed:varName].
- ^ VariableNode type:#InstanceVariable
- name:varName
- index:instIndex
- selfValue:selfValue
- ].
+ "is it an instance-variable ?"
+
+ instIndex := (self classesInstVarNames) lastIndexOf:varName.
+ instIndex ~~ 0 ifTrue:[
+ parseForCode ifFalse:[self rememberInstVarUsed:varName].
+ ^ VariableNode type:#InstanceVariable
+ name:varName
+ index:instIndex
+ selfValue:selfValue
+ ].
"/ "is it a class-instance-variable ?"
"/
"/ it is not allowed to fetch class-instance variables
"/ from instance methods ...
"/
- instIndex := (self classesClassInstVarNames) lastIndexOf:varName.
- instIndex ~~ 0 ifTrue:[
- aClass := self inWhichClassIsClassInstVar:varName.
- aClass notNil ifTrue:[
- parseForCode ifFalse:[self rememberClassVarUsed:varName].
+ instIndex := (self classesClassInstVarNames) lastIndexOf:varName.
+ instIndex ~~ 0 ifTrue:[
+ aClass := self inWhichClassIsClassInstVar:varName.
+ aClass notNil ifTrue:[
+ parseForCode ifFalse:[self rememberClassVarUsed:varName].
self warning:'access to class-inst-var from inst method will soon be no longer supported'.
- ^ VariableNode type:#ClassInstanceVariable
- name:varName
- index:instIndex
- selfClass:aClass
- ]
- ].
-
- "is it a class-variable ?"
-
- instIndex := (self classesClassVarNames) lastIndexOf:varName.
- instIndex ~~ 0 ifTrue:[
- aClass := self inWhichClassIsClassVar:varName.
- aClass notNil ifTrue:[
- parseForCode ifFalse:[self rememberClassVarUsed:varName].
- ^ VariableNode type:#ClassVariable class:aClass name:varName
- ]
- ].
-
- "is it a private-class ?"
-
- aClass := classToCompileFor.
- aClass isMeta ifTrue:[
- aClass := aClass soleInstance.
- ].
- (aClass privateClassesAt:varName) notNil ifTrue:[
- parseForCode ifFalse:[self rememberGlobalUsed:(aClass name , '::' , varName)].
- ^ VariableNode type:#PrivateClass class:aClass name:varName
- ].
+ ^ VariableNode type:#ClassInstanceVariable
+ name:varName
+ index:instIndex
+ selfClass:aClass
+ ]
+ ].
+
+ "is it a class-variable ?"
+
+ instIndex := (self classesClassVarNames) lastIndexOf:varName.
+ instIndex ~~ 0 ifTrue:[
+ aClass := self inWhichClassIsClassVar:varName.
+ aClass notNil ifTrue:[
+ parseForCode ifFalse:[self rememberClassVarUsed:varName].
+ ^ VariableNode type:#ClassVariable class:aClass name:varName
+ ]
+ ].
+
+ "is it a private-class ?"
+
+ aClass := classToCompileFor.
+ aClass isMeta ifTrue:[
+ aClass := aClass soleInstance.
+ ].
+ (aClass privateClassesAt:varName) notNil ifTrue:[
+ parseForCode ifFalse:[self rememberGlobalUsed:(aClass name , '::' , varName)].
+ ^ VariableNode type:#PrivateClass class:aClass name:varName
+ ].
].
"is it in a namespace ?"
space := self findNameSpaceWith:varName.
space notNil ifTrue:[
- space ~~ Smalltalk ifTrue:[
- parseForCode ifFalse:[self rememberGlobalUsed:(space name , '::' , varName)].
- ^ VariableNode type:#PrivateClass class:space name:varName
- ] ifFalse:[
- parseForCode ifFalse:[self rememberGlobalUsed:varName].
- ^ VariableNode type:#GlobalVariable name:varName asSymbol
- ]
+ space ~~ Smalltalk ifTrue:[
+ parseForCode ifFalse:[self rememberGlobalUsed:(space name , '::' , varName)].
+ ^ VariableNode type:#PrivateClass class:space name:varName
+ ] ifFalse:[
+ parseForCode ifFalse:[self rememberGlobalUsed:varName].
+ ^ VariableNode type:#GlobalVariable name:varName asSymbol
+ ]
].
"is it a global-variable ?"
tokenSymbol := varName asSymbolIfInterned.
tokenSymbol notNil ifTrue:[
- (Smalltalk includesKey:tokenSymbol) ifTrue:[
- parseForCode ifFalse:[self rememberGlobalUsed:varName].
- ^ VariableNode type:#GlobalVariable name:tokenSymbol
- ]
+ (Smalltalk includesKey:tokenSymbol) ifTrue:[
+ parseForCode ifFalse:[self rememberGlobalUsed:varName].
+ ^ VariableNode type:#GlobalVariable name:tokenSymbol
+ ]
].
^ #Error
@@ -3829,16 +3875,17 @@
spc := currentNamespace.
spc isNil ifTrue:[
- (requestor respondsTo:#currentNameSpace) ifTrue:[
- spc := requestor currentNameSpace
- ] ifFalse:[
- spc := Class nameSpaceQuerySignal raise.
- ].
- currentNamespace := spc.
+ (requestor respondsTo:#currentNameSpace) ifTrue:[
+ spc := requestor currentNameSpace
+ ] ifFalse:[
+ spc := Class nameSpaceQuerySignal raise.
+ ].
+ currentNamespace := spc.
].
^ spc
"Created: 19.12.1996 / 23:47:58 / cg"
+ "Modified: 14.10.1997 / 20:56:06 / cg"
!
currentNameSpace:aNameSpace
@@ -3852,12 +3899,12 @@
spaces := currentUsedNamespaces.
spaces isNil ifTrue:[
- (requestor respondsTo:#usedNameSpaces) ifTrue:[
- spaces := requestor usedNameSpaces
- ] ifFalse:[
- spaces := Class usedNameSpaceQuerySignal raise.
- ].
- currentUsedNamespaces := spaces.
+ (requestor respondsTo:#usedNameSpaces) ifTrue:[
+ spaces := requestor usedNameSpaces
+ ] ifFalse:[
+ spaces := Class usedNameSpaceQuerySignal raise.
+ ].
+ currentUsedNamespaces := spaces.
].
^ spaces
@@ -3870,27 +3917,27 @@
"/ private names have already been searched for.
classToCompileFor notNil ifTrue:[
- "/ Q:
- "/ consider private classes of superclasses.
- "/ or search in the top owing classes namespace only ?
-
- "/ for now, ignore other private classes - they are only
- "/ known to the corresponding ownerClass.
-
- "is it in the classes namespace ?"
-
- classToCompileFor isPrivate ifTrue:[
- ns := classToCompileFor topOwningClass nameSpace
- ] ifFalse:[
- ns := classToCompileFor nameSpace.
- ].
-
- (ns notNil
- and:[ns ~~ Smalltalk]) ifTrue:[
- (ns privateClassesAt:aVariableName) notNil ifTrue:[
- ^ ns
- ]
- ].
+ "/ Q:
+ "/ consider private classes of superclasses.
+ "/ or search in the top owing classes namespace only ?
+
+ "/ for now, ignore other private classes - they are only
+ "/ known to the corresponding ownerClass.
+
+ "is it in the classes namespace ?"
+
+ classToCompileFor isPrivate ifTrue:[
+ ns := classToCompileFor topOwningClass nameSpace
+ ] ifFalse:[
+ ns := classToCompileFor nameSpace.
+ ].
+
+ (ns notNil
+ and:[ns ~~ Smalltalk]) ifTrue:[
+ (ns privateClassesAt:aVariableName) notNil ifTrue:[
+ ^ ns
+ ]
+ ].
"/ ns := classToCompileFor nameSpace.
"/ ns notNil ifTrue:[
@@ -3905,24 +3952,24 @@
currentSpace := self currentNameSpace.
(currentSpace notNil
and:[currentSpace ~~ Smalltalk]) ifTrue:[
- (currentSpace privateClassesAt:aVariableName) notNil ifTrue:[
- ^ currentSpace
- ]
+ (currentSpace privateClassesAt:aVariableName) notNil ifTrue:[
+ ^ currentSpace
+ ]
].
"is it in one of the used namespaces ?"
usedSpaces := self currentUsedNameSpaces.
usedSpaces notNil ifTrue:[
- usedSpaces do:[:aNameSpace |
- (aNameSpace privateClassesAt:aVariableName) notNil ifTrue:[
- ^ aNameSpace
- ]
- ]
+ usedSpaces do:[:aNameSpace |
+ (aNameSpace privateClassesAt:aVariableName) notNil ifTrue:[
+ ^ aNameSpace
+ ]
+ ]
].
^ nil
"Created: 19.12.1996 / 23:51:02 / cg"
- "Modified: 10.2.1997 / 19:59:31 / cg"
+ "Modified: 14.10.1997 / 20:56:35 / cg"
! !
!Parser methodsFor:'queries'!
@@ -3931,7 +3978,7 @@
"caching allInstVarNames for next compilation saves time ..."
PrevClassInstVarNames isNil ifTrue:[
- PrevClassInstVarNames := classToCompileFor class allInstVarNames
+ PrevClassInstVarNames := classToCompileFor class allInstVarNames
].
^ PrevClassInstVarNames
@@ -3944,14 +3991,14 @@
|aClass|
PrevClassVarNames isNil ifTrue:[
- aClass := classToCompileFor.
- aClass isMeta ifTrue:[
- aClass := aClass soleInstance.
- aClass isNil ifTrue:[
- aClass := classToCompileFor
- ]
- ].
- PrevClassVarNames := aClass allClassVarNames
+ aClass := classToCompileFor.
+ aClass isMeta ifTrue:[
+ aClass := aClass soleInstance.
+ aClass isNil ifTrue:[
+ aClass := classToCompileFor
+ ]
+ ].
+ PrevClassVarNames := aClass allClassVarNames
].
^ PrevClassVarNames
@@ -3964,14 +4011,14 @@
"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
+ PrevClass notNil ifTrue:[
+ PrevClass removeDependent:Parser
+ ].
+ PrevClass := classToCompileFor.
+ PrevInstVarNames := classToCompileFor allInstVarNames.
+ PrevClassInstVarNames := nil.
+ PrevClassVarNames := nil.
+ PrevClass addDependent:Parser
].
^ PrevInstVarNames
@@ -4205,6 +4252,6 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.146 1997-09-06 23:25:50 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.147 1997-10-15 11:14:50 cg Exp $'
! !
Parser initialize!