--- a/Parser.st Wed Apr 03 23:17:45 2013 +0200
+++ b/Parser.st Wed Apr 03 23:20:57 2013 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -57,33 +57,12 @@
privateIn:Parser
!
-Parser::ParseError subclass:#UndefinedSuperclassError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
-!
-
-Parser::ParseError subclass:#UndefinedVariableError
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
-!
-
-Notification subclass:#UndefinedVariableNotification
- instanceVariableNames:'parser'
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
-!
-
!Parser class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -102,11 +81,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.
@@ -130,16 +109,16 @@
(i.e. something like 'Float pi sin' or '1.5 + 0.3' will be reduced to a constant).
Constant folding can be turned off completely (setting FoldConstants to nil)
- to ``secure folding'', which only folds constant numbers (#level1) or to #full.
- In full mode, more constant expressions are folded (for example: '1.0 @ 1.0' is
- reduced to a constant point), but the resulting code may not be compatible with other
- smalltalk systems (consider the case, where the point is modified using #x: or #y: messages).
+ to ``secure folding'', which only folds constant numbers (#level1) or to #full.
+ In full mode, more constant expressions are folded (for example: '1.0 @ 1.0' is
+ reduced to a constant point), but the resulting code may not be compatible with other
+ smalltalk systems (consider the case, where the point is modified using #x: or #y: messages).
Therefore, this mode is a bit dangerous and disabled by default.
The current implementation, base upon a global constant-folding setting is somewhat stupid
and intermediate - a better solution would be to allow the optimization to be controlled
by a method-pragma, since it may make sense to disable optimization on a method level,
if its known that the used constant objects are subject of modifications as described above.
-
+
Immutable arrays:
@@ -159,143 +138,143 @@
[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.
-
- StringsAreImmutable <Boolean> same as above for string literals
-
- 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.
+
+ StringsAreImmutable <Boolean> same as above for string literals
+
+ 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
"
!
examples
"
- [exBegin]
- Parser
- evaluate:'1+2*3'
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:nil
- [exEnd]
- [exBegin]
+ [exBegin]
+ Parser
+ evaluate:'1+2*3'
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:nil
+ [exEnd]
+ [exBegin]
Parser undefinedVariableNotification handle:[:ex |
- |badName|
-
- badName := ex variableName.
- ex proceedWith:(ConstantNode value:5).
+ |badName|
+
+ badName := ex variableName.
+ ex proceedWith:(ConstantNode value:5).
] do:[
- ^ self compilerClass
- evaluate:'foo * 3'
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:nil
+ ^ self compilerClass
+ evaluate:'foo * 3'
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:nil
]
- [exEnd]
+ [exEnd]
the following are experimental...
- [exBegin]
+ [exBegin]
<pragma: +arrayIndexSyntaxExtension>
|c|
@@ -304,8 +283,8 @@
c[6] := 6.
c[7] := 7.
c[7] := c[4] - c[6].
- [exEnd]
- [exBegin]
+ [exEnd]
+ [exBegin]
<pragma: +arrayIndexSyntaxExtension>
|d|
@@ -314,22 +293,22 @@
d['two'] := 'zwei'.
d['three'] := 'drei'.
- d['two'] , d['three']
- [exEnd]
+ d['two'] , d['three']
+ [exEnd]
Reparse whole image...
- [exBegin]
+ [exBegin]
Smalltalk allClassesDo:[:cls|
- cls isLoaded ifTrue:[
- Transcript show: cls name; show: '...'.
- cls methodsDo:[:mth|
- Parser parseMethod: mth source.
- ].
- Transcript showCR:'OK'.
- ]
+ cls isLoaded ifTrue:[
+ Transcript show: cls name; show: '...'.
+ cls methodsDo:[:mth|
+ Parser parseMethod: mth source.
+ ].
+ Transcript showCR:'OK'.
+ ]
]
- [exEnd]
+ [exEnd]
"
! !
@@ -364,7 +343,7 @@
evaluate:someString for:aReceiver logged:logged
^ self evaluate:someString receiver:aReceiver logged:logged
-
+
! !
@@ -393,6 +372,10 @@
"Created: / 15.11.2001 / 22:57:05 / cg"
!
+undefinedSuperclassError
+ ^ UndefinedSuperclassError
+!
+
undefinedVariableError
^ UndefinedVariableError
!
@@ -407,13 +390,13 @@
"unconditional flush name caches"
[
- PrevClass notNil ifTrue:[
- PrevClass removeDependent:Parser
- ].
- PrevClass := nil.
- PrevInstVarNames := nil.
- PrevClassVarNames := nil.
- PrevClassInstVarNames := nil.
+ PrevClass notNil ifTrue:[
+ PrevClass removeDependent:Parser
+ ].
+ PrevClass := nil.
+ PrevInstVarNames := nil.
+ PrevClassVarNames := nil.
+ PrevClassInstVarNames := nil.
] valueUninterruptably
"Parser flushNameCache"
@@ -423,14 +406,14 @@
"aClass has changed its definition - flush name caches if we have to"
(changedObject == PrevClass) ifTrue:[
- something == #definition ifTrue:[
- self flushNameCache
- ]
+ something == #definition ifTrue:[
+ self flushNameCache
+ ]
].
(changedObject == Smalltalk) ifTrue:[
- something == #classDefinition ifTrue:[
- self flushNameCache
- ]
+ something == #classDefinition ifTrue:[
+ self flushNameCache
+ ]
]
! !
@@ -443,8 +426,8 @@
LineNumberInfo := false.
ParseErrorSignal isNil ifTrue:[
- ParseErrorSignal := ParseError.
- ParseErrorSignal notifierString:'Parse error:'.
+ ParseErrorSignal := ParseError.
+ ParseErrorSignal notifierString:'Parse error:'.
"/ ParseErrorSignal := Error newSignalMayProceed:true.
"/ ParseErrorSignal notifierString:'parse error'.
@@ -531,8 +514,8 @@
"
can be added to your private.rc file:
- Compiler arraysAreImmutable:true
- Compiler arraysAreImmutable:false
+ Compiler arraysAreImmutable:true
+ Compiler arraysAreImmutable:false
"
!
@@ -555,8 +538,8 @@
^ oldLazy
"
- Compiler compileLazy:false
- Compiler compileLazy:true
+ Compiler compileLazy:false
+ Compiler compileLazy:true
"
!
@@ -571,10 +554,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
@@ -596,7 +579,7 @@
"
ParserFlags implicitSelfSends:true
- ParserFlags implicitSelfSends:false
+ ParserFlags implicitSelfSends:false
"
!
@@ -628,8 +611,8 @@
"
can be added to your private.rc file:
- ParserFlags stringsAreImmutable:true
- ParserFlags stringsAreImmutable:false
+ ParserFlags stringsAreImmutable:true
+ ParserFlags stringsAreImmutable:false
"
"Created: / 3.8.1998 / 14:53:28 / cg"
@@ -637,31 +620,31 @@
warnAboutBadComments:aBoolean
"controls generation of warning messages about empty comments"
-
+
ParserFlags warnAboutBadComments:aBoolean
!
-warnAboutVariableNameConventions
+warnAboutVariableNameConventions
"controls generation of warning messages about wrong variable names"
-
+
^ ParserFlags warnAboutVariableNameConventions
!
-warnAboutVariableNameConventions:aBoolean
+warnAboutVariableNameConventions:aBoolean
"controls generation of warning messages about wrong variable names"
-
+
ParserFlags warnAboutVariableNameConventions:aBoolean
!
warnAboutWrongVariableNames
"controls generation of warning messages about wrong variable names"
-
+
^ ParserFlags warnAboutWrongVariableNames
!
warnAboutWrongVariableNames:aBoolean
"controls generation of warning messages about wrong variable names"
-
+
ParserFlags warnAboutWrongVariableNames:aBoolean
!
@@ -716,58 +699,58 @@
lcSelector := aString asLowercase.
block := [:sym :mthd|
- |similarity lcSym keepThis|
-
- lcSym := sym asLowercase.
- (info contains:[:i | i key == sym]) ifFalse:[
- similarity := lcSelector spellAgainst:lcSym. "/ 0..100
- forCompletion ifTrue:[
- (lcSym startsWith:lcSelector) ifTrue:[
- similarity := similarity + (aString size * 10).
- ].
- aClassOrNil == mthd mclass ifTrue:[
- similarity := similarity * 2.
- ].
- ].
-
- (similarity > 20) ifTrue:[
- (info contains:[:entry | entry key = sym]) ifFalse:[
- keepThis := true.
- info size >= nMax ifTrue:[
- "will remove last entry anyway - so check if this one will remain..."
- similarity < info last value ifTrue:[
- keepThis := false.
- ]
- ].
- keepThis ifTrue:[
- "expensive - therefore do this check at last"
- mthd isObsolete ifFalse:[
- info add:(sym -> similarity).
- info size > nMax ifTrue:[
- info removeLast.
- ]
- ]
- ]
- ]
- ]
- ]
+ |similarity lcSym keepThis|
+
+ lcSym := sym asLowercase.
+ (info contains:[:i | i key == sym]) ifFalse:[
+ similarity := lcSelector spellAgainst:lcSym. "/ 0..100
+ forCompletion ifTrue:[
+ (lcSym startsWith:lcSelector) ifTrue:[
+ similarity := similarity + (aString size * 10).
+ ].
+ aClassOrNil == mthd mclass ifTrue:[
+ similarity := similarity * 2.
+ ].
+ ].
+
+ (similarity > 20) ifTrue:[
+ (info contains:[:entry | entry key = sym]) ifFalse:[
+ keepThis := true.
+ info size >= nMax ifTrue:[
+ "will remove last entry anyway - so check if this one will remain..."
+ similarity < info last value ifTrue:[
+ keepThis := false.
+ ]
+ ].
+ keepThis ifTrue:[
+ "expensive - therefore do this check at last"
+ mthd isObsolete ifFalse:[
+ info add:(sym -> similarity).
+ info size > nMax ifTrue:[
+ info removeLast.
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
].
aClassOrNil isNil ifTrue:[
- Smalltalk allClassesDo:[:cls |
- cls methodDictionary keysAndValuesDo:block.
- cls class methodDictionary keysAndValuesDo:block.
- ]
+ Smalltalk allClassesDo:[:cls |
+ cls methodDictionary keysAndValuesDo:block.
+ cls class methodDictionary keysAndValuesDo:block.
+ ]
] ifFalse:[
- (searchClass := aClassOrNil) isLoaded ifFalse:[
- searchClass := searchClass autoload
- ].
- searchClass notNil ifTrue:[
- searchClass withAllSuperclassesDo:[:cls |
- cls methodDictionary keysAndValuesDo:block.
- "/ cls class methodDictionary keysAndValuesDo:block.
- ]
- ]
+ (searchClass := aClassOrNil) isLoaded ifFalse:[
+ searchClass := searchClass autoload
+ ].
+ searchClass notNil ifTrue:[
+ searchClass withAllSuperclassesDo:[:cls |
+ cls methodDictionary keysAndValuesDo:block.
+ "/ cls class methodDictionary keysAndValuesDo:block.
+ ]
+ ]
].
^ info asOrderedCollection collect:[:a | a key]
@@ -804,14 +787,14 @@
"return the result of evaluating an expression in aStringOrStream.
No doit-entry is added to the changeLog."
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:nil
- compile:true
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:nil
+ compile:true
"
Compiler evaluate:'1 + 2'
@@ -821,8 +804,8 @@
!
evaluate:aStringOrStream compile:compile
- "return the result of evaluating aString,
- The compile argument specifies if the string should be compiled down to
+ "return the result of evaluating aString,
+ The compile argument specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -830,14 +813,14 @@
reading and simple sends, where the overhead of compilation is bigger
than the interpretation overhead."
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:nil
- compile:compile
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:nil
+ compile:compile
!
evaluate:aStringOrStream ifFail:failBlock
@@ -845,59 +828,59 @@
In case of any syntax errors, return the value of failBlock.
No doit-entry is added to the changeLog."
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:failBlock
- compile:true
- "
- Compiler evaluate:'1 +' ifFail:['oops']
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:failBlock
+ compile:true
+ "
+ Compiler evaluate:'1 +' ifFail:['oops']
"
!
evaluate:aStringOrStream in:aContext receiver:anObject notifying:requestor ifFail:failBlock
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
- No doIt entry is added to the change-file.
+ No doIt entry is added to the change-file.
If the failBlock argument is non-nil, it is evaluated if an error occurs."
- ^ self
- evaluate:aStringOrStream
- in:aContext
- receiver:anObject
- notifying:requestor
- logged:false
- ifFail:nil
- compile:true
+ ^ self
+ evaluate:aStringOrStream
+ in:aContext
+ receiver:anObject
+ notifying:requestor
+ logged:false
+ ifFail:nil
+ compile:true
"Modified: / 17.1.1998 / 02:54:07 / cg"
!
evaluate:aStringOrStream in:aContext receiver:anObject notifying:requestor logged:logged ifFail:failBlock
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs."
- ^ self
- evaluate:aStringOrStream
- in:aContext
- receiver:anObject
- notifying:requestor
- logged:logged
- ifFail:failBlock
- compile:true
+ ^ self
+ evaluate:aStringOrStream
+ in:aContext
+ receiver:anObject
+ notifying:requestor
+ logged:logged
+ ifFail:failBlock
+ compile:true
!
evaluate:aStringOrStream in:aContext receiver:anObject notifying:requestor logged:logged ifFail:failBlock compile:compile
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -906,54 +889,54 @@
than the interpretation overhead."
^ self new
- allowUndeclaredVariables:false;
-
- evaluate:aStringOrStream
- in:aContext
- receiver:anObject
- notifying:requestor
- logged:logged
- ifFail:failBlock
- compile:compile
- checkForEndOfInput:(aStringOrStream isStream not)
+ allowUndeclaredVariables:false;
+
+ evaluate:aStringOrStream
+ in:aContext
+ receiver:anObject
+ notifying:requestor
+ logged:logged
+ ifFail:failBlock
+ compile:compile
+ checkForEndOfInput:(aStringOrStream isStream not)
!
evaluate:aStringOrStream logged:logged
"return the result of evaluating an expression in aStringOrStream.
The argument log controls if an entry is added to the changeLog."
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:logged
- ifFail:nil
- compile:true
- "
- Compiler evaluate:'''some string''' logged:false
- Compiler evaluate:'''some string''' logged:true
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:logged
+ ifFail:nil
+ compile:true
+ "
+ Compiler evaluate:'''some string''' logged:false
+ Compiler evaluate:'''some string''' logged:true
"
!
evaluate:aStringOrStream notifying:requestor
- "return the result of evaluating aString,
+ "return the result of evaluating aString,
errors are reported to requestor"
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:requestor
- logged:false
- ifFail:nil
- compile:true
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:requestor
+ logged:false
+ ifFail:nil
+ compile:true
!
evaluate:aStringOrStream notifying:requestor compile:compile
- "return the result of evaluating aString,
+ "return the result of evaluating aString,
errors are reported to requestor.
- The compile argument specifies if the string should be compiled down to
+ The compile argument specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -961,43 +944,43 @@
reading and simple sends, where the overhead of compilation is bigger
than the interpretation overhead."
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:requestor
- logged:false
- ifFail:nil
- compile:compile
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:requestor
+ logged:false
+ ifFail:nil
+ compile:compile
!
evaluate:aStringOrStream notifying:requestor logged:logged
- "return the result of evaluating aString,
+ "return the result of evaluating aString,
errors are reported to requestor"
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:requestor
- logged:logged
- ifFail:nil
- compile:true
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:requestor
+ logged:logged
+ ifFail:nil
+ compile:true
!
evaluate:aStringOrStream receiver:anObject
- "return the result of evaluating aString,
+ "return the result of evaluating aString,
errors are reported to requestor. Allow access to
anObject as self and to its instVars "
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:anObject
- notifying:nil
- logged:false
- ifFail:nil
- compile:true
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:nil
+ logged:false
+ ifFail:nil
+ compile:true
"
Compiler evaluate:'self x' receiver:(1 @ 2)
@@ -1011,46 +994,46 @@
"return the result of evaluating an expression in aStringOrStream.
The argument log controls if an entry is added to the changeLog."
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:someOne
- notifying:nil
- logged:logged
- ifFail:nil
- compile:true
- "
- Compiler evaluate:'''some string''' logged:false
- Compiler evaluate:'''some string''' logged:true
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:someOne
+ notifying:nil
+ logged:logged
+ ifFail:nil
+ compile:true
+ "
+ Compiler evaluate:'''some string''' logged:false
+ Compiler evaluate:'''some string''' logged:true
Compiler evaluate:'self class' receiver:nil logged:false
- Compiler evaluate:'self class' receiver:1 logged:false
+ Compiler evaluate:'self class' receiver:1 logged:false
"
!
evaluate:aStringOrStream receiver:anObject notifying:requestor
- "return the result of evaluating aString,
+ "return the result of evaluating aString,
errors are reported to requestor. Allow access to
anObject as self and to its instVars (used in the inspector)"
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:anObject
- notifying:requestor
- logged:false
- ifFail:nil
- compile:true
-
- "
- Compiler evaluate:'self x' receiver:(1 @ 2) notifying:nil
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:requestor
+ logged:false
+ ifFail:nil
+ compile:true
+
+ "
+ Compiler evaluate:'self x' receiver:(1 @ 2) notifying:nil
"
!
evaluate:aStringOrStream receiver:anObject notifying:requestor compile:compile
- "return the result of evaluating aString,
+ "return the result of evaluating aString,
errors are reported to requestor. Allow access to
anObject as self and to its instVars (used in the inspector).
- The compile argument specifies if the string should be compiled down to
+ The compile argument specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -1058,14 +1041,14 @@
reading and simple sends, where the overhead of compilation is bigger
than the interpretation overhead."
- ^ self
- evaluate:aStringOrStream
- in:nil
- receiver:anObject
- notifying:requestor
- logged:false
- ifFail:nil
- compile:compile
+ ^ self
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:requestor
+ logged:false
+ ifFail:nil
+ compile:compile
!
evaluateFrom:aStringOrStream ifFail:failBlock
@@ -1073,25 +1056,25 @@
In case of any syntax errors, return the value of failBlock.
No doit-entry is added to the changeLog."
- ^ self
- evaluateFrom:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:failBlock
- compile:true
- "
- Compiler evaluate:'1 + 2' ifFail:['oops']
+ ^ self
+ evaluateFrom:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:failBlock
+ compile:true
+ "
+ Compiler evaluate:'1 + 2' ifFail:['oops']
"
!
evaluateFrom:aStringOrStream in:aContext receiver:anObject notifying:requestor logged:logged ifFail:failBlock compile:compile
- "return the result of evaluating the next expression from aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating the next expression from aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -1100,14 +1083,14 @@
than the interpretation overhead."
^ self new
- evaluate:aStringOrStream
- in:aContext
- receiver:anObject
- notifying:requestor
- logged:logged
- ifFail:failBlock
- compile:compile
- checkForEndOfInput:false
+ evaluate:aStringOrStream
+ in:aContext
+ receiver:anObject
+ notifying:requestor
+ logged:logged
+ ifFail:failBlock
+ compile:compile
+ checkForEndOfInput:false
! !
!Parser class methodsFor:'general helpers'!
@@ -1132,14 +1115,14 @@
comments := parser comments.
comments size ~~ 0 ifTrue:[
- comment := comments first asString.
- (comment withoutSpaces endsWith:'}') ifTrue:[
- "if first comment is a pragma, take next comment"
- comment := comments at:2 ifAbsent:nil.
- comment notNil ifTrue:[
- comment := comment string.
- ].
- ].
+ comment := comments first asString.
+ (comment withoutSpaces endsWith:'}') ifTrue:[
+ "if first comment is a pragma, take next comment"
+ comment := comments at:2 ifAbsent:nil.
+ comment notNil ifTrue:[
+ comment := comment string.
+ ].
+ ].
].
^ comment.
@@ -1154,7 +1137,7 @@
!Parser class methodsFor:'parsing'!
blockAtLine:line in:aMethod orSource:aString numArgs:nA numVars:nV
- "given a lineNr in some method,
+ "given a lineNr in some method,
return the containing BlockNode or nil.
The given lineNr must be within a block for this to work.
This is used by the debugger, to guess reverse from a lineNumber,
@@ -1162,38 +1145,38 @@
variable names (mhmh - all of this wasnt't needed, if blocks stored
their characterPosition internally)."
- |compiler tree mSource who mClass blocks
+ |compiler tree mSource who mClass blocks
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].
- ].
- m 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].
+ ].
+ m 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"
@@ -1205,71 +1188,71 @@
compiler ignoreErrors:true.
compiler lineNumberInfo:#full.
- Notification
- handle:
- [:ex |
- ex proceed
- ]
- do:[
- aMethod notNil ifTrue:[
- (compiler parseMethodSpec == #Error) ifTrue:[
- ^ nil.
- ].
-
- who notNil ifTrue:[
- compiler selector ~~ (who methodSelector) ifTrue:[
- ^ nil
- ]
- ].
- ] ifFalse:[
- compiler nextToken.
- ].
-
- tree := compiler parseMethodBody.
- ].
-
- (compiler errorFlag
+ Notification
+ handle:
+ [:ex |
+ ex proceed
+ ]
+ do:[
+ aMethod notNil ifTrue:[
+ (compiler parseMethodSpec == #Error) ifTrue:[
+ ^ nil.
+ ].
+
+ who notNil ifTrue:[
+ compiler selector ~~ (who methodSelector) ifTrue:[
+ ^ nil
+ ]
+ ].
+ ] ifFalse:[
+ compiler nextToken.
+ ].
+
+ tree := compiler parseMethodBody.
+ ].
+
+ (compiler errorFlag
or:[tree == #Error
or:[tree isNil]]) 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.
@@ -1282,7 +1265,7 @@
Return a parser (if ok), nil (empty) or #Error (syntax).
The parser can be queried for selector, receiver, args, locals,
used selectors, modified instvars, referenced classvars etc.
- The noErrors and noWarnings arguments specify if error and warning
+ The noErrors and noWarnings arguments specify if error and warning
messages should be sent to the Transcript or suppressed."
|parser tree|
@@ -1298,34 +1281,34 @@
"
self
- checkMethod:'foo
- |local1 local2 local3|
-
- local1 := local2.
- ^ local3
- '
- in:UndefinedObject
- ignoreErrors:true
- ignoreWarnings:true
+ checkMethod:'foo
+ |local1 local2 local3|
+
+ local1 := local2.
+ ^ local3
+ '
+ in:UndefinedObject
+ ignoreErrors:true
+ ignoreWarnings:true
"
"Modified: / 30.10.1997 / 16:38:31 / cg"
!
parseExpression:aString
- "parse aString as an expression;
- Return the parseTree (if ok), nil (for an empty string
+ "parse aString as an expression;
+ Return the parseTree (if ok), nil (for an empty string
or comment only) or #Error (syntactic error).
Error and warning messages are suppressed."
- ^ self
- withSelf:nil
- parseExpression:aString
- onError:#Error
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
- inNameSpace:nil
+ ^ self
+ withSelf:nil
+ parseExpression:aString
+ onError:#Error
+ notifying:nil
+ ignoreErrors:true "silence on Transcript"
+ ignoreWarnings:true
+ inNameSpace:nil
"
Parser parseExpression:'self foo'
@@ -1335,57 +1318,57 @@
!
parseExpression:aString inNameSpace:aNameSpaceOrNil
- "parse aString as an expression;
- Return the parseTree (if ok), nil (for an empty string
+ "parse aString as an expression;
+ Return the parseTree (if ok), nil (for an empty string
or comment only) or #Error (syntactic error).
Error and warning messages are suppressed."
- ^ self
- withSelf:nil
- parseExpression:aString
- onError:#Error
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
- inNameSpace:aNameSpaceOrNil
+ ^ self
+ withSelf:nil
+ parseExpression:aString
+ onError:#Error
+ 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"
!
parseExpression:aString inNameSpace:aNameSpaceOrNil onError:errorValue
- "parse aString as an expression;
- Return the parseTree (if ok), nil (for an empty string
+ "parse aString as an expression;
+ Return the parseTree (if ok), nil (for an empty string
or comment only) or errorValue (syntactic error).
Error and warning messages are suppressed."
- ^ self
- withSelf:nil
- parseExpression:aString
- onError:errorValue
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
- inNameSpace:aNameSpaceOrNil
+ ^ self
+ withSelf:nil
+ parseExpression:aString
+ onError:errorValue
+ 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"
!
parseExpression:aString onError:errorValue
- "parse aString as an expression;
- Return the parseTree (if ok), nil (for an empty string
+ "parse aString as an expression;
+ Return the parseTree (if ok), nil (for an empty string
or comment only) or errorValue (syntactic error).
Error and warning messages are suppressed."
- ^ self
- withSelf:nil
- parseExpression:aString
- onError:errorValue
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
- inNameSpace:nil
+ ^ self
+ withSelf:nil
+ parseExpression:aString
+ onError:errorValue
+ notifying:nil
+ ignoreErrors:true "silence on Transcript"
+ ignoreWarnings:true
+ inNameSpace:nil
"Modified: 24.6.1997 / 16:44:00 / cg"
!
@@ -1411,13 +1394,13 @@
"
|p|
- p := Parser
- parseMethod:'
- foo:arg1 bar:arg2 baz:arg3
- |l1 l2|
- l1 := 0.
- l2 := arg1.
- ^ self'.
+ p := Parser
+ parseMethod:'
+ foo:arg1 bar:arg2 baz:arg3
+ |l1 l2|
+ l1 := 0.
+ l2 := arg1.
+ ^ self'.
'nArgs: ' print. p numberOfMethodArgs printNL.
'args: ' print. p methodArgs printNL.
@@ -1437,11 +1420,11 @@
used selectors, modified instvars, referenced classvars etc.
Error and warning messages are sent to the Transcript."
- ^ self
- parseMethod:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
+ ^ self
+ parseMethod:aString
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
"Modified: 24.4.1996 / 13:18:34 / cg"
!
@@ -1451,12 +1434,12 @@
Return a parser (if ok) or #Error (syntax).
The parser can be queried for selector, receiver, args, locals,
used selectors, modified instvars, referenced classvars etc.
- The noErrors and noWarnings arguments specify if error and warning
+ The noErrors and noWarnings arguments specify if error and warning
messages should be sent to the Transcript or suppressed."
|parser|
- parser := self new.
+ parser := self new.
parser parseMethod:aString in:aClass ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings.
^ parser
@@ -1469,17 +1452,17 @@
Return a parser (if ok), nil (empty) or #Error (syntax).
The parser can be queried for selector, receiver, args, locals,
used selectors, modified instvars, referenced classvars etc.
- The warnBoolean arguments specifies if warning
+ The warnBoolean arguments specifies if warning
messages should be sent to the Transcript or suppressed.
This method is OBSOLETE, and left in for backward compatibility."
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"
!
@@ -1498,10 +1481,10 @@
"
|p|
- p := Parser
- parseMethodArgAndVarSpecification:'
- foo:arg1 bar:arg2 baz:arg3
- |l1 l2|'.
+ p := Parser
+ parseMethodArgAndVarSpecification:'
+ foo:arg1 bar:arg2 baz:arg3
+ |l1 l2|'.
'nArgs: ' print. p numberOfMethodArgs printNL.
'args: ' print. p methodArgs printNL.
@@ -1522,20 +1505,20 @@
This method is OBSOLETE."
self obsoleteMethodWarning.
- ^ self parseMethodArgAndVarSpecification:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
- parseBody:false
+ ^ self parseMethodArgAndVarSpecification:aString
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
+ parseBody:false
"Modified: 24.4.1996 / 13:30:03 / cg"
!
parseMethodArgAndVarSpecification:aString in:aClass ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings parseBody:body
"parse a methods selector, arg and var spec in a given class;
- If parseBody is true, also parse the statements
+ If parseBody is true, also parse the statements
(for primitives & resourceSpecs).
- The noErrors and noWarnings arguments specify if error and warning
+ The noErrors and noWarnings arguments specify if error and warning
messages should be sent to the Transcript or suppressed.
Return a parser (if ok), nil (empty) or #Error (syntax).
@@ -1554,9 +1537,9 @@
"/ - now, alternatively parse body for resource & primitive specs ..
"/
body ifTrue:[
- parser parseMethodBodyOrEmpty
+ parser parseMethodBodyOrEmpty
] ifFalse:[
- parser parseMethodBodyVarSpec
+ parser parseMethodBodyVarSpec
].
parser errorFlag ifTrue:[^ nil].
^ parser
@@ -1584,11 +1567,11 @@
Like #parseMethodArgAndVarSpecification:in:, but does not
display error/warning messages on the transcript."
- ^ self parseMethodArgAndVarSpecification:aString
- in:aClass
- ignoreErrors:true
- ignoreWarnings:true
- parseBody:false
+ ^ self parseMethodArgAndVarSpecification:aString
+ in:aClass
+ ignoreErrors:true
+ ignoreWarnings:true
+ parseBody:false
"Modified: 24.4.1996 / 13:14:27 / cg"
!
@@ -1612,17 +1595,17 @@
used selectors, modified instvars, referenced classvars etc.
Like #parseMethod:in:, but warning/error messages are suppressed."
- ^ self
- parseMethod:aString
- in:aClass
- ignoreErrors:true
- ignoreWarnings:true
+ ^ self
+ parseMethod:aString
+ in:aClass
+ ignoreErrors:true
+ ignoreWarnings:true
"Modified: 24.4.1996 / 13:32:57 / cg"
!
parseMethodSpecification:aString
- "parse a methods selector & arg specification;
+ "parse a methods selector & arg specification;
Return a parser (if ok), nil (empty) or #Error (syntax).
The parser can be queried for selector, receiver etc."
@@ -1643,13 +1626,13 @@
Return a parser (if ok), nil (empty) or #Error (syntax).
The parser can be queried for selector, receiver etc."
- ^ self parseMethodSpecification:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
-!
-
-parseMethodSpecification:aString in:aClass ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings
+ ^ self parseMethodSpecification:aString
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
+!
+
+parseMethodSpecification:aString in:aClass ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings
"parse a methods selector & arg spec for a given class;
Return a parser (if ok), nil (empty) or #Error (syntax).
The parser can be queried for selector, receiver etc.
@@ -1671,7 +1654,7 @@
!
parseMethodSpecificationSilent:aString
- "parse a methods selector & arg specification;
+ "parse a methods selector & arg specification;
Return a parser (if ok), nil (empty) or #Error (syntax).
The parser can be queried for selector, receiver etc.
Like #parseMethodSpecification:, but does not display any error/warning Messages on the transcript."
@@ -1685,10 +1668,10 @@
The parser can be queried for selector, receiver etc.
Like #parseMethodSpecification:in:, but does not display any error/warning Messages on the transcript."
- ^ self parseMethodSpecification:aString
- in:aClass
- ignoreErrors:true
- ignoreWarnings:true
+ ^ self parseMethodSpecification:aString
+ in:aClass
+ ignoreErrors:true
+ ignoreWarnings:true
"Created: 31.10.1995 / 14:37:49 / cg"
!
@@ -1704,33 +1687,33 @@
stringParsed := aString withoutSeparators.
stringParsed isEmpty ifTrue:[^ nil].
(stringParsed startsWith:'^') ifTrue:[
- stringParsed := stringParsed copyFrom:2.
- ].
-
- Error
- handle:[:ex | ]
- do:[
- tree := self withSelf:nil
- parseExpression:stringParsed
- notifying:nil
- ignoreErrors:true
- ignoreWarnings:true.
- ].
+ stringParsed := stringParsed copyFrom:2.
+ ].
+
+ Error
+ handle:[:ex | ]
+ do:[
+ tree := self withSelf:nil
+ parseExpression:stringParsed
+ 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:[
- (expression := tree expression) isMessage ifTrue:[
- tree := expression
- ]
- ].
- tree isMessage ifTrue:[
- ^ tree selector
- ].
+ (tree isAssignment
+ or:[tree isReturnNode]) ifTrue:[
+ (expression := tree expression) isMessage ifTrue:[
+ tree := expression
+ ]
+ ].
+ tree isMessage ifTrue:[
+ ^ tree selector
+ ].
].
"
@@ -1738,72 +1721,72 @@
"
parser := self for:(ReadStream on:stringParsed).
parser ignoreErrors:true.
- Error
- handle:[:ex | ]
- do:[
- parser nextToken.
- sel := parser degeneratedKeywordExpressionForSelector
- ].
+ Error
+ handle:[:ex | ]
+ do:[
+ parser nextToken.
+ sel := parser degeneratedKeywordExpressionForSelector
+ ].
^ sel
"
- Parser selectorInExpression:'foo at:1 put:(5 * bar)'
- Parser selectorInExpression:'(foo at:1) at:1'
- Parser selectorInExpression:'a + 4'
- Parser selectorInExpression:'a negated'
- Parser selectorInExpression:'at:1 put:5'
- Parser selectorInExpression:'at:1 put:'
- Parser selectorInExpression:'a at:1 put:5'
- Parser selectorInExpression:'a at:1 put:'
- Parser selectorInExpression:'a := foo at:1 put:5'
+ Parser selectorInExpression:'foo at:1 put:(5 * bar)'
+ Parser selectorInExpression:'(foo at:1) at:1'
+ Parser selectorInExpression:'a + 4'
+ Parser selectorInExpression:'a negated'
+ Parser selectorInExpression:'at:1 put:5'
+ Parser selectorInExpression:'at:1 put:'
+ Parser selectorInExpression:'a at:1 put:5'
+ Parser selectorInExpression:'a at:1 put:'
+ Parser selectorInExpression:'a := foo at:1 put:5'
"
"Modified (comment): / 28-02-2012 / 10:11:15 / cg"
!
-withSelf:anObject parseExpression:aString notifying:someOne
+withSelf:anObject parseExpression:aString notifying:someOne
"parse aString as an expression with self set to anObject;
- Return the parseTree (if ok), nil (for an empty string
+ Return the parseTree (if ok), nil (for an empty string
or comment only ) or #Error (syntactic error).
Errors and warnings are forwarded to someOne (usually some
codeView) which can highlight it and show a popup box."
- ^ self
- withSelf:anObject
- parseExpression:aString
- onError:#Error
- notifying:someOne
- ignoreErrors:false
- ignoreWarnings:false
- inNameSpace:nil
+ ^ self
+ withSelf:anObject
+ parseExpression:aString
+ onError:#Error
+ notifying:someOne
+ ignoreErrors:false
+ ignoreWarnings:false
+ inNameSpace:nil
"Modified: 24.6.1997 / 16:43:37 / cg"
!
withSelf:anObject parseExpression:aString notifying:someOne ignoreErrors:ignore
"parse aString as an expression with self set to anObject;
- Return the parseTree (if ok), nil (for an empty string
+ Return the parseTree (if ok), nil (for an empty string
or comment only ) or #Error (syntactic error).
Errors and warnings are forwarded to someOne (usually some
codeView) which can highlight it and show a popup box."
- ^ self
- withSelf:anObject
- parseExpression:aString
- onError:#Error
- notifying:someOne
- ignoreErrors:ignore
- ignoreWarnings:ignore
- inNameSpace:nil
+ ^ self
+ withSelf:anObject
+ parseExpression:aString
+ onError:#Error
+ notifying:someOne
+ ignoreErrors:ignore
+ ignoreWarnings:ignore
+ inNameSpace:nil
"Modified: 24.6.1997 / 16:43:26 / cg"
!
withSelf:anObject parseExpression:aString notifying:someOne ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings
"parse aString as an expression with self set to anObject;
- Return the parseTree (if ok), nil (for an empty string
+ Return the parseTree (if ok), nil (for an empty string
or comment only ) or #Error (syntactic error).
Errors and warnings are forwarded to someOne (usually some
@@ -1811,20 +1794,20 @@
iff ignoreErrors/ignoreWarnings is true respectively."
^ self
- withSelf:anObject
- parseExpression:aString
- onError:#Error
- notifying:someOne
- ignoreErrors:ignoreErrors
- ignoreWarnings:ignoreWarnings
- inNameSpace:nil
+ withSelf:anObject
+ parseExpression:aString
+ onError:#Error
+ notifying:someOne
+ ignoreErrors:ignoreErrors
+ ignoreWarnings:ignoreWarnings
+ inNameSpace:nil
"Modified: 24.6.1997 / 16:43:12 / cg"
!
withSelf:anObject parseExpression:aString notifying:someOne ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings inNameSpace:aNameSpaceOrNil
"parse aString as an expression with self set to anObject;
- Return the parseTree (if ok), nil (for an empty string
+ Return the parseTree (if ok), nil (for an empty string
or comment only ) or #Error (syntactic error).
Errors and warnings are forwarded to someOne (usually some
@@ -1832,18 +1815,18 @@
iff ignoreErrors/ignoreWarnings is true respectively."
^ self
- withSelf:anObject
- parseExpression:aString
- onError:#Error
- notifying:someOne
- ignoreErrors:ignoreErrors
- ignoreWarnings:ignoreWarnings
- inNameSpace:aNameSpaceOrNil
+ withSelf:anObject
+ parseExpression:aString
+ onError:#Error
+ notifying:someOne
+ ignoreErrors:ignoreErrors
+ ignoreWarnings:ignoreWarnings
+ inNameSpace:aNameSpaceOrNil
!
withSelf:anObject parseExpression:aString onError:errorValue notifying:someOne ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings inNameSpace:aNameSpaceOrNil
"parse aString as an expression with self set to anObject;
- Return the parseTree (if ok), nil (for an empty string
+ Return the parseTree (if ok), nil (for an empty string
or comment only ) or errorValue (syntactic error).
Errors and warnings are forwarded to someOne (usually some
@@ -1855,14 +1838,14 @@
aString isNil ifTrue:[^ nil].
parser := self for:(ReadStream on:aString).
- tree := parser
- parseExpressionWithSelf:anObject
- notifying:someOne
- ignoreErrors:ignoreErrors
- ignoreWarnings:ignoreWarnings
- inNameSpace:aNameSpaceOrNil.
+ tree := parser
+ parseExpressionWithSelf:anObject
+ notifying:someOne
+ ignoreErrors:ignoreErrors
+ ignoreWarnings:ignoreWarnings
+ inNameSpace:aNameSpaceOrNil.
tree == #Error ifTrue:[
- ^ errorValue value
+ ^ errorValue value
].
^ tree
@@ -1878,7 +1861,7 @@
selectorSymbol isNil ifTrue:[^ false].
Smalltalk allClassesAndMetaclassesDo:[:cls |
- (cls includesSelector:selectorSymbol) ifTrue:[^ true].
+ (cls includesSelector:selectorSymbol) ifTrue:[^ true].
].
^ false
@@ -1890,7 +1873,7 @@
newObject := anObject copy.
what notNil ifTrue:[
- newObject changeClassTo:what.
+ newObject changeClassTo:what.
].
newObject beImmutable.
^ newObject
@@ -1919,24 +1902,24 @@
n := aSelector numArgs.
n == 1 ifTrue:[
- argNames := #('arg')
+ argNames := #('arg')
] ifFalse:[
- n <= 15 ifTrue:[
- argNames := #('arg1' 'arg2' 'arg3' 'arg4' 'arg5' 'arg6'
- 'arg7' 'arg8' 'arg9' 'arg10' 'arg11' 'arg12'
- 'arg13' 'arg14' 'arg15')
- ] ifFalse:[
- argNames := (1 to:aSelector numArgs) collect:[:i | 'arg' , i printString].
- ].
+ n <= 15 ifTrue:[
+ argNames := #('arg1' 'arg2' 'arg3' 'arg4' 'arg5' 'arg6'
+ 'arg7' 'arg8' 'arg9' 'arg10' 'arg11' 'arg12'
+ 'arg13' 'arg14' 'arg15')
+ ] ifFalse:[
+ argNames := (1 to:aSelector numArgs) collect:[:i | 'arg' , i printString].
+ ].
].
^ self methodSpecificationForSelector:aSelector argNames:argNames
"
- Parser methodSpecificationForSelector:#foo:
- Parser methodSpecificationForSelector:#foo:bar:
- Parser methodSpecificationForSelector:#foo:bar:baz:
- Parser methodSpecificationForSelector:#+
- Parser methodSpecificationForSelector:#negated
+ Parser methodSpecificationForSelector:#foo:
+ Parser methodSpecificationForSelector:#foo:bar:
+ Parser methodSpecificationForSelector:#foo:bar:baz:
+ Parser methodSpecificationForSelector:#+
+ Parser methodSpecificationForSelector:#negated
"
"Modified: / 12.2.1999 / 13:12:44 / cg"
@@ -1952,25 +1935,25 @@
s := WriteStream on:String new.
nargs := aSelector numArgs.
nargs == 0 ifTrue:[
- s nextPutAll:aSelector
+ s nextPutAll:aSelector
] ifFalse:[
- parts := aSelector partsIfSelector.
- 1 to:nargs do:[:i |
- part := parts at:i.
- s nextPutAll:part.
- (part endsWith:$:) ifFalse:[
- s space.
- ].
- s nextPutAll:(argNames at:i).
- i ~~ nargs ifTrue:[s space].
- ]
+ parts := aSelector partsIfSelector.
+ 1 to:nargs do:[:i |
+ part := parts at:i.
+ s nextPutAll:part.
+ (part endsWith:$:) ifFalse:[
+ s space.
+ ].
+ s nextPutAll:(argNames at:i).
+ i ~~ nargs ifTrue:[s space].
+ ]
].
^ s contents
"
- Parser methodSpecificationForSelector:#foo:bar: argNames:#('one' 'two' 'three')
- Parser methodSpecificationForSelector:#+ argNames:#('one')
- Parser methodSpecificationForSelector:#negated
+ Parser methodSpecificationForSelector:#foo:bar: argNames:#('one' 'two' 'three')
+ Parser methodSpecificationForSelector:#+ argNames:#('one')
+ Parser methodSpecificationForSelector:#negated
"
"Modified: / 12.2.1999 / 12:33:50 / cg"
@@ -1987,13 +1970,13 @@
"/ stupid - there seem to be differences among the various
"/ ST dialects ...
aClassOrContext isBehavior ifTrue:[
- self setClassToCompileFor:aClassOrContext.
- selfValue := nil.
+ self setClassToCompileFor:aClassOrContext.
+ selfValue := nil.
] ifFalse:[
- self setContext:aClassOrContext.
- aClassOrContext notNil ifTrue:[
- self setSelf:(aClassOrContext receiver)
- ].
+ self setContext:aClassOrContext.
+ aClassOrContext notNil ifTrue:[
+ self setSelf:(aClassOrContext receiver)
+ ].
].
requestor := aRequestor.
@@ -2001,8 +1984,8 @@
parseTree := self parseMethodBody.
(errorFlag or:[tree == #Error]) ifTrue:[^ #Error].
parseTree notNil ifTrue:[
- self evalExitBlock:[:value | ^ failBlock value].
- value := parseTree evaluate
+ self evalExitBlock:[:value | ^ failBlock value].
+ value := parseTree evaluate
].
self release.
^ value
@@ -2018,11 +2001,11 @@
self parseMethod.
^ (MethodNode new
- selector:selector
- arguments:methodArgs
- locals:methodVars
- statements:(tree isNil ifTrue:[#()] ifFalse:[tree asCollectionOfStatements]))
- encoder:self
+ selector:selector
+ arguments:methodArgs
+ locals:methodVars
+ statements:(tree isNil ifTrue:[#()] ifFalse:[tree asCollectionOfStatements]))
+ encoder:self
"Created: / 17-10-1997 / 12:35:01 / cg"
"Modified: / 12-09-2011 / 09:48:00 / cg"
@@ -2038,12 +2021,12 @@
"
Parser new
- parseSelector:'
+ parseSelector:'
parseSelector:aStringOrStream
self initializeFor:aStringOrStream.
self parseMethodSpec.
^ selector.
-'
+'
"
"Modified: 17.10.1997 / 12:35:46 / cg"
@@ -2171,9 +2154,9 @@
"sent from a namespace directive, if there is no requestor.
Remember the current namespace."
- currentNamespace := aNameSpaceName isString
- ifTrue:[ NameSpace fullName:aNameSpaceName ]
- ifFalse:[ aNameSpaceName ].
+ currentNamespace := aNameSpaceName isString
+ ifTrue:[ NameSpace fullName:aNameSpaceName ]
+ ifFalse:[ aNameSpaceName ].
"Modified: 8.11.1996 / 13:43:14 / cg"
!
@@ -2277,21 +2260,21 @@
self shouldPerformCodingStyleChecks ifFalse:[^ self ].
aVariableName isUppercaseFirst ifTrue:[
- msg := ('variable "' , aVariableName , '" should be lowercase (by convention)').
- self
- warning:msg
- doNotShowAgainAction:[ ParserFlags warnAboutNonLowercaseLocalVariableNames:false.
- parserFlags warnAboutNonLowercaseLocalVariableNames:false.]
- position:tokenPosition to:source position1Based - 1.
-
- Tools::ToDoListBrowser notNil ifTrue:[
- self
- notifyTodo:msg position:tokenPosition
- className:(self classToCompileFor name) selector:selector
- severity:#warning priority:#medium
- equalityParameter:nil
- checkAction:nil.
- ].
+ msg := ('variable "' , aVariableName , '" should be lowercase (by convention)').
+ self
+ warning:msg
+ doNotShowAgainAction:[ ParserFlags warnAboutNonLowercaseLocalVariableNames:false.
+ parserFlags warnAboutNonLowercaseLocalVariableNames:false.]
+ position:tokenPosition to:source position1Based - 1.
+
+ Tools::ToDoListBrowser notNil ifTrue:[
+ self
+ notifyTodo:msg position:tokenPosition
+ className:(self classToCompileFor name) selector:selector
+ severity:#warning priority:#medium
+ equalityParameter:nil
+ checkAction:nil.
+ ].
].
"Modified: / 18-10-2006 / 19:38:20 / cg"
@@ -2305,107 +2288,107 @@
self shouldPerformCodingStyleChecks ifFalse:[^ self ].
soundsLikeVowel := [:word |
- |soundsLikeVowel firstCharacter|
-
- soundsLikeVowel := false.
- firstCharacter := word first.
- ('AEIX' includes:firstCharacter) ifTrue:[
- soundsLikeVowel := true.
- ] ifFalse:[
- firstCharacter := word first.
- "/ U and H sound like a vowel, if followed by two more non-vowels
-
- ('UH' includes:firstCharacter) ifTrue:[
- word size > 2 ifTrue:[
- (word at:2) isVowel ifFalse:[
- (word at:3) isVowel ifFalse:[
- soundsLikeVowel := true.
- ].
- ].
- ].
- ].
- "/ R sound like a vowel, if followed by a consonant
- ('R' includes:firstCharacter) ifTrue:[
- word size > 2 ifTrue:[
- (word at:2) isVowel ifFalse:[
- soundsLikeVowel := true.
- ].
- ].
- ].
- "/ O sound like a vowel, if not followed by 'ne'
- ('O' includes:firstCharacter) ifTrue:[
- word size > 2 ifTrue:[
- (word copyTo:3) asLowercase = 'one' ifFalse:[
- soundsLikeVowel := true.
- ].
- ].
- ].
- "/ S sounds like a vowel, if followed by UC-consonant followed by vocal
- "/ aSBrowser -> anSBrowser
- ('S' includes:firstCharacter) ifTrue:[
- word size > 3 ifTrue:[
- ((word at:2) isVowel not
- and:[ (word at:2) isUppercase
- and:[ (word at:3) isVowel]]) ifTrue:[
- soundsLikeVowel := true.
- ].
- ].
- ].
- "/ M sounds like a vowel, if followed by UC-consonant followed by consonant
- "/ anMC aMA
- ('MN' includes:firstCharacter) ifTrue:[
- word size > 2 ifTrue:[
- ((word at:2) isVowel not
- and:[ (word at:2) isUppercase
- and:[ (word at:3) isVowel not]]) ifTrue:[
- soundsLikeVowel := true.
- ].
- ].
- ].
- ].
- soundsLikeVowel.
- ].
-
- aVariableName size > 4 ifTrue:[
- (aVariableName startsWith:'an') ifTrue:[
- firstCharacterAfterArticle := aVariableName at:3.
- firstCharacterAfterArticle isUppercase ifTrue:[
- rest := aVariableName copyFrom:3.
- (soundsLikeVowel value:rest) ifFalse:[
- whatShouldItBeNamed := 'a' , rest.
- ]
- ].
- ] ifFalse:[
- (aVariableName startsWith:'a') ifTrue:[
- firstCharacterAfterArticle := aVariableName at:2.
- firstCharacterAfterArticle isUppercase ifTrue:[
- rest := aVariableName copyFrom:2.
- (soundsLikeVowel value:rest) ifTrue:[
- whatShouldItBeNamed := 'an' , rest.
- ].
- ].
- ].
- ].
- whatShouldItBeNamed notNil ifTrue:[
-"/ self
+ |soundsLikeVowel firstCharacter|
+
+ soundsLikeVowel := false.
+ firstCharacter := word first.
+ ('AEIX' includes:firstCharacter) ifTrue:[
+ soundsLikeVowel := true.
+ ] ifFalse:[
+ firstCharacter := word first.
+ "/ U and H sound like a vowel, if followed by two more non-vowels
+
+ ('UH' includes:firstCharacter) ifTrue:[
+ word size > 2 ifTrue:[
+ (word at:2) isVowel ifFalse:[
+ (word at:3) isVowel ifFalse:[
+ soundsLikeVowel := true.
+ ].
+ ].
+ ].
+ ].
+ "/ R sound like a vowel, if followed by a consonant
+ ('R' includes:firstCharacter) ifTrue:[
+ word size > 2 ifTrue:[
+ (word at:2) isVowel ifFalse:[
+ soundsLikeVowel := true.
+ ].
+ ].
+ ].
+ "/ O sound like a vowel, if not followed by 'ne'
+ ('O' includes:firstCharacter) ifTrue:[
+ word size > 2 ifTrue:[
+ (word copyTo:3) asLowercase = 'one' ifFalse:[
+ soundsLikeVowel := true.
+ ].
+ ].
+ ].
+ "/ S sounds like a vowel, if followed by UC-consonant followed by vocal
+ "/ aSBrowser -> anSBrowser
+ ('S' includes:firstCharacter) ifTrue:[
+ word size > 3 ifTrue:[
+ ((word at:2) isVowel not
+ and:[ (word at:2) isUppercase
+ and:[ (word at:3) isVowel]]) ifTrue:[
+ soundsLikeVowel := true.
+ ].
+ ].
+ ].
+ "/ M sounds like a vowel, if followed by UC-consonant followed by consonant
+ "/ anMC aMA
+ ('MN' includes:firstCharacter) ifTrue:[
+ word size > 2 ifTrue:[
+ ((word at:2) isVowel not
+ and:[ (word at:2) isUppercase
+ and:[ (word at:3) isVowel not]]) ifTrue:[
+ soundsLikeVowel := true.
+ ].
+ ].
+ ].
+ ].
+ soundsLikeVowel.
+ ].
+
+ aVariableName size > 4 ifTrue:[
+ (aVariableName startsWith:'an') ifTrue:[
+ firstCharacterAfterArticle := aVariableName at:3.
+ firstCharacterAfterArticle isUppercase ifTrue:[
+ rest := aVariableName copyFrom:3.
+ (soundsLikeVowel value:rest) ifFalse:[
+ whatShouldItBeNamed := 'a' , rest.
+ ]
+ ].
+ ] ifFalse:[
+ (aVariableName startsWith:'a') ifTrue:[
+ firstCharacterAfterArticle := aVariableName at:2.
+ firstCharacterAfterArticle isUppercase ifTrue:[
+ rest := aVariableName copyFrom:2.
+ (soundsLikeVowel value:rest) ifTrue:[
+ whatShouldItBeNamed := 'an' , rest.
+ ].
+ ].
+ ].
+ ].
+ whatShouldItBeNamed notNil ifTrue:[
+"/ self
"/ warnCommonMistake:('variable "',aVariableName,'" should be named "',whatShouldItBeNamed,'" (by english language rules)')
"/ position:tokenPosition to:source position1Based - 1.
- msg := ('variable "',aVariableName,'" should be named "',whatShouldItBeNamed,'" (by english language rules)').
- self
- warning:msg
- doNotShowAgainAction:[ parserFlags warnAboutWrongVariableNames:false. ParserFlags warnAboutWrongVariableNames:false ]
- doNotShowAgainForThisMethodAction: [ self disableWarningsOnCurrentMethodFor: #warnAboutWrongVariableNames ]
- position:tokenPosition to:source position1Based - 1.
-
- Tools::ToDoListBrowser notNil ifTrue:[
- self
- notifyTodo:msg position:tokenPosition
- className:(self classToCompileFor name) selector:selector
- severity:#warning priority:#low
- equalityParameter:nil
- checkAction:nil.
- ].
- ].
+ msg := ('variable "',aVariableName,'" should be named "',whatShouldItBeNamed,'" (by english language rules)').
+ self
+ warning:msg
+ doNotShowAgainAction:[ parserFlags warnAboutWrongVariableNames:false. ParserFlags warnAboutWrongVariableNames:false ]
+ doNotShowAgainForThisMethodAction: [ self disableWarningsOnCurrentMethodFor: #warnAboutWrongVariableNames ]
+ position:tokenPosition to:source position1Based - 1.
+
+ Tools::ToDoListBrowser notNil ifTrue:[
+ self
+ notifyTodo:msg position:tokenPosition
+ className:(self classToCompileFor name) selector:selector
+ severity:#warning priority:#low
+ equalityParameter:nil
+ checkAction:nil.
+ ].
+ ].
].
"Modified: / 16-03-2012 / 18:36:43 / cg"
@@ -2417,37 +2400,37 @@
self shouldPerformCodingStyleChecks ifFalse:[^ self ].
parserFlags warnAboutVariableNameConventions == true ifTrue:[
- parserFlags warnAboutNonLowercaseLocalVariableNames == true ifTrue:[
- self checkForLowercaseVariableName:aVariableName.
- ].
- parserFlags warnAboutShortLocalVariableNames == true ifTrue:[
- aVariableName size <= 2 ifTrue:[
- (#(
- 'x' 'y'
- ) includes:aVariableName)
- ifFalse:[
- msg := ('short variable name: "' , aVariableName , '"').
- self
- warning:('short variable name: "' , aVariableName , '"')
- doNotShowAgainAction:[ ParserFlags warnAboutShortLocalVariableNames:false]
- position:tokenPosition to:source position1Based - 1.
-
- Tools::ToDoListBrowser notNil ifTrue:[
- self
- notifyTodo:msg position:tokenPosition
- className:(self classToCompileFor name) selector:selector
- severity:#warning priority:#medium
- equalityParameter:nil
- checkAction:nil.
- ].
- ].
- ].
- ].
+ parserFlags warnAboutNonLowercaseLocalVariableNames == true ifTrue:[
+ self checkForLowercaseVariableName:aVariableName.
+ ].
+ parserFlags warnAboutShortLocalVariableNames == true ifTrue:[
+ aVariableName size <= 2 ifTrue:[
+ (#(
+ 'x' 'y'
+ ) includes:aVariableName)
+ ifFalse:[
+ msg := ('short variable name: "' , aVariableName , '"').
+ self
+ warning:('short variable name: "' , aVariableName , '"')
+ doNotShowAgainAction:[ ParserFlags warnAboutShortLocalVariableNames:false]
+ position:tokenPosition to:source position1Based - 1.
+
+ Tools::ToDoListBrowser notNil ifTrue:[
+ self
+ notifyTodo:msg position:tokenPosition
+ className:(self classToCompileFor name) selector:selector
+ severity:#warning priority:#medium
+ equalityParameter:nil
+ checkAction:nil.
+ ].
+ ].
+ ].
+ ].
].
parserFlags warnAboutWrongVariableNames == true ifTrue:[
- (ParserFlags isFlag:#warnAboutWrongVariableNames enabledForClass:classToCompileFor selector:selector) ifTrue:[
- self checkForProperUseOfArticleInVariableName:aVariableName.
- ].
+ (ParserFlags isFlag:#warnAboutWrongVariableNames enabledForClass:classToCompileFor selector:selector) ifTrue:[
+ self checkForProperUseOfArticleInVariableName:aVariableName.
+ ].
].
"Modified: / 16-03-2012 / 18:42:56 / cg"
@@ -2474,11 +2457,11 @@
note := self plausibilityCheck:aNode.
note notNil ifTrue:[
- self
- warning:('Plausibility Check\' withCRs, note)
- doNotShowAgainAction:[ parserFlags warnPlausibilityChecks:false. ParserFlags warnPlausibilityChecks:false ]
- doNotShowAgainForThisMethodAction: [ self disableWarningsOnCurrentMethodFor: #warnPlausibilityChecks ]
- position:startPosition to:endPosition.
+ self
+ warning:('Plausibility Check\' withCRs, note)
+ doNotShowAgainAction:[ parserFlags warnPlausibilityChecks:false. ParserFlags warnPlausibilityChecks:false ]
+ doNotShowAgainForThisMethodAction: [ self disableWarningsOnCurrentMethodFor: #warnPlausibilityChecks ]
+ position:startPosition to:endPosition.
].
"Created: / 19-01-2012 / 10:44:05 / cg"
@@ -2496,12 +2479,12 @@
returnsSelf := returnedValues contains:[:node | node isSelf].
returnsBoolean ifTrue:[
- (returnsNonBooleanLiteral or:[returnsSelf]) ifTrue:[
- self
- warning:'Possible Error Warning:\\Method returns both boolean and non-boolean values.' withCRs
- doNotShowAgainAction:[ ParserFlags warnInconsistentReturnValues:false ]
- position:1 to:tokenPosition
- ]
+ (returnsNonBooleanLiteral or:[returnsSelf]) ifTrue:[
+ self
+ warning:'Possible Error Warning:\\Method returns both boolean and non-boolean values.' withCRs
+ doNotShowAgainAction:[ ParserFlags warnInconsistentReturnValues:false ]
+ position:1 to:tokenPosition
+ ]
].
"Created: / 17.11.2001 / 10:31:03 / cg"
@@ -2519,81 +2502,81 @@
self shouldPerformCodingStyleChecks ifFalse:[^ nil ].
cls isNil ifTrue:[
- SystemBrowser isNil ifTrue:[
- ^ nil
- ].
- "beware, this is sort of slow, especially for the SyntaxHighlighter"
- implementors := SystemBrowser
- findImplementorsOf:selector
- in:(Smalltalk allClasses)
- ignoreCase:false.
- implementors size == 0 ifTrue:[
- ^ 'is nowhere implemented'
- ].
-
- (implementors conform:[:eachMethod| eachMethod isObsolete]) ifTrue:[
- ^ 'each implementation of this selector in the system is deprecated'
- ].
- ^ nil
+ SystemBrowser isNil ifTrue:[
+ ^ nil
+ ].
+ "beware, this is sort of slow, especially for the SyntaxHighlighter"
+ implementors := SystemBrowser
+ findImplementorsOf:selector
+ in:(Smalltalk allClasses)
+ ignoreCase:false.
+ implementors size == 0 ifTrue:[
+ ^ 'is nowhere implemented'
+ ].
+
+ (implementors conform:[:eachMethod| eachMethod isObsolete]) ifTrue:[
+ ^ 'each implementation of this selector in the system is deprecated'
+ ].
+ ^ nil
].
mthd := cls lookupMethodFor:selector.
mthd isNil ifTrue:[
- cls isBehavior ifTrue:[
- cls isMeta ifTrue:[
- mthd := Metaclass lookupMethodFor:selector.
- ].
- ].
+ cls isBehavior ifTrue:[
+ cls isMeta ifTrue:[
+ mthd := Metaclass lookupMethodFor:selector.
+ ].
+ ].
].
mthd isNil ifTrue:[
- cls == Boolean ifTrue:[
- mthd := True compiledMethodAt:selector.
- mthd isNil ifTrue:[
- mthd := False compiledMethodAt:selector.
- ].
- ]
+ cls == Boolean ifTrue:[
+ mthd := True compiledMethodAt:selector.
+ mthd isNil ifTrue:[
+ mthd := False compiledMethodAt:selector.
+ ].
+ ]
].
mthd isNil ifTrue:[
- "if it implements #doesNotUnderstand somewhere, assume it is ok"
- implementor := cls whichClassIncludesSelector:#doesNotUnderstand:.
+ "if it implements #doesNotUnderstand somewhere, assume it is ok"
+ implementor := cls whichClassIncludesSelector:#doesNotUnderstand:.
"/ (implementor isNil or:[implementor == Object]) ifTrue:[
- err := 'is not implemented in ' , cls name allBold
+ err := 'is not implemented in ' , cls name allBold
"/ ].
] ifFalse:[
- (mthd sends:#shouldNotImplement) ifTrue:[
- mthd messagesSent size == 1 ifTrue:[
- allowed := (cls == classToCompileFor). "methods in abstract classes may send messages to abstract methods in the same class"
- allowed ifFalse:[
- err := 'is not (should not be) implemented'
- ]
- ]
- ] ifFalse:[
- ((mthd sends:#subclassResponsibility) or:[ mthd sends:#subclassResponsibility: ]) ifTrue:[
- allowed := (cls == classToCompileFor). "methods in abstract classes may send messages to abstract methods in the same class"
- allowed ifFalse:[
- "methods in abstract classes may send messages to abstract methods in meta class"
- (cls == classToCompileFor class) ifTrue:[
- allowed := receiver isMessage and:[receiver selector = 'class']
- ].
- ].
- allowed ifTrue:[
- "/ not from cg to stefan: thats wrong - if not implemented in all subclasses,
- "/ its a bug of the subclass not a bug here - that message send here
- "/ is perfectly correct. (it is very annoying for a framework developped to get
- "/ error messages for bugs which are not his...
+ (mthd sends:#shouldNotImplement) ifTrue:[
+ mthd messagesSent size == 1 ifTrue:[
+ allowed := (cls == classToCompileFor). "methods in abstract classes may send messages to abstract methods in the same class"
+ allowed ifFalse:[
+ err := 'is not (should not be) implemented'
+ ]
+ ]
+ ] ifFalse:[
+ ((mthd sends:#subclassResponsibility) or:[ mthd sends:#subclassResponsibility: ]) ifTrue:[
+ allowed := (cls == classToCompileFor). "methods in abstract classes may send messages to abstract methods in the same class"
+ allowed ifFalse:[
+ "methods in abstract classes may send messages to abstract methods in meta class"
+ (cls == classToCompileFor class) ifTrue:[
+ allowed := receiver isMessage and:[receiver selector = 'class']
+ ].
+ ].
+ allowed ifTrue:[
+ "/ not from cg to stefan: thats wrong - if not implemented in all subclasses,
+ "/ its a bug of the subclass not a bug here - that message send here
+ "/ is perfectly correct. (it is very annoying for a framework developped to get
+ "/ error messages for bugs which are not his...
"/ (self checkIfAllSubclassesOf:cls implement:selector) ifFalse:[
"/ "if not all subclasses implement the selector - this is a possible bug"
"/ allowed := false
"/ ].
- ].
- allowed ifFalse:[
- err := 'is subclassResponsibility'
- ].
- ] ifFalse:[mthd isObsolete ifTrue:[
- err := 'is deprecated'.
- ]]
- ].
+ ].
+ allowed ifFalse:[
+ err := 'is subclassResponsibility'
+ ].
+ ] ifFalse:[mthd isObsolete ifTrue:[
+ err := 'is deprecated'.
+ ]]
+ ].
].
^ err.
!
@@ -2605,10 +2588,10 @@
parserFlags warnUnusedVars ifFalse:[^ self].
methodVars notNil ifTrue:[
- unused := methodVars select:[:var| var used ~~ true] thenCollect:[:var| var name].
+ unused := methodVars select:[:var| var used ~~ true] thenCollect:[:var| var name].
].
unused size > 0 ifTrue:[
- self warnUnused:unused.
+ self warnUnused:unused.
].
"Created: / 17-11-2001 / 10:23:47 / cg"
@@ -2721,7 +2704,7 @@
|holder|
doItTemporaries isNil ifTrue:[
- doItTemporaries := IdentityDictionary new.
+ doItTemporaries := IdentityDictionary new.
].
doItTemporaries at:varName asSymbol put:(holder := ValueHolder new).
^ holder
@@ -2729,7 +2712,7 @@
alreadyWarnedUnimplementedSelectors
alreadyWarnedUnimplementedSelectors isNil ifTrue:[
- alreadyWarnedUnimplementedSelectors := Set new
+ alreadyWarnedUnimplementedSelectors := Set new
].
^ alreadyWarnedUnimplementedSelectors
!
@@ -2742,7 +2725,7 @@
"in systems without widgets ..."
ListSelectionBox isNil ifTrue:[
- ^ self confirm:aString
+ ^ self confirm:aString
].
box := ListSelectionBox title:aString.
box initialText:(aList at:1).
@@ -2762,7 +2745,7 @@
"in systems without widgets ..."
ListSelectionBox isNil ifTrue:[
- ^ self confirm:aString
+ ^ self confirm:aString
].
box := ListSelectionBox title:aString.
box initialText:(aList at:1).
@@ -2779,7 +2762,7 @@
|l how varNameIsLowercase popupMenu choiceIndex typeChoice|
typeChoice := (AskForVariableTypeOfUndeclaredQuery new
- parser:self nameOfUnknownVariable:varName) query.
+ parser:self nameOfUnknownVariable:varName) query.
"/
"/ l := OrderedCollection new.
@@ -2799,7 +2782,7 @@
"/ ].
"/ (classToCompileFor notNil
"/ and:[classToCompileFor isMeta not
-"/ and:[classToCompileFor isBuiltInClass not
+"/ and:[classToCompileFor isBuiltInClass not
"/ and:[(self isDoIt not)]]]) ifTrue:[
"/ l add:'Instance Variable'.
"/ how add: #InstanceVariable.
@@ -2831,7 +2814,7 @@
"/ ].
"/
"/ l size > 0 ifTrue:[
-"/ l := (Array with:('Declare ' , varName allBold , ' as:')
+"/ l := (Array with:('Declare ' , varName allBold , ' as:')
"/ with:'-'
"/ ) , l.
"/ how := #(nil nil) , how.
@@ -2844,7 +2827,7 @@
"/ ].
typeChoice notNil ifTrue:[
- ^ self declareUndefinedVariable:varName as:typeChoice
+ ^ self declareUndefinedVariable:varName as:typeChoice
].
^ nil.
@@ -2874,13 +2857,13 @@
requestor deleteSelection.
"
- get the updated source-string
+ get the updated source-string
which is needed, when we eventually install the new method
"
correctedSource := requestor currentSourceCode.
"/ update the current source position
source := (ReadStream on:correctedSource)
- position:(source position1Based - selectionSize).
+ position:(source position1Based - selectionSize).
^ nil
@@ -2889,7 +2872,7 @@
correctSelector:aSelectorString message:msg positions:posVector in:aClassOrNil for:receiverNode
"notify error and correct if user wants to;
- return #Error if there was no correction
+ return #Error if there was no correction
or a ParseNode as returned by variable"
|correctIt suggestedNames newSelector className classToGenerateCode pos1 pos2|
@@ -2898,7 +2881,7 @@
pos2 := posVector last stop.
(self alreadyWarnedUnimplementedSelectors includes:aSelectorString) ifTrue:[
- ^ aSelectorString
+ ^ aSelectorString
].
"
@@ -2906,89 +2889,89 @@
currently (too much work - maybe Ill do it later when everything else works :-)
"
(aSelectorString occurrencesOf:$:) > 1 ifTrue:[
- self warning:msg position:pos1 to:pos2.
- alreadyWarnedUnimplementedSelectors add:aSelectorString.
- ^ aSelectorString
+ self warning:msg position:pos1 to:pos2.
+ alreadyWarnedUnimplementedSelectors add:aSelectorString.
+ ^ aSelectorString
].
correctIt := self correctableSelectorWarning:msg position:pos1 to:pos2.
correctIt == #generate ifTrue:[
- receiverNode isSelf ifTrue:[
- classToGenerateCode := classToCompileFor
- ] ifFalse:[
- receiverNode isVariable ifTrue:[
- receiverNode isGlobal ifTrue:[
- classToGenerateCode := receiverNode evaluate.
- classToGenerateCode isBehavior ifTrue:[
- classToGenerateCode := classToGenerateCode theMetaclass.
- ] ifFalse:[
- classToGenerateCode := nil
- ].
- ].
- ]
- ].
- classToGenerateCode isNil ifTrue:[
- className := Dialog request:'Generate code in class:' initialAnswer:classToCompileFor name.
- className size == 0 ifTrue:[
- ^ aSelectorString
- ].
- classToGenerateCode := Smalltalk at:className asSymbol.
- classToGenerateCode isNil ifTrue:[
- self warn:'No such class.'.
- ^ aSelectorString
- ].
- ].
- (classToGenerateCode includesSelector:aSelectorString asSymbol) ifFalse:[
- |code category wantSetter wantGetter|
-
- wantSetter := wantGetter := false.
-
- (aSelectorString isKeywordSelector
- and:[aSelectorString numArgs == 1
- and:[classToGenerateCode instVarNames includes:(aSelectorString copyWithoutLast:1)]]) ifTrue:[
- "/ want a setter ?
- wantSetter := Dialog confirmWithCancel:('Create a setter for %1 ?' bindWith:(aSelectorString copyWithoutLast:1) allBold).
- wantSetter isNil ifTrue:[^ aSelectorString].
- ] ifFalse:[
- (aSelectorString isUnarySelector
- and:[classToGenerateCode instVarNames includes:aSelectorString]) ifTrue:[
- "/ want a getter ?
- wantGetter := Dialog confirmWithCancel:('Create a getter for %1 ?' bindWith:aSelectorString allBold).
- wantGetter isNil ifTrue:[^ aSelectorString].
- ]
- ].
- wantSetter ifTrue:[
- code := ('%1:something\ %1 := something.' bindWith:(aSelectorString copyWithoutLast:1)) withCRs.
- category := 'accessing'.
- ] ifFalse:[
- wantGetter ifTrue:[
- code := ('%1\ ^ %1.' bindWith:aSelectorString) withCRs.
- category := 'accessing'.
- ] ifFalse:[
- code := (self class methodSpecificationForSelector:aSelectorString) , '\ self shouldImplement' withCRs.
- category := Compiler defaultMethodCategory.
- ].
- ].
-
- "do not overwrite an already existant (deprecated) method"
- classToGenerateCode
- compile:code
- classified:category.
- ].
- correctIt := false.
+ receiverNode isSelf ifTrue:[
+ classToGenerateCode := classToCompileFor
+ ] ifFalse:[
+ receiverNode isVariable ifTrue:[
+ receiverNode isGlobal ifTrue:[
+ classToGenerateCode := receiverNode evaluate.
+ classToGenerateCode isBehavior ifTrue:[
+ classToGenerateCode := classToGenerateCode theMetaclass.
+ ] ifFalse:[
+ classToGenerateCode := nil
+ ].
+ ].
+ ]
+ ].
+ classToGenerateCode isNil ifTrue:[
+ className := Dialog request:'Generate code in class:' initialAnswer:classToCompileFor name.
+ className size == 0 ifTrue:[
+ ^ aSelectorString
+ ].
+ classToGenerateCode := Smalltalk at:className asSymbol.
+ classToGenerateCode isNil ifTrue:[
+ self warn:'No such class.'.
+ ^ aSelectorString
+ ].
+ ].
+ (classToGenerateCode includesSelector:aSelectorString asSymbol) ifFalse:[
+ |code category wantSetter wantGetter|
+
+ wantSetter := wantGetter := false.
+
+ (aSelectorString isKeywordSelector
+ and:[aSelectorString numArgs == 1
+ and:[classToGenerateCode instVarNames includes:(aSelectorString copyWithoutLast:1)]]) ifTrue:[
+ "/ want a setter ?
+ wantSetter := Dialog confirmWithCancel:('Create a setter for %1 ?' bindWith:(aSelectorString copyWithoutLast:1) allBold).
+ wantSetter isNil ifTrue:[^ aSelectorString].
+ ] ifFalse:[
+ (aSelectorString isUnarySelector
+ and:[classToGenerateCode instVarNames includes:aSelectorString]) ifTrue:[
+ "/ want a getter ?
+ wantGetter := Dialog confirmWithCancel:('Create a getter for %1 ?' bindWith:aSelectorString allBold).
+ wantGetter isNil ifTrue:[^ aSelectorString].
+ ]
+ ].
+ wantSetter ifTrue:[
+ code := ('%1:something\ %1 := something.' bindWith:(aSelectorString copyWithoutLast:1)) withCRs.
+ category := 'accessing'.
+ ] ifFalse:[
+ wantGetter ifTrue:[
+ code := ('%1\ ^ %1.' bindWith:aSelectorString) withCRs.
+ category := 'accessing'.
+ ] ifFalse:[
+ code := (self class methodSpecificationForSelector:aSelectorString) , '\ self shouldImplement' withCRs.
+ category := Compiler defaultMethodCategory.
+ ].
+ ].
+
+ "do not overwrite an already existant (deprecated) method"
+ classToGenerateCode
+ compile:code
+ classified:category.
+ ].
+ correctIt := false.
].
correctIt ifFalse:[
- alreadyWarnedUnimplementedSelectors add:aSelectorString.
- ^ aSelectorString
+ alreadyWarnedUnimplementedSelectors add:aSelectorString.
+ ^ aSelectorString
].
suggestedNames := self findBestSelectorsFor:aSelectorString in:aClassOrNil.
suggestedNames notNil ifTrue:[
- newSelector := self askForCorrection:'Correct Selector to: ' fromList:suggestedNames for:aSelectorString.
- newSelector isNil ifTrue:[AbortSignal raise "^ aSelectorString"].
+ newSelector := self askForCorrection:'Correct Selector to: ' fromList:suggestedNames for:aSelectorString.
+ newSelector isNil ifTrue:[AbortSignal raise "^ aSelectorString"].
] ifFalse:[
- self information:'no good correction found'.
- ^ aSelectorString
+ self information:'no good correction found'.
+ ^ aSelectorString
].
"
@@ -2997,12 +2980,12 @@
"
requestor replaceSelectionBy:newSelector keepCursor:false.
"
- get the updated source-string
+ get the updated source-string
which is needed, when we eventually install the new method
"
correctedSource := requestor currentSourceCode.
source := (ReadStream on:correctedSource)
- position:(source position + (newSelector size - aSelectorString size)).
+ position:(source position + (newSelector size - aSelectorString size)).
^ newSelector
"Modified: / 22.1.1998 / 16:36:04 / stefan"
@@ -3025,24 +3008,24 @@
requestor deleteFromCharacterPosition:start to:stop.
"
- get the updated source-string
+ get the updated source-string
which is needed, when we eventually install the new method
"
correctedSource := requestor currentSourceCode.
"/ update the current source position
source atEnd ifTrue:[
- newPos := correctedSource size.
+ newPos := correctedSource size.
] ifFalse:[
- source position1Based >= stop ifTrue:[
- newPos := source position1Based - deleteSize
- ] ifFalse:[
- source position1Based < start ifTrue:[
- newPos := source position1Based
- ] ifFalse:[
- newPos := start
- ].
- ]
+ source position1Based >= stop ifTrue:[
+ newPos := source position1Based - deleteSize
+ ] ifFalse:[
+ source position1Based < start ifTrue:[
+ newPos := source position1Based
+ ] ifFalse:[
+ newPos := start
+ ].
+ ]
].
source := (ReadStream on:correctedSource) position1Based:newPos.
@@ -3053,21 +3036,21 @@
localDefsStart >= stop ifTrue:[^ self].
(localDefsStart >= start and:[localDefsStop <= stop]) ifTrue:[
- localVarDefPosition := nil.
- ^ self
- ].
+ localVarDefPosition := nil.
+ ^ self
+ ].
"/ must update
(start > localDefsStart and:[stop < localDefsStop]) ifTrue:[
- localVarDefPosition at:2 put:(localDefsStop - (stop-start+1)).
- ^ self.
+ localVarDefPosition at:2 put:(localDefsStop - (stop-start+1)).
+ ^ self.
].
^ self
!
correctVariable:varName atPosition:pos1 to:pos2
"notify error and correct if user wants to;
- return #Error if there was no correction
+ return #Error if there was no correction
or a ParseNode as returned by variable"
|correctIt suggestedNames newName rslt
@@ -3077,85 +3060,85 @@
sameForAll := false.
variableCorrectActionForAll notNil ifTrue:[
- correctIt := variableCorrectActionForAll
+ correctIt := variableCorrectActionForAll
] ifFalse:[
- SameForAllNotification handle:[:ex |
- sameForAll := true.
- ex proceed.
- ] do:[
- correctIt := self undefError:varName position:pos1 to:pos2.
- ].
+ SameForAllNotification handle:[:ex |
+ sameForAll := true.
+ ex proceed.
+ ] do:[
+ correctIt := self undefError:varName position:pos1 to:pos2.
+ ].
].
correctIt == #Error ifTrue:[
- ^ #Error
+ ^ #Error
].
sameForAll == true ifTrue:[
- variableCorrectActionForAll := correctIt.
- variableTypeOfLastCorrectAction := nil.
- correctIt == false ifTrue:[
- parserFlags warnUndeclared:false.
- ].
+ variableCorrectActionForAll := correctIt.
+ variableTypeOfLastCorrectAction := nil.
+ correctIt == false ifTrue:[
+ parserFlags warnUndeclared:false.
+ ].
].
correctIt == #declare ifTrue:[
- "/ declare it
- (variableCorrectActionForAll == #declare
- and:[ variableTypeOfLastCorrectAction notNil ]) ifTrue:[
- rslt := self declareUndefinedVariable:varName as:variableTypeOfLastCorrectAction.
- ^ rslt
- ].
- rslt := self askForVariableTypeWhenDeclaringUndefined:varName.
- rslt notNil ifTrue:[
- variableTypeOfLastCorrectAction := rslt type.
- ^ rslt
- ].
- correctIt := #continue.
+ "/ declare it
+ (variableCorrectActionForAll == #declare
+ and:[ variableTypeOfLastCorrectAction notNil ]) ifTrue:[
+ rslt := self declareUndefinedVariable:varName as:variableTypeOfLastCorrectAction.
+ ^ rslt
+ ].
+ rslt := self askForVariableTypeWhenDeclaringUndefined:varName.
+ rslt notNil ifTrue:[
+ variableTypeOfLastCorrectAction := rslt type.
+ ^ rslt
+ ].
+ correctIt := #continue.
].
(correctIt == false or:[correctIt == #continue]) ifTrue:[
- "/ no correction wanted.
-
- "/ lowerCase vars are added to the Undeclared dictionary,
- "/ allowing easy search for bad-spots later.
- boldName := varName allBold.
-
- varNameIsLowercase ifTrue:[
- undeclared := Smalltalk at:#Undeclared.
- ((undeclared notNil)
- and:[(undeclared includes:varName asSymbol)]) ifFalse:[
- self warning:('Adding ''' , boldName , ''' as Undeclared.\\Remember to fix that later.') withCRs position:pos1 to:pos2.
- ].
- ^ self defineAsUndeclaredVariable:varName
- ].
-
- "/ upperCase vars are declared as global
- parserFlags warnings ifTrue:[
- parserFlags warnUndeclared ifTrue:[
- (warnedUndefVars isNil or:[(warnedUndefVars includes:varName) not]) ifTrue:[
- (warnedUnknownNamespaces isNil or:[(warnedUnknownNamespaces includes:varName) not]) ifTrue:[
- self warning:('adding ''' , boldName , ''' as Global.') withCRs position:pos1 to:pos2.
- ]
- ].
- ].
- ].
- ^ VariableNode globalNamed:varName
+ "/ no correction wanted.
+
+ "/ lowerCase vars are added to the Undeclared dictionary,
+ "/ allowing easy search for bad-spots later.
+ boldName := varName allBold.
+
+ varNameIsLowercase ifTrue:[
+ undeclared := Smalltalk at:#Undeclared.
+ ((undeclared notNil)
+ and:[(undeclared includes:varName asSymbol)]) ifFalse:[
+ self warning:('Adding ''' , boldName , ''' as Undeclared.\\Remember to fix that later.') withCRs position:pos1 to:pos2.
+ ].
+ ^ self defineAsUndeclaredVariable:varName
+ ].
+
+ "/ upperCase vars are declared as global
+ parserFlags warnings ifTrue:[
+ parserFlags warnUndeclared ifTrue:[
+ (warnedUndefVars isNil or:[(warnedUndefVars includes:varName) not]) ifTrue:[
+ (warnedUnknownNamespaces isNil or:[(warnedUnknownNamespaces includes:varName) not]) ifTrue:[
+ self warning:('adding ''' , boldName , ''' as Global.') withCRs position:pos1 to:pos2.
+ ]
+ ].
+ ].
+ ].
+ ^ VariableNode globalNamed:varName
].
(correctIt isKindOf:ParseNode) ifTrue:[
- ^ correctIt
+ ^ correctIt
].
suggestedNames := self findBestVariablesFor:varName.
suggestedNames isNil ifTrue:[
- self information:'No good correction found'.
- ^ #Error
+ self information:'No good correction found'.
+ ^ #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].
"
"
@@ -3164,12 +3147,12 @@
"
requestor replaceSelectionBy:newName.
"
- get the updated source-string
+ get the updated source-string
which is needed, when we eventually install the new method
"
correctedSource := requestor currentSourceCode.
source := (ReadStream on:correctedSource)
- position:(source position1Based + newName size - tokenName size).
+ position:(source position1Based + newName size - tokenName size).
"redo parse with new value"
token := tokenName := newName.
@@ -3177,9 +3160,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
@@ -3191,118 +3174,118 @@
|holder newClass owningClass|
variableType == #WorkspaceVariable ifTrue:[
- holder := Workspace addWorkspaceVariable:varName.
- ^ VariableNode type:#WorkspaceVariable holder:holder name:varName
+ holder := Workspace addWorkspaceVariable:varName.
+ ^ VariableNode type:#WorkspaceVariable holder:holder name:varName
].
variableType == #DoItTemporary ifTrue:[
- holder := self addDoItTemporary:varName.
- ^ VariableNode type:#DoItTemporary holder:holder name:varName
+ holder := self addDoItTemporary:varName.
+ ^ VariableNode type:#DoItTemporary holder:holder name:varName
].
variableType == #GlobalVariable ifTrue:[
- Smalltalk at:varName asSymbol put:nil.
- ^ VariableNode globalNamed:varName
+ Smalltalk at:varName asSymbol put:nil.
+ ^ VariableNode globalNamed:varName
].
variableType == #NewClass ifTrue:[
- newClass := Object subclass:varName asSymbol
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'* As yet uncategorized *'.
- ^ VariableNode globalNamed:newClass name
+ newClass := Object subclass:varName asSymbol
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'* As yet uncategorized *'.
+ ^ VariableNode globalNamed:newClass name
].
variableType == #PrivateClass ifTrue:[
- owningClass := classToCompileFor theNonMetaclass.
- newClass := Object subclass:varName asSymbol
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:owningClass.
- ^ VariableNode type:#PrivateClass class:owningClass name:newClass name
+ owningClass := classToCompileFor theNonMetaclass.
+ newClass := Object subclass:varName asSymbol
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:owningClass.
+ ^ VariableNode type:#PrivateClass class:owningClass name:newClass name
].
variableType == #NameSpace ifTrue:[
- NameSpace name:varName.
- ^ VariableNode globalNamed:varName
+ NameSpace name:varName.
+ ^ VariableNode globalNamed:varName
].
variableType == #ClassVariable ifTrue:[
- classToCompileFor theNonMetaclass addClassVarName:varName.
- ^ VariableNode type:#ClassVariable class:classToCompileFor theNonMetaclass name:varName
+ classToCompileFor theNonMetaclass addClassVarName:varName.
+ ^ VariableNode type:#ClassVariable class:classToCompileFor theNonMetaclass name:varName
].
variableType == #InstanceVariable ifTrue:[
- classToCompileFor theNonMetaclass addInstVarName:varName.
- "/ ST/X special - old classToCompileFor is obsoleted - refetch
- classToCompileFor := Smalltalk classNamed:(classToCompileFor name).
- RestartCompilationSignal raise.
- "/ not reached - restarted compile will not arrive here again
- self error:'restart compile failed'.
+ classToCompileFor theNonMetaclass addInstVarName:varName.
+ "/ ST/X special - old classToCompileFor is obsoleted - refetch
+ classToCompileFor := Smalltalk classNamed:(classToCompileFor name).
+ RestartCompilationSignal raise.
+ "/ not reached - restarted compile will not arrive here again
+ self error:'restart compile failed'.
].
variableType == #ClassInstanceVariable ifTrue:[
- classToCompileFor theMetaclass addInstVarName:varName.
- "/ ST/X special - old classToCompileFor is obsoleted - refetch
- classToCompileFor := Smalltalk classNamed:(classToCompileFor name).
- RestartCompilationSignal raise.
- "/ not reached - restarted compile will not arrive here again
- self error:'restart compile failed'.
+ classToCompileFor theMetaclass addInstVarName:varName.
+ "/ ST/X special - old classToCompileFor is obsoleted - refetch
+ classToCompileFor := Smalltalk classNamed:(classToCompileFor name).
+ RestartCompilationSignal raise.
+ "/ not reached - restarted compile will not arrive here again
+ self error:'restart compile failed'.
].
variableType == #MethodVariable ifTrue:[
- |varIndex var endLocalsPos posToInsert ins space spaceString |
-
- "JV@2012-07-02: Changed to respect formatting settings"
- space := UserPreferences current at:#'formatter.spaceAroundTemporaries' ifAbsent:[false].
- spaceString := space ifTrue:[' '] ifFalse:[''].
-
- localVarDefPosition size == 2 ifTrue:[
- endLocalsPos := posToInsert := localVarDefPosition at:2.
- space ifTrue:[
- "/Is there already a space after last temporary?
- ((requestor contents at: posToInsert - 1 ) isSeparator) ifTrue:[
- ins := varName , spaceString
- ] ifFalse:[
- ins := ' ' , varName , spaceString
- ]
- ] ifFalse:[
- ins := ' ' , varName.
- ].
- ] ifFalse:[
- endOfSelectorPosition notNil ifTrue:[
- posToInsert := beginOfBodyPosition.
- ins := '|' , spaceString, varName , spaceString , '|' , Character cr asString , Character cr asString.
- ins := ins , (String new:(requestor colOfCharacterPosition:posToInsert)-1).
- ]
- ].
- posToInsert notNil ifTrue:[
- requestor
- insertString:ins
- atCharacterPosition:posToInsert.
-
- endLocalsPos notNil ifTrue:[
- localVarDefPosition at:2 put:(endLocalsPos + varName size + 1).
-
- methodVarNames := methodVarNames copyWith:varName.
- methodVars := methodVars copyWith:(var := Variable new name:varName).
- ] ifFalse:[
- localVarDefPosition := Array with:posToInsert with:posToInsert+varName size+1+(space ifTrue:[2] ifFalse:[0]).
-
- methodVarNames := Array with:varName.
- methodVars := Array with:(var := Variable new name:varName).
- ].
- correctedSource := requestor currentSourceCode asString string.
- source := (ReadStream on:correctedSource)
- position:(source position1Based + ins size).
-
- varIndex := methodVarNames size.
- var used:true.
- ^ VariableNode type:#MethodVariable
- name:varName
- token:var
- index:varIndex
- ].
+ |varIndex var endLocalsPos posToInsert ins space spaceString |
+
+ "JV@2012-07-02: Changed to respect formatting settings"
+ space := UserPreferences current at:#'formatter.spaceAroundTemporaries' ifAbsent:[false].
+ spaceString := space ifTrue:[' '] ifFalse:[''].
+
+ localVarDefPosition size == 2 ifTrue:[
+ endLocalsPos := posToInsert := localVarDefPosition at:2.
+ space ifTrue:[
+ "/Is there already a space after last temporary?
+ ((requestor contents at: posToInsert - 1 ) isSeparator) ifTrue:[
+ ins := varName , spaceString
+ ] ifFalse:[
+ ins := ' ' , varName , spaceString
+ ]
+ ] ifFalse:[
+ ins := ' ' , varName.
+ ].
+ ] ifFalse:[
+ endOfSelectorPosition notNil ifTrue:[
+ posToInsert := beginOfBodyPosition.
+ ins := '|' , spaceString, varName , spaceString , '|' , Character cr asString , Character cr asString.
+ ins := ins , (String new:(requestor colOfCharacterPosition:posToInsert)-1).
+ ]
+ ].
+ posToInsert notNil ifTrue:[
+ requestor
+ insertString:ins
+ atCharacterPosition:posToInsert.
+
+ endLocalsPos notNil ifTrue:[
+ localVarDefPosition at:2 put:(endLocalsPos + varName size + 1).
+
+ methodVarNames := methodVarNames copyWith:varName.
+ methodVars := methodVars copyWith:(var := Variable new name:varName).
+ ] ifFalse:[
+ localVarDefPosition := Array with:posToInsert with:posToInsert+varName size+1+(space ifTrue:[2] ifFalse:[0]).
+
+ methodVarNames := Array with:varName.
+ methodVars := Array with:(var := Variable new name:varName).
+ ].
+ correctedSource := requestor currentSourceCode asString string.
+ source := (ReadStream on:correctedSource)
+ position:(source position1Based + ins size).
+
+ varIndex := methodVarNames size.
+ var used:true.
+ ^ VariableNode type:#MethodVariable
+ name:varName
+ token:var
+ index:varIndex
+ ].
].
self warning:'Sorry - unimplemented (adding ' , variableType , ')'.
@@ -3325,7 +3308,7 @@
undeclared := Smalltalk at:#Undeclared.
undeclared isNil ifTrue:[
- Smalltalk at:#Undeclared put:(undeclared := IdentitySet new).
+ Smalltalk at:#Undeclared put:(undeclared := IdentitySet new).
].
undeclared add:tokenName asSymbol.
varName := (Smalltalk undeclaredPrefix) , tokenName.
@@ -3356,107 +3339,107 @@
startSearch := defStartPos+1.
[true] whileTrue:[
- |prevChar isFirstVar didPassEndOfLine|
-
- "/ search this name's position in the declaration part ...
- pos := source indexOfSubCollection:varName startingAt:startSearch ifAbsent:0.
- (pos == 0 or:[pos >= defEndPos]) ifTrue:[
- self error:'should not happen' mayProceed:true.
- ^ self.
- ].
-
- pos2 := pos + varName size - 1.
- pos > 1 ifTrue:[
- prevChar := source at:pos-1.
- ].
- (prevChar isNil or:[prevChar isLetterOrDigit not]) ifTrue:[
- nextChar := source at:pos2+1.
- nextChar isLetterOrDigit ifFalse:[
- "/ halfway intuitive space-removal behavior;
- "/ if there was a space after/before the |-char,
- "/ leave it; otherwise remove it.
- isFirstVar := pos == (defStartPos+1).
- (source at:pos-1) isSeparator ifTrue:[
- pos := pos - 1.
- [ (source at:pos-1) isSeparator] whileTrue:[
- pos := pos - 1.
- ].
- (source at:pos-1) == $| ifTrue:[
- "/ there was a space before - leave it
- pos := pos + 1.
- isFirstVar := true.
- ]
- ].
-
- (source at:pos2+1) isSeparator ifTrue:[
- didPassEndOfLine := (source at:pos2+1) == Character cr.
- pos2 := pos2 + 1.
- [ (source at:pos2+1) isSeparator] whileTrue:[
- (source at:pos2+1) == Character cr ifTrue:[ didPassEndOfLine := true ].
- pos2 := pos2 + 1.
- ].
-
- didPassEndOfLine ifFalse:[
- (source at:pos2+1) == $" ifTrue:[
- "/ comment follows - assume it belongs to the removed variable
- pos2 := pos2 + 1.
- (source at:pos2+1) == $/ ifTrue:[
- "/ EOL comment
- [ (source at:pos2+1) == Character cr ] whileFalse:[
- pos2 := pos2 + 1.
- ].
- pos2 := pos2 + 1.
- ] ifFalse:[
- "/ regular comment
- [ (source at:pos2+1) == $" ] whileFalse:[
- pos2 := pos2 + 1.
- ].
- pos2 := pos2 + 1.
- ].
- [ (source at:pos2+1) isSeparator] whileTrue:[
- (source at:pos2+1) == Character cr ifTrue:[ didPassEndOfLine := true ].
- pos2 := pos2 + 1.
- ].
- ]
- ].
-
- (source at:pos2+1) == $| ifTrue:[
- "/ there was a space after - leave it
- pos2 := pos2 - 1.
- ] ifFalse:[
- isFirstVar ifFalse:[
- pos2 := pos2 - 1.
- ]
- ].
- ].
-
- "/ if this was the last, remove empty var-declaration completely
- ((source at:pos-1) == $|
- and:[ (source at:pos2+1) == $| ]) ifTrue:[
- pos := pos - 1.
- pos2 := pos2 + 1.
- "/ see if that gives us an empty line
- p := pos.
- p2 := pos2.
-
- [(source at:p-1) == Character space] whileTrue:[ p := p - 1 ].
- [(source at:p2+1) == Character space] whileTrue:[ p2 := p2 + 1 ].
- ((source at:p-1) == Character cr and:[ (source at:p2+1) == Character cr]) ifTrue:[
- pos := p-1.
- pos2 := p2.
- (((source at:pos-1) == Character cr) and:[((source at:pos-2) == Character cr)])
- ifTrue:[ pos := pos - 1 ]
- ifFalse:[
- (((source at:pos2+1) == Character cr) and:[((source at:pos2+2) == Character cr)]) ifTrue:[
- pos2 := pos2 + 1 ]].
- ].
- ].
-
- self correctSourceByDeletingFrom:pos to:pos2.
- ^ self.
- ].
- ].
- startSearch := pos2 + 1.
+ |prevChar isFirstVar didPassEndOfLine|
+
+ "/ search this name's position in the declaration part ...
+ pos := source indexOfSubCollection:varName startingAt:startSearch ifAbsent:0.
+ (pos == 0 or:[pos >= defEndPos]) ifTrue:[
+ self error:'should not happen' mayProceed:true.
+ ^ self.
+ ].
+
+ pos2 := pos + varName size - 1.
+ pos > 1 ifTrue:[
+ prevChar := source at:pos-1.
+ ].
+ (prevChar isNil or:[prevChar isLetterOrDigit not]) ifTrue:[
+ nextChar := source at:pos2+1.
+ nextChar isLetterOrDigit ifFalse:[
+ "/ halfway intuitive space-removal behavior;
+ "/ if there was a space after/before the |-char,
+ "/ leave it; otherwise remove it.
+ isFirstVar := pos == (defStartPos+1).
+ (source at:pos-1) isSeparator ifTrue:[
+ pos := pos - 1.
+ [ (source at:pos-1) isSeparator] whileTrue:[
+ pos := pos - 1.
+ ].
+ (source at:pos-1) == $| ifTrue:[
+ "/ there was a space before - leave it
+ pos := pos + 1.
+ isFirstVar := true.
+ ]
+ ].
+
+ (source at:pos2+1) isSeparator ifTrue:[
+ didPassEndOfLine := (source at:pos2+1) == Character cr.
+ pos2 := pos2 + 1.
+ [ (source at:pos2+1) isSeparator] whileTrue:[
+ (source at:pos2+1) == Character cr ifTrue:[ didPassEndOfLine := true ].
+ pos2 := pos2 + 1.
+ ].
+
+ didPassEndOfLine ifFalse:[
+ (source at:pos2+1) == $" ifTrue:[
+ "/ comment follows - assume it belongs to the removed variable
+ pos2 := pos2 + 1.
+ (source at:pos2+1) == $/ ifTrue:[
+ "/ EOL comment
+ [ (source at:pos2+1) == Character cr ] whileFalse:[
+ pos2 := pos2 + 1.
+ ].
+ pos2 := pos2 + 1.
+ ] ifFalse:[
+ "/ regular comment
+ [ (source at:pos2+1) == $" ] whileFalse:[
+ pos2 := pos2 + 1.
+ ].
+ pos2 := pos2 + 1.
+ ].
+ [ (source at:pos2+1) isSeparator] whileTrue:[
+ (source at:pos2+1) == Character cr ifTrue:[ didPassEndOfLine := true ].
+ pos2 := pos2 + 1.
+ ].
+ ]
+ ].
+
+ (source at:pos2+1) == $| ifTrue:[
+ "/ there was a space after - leave it
+ pos2 := pos2 - 1.
+ ] ifFalse:[
+ isFirstVar ifFalse:[
+ pos2 := pos2 - 1.
+ ]
+ ].
+ ].
+
+ "/ if this was the last, remove empty var-declaration completely
+ ((source at:pos-1) == $|
+ and:[ (source at:pos2+1) == $| ]) ifTrue:[
+ pos := pos - 1.
+ pos2 := pos2 + 1.
+ "/ see if that gives us an empty line
+ p := pos.
+ p2 := pos2.
+
+ [(source at:p-1) == Character space] whileTrue:[ p := p - 1 ].
+ [(source at:p2+1) == Character space] whileTrue:[ p2 := p2 + 1 ].
+ ((source at:p-1) == Character cr and:[ (source at:p2+1) == Character cr]) ifTrue:[
+ pos := p-1.
+ pos2 := p2.
+ (((source at:pos-1) == Character cr) and:[((source at:pos-2) == Character cr)])
+ ifTrue:[ pos := pos - 1 ]
+ ifFalse:[
+ (((source at:pos2+1) == Character cr) and:[((source at:pos2+2) == Character cr)]) ifTrue:[
+ pos2 := pos2 + 1 ]].
+ ].
+ ].
+
+ self correctSourceByDeletingFrom:pos to:pos2.
+ ^ self.
+ ].
+ ].
+ startSearch := pos2 + 1.
]
"Modified: / 18-07-2006 / 08:56:25 / cg"
@@ -3466,7 +3449,7 @@
"collect known selectors with their spelling distances to aString;
return the 10 best suggestions"
- ^ self class findBestSelectorsFor:aString
+ ^ self class findBestSelectorsFor:aString
"Time millisecondsToRun:[Parser new findBestSelectorsFor:'foo']"
"Parser new findBestSelectorsFor:'findBestSel'"
@@ -3486,62 +3469,62 @@
"collect known variables with their spelling distances to aString;
return the 10 best suggestions"
- |names dists searchBlock args vars "aClass className baseClass"
+ |names dists searchBlock args vars "aClass className baseClass"
n instVarNames classVarNames spellAgainstNodeAction spellAgainstAction|
names := OrderedCollection new.
dists := OrderedCollection new.
- spellAgainstAction :=
- [:givenName |
- |dist|
-
- names add:givenName.
- dist := aString spellAgainst:givenName.
- (aString startsWith:givenName) ifTrue:[
- dist := dist + (givenName size * 10).
- ].
- dists add:dist
- ].
-
- spellAgainstNodeAction :=
- [:aVarNode |
- spellAgainstAction value:(aVarNode name).
- ].
+ spellAgainstAction :=
+ [:givenName |
+ |dist|
+
+ names add:givenName.
+ dist := aString spellAgainst:givenName.
+ (aString startsWith:givenName) ifTrue:[
+ dist := dist + (givenName size * 10).
+ ].
+ dists add:dist
+ ].
+
+ spellAgainstNodeAction :=
+ [:aVarNode |
+ spellAgainstAction value:(aVarNode name).
+ ].
"block arguments"
searchBlock := currentBlock.
[searchBlock notNil] whileTrue:[
- args := searchBlock arguments.
- args notNil ifTrue:[
- args do:spellAgainstNodeAction
- ].
-
- vars := searchBlock variables.
- vars notNil ifTrue:[
- vars do:spellAgainstNodeAction
- ].
- searchBlock := searchBlock home
+ args := searchBlock arguments.
+ args notNil ifTrue:[
+ args do:spellAgainstNodeAction
+ ].
+
+ vars := searchBlock variables.
+ vars notNil ifTrue:[
+ vars do:spellAgainstNodeAction
+ ].
+ searchBlock := searchBlock home
].
"method-variables"
methodVars notNil ifTrue:[
- methodVarNames do:spellAgainstAction
+ methodVarNames do:spellAgainstAction
].
"method-arguments"
methodArgs notNil ifTrue:[
- methodArgNames do:spellAgainstAction
+ methodArgNames do:spellAgainstAction
].
"instance-variables"
classToCompileFor notNil ifTrue:[
- self classesInstVarNames do:spellAgainstAction
+ self classesInstVarNames do:spellAgainstAction
].
"class-variables"
classToCompileFor notNil ifTrue:[
- self classesClassVarNames do:spellAgainstAction.
+ self classesClassVarNames do:spellAgainstAction.
"/ aClass := classToCompileFor.
"/ aClass isMeta ifTrue:[
@@ -3564,98 +3547,98 @@
"globals"
Smalltalk keysDo:[:aKey |
- |globalVarName parts|
-
- globalVarName := aKey asString.
-
- "only compare strings where length is about right"
- ((globalVarName size - aString size) abs < 3) ifTrue:[
- spellAgainstAction value:globalVarName.
- ].
- (globalVarName includes:$:) ifTrue:[
- parts := globalVarName asCollectionOfSubCollectionsSeparatedByAll:'::'.
- parts size > 1 ifTrue:[
- parts do:[:eachPart |
- |dist|
- ((eachPart size - aString size) abs < 3) ifTrue:[
- names add:globalVarName.
- dist := aString spellAgainst:eachPart.
- (aString startsWith:eachPart) ifTrue:[
- dist := dist + (eachPart size * 10).
- ].
- dists add:dist
- ].
- ].
- ].
- ].
+ |globalVarName parts|
+
+ globalVarName := aKey asString.
+
+ "only compare strings where length is about right"
+ ((globalVarName size - aString size) abs < 3) ifTrue:[
+ spellAgainstAction value:globalVarName.
+ ].
+ (globalVarName includes:$:) ifTrue:[
+ parts := globalVarName asCollectionOfSubCollectionsSeparatedByAll:'::'.
+ parts size > 1 ifTrue:[
+ parts do:[:eachPart |
+ |dist|
+ ((eachPart size - aString size) abs < 3) ifTrue:[
+ names add:globalVarName.
+ dist := aString spellAgainst:eachPart.
+ (aString startsWith:eachPart) ifTrue:[
+ dist := dist + (eachPart size * 10).
+ ].
+ dists add:dist
+ ].
+ ].
+ ].
+ ].
].
"misc"
#('self' 'super' 'nil' 'thisContext') do:spellAgainstAction.
(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.
- ]
- ].
- classToCompileFor notNil ifTrue:[
- instVarNames := OrderedCollection new.
- self classesInstVarNames asSortedCollection do:[:instVarName |
- (instVarNames includes:instVarName) ifFalse:[
- instVarNames add:instVarName.
- ]
- ].
-
- instVarNames size > 0 ifTrue:[
- (classToCompileFor notNil and:[classToCompileFor isMeta]) ifTrue:[
- names add:'---- class instance variables ----'.
- ] ifFalse:[
- names add:'---- instance variables ----'.
- ].
- instVarNames do:[:instVarName |
- (names includes:instVarName) ifFalse:[
- names add:instVarName.
- ]
- ]
- ].
-
- classVarNames := OrderedCollection new.
- self classesClassVarNames asSortedCollection do:[:classVarName |
- (classVarNames includes:classVarName) ifFalse:[
- classVarNames add:classVarName.
- ]
- ].
-
- classVarNames size > 0 ifTrue:[
- names add:'---- class variables ----'.
- classVarNames do:[:classVarName |
- (names includes:classVarName) ifFalse:[
- names add:classVarName.
- ]
- ]
- ].
- ].
- ].
-
- ^ 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.
+ ]
+ ].
+ classToCompileFor notNil ifTrue:[
+ instVarNames := OrderedCollection new.
+ self classesInstVarNames asSortedCollection do:[:instVarName |
+ (instVarNames includes:instVarName) ifFalse:[
+ instVarNames add:instVarName.
+ ]
+ ].
+
+ instVarNames size > 0 ifTrue:[
+ (classToCompileFor notNil and:[classToCompileFor isMeta]) ifTrue:[
+ names add:'---- class instance variables ----'.
+ ] ifFalse:[
+ names add:'---- instance variables ----'.
+ ].
+ instVarNames do:[:instVarName |
+ (names includes:instVarName) ifFalse:[
+ names add:instVarName.
+ ]
+ ]
+ ].
+
+ classVarNames := OrderedCollection new.
+ self classesClassVarNames asSortedCollection do:[:classVarName |
+ (classVarNames includes:classVarName) ifFalse:[
+ classVarNames add:classVarName.
+ ]
+ ].
+
+ classVarNames size > 0 ifTrue:[
+ names add:'---- class variables ----'.
+ classVarNames do:[:classVarName |
+ (names includes:classVarName) ifFalse:[
+ names add:classVarName.
+ ]
+ ]
+ ].
+ ].
+ ].
+
+ ^ names
].
^ nil
@@ -3667,11 +3650,11 @@
!
selectorCheck:aSelectorString for:receiver positions:posVector
- "just a quick check: if a selector is totally unknown as a symbol,
+ "just a quick check: if a selector is totally unknown as a symbol,
has the same name as a variable, cannot be understood or is obsolete.
Simple, but catches many typos"
- |isSyntaxHighlighter err selectorSymbol rec names recType selClass newSelector nm nowhereImplemented
+ |isSyntaxHighlighter err selectorSymbol rec names recType selClass newSelector nm nowhereImplemented
pos1 pos2 canDefine|
isSyntaxHighlighter := self isSyntaxHighlighter.
@@ -3680,17 +3663,17 @@
is no requestor, do not check
"
isSyntaxHighlighter ifFalse:[
- (LazyCompilation == true) ifTrue:[^ aSelectorString].
- (ignoreErrors or:[ignoreWarnings]) ifTrue:[^ aSelectorString].
- (requestor isNil or:[requestor isStream]) ifTrue:[^ aSelectorString].
- parserFlags warnings ifFalse:[^ aSelectorString].
+ (LazyCompilation == true) ifTrue:[^ aSelectorString].
+ (ignoreErrors or:[ignoreWarnings]) ifTrue:[^ aSelectorString].
+ (requestor isNil or:[requestor isStream]) ifTrue:[^ aSelectorString].
+ parserFlags warnings ifFalse:[^ aSelectorString].
].
"/ do not check messages to undefined variables...
(receiver isVariable and:[receiver isUndeclared]) ifTrue:[
- ^ aSelectorString
+ ^ aSelectorString
].
self isDoIt ifTrue:[
- ^ aSelectorString
+ ^ aSelectorString
].
canDefine := false.
@@ -3699,13 +3682,13 @@
pos2 := posVector last stop.
(#('#' '|' '^') includes:aSelectorString) ifTrue:[
- self
- warnPossibleIncompatibility:('''',aSelectorString,''' might not be a valid selector in other smalltalk systems')
- position:pos1 to:pos2.
+ self
+ warnPossibleIncompatibility:('''',aSelectorString,''' might not be a valid selector in other smalltalk systems')
+ position:pos1 to:pos2.
].
requestor isNil ifTrue:[
- ^ aSelectorString
+ ^ aSelectorString
].
"/ (parserFlags warnAboutPossiblyUnimplementedSelectors ifFalse:[
"/ ^ aSelectorString
@@ -3719,7 +3702,7 @@
selectorSymbol := aSelectorString asSymbolIfInterned.
selectorSymbol isNil ifTrue:[
- nowhereImplemented := true.
+ nowhereImplemented := true.
] ifFalse:[
"/ temporarily disabled - too slow.
"/ self isSyntaxHighlighter ifTrue:[
@@ -3728,222 +3711,222 @@
].
nowhereImplemented ifTrue:[
- isSyntaxHighlighter ifFalse:[
- self classToCompileFor notNil ifTrue:[
- Tools::ToDoListBrowser notNil ifTrue:[
- "/ experimental
- self
- notifyTodo:('"%1" is nowhere implemented' bindWith:aSelectorString) position:posVector first
- className:(self classToCompileFor name) selector:selector
- severity:#warning priority:#high
- equalityParameter:aSelectorString
- checkAction:[:e |
- e problemMethod notNil
- and:[(e problemMethod sends:aSelectorString asSymbol)
- and:[self class implementedInAnyClass:aSelectorString]] ]
- ].
- ].
- ].
-
- err := ' is currently nowhere implemented'.
-
- "
- if the selector has the name of a variable, use another message
- "
- ((methodVarNames notNil and:[methodVarNames includes:aSelectorString])
- or:[(methodArgNames notNil and:[methodArgNames includes:aSelectorString])
- or:[classToCompileFor notNil
- and:[((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 ..
-.. but a variable with that name is defined.
-
-Missing ''.'' after the previous expression
+ isSyntaxHighlighter ifFalse:[
+ self classToCompileFor notNil ifTrue:[
+ Tools::ToDoListBrowser notNil ifTrue:[
+ "/ experimental
+ self
+ notifyTodo:('"%1" is nowhere implemented' bindWith:aSelectorString) position:posVector first
+ className:(self classToCompileFor name) selector:selector
+ severity:#warning priority:#high
+ equalityParameter:aSelectorString
+ checkAction:[:e |
+ e problemMethod notNil
+ and:[(e problemMethod sends:aSelectorString asSymbol)
+ and:[self class implementedInAnyClass:aSelectorString]] ]
+ ].
+ ].
+ ].
+
+ err := ' is currently nowhere implemented'.
+
+ "
+ if the selector has the name of a variable, use another message
+ "
+ ((methodVarNames notNil and:[methodVarNames includes:aSelectorString])
+ or:[(methodArgNames notNil and:[methodArgNames includes:aSelectorString])
+ or:[classToCompileFor notNil
+ and:[((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 ..
+.. but a variable with that name is defined.
+
+Missing ''.'' after the previous expression
or missing keyword/receiver before that word ?'.
- ].
+ ].
] ifFalse:[
- receiver notNil ifTrue:[
- selClass := self typeOfNode:receiver.
- selClass notNil ifTrue:[
- "this could be performed if selClass isNil, but it is too slow"
- err := self checkSelector:selectorSymbol for:receiver inClass:selClass.
- ].
-
- err notNil ifTrue:[
- isSyntaxHighlighter ifFalse:[
- self classToCompileFor notNil ifTrue:[
- Tools::ToDoListBrowser notNil ifTrue:[
- "/ experimental
- self
- notifyTodo:(selectorSymbol ,' ',err) position:posVector first
- className:(self classToCompileFor name) selector:selector
- severity:#warning priority:#high
- equalityParameter:selectorSymbol
- checkAction:[:e |
- |selClass|
-
- selClass := self typeOfNode:receiver.
- e problemMethod notNil
- and:[(e problemMethod sends:aSelectorString asSymbol)
- and:[(self checkSelector:selectorSymbol for:receiver inClass:selClass) notNil]]].
- ].
- ].
- ].
- ].
-
- (receiver isConstant or:[receiver isBlock]) ifTrue:[
- err notNil ifTrue:[
- err := err, ' in ' , selClass name , ' or any of its superclasses'.
- ].
- ] ifFalse:[(((recType := receiver type) == #GlobalVariable)
- or:[recType == #PrivateClass]) ifTrue:[
- rec := receiver evaluate.
- "/ dont check autoloaded classes - it may work after loading
- (rec isNil
- or:[rec isBehavior and:[rec isLoaded not]]) ifTrue:[
- ^ aSelectorString
- ].
-
- err notNil ifTrue:[
- (rec isBehavior
- and:[rec theNonMetaclass name = receiver name]) ifTrue:[
- err := err, ' in ' , rec theNonMetaclass name.
- ] ifFalse:[
- err := err, ' in currently assigned value (is currently ' , rec classNameWithArticle , ')'.
- ]
- ].
- ] ifFalse:[receiver isSuper ifTrue:[
- receiver isHere ifFalse:[
- err notNil ifTrue:[
- err := err, ' in superclass chain'.
- ].
- ] ifTrue:[
- err notNil ifTrue:[
- err := err, ' in this class or superclass chain'.
- ].
- ]
- ] ifFalse:[receiver isSelf ifTrue:[
- err notNil ifTrue:[
- |subErr|
-
- "/ understood by all subclasses ?
- classToCompileFor allSubclassesDo:[:eachSubclass |
- subErr isNil ifTrue:[
- selClass := eachSubclass.
- subErr := self checkSelector:selectorSymbol for:receiver inClass:selClass.
- ].
- ].
- subErr notNil ifTrue:[
- err := subErr, ' in this class, superclass chain or all subclasses'
- ] ifFalse:[
- err := err, ' in this class or superclass chain'.
- ].
- canDefine := true.
- ].
- ] ifFalse:[(receiver isUnaryMessage
- and:[receiver selector == #class
- and:[receiver receiver isSelf]]) ifTrue:[
- "its a message to self class - can check this too ..."
- err notNil ifTrue:[
- classToCompileFor isMeta ifTrue:[
- err := err, ' for the classes class'.
- (self checkSelector:selectorSymbol for:receiver inClass:classToCompileFor) isNil ifTrue:[
- err := err, '...\\...but its implemented for the class itself. You probably do not want the #class message here.'.
- err := err withCRs.
- ].
- ] ifFalse:[
- err := err, ' for my class'.
- (self checkSelector:selectorSymbol for:receiver inClass:classToCompileFor) isNil ifTrue:[
- err := err, '...\\...but its implemented for instances. You may want to remove the #class message.'.
- err := err withCRs.
- ].
- ].
- ].
- ] ifFalse:[(receiver isMethodVariable and:[receiver token type isNil]) ifTrue:[
- "if it is an uninitialized variable ..."
- ((modifiedLocalVars isNil or:[(modifiedLocalVars includes:receiver name) not])
- and:[hasPrimitiveCode not
- and:[currentBlock isNil
- and:[alreadyWarnedUninitializedVars isNil
- or:[(alreadyWarnedUninitializedVars includes:receiver name) not]]]])
- ifTrue:[
- ((#(at: at:put: basicAt: basicAt:put:) includes:selectorSymbol)
- or:[(nil respondsTo:selectorSymbol) not])ifTrue:[
- "/ avoid trouble in miniTalk
- "/ during bootstrap
- nm := receiver name.
- Text notNil ifTrue:[
- nm := nm allItalic
- ].
- err := 'sent to possibly uninitialized variable ''' , nm , ''' here (?)'.
- alreadyWarnedUninitializedVars isNil ifTrue:[
- alreadyWarnedUninitializedVars := Set new
- ].
- alreadyWarnedUninitializedVars add:receiver name
- ]
- ]
- ] ifFalse:[
- (err notNil and:[selClass notNil]) ifTrue:[
- err := err, ' (message to ' , selClass nameWithArticle , ')'.
- ].
- ]]]]]].
- ]
+ receiver notNil ifTrue:[
+ selClass := self typeOfNode:receiver.
+ selClass notNil ifTrue:[
+ "this could be performed if selClass isNil, but it is too slow"
+ err := self checkSelector:selectorSymbol for:receiver inClass:selClass.
+ ].
+
+ err notNil ifTrue:[
+ isSyntaxHighlighter ifFalse:[
+ self classToCompileFor notNil ifTrue:[
+ Tools::ToDoListBrowser notNil ifTrue:[
+ "/ experimental
+ self
+ notifyTodo:(selectorSymbol ,' ',err) position:posVector first
+ className:(self classToCompileFor name) selector:selector
+ severity:#warning priority:#high
+ equalityParameter:selectorSymbol
+ checkAction:[:e |
+ |selClass|
+
+ selClass := self typeOfNode:receiver.
+ e problemMethod notNil
+ and:[(e problemMethod sends:aSelectorString asSymbol)
+ and:[(self checkSelector:selectorSymbol for:receiver inClass:selClass) notNil]]].
+ ].
+ ].
+ ].
+ ].
+
+ (receiver isConstant or:[receiver isBlock]) ifTrue:[
+ err notNil ifTrue:[
+ err := err, ' in ' , selClass name , ' or any of its superclasses'.
+ ].
+ ] ifFalse:[(((recType := receiver type) == #GlobalVariable)
+ or:[recType == #PrivateClass]) ifTrue:[
+ rec := receiver evaluate.
+ "/ dont check autoloaded classes - it may work after loading
+ (rec isNil
+ or:[rec isBehavior and:[rec isLoaded not]]) ifTrue:[
+ ^ aSelectorString
+ ].
+
+ err notNil ifTrue:[
+ (rec isBehavior
+ and:[rec theNonMetaclass name = receiver name]) ifTrue:[
+ err := err, ' in ' , rec theNonMetaclass name.
+ ] ifFalse:[
+ err := err, ' in currently assigned value (is currently ' , rec classNameWithArticle , ')'.
+ ]
+ ].
+ ] ifFalse:[receiver isSuper ifTrue:[
+ receiver isHere ifFalse:[
+ err notNil ifTrue:[
+ err := err, ' in superclass chain'.
+ ].
+ ] ifTrue:[
+ err notNil ifTrue:[
+ err := err, ' in this class or superclass chain'.
+ ].
+ ]
+ ] ifFalse:[receiver isSelf ifTrue:[
+ err notNil ifTrue:[
+ |subErr|
+
+ "/ understood by all subclasses ?
+ classToCompileFor allSubclassesDo:[:eachSubclass |
+ subErr isNil ifTrue:[
+ selClass := eachSubclass.
+ subErr := self checkSelector:selectorSymbol for:receiver inClass:selClass.
+ ].
+ ].
+ subErr notNil ifTrue:[
+ err := subErr, ' in this class, superclass chain or all subclasses'
+ ] ifFalse:[
+ err := err, ' in this class or superclass chain'.
+ ].
+ canDefine := true.
+ ].
+ ] ifFalse:[(receiver isUnaryMessage
+ and:[receiver selector == #class
+ and:[receiver receiver isSelf]]) ifTrue:[
+ "its a message to self class - can check this too ..."
+ err notNil ifTrue:[
+ classToCompileFor isMeta ifTrue:[
+ err := err, ' for the classes class'.
+ (self checkSelector:selectorSymbol for:receiver inClass:classToCompileFor) isNil ifTrue:[
+ err := err, '...\\...but its implemented for the class itself. You probably do not want the #class message here.'.
+ err := err withCRs.
+ ].
+ ] ifFalse:[
+ err := err, ' for my class'.
+ (self checkSelector:selectorSymbol for:receiver inClass:classToCompileFor) isNil ifTrue:[
+ err := err, '...\\...but its implemented for instances. You may want to remove the #class message.'.
+ err := err withCRs.
+ ].
+ ].
+ ].
+ ] ifFalse:[(receiver isMethodVariable and:[receiver token type isNil]) ifTrue:[
+ "if it is an uninitialized variable ..."
+ ((modifiedLocalVars isNil or:[(modifiedLocalVars includes:receiver name) not])
+ and:[hasPrimitiveCode not
+ and:[currentBlock isNil
+ and:[alreadyWarnedUninitializedVars isNil
+ or:[(alreadyWarnedUninitializedVars includes:receiver name) not]]]])
+ ifTrue:[
+ ((#(at: at:put: basicAt: basicAt:put:) includes:selectorSymbol)
+ or:[(nil respondsTo:selectorSymbol) not])ifTrue:[
+ "/ avoid trouble in miniTalk
+ "/ during bootstrap
+ nm := receiver name.
+ Text notNil ifTrue:[
+ nm := nm allItalic
+ ].
+ err := 'sent to possibly uninitialized variable ''' , nm , ''' here (?)'.
+ alreadyWarnedUninitializedVars isNil ifTrue:[
+ alreadyWarnedUninitializedVars := Set new
+ ].
+ alreadyWarnedUninitializedVars add:receiver name
+ ]
+ ]
+ ] ifFalse:[
+ (err notNil and:[selClass notNil]) ifTrue:[
+ err := err, ' (message to ' , selClass nameWithArticle , ')'.
+ ].
+ ]]]]]].
+ ]
].
parserFlags warnAboutPossiblyUnimplementedSelectors ifFalse:[
- ^ aSelectorString
+ ^ aSelectorString
].
err notNil ifTrue:[
- (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
- ].
- rec class == UndefinedVariable ifTrue:[
- "/ dont check undefined vars;
- "/ it may work after loading/defining
- ^ aSelectorString
- ].
- ].
- Text notNil ifTrue:[
- err := '"' , aSelectorString allBold, '" ', err
- ] ifFalse:[
- err := aSelectorString , ' ', err
- ].
- "/ if its a recursive invocation of just that selector, do not complain
- (selector = aSelectorString and:[ receiver isSelf]) ifTrue:[
- ^ aSelectorString
- ].
- isSyntaxHighlighter ifTrue:[
- posVector do:[:p |
- self markUnknownIdentifierFrom:(p start) to:(p stop).
- ].
- ].
- isSyntaxHighlighter ifFalse:[
- err := err , '\\This is a warning from the compiler - the code has not yet been executed/compiled.'.
-
- DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
- parserFlags warnAboutPossiblyUnimplementedSelectors:false.
- ParserFlags warnAboutPossiblyUnimplementedSelectors:false.
- ex proceed.
- ] do:[
- newSelector := self correctSelector:aSelectorString
- message:err withCRs
- positions:posVector in:selClass for:receiver.
+ (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
+ ].
+ rec class == UndefinedVariable ifTrue:[
+ "/ dont check undefined vars;
+ "/ it may work after loading/defining
+ ^ aSelectorString
+ ].
+ ].
+ Text notNil ifTrue:[
+ err := '"' , aSelectorString allBold, '" ', err
+ ] ifFalse:[
+ err := aSelectorString , ' ', err
+ ].
+ "/ if its a recursive invocation of just that selector, do not complain
+ (selector = aSelectorString and:[ receiver isSelf]) ifTrue:[
+ ^ aSelectorString
+ ].
+ isSyntaxHighlighter ifTrue:[
+ posVector do:[:p |
+ self markUnknownIdentifierFrom:(p start) to:(p stop).
+ ].
+ ].
+ isSyntaxHighlighter ifFalse:[
+ err := err , '\\This is a warning from the compiler - the code has not yet been executed/compiled.'.
+
+ DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+ parserFlags warnAboutPossiblyUnimplementedSelectors:false.
+ ParserFlags warnAboutPossiblyUnimplementedSelectors:false.
+ ex proceed.
+ ] do:[
+ newSelector := self correctSelector:aSelectorString
+ message:err withCRs
+ positions:posVector in:selClass for:receiver.
"/ self warning:('#' , aSelectorString , '\\' , err) withCRs position:pos1 to:pos2.
- ].
- ^ newSelector.
- ].
+ ].
+ ^ newSelector.
+ ].
].
^ aSelectorString
@@ -3955,70 +3938,70 @@
|nodeVal nodeType classHint rClass|
aNode isConstant ifTrue:[
- "if the receiver is a constant, we know its class..."
- nodeVal := aNode evaluate.
- ^ nodeVal class.
+ "if the receiver is a constant, we know its class..."
+ nodeVal := aNode evaluate.
+ ^ nodeVal class.
].
aNode isBlock ifTrue:[
- "/ this should help with typos, sending #ifTrue to blocks ...
- ^ Block
+ "/ this should help with typos, sending #ifTrue to blocks ...
+ ^ Block
].
aNode isVariable ifTrue:[
- nodeType := aNode type.
- (nodeType == #GlobalVariable or:[nodeType == #PrivateClass]) ifTrue:[
- "if the receiver is a global, we check it too ..."
-
- nodeVal := aNode evaluate.
- "/ dont check autoloaded classes
- "/ - it may work after loading
- (nodeVal isNil
- or:[nodeVal isBehavior and:[nodeVal isLoaded not]]) ifTrue:[
- ^ nil
- ].
-
- ^ nodeVal class.
- ].
-
- (aNode isLocal) ifTrue:[
- classHint := aNode token classHint.
- classHint notNil ifTrue:[
- ^ Smalltalk classNamed:classHint
- ].
- ].
+ nodeType := aNode type.
+ (nodeType == #GlobalVariable or:[nodeType == #PrivateClass]) ifTrue:[
+ "if the receiver is a global, we check it too ..."
+
+ nodeVal := aNode evaluate.
+ "/ dont check autoloaded classes
+ "/ - it may work after loading
+ (nodeVal isNil
+ or:[nodeVal isBehavior and:[nodeVal isLoaded not]]) ifTrue:[
+ ^ nil
+ ].
+
+ ^ nodeVal class.
+ ].
+
+ (aNode isLocal) ifTrue:[
+ classHint := aNode token classHint.
+ classHint notNil ifTrue:[
+ ^ Smalltalk classNamed:classHint
+ ].
+ ].
].
aNode isSuper ifTrue:[
- "if its a super- or here-send, we can do more checking"
- aNode isHere ifFalse:[
- ^ classToCompileFor superclass ? UndefinedObject.
- ].
- ^ classToCompileFor.
+ "if its a super- or here-send, we can do more checking"
+ aNode isHere ifFalse:[
+ ^ classToCompileFor superclass ? UndefinedObject.
+ ].
+ ^ classToCompileFor.
].
aNode isSelf ifTrue:[
- ^ classToCompileFor.
+ ^ classToCompileFor.
].
(aNode isUnaryMessage) ifTrue:[
- (aNode selector == #class) ifTrue:[
+ (aNode selector == #class) ifTrue:[
"/ aNode receiver isSelf ifTrue:[
"/ "its a message to self class - can check this too ..."
"/ ^ classToCompileFor class.
"/ ].
- rClass := self typeOfNode:aNode receiver.
- rClass notNil ifTrue:[
- ^ rClass class.
- ].
- ].
- ( #(#'isNil' #'notNil') includes:aNode selector) ifTrue:[
- ^ Boolean.
- ]
+ rClass := self typeOfNode:aNode receiver.
+ rClass notNil ifTrue:[
+ ^ rClass class.
+ ].
+ ].
+ ( #(#'isNil' #'notNil') includes:aNode selector) ifTrue:[
+ ^ Boolean.
+ ]
].
aNode isBinaryMessage ifTrue:[
- ( #(#'<' #'>' #'>=' #'<=' #'=' #'==' #'~=' #'~~') includes:aNode selector) ifTrue:[
- ^ Boolean.
- ]
+ ( #(#'<' #'>' #'>=' #'<=' #'=' #'==' #'~=' #'~~') includes:aNode selector) ifTrue:[
+ ^ Boolean.
+ ]
].
^ nil
@@ -4030,15 +4013,15 @@
"argname reuse"
self isSyntaxHighlighter ifTrue:[
- self markBadIdentifierFrom:pos1 to:pos2.
+ self markBadIdentifierFrom:pos1 to:pos2.
] ifFalse:[
- self
- syntaxError:'redefinition of ''' , tokenName , ''' in argument list.'
- position:pos1 to:pos2
- ].
-!
-
-disableWarningsOnCurrentMethodFor:flagName
+ self
+ syntaxError:'redefinition of ''' , tokenName , ''' in argument list.'
+ position:pos1 to:pos2
+ ].
+!
+
+disableWarningsOnCurrentMethodFor:flagName
ParserFlags disableFlag:flagName forClass:classToCompileFor selector:selector
"Created: / 28-02-2012 / 14:44:31 / cg"
@@ -4048,38 +4031,38 @@
|idx implementors|
classToCompileFor notNil ifTrue:[
- "/ is it an instance-variable marked inaccessable ?
-
- idx := (self classesInstVarNames) indexOf:(aName , '*') startingAt:1.
- idx ~~ 0 ifTrue:[
- ^ '''%1'' is a hidden instvar (not accessable from ST-code)' bindWith:aName allBold.
- ].
-
- "/ is it an instance variable, while evaluateing for the class ?
- classToCompileFor isMeta ifTrue:[
- (classToCompileFor soleInstance allInstVarNames includes:aName) ifTrue:[
- ^ '''%1'' is an instvar\(hint: you are evaluating/compiling in the classes context)' bindWith:aName allBold.
- ]
- ]
+ "/ is it an instance-variable marked inaccessable ?
+
+ idx := (self classesInstVarNames) indexOf:(aName , '*') startingAt:1.
+ idx ~~ 0 ifTrue:[
+ ^ '''%1'' is a hidden instvar (not accessable from ST-code)' bindWith:aName allBold.
+ ].
+
+ "/ is it an instance variable, while evaluateing for the class ?
+ classToCompileFor isMeta ifTrue:[
+ (classToCompileFor soleInstance allInstVarNames includes:aName) ifTrue:[
+ ^ '''%1'' is an instvar\(hint: you are evaluating/compiling in the classes context)' bindWith:aName allBold.
+ ]
+ ]
].
self isDoIt ifTrue:[
- SystemBrowser notNil ifTrue:[
- implementors := SystemBrowser
- findImplementorsOf:aName
- in:(Smalltalk allClasses)
- ignoreCase:false.
- implementors size > 0 ifTrue:[
- implementors size == 1 ifTrue:[
- ^ '''%1'' is undefined but known as a message selector in %2.\(hint: did you forget to specify or select the receiver ?)'
- bindWith:aName allBold
- with:implementors first mclass name allBold
- ].
- ^ '''%1'' is undefined but known as a message selector.\(hint: did you forget to specify or select the receiver ?)' bindWith:aName allBold.
- ].
- ].
+ SystemBrowser notNil ifTrue:[
+ implementors := SystemBrowser
+ findImplementorsOf:aName
+ in:(Smalltalk allClasses)
+ ignoreCase:false.
+ implementors size > 0 ifTrue:[
+ implementors size == 1 ifTrue:[
+ ^ '''%1'' is undefined but known as a message selector in %2.\(hint: did you forget to specify or select the receiver ?)'
+ bindWith:aName allBold
+ with:implementors first mclass name allBold
+ ].
+ ^ '''%1'' is undefined but known as a message selector.\(hint: did you forget to specify or select the receiver ?)' bindWith:aName allBold.
+ ].
+ ].
].
peekChar == $: ifTrue:[
- ^ 'NameSpace "%1" is undefined' bindWith:aName allBold.
+ ^ 'NameSpace "%1" is undefined' bindWith:aName allBold.
].
^ '"%1" is undefined' bindWith:aName allBold.
!
@@ -4094,12 +4077,12 @@
|msg|
(#(True False Self Nil Super ThisContext) includes:tokenType) ifTrue:[
- msg := 'Reserved keyword in '
+ msg := 'Reserved keyword in '
] ifFalse:[
- msg := 'Identifier expected in '
+ msg := 'Identifier expected in '
].
self syntaxError:(msg , what , ' (got ''' , tokenType printString, ''')')
- position:tokenPosition to:source position1Based - 1.
+ position:tokenPosition to:source position1Based - 1.
^ #Error
!
@@ -4107,11 +4090,11 @@
"argname reuse"
self isSyntaxHighlighter ifTrue:[
- self markBadIdentifierFrom:pos1 to:pos2.
+ self markBadIdentifierFrom:pos1 to:pos2.
] ifFalse:[
- self
- syntaxError:'redefinition of ''' , tokenName , ''' in argument list.'
- position:pos1 to:pos2
+ self
+ syntaxError:'redefinition of ''' , tokenName , ''' in argument list.'
+ position:pos1 to:pos2
].
!
@@ -4122,31 +4105,31 @@
|msg|
ignoreErrors ifFalse:[
- Smalltalk silentLoading ifFalse:[
- msg := ''.
- pos notNil ifTrue:[
- msg := msg , (pos printString).
- msg := msg , ' '.
- ].
- msg := msg , aMessage.
- selector notNil ifTrue:[
- msg := msg , ' in '.
- classToCompileFor notNil ifTrue:[
- msg := msg , classToCompileFor name , '>>'
- ].
- msg := msg , selector.
- ] ifFalse:[
- classToCompileFor notNil ifTrue:[
- msg := msg , ' (' , classToCompileFor name , ')'
- ]
- ].
-
- UserInformation isHandled ifTrue:[
- UserInformation raiseErrorString:msg
- ] ifFalse:[
- Transcript showCR:msg.
- ]
- ]
+ Smalltalk silentLoading ifFalse:[
+ msg := ''.
+ pos notNil ifTrue:[
+ msg := msg , (pos printString).
+ msg := msg , ' '.
+ ].
+ msg := msg , aMessage.
+ selector notNil ifTrue:[
+ msg := msg , ' in '.
+ classToCompileFor notNil ifTrue:[
+ msg := msg , classToCompileFor name , '>>'
+ ].
+ msg := msg , selector.
+ ] ifFalse:[
+ classToCompileFor notNil ifTrue:[
+ msg := msg , ' (' , classToCompileFor name , ')'
+ ]
+ ].
+
+ UserInformation isHandled ifTrue:[
+ UserInformation raiseErrorString:msg
+ ] ifFalse:[
+ Transcript showCR:msg.
+ ]
+ ]
]
"Modified: 18.5.1996 / 15:44:15 / cg"
@@ -4156,10 +4139,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'.
@@ -4180,23 +4163,23 @@
ex suspendedContext:thisContext.
doCorrect := ex raiseRequest.
doCorrect notNil ifTrue:[
- ^ doCorrect
+ ^ doCorrect
].
"
already 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
+ ].
].
"/ ignoreWarnings ifTrue:[^ false].
parserFlags warnUndeclared ifFalse:[^ false].
-"/ (classToCompileFor notNil
+"/ (classToCompileFor notNil
"/ and:[classToCompileFor superclass notNil
"/ and:[classToCompileFor superclass instanceVariableString isNil]]) ifTrue:[
"/ self showErrorMessage:'Error: no source information (instvar names)' position:pos1.
@@ -4206,48 +4189,48 @@
boldName := aName allBold.
(requestor isNil or:[requestor isStream]) ifTrue:[
- errMsg := 'Error: "%1" is undefined' bindWith:boldName.
- aName isUppercaseFirst ifFalse:[
- self showErrorMessage:errMsg position:pos1.
- ].
- doCorrect := false.
+ errMsg := 'Error: "%1" is undefined' bindWith:boldName.
+ aName isUppercaseFirst ifFalse:[
+ self showErrorMessage:errMsg 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.
- "
- errMsg := self errorMessageForUndefined:aName.
- aName isUppercaseFirst ifTrue:[
- doCorrect := self
- correctableWarning:errMsg withCRs
- position:pos1 to:pos2
- ] ifFalse:[
- doCorrect := self
- correctableError:errMsg withCRs
- 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.
+ "
+ errMsg := self errorMessageForUndefined:aName.
+ aName isUppercaseFirst ifTrue:[
+ doCorrect := self
+ correctableWarning:errMsg withCRs
+ position:pos1 to:pos2
+ ] ifFalse:[
+ doCorrect := self
+ correctableError:errMsg withCRs
+ position:pos1 to:pos2
+ ].
].
doCorrect == false ifTrue:[
- warnedUndefVars isNil ifTrue:[
- warnedUndefVars := Set new.
- ].
- warnedUndefVars add:aName.
- self classToCompileFor notNil ifTrue:[
- Tools::ToDoListBrowser notNil ifTrue:[
- "/ experimental
- self
- notifyTodo:errMsg position:pos1
- className:(self classToCompileFor name) selector:selector
- severity:#error priority:#high
- equalityParameter:aName
- checkAction:[:e |
- e problemMethod notNil
- and:[(e problemMethod usedGlobals includes:aName)
- and:[(Smalltalk includesKey:aName) not]] ].
- ].
- ].
+ warnedUndefVars isNil ifTrue:[
+ warnedUndefVars := Set new.
+ ].
+ warnedUndefVars add:aName.
+ self classToCompileFor notNil ifTrue:[
+ Tools::ToDoListBrowser notNil ifTrue:[
+ "/ experimental
+ self
+ notifyTodo:errMsg position:pos1
+ className:(self classToCompileFor name) selector:selector
+ severity:#error priority:#high
+ equalityParameter:aName
+ checkAction:[:e |
+ e problemMethod notNil
+ and:[(e problemMethod usedGlobals includes:aName)
+ and:[(Smalltalk includesKey:aName) not]] ].
+ ].
+ ].
].
^ doCorrect
@@ -4257,32 +4240,32 @@
warnSTXHereExtensionUsedAt:position
ignoreWarnings ifFalse:[
- didWarnAboutSTXHereExtensionUsed ifFalse:[
- parserFlags warnSTXHereExtensionUsed ifTrue:[
- self warning:'here-sends are a nonstandard feature of ST/X'
- position:position to:position+3.
- "
- only warn once
- "
- didWarnAboutSTXHereExtensionUsed := true
- ].
- ].
+ didWarnAboutSTXHereExtensionUsed ifFalse:[
+ parserFlags warnSTXHereExtensionUsed ifTrue:[
+ self warning:'here-sends are a nonstandard feature of ST/X'
+ position:position to:position+3.
+ "
+ only warn once
+ "
+ didWarnAboutSTXHereExtensionUsed := true
+ ].
+ ].
].
!
warnSTXNameSpaceUseAt:position
ignoreWarnings ifFalse:[
- didWarnAboutSTXNameSpaceUse ifFalse:[
- parserFlags warnSTXNameSpaceUse ifTrue:[
- self warning:'NameSpaces are a nonstandard feature of ST/X'
- doNotShowAgainAction:[ ParserFlags warnSTXSpecials:false ]
- position:position to:(source position1Based).
- "
- only warn once
- "
- didWarnAboutSTXNameSpaceUse := false
- ]
- ]
+ didWarnAboutSTXNameSpaceUse ifFalse:[
+ parserFlags warnSTXNameSpaceUse ifTrue:[
+ self warning:'NameSpaces are a nonstandard feature of ST/X'
+ doNotShowAgainAction:[ ParserFlags warnSTXSpecials:false ]
+ position:position to:(source position1Based).
+ "
+ only warn once
+ "
+ didWarnAboutSTXNameSpaceUse := false
+ ]
+ ]
].
!
@@ -4298,65 +4281,65 @@
|msg answer lineLength first queries|
- ignoreErrors ifTrue:[^ self].
- ignoreWarnings ifTrue:[^ self].
- parserFlags warnUnusedVars ifFalse:[^ self].
-
- (ParserFlags isFlag:#warnUnusedVars enabledForClass:classToCompileFor selector:selector)
- ifFalse:[^ self].
+ ignoreErrors ifTrue:[^ self].
+ ignoreWarnings ifTrue:[^ self].
+ parserFlags warnUnusedVars ifFalse:[^ self].
+
+ (ParserFlags isFlag:#warnUnusedVars enabledForClass:classToCompileFor selector:selector)
+ ifFalse:[^ self].
msg := 'Unused method variable(s): '.
lineLength := msg size.
first := true.
aNameCollection asSortedCollection do:[:name|
- first ifTrue:[ first := false ] ifFalse:[msg := msg , ', '].
- msg := msg , ('"',name allBold,'"').
- lineLength := lineLength + 2 + name size + 1.
- lineLength > 60 ifTrue:[
- msg := msg , '\' withCRs.
- lineLength := 0.
- ].
+ first ifTrue:[ first := false ] ifFalse:[msg := msg , ', '].
+ msg := msg , ('"',name allBold,'"').
+ lineLength := lineLength + 2 + name size + 1.
+ lineLength > 60 ifTrue:[
+ msg := msg , '\' withCRs.
+ lineLength := 0.
+ ].
].
(requestor isNil or:[requestor isStream]) ifTrue:[
- self showErrorMessage:('Warning: ', msg) position:nil.
+ self showErrorMessage:('Warning: ', msg) position:nil.
] ifFalse:[
- queries := DoNotShowCompilerWarningAgainActionQuery.
- (self isDoIt not
- and:[ classToCompileFor notNil
- and:[ selector notNil ]]) ifTrue:[
- queries := queries , DoNotShowCompilerWarningAgainForThisMethodActionQuery.
- ].
- queries handle:[:ex |
- ex signal == DoNotShowCompilerWarningAgainActionQuery ifTrue:[
- parserFlags warnUnusedVars:false.
- ParserFlags warnUnusedVars:false.
- ] ifFalse:[
- self disableWarningsOnCurrentMethodFor: #warnUnusedVars
- ].
- ex proceed.
- ] do:[
- answer := requestor
- unusedVariableWarning:msg
- position:(localVarDefPosition first) to:(localVarDefPosition last) from:self.
- ].
- answer == true ifTrue:[
- "/ delete the definitions ...
- aNameCollection do:[:eachName |
- self deleteDefinitionOf:eachName in:(localVarDefPosition first) to:(localVarDefPosition last).
- ].
- RestartCompilationSignal raise
- ].
+ queries := DoNotShowCompilerWarningAgainActionQuery.
+ (self isDoIt not
+ and:[ classToCompileFor notNil
+ and:[ selector notNil ]]) ifTrue:[
+ queries := queries , DoNotShowCompilerWarningAgainForThisMethodActionQuery.
+ ].
+ queries handle:[:ex |
+ ex signal == DoNotShowCompilerWarningAgainActionQuery ifTrue:[
+ parserFlags warnUnusedVars:false.
+ ParserFlags warnUnusedVars:false.
+ ] ifFalse:[
+ self disableWarningsOnCurrentMethodFor: #warnUnusedVars
+ ].
+ ex proceed.
+ ] do:[
+ answer := requestor
+ unusedVariableWarning:msg
+ position:(localVarDefPosition first) to:(localVarDefPosition last) from:self.
+ ].
+ answer == true ifTrue:[
+ "/ delete the definitions ...
+ aNameCollection do:[:eachName |
+ self deleteDefinitionOf:eachName in:(localVarDefPosition first) to:(localVarDefPosition last).
+ ].
+ RestartCompilationSignal raise
+ ].
].
Tools::ToDoListBrowser notNil ifTrue:[
- "/ experimental
- self
- notifyTodo:msg position:(localVarDefPosition first)
- className:(self classToCompileFor name) selector:selector
- severity:#warning priority:#low
- equalityParameter:nil
- checkAction:nil.
+ "/ experimental
+ self
+ notifyTodo:msg position:(localVarDefPosition first)
+ className:(self classToCompileFor name) selector:selector
+ severity:#warning priority:#low
+ equalityParameter:nil
+ checkAction:nil.
].
"Modified: / 28-02-2012 / 14:55:07 / cg"
@@ -4369,11 +4352,11 @@
!
evaluate:aStringOrStream
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -4382,22 +4365,22 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:requestor
- logged:logged
- ifFail:(self defaultFailBlock)
- compile:false
- checkForEndOfInput:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:requestor
+ logged:logged
+ ifFail:(self defaultFailBlock)
+ compile:false
+ checkForEndOfInput:true
!
evaluate:aStringOrStream compile:compile
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -4406,24 +4389,24 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:requestor
- logged:logged
- ifFail:(self defaultFailBlock)
- compile:compile
- checkForEndOfInput:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:requestor
+ logged:logged
+ ifFail:(self defaultFailBlock)
+ compile:compile
+ checkForEndOfInput:true
"Created: / 07-12-2006 / 19:30:04 / cg"
!
evaluate:aStringOrStream ifFail:failBlock
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -4432,22 +4415,22 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:requestor
- logged:logged
- ifFail:failBlock
- compile:false
- checkForEndOfInput:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:requestor
+ logged:logged
+ ifFail:failBlock
+ compile:false
+ checkForEndOfInput:true
!
evaluate:aStringOrStream in:aContext receiver:anObject
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -4456,22 +4439,22 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:aContext
- receiver:anObject
- notifying:requestor
- logged:logged
- ifFail:(self defaultFailBlock)
- compile:false
- checkForEndOfInput:true
+ evaluate:aStringOrStream
+ in:aContext
+ receiver:anObject
+ notifying:requestor
+ logged:logged
+ ifFail:(self defaultFailBlock)
+ compile:false
+ checkForEndOfInput:true
!
evaluate:aStringOrStream in:aContext receiver:anObject ifFail:failBlock
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -4480,22 +4463,22 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:aContext
- receiver:anObject
- notifying:requestor
- logged:logged
- ifFail:failBlock
- compile:false
- checkForEndOfInput:true
+ evaluate:aStringOrStream
+ in:aContext
+ receiver:anObject
+ notifying:requestor
+ logged:logged
+ ifFail:failBlock
+ compile:false
+ checkForEndOfInput:true
!
evaluate:aStringOrStream in:aContext receiver:anObject notifying:requestor logged:logged ifFail:failBlock
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -4504,21 +4487,21 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:aContext
- receiver:anObject
- notifying:requestor
- logged:logged
- ifFail:failBlock
- compile:true
+ evaluate:aStringOrStream
+ in:aContext
+ receiver:anObject
+ notifying:requestor
+ logged:logged
+ ifFail:failBlock
+ compile:true
!
evaluate:aStringOrStream in:aContext receiver:anObject notifying:requestor logged:logged ifFail:failBlock compile:compile
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -4527,22 +4510,22 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:aContext
- receiver:anObject
- notifying:requestor
- logged:logged
- ifFail:failBlock
- compile:compile
- checkForEndOfInput:true
+ evaluate:aStringOrStream
+ in:aContext
+ receiver:anObject
+ notifying:requestor
+ logged:logged
+ ifFail:failBlock
+ compile:compile
+ checkForEndOfInput:true
!
evaluate:aStringOrStream in:aContext receiver:anObject notifying:requestor logged:logged ifFail:failBlock compile:compile checkForEndOfInput:checkForEndOfInput
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -4648,7 +4631,7 @@
]
].
- Parser::UndefinedVariableError handle:[:ex |
+ Parser undefinedVariableError handle:[:ex |
failBlock isNil ifTrue:[
ex reject.
] ifFalse:[
@@ -4660,14 +4643,14 @@
|method|
"
- if compile is false, or the parse tree is that of a constant,
+ 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:.
+ via #readFrom:.
The overhead of compiling a method is avoided in this case.
"
((SuppressDoItCompilation == true)
- or:[compile not
+ or:[compile not
or:[tree isSimpleConstant
or:[tree isSimpleVariable
or:[aStringOrStream isStream
@@ -4682,7 +4665,7 @@
otherwise, just evaluate the tree; slower, but not too bad ...
This allows systems to be delivered without the ByteCodeCompiler,
- and still evaluate expressions
+ and still evaluate expressions
(needed to read resource files or to process .rc files).
"
self == Parser ifTrue:[
@@ -4691,7 +4674,7 @@
self evalExitBlock:nil.
] ifFalse:[
s := self correctedSource.
- s isNil ifTrue:[
+ s isNil ifTrue:[
aStringOrStream isStream ifTrue:[
s := self collectedSource. "/ does not work yet ...
] ifFalse:[
@@ -4707,12 +4690,12 @@
compiler := ByteCodeCompiler new.
compiler initializeFlagsFrom:self.
method := compiler
- compile:sReal
+ compile:sReal
forClass:anObject class
- inCategory:'_temporary_'
- notifying:requestor
- install:false
- skipIfSame:false
+ inCategory:'_temporary_'
+ notifying:requestor
+ install:false
+ skipIfSame:false
silent:true
foldConstants:false.
@@ -4728,10 +4711,10 @@
"
method checked:true.
- value := method
- valueWithReceiver:anObject
- arguments:nil "/ (Array with:m)
- selector:(requestor isNil ifTrue:[#'doItX'] ifFalse:[#'doIt']) "/ #doIt:
+ value := method
+ valueWithReceiver:anObject
+ arguments:nil "/ (Array with:m)
+ selector:(requestor isNil ifTrue:[#'doItX'] ifFalse:[#'doIt']) "/ #doIt:
search:nil
sender:nil.
] ifFalse:[
@@ -4753,45 +4736,45 @@
evaluate:aStringOrStream logged:logged
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:logged
- ifFail:(self defaultFailBlock)
- compile:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:logged
+ ifFail:(self defaultFailBlock)
+ compile:true
!
evaluate:aStringOrStream notifying:someRequestor
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:someRequestor
- logged:false
- ifFail:nil
- compile:true
- checkForEndOfInput:(aStringOrStream isStream not)
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:someRequestor
+ logged:false
+ ifFail:nil
+ compile:true
+ checkForEndOfInput:(aStringOrStream isStream not)
!
evaluate:aStringOrStream notifying:someRequestor compile:compileBoolean
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:someRequestor
- logged:false
- ifFail:nil
- compile:compileBoolean
- checkForEndOfInput:(aStringOrStream isStream not)
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:someRequestor
+ logged:false
+ ifFail:nil
+ compile:compileBoolean
+ checkForEndOfInput:(aStringOrStream isStream not)
!
evaluate:aStringOrStream receiver:anObject
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -4800,22 +4783,22 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:anObject
- notifying:requestor
- logged:logged
- ifFail:(self defaultFailBlock)
- compile:false
- checkForEndOfInput:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:requestor
+ logged:logged
+ ifFail:(self defaultFailBlock)
+ compile:false
+ checkForEndOfInput:true
!
evaluate:aStringOrStream receiver:anObject ifFail:failBlock
- "return the result of evaluating aStringOrStream, errors are reported to requestor.
+ "return the result of evaluating aStringOrStream, errors are reported to requestor.
Allow access to anObject as self and to its instVars (used in the inspector).
If logged is true, an entry is added to the change-file. If the failBlock argument
is non-nil, it is evaluated if an error occurs.
- Finally, compile specifies if the string should be compiled down to
+ Finally, compile specifies if the string should be compiled down to
bytecode or instead be interpreted from the parseTree.
The first should be done for doIts etc, where a readable walkback is
required.
@@ -4824,26 +4807,26 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:anObject
- notifying:requestor
- logged:logged
- ifFail:failBlock
- compile:false
- checkForEndOfInput:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:requestor
+ logged:logged
+ ifFail:failBlock
+ compile:false
+ checkForEndOfInput:true
!
evaluateDeclarationFor:anEnvironment
^ self
- evaluate:source
- in:nil
- receiver:selfValue
- notifying:requestor
- logged:logged
- ifFail:nil
- compile:false
- checkForEndOfInput:false.
+ evaluate:source
+ in:nil
+ receiver:selfValue
+ notifying:requestor
+ logged:logged
+ ifFail:nil
+ compile:false
+ checkForEndOfInput:false.
"Created: / 04-08-2010 / 11:42:42 / cg"
! !
@@ -4872,53 +4855,53 @@
lno := tokenLineNr.
self nextToken.
(tokenType == $: ) ifTrue:[
- [tokenType == $:] whileTrue:[
- pos := tokenPosition.
- self nextToken.
-
- (pos == (tokenPosition - 1)) ifFalse:[
- self warnPossibleIncompatibility:'space(s) between colon and identifier may be non-portable' position:pos to:tokenPosition.
- ].
- (tokenType ~~ #Identifier) ifTrue:[
- ^ self identifierExpectedIn:'block-arg declaration'
- ].
-
- pos2 := tokenPosition + tokenName size - 1.
- self markArgumentIdentifierFrom:tokenPosition to:pos2.
- self checkBlockArgumentNameConventionsFor:tokenName.
- arg := Variable name:tokenName.
- args isNil ifTrue:[
- args := Array with:arg.
- argNames := Array with:tokenName.
- ] ifFalse:[
- (argNames includes:tokenName) ifTrue:[
- self blockArgRedefined:tokenName from:tokenPosition to:pos2
- ].
- 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 startPosition: startPos endPosition: tokenPosition.
- node lineNumber:lno.
- self markBlockFrom:startPos to:tokenPosition.
- "/ self nextToken. -- should be done & removed in caller
- ^ self blockNodeRewriteHookFor:node
- ].
- self syntaxError:'| expected after block-arg declaration'.
- ^ #Error
- ].
- self nextToken
+ [tokenType == $:] whileTrue:[
+ pos := tokenPosition.
+ self nextToken.
+
+ (pos == (tokenPosition - 1)) ifFalse:[
+ self warnPossibleIncompatibility:'space(s) between colon and identifier may be non-portable' position:pos to:tokenPosition.
+ ].
+ (tokenType ~~ #Identifier) ifTrue:[
+ ^ self identifierExpectedIn:'block-arg declaration'
+ ].
+
+ pos2 := tokenPosition + tokenName size - 1.
+ self markArgumentIdentifierFrom:tokenPosition to:pos2.
+ self checkBlockArgumentNameConventionsFor:tokenName.
+ arg := Variable name:tokenName.
+ args isNil ifTrue:[
+ args := Array with:arg.
+ argNames := Array with:tokenName.
+ ] ifFalse:[
+ (argNames includes:tokenName) ifTrue:[
+ self blockArgRedefined:tokenName from:tokenPosition to:pos2
+ ].
+ 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 startPosition: startPos endPosition: tokenPosition.
+ node lineNumber:lno.
+ self markBlockFrom:startPos to:tokenPosition.
+ "/ self nextToken. -- should be done & removed in caller
+ ^ self blockNodeRewriteHookFor:node
+ ].
+ self syntaxError:'| expected after block-arg declaration'.
+ ^ #Error
+ ].
+ self nextToken
].
node := self blockBody:args.
(node notNil and:[node ~~ #Error]) ifTrue:[
- endPos := tokenPosition.
- node lineNumber:lno.
- node startPosition:startPos; endPosition:endPos.
+ endPos := tokenPosition.
+ node lineNumber:lno.
+ node startPosition:startPos; endPosition:endPos.
].
self markBlockFrom:startPos to:endPos.
@@ -4935,53 +4918,53 @@
|prevFlags stats node var vars lno pos2|
((tokenType == #BinaryOperator) and:[tokenName = '<']) ifTrue:[
- prevFlags := parserFlags copy.
- self parsePrimitiveOrResourceSpecOrEmpty.
+ prevFlags := parserFlags copy.
+ self parsePrimitiveOrResourceSpecOrEmpty.
].
lno := tokenLineNr.
(tokenType == $| ) ifTrue:[
- self nextToken.
- [tokenType == $|] whileFalse:[
- (tokenType == #Identifier) ifFalse:[
- ^ self identifierExpectedIn:'block-var declaration'
- ].
- pos2 := tokenPosition + tokenName size - 1.
- self markLocalIdentifierFrom:tokenPosition to:pos2.
- self checkBlockVariableNameConventionsFor:tokenName.
- var := Variable name:tokenName.
- vars isNil ifTrue:[
- vars := Array with:var.
- ] ifFalse:[
- (vars contains:[:var | var name = tokenName]) ifTrue:[
- "/ varname reuse
- self isSyntaxHighlighter ifTrue:[
- self markBadIdentifierFrom:tokenPosition to:pos2.
- ] ifFalse:[
- self
- parseError:'redefinition of ''' , tokenName , ''' in local variables'
- position:tokenPosition to:pos2.
- ]
- ] ifFalse:[
- vars := vars copyWith:var.
- ]
- ].
- self nextToken.
-
- parserFlags allowLocalVariableDeclarationWithInitializerExpression == true ifTrue:[
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self nextToken.
- "/ Q: should we allow literals only, or arbitrary expressions ?
- self shouldImplement.
- ]
- ].
- parserFlags allowDomainVariables == true ifTrue:[
- (tokenType == $() ifTrue:[
- self variableTypeDeclarationFor:var.
- ].
- ].
- ].
- self nextToken
+ self nextToken.
+ [tokenType == $|] whileFalse:[
+ (tokenType == #Identifier) ifFalse:[
+ ^ self identifierExpectedIn:'block-var declaration'
+ ].
+ pos2 := tokenPosition + tokenName size - 1.
+ self markLocalIdentifierFrom:tokenPosition to:pos2.
+ self checkBlockVariableNameConventionsFor:tokenName.
+ var := Variable name:tokenName.
+ vars isNil ifTrue:[
+ vars := Array with:var.
+ ] ifFalse:[
+ (vars contains:[:var | var name = tokenName]) ifTrue:[
+ "/ varname reuse
+ self isSyntaxHighlighter ifTrue:[
+ self markBadIdentifierFrom:tokenPosition to:pos2.
+ ] ifFalse:[
+ self
+ parseError:'redefinition of ''' , tokenName , ''' in local variables'
+ position:tokenPosition to:pos2.
+ ]
+ ] ifFalse:[
+ vars := vars copyWith:var.
+ ]
+ ].
+ self nextToken.
+
+ parserFlags allowLocalVariableDeclarationWithInitializerExpression == true ifTrue:[
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self nextToken.
+ "/ Q: should we allow literals only, or arbitrary expressions ?
+ self shouldImplement.
+ ]
+ ].
+ parserFlags allowDomainVariables == true ifTrue:[
+ (tokenType == $() ifTrue:[
+ self variableTypeDeclarationFor:var.
+ ].
+ ].
+ ].
+ self nextToken
].
node := BlockNode arguments:args home:currentBlock variables:vars.
@@ -4991,13 +4974,13 @@
(stats == #Error) ifTrue:[^ #Error].
parserFlags fullLineNumberInfo ifTrue:[
- node endLineNumber:tokenLineNr
+ node endLineNumber:tokenLineNr
].
node statements:stats.
currentBlock := node home.
prevFlags notNil ifTrue:[
- parserFlags := prevFlags.
+ parserFlags := prevFlags.
].
^ node
@@ -5009,8 +4992,8 @@
Not used by ST/X's parser, but added for ST-80 compatibility."
tokenType ~~ $[ ifTrue:[
- self syntaxError:'[ expected'.
- ^ #Error.
+ self syntaxError:'[ expected'.
+ ^ #Error.
].
^ self block
!
@@ -5028,41 +5011,41 @@
(thisStatement == #Error) ifTrue:[^ #Error].
firstStatement := thisStatement.
[tokenType == $] ] whileFalse:[
- (tokenType == $.) ifFalse:[
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'missing '']'' in block' position:blockStart to:(source position1Based).
- ^ #Error.
- ].
-
- (tokenType == $) ) ifTrue:[
- eMsg := 'missing '']'' or bad '')'' in block'
- ] ifFalse:[
- eMsg := 'missing ''.'' between statements (i.e. ''' , tokenType printString , '''-token unexpected)'
- ].
-
- self syntaxError:eMsg position:thisStatement startPosition to:tokenPosition.
- "/ ^ #Error --- can proceed
- ] ifTrue:[
- self nextToken.
- ].
-
- prevStatement := thisStatement.
-
- tokenType == $] ifTrue:[
- "
- *** I had a warning here (since it was not defined
- *** in the blue-book; but PD-code contains a lot of
- *** code with periods at the end so that the warnings
- *** became annoying
-
- self warning:'period after last statement in block'.
- "
- self markBracketAt:tokenPosition.
- ^ firstStatement
- ].
- thisStatement := self statement.
- (thisStatement == #Error) ifTrue:[^ #Error].
- prevStatement nextStatement:thisStatement
+ (tokenType == $.) ifFalse:[
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'missing '']'' in block' position:blockStart to:(source position1Based).
+ ^ #Error.
+ ].
+
+ (tokenType == $) ) ifTrue:[
+ eMsg := 'missing '']'' or bad '')'' in block'
+ ] ifFalse:[
+ eMsg := 'missing ''.'' between statements (i.e. ''' , tokenType printString , '''-token unexpected)'
+ ].
+
+ self syntaxError:eMsg position:thisStatement startPosition to:tokenPosition.
+ "/ ^ #Error --- can proceed
+ ] ifTrue:[
+ self nextToken.
+ ].
+
+ prevStatement := thisStatement.
+
+ tokenType == $] ifTrue:[
+ "
+ *** I had a warning here (since it was not defined
+ *** in the blue-book; but PD-code contains a lot of
+ *** code with periods at the end so that the warnings
+ *** became annoying
+
+ self warning:'period after last statement in block'.
+ "
+ self markBracketAt:tokenPosition.
+ ^ firstStatement
+ ].
+ thisStatement := self statement.
+ (thisStatement == #Error) ifTrue:[^ #Error].
+ prevStatement nextStatement:thisStatement
].
self markBracketAt:tokenPosition.
^ self statementListRewriteHookFor:firstStatement
@@ -5077,33 +5060,33 @@
|what msg endPos|
(tokenType ~~ #EOF) ifTrue:[
- "/ just for the nicer error message
- (#(Self Nil True False Super Here) includes:tokenType) ifTrue:[
- msg := '"',tokenName allBold,'" unexpected (missing "." or ":" before ' , tokenName , ' ?)'.
- endPos := tokenPosition + tokenName size - 1.
- ] ifFalse:[
- tokenType isCharacter ifTrue:[
- what := '"' , tokenType asString allBold, '"'.
- ] ifFalse:[
- what := tokenType printString allBold.
- ].
- msg := what , ' unexpected. (missing ".", ":" or selector before it ?)'.
- endPos := source position1Based-1.
- ].
- self parseError:msg position:tokenPosition to:endPos.
- ^#Error
+ "/ just for the nicer error message
+ (#(Self Nil True False Super Here) includes:tokenType) ifTrue:[
+ msg := '"',tokenName allBold,'" unexpected (missing "." or ":" before ' , tokenName , ' ?)'.
+ endPos := tokenPosition + tokenName size - 1.
+ ] ifFalse:[
+ tokenType isCharacter ifTrue:[
+ what := '"' , tokenType asString allBold, '"'.
+ ] ifFalse:[
+ what := tokenType printString allBold.
+ ].
+ msg := what , ' unexpected. (missing ".", ":" or selector before it ?)'.
+ endPos := source position1Based-1.
+ ].
+ self parseError:msg position:tokenPosition to:endPos.
+ ^#Error
]
"Modified: / 22-08-2006 / 14:22:45 / cg"
!
emptyStatement
- (parserFlags allowEmptyStatements
+ (parserFlags allowEmptyStatements
or:[parserFlags allowSqueakExtensions == true]) ifTrue:[
- self warnAboutEmptyStatement.
- self nextToken.
+ self warnAboutEmptyStatement.
+ self nextToken.
] ifFalse:[
- self parseError:'empty statement - please enable in the settings' position:tokenPosition to:tokenPosition
+ self parseError:'empty statement - please enable in the settings' position:tokenPosition to:tokenPosition
].
"Created: / 20-11-2006 / 14:04:14 / cg"
@@ -5113,7 +5096,7 @@
makeSelector:rawSelector
false ifTrue:[ "/ will eventually support namespace selectors
currentNamespace notNil ifTrue:[
- ^ (':',currentNamespace name,':',rawSelector) asSymbol
+ ^ (':',currentNamespace name,':',rawSelector) asSymbol
].
].
^ rawSelector asSymbol.
@@ -5121,7 +5104,7 @@
parseExpressionWithSelf:anObject notifying:someOne ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings inNameSpace:aNameSpaceOrNil
"parse aString as an expression with self set to anObject;
- Return the parseTree (if ok), nil (for an empty string
+ Return the parseTree (if ok), nil (for an empty string
or comment only ) or #Error (syntactic error).
Errors and warnings are forwarded to someOne (usually some
@@ -5131,20 +5114,20 @@
|tree token|
aNameSpaceOrNil notNil ifTrue:[
- self currentNameSpace:aNameSpaceOrNil
+ self currentNameSpace:aNameSpaceOrNil
].
self setSelf:anObject.
self notifying:someOne.
self ignoreErrors:ignoreErrors.
self ignoreWarnings:ignoreWarnings.
tokenType isNil ifTrue:[
- self nextToken.
+ self nextToken.
].
(token == $^) ifTrue:[
- self nextToken.
+ self nextToken.
].
(token == #EOF) ifTrue:[
- ^ nil
+ ^ nil
].
tree := self expression.
(self errorFlag or:[tree == #Error]) ifTrue:[^ #Error].
@@ -5161,8 +5144,8 @@
Returns that array"
self nextToken ~~ #HashLeftParen ifTrue:[
- self syntaxError: '# expected, ', token printString ,'found.'.
- ^ ParseError raise.
+ self syntaxError: '# expected, ', token printString ,'found.'.
+ ^ ParseError raise.
].
self nextToken.
^self array.
@@ -5184,7 +5167,7 @@
(self parseMethodSpec == #Error) ifTrue:[^ #Error].
parseTree := self parseMethodBody.
(parseTree == #Error) ifFalse:[
- self tree:parseTree
+ self tree:parseTree
].
self checkForEndOfInput.
^ parseTree
@@ -5193,19 +5176,19 @@
"Modified: / 12-07-2010 / 10:08:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-parseMethod:aString in:aClass
+parseMethod:aString in:aClass
"parse a method in a given class.
Return a parser (if ok) or #Error (syntax).
The parser can be queried for selector, receiver, args, locals,
used selectors, modified instvars, referenced classvars etc.
- The noErrors and noWarnings arguments specify if error and warning
+ The noErrors and noWarnings arguments specify if error and warning
messages should be sent to the Transcript or suppressed."
- ^ self
- parseMethod:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
+ ^ self
+ parseMethod:aString
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
"Modified: / 06-03-2007 / 18:33:39 / cg"
"Created: / 04-10-2011 / 15:35:15 / cg"
@@ -5216,7 +5199,7 @@
Return a parser (if ok), nil (empty) or #Error (syntax).
The parser can be queried for selector, receiver, args, locals,
used selectors, modified instvars, referenced classvars etc.
- The noErrors and noWarnings arguments specify if error and warning
+ The noErrors and noWarnings arguments specify if error and warning
messages should be sent to the Transcript or suppressed."
|tree|
@@ -5235,34 +5218,34 @@
!
parseMethodBody
- "parse a methods body (locals & statements).
+ "parse a methods body (locals & statements).
No more tokens may follow.
Return a node-tree, or #Error
methodBody ::= '<' st80Primitive '>' #EOF
- | '<' st80Primitive '>' methodBodyVarSpec statementList #EOF
+ | '<' st80Primitive '>' methodBodyVarSpec statementList #EOF
"
|stats|
tokenType isNil ifTrue:[
- self nextToken.
+ self nextToken.
].
tokenType == $. ifTrue:[
- self emptyStatement.
+ self emptyStatement.
].
stats := self parseMethodBodyOrEmpty.
(stats == #Error) ifFalse:[
- self checkForEndOfInput.
+ self checkForEndOfInput.
].
(requestor notNil and:[ignoreWarnings not]) ifTrue:[
- parserFlags warnings ifTrue:[
- self hasPrimitiveCode ifFalse:[
- self checkUnusedMethodVars.
- ].
- self checkReturnedValues.
- ]
+ parserFlags warnings ifTrue:[
+ self hasPrimitiveCode ifFalse:[
+ self checkUnusedMethodVars.
+ ].
+ self checkReturnedValues.
+ ]
].
^ stats
@@ -5271,12 +5254,12 @@
parseMethodBodyOrEmpty
"parse a methods body (locals & statements);
- return a node-tree, nil or #Error.
+ return a node-tree, nil or #Error.
empty (or comment only) input is accepted and returns nil.
methodBodyOrNil ::= '<' st80Primitive '>'
- | '<' st80Primitive '>' methodBodyVarSpec statementList
- | <empty>
+ | '<' st80Primitive '>' methodBodyVarSpec statementList
+ | <empty>
"
|stats|
@@ -5284,10 +5267,10 @@
(self parseMethodBodyVarSpec == #Error) ifTrue:[^ #Error].
tokenType == $. ifTrue:[
- self emptyStatement.
+ self emptyStatement.
].
(tokenType ~~ #EOF) ifTrue:[
- stats := self statementList
+ stats := self statementList
].
"/ (tokenType ~~ #EOF) ifTrue:[
"/ self parseError:'nothing more expected here' position:tokenPosition to:tokenPosition.
@@ -5295,14 +5278,14 @@
"/ ].
(stats notNil
and:[stats ~~ #Error]) ifTrue:[
- (self isStatementListAnUnconditionalReturn:stats) ifFalse:[
- "/ remember a returned self here.
- self rememberReturnedValue:(self selfNode)
- ].
+ (self isStatementListAnUnconditionalReturn:stats) ifFalse:[
+ "/ remember a returned self here.
+ self rememberReturnedValue:(self selfNode)
+ ].
].
tree notNil ifTrue:[
- tree last nextStatement:stats.
- ^ tree.
+ tree last nextStatement:stats.
+ ^ tree.
].
^ stats
@@ -5312,129 +5295,129 @@
parseMethodBodyVarSpec
"parse a methods local variable specification, handling
possible primitive or resourceSpecs.
- .
+ .
Leave spec of locals in methodLocals as a side effect.
Return #Error or self.
methodBodyVarSpec ::= '|' { IDENTIFIER } '|'
- | <empty>
+ | <empty>
"
|var pos pos2 msg classHint whatIsHidden|
((tokenType == #BinaryOperator) and:[tokenName = '<']) ifTrue:[
- self parsePrimitiveOrResourceSpecOrEmpty.
+ self parsePrimitiveOrResourceSpecOrEmpty.
].
(tokenType == $|) ifTrue:[
- "memorize position for declaration in correction"
-
- localVarDefPosition := Array with:tokenPosition with:nil.
- self nextToken.
- pos := tokenPosition.
- [tokenType == #Identifier] whileTrue:[
- pos2 := tokenPosition + tokenName size - 1.
- self markLocalIdentifierFrom:tokenPosition to:pos2.
- self checkMethodVariableNameConventionsFor:tokenName.
- var := Variable name:tokenName.
-
- methodVars isNil ifTrue:[
- methodVars := OrderedCollection with:var.
- methodVarNames := OrderedCollection with:tokenName
- ] ifFalse:[
- (methodVarNames includes:tokenName) ifTrue:[
- "/ redefinition
- self isSyntaxHighlighter ifTrue:[
- self markBadIdentifierFrom:tokenPosition to:pos2.
- ] ifFalse:[
- self
- parseError:'redefinition of ''' , tokenName , ''' in local variables.'
- position:tokenPosition to:pos2.
- ]
- ] ifFalse:[
- methodVars add:var.
- methodVarNames add:tokenName
- ]
- ].
-
- (self isDoIt not
- and:[ parserFlags warnHiddenVariables
- and:[(ParserFlags isFlag:#warnHiddenVariables enabledForClass:classToCompileFor selector:selector)
- ]]) ifTrue:[
- whatIsHidden := nil.
- methodArgNames notNil ifTrue:[
- (methodArgNames includes:tokenName) ifTrue:[
- whatIsHidden := 'method argument'
- ]
- ].
- classToCompileFor notNil ifTrue:[
- (self classesInstVarNames includes:tokenName) ifTrue:[
- classToCompileFor isMeta ifTrue:[
- whatIsHidden := 'class instance variable'.
- ] ifFalse:[
- whatIsHidden := 'instance variable'.
- ]
- ]
- ].
- whatIsHidden notNil ifTrue:[
- self
- warning:(('local variable "%1" hides ',whatIsHidden,'.') bindWith:tokenName allBold)
- doNotShowAgainAction:[ parserFlags warnHiddenVariables:false. ParserFlags warnHiddenVariables:false ]
- doNotShowAgainForThisMethodAction: [ self disableWarningsOnCurrentMethodFor: #warnHiddenVariables ]
- position:tokenPosition to:pos2
- ]
- ].
-
- self nextToken.
-
- classHint := nil.
- lastDirective notNil ifTrue:[
- lastDirective isClassHintDirective ifTrue:[
- var classHint:lastDirective className.
- ].
- lastDirective := nil.
- ].
-
- parserFlags allowLocalVariableDeclarationWithInitializerExpression == true ifTrue:[
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self nextToken.
- "/ Q: should we allow literals only, or arbitrary expressions ?
- self shouldImplement.
- ]
- ].
- parserFlags allowDomainVariables == true ifTrue:[
- (tokenType == $() ifTrue:[
- self variableTypeDeclarationFor:var.
- ].
- ].
- pos := tokenPosition
- ].
-
- (tokenType ~~ $|) ifTrue:[
- (#(True False Self Nil Super ThisContext) includes:tokenType) ifTrue:[
- msg := 'reserved keyword "',tokenName allBold,'" in local var declaration'.
- pos2 := tokenPosition + tokenName size - 1.
- self markBadIdentifierFrom:tokenPosition to:pos2.
- ] ifFalse:[
- pos2 := source position1Based-1.
- msg := 'Identifier or | expected in local var declaration'
- ].
- self syntaxError:msg position:tokenPosition to:pos2.
- ^ #Error
- ].
- localVarDefPosition at:2 put:tokenPosition.
- self nextToken
+ "memorize position for declaration in correction"
+
+ localVarDefPosition := Array with:tokenPosition with:nil.
+ self nextToken.
+ pos := tokenPosition.
+ [tokenType == #Identifier] whileTrue:[
+ pos2 := tokenPosition + tokenName size - 1.
+ self markLocalIdentifierFrom:tokenPosition to:pos2.
+ self checkMethodVariableNameConventionsFor:tokenName.
+ var := Variable name:tokenName.
+
+ methodVars isNil ifTrue:[
+ methodVars := OrderedCollection with:var.
+ methodVarNames := OrderedCollection with:tokenName
+ ] ifFalse:[
+ (methodVarNames includes:tokenName) ifTrue:[
+ "/ redefinition
+ self isSyntaxHighlighter ifTrue:[
+ self markBadIdentifierFrom:tokenPosition to:pos2.
+ ] ifFalse:[
+ self
+ parseError:'redefinition of ''' , tokenName , ''' in local variables.'
+ position:tokenPosition to:pos2.
+ ]
+ ] ifFalse:[
+ methodVars add:var.
+ methodVarNames add:tokenName
+ ]
+ ].
+
+ (self isDoIt not
+ and:[ parserFlags warnHiddenVariables
+ and:[(ParserFlags isFlag:#warnHiddenVariables enabledForClass:classToCompileFor selector:selector)
+ ]]) ifTrue:[
+ whatIsHidden := nil.
+ methodArgNames notNil ifTrue:[
+ (methodArgNames includes:tokenName) ifTrue:[
+ whatIsHidden := 'method argument'
+ ]
+ ].
+ classToCompileFor notNil ifTrue:[
+ (self classesInstVarNames includes:tokenName) ifTrue:[
+ classToCompileFor isMeta ifTrue:[
+ whatIsHidden := 'class instance variable'.
+ ] ifFalse:[
+ whatIsHidden := 'instance variable'.
+ ]
+ ]
+ ].
+ whatIsHidden notNil ifTrue:[
+ self
+ warning:(('local variable "%1" hides ',whatIsHidden,'.') bindWith:tokenName allBold)
+ doNotShowAgainAction:[ parserFlags warnHiddenVariables:false. ParserFlags warnHiddenVariables:false ]
+ doNotShowAgainForThisMethodAction: [ self disableWarningsOnCurrentMethodFor: #warnHiddenVariables ]
+ position:tokenPosition to:pos2
+ ]
+ ].
+
+ self nextToken.
+
+ classHint := nil.
+ lastDirective notNil ifTrue:[
+ lastDirective isClassHintDirective ifTrue:[
+ var classHint:lastDirective className.
+ ].
+ lastDirective := nil.
+ ].
+
+ parserFlags allowLocalVariableDeclarationWithInitializerExpression == true ifTrue:[
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self nextToken.
+ "/ Q: should we allow literals only, or arbitrary expressions ?
+ self shouldImplement.
+ ]
+ ].
+ parserFlags allowDomainVariables == true ifTrue:[
+ (tokenType == $() ifTrue:[
+ self variableTypeDeclarationFor:var.
+ ].
+ ].
+ pos := tokenPosition
+ ].
+
+ (tokenType ~~ $|) ifTrue:[
+ (#(True False Self Nil Super ThisContext) includes:tokenType) ifTrue:[
+ msg := 'reserved keyword "',tokenName allBold,'" in local var declaration'.
+ pos2 := tokenPosition + tokenName size - 1.
+ self markBadIdentifierFrom:tokenPosition to:pos2.
+ ] ifFalse:[
+ pos2 := source position1Based-1.
+ msg := 'Identifier or | expected in local var declaration'
+ ].
+ self syntaxError:msg position:tokenPosition to:pos2.
+ ^ #Error
+ ].
+ localVarDefPosition at:2 put:tokenPosition.
+ self nextToken
].
(parserFlags allowSqueakPrimitives
or:[ parserFlags allowSqueakExtensions
or:[ parserFlags allowVisualAgePrimitives
or:[ parserFlags allowSTVPrimitives ]]]) ifTrue:[
- "/ allow for primitiveSpec after local-var decl.
-
- ((tokenType == #BinaryOperator) and:[tokenName = '<']) ifTrue:[
- self parsePrimitiveOrResourceSpecOrEmpty.
- ]
+ "/ allow for primitiveSpec after local-var decl.
+
+ ((tokenType == #BinaryOperator) and:[tokenName = '<']) ifTrue:[
+ self parsePrimitiveOrResourceSpecOrEmpty.
+ ]
].
^ self
@@ -5448,14 +5431,14 @@
Return the receiver or #Error.
methodSpec ::= { KEYWORD IDENTIFIER }
- | binaryOperator IDENTIFIER
- | IDENTIFIER
+ | binaryOperator IDENTIFIER
+ | IDENTIFIER
"
|arg pos1 pos2 argPos1 argPos2 rawSelector|
tokenType isNil ifTrue:[
- self nextToken.
+ self nextToken.
].
pos1 := tokenPosition.
@@ -5463,102 +5446,102 @@
"/ selectorPositions := OrderedCollection new.
(tokenType == #Keyword) ifTrue:[
- rawSelector := ''.
- [tokenType == #Keyword] whileTrue:[
- "/ selectorPositions add:(tokenPosition to:(tokenPosition+tokenName size - 1)).
- self markMethodSelectorFrom:tokenPosition to:(tokenPosition+tokenName size - 1).
- rawSelector := rawSelector , tokenName.
- self nextToken.
-
- (tokenType ~~ #Identifier) ifTrue:[
- "/ ^ #Error].
- ^ self identifierExpectedIn:'method-arg declaration'
- ].
- argPos1 := tokenPosition.
- argPos2 := argPos1+tokenName size - 1.
- pos2 := argPos2.
- self markMethodArgumentIdentifierFrom:argPos1 to:argPos2.
- self checkMethodArgumentNameConventionsFor:tokenName.
- arg := Variable name:tokenName.
- methodArgs isNil ifTrue:[
- methodArgs := Array with:arg.
- methodArgNames := Array with:tokenName
- ] ifFalse:[
- (methodArgNames includes:tokenName) ifTrue:[
- self methodArgRedefined:tokenName from:argPos1 to:argPos2
- ].
- methodArgs := methodArgs copyWith:arg.
- methodArgNames := methodArgNames copyWith:tokenName
- ].
- parserFlags warnHiddenVariables ifTrue:[
- classToCompileFor isClass ifTrue:[
- (self classesInstVarNames includes:tokenName) ifTrue:[
- self
- warning:'argument "' , tokenName allBold , '" hides instance variable.'
- position:argPos1 to:argPos2
- ]
- ].
- ].
- self nextToken.
+ rawSelector := ''.
+ [tokenType == #Keyword] whileTrue:[
+ "/ selectorPositions add:(tokenPosition to:(tokenPosition+tokenName size - 1)).
+ self markMethodSelectorFrom:tokenPosition to:(tokenPosition+tokenName size - 1).
+ rawSelector := rawSelector , tokenName.
+ self nextToken.
+
+ (tokenType ~~ #Identifier) ifTrue:[
+ "/ ^ #Error].
+ ^ self identifierExpectedIn:'method-arg declaration'
+ ].
+ argPos1 := tokenPosition.
+ argPos2 := argPos1+tokenName size - 1.
+ pos2 := argPos2.
+ self markMethodArgumentIdentifierFrom:argPos1 to:argPos2.
+ self checkMethodArgumentNameConventionsFor:tokenName.
+ arg := Variable name:tokenName.
+ methodArgs isNil ifTrue:[
+ methodArgs := Array with:arg.
+ methodArgNames := Array with:tokenName
+ ] ifFalse:[
+ (methodArgNames includes:tokenName) ifTrue:[
+ self methodArgRedefined:tokenName from:argPos1 to:argPos2
+ ].
+ methodArgs := methodArgs copyWith:arg.
+ methodArgNames := methodArgNames copyWith:tokenName
+ ].
+ parserFlags warnHiddenVariables ifTrue:[
+ classToCompileFor isClass ifTrue:[
+ (self classesInstVarNames includes:tokenName) ifTrue:[
+ self
+ warning:'argument "' , tokenName allBold , '" hides instance variable.'
+ position:argPos1 to:argPos2
+ ]
+ ].
+ ].
+ self nextToken.
"/ ((tokenType == #BinaryOperator) and:[token = '#']) ifTrue:[
"/ self nextToken.
"/ arg domain:nil.
"/ ].
- ].
-
- selector := self makeSelector:rawSelector.
- endOfSelectorPosition := pos2.
- beginOfBodyPosition := tokenPosition.
- ^ self
+ ].
+
+ selector := self makeSelector:rawSelector.
+ endOfSelectorPosition := pos2.
+ beginOfBodyPosition := tokenPosition.
+ ^ self
].
(self isValidUnarySelector:tokenType) ifTrue:[
- pos2 := pos1+tokenName size - 1.
- self markMethodSelectorFrom:pos1 to:pos2.
- rawSelector := tokenName.
- self nextToken.
-
- selector := self makeSelector:rawSelector.
- endOfSelectorPosition := pos2.
- beginOfBodyPosition := tokenPosition.
- ^ self
+ pos2 := pos1+tokenName size - 1.
+ self markMethodSelectorFrom:pos1 to:pos2.
+ rawSelector := tokenName.
+ self nextToken.
+
+ selector := self makeSelector:rawSelector.
+ endOfSelectorPosition := pos2.
+ beginOfBodyPosition := tokenPosition.
+ ^ self
].
"/ special handling for | and ^, which are also lexical tokens
- (tokenType == $|
+ (tokenType == $|
or:[(tokenType == $^) and:[parserFlags allowCaretAsBinop]]) ifTrue:[
- pos2 := pos1+token size - 1.
- token := tokenName := (String with:tokenType).
- tokenType := #BinaryOperator.
- self
- warnPossibleIncompatibility:('''',token,''' might not be a valid selector in other smalltalk systems')
- position:pos1 to:pos2.
+ pos2 := pos1+token size - 1.
+ token := tokenName := (String with:tokenType).
+ tokenType := #BinaryOperator.
+ self
+ warnPossibleIncompatibility:('''',token,''' might not be a valid selector in other smalltalk systems')
+ position:pos1 to:pos2.
].
(tokenType == #BinaryOperator) ifTrue:[
- self markMethodSelectorFrom:pos1 to:(pos1+tokenName size - 1).
- rawSelector := tokenName.
- self nextToken.
- (tokenType ~~ #Identifier) ifTrue:[^ #Error].
- argPos1 := tokenPosition.
- pos2 := argPos2 := argPos1+tokenName size - 1.
- self markMethodArgumentIdentifierFrom:argPos1 to:argPos2.
- self checkMethodArgumentNameConventionsFor:tokenName.
- arg := Variable name:tokenName.
-
- methodArgs := Array with:arg.
- methodArgNames := Array with:tokenName.
-
- endOfSelectorPosition := pos2.
- self nextToken.
- selector := self makeSelector:rawSelector.
- beginOfBodyPosition := tokenPosition.
+ self markMethodSelectorFrom:pos1 to:(pos1+tokenName size - 1).
+ rawSelector := tokenName.
+ self nextToken.
+ (tokenType ~~ #Identifier) ifTrue:[^ #Error].
+ argPos1 := tokenPosition.
+ pos2 := argPos2 := argPos1+tokenName size - 1.
+ self markMethodArgumentIdentifierFrom:argPos1 to:argPos2.
+ self checkMethodArgumentNameConventionsFor:tokenName.
+ arg := Variable name:tokenName.
+
+ methodArgs := Array with:arg.
+ methodArgNames := Array with:tokenName.
+
+ endOfSelectorPosition := pos2.
+ self nextToken.
+ selector := self makeSelector:rawSelector.
+ beginOfBodyPosition := tokenPosition.
"/ ((tokenType == #BinaryOperator) and:[token = '#']) ifTrue:[
"/ self nextToken.
"/ arg domain:nil.
"/ ].
- ^ self
+ ^ self
].
^ #Error
@@ -5604,8 +5587,8 @@
"parse a statement; return a node-tree or #Error.
statement ::= '^' expression
- | PRIMITIVECODE
- | expression
+ | PRIMITIVECODE
+ | expression
"
|expr node lnr code pos|
@@ -5613,39 +5596,39 @@
pos := tokenPosition.
(tokenType == $^) ifTrue:[
- ^ self returnStatement
+ ^ self returnStatement
].
(tokenType == #Primitive) ifTrue:[
- code := tokenValue.
- node := PrimitiveNode code:code.
- node startPosition: tokenPosition endPosition: source position1Based.
- self nextToken.
- node isOptional ifFalse:[
- hasNonOptionalPrimitiveCode := true
- ].
- hasPrimitiveCode := true.
- ^ node
+ code := tokenValue.
+ node := PrimitiveNode code:code.
+ node startPosition: tokenPosition endPosition: source position1Based.
+ self nextToken.
+ node isOptional ifFalse:[
+ hasNonOptionalPrimitiveCode := true
+ ].
+ hasPrimitiveCode := true.
+ ^ node
].
(tokenType == #EOF) ifTrue:[
- currentBlock notNil ifTrue:[
- self syntaxError:'missing '']'' at end of block'.
- ] ifFalse:[
- self syntaxError:'period after last statement'.
- ].
- ^ #Error
+ currentBlock notNil ifTrue:[
+ self syntaxError:'missing '']'' at end of block'.
+ ] ifFalse:[
+ self syntaxError:'period after last statement'.
+ ].
+ ^ #Error
].
(tokenType == $.) ifTrue:[
- (parserFlags allowEmptyStatements
- or:[parserFlags allowSqueakExtensions == true]) ifTrue:[
- "/ allow empty statement
- self warnAboutEmptyStatement.
- node := StatementNode expression:nil.
- node startPosition:pos.
- ^ node
- ].
+ (parserFlags allowEmptyStatements
+ or:[parserFlags allowSqueakExtensions == true]) ifTrue:[
+ "/ allow empty statement
+ self warnAboutEmptyStatement.
+ node := StatementNode expression:nil.
+ node startPosition:pos.
+ ^ node
+ ].
].
expr := self expression.
@@ -5673,7 +5656,7 @@
Statements must be separated by periods.
statementList ::= <statement>
- | <statementList> . <statement>
+ | <statementList> . <statement>
"
|thisStatement prevStatement firstStatement periodPos prevExpr|
@@ -5682,41 +5665,41 @@
(thisStatement == #Error) ifTrue:[^ #Error].
firstStatement := thisStatement.
[tokenType == $.] whileTrue:[
- prevExpr := thisStatement expression.
- (prevExpr notNil
- and:[prevExpr isMessage
- and:[thisStatement isReturnNode not]]) ifTrue:[
- (#(#'=' #'==') includes:prevExpr selector) ifTrue:[
- self warning:'useless computation - mistyped assignment (i.e. did you mean '':='') ?' position:prevExpr selectorPosition
- ].
- ].
-
- periodPos := tokenPosition.
- self nextToken.
- tokenType == $. ifTrue:[
- self emptyStatement.
- ].
- (tokenType == $]) ifTrue:[
- currentBlock isNil ifTrue:[
- self parseError:''']'' unexpected (block nesting error)'.
- ].
- ^ self statementListRewriteHookFor:firstStatement
- ].
- (tokenType == #EOF) ifTrue:[
- currentBlock notNil ifTrue:[
- self parseError:''']'' expected (block nesting error)'.
- ].
- ^ self statementListRewriteHookFor:firstStatement
- ].
-
- prevStatement := thisStatement.
- prevStatement isReturnNode ifTrue:[
- self warning:'Statements after return.\\Some other Smalltalk systems will not allow this (Squeak, for example)' withCRs position:tokenPosition
- ].
-
- thisStatement := self statement.
- (thisStatement == #Error) ifTrue:[^ #Error].
- prevStatement nextStatement:thisStatement
+ prevExpr := thisStatement expression.
+ (prevExpr notNil
+ and:[prevExpr isMessage
+ and:[thisStatement isReturnNode not]]) ifTrue:[
+ (#(#'=' #'==') includes:prevExpr selector) ifTrue:[
+ self warning:'useless computation - mistyped assignment (i.e. did you mean '':='') ?' position:prevExpr selectorPosition
+ ].
+ ].
+
+ periodPos := tokenPosition.
+ self nextToken.
+ tokenType == $. ifTrue:[
+ self emptyStatement.
+ ].
+ (tokenType == $]) ifTrue:[
+ currentBlock isNil ifTrue:[
+ self parseError:''']'' unexpected (block nesting error)'.
+ ].
+ ^ self statementListRewriteHookFor:firstStatement
+ ].
+ (tokenType == #EOF) ifTrue:[
+ currentBlock notNil ifTrue:[
+ self parseError:''']'' expected (block nesting error)'.
+ ].
+ ^ self statementListRewriteHookFor:firstStatement
+ ].
+
+ prevStatement := thisStatement.
+ prevStatement isReturnNode ifTrue:[
+ self warning:'Statements after return.\\Some other Smalltalk systems will not allow this (Squeak, for example)' withCRs position:tokenPosition
+ ].
+
+ thisStatement := self statement.
+ (thisStatement == #Error) ifTrue:[^ #Error].
+ prevStatement nextStatement:thisStatement
].
^ self statementListRewriteHookFor:firstStatement
@@ -5726,71 +5709,71 @@
variableTypeDeclarationFor:aVariable
"experimental support for Domain variables (constraint programming support):
a variable-declaration of the form
- |var (domain) ... |
+ |var (domain) ... |
declares var as a domainVariable.
Valid domains are:
- min %% max - integer range domain
- Bool - boolean domain
- Nat - positive integer domain
- Int - integer domain
- #sym1 ... #sym2 - enumerated symbolic domain
+ min %% max - integer range domain
+ Bool - boolean domain
+ Nat - positive integer domain
+ Int - integer domain
+ #sym1 ... #sym2 - enumerated symbolic domain
"
|min max domain enumValues|
(tokenType == $() ifFalse:[
- self syntaxError:'''('' expected' position:tokenPosition.
- ^ #Error
- ].
+ self syntaxError:'''('' expected' position:tokenPosition.
+ ^ #Error
+ ].
self nextToken.
(tokenType == #Integer) ifTrue:[
- min := token.
- self nextToken.
- ((tokenType == #BinaryOperator) and:[token = '%%']) ifFalse:[
- self syntaxError:'''%%'' expected' position:tokenPosition.
- ].
- self nextToken.
- (tokenType == #Integer) ifFalse:[
- self syntaxError:'Integer (upper bound) expected' position:tokenPosition.
- ].
- max := token.
- self nextToken.
- domain := IntegerDomain min:min max:max.
+ min := token.
+ self nextToken.
+ ((tokenType == #BinaryOperator) and:[token = '%%']) ifFalse:[
+ self syntaxError:'''%%'' expected' position:tokenPosition.
+ ].
+ self nextToken.
+ (tokenType == #Integer) ifFalse:[
+ self syntaxError:'Integer (upper bound) expected' position:tokenPosition.
+ ].
+ max := token.
+ self nextToken.
+ domain := IntegerDomain min:min max:max.
] ifFalse:[
- ((tokenType == #Identifier) and:[token isUppercaseFirst]) ifTrue:[
- token = 'Bool' ifTrue:[
- self nextToken.
- domain := BooleanDomain singleton.
- ].
- token = 'Nat' ifTrue:[
- self nextToken.
- domain := IntegerDomain min:0 max:(SmallInteger maxVal).
- ].
- token = 'Int' ifTrue:[
- self nextToken.
- domain := IntegerDomain min:(SmallInteger minVal) max:(SmallInteger maxVal).
- ].
- ] ifFalse:[
- ((tokenType == #Symbol) or:[(tokenType == #Identifier)]) ifTrue:[
- enumValues := OrderedCollection new.
- [((tokenType == #Symbol) or:[(tokenType == #Identifier)])] whileTrue:[
- enumValues add:token.
- self nextToken.
- ].
- domain := EnumeratedDomain new values:enumValues.
- ].
- ].
+ ((tokenType == #Identifier) and:[token isUppercaseFirst]) ifTrue:[
+ token = 'Bool' ifTrue:[
+ self nextToken.
+ domain := BooleanDomain singleton.
+ ].
+ token = 'Nat' ifTrue:[
+ self nextToken.
+ domain := IntegerDomain min:0 max:(SmallInteger maxVal).
+ ].
+ token = 'Int' ifTrue:[
+ self nextToken.
+ domain := IntegerDomain min:(SmallInteger minVal) max:(SmallInteger maxVal).
+ ].
+ ] ifFalse:[
+ ((tokenType == #Symbol) or:[(tokenType == #Identifier)]) ifTrue:[
+ enumValues := OrderedCollection new.
+ [((tokenType == #Symbol) or:[(tokenType == #Identifier)])] whileTrue:[
+ enumValues add:token.
+ self nextToken.
+ ].
+ domain := EnumeratedDomain new values:enumValues.
+ ].
+ ].
].
domain isNil ifTrue:[
- self syntaxError:'invalid domain' position:tokenPosition.
+ self syntaxError:'invalid domain' position:tokenPosition.
].
aVariable domain:domain.
(tokenType == $)) ifFalse:[
- self syntaxError:''')'' expected' position:tokenPosition.
- ^ #Error
- ].
+ self syntaxError:''')'' expected' position:tokenPosition.
+ ^ #Error
+ ].
self nextToken.
"Modified: / 09-08-2010 / 00:27:16 / cg"
@@ -5798,18 +5781,18 @@
warnAboutEmptyStatement
parserFlags warnAboutPossibleSTCCompilationProblems ifTrue:[
- self
- warning:'stc will not compile empty statements'
- line:lineNr.
-
- (Tools::ToDoListBrowser notNil and:[self classToCompileFor notNil]) ifTrue:[
- self
- notifyTodo:'stc will not compile empty statements' position:tokenPosition
- className:(self classToCompileFor name) selector:selector
- severity:#warning priority:#medium
- equalityParameter:nil
- checkAction:nil.
- ].
+ self
+ warning:'stc will not compile empty statements'
+ line:lineNr.
+
+ (Tools::ToDoListBrowser notNil and:[self classToCompileFor notNil]) ifTrue:[
+ self
+ notifyTodo:'stc will not compile empty statements' position:tokenPosition
+ className:(self classToCompileFor name) selector:selector
+ severity:#warning priority:#medium
+ equalityParameter:nil
+ checkAction:nil.
+ ].
].
! !
@@ -5821,20 +5804,20 @@
pos1 := tokenPosition.
elements := OrderedCollection new:20.
[tokenType ~~ $) ] whileTrue:[
- elem := self arrayConstant.
+ elem := self arrayConstant.
"/ (elem == #Error) ifTrue:[
"/ (tokenType == #EOF) ifTrue:[
-"/ self syntaxError:'unterminated array-constant; '')'' expected'
+"/ self syntaxError:'unterminated array-constant; '')'' expected'
"/ position:pos1 to:tokenPosition
"/ ].
"/ ^ #Error
"/ ].
- elem isSymbol ifTrue:[
- self markSymbolFrom:tokenPosition to:(source position1Based-1).
- ].
- elements add:elem.
- self nextToken.
+ elem isSymbol ifTrue:[
+ self markSymbolFrom:tokenPosition to:(source position1Based-1).
+ ].
+ elements add:elem.
+ self nextToken.
"/ tokenType == $. ifTrue:[
"/ self emptyStatement.
"/ ].
@@ -5842,7 +5825,7 @@
arr := Array withAll:elements.
parserFlags arraysAreImmutable ifTrue:[
- ^ self makeImmutableArray:arr
+ ^ self makeImmutableArray:arr
].
^ arr
@@ -5853,97 +5836,97 @@
|val|
(tokenType == #Nil) ifTrue:[
- self warnPossibleIncompatibility:'nil in array constant is interpreted as #nil (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
- ^ tokenValue
+ self warnPossibleIncompatibility:'nil in array constant is interpreted as #nil (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
+ ^ tokenValue
].
(tokenType == #True) ifTrue:[
- self warnPossibleIncompatibility:'true in array constant is interpreted as #true (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
- ^ tokenValue
+ self warnPossibleIncompatibility:'true in array constant is interpreted as #true (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
+ ^ tokenValue
].
(tokenType == #False) ifTrue:[
- self warnPossibleIncompatibility:'false in array constant is interpreted as #false (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
- ^ tokenValue
- ].
- ((tokenType == #Integer)
+ self warnPossibleIncompatibility:'false in array constant is interpreted as #false (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
+ ^ tokenValue
+ ].
+ ((tokenType == #Integer)
or:[tokenType == #Float]) ifTrue:[
- ^ tokenValue
+ ^ tokenValue
].
(tokenType == #String) ifTrue:[
- parserFlags stringsAreImmutable ifTrue:[^ self makeImmutableString:tokenValue].
- ^ tokenValue
+ parserFlags stringsAreImmutable ifTrue:[^ self makeImmutableString:tokenValue].
+ ^ tokenValue
].
(tokenType == #Character) ifTrue:[
- ^ tokenValue
+ ^ tokenValue
].
(tokenType == #Error) ifTrue:[
- ^ ParseError raise.
+ ^ ParseError raise.
].
(tokenType == #BinaryOperator) ifTrue:[
- val := tokenName asSymbol.
- parseForCode ifFalse:[
- self rememberSymbolUsed:val.
- ].
- ^ val
+ val := tokenName asSymbol.
+ parseForCode ifFalse:[
+ self rememberSymbolUsed:val.
+ ].
+ ^ val
].
"/ some more special symbol consts ...
(tokenType == $| ) ifTrue:[
- ^ #|
+ ^ #|
].
(tokenType == #Self ) ifTrue:[
- ^ #'self'
+ ^ #'self'
].
(tokenType == #Super ) ifTrue:[
- ^ #'super'
+ ^ #'super'
].
(tokenType == #Here ) ifTrue:[
- ^ #'here'
+ ^ #'here'
].
(tokenType == #ThisContext ) ifTrue:[
- ^ #'thisContext'
- ].
-
- ((tokenType == #Keyword)
+ ^ #'thisContext'
+ ].
+
+ ((tokenType == #Keyword)
or:[tokenType == #Identifier]) ifTrue:[
- val := tokenName asSymbol.
- parseForCode ifFalse:[
- self rememberSymbolUsed:val.
- ].
- ^ val
+ val := tokenName asSymbol.
+ parseForCode ifFalse:[
+ self rememberSymbolUsed:val.
+ ].
+ ^ val
].
((tokenType == $()
or:[tokenType == #HashLeftParen]) ifTrue:[
- self nextToken.
- ^ self array
- ].
- ((tokenType == $[)
+ self nextToken.
+ ^ self array
+ ].
+ ((tokenType == $[)
or:[tokenType == #HashLeftBrack]) ifTrue:[
- self nextToken.
- ^ self byteArray
+ self nextToken.
+ ^ self byteArray
].
(tokenType == #HashLeftBrace) ifTrue:[
- parserFlags allowQualifiedNames == true ifFalse:[
- self parseError:'non-Standard VisualWorks extension: #{..}. Please enable in settings.' position:tokenPosition to:tokenPosition+1.
- ].
- val := self qualifiedNameOrInlineObject .
- "/ val := QualifiedName for:val name.
- val := val value.
- ^ val
- ].
+ parserFlags allowQualifiedNames == true ifFalse:[
+ self parseError:'non-Standard VisualWorks extension: #{..}. Please enable in settings.' position:tokenPosition to:tokenPosition+1.
+ ].
+ val := self qualifiedNameOrInlineObject .
+ "/ val := QualifiedName for:val name.
+ val := val value.
+ ^ val
+ ].
(tokenType == #Symbol) ifTrue:[
- parseForCode ifFalse:[
- self rememberSymbolUsed:tokenValue.
- ].
- ^ tokenValue
+ parseForCode ifFalse:[
+ self rememberSymbolUsed:tokenValue.
+ ].
+ ^ tokenValue
].
(tokenType == #EOF) ifTrue:[
- "just for the better error-hilight; let caller handle error"
- self syntaxError:'EOF unexpected in array-constant'.
- ^ ParseError raise.
- ].
- self syntaxError:('"'
- , tokenType printString
- , '" unexpected in array-constant').
+ "just for the better error-hilight; let caller handle error"
+ self syntaxError:'EOF unexpected in array-constant'.
+ ^ ParseError raise.
+ ].
+ self syntaxError:('"'
+ , tokenType printString
+ , '" unexpected in array-constant').
^ ParseError raise.
"Modified: / 22-08-2006 / 14:21:16 / cg"
@@ -5967,40 +5950,40 @@
argList := OrderedCollection new.
[
- [
- |indexNode|
-
- self nextToken.
- indexNode := self expression.
- argList isEmpty ifTrue:[selectorStream nextPutAll:'_'].
- selectorStream nextPutAll:'at:'.
- argList add: indexNode.
- (tokenType == #BinaryOperator ) and:[ token = ',']
- ] whileTrue.
-
- tokenType == $] ifFalse:[
- self parseError:''']'' expected'.
- ^ #Error
- ].
- self nextToken.
-
- tokenType == $[ ifTrue:[
- receiver := MessageNode
- receiver:receiver
- selector:(selectorStream contents)
- args:argList.
- selectorStream := WriteStream on: (String new: 32).
- ].
- tokenType == $[
+ [
+ |indexNode|
+
+ self nextToken.
+ indexNode := self expression.
+ argList isEmpty ifTrue:[selectorStream nextPutAll:'_'].
+ selectorStream nextPutAll:'at:'.
+ argList add: indexNode.
+ (tokenType == #BinaryOperator ) and:[ token = ',']
+ ] whileTrue.
+
+ tokenType == $] ifFalse:[
+ self parseError:''']'' expected'.
+ ^ #Error
+ ].
+ self nextToken.
+
+ tokenType == $[ ifTrue:[
+ receiver := MessageNode
+ receiver:receiver
+ selector:(selectorStream contents)
+ args:argList.
+ selectorStream := WriteStream on: (String new: 32).
+ ].
+ tokenType == $[
] whileTrue.
tokenType == #':=' ifTrue:[
- self nextToken.
- selectorStream nextPutAll:'put:'.
- valNode := self expression.
- valNode == #Error ifTrue:[
- ^ valNode
- ].
+ self nextToken.
+ selectorStream nextPutAll:'put:'.
+ valNode := self expression.
+ valNode == #Error ifTrue:[
+ ^ valNode
+ ].
"/ this was found in squeak - why make it a block ?
"/ (valNode isKindOf: BlockNode) ifFalse:[
"/ valNode _ BlockNode new
@@ -6009,13 +5992,13 @@
"/ returns: false
"/ from: encoder.
"/ ].
- argList add: valNode
- ].
-
- ^ MessageNode
- receiver:receiver
- selector:selectorStream contents
- args:argList.
+ argList add: valNode
+ ].
+
+ ^ MessageNode
+ receiver:receiver
+ selector:selectorStream contents
+ args:argList.
"
AllowArrayIndexSyntaxExtension := true.
@@ -6026,15 +6009,15 @@
|foo|
foo := Array new:10 withAll:2.
- 1 + foo[1].
+ 1 + foo[1].
"
"
|foo|
foo := Array new:10.
- foo[1] := 'hello'.
- foo[2].
- foo[1].
+ foo[1] := 'hello'.
+ foo[2].
+ foo[1].
"
!
@@ -6059,66 +6042,66 @@
"special kludge: since Scanner cannot know if -digit is a binary
expression or a negative constant, handle cases here"
- [(tokenType == #BinaryOperator)
+ [(tokenType == #BinaryOperator)
or:[(tokenType == $|)
or:[(tokenType == $^ and:[parserFlags allowCaretAsBinop])
- or:[((tokenType == #Integer) or:[tokenType == #Float])
- and:[tokenValue < 0]]]]
+ or:[((tokenType == #Integer) or:[tokenType == #Float])
+ and:[tokenValue < 0]]]]
] whileTrue:[
- "/ kludge alarm: in a function-call argList, #, is not a binarySelector
- inFunctionCallArgument == true ifTrue:[
- ((tokenType == #BinaryOperator) and:[tokenName = ',']) ifTrue:[
- ^ receiver
- ].
- ].
-
- pos1 := tokenPosition.
- lno := tokenLineNr.
-
- "/ kludge alarm: bar, caret and minus are not scanned as binop
- (tokenType == $|) ifTrue:[
- sel := '|'.
- sel := self selectorCheck:sel for:receiver position:tokenPosition to:tokenPosition.
- self nextToken.
- ] ifFalse:[
- (tokenType == $^) ifTrue:[
- sel := '^'.
- sel := self selectorCheck:sel for:receiver position:tokenPosition to:tokenPosition.
- self nextToken.
- ] ifFalse:[
- (tokenType == #BinaryOperator) ifTrue:[
- sel := tokenName.
- sel := self selectorCheck:sel for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
- self nextToken
- ] ifFalse:[
- sel := '-'.
- token := tokenValue := tokenValue negated.
- tokenPosition := tokenPosition + 1. "/ to skip the sign
- ]
- ].
- ].
-
- pos2 := pos1 + sel size - 1.
- self markSelector:sel from:pos1 to:pos2 receiverNode:receiver.
-
- arg := self unaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
-
- expr := BinaryNode receiver:receiver selector:sel arg:arg fold:foldConstants.
- expr isErrorNode ifTrue:[
- self parseError:(expr errorString) position:pos1 to:tokenPosition.
- errorFlag := false. "ok, user wants it - so he'll get it"
- expr := BinaryNode receiver:receiver selector:sel arg:arg fold:nil.
- ].
- expr lineNumber:lno.
- expr selectorPosition:pos1.
-
- self checkPlausibilityOf:expr from:pos1 to:pos2.
- parseForCode ifFalse:[
- self rememberSelectorUsed:sel receiver:receiver
- ].
- expr := self messageNodeRewriteHookFor:expr.
- receiver := expr. "/ for next message
+ "/ kludge alarm: in a function-call argList, #, is not a binarySelector
+ inFunctionCallArgument == true ifTrue:[
+ ((tokenType == #BinaryOperator) and:[tokenName = ',']) ifTrue:[
+ ^ receiver
+ ].
+ ].
+
+ pos1 := tokenPosition.
+ lno := tokenLineNr.
+
+ "/ kludge alarm: bar, caret and minus are not scanned as binop
+ (tokenType == $|) ifTrue:[
+ sel := '|'.
+ sel := self selectorCheck:sel for:receiver position:tokenPosition to:tokenPosition.
+ self nextToken.
+ ] ifFalse:[
+ (tokenType == $^) ifTrue:[
+ sel := '^'.
+ sel := self selectorCheck:sel for:receiver position:tokenPosition to:tokenPosition.
+ self nextToken.
+ ] ifFalse:[
+ (tokenType == #BinaryOperator) ifTrue:[
+ sel := tokenName.
+ sel := self selectorCheck:sel for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
+ self nextToken
+ ] ifFalse:[
+ sel := '-'.
+ token := tokenValue := tokenValue negated.
+ tokenPosition := tokenPosition + 1. "/ to skip the sign
+ ]
+ ].
+ ].
+
+ pos2 := pos1 + sel size - 1.
+ self markSelector:sel from:pos1 to:pos2 receiverNode:receiver.
+
+ arg := self unaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+
+ expr := BinaryNode receiver:receiver selector:sel arg:arg fold:foldConstants.
+ expr isErrorNode ifTrue:[
+ self parseError:(expr errorString) position:pos1 to:tokenPosition.
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ expr := BinaryNode receiver:receiver selector:sel arg:arg fold:nil.
+ ].
+ expr lineNumber:lno.
+ expr selectorPosition:pos1.
+
+ self checkPlausibilityOf:expr from:pos1 to:pos2.
+ parseForCode ifFalse:[
+ self rememberSelectorUsed:sel receiver:receiver
+ ].
+ expr := self messageNodeRewriteHookFor:expr.
+ receiver := expr. "/ for next message
].
^ receiver
@@ -6135,48 +6118,48 @@
bytes := ByteArray uninitializedNew:5000.
index := 0. limit := 5000.
[tokenType ~~ $] ] whileTrue:[
- pos2 := tokenPosition.
- "
- this is not good programming style, but speeds up
- reading of huge byte arrays (i.e. stored Images ...)
- "
- (tokenType == #Integer) ifTrue:[
- elem := tokenValue
- ] ifFalse:[
- elem := self arrayConstant.
- (elem == #Error) ifTrue:[
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'unterminated bytearray-constant; '']'' expected'
- position:pos1 to:tokenPosition
- ].
- ^ #Error
- ].
- ].
- ((elem isMemberOf:SmallInteger) and:[elem between:0 and:255]) ifTrue:[
- index := index + 1.
- bytes at:index put:elem.
- index == limit ifTrue:[
- newArray := ByteArray uninitializedNew:(limit * 2).
- newArray replaceFrom:1 to:limit with:bytes startingAt:1.
- limit := limit * 2.
- bytes := newArray
- ].
- ] ifFalse:[
- self parseError:'invalid ByteArray element' position:pos2 to:tokenPosition - 1
- ].
- self nextToken.
+ pos2 := tokenPosition.
+ "
+ this is not good programming style, but speeds up
+ reading of huge byte arrays (i.e. stored Images ...)
+ "
+ (tokenType == #Integer) ifTrue:[
+ elem := tokenValue
+ ] ifFalse:[
+ elem := self arrayConstant.
+ (elem == #Error) ifTrue:[
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'unterminated bytearray-constant; '']'' expected'
+ position:pos1 to:tokenPosition
+ ].
+ ^ #Error
+ ].
+ ].
+ ((elem isMemberOf:SmallInteger) and:[elem between:0 and:255]) ifTrue:[
+ index := index + 1.
+ bytes at:index put:elem.
+ index == limit ifTrue:[
+ newArray := ByteArray uninitializedNew:(limit * 2).
+ newArray replaceFrom:1 to:limit with:bytes startingAt:1.
+ limit := limit * 2.
+ bytes := newArray
+ ].
+ ] ifFalse:[
+ self parseError:'invalid ByteArray element' position:pos2 to:tokenPosition - 1
+ ].
+ self nextToken.
].
newArray := ByteArray uninitializedNew:index.
newArray replaceFrom:1 to:index with:bytes startingAt:1.
parserFlags arraysAreImmutable ifTrue:[
- ^ self class makeImmutableByteArray:newArray
+ ^ self class makeImmutableByteArray:newArray
].
^ newArray
!
degeneratedKeywordExpressionForSelector
- "parse a keyword-expression without receiver - for the selector only.
- Return the selector or nil (if it cannot be determined).
+ "parse a keyword-expression without receiver - for the selector only.
+ Return the selector or nil (if it cannot be determined).
This is not used in normal parsing, but instead to extract the selector from a code fragment.
(for example, the system browsers 'implementors'-function uses this to extract a selector from
the selection)"
@@ -6184,17 +6167,17 @@
|sel arg rec|
(tokenType == #Keyword) ifTrue:[
- sel := tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ sel].
- [tokenType == #Keyword] whileTrue:[
- sel := sel , tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ sel].
- ].
- ^ sel
+ sel := tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ sel].
+ [tokenType == #Keyword] whileTrue:[
+ sel := sel , tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ sel].
+ ].
+ ^ sel
].
(rec := self arrayIndexingExpression) == #Error ifTrue:[ ^ nil].
@@ -6202,17 +6185,17 @@
sel notNil ifTrue:[ ^ sel].
rec isAssignment ifTrue:[
- rec := rec expression
+ rec := rec expression
].
rec isMessage ifTrue:[
- ^ rec selector
- ].
+ ^ rec selector
+ ].
^ nil
"
- (self new source:'hello:world:') nextToken; degeneratedKeywordExpressionForSelector
- (self new source:'hello:world') nextToken; degeneratedKeywordExpressionForSelector
- (self new source:'hello:') nextToken; degeneratedKeywordExpressionForSelector
+ (self new source:'hello:world:') nextToken; degeneratedKeywordExpressionForSelector
+ (self new source:'hello:world') nextToken; degeneratedKeywordExpressionForSelector
+ (self new source:'hello:') nextToken; degeneratedKeywordExpressionForSelector
"
!
@@ -6220,14 +6203,14 @@
"parse a cascade-expression; return a node-tree, nil or #Error.
expression ::= keywordExpression
- | keywordExpression cascade
+ | keywordExpression cascade
cascade ::= ';' expressionSendPart
- | cascade ';' expressionSendPart
+ | cascade ';' expressionSendPart
expressionSendPart ::= { KEYWORD binaryExpression }
- | BINARYOPERATOR unaryExpression
- | IDENTIFIER
+ | BINARYOPERATOR unaryExpression
+ | IDENTIFIER
"
|receiver arg sel args pos pos2 lno tokenEnd realReceiver positions|
@@ -6236,107 +6219,107 @@
receiver := self keywordExpression.
(receiver == #Error) ifTrue:[^ #Error].
(tokenType == $;) ifTrue:[
- receiver isMessage ifFalse:[
- self syntaxError:'left side of cascade must be a message expression'
- position:pos to:tokenPosition.
- realReceiver := receiver. "/ only to allow continuing.
- ] ifTrue:[
- realReceiver := receiver receiver.
- ].
- [tokenType == $;] whileTrue:[
- self nextToken.
- (tokenType == #Identifier) ifTrue:[
- tokenEnd := tokenPosition + tokenName size - 1.
- self markSelector:tokenName from:tokenPosition to:tokenEnd receiverNode:realReceiver.
- sel := tokenName.
- sel := self selectorCheck:tokenName for:realReceiver position:tokenPosition to:tokenEnd.
- receiver := CascadeNode receiver:receiver selector:sel.
- receiver startPosition: receiver receiver startPosition
- endPosition: tokenLastEndPosition.
- receiver lineNumber:tokenLineNr.
- parseForCode ifFalse:[
- self rememberSelectorUsed:sel receiver:realReceiver
- ].
- self nextToken.
- ] ifFalse:[
- (tokenType == #BinaryOperator) ifTrue:[
- tokenEnd := tokenPosition + tokenName size - 1.
- self markSelector:tokenName from:tokenPosition to:tokenEnd receiverNode:realReceiver.
- sel := tokenName.
- sel := self selectorCheck:tokenName for:realReceiver position:tokenPosition to:tokenEnd.
- lno := tokenLineNr.
- self nextToken.
- arg := self unaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- receiver := CascadeNode receiver:receiver selector:sel arg:arg.
- receiver lineNumber:lno.
- parseForCode ifFalse:[
- self rememberSelectorUsed:sel receiver:realReceiver
- ].
- ] ifFalse:[
- (tokenType == #Keyword) ifTrue:[
- tokenEnd := tokenPosition + tokenName size - 1.
- positions := OrderedCollection with:(tokenPosition to:tokenEnd).
- pos := tokenPosition.
- pos2 := tokenEnd.
- lno := tokenLineNr.
- sel := tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := Array with:arg.
- [tokenType == #Keyword] whileTrue:[
- tokenEnd := tokenPosition + tokenName size - 1.
- positions add:(tokenPosition to:tokenEnd).
- sel := sel , tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := args copyWith:arg.
- pos2 := tokenEnd
- ].
- positions do:[:p |
- self markSelector:sel from:p start to:p stop receiverNode:realReceiver.
- ].
-
- sel := self selectorCheck:sel for:realReceiver position:pos to:pos2.
-
- receiver := CascadeNode receiver:receiver selector:sel args:args.
- receiver lineNumber:lno.
- parseForCode ifFalse:[
- self rememberSelectorUsed:sel receiver:realReceiver args:args
- ].
- ] ifFalse:[
- (tokenType == #Error) ifTrue:[^ #Error].
- self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
- position:tokenPosition to:source position1Based - 1.
- ^ #Error
- ]
- ]
- ]
- ].
-
- "obscure (unspecified ?) if selector follows; Question:
-
- is
- 'expr sel1; sel2 sel3'
-
- to be parsed as:
- (t := expr.
- t sel1.
- t sel2) sel3
-
- or:
- (t := expr.
- t sel1.
- t sel2 sel3)
- "
- ((tokenType == #Identifier)
- or:[(tokenType == #BinaryOperator)
- or:[tokenType == #Keyword]]) ifTrue:[
- self syntaxError:'ambigous cascade - please group using (...)'
- position:tokenPosition to:source position1Based - 1.
- ^ #Error
+ receiver isMessage ifFalse:[
+ self syntaxError:'left side of cascade must be a message expression'
+ position:pos to:tokenPosition.
+ realReceiver := receiver. "/ only to allow continuing.
+ ] ifTrue:[
+ realReceiver := receiver receiver.
+ ].
+ [tokenType == $;] whileTrue:[
+ self nextToken.
+ (tokenType == #Identifier) ifTrue:[
+ tokenEnd := tokenPosition + tokenName size - 1.
+ self markSelector:tokenName from:tokenPosition to:tokenEnd receiverNode:realReceiver.
+ sel := tokenName.
+ sel := self selectorCheck:tokenName for:realReceiver position:tokenPosition to:tokenEnd.
+ receiver := CascadeNode receiver:receiver selector:sel.
+ receiver startPosition: receiver receiver startPosition
+ endPosition: tokenLastEndPosition.
+ receiver lineNumber:tokenLineNr.
+ parseForCode ifFalse:[
+ self rememberSelectorUsed:sel receiver:realReceiver
+ ].
+ self nextToken.
+ ] ifFalse:[
+ (tokenType == #BinaryOperator) ifTrue:[
+ tokenEnd := tokenPosition + tokenName size - 1.
+ self markSelector:tokenName from:tokenPosition to:tokenEnd receiverNode:realReceiver.
+ sel := tokenName.
+ sel := self selectorCheck:tokenName for:realReceiver position:tokenPosition to:tokenEnd.
+ lno := tokenLineNr.
+ self nextToken.
+ arg := self unaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ receiver := CascadeNode receiver:receiver selector:sel arg:arg.
+ receiver lineNumber:lno.
+ parseForCode ifFalse:[
+ self rememberSelectorUsed:sel receiver:realReceiver
+ ].
+ ] ifFalse:[
+ (tokenType == #Keyword) ifTrue:[
+ tokenEnd := tokenPosition + tokenName size - 1.
+ positions := OrderedCollection with:(tokenPosition to:tokenEnd).
+ pos := tokenPosition.
+ pos2 := tokenEnd.
+ lno := tokenLineNr.
+ sel := tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := Array with:arg.
+ [tokenType == #Keyword] whileTrue:[
+ tokenEnd := tokenPosition + tokenName size - 1.
+ positions add:(tokenPosition to:tokenEnd).
+ sel := sel , tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := args copyWith:arg.
+ pos2 := tokenEnd
+ ].
+ positions do:[:p |
+ self markSelector:sel from:p start to:p stop receiverNode:realReceiver.
+ ].
+
+ sel := self selectorCheck:sel for:realReceiver position:pos to:pos2.
+
+ receiver := CascadeNode receiver:receiver selector:sel args:args.
+ receiver lineNumber:lno.
+ parseForCode ifFalse:[
+ self rememberSelectorUsed:sel receiver:realReceiver args:args
+ ].
+ ] ifFalse:[
+ (tokenType == #Error) ifTrue:[^ #Error].
+ self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
+ position:tokenPosition to:source position1Based - 1.
+ ^ #Error
+ ]
+ ]
+ ]
+ ].
+
+ "obscure (unspecified ?) if selector follows; Question:
+
+ is
+ 'expr sel1; sel2 sel3'
+
+ to be parsed as:
+ (t := expr.
+ t sel1.
+ t sel2) sel3
+
+ or:
+ (t := expr.
+ t sel1.
+ t sel2 sel3)
+ "
+ ((tokenType == #Identifier)
+ or:[(tokenType == #BinaryOperator)
+ or:[tokenType == #Keyword]]) ifTrue:[
+ self syntaxError:'ambigous cascade - please group using (...)'
+ position:tokenPosition to:source position1Based - 1.
+ ^ #Error
"/ self warning: "syntaxError:" 'possibly ambigous cascade - please group using (...)'
"/ position:tokenPosition to:source position - 1.
"/ tokenType == #Identifier ifTrue:[
@@ -6346,7 +6329,7 @@
"/ ^ self binaryExpressionFor:receiver
"/ ].
"/ ^ self keywordExpressionFor:receiver
- ]
+ ]
].
^ receiver
@@ -6362,33 +6345,33 @@
argList := OrderedCollection new.
[ true ] whileTrue:[
- prevInFunctionCallArgument := inFunctionCallArgument.
- inFunctionCallArgument := true.
-
- arg := self expression.
- arg == #Error ifTrue:[^ #Error].
- argList add:arg.
-
- inFunctionCallArgument := prevInFunctionCallArgument.
-
- tokenType == $) ifTrue:[
- self nextToken.
- ^ argList
- ].
- ((tokenType == #BinaryOperator) and:[tokenName = ',']) ifFalse:[
- self parseError:'"," or ")" expected'.
- ^ argList
- ].
- self nextToken.
+ prevInFunctionCallArgument := inFunctionCallArgument.
+ inFunctionCallArgument := true.
+
+ arg := self expression.
+ arg == #Error ifTrue:[^ #Error].
+ argList add:arg.
+
+ inFunctionCallArgument := prevInFunctionCallArgument.
+
+ tokenType == $) ifTrue:[
+ self nextToken.
+ ^ argList
+ ].
+ ((tokenType == #BinaryOperator) and:[tokenName = ',']) ifFalse:[
+ self parseError:'"," or ")" expected'.
+ ^ argList
+ ].
+ self nextToken.
].
!
functionCallExpression
- "parse a functionCall;
+ "parse a functionCall;
this is an st/x extension.
- foo(x)
- is syntactic sugar for
- foo value:x
+ foo(x)
+ is syntactic sugar for
+ foo value:x
"
|receiver numArgs argList evalSelectors evalSelector|
@@ -6400,11 +6383,11 @@
(receiver == #Error) ifTrue:[^ #Error].
receiver isVariable ifFalse:[
- ((receiver isMessage or:[receiver isAssignment]) and:[receiver parenthesized]) ifFalse:[
- receiver isBlock ifFalse:[
- ^ receiver
- ]
- ].
+ ((receiver isMessage or:[receiver isAssignment]) and:[receiver parenthesized]) ifFalse:[
+ receiver isBlock ifFalse:[
+ ^ receiver
+ ]
+ ].
].
argList := self functionCallArgList.
@@ -6412,34 +6395,34 @@
"/ make it a block evaluation
numArgs := argList size.
numArgs == 0 ifTrue:[
- ^ UnaryNode receiver:receiver selector:#value
+ ^ UnaryNode receiver:receiver selector:#value
].
evalSelectors := #(#'value:'
- #'value:value:'
- #'value:value:value:'
- #'value:value:value:value:'
- #'value:value:value:value:value:'
- #'value:value:value:value:value:value:'
- #'value:value:value:value:value:value:value:'
- #'value:value:value:value:value:value:value:value:'
- ).
+ #'value:value:'
+ #'value:value:value:'
+ #'value:value:value:value:'
+ #'value:value:value:value:value:'
+ #'value:value:value:value:value:value:'
+ #'value:value:value:value:value:value:value:'
+ #'value:value:value:value:value:value:value:value:'
+ ).
numArgs <= evalSelectors size ifTrue:[
- evalSelector := evalSelectors at:numArgs.
- ^ (MessageNode
- receiver:receiver
- selector:evalSelector
- args:argList)
- startPosition: receiver startPosition
- endPosition: tokenLastEndPosition.
+ evalSelector := evalSelectors at:numArgs.
+ ^ (MessageNode
+ receiver:receiver
+ selector:evalSelector
+ args:argList)
+ startPosition: receiver startPosition
+ endPosition: tokenLastEndPosition.
].
"/ gen argument vector
- ^ (MessageNode
- receiver:receiver
- selector:#valueWithArguments:
- args:(self genMakeArrayWith:argList))
- startPosition: receiver startPosition
- endPosition: tokenLastEndPosition.
+ ^ (MessageNode
+ receiver:receiver
+ selector:#valueWithArguments:
+ args:(self genMakeArrayWith:argList))
+ startPosition: receiver startPosition
+ endPosition: tokenLastEndPosition.
"
Parser allowFunctionCallSyntaxForBlockEvaluation:true.
"
@@ -6448,15 +6431,15 @@
|foo|
foo := [:x | x + 1].
- 1 + foo(1).
- foo(1).
+ 1 + foo(1).
+ foo(1).
"
"
|addN add1|
addN := [:n | [:x | x + n]].
add1 := addN(1).
- add1(10).
+ add1(10).
"
"AllowFunctionCallSyntaxForBlockEvaluation := false."
"
@@ -6464,7 +6447,7 @@
addN := [:n | [:x | x + n]].
add1 := addN value:1.
- add1 value:10
+ add1 value:10
"
"Modified: / 27-07-2011 / 15:39:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -6481,24 +6464,24 @@
namesAndValues := OrderedCollection new.
[ tokenType ~~ $} ] whileTrue:[
- (tokenType == #Keyword) ifFalse:[
- self syntaxError:'Bad inlineObject; Keyword expected'
- position:pos1 to:tokenPosition
- ].
- name := tokenName copyWithoutLast:1.
- self nextToken.
- value := self arrayConstant.
- self nextToken.
- namesAndValues add:(name -> value).
-
- tokenType = $. ifTrue:[
- self nextToken.
- ].
- ].
-
- self
- warning:'InlineObjects are an experimental feature which is not yet supported by stc'
- position:pos1 to:tokenPosition.
+ (tokenType == #Keyword) ifFalse:[
+ self syntaxError:'Bad inlineObject; Keyword expected'
+ position:pos1 to:tokenPosition
+ ].
+ name := tokenName copyWithoutLast:1.
+ self nextToken.
+ value := self arrayConstant.
+ self nextToken.
+ namesAndValues add:(name -> value).
+
+ tokenType = $. ifTrue:[
+ self nextToken.
+ ].
+ ].
+
+ self
+ warning:'InlineObjects are an experimental feature which is not yet supported by stc'
+ position:pos1 to:tokenPosition.
self nextToken.
^ ConstantNode type:#Object value:(self literalInlineObjectFor:namesAndValues).
@@ -6508,7 +6491,7 @@
"parse a keyword-expression; return a node-tree, nil or #Error.
keywordExpression ::= binaryexpression
- | { KEYWORD-PART binaryExpression }
+ | { KEYWORD-PART binaryExpression }
"
|receiver|
@@ -6522,7 +6505,7 @@
"parse a keyword-expression; return a node-tree, nil or #Error.
keywordExpression ::= binaryexpression
- | { KEYWORD-PART binaryExpression }
+ | { KEYWORD-PART binaryExpression }
"
|expr receiver sel arg args posR1 posR2 pos1 pos2 lno positions constVal|
@@ -6541,39 +6524,39 @@
(arg == #Error) ifTrue:[^ #Error].
args := Array with:arg.
[tokenType == #Keyword] whileTrue:[
- sel := sel , tokenName.
- pos2 := tokenPosition + tokenName size - 1.
- positions add:(tokenPosition to:pos2).
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := args copyWith:arg.
+ sel := sel , tokenName.
+ pos2 := tokenPosition + tokenName size - 1.
+ positions add:(tokenPosition to:pos2).
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := args copyWith:arg.
].
positions do:[:p |
- self markSelector:sel from:p start to:p stop receiverNode:receiver.
+ self markSelector:sel from:p start to:p stop receiverNode:receiver.
].
sel := self selectorCheck:sel for:receiver positions:positions.
ignoreWarnings ifFalse:[
- (Class definitionSelectors includes:sel) ifTrue:[
- (receiver isVariable and:[receiver isUndeclared]) ifTrue:[
- "this is not an error - the undefined class may be loaded after this code!!"
- self warning:('as yet undefined superclass: ' , receiver name) position:pos1 to:pos2.
- ].
- ].
+ (Class definitionSelectors includes:sel) ifTrue:[
+ (receiver isVariable and:[receiver isUndeclared]) ifTrue:[
+ "this is not an error - the undefined class may be loaded after this code!!"
+ self warning:('as yet undefined superclass: ' , receiver name) position:pos1 to:pos2.
+ ].
+ ].
].
expr := MessageNode receiver:receiver selector:sel args:args fold:foldConstants.
expr isErrorNode ifTrue:[
- self parseError:(expr errorString) position:pos1 to:pos2.
- errorFlag := false. "ok, user wants it - so he'll get it"
- expr := MessageNode receiver:receiver selector:sel args:args fold:nil.
+ self parseError:(expr errorString) position:pos1 to:pos2.
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ expr := MessageNode receiver:receiver selector:sel args:args fold:nil.
].
expr lineNumber:lno.
self checkPlausibilityOf:expr from:pos1 to:pos2.
"/ parseForCode ifFalse:[
- self rememberSelectorUsed:sel receiver:receiver args:args.
+ self rememberSelectorUsed:sel receiver:receiver args:args.
"/ ].
"/ (contextToEvaluateIn isNil and:[selfValue isNil]) ifTrue:[ "/ do not check this for doits
@@ -6587,64 +6570,64 @@
"/
self isSyntaxHighlighter ifTrue:[
- "/ look for true ifTrue / false ifFalse and mark as comment
- (sel = #ifTrue: or:[sel = #ifFalse: or:[sel = #ifTrue:ifFalse: or:[sel = #ifFalse:ifTrue:]]]) ifTrue:[
- (receiver withConstantValueDo:[:val | constVal := val]) ifTrue:[
- |indexOfArgNotExecuted|
-
- "/ receiver evaluates to a constant
- constVal == true ifTrue:[
- indexOfArgNotExecuted := (sel startsWith: #ifFalse:) ifTrue:[1] ifFalse:[2]
- ].
- constVal == false ifTrue:[
- indexOfArgNotExecuted := (sel startsWith: #ifTrue:) ifTrue:[1] ifFalse:[2]
- ].
- indexOfArgNotExecuted == 2 ifTrue:[
- args size == 1 ifTrue:[ indexOfArgNotExecuted := nil]
- ].
-
- indexOfArgNotExecuted notNil ifTrue:[
- |argIsNotExecuted|
-
- "/ self warning:'receiver is constant; arg',indexOfArgNotExecuted printString,' is never executed' position:pos1 to:tokenPosition.
- argIsNotExecuted := expr args at:indexOfArgNotExecuted.
- argIsNotExecuted isBlockNode ifTrue:[
- self markCommentFrom:argIsNotExecuted startPosition to:argIsNotExecuted endPosition.
- ].
- ].
- ].
- ].
+ "/ look for true ifTrue / false ifFalse and mark as comment
+ (sel = #ifTrue: or:[sel = #ifFalse: or:[sel = #ifTrue:ifFalse: or:[sel = #ifFalse:ifTrue:]]]) ifTrue:[
+ (receiver withConstantValueDo:[:val | constVal := val]) ifTrue:[
+ |indexOfArgNotExecuted|
+
+ "/ receiver evaluates to a constant
+ constVal == true ifTrue:[
+ indexOfArgNotExecuted := (sel startsWith: #ifFalse:) ifTrue:[1] ifFalse:[2]
+ ].
+ constVal == false ifTrue:[
+ indexOfArgNotExecuted := (sel startsWith: #ifTrue:) ifTrue:[1] ifFalse:[2]
+ ].
+ indexOfArgNotExecuted == 2 ifTrue:[
+ args size == 1 ifTrue:[ indexOfArgNotExecuted := nil]
+ ].
+
+ indexOfArgNotExecuted notNil ifTrue:[
+ |argIsNotExecuted|
+
+ "/ self warning:'receiver is constant; arg',indexOfArgNotExecuted printString,' is never executed' position:pos1 to:tokenPosition.
+ argIsNotExecuted := expr args at:indexOfArgNotExecuted.
+ argIsNotExecuted isBlockNode ifTrue:[
+ self markCommentFrom:argIsNotExecuted startPosition to:argIsNotExecuted endPosition.
+ ].
+ ].
+ ].
+ ].
].
(ignoreErrors or:[ignoreWarnings]) ifFalse:[
- (sel = #and: or:[sel = #or:]) ifTrue:[
- expr arg1 isBlock ifFalse:[
- (expr arg1 isVariable
- and:[ (expr arg1 name asLowercase includesString:'block')]) ifFalse:[
- self warnCommonMistake:'(possible common mistake) missing block brackets ?'
- position:pos2+1 to:tokenPosition-1
- ]
- ].
- ].
-
- (sel = #whileTrue: or:[sel = #whileFalse:]) ifTrue:[
- receiver isBlock ifFalse:[
- (receiver isVariable
- and:[ (receiver name asLowercase includesString:'block')]) ifFalse:[
- self warnCommonMistake:'(possible common mistake) missing block brackets ?'
- position:pos1 to:pos2
- ]
- ].
- ].
-
- (sel = #ifTrue: or:[sel = #ifFalse:]) ifTrue:[
- receiver isMessage ifTrue:[
- (receiver selector = #whileTrue or:[receiver selector = #whileFalse]) ifTrue:[
- self warnCommonMistake:'strange receiver expression'
- position:pos1 to:pos2
- ].
- ].
- ].
+ (sel = #and: or:[sel = #or:]) ifTrue:[
+ expr arg1 isBlock ifFalse:[
+ (expr arg1 isVariable
+ and:[ (expr arg1 name asLowercase includesString:'block')]) ifFalse:[
+ self warnCommonMistake:'(possible common mistake) missing block brackets ?'
+ position:pos2+1 to:tokenPosition-1
+ ]
+ ].
+ ].
+
+ (sel = #whileTrue: or:[sel = #whileFalse:]) ifTrue:[
+ receiver isBlock ifFalse:[
+ (receiver isVariable
+ and:[ (receiver name asLowercase includesString:'block')]) ifFalse:[
+ self warnCommonMistake:'(possible common mistake) missing block brackets ?'
+ position:pos1 to:pos2
+ ]
+ ].
+ ].
+
+ (sel = #ifTrue: or:[sel = #ifFalse:]) ifTrue:[
+ receiver isMessage ifTrue:[
+ (receiver selector = #whileTrue or:[receiver selector = #whileFalse]) ifTrue:[
+ self warnCommonMistake:'strange receiver expression'
+ position:pos1 to:pos2
+ ].
+ ].
+ ].
].
^ self messageNodeRewriteHookFor:expr.
@@ -6665,20 +6648,20 @@
class setInstanceVariableString:(names asStringWith:Character space).
class instSize: names size.
- names keysAndValuesDo:[:idx :instVarName |
- idx <= InlineObjectPrototype instSize ifTrue:[
- class basicAddSelector:(instVarName asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1' bindWith:idx) asSymbol).
- inlineObjectsAreReadonly ifFalse:[
- class basicAddSelector:((instVarName,':') asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1:' bindWith:idx) asSymbol).
- ].
- ] ifFalse:[
- Class withoutUpdatingChangesDo:[
- Compiler compile:('%1 ^%1' bindWith:instVarName) forClass:class.
- inlineObjectsAreReadonly ifFalse:[
- Compiler compile:('%1:something %1 := something' bindWith:instVarName) forClass:class.
- ].
- ].
- ].
+ names keysAndValuesDo:[:idx :instVarName |
+ idx <= InlineObjectPrototype instSize ifTrue:[
+ class basicAddSelector:(instVarName asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1' bindWith:idx) asSymbol).
+ inlineObjectsAreReadonly ifFalse:[
+ class basicAddSelector:((instVarName,':') asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1:' bindWith:idx) asSymbol).
+ ].
+ ] ifFalse:[
+ Class withoutUpdatingChangesDo:[
+ Compiler compile:('%1 ^%1' bindWith:instVarName) forClass:class.
+ inlineObjectsAreReadonly ifFalse:[
+ Compiler compile:('%1:something %1 := something' bindWith:instVarName) forClass:class.
+ ].
+ ].
+ ].
].
instance := class new.
@@ -6693,231 +6676,231 @@
|val pos node eMsg endPos|
(tokenType == #Self) ifTrue:[
- ^ self primary_self.
+ ^ self primary_self.
].
pos := tokenPosition.
(tokenType == #Identifier) ifTrue:[
- "
- must check for variable first, to be backward compatible
- with other smalltalks.
- "
- tokenName = 'here' ifTrue:[
- (self variableOrError:tokenName) == #Error ifTrue:[
- self warnSTXHereExtensionUsedAt:pos.
- tokenType := #Here.
- ^ self primary_here.
- ]
- ].
- node := self primary_identifier.
- node isVariable ifTrue:[
- ^ self variableReadRewriteHookFor:node
- ].
- ^ node.
- ].
-
- ((tokenType == #Integer)
+ "
+ must check for variable first, to be backward compatible
+ with other smalltalks.
+ "
+ tokenName = 'here' ifTrue:[
+ (self variableOrError:tokenName) == #Error ifTrue:[
+ self warnSTXHereExtensionUsedAt:pos.
+ tokenType := #Here.
+ ^ self primary_here.
+ ]
+ ].
+ node := self primary_identifier.
+ node isVariable ifTrue:[
+ ^ self variableReadRewriteHookFor:node
+ ].
+ ^ node.
+ ].
+
+ ((tokenType == #Integer)
or:[(tokenType == #String)
- or:[(tokenType == #Character)
+ or:[(tokenType == #Character)
or:[(tokenType == #Float)
or:[(tokenType == #Symbol)
or:[(tokenType == #ESSymbol)]]]]]) ifTrue:[
- ^ self primary_simpleLiteral.
+ ^ self primary_simpleLiteral.
].
(tokenType == #FixedPoint) ifTrue:[
- parserFlags allowFixedPointLiterals == true ifFalse:[
- self parseError:'non-Standard literal: FixedPoint. Please enable in settings.' position:pos to:pos+2.
- ^ #Error
- ].
- ^ self primary_simpleLiteral.
+ parserFlags allowFixedPointLiterals == true ifFalse:[
+ self parseError:'non-Standard literal: FixedPoint. Please enable in settings.' position:pos to:pos+2.
+ ^ #Error
+ ].
+ ^ self primary_simpleLiteral.
].
(tokenType == #Nil) ifTrue:[
- ^ self primary_nil.
+ ^ self primary_nil.
].
(tokenType == #True) ifTrue:[
- ^ self primary_true
+ ^ self primary_true
].
(tokenType == #False) ifTrue:[
- ^ self primary_false
+ ^ self primary_false
].
(tokenType == #Super) ifTrue:[
- ^ self primary_super.
+ ^ self primary_super.
].
(tokenType == #ThisContext) ifTrue:[
- ^ self primary_thisContext
+ ^ self primary_thisContext
].
(tokenType == #HashLeftParen) ifTrue:[
- self nextToken.
- self inArrayLiteral:true.
- ParseError handle:[:ex |
- self inArrayLiteral:false.
- ^ #Error
- ] do:[
- val := self array.
- ].
- self inArrayLiteral:false.
- self nextToken.
- (self noAssignmentAllowed:'Assignment to a constant' at:pos) ifFalse:[
- ^ #Error
- ].
- ^ ConstantNode type:#Array value:val from: pos to: tokenLastEndPosition.
+ self nextToken.
+ self inArrayLiteral:true.
+ ParseError handle:[:ex |
+ self inArrayLiteral:false.
+ ^ #Error
+ ] do:[
+ val := self array.
+ ].
+ self inArrayLiteral:false.
+ self nextToken.
+ (self noAssignmentAllowed:'Assignment to a constant' at:pos) ifFalse:[
+ ^ #Error
+ ].
+ ^ ConstantNode type:#Array value:val from: pos to: tokenLastEndPosition.
].
(tokenType == #HashLeftBrace) ifTrue:[
- parserFlags allowQualifiedNames == true ifFalse:[
- self parseError:'non-Standard VisualWorks extension: #{..}. Please enable in settings.' position:pos to:tokenPosition.
- ].
- val := self qualifiedNameOrInlineObject.
- ^ val.
+ parserFlags allowQualifiedNames == true ifFalse:[
+ self parseError:'non-Standard VisualWorks extension: #{..}. Please enable in settings.' position:pos to:tokenPosition.
+ ].
+ val := self qualifiedNameOrInlineObject.
+ ^ val.
].
(tokenType == #HashLeftBrack) ifTrue:[
- self nextToken.
- val := self byteArray.
- self nextToken.
- (self noAssignmentAllowed:'Assignment to a constant' at:pos) ifFalse:[
- ^ #Error
- ].
- ^ ConstantNode type:#ByteArray value:val from: pos to: tokenLastEndPosition.
+ self nextToken.
+ val := self byteArray.
+ self nextToken.
+ (self noAssignmentAllowed:'Assignment to a constant' at:pos) ifFalse:[
+ ^ #Error
+ ].
+ ^ ConstantNode type:#ByteArray value:val from: pos to: tokenLastEndPosition.
].
(tokenType == $() ifTrue:[
- parenthesisLevel := parenthesisLevel + 1.
- self markParenthesisAt:tokenPosition.
- ^ self primary_expression.
+ parenthesisLevel := parenthesisLevel + 1.
+ self markParenthesisAt:tokenPosition.
+ ^ self primary_expression.
].
(tokenType == $[ ) ifTrue:[
- self markBracketAt:tokenPosition.
- val := self block.
- self nextToken.
- (self noAssignmentAllowed:'invalid assignment' at:pos) ifFalse:[
- ^ #Error
- ].
- ^ val
+ self markBracketAt:tokenPosition.
+ val := self block.
+ self nextToken.
+ (self noAssignmentAllowed:'invalid assignment' at:pos) ifFalse:[
+ ^ #Error
+ ].
+ ^ val
].
"/ EXPERIMENTAL - may be in next release
parserFlags allowVariableReferences == true ifTrue:[
- ((tokenType == #BinaryOperator) and:[token = '&']) ifTrue:[
- self nextToken.
- node := self primary_identifier.
- "/ generate a Reference
- ^ self makeReferenceFor:node
- ].
+ ((tokenType == #BinaryOperator) and:[token = '&']) ifTrue:[
+ self nextToken.
+ node := self primary_identifier.
+ "/ generate a Reference
+ ^ self makeReferenceFor:node
+ ].
].
(tokenType == ${ ) ifTrue:[
- parserFlags allowSqueakExtensions == true ifFalse:[
- didWarnAboutSqueakExtensions~~ true ifTrue:[
- didWarnAboutSqueakExtensions := true.
- "/ self parseError:'non-Standard Squeak extension: Brace Computed Array. Enable in settings.' position:pos to:tokenPosition.
- self
- warning:('non-Standard Squeak extension: Brace Computed Array. Enable in settings.')
- doNotShowAgainAction:[ ParserFlags allowSqueakExtensions:true ]
- position:pos to:tokenPosition.
-
- "/ errorFlag := false.
- ].
- ].
- ^ self primary_squeakComputedArray.
+ parserFlags allowSqueakExtensions == true ifFalse:[
+ didWarnAboutSqueakExtensions~~ true ifTrue:[
+ didWarnAboutSqueakExtensions := true.
+ "/ self parseError:'non-Standard Squeak extension: Brace Computed Array. Enable in settings.' position:pos to:tokenPosition.
+ self
+ warning:('non-Standard Squeak extension: Brace Computed Array. Enable in settings.')
+ doNotShowAgainAction:[ ParserFlags allowSqueakExtensions:true ]
+ position:pos to:tokenPosition.
+
+ "/ errorFlag := false.
+ ].
+ ].
+ ^ self primary_squeakComputedArray.
].
(tokenType == #Primitive) ifTrue:[
- node := PrimitiveNode code:tokenValue.
- node startPosition: tokenPosition endPosition: source position1Based.
- self nextToken.
- hasNonOptionalPrimitiveCode := true.
- hasPrimitiveCode := true.
- ^ node
+ node := PrimitiveNode code:tokenValue.
+ node startPosition: tokenPosition endPosition: source position1Based.
+ self nextToken.
+ hasNonOptionalPrimitiveCode := true.
+ hasPrimitiveCode := true.
+ ^ node
].
tokenType == #HashHashLeftParen ifTrue:[
- self nextToken.
- parserFlags allowDolphinExtensions == true ifFalse:[
- self parseError:'non-Standard Dolphin extension: ##(..). Enable in settings.' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ self primary_dolphinComputedLiteral.
+ self nextToken.
+ parserFlags allowDolphinExtensions == true ifFalse:[
+ self parseError:'non-Standard Dolphin extension: ##(..). Enable in settings.' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ self primary_dolphinComputedLiteral.
].
tokenType == #ExclaLeftBrack ifTrue:[
- self nextToken.
- parserFlags allowLazyValueExtension == true ifFalse:[
- self parseError:'non-Standard LazyValue extension. Enable in classVariable.' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ self primary_lazyValue.
+ self nextToken.
+ parserFlags allowLazyValueExtension == true ifFalse:[
+ self parseError:'non-Standard LazyValue extension. Enable in classVariable.' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ self primary_lazyValue.
].
tokenType == #HashHash ifTrue:[
- self warnPossibleIncompatibility:'''##'' might be interpreted differently in other smalltalk systems' position:pos to:tokenPosition.
- tokenType := #Symbol.
- token := tokenValue := tokenName := '#'.
- ^ self primary_simpleLiteral.
+ self warnPossibleIncompatibility:'''##'' might be interpreted differently in other smalltalk systems' position:pos to:tokenPosition.
+ tokenType := #Symbol.
+ token := tokenValue := tokenName := '#'.
+ ^ self primary_simpleLiteral.
].
parserFlags allowSqueakExtensions == true ifTrue:[
- ((tokenType == #BinaryOperator) and:[token = '#']) ifTrue:[
- self nextToken.
- (tokenType == $( ) ifFalse:[
- self parseError:'''('' expected after #.' position:pos to:tokenPosition.
- ^ #Error.
- ].
- self nextToken.
- self inArrayLiteral:true.
- ParseError handle:[:ex |
- self inArrayLiteral:false.
- ^ #Error
- ] do:[
- val := self array.
- ].
- self inArrayLiteral:false.
- self nextToken.
- (self noAssignmentAllowed:'Assignment to a constant' at:pos) ifFalse:[
- ^ #Error
- ].
- ^ ConstantNode type:#Array value:val from: pos to: tokenLastEndPosition.
- ].
+ ((tokenType == #BinaryOperator) and:[token = '#']) ifTrue:[
+ self nextToken.
+ (tokenType == $( ) ifFalse:[
+ self parseError:'''('' expected after #.' position:pos to:tokenPosition.
+ ^ #Error.
+ ].
+ self nextToken.
+ self inArrayLiteral:true.
+ ParseError handle:[:ex |
+ self inArrayLiteral:false.
+ ^ #Error
+ ] do:[
+ val := self array.
+ ].
+ self inArrayLiteral:false.
+ self nextToken.
+ (self noAssignmentAllowed:'Assignment to a constant' at:pos) ifFalse:[
+ ^ #Error
+ ].
+ ^ ConstantNode type:#Array value:val from: pos to: tokenLastEndPosition.
+ ].
].
((tokenType == #BinaryOperator) and:[token = '-']) ifTrue:[
- self nextToken.
- ((tokenType == #Integer)
- or:[(tokenType == #Float)]) ifFalse:[
- self parseError:'number expected after sign.' position:pos to:tokenPosition.
- ^ #Error.
- ].
- ((parserFlags allowSqueakExtensions == true)
- or:[parserFlags allowSTVExtensions == true]) ifFalse:[
- self parseError:'non-Standard Squeak (or ST/V) extension: space between sign and number. Enable in settings.' position:pos to:tokenPosition.
- errorFlag := false.
- ].
-
- node := self primary_simpleLiteral.
- node isConstant ifFalse:[
- self parseError:'number expected after sign.' position:pos to:tokenPosition.
- ^ #Error.
- ].
- ^ ConstantNode type:(node type) value:(node value negated) from: node startPosition to: node endPosition.
+ self nextToken.
+ ((tokenType == #Integer)
+ or:[(tokenType == #Float)]) ifFalse:[
+ self parseError:'number expected after sign.' position:pos to:tokenPosition.
+ ^ #Error.
+ ].
+ ((parserFlags allowSqueakExtensions == true)
+ or:[parserFlags allowSTVExtensions == true]) ifFalse:[
+ self parseError:'non-Standard Squeak (or ST/V) extension: space between sign and number. Enable in settings.' position:pos to:tokenPosition.
+ errorFlag := false.
+ ].
+
+ node := self primary_simpleLiteral.
+ node isConstant ifFalse:[
+ self parseError:'number expected after sign.' position:pos to:tokenPosition.
+ ^ #Error.
+ ].
+ ^ ConstantNode type:(node type) value:(node value negated) from: node startPosition to: node endPosition.
].
(tokenType == #Error) ifTrue:[^ #Error].
tokenType isCharacter ifTrue:[
- eMsg := '"',tokenType printString,'" unexpected in primary.'.
- endPos := tokenPosition.
+ eMsg := '"',tokenType printString,'" unexpected in primary.'.
+ endPos := tokenPosition.
] ifFalse:[
- (#(BinaryOperator Keyword) includes:tokenType) ifTrue:[
- eMsg := tokenType printString,' ("' , tokenName , '") ',' unexpected in primary. (missing receiver ?)'
- ] ifFalse:[
- (#(Integer Float) includes:tokenType) ifTrue:[
- eMsg := tokenType printString,' (' , tokenValue , ') ',' unexpected in primary. (missing receiver ?)'
- ] ifFalse:[
- eMsg := '"',(token ? ''),'" (',tokenType printString,') unexpected in primary.'
- ]
- ].
- endPos :=source position1Based - 1.
+ (#(BinaryOperator Keyword) includes:tokenType) ifTrue:[
+ eMsg := tokenType printString,' ("' , tokenName , '") ',' unexpected in primary. (missing receiver ?)'
+ ] ifFalse:[
+ (#(Integer Float) includes:tokenType) ifTrue:[
+ eMsg := tokenType printString,' (' , tokenValue , ') ',' unexpected in primary. (missing receiver ?)'
+ ] ifFalse:[
+ eMsg := '"',(token ? ''),'" (',tokenType printString,') unexpected in primary.'
+ ]
+ ].
+ endPos :=source position1Based - 1.
].
self syntaxError:eMsg position:tokenPosition to:endPos.
^ #Error
@@ -6937,7 +6920,7 @@
if you ever plan to stc-compile it into a shared library.
The question is still: how should stc ever be able to do this, as it cannot execute
smalltalk code; it could generate code to execute it at initialization time of the
- generated code, but then, it is no longer a compile-time constant
+ generated code, but then, it is no longer a compile-time constant
(for example, generating a compilation-Date constant is then not possible...)"
|pos pos2 expr val|
@@ -6947,40 +6930,40 @@
expr := self expression.
tokenType ~~ $) ifTrue:[
- self parseError:''')'' expected' position:tokenPosition.
- ^ #Error
+ self parseError:''')'' expected' position:tokenPosition.
+ ^ #Error
].
pos2 := tokenPosition.
self nextToken.
(self noAssignmentAllowed:'Invalid assignment to a computed constant' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
val := expr evaluate.
val isLiteral ifTrue:[
- val isString ifTrue:[
- ^ ConstantNode type:#String value:val from: pos to: pos2
- ].
- val isByteArray ifTrue:[
- ^ ConstantNode type:#ByteArray value:val from: pos to: pos2
- ].
- val isCharacter ifTrue:[
- ^ ConstantNode type:#Character value:val from: pos to: pos2
- ].
- val isInteger ifTrue:[
- ^ ConstantNode type:#Integer value:val from: pos to: pos2
- ].
- val isLimitedPrecisionReal ifTrue:[
- ^ ConstantNode type:#Float value:val from: pos to: pos2
- ].
- val isArray ifTrue:[
- ^ ConstantNode type:#Array value:val from: pos to: pos2
- ].
+ val isString ifTrue:[
+ ^ ConstantNode type:#String value:val from: pos to: pos2
+ ].
+ val isByteArray ifTrue:[
+ ^ ConstantNode type:#ByteArray value:val from: pos to: pos2
+ ].
+ val isCharacter ifTrue:[
+ ^ ConstantNode type:#Character value:val from: pos to: pos2
+ ].
+ val isInteger ifTrue:[
+ ^ ConstantNode type:#Integer value:val from: pos to: pos2
+ ].
+ val isLimitedPrecisionReal ifTrue:[
+ ^ ConstantNode type:#Float value:val from: pos to: pos2
+ ].
+ val isArray ifTrue:[
+ ^ ConstantNode type:#Array value:val from: pos to: pos2
+ ].
] ifFalse:[
- self parseError:'must be representable as a literal (for now)' position:pos.
- ^ #Error
+ self parseError:'must be representable as a literal (for now)' position:pos.
+ ^ #Error
].
self shouldImplement.
@@ -6992,7 +6975,7 @@
"
"/ "/ make it an array creation expression ...
-"/ expr := MessageNode
+"/ expr := MessageNode
"/ receiver:(VariableNode globalNamed:#Array)
"/ selector:#new:
"/ arg:(ConstantNode type:#Integer value:(exprList size)).
@@ -7028,19 +7011,19 @@
val := self expression.
(val == #Error) ifTrue:[^ #Error].
(tokenType == $) ) ifFalse:[
- tokenType isCharacter ifTrue:[
- eMsg := 'missing '')'' (i.e. ''' , tokenType asString , ''' unexpected)'.
- ] ifFalse:[
- eMsg := 'missing '')'''.
- ].
- self syntaxError:eMsg withCRs position:pos to:tokenPosition.
- ^ #Error
+ tokenType isCharacter ifTrue:[
+ eMsg := 'missing '')'' (i.e. ''' , tokenType asString , ''' unexpected)'.
+ ] ifFalse:[
+ eMsg := 'missing '')'''.
+ ].
+ self syntaxError:eMsg withCRs position:pos to:tokenPosition.
+ ^ #Error
].
self markParenthesisAt:tokenPosition.
parenthesisLevel := parenthesisLevel - 1.
self nextToken.
(self noAssignmentAllowed:'Invalid assignment to an expression' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
val parenthesized:true.
^ val
@@ -7057,7 +7040,7 @@
self nextToken.
(self noAssignmentAllowed:'Assignment to ''false'' would break Smalltalk' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
self markBooleanConstantFrom:pos to:pos+4.
^ ConstantNode type:#False value:false from: pos to: pos + 4
@@ -7075,15 +7058,15 @@
self nextToken.
(self noAssignmentAllowed:'Assignment to pseudo variable ''here''' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
classToCompileFor isNil ifTrue:[
- self warning:'in which class are you ?' position:pos to:(pos + 3).
+ self warning:'in which class are you ?' position:pos to:(pos + 3).
].
self markSelfFrom:pos to:pos+3.
^ (SuperNode value:selfValue inClass:classToCompileFor here:true)
- startPosition: pos endPosition: pos + 3;
- yourself
+ startPosition: pos endPosition: pos + 3;
+ yourself
"Modified: / 19-07-2011 / 17:51:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 26-07-2012 / 11:36:53 / cg"
@@ -7101,270 +7084,270 @@
varName := tokenName.
- (self isDoIt
+ (self isDoIt
and:[ currentBlock isNil
and:[ requestor notNil
and:[ (autoHow := requestor perform:#autoDefineVariables ifNotUnderstood:nil) notNil]]]) ifTrue:[
- var := self variableOrError:varName.
- self nextToken.
- (var == #Error) ifTrue:[
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- autoHow == #workspace ifTrue:[
- holder := Workspace addWorkspaceVariable:varName.
- var := VariableNode type:#WorkspaceVariable holder:holder name:varName.
- var startPosition: pos1 endPosition: pos2.
- ] ifFalse:[
- holder := self addDoItTemporary:varName.
- var := VariableNode type:#DoItTemporary holder:holder name:varName.
- var startPosition: pos1 endPosition: pos2.
- ].
- ] ifFalse:[
- var := self correctVariable:varName atPosition:pos1 to:pos2.
- var startPosition: pos1 endPosition: pos2.
- ].
- ]
+ var := self variableOrError:varName.
+ self nextToken.
+ (var == #Error) ifTrue:[
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ autoHow == #workspace ifTrue:[
+ holder := Workspace addWorkspaceVariable:varName.
+ var := VariableNode type:#WorkspaceVariable holder:holder name:varName.
+ var startPosition: pos1 endPosition: pos2.
+ ] ifFalse:[
+ holder := self addDoItTemporary:varName.
+ var := VariableNode type:#DoItTemporary holder:holder name:varName.
+ var startPosition: pos1 endPosition: pos2.
+ ].
+ ] ifFalse:[
+ var := self correctVariable:varName atPosition:pos1 to:pos2.
+ var startPosition: pos1 endPosition: pos2.
+ ].
+ ]
] ifFalse:[
- var := self variable.
- self nextToken.
+ var := self variable.
+ self nextToken.
].
"/ errorFlag == true ifTrue:[self halt].
(var == #Error) ifTrue:[
- errorFlag := true
+ errorFlag := true
].
(tokenType == #'::') ifTrue:[
- globlName := rawName := varName.
-
- "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:[
- self warnSTXNameSpaceUseAt:pos1.
- varName := tokenName.
-
- globlName := (nameSpace , '::' , varName).
- rawName := (rawName , '::' , varName).
-
- nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
- nameSpaceGlobal isNil ifTrue:[
- warnedUnknownNamespaces isNil ifTrue:[
- warnedUnknownNamespaces := Set new.
- ].
- (warnedUnknownNamespaces includes:nameSpace) ifFalse:[
+ globlName := rawName := varName.
+
+ "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:[
+ self warnSTXNameSpaceUseAt:pos1.
+ varName := tokenName.
+
+ globlName := (nameSpace , '::' , varName).
+ rawName := (rawName , '::' , varName).
+
+ nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
+ nameSpaceGlobal isNil ifTrue:[
+ warnedUnknownNamespaces isNil ifTrue:[
+ warnedUnknownNamespaces := Set new.
+ ].
+ (warnedUnknownNamespaces includes:nameSpace) ifFalse:[
"/ not needed; already warned.
-"/ "correctIt :=" requestor
-"/ correctableError:('Unknown nameSpace: "', nameSpace,'"')
+"/ "correctIt :=" requestor
+"/ correctableError:('Unknown nameSpace: "', nameSpace,'"')
"/ position:pos1 to:tokenPosition-1 from:self.
-"/ self warning:('unknown nameSpace: ', nameSpace)
+"/ self warning:('unknown nameSpace: ', nameSpace)
"/ position:pos1 to:tokenPosition-1.
"/ self parseError:('unknown nameSpace: ', nameSpace) position:pos to:tokenPosition-1.
- warnedUnknownNamespaces add:nameSpace.
- ]
- ] ifFalse:[
- nameSpaceGlobal isNameSpace ifTrue:[
- "/ for now: only Smalltalk is allowed
- nameSpaceGlobal ~~ Smalltalk ifTrue:[
+ warnedUnknownNamespaces add:nameSpace.
+ ]
+ ] 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.
- ] ifFalse:[
- globlName := varName
- ].
- ] ifFalse:[
- nameSpaceGlobal isBehavior ifFalse:[
- self parseError:('invalid nameSpace: ' , nameSpace) position:pos1 to:tokenPosition-1.
- ] ifTrue:[
- nameSpaceGlobal isLoaded ifTrue:[
- (nameSpaceGlobal privateClassesAt:varName asSymbol) isNil ifTrue:[
- (Smalltalk at:rawName asSymbol) notNil ifTrue:[
- self warning:('Possible name clash (global: ' , rawName , ' vs. private: ' , (nameSpace , '::', varName) , ') - assume globl.')
- position:pos1 to:source position "tokenPosition-1".
- globlName := rawName asSymbol.
- ] ifFalse:[
- self warning:('no private class: ' , varName allBold , ' in class: ' , nameSpace)
- position:pos1 to:source position "tokenPosition-1".
-"/ self parseError:('no private class: ' , name , ' in class: ' , nameSpace) position:pos to:tokenPosition-1.
- ]
- ] ifFalse:[
- "/ reference to a private class
- (classToCompileFor notNil and:[nameSpaceGlobal ~~ classToCompileFor theNonMetaclass]) ifTrue:[
- self classToCompileFor notNil ifTrue:[
- self isDoIt ifFalse:[
- parserFlags warnAboutReferenceToPrivateClass ifTrue:[
- self warning:('Referring to private class ''' , varName allBold , ''' here.')
- doNotShowAgainAction:[ ParserFlags warnAboutReferenceToPrivateClass:false.
- parserFlags warnAboutReferenceToPrivateClass:false. ]
- position:pos1 to:source position " tokenPosition-1".
- ].
- Tools::ToDoListBrowser notNil ifTrue:[
- self
- notifyTodo:('Referring to private class ''' , varName allBold , ''' here.') position:pos1
- className:(self classToCompileFor name) selector:selector
- severity:#warning priority:#medium
- equalityParameter:nil
- checkAction:nil.
- ].
- ].
- ].
- ]
- ].
- ]
- ]
- ].
- ].
- pos2 := source position.
- self nextToken.
- ].
- var := VariableNode globalNamed:globlName.
- var startPosition: pos1 endPosition: pos2.
- parseForCode ifFalse:[self rememberGlobalUsed:globlName].
- ].
- self markVariable:var from:pos1 to:pos1 + rawName size - 1.
+ ] ifFalse:[
+ globlName := varName
+ ].
+ ] ifFalse:[
+ nameSpaceGlobal isBehavior ifFalse:[
+ self parseError:('invalid nameSpace: ' , nameSpace) position:pos1 to:tokenPosition-1.
+ ] ifTrue:[
+ nameSpaceGlobal isLoaded ifTrue:[
+ (nameSpaceGlobal privateClassesAt:varName asSymbol) isNil ifTrue:[
+ (Smalltalk at:rawName asSymbol) notNil ifTrue:[
+ self warning:('Possible name clash (global: ' , rawName , ' vs. private: ' , (nameSpace , '::', varName) , ') - assume globl.')
+ position:pos1 to:source position "tokenPosition-1".
+ globlName := rawName asSymbol.
+ ] ifFalse:[
+ self warning:('no private class: ' , varName allBold , ' in class: ' , nameSpace)
+ position:pos1 to:source position "tokenPosition-1".
+"/ self parseError:('no private class: ' , name , ' in class: ' , nameSpace) position:pos to:tokenPosition-1.
+ ]
+ ] ifFalse:[
+ "/ reference to a private class
+ (classToCompileFor notNil and:[nameSpaceGlobal ~~ classToCompileFor theNonMetaclass]) ifTrue:[
+ self classToCompileFor notNil ifTrue:[
+ self isDoIt ifFalse:[
+ parserFlags warnAboutReferenceToPrivateClass ifTrue:[
+ self warning:('Referring to private class ''' , varName allBold , ''' here.')
+ doNotShowAgainAction:[ ParserFlags warnAboutReferenceToPrivateClass:false.
+ parserFlags warnAboutReferenceToPrivateClass:false. ]
+ position:pos1 to:source position " tokenPosition-1".
+ ].
+ Tools::ToDoListBrowser notNil ifTrue:[
+ self
+ notifyTodo:('Referring to private class ''' , varName allBold , ''' here.') position:pos1
+ className:(self classToCompileFor name) selector:selector
+ severity:#warning priority:#medium
+ equalityParameter:nil
+ checkAction:nil.
+ ].
+ ].
+ ].
+ ]
+ ].
+ ]
+ ]
+ ].
+ ].
+ pos2 := source position.
+ self nextToken.
+ ].
+ var := VariableNode globalNamed:globlName.
+ var startPosition: pos1 endPosition: pos2.
+ parseForCode ifFalse:[self rememberGlobalUsed:globlName].
+ ].
+ self markVariable:var from:pos1 to:pos1 + rawName size - 1.
].
var == #Error ifTrue:[
- ^ #Error
+ ^ #Error
].
"/ errorFlag ~~ true ifTrue:[
"/ self markVariable:var from:pos1 to:pos1 + varName size - 1.
"/ ].
(ignoreErrors or:[parseForCode not and:[ignoreWarnings]]) ifTrue:[
- errorFlag := false.
+ errorFlag := false.
].
((tokenType ~~ $_) and:[tokenType ~~ #':=']) ifTrue:[
- parseForCode ifFalse:[
- var isInstanceVariable ifTrue:[ self rememberInstVarRead:var name].
- var isClassVariable ifTrue:[ self rememberClassVarRead:var name].
- var isPoolVariable ifTrue:[ self rememberPoolVarRead:var name].
- var isGlobalVariable ifTrue:[ self rememberGlobalRead:var name].
- ].
- ^ var
+ parseForCode ifFalse:[
+ var isInstanceVariable ifTrue:[ self rememberInstVarRead:var name].
+ var isClassVariable ifTrue:[ self rememberClassVarRead:var name].
+ var isPoolVariable ifTrue:[ self rememberPoolVarRead:var name].
+ var isGlobalVariable ifTrue:[ self rememberGlobalRead:var name].
+ ].
+ ^ var
].
"/ assignment...
(usedGlobals notNil and:[usedGlobals includes:(Smalltalk undeclaredPrefix,var name)]) ifFalse:[
- self markAssignedVariable:var from:pos1 to:pos1 + var name size - 1.
+ self markAssignedVariable:var from:pos1 to:pos1 + var name size - 1.
].
"/ careful: it could already be an implicit self send
parserFlags implicitSelfSends ifTrue:[
- var isMessage ifTrue:[
- self nextToken.
- expr := self expression.
- self isSyntaxHighlighter ifFalse:[
- (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
- ].
- ^ MessageNode receiver:(self selfNode) selector:('__' , varName , ':') asSymbol arg:expr.
- ].
+ var isMessage ifTrue:[
+ self nextToken.
+ expr := self expression.
+ self isSyntaxHighlighter ifFalse:[
+ (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
+ ].
+ ^ MessageNode receiver:(self selfNode) selector:('__' , varName , ':') asSymbol arg:expr.
+ ].
].
assignmentAllowed := true.
(var ~~ #Error) ifTrue:[
- t := var type.
- t == #MethodVariable ifTrue:[
- modifiedLocalVars isNil ifTrue:[
- modifiedLocalVars := Set new.
- ].
- modifiedLocalVars add:var name.
- ] ifFalse:[ (t == #InstanceVariable) ifTrue:[
- varName := self classesInstVarNames at:(var index).
-
- classToCompileFor isMeta ifTrue:[
- "/ ca once assigned to "name" on the class side 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)
- ignoreWarnings ifFalse:[
- parserFlags warnings ifTrue:[
- parserFlags warnCommonMistakes ifTrue:[
- (classToCompileFor isSubclassOf:Class) ifTrue:[
- (Class allInstVarNames includes:(var name)) ifTrue:[
- self warning:'assignment to a classInstanceVariable\(see hierarchy of "Class")' withCRs position:pos1 to:pos2.
- ]
- ]
- ]
- ].
- ].
- ].
-
- parseForCode ifFalse:[
- self rememberInstVarModified:varName
- ]
- ] ifFalse:[ (t == #ClassVariable) ifTrue:[
- varName := var name.
- varName := varName copyFrom:((varName indexOf:$:) + 1).
- parseForCode ifFalse:[
- self rememberClassVarModified:varName
- ]
- ] 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:pos1 to:pos2.
- ]
- ].
- parseForCode ifFalse:[
- self rememberGlobalModified:var name
- ]
- ] ifFalse:[
- (t == #PrivateClass) ifTrue:[
- assignmentAllowed := false.
- self parseError:'assignment to private class' position:pos1 to:pos2.
- ] ifFalse:[ (t == #MethodArg) ifTrue:[
- (assignmentAllowed := parserFlags allowAssignmentToMethodArgument) ifTrue:[
- self warning:'Assignment to method argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
- ] ifFalse:[
- self parseError:'Assignment to method argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
- errorFlag := false. "ok, user wants it - so he'll get it"
- assignmentAllowed := true. "/ if proceeded
- ].
- ] ifFalse:[ (t == #BlockArg) ifTrue:[
- (assignmentAllowed := parserFlags allowAssignmentToBlockArgument) ifTrue:[
- self warning:'Assignment to block argument' position:pos1 to:pos2.
- ] ifFalse:[
- DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
- parserFlags allowAssignmentToBlockArgument:true.
- ParserFlags allowAssignmentToBlockArgument:true.
- ex proceed.
- ] do:[
- self parseError:'assignment to block argument' position:pos1 to:pos2.
- ].
- errorFlag := false. "ok, user wants it - so he'll get it"
- assignmentAllowed := true. "/ if proceeded
- ]
- ] ifFalse:[ (t == #PoolVariable) ifTrue:[
- self isDoIt ifTrue:[
- self warning:'assignment to pool variable' position:pos1 to:pos2.
- assignmentAllowed := true.
- ] ifFalse:[
- (assignmentAllowed := parserFlags allowAssignmentToPoolVariable) ifTrue:[
- self warning:'assignment to pool variable' position:pos1 to:pos2.
- ] ifFalse:[
- DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
- parserFlags allowAssignmentToPoolVariable:true.
- ParserFlags allowAssignmentToPoolVariable:true.
- ex proceed.
- ] do:[
- self parseError:'assignment to pool variable' position:pos1 to:pos2.
- ].
- errorFlag := false. "ok, user wants it - so he'll get it"
- assignmentAllowed := true. "/ if proceeded
- parseForCode ifFalse:[
- self rememberPoolVarModified:var name
- ]
- ].
- ]
- ]]]]]]]
- ].
+ t := var type.
+ t == #MethodVariable ifTrue:[
+ modifiedLocalVars isNil ifTrue:[
+ modifiedLocalVars := Set new.
+ ].
+ modifiedLocalVars add:var name.
+ ] ifFalse:[ (t == #InstanceVariable) ifTrue:[
+ varName := self classesInstVarNames at:(var index).
+
+ classToCompileFor isMeta ifTrue:[
+ "/ ca once assigned to "name" on the class side 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)
+ ignoreWarnings ifFalse:[
+ parserFlags warnings ifTrue:[
+ parserFlags warnCommonMistakes ifTrue:[
+ (classToCompileFor isSubclassOf:Class) ifTrue:[
+ (Class allInstVarNames includes:(var name)) ifTrue:[
+ self warning:'assignment to a classInstanceVariable\(see hierarchy of "Class")' withCRs position:pos1 to:pos2.
+ ]
+ ]
+ ]
+ ].
+ ].
+ ].
+
+ parseForCode ifFalse:[
+ self rememberInstVarModified:varName
+ ]
+ ] ifFalse:[ (t == #ClassVariable) ifTrue:[
+ varName := var name.
+ varName := varName copyFrom:((varName indexOf:$:) + 1).
+ parseForCode ifFalse:[
+ self rememberClassVarModified:varName
+ ]
+ ] 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:pos1 to:pos2.
+ ]
+ ].
+ parseForCode ifFalse:[
+ self rememberGlobalModified:var name
+ ]
+ ] ifFalse:[
+ (t == #PrivateClass) ifTrue:[
+ assignmentAllowed := false.
+ self parseError:'assignment to private class' position:pos1 to:pos2.
+ ] ifFalse:[ (t == #MethodArg) ifTrue:[
+ (assignmentAllowed := parserFlags allowAssignmentToMethodArgument) ifTrue:[
+ self warning:'Assignment to method argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
+ ] ifFalse:[
+ self parseError:'Assignment to method argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ assignmentAllowed := true. "/ if proceeded
+ ].
+ ] ifFalse:[ (t == #BlockArg) ifTrue:[
+ (assignmentAllowed := parserFlags allowAssignmentToBlockArgument) ifTrue:[
+ self warning:'Assignment to block argument' position:pos1 to:pos2.
+ ] ifFalse:[
+ DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+ parserFlags allowAssignmentToBlockArgument:true.
+ ParserFlags allowAssignmentToBlockArgument:true.
+ ex proceed.
+ ] do:[
+ self parseError:'assignment to block argument' position:pos1 to:pos2.
+ ].
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ assignmentAllowed := true. "/ if proceeded
+ ]
+ ] ifFalse:[ (t == #PoolVariable) ifTrue:[
+ self isDoIt ifTrue:[
+ self warning:'assignment to pool variable' position:pos1 to:pos2.
+ assignmentAllowed := true.
+ ] ifFalse:[
+ (assignmentAllowed := parserFlags allowAssignmentToPoolVariable) ifTrue:[
+ self warning:'assignment to pool variable' position:pos1 to:pos2.
+ ] ifFalse:[
+ DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+ parserFlags allowAssignmentToPoolVariable:true.
+ ParserFlags allowAssignmentToPoolVariable:true.
+ ex proceed.
+ ] do:[
+ self parseError:'assignment to pool variable' position:pos1 to:pos2.
+ ].
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ assignmentAllowed := true. "/ if proceeded
+ parseForCode ifFalse:[
+ self rememberPoolVarModified:var name
+ ]
+ ].
+ ]
+ ]]]]]]]
+ ].
].
lnr := tokenLineNr.
@@ -7384,30 +7367,30 @@
"/ does not what a beginner might think.
self isSyntaxHighlighter ifTrue:[
- (expr == #Error) ifTrue:[^ #Error].
+ (expr == #Error) ifTrue:[^ #Error].
] ifFalse:[
- parserFlags warnings ifTrue:[
- parserFlags 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:pos1 to:pos2.
- ].
- ].
- ].
-
- (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
- expr isVariable ifTrue:[
- expr name = var name ifTrue:[
- self warning:('useless assignment to "' , var name, '"' ) position:pos1 to:pos2-1.
- ].
- ].
+ parserFlags warnings ifTrue:[
+ parserFlags 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:pos1 to:pos2.
+ ].
+ ].
+ ].
+
+ (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
+ expr isVariable ifTrue:[
+ expr name = var name ifTrue:[
+ self warning:('useless assignment to "' , var name, '"' ) position:pos1 to:pos2-1.
+ ].
+ ].
].
assignmentAllowed ifTrue:[
- node := AssignmentNode variable:var expression:expr.
- parserFlags fullLineNumberInfo ifTrue:[node lineNumber:lnr].
- node := self assignmentRewriteHookFor:node.
+ node := AssignmentNode variable:var expression:expr.
+ parserFlags fullLineNumberInfo ifTrue:[node lineNumber:lnr].
+ node := self assignmentRewriteHookFor:node.
] ifFalse:[
- self parseError:('assignment to "' , var name, '" suppressed' ) position:pos1 to:pos2-1.
- node := expr.
+ self parseError:('assignment to "' , var name, '" suppressed' ) position:pos1 to:pos2-1.
+ node := expr.
].
^ node
@@ -7422,17 +7405,17 @@
pos := tokenPosition.
(tokenType == $: ) ifTrue:[
- self parseError:'lazyValues have no arguments' position:tokenPosition.
- ^ #Error
+ self parseError:'lazyValues have no arguments' position:tokenPosition.
+ ^ #Error
].
block := self blockBody:#().
self nextToken.
- expr := MessageNode
- receiver:(VariableNode globalNamed:#LazyValue)
- selector:#'block:'
- arg:block.
+ expr := MessageNode
+ receiver:(VariableNode globalNamed:#LazyValue)
+ selector:#'block:'
+ arg:block.
^ expr
!
@@ -7445,7 +7428,7 @@
self nextToken.
(self noAssignmentAllowed:'Assignment to ''nil'' would break Smalltalk' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
"/ self markConstantFrom:pos to:pos+2.
"/ JV@2011-07-19: Changed not to share the nodes
@@ -7453,7 +7436,7 @@
^ConstantNode type:#Nil value:nil from: pos to: pos + 2
"/ Old code
-"/ nilNode isNil ifTrue:[
+"/ nilNode isNil ifTrue:[
"/ nilNode := ConstantNode type:#Nil value:nil
"/ ].
"/ ^ nilNode
@@ -7471,7 +7454,7 @@
self nextToken.
(self noAssignmentAllowed:'Assignment to pseudo variable ''self''' at:pos) ifFalse:[
- ^ ParseError raiseErrorString:'Assignment to self'.
+ ^ ParseError raiseErrorString:'Assignment to self'.
].
self markSelfFrom:pos to:pos+3.
^ self selfNode startPosition: pos endPosition: pos + 3
@@ -7493,30 +7476,30 @@
"/
((tokenType == #String)
and:[(parserFlags stringsAreImmutable)]) ifTrue:[
- token := tokenValue := self makeImmutableString:tokenValue.
+ token := tokenValue := self makeImmutableString:tokenValue.
].
((tokenType == #Symbol) or:[tokenType == #ESSymbol]) ifTrue:[
- parseForCode ifFalse:[
- self rememberSymbolUsed:tokenValue
- ].
+ parseForCode ifFalse:[
+ self rememberSymbolUsed:tokenValue
+ ].
].
val := ConstantNode type: tokenType value:tokenValue
- from: pos to: pos2.
+ from: pos to: pos2.
((tokenType == #Symbol) or:[tokenType == #ESSymbol]) ifTrue:[
- self markSymbolFrom:tokenPosition to:tokenPosition+tokenValue size-1.
+ self markSymbolFrom:tokenPosition to:tokenPosition+tokenValue size-1.
] ifFalse:[
- tokenType == #String ifTrue:[
- self markStringFrom:pos to:source position1Based-1.
- ] ifFalse:[
- self markConstantFrom:pos to:source position1Based-1.
- ].
+ tokenType == #String ifTrue:[
+ self markStringFrom:pos to:source position1Based-1.
+ ] ifFalse:[
+ self markConstantFrom:pos to:source position1Based-1.
+ ].
].
self nextToken.
(self noAssignmentAllowed:'Assignment to a constant' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
^ val
@@ -7538,26 +7521,26 @@
(exprList == #Error) ifTrue:[ ^ #Error ].
tokenType ~~ $} ifTrue:[
- self parseError:'"." or "}" expected in computed array expression' position:tokenPosition.
- ^ #Error
+ self parseError:'"." or "}" expected in computed array expression' position:tokenPosition.
+ ^ #Error
].
pos2 := tokenPosition.
self nextToken.
(self noAssignmentAllowed:'Invalid assignment' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
"/ make it an array creation expression ...
^ (self genMakeArrayWith:exprList)
- startPosition: pos
- endPosition: pos2
+ startPosition: pos
+ endPosition: pos2
"
Compiler allowSqueakExtensions:true.
"
"
- { 1@2. 10 factorial. Date today }.
+ { 1@2. 10 factorial. Date today }.
"
"
@@ -7578,10 +7561,10 @@
usesSuper := true.
self nextToken.
(self noAssignmentAllowed:'Assignment to pseudo variable ''super''' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
(classToCompileFor isNil or:[classToCompileFor superclass isNil]) ifTrue:[
- self warning:'superclass is (currently ?) nil' position:pos to:(pos + 4).
+ self warning:'superclass is (currently ?) nil' position:pos to:(pos + 4).
].
"/ JV@2011-07-19: Changed not to share the nodes
"/ superNode isNil ifTrue:[
@@ -7592,7 +7575,7 @@
"/ JV@2011-07-19: Changed not to share the nodes
"/ ^ superNode
^ (SuperNode value:selfValue inClass:classToCompileFor)
- startPosition: pos endPosition: pos + 4
+ startPosition: pos endPosition: pos + 4
"Modified: / 19-07-2011 / 18:12:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 26-07-2012 / 11:37:58 / cg"
@@ -7601,17 +7584,17 @@
primary_thisContext
"parse a thisContext primary; return a node-tree, or raise an Error."
- |pos|
+ |pos|
pos := tokenPosition.
self nextToken.
(self noAssignmentAllowed:'Assignment to pseudo variable ''thisContext''' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
self markIdentifierFrom:pos to:pos+10.
^ (VariableNode type:#ThisContext context:contextToEvaluateIn "often nil")
- startPosition: pos endPosition: pos + 10
+ startPosition: pos endPosition: pos + 10
"Modified: / 19-07-2011 / 18:14:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 26-07-2012 / 11:38:01 / cg"
@@ -7626,7 +7609,7 @@
self nextToken.
(self noAssignmentAllowed:'Assignment to ''true'' would break Smalltalk' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
self markBooleanConstantFrom:pos to:pos+3.
^ ConstantNode type:#True value:true from:pos to:pos+3
@@ -7644,37 +7627,37 @@
elements := OrderedCollection new.
[ tokenType ~~ $} ] whileTrue:[
- (tokenType == #Identifier) ifFalse:[
- self syntaxError:'Bad qualifiedName; Identifier expected'
- position:pos1 to:tokenPosition
- ].
- elem := tokenName.
- elements add:elem.
-
- self nextToken.
- tokenType = $} ifTrue:[
- ] ifFalse:[
- tokenType == #'::' ifTrue:[
- "/ notice that Foo.Bar has already been scanned as Foo::Bar
- "/ (which is a kludge)
- self nextToken.
- ] ifFalse:[
- self syntaxError:'bad qualifiedName syntax; ''.'' or ''}'' expected (got ',tokenType,')'
- position:pos1 to:tokenPosition.
- ].
- ].
+ (tokenType == #Identifier) ifFalse:[
+ self syntaxError:'Bad qualifiedName; Identifier expected'
+ position:pos1 to:tokenPosition
+ ].
+ elem := tokenName.
+ elements add:elem.
+
+ self nextToken.
+ tokenType = $} ifTrue:[
+ ] ifFalse:[
+ tokenType == #'::' ifTrue:[
+ "/ notice that Foo.Bar has already been scanned as Foo::Bar
+ "/ (which is a kludge)
+ self nextToken.
+ ] ifFalse:[
+ self syntaxError:'bad qualifiedName syntax; ''.'' or ''}'' expected (got ',tokenType,')'
+ position:pos1 to:tokenPosition.
+ ].
+ ].
"/ elem := self variable.
"/ (elem == #Error) ifTrue:[
"/ (tokenType == #EOF) ifTrue:[
-"/ self syntaxError:'unterminated qualifiedName; ''}'' expected'
+"/ self syntaxError:'unterminated qualifiedName; ''}'' expected'
"/ position:pos1 to:tokenPosition
"/ ].
"/ ^ #Error
"/ ].
"/ errorFlag := false.
"/ (elem isVariable and:[elem isGlobal]) ifFalse:[
-"/ self warning:'elements of a qualifiedName should be globalIdentifiers'
+"/ self warning:'elements of a qualifiedName should be globalIdentifiers'
"/ position:pos1 to:tokenPosition
"/ ].
"/ elements add:elem.
@@ -7686,7 +7669,7 @@
"/ self nextToken.
"/ ] ifFalse:[
"/ tokenType ~~ $} ifTrue:[
-"/ self syntaxError:'bad qualifiedName syntax; ''.'' or ''}'' expected'
+"/ self syntaxError:'bad qualifiedName syntax; ''.'' or ''}'' expected'
"/ position:pos1 to:tokenPosition.
"/ ^ #Error
"/ ].
@@ -7696,10 +7679,10 @@
self nextToken.
parserFlags flattenVisualWorksNamespaces ifTrue:[
- "/ temporary kludge when loading VW UIBuilder code...
- ( #('UI' 'Core' 'Graphics') includes:elements first) ifTrue:[
- elements := elements copyFrom:2.
- ].
+ "/ temporary kludge when loading VW UIBuilder code...
+ ( #('UI' 'Core' 'Graphics') includes:elements first) ifTrue:[
+ elements := elements copyFrom:2.
+ ].
].
nm := (elements asStringWith:'::') asSymbol.
@@ -7724,7 +7707,7 @@
self nextToken.
(tokenType == #Keyword) ifTrue:[
- ^ self inlineObjectFrom:pos1.
+ ^ self inlineObjectFrom:pos1.
].
^ self qualifiedNameFrom:pos1
!
@@ -7733,28 +7716,28 @@
|expressions elem pos1|
tokenType == $} ifTrue:[
- ^ #()
+ ^ #()
].
pos1 := tokenPosition.
expressions := OrderedCollection new:20.
[true] whileTrue:[
- elem := self expression.
- (elem == #Error) ifTrue:[
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'unterminated computed-array-element; ''}'' expected'
- position:pos1 to:tokenPosition
- ].
- ^ #Error
- ].
- expressions add:elem.
- tokenType == $. ifFalse:[
- ^ expressions
- ].
- self nextToken.
- tokenType == $} ifTrue:[
- ^ expressions
- ].
+ elem := self expression.
+ (elem == #Error) ifTrue:[
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'unterminated computed-array-element; ''}'' expected'
+ position:pos1 to:tokenPosition
+ ].
+ ^ #Error
+ ].
+ expressions add:elem.
+ tokenType == $. ifFalse:[
+ ^ expressions
+ ].
+ self nextToken.
+ tokenType == $} ifTrue:[
+ ^ expressions
+ ].
].
"/ not reached
!
@@ -7778,59 +7761,59 @@
(receiver == #Error) ifTrue:[^ #Error].
[ self isValidUnarySelector:tokenType ] whileTrue:[
- pos := tokenPosition.
- pos2 := pos + tokenName size - 1.
- lNr := tokenLineNr.
- sel := tokenName.
-
- self markSelector:sel from:pos to:pos2 receiverNode:receiver.
-
- self nextToken.
- tokenType == $( ifTrue:[
- parserFlags allowSqueakExtensions == true ifTrue:[
- "/ croquet/squeak extension - c/java-style arguments
- arguments := self functionCallArgList.
- (arguments == #Error) ifTrue:[^ #Error].
- "/ synthetic selector: foo[:[with:[with:[...]]]]
- arguments notEmpty ifTrue:[
- sel := sel , ':'.
- arguments size - 1 timesRepeat:[ sel := sel , 'with:' ].
- ].
- sel := self selectorCheck:sel for:receiver position:pos to:pos2.
- expr := MessageNode receiver:receiver selector:sel args:arguments fold:foldConstants.
- expr isErrorNode ifTrue:[
- self parseError:(expr errorString) position:pos to:pos2.
- errorFlag := false. "ok, user wants it - so he'll get it"
- expr := MessageNode receiver:receiver selector:sel args:arguments fold:nil.
- ].
- expr lineNumber:lNr.
-
- self checkPlausibilityOf:expr from:pos to:pos2.
- parseForCode ifFalse:[
- self rememberSelectorUsed:sel receiver:receiver
- ].
- ^ expr.
- ].
- ].
-
- sel := self selectorCheck:sel for:receiver position:pos to:pos2.
- expr := UnaryNode receiver:receiver selector:sel fold:foldConstants.
- expr startPosition: receiver startPosition endPosition: pos2.
- expr isErrorNode ifTrue:[
- self warning:(expr errorString , '.\\If you proceed, that error will happen at runtime.') withCRs position:pos to:pos2.
- errorFlag := false. "ok, user wants it - so he'll get it"
- expr := UnaryNode receiver:receiver selector:sel fold:nil.
- expr startPosition: receiver startPosition endPosition: pos2.
- ].
- expr lineNumber:lNr.
-
- self checkPlausibilityOf:expr from:pos to:pos2.
- parseForCode ifFalse:[
- self rememberSelectorUsed:sel receiver:receiver
- ].
-
- expr := self messageNodeRewriteHookFor:expr.
- receiver := expr. "/ for next message
+ pos := tokenPosition.
+ pos2 := pos + tokenName size - 1.
+ lNr := tokenLineNr.
+ sel := tokenName.
+
+ self markSelector:sel from:pos to:pos2 receiverNode:receiver.
+
+ self nextToken.
+ tokenType == $( ifTrue:[
+ parserFlags allowSqueakExtensions == true ifTrue:[
+ "/ croquet/squeak extension - c/java-style arguments
+ arguments := self functionCallArgList.
+ (arguments == #Error) ifTrue:[^ #Error].
+ "/ synthetic selector: foo[:[with:[with:[...]]]]
+ arguments notEmpty ifTrue:[
+ sel := sel , ':'.
+ arguments size - 1 timesRepeat:[ sel := sel , 'with:' ].
+ ].
+ sel := self selectorCheck:sel for:receiver position:pos to:pos2.
+ expr := MessageNode receiver:receiver selector:sel args:arguments fold:foldConstants.
+ expr isErrorNode ifTrue:[
+ self parseError:(expr errorString) position:pos to:pos2.
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ expr := MessageNode receiver:receiver selector:sel args:arguments fold:nil.
+ ].
+ expr lineNumber:lNr.
+
+ self checkPlausibilityOf:expr from:pos to:pos2.
+ parseForCode ifFalse:[
+ self rememberSelectorUsed:sel receiver:receiver
+ ].
+ ^ expr.
+ ].
+ ].
+
+ sel := self selectorCheck:sel for:receiver position:pos to:pos2.
+ expr := UnaryNode receiver:receiver selector:sel fold:foldConstants.
+ expr startPosition: receiver startPosition endPosition: pos2.
+ expr isErrorNode ifTrue:[
+ self warning:(expr errorString , '.\\If you proceed, that error will happen at runtime.') withCRs position:pos to:pos2.
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ expr := UnaryNode receiver:receiver selector:sel fold:nil.
+ expr startPosition: receiver startPosition endPosition: pos2.
+ ].
+ expr lineNumber:lNr.
+
+ self checkPlausibilityOf:expr from:pos to:pos2.
+ parseForCode ifFalse:[
+ self rememberSelectorUsed:sel receiver:receiver
+ ].
+
+ expr := self messageNodeRewriteHookFor:expr.
+ receiver := expr. "/ for next message
].
^ receiver
@@ -7839,7 +7822,7 @@
!
variable
- "parse a simple (i.e. non-namespace-access path) variable;
+ "parse a simple (i.e. non-namespace-access path) variable;
return a node-tree, nil or #Error.
Does not advance to next token.
If undefined, notify error and correct if user wants to"
@@ -7848,10 +7831,10 @@
v := self variableOrError:tokenName.
(v ~~ #Error) ifTrue:[
- (v isMemberOf:VariableNode) ifTrue:[
- self markVariable:v.
- ].
- ^ v
+ (v isMemberOf:VariableNode) ifTrue:[
+ self markVariable:v.
+ ].
+ ^ v
].
pos1 := tokenPosition.
@@ -7859,37 +7842,37 @@
self markUnknownIdentifierFrom:pos1 to:pos2.
parseForCode ifTrue:[
- allowUndeclaredVariables ifFalse:[
- self
- parseError:'Parser [error]: undeclared variable: ',tokenName
- position:pos1 to:pos2.
- ].
- v := self correctVariable:tokenName atPosition:pos1 to:pos2.
- (v ~~ #Error) ifTrue:[^ v].
-
- self errorFlag:true.
-
- tokenName first isLowercase ifTrue:[
- parserFlags implicitSelfSends ifTrue:[
- ^ UnaryNode receiver:(self selfNode) selector:('__' , tokenName) asSymbol.
- ].
- ^ #Error
- ]
+ allowUndeclaredVariables ifFalse:[
+ self
+ parseError:'Parser [error]: undeclared variable: ',tokenName
+ position:pos1 to:pos2.
+ ].
+ v := self correctVariable:tokenName atPosition:pos1 to:pos2.
+ (v ~~ #Error) ifTrue:[^ v].
+
+ self errorFlag:true.
+
+ tokenName first isLowercase ifTrue:[
+ parserFlags implicitSelfSends ifTrue:[
+ ^ UnaryNode receiver:(self selfNode) selector:('__' , tokenName) asSymbol.
+ ].
+ ^ #Error
+ ]
] ifFalse:[
- self rememberGlobalUsed:(Smalltalk undeclaredPrefix) , tokenName.
- self rememberGlobalUsed:tokenName.
+ self rememberGlobalUsed:(Smalltalk undeclaredPrefix) , tokenName.
+ self rememberGlobalUsed:tokenName.
].
"/ self markGlobalIdentifierFrom:pos1 to:pos2.
- ^ (VariableNode globalNamed:tokenName)
- startPosition: pos1 endPosition: (pos1 + tokenName size - 1)
+ ^ (VariableNode globalNamed:tokenName)
+ startPosition: pos1 endPosition: (pos1 + tokenName size - 1)
"Modified: / 25-08-2011 / 11:57:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-09-2011 / 07:34:57 / cg"
!
variableOrError
- "parse a simple (i.e. non-namespace-access path) variable;
+ "parse a simple (i.e. non-namespace-access path) variable;
return a node-tree, nil or #Error.
Does not advance to next token."
@@ -7897,164 +7880,164 @@
!
variableOrError:varName
- "parse a simple (i.e. non-namespace-access path) variable;
+ "parse a simple (i.e. non-namespace-access path) variable;
return a node-tree, nil or #Error.
Does not advance to next token."
- |varIndex aClass searchBlock args vars
+ |varIndex aClass searchBlock args vars
tokenSymbol space classVarIndex holder node
checkSharedPoolAction|
checkSharedPoolAction :=
- [:eachPoolName |
- |sharedPool|
-
- sharedPool := Smalltalk classNamed:eachPoolName.
- sharedPool isNil ifTrue:[
- Transcript showCR:'No such pool: ' , eachPoolName.
- "/ self warning:('No such pool: ' , eachPoolName).
- ] ifFalse:[
- (sharedPool includesKey:varName) ifTrue:[
- parseForCode ifFalse:[self rememberGlobalUsed:(sharedPool name , ':' , varName)].
- ^ (VariableNode type:#PoolVariable class:sharedPool name:varName)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ].
- ].
- ].
+ [:eachPoolName |
+ |sharedPool|
+
+ sharedPool := Smalltalk classNamed:eachPoolName.
+ sharedPool isNil ifTrue:[
+ Transcript showCR:'No such pool: ' , eachPoolName.
+ "/ self warning:('No such pool: ' , eachPoolName).
+ ] ifFalse:[
+ (sharedPool includesKey:varName) ifTrue:[
+ parseForCode ifFalse:[self rememberGlobalUsed:(sharedPool name , ':' , varName)].
+ ^ (VariableNode type:#PoolVariable class:sharedPool name:varName)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ].
+ ].
+ ].
"is it a block-arg or block-var ?"
searchBlock := currentBlock.
[searchBlock notNil] whileTrue:[
- vars := searchBlock variables.
- vars notNil ifTrue:[
- varIndex := vars findFirst:[:aBlockVar | aBlockVar name = varName].
- varIndex ~~ 0 ifTrue:[
- ^ (VariableNode type:#BlockVariable
- name:varName
- token:(vars at:varIndex)
- index:varIndex
- block:searchBlock
- from:currentBlock)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ].
- ].
-
- args := searchBlock arguments.
- args notNil ifTrue:[
- varIndex := args findFirst:[:aBlockArg | aBlockArg name = varName].
- varIndex ~~ 0 ifTrue:[
- ^ (VariableNode type:#BlockArg
- name:varName
- token:(args at:varIndex)
- index:varIndex
- block:searchBlock
- from:currentBlock)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ].
-
- ].
-
- searchBlock := searchBlock home
+ vars := searchBlock variables.
+ vars notNil ifTrue:[
+ varIndex := vars findFirst:[:aBlockVar | aBlockVar name = varName].
+ varIndex ~~ 0 ifTrue:[
+ ^ (VariableNode type:#BlockVariable
+ name:varName
+ token:(vars at:varIndex)
+ index:varIndex
+ block:searchBlock
+ from:currentBlock)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ].
+ ].
+
+ args := searchBlock arguments.
+ args notNil ifTrue:[
+ varIndex := args findFirst:[:aBlockArg | aBlockArg name = varName].
+ varIndex ~~ 0 ifTrue:[
+ ^ (VariableNode type:#BlockArg
+ name:varName
+ token:(args at:varIndex)
+ index:varIndex
+ block:searchBlock
+ from:currentBlock)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ].
+
+ ].
+
+ searchBlock := searchBlock home
].
"is it a method-variable ?"
(node := self nodeForMethodVariable:varName) notNil
ifTrue:[
- ^ node
+ ^ node
].
"is it a method-argument ?"
(node := self nodeForMethodArg:varName) notNil
ifTrue:[
- ^ node
+ ^ node
].
contextToEvaluateIn notNil ifTrue:[
- |con varNames|
-
- "/
- "/ search names of the context.
- "/
- con := contextToEvaluateIn.
- [con notNil] whileTrue:[
- varNames := con argAndVarNames.
- varNames size > 0 ifTrue:[
- varIndex := varNames lastIndexOf:varName.
- varIndex ~~ 0 ifTrue:[
- ^ (VariableNode type:#ContextVariable
- name:varName
- context:con
- index:varIndex)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ].
- ].
- con := con home.
- ].
+ |con varNames|
+
+ "/
+ "/ search names of the context.
+ "/
+ con := contextToEvaluateIn.
+ [con notNil] whileTrue:[
+ varNames := con argAndVarNames.
+ varNames size > 0 ifTrue:[
+ varIndex := varNames lastIndexOf:varName.
+ varIndex ~~ 0 ifTrue:[
+ ^ (VariableNode type:#ContextVariable
+ name:varName
+ context:con
+ index:varIndex)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ].
+ ].
+ con := con home.
+ ].
].
classToCompileFor notNil ifTrue:[
- "is it an instance-variable ?"
-
- varIndex := (self classesInstVarNames) lastIndexOf:varName.
- varIndex ~~ 0 ifTrue:[
- classToCompileFor isMeta ifTrue:[
- classVarIndex := (self classesClassVarNames) lastIndexOf:varName.
- classVarIndex ~~ 0 ifTrue:[
-
- "/ give a warning - that maybe a common error
- alreadyWarnedClassInstVarRefs isNil ifTrue:[
- alreadyWarnedClassInstVarRefs := Set new
- ].
- (alreadyWarnedClassInstVarRefs includes:varName) ifFalse:[
- self warning:('there is both a class variable and a class-instance variable named "%1" (in %2).\\Refering to the class-instance variable here.' withCRs
- bindWith:varName with:(self whichClassIncludesClassVar:varName) name).
- alreadyWarnedClassInstVarRefs add:varName.
- ].
- ].
- ].
- parseForCode ifFalse:[self rememberInstVarUsed:varName].
- ^ (VariableNode
- type:#InstanceVariable
- name:varName
- index:varIndex
- selfValue:selfValue)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ].
-
- "/ see if there is a corresponding classVar (for the warning)
- classVarIndex := (self classesClassVarNames) lastIndexOf:varName.
-
- "/ "is it a class-instance-variable ?"
- "/
- "/ Notice:
- "/ it is no longer allowed to fetch class-instance variables
- "/ from instance methods ...
- "/ (used to be in previous ST/X versions)
- "/
- varIndex := (self classesClassInstVarNames) lastIndexOf:varName.
- varIndex ~~ 0 ifTrue:[
- aClass := self inWhichClassIsClassInstVar:varName.
- aClass notNil ifTrue:[
- classToCompileFor isMeta ifFalse:[
- classVarIndex == 0 ifTrue:[
- "/ there is no corresponding classVar;
- "/ wants to access classInstVar ?
- contextToEvaluateIn notNil ifTrue:[
- "/ allow it in a doIt ...
-
- ^ (VariableNode type:#ClassInstanceVariable
- name:varName
- index:varIndex
- selfClass:aClass)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ].
- self parseError:'access to class-inst-var from inst method is not allowed'.
- ^ #Error.
- ] ifFalse:[
- "/ give a warning - that maybe a common error
- self warning:('there is both a class variable and a class-instance variable named ''' , varName , '''.\\Refering to the class variable here (instMethods dont see classInstVars).') withCRs.
- ]
- ].
+ "is it an instance-variable ?"
+
+ varIndex := (self classesInstVarNames) lastIndexOf:varName.
+ varIndex ~~ 0 ifTrue:[
+ classToCompileFor isMeta ifTrue:[
+ classVarIndex := (self classesClassVarNames) lastIndexOf:varName.
+ classVarIndex ~~ 0 ifTrue:[
+
+ "/ give a warning - that maybe a common error
+ alreadyWarnedClassInstVarRefs isNil ifTrue:[
+ alreadyWarnedClassInstVarRefs := Set new
+ ].
+ (alreadyWarnedClassInstVarRefs includes:varName) ifFalse:[
+ self warning:('there is both a class variable and a class-instance variable named "%1" (in %2).\\Refering to the class-instance variable here.' withCRs
+ bindWith:varName with:(self whichClassIncludesClassVar:varName) name).
+ alreadyWarnedClassInstVarRefs add:varName.
+ ].
+ ].
+ ].
+ parseForCode ifFalse:[self rememberInstVarUsed:varName].
+ ^ (VariableNode
+ type:#InstanceVariable
+ name:varName
+ index:varIndex
+ selfValue:selfValue)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ].
+
+ "/ see if there is a corresponding classVar (for the warning)
+ classVarIndex := (self classesClassVarNames) lastIndexOf:varName.
+
+ "/ "is it a class-instance-variable ?"
+ "/
+ "/ Notice:
+ "/ it is no longer allowed to fetch class-instance variables
+ "/ from instance methods ...
+ "/ (used to be in previous ST/X versions)
+ "/
+ varIndex := (self classesClassInstVarNames) lastIndexOf:varName.
+ varIndex ~~ 0 ifTrue:[
+ aClass := self inWhichClassIsClassInstVar:varName.
+ aClass notNil ifTrue:[
+ classToCompileFor isMeta ifFalse:[
+ classVarIndex == 0 ifTrue:[
+ "/ there is no corresponding classVar;
+ "/ wants to access classInstVar ?
+ contextToEvaluateIn notNil ifTrue:[
+ "/ allow it in a doIt ...
+
+ ^ (VariableNode type:#ClassInstanceVariable
+ name:varName
+ index:varIndex
+ selfClass:aClass)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ].
+ self parseError:'access to class-inst-var from inst method is not allowed'.
+ ^ #Error.
+ ] ifFalse:[
+ "/ give a warning - that maybe a common error
+ self warning:('there is both a class variable and a class-instance variable named ''' , varName , '''.\\Refering to the class variable here (instMethods dont see classInstVars).') withCRs.
+ ]
+ ].
"/ OLD CODE:
"/ self warning:'access to class-inst-var from inst method will soon be no longer supported'.
@@ -8065,102 +8048,102 @@
"/ index:varIndex
"/ selfClass:aClass
"/ ].
- ] ifFalse:[
- "/ self halt:'oops - should not happen'.
- ]
- ].
-
- "is it a class-variable ?"
-
- varIndex := classVarIndex.
- varIndex ~~ 0 ifTrue:[
- aClass := self inWhichClassIsClassVar:varName.
- aClass notNil ifTrue:[
- parseForCode ifFalse:[self rememberClassVarUsed:varName].
- ^ (VariableNode type:#ClassVariable class:aClass name:varName)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ].
- "/ self halt:'oops - should not happen'.
- ].
-
- "is it a private-class ?"
-
- aClass := self classToLookForClassVars.
- aClass := aClass theNonMetaclass.
- aClass isLoaded ifTrue:[
- (aClass privateClassesAt:varName) notNil ifTrue:[
- parseForCode ifFalse:[self rememberGlobalUsed:(aClass name , '::' , varName)].
- ^ (VariableNode type:#PrivateClass class:aClass name:varName)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ].
- ].
-
- " is it a pool-variable ?"
- classToCompileFor theNonMetaclass realSharedPoolNames do:checkSharedPoolAction.
+ ] ifFalse:[
+ "/ self halt:'oops - should not happen'.
+ ]
+ ].
+
+ "is it a class-variable ?"
+
+ varIndex := classVarIndex.
+ varIndex ~~ 0 ifTrue:[
+ aClass := self inWhichClassIsClassVar:varName.
+ aClass notNil ifTrue:[
+ parseForCode ifFalse:[self rememberClassVarUsed:varName].
+ ^ (VariableNode type:#ClassVariable class:aClass name:varName)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ].
+ "/ self halt:'oops - should not happen'.
+ ].
+
+ "is it a private-class ?"
+
+ aClass := self classToLookForClassVars.
+ aClass := aClass theNonMetaclass.
+ aClass isLoaded ifTrue:[
+ (aClass privateClassesAt:varName) notNil ifTrue:[
+ parseForCode ifFalse:[self rememberGlobalUsed:(aClass name , '::' , varName)].
+ ^ (VariableNode type:#PrivateClass class:aClass name:varName)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ].
+ ].
+
+ " is it a pool-variable ?"
+ classToCompileFor theNonMetaclass realSharedPoolNames do:checkSharedPoolAction.
].
(self isDoIt) ifTrue:[
- moreSharedPools notNil ifTrue:[
- moreSharedPools do:checkSharedPoolAction.
- ].
+ moreSharedPools notNil ifTrue:[
+ moreSharedPools do:checkSharedPoolAction.
+ ].
].
"is it in a namespace ?"
space := self findNameSpaceWith:varName.
space notNil ifTrue:[
- space ~~ Smalltalk ifTrue:[
- parseForCode ifFalse:[self rememberGlobalUsed:(space name , '::' , varName)].
- space isNameSpace ifTrue:[
- ^ (VariableNode globalNamed:(space name , '::' , varName))
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ].
- ^ (VariableNode type:#PrivateClass class:space name:varName)
- startPosition: tokenPosition endPosition: tokenPosition + varName size -1
- ].
- parseForCode ifFalse:[self rememberGlobalUsed:varName].
- ^ (VariableNode globalNamed:varName) startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ space ~~ Smalltalk ifTrue:[
+ parseForCode ifFalse:[self rememberGlobalUsed:(space name , '::' , varName)].
+ space isNameSpace ifTrue:[
+ ^ (VariableNode globalNamed:(space name , '::' , varName))
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ].
+ ^ (VariableNode type:#PrivateClass class:space name:varName)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size -1
+ ].
+ parseForCode ifFalse:[self rememberGlobalUsed:varName].
+ ^ (VariableNode globalNamed:varName) startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
].
"is it a global-variable ?"
tokenSymbol := varName asSymbolIfInterned.
tokenSymbol notNil ifTrue:[
- (Smalltalk includesKey:tokenSymbol) ifTrue:[
- parseForCode ifFalse:[self rememberGlobalUsed:varName].
- ^ (VariableNode globalNamed:tokenSymbol) startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ]
+ (Smalltalk includesKey:tokenSymbol) ifTrue:[
+ parseForCode ifFalse:[self rememberGlobalUsed:varName].
+ ^ (VariableNode globalNamed:tokenSymbol) startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ]
].
"is it a workspace variable ?"
(requestor notNil and:[requestor isStream not]) ifTrue:[
- "/ when parsing doits, this is done twice;
- "/ first, for the parse, then as a block-code
- "/ for the code.
- "/ We only care for WorkspaceVars in doIts
- (self isDoIt) ifTrue:[
- (Workspace notNil
- and:[(holder := Workspace workspaceVariableAt:varName) notNil])
- ifTrue:[
- ^ (VariableNode type:#WorkspaceVariable holder:holder name:varName)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ]
- ]
+ "/ when parsing doits, this is done twice;
+ "/ first, for the parse, then as a block-code
+ "/ for the code.
+ "/ We only care for WorkspaceVars in doIts
+ (self isDoIt) ifTrue:[
+ (Workspace notNil
+ and:[(holder := Workspace workspaceVariableAt:varName) notNil])
+ ifTrue:[
+ ^ (VariableNode type:#WorkspaceVariable holder:holder name:varName)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ]
+ ]
].
"is it a doIt variable ?"
"/ (requestor notNil and:[requestor isStream not]) ifTrue:[
- "/ when parsing doits, this is done twice;
- "/ first, for the parse, then as a block-code
- "/ for the code.
- "/ We only care for WorkspaceVars in doIts
-
- (self isDoIt) ifTrue:[
- (doItTemporaries notNil
- and:[(holder := doItTemporaries at:varName asSymbol ifAbsent:nil) notNil])
- ifTrue:[
- ^ (VariableNode type:#DoItTemporary holder:holder name:varName)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
- ]
- ].
+ "/ when parsing doits, this is done twice;
+ "/ first, for the parse, then as a block-code
+ "/ for the code.
+ "/ We only care for WorkspaceVars in doIts
+
+ (self isDoIt) ifTrue:[
+ (doItTemporaries notNil
+ and:[(holder := doItTemporaries at:varName asSymbol ifAbsent:nil) notNil])
+ ifTrue:[
+ ^ (VariableNode type:#DoItTemporary holder:holder name:varName)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ ]
+ ].
"/ ].
^ #Error
@@ -8173,10 +8156,10 @@
checkForClosingAngle
((tokenType == #BinaryOperator) and:[tokenName = '>']) ifTrue:[
- self nextToken.
+ self nextToken.
] ifFalse:[
- self parseError:'bad primitive definition (''>'' expected)'.
- self skipForClosingAngle.
+ self parseError:'bad primitive definition (''>'' expected)'.
+ self skipForClosingAngle.
]
!
@@ -8196,49 +8179,49 @@
|args sel node|
fn argumentTypes size ~~ (methodArgNames size
- "the following stuff was commented (2007-07-30), to make ole: work.
- Ask felix or stefan"
- " + (fn isCPPFunction ifTrue:1 ifFalse:0)") ifTrue:[
- self
- ignorableParseError:('Number of method args (%1) does not match function arg list (ST/V api call)'
- bindWith: methodArgNames size).
+ "the following stuff was commented (2007-07-30), to make ole: work.
+ Ask felix or stefan"
+ " + (fn isCPPFunction ifTrue:1 ifFalse:0)") ifTrue:[
+ self
+ ignorableParseError:('Number of method args (%1) does not match function arg list (ST/V api call)'
+ bindWith: methodArgNames size).
].
args := (methodArgNames ? #()) collect:[:eachArgName | self nodeForMethodArg:eachArgName].
fn isVirtualCPP ifTrue:[
- sel := #(
- invokeCPPVirtualOn:
- invokeCPPVirtualOn:with:
- invokeCPPVirtualOn:with:with:
- invokeCPPVirtualOn:with:with:with:
- ) at:args size+1 ifAbsent:nil.
- sel isNil ifTrue:[
- args := Array with:(self selfNode) with:(self genMakeArrayWith:args).
- sel := #invokeCPPVirtualOn:withArguments:.
- ] ifFalse:[
- args := (Array with:(self selfNode)) , args.
- ].
+ sel := #(
+ invokeCPPVirtualOn:
+ invokeCPPVirtualOn:with:
+ invokeCPPVirtualOn:with:with:
+ invokeCPPVirtualOn:with:with:with:
+ ) at:args size+1 ifAbsent:nil.
+ sel isNil ifTrue:[
+ args := Array with:(self selfNode) with:(self genMakeArrayWith:args).
+ sel := #invokeCPPVirtualOn:withArguments:.
+ ] ifFalse:[
+ args := (Array with:(self selfNode)) , args.
+ ].
] ifFalse:[
- fn isNonVirtualCPP ifTrue:[
- args := (Array with:(self selfNode)) , args
- ].
- sel := #(
- invoke
- invokeWith:
- invokeWith:with:
- invokeWith:with:with:
- ) at:args size+1 ifAbsent:nil.
- sel isNil ifTrue:[
- args := Array with:(self genMakeArrayWith:args).
- sel := #invokeWithArguments:.
- ].
- ].
-
- node := MessageNode
- receiver:(ConstantNode type:nil value:fn)
- selector:sel
- args:args
- fold:false.
+ fn isNonVirtualCPP ifTrue:[
+ args := (Array with:(self selfNode)) , args
+ ].
+ sel := #(
+ invoke
+ invokeWith:
+ invokeWith:with:
+ invokeWith:with:with:
+ ) at:args size+1 ifAbsent:nil.
+ sel isNil ifTrue:[
+ args := Array with:(self genMakeArrayWith:args).
+ sel := #invokeWithArguments:.
+ ].
+ ].
+
+ node := MessageNode
+ receiver:(ConstantNode type:nil value:fn)
+ selector:sel
+ args:args
+ fold:false.
node lineNumber:lineNr.
tree := ReturnNode expression:node.
tree lineNumber:lineNr.
@@ -8278,38 +8261,38 @@
|value|
(((tokenType == #String) or: [(tokenType == #Integer)] or: [(tokenType == #True)] or: [(tokenType == #False)] or: [(tokenType == #Nil)])
- or: [(tokenType == #Symbol)] or:[(tokenType == #Character)]) ifTrue: [
- value := tokenValue.
- self nextToken.
- ^ value.
+ or: [(tokenType == #Symbol)] or:[(tokenType == #Character)]) ifTrue: [
+ value := tokenValue.
+ self nextToken.
+ ^ value.
].
(tokenType == #Identifier) ifTrue:[
- value := tokenName asSymbol.
- self nextToken.
- ^ value.
+ value := tokenName asSymbol.
+ self nextToken.
+ ^ value.
].
"
(tokenType == #Keyword) ifTrue: [
- value := '#', tokenName.
- self nextToken.
- ^ value.
+ value := '#', tokenName.
+ self nextToken.
+ ^ value.
].
"
((tokenType == $() or:[tokenType == #HashLeftParen]) ifTrue:[
- self nextToken.
- value := self array.
- self nextToken.
- ^ value.
+ self nextToken.
+ value := self array.
+ self nextToken.
+ ^ value.
].
((tokenType == $[) or:[tokenType == #HashLeftBrack]) ifTrue:[
- self nextToken.
- value := self byteArray.
- self nextToken.
- ^value.
+ self nextToken.
+ value := self byteArray.
+ self nextToken.
+ ^value.
].
^ #Error
@@ -8319,36 +8302,36 @@
!
parseExceptionOrContextPragma
- "parse
- <exception: #handle|raise|unwind>,
- <context: #return>
+ "parse
+ <exception: #handle|raise|unwind>,
+ <context: #return>
context flagging pragmas."
-
+
|pragmaType|
"/ notice: '<' has already been parsed.
pragmaType := tokenName.
self nextToken.
(tokenType ~~ #Symbol) ifTrue:[
- self parseError:'symbol expected'.
- ^ #Error
+ self parseError:'symbol expected'.
+ ^ #Error
].
(pragmaType = 'context:') ifTrue:[
- (tokenValue == #return) ifTrue:[
- self rememberContextReturnablePragma
- ] ifFalse:[
- self parseError:'unrecognized context pragma: ' , tokenValue.
- ].
+ (tokenValue == #return) ifTrue:[
+ self rememberContextReturnablePragma
+ ] ifFalse:[
+ self parseError:'unrecognized context pragma: ' , tokenValue.
+ ].
].
(pragmaType = 'exception:') ifTrue:[
- (tokenValue == #handle
- or:[ tokenValue == #raise
- or:[ tokenValue == #unwind ]]) ifTrue:[
- self rememberContextPragma:pragmaType value:tokenValue
- ] ifFalse:[
- self parseError:'unrecognized exception pragma: ' , tokenValue.
- ].
+ (tokenValue == #handle
+ or:[ tokenValue == #raise
+ or:[ tokenValue == #unwind ]]) ifTrue:[
+ self rememberContextPragma:pragmaType value:tokenValue
+ ] ifFalse:[
+ self parseError:'unrecognized exception pragma: ' , tokenValue.
+ ].
].
annotations := annotations copyWith:{ pragmaType asSymbol . { tokenValue }}.
@@ -8368,70 +8351,70 @@
cString := source upTo:$>.
self nextToken.
parseForCode ifFalse:[
- ^ -1
+ ^ -1
].
CParser notNil ifTrue:[
- dictionaryOfKnownTypes := Dictionary new.
-
- "/ a few wellknown types
-
- self defineWellknownCTypesIn:dictionaryOfKnownTypes.
-
- "/ collect existing types...
-
- classToCompileFor
- methodsDo:[:m |
- m
- literalsDo:[:lit |
- (lit isKindOf:CType) ifTrue:[
- self assert:lit name notNil.
- dictionaryOfKnownTypes at:lit name put:lit.
- ].
- ].
- ].
+ dictionaryOfKnownTypes := Dictionary new.
+
+ "/ a few wellknown types
+
+ self defineWellknownCTypesIn:dictionaryOfKnownTypes.
+
+ "/ collect existing types...
+
+ classToCompileFor
+ methodsDo:[:m |
+ m
+ literalsDo:[:lit |
+ (lit isKindOf:CType) ifTrue:[
+ self assert:lit name notNil.
+ dictionaryOfKnownTypes at:lit name put:lit.
+ ].
+ ].
+ ].
].
cStream := cString readStream.
(#( 'apicall:' 'cdecl:' 'stdcall:' 'virtual' ) includes:callType) ifTrue:[
- "/ squeak/dolphin/stx external function definition
- annotations := annotations
- copyWith:(Array with:callType asSymbol with:cString).
- self
- parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:cStream
- definitionType:callType
- knownDefinitions:dictionaryOfKnownTypes
- lineNr:lineNr.
- ^ -1
+ "/ squeak/dolphin/stx external function definition
+ annotations := annotations
+ copyWith:(Array with:callType asSymbol with:cString).
+ self
+ parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
+ ^ -1
].
callType = 'c:' ifTrue:[
- "/ VW external function definition
- annotations := annotations
- copyWith:(Array with:callType asSymbol with:cString).
- self
- parseVWTypeOrExternalFunctionDeclarationFrom:cStream
- definitionType:callType
- knownDefinitions:dictionaryOfKnownTypes
- lineNr:lineNr.
- ^ -1
+ "/ VW external function definition
+ annotations := annotations
+ copyWith:(Array with:callType asSymbol with:cString).
+ self
+ parseVWTypeOrExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
+ ^ -1
].
(callType = 'api:' or:[ callType = 'ole:' ]) ifTrue:[
- "/ ST/V external function definition
- annotations := annotations
- copyWith:(Array with:callType asSymbol with:cString).
- self
- parseSTVExternalFunctionDeclarationFrom:cStream
- definitionType:callType
- knownDefinitions:dictionaryOfKnownTypes
- lineNr:lineNr.
- ^ -1
- ].
- self
- ignorableParseError:'unsupported external function call type: ' , callType.
+ "/ ST/V external function definition
+ annotations := annotations
+ copyWith:(Array with:callType asSymbol with:cString).
+ self
+ parseSTVExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
+ ^ -1
+ ].
+ self
+ ignorableParseError:'unsupported external function call type: ' , callType.
^ -1
"
(Parser for:'foo <cdecl: void ''glFlush'' (void) module: ''GL''>')
- nextToken;
- parseMethod"
+ nextToken;
+ parseMethod"
"Modified: / 25-10-2006 / 12:03:33 / cg"
"Modified: / 19-11-2009 / 11:09:51 / Jan Travnicek <travnja3@fel.cvut.cz>"
"Modified: / 01-07-2010 / 12:05:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -8440,14 +8423,14 @@
parseGSTExternalFunctionDeclaration: argArray
"Handles GNU Smalltalk-style exteranl function declarations.
Example:
- <cCall: 'cairo_close_path' returning: #void args: #(#cObject )>
+ <cCall: 'cairo_close_path' returning: #void args: #(#cObject )>
"
| function |
- function := ExternalLibraryFunction
- name:argArray first
- module:nil
- returnType:argArray second
- argumentTypes:argArray third asArray.
+ function := ExternalLibraryFunction
+ name:argArray first
+ module:nil
+ returnType:argArray second
+ argumentTypes:argArray third asArray.
function beCallTypeC.
function owningClass:classToCompileFor.
self generateCallToExternalFunction:function lineNr:lineNr.
@@ -8462,39 +8445,39 @@
value := true.
self nextToken.
((tokenType == #BinaryOperator) and:[ tokenName = '>' ]) ifTrue:[
- annotations := annotations copyWith:(Array with:key asSymbol with:value).
- self nextToken.
- ^ nil.
+ annotations := annotations copyWith:(Array with:key asSymbol with:value).
+ self nextToken.
+ ^ nil.
].
value := self parseAnotationLiteral.
(value == #Error) ifTrue:[
- ^ #Error.
+ ^ #Error.
].
((tokenType == #BinaryOperator) and:[ tokenName = '>' ]) ifTrue:[
- annotations := annotations
- copyWith:(Array with:key asSymbol with:(Array with:value)).
- self nextToken.
- ^ nil.
+ annotations := annotations
+ copyWith:(Array with:key asSymbol with:(Array with:value)).
+ self nextToken.
+ ^ nil.
].
values := OrderedCollection new:4.
values add:value.
[
- (tokenType == #Keyword or:[ tokenType == #Identifier ])
+ (tokenType == #Keyword or:[ tokenType == #Identifier ])
] whileTrue:[
- key := key , tokenName.
- self nextToken.
- value := self parseAnotationLiteral.
- (value == #Error) ifTrue:[
- ^ #Error.
- ].
- values add:value.
- ].
- annotations := annotations
- copyWith:(Array with:key asSymbol with:(values asArray)).
+ key := key , tokenName.
+ self nextToken.
+ value := self parseAnotationLiteral.
+ (value == #Error) ifTrue:[
+ ^ #Error.
+ ].
+ values add:value.
+ ].
+ annotations := annotations
+ copyWith:(Array with:key asSymbol with:(values asArray)).
"JV@2012-04-09: Check for GNU Smalltalk-style external function declaration"
key = #'cCall:returning:args:' ifTrue:[
- self parseGSTExternalFunctionDeclaration: values.
+ self parseGSTExternalFunctionDeclaration: values.
].
self checkForClosingAngle.
@@ -8507,30 +8490,30 @@
parsePragma
" '<' has already been parsed."
-
+
|type flagValue|
type := token.
type ~= 'pragma:' ifTrue:[
- self parseError:'pragma expected'.
- ^ #self
+ self parseError:'pragma expected'.
+ ^ #self
].
self nextToken.
((token = '+') or:[token = '-']) ifTrue:[
- flagValue := (token = '+').
- self nextToken.
- (tokenType == #Identifier) ifTrue:[
- token = 'arrayIndexSyntaxExtension' ifTrue:[
- parserFlags perform:('allow',token asUppercaseFirst,':') asSymbol with:flagValue.
- self nextToken.
- self checkForClosingAngle.
- ^ self.
- ].
- ].
- self halt.
- self parseError:'unknown pragma'.
- ^ self
+ flagValue := (token = '+').
+ self nextToken.
+ (tokenType == #Identifier) ifTrue:[
+ token = 'arrayIndexSyntaxExtension' ifTrue:[
+ parserFlags perform:('allow',token asUppercaseFirst,':') asSymbol with:flagValue.
+ self nextToken.
+ self checkForClosingAngle.
+ ^ self.
+ ].
+ ].
+ self halt.
+ self parseError:'unknown pragma'.
+ ^ self
].
self parseError:'+/- expected'.
@@ -8539,20 +8522,20 @@
parsePrimitive
"parse an ST-80 type primitive as '< primitive: nr >';
- (return primitive number or #Error)
+ (return primitive number or #Error)
or a Squeak-style primitive, as '< primitive: string >';
- (return primitive name or #Error)
+ (return primitive name or #Error)
or a V'Age-style primitive, as '< primitive: identifier >';
- (return primitive name or #Error)
+ (return primitive name or #Error)
Also, resource specs are parsed; the result is left (as side effect) in primitiveResource.
It is used to flag methods, for faster finding of used keyboard accelerators,
and to mark resource methods (image, menu or canvas resources).
prim ::= st80Primitive | st80Pragma | stxPragma
- | squeakPrimitive | vAgePrimitive | newSTXPrimitive
- | externalFuncDecl
- | resourceDecl
+ | squeakPrimitive | vAgePrimitive | newSTXPrimitive
+ | externalFuncDecl
+ | resourceDecl
st80Primitive ::= 'primitive:' INTEGER
st80Pragma ::= 'exception:' ( 'handle | 'raise' | 'unwind' )
@@ -8563,112 +8546,112 @@
newSTXPrimitive ::= 'primitive'
vAgePrimitive ::= 'primitive:' IDENTIFIER
- | 'sysprim:' IDENTIFIER
+ | 'sysprim:' IDENTIFIER
externalFuncDecl ::= vwExternalFuncDecl
- | stvExternalFuncDecl
- | squeakExternalFuncDecl
- | dolphinExternalFuncDecl
+ | stvExternalFuncDecl
+ | squeakExternalFuncDecl
+ | dolphinExternalFuncDecl
vwExternalFuncDecl ::= 'c:' vwFuncDecl
stvExternalFuncDecl ::= 'api:' stvFuncDecl
- | 'ole:' stvFuncDecl
+ | 'ole:' stvFuncDecl
squeakExternalFuncDecl ::= 'apicall:' stvFuncDecl
- | 'cdecl:' stvFuncDecl
+ | 'cdecl:' stvFuncDecl
dolphinExternalFuncDecl ::= 'stdcall:' stvFuncDecl
resourceDecl ::= 'resource:' SYMBOL - leave SYMBOL in primitiveResource
- | 'resource:' SYMBOL (...) - leave (SYMBOL (...)) in primitiveResource
- | 'pragma:' SYMBOL - same as resource; alternative syntax
- | 'pragma:' SYMBOL (...) - same as resource; alternative syntax
- | 'attribute:' SYMBOL - same as resource; alternative syntax
- | 'attribute:' SYMBOL (...) - same as resource; alternative syntax"
-
+ | 'resource:' SYMBOL (...) - leave (SYMBOL (...)) in primitiveResource
+ | 'pragma:' SYMBOL - same as resource; alternative syntax
+ | 'pragma:' SYMBOL (...) - same as resource; alternative syntax
+ | 'attribute:' SYMBOL - same as resource; alternative syntax
+ | 'attribute:' SYMBOL (...) - same as resource; alternative syntax"
+
|lcTokenName tmp|
(tokenType == #Keyword or:[ tokenType == #Identifier ]) ifFalse:[
- self parseError:'bad primitive definition (keyword expected)'.
- ^ #Error
+ self parseError:'bad primitive definition (keyword expected)'.
+ ^ #Error
].
(tokenName = 'primitive:') ifTrue:[
- tmp := self parseTraditionalPrimitive.
- annotations := annotations
- copyWith:(Array with:'primitive:' asSymbol with:tmp).
- ^ tmp.
+ tmp := self parseTraditionalPrimitive.
+ annotations := annotations
+ copyWith:(Array with:'primitive:' asSymbol with:tmp).
+ ^ tmp.
].
(tokenName = 'sysprim:') ifTrue:[
- parserFlags allowVisualAgePrimitives ifTrue:[
- tmp := self parseTraditionalPrimitive.
- annotations := annotations
- copyWith:(Array with:'sysprim:' asSymbol with:tmp).
- ^ tmp.
- ].
+ parserFlags allowVisualAgePrimitives ifTrue:[
+ tmp := self parseTraditionalPrimitive.
+ annotations := annotations
+ copyWith:(Array with:'sysprim:' asSymbol with:tmp).
+ ^ tmp.
+ ].
].
(tokenName = 'primitive') ifTrue:[
- self nextToken.
- self checkForClosingAngle.
- annotations := annotations
- copyWith:(Array with:'primitive' asSymbol with:0).
- ^ 0
- "/ no primitive number
- .
+ self nextToken.
+ self checkForClosingAngle.
+ annotations := annotations
+ copyWith:(Array with:'primitive' asSymbol with:0).
+ ^ 0
+ "/ no primitive number
+ .
].
(tokenName = 'resource:') ifTrue:[
- self parseResourcePragma.
- ^ nil
- "/ no primitive number
- .
+ self parseResourcePragma.
+ ^ nil
+ "/ no primitive number
+ .
].
(tokenName = 'pragma:') ifTrue:[
- self parsePragma.
- ^ nil
- "/ no primitive number
- .
+ self parsePragma.
+ ^ nil
+ "/ no primitive number
+ .
].
(tokenName = 'exception:' or:[ tokenName = 'context:' ]) ifTrue:[
- (self parseExceptionOrContextPragma) == #Error ifTrue:[
- ^ #Error
- ].
- self checkForClosingAngle.
- ^ nil
- "/ no primitive number
+ (self parseExceptionOrContextPragma) == #Error ifTrue:[
+ ^ #Error
+ ].
+ self checkForClosingAngle.
+ ^ nil
+ "/ no primitive number
].
lcTokenName := tokenName asLowercase.
((lcTokenName = 'c:'
- "/ vw external function definition
- )
- or:[
- lcTokenName = 'api:'
- "/ st/v external function definition
-
- or:[
- lcTokenName = 'ole:'
- "/ st/v external function definition
-
- or:[
- lcTokenName = 'apicall:'
- "/ squeak external function definition
-
- or:[
- lcTokenName = 'cdecl:'
- "/ squeak external function definition
-
- or:[
- lcTokenName = 'stdcall:'
- "/ dolphin external function definition
- ]
- ]
- ]
- ]
- ])
- ifTrue:[
- self parseExternalFunctionCallDeclaration.
- ^ nil
- "/ no primitive number
- ].
+ "/ vw external function definition
+ )
+ or:[
+ lcTokenName = 'api:'
+ "/ st/v external function definition
+
+ or:[
+ lcTokenName = 'ole:'
+ "/ st/v external function definition
+
+ or:[
+ lcTokenName = 'apicall:'
+ "/ squeak external function definition
+
+ or:[
+ lcTokenName = 'cdecl:'
+ "/ squeak external function definition
+
+ or:[
+ lcTokenName = 'stdcall:'
+ "/ dolphin external function definition
+ ]
+ ]
+ ]
+ ]
+ ])
+ ifTrue:[
+ self parseExternalFunctionCallDeclaration.
+ ^ nil
+ "/ no primitive number
+ ].
^ self parseOtherPrimitives.
"Modified: / 10-01-2010 / 17:10:11 / Jan Travnicek <travnja3@fel.cvut.cz>"
@@ -8681,35 +8664,35 @@
|pos wmsg primNr primNrOrString|
[(tokenType == #BinaryOperator) and:[tokenName = '<']] whileTrue:[
- pos := tokenPosition.
- self nextToken.
- primNrOrString := self parsePrimitive.
-
- (primNrOrString == #Error) ifTrue:[^ #Error].
- wmsg := nil.
-
- primNrOrString isString ifTrue:[
- primNr := self primitiveNumberFromName:primNrOrString
- ] ifFalse:[
- primNr := primNrOrString
- ].
-
- primNr notNil ifTrue:[
- primNr < 0 ifTrue:[
- parserFlags warnST80Directives == true ifTrue:[
- wmsg := 'ST-80/Squeak directive ignored'.
- ].
- ] ifFalse:[
- primNr > 0 ifTrue:[
- primitiveNr := primNr.
- wmsg := 'ST-80 primitive may not work'
- ] ifFalse:[
- primitiveNr := primNr.
- wmsg := 'ST/X primitives only work in rel5 and newer'
- ]
- ].
- wmsg notNil ifTrue:[self warning:wmsg position:pos]
- ].
+ pos := tokenPosition.
+ self nextToken.
+ primNrOrString := self parsePrimitive.
+
+ (primNrOrString == #Error) ifTrue:[^ #Error].
+ wmsg := nil.
+
+ primNrOrString isString ifTrue:[
+ primNr := self primitiveNumberFromName:primNrOrString
+ ] ifFalse:[
+ primNr := primNrOrString
+ ].
+
+ primNr notNil ifTrue:[
+ primNr < 0 ifTrue:[
+ parserFlags warnST80Directives == true ifTrue:[
+ wmsg := 'ST-80/Squeak directive ignored'.
+ ].
+ ] ifFalse:[
+ primNr > 0 ifTrue:[
+ primitiveNr := primNr.
+ wmsg := 'ST-80 primitive may not work'
+ ] ifFalse:[
+ primitiveNr := primNr.
+ wmsg := 'ST/X primitives only work in rel5 and newer'
+ ]
+ ].
+ wmsg notNil ifTrue:[self warning:wmsg position:pos]
+ ].
].
"Created: 27.4.1996 / 16:55:55 / cg"
@@ -8718,45 +8701,45 @@
parseResourcePragma
" '<' has already been parsed."
-
+
|type keys resource resourceValue|
type := token.
self nextToken.
(tokenType ~~ #Symbol) ifTrue:[
- self parseError:'symbol expected'.
- ^ #Error
+ self parseError:'symbol expected'.
+ ^ #Error
].
resource := tokenValue.
resourceValue := true.
self nextToken.
tokenType == $( ifTrue:[
- self nextToken.
- keys := OrderedCollection new.
- [
- (tokenType == $)) or:[ tokenType == #EOF ]
- ] whileFalse:[
- keys add:tokenValue.
- self nextToken.
- ].
- resourceValue := keys.
- (tokenType == $)) ifFalse:[
- self parseError:'unterminated primitive/spec (missing '')'')'.
- ].
- self nextToken.
+ self nextToken.
+ keys := OrderedCollection new.
+ [
+ (tokenType == $)) or:[ tokenType == #EOF ]
+ ] whileFalse:[
+ keys add:tokenValue.
+ self nextToken.
+ ].
+ resourceValue := keys.
+ (tokenType == $)) ifFalse:[
+ self parseError:'unterminated primitive/spec (missing '')'')'.
+ ].
+ self nextToken.
].
primitiveResource isNil ifTrue:[
- primitiveResource := IdentityDictionary new.
+ primitiveResource := IdentityDictionary new.
].
primitiveResource at:(resource asSymbol) put:resourceValue.
self checkForClosingAngle.
(resourceValue isBoolean and:[ resourceValue ]) ifTrue:[
- annotations := annotations
- copyWith:(Array with:#resource: asSymbol with:(Array with:resource)).
+ annotations := annotations
+ copyWith:(Array with:#resource: asSymbol with:(Array with:resource)).
] ifFalse:[
- annotations := annotations
- copyWith:(Array with:#resource:values: asSymbol
- with:(Array with:resource with:resourceValue)).
+ annotations := annotations
+ copyWith:(Array with:#resource:values: asSymbol
+ with:(Array with:resource with:resourceValue)).
]
"Modified: / 19-11-2009 / 11:11:26 / Jan Travnicek <travnja3@fel.cvut.cz>"
@@ -8764,51 +8747,51 @@
!
parseSTVExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
- "parses ST/V function declarations of the forms
- '<api: functionName argType1 .. argTypeN returnType>'
- '<ole: vFunctionIndex argType1 .. argTypeN returnType>'
+ "parses ST/V function declarations of the forms
+ '<api: functionName argType1 .. argTypeN returnType>'
+ '<ole: vFunctionIndex argType1 .. argTypeN returnType>'
"
|primParser function|
primParser := PrimitiveSpecParser new.
- function := primParser
- parseSTVExternalFunctionDeclarationFrom:aStream
- definitionType:definitionType
- lineNr:lineNr
- for:self.
+ function := primParser
+ parseSTVExternalFunctionDeclarationFrom:aStream
+ definitionType:definitionType
+ lineNr:lineNr
+ for:self.
function notNil ifTrue:[
- function owningClass:classToCompileFor.
- self generateCallToExternalFunction:function lineNr:lineNr.
+ function owningClass:classToCompileFor.
+ self generateCallToExternalFunction:function lineNr:lineNr.
].
"Modified: / 07-09-2011 / 22:07:36 / cg"
!
-parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:aStream definitionType:definitionType
+parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:aStream definitionType:definitionType
knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
- "parses squeak/dolphin/stx function declarations of the forms
- '<stdcall: [virtual|nonVirtual] returnType functionNameOrIndex argType1..argTypeN>'
- '<cdecl: [virtual|nonVirtual] returnType functionNameOrIndex argType1..argTypeN>'
-
- '<cdecl: [async] [virtual|nonVirtual] returnType functionNameOrIndex ( argType1..argTypeN ) module: moduleName >'
- '<apicall: [async] [virtual|nonVirtual] returnType functionNameOrIndex ( argType1..argTypeN ) module: moduleName >'
+ "parses squeak/dolphin/stx function declarations of the forms
+ '<stdcall: [virtual|nonVirtual] returnType functionNameOrIndex argType1..argTypeN>'
+ '<cdecl: [virtual|nonVirtual] returnType functionNameOrIndex argType1..argTypeN>'
+
+ '<cdecl: [async] [virtual|nonVirtual] returnType functionNameOrIndex ( argType1..argTypeN ) module: moduleName >'
+ '<apicall: [async] [virtual|nonVirtual] returnType functionNameOrIndex ( argType1..argTypeN ) module: moduleName >'
"
|primParser function|
primParser := PrimitiveSpecParser new setClassToCompileFor:classToCompileFor.
primParser notifying:requestor.
- function := primParser
- parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:aStream
- definitionType:definitionType
- lineNr:lineNr
- for:self.
+ function := primParser
+ parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:aStream
+ definitionType:definitionType
+ lineNr:lineNr
+ for:self.
function notNil ifTrue:[
- function owningClass:classToCompileFor.
- self generateCallToExternalFunction:function lineNr:lineNr.
+ function owningClass:classToCompileFor.
+ self generateCallToExternalFunction:function lineNr:lineNr.
].
"Created: / 25-10-2006 / 12:03:24 / cg"
@@ -8821,22 +8804,22 @@
self nextToken.
(tokenType == #Integer) ifFalse:[
- (tokenType == #String) ifTrue:[
- (parserFlags allowSqueakExtensions
- or:[ parserFlags allowSqueakPrimitives
- or:[ parserFlags allowVisualAgePrimitives ]]) ifFalse:[
- self parseError:'primitive name as string expected (Squeak/V''Age primitives not allowed - see settings)'.
- ].
- ] ifFalse:[
- (tokenType == #Identifier) ifTrue:[
- (false "parserFlags allowVisualAgeExtensions"
- or:[ parserFlags allowVisualAgePrimitives ]) ifFalse:[
- self parseError:'primitive number expected (V''Age-primitives not allowed - see settings)'.
- ]
- ] ifFalse:[
- self parseError:'primitive number expected'.
- ].
- ].
+ (tokenType == #String) ifTrue:[
+ (parserFlags allowSqueakExtensions
+ or:[ parserFlags allowSqueakPrimitives
+ or:[ parserFlags allowVisualAgePrimitives ]]) ifFalse:[
+ self parseError:'primitive name as string expected (Squeak/V''Age primitives not allowed - see settings)'.
+ ].
+ ] ifFalse:[
+ (tokenType == #Identifier) ifTrue:[
+ (false "parserFlags allowVisualAgeExtensions"
+ or:[ parserFlags allowVisualAgePrimitives ]) ifFalse:[
+ self parseError:'primitive number expected (V''Age-primitives not allowed - see settings)'.
+ ]
+ ] ifFalse:[
+ self parseError:'primitive number expected'.
+ ].
+ ].
"/ (parserFlags allowSqueakExtensions
"/ or:[ parserFlags allowSqueakPrimitives ]) ifTrue:[
"/ (tokenType == #String) ifFalse:[
@@ -8856,44 +8839,44 @@
"/ ]
].
primitiveNr notNil ifTrue:[
- self parseError:'only one primitive spec allowed'.
- primNumber := -1.
+ self parseError:'only one primitive spec allowed'.
+ primNumber := -1.
] ifFalse:[
- primNumber := tokenValue.
+ primNumber := tokenValue.
].
self nextToken.
(tokenType == #Keyword) ifTrue:[
- (tokenName = 'errorCode:') ifTrue:[
- self nextToken.
- (tokenType == #Identifier) ifTrue:[
- self nextToken.
- ] ifFalse:[
- self error:'not yet implemented'.
- ]
- ].
- (tokenName = 'module:') ifTrue:[
- self nextToken.
- (tokenType == #String) ifTrue:[
- self nextToken.
- ] ifFalse:[
- self error:'not yet implemented'.
- ]
- ].
+ (tokenName = 'errorCode:') ifTrue:[
+ self nextToken.
+ (tokenType == #Identifier) ifTrue:[
+ self nextToken.
+ ] ifFalse:[
+ self error:'not yet implemented'.
+ ]
+ ].
+ (tokenName = 'module:') ifTrue:[
+ self nextToken.
+ (tokenType == #String) ifTrue:[
+ self nextToken.
+ ] ifFalse:[
+ self error:'not yet implemented'.
+ ]
+ ].
].
tokenType == $: ifTrue:[
- "/ va-style:
- "/ <primitive: 'PACKAGER_PRIMITIVES':EsMakeAssociationGlobal>
- primNumber isString ifFalse:[
- self error:'unknown V''Age primitive spec format'.
- ].
- self nextToken.
- tokenType == #Identifier ifFalse:[
- self parseError:'unknown V''Age primitive spec format'.
- ].
- primNumber := primNumber,':',tokenName.
- self nextToken.
+ "/ va-style:
+ "/ <primitive: 'PACKAGER_PRIMITIVES':EsMakeAssociationGlobal>
+ primNumber isString ifFalse:[
+ self error:'unknown V''Age primitive spec format'.
+ ].
+ self nextToken.
+ tokenType == #Identifier ifFalse:[
+ self parseError:'unknown V''Age primitive spec format'.
+ ].
+ primNumber := primNumber,':',tokenName.
+ self nextToken.
].
self checkForClosingAngle.
@@ -8904,24 +8887,24 @@
!
parseVWTypeOrExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
- "parses visualWorks type/function declarations of the form:
- '<c: ...>'"
+ "parses visualWorks type/function declarations of the form:
+ '<c: ...>'"
|primParser functionOrTypeOrValue|
primParser := PrimitiveSpecParser new setClassToCompileFor:classToCompileFor.
functionOrTypeOrValue := primParser
- parseVWTypeOrExternalFunctionDeclarationFrom:aStream
- definitionType:definitionType
- knownDefinitions:dictionaryOfTypesOrNil
- lineNr:lineNr
- for: self.
+ parseVWTypeOrExternalFunctionDeclarationFrom:aStream
+ definitionType:definitionType
+ knownDefinitions:dictionaryOfTypesOrNil
+ lineNr:lineNr
+ for: self.
functionOrTypeOrValue isNil ifTrue:[^ self].
(functionOrTypeOrValue isExternalLibraryFunction) ifFalse:[
- self generateReturnOfValue:functionOrTypeOrValue.
- ^ self
+ self generateReturnOfValue:functionOrTypeOrValue.
+ ^ self
].
functionOrTypeOrValue owningClass:classToCompileFor.
@@ -8938,7 +8921,7 @@
rememberContextPragma:pragmaType value:pragmaValue
primitiveContextInfo isNil ifTrue:[
- primitiveContextInfo := Set new.
+ primitiveContextInfo := Set new.
].
primitiveContextInfo add:(pragmaType -> pragmaValue).
@@ -8954,11 +8937,11 @@
skipForClosingAngle
"/ skip
[tokenType ~~ #EOF] whileTrue:[
- ((tokenType == #BinaryOperator) and:[tokenName = '>']) ifTrue:[
- self nextToken.
- ^ nil "/ no primitive number
- ].
- self nextToken.
+ ((tokenType == #BinaryOperator) and:[tokenName = '>']) ifTrue:[
+ self nextToken.
+ ^ nil "/ no primitive number
+ ].
+ self nextToken.
].
! !
@@ -8969,12 +8952,12 @@
spc := currentNamespace.
spc isNil ifTrue:[
- (requestor respondsTo:#currentNameSpace) ifTrue:[
- spc := requestor currentNameSpace
- ] ifFalse:[
- spc := Class nameSpaceQuerySignal query.
- ].
- currentNamespace := spc.
+ (requestor respondsTo:#currentNameSpace) ifTrue:[
+ spc := requestor currentNameSpace
+ ] ifFalse:[
+ spc := Class nameSpaceQuerySignal query.
+ ].
+ currentNamespace := spc.
].
^ spc
@@ -9002,12 +8985,12 @@
pkg := currentPackage.
pkg isNil ifTrue:[
- (requestor respondsTo:#currentPackage) ifTrue:[
- pkg := requestor currentPackage
- ] ifFalse:[
- pkg := Class packageQuerySignal query.
- ].
- currentPackage := pkg.
+ (requestor respondsTo:#currentPackage) ifTrue:[
+ pkg := requestor currentPackage
+ ] ifFalse:[
+ pkg := Class packageQuerySignal query.
+ ].
+ currentPackage := pkg.
].
^ pkg
!
@@ -9017,15 +9000,15 @@
spaces := currentUsedNamespaces.
spaces isNil ifTrue:[
- (requestor respondsTo:#usedNameSpaces) ifTrue:[
- spaces := requestor usedNameSpaces
- ] ifFalse:[
- spaces := Class usedNameSpaceQuerySignal query.
- ].
- spaces isNil ifTrue:[
- spaces := #()
- ].
- currentUsedNamespaces := spaces.
+ (requestor respondsTo:#usedNameSpaces) ifTrue:[
+ spaces := requestor usedNameSpaces
+ ] ifFalse:[
+ spaces := Class usedNameSpaceQuerySignal query.
+ ].
+ spaces isNil ifTrue:[
+ spaces := #()
+ ].
+ currentUsedNamespaces := spaces.
].
^ spaces
@@ -9040,24 +9023,24 @@
"/ 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 ?"
-
- ns := classToCompileFor topNameSpace.
- (ns notNil
- and:[ns ~~ Smalltalk]) ifTrue:[
- ns isNameSpace ifTrue:[
- (ns at: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 ?"
+
+ ns := classToCompileFor topNameSpace.
+ (ns notNil
+ and:[ns ~~ Smalltalk]) ifTrue:[
+ ns isNameSpace ifTrue:[
+ (ns at:aVariableName) notNil ifTrue:[
+ ^ ns
+ ]
+ ]
+ ].
"/ ns := classToCompileFor nameSpace.
"/ ns notNil ifTrue:[
@@ -9072,21 +9055,21 @@
currentSpace := self currentNameSpace.
(currentSpace notNil
and:[currentSpace ~~ Smalltalk]) ifTrue:[
- currentSpace isNameSpace ifTrue:[
- (currentSpace at:aVariableName) notNil ifTrue:[
- ^ currentSpace
- ]
- ] ifFalse:[
- (currentSpace privateClassesAt:aVariableName) notNil ifTrue:[
- ^ currentSpace
- ]
- ]
+ currentSpace isNameSpace ifTrue:[
+ (currentSpace at:aVariableName) notNil ifTrue:[
+ ^ currentSpace
+ ]
+ ] ifFalse:[
+ (currentSpace privateClassesAt:aVariableName) notNil ifTrue:[
+ ^ currentSpace
+ ]
+ ]
].
"is it in one of the used namespaces ?"
usedSpaces := self currentUsedNameSpaces.
usedSpaces notNil ifTrue:[
- ^ usedSpaces detect:[:aNameSpace | (aNameSpace at:aVariableName) notNil] ifNone:nil.
+ ^ usedSpaces detect:[:aNameSpace | (aNameSpace at:aVariableName) notNil] ifNone:nil.
].
^ nil
@@ -9097,9 +9080,9 @@
genMakeArrayWith:elementExpressions
"return a node to generate an array at runtime.
Will generate:
- Array with:el1 ... with:elN (if N <= 5)
+ Array with:el1 ... with:elN (if N <= 5)
or:
- (Array new at:1 put:el1; ... at:N put:elN; yourself) (otherwise)
+ (Array new at:1 put:el1; ... at:N put:elN; yourself) (otherwise)
"
|numEl arrRec sel expr|
@@ -9110,45 +9093,45 @@
numEl := elementExpressions size.
(numEl between:1 and:8) ifTrue:[
- sel := #(
- #'with:'
- #'with:with:'
- #'with:with:with:'
- #'with:with:with:with:'
- #'with:with:with:with:with:'
- #'with:with:with:with:with:with:'
- #'with:with:with:with:with:with:with:'
- #'with:with:with:with:with:with:with:with:'
- ) at:numEl.
-
- ^ MessageNode
- receiver:arrRec
- selector:sel
- args:elementExpressions.
+ sel := #(
+ #'with:'
+ #'with:with:'
+ #'with:with:with:'
+ #'with:with:with:with:'
+ #'with:with:with:with:with:'
+ #'with:with:with:with:with:with:'
+ #'with:with:with:with:with:with:with:'
+ #'with:with:with:with:with:with:with:with:'
+ ) at:numEl.
+
+ ^ MessageNode
+ receiver:arrRec
+ selector:sel
+ args:elementExpressions.
].
"/ array creation expression ...
- expr := MessageNode
- receiver:arrRec
- selector:#new:
- arg:(ConstantNode type:#Integer value:numEl from: -1 to: -1). "/ -1 means artifitial node
+ expr := MessageNode
+ receiver:arrRec
+ selector:#new:
+ arg:(ConstantNode type:#Integer value:numEl from: -1 to: -1). "/ -1 means artifitial node
numEl == 0 ifTrue:[
- ^ expr.
+ ^ expr.
].
"/ followed by a bunch of #at:put: messages...
elementExpressions keysAndValuesDo:[:idx :e |
- expr := (idx == 1 ifTrue:[MessageNode] ifFalse:[CascadeNode])
- receiver:expr
- selector:#at:put:
- arg1:(ConstantNode type:#Integer value:idx from: -1 to:-1)"/ -1 means artifitial node
- arg2:e
- fold:false.
+ expr := (idx == 1 ifTrue:[MessageNode] ifFalse:[CascadeNode])
+ receiver:expr
+ selector:#at:put:
+ arg1:(ConstantNode type:#Integer value:idx from: -1 to:-1)"/ -1 means artifitial node
+ arg2:e
+ fold:false.
].
"/ followed by a #yourself: message...
expr := CascadeNode
- receiver:expr
- selector:#yourself.
+ receiver:expr
+ selector:#yourself.
^ expr
"Modified: / 01-08-2011 / 12:38:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -9163,8 +9146,8 @@
aClass := self classToLookForClassVars.
[aClass notNil] whileTrue:[
- (aClass class instVarNames includes:aString) ifTrue:[ ^ aClass].
- aClass := aClass superclass
+ (aClass class instVarNames includes:aString) ifTrue:[ ^ aClass].
+ aClass := aClass superclass
].
^ nil
@@ -9180,11 +9163,11 @@
aClass := self classToLookForClassVars.
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
@@ -9204,42 +9187,42 @@
|expr checkBlock check2Blocks selector block1 block2|
- checkBlock :=
- [:block |
- |stats|
-
- stats := block statements.
- stats notEmptyOrNil and:[ self isStatementListAnUnconditionalReturn:stats ]
- ].
-
- check2Blocks :=
- [:block1 :block2 |
- block1 isBlockNode
- and:[ block2 isBlockNode
- and:[ (checkBlock value:block1)
- and:[ (checkBlock value:block2) ]]]
- ].
+ checkBlock :=
+ [:block |
+ |stats|
+
+ stats := block statements.
+ stats notEmptyOrNil and:[ self isStatementListAnUnconditionalReturn:stats ]
+ ].
+
+ check2Blocks :=
+ [:block1 :block2 |
+ block1 isBlockNode
+ and:[ block2 isBlockNode
+ and:[ (checkBlock value:block1)
+ and:[ (checkBlock value:block2) ]]]
+ ].
aStatementNode isReturnNode ifTrue:[^ true ].
((expr := aStatementNode expression) notNil
and:[expr isMessage]) ifTrue:[
- selector := expr selector.
-
- "/ if both pathes of an if end in return...
- "/ or both the handler and the block of a handle:do: end in a return...
- (selector == #'ifTrue:ifFalse:'
- or:[ selector == #'ifFalse:ifTrue:'
- or:[ selector == #'handle:do:' ]]) ifTrue:[
- block1 := expr arg1.
- block2 := expr arguments at:2.
- ^ check2Blocks value:block1 value:block2
- ].
- (selector == #'on:do:') ifTrue:[
- block1 := expr receiver.
- block2 := expr arguments at:2.
- ^ check2Blocks value:block1 value:block2
- ].
+ selector := expr selector.
+
+ "/ if both pathes of an if end in return...
+ "/ or both the handler and the block of a handle:do: end in a return...
+ (selector == #'ifTrue:ifFalse:'
+ or:[ selector == #'ifFalse:ifTrue:'
+ or:[ selector == #'handle:do:' ]]) ifTrue:[
+ block1 := expr arg1.
+ block2 := expr arguments at:2.
+ ^ check2Blocks value:block1 value:block2
+ ].
+ (selector == #'on:do:') ifTrue:[
+ block1 := expr receiver.
+ block2 := expr arguments at:2.
+ ^ check2Blocks value:block1 value:block2
+ ].
].
^ false.
@@ -9253,8 +9236,8 @@
stat := aStatementNode.
[stat notNil] whileTrue:[
- (self isStatementAnUnconditionalReturn:stat) ifTrue:[^ true].
- stat := stat nextStatement
+ (self isStatementAnUnconditionalReturn:stat) ifTrue:[^ true].
+ stat := stat nextStatement
].
^ false.
@@ -9266,12 +9249,12 @@
tokenType == #Here ifTrue:[^true].
parserFlags allowReservedWordsAsSelectors == true ifTrue:[
- tokenType == #Self ifTrue:[^true].
- tokenType == #Nil ifTrue:[^true].
- tokenType == #True ifTrue:[^true].
- tokenType == #False ifTrue:[^true].
- tokenType == #Super ifTrue:[^true].
- tokenType == #ThisContext ifTrue:[^true].
+ tokenType == #Self ifTrue:[^true].
+ tokenType == #Nil ifTrue:[^true].
+ tokenType == #True ifTrue:[^true].
+ tokenType == #False ifTrue:[^true].
+ tokenType == #Super ifTrue:[^true].
+ tokenType == #ThisContext ifTrue:[^true].
].
^ false
@@ -9312,18 +9295,18 @@
indexNode := ConstantNode type:#Integer value:aNode index.
aNode isArgument ifTrue:[
- sel := #forArgument:in:.
- arg1 := indexNode.
- arg2 := contextNode.
+ sel := #forArgument:in:.
+ arg1 := indexNode.
+ arg2 := contextNode.
] ifFalse:[
- aNode isLocal ifTrue:[
- sel := #forLocal:in:.
- arg1 := indexNode.
- arg2 := contextNode.
- ] ifFalse:[
- self parseError:'unsupported variable reference (must be local or argument)'.
- ^ aNode
- ]
+ aNode isLocal ifTrue:[
+ sel := #forLocal:in:.
+ arg1 := indexNode.
+ arg2 := contextNode.
+ ] ifFalse:[
+ self parseError:'unsupported variable reference (must be local or argument)'.
+ ^ aNode
+ ]
].
parseForCode ifFalse:[self rememberGlobalUsed:'Reference'].
@@ -9336,11 +9319,11 @@
noAssignmentAllowed:eMsg at:pos
((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:eMsg position:pos to:tokenPosition + tokenType size - 1.
- self isSyntaxHighlighter ifFalse:[
- ^ false
- ].
- self nextToken. "/ eat the assign when doing highlighting only
+ self parseError:eMsg position:pos to:tokenPosition + tokenType size - 1.
+ self isSyntaxHighlighter ifFalse:[
+ ^ false
+ ].
+ self nextToken. "/ eat the assign when doing highlighting only
].
^ true
!
@@ -9355,10 +9338,10 @@
var := methodArgs at:varIndex.
"/ var used:true.
^ (VariableNode type:#MethodArg
- name:varName
- token:var
- index:varIndex)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ name:varName
+ token:var
+ index:varIndex)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
"Modified: / 21-08-2011 / 07:58:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -9374,10 +9357,10 @@
var used:true.
parseForCode ifFalse:[self rememberLocalUsed:varName].
^ (VariableNode type:#MethodVariable
- name:varName
- token:var
- index:varIndex)
- startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
+ name:varName
+ token:var
+ index:varIndex)
+ startPosition: tokenPosition endPosition: tokenPosition + varName size - 1
"Modified: / 25-08-2011 / 11:42:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -9387,19 +9370,19 @@
note := aNode plausibilityCheckIn:self.
note isNil ifTrue:[
- aNode isMessage ifTrue:[
- (contextToEvaluateIn isNil and:[selfValue isNil]) ifTrue:[ "/ do not check this for doits
- rcvr := aNode receiver.
- (rcvr isSuper and:[rcvr isHere not]) ifTrue:[
- aNode selector ~= selector ifTrue:[
- didWarnAboutBadSupersend ifFalse:[
- didWarnAboutBadSupersend := true.
- note := 'possible bad super message ? (selector should usually be the same as in current method)'.
- ]
- ].
- ].
- ].
- ].
+ aNode isMessage ifTrue:[
+ (contextToEvaluateIn isNil and:[selfValue isNil]) ifTrue:[ "/ do not check this for doits
+ rcvr := aNode receiver.
+ (rcvr isSuper and:[rcvr isHere not]) ifTrue:[
+ aNode selector ~= selector ifTrue:[
+ didWarnAboutBadSupersend ifFalse:[
+ didWarnAboutBadSupersend := true.
+ note := 'possible bad super message ? (selector should usually be the same as in current method)'.
+ ]
+ ].
+ ].
+ ].
+ ].
].
note isNil ifTrue:[ ^ nil].
^ note withCRs
@@ -9414,7 +9397,7 @@
^ SelfNode value:selfValue
"/ Old code
-"/ selfNode isNil ifTrue:[
+"/ selfNode isNil ifTrue:[
"/ selfNode := SelfNode value:selfValue
"/ ].
"/ ^ selfNode
@@ -9440,14 +9423,14 @@
|m who|
contextToEvaluateIn notNil ifTrue:[
- m := contextToEvaluateIn method.
- m notNil ifTrue:[
- who := contextToEvaluateIn method who.
- who notNil ifTrue:[
- ^ who methodClass.
- ]
- ].
- "/ mhmh - might be a doIt ...
+ m := contextToEvaluateIn method.
+ m notNil ifTrue:[
+ who := contextToEvaluateIn method who.
+ who notNil ifTrue:[
+ ^ who methodClass.
+ ]
+ ].
+ "/ mhmh - might be a doIt ...
].
^ classToCompileFor
@@ -9461,20 +9444,20 @@
|names|
[
- |cls|
-
- cls := self classToLookForClassVars.
-
- (PrevClassInstVarNames isNil or:[PrevClass ~~ cls]) ifTrue:[
- PrevClass notNil ifTrue:[
- PrevClass removeDependent:Parser
- ].
- PrevClass := cls.
-
- PrevClassInstVarNames := cls class allInstVarNames.
- PrevClass addDependent:Parser.
- ].
- names := PrevClassInstVarNames.
+ |cls|
+
+ cls := self classToLookForClassVars.
+
+ (PrevClassInstVarNames isNil or:[PrevClass ~~ cls]) ifTrue:[
+ PrevClass notNil ifTrue:[
+ PrevClass removeDependent:Parser
+ ].
+ PrevClass := cls.
+
+ PrevClassInstVarNames := cls class allInstVarNames.
+ PrevClass addDependent:Parser.
+ ].
+ names := PrevClassInstVarNames.
] valueUninterruptably.
^ names
@@ -9488,25 +9471,25 @@
|names|
[
- |cls aClass|
-
- cls := self classToLookForClassVars.
-
- (PrevClassVarNames isNil or:[PrevClass ~~ cls]) ifTrue:[
- PrevClass notNil ifTrue:[
- PrevClass removeDependent:Parser
- ].
- aClass := PrevClass := cls.
- aClass isMeta ifTrue:[
- aClass := aClass soleInstance.
- aClass isNil ifTrue:[
- aClass := classToCompileFor
- ]
- ].
- PrevClassVarNames := aClass allClassVarNames.
- PrevClass addDependent:Parser.
- ].
- names := PrevClassVarNames.
+ |cls aClass|
+
+ cls := self classToLookForClassVars.
+
+ (PrevClassVarNames isNil or:[PrevClass ~~ cls]) ifTrue:[
+ PrevClass notNil ifTrue:[
+ PrevClass removeDependent:Parser
+ ].
+ aClass := PrevClass := cls.
+ aClass isMeta ifTrue:[
+ aClass := aClass soleInstance.
+ aClass isNil ifTrue:[
+ aClass := classToCompileFor
+ ]
+ ].
+ PrevClassVarNames := aClass allClassVarNames.
+ PrevClass addDependent:Parser.
+ ].
+ names := PrevClassVarNames.
] valueUninterruptably.
^ names
@@ -9521,17 +9504,17 @@
|names|
[
- (PrevInstVarNames isNil or:[PrevClass ~~ classToCompileFor]) ifTrue:[
- PrevClass notNil ifTrue:[
- PrevClass removeDependent:Parser
- ].
- PrevClass := classToCompileFor.
- PrevInstVarNames := classToCompileFor allInstVarNames.
- PrevClassInstVarNames := nil.
- PrevClassVarNames := nil.
- PrevClass addDependent:Parser
- ].
- names := PrevInstVarNames
+ (PrevInstVarNames isNil or:[PrevClass ~~ classToCompileFor]) ifTrue:[
+ PrevClass notNil ifTrue:[
+ PrevClass removeDependent:Parser
+ ].
+ PrevClass := classToCompileFor.
+ PrevInstVarNames := classToCompileFor allInstVarNames.
+ PrevClassInstVarNames := nil.
+ PrevClassVarNames := nil.
+ PrevClass addDependent:Parser
+ ].
+ names := PrevInstVarNames
] valueUninterruptably.
^ names
@@ -9542,8 +9525,8 @@
contextMustBeReturnable
"/ misusing/misinterpreting the lineNumberInfo flag is a q&d hack; there should be an extra flag
^ (parserFlags fullLineNumberInfo)
- or:[ primitiveContextInfo notNil
- and:[ primitiveContextInfo includes:('context:' -> #return) ]]
+ or:[ primitiveContextInfo notNil
+ and:[ primitiveContextInfo includes:('context:' -> #return) ]]
"Modified: / 26-09-2012 / 14:15:33 / cg"
!
@@ -9563,7 +9546,7 @@
isCompiling
"return true if compiling code as opposed to evaluating"
- ^ false
+ ^ false
!
isDoIt
@@ -9739,7 +9722,7 @@
usedSymbols
"return a collection with used symbols (except for sent messages) (valid after parsing)"
- ^ (usedSymbols ? #())
+ ^ (usedSymbols ? #())
!
usedVars
@@ -9761,10 +9744,10 @@
cls := self classToLookForClassVars.
cls isMeta ifTrue:[
- cls := cls soleInstance.
- cls isNil ifTrue:[
- cls := classToCompileFor
- ]
+ cls := cls soleInstance.
+ cls isNil ifTrue:[
+ cls := classToCompileFor
+ ]
].
^ cls whichClassDefinesClassVar:aVariableName
@@ -9828,9 +9811,9 @@
classToCompileFor := aClass.
(classToCompileFor ~~ PrevClass) ifTrue:[
- PrevClass notNil ifTrue:[
- Parser update:PrevClass
- ]
+ PrevClass notNil ifTrue:[
+ Parser update:PrevClass
+ ]
]
!
@@ -9846,9 +9829,9 @@
selfValue := anObject.
classToCompileFor := anObject class.
(classToCompileFor ~~ PrevClass) ifTrue:[
- PrevClass notNil ifTrue:[
- Parser update:PrevClass
- ]
+ PrevClass notNil ifTrue:[
+ Parser update:PrevClass
+ ]
]
!
@@ -9888,136 +9871,136 @@
!Parser methodsFor:'statistic'!
-rememberClassVarModified:name
+rememberClassVarModified:name
modifiedClassVars isNil ifTrue:[
- modifiedClassVars := Set new
+ modifiedClassVars := Set new
].
modifiedClassVars add:name.
self rememberClassVarUsed:name
!
-rememberClassVarRead:name
+rememberClassVarRead:name
readClassVars isNil ifTrue:[
- readClassVars := Set new
+ readClassVars := Set new
].
readClassVars add:name.
self rememberClassVarUsed:name
!
-rememberClassVarUsed:name
+rememberClassVarUsed:name
usedClassVars isNil ifTrue:[
- usedClassVars := Set new
+ usedClassVars := Set new
].
usedClassVars add:name.
self rememberVariableUsed:name
!
-rememberGlobalModified:name
+rememberGlobalModified:name
modifiedGlobals isNil ifTrue:[
- modifiedGlobals := Set new
+ modifiedGlobals := Set new
].
modifiedGlobals add:name.
self rememberGlobalUsed:name.
!
-rememberGlobalRead:name
+rememberGlobalRead:name
readGlobals isNil ifTrue:[
- readGlobals := Set new
+ readGlobals := Set new
].
readGlobals add:name.
self rememberGlobalUsed:name
!
-rememberGlobalUsed:name
+rememberGlobalUsed:name
usedGlobals isNil ifTrue:[
- usedGlobals := Set new
+ usedGlobals := Set new
].
usedGlobals add:name.
self rememberVariableUsed:name
!
-rememberInstVarModified:name
+rememberInstVarModified:name
modifiedInstVars isNil ifTrue:[
- modifiedInstVars := Set new
+ modifiedInstVars := Set new
].
modifiedInstVars add:name.
self rememberInstVarUsed:name.
!
-rememberInstVarRead:name
+rememberInstVarRead:name
readInstVars isNil ifTrue:[
- readInstVars := Set new
+ readInstVars := Set new
].
readInstVars add:name.
self rememberVariableUsed:name
!
-rememberInstVarUsed:name
+rememberInstVarUsed:name
usedInstVars isNil ifTrue:[
- usedInstVars := Set new
+ usedInstVars := Set new
].
usedInstVars add:name.
self rememberVariableUsed:name
!
-rememberLocalUsed:name
+rememberLocalUsed:name
usedLocalVars isNil ifTrue:[
- usedLocalVars := Set new
+ usedLocalVars := Set new
].
usedLocalVars add:name.
!
-rememberPoolVarModified:name
+rememberPoolVarModified:name
modifiedPoolVars isNil ifTrue:[
- modifiedPoolVars := Set new
+ modifiedPoolVars := Set new
].
modifiedPoolVars add:name.
self rememberPoolVarUsed:name.
!
-rememberPoolVarRead:name
+rememberPoolVarRead:name
readPoolVars isNil ifTrue:[
- readPoolVars := Set new
+ readPoolVars := Set new
].
readPoolVars add:name.
self rememberPoolVarUsed:name
!
-rememberPoolVarUsed:name
+rememberPoolVarUsed:name
usedPoolVars isNil ifTrue:[
- usedPoolVars := Set new
+ usedPoolVars := Set new
].
usedPoolVars add:name.
self rememberVariableUsed:name
!
-rememberReturnedValue:anExpressionNode
+rememberReturnedValue:anExpressionNode
|expr|
returnedValues isNil ifTrue:[returnedValues := Set new].
expr := anExpressionNode.
expr isAssignment ifTrue:[
- expr := expr expression.
+ expr := expr expression.
].
(expr isConstant or:[expr isSelf]) ifTrue:[
- returnedValues add:expr
+ returnedValues add:expr
].
!
rememberSelectorPossiblyUsed:sel
messagesPossiblySent isNil ifTrue:[
- messagesPossiblySent := IdentitySet new.
- ].
- messagesPossiblySent add:sel
+ messagesPossiblySent := IdentitySet new.
+ ].
+ messagesPossiblySent add:sel
!
rememberSelectorUsed:sel
messagesSent isNil ifTrue:[
- messagesSent := IdentitySet new.
- ].
- messagesSent add:sel
+ messagesSent := IdentitySet new.
+ ].
+ messagesSent add:sel
!
rememberSelectorUsed:selectorArg receiver:receiverNode
@@ -10026,11 +10009,11 @@
sel := selectorArg asSymbol.
self rememberSelectorUsed:sel.
receiverNode isSuper ifTrue:[
- self rememberSelectorUsedInSuperSend:sel
+ self rememberSelectorUsedInSuperSend:sel
] ifFalse:[
- receiverNode isSelf ifTrue:[
- self rememberSelectorUsedInSelfSend:sel
- ].
+ receiverNode isSelf ifTrue:[
+ self rememberSelectorUsedInSelfSend:sel
+ ].
].
!
@@ -10040,38 +10023,38 @@
sel := selectorArg asSymbol.
self rememberSelectorUsed:sel receiver:receiverNode.
(sel startsWith:'perform:') ifTrue:[
- args first isConstant ifTrue:[
- (selPerformed := args first value) isSymbol ifTrue:[
- self rememberSelectorPossiblyUsed:selPerformed
- ]
- ]
+ args first isConstant ifTrue:[
+ (selPerformed := args first value) isSymbol ifTrue:[
+ self rememberSelectorPossiblyUsed:selPerformed
+ ]
+ ]
].
!
rememberSelectorUsedInSelfSend:sel
messagesSentToSelf isNil ifTrue:[
- messagesSentToSelf := IdentitySet new.
+ messagesSentToSelf := IdentitySet new.
].
messagesSentToSelf add:sel
!
rememberSelectorUsedInSuperSend:sel
messagesSentToSuper isNil ifTrue:[
- messagesSentToSuper := IdentitySet new.
+ messagesSentToSuper := IdentitySet new.
].
messagesSentToSuper add:sel
!
rememberSymbolUsed:aSymbol
usedSymbols isNil ifTrue:[
- usedSymbols := IdentitySet new.
- ].
- usedSymbols add:aSymbol
-!
-
-rememberVariableUsed:name
+ usedSymbols := IdentitySet new.
+ ].
+ usedSymbols add:aSymbol
+!
+
+rememberVariableUsed:name
usedVars isNil ifTrue:[
- usedVars := Set new
+ usedVars := Set new
].
usedVars add:name
! !
@@ -10103,7 +10086,7 @@
"Created: / 20-10-2010 / 18:27:24 / cg"
!
-parser:parserArg nameOfUnknownVariable:nameOfUnknownVariableArg
+parser:parserArg nameOfUnknownVariable:nameOfUnknownVariableArg
parser := parserArg.
nameOfUnknownVariable := nameOfUnknownVariableArg.
@@ -10138,33 +10121,33 @@
"/ currentBlock notNil ifTrue:[
"/ list add: #BlockVariable.
"/ ].
- parser selector notNil ifTrue:[
- list add: #MethodVariable.
- ].
- (classToCompileFor notNil
- and:[classToCompileFor isMeta not
- and:[classToCompileFor isBuiltInClass not
- and:[(parser isDoIt not)]]]) ifTrue:[
- list add: #InstanceVariable.
- ].
+ parser selector notNil ifTrue:[
+ list add: #MethodVariable.
+ ].
+ (classToCompileFor notNil
+ and:[classToCompileFor isMeta not
+ and:[classToCompileFor isBuiltInClass not
+ and:[(parser isDoIt not)]]]) ifTrue:[
+ list add: #InstanceVariable.
+ ].
] ifFalse:[
- list addAll: #( NewClass GlobalVariable NameSpace ).
-
- (classToCompileFor notNil
- and:[classToCompileFor isBuiltInClass not
- and:[parser isDoIt not]]) ifTrue:[
- classToCompileFor isMeta ifTrue:[
- list add: #ClassInstanceVariable.
- ].
- list addAll: #( #ClassVariable #PrivateClass ).
- ]
+ list addAll: #( NewClass GlobalVariable NameSpace ).
+
+ (classToCompileFor notNil
+ and:[classToCompileFor isBuiltInClass not
+ and:[parser isDoIt not]]) ifTrue:[
+ classToCompileFor isMeta ifTrue:[
+ list add: #ClassInstanceVariable.
+ ].
+ list addAll: #( #ClassVariable #PrivateClass ).
+ ]
].
parser isDoIt ifTrue:[
- l size > 0 ifTrue:[
- list add: nil.
- ].
- list addAll: #( WorkspaceVariable DoItTemporary ).
+ l size > 0 ifTrue:[
+ list add: nil.
+ ].
+ list addAll: #( WorkspaceVariable DoItTemporary ).
].
^ list
@@ -10178,19 +10161,19 @@
|valueList menuLabels popupMenu choiceIndex typeChoice|
list notEmptyOrNil ifTrue:[
- menuLabels := self userfriendlyMenuItemNameListFor:list.
-
- menuLabels := (Array
- with:('Declare ' , nameOfUnknownVariable allBold , ' as:')
- with:'-'
- ) , menuLabels.
- valueList := #(nil nil) , list.
- popupMenu := PopUpMenu labels:menuLabels.
-
- choiceIndex := popupMenu startUp.
- (choiceIndex notNil and:[choiceIndex > 0]) ifTrue:[
- typeChoice := valueList at:choiceIndex.
- ].
+ menuLabels := self userfriendlyMenuItemNameListFor:list.
+
+ menuLabels := (Array
+ with:('Declare ' , nameOfUnknownVariable allBold , ' as:')
+ with:'-'
+ ) , menuLabels.
+ valueList := #(nil nil) , list.
+ popupMenu := PopUpMenu labels:menuLabels.
+
+ choiceIndex := popupMenu startUp.
+ (choiceIndex notNil and:[choiceIndex > 0]) ifTrue:[
+ typeChoice := valueList at:choiceIndex.
+ ].
].
^ typeChoice
@@ -10199,44 +10182,44 @@
!
userfriendlyMenuItemNameFor:varType
- varType = #BlockVariable ifTrue:[
- ^ 'Block Local'
- ].
- varType = #MethodVariable ifTrue:[
- ^ 'Method Local Variable'
- ].
- varType = #InstanceVariable ifTrue:[
- ^ 'Instance Variable'
- ].
- varType = #NewClass ifTrue:[
- ^ 'New Class'
- ].
- varType = #GlobalVariable ifTrue:[
- ^ 'Global'
- ].
- varType = #NameSpace ifTrue:[
- ^ 'NameSpace'
- ].
- varType = #ClassInstanceVariable ifTrue:[
- ^ 'Class Instance Variable'
+ varType = #BlockVariable ifTrue:[
+ ^ 'Block Local'
+ ].
+ varType = #MethodVariable ifTrue:[
+ ^ 'Method Local Variable'
+ ].
+ varType = #InstanceVariable ifTrue:[
+ ^ 'Instance Variable'
+ ].
+ varType = #NewClass ifTrue:[
+ ^ 'New Class'
+ ].
+ varType = #GlobalVariable ifTrue:[
+ ^ 'Global'
+ ].
+ varType = #NameSpace ifTrue:[
+ ^ 'NameSpace'
+ ].
+ varType = #ClassInstanceVariable ifTrue:[
+ ^ 'Class Instance Variable'
].
varType = #ClassVariable ifTrue:[
- (self classToCompileFor notNil and:[self classToCompileFor theNonMetaclass isSharedPool]) ifTrue:[
- ^ 'Pool Constant (= Class Variable)'
- ].
- ^ 'Class Variable'
- ].
- varType = #PrivateClass ifTrue:[
- ^ 'Private Class'
- ].
- varType = #WorkspaceVariable ifTrue:[
- ^ 'Workspace Variable'
- ].
- varType = #DoItTemporary ifTrue:[
- ^ 'DoIt Temporary'
- ].
- varType isNil ifTrue:[
- ^ '-'
+ (self classToCompileFor notNil and:[self classToCompileFor theNonMetaclass isSharedPool]) ifTrue:[
+ ^ 'Pool Constant (= Class Variable)'
+ ].
+ ^ 'Class Variable'
+ ].
+ varType = #PrivateClass ifTrue:[
+ ^ 'Private Class'
+ ].
+ varType = #WorkspaceVariable ifTrue:[
+ ^ 'Workspace Variable'
+ ].
+ varType = #DoItTemporary ifTrue:[
+ ^ 'DoIt Temporary'
+ ].
+ varType isNil ifTrue:[
+ ^ '-'
].
^ varType
@@ -10246,7 +10229,7 @@
userfriendlyMenuItemNameListFor:listOfPossibleVariableTypes
^ listOfPossibleVariableTypes
- collect:[:varType | self userfriendlyMenuItemNameFor:varType]
+ collect:[:varType | self userfriendlyMenuItemNameFor:varType]
"Created: / 20-10-2010 / 18:42:13 / cg"
! !
@@ -10265,10 +10248,10 @@
!Parser::PrimitiveSpecParser methodsFor:'parsing'!
parseSTVExternalFunctionDeclarationFrom:aStream definitionType:definitionType lineNr:lineNr for:aParserOrNil
- "parses ST/V function declarations of the forms
- '<api: functionName argType1 .. argTypeN returnType>'
- '<ccall: functionName argType1 .. argTypeN returnType>'
- '<ole: [async] vFunctionIndex argType1 .. argTypeN returnType>'
+ "parses ST/V function declarations of the forms
+ '<api: functionName argType1 .. argTypeN returnType>'
+ '<ccall: functionName argType1 .. argTypeN returnType>'
+ '<ole: [async] vFunctionIndex argType1 .. argTypeN returnType>'
"
|returnType functionName argTypes function virtualFunctionIndex isAsync|
@@ -10279,62 +10262,62 @@
self nextToken.
((tokenType == #Identifier) and:[ token = 'async' ]) ifTrue:[
- self nextToken.
- isAsync := true
+ self nextToken.
+ isAsync := true
] ifFalse:[
- isAsync := false
+ isAsync := false
].
(definitionType = 'ole:') ifTrue:[
- (tokenType == #Integer) ifFalse:[
- self parseError:'virtual function number expected (got ' , token printString , ')'.
- ].
- virtualFunctionIndex := token.
- self nextToken.
- ] ifFalse:[
- (tokenType == #String) ifTrue:[
- functionName := tokenValue.
- ] ifFalse:[
- (tokenType == #Identifier) ifTrue:[
- functionName := token.
- ] ifFalse:[
- self parseError:'function identifier expected (got ' , token printString , ')'.
- ].
- ].
- self nextToken.
-
- functionName isAlphaNumeric ifFalse:[
- "/ mhm a newer squeak definition in the form 'extern void warning(char *s)'
- self parseError:'cannot (yet) parse new style squeak external functions'.
- ^ nil
- ].
+ (tokenType == #Integer) ifFalse:[
+ self parseError:'virtual function number expected (got ' , token printString , ')'.
+ ].
+ virtualFunctionIndex := token.
+ self nextToken.
+ ] ifFalse:[
+ (tokenType == #String) ifTrue:[
+ functionName := tokenValue.
+ ] ifFalse:[
+ (tokenType == #Identifier) ifTrue:[
+ functionName := token.
+ ] ifFalse:[
+ self parseError:'function identifier expected (got ' , token printString , ')'.
+ ].
+ ].
+ self nextToken.
+
+ functionName isAlphaNumeric ifFalse:[
+ "/ mhm a newer squeak definition in the form 'extern void warning(char *s)'
+ self parseError:'cannot (yet) parse new style squeak external functions'.
+ ^ nil
+ ].
].
argTypes := OrderedCollection new.
[ token notNil and:[ (token ~= '>') and:[ (tokenType ~~ #BinaryOperator) or:[tokenName ~= '>']]]] whileTrue:[
- argTypes add:(self typeMappingFor:token).
- self nextToken.
+ argTypes add:(self typeMappingFor:token).
+ self nextToken.
].
returnType := argTypes last.
argTypes := argTypes copyWithoutLast:1.
- function := ExternalLibraryFunction
- name:(functionName ? virtualFunctionIndex)
- module:nil
- returnType:returnType
- argumentTypes:argTypes asArray.
+ function := ExternalLibraryFunction
+ name:(functionName ? virtualFunctionIndex)
+ module:nil
+ returnType:returnType
+ argumentTypes:argTypes asArray.
(definitionType = 'api:') ifTrue:[
- function beCallTypeAPI
- ] ifFalse:[
- (definitionType = 'ole:') ifTrue:[
- function beCallTypeOLE
- ] ifFalse:[
- function beCallTypeC
- ].
+ function beCallTypeAPI
+ ] ifFalse:[
+ (definitionType = 'ole:') ifTrue:[
+ function beCallTypeOLE
+ ] ifFalse:[
+ function beCallTypeC
+ ].
].
isAsync ifTrue:[
- function beAsync
+ function beAsync
].
^ function
@@ -10343,16 +10326,16 @@
!
parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:aStream definitionType:definitionType lineNr:lineNrArg for: aParserOrNil
- "parses squeak/dolphin function declarations of the forms
- '<stdcall: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN>'
- '<cdecl: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN>'
-
- '<cdecl: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName >'
- '<apicall: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName >'
+ "parses squeak/dolphin function declarations of the forms
+ '<stdcall: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN>'
+ '<cdecl: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN>'
+
+ '<cdecl: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName >'
+ '<apicall: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName >'
"
|isVirtualCall isNonVirtualCall isAsyncCall isUnlimitedStack isConst scanningCallModifiers
- returnType functionName virtualFunctionIndex argTypes moduleName argType function
+ returnType functionName virtualFunctionIndex argTypes moduleName argType function
parentized thisType|
masterParser := aParserOrNil.
@@ -10364,130 +10347,130 @@
self nextToken.
- scanningCallModifiers := true.
- [scanningCallModifiers] whileTrue:[
- scanningCallModifiers := false.
- (tokenType == #Identifier) ifTrue:[
- (token = 'async') ifTrue:[
- self nextToken.
- isAsyncCall := true.
- scanningCallModifiers := true.
- ] ifFalse:[ (token = 'virtual') ifTrue:[
- self nextToken.
- isVirtualCall := true.
- scanningCallModifiers := true.
- ] ifFalse:[ (token = 'nonVirtual') ifTrue:[
- self nextToken.
- isNonVirtualCall := true.
- scanningCallModifiers := true.
- ] ifFalse:[ (token = 'unlimitedStack') ifTrue:[
- self nextToken.
- isUnlimitedStack := true.
- scanningCallModifiers := true.
- ] ifFalse:[ (token = 'const') ifTrue:[
- self nextToken.
- isConst := true.
- scanningCallModifiers := true.
- ]]]]]
- ]
+ scanningCallModifiers := true.
+ [scanningCallModifiers] whileTrue:[
+ scanningCallModifiers := false.
+ (tokenType == #Identifier) ifTrue:[
+ (token = 'async') ifTrue:[
+ self nextToken.
+ isAsyncCall := true.
+ scanningCallModifiers := true.
+ ] ifFalse:[ (token = 'virtual') ifTrue:[
+ self nextToken.
+ isVirtualCall := true.
+ scanningCallModifiers := true.
+ ] ifFalse:[ (token = 'nonVirtual') ifTrue:[
+ self nextToken.
+ isNonVirtualCall := true.
+ scanningCallModifiers := true.
+ ] ifFalse:[ (token = 'unlimitedStack') ifTrue:[
+ self nextToken.
+ isUnlimitedStack := true.
+ scanningCallModifiers := true.
+ ] ifFalse:[ (token = 'const') ifTrue:[
+ self nextToken.
+ isConst := true.
+ scanningCallModifiers := true.
+ ]]]]]
+ ]
].
returnType := self parseTypeSpec.
isVirtualCall ifTrue:[
- tokenType ~~ #Integer ifTrue:[
- (masterParser ? self) ignorableParseError:'invalid cdecl - virtual function index expected'.
- ^ nil
- ].
- virtualFunctionIndex := token.
- self nextToken.
+ tokenType ~~ #Integer ifTrue:[
+ (masterParser ? self) ignorableParseError:'invalid cdecl - virtual function index expected'.
+ ^ nil
+ ].
+ virtualFunctionIndex := token.
+ self nextToken.
] ifFalse:[
- tokenType ~~ #String ifTrue:[
- (masterParser ? self) ignorableParseError:'invalid cdecl - functionName expected'.
- ^ nil
- ].
- functionName := token asSymbol.
- self nextToken.
+ tokenType ~~ #String ifTrue:[
+ (masterParser ? self) ignorableParseError:'invalid cdecl - functionName expected'.
+ ^ nil
+ ].
+ functionName := token asSymbol.
+ self nextToken.
].
tokenType = $( ifTrue:[
- parentized := true.
- self nextToken.
+ parentized := true.
+ self nextToken.
] ifFalse:[
- parentized := false.
+ parentized := false.
].
argTypes := OrderedCollection new.
[ tokenType == #EOF
or:[ parentized and:[tokenType = $) ]] ] whileFalse:[
- argType := self parseTypeSpec.
- argTypes add:argType.
- (tokenType = $,
- or:[ tokenType == #BinaryOperator and:[token = ','] ]) ifTrue:[
- self nextToken
- ]
+ argType := self parseTypeSpec.
+ argTypes add:argType.
+ (tokenType = $,
+ or:[ tokenType == #BinaryOperator and:[token = ','] ]) ifTrue:[
+ self nextToken
+ ]
].
tokenType = $) ifTrue:[
- self nextToken.
+ self nextToken.
].
((tokenType == #Identifier and:[token = 'module'])
or:[tokenType == #Keyword and:[ token = 'module:']]) ifTrue:[
- self nextToken.
- tokenType == $: ifTrue:[
- self nextToken.
- ].
-
- tokenType ~~ #String ifTrue:[
- (masterParser ? self) ignorableParseError:'Invalid declaration - moduleName expected'.
- ^ nil
- ].
- moduleName := token asSymbol.
+ self nextToken.
+ tokenType == $: ifTrue:[
+ self nextToken.
+ ].
+
+ tokenType ~~ #String ifTrue:[
+ (masterParser ? self) ignorableParseError:'Invalid declaration - moduleName expected'.
+ ^ nil
+ ].
+ moduleName := token asSymbol.
].
(argTypes size == 1 and:[argTypes first == #void "isCVoid"]) ifTrue:[
- argTypes := #()
+ argTypes := #()
].
isNonVirtualCall ifTrue:[
- (classToCompileFor isSubclassOf:ExternalStructure) ifTrue:[
- thisType := classToCompileFor name.
-"/ (thisType := classToCompileFor cType) isNil ifTrue:[
+ (classToCompileFor isSubclassOf:ExternalStructure) ifTrue:[
+ thisType := classToCompileFor name.
+"/ (thisType := classToCompileFor cType) isNil ifTrue:[
"/ "/ self warning:'missing CType definition in ' , tok printString.
"/ thisType := CType newStructType.
"/ thisType name:(classToCompileFor nameWithoutPrefix).
"/ thisType := CType pointerTypeClass new baseType:thisType.
"/ ].
- ].
- thisType := thisType ? #pointer.
- argTypes := (Array with:thisType) , argTypes.
- ].
-
- function := ExternalLibraryFunction
- name:(functionName ? virtualFunctionIndex)
- module:moduleName
- returnType:returnType
- argumentTypes:argTypes asArray.
+ ].
+ thisType := thisType ? #pointer.
+ argTypes := (Array with:thisType) , argTypes.
+ ].
+
+ function := ExternalLibraryFunction
+ name:(functionName ? virtualFunctionIndex)
+ module:moduleName
+ returnType:returnType
+ argumentTypes:argTypes asArray.
(definitionType = 'apicall:') ifTrue:[
- function beCallTypeAPI
- ] ifFalse:[
- (definitionType = 'olecall:') ifTrue:[
- function beCallTypeOLE
- ] ifFalse:[
- function beCallTypeC
- ].
+ function beCallTypeAPI
+ ] ifFalse:[
+ (definitionType = 'olecall:') ifTrue:[
+ function beCallTypeOLE
+ ] ifFalse:[
+ function beCallTypeC
+ ].
].
isNonVirtualCall ifTrue:[
- function beNonVirtualCPP
+ function beNonVirtualCPP
].
isAsyncCall ifTrue:[
- function beAsync
+ function beAsync
].
isUnlimitedStack ifTrue:[
- function beUnlimitedStack
+ function beUnlimitedStack
].
isConst ifTrue:[
- function beConstReturnValue
+ function beConstReturnValue
].
^ function
@@ -10502,79 +10485,79 @@
self nextToken.
((tokenType == #'::') or:[(tokenType == #'.')]) ifTrue:[
- "/ namespace...
- [(tokenType == #'::') or:[(tokenType == #'.')]] whileTrue:[
- typeName := typeName , '::'.
- self nextToken.
- tokenType ~~ #Identifier ifTrue:[
- (masterParser ? self) parseError:'invalid type identifier'.
- ].
- typeName := typeName , token.
- self nextToken.
- ]
+ "/ namespace...
+ [(tokenType == #'::') or:[(tokenType == #'.')]] whileTrue:[
+ typeName := typeName , '::'.
+ self nextToken.
+ tokenType ~~ #Identifier ifTrue:[
+ (masterParser ? self) parseError:'invalid type identifier'.
+ ].
+ typeName := typeName , token.
+ self nextToken.
+ ]
].
(tokenType == #Identifier and:[tokenName = 'long']) ifTrue:[
- "/ long long
- (type = 'long') ifTrue:[
- "/ long long
- typeName := 'longLong'.
- self nextToken.
- ].
- "/ unsigned long
- (type = 'unsigned') ifTrue:[
- "/ unsigned long
- typeName := 'ulong'.
- self nextToken.
- ].
+ "/ long long
+ (type = 'long') ifTrue:[
+ "/ long long
+ typeName := 'longLong'.
+ self nextToken.
+ ].
+ "/ unsigned long
+ (type = 'unsigned') ifTrue:[
+ "/ unsigned long
+ typeName := 'ulong'.
+ self nextToken.
+ ].
].
(tokenType == #Identifier and:[tokenName = 'int']) ifTrue:[
- "/ long long int
- "/ unsigned int
- "/ long int
- ( #('longLong' 'unsigned' 'long') includes: typeName) ifTrue:[
- self nextToken.
- ].
+ "/ long long int
+ "/ unsigned int
+ "/ long int
+ ( #('longLong' 'unsigned' 'long') includes: typeName) ifTrue:[
+ self nextToken.
+ ].
].
(tokenType == #Identifier and:[tokenName = 'unsigned']) ifTrue:[
- "/ long long unsigned
- "/ int unsigned
- "/ long unsigned
- ( #('longLong' 'int' 'long') includes: typeName) ifTrue:[
- typeName := 'u',typeName.
- self nextToken.
- ].
+ "/ long long unsigned
+ "/ int unsigned
+ "/ long unsigned
+ ( #('longLong' 'int' 'long') includes: typeName) ifTrue:[
+ typeName := 'u',typeName.
+ self nextToken.
+ ].
].
type := self typeMappingFor:typeName.
[
- (tokenType = $*)
- or:[((tokenType == #BinaryOperator) and:[tokenName conform:[:ch | ch = $*]])]
+ (tokenType = $*)
+ or:[((tokenType == #BinaryOperator) and:[tokenName conform:[:ch | ch = $*]])]
] whileTrue:[
- "/ that many indirections added
- tokenName size timesRepeat:[
- type := self pointerTypeMappingFor:type.
- ].
- self nextToken.
+ "/ that many indirections added
+ tokenName size timesRepeat:[
+ type := self pointerTypeMappingFor:type.
+ ].
+ self nextToken.
].
type isUppercaseFirst ifTrue:[
- (ns := classToCompileFor nameSpace) notNil ifTrue:[
- cls := ns at:type.
- ].
- cls isNil ifTrue:[
- cls := Smalltalk at:type.
- ].
- cls isNil ifTrue:[
- (masterParser ? self) ignorableParseError:'possibly unknown type: ', type allBold.
- ] ifFalse:[
- cls autoload.
- (cls isSubclassOf:ExternalBytes) ifFalse:[
- (masterParser ? self) ignorableParseError:'possibly wrong type: ', type allBold.
- ].
- type := cls name.
- ].
+ (ns := classToCompileFor nameSpace) notNil ifTrue:[
+ cls := ns at:type.
+ ].
+ cls isNil ifTrue:[
+ cls := Smalltalk at:type.
+ ].
+ cls isNil ifTrue:[
+ (masterParser ? self) ignorableParseError:'possibly unknown type: ', type allBold.
+ ] ifFalse:[
+ cls autoload.
+ (cls isSubclassOf:ExternalBytes) ifFalse:[
+ (masterParser ? self) ignorableParseError:'possibly wrong type: ', type allBold.
+ ].
+ type := cls name.
+ ].
].
^ type
@@ -10583,9 +10566,9 @@
!
parseVWTypeOrExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr for:aParserOrNil
- "parses visualWorks type/function declarations of the form:
- '<c: ...>'
- '<c: #define NAME value>'"
+ "parses visualWorks type/function declarations of the form:
+ '<c: ...>'
+ '<c: #define NAME value>'"
|cParser moduleName type name val
nameAndFunctionOrType functionOrType function libName|
@@ -10595,37 +10578,37 @@
self source:aStream.
self nextToken.
((tokenType == #Symbol) and:[token = #define]) ifTrue:[
- self nextToken.
- (tokenType == #Identifier) ifFalse:[
- (masterParser ? self) ignorableParseError:'invalid cdecl - identifier expected'.
- self generateTrapCodeForUnavailableCParser.
- ^ nil.
- ].
- name := token.
- self nextToken.
- "/ for now, only allow integer, string or floats.
- (#(Integer String Float) includes:tokenType) ifTrue:[
- ^ token
- ].
- tokenType == $( ifTrue:[
- self nextToken.
- (#(Integer String Float) includes:tokenType) ifTrue:[
- val := token.
- self nextToken.
- tokenType == $) ifTrue:[ ^ val ].
- ].
- ].
-
- (masterParser ? self) ignorableParseError:'invalid cdecl - integer, float or string expected'.
- self generateTrapCodeForUnavailableCParser.
- ^ nil.
+ self nextToken.
+ (tokenType == #Identifier) ifFalse:[
+ (masterParser ? self) ignorableParseError:'invalid cdecl - identifier expected'.
+ self generateTrapCodeForUnavailableCParser.
+ ^ nil.
+ ].
+ name := token.
+ self nextToken.
+ "/ for now, only allow integer, string or floats.
+ (#(Integer String Float) includes:tokenType) ifTrue:[
+ ^ token
+ ].
+ tokenType == $( ifTrue:[
+ self nextToken.
+ (#(Integer String Float) includes:tokenType) ifTrue:[
+ val := token.
+ self nextToken.
+ tokenType == $) ifTrue:[ ^ val ].
+ ].
+ ].
+
+ (masterParser ? self) ignorableParseError:'invalid cdecl - integer, float or string expected'.
+ self generateTrapCodeForUnavailableCParser.
+ ^ nil.
].
aStream reset.
CParser isNil ifTrue:[
- self generateTrapCodeForUnavailableCParser.
- ^ nil.
+ self generateTrapCodeForUnavailableCParser.
+ ^ nil.
].
cParser := CParser new.
@@ -10635,43 +10618,43 @@
cParser nextToken.
cParser tokenType == #struct ifTrue:[
- type := cParser type.
+ type := cParser type.
] ifFalse:[
- cParser tokenType == #typedef ifTrue:[
- type := cParser typedef.
- ] ifFalse:[
- nameAndFunctionOrType := cParser typeOrFunctionDeclaration.
- functionOrType := nameAndFunctionOrType second.
- functionOrType isCFunction ifFalse:[
- type := functionOrType.
- function := nil.
- ] ifTrue:[
- function := functionOrType.
- type := nil.
- ].
- ]
+ cParser tokenType == #typedef ifTrue:[
+ type := cParser typedef.
+ ] ifFalse:[
+ nameAndFunctionOrType := cParser typeOrFunctionDeclaration.
+ functionOrType := nameAndFunctionOrType second.
+ functionOrType isCFunction ifFalse:[
+ type := functionOrType.
+ function := nil.
+ ] ifTrue:[
+ function := functionOrType.
+ type := nil.
+ ].
+ ]
].
cParser token notNil ifTrue:[
- (masterParser ? self) ignorableParseError:'invalid cdecl - nothing more expected'.
- ^ nil.
+ (masterParser ? self) ignorableParseError:'invalid cdecl - nothing more expected'.
+ ^ nil.
].
type notNil ifTrue:[
- ^ type.
+ ^ type.
].
moduleName isNil ifTrue:[
self halt.
- libName := classToCompileFor theNonMetaclass perform:#libraryName ifNotUnderstood:'unknown'.
- moduleName := libName asSymbol.
- ].
-
- function := ExternalLibraryFunction
- name:function name
- module:moduleName
- returnType:function returnType
- argumentTypes:function argumentTypes asArray.
-
- function beCallTypeC.
+ libName := classToCompileFor theNonMetaclass perform:#libraryName ifNotUnderstood:'unknown'.
+ moduleName := libName asSymbol.
+ ].
+
+ function := ExternalLibraryFunction
+ name:function name
+ module:moduleName
+ returnType:function returnType
+ argumentTypes:function argumentTypes asArray.
+
+ function beCallTypeC.
^ function
"Created: / 01-08-2006 / 16:18:05 / cg"
@@ -10686,39 +10669,39 @@
|e cls|
e := #(
- (void voidPointer )
- (char charPointer )
- (byte bytePointer )
- (uint8 uint8Pointer )
- (uint16 uint16Pointer )
- (uint32 uint32Pointer )
- (uint64 uint64Pointer )
- (int8 int8Pointer )
- (int16 int16Pointer )
- (int32 int32Pointer )
- (int64 int64Pointer )
- (int intPointer )
- (short shortPointer )
- (ushort ushortPointer )
- (long longPointer )
- (uint uintPointer )
- (ulong ulongPointer )
- (float floatPointer )
- (double doublePointer )
+ (void voidPointer )
+ (char charPointer )
+ (byte bytePointer )
+ (uint8 uint8Pointer )
+ (uint16 uint16Pointer )
+ (uint32 uint32Pointer )
+ (uint64 uint64Pointer )
+ (int8 int8Pointer )
+ (int16 int16Pointer )
+ (int32 int32Pointer )
+ (int64 int64Pointer )
+ (int intPointer )
+ (short shortPointer )
+ (ushort ushortPointer )
+ (long longPointer )
+ (uint uintPointer )
+ (ulong ulongPointer )
+ (float floatPointer )
+ (double doublePointer )
) detect:[:p | p first = aTypeSymbol] ifNone:nil.
e notNil ifTrue:[
- ^ e second
+ ^ e second
].
cls := Smalltalk classNamed:aTypeSymbol.
cls notNil ifTrue:[
- (cls isSubclassOf:ExternalStructure) ifTrue:[
- ^ #pointer
- ].
+ (cls isSubclassOf:ExternalStructure) ifTrue:[
+ ^ #pointer
+ ].
].
(aTypeSymbol endsWith:'Pointer') ifTrue:[
- ^ aTypeSymbol , 'Pointer'
+ ^ aTypeSymbol , 'Pointer'
].
(masterParser ? self) ignorableParseError:'missing pointer type mapping for type: ', aTypeSymbol allBold.
@@ -10732,35 +10715,35 @@
|e|
e := #(
- (short int16 )
- (long int32 )
- (int int32 )
- (ushort uint16 )
- (ulong uint32 )
- (unsignedByte uint8 )
- (unsignedChar uint8 )
- (unsignedShort uint16 )
- (unsignedLong uint32 )
- (double double )
- (float float )
- (char char )
- (uchar uint8 )
- (byte uint8 )
- (void void )
- (bool bool )
- (boolean bool )
- (dword uint32 )
- (sdword int32 )
- (word uint16 )
- (sword int16 )
- (handle voidPointer )
- (lpstr charPointer )
- (hresult uint32 )
- (ulongReturn uint32 )
- (none void )
- (struct voidPointer )
- (structIn voidPointer )
- (structOut voidPointer )
+ (short int16 )
+ (long int32 )
+ (int int32 )
+ (ushort uint16 )
+ (ulong uint32 )
+ (unsignedByte uint8 )
+ (unsignedChar uint8 )
+ (unsignedShort uint16 )
+ (unsignedLong uint32 )
+ (double double )
+ (float float )
+ (char char )
+ (uchar uint8 )
+ (byte uint8 )
+ (void void )
+ (bool bool )
+ (boolean bool )
+ (dword uint32 )
+ (sdword int32 )
+ (word uint16 )
+ (sword int16 )
+ (handle voidPointer )
+ (lpstr charPointer )
+ (hresult uint32 )
+ (ulongReturn uint32 )
+ (none void )
+ (struct voidPointer )
+ (structIn voidPointer )
+ (structOut voidPointer )
) detect:[:p | p first = aTypeSymbol] ifNone:nil.
e notNil ifTrue:[ ^ e second ].
@@ -10776,7 +10759,7 @@
"/ ].
"/ cls notNil ifTrue:[
"/ (cls isSubclassOf:ExternalStructure) ifTrue:[
-"/ (cType := cls cType) isNil ifTrue:[
+"/ (cType := cls cType) isNil ifTrue:[
"/ "/ self warning:'missing CType definition in ' , tok printString.
"/ cType := CType newStructType.
"/ cType name:cls name.
@@ -10809,36 +10792,14 @@
"Created: / 01-08-2006 / 14:54:48 / cg"
! !
-!Parser::UndefinedVariableNotification methodsFor:'accessing'!
-
-description
- ^ 'undefined variable: ' , self variableName
-!
-
-parser
- "return the value of the instance variable 'parser' (automatically generated)"
-
- ^ parser
-!
-
-parser:something
- "set the value of the instance variable 'parser' (automatically generated)"
-
- parser := something.
-!
-
-variableName
- ^ parameter
-! !
-
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.742 2013-04-03 17:56:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.743 2013-04-03 21:20:57 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.742 2013-04-03 17:56:40 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.743 2013-04-03 21:20:57 cg Exp $'
!
version_SVN