--- a/Parser.st Sat Aug 31 13:30:42 2013 +0200
+++ b/Parser.st Sun Sep 01 00:35:44 2013 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -12,126 +12,126 @@
"{ Package: 'stx:libcomp' }"
Scanner subclass:#Parser
- instanceVariableNames:'classToCompileFor selfValue contextToEvaluateIn selector
- methodArgs methodArgNames methodVars methodVarNames tree
- currentBlock parseForCode readInstVars readClassVars readGlobals
- usedInstVars usedClassVars usedVars modifiedInstVars
- modifiedClassVars modifiedGlobals usesSuper usedGlobals
- usedSymbols messagesSent messagesPossiblySent messagesSentToSelf
- messagesSentToSuper localVarDefPosition evalExitBlock selfNode
- superNode nilNode hasPrimitiveCode hasNonOptionalPrimitiveCode
- primitiveNr primitiveResource logged warnedUndefVars
- warnedUnknownNamespaces correctedSource foldConstants
- lineNumberInfo currentNamespace currentUsedNamespaces methodNode
- alreadyWarnedClassInstVarRefs localBlockVarDefPosition
- endOfSelectorPosition beginOfBodyPosition startOfBlockPosition
- primitiveContextInfo usedLocalVars modifiedLocalVars
- alreadyWarnedUninitializedVars
- alreadyWarnedUnimplementedSelectors returnedValues currentPackage
- doItTemporaries moreSharedPools inFunctionCallArgument
- didWarnAboutSTXNameSpaceUse didWarnAboutSTXHereExtensionUsed
- parenthesisLevel didWarnAboutBadSupersend
- didWarnAboutSqueakExtensions allowUndeclaredVariables
- interactiveMode variableCorrectActionForAll annotations
- variableTypeOfLastCorrectAction usedPoolVars readPoolVars
- modifiedPoolVars'
- classVariableNames:'PrevClass PrevInstVarNames PrevClassVarNames
- PrevClassInstVarNames LazyCompilation FoldConstants
- LineNumberInfo SuppressDoItCompilation ParseErrorSignal
- RestartCompilationSignal'
- poolDictionaries:''
- category:'System-Compiler'
+ instanceVariableNames:'classToCompileFor selfValue contextToEvaluateIn selector
+ methodArgs methodArgNames methodVars methodVarNames tree
+ currentBlock parseForCode readInstVars readClassVars readGlobals
+ usedInstVars usedClassVars usedVars modifiedInstVars
+ modifiedClassVars modifiedGlobals usesSuper usedGlobals
+ usedSymbols messagesSent messagesPossiblySent messagesSentToSelf
+ messagesSentToSuper localVarDefPosition evalExitBlock selfNode
+ superNode nilNode hasPrimitiveCode hasNonOptionalPrimitiveCode
+ primitiveNr primitiveResource logged warnedUndefVars
+ warnedUnknownNamespaces correctedSource foldConstants
+ lineNumberInfo currentNamespace currentUsedNamespaces methodNode
+ alreadyWarnedClassInstVarRefs localBlockVarDefPosition
+ endOfSelectorPosition beginOfBodyPosition startOfBlockPosition
+ primitiveContextInfo usedLocalVars modifiedLocalVars
+ alreadyWarnedUninitializedVars
+ alreadyWarnedUnimplementedSelectors returnedValues currentPackage
+ doItTemporaries moreSharedPools inFunctionCallArgument
+ didWarnAboutSTXNameSpaceUse didWarnAboutSTXHereExtensionUsed
+ parenthesisLevel didWarnAboutBadSupersend
+ didWarnAboutSqueakExtensions allowUndeclaredVariables
+ interactiveMode variableCorrectActionForAll annotations
+ variableTypeOfLastCorrectAction usedPoolVars readPoolVars
+ modifiedPoolVars'
+ classVariableNames:'PrevClass PrevInstVarNames PrevClassVarNames
+ PrevClassInstVarNames LazyCompilation FoldConstants
+ LineNumberInfo SuppressDoItCompilation ParseErrorSignal
+ RestartCompilationSignal'
+ poolDictionaries:''
+ category:'System-Compiler'
!
Query subclass:#AskForVariableTypeOfUndeclaredQuery
- instanceVariableNames:'parser nameOfUnknownVariable'
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:'parser nameOfUnknownVariable'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Object subclass:#Correction
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Parser::Correction subclass:#CorrectByDeclaringIdentifierAs
- instanceVariableNames:'lastType'
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:'lastType'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Parser::Correction subclass:#CorrectByDeletingLocalIdentifier
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Parser::Correction subclass:#CorrectByGeneratingMissingMethod
- instanceVariableNames:'receiverNode selector'
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:'receiverNode selector'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Parser::Correction subclass:#CorrectByGroupingMessage
- instanceVariableNames:'possibleSplits receiverNode selectorPositions'
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:'possibleSplits receiverNode selectorPositions'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Parser::Correction subclass:#CorrectByInsertingPeriod
- instanceVariableNames:'positionOfPeriod'
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:'positionOfPeriod'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Parser::Correction subclass:#CorrectByInteractiveCorrection
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Parser::Correction subclass:#CorrectByInteractiveRename
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Parser::Correction subclass:#CorrectByMakingValidHexConstant
- instanceVariableNames:'receiverNode selector'
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:'receiverNode selector'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Parser::Correction subclass:#CorrectByChangingSelector
- instanceVariableNames:'receiverNode receiverClass selector'
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:'receiverNode receiverClass selector'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Query subclass:#PossibleCorrectionsQuery
- instanceVariableNames:'parser message'
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:'parser message'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
Parser subclass:#PrimitiveSpecParser
- instanceVariableNames:'masterParser'
- classVariableNames:''
- poolDictionaries:''
- privateIn:Parser
+ instanceVariableNames:'masterParser'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:Parser
!
!Parser class methodsFor:'documentation'!
@@ -139,7 +139,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
@@ -158,11 +158,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.
@@ -215,143 +215,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|
@@ -360,8 +360,8 @@
c[6] := 6.
c[7] := 7.
c[7] := c[4] - c[6].
- [exEnd]
- [exBegin]
+ [exEnd]
+ [exBegin]
<pragma: +arrayIndexSyntaxExtension>
|d|
@@ -371,21 +371,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]
"
! !
@@ -483,13 +483,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"
@@ -499,14 +499,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
+ ]
]
! !
@@ -519,8 +519,8 @@
LineNumberInfo := false.
ParseErrorSignal isNil ifTrue:[
- ParseErrorSignal := ParseError.
- ParseErrorSignal notifierString:'Parse error:'.
+ ParseErrorSignal := ParseError.
+ ParseErrorSignal notifierString:'Parse error:'.
"/ ParseErrorSignal := Error newSignalMayProceed:true.
"/ ParseErrorSignal notifierString:'parse error'.
@@ -647,10 +647,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
@@ -778,7 +778,8 @@
!
findBest:nMax selectorsFor:aString in:aClassOrNil forCompletion:forCompletion
- "collect known selectors with their spelling distances to aString;
+ "soon OBSOLETE and replaced by corresponding into: API.
+ collect known selectors with their spelling distances to aString;
return the nMax best suggestions. If the argument, aClassOrNil is not nil,
the message is assumed to be sent to instances of that class (i.e. offer
corrections from that hierarchy only).
@@ -890,13 +891,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'
@@ -916,13 +917,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
@@ -931,13 +932,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']
"
@@ -950,13 +951,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"
!
@@ -968,13 +969,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
@@ -991,16 +992,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
@@ -1008,13 +1009,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
@@ -1026,13 +1027,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
@@ -1047,13 +1048,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
@@ -1061,13 +1062,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
@@ -1076,13 +1077,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)
@@ -1097,13 +1098,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
@@ -1118,13 +1119,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
@@ -1144,13 +1145,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
@@ -1159,13 +1160,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']
"
@@ -1185,14 +1186,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'!
@@ -1217,14 +1218,14 @@
comments := parser comments.
comments size ~~ 0 ifTrue:[
- comment := comments first asString.
- (comment withoutSpaces endsWith:'}') ifTrue:[
- "if first comment is a pragma, take next comment"
- comment := comments at:2 ifAbsent:nil.
- comment notNil ifTrue:[
- comment := comment string.
- ].
- ].
+ comment := comments first asString.
+ (comment withoutSpaces endsWith:'}') ifTrue:[
+ "if first comment is a pragma, take next comment"
+ comment := comments at:2 ifAbsent:nil.
+ comment notNil ifTrue:[
+ comment := comment string.
+ ].
+ ].
].
^ comment.
@@ -1251,34 +1252,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"
@@ -1291,70 +1292,70 @@
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
+ ].
].
"/ 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.
@@ -1383,15 +1384,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"
@@ -1428,13 +1429,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"
@@ -1447,13 +1448,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"
@@ -1466,13 +1467,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"
!
@@ -1499,12 +1500,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.
@@ -1525,10 +1526,10 @@
Error and warning messages are sent to the Transcript."
^ self
- parseMethod:aString
- in:aClass
- ignoreErrors:false
- ignoreWarnings:false
+ parseMethod:aString
+ in:aClass
+ ignoreErrors:false
+ ignoreWarnings:false
"Modified: 24.4.1996 / 13:18:34 / cg"
!
@@ -1563,10 +1564,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"
!
@@ -1586,9 +1587,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.
@@ -1610,10 +1611,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"
!
@@ -1641,9 +1642,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
@@ -1672,10 +1673,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"
!
@@ -1700,10 +1701,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"
!
@@ -1731,9 +1732,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
@@ -1773,9 +1774,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"
!
@@ -1791,33 +1792,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
+ ].
].
"
@@ -1826,11 +1827,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
"
@@ -1857,13 +1858,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"
!
@@ -1877,13 +1878,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"
!
@@ -1898,13 +1899,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"
!
@@ -1919,13 +1920,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
@@ -1965,7 +1966,7 @@
selectorSymbol isNil ifTrue:[^ false].
Smalltalk allClassesAndMetaclassesDo:[:cls |
- (cls includesSelector:selectorSymbol) ifTrue:[^ true].
+ (cls includesSelector:selectorSymbol) ifTrue:[^ true].
].
^ false
@@ -1977,7 +1978,7 @@
newObject := anObject copy.
what notNil ifTrue:[
- newObject changeClassTo:what.
+ newObject changeClassTo:what.
].
newObject beImmutable.
^ newObject
@@ -2006,15 +2007,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
@@ -2039,18 +2040,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
@@ -2074,13 +2075,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.
@@ -2088,8 +2089,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
@@ -2105,11 +2106,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"
@@ -2125,7 +2126,7 @@
"
Parser new
- parseSelector:'
+ parseSelector:'
parseSelector:aStringOrStream
self initializeFor:aStringOrStream.
self parseMethodSpec.
@@ -2268,8 +2269,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"
!
@@ -2650,12 +2651,12 @@
returnsSelf := returnedValues contains:[:node | node isSelf].
returnsBoolean ifTrue:[
- (returnsNonBooleanLiteral or:[returnsSelf]) ifTrue:[
- self
- warning:'Possible Error Warning:\\Method returns both boolean and non-boolean values.' withCRs
- doNotShowAgainAction:[ ParserFlags warnInconsistentReturnValues:false ]
- position:1 to:tokenPosition
- ]
+ (returnsNonBooleanLiteral or:[returnsSelf]) ifTrue:[
+ self
+ warning:'Possible Error Warning:\\Method returns both boolean and non-boolean values.' withCRs
+ doNotShowAgainAction:[ ParserFlags warnInconsistentReturnValues:false ]
+ position:1 to:tokenPosition
+ ]
].
"Created: / 17.11.2001 / 10:31:03 / cg"
@@ -2673,81 +2674,81 @@
self shouldPerformCodingStyleChecks ifFalse:[^ nil ].
cls isNil ifTrue:[
- SystemBrowser isNil ifTrue:[
- ^ nil
- ].
- "beware, this is sort of slow, especially for the SyntaxHighlighter"
- implementors := SystemBrowser
- findImplementorsOf:selector
- in:(Smalltalk allClasses)
- ignoreCase:false.
- implementors size == 0 ifTrue:[
- ^ 'is nowhere implemented'
- ].
-
- (implementors conform:[:eachMethod| eachMethod isObsolete]) ifTrue:[
- ^ 'each implementation of this selector in the system is deprecated'
- ].
- ^ nil
+ SystemBrowser isNil ifTrue:[
+ ^ nil
+ ].
+ "beware, this is sort of slow, especially for the SyntaxHighlighter"
+ implementors := SystemBrowser
+ findImplementorsOf:selector
+ in:(Smalltalk allClasses)
+ ignoreCase:false.
+ implementors size == 0 ifTrue:[
+ ^ 'is nowhere implemented'
+ ].
+
+ (implementors conform:[:eachMethod| eachMethod isObsolete]) ifTrue:[
+ ^ '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.
!
@@ -2759,10 +2760,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"
@@ -2879,7 +2880,7 @@
|holder|
doItTemporaries isNil ifTrue:[
- doItTemporaries := IdentityDictionary new.
+ doItTemporaries := IdentityDictionary new.
].
doItTemporaries at:varName asSymbol put:(holder := ValueHolder new).
^ holder
@@ -2887,7 +2888,7 @@
alreadyWarnedUnimplementedSelectors
alreadyWarnedUnimplementedSelectors isNil ifTrue:[
- alreadyWarnedUnimplementedSelectors := Set new
+ alreadyWarnedUnimplementedSelectors := Set new
].
^ alreadyWarnedUnimplementedSelectors
!
@@ -2900,7 +2901,7 @@
"in systems without widgets ..."
ListSelectionBox isNil ifTrue:[
- ^ self confirm:aString
+ ^ self confirm:aString
].
box := ListSelectionBox title:aString.
box initialText:(aList at:1).
@@ -3015,36 +3016,6 @@
"Modified: / 13-09-2006 / 11:40:52 / cg"
!
-correctByDeleting
- "correct (by deleting token) if user wants to;
- return #Error if there was no correction;
- nil if there was one."
-
- |selectionSize|
-
- (self confirm:'confirm deleting') ifFalse:[^ #Error].
-
- "
- tell requestor (i.e. CodeView) about the change
- this will update what the requestor shows.
- "
- selectionSize := requestor selection size.
- requestor deleteSelection.
-
- "
- get the updated source-string
- which is needed, when we eventually install the new method
- "
- correctedSource := requestor currentSourceCode.
- "/ update the current source position
- source := (ReadStream on:correctedSource)
- position:(source position + 1 - selectionSize).
-
- ^ nil
-
- "Modified: / 22.1.1998 / 16:39:11 / stefan"
-!
-
correctSelector:aSelectorString message:msg positions:posVector in:aClassOrNil for:receiverNode
"notify error and correct if user wants to;
return #Error if there was no correction
@@ -3582,7 +3553,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.
@@ -4080,12 +4051,12 @@
].
subErr notNil ifTrue:[
nOther > 0 ifTrue:[
- err := subErr, (' and %1 other subclass(es), this class or superclass chain' bindWith:nOther)
+ err := subErr, (' in %1 other subclass(es), this class or superclass chain' bindWith:nOther)
] ifFalse:[
- err := subErr, ', this class or superclass chain'
+ err := subErr, ', in this class or superclass chain'
].
] ifFalse:[
- err := err, ', this class or superclass chain'.
+ err := err, ', in this class or superclass chain'.
].
canDefine := true.
].
@@ -4234,70 +4205,70 @@
|nodeVal nodeType classHint rClass|
aNode isConstant ifTrue:[
- "if the receiver is a constant, we know its class..."
- nodeVal := aNode evaluate.
- ^ nodeVal class.
+ "if the receiver is a constant, we know its class..."
+ nodeVal := aNode evaluate.
+ ^ nodeVal class.
].
aNode isBlock ifTrue:[
- "/ this should help with typos, sending #ifTrue to blocks ...
- ^ Block
+ "/ this should help with typos, sending #ifTrue to blocks ...
+ ^ Block
].
aNode isVariable ifTrue:[
- nodeType := aNode type.
- (nodeType == #GlobalVariable or:[nodeType == #PrivateClass]) ifTrue:[
- "if the receiver is a global, we check it too ..."
-
- nodeVal := aNode evaluate.
- "/ dont check autoloaded classes
- "/ - it may work after loading
- (nodeVal isNil
- or:[nodeVal isBehavior and:[nodeVal isLoaded not]]) ifTrue:[
- ^ nil
- ].
-
- ^ nodeVal class.
- ].
-
- (aNode isLocal) ifTrue:[
- classHint := aNode token classHint.
- classHint notNil ifTrue:[
- ^ Smalltalk classNamed:classHint
- ].
- ].
+ nodeType := aNode type.
+ (nodeType == #GlobalVariable or:[nodeType == #PrivateClass]) ifTrue:[
+ "if the receiver is a global, we check it too ..."
+
+ nodeVal := aNode evaluate.
+ "/ dont check autoloaded classes
+ "/ - it may work after loading
+ (nodeVal isNil
+ or:[nodeVal isBehavior and:[nodeVal isLoaded not]]) ifTrue:[
+ ^ nil
+ ].
+
+ ^ nodeVal class.
+ ].
+
+ (aNode isLocal) ifTrue:[
+ classHint := aNode token classHint.
+ classHint notNil ifTrue:[
+ ^ Smalltalk classNamed:classHint
+ ].
+ ].
].
aNode isSuper ifTrue:[
- "if its a super- or here-send, we can do more checking"
- aNode isHere ifFalse:[
- ^ classToCompileFor superclass ? UndefinedObject.
- ].
- ^ classToCompileFor.
+ "if its a super- or here-send, we can do more checking"
+ aNode isHere ifFalse:[
+ ^ classToCompileFor superclass ? UndefinedObject.
+ ].
+ ^ classToCompileFor.
].
aNode isSelf ifTrue:[
- ^ classToCompileFor.
+ ^ classToCompileFor.
].
(aNode isUnaryMessage) ifTrue:[
- (aNode selector == #class) ifTrue:[
+ (aNode selector == #class) ifTrue:[
"/ aNode receiver isSelf ifTrue:[
"/ "its a message to self class - can check this too ..."
"/ ^ classToCompileFor class.
"/ ].
- rClass := self typeOfNode:aNode receiver.
- rClass notNil ifTrue:[
- ^ rClass class.
- ].
- ].
- ( #(#'isNil' #'notNil') includes:aNode selector) ifTrue:[
- ^ Boolean.
- ]
+ rClass := self typeOfNode:aNode receiver.
+ rClass notNil ifTrue:[
+ ^ rClass class.
+ ].
+ ].
+ ( #(#'isNil' #'notNil') includes:aNode selector) ifTrue:[
+ ^ Boolean.
+ ]
].
aNode isBinaryMessage ifTrue:[
- ( #(#'<' #'>' #'>=' #'<=' #'=' #'==' #'~=' #'~~') includes:aNode selector) ifTrue:[
- ^ Boolean.
- ]
+ ( #(#'<' #'>' #'>=' #'<=' #'=' #'==' #'~=' #'~~') includes:aNode selector) ifTrue:[
+ ^ Boolean.
+ ]
].
^ nil
@@ -4309,11 +4280,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
].
!
@@ -4327,38 +4298,38 @@
|idx implementors|
classToCompileFor notNil ifTrue:[
- "/ is it an instance-variable marked inaccessable ?
-
- idx := (self classesInstVarNames) indexOf:(aName , '*') startingAt:1.
- idx ~~ 0 ifTrue:[
- ^ '''%1'' is a hidden instvar (not accessable from ST-code)' bindWith:aName allBold.
- ].
-
- "/ is it an instance variable, while evaluateing for the class ?
- classToCompileFor isMeta ifTrue:[
- (classToCompileFor soleInstance allInstVarNames includes:aName) ifTrue:[
- ^ '''%1'' is an instvar\(hint: you are evaluating/compiling in the classes context)' bindWith:aName allBold.
- ]
- ]
+ "/ is it an instance-variable marked inaccessable ?
+
+ idx := (self classesInstVarNames) indexOf:(aName , '*') startingAt:1.
+ idx ~~ 0 ifTrue:[
+ ^ '''%1'' is a hidden instvar (not accessable from ST-code)' bindWith:aName allBold.
+ ].
+
+ "/ is it an instance variable, while evaluateing for the class ?
+ classToCompileFor isMeta ifTrue:[
+ (classToCompileFor soleInstance allInstVarNames includes:aName) ifTrue:[
+ ^ '''%1'' is an instvar\(hint: you are evaluating/compiling in the classes context)' bindWith:aName allBold.
+ ]
+ ]
].
self isDoIt ifTrue:[
- SystemBrowser notNil ifTrue:[
- implementors := SystemBrowser
- findImplementorsOf:aName
- in:(Smalltalk allClasses)
- ignoreCase:false.
- implementors size > 0 ifTrue:[
- implementors size == 1 ifTrue:[
- ^ '''%1'' is undefined but known as a message selector in %2.\(hint: did you forget to specify or select the receiver ?)'
- bindWith:aName allBold
- with:implementors first mclass name allBold
- ].
- ^ '''%1'' is undefined but known as a message selector.\(hint: did you forget to specify or select the receiver ?)' bindWith:aName allBold.
- ].
- ].
+ SystemBrowser notNil ifTrue:[
+ implementors := SystemBrowser
+ findImplementorsOf:aName
+ in:(Smalltalk allClasses)
+ ignoreCase:false.
+ implementors size > 0 ifTrue:[
+ implementors size == 1 ifTrue:[
+ ^ '''%1'' is undefined but known as a message selector in %2.\(hint: did you forget to specify or select the receiver ?)'
+ bindWith:aName allBold
+ with:implementors first mclass name allBold
+ ].
+ ^ '''%1'' is undefined but known as a message selector.\(hint: did you forget to specify or select the receiver ?)' bindWith:aName allBold.
+ ].
+ ].
].
peekChar == $: ifTrue:[
- ^ 'NameSpace "%1" is undefined' bindWith:aName allBold.
+ ^ 'NameSpace "%1" is undefined' bindWith:aName allBold.
].
^ '"%1" is undefined' bindWith:aName allBold.
!
@@ -4386,11 +4357,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
].
!
@@ -4401,31 +4372,31 @@
|msg|
ignoreErrors ifFalse:[
- Smalltalk silentLoading ifFalse:[
- msg := ''.
- pos notNil ifTrue:[
- msg := msg , (pos printString).
- msg := msg , ' '.
- ].
- msg := msg , aMessage.
- selector notNil ifTrue:[
- msg := msg , ' in '.
- classToCompileFor notNil ifTrue:[
- msg := msg , classToCompileFor name , '>>'
- ].
- msg := msg , selector.
- ] ifFalse:[
- classToCompileFor notNil ifTrue:[
- msg := msg , ' (' , classToCompileFor name , ')'
- ]
- ].
-
- UserInformation isHandled ifTrue:[
- UserInformation raiseErrorString:msg
- ] ifFalse:[
- Transcript showCR:msg.
- ]
- ]
+ Smalltalk silentLoading ifFalse:[
+ msg := ''.
+ pos notNil ifTrue:[
+ msg := msg , (pos printString).
+ msg := msg , ' '.
+ ].
+ msg := msg , aMessage.
+ selector notNil ifTrue:[
+ msg := msg , ' in '.
+ classToCompileFor notNil ifTrue:[
+ msg := msg , classToCompileFor name , '>>'
+ ].
+ msg := msg , selector.
+ ] ifFalse:[
+ classToCompileFor notNil ifTrue:[
+ msg := msg , ' (' , classToCompileFor name , ')'
+ ]
+ ].
+
+ UserInformation isHandled ifTrue:[
+ UserInformation raiseErrorString:msg
+ ] ifFalse:[
+ Transcript showCR:msg.
+ ]
+ ]
]
"Modified: 18.5.1996 / 15:44:15 / cg"
@@ -4435,10 +4406,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'.
@@ -4536,16 +4507,16 @@
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
+ ].
+ ].
].
!
@@ -4661,14 +4632,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
@@ -4685,14 +4656,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"
!
@@ -4711,14 +4682,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
@@ -4735,14 +4706,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
@@ -4759,14 +4730,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
@@ -4783,13 +4754,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
@@ -4806,14 +4777,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
@@ -5033,37 +5004,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
@@ -5080,14 +5051,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
@@ -5104,26 +5075,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"
! !
@@ -5140,6 +5111,38 @@
selector := aParser selector.
! !
+!Parser methodsFor:'obsolete'!
+
+correctByDeleting
+ "correct (by deleting token) if user wants to;
+ return #Error if there was no correction;
+ nil if there was one."
+
+ |selectionSize|
+
+ (self confirm:'confirm deleting') ifFalse:[^ #Error].
+
+ "
+ tell requestor (i.e. CodeView) about the change
+ this will update what the requestor shows.
+ "
+ selectionSize := requestor selection size.
+ requestor deleteSelection.
+
+ "
+ get the updated source-string
+ which is needed, when we eventually install the new method
+ "
+ correctedSource := requestor currentSourceCode.
+ "/ update the current source position
+ source := (ReadStream on:correctedSource)
+ position:(source position + 1 - selectionSize).
+
+ ^ nil
+
+ "Modified: / 22.1.1998 / 16:39:11 / stefan"
+! !
+
!Parser methodsFor:'parsing'!
block
@@ -5152,53 +5155,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.
@@ -5215,53 +5218,53 @@
|prevFlags stats node var vars lno pos2|
((tokenType == #BinaryOperator) and:[tokenName = '<']) ifTrue:[
- prevFlags := parserFlags copy.
- self parsePrimitiveOrResourceSpecOrEmpty.
+ prevFlags := parserFlags copy.
+ self parsePrimitiveOrResourceSpecOrEmpty.
].
lno := tokenLineNr.
(tokenType == $| ) ifTrue:[
- self nextToken.
- [tokenType == $|] whileFalse:[
- (tokenType == #Identifier) ifFalse:[
- ^ self identifierExpectedIn:'block-var declaration'
- ].
- pos2 := tokenPosition + tokenName size - 1.
- self markLocalIdentifierFrom:tokenPosition to:pos2.
- self checkBlockVariableNameConventionsFor:tokenName.
- var := Variable name:tokenName.
- vars isNil ifTrue:[
- vars := Array with:var.
- ] ifFalse:[
- (vars contains:[:var | var name = tokenName]) ifTrue:[
- "/ varname reuse
- self isSyntaxHighlighter ifTrue:[
- self markBadIdentifierFrom:tokenPosition to:pos2.
- ] ifFalse:[
- self
- parseError:'redefinition of ''' , tokenName , ''' in local variables'
- position:tokenPosition to:pos2.
- ]
- ] ifFalse:[
- vars := vars copyWith:var.
- ]
- ].
- self nextToken.
-
- parserFlags allowLocalVariableDeclarationWithInitializerExpression == true ifTrue:[
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self nextToken.
- "/ Q: should we allow literals only, or arbitrary expressions ?
- self shouldImplement.
- ]
- ].
- parserFlags allowDomainVariables == true ifTrue:[
- (tokenType == $() ifTrue:[
- self variableTypeDeclarationFor:var.
- ].
- ].
- ].
- self nextToken
+ self nextToken.
+ [tokenType == $|] whileFalse:[
+ (tokenType == #Identifier) ifFalse:[
+ ^ self identifierExpectedIn:'block-var declaration'
+ ].
+ pos2 := tokenPosition + tokenName size - 1.
+ self markLocalIdentifierFrom:tokenPosition to:pos2.
+ self checkBlockVariableNameConventionsFor:tokenName.
+ var := Variable name:tokenName.
+ vars isNil ifTrue:[
+ vars := Array with:var.
+ ] ifFalse:[
+ (vars contains:[:var | var name = tokenName]) ifTrue:[
+ "/ varname reuse
+ self isSyntaxHighlighter ifTrue:[
+ self markBadIdentifierFrom:tokenPosition to:pos2.
+ ] ifFalse:[
+ self
+ parseError:'redefinition of ''' , tokenName , ''' in local variables'
+ position:tokenPosition to:pos2.
+ ]
+ ] ifFalse:[
+ vars := vars copyWith:var.
+ ]
+ ].
+ self nextToken.
+
+ parserFlags allowLocalVariableDeclarationWithInitializerExpression == true ifTrue:[
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self nextToken.
+ "/ Q: should we allow literals only, or arbitrary expressions ?
+ self shouldImplement.
+ ]
+ ].
+ parserFlags allowDomainVariables == true ifTrue:[
+ (tokenType == $() ifTrue:[
+ self variableTypeDeclarationFor:var.
+ ].
+ ].
+ ].
+ self nextToken
].
node := BlockNode arguments:args home:currentBlock variables:vars.
@@ -5271,13 +5274,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
@@ -5289,8 +5292,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
!
@@ -5381,10 +5384,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"
@@ -5394,7 +5397,7 @@
makeSelector:rawSelector
false ifTrue:[ "/ will eventually support namespace selectors
currentNamespace notNil ifTrue:[
- ^ (':',currentNamespace name,':',rawSelector) asSymbol
+ ^ (':',currentNamespace name,':',rawSelector) asSymbol
].
].
^ rawSelector asSymbol.
@@ -5442,8 +5445,8 @@
Returns that array"
self nextToken ~~ #HashLeftParen ifTrue:[
- self syntaxError: '# expected, ', token printString ,'found.'.
- ^ ParseError raise.
+ self syntaxError: '# expected, ', token printString ,'found.'.
+ ^ ParseError raise.
].
self nextToken.
^self array.
@@ -5465,7 +5468,7 @@
(self parseMethodSpec == #Error) ifTrue:[^ #Error].
parseTree := self parseMethodBody.
(parseTree == #Error) ifFalse:[
- self tree:parseTree
+ self tree:parseTree
].
self checkForEndOfInput.
^ parseTree
@@ -5483,10 +5486,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"
@@ -5521,29 +5524,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
@@ -5556,8 +5559,8 @@
empty (or comment only) input is accepted and returns nil.
methodBodyOrNil ::= '<' st80Primitive '>'
- | '<' st80Primitive '>' methodBodyVarSpec statementList
- | <empty>
+ | '<' st80Primitive '>' methodBodyVarSpec statementList
+ | <empty>
"
|stats|
@@ -5565,10 +5568,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.
@@ -5576,14 +5579,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
@@ -5978,7 +5981,7 @@
Statements must be separated by periods.
statementList ::= <statement>
- | <statementList> . <statement>
+ | <statementList> . <statement>
"
|thisStatement prevStatement firstStatement periodPos prevExpr|
@@ -5987,41 +5990,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
@@ -6031,70 +6034,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.
@@ -6103,18 +6106,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.
+ ].
].
! !
@@ -6158,97 +6161,97 @@
|val|
(tokenType == #Nil) ifTrue:[
- self warnPossibleIncompatibility:'nil in array constant is interpreted as #nil (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
- ^ tokenValue
+ self warnPossibleIncompatibility:'nil in array constant is interpreted as #nil (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
+ ^ tokenValue
].
(tokenType == #True) ifTrue:[
- self warnPossibleIncompatibility:'true in array constant is interpreted as #true (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
- ^ tokenValue
+ self warnPossibleIncompatibility:'true in array constant is interpreted as #true (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
+ ^ tokenValue
].
(tokenType == #False) ifTrue:[
- self warnPossibleIncompatibility:'false in array constant is interpreted as #false (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
- ^ tokenValue
+ self warnPossibleIncompatibility:'false in array constant is interpreted as #false (symbol) in other smalltalks' position:tokenPosition to:tokenPosition+token size - 1.
+ ^ tokenValue
].
((tokenType == #Integer)
or:[tokenType == #Float]) ifTrue:[
- ^ tokenValue
+ ^ tokenValue
].
(tokenType == #String) ifTrue:[
- parserFlags stringsAreImmutable ifTrue:[^ self makeImmutableString:tokenValue].
- ^ tokenValue
+ parserFlags stringsAreImmutable ifTrue:[^ self makeImmutableString:tokenValue].
+ ^ tokenValue
].
(tokenType == #Character) ifTrue:[
- ^ tokenValue
+ ^ tokenValue
].
(tokenType == #Error) ifTrue:[
- ^ ParseError raise.
+ ^ ParseError raise.
].
(tokenType == #BinaryOperator) ifTrue:[
- val := tokenName asSymbol.
- parseForCode ifFalse:[
- self rememberSymbolUsed:val.
- ].
- ^ val
+ val := tokenName asSymbol.
+ parseForCode ifFalse:[
+ self rememberSymbolUsed:val.
+ ].
+ ^ val
].
"/ some more special symbol consts ...
(tokenType == $| ) ifTrue:[
- ^ #|
+ ^ #|
].
(tokenType == #Self ) ifTrue:[
- ^ #'self'
+ ^ #'self'
].
(tokenType == #Super ) ifTrue:[
- ^ #'super'
+ ^ #'super'
].
(tokenType == #Here ) ifTrue:[
- ^ #'here'
+ ^ #'here'
].
(tokenType == #ThisContext ) ifTrue:[
- ^ #'thisContext'
+ ^ #'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 raise.
+ "just for the better error-hilight; let caller handle error"
+ self syntaxError:'EOF unexpected in array-constant'.
+ ^ ParseError raise.
].
self syntaxError:('"'
- , tokenType printString
- , '" unexpected in array-constant').
+ , tokenType printString
+ , '" unexpected in array-constant').
^ ParseError raise.
"Modified: / 22-08-2006 / 14:21:16 / cg"
@@ -6272,40 +6275,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
@@ -6314,13 +6317,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.
@@ -6444,41 +6447,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
!
@@ -6493,17 +6496,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].
@@ -6511,10 +6514,10 @@
sel notNil ifTrue:[ ^ sel].
rec isAssignment ifTrue:[
- rec := rec expression
+ rec := rec expression
].
rec isMessage ifTrue:[
- ^ rec selector
+ ^ rec selector
].
^ nil
@@ -6676,33 +6679,33 @@
argList := OrderedCollection new.
[ true ] whileTrue:[
- prevInFunctionCallArgument := inFunctionCallArgument.
- inFunctionCallArgument := true.
-
- arg := self expression.
- arg == #Error ifTrue:[^ #Error].
- argList add:arg.
-
- inFunctionCallArgument := prevInFunctionCallArgument.
-
- tokenType == $) ifTrue:[
- self nextToken.
- ^ argList
- ].
- ((tokenType == #BinaryOperator) and:[tokenName = ',']) ifFalse:[
- self parseError:'"," or ")" expected'.
- ^ argList
- ].
- self nextToken.
+ prevInFunctionCallArgument := inFunctionCallArgument.
+ inFunctionCallArgument := true.
+
+ arg := self expression.
+ arg == #Error ifTrue:[^ #Error].
+ argList add:arg.
+
+ inFunctionCallArgument := prevInFunctionCallArgument.
+
+ tokenType == $) ifTrue:[
+ self nextToken.
+ ^ argList
+ ].
+ ((tokenType == #BinaryOperator) and:[tokenName = ',']) ifFalse:[
+ self parseError:'"," or ")" expected'.
+ ^ argList
+ ].
+ self nextToken.
].
!
functionCallExpression
"parse a functionCall;
this is an st/x extension.
- foo(x)
+ foo(x)
is syntactic sugar for
- foo value:x
+ foo value:x
"
|receiver numArgs argList evalSelectors evalSelector|
@@ -6714,11 +6717,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.
@@ -6726,34 +6729,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.
"
@@ -6982,19 +6985,19 @@
class instSize: names size.
names keysAndValuesDo:[:idx :instVarName |
- idx <= InlineObjectPrototype instSize ifTrue:[
- class basicAddSelector:(instVarName asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1' bindWith:idx) asSymbol).
- inlineObjectsAreReadonly ifFalse:[
- class basicAddSelector:((instVarName,':') asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1:' bindWith:idx) asSymbol).
- ].
- ] ifFalse:[
- Class withoutUpdatingChangesDo:[
- Compiler compile:('%1 ^%1' bindWith:instVarName) forClass:class.
- inlineObjectsAreReadonly ifFalse:[
- Compiler compile:('%1:something %1 := something' bindWith:instVarName) forClass:class.
- ].
- ].
- ].
+ idx <= InlineObjectPrototype instSize ifTrue:[
+ class basicAddSelector:(instVarName asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1' bindWith:idx) asSymbol).
+ inlineObjectsAreReadonly ifFalse:[
+ class basicAddSelector:((instVarName,':') asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1:' bindWith:idx) asSymbol).
+ ].
+ ] ifFalse:[
+ Class withoutUpdatingChangesDo:[
+ Compiler compile:('%1 ^%1' bindWith:instVarName) forClass:class.
+ inlineObjectsAreReadonly ifFalse:[
+ Compiler compile:('%1:something %1 := something' bindWith:instVarName) forClass:class.
+ ].
+ ].
+ ].
].
instance := class new.
@@ -7264,40 +7267,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.
@@ -7345,19 +7348,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
@@ -7374,7 +7377,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
@@ -7392,15 +7395,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"
@@ -7766,17 +7769,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
!
@@ -7789,7 +7792,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
@@ -7815,7 +7818,7 @@
self nextToken.
(self noAssignmentAllowed:'Assignment to pseudo variable ''self''' at:pos) ifFalse:[
- ^ ParseError raiseErrorString:'Assignment to self'.
+ ^ ParseError raiseErrorString:'Assignment to self'.
].
self markSelfFrom:pos to:pos+3.
^ self selfNode startPosition: pos endPosition: pos + 3
@@ -7882,19 +7885,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.
@@ -7922,10 +7925,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:[
@@ -7936,7 +7939,7 @@
"/ JV@2011-07-19: Changed not to share the nodes
"/ ^ superNode
^ (SuperNode value:selfValue inClass:classToCompileFor)
- startPosition: pos endPosition: pos + 4
+ startPosition: pos endPosition: pos + 4
"Modified: / 19-07-2011 / 18:12:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 26-07-2012 / 11:37:58 / cg"
@@ -7951,11 +7954,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"
@@ -7970,7 +7973,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
@@ -8070,7 +8073,7 @@
self nextToken.
(tokenType == #Keyword) ifTrue:[
- ^ self inlineObjectFrom:pos1.
+ ^ self inlineObjectFrom:pos1.
].
^ self qualifiedNameFrom:pos1
!
@@ -8079,28 +8082,28 @@
|expressions elem pos1|
tokenType == $} ifTrue:[
- ^ #()
+ ^ #()
].
pos1 := tokenPosition.
expressions := OrderedCollection new:20.
[true] whileTrue:[
- elem := self expression.
- (elem == #Error) ifTrue:[
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'unterminated computed-array-element; ''}'' expected'
- position:pos1 to:tokenPosition
- ].
- ^ #Error
- ].
- expressions add:elem.
- tokenType == $. ifFalse:[
- ^ expressions
- ].
- self nextToken.
- tokenType == $} ifTrue:[
- ^ expressions
- ].
+ elem := self expression.
+ (elem == #Error) ifTrue:[
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'unterminated computed-array-element; ''}'' expected'
+ position:pos1 to:tokenPosition
+ ].
+ ^ #Error
+ ].
+ expressions add:elem.
+ tokenType == $. ifFalse:[
+ ^ expressions
+ ].
+ self nextToken.
+ tokenType == $} ifTrue:[
+ ^ expressions
+ ].
].
"/ not reached
!
@@ -8207,10 +8210,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.
@@ -8218,30 +8221,30 @@
self markUnknownIdentifierFrom:pos1 to:pos2.
parseForCode ifTrue:[
- allowUndeclaredVariables ifFalse:[
- self
- parseError:'Parser [error]: undeclared variable: ',tokenName
- position:pos1 to:pos2.
- ].
- v := self correctVariable:tokenName atPosition:pos1 to:pos2.
- (v ~~ #Error) ifTrue:[^ v].
-
- self errorFlag:true.
-
- tokenName first isLowercase ifTrue:[
- parserFlags implicitSelfSends ifTrue:[
- ^ UnaryNode receiver:(self selfNode) selector:('__' , tokenName) asSymbol.
- ].
- ^ #Error
- ]
+ allowUndeclaredVariables ifFalse:[
+ self
+ parseError:'Parser [error]: undeclared variable: ',tokenName
+ position:pos1 to:pos2.
+ ].
+ v := self correctVariable:tokenName atPosition:pos1 to:pos2.
+ (v ~~ #Error) ifTrue:[^ v].
+
+ self errorFlag:true.
+
+ tokenName first isLowercase ifTrue:[
+ parserFlags implicitSelfSends ifTrue:[
+ ^ UnaryNode receiver:(self selfNode) selector:('__' , tokenName) asSymbol.
+ ].
+ ^ #Error
+ ]
] ifFalse:[
- self rememberGlobalUsed:(Smalltalk undeclaredPrefix) , tokenName.
- self rememberGlobalUsed:tokenName.
+ self rememberGlobalUsed:(Smalltalk undeclaredPrefix) , tokenName.
+ self rememberGlobalUsed:tokenName.
].
"/ self markGlobalIdentifierFrom:pos1 to:pos2.
^ (VariableNode globalNamed:tokenName)
- startPosition: pos1 endPosition: (pos1 + tokenName size - 1)
+ 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"
@@ -8534,10 +8537,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.
]
!
@@ -8557,49 +8560,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.
@@ -8639,38 +8642,38 @@
|value|
(((tokenType == #String) or: [(tokenType == #Integer)] or: [(tokenType == #True)] or: [(tokenType == #False)] or: [(tokenType == #Nil)])
- or: [(tokenType == #Symbol)] or:[(tokenType == #Character)]) ifTrue: [
- value := tokenValue.
- self nextToken.
- ^ value.
+ or: [(tokenType == #Symbol)] or:[(tokenType == #Character)]) ifTrue: [
+ value := tokenValue.
+ self nextToken.
+ ^ value.
].
(tokenType == #Identifier) ifTrue:[
- value := tokenName asSymbol.
- self nextToken.
- ^ value.
+ value := tokenName asSymbol.
+ self nextToken.
+ ^ value.
].
"
(tokenType == #Keyword) ifTrue: [
- value := '#', tokenName.
- self nextToken.
- ^ value.
+ value := '#', tokenName.
+ self nextToken.
+ ^ value.
].
"
((tokenType == $() or:[tokenType == #HashLeftParen]) ifTrue:[
- self nextToken.
- value := self array.
- self nextToken.
- ^ value.
+ self nextToken.
+ value := self array.
+ self nextToken.
+ ^ value.
].
((tokenType == $[) or:[tokenType == #HashLeftBrack]) ifTrue:[
- self nextToken.
- value := self byteArray.
- self nextToken.
- ^value.
+ self nextToken.
+ value := self byteArray.
+ self nextToken.
+ ^value.
].
^ #Error
@@ -8681,8 +8684,8 @@
parseExceptionOrContextPragma
"parse
- <exception: #handle|raise|unwind>,
- <context: #return>
+ <exception: #handle|raise|unwind>,
+ <context: #return>
context flagging pragmas."
|pragmaType|
@@ -8691,25 +8694,25 @@
pragmaType := tokenName.
self nextToken.
(tokenType ~~ #Symbol) ifTrue:[
- self parseError:'symbol expected'.
- ^ #Error
+ self parseError:'symbol expected'.
+ ^ #Error
].
(pragmaType = 'context:') ifTrue:[
- (tokenValue == #return) ifTrue:[
- self rememberContextReturnablePragma
- ] ifFalse:[
- self parseError:'unrecognized context pragma: ' , tokenValue.
- ].
+ (tokenValue == #return) ifTrue:[
+ self rememberContextReturnablePragma
+ ] ifFalse:[
+ self parseError:'unrecognized context pragma: ' , tokenValue.
+ ].
].
(pragmaType = 'exception:') ifTrue:[
- (tokenValue == #handle
- or:[ tokenValue == #raise
- or:[ tokenValue == #unwind ]]) ifTrue:[
- self rememberContextPragma:pragmaType value:tokenValue
- ] ifFalse:[
- self parseError:'unrecognized exception pragma: ' , tokenValue.
- ].
+ (tokenValue == #handle
+ or:[ tokenValue == #raise
+ or:[ tokenValue == #unwind ]]) ifTrue:[
+ self rememberContextPragma:pragmaType value:tokenValue
+ ] ifFalse:[
+ self parseError:'unrecognized exception pragma: ' , tokenValue.
+ ].
].
annotations := annotations copyWith:{ pragmaType asSymbol . { tokenValue }}.
@@ -8729,70 +8732,70 @@
cString := source upTo:$>.
self nextToken.
parseForCode ifFalse:[
- ^ -1
+ ^ -1
].
CParser notNil ifTrue:[
- dictionaryOfKnownTypes := Dictionary new.
-
- "/ a few wellknown types
-
- self defineWellknownCTypesIn:dictionaryOfKnownTypes.
-
- "/ collect existing types...
-
- classToCompileFor
- methodsDo:[:m |
- m
- literalsDo:[:lit |
- (lit isKindOf:CType) ifTrue:[
- self assert:lit name notNil.
- dictionaryOfKnownTypes at:lit name put:lit.
- ].
- ].
- ].
+ dictionaryOfKnownTypes := Dictionary new.
+
+ "/ a few wellknown types
+
+ self defineWellknownCTypesIn:dictionaryOfKnownTypes.
+
+ "/ collect existing types...
+
+ classToCompileFor
+ methodsDo:[:m |
+ m
+ literalsDo:[:lit |
+ (lit isKindOf:CType) ifTrue:[
+ self assert:lit name notNil.
+ dictionaryOfKnownTypes at:lit name put:lit.
+ ].
+ ].
+ ].
].
cStream := cString readStream.
(#( 'apicall:' 'cdecl:' 'stdcall:' 'virtual' ) includes:callType) ifTrue:[
- "/ squeak/dolphin/stx external function definition
- annotations := annotations
- copyWith:(Array with:callType asSymbol with:cString).
- self
- parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:cStream
- definitionType:callType
- knownDefinitions:dictionaryOfKnownTypes
- lineNr:lineNr.
- ^ -1
+ "/ squeak/dolphin/stx external function definition
+ annotations := annotations
+ copyWith:(Array with:callType asSymbol with:cString).
+ self
+ parseSTXOrSqueakOrDolphinExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
+ ^ -1
].
callType = 'c:' ifTrue:[
- "/ VW external function definition
- annotations := annotations
- copyWith:(Array with:callType asSymbol with:cString).
- self
- parseVWTypeOrExternalFunctionDeclarationFrom:cStream
- definitionType:callType
- knownDefinitions:dictionaryOfKnownTypes
- lineNr:lineNr.
- ^ -1
+ "/ VW external function definition
+ annotations := annotations
+ copyWith:(Array with:callType asSymbol with:cString).
+ self
+ parseVWTypeOrExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
+ ^ -1
].
(callType = 'api:' or:[ callType = 'ole:' ]) ifTrue:[
- "/ ST/V external function definition
- annotations := annotations
- copyWith:(Array with:callType asSymbol with:cString).
- self
- parseSTVExternalFunctionDeclarationFrom:cStream
- definitionType:callType
- knownDefinitions:dictionaryOfKnownTypes
- lineNr:lineNr.
- ^ -1
+ "/ ST/V external function definition
+ annotations := annotations
+ copyWith:(Array with:callType asSymbol with:cString).
+ self
+ parseSTVExternalFunctionDeclarationFrom:cStream
+ definitionType:callType
+ knownDefinitions:dictionaryOfKnownTypes
+ lineNr:lineNr.
+ ^ -1
].
self
- ignorableParseError:'unsupported external function call type: ' , callType.
+ 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>"
@@ -8801,14 +8804,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.
@@ -8823,39 +8826,39 @@
value := true.
self nextToken.
((tokenType == #BinaryOperator) and:[ tokenName = '>' ]) ifTrue:[
- annotations := annotations copyWith:(Array with:key asSymbol with:value).
- self nextToken.
- ^ nil.
+ annotations := annotations copyWith:(Array with:key asSymbol with:value).
+ self nextToken.
+ ^ nil.
].
value := self parseAnotationLiteral.
(value == #Error) ifTrue:[
- ^ #Error.
+ ^ #Error.
].
((tokenType == #BinaryOperator) and:[ tokenName = '>' ]) ifTrue:[
- annotations := annotations
- copyWith:(Array with:key asSymbol with:(Array with:value)).
- self nextToken.
- ^ nil.
+ annotations := annotations
+ copyWith:(Array with:key asSymbol with:(Array with:value)).
+ self nextToken.
+ ^ nil.
].
values := OrderedCollection new:4.
values add:value.
[
- (tokenType == #Keyword or:[ tokenType == #Identifier ])
+ (tokenType == #Keyword or:[ tokenType == #Identifier ])
] whileTrue:[
- key := key , tokenName.
- self nextToken.
- value := self parseAnotationLiteral.
- (value == #Error) ifTrue:[
- ^ #Error.
- ].
- values add:value.
+ key := key , tokenName.
+ self nextToken.
+ value := self parseAnotationLiteral.
+ (value == #Error) ifTrue:[
+ ^ #Error.
+ ].
+ values add:value.
].
annotations := annotations
- copyWith:(Array with:key asSymbol with:(values asArray)).
+ copyWith:(Array with:key asSymbol with:(values asArray)).
"JV@2012-04-09: Check for GNU Smalltalk-style external function declaration"
key = #'cCall:returning:args:' ifTrue:[
- self parseGSTExternalFunctionDeclaration: values.
+ self parseGSTExternalFunctionDeclaration: values.
].
self checkForClosingAngle.
@@ -8900,20 +8903,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' )
@@ -8924,112 +8927,112 @@
newSTXPrimitive ::= 'primitive'
vAgePrimitive ::= 'primitive:' IDENTIFIER
- | 'sysprim:' IDENTIFIER
+ | 'sysprim:' IDENTIFIER
externalFuncDecl ::= vwExternalFuncDecl
- | stvExternalFuncDecl
- | squeakExternalFuncDecl
- | dolphinExternalFuncDecl
+ | stvExternalFuncDecl
+ | squeakExternalFuncDecl
+ | dolphinExternalFuncDecl
vwExternalFuncDecl ::= 'c:' vwFuncDecl
stvExternalFuncDecl ::= 'api:' stvFuncDecl
- | 'ole:' stvFuncDecl
+ | 'ole:' stvFuncDecl
squeakExternalFuncDecl ::= 'apicall:' stvFuncDecl
- | 'cdecl:' stvFuncDecl
+ | 'cdecl:' stvFuncDecl
dolphinExternalFuncDecl ::= 'stdcall:' stvFuncDecl
resourceDecl ::= 'resource:' SYMBOL - leave SYMBOL in primitiveResource
- | 'resource:' SYMBOL (...) - leave (SYMBOL (...)) in primitiveResource
- | 'pragma:' SYMBOL - same as resource; alternative syntax
- | 'pragma:' SYMBOL (...) - same as resource; alternative syntax
- | 'attribute:' SYMBOL - same as resource; alternative syntax
- | 'attribute:' SYMBOL (...) - same as resource; alternative syntax"
+ | 'resource:' SYMBOL (...) - leave (SYMBOL (...)) in primitiveResource
+ | 'pragma:' SYMBOL - same as resource; alternative syntax
+ | 'pragma:' SYMBOL (...) - same as resource; alternative syntax
+ | 'attribute:' SYMBOL - same as resource; alternative syntax
+ | 'attribute:' SYMBOL (...) - same as resource; alternative syntax"
|lcTokenName tmp|
(tokenType == #Keyword or:[ tokenType == #Identifier ]) ifFalse:[
- self parseError:'bad primitive definition (keyword expected)'.
- ^ #Error
+ self parseError:'bad primitive definition (keyword expected)'.
+ ^ #Error
].
(tokenName = 'primitive:') ifTrue:[
- tmp := self parseTraditionalPrimitive.
- annotations := annotations
- copyWith:(Array with:'primitive:' asSymbol with:tmp).
- ^ tmp.
+ tmp := self parseTraditionalPrimitive.
+ annotations := annotations
+ copyWith:(Array with:'primitive:' asSymbol with:tmp).
+ ^ tmp.
].
(tokenName = 'sysprim:') ifTrue:[
- parserFlags allowVisualAgePrimitives ifTrue:[
- tmp := self parseTraditionalPrimitive.
- annotations := annotations
- copyWith:(Array with:'sysprim:' asSymbol with:tmp).
- ^ tmp.
- ].
+ parserFlags allowVisualAgePrimitives ifTrue:[
+ tmp := self parseTraditionalPrimitive.
+ annotations := annotations
+ copyWith:(Array with:'sysprim:' asSymbol with:tmp).
+ ^ tmp.
+ ].
].
(tokenName = 'primitive') ifTrue:[
- self nextToken.
- self checkForClosingAngle.
- annotations := annotations
- copyWith:(Array with:'primitive' asSymbol with:0).
- ^ 0
- "/ no primitive number
- .
+ self nextToken.
+ self checkForClosingAngle.
+ annotations := annotations
+ copyWith:(Array with:'primitive' asSymbol with:0).
+ ^ 0
+ "/ no primitive number
+ .
].
(tokenName = 'resource:') ifTrue:[
- self parseResourcePragma.
- ^ nil
- "/ no primitive number
- .
+ self parseResourcePragma.
+ ^ nil
+ "/ no primitive number
+ .
].
(tokenName = 'pragma:') ifTrue:[
- self parsePragma.
- ^ nil
- "/ no primitive number
- .
+ self parsePragma.
+ ^ nil
+ "/ no primitive number
+ .
].
(tokenName = 'exception:' or:[ tokenName = 'context:' ]) ifTrue:[
- (self parseExceptionOrContextPragma) == #Error ifTrue:[
- ^ #Error
- ].
- self checkForClosingAngle.
- ^ nil
- "/ no primitive number
+ (self parseExceptionOrContextPragma) == #Error ifTrue:[
+ ^ #Error
+ ].
+ self checkForClosingAngle.
+ ^ nil
+ "/ no primitive number
].
lcTokenName := tokenName asLowercase.
((lcTokenName = 'c:'
- "/ vw external function definition
- )
- or:[
- lcTokenName = 'api:'
- "/ st/v external function definition
-
- or:[
- lcTokenName = 'ole:'
- "/ st/v external function definition
-
- or:[
- lcTokenName = 'apicall:'
- "/ squeak external function definition
-
- or:[
- lcTokenName = 'cdecl:'
- "/ squeak external function definition
-
- or:[
- lcTokenName = 'stdcall:'
- "/ dolphin external function definition
- ]
- ]
- ]
- ]
- ])
- ifTrue:[
- self parseExternalFunctionCallDeclaration.
- ^ nil
- "/ no primitive number
- ].
+ "/ vw external function definition
+ )
+ or:[
+ lcTokenName = 'api:'
+ "/ st/v external function definition
+
+ or:[
+ lcTokenName = 'ole:'
+ "/ st/v external function definition
+
+ or:[
+ lcTokenName = 'apicall:'
+ "/ squeak external function definition
+
+ or:[
+ lcTokenName = 'cdecl:'
+ "/ squeak external function definition
+
+ or:[
+ lcTokenName = 'stdcall:'
+ "/ dolphin external function definition
+ ]
+ ]
+ ]
+ ]
+ ])
+ ifTrue:[
+ self parseExternalFunctionCallDeclaration.
+ ^ nil
+ "/ no primitive number
+ ].
^ self parseOtherPrimitives.
"Modified: / 10-01-2010 / 17:10:11 / Jan Travnicek <travnja3@fel.cvut.cz>"
@@ -9042,35 +9045,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"
@@ -9085,39 +9088,39 @@
type := token.
self nextToken.
(tokenType ~~ #Symbol) ifTrue:[
- self parseError:'symbol expected'.
- ^ #Error
+ self parseError:'symbol expected'.
+ ^ #Error
].
resource := tokenValue.
resourceValue := true.
self nextToken.
tokenType == $( ifTrue:[
- self nextToken.
- keys := OrderedCollection new.
- [
- (tokenType == $)) or:[ tokenType == #EOF ]
- ] whileFalse:[
- keys add:tokenValue.
- self nextToken.
- ].
- resourceValue := keys.
- (tokenType == $)) ifFalse:[
- self parseError:'unterminated primitive/spec (missing '')'')'.
- ].
- self nextToken.
+ self nextToken.
+ keys := OrderedCollection new.
+ [
+ (tokenType == $)) or:[ tokenType == #EOF ]
+ ] whileFalse:[
+ keys add:tokenValue.
+ self nextToken.
+ ].
+ resourceValue := keys.
+ (tokenType == $)) ifFalse:[
+ self parseError:'unterminated primitive/spec (missing '')'')'.
+ ].
+ self nextToken.
].
primitiveResource isNil ifTrue:[
- primitiveResource := IdentityDictionary new.
+ primitiveResource := IdentityDictionary new.
].
primitiveResource at:(resource asSymbol) put:resourceValue.
self checkForClosingAngle.
(resourceValue isBoolean and:[ resourceValue ]) ifTrue:[
- annotations := annotations
- copyWith:(Array with:#resource: asSymbol with:(Array with:resource)).
+ annotations := annotations
+ copyWith:(Array with:#resource: asSymbol with:(Array with:resource)).
] ifFalse:[
- annotations := annotations
- copyWith:(Array with:#resource:values: asSymbol
- with:(Array with:resource with:resourceValue)).
+ annotations := annotations
+ copyWith:(Array with:#resource:values: asSymbol
+ with:(Array with:resource with:resourceValue)).
]
"Modified: / 19-11-2009 / 11:11:26 / Jan Travnicek <travnja3@fel.cvut.cz>"
@@ -9126,21 +9129,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"
@@ -9150,11 +9153,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|
@@ -9162,14 +9165,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"
@@ -9182,22 +9185,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:[
@@ -9217,44 +9220,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.
@@ -9266,23 +9269,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.
@@ -9299,7 +9302,7 @@
rememberContextPragma:pragmaType value:pragmaValue
primitiveContextInfo isNil ifTrue:[
- primitiveContextInfo := Set new.
+ primitiveContextInfo := Set new.
].
primitiveContextInfo add:(pragmaType -> pragmaValue).
@@ -9315,11 +9318,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.
].
! !
@@ -9330,12 +9333,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
@@ -9363,12 +9366,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
!
@@ -9378,15 +9381,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
@@ -9401,24 +9404,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:[
@@ -9433,21 +9436,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
@@ -9458,9 +9461,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|
@@ -9471,45 +9474,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>"
@@ -9524,8 +9527,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
@@ -9566,41 +9569,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.
@@ -9614,8 +9617,8 @@
stat := aStatementNode.
[stat notNil] whileTrue:[
- (self isStatementAnUnconditionalReturn:stat) ifTrue:[^ true].
- stat := stat nextStatement
+ (self isStatementAnUnconditionalReturn:stat) ifTrue:[^ true].
+ stat := stat nextStatement
].
^ false.
@@ -9627,12 +9630,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
@@ -9673,18 +9676,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'].
@@ -9736,11 +9739,11 @@
noAssignmentAllowed:eMsg at:pos
((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:eMsg position:pos to:tokenPosition + tokenType size - 1.
- self isSyntaxHighlighter ifFalse:[
- ^ false
- ].
- self nextToken. "/ eat the assign when doing highlighting only
+ self parseError:eMsg position:pos to:tokenPosition + tokenType size - 1.
+ self isSyntaxHighlighter ifFalse:[
+ ^ false
+ ].
+ self nextToken. "/ eat the assign when doing highlighting only
].
^ true
!
@@ -9755,10 +9758,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>"
!
@@ -9774,10 +9777,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>"
!
@@ -9787,19 +9790,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
@@ -9840,14 +9843,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
@@ -9861,20 +9864,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
@@ -9888,25 +9891,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
@@ -9921,17 +9924,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
@@ -9943,7 +9946,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"
!
@@ -10019,10 +10022,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
@@ -10230,9 +10233,9 @@
classToCompileFor := aClass.
(classToCompileFor ~~ PrevClass) ifTrue:[
- PrevClass notNil ifTrue:[
- Parser update:PrevClass
- ]
+ PrevClass notNil ifTrue:[
+ Parser update:PrevClass
+ ]
]
!
@@ -10248,9 +10251,9 @@
selfValue := anObject.
classToCompileFor := anObject class.
(classToCompileFor ~~ PrevClass) ifTrue:[
- PrevClass notNil ifTrue:[
- Parser update:PrevClass
- ]
+ PrevClass notNil ifTrue:[
+ Parser update:PrevClass
+ ]
]
!
@@ -10292,7 +10295,7 @@
rememberClassVarModified:name
modifiedClassVars isNil ifTrue:[
- modifiedClassVars := Set new
+ modifiedClassVars := Set new
].
modifiedClassVars add:name.
self rememberClassVarUsed:name
@@ -10300,7 +10303,7 @@
rememberClassVarRead:name
readClassVars isNil ifTrue:[
- readClassVars := Set new
+ readClassVars := Set new
].
readClassVars add:name.
self rememberClassVarUsed:name
@@ -10308,7 +10311,7 @@
rememberClassVarUsed:name
usedClassVars isNil ifTrue:[
- usedClassVars := Set new
+ usedClassVars := Set new
].
usedClassVars add:name.
self rememberVariableUsed:name
@@ -10316,7 +10319,7 @@
rememberGlobalModified:name
modifiedGlobals isNil ifTrue:[
- modifiedGlobals := Set new
+ modifiedGlobals := Set new
].
modifiedGlobals add:name.
self rememberGlobalUsed:name.
@@ -10324,7 +10327,7 @@
rememberGlobalRead:name
readGlobals isNil ifTrue:[
- readGlobals := Set new
+ readGlobals := Set new
].
readGlobals add:name.
self rememberGlobalUsed:name
@@ -10332,7 +10335,7 @@
rememberGlobalUsed:name
usedGlobals isNil ifTrue:[
- usedGlobals := Set new
+ usedGlobals := Set new
].
usedGlobals add:name.
self rememberVariableUsed:name
@@ -10340,7 +10343,7 @@
rememberInstVarModified:name
modifiedInstVars isNil ifTrue:[
- modifiedInstVars := Set new
+ modifiedInstVars := Set new
].
modifiedInstVars add:name.
self rememberInstVarUsed:name.
@@ -10348,7 +10351,7 @@
rememberInstVarRead:name
readInstVars isNil ifTrue:[
- readInstVars := Set new
+ readInstVars := Set new
].
readInstVars add:name.
self rememberVariableUsed:name
@@ -10356,7 +10359,7 @@
rememberInstVarUsed:name
usedInstVars isNil ifTrue:[
- usedInstVars := Set new
+ usedInstVars := Set new
].
usedInstVars add:name.
self rememberVariableUsed:name
@@ -10372,7 +10375,7 @@
rememberLocalUsed:name
usedLocalVars isNil ifTrue:[
- usedLocalVars := Set new
+ usedLocalVars := Set new
].
usedLocalVars add:name.
@@ -10380,7 +10383,7 @@
rememberPoolVarModified:name
modifiedPoolVars isNil ifTrue:[
- modifiedPoolVars := Set new
+ modifiedPoolVars := Set new
].
modifiedPoolVars add:name.
self rememberPoolVarUsed:name.
@@ -10388,7 +10391,7 @@
rememberPoolVarRead:name
readPoolVars isNil ifTrue:[
- readPoolVars := Set new
+ readPoolVars := Set new
].
readPoolVars add:name.
self rememberPoolVarUsed:name
@@ -10396,7 +10399,7 @@
rememberPoolVarUsed:name
usedPoolVars isNil ifTrue:[
- usedPoolVars := Set new
+ usedPoolVars := Set new
].
usedPoolVars add:name.
self rememberVariableUsed:name
@@ -10409,23 +10412,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
!
@@ -10472,28 +10475,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
! !
@@ -10600,19 +10603,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
@@ -10622,43 +10625,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
@@ -10668,7 +10671,7 @@
userfriendlyMenuItemNameListFor:listOfPossibleVariableTypes
^ listOfPossibleVariableTypes
- collect:[:varType | self userfriendlyMenuItemNameFor:varType]
+ collect:[:varType | self userfriendlyMenuItemNameFor:varType]
"Created: / 20-10-2010 / 18:42:13 / cg"
! !
@@ -10756,6 +10759,13 @@
^ 'Declare As...'
! !
+!Parser::CorrectByDeclaringIdentifierAs methodsFor:'fixing'!
+
+fixFrom:pos1 to:pos2 for:aCompiler
+
+self halt.
+! !
+
!Parser::CorrectByDeclaringIdentifierAs methodsFor:'queries'!
buttonLabel
@@ -11247,11 +11257,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
@@ -11269,128 +11279,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
@@ -11405,79 +11415,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
@@ -11589,39 +11599,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.
@@ -11635,35 +11645,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 ].
@@ -11715,11 +11725,11 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.789 2013-08-30 22:55:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.790 2013-08-31 22:35:44 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.789 2013-08-30 22:55:26 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.790 2013-08-31 22:35:44 cg Exp $'
!
version_SVN