--- a/Parser.st Mon Feb 02 17:17:17 2015 +0100
+++ b/Parser.st Mon Feb 02 18:45:40 2015 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -36,7 +36,8 @@
didWarnAboutSqueakExtensions allowUndeclaredVariables
interactiveMode variableCorrectActionForAll annotations
variableTypeOfLastCorrectAction usedPoolVars readPoolVars
- modifiedPoolVars warnings didWarnAboutSTXExtensions'
+ modifiedPoolVars warnings didWarnAboutSTXExtensions
+annotationStartPosition annotationEndPosition'
classVariableNames:'PrevClass PrevInstVarNames PrevClassVarNames
PrevClassInstVarNames LazyCompilation FoldConstants
LineNumberInfo SuppressDoItCompilation ParseErrorSignal'
@@ -154,7 +155,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -173,11 +174,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.
@@ -230,143 +231,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]
+ [exBegin]
Parser
- evaluate:'1+2*3'
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:nil
- [exEnd]
- [exBegin]
+ 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|
@@ -375,8 +376,8 @@
c[6] := 6.
c[7] := 7.
c[7] := c[4] - c[6].
- [exEnd]
- [exBegin]
+ [exEnd]
+ [exBegin]
<pragma: +arrayIndexSyntaxExtension>
|d|
@@ -386,21 +387,21 @@
d['three'] := 'drei'.
d['two'] , d['three']
- [exEnd]
+ [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]
"
! !
@@ -498,13 +499,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"
@@ -514,14 +515,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
+ ]
]
! !
@@ -534,8 +535,8 @@
LineNumberInfo := false.
ParseErrorSignal isNil ifTrue:[
- ParseErrorSignal := ParseError.
- ParseErrorSignal notifierString:'Parse error:'.
+ ParseErrorSignal := ParseError.
+ ParseErrorSignal notifierString:'Parse error:'.
].
Smalltalk addDependent:self.
@@ -657,10 +658,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
@@ -807,65 +808,65 @@
lcSelector := aString asLowercase.
block := [:sym :mthd|
- |similarity lcSym keepThis|
-
- (forCompletion and:[sym = aString]) ifFalse:[
- lcSym := sym asLowercase.
- (info contains:[:i | i key == sym]) ifFalse:[
- "/ higher simililarity if string to complete starts with the selector
- (forCompletion and:[lcSym startsWith:lcSelector]) ifTrue:[
- similarity := 100 * (1 + (lcSelector size / lcSym size)).
- ] ifFalse:[
- similarity := lcSelector spellAgainst:lcSym. "/ 0..100
- "/ similarity := similarity * (lcSym size).
- ].
- forCompletion ifTrue:[
- "/ higher simililarity for my own messages
- aClassOrNil == mthd mclass ifTrue:[
- similarity := similarity * 2.
- ].
- ].
-
- ((similarity > 40) or:[lcSym startsWith:lcSelector]) 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|
+
+ (forCompletion and:[sym = aString]) ifFalse:[
+ lcSym := sym asLowercase.
+ (info contains:[:i | i key == sym]) ifFalse:[
+ "/ higher simililarity if string to complete starts with the selector
+ (forCompletion and:[lcSym startsWith:lcSelector]) ifTrue:[
+ similarity := 100 * (1 + (lcSelector size / lcSym size)).
+ ] ifFalse:[
+ similarity := lcSelector spellAgainst:lcSym. "/ 0..100
+ "/ similarity := similarity * (lcSym size).
+ ].
+ forCompletion ifTrue:[
+ "/ higher simililarity for my own messages
+ aClassOrNil == mthd mclass ifTrue:[
+ similarity := similarity * 2.
+ ].
+ ].
+
+ ((similarity > 40) or:[lcSym startsWith:lcSelector]) 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 or:[aClassOrNil == Object]) ifTrue:[
- Smalltalk allClassesDo:[:cls |
- (excludedClasses includes:cls) ifFalse:[
- cls methodDictionary keysAndValuesDo:block.
- cls class methodDictionary keysAndValuesDo:block.
- ]
- ]
+ Smalltalk allClassesDo:[:cls |
+ (excludedClasses includes:cls) ifFalse:[
+ cls methodDictionary keysAndValuesDo:block.
+ cls class methodDictionary keysAndValuesDo:block.
+ ]
+ ]
] ifFalse:[
- (loadedClass := aClassOrNil) isLoaded ifFalse:[
- loadedClass := aClassOrNil autoload
- ].
- loadedClass withAllSuperclassesDo:[:cls |
- "/ Transcript showCR:'try ',cls name.
- cls methodDictionary keysAndValuesDo:block.
- "/ cls class methodDictionary keysAndValuesDo:block.
- ].
+ (loadedClass := aClassOrNil) isLoaded ifFalse:[
+ loadedClass := aClassOrNil autoload
+ ].
+ loadedClass withAllSuperclassesDo:[:cls |
+ "/ Transcript showCR:'try ',cls name.
+ cls methodDictionary keysAndValuesDo:block.
+ "/ cls class methodDictionary keysAndValuesDo:block.
+ ].
"/ loadedClass withAllSubclassesDo:[:cls |
"/ cls methodDictionary keysAndValuesDo:block.
"/ "/ cls class methodDictionary keysAndValuesDo:block.
@@ -909,13 +910,13 @@
No doit-entry is added to the changeLog."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:nil
- compile:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:nil
+ compile:true
"
Compiler evaluate:'1 + 2'
@@ -935,13 +936,13 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:nil
- compile:compile
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:nil
+ compile:compile
!
evaluate:aStringOrStream ifFail:failBlock
@@ -950,13 +951,13 @@
No doit-entry is added to the changeLog."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:failBlock
- compile:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:failBlock
+ compile:true
"
Compiler evaluate:'1 +' ifFail:['oops']
"
@@ -969,13 +970,13 @@
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
+ evaluate:aStringOrStream
+ in:aContext
+ receiver:anObject
+ notifying:requestor
+ logged:false
+ ifFail:nil
+ compile:true
"Modified: / 17.1.1998 / 02:54:07 / cg"
!
@@ -987,13 +988,13 @@
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
+ 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
@@ -1010,16 +1011,16 @@
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
@@ -1027,13 +1028,13 @@
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
+ 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
@@ -1045,13 +1046,13 @@
errors are reported to requestor"
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:requestor
- logged:false
- ifFail:nil
- compile:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:requestor
+ logged:false
+ ifFail:nil
+ compile:true
!
evaluate:aStringOrStream notifying:requestor compile:compile
@@ -1066,13 +1067,13 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:requestor
- logged:false
- ifFail:nil
- compile:compile
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:requestor
+ logged:false
+ ifFail:nil
+ compile:compile
!
evaluate:aStringOrStream notifying:requestor logged:logged
@@ -1080,13 +1081,13 @@
errors are reported to requestor"
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:nil
- notifying:requestor
- logged:logged
- ifFail:nil
- compile:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:requestor
+ logged:logged
+ ifFail:nil
+ compile:true
!
evaluate:aStringOrStream receiver:anObject
@@ -1095,13 +1096,13 @@
anObject as self and to its instVars "
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:anObject
- notifying:nil
- logged:false
- ifFail:nil
- compile:true
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:nil
+ logged:false
+ ifFail:nil
+ compile:true
"
Compiler evaluate:'self x' receiver:(1 @ 2)
@@ -1116,13 +1117,13 @@
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
+ 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
@@ -1137,13 +1138,13 @@
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
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:requestor
+ logged:false
+ ifFail:nil
+ compile:true
"
Compiler evaluate:'self x' receiver:(1 @ 2) notifying:nil
@@ -1163,13 +1164,13 @@
than the interpretation overhead."
^ self
- evaluate:aStringOrStream
- in:nil
- receiver:anObject
- notifying:requestor
- logged:false
- ifFail:nil
- compile:compile
+ evaluate:aStringOrStream
+ in:nil
+ receiver:anObject
+ notifying:requestor
+ logged:false
+ ifFail:nil
+ compile:compile
!
evaluateFrom:aStringOrStream ifFail:failBlock
@@ -1178,13 +1179,13 @@
No doit-entry is added to the changeLog."
^ self
- evaluateFrom:aStringOrStream
- in:nil
- receiver:nil
- notifying:nil
- logged:false
- ifFail:failBlock
- compile:true
+ evaluateFrom:aStringOrStream
+ in:nil
+ receiver:nil
+ notifying:nil
+ logged:false
+ ifFail:failBlock
+ compile:true
"
Compiler evaluate:'1 + 2' ifFail:['oops']
"
@@ -1204,14 +1205,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'!
@@ -1232,14 +1233,14 @@
comments := self methodCommentsFromSource:aString.
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.
@@ -1286,34 +1287,34 @@
maxSoFar innerBlock m|
(line isNil or:[line == self maxLineNumber]) ifTrue:[
- ^ nil
+ ^ nil
].
aMethod notNil ifTrue:[
- m := aMethod.
- who := m who.
- who isNil ifTrue:[
- m isWrapped ifTrue:[
- m := m wrapper.
- m notNil ifTrue:[
- who := m who.
- ]
- ]
- ].
- who notNil ifTrue:[
- mClass := who methodClass.
- mClass isNil ifTrue:[ ^ nil].
- ].
- 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"
@@ -1326,73 +1327,73 @@
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.
- ].
+ 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
+ ].
].
"/ still more than one possible block;
"/ look for the one which has a statement in that line
blocks := blocks select:[:aBlock | aBlock firstStatement notNil
- and:[ aBlock firstStatement lineNumber <= line]].
+ and:[ aBlock firstStatement lineNumber <= line]].
blocks size == 1 ifTrue:[
- ^ blocks at:1
+ ^ 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.
@@ -1421,15 +1422,15 @@
"
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"
@@ -1442,13 +1443,13 @@
Error and warning messages are suppressed."
^ self
- withSelf:nil
- parseExpression:aString
- onError:#Error
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
- inNameSpace:nil
+ withSelf:nil
+ parseExpression:aString
+ onError:#Error
+ notifying:nil
+ ignoreErrors:true "silence on Transcript"
+ ignoreWarnings:true
+ inNameSpace:nil
"
Parser parseExpression:''
@@ -1466,13 +1467,13 @@
Error and warning messages are suppressed."
^ self
- withSelf:nil
- parseExpression:aString
- onError:#Error
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
- inNameSpace:aNameSpaceOrNil
+ 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"
@@ -1485,13 +1486,13 @@
Error and warning messages are suppressed."
^ self
- withSelf:nil
- parseExpression:aString
- onError:errorValue
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
- inNameSpace:aNameSpaceOrNil
+ 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"
@@ -1504,13 +1505,13 @@
Error and warning messages are suppressed."
^ self
- withSelf:nil
- parseExpression:aString
- onError:errorValue
- notifying:nil
- ignoreErrors:true "silence on Transcript"
- ignoreWarnings:true
- inNameSpace:nil
+ 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"
!
@@ -1537,12 +1538,12 @@
|p|
p := Parser
- parseMethod:'
- foo:arg1 bar:arg2 baz:arg3
- |l1 l2|
- l1 := 0.
- l2 := arg1.
- ^ self'.
+ parseMethod:'
+ foo:arg1 bar:arg2 baz:arg3
+ |l1 l2|
+ l1 := 0.
+ l2 := arg1.
+ ^ self'.
'nArgs: ' print. p numberOfMethodArgs printNL.
'args: ' print. p methodArgs printNL.
@@ -1562,15 +1563,15 @@
used selectors, modified instvars, referenced classvars etc.
Error and warning messages are sent to the Transcript."
- ParseError handle:[:ex |
- Transcript showCR:ex description.
- ex proceed.
+ ParseError handle:[:ex |
+ Transcript showCR:ex description.
+ ex proceed.
] do:[
- ^ 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"
@@ -1606,10 +1607,10 @@
self obsoleteMethodWarning.
^ self
- parseMethod:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:warnBoolean not
+ parseMethod:aString
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:warnBoolean not
"Modified: 24.4.1996 / 13:28:05 / cg"
!
@@ -1629,9 +1630,9 @@
|p|
p := Parser
- parseMethodArgAndVarSpecification:'
- foo:arg1 bar:arg2 baz:arg3
- |l1 l2|'.
+ parseMethodArgAndVarSpecification:'
+ foo:arg1 bar:arg2 baz:arg3
+ |l1 l2|'.
'nArgs: ' print. p numberOfMethodArgs printNL.
'args: ' print. p methodArgs printNL.
@@ -1653,10 +1654,10 @@
self obsoleteMethodWarning.
^ self parseMethodArgAndVarSpecification:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
- parseBody:false
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
+ parseBody:false
"Modified: 24.4.1996 / 13:30:03 / cg"
!
@@ -1684,9 +1685,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
@@ -1715,10 +1716,10 @@
display error/warning messages on the transcript."
^ self parseMethodArgAndVarSpecification:aString
- in:aClass
- ignoreErrors:true
- ignoreWarnings:true
- parseBody:false
+ in:aClass
+ ignoreErrors:true
+ ignoreWarnings:true
+ parseBody:false
"Modified: 24.4.1996 / 13:14:27 / cg"
!
@@ -1743,10 +1744,10 @@
Like #parseMethod:in:, but warning/error messages are suppressed."
^ self
- parseMethod:aString
- in:aClass
- ignoreErrors:true
- ignoreWarnings:true
+ parseMethod:aString
+ in:aClass
+ ignoreErrors:true
+ ignoreWarnings:true
"Modified: 24.4.1996 / 13:32:57 / cg"
!
@@ -1774,9 +1775,9 @@
The parser can be queried for selector, receiver etc."
^ self parseMethodSpecification:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
!
parseMethodSpecification:aString in:aClass ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings
@@ -1816,9 +1817,9 @@
Like #parseMethodSpecification:in:, but does not display any error/warning Messages on the transcript."
^ self parseMethodSpecification:aString
- in:aClass
- ignoreErrors:true
- ignoreWarnings:true
+ in:aClass
+ ignoreErrors:true
+ ignoreWarnings:true
"Created: 31.10.1995 / 14:37:49 / cg"
!
@@ -1834,33 +1835,33 @@
stringParsed := aString withoutSeparators.
stringParsed isEmpty ifTrue:[^ nil].
(stringParsed startsWith:'^') ifTrue:[
- stringParsed := stringParsed copyFrom:2.
+ stringParsed := stringParsed copyFrom:2.
].
Error
- handle:[:ex | ]
- do:[
- tree := self withSelf:nil
- parseExpression:stringParsed
- notifying:nil
- ignoreErrors:true
- ignoreWarnings:true.
- ].
+ 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
+ ].
].
"
@@ -1869,11 +1870,11 @@
parser := self for:(ReadStream on:stringParsed).
parser ignoreErrors:true.
Error
- handle:[:ex | ]
- do:[
- parser nextToken.
- sel := parser degeneratedKeywordExpressionForSelector
- ].
+ handle:[:ex | ]
+ do:[
+ parser nextToken.
+ sel := parser degeneratedKeywordExpressionForSelector
+ ].
^ sel
"
@@ -1900,13 +1901,13 @@
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
+ withSelf:anObject
+ parseExpression:aString
+ onError:#Error
+ notifying:someOne
+ ignoreErrors:false
+ ignoreWarnings:false
+ inNameSpace:nil
"Modified: 24.6.1997 / 16:43:37 / cg"
!
@@ -1920,13 +1921,13 @@
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
+ withSelf:anObject
+ parseExpression:aString
+ onError:#Error
+ notifying:someOne
+ ignoreErrors:ignore
+ ignoreWarnings:ignore
+ inNameSpace:nil
"Modified: 24.6.1997 / 16:43:26 / cg"
!
@@ -1941,13 +1942,13 @@
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"
!
@@ -1962,13 +1963,13 @@
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:aStringOrStream onError:errorValue notifying:someOne ignoreErrors:ignoreErrors ignoreWarnings:ignoreWarnings inNameSpace:aNameSpaceOrNil
@@ -1986,18 +1987,18 @@
parser := self for:(aStringOrStream readStream).
ParseErrorSignal handle:[:ex |
- ^ errorValue value
+ ^ errorValue value
] do:[
- tree := parser
- parseExpressionWithSelf:anObject
- notifying:someOne
- ignoreErrors:ignoreErrors
- ignoreWarnings:ignoreWarnings
- inNameSpace:aNameSpaceOrNil.
+ tree := parser
+ parseExpressionWithSelf:anObject
+ notifying:someOne
+ ignoreErrors:ignoreErrors
+ ignoreWarnings:ignoreWarnings
+ inNameSpace:aNameSpaceOrNil.
].
"/ #Error returnValue will vanish
tree == #Error ifTrue:[
- ^ errorValue value
+ ^ errorValue value
].
^ tree
@@ -2009,9 +2010,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|
@@ -2022,45 +2023,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
+ 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>"
@@ -2073,7 +2074,7 @@
selectorSymbol isNil ifTrue:[^ false].
Smalltalk allClassesAndMetaclassesDo:[:cls |
- (cls includesSelector:selectorSymbol) ifTrue:[^ true].
+ (cls includesSelector:selectorSymbol) ifTrue:[^ true].
].
^ false
@@ -2087,7 +2088,7 @@
newObject := anObject copy.
whichImmutableClass notNil ifTrue:[
- newObject changeClassTo:whichImmutableClass.
+ newObject changeClassTo:whichImmutableClass.
].
newObject beImmutable.
^ newObject
@@ -2122,15 +2123,15 @@
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
@@ -2155,18 +2156,18 @@
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
@@ -2194,13 +2195,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.
@@ -2208,8 +2209,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
@@ -2225,11 +2226,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"
@@ -2245,7 +2246,7 @@
"
Parser new
- parseSelector:'
+ parseSelector:'
parseSelector:aStringOrStream
self initializeFor:aStringOrStream.
self parseMethodSpec.
@@ -2281,7 +2282,7 @@
"return either the corrected or the requestors original source"
correctedSource notNil ifTrue:[
- ^ correctedSource
+ ^ correctedSource
].
^ requestor currentSourceCode
!
@@ -2388,8 +2389,8 @@
Remember the current namespace."
currentNamespace := aNameSpaceName isString
- ifTrue:[ NameSpace fullName:aNameSpaceName ]
- ifFalse:[ aNameSpaceName ].
+ ifTrue:[ NameSpace fullName:aNameSpaceName ]
+ ifFalse:[ aNameSpaceName ].
"Modified: 8.11.1996 / 13:43:14 / cg"
!
@@ -2495,37 +2496,37 @@
|sel receiver|
aNode isMessage ifTrue:[
- sel := aNode selector.
- receiver := aNode receiver.
-
- (sel = #and: or:[sel = #or:]) ifTrue:[
- aNode arg1 realNode isBlockNode ifFalse:[
- (aNode arg1 isVariable
- and:[ (aNode arg1 name asLowercase includesString:'block')]) ifFalse:[
- self warnCommonMistake:'(possible common mistake) missing block brackets ?'
- position:endPosition+1 to:tokenPosition-1
- ]
- ].
- ].
-
- (sel = #whileTrue: or:[sel = #whileFalse:]) ifTrue:[
- receiver realNode isBlockNode ifFalse:[
- (receiver isVariable
- and:[ (receiver name asLowercase includesString:'block')]) ifFalse:[
- self warnCommonMistake:'(possible common mistake) missing block brackets ?'
- position:startPosition to:endPosition
- ]
- ].
- ].
-
- (sel = #ifTrue: or:[sel = #ifFalse:]) ifTrue:[
- receiver isMessage ifTrue:[
- (receiver selector = #whileTrue or:[receiver selector = #whileFalse]) ifTrue:[
- self warnCommonMistake:'strange receiver expression'
- position:startPosition to:endPosition
- ].
- ].
- ].
+ sel := aNode selector.
+ receiver := aNode receiver.
+
+ (sel = #and: or:[sel = #or:]) ifTrue:[
+ aNode arg1 realNode isBlockNode ifFalse:[
+ (aNode arg1 isVariable
+ and:[ (aNode arg1 name asLowercase includesString:'block')]) ifFalse:[
+ self warnCommonMistake:'(possible common mistake) missing block brackets ?'
+ position:endPosition+1 to:tokenPosition-1
+ ]
+ ].
+ ].
+
+ (sel = #whileTrue: or:[sel = #whileFalse:]) ifTrue:[
+ receiver realNode isBlockNode ifFalse:[
+ (receiver isVariable
+ and:[ (receiver name asLowercase includesString:'block')]) ifFalse:[
+ self warnCommonMistake:'(possible common mistake) missing block brackets ?'
+ position:startPosition to:endPosition
+ ]
+ ].
+ ].
+
+ (sel = #ifTrue: or:[sel = #ifFalse:]) ifTrue:[
+ receiver isMessage ifTrue:[
+ (receiver selector = #whileTrue or:[receiver selector = #whileFalse]) ifTrue:[
+ self warnCommonMistake:'strange receiver expression'
+ position:startPosition to:endPosition
+ ].
+ ].
+ ].
].
"Created: / 19-01-2012 / 10:44:05 / cg"
@@ -2537,21 +2538,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 position.
-
- 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 position.
+
+ 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"
@@ -2567,107 +2568,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.
+ |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:[
+ (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 position.
-
- 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 position.
+
+ 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"
@@ -2679,37 +2680,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' 'ex'
- ) includes:aVariableName)
- ifFalse:[
- msg := ('short variable name: "' , aVariableName , '"').
- self
- warning:('short variable name: "' , aVariableName , '"')
- doNotShowAgainAction:[ ParserFlags warnAboutShortLocalVariableNames:false]
- position:tokenPosition to:source position.
-
- 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' 'ex'
+ ) includes:aVariableName)
+ ifFalse:[
+ msg := ('short variable name: "' , aVariableName , '"').
+ self
+ warning:('short variable name: "' , aVariableName , '"')
+ doNotShowAgainAction:[ ParserFlags warnAboutShortLocalVariableNames:false]
+ position:tokenPosition to:source position.
+
+ 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"
@@ -2736,29 +2737,29 @@
note := self plausibilityCheck:aNode.
note notNil ifTrue:[
- "/ this is a hack (which I dont like)
- (note includesString:'missing ''.''') ifTrue:[
- fixes := { CorrectByInsertingPeriod }
- ] ifFalse:[
- fixes := Parser possibleCorrectionsQuery basicNew defaultResumeValue
- ].
- PossibleCorrectionsQuery answer:fixes
- do:[
- |fix|
-
- fix:= self
- correctableWarning:('Plausibility Check\' withCRs, note)
- doNotShowAgainAction:[ parserFlags warnPlausibilityChecks:false. ParserFlags warnPlausibilityChecks:false ]
- doNotShowAgainForThisMethodAction: [ self disableWarningsOnCurrentMethodFor: #warnPlausibilityChecks ]
- position:startPosition to:endPosition.
- fix isBehavior ifTrue:[
- self correctWith:(fix new positionOfPeriod:aNode receiver endPosition) from:startPosition to:endPosition.
- ].
- ].
+ "/ this is a hack (which I dont like)
+ (note includesString:'missing ''.''') ifTrue:[
+ fixes := { CorrectByInsertingPeriod }
+ ] ifFalse:[
+ fixes := Parser possibleCorrectionsQuery basicNew defaultResumeValue
+ ].
+ PossibleCorrectionsQuery answer:fixes
+ do:[
+ |fix|
+
+ fix:= self
+ correctableWarning:('Plausibility Check\' withCRs, note)
+ doNotShowAgainAction:[ parserFlags warnPlausibilityChecks:false. ParserFlags warnPlausibilityChecks:false ]
+ doNotShowAgainForThisMethodAction: [ self disableWarningsOnCurrentMethodFor: #warnPlausibilityChecks ]
+ position:startPosition to:endPosition.
+ fix isBehavior ifTrue:[
+ self correctWith:(fix new positionOfPeriod:aNode receiver endPosition) from:startPosition to:endPosition.
+ ].
+ ].
].
aNode isMessage ifTrue:[
- self checkBracketParenthesisMistakeInIfOrWhile:aNode from:startPosition to:endPosition
+ self checkBracketParenthesisMistakeInIfOrWhile:aNode from:startPosition to:endPosition
].
"Created: / 19-01-2012 / 10:44:05 / cg"
@@ -2776,12 +2777,12 @@
returnsSelf := returnedValues contains:[:node | node isSelf].
returnsBoolean ifTrue:[
- (returnsNonBooleanLiteral or:[returnsSelf]) ifTrue:[
- self
- warning:'Possible Error Warning:\\Method possibly 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 possibly returns both boolean and non-boolean values.' withCRs
+ doNotShowAgainAction:[ ParserFlags warnInconsistentReturnValues:false ]
+ position:1 to:tokenPosition
+ ]
].
"Created: / 17.11.2001 / 10:31:03 / cg"
@@ -2799,81 +2800,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:[
- ^ 'every 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:[
+ ^ 'every 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.
!
@@ -2885,10 +2886,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"
@@ -2906,13 +2907,13 @@
and:[(alreadyWarnedUninitializedVars includes:varName)]) ifTrue:[^ false].
aNode isMethodVariable ifTrue:[
- currentBlock notNil ifTrue:[^ false].
- (modifiedLocalVars notNil and:[(modifiedLocalVars includes:varName)]) ifTrue:[^ false].
+ currentBlock notNil ifTrue:[^ false].
+ (modifiedLocalVars notNil and:[(modifiedLocalVars includes:varName)]) ifTrue:[^ false].
] ifFalse:[
- aNode isBlockVariable ifTrue:[
- aNode block == currentBlock ifFalse:[^ false].
- (currentBlock modifiedLocalVars notNil and:[(currentBlock modifiedLocalVars includes:varName)]) ifTrue:[^ false].
- ].
+ aNode isBlockVariable ifTrue:[
+ aNode block == currentBlock ifFalse:[^ false].
+ (currentBlock modifiedLocalVars notNil and:[(currentBlock modifiedLocalVars includes:varName)]) ifTrue:[^ false].
+ ].
].
^ true.
! !
@@ -3033,7 +3034,7 @@
|holder|
doItTemporaries isNil ifTrue:[
- doItTemporaries := IdentityDictionary new.
+ doItTemporaries := IdentityDictionary new.
].
doItTemporaries at:varName asSymbol put:(holder := ValueHolder new).
^ holder
@@ -3041,7 +3042,7 @@
alreadyWarnedUnimplementedSelectors
alreadyWarnedUnimplementedSelectors isNil ifTrue:[
- alreadyWarnedUnimplementedSelectors := Set new
+ alreadyWarnedUnimplementedSelectors := Set new
].
^ alreadyWarnedUnimplementedSelectors
!
@@ -3054,7 +3055,7 @@
"in systems without widgets ..."
ListSelectionBox isNil ifTrue:[
- ^ self confirm:aString
+ ^ self confirm:aString
].
box := ListSelectionBox title:aString.
box initialText:(aList at:1).
@@ -3074,7 +3075,7 @@
"in systems without widgets ..."
ListSelectionBox isNil ifTrue:[
- ^ self confirm:aString
+ ^ self confirm:aString
].
box := ListSelectionBox title:aString.
box initialText:(aList firstIfEmpty:originalSelector).
@@ -3091,7 +3092,7 @@
|typeChoice|
typeChoice := (AskForVariableTypeOfUndeclaredQuery new
- parser:self nameOfUnknownVariable:varName) query.
+ parser:self nameOfUnknownVariable:varName) query.
"/
"/ l := OrderedCollection new.
@@ -3156,7 +3157,7 @@
"/ ].
typeChoice notNil ifTrue:[
- ^ self declareUndefinedVariable:varName as:typeChoice
+ ^ self declareUndefinedVariable:varName as:typeChoice
].
^ nil.
@@ -3178,7 +3179,7 @@
positionOfPeriod|
(self alreadyWarnedUnimplementedSelectors includes:aSelectorString) ifTrue:[
- ^ aSelectorString
+ ^ aSelectorString
].
pos1 := posVector first start.
@@ -3186,7 +3187,7 @@
"/ also highlight the receiver; looks better in browser
receiverNode startPosition notNil ifTrue:[
- pos1 := pos1 min:(receiverNode startPosition).
+ pos1 := pos1 min:(receiverNode startPosition).
].
"
@@ -3194,85 +3195,85 @@
currently (too much work - maybe Ill do it later when everything else works :-)
"
false "(aSelectorString occurrencesOf:$:) > 1" ifTrue:[
- fixes := { CorrectByGeneratingMissingMethod }.
+ fixes := { CorrectByGeneratingMissingMethod }.
] ifFalse:[
- fixes := { CorrectByChangingSelector . CorrectByGeneratingMissingMethod }.
+ fixes := { CorrectByChangingSelector . CorrectByGeneratingMissingMethod }.
].
aSelectorString isKeywordSelector ifTrue:[
- |parts possibleSplits|
-
- possibleSplits := OrderedCollection new.
- parts := aSelectorString partsIfSelector.
- 1 to:parts size-1 do:[:sepIdx |
- |msg1 msg2 msg1Ok msg2Ok|
-
- msg1 := (parts copyTo:sepIdx) asStringWith:''.
- msg2 := (parts copyFrom:sepIdx+1) asStringWith:''.
- (msg1 := msg1 asSymbolIfInterned) notNil ifTrue:[
- (msg2 := msg2 asSymbolIfInterned) notNil ifTrue:[
- aClassOrNil notNil ifTrue:[
- msg1Ok := aClassOrNil canUnderstand:msg1
- ] ifFalse:[
- msg1Ok := (SystemBrowser
- findImplementorsOf: msg1
- in: Smalltalk allClasses
- ignoreCase: false) notEmpty.
- ].
- msg2Ok := (SystemBrowser
- findImplementorsOf: msg2
- in: Smalltalk allClasses
- ignoreCase: false) notEmpty.
-
- (msg1Ok and:[msg2Ok]) ifTrue:[
- possibleSplits add:{ msg1 . msg2 }
- ] ifFalse:[
+ |parts possibleSplits|
+
+ possibleSplits := OrderedCollection new.
+ parts := aSelectorString partsIfSelector.
+ 1 to:parts size-1 do:[:sepIdx |
+ |msg1 msg2 msg1Ok msg2Ok|
+
+ msg1 := (parts copyTo:sepIdx) asStringWith:''.
+ msg2 := (parts copyFrom:sepIdx+1) asStringWith:''.
+ (msg1 := msg1 asSymbolIfInterned) notNil ifTrue:[
+ (msg2 := msg2 asSymbolIfInterned) notNil ifTrue:[
+ aClassOrNil notNil ifTrue:[
+ msg1Ok := aClassOrNil canUnderstand:msg1
+ ] ifFalse:[
+ msg1Ok := (SystemBrowser
+ findImplementorsOf: msg1
+ in: Smalltalk allClasses
+ ignoreCase: false) notEmpty.
+ ].
+ msg2Ok := (SystemBrowser
+ findImplementorsOf: msg2
+ in: Smalltalk allClasses
+ ignoreCase: false) notEmpty.
+
+ (msg1Ok and:[msg2Ok]) ifTrue:[
+ possibleSplits add:{ msg1 . msg2 }
+ ] ifFalse:[
self breakPoint:#cg.
- ]
- ] ifFalse:[
+ ]
+ ] ifFalse:[
"/ self breakPoint:#cg.
- ]
- ].
- ].
- possibleSplits notEmpty ifTrue:[
- fixes := fixes copyWith: (CorrectByGroupingMessage new
- possibleSplits:possibleSplits;
- selectorPositions:posVector).
- ].
+ ]
+ ].
+ ].
+ possibleSplits notEmpty ifTrue:[
+ fixes := fixes copyWith: (CorrectByGroupingMessage new
+ possibleSplits:possibleSplits;
+ selectorPositions:posVector).
+ ].
].
"/ a hack - don't like looking into string; needs fix (caller must pass in possible corrections)
(msg includesString:'issing ''.''') ifTrue:[
- receiverNode notNil ifTrue:[
- positionOfPeriod := receiverNode endPosition.
- fixes := fixes copyWith: CorrectByInsertingPeriod.
- ].
+ receiverNode notNil ifTrue:[
+ positionOfPeriod := receiverNode endPosition.
+ fixes := fixes copyWith: CorrectByInsertingPeriod.
+ ].
].
(msg includesString:'hex integer') ifTrue:[
- (receiverNode notNil
- and:[ receiverNode isConstant
- and:[ receiverNode value == 0
- and:[ (aSelectorString asLowercase startsWith:'x')
- and:[ aSelectorString from:2 conform:[:ch | ch isDigitRadix:16]
- ]]]]) ifTrue:[
- fixes := fixes copyWith:CorrectByMakingValidHexConstant
- ].
+ (receiverNode notNil
+ and:[ receiverNode isConstant
+ and:[ receiverNode value == 0
+ and:[ (aSelectorString asLowercase startsWith:'x')
+ and:[ aSelectorString from:2 conform:[:ch | ch isDigitRadix:16]
+ ]]]]) ifTrue:[
+ fixes := fixes copyWith:CorrectByMakingValidHexConstant
+ ].
].
PossibleCorrectionsQuery answer:fixes do:[
- correctIt := self correctableWarning:msg position:pos1 to:pos2.
+ correctIt := self correctableWarning:msg position:pos1 to:pos2.
].
(correctIt isBehavior or:[correctIt isKindOf:Correction]) ifTrue:[
- self
- correctWith:(correctIt instance
- positionOfPeriod:positionOfPeriod;
- receiverNode:receiverNode;
- receiverClass:aClassOrNil;
- selector:aSelectorString)
- from:pos1 to:pos2.
- "/ normally not reached (unless, the corrector did something somewhere else,
- "/ and no change is needed here)
- correctIt := false.
+ self
+ correctWith:(correctIt instance
+ positionOfPeriod:positionOfPeriod;
+ receiverNode:receiverNode;
+ receiverClass:aClassOrNil;
+ selector:aSelectorString)
+ from:pos1 to:pos2.
+ "/ normally not reached (unless, the corrector did something somewhere else,
+ "/ and no change is needed here)
+ correctIt := false.
].
"/ code moved to CorrectByGeneratingMissing
@@ -3342,17 +3343,17 @@
"/ correctIt := false.
"/ ].
(correctIt == false or:[correctIt == #continue]) ifTrue:[
- alreadyWarnedUnimplementedSelectors add:aSelectorString.
- ^ aSelectorString
+ alreadyWarnedUnimplementedSelectors add:aSelectorString.
+ ^ aSelectorString
].
suggestedNames := self findBestSelectorsFor:aSelectorString in:aClassOrNil.
suggestedNames notEmptyOrNil ifTrue:[
- newSelector := self askForCorrection:'Correct Selector to: ' fromList:suggestedNames for:aSelectorString.
- newSelector isNil ifTrue:[AbortOperationRequest raise "^ aSelectorString"].
+ newSelector := self askForCorrection:'Correct Selector to: ' fromList:suggestedNames for:aSelectorString.
+ newSelector isNil ifTrue:[AbortOperationRequest raise "^ aSelectorString"].
] ifFalse:[
- self information:'no good correction found'.
- ^ aSelectorString
+ self information:'no good correction found'.
+ ^ aSelectorString
].
"
@@ -3366,7 +3367,7 @@
"
correctedSource := requestor currentSourceCode.
source := (ReadStream on:correctedSource)
- position:(source position + (newSelector size - aSelectorString size)).
+ position:(source position + (newSelector size - aSelectorString size)).
^ newSelector
"Modified: / 22-01-1998 / 16:36:04 / stefan"
@@ -3396,17 +3397,17 @@
"/ update the current source position
source atEnd ifTrue:[
- newPos := correctedSource size.
+ newPos := correctedSource size.
] ifFalse:[
- source position + 1 >= stop ifTrue:[
- newPos := source position - deleteSize.
- ] ifFalse:[
- source position + 1 < start ifTrue:[
- newPos := source position.
- ] ifFalse:[
- newPos := start-1.
- ].
- ]
+ source position + 1 >= stop ifTrue:[
+ newPos := source position - deleteSize.
+ ] ifFalse:[
+ source position + 1 < start ifTrue:[
+ newPos := source position.
+ ] ifFalse:[
+ newPos := start-1.
+ ].
+ ]
].
source := (ReadStream on:correctedSource) position:newPos.
@@ -3418,14 +3419,14 @@
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
!
@@ -3442,62 +3443,62 @@
sameForAll := false.
(correctIt := variableCorrectActionForAll) isNil ifTrue:[
- 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.
+ ].
].
"/ backward compatibility (symbols) will vanish...
((correctIt == #declare)
or:[correctIt == CorrectByDeclaringIdentifierAs
or:[correctIt isKindOf: Correction]]) ifTrue:[
- "/ declare it
- (((variableCorrectActionForAll == #declare)
- or:[ correctIt isKindOf: CorrectByDeclaringIdentifierAs ])
- 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)
+ or:[ correctIt isKindOf: CorrectByDeclaringIdentifierAs ])
+ 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.
- ].
- rslt := self defineAsUndeclaredVariable:varName.
- rslt startPosition: pos1 endPosition: pos2.
- ^ rslt
- ].
-
- "/ upperCase vars are declared as global
+ "/ 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.
+ ].
+ rslt := self defineAsUndeclaredVariable:varName.
+ rslt startPosition: pos1 endPosition: pos2.
+ ^ rslt
+ ].
+
+ "/ upperCase vars are declared as global
"/ parserFlags warnings ifTrue:[
"/ parserFlags warnUndeclared ifTrue:[
"/ (warnedUndefVars isNil or:[(warnedUndefVars includes:varName) not]) ifTrue:[
@@ -3507,24 +3508,24 @@
"/ ].
"/ ].
"/ ].
- ^ (VariableNode globalNamed:varName) startPosition: pos1 endPosition: pos2.
+ ^ (VariableNode globalNamed:varName) startPosition: pos1 endPosition: pos2.
].
(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].
"
"
@@ -3538,7 +3539,7 @@
"
correctedSource := self currentSource.
source := (ReadStream on:correctedSource)
- position:(source position + 1 + newName size - tokenName size).
+ position:(source position + 1 + newName size - tokenName size).
"redo parse with new value"
token := tokenName := newName.
@@ -3546,7 +3547,7 @@
"/ failed again ?
rslt == #Error ifTrue:[
- "/ install as Undeclared:<name>, remember in #undeclared
+ "/ install as Undeclared:<name>, remember in #undeclared
rslt := self defineAsUndeclaredVariable:varName.
rslt startPosition: pos1 endPosition: pos2.
@@ -3563,9 +3564,9 @@
newSource := correctionOperation fixFrom:pos1 to:pos2 for:self.
newSource notNil ifTrue:[
- correctedSource := newSource.
- requestor contents:newSource keepUndoHistory:true.
- RestartCompilationSignal raiseRequest.
+ correctedSource := newSource.
+ requestor contents:newSource keepUndoHistory:true.
+ RestartCompilationSignal raiseRequest.
].
^ #Error
!
@@ -3574,118 +3575,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 raiseRequest.
- "/ 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 raiseRequest.
+ "/ 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 raiseRequest.
- "/ 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 raiseRequest.
+ "/ 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.
- correctedSource := requestor currentSourceCode asString string.
-
- endLocalsPos notNil ifTrue:[
- localVarDefPosition at:2 put:(endLocalsPos + varName size + 1).
- "/ sigh - methodVarNames is nil if decl is empty
- 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).
- ].
- source := (ReadStream on:correctedSource)
- position:(source position + 1 + 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.
+ correctedSource := requestor currentSourceCode asString string.
+
+ endLocalsPos notNil ifTrue:[
+ localVarDefPosition at:2 put:(endLocalsPos + varName size + 1).
+ "/ sigh - methodVarNames is nil if decl is empty
+ 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).
+ ].
+ source := (ReadStream on:correctedSource)
+ position:(source position + 1 + ins size).
+
+ varIndex := methodVarNames size.
+ var used:true.
+ ^ VariableNode type:#MethodVariable
+ name:varName
+ token:var
+ index:varIndex
+ ].
].
self warning:'sorry - unimplemented (adding ' , variableType , ')'.
@@ -3708,7 +3709,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.
@@ -3743,115 +3744,115 @@
"/ in case not the position of the var-decl bars, but of the varName is passed in
(source at:defStartPos) == $| ifFalse:[
- defStartPos := source lastIndexOf:$| startingAt:defStartPos+1.
+ defStartPos := source lastIndexOf:$| startingAt:defStartPos+1.
].
(source at:defEndPos) == $| ifFalse:[
- defEndPos := source indexOf:$| startingAt:defEndPos+1.
+ defEndPos := source indexOf:$| startingAt:defEndPos+1.
].
startSearch := defStartPos+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.
+ |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.
] loop.
"Modified: / 18-07-2006 / 08:56:25 / cg"
@@ -3888,157 +3889,157 @@
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
- ].
+ [: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).
- ].
+ [: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
].
classToCompileFor notNil ifTrue:[
- "instance-variables"
- self classesInstVarNames do:spellAgainstAction.
-
- "all class-variables"
- self classesClassVarNames do:spellAgainstAction.
-
- "private classes"
- (classToCompileFor privateClasses collect:[:each | each nameWithoutPrefix]) do:spellAgainstAction.
-
- "pools"
- classToCompileFor sharedPools do:[:eachPool |
- eachPool classVarNames do:spellAgainstAction.
- ].
+ "instance-variables"
+ self classesInstVarNames do:spellAgainstAction.
+
+ "all class-variables"
+ self classesClassVarNames do:spellAgainstAction.
+
+ "private classes"
+ (classToCompileFor privateClasses collect:[:each | each nameWithoutPrefix]) do:spellAgainstAction.
+
+ "pools"
+ classToCompileFor sharedPools do:[:eachPool |
+ eachPool classVarNames do:spellAgainstAction.
+ ].
].
"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 |
- (names 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 |
- (names 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 |
+ (names 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 |
+ (names 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
@@ -4063,17 +4064,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.
@@ -4082,16 +4083,16 @@
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
+ ^ aSelectorString
].
"
@@ -4102,7 +4103,7 @@
selectorSymbol := aSelectorString asSymbolIfInterned.
selectorSymbol isNil ifTrue:[
- nowhereImplemented := true.
+ nowhereImplemented := true.
] ifFalse:[
"/ temporarily disabled - too slow.
"/ self isSyntaxHighlighter ifTrue:[
@@ -4111,247 +4112,247 @@
].
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'.
+ 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'.
] 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 nOther|
-
- "/ understood by all subclasses ?
- nOther := 0.
- classToCompileFor allSubclassesDo:[:eachSubclass |
- subErr isNil ifTrue:[
- selClass := eachSubclass.
- subErr := self checkSelector:selectorSymbol for:receiver inClass:selClass.
- ] ifFalse:[
- (self checkSelector:selectorSymbol for:receiver inClass:selClass) notNil ifTrue:[ nOther := nOther + 1 ].
- ]
- ].
- subErr notNil ifTrue:[
- nOther > 0 ifTrue:[
- err := subErr, (' in %1 other subclass(es), this class or superclass chain' bindWith:nOther)
- ] ifFalse:[
- err := subErr, ', in this class or superclass chain'
- ].
- ] 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:[
- (self isPossiblyUninitializedLocal:receiver) ifTrue:[
+ 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 nOther|
+
+ "/ understood by all subclasses ?
+ nOther := 0.
+ classToCompileFor allSubclassesDo:[:eachSubclass |
+ subErr isNil ifTrue:[
+ selClass := eachSubclass.
+ subErr := self checkSelector:selectorSymbol for:receiver inClass:selClass.
+ ] ifFalse:[
+ (self checkSelector:selectorSymbol for:receiver inClass:selClass) notNil ifTrue:[ nOther := nOther + 1 ].
+ ]
+ ].
+ subErr notNil ifTrue:[
+ nOther > 0 ifTrue:[
+ err := subErr, (' in %1 other subclass(es), this class or superclass chain' bindWith:nOther)
+ ] ifFalse:[
+ err := subErr, ', in this class or superclass chain'
+ ].
+ ] 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:[
+ (self isPossiblyUninitializedLocal:receiver) ifTrue:[
"/ (receiver isLocal and:[receiver token type isNil]) ifTrue:[
- "if it is an uninitialized variable ..."
+ "if it is an uninitialized variable ..."
"/ ((modifiedLocalVars isNil or:[(modifiedLocalVars includes:receiver name) not])
"/ and:[hasPrimitiveCode not
"/ and:[((receiver isMethodVariable and:[currentBlock isNil])
-"/ or:[ receiver isBlockVariable and:[receiver block == currentBlock]])
+"/ or:[ receiver isBlockVariable and:[receiver block == currentBlock]])
"/ 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
- ]
+ ((#(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:[
- ((selClass == Boolean)
- and:[ receiver isMessage
- and:[ receiver selector == #'=' ]])
- ifTrue:[
- err := err, ' (message to Boolean; did you mean ":=" instead of "=" in the receiver?)'
- ] ifFalse:[
- err := err, ' (message to ' , selClass nameWithArticle , ')'.
- ]
- ].
- ]]]]]].
- ]
+ ] ifFalse:[
+ (err notNil and:[selClass notNil]) ifTrue:[
+ ((selClass == Boolean)
+ and:[ receiver isMessage
+ and:[ receiver selector == #'=' ]])
+ ifTrue:[
+ err := err, ' (message to Boolean; did you mean ":=" instead of "=" in the receiver?)'
+ ] ifFalse:[
+ err := err, ' (message to ' , selClass nameWithArticle , ')'.
+ ]
+ ].
+ ]]]]]].
+ ]
].
err notNil ifTrue:[
- "
- 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 := err , '
+ "
+ 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 := err , '
.. but a variable with that name is defined.
Missing ''.'' after the previous expression
or missing keyword/receiver before that word ?'.
- ].
-
- ((aSelectorString startsWith:'x') or:[aSelectorString startsWith:'X']) and:[
- (aSelectorString from:2 conform:[:ch | ch isDigitRadix:16]) ifTrue:[
- (receiver isConstant
- and:[ receiver value == 0
- and:[ receiver startPosition == receiver endPosition "/ single digit
- ]]) ifTrue:[
- err := err, ('\\or did you mean a C/Java hex integer (which should be 16r',(aSelectorString from:2),' in Smalltalk)')
- ].
- ].
- ].
-
- (receiver notNil
- and:[((recType := receiver type) == #GlobalVariable)
- or:[recType == #PrivateClass]]) ifTrue:[
- "/ don't 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).
- ].
- ] ifFalse:[
- self isDoIt ifTrue:[
- 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.
+ ].
+
+ ((aSelectorString startsWith:'x') or:[aSelectorString startsWith:'X']) and:[
+ (aSelectorString from:2 conform:[:ch | ch isDigitRadix:16]) ifTrue:[
+ (receiver isConstant
+ and:[ receiver value == 0
+ and:[ receiver startPosition == receiver endPosition "/ single digit
+ ]]) ifTrue:[
+ err := err, ('\\or did you mean a C/Java hex integer (which should be 16r',(aSelectorString from:2),' in Smalltalk)')
+ ].
+ ].
+ ].
+
+ (receiver notNil
+ and:[((recType := receiver type) == #GlobalVariable)
+ or:[recType == #PrivateClass]]) ifTrue:[
+ "/ don't 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).
+ ].
+ ] ifFalse:[
+ self isDoIt ifTrue:[
+ 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
@@ -4363,70 +4364,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 ..."
-
- Error handle:[:ex | ] do:[ 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 ..."
+
+ Error handle:[:ex | ] do:[ 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
@@ -4438,11 +4439,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
].
!
@@ -4459,51 +4460,51 @@
nameBold := variableName allBold.
classToCompileFor notNil ifTrue:[
- "/ is it an instance-variable marked inaccessable ?
-
- idx := (self classesInstVarNames) indexOf:(variableName , '*') startingAt:1.
- idx ~~ 0 ifTrue:[
- ^ '''%1'' is a hidden instvar (not accessable from ST-code)' bindWith:nameBold.
- ].
-
- "/ is it an instance variable, while evaluateing for the class ?
- classToCompileFor isMeta ifTrue:[
- (classToCompileFor soleInstance allInstVarNames includes:variableName) ifTrue:[
- ^ '''%1'' is an instvar\(hint: you are evaluating/compiling in the classes context)' bindWith:nameBold.
- ]
- ]
+ "/ is it an instance-variable marked inaccessable ?
+
+ idx := (self classesInstVarNames) indexOf:(variableName , '*') startingAt:1.
+ idx ~~ 0 ifTrue:[
+ ^ '''%1'' is a hidden instvar (not accessable from ST-code)' bindWith:nameBold.
+ ].
+
+ "/ is it an instance variable, while evaluateing for the class ?
+ classToCompileFor isMeta ifTrue:[
+ (classToCompileFor soleInstance allInstVarNames includes:variableName) ifTrue:[
+ ^ '''%1'' is an instvar\(hint: you are evaluating/compiling in the classes context)' bindWith:nameBold.
+ ]
+ ]
].
variableNameAsSymbol := variableName asSymbolIfInterned.
(variableNameAsSymbol notNil and:[self isDoIt]) ifTrue:[
- SystemBrowser notNil ifTrue:[
- implementors := SystemBrowser
- findImplementorsOf:variableName
- 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:nameBold
- 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:variableName allBold.
- ].
- ].
+ SystemBrowser notNil ifTrue:[
+ implementors := SystemBrowser
+ findImplementorsOf:variableName
+ 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:nameBold
+ 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:variableName allBold.
+ ].
+ ].
].
peekChar == $: ifTrue:[
- ^ 'NameSpace "%1" is undefined' bindWith:nameBold.
- ].
- variableNameAsSymbol notNil ifTrue:[
- spaces := NameSpace allNameSpaces select:[:ns |ns includesKey:variableNameAsSymbol].
- spaces notEmpty ifTrue:[
- spaces size == 1 ifTrue:[
- ^ '"%1" is undefined\(but found in namespace "%2")'
- bindWith:nameBold with:spaces first name.
- ].
- ^ '"%1" is undefined\(but found in "%2" and %3 other namespaces)'
- bindWith:nameBold with:spaces first name with:spaces size-1.
- ].
+ ^ 'NameSpace "%1" is undefined' bindWith:nameBold.
+ ].
+ variableNameAsSymbol notNil ifTrue:[
+ spaces := NameSpace allNameSpaces select:[:ns |ns includesKey:variableNameAsSymbol].
+ spaces notEmpty ifTrue:[
+ spaces size == 1 ifTrue:[
+ ^ '"%1" is undefined\(but found in namespace "%2")'
+ bindWith:nameBold with:spaces first name.
+ ].
+ ^ '"%1" is undefined\(but found in "%2" and %3 other namespaces)'
+ bindWith:nameBold with:spaces first name with:spaces size-1.
+ ].
].
^ '"%1" is undefined' bindWith:nameBold.
@@ -4520,12 +4521,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 position.
+ position:tokenPosition to:source position.
^ #Error
!
@@ -4534,7 +4535,7 @@
Remember, that the warning has been shown"
(warnings notNil and:[warnings includes:something]) ifTrue:[
- ^ false.
+ ^ false.
].
self rememberWarning:something.
^ true
@@ -4544,11 +4545,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
].
!
@@ -4556,7 +4557,7 @@
"remember, that a warning for something has been shown."
warnings isNil ifTrue:[
- warnings := Set new.
+ warnings := Set new.
].
warnings add:something.
!
@@ -4568,31 +4569,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 raiseRequestErrorString: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 raiseRequestErrorString:msg
+ ] ifFalse:[
+ Transcript showCR:msg.
+ ]
+ ]
]
"Modified: 18.5.1996 / 15:44:15 / cg"
@@ -4602,10 +4603,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'.
@@ -4621,24 +4622,24 @@
|ex doCorrect boldName errMsg|
UndefinedVariableNotification isHandled ifTrue:[
- ex := UndefinedVariableNotification newException.
- ex parser:self.
- ex parameter:aName.
- ex suspendedContext:thisContext.
- doCorrect := ex raiseRequest.
- doCorrect notNil ifTrue:[
- ^ doCorrect
- ].
+ ex := UndefinedVariableNotification newException.
+ ex parser:self.
+ ex parameter:aName.
+ ex suspendedContext:thisContext.
+ doCorrect := ex raiseRequest.
+ doCorrect notNil ifTrue:[
+ ^ 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].
@@ -4654,48 +4655,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
+ ].
].
"/ notice: doCorrect may be a non-boolean
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
@@ -4705,32 +4706,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 position + 1).
- "
- 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 position + 1).
+ "
+ only warn once
+ "
+ didWarnAboutSTXNameSpaceUse := false
+ ]
+ ]
].
!
@@ -4751,60 +4752,60 @@
parserFlags warnUnusedVars ifFalse:[^ self].
(ParserFlags isFlag:#warnUnusedVars enabledForClass:classToCompileFor selector:selector)
- ifFalse:[^ self].
+ 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 creator == 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 raiseRequest
- ].
+ queries := DoNotShowCompilerWarningAgainActionQuery.
+ (self isDoIt not
+ and:[ classToCompileFor notNil
+ and:[ selector notNil ]]) ifTrue:[
+ queries := queries , DoNotShowCompilerWarningAgainForThisMethodActionQuery.
+ ].
+ queries handle:[:ex |
+ ex creator == 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 raiseRequest
+ ].
].
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"
@@ -4830,14 +4831,14 @@
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
@@ -4854,14 +4855,14 @@
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"
!
@@ -4880,14 +4881,14 @@
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
@@ -4904,14 +4905,14 @@
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
@@ -4928,14 +4929,14 @@
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
@@ -4952,13 +4953,13 @@
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
@@ -4975,14 +4976,14 @@
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
@@ -5005,14 +5006,14 @@
nameSpaceQuerySignal compiler cls|
aStringOrStream isNil ifTrue:[
- EmptySourceNotificationSignal raiseRequest.
- ^ nil
+ EmptySourceNotificationSignal raiseRequest.
+ ^ nil
].
(mustBackup := aStringOrStream isStream) ifTrue:[
- s := aStringOrStream.
+ s := aStringOrStream.
] ifFalse:[
- loggedString := aStringOrStream.
- s := ReadStream on:aStringOrStream.
+ loggedString := aStringOrStream.
+ s := ReadStream on:aStringOrStream.
].
self source:s.
@@ -5023,61 +5024,61 @@
self setSelf:anObject.
self setContext:aContext.
aContext notNil ifTrue:[
- self setSelf:(aContext receiver).
- aContext method notNil ifTrue:[
- cls := aContext method mclass
- ].
- self setClassToCompileFor:(cls ? aContext receiver class).
- "/ self setClassToCompileFor:(aContext receiver class).
+ self setSelf:(aContext receiver).
+ aContext method notNil ifTrue:[
+ cls := aContext method mclass
+ ].
+ self setClassToCompileFor:(cls ? aContext receiver class).
+ "/ self setClassToCompileFor:(aContext receiver class).
].
self notifying:requestor.
self nextToken.
self evalExitBlock:[:value | self release. ^ value].
failBlock isNil ifTrue:[
- tree := self parseMethodBodyOrEmpty.
+ tree := self parseMethodBodyOrEmpty.
] ifFalse:[
- ParseError handle:[:ex |
- ^ failBlock valueWithOptionalArgument:ex description
- ] do:[
- tree := self parseMethodBodyOrEmpty.
- ].
+ ParseError handle:[:ex |
+ ^ failBlock valueWithOptionalArgument:ex description
+ ] do:[
+ tree := self parseMethodBodyOrEmpty.
+ ].
].
checkForEndOfInput ifTrue:[self checkForEndOfInput].
"if reading from a stream, backup for next expression"
mustBackup ifTrue:[
- self backupPosition
+ self backupPosition
].
(self errorFlag or:[tree == #Error]) ifTrue:[
- failBlock notNil ifTrue:[
- ^ failBlock valueWithOptionalArgument:'parse error'
- ].
- ^ #Error
+ failBlock notNil ifTrue:[
+ ^ failBlock valueWithOptionalArgument:'parse error'
+ ].
+ ^ #Error
].
tree isNil ifTrue:[
- EmptySourceNotificationSignal raiseRequest.
- ^ nil
+ EmptySourceNotificationSignal raiseRequest.
+ ^ nil
].
(logged
and:[loggedString notNil
and:[Smalltalk logDoits]]) ifTrue:[
- Class updateChangeFileQuerySignal query ifTrue:[
- chgStream := Class changesStream.
- chgStream notNil ifTrue:[
- chgStream nextChunkPut:loggedString.
- chgStream cr.
- chgStream close
- ]
- ].
- Project notNil ifTrue:[
- Class updateChangeListQuerySignal query ifTrue:[
- Project addDoIt:loggedString
- ]
- ]
+ Class updateChangeFileQuerySignal query ifTrue:[
+ chgStream := Class changesStream.
+ chgStream notNil ifTrue:[
+ chgStream nextChunkPut:loggedString.
+ chgStream cr.
+ chgStream close
+ ]
+ ].
+ Project notNil ifTrue:[
+ Class updateChangeListQuerySignal query ifTrue:[
+ Project addDoIt:loggedString
+ ]
+ ]
].
"
@@ -5090,107 +5091,107 @@
spc := self getNameSpace.
spc isNil ifTrue:[
- (requestor respondsTo:#currentNameSpace) ifTrue:[
- spc := requestor currentNameSpace
- ] ifFalse:[
- spc := nameSpaceQuerySignal query.
- ]
+ (requestor respondsTo:#currentNameSpace) ifTrue:[
+ spc := requestor currentNameSpace
+ ] ifFalse:[
+ spc := nameSpaceQuerySignal query.
+ ]
].
Parser undefinedVariableError handle:[:ex |
- failBlock isNil ifTrue:[
- ex reject.
- ] ifFalse:[
- ^ failBlock valueWithOptionalArgument:ex description.
- ].
+ failBlock isNil ifTrue:[
+ ex reject.
+ ] ifFalse:[
+ ^ failBlock valueWithOptionalArgument:ex description.
+ ].
] do:[
- nameSpaceQuerySignal answer:spc
- do:[
- |method|
-
- "
- if compile is false, or the parse tree is that of a constant,
- or a variable, quickly return its value.
- This is used for example, when reading simple objects
- via #readFrom:.
- The overhead of compiling a method is avoided in this case.
- "
- ((SuppressDoItCompilation == true)
- or:[compile not
- or:[tree isSimpleConstant
- or:[tree isSimpleVariable
- or:[aStringOrStream isStream
- or:[aContext notNil "also, if we evaluate inside a context (cannot generate code for context access, yet)"
- ]]]]]) ifTrue:[
- ^ tree evaluate
- ].
-
- "
- if I am the ByteCodeCompiler,
- generate a dummy method, execute it and return the value.
- otherwise, just evaluate the tree; slower, but not too bad ...
-
- This allows systems to be delivered without the ByteCodeCompiler,
- and still evaluate expressions
- (needed to read resource files or to process .rc files).
- "
- self == Parser ifTrue:[
- self evalExitBlock:[:value | self release. ^ value].
- value := tree evaluate.
- self evalExitBlock:nil.
- ] ifFalse:[
- s := self correctedSource.
- s isNil ifTrue:[
- aStringOrStream isStream ifTrue:[
- s := self collectedSource. "/ does not work yet ...
- ] ifFalse:[
- s := aStringOrStream
- ].
- ].
-
- "/ actually, its a block, to allow
- "/ easy return ...
-
- sReal := 'doIt ^[ ' , s , '\] value' withCRs.
-
- compiler := ByteCodeCompiler new.
- compiler initializeFlagsFrom:self.
- method := compiler
- compile:sReal
- forClass:anObject class
- inCategory:'_temporary_'
- notifying:requestor
- install:false
- skipIfSame:false
- silent:true
- foldConstants:false.
-
- method notNil ifTrue:[
- method ~~ #Error ifTrue:[
- "
- fake: patch the source string, to what the user expects
- in the browser
- "
- method source:"' ' , "s string.
- "
- don't do any just-in-time compilation on it (pretent that it was already checked).
- "
- method checked:true.
-
- value := method
- valueWithReceiver:anObject
- arguments:nil "/ (Array with:m)
- selector:(requestor isNil ifTrue:[#'doItX'] ifFalse:[#'doIt']) "/ #doIt:
- search:nil
- sender:nil.
- ] ifFalse:[
- self evalExitBlock:[:value | self release. ^ value].
- value := tree evaluate.
- self evalExitBlock:nil.
- ]
- ].
- ]
- ].
+ nameSpaceQuerySignal answer:spc
+ do:[
+ |method|
+
+ "
+ if compile is false, or the parse tree is that of a constant,
+ or a variable, quickly return its value.
+ This is used for example, when reading simple objects
+ via #readFrom:.
+ The overhead of compiling a method is avoided in this case.
+ "
+ ((SuppressDoItCompilation == true)
+ or:[compile not
+ or:[tree isSimpleConstant
+ or:[tree isSimpleVariable
+ or:[aStringOrStream isStream
+ or:[aContext notNil "also, if we evaluate inside a context (cannot generate code for context access, yet)"
+ ]]]]]) ifTrue:[
+ ^ tree evaluate
+ ].
+
+ "
+ if I am the ByteCodeCompiler,
+ generate a dummy method, execute it and return the value.
+ otherwise, just evaluate the tree; slower, but not too bad ...
+
+ This allows systems to be delivered without the ByteCodeCompiler,
+ and still evaluate expressions
+ (needed to read resource files or to process .rc files).
+ "
+ self == Parser ifTrue:[
+ self evalExitBlock:[:value | self release. ^ value].
+ value := tree evaluate.
+ self evalExitBlock:nil.
+ ] ifFalse:[
+ s := self correctedSource.
+ s isNil ifTrue:[
+ aStringOrStream isStream ifTrue:[
+ s := self collectedSource. "/ does not work yet ...
+ ] ifFalse:[
+ s := aStringOrStream
+ ].
+ ].
+
+ "/ actually, its a block, to allow
+ "/ easy return ...
+
+ sReal := 'doIt ^[ ' , s , '\] value' withCRs.
+
+ compiler := ByteCodeCompiler new.
+ compiler initializeFlagsFrom:self.
+ method := compiler
+ compile:sReal
+ forClass:anObject class
+ inCategory:'_temporary_'
+ notifying:requestor
+ install:false
+ skipIfSame:false
+ silent:true
+ foldConstants:false.
+
+ method notNil ifTrue:[
+ method ~~ #Error ifTrue:[
+ "
+ fake: patch the source string, to what the user expects
+ in the browser
+ "
+ method source:"' ' , "s string.
+ "
+ don't do any just-in-time compilation on it (pretent that it was already checked).
+ "
+ method checked:true.
+
+ value := method
+ valueWithReceiver:anObject
+ arguments:nil "/ (Array with:m)
+ selector:(requestor isNil ifTrue:[#'doItX'] ifFalse:[#'doIt']) "/ #doIt:
+ search:nil
+ sender:nil.
+ ] ifFalse:[
+ self evalExitBlock:[:value | self release. ^ value].
+ value := tree evaluate.
+ self evalExitBlock:nil.
+ ]
+ ].
+ ]
+ ].
].
self release.
^ value
@@ -5202,37 +5203,37 @@
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
@@ -5249,14 +5250,14 @@
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
@@ -5273,26 +5274,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"
! !
@@ -5334,7 +5335,7 @@
correctedSource := requestor currentSourceCode.
"/ update the current source position
source := (ReadStream on:correctedSource)
- position:(source position + 1 - selectionSize).
+ position:(source position + 1 - selectionSize).
^ nil
@@ -5353,53 +5354,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.
@@ -5416,53 +5417,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 markLocalVariableDeclaration: tokenName from: 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 markLocalVariableDeclaration: tokenName from: 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.
@@ -5472,13 +5473,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
@@ -5491,8 +5492,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
!
@@ -5510,41 +5511,41 @@
(thisStatement == #Error) ifTrue:[^ #Error].
firstStatement := thisStatement.
[tokenType == $] ] whileFalse:[
- (tokenType == $.) ifFalse:[
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'missing '']'' in block' position:blockStart to:(source position + 1).
- ^ #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.
- ^ self statementListRewriteHookFor: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 position + 1).
+ ^ #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.
+ ^ self statementListRewriteHookFor:firstStatement
+ ].
+ thisStatement := self statement.
+ (thisStatement == #Error) ifTrue:[^ #Error].
+ prevStatement nextStatement:thisStatement
].
self markBracketAt:tokenPosition.
^ self statementListRewriteHookFor:firstStatement
@@ -5560,21 +5561,21 @@
|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 position.
- ].
- 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 position.
+ ].
+ self parseError:msg position:tokenPosition to:endPos.
+ ^#Error
]
"Modified: / 22-08-2006 / 14:22:45 / cg"
@@ -5583,10 +5584,10 @@
emptyStatement
(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"
@@ -5596,7 +5597,7 @@
makeSelector:rawSelector
false ifTrue:[ "/ will eventually support namespace selectors
currentNamespace notNil ifTrue:[
- ^ (':',currentNamespace name,':',rawSelector) asSymbol
+ ^ (':',currentNamespace name,':',rawSelector) asSymbol
].
].
@@ -5618,20 +5619,20 @@
|tree|
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.
].
(tokenType == $^) ifTrue:[
- self nextToken.
+ self nextToken.
].
(tokenType == #EOF) ifTrue:[
- ^ nil
+ ^ nil
].
tree := self expression.
"/ (self errorFlag or:[tree == #Error]) ifTrue:[^ #Error].
@@ -5648,8 +5649,8 @@
Returns that array"
self nextToken ~~ #HashLeftParen ifTrue:[
- self syntaxError: '# expected, ', token printString ,'found.'.
- ^ ParseError raiseRequest.
+ self syntaxError: '# expected, ', token printString ,'found.'.
+ ^ ParseError raiseRequest.
].
self nextToken.
^self array.
@@ -5671,7 +5672,7 @@
(self parseMethodSpec == #Error) ifTrue:[^ #Error].
parseTree := self parseMethodBody.
(parseTree == #Error) ifFalse:[
- self tree:parseTree
+ self tree:parseTree
].
self checkForEndOfInput.
^ parseTree
@@ -5689,10 +5690,10 @@
messages should be sent to the Transcript or suppressed."
^ self
- parseMethod:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
+ parseMethod:aString
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
"Modified: / 06-03-2007 / 18:33:39 / cg"
"Created: / 04-10-2011 / 15:35:15 / cg"
@@ -5727,29 +5728,29 @@
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
@@ -5762,8 +5763,8 @@
empty (or comment only) input is accepted and returns nil.
methodBodyOrNil ::= '<' st80Primitive '>'
- | '<' st80Primitive '>' methodBodyVarSpec statementList
- | <empty>
+ | '<' st80Primitive '>' methodBodyVarSpec statementList
+ | <empty>
"
|stats|
@@ -5771,10 +5772,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.
@@ -5782,14 +5783,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
@@ -5804,136 +5805,136 @@
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 markLocalVariableDeclaration: tokenName from: 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:[ ignoreWarnings not
- 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:[
- PossibleCorrectionsQuery answer:{ CorrectByInteractiveRename . CorrectByDeletingLocalIdentifier } do:[
- |fix|
-
- fix := self
- correctableWarning:(('local variable "%1" hides ',whatIsHidden,'.') bindWith:tokenName allBold)
- doNotShowAgainAction:[ parserFlags warnHiddenVariables:false. ParserFlags warnHiddenVariables:false ]
- doNotShowAgainForThisMethodAction: [ self disableWarningsOnCurrentMethodFor: #warnHiddenVariables ]
- position:tokenPosition to:pos2.
- fix isBehavior ifTrue:[
- self correctWith:(fix new) from:pos to:pos2.
- ].
- self breakPoint:#cg.
- fix == #Error ifTrue:[
- ^ #Error
- ]
- ]
- ]
- ].
-
- 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 position.
- 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 markLocalVariableDeclaration: tokenName from: 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:[ ignoreWarnings not
+ 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:[
+ PossibleCorrectionsQuery answer:{ CorrectByInteractiveRename . CorrectByDeletingLocalIdentifier } do:[
+ |fix|
+
+ fix := self
+ correctableWarning:(('local variable "%1" hides ',whatIsHidden,'.') bindWith:tokenName allBold)
+ doNotShowAgainAction:[ parserFlags warnHiddenVariables:false. ParserFlags warnHiddenVariables:false ]
+ doNotShowAgainForThisMethodAction: [ self disableWarningsOnCurrentMethodFor: #warnHiddenVariables ]
+ position:tokenPosition to:pos2.
+ fix isBehavior ifTrue:[
+ self correctWith:(fix new) from:pos to:pos2.
+ ].
+ self breakPoint:#cg.
+ fix == #Error ifTrue:[
+ ^ #Error
+ ]
+ ]
+ ]
+ ].
+
+ 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 position.
+ 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
@@ -5948,14 +5949,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.
@@ -5963,115 +5964,115 @@
"/ 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
- ].
- self isSyntaxHighlighter ifFalse:[
- (ignoreWarnings not and:[parserFlags warnHiddenVariables]) ifTrue:[
- classToCompileFor isClass ifTrue:[
- (self classesInstVarNames includes:tokenName) ifTrue:[
- PossibleCorrectionsQuery answer:{ CorrectByInteractiveRename } do:[
- |fix|
-
- fix := self
- correctableWarning:'argument "' , tokenName allBold , '" hides instance variable.'
- position:argPos1 to:argPos2.
- "/ migrating to the new scheme...
- fix isBehavior ifTrue:[
- self correctWith:(fix new) from: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
+ ].
+ self isSyntaxHighlighter ifFalse:[
+ (ignoreWarnings not and:[parserFlags warnHiddenVariables]) ifTrue:[
+ classToCompileFor isClass ifTrue:[
+ (self classesInstVarNames includes:tokenName) ifTrue:[
+ PossibleCorrectionsQuery answer:{ CorrectByInteractiveRename } do:[
+ |fix|
+
+ fix := self
+ correctableWarning:'argument "' , tokenName allBold , '" hides instance variable.'
+ position:argPos1 to:argPos2.
+ "/ migrating to the new scheme...
+ fix isBehavior ifTrue:[
+ self correctWith:(fix new) from: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 == $|
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
- ^ self identifierExpectedIn:'method-arg declaration'.
- ].
- 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
+ ^ self identifierExpectedIn:'method-arg declaration'.
+ ].
+ 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
].
self parseError:'invalid method specification'.
^ #Error
@@ -6117,8 +6118,8 @@
"parse a statement; return a node-tree or #Error.
statement ::= '^' expression
- | PRIMITIVECODE
- | expression
+ | PRIMITIVECODE
+ | expression
"
|expr node lnr code pos|
@@ -6126,39 +6127,39 @@
pos := tokenPosition.
(tokenType == $^) ifTrue:[
- ^ self returnStatement
+ ^ self returnStatement
].
(tokenType == #Primitive) ifTrue:[
- code := tokenValue.
- node := PrimitiveNode code:code.
- node startPosition: tokenPosition endPosition: source position + 1.
- self nextToken.
- node isOptional ifFalse:[
- hasNonOptionalPrimitiveCode := true
- ].
- hasPrimitiveCode := true.
- ^ node
+ code := tokenValue.
+ node := PrimitiveNode code:code.
+ node startPosition: tokenPosition endPosition: source position + 1.
+ 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
+ ].
].
lnr := tokenLineNr.
@@ -6188,7 +6189,7 @@
Statements must be separated by periods.
statementList ::= <statement>
- | <statementList> . <statement>
+ | <statementList> . <statement>
"
|thisStatement prevStatement firstStatement periodPos prevExpr|
@@ -6197,41 +6198,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
@@ -6241,70 +6242,70 @@
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.
@@ -6313,18 +6314,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.
+ ].
].
! !
@@ -6336,7 +6337,7 @@
pos1 := tokenPosition.
elements := OrderedCollection new.
[tokenType ~~ $) ] whileTrue:[
- elem := self arrayConstant.
+ elem := self arrayConstant.
"/ (elem == #Error) ifTrue:[
"/ (tokenType == #EOF) ifTrue:[
@@ -6345,11 +6346,11 @@
"/ ].
"/ ^ #Error
"/ ].
- elem isSymbol ifTrue:[
- self markSymbolFrom:tokenPosition to:(source position).
- ].
- elements add:elem.
- self nextToken.
+ elem isSymbol ifTrue:[
+ self markSymbolFrom:tokenPosition to:(source position).
+ ].
+ elements add:elem.
+ self nextToken.
"/ tokenType == $. ifTrue:[
"/ self emptyStatement.
"/ ].
@@ -6357,7 +6358,7 @@
arr := Array withAll:elements.
parserFlags arraysAreImmutable ifTrue:[
- ^ self makeImmutableArray:arr
+ ^ self makeImmutableArray:arr
].
^ arr
@@ -6368,97 +6369,97 @@
|val|
(tokenType == #Nil) ifTrue:[
- self warnPossibleIncompatibility:'nil in array constant is interpreted as #nil (symbol) in some other (older) Smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
- ^ tokenValue
+ self warnPossibleIncompatibility:'nil in array constant is interpreted as #nil (symbol) in some other (older) Smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
+ ^ tokenValue
].
(tokenType == #True) ifTrue:[
- self warnPossibleIncompatibility:'true in array constant is interpreted as #true (symbol) in some other (older) Smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
- ^ tokenValue
+ self warnPossibleIncompatibility:'true in array constant is interpreted as #true (symbol) in some other (older) Smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
+ ^ tokenValue
].
(tokenType == #False) ifTrue:[
- self warnPossibleIncompatibility:'false in array constant is interpreted as #false (symbol) in some other (older) Smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
- ^ tokenValue
+ self warnPossibleIncompatibility:'false in array constant is interpreted as #false (symbol) in some other (older) 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 raiseRequest.
+ ^ ParseError raiseRequest.
].
(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'
+ ^ #'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
+ 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 raiseRequest.
+ "just for the better error-hilight; let caller handle error"
+ self syntaxError:'EOF unexpected in array-constant'.
+ ^ ParseError raiseRequest.
].
self syntaxError:('"'
- , tokenType printString
- , '" unexpected in array-constant').
+ , tokenType printString
+ , '" unexpected in array-constant').
^ ParseError raiseRequest.
"Modified: / 22-08-2006 / 14:21:16 / cg"
@@ -6484,40 +6485,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
@@ -6526,13 +6527,13 @@
"/ returns: false
"/ from: encoder.
"/ ].
- argList add: valNode
+ argList add: valNode
].
^ MessageNode
- receiver:receiver
- selector:selectorStream contents
- args:argList.
+ receiver:receiver
+ selector:selectorStream contents
+ args:argList.
"
AllowArrayIndexSyntaxExtension := true.
@@ -6583,69 +6584,69 @@
[(tokenType == #BinaryOperator)
or:[(tokenType == $|)
or:[(tokenType == $^ and:[parserFlags allowCaretAsBinop or:[parserFlags allowExtendedBinarySelectors]])
- 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.
- self clearErrorFlag. "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 isPossiblyUninitializedLocal:arg) ifTrue:[
- self
- warning:'"',arg name,'" is uninitialized here (always nil)'
- position:(arg startPosition) to:(arg endPosition).
- ].
-
- 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.
+ self clearErrorFlag. "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 isPossiblyUninitializedLocal:arg) ifTrue:[
+ self
+ warning:'"',arg name,'" is uninitialized here (always nil)'
+ position:(arg startPosition) to:(arg endPosition).
+ ].
+
+ self checkPlausibilityOf:expr from:pos1 to:pos2.
+ parseForCode ifFalse:[
+ self rememberSelectorUsed:sel receiver:receiver
+ ].
+ expr := self messageNodeRewriteHookFor:expr.
+ receiver := expr. "/ for next message
].
^ receiver
@@ -6662,41 +6663,41 @@
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
!
@@ -6711,17 +6712,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].
@@ -6729,10 +6730,10 @@
sel notNil ifTrue:[ ^ sel].
rec isAssignment ifTrue:[
- rec := rec expression
+ rec := rec expression
].
rec isMessage ifTrue:[
- ^ rec selector
+ ^ rec selector
].
^ nil
@@ -6747,14 +6748,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 tokenStart tokenEnd realReceiver positions
@@ -6764,121 +6765,121 @@
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:[
- lastSemiPosition := tokenPosition.
- self nextToken.
- (tokenType == #Identifier) ifTrue:[
- tokenStart := tokenPosition.
- 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: tokenStart
- endPosition: tokenEnd.
- receiver selectorPartPositions: (Array with: (tokenStart to: tokenEnd)).
- receiver lineNumber:tokenLineNr.
- receiver := self messageNodeRewriteHookFor:receiver.
- parseForCode ifFalse:[
- self rememberSelectorUsed:sel receiver:realReceiver
- ].
- self nextToken.
- ] ifFalse:[
- (tokenType == #BinaryOperator) ifTrue:[
- tokenStart := tokenPosition.
- 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 startPosition: tokenStart endPosition: arg endPosition.
- receiver selectorPartPositions: (Array with: (tokenStart to: tokenEnd)).
- receiver lineNumber:lno.
- receiver := self messageNodeRewriteHookFor:receiver.
- receiver lineNumber:lno.
- parseForCode ifFalse:[
- self rememberSelectorUsed:sel receiver:realReceiver
- ].
- ] ifFalse:[
- (tokenType == #Keyword) ifTrue:[
- tokenStart := tokenPosition.
- 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.
- receiver startPosition: tokenStart endPosition: args last endPosition.
- receiver := self messageNodeRewriteHookFor:receiver.
- receiver lineNumber:lno.
- receiver selectorPartPositions: positions.
- parseForCode ifFalse:[
- self rememberSelectorUsed:sel receiver:realReceiver args:args
- ].
- ] ifFalse:[
- (tokenType == #Error) ifTrue:[^ #Error].
- self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
- position:lastSemiPosition to:source position.
- ^ #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 position.
- ^ #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:[
+ lastSemiPosition := tokenPosition.
+ self nextToken.
+ (tokenType == #Identifier) ifTrue:[
+ tokenStart := tokenPosition.
+ 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: tokenStart
+ endPosition: tokenEnd.
+ receiver selectorPartPositions: (Array with: (tokenStart to: tokenEnd)).
+ receiver lineNumber:tokenLineNr.
+ receiver := self messageNodeRewriteHookFor:receiver.
+ parseForCode ifFalse:[
+ self rememberSelectorUsed:sel receiver:realReceiver
+ ].
+ self nextToken.
+ ] ifFalse:[
+ (tokenType == #BinaryOperator) ifTrue:[
+ tokenStart := tokenPosition.
+ 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 startPosition: tokenStart endPosition: arg endPosition.
+ receiver selectorPartPositions: (Array with: (tokenStart to: tokenEnd)).
+ receiver lineNumber:lno.
+ receiver := self messageNodeRewriteHookFor:receiver.
+ receiver lineNumber:lno.
+ parseForCode ifFalse:[
+ self rememberSelectorUsed:sel receiver:realReceiver
+ ].
+ ] ifFalse:[
+ (tokenType == #Keyword) ifTrue:[
+ tokenStart := tokenPosition.
+ 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.
+ receiver startPosition: tokenStart endPosition: args last endPosition.
+ receiver := self messageNodeRewriteHookFor:receiver.
+ receiver lineNumber:lno.
+ receiver selectorPartPositions: positions.
+ parseForCode ifFalse:[
+ self rememberSelectorUsed:sel receiver:realReceiver args:args
+ ].
+ ] ifFalse:[
+ (tokenType == #Error) ifTrue:[^ #Error].
+ self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
+ position:lastSemiPosition to:source position.
+ ^ #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 position.
+ ^ #Error
"/ self warning: "syntaxError:" 'possibly ambigous cascade - please group using (...)'
"/ position:tokenPosition to:source position - 1.
"/ tokenType == #Identifier ifTrue:[
@@ -6888,7 +6889,7 @@
"/ ^ self binaryExpressionFor:receiver
"/ ].
"/ ^ self keywordExpressionFor:receiver
- ]
+ ]
].
^ receiver
@@ -6904,33 +6905,33 @@
argList := OrderedCollection new.
[
- 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.
] loop.
!
functionCallExpression
"parse a functionCall;
this is an st/x extension.
- foo(x)
+ foo(x)
is syntactic sugar for
- foo value:x
+ foo value:x
This syntax extension must be enabled in the parserFlags as
allowFunctionCallSyntaxForBlockEvaluation (disabled by default)
"
@@ -6944,11 +6945,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.
@@ -6956,34 +6957,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.
+ receiver:receiver
+ selector:#valueWithArguments:
+ args:(self genMakeArrayWith:argList))
+ startPosition: receiver startPosition
+ endPosition: tokenLastEndPosition.
"
Parser allowFunctionCallSyntaxForBlockEvaluation:true.
"
@@ -7025,26 +7026,26 @@
namesAndValues := OrderedCollection new.
[ tokenType ~~ $} ] whileTrue:[
- (tokenType == #Keyword) ifFalse:[
- self syntaxError:'Bad inlineObject; Keyword expected'
- position:pos1 to:tokenPosition
- ].
- name := tokenName copyButLast:1.
- self nextToken.
- value := self arrayConstant.
- self nextToken.
- namesAndValues add:(name -> value).
-
- tokenType = $. ifTrue:[
- self nextToken.
- ].
+ (tokenType == #Keyword) ifFalse:[
+ self syntaxError:'Bad inlineObject; Keyword expected'
+ position:pos1 to:tokenPosition
+ ].
+ name := tokenName copyButLast:1.
+ self nextToken.
+ value := self arrayConstant.
+ self nextToken.
+ namesAndValues add:(name -> value).
+
+ tokenType = $. ifTrue:[
+ self nextToken.
+ ].
].
didWarnAboutSTXExtensions~~ true ifTrue:[
- didWarnAboutSTXExtensions := true.
- self
- warning:'InlineObjects are an experimental feature which is not yet supported by stc'
- position:pos1 to:tokenPosition.
+ didWarnAboutSTXExtensions := true.
+ 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).
@@ -7054,7 +7055,7 @@
"parse a keyword-expression; return a node-tree, nil or #Error.
keywordExpression ::= binaryexpression
- | { KEYWORD-PART binaryExpression }
+ | { KEYWORD-PART binaryExpression }
"
|receiver expr|
@@ -7067,48 +7068,48 @@
expr := self keywordExpressionFor:receiver.
expr == #Error ifTrue:[ "/ should no longer happen
-self breakPoint:#cg.
- ^ #Error
+self breakPoint:#cg.
+ ^ #Error
].
"/ expr could be an assignment as well, here
(ignoreWarnings or:[ignoreErrors]) ifFalse:[
- "/ for a better error message, in case of a missing period in the previous message,
- "/ <expr> <missing period> foo := ...
- "/ would be parsed as unary message foo; detect this here, instead of high up in the calling hierarchy,
- "/ where it is difficult to provide a reasonable error message
- tokenType == #':=' ifTrue:[
- |positionOfPeriod|
-
- expr isMessage ifTrue:[
- expr isUnaryMessage ifTrue:[
- positionOfPeriod := expr receiver positionToInsertPeriodForStatementSeparation
- ] ifFalse:[
- |lastArg|
-
- (lastArg := expr args last) isUnaryMessage ifTrue:[
- positionOfPeriod := lastArg receiver positionToInsertPeriodForStatementSeparation
- ].
- ].
- ].
- positionOfPeriod notNil ifTrue:[
- PossibleCorrectionsQuery answer:{ CorrectByInsertingPeriod new positionOfPeriod:positionOfPeriod} do:[
- |fix|
-
- fix := self
- correctableWarning:('":=" unexpected. Probably missing "." in previous expression.')
- position:tokenPosition to:tokenPosition+token size-1.
-
- (fix isBehavior or:[fix isKindOf:Correction]) ifTrue:[
- self correctWith:fix from:tokenPosition to:tokenPosition+token size-1.
- ].
+ "/ for a better error message, in case of a missing period in the previous message,
+ "/ <expr> <missing period> foo := ...
+ "/ would be parsed as unary message foo; detect this here, instead of high up in the calling hierarchy,
+ "/ where it is difficult to provide a reasonable error message
+ tokenType == #':=' ifTrue:[
+ |positionOfPeriod|
+
+ expr isMessage ifTrue:[
+ expr isUnaryMessage ifTrue:[
+ positionOfPeriod := expr receiver positionToInsertPeriodForStatementSeparation
+ ] ifFalse:[
+ |lastArg|
+
+ (lastArg := expr args last) isUnaryMessage ifTrue:[
+ positionOfPeriod := lastArg receiver positionToInsertPeriodForStatementSeparation
+ ].
+ ].
+ ].
+ positionOfPeriod notNil ifTrue:[
+ PossibleCorrectionsQuery answer:{ CorrectByInsertingPeriod new positionOfPeriod:positionOfPeriod} do:[
+ |fix|
+
+ fix := self
+ correctableWarning:('":=" unexpected. Probably missing "." in previous expression.')
+ position:tokenPosition to:tokenPosition+token size-1.
+
+ (fix isBehavior or:[fix isKindOf:Correction]) ifTrue:[
+ self correctWith:fix from:tokenPosition to:tokenPosition+token size-1.
+ ].
self breakPoint:#cg.
- fix == #Error ifTrue:[
- ^ #Error
- ]
- ]
- ]
- ].
+ fix == #Error ifTrue:[
+ ^ #Error
+ ]
+ ]
+ ]
+ ].
].
^ expr
@@ -7118,7 +7119,7 @@
"parse a keyword-expression; return a node-tree, nil or #Error.
keywordExpression ::= binaryexpression
- | { KEYWORD-PART binaryExpression }
+ | { KEYWORD-PART binaryExpression }
"
|expr receiver sel selChecked arg args posR1 posR2 pos1 pos2 lno selectorPartPositions|
@@ -7137,25 +7138,25 @@
(arg == #Error) ifTrue:[^ #Error].
args := Array with:arg.
[tokenType == #Keyword] whileTrue:[
- sel := sel , tokenName.
- pos2 := tokenPosition + tokenName size - 1.
- selectorPartPositions 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.
+ selectorPartPositions add:(tokenPosition to:pos2).
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := args copyWith:arg.
].
args do:[:eachArg |
- (self isPossiblyUninitializedLocal:eachArg) ifTrue:[
- self
- warning:'"',eachArg name,'" is uninitialized here (always nil)'
- position:(eachArg startPosition) to:(eachArg endPosition).
- ].
+ (self isPossiblyUninitializedLocal:eachArg) ifTrue:[
+ self
+ warning:'"',eachArg name,'" is uninitialized here (always nil)'
+ position:(eachArg startPosition) to:(eachArg endPosition).
+ ].
].
selectorPartPositions do:[:p |
- self markSelector:sel from:p start to:p stop receiverNode:receiver.
+ self markSelector:sel from:p start to:p stop receiverNode:receiver.
].
"/ need this before, so receiver has a parent (needed by correction)
@@ -7165,31 +7166,31 @@
selChecked := self selectorCheck:sel for:receiver positions:selectorPartPositions.
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 isErrorNode ifTrue:[
- self parseError:(expr errorString) position:pos1 to:pos2.
- self clearErrorFlag. "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.
+ self clearErrorFlag. "ok, user wants it - so he'll get it"
+ expr := MessageNode receiver:receiver selector:sel args:args fold:nil.
].
sel ~~ selChecked ifTrue:[
- expr args size ~~ args size ifTrue:[
- self parseError:'Parser: selector botch (message folded?'.
- ].
- expr selector:sel. "/ in case it was changed in the selectorCheck.
+ expr args size ~~ args size ifTrue:[
+ self parseError:'Parser: selector botch (message folded?'.
+ ].
+ expr selector:sel. "/ in case it was changed in the selectorCheck.
].
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
@@ -7203,8 +7204,8 @@
"/
self isSyntaxHighlighter ifTrue:[
- "/ look for true ifTrue / false ifFalse and mark as comment
- self markUnreachableCodeAsCommentIn:expr.
+ "/ look for true ifTrue / false ifFalse and mark as comment
+ self markUnreachableCodeAsCommentIn:expr.
].
^ self messageNodeRewriteHookFor:expr.
@@ -7227,21 +7228,21 @@
class instSize: names size.
names keysAndValuesDo:[:idx :instVarName |
- |m|
-
- idx <= InlineObjectPrototype instSize ifTrue:[
- class basicAddSelector:(instVarName asSymbol) withMethod:(m := InlineObjectPrototype compiledMethodAt:('i%1' bindWith:idx) asSymbol).
- inlineObjectsAreReadonly ifFalse:[
- class basicAddSelector:(instVarName asMutator) withMethod:(m := 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.
- ].
- ].
- ].
+ |m|
+
+ idx <= InlineObjectPrototype instSize ifTrue:[
+ class basicAddSelector:(instVarName asSymbol) withMethod:(m := InlineObjectPrototype compiledMethodAt:('i%1' bindWith:idx) asSymbol).
+ inlineObjectsAreReadonly ifFalse:[
+ class basicAddSelector:(instVarName asMutator) withMethod:(m := 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.
@@ -7256,27 +7257,27 @@
|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.
+ "
+ 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)
@@ -7285,39 +7286,39 @@
or:[(tokenType == #Float)
or:[(tokenType == #Symbol)
or:[(tokenType == #ESSymbol)]]]]]) ifTrue:[
- ^ self primary_simpleLiteral.
+ ^ self primary_simpleLiteral.
].
(tokenType == #FixedPoint) ifTrue:[
- parserFlags allowFixedPointLiterals == true ifFalse:[
- self isSyntaxHighlighter ifFalse:[
- self parseError:'non-Standard literal: FixedPoint. Please enable in settings.' position:pos to:pos+2.
- ^ #Error
- ].
- self warning:'non-Standard literal: FixedPoint.'
- ].
- ^ self primary_simpleLiteral.
+ parserFlags allowFixedPointLiterals == true ifFalse:[
+ self isSyntaxHighlighter ifFalse:[
+ self parseError:'non-Standard literal: FixedPoint. Please enable in settings.' position:pos to:pos+2.
+ ^ #Error
+ ].
+ self warning:'non-Standard literal: FixedPoint.'
+ ].
+ ^ 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 inArrayLiteral:true.
- self nextToken.
+ self inArrayLiteral:true.
+ self nextToken.
"/ old
"/ ParseError handle:[:ex |
"/ self inArrayLiteral:false.
@@ -7326,118 +7327,118 @@
"/ val := self array.
"/ ].
"/ self inArrayLiteral:false.
- [
- val := self array.
- ] ensure:[
- self inArrayLiteral:false.
- ].
- self nextToken.
- (self noAssignmentAllowed:'Assignment to a constant' at:pos) ifFalse:[
- ^ #Error
- ].
- ^ ConstantNode type:#Array value:val from: pos to: tokenLastEndPosition.
+ [
+ val := self array.
+ ] ensure:[
+ 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:[
- val := self qualifiedNameOrInlineObject.
- ^ val.
+ 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 position + 1.
- self nextToken.
- hasNonOptionalPrimitiveCode := true.
- hasPrimitiveCode := true.
- ^ node
+ node := PrimitiveNode code:tokenValue.
+ node startPosition: tokenPosition endPosition: source position + 1.
+ 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:[
- "allow # (element...) - i.e. with a separator inbetween"
- ((tokenType == #BinaryOperator) and:[token = '#']) ifTrue:[
- self nextToken.
- (tokenType == $( ) ifFalse:[
- self parseError:'''('' expected after #.' position:pos to:tokenPosition.
- ^ #Error.
- ].
- self nextToken.
- self inArrayLiteral:true.
- "/ old
+ "allow # (element...) - i.e. with a separator inbetween"
+ ((tokenType == #BinaryOperator) and:[token = '#']) ifTrue:[
+ self nextToken.
+ (tokenType == $( ) ifFalse:[
+ self parseError:'''('' expected after #.' position:pos to:tokenPosition.
+ ^ #Error.
+ ].
+ self nextToken.
+ self inArrayLiteral:true.
+ "/ old
"/ ParseError handle:[:ex |
"/ self inArrayLiteral:false.
"/ ^ #Error
@@ -7445,76 +7446,76 @@
"/ val := self array.
"/ ].
"/ self inArrayLiteral:false.
- "/ new
- [
- val := self array.
- ] ensure:[
- self inArrayLiteral:false.
- ].
-
- self nextToken.
- (self noAssignmentAllowed:'Assignment to a constant' at:pos) ifFalse:[
- ^ #Error
- ].
- ^ ConstantNode type:#Array value:val from: pos to: tokenLastEndPosition.
- ].
+ "/ new
+ [
+ val := self array.
+ ] ensure:[
+ 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:[
- "/ this is a bad hack, because the scanner does not know
- "/ if -1 is to be scanned as a negative number
- "/ (for example, in: 'a-1' it has to be scanned as a binop)
- "/ So the scanner always gives us a binop-"-".
- "/ The hack code below deals with that.
-
- "/ But make sure, there is no whitespace in between, so we do not scan "foo := - 2"
- "/ as a negative 2.
- |endPos1|
-
- endPos1 := source position.
- self nextToken.
- ((tokenType == #Integer) or:[(tokenType == #Float)]) ifFalse:[
- self parseError:'number expected after sign.' position:pos to:tokenPosition.
- ^ #Error.
- ].
- tokenPosition = (endPos1+1) ifFalse:[
- self isSyntaxHighlighter ifFalse:[
- parserFlags allowPossibleSTCCompilationProblems ifFalse:[
- self parseError:'Space between sign and number; this will not compile with stc' position:pos to:tokenPosition.
- "/ errorFlag := false.
- ].
- ((parserFlags allowSqueakExtensions not)
- and:[parserFlags allowSTVExtensions not]) ifTrue:[
- self parseError:'non-Standard Squeak (or ST/V) extension: space between sign and number. Enable in Settings' position:pos to:tokenPosition.
- "/ errorFlag := false.
- ].
- ].
- self warning:'Space between sign and number is not allowed in stc (and some other smalltalk systems)' position:endPos1 to:tokenPosition.
- ].
-
- 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.
+ "/ this is a bad hack, because the scanner does not know
+ "/ if -1 is to be scanned as a negative number
+ "/ (for example, in: 'a-1' it has to be scanned as a binop)
+ "/ So the scanner always gives us a binop-"-".
+ "/ The hack code below deals with that.
+
+ "/ But make sure, there is no whitespace in between, so we do not scan "foo := - 2"
+ "/ as a negative 2.
+ |endPos1|
+
+ endPos1 := source position.
+ self nextToken.
+ ((tokenType == #Integer) or:[(tokenType == #Float)]) ifFalse:[
+ self parseError:'number expected after sign.' position:pos to:tokenPosition.
+ ^ #Error.
+ ].
+ tokenPosition = (endPos1+1) ifFalse:[
+ self isSyntaxHighlighter ifFalse:[
+ parserFlags allowPossibleSTCCompilationProblems ifFalse:[
+ self parseError:'Space between sign and number; this will not compile with stc' position:pos to:tokenPosition.
+ "/ errorFlag := false.
+ ].
+ ((parserFlags allowSqueakExtensions not)
+ and:[parserFlags allowSTVExtensions not]) ifTrue:[
+ self parseError:'non-Standard Squeak (or ST/V) extension: space between sign and number. Enable in Settings' position:pos to:tokenPosition.
+ "/ errorFlag := false.
+ ].
+ ].
+ self warning:'Space between sign and number is not allowed in stc (and some other smalltalk systems)' position:endPos1 to:tokenPosition.
+ ].
+
+ 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 position.
+ (#(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 position.
].
self syntaxError:eMsg position:tokenPosition to:endPos.
^ #Error
@@ -7544,40 +7545,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.
@@ -7625,19 +7626,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
@@ -7654,7 +7655,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
@@ -7672,15 +7673,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"
@@ -7702,25 +7703,25 @@
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.
- ] ifFalse:[
- holder := self addDoItTemporary:varName.
- var := VariableNode type:#DoItTemporary holder:holder name:varName.
- ].
- ] 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.
+ ] ifFalse:[
+ holder := self addDoItTemporary:varName.
+ var := VariableNode type:#DoItTemporary holder:holder name:varName.
+ ].
+ ] 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].
@@ -7729,31 +7730,31 @@
"/ ].
(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,'"')
@@ -7762,76 +7763,76 @@
"/ 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:[
- rawName := rawName asSymbol.
- (Smalltalk at:rawName) notNil ifTrue:[
- (self isFirstWarning:(#globalVsPrivateClass -> rawName)) ifTrue:[
- self warning:('Possible name clash (global: ' , rawName , ' vs. private: ' , (nameSpace , '::', varName) , ') - assume globl.')
- position:pos1 to:source position "tokenPosition-1".
- ].
- globlName := rawName.
- ] ifFalse:[
- (self isFirstWarning:(#noPrivateClass -> (nameSpace , '::', varName))) ifTrue:[
- self warning:('no private class: ' , varName allBold , ' in class: ' , nameSpace)
- position:pos1 to:source position "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:[
+ rawName := rawName asSymbol.
+ (Smalltalk at:rawName) notNil ifTrue:[
+ (self isFirstWarning:(#globalVsPrivateClass -> rawName)) ifTrue:[
+ self warning:('Possible name clash (global: ' , rawName , ' vs. private: ' , (nameSpace , '::', varName) , ') - assume globl.')
+ position:pos1 to:source position "tokenPosition-1".
+ ].
+ globlName := rawName.
+ ] ifFalse:[
+ (self isFirstWarning:(#noPrivateClass -> (nameSpace , '::', varName))) ifTrue:[
+ 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
- and:[self isFirstWarning:(#noPrivateClass -> (nameSpace , '::', varName))]) 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 assigned:false.
+ ]
+ ] ifFalse:[
+ "/ reference to a private class
+ (classToCompileFor notNil and:[nameSpaceGlobal ~~ classToCompileFor theNonMetaclass]) ifTrue:[
+ self classToCompileFor notNil ifTrue:[
+ self isDoIt ifFalse:[
+ (parserFlags warnAboutReferenceToPrivateClass
+ and:[self isFirstWarning:(#noPrivateClass -> (nameSpace , '::', varName))]) 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 assigned:false.
].
var == #Error ifTrue:[
- ^ #Error
+ ^ #Error
].
"/ errorFlag ~~ true ifTrue:[
@@ -7842,157 +7843,157 @@
"/ ].
((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.
+ var isMessage ifTrue:[
+ self nextToken.
+ expr := self expression.
"/ self isSyntaxHighlighter ifFalse:[
"/ (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
"/ ].
- ^ MessageNode receiver:(self selfNode) selector:('__' , varName) asMutator arg:expr.
- ].
+ ^ MessageNode receiver:(self selfNode) selector:('__' , varName) asMutator arg:expr.
+ ].
].
assignmentAllowed := true.
(var ~~ #Error) ifTrue:[
- t := var type.
- t == #MethodVariable ifTrue:[
- self rememberLocalModified:var name.
- ] ifFalse:[ t == #BlockVariable ifTrue:[
- var block rememberLocalModified: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:[
- parserFlags warnAssignmentToMethodArgument ifTrue:[
- DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
- parserFlags warnAssignmentToMethodArgument:false.
- parserFlags warnAssignmentToMethodArgument:false.
- ex proceed.
- ] do:[
- self warning:'assignment to method argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
- ]
- ]
- ] ifFalse:[
- DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
- parserFlags allowAssignmentToMethodArgument:true.
- ParserFlags allowAssignmentToMethodArgument:true.
- ex proceed.
- ] do:[
- self parseError:'assignment to method argument.' withCRs position:pos1 to:pos2.
- self clearErrorFlag. "ok, user wants it - so he'll get it"
- assignmentAllowed := true. "/ if proceeded
- ].
- ]
- ] ifFalse:[ (t == #BlockArg) ifTrue:[
- (assignmentAllowed := parserFlags allowAssignmentToBlockArgument) ifTrue:[
- parserFlags warnAssignmentToBlockArgument ifTrue:[
- DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
- parserFlags warnAssignmentToBlockArgument:false.
- parserFlags warnAssignmentToBlockArgument:false.
- ex proceed.
- ] do:[
- self warning:'assignment to block argument.\\Not all Smalltalk dialects allow this.' withCRs 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.
- ]
- ].
- self clearErrorFlag. "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.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
- assignmentAllowed := true.
- ] ifFalse:[
- (assignmentAllowed := parserFlags allowAssignmentToPoolVariable) ifTrue:[
- parserFlags warnAssignmentToPoolVariable ifTrue:[
- DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
- parserFlags warnAssignmentToPoolVariable:false.
- ParserFlags warnAssignmentToPoolVariable:false.
- ex proceed.
- ] do:[
- self warning:'assignment to pool variable.\\Not all Smalltalk dialects allow this.' withCRs 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.
- ].
- self clearErrorFlag. "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:[
+ self rememberLocalModified:var name.
+ ] ifFalse:[ t == #BlockVariable ifTrue:[
+ var block rememberLocalModified: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:[
+ parserFlags warnAssignmentToMethodArgument ifTrue:[
+ DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+ parserFlags warnAssignmentToMethodArgument:false.
+ parserFlags warnAssignmentToMethodArgument:false.
+ ex proceed.
+ ] do:[
+ self warning:'assignment to method argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
+ ]
+ ]
+ ] ifFalse:[
+ DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+ parserFlags allowAssignmentToMethodArgument:true.
+ ParserFlags allowAssignmentToMethodArgument:true.
+ ex proceed.
+ ] do:[
+ self parseError:'assignment to method argument.' withCRs position:pos1 to:pos2.
+ self clearErrorFlag. "ok, user wants it - so he'll get it"
+ assignmentAllowed := true. "/ if proceeded
+ ].
+ ]
+ ] ifFalse:[ (t == #BlockArg) ifTrue:[
+ (assignmentAllowed := parserFlags allowAssignmentToBlockArgument) ifTrue:[
+ parserFlags warnAssignmentToBlockArgument ifTrue:[
+ DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+ parserFlags warnAssignmentToBlockArgument:false.
+ parserFlags warnAssignmentToBlockArgument:false.
+ ex proceed.
+ ] do:[
+ self warning:'assignment to block argument.\\Not all Smalltalk dialects allow this.' withCRs 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.
+ ]
+ ].
+ self clearErrorFlag. "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.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
+ assignmentAllowed := true.
+ ] ifFalse:[
+ (assignmentAllowed := parserFlags allowAssignmentToPoolVariable) ifTrue:[
+ parserFlags warnAssignmentToPoolVariable ifTrue:[
+ DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+ parserFlags warnAssignmentToPoolVariable:false.
+ ParserFlags warnAssignmentToPoolVariable:false.
+ ex proceed.
+ ] do:[
+ self warning:'assignment to pool variable.\\Not all Smalltalk dialects allow this.' withCRs 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.
+ ].
+ self clearErrorFlag. "ok, user wants it - so he'll get it"
+ assignmentAllowed := true. "/ if proceeded
+ parseForCode ifFalse:[
+ self rememberPoolVarModified:var name
+ ]
+ ].
+ ]]]]]]]]]
+ ].
].
lnr := tokenLineNr.
@@ -8016,27 +8017,27 @@
] ifFalse:[
"/ (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
- (ignoreWarnings not and:[ 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.
- ].
- ].
-
- expr isVariable ifTrue:[
- expr name = var name ifTrue:[
- self warning:('useless assignment to "' , var name, '"' ) position:pos1 to:pos2-1.
- ].
- ].
- ].
+ (ignoreWarnings not and:[ 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.
+ ].
+ ].
+
+ 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
@@ -8051,17 +8052,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.
+ receiver:(VariableNode globalNamed:#LazyValue)
+ selector:#'block:'
+ arg:block.
^ expr
!
@@ -8074,7 +8075,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
@@ -8100,7 +8101,7 @@
self nextToken.
(self noAssignmentAllowed:'Assignment to pseudo variable ''self''' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
self markSelfFrom:pos to:pos+3.
^ self selfNode startPosition: pos endPosition: pos + 3
@@ -8122,30 +8123,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 position.
- ] ifFalse:[
- self markConstantFrom:pos to:source position.
- ].
+ tokenType == #String ifTrue:[
+ self markStringFrom:pos to:source position.
+ ] ifFalse:[
+ self markConstantFrom:pos to:source position.
+ ].
].
self nextToken.
(self noAssignmentAllowed:'Assignment to a constant' at:pos) ifFalse:[
- ^ #Error
+ ^ #Error
].
^ val
@@ -8167,19 +8168,19 @@
(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.
@@ -8207,10 +8208,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:[
@@ -8221,7 +8222,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: / 26-07-2012 / 11:37:58 / cg"
"Modified: / 25-02-2014 / 22:00:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -8236,11 +8237,11 @@
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"
@@ -8255,7 +8256,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
@@ -8273,25 +8274,25 @@
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:[
@@ -8325,12 +8326,12 @@
self nextToken.
parserFlags flattenVisualWorksNamespaces ifTrue:[
- elements size > 1 ifTrue:[
- "/ temporary kludge when loading VW UIBuilder code...
- ( #('UI' 'Core' 'Graphics') includes:elements first) ifTrue:[
- elements := elements copyFrom:2.
- ]
- ].
+ elements size > 1 ifTrue:[
+ "/ temporary kludge when loading VW UIBuilder code...
+ ( #('UI' 'Core' 'Graphics') includes:elements first) ifTrue:[
+ elements := elements copyFrom:2.
+ ]
+ ].
].
nm := (elements asStringWith:'::') asSymbol.
@@ -8355,10 +8356,10 @@
self nextToken.
(tokenType == #Keyword) ifTrue:[
- ^ self inlineObjectFrom:pos1.
+ ^ self inlineObjectFrom:pos1.
].
parserFlags allowQualifiedNames == true ifFalse:[
- self parseError:'non-Standard VisualWorks extension: #{..}. Please enable in settings.' position:pos1 to:tokenPosition.
+ self parseError:'non-Standard VisualWorks extension: #{..}. Please enable in settings.' position:pos1 to:tokenPosition.
].
^ self qualifiedNameFrom:pos1
!
@@ -8367,28 +8368,28 @@
|expressions elem pos1|
tokenType == $} ifTrue:[
- ^ #()
+ ^ #()
].
pos1 := tokenPosition.
expressions := OrderedCollection new:20.
[
- 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
+ ].
] loop.
"/ not reached
!
@@ -8415,67 +8416,67 @@
(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.
- self clearErrorFlag. "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.
- ].
- ].
-
- "/ create the expression before (corrector may need it)
- expr := UnaryNode receiver:receiver selector:sel fold:foldConstants.
- expr startPosition: receiver startPosition endPosition: pos2.
-
- "/ attention: may have been optimized (Character return -> const!!
- expr isMessage ifTrue:[
- expr selectorPosition:pos.
- sel := self selectorCheck:sel for:receiver position:pos to:pos2.
- expr selector:sel. "/ update possibly changed selector.
- ].
-
- expr isErrorNode ifTrue:[
- self warning:(expr errorString , '.\\If you proceed, that error will happen at runtime.') withCRs position:pos to:pos2.
- self clearErrorFlag. "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.
+ self clearErrorFlag. "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.
+ ].
+ ].
+
+ "/ create the expression before (corrector may need it)
+ expr := UnaryNode receiver:receiver selector:sel fold:foldConstants.
+ expr startPosition: receiver startPosition endPosition: pos2.
+
+ "/ attention: may have been optimized (Character return -> const!!
+ expr isMessage ifTrue:[
+ expr selectorPosition:pos.
+ sel := self selectorCheck:sel for:receiver position:pos to:pos2.
+ expr selector:sel. "/ update possibly changed selector.
+ ].
+
+ expr isErrorNode ifTrue:[
+ self warning:(expr errorString , '.\\If you proceed, that error will happen at runtime.') withCRs position:pos to:pos2.
+ self clearErrorFlag. "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
@@ -8493,10 +8494,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.
@@ -8504,40 +8505,40 @@
self markUnknownIdentifierFrom:pos1 to:pos2.
parseForCode ifTrue:[
- allowUndeclaredVariables ifFalse:[
- |msg|
-
- msg := 'Undeclared variable: %1'.
- "/ for a better error message only
- (self isDoIt
- and:[classToCompileFor notNil
- and:[classToCompileFor theNonMetaclass instanceVariableNames includes:tokenName]])
- ifTrue:[
- msg := 'Instance variable %1 not in scope (in a DoIt evaluation)'.
- self
- parseError:(msg bindWith:tokenName)
- position:pos1 to:pos2.
- ].
- ].
- v := self correctVariable:tokenName atPosition:pos1 to:pos2.
- (v ~~ #Error) ifTrue:[^ v].
+ allowUndeclaredVariables ifFalse:[
+ |msg|
+
+ msg := 'Undeclared variable: %1'.
+ "/ for a better error message only
+ (self isDoIt
+ and:[classToCompileFor notNil
+ and:[classToCompileFor theNonMetaclass instanceVariableNames includes:tokenName]])
+ ifTrue:[
+ msg := 'Instance variable %1 not in scope (in a DoIt evaluation)'.
+ self
+ parseError:(msg bindWith: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.
- ].
- ].
- self parseError:'undeclared variable: ',tokenName.
+ tokenName first isLowercase ifTrue:[
+ parserFlags implicitSelfSends ifTrue:[
+ ^ UnaryNode receiver:(self selfNode) selector:('__' , tokenName) asSymbol.
+ ].
+ ].
+ self parseError:'undeclared variable: ',tokenName.
] 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)
+ 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"
@@ -8561,158 +8562,158 @@
checkSharedPoolAction|
checkSharedPoolAction :=
- [:eachPoolName |
- |sharedPool|
-
- sharedPool := Smalltalk classNamed:eachPoolName.
- sharedPool isNil ifTrue:[
- Transcript showCR:'Parser: 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:'Parser: 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)
- position:tokenPosition to:tokenPosition+varName size-1.
- 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 don''t 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)
+ position:tokenPosition to:tokenPosition+varName size-1.
+ 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 don''t see classInstVars).') withCRs.
+ ]
+ ].
"/ OLD CODE:
"/ self warning:'access to class-inst-var from inst method will soon be no longer supported'.
@@ -8723,102 +8724,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 workspaceVariableHolderAt: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 workspaceVariableHolderAt: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
+ ]
+ ].
"/ ].
"/ do not raise parseError here, but instead report it a the old stupid #Error token.
"/ this is required here so that the caller can check for an assignment,
@@ -8844,10 +8845,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.
]
!
@@ -8867,49 +8868,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:.
- ].
+ 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.
+ receiver:(ConstantNode type:nil value:fn)
+ selector:sel
+ args:args
+ fold:false.
node lineNumber:lineNr.
tree := ReturnNode expression:node.
tree lineNumber:lineNr.
@@ -8949,38 +8950,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.
].
self parseError:tokenType,' unexpected in annotation'.
^ #Error
@@ -8992,8 +8993,8 @@
parseExceptionOrContextPragma
"parse
- <exception: #handle|raise|unwind>,
- <context: #return>
+ <exception: #handle|raise|unwind>,
+ <context: #return>
context flagging pragmas."
|pragmaType|
@@ -9003,24 +9004,24 @@
self nextToken.
(pragmaType = 'context:') ifTrue:[
- ((tokenType == #Symbol) and:[tokenValue == #return]) ifTrue:[
- self rememberContextReturnablePragma
- ] ifFalse:[
- self parseError:'invalid context pragma: ' , (tokenValue ? tokenName).
- ].
+ ((tokenType == #Symbol) and:[tokenValue == #return]) ifTrue:[
+ self rememberContextReturnablePragma
+ ] ifFalse:[
+ self parseError:'invalid context pragma: ' , (tokenValue ? tokenName).
+ ].
].
(pragmaType = 'exception:') ifTrue:[
- ((tokenType == #Symbol)
- and:[
- tokenValue == #handle
- or:[ tokenValue == #raise
- or:[ tokenValue == #unwind ]]]
- ) ifTrue:[
- self rememberContextPragma:pragmaType value:tokenValue
- ] ifFalse:[
- self parseError:'invalid exception pragma: ' , (tokenValue ? tokenName).
- ].
+ ((tokenType == #Symbol)
+ and:[
+ tokenValue == #handle
+ or:[ tokenValue == #raise
+ or:[ tokenValue == #unwind ]]]
+ ) ifTrue:[
+ self rememberContextPragma:pragmaType value:tokenValue
+ ] ifFalse:[
+ self parseError:'invalid exception pragma: ' , (tokenValue ? tokenName).
+ ].
].
self addAnnotationWithKey:pragmaType asSymbol andArguments:{ tokenValue }.
@@ -9040,66 +9041,66 @@
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
- self addAnnotationWithKey:callType asSymbol andArguments:cString.
- self
- parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:cStream
- definitionType:callType
- knownDefinitions:dictionaryOfKnownTypes
- lineNr:lineNr.
- ^ -1
+ "/ squeak/dolphin/stx external function definition
+ self addAnnotationWithKey:callType asSymbol andArguments:cString.
+ self
+ parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
+ ^ -1
].
callType = 'c:' ifTrue:[
- "/ VW external function definition
- self addAnnotationWithKey:callType asSymbol andArguments:cString.
- self
- parseVWTypeOrExternalFunctionDeclarationFrom:cStream
- definitionType:callType
- knownDefinitions:dictionaryOfKnownTypes
- lineNr:lineNr.
- ^ -1
+ "/ VW external function definition
+ self addAnnotationWithKey:callType asSymbol andArguments:cString.
+ self
+ parseVWTypeOrExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
+ ^ -1
].
(callType = 'api:' or:[ callType = 'ole:' ]) ifTrue:[
- "/ ST/V external function definition
- self addAnnotationWithKey:callType asSymbol andArguments:cString.
- self
- parseSTVExternalFunctionDeclarationFrom:cStream
- definitionType:callType
- knownDefinitions:dictionaryOfKnownTypes
- lineNr:lineNr.
- ^ -1
+ "/ ST/V external function definition
+ self addAnnotationWithKey:callType asSymbol andArguments: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>"
@@ -9108,14 +9109,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.
+ name:argArray first
+ module:nil
+ returnType:argArray second
+ argumentTypes:argArray third asArray.
function beCallTypeC.
function owningClass:classToCompileFor.
self generateCallToExternalFunction:function lineNr:lineNr.
@@ -9130,37 +9131,37 @@
value := true.
self nextToken.
((tokenType == #BinaryOperator) and:[ tokenName = '>' ]) ifTrue:[
- self addAnnotationWithKey:key asSymbol andArguments:value.
- self nextToken.
- ^ nil.
+ self addAnnotationWithKey:key asSymbol andArguments:value.
+ self nextToken.
+ ^ nil.
].
value := self parseAnotationLiteral.
(value == #Error) ifTrue:[
- ^ #Error.
+ ^ #Error.
].
((tokenType == #BinaryOperator) and:[ tokenName = '>' ]) ifTrue:[
- self addAnnotationWithKey:key asSymbol andArguments:{ value }.
- self nextToken.
- ^ nil.
+ self addAnnotationWithKey:key asSymbol andArguments:{ 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.
+ key := key , tokenName.
+ self nextToken.
+ value := self parseAnotationLiteral.
+ (value == #Error) ifTrue:[
+ ^ #Error.
+ ].
+ values add:value.
].
self addAnnotationWithKey:key asSymbol andArguments: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.
@@ -9180,29 +9181,29 @@
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:[
- ( #(
- 'arrayIndexSyntaxExtension'
- "possibly add more here"
- ) includes:token
- ) ifTrue:[
- parserFlags perform:('allow',token asUppercaseFirst) asMutator with:flagValue.
- self nextToken.
- self checkForClosingAngle.
- ^ self.
- ].
- ].
- self breakPoint:#cg.
- self parseError:'unknown pragma'.
- ^ self
+ flagValue := (token = '+').
+ self nextToken.
+ (tokenType == #Identifier) ifTrue:[
+ ( #(
+ 'arrayIndexSyntaxExtension'
+ "possibly add more here"
+ ) includes:token
+ ) ifTrue:[
+ parserFlags perform:('allow',token asUppercaseFirst) asMutator with:flagValue.
+ self nextToken.
+ self checkForClosingAngle.
+ ^ self.
+ ].
+ ].
+ self breakPoint:#cg.
+ self parseError:'unknown pragma'.
+ ^ self
].
self parseError:'+/- expected'.
@@ -9211,20 +9212,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' )
@@ -9235,75 +9236,75 @@
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.
- self addAnnotationWithKey:#'primitive:' andArguments:tmp.
- ^ tmp.
+ tmp := self parseTraditionalPrimitive.
+ self addAnnotationWithKey:#'primitive:' andArguments:tmp.
+ ^ tmp.
].
(tokenName = 'sysprim:') ifTrue:[
- parserFlags allowVisualAgePrimitives ifTrue:[
- tmp := self parseTraditionalPrimitive.
- self addAnnotationWithKey:#'sysprim:' andArguments:tmp.
- ^ tmp.
- ].
+ parserFlags allowVisualAgePrimitives ifTrue:[
+ tmp := self parseTraditionalPrimitive.
+ self addAnnotationWithKey:#'sysprim:' andArguments:tmp.
+ ^ tmp.
+ ].
].
(tokenName = 'primitive') ifTrue:[
- self nextToken.
- self checkForClosingAngle.
- self addAnnotationWithKey:#'primitive' andArguments:0.
- ^ 0
- "/ no primitive number
- .
+ self nextToken.
+ self checkForClosingAngle.
+ self addAnnotationWithKey:#'primitive' andArguments: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
@@ -9313,9 +9314,9 @@
or:[ lcTokenName = 'cdecl:' "/ squeak external function definition
or:[ lcTokenName = 'stdcall:' "/ dolphin external function definition
]]]]]) ifTrue:[
- self parseExternalFunctionCallDeclaration.
- ^ nil
- "/ no primitive number
+ self parseExternalFunctionCallDeclaration.
+ ^ nil
+ "/ no primitive number
].
^ self parseOtherPrimitives.
@@ -9329,35 +9330,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"
@@ -9372,36 +9373,36 @@
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:[
- self addAnnotationWithKey:#'resource:' andArguments:{ resource }.
+ self addAnnotationWithKey:#'resource:' andArguments:{ resource }.
] ifFalse:[
- self addAnnotationWithKey:#'resource:values:' andArguments:{resource . resourceValue}.
+ self addAnnotationWithKey:#'resource:values:' andArguments:{resource . resourceValue}.
]
"Modified: / 19-11-2009 / 11:11:26 / Jan Travnicek <travnja3@fel.cvut.cz>"
@@ -9410,21 +9411,21 @@
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>'
+ '<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.
+ 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"
@@ -9434,11 +9435,11 @@
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 >'
+ '<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|
@@ -9446,14 +9447,14 @@
primParser := PrimitiveSpecParser new setClassToCompileFor:classToCompileFor.
primParser notifying:requestor.
function := primParser
- parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:aStream
- definitionType:definitionType
- lineNr:lineNr
- for:self.
+ 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"
@@ -9466,22 +9467,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:[
@@ -9501,44 +9502,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.
@@ -9550,23 +9551,23 @@
parseVWTypeOrExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr
"parses visualWorks type/function declarations of the form:
- '<c: ...>'"
+ '<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.
@@ -9583,7 +9584,7 @@
rememberContextPragma:pragmaType value:pragmaValue
primitiveContextInfo isNil ifTrue:[
- primitiveContextInfo := Set new.
+ primitiveContextInfo := Set new.
].
primitiveContextInfo add:(pragmaType -> pragmaValue).
@@ -9599,11 +9600,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.
].
! !
@@ -9614,12 +9615,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
@@ -9647,12 +9648,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
!
@@ -9662,15 +9663,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
@@ -9685,24 +9686,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:[
@@ -9717,21 +9718,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
@@ -9742,9 +9743,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)
"
^ self class genMakeArrayWith:elementExpressions
@@ -9761,8 +9762,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
@@ -9778,11 +9779,11 @@
aClass := self classToLookForClassVars.
aClass isMeta ifTrue:[
- className := aClass name copyButLast:6.
- baseClass := Smalltalk at:(className asSymbol).
- baseClass notNil ifTrue:[
- aClass := baseClass
- ]
+ className := aClass name copyButLast:6.
+ baseClass := Smalltalk at:(className asSymbol).
+ baseClass notNil ifTrue:[
+ aClass := baseClass
+ ]
].
^ aClass whichClassDefinesClassVar:aString
@@ -9803,41 +9804,41 @@
|expr checkBlock check2Blocks selector block1 block2|
checkBlock :=
- [:block |
- |stats|
-
- stats := block statements.
- stats notEmptyOrNil and:[ self isStatementListAnUnconditionalReturn:stats ]
- ].
+ [: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) ]]]
- ].
+ [: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.
@@ -9851,8 +9852,8 @@
stat := aStatementNode.
[stat notNil] whileTrue:[
- (self isStatementAnUnconditionalReturn:stat) ifTrue:[^ true].
- stat := stat nextStatement
+ (self isStatementAnUnconditionalReturn:stat) ifTrue:[^ true].
+ stat := stat nextStatement
].
^ false.
@@ -9864,12 +9865,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
@@ -9910,18 +9911,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'].
@@ -9936,8 +9937,8 @@
|sel constVal receiver args|
expr isMessage ifFalse:[
- "take care (ignore) for unreachable constants which do not have a selector"
- ^ self
+ "take care (ignore) for unreachable constants which do not have a selector"
+ ^ self
].
sel := expr selector.
@@ -9949,40 +9950,40 @@
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 realNode isBlockNode ifTrue:[
- self markCommentFrom:argIsNotExecuted startPosition to:argIsNotExecuted endPosition.
- ].
- ].
- ].
+ (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 realNode isBlockNode ifTrue:[
+ self markCommentFrom:argIsNotExecuted startPosition to:argIsNotExecuted endPosition.
+ ].
+ ].
+ ].
].
!
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
!
@@ -9997,10 +9998,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>"
!
@@ -10016,10 +10017,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>"
!
@@ -10029,19 +10030,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
@@ -10093,14 +10094,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
@@ -10114,20 +10115,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
@@ -10141,25 +10142,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
@@ -10174,17 +10175,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
@@ -10196,7 +10197,7 @@
"/ 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) ]]
+ and:[ primitiveContextInfo includes:('context:' -> #return) ]]
"Modified: / 26-09-2012 / 14:15:33 / cg"
!
@@ -10274,10 +10275,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
@@ -10296,16 +10297,16 @@
msgs := Set withAll:((messagesPossiblySent ? #()) collect:[:each | each asSymbol]).
usedSymbols notEmptyOrNil ifTrue:[
- "/ add the ones we know have implementations
- "/ (the above have been added unconditionally)
-
- Smalltalk allClassesDo:[:cls |
- cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
- (usedSymbols includes:sel) ifTrue:[
- msgs add:sel.
- ].
- ]
- ].
+ "/ add the ones we know have implementations
+ "/ (the above have been added unconditionally)
+
+ Smalltalk allClassesDo:[:cls |
+ cls instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ (usedSymbols includes:sel) ifTrue:[
+ msgs add:sel.
+ ].
+ ]
+ ].
].
^ msgs
!
@@ -10502,9 +10503,9 @@
classToCompileFor := aClass.
(classToCompileFor ~~ PrevClass) ifTrue:[
- PrevClass notNil ifTrue:[
- Parser update:PrevClass
- ]
+ PrevClass notNil ifTrue:[
+ Parser update:PrevClass
+ ]
]
!
@@ -10520,9 +10521,9 @@
selfValue := anObject.
classToCompileFor := anObject class.
(classToCompileFor ~~ PrevClass) ifTrue:[
- PrevClass notNil ifTrue:[
- Parser update:PrevClass
- ]
+ PrevClass notNil ifTrue:[
+ Parser update:PrevClass
+ ]
]
!
@@ -10564,7 +10565,7 @@
rememberClassVarModified:name
modifiedClassVars isNil ifTrue:[
- modifiedClassVars := Set new
+ modifiedClassVars := Set new
].
modifiedClassVars add:name.
self rememberClassVarUsed:name
@@ -10572,7 +10573,7 @@
rememberClassVarRead:name
readClassVars isNil ifTrue:[
- readClassVars := Set new
+ readClassVars := Set new
].
readClassVars add:name.
self rememberClassVarUsed:name
@@ -10580,7 +10581,7 @@
rememberClassVarUsed:name
usedClassVars isNil ifTrue:[
- usedClassVars := Set new
+ usedClassVars := Set new
].
usedClassVars add:name.
self rememberVariableUsed:name
@@ -10588,7 +10589,7 @@
rememberGlobalModified:name
modifiedGlobals isNil ifTrue:[
- modifiedGlobals := Set new
+ modifiedGlobals := Set new
].
modifiedGlobals add:name.
self rememberGlobalUsed:name.
@@ -10596,7 +10597,7 @@
rememberGlobalRead:name
readGlobals isNil ifTrue:[
- readGlobals := Set new
+ readGlobals := Set new
].
readGlobals add:name.
self rememberGlobalUsed:name
@@ -10604,7 +10605,7 @@
rememberGlobalUsed:name
usedGlobals isNil ifTrue:[
- usedGlobals := Set new
+ usedGlobals := Set new
].
usedGlobals add:name.
self rememberVariableUsed:name
@@ -10612,7 +10613,7 @@
rememberInstVarModified:name
modifiedInstVars isNil ifTrue:[
- modifiedInstVars := Set new
+ modifiedInstVars := Set new
].
modifiedInstVars add:name.
self rememberInstVarUsed:name.
@@ -10620,7 +10621,7 @@
rememberInstVarRead:name
readInstVars isNil ifTrue:[
- readInstVars := Set new
+ readInstVars := Set new
].
readInstVars add:name.
self rememberVariableUsed:name
@@ -10628,7 +10629,7 @@
rememberInstVarUsed:name
usedInstVars isNil ifTrue:[
- usedInstVars := Set new
+ usedInstVars := Set new
].
usedInstVars add:name.
self rememberVariableUsed:name
@@ -10636,7 +10637,7 @@
rememberLocalModified:name
modifiedLocalVars isNil ifTrue:[
- modifiedLocalVars := Set new.
+ modifiedLocalVars := Set new.
].
modifiedLocalVars add:name.
self rememberLocalUsed:name
@@ -10644,7 +10645,7 @@
rememberLocalUsed:name
usedLocalVars isNil ifTrue:[
- usedLocalVars := Set new
+ usedLocalVars := Set new
].
usedLocalVars add:name.
@@ -10652,7 +10653,7 @@
rememberPoolVarModified:name
modifiedPoolVars isNil ifTrue:[
- modifiedPoolVars := Set new
+ modifiedPoolVars := Set new
].
modifiedPoolVars add:name.
self rememberPoolVarUsed:name.
@@ -10660,7 +10661,7 @@
rememberPoolVarRead:name
readPoolVars isNil ifTrue:[
- readPoolVars := Set new
+ readPoolVars := Set new
].
readPoolVars add:name.
self rememberPoolVarUsed:name
@@ -10668,7 +10669,7 @@
rememberPoolVarUsed:name
usedPoolVars isNil ifTrue:[
- usedPoolVars := Set new
+ usedPoolVars := Set new
].
usedPoolVars add:name.
self rememberVariableUsed:name
@@ -10681,23 +10682,23 @@
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 := IdentitySet new.
].
messagesPossiblySent add:sel
!
rememberSelectorUsed:sel
messagesSent isNil ifTrue:[
- messagesSent := IdentitySet new.
+ messagesSent := IdentitySet new.
].
messagesSent add:sel
!
@@ -10712,11 +10713,11 @@
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
+ ].
].
"Modified (format): / 30-07-2013 / 15:51:56 / cg"
@@ -10733,33 +10734,33 @@
self rememberSelectorUsed:sel receiver:receiverNode.
parseForCode ifFalse:[
- "/ for messages we know will do a perform, also remember in
- "/ the possiblySent messages.
-
- (
- #( 'perform:'
- 'pushEvent:'
- 'pushUserEvent:'
- 'enqueueMessage:'
- "/ new: knowing that symbol responds to value:
- 'do:'
- 'select:'
- 'collect:'
- 'reject:'
- 'detect:'
- 'map:'
- 'findFirst:'
- 'contains:'
- 'flatDo:'
- 'flatDetect:'
- )
- contains:[:prefix | sel startsWith:prefix]) ifTrue:[
- (arg1 := args first) isConstant ifTrue:[
- (selPerformed := arg1 value) isSymbol ifTrue:[
- self rememberSelectorPossiblyUsed:selPerformed
- ]
- ]
- ].
+ "/ for messages we know will do a perform, also remember in
+ "/ the possiblySent messages.
+
+ (
+ #( 'perform:'
+ 'pushEvent:'
+ 'pushUserEvent:'
+ 'enqueueMessage:'
+ "/ new: knowing that symbol responds to value:
+ 'do:'
+ 'select:'
+ 'collect:'
+ 'reject:'
+ 'detect:'
+ 'map:'
+ 'findFirst:'
+ 'contains:'
+ 'flatDo:'
+ 'flatDetect:'
+ )
+ contains:[:prefix | sel startsWith:prefix]) ifTrue:[
+ (arg1 := args first) isConstant ifTrue:[
+ (selPerformed := arg1 value) isSymbol ifTrue:[
+ self rememberSelectorPossiblyUsed:selPerformed
+ ]
+ ]
+ ].
].
"Modified (format): / 30-07-2013 / 15:48:37 / cg"
@@ -10767,28 +10768,28 @@
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 := IdentitySet new.
].
usedSymbols add:aSymbol.
!
rememberVariableUsed:name
usedVars isNil ifTrue:[
- usedVars := Set new
+ usedVars := Set new
].
usedVars add:name
! !
@@ -10855,34 +10856,34 @@
"/ 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:[parser isDoIt not]) ifTrue:[
- classToCompileFor isBuiltInClass ifFalse:[
- classToCompileFor isMeta ifTrue:[
- list add: #ClassInstanceVariable.
- ].
- ].
- list addAll: #( #ClassVariable #PrivateClass ).
- ]
+ list addAll: #( NewClass GlobalVariable NameSpace ).
+
+ (classToCompileFor notNil
+ and:[parser isDoIt not]) ifTrue:[
+ classToCompileFor isBuiltInClass ifFalse:[
+ classToCompileFor isMeta ifTrue:[
+ list add: #ClassInstanceVariable.
+ ].
+ ].
+ list addAll: #( #ClassVariable #PrivateClass ).
+ ]
].
parser isDoIt ifTrue:[
- list notEmpty ifTrue:[
- list add: nil.
- ].
- list addAll: #( WorkspaceVariable DoItTemporary ).
+ list notEmpty ifTrue:[
+ list add: nil.
+ ].
+ list addAll: #( WorkspaceVariable DoItTemporary ).
].
^ list
@@ -10896,19 +10897,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
@@ -10918,43 +10919,43 @@
userfriendlyMenuItemNameFor:varType
varType = #BlockVariable ifTrue:[
- ^ 'Block Local'
+ ^ 'Block Local'
].
varType = #MethodVariable ifTrue:[
- ^ 'Method Local Variable'
+ ^ 'Method Local Variable'
].
varType = #InstanceVariable ifTrue:[
- ^ 'Instance Variable'
+ ^ 'Instance Variable'
].
varType = #NewClass ifTrue:[
- ^ 'New Class'
+ ^ 'New Class'
].
varType = #GlobalVariable ifTrue:[
- ^ 'Global'
+ ^ 'Global'
].
varType = #NameSpace ifTrue:[
- ^ 'NameSpace'
+ ^ 'NameSpace'
].
varType = #ClassInstanceVariable ifTrue:[
- ^ 'Class Instance Variable'
+ ^ 'Class Instance Variable'
].
varType = #ClassVariable ifTrue:[
- (self classToCompileFor notNil and:[self classToCompileFor theNonMetaclass isSharedPool]) ifTrue:[
- ^ 'Pool Constant (= Class Variable)'
- ].
- ^ 'Class Variable'
+ (self classToCompileFor notNil and:[self classToCompileFor theNonMetaclass isSharedPool]) ifTrue:[
+ ^ 'Pool Constant (= Class Variable)'
+ ].
+ ^ 'Class Variable'
].
varType = #PrivateClass ifTrue:[
- ^ 'Private Class'
+ ^ 'Private Class'
].
varType = #WorkspaceVariable ifTrue:[
- ^ 'Workspace Variable'
+ ^ 'Workspace Variable'
].
varType = #DoItTemporary ifTrue:[
- ^ 'DoIt Temporary'
+ ^ 'DoIt Temporary'
].
varType isNil ifTrue:[
- ^ '-'
+ ^ '-'
].
^ varType
@@ -10964,7 +10965,7 @@
userfriendlyMenuItemNameListFor:listOfPossibleVariableTypes
^ listOfPossibleVariableTypes
- collect:[:varType | self userfriendlyMenuItemNameFor:varType]
+ collect:[:varType | self userfriendlyMenuItemNameFor:varType]
"Created: / 20-10-2010 / 18:42:13 / cg"
! !
@@ -11063,7 +11064,7 @@
buttonLabel
lastType isNil ifTrue:[
- ^ self class buttonLabel
+ ^ self class buttonLabel
].
^ 'Declare as ',lastType.
! !
@@ -11116,117 +11117,117 @@
suggestedClassToCompileFor := aCompiler classToCompileFor.
receiverNode isSelf ifTrue:[
- classToGenerateCode := aCompiler classToCompileFor
+ classToGenerateCode := aCompiler classToCompileFor
] ifFalse:[
- receiverNode isSuper ifTrue:[
- classToGenerateCode := aCompiler classToCompileFor superclass
- ] ifFalse:[
- receiverNode isVariable ifTrue:[
- receiverNode name isUppercaseFirst ifTrue:[
- receiverNode isGlobal ifTrue:[
- classToGenerateCode := receiverNode evaluate.
- classToGenerateCode isBehavior ifTrue:[
- classToGenerateCode := classToGenerateCode theMetaclass.
- ] ifFalse:[
- classToGenerateCode := nil
- ].
- ] ifFalse:[
- (privateClass := aCompiler classToCompileFor privateClassesAt:receiverNode name) notNil ifTrue:[
- classToGenerateCode := privateClass theMetaclass.
- ].
- ]
- ]
- ] ifFalse:[
- (receiverNode isMessage
- and:[ receiverNode receiver isSelf
- and:[ receiverNode selector == #class]]) ifTrue:[
- suggestedClassToCompileFor := aCompiler classToCompileFor theMetaclass
- ].
- ]
- ]
- ].
-
- true
- "/ (classToGenerateCode isNil
+ receiverNode isSuper ifTrue:[
+ classToGenerateCode := aCompiler classToCompileFor superclass
+ ] ifFalse:[
+ receiverNode isVariable ifTrue:[
+ receiverNode name isUppercaseFirst ifTrue:[
+ receiverNode isGlobal ifTrue:[
+ classToGenerateCode := receiverNode evaluate.
+ classToGenerateCode isBehavior ifTrue:[
+ classToGenerateCode := classToGenerateCode theMetaclass.
+ ] ifFalse:[
+ classToGenerateCode := nil
+ ].
+ ] ifFalse:[
+ (privateClass := aCompiler classToCompileFor privateClassesAt:receiverNode name) notNil ifTrue:[
+ classToGenerateCode := privateClass theMetaclass.
+ ].
+ ]
+ ]
+ ] ifFalse:[
+ (receiverNode isMessage
+ and:[ receiverNode receiver isSelf
+ and:[ receiverNode selector == #class]]) ifTrue:[
+ suggestedClassToCompileFor := aCompiler classToCompileFor theMetaclass
+ ].
+ ]
+ ]
+ ].
+
+ true
+ "/ (classToGenerateCode isNil
"/ or:[ (classToGenerateCode superclass notNil
"/ and:[ classToGenerateCode superclass ~~ Object
- "/ and:[ classToGenerateCode superclass isAbstract not]]) ])
+ "/ and:[ classToGenerateCode superclass isAbstract not]]) ])
ifTrue:[
- className := Dialog
- request:'Generate code in class:'
- initialAnswer:(suggestedClassToCompileFor name)
- okLabel:'OK'
- title:('Generate code in class:')
- onCancel:nil
- list:(suggestedClassToCompileFor withAllSuperclasses collect:[:cls | cls name])
- entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
-
- className size == 0 ifTrue:[ ^ nil ].
- classToGenerateCode := Smalltalk classNamed:className.
- classToGenerateCode isNil ifTrue:[
- self warn:'Oops: No such class: ',className.
- ^ nil
- ].
+ className := Dialog
+ request:'Generate code in class:'
+ initialAnswer:(suggestedClassToCompileFor name)
+ okLabel:'OK'
+ title:('Generate code in class:')
+ onCancel:nil
+ list:(suggestedClassToCompileFor withAllSuperclasses collect:[:cls | cls name])
+ entryCompletionBlock:(DoWhatIMeanSupport classNameEntryCompletionBlock).
+
+ className size == 0 ifTrue:[ ^ nil ].
+ classToGenerateCode := Smalltalk classNamed:className.
+ classToGenerateCode isNil ifTrue:[
+ self warn:'Oops: No such class: ',className.
+ ^ nil
+ ].
].
codeGeneratorClass := classToGenerateCode programmingLanguage codeGeneratorClass.
codeGeneratorClass isNil ifTrue:[
- Dialog information:'sorry - no codegeneration facility for this class'.
- ^ nil.
+ Dialog information:'sorry - no codegeneration facility for this class'.
+ ^ nil.
].
"do not overwrite an already existing method"
(classToGenerateCode includesSelector:selector asSymbol) ifFalse:[
- |code wantInstCreator wantSetter wantGetter varNames lcVarNames|
-
- wantSetter := wantGetter := wantInstCreator := false.
- varNames := classToGenerateCode isMeta
- ifTrue:[ classToGenerateCode theNonMetaclass classVarNames , classToGenerateCode instVarNames ]
- ifFalse:[ classToGenerateCode instVarNames ].
- lcVarNames := varNames collect:[:nm | nm asLowercaseFirst].
-
- (selector isKeywordSelector
- and:[selector numArgs == 1
- and:[lcVarNames includes:(selector copyButLast:1)]]) ifTrue:[
- "/ want a setter ?
- varName := varNames at:(lcVarNames indexOf:(selector copyButLast:1)).
- wantSetter := Dialog confirmWithCancel:('Generate as setter for %1 ?' bindWith:varName allBold) default:true.
- wantSetter isNil ifTrue:[ AbortOperationRequest raise. "^ selector"].
- ] ifFalse:[
- (selector isUnarySelector
- and:[lcVarNames includes:selector]) ifTrue:[
- "/ want a getter ?
- varName := varNames at:(lcVarNames indexOf:selector).
- wantGetter := Dialog confirmWithCancel:('Generate as getter for %1 ?' bindWith:varName allBold) default:true.
- wantGetter isNil ifTrue:[AbortOperationRequest raise "^ selector"].
- ] ifFalse:[
- (selector isKeywordSelector
- and:[ selector numArgs == 1
- and:[ classToGenerateCode isMeta
- and:[ classToGenerateCode theNonMetaclass instVarNames includes:(varName := selector copyButLast:1) ]]]
- ) ifTrue:[
- wantInstCreator := Dialog confirmWithCancel:('Generate as initialized instance creator for %1?' bindWith:varName).
- wantInstCreator isNil ifTrue:[AbortOperationRequest raise "^ selector"].
- ].
- ].
- ].
-
- "/ get the real name (UC if classvar)
- codeGenerator := codeGeneratorClass new.
-
- wantSetter ifTrue:[
- codeGenerator createSetterFor:varName in:classToGenerateCode.
- ] ifFalse:[
- wantGetter ifTrue:[
- codeGenerator createGetterFor:varName in:classToGenerateCode.
- ] ifFalse:[
- wantInstCreator ifTrue:[
- codeGenerator createInstanceCreationMethodWithSetupFor:selector category:('instance creation') in:classToGenerateCode
- ] ifFalse:[
- codeGenerator createShouldImplementMethodFor:selector category:nil in:classToGenerateCode.
- ].
- ]
- ]
+ |code wantInstCreator wantSetter wantGetter varNames lcVarNames|
+
+ wantSetter := wantGetter := wantInstCreator := false.
+ varNames := classToGenerateCode isMeta
+ ifTrue:[ classToGenerateCode theNonMetaclass classVarNames , classToGenerateCode instVarNames ]
+ ifFalse:[ classToGenerateCode instVarNames ].
+ lcVarNames := varNames collect:[:nm | nm asLowercaseFirst].
+
+ (selector isKeywordSelector
+ and:[selector numArgs == 1
+ and:[lcVarNames includes:(selector copyButLast:1)]]) ifTrue:[
+ "/ want a setter ?
+ varName := varNames at:(lcVarNames indexOf:(selector copyButLast:1)).
+ wantSetter := Dialog confirmWithCancel:('Generate as setter for %1 ?' bindWith:varName allBold) default:true.
+ wantSetter isNil ifTrue:[ AbortOperationRequest raise. "^ selector"].
+ ] ifFalse:[
+ (selector isUnarySelector
+ and:[lcVarNames includes:selector]) ifTrue:[
+ "/ want a getter ?
+ varName := varNames at:(lcVarNames indexOf:selector).
+ wantGetter := Dialog confirmWithCancel:('Generate as getter for %1 ?' bindWith:varName allBold) default:true.
+ wantGetter isNil ifTrue:[AbortOperationRequest raise "^ selector"].
+ ] ifFalse:[
+ (selector isKeywordSelector
+ and:[ selector numArgs == 1
+ and:[ classToGenerateCode isMeta
+ and:[ classToGenerateCode theNonMetaclass instVarNames includes:(varName := selector copyButLast:1) ]]]
+ ) ifTrue:[
+ wantInstCreator := Dialog confirmWithCancel:('Generate as initialized instance creator for %1?' bindWith:varName).
+ wantInstCreator isNil ifTrue:[AbortOperationRequest raise "^ selector"].
+ ].
+ ].
+ ].
+
+ "/ get the real name (UC if classvar)
+ codeGenerator := codeGeneratorClass new.
+
+ wantSetter ifTrue:[
+ codeGenerator createSetterFor:varName in:classToGenerateCode.
+ ] ifFalse:[
+ wantGetter ifTrue:[
+ codeGenerator createGetterFor:varName in:classToGenerateCode.
+ ] ifFalse:[
+ wantInstCreator ifTrue:[
+ codeGenerator createInstanceCreationMethodWithSetupFor:selector category:('instance creation') in:classToGenerateCode
+ ] ifFalse:[
+ codeGenerator createShouldImplementMethodFor:selector category:nil in:classToGenerateCode.
+ ].
+ ]
+ ]
].
"/ return nil, so nothing is done in the compiler
@@ -11237,7 +11238,7 @@
buttonLabel
possibleSplits size > 1 ifTrue:[
- ^ 'Correct by Grouping...'
+ ^ 'Correct by Grouping...'
].
^ 'Correct by Grouping (%1)' bindWith:possibleSplits first first
!
@@ -11258,24 +11259,24 @@
fixFrom:position1 to:position2 for:aCompiler
"regroup a keyword message from:
- rcvr foo:a1 bar:a2 baz: a3
+ rcvr foo:a1 bar:a2 baz: a3
into:
- rcvr foo:(a1 bar:a2 baz:a3)
+ rcvr foo:(a1 bar:a2 baz:a3)
"
|split source numParts1 source1 source2 newSource source3|
possibleSplits size > 1 ifTrue:[
- split := Dialog
- choose:'Choose grouping:'
- fromList:(possibleSplits collect:[:split | split first,'(',split second,')'])
- values:possibleSplits
- lines:5.
- split isNil ifTrue:[^ nil].
+ split := Dialog
+ choose:'Choose grouping:'
+ fromList:(possibleSplits collect:[:split | split first,'(',split second,')'])
+ values:possibleSplits
+ lines:5.
+ split isNil ifTrue:[^ nil].
] ifFalse:[
- split := possibleSplits first.
+ split := possibleSplits first.
].
source := aCompiler currentSource.
@@ -11344,35 +11345,35 @@
badName := source copyFrom:pos1 to:pos2.
node := DoWhatIMeanSupport
- findNodeForInterval:(pos1 to:pos2)
- in:source.
+ findNodeForInterval:(pos1 to:pos2)
+ in:source.
node isNil ifTrue:[
- Dialog information:'Sorry - could not extract identifier node from the source'.
- ^ nil.
+ Dialog information:'Sorry - could not extract identifier node from the source'.
+ ^ nil.
].
node isVariable ifFalse:[
- Dialog information:'Huh - node is not a variable'.
- ^ nil.
+ Dialog information:'Huh - node is not a variable'.
+ ^ nil.
].
definingNode := node whoDefines: badName.
definingNode isNil ifTrue: [
- Dialog information: badName , ' is not a temporary variable in the method'.
- ^ nil.
+ Dialog information: badName , ' is not a temporary variable in the method'.
+ ^ nil.
].
newName := Dialog request:(Dialog resources string:'Rename "%1" to:' with:badName) initialAnswer:badName.
newName isNil ifTrue:[
- AbortOperationRequest raise.
+ AbortOperationRequest raise.
].
(newName isEmpty or:[newName = badName]) ifTrue:[
- ^ nil
+ ^ nil
].
refactoring := RenameTemporaryRefactoring
- renameTemporaryFrom:node sourceInterval
- to:newName
- in:nil
- selector:nil.
+ renameTemporaryFrom:node sourceInterval
+ to:newName
+ in:nil
+ selector:nil.
"/ refactoring oldName:badName.
refactoring source:source.
@@ -11441,8 +11442,8 @@
suggestedNames := aCompiler findBestSelectorsFor:selector in:receiverClass.
suggestedNames isEmptyOrNil ifTrue:[
- self information:'no good correction found'.
- ^ nil
+ self information:'no good correction found'.
+ ^ nil
].
newSelector := aCompiler askForCorrection:'Correct Selector to: ' fromList:suggestedNames for:selector.
newSelector isNil ifTrue:[AbortOperationRequest raise "^ aSelectorString"].
@@ -11454,65 +11455,65 @@
this will update what the requestor shows.
"
aCompiler requestor textView undoableDo:[
- (aCompiler requestor selectionAsString startsWith:selector) ifFalse:[
- "/ must find out the selector position!!
- (receiverNode notNil
- and:[receiverNode parent notNil
- and:[receiverNode parent isMessage
- and:[receiverNode parent selector = selector ]]])
- ifTrue:[
- |positions endPos offset|
-
- aCompiler requestor unselect.
-
- offset := 0.
- positions := OrderedCollection withAll:receiverNode parent selectorPartPositions.
- endPos := positions last stop.
- newSelector partsIfSelector doWithIndex:[:part :index |
- |oldPos2 startPos2 endPos2 oldLen newLen|
-
- oldPos2 := positions firstIfEmpty:nil.
- oldPos2 isNil ifTrue:[
- "/ new selector has more parts
- aCompiler requestor insertString:(' ',part,'arg') atCharacterPosition:receiverNode parent endPosition+offset+1.
- ] ifFalse:[
- "/ replace a selector part
- startPos2 := oldPos2 start + offset.
- endPos2 := oldPos2 stop + offset.
- positions removeFirst.
- oldLen := endPos2 - startPos2 + 1.
- newLen := part size.
- aCompiler requestor replaceFromCharacterPosition:startPos2 to:endPos2 with:part.
- offset := offset + (newLen - oldLen).
- ].
- ].
- positions notEmpty ifTrue:[
- |indexOfArgToRemove|
-
- indexOfArgToRemove := receiverNode parent arguments size - positions size + 1.
- [positions notEmpty] whileTrue:[
- |oldPos3 startPos3 endPos3 argExpr|
-
- "/ any remaining (new selector has less parts than old)
- oldPos3 := positions removeFirst.
- "/ remove the selector
- startPos3 := oldPos3 start + offset.
- endPos3 := oldPos3 stop + offset.
- aCompiler requestor deleteFromCharacterPosition:startPos3 to:endPos3.
- offset := offset - (endPos3 - startPos3 + 1).
- "/ remove the arg expression
- argExpr := receiverNode parent arguments at:indexOfArgToRemove.
- startPos3 := argExpr startPosition + offset.
- endPos3 := argExpr endPosition + offset.
- aCompiler requestor deleteFromCharacterPosition:startPos3 to:endPos3.
- offset := offset - (endPos3 - startPos3 + 1).
- ].
- ].
- aCompiler requestor cursorToCharacterPosition:endPos.
- ].
- ] ifTrue:[
- aCompiler requestor replaceSelectionBy:newSelector keepCursor:false.
- ].
+ (aCompiler requestor selectionAsString startsWith:selector) ifFalse:[
+ "/ must find out the selector position!!
+ (receiverNode notNil
+ and:[receiverNode parent notNil
+ and:[receiverNode parent isMessage
+ and:[receiverNode parent selector = selector ]]])
+ ifTrue:[
+ |positions endPos offset|
+
+ aCompiler requestor unselect.
+
+ offset := 0.
+ positions := OrderedCollection withAll:receiverNode parent selectorPartPositions.
+ endPos := positions last stop.
+ newSelector partsIfSelector doWithIndex:[:part :index |
+ |oldPos2 startPos2 endPos2 oldLen newLen|
+
+ oldPos2 := positions firstIfEmpty:nil.
+ oldPos2 isNil ifTrue:[
+ "/ new selector has more parts
+ aCompiler requestor insertString:(' ',part,'arg') atCharacterPosition:receiverNode parent endPosition+offset+1.
+ ] ifFalse:[
+ "/ replace a selector part
+ startPos2 := oldPos2 start + offset.
+ endPos2 := oldPos2 stop + offset.
+ positions removeFirst.
+ oldLen := endPos2 - startPos2 + 1.
+ newLen := part size.
+ aCompiler requestor replaceFromCharacterPosition:startPos2 to:endPos2 with:part.
+ offset := offset + (newLen - oldLen).
+ ].
+ ].
+ positions notEmpty ifTrue:[
+ |indexOfArgToRemove|
+
+ indexOfArgToRemove := receiverNode parent arguments size - positions size + 1.
+ [positions notEmpty] whileTrue:[
+ |oldPos3 startPos3 endPos3 argExpr|
+
+ "/ any remaining (new selector has less parts than old)
+ oldPos3 := positions removeFirst.
+ "/ remove the selector
+ startPos3 := oldPos3 start + offset.
+ endPos3 := oldPos3 stop + offset.
+ aCompiler requestor deleteFromCharacterPosition:startPos3 to:endPos3.
+ offset := offset - (endPos3 - startPos3 + 1).
+ "/ remove the arg expression
+ argExpr := receiverNode parent arguments at:indexOfArgToRemove.
+ startPos3 := argExpr startPosition + offset.
+ endPos3 := argExpr endPosition + offset.
+ aCompiler requestor deleteFromCharacterPosition:startPos3 to:endPos3.
+ offset := offset - (endPos3 - startPos3 + 1).
+ ].
+ ].
+ aCompiler requestor cursorToCharacterPosition:endPos.
+ ].
+ ] ifTrue:[
+ aCompiler requestor replaceSelectionBy:newSelector keepCursor:false.
+ ].
] info:'correct selector'.
"
@@ -11554,7 +11555,7 @@
key := something.
!
-key:keyArg arguments:argumentsArg
+key:keyArg arguments:argumentsArg
key := keyArg.
arguments := argumentsArg.
!
@@ -11567,7 +11568,7 @@
startPostion := something.
!
-startPostion:startPostionArg endPosition:endPositionArg
+startPostion:startPostionArg endPosition:endPositionArg
startPostion := startPostionArg.
endPosition := endPositionArg.
! !
@@ -11582,12 +11583,12 @@
Users should rewrite their code."
index == 1 ifTrue:[
- Transcript showCR:'Parser: old style use of parsed annotations. Please rewrite to use #key'.
- ^ key.
+ Transcript showCR:'Parser: old style use of parsed annotations. Please rewrite to use #key'.
+ ^ key.
].
index == 2 ifTrue:[
- Transcript showCR:'Parser: old style use of parsed annotations. Please rewrite to use #arguments'.
- ^ arguments.
+ Transcript showCR:'Parser: old style use of parsed annotations. Please rewrite to use #arguments'.
+ ^ arguments.
].
self error:'invalid index.'.
! !
@@ -11629,9 +11630,9 @@
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>'
+ '<api: functionName argType1 .. argTypeN returnType>'
+ '<ccall: functionName argType1 .. argTypeN returnType>'
+ '<ole: [async] vFunctionIndex argType1 .. argTypeN returnType>'
"
|returnType functionName argTypes function virtualFunctionIndex isAsync|
@@ -11642,62 +11643,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.
+ (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 == #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 copyButLast:1.
function := ExternalLibraryFunction
- name:(functionName ? virtualFunctionIndex)
- module:nil
- returnType:returnType
- argumentTypes:argTypes asArray.
+ name:(functionName ? virtualFunctionIndex)
+ module:nil
+ returnType:returnType
+ argumentTypes:argTypes asArray.
(definitionType = 'api:') ifTrue:[
- function beCallTypeAPI
+ function beCallTypeAPI
] ifFalse:[
- (definitionType = 'ole:') ifTrue:[
- function beCallTypeOLE
- ] ifFalse:[
- function beCallTypeC
- ].
+ (definitionType = 'ole:') ifTrue:[
+ function beCallTypeOLE
+ ] ifFalse:[
+ function beCallTypeC
+ ].
].
isAsync ifTrue:[
- function beAsync
+ function beAsync
].
^ function
@@ -11707,11 +11708,11 @@
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 >'
+ '<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
@@ -11729,128 +11730,128 @@
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 := 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.
+ (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.
+ ].
+ thisType := thisType ? #pointer.
+ argTypes := (Array with:thisType) , argTypes.
].
function := ExternalLibraryFunction
- name:(functionName ? virtualFunctionIndex)
- module:moduleName
- returnType:returnType
- argumentTypes:argTypes asArray.
+ name:(functionName ? virtualFunctionIndex)
+ module:moduleName
+ returnType:returnType
+ argumentTypes:argTypes asArray.
(definitionType = 'apicall:') ifTrue:[
- function beCallTypeAPI
+ function beCallTypeAPI
] ifFalse:[
- (definitionType = 'olecall:') ifTrue:[
- function beCallTypeOLE
- ] ifFalse:[
- function beCallTypeC
- ].
+ (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
@@ -11865,79 +11866,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
@@ -11947,8 +11948,8 @@
parseVWTypeOrExternalFunctionDeclarationFrom:aStream definitionType:definitionType knownDefinitions:dictionaryOfTypesOrNil lineNr:lineNr for:aParserOrNil
"parses visualWorks type/function declarations of the form:
- '<c: ...>'
- '<c: #define NAME value>'"
+ '<c: ...>'
+ '<c: #define NAME value>'"
|cParser moduleName type name val
nameAndFunctionOrType functionOrType function libName|
@@ -11958,37 +11959,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.
@@ -11998,41 +11999,41 @@
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 breakPoint:#cg.
- libName := classToCompileFor theNonMetaclass perform:#libraryName ifNotUnderstood:'unknown'.
- moduleName := libName asSymbol.
+ self breakPoint:#cg.
+ libName := classToCompileFor theNonMetaclass perform:#libraryName ifNotUnderstood:'unknown'.
+ moduleName := libName asSymbol.
].
function := ExternalLibraryFunction
- name:function name
- module:moduleName
- returnType:function returnType
- argumentTypes:function argumentTypes asArray.
+ name:function name
+ module:moduleName
+ returnType:function returnType
+ argumentTypes:function argumentTypes asArray.
function beCallTypeC.
^ function
@@ -12049,39 +12050,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.
@@ -12095,35 +12096,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 ].
@@ -12175,11 +12176,11 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.858 2015-02-02 16:16:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.859 2015-02-02 17:45:40 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.858 2015-02-02 16:16:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.859 2015-02-02 17:45:40 cg Exp $'
!
version_SVN