--- a/Parser.st Mon Dec 03 16:25:08 2001 +0100
+++ b/Parser.st Mon Dec 03 16:31:36 2001 +0100
@@ -4590,23 +4590,13 @@
"parse a primary-expression; return a node-tree, nil or #Error.
This also cares for namespace-access-pathes."
- |val var expr pos name t cls nameSpace nameSpaceGlobal globlName lnr node
- pos2 eMsg exprList rawName|
-
- pos := tokenPosition.
+ |val pos node eMsg|
(tokenType == #Self) ifTrue:[
- self nextToken.
- (self noAssignmentAllowed:'assignment to pseudo variable ''self''' at:pos) ifFalse:[
- ^ ParseError raise
- ].
- selfNode isNil ifTrue:[
- selfNode := SelfNode value:selfValue
- ].
- self markSelfFrom:pos to:pos+3.
- ^ selfNode
- ].
-
+ ^ self primary_self.
+ ].
+
+ pos := tokenPosition.
(tokenType == #Identifier) ifTrue:[
"
must check for variable first, to be backward compatible
@@ -4628,226 +4618,7 @@
].
(tokenType == #Identifier) ifTrue:[
- name := tokenName.
-
- var := self variable.
- "/ errorFlag == true ifTrue:[self halt].
- (var == #Error) ifTrue:[
- errorFlag := true
- ].
- self nextToken.
-
- (tokenType == #'::') ifTrue:[
- globlName := rawName := name.
-
- "is it in a namespace ?"
- nameSpace := self findNameSpaceWith:globlName.
- nameSpace notNil ifTrue:[
- globlName := nameSpace name , '::' , globlName
- ].
-
- [tokenType == #'::'] whileTrue:[
- nameSpace := globlName.
-
- self nextToken.
- (tokenType == #Identifier) ifTrue:[
- ignoreWarnings ifFalse:[
- warnSTXNameSpaceUse ifTrue:[
- self warning:'nameSpaces are a nonstandard feature of ST/X'
- position:pos to:(source position).
- "
- only warn once
- "
- warnSTXNameSpaceUse := false
- ]
- ].
- name := tokenName.
-
- globlName := (nameSpace , '::' , name).
- rawName := (rawName , '::' , name).
-
- nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
- nameSpaceGlobal isNil ifTrue:[
- warnedUnknownNamespaces isNil ifTrue:[
- warnedUnknownNamespaces := Set new.
- ].
- (warnedUnknownNamespaces includes:nameSpace) ifFalse:[
- self warning:('unknown nameSpace: ', nameSpace)
- position:pos to:tokenPosition-1.
-"/ self parseError:('unknown nameSpace: ', nameSpace) position:pos to:tokenPosition-1.
- warnedUnknownNamespaces add:nameSpace.
- ]
- ] ifFalse:[
- nameSpaceGlobal isNameSpace ifTrue:[
- "/ for now: only Smalltalk is allowed
- nameSpaceGlobal ~~ Smalltalk ifTrue:[
-"/ self parseError:('(currently) the only valid nameSpace is `Smalltalk''') position:pos to:tokenPosition-1.
- ] ifFalse:[
- globlName := name
- ].
- ] ifFalse:[
- nameSpaceGlobal isBehavior ifFalse:[
- self parseError:('invalid nameSpace: ' , nameSpace) position:pos to:tokenPosition-1.
- ] ifTrue:[
- (nameSpaceGlobal privateClassesAt:name asSymbol) isNil ifTrue:[
- self warning:('no private class: ' , name , ' in class: ' , nameSpace)
- position:pos to:tokenPosition-1.
-"/ self parseError:('no private class: ' , name , ' in class: ' , nameSpace) position:pos to:tokenPosition-1.
- ]
- ]
- ].
- ].
- self nextToken.
- ].
- var := VariableNode type:#GlobalVariable name:globlName asSymbol.
- parseForCode ifFalse:[self rememberGlobalUsed:globlName].
- ].
- self markVariable:var from:pos to:pos + rawName size - 1.
- ].
-
- var == #Error ifTrue:[
- ^ #Error
- ].
-
- errorFlag ~~ true ifTrue:[
- self markVariable:var from:pos to:pos + name size - 1.
- ].
- (ignoreErrors or:[ignoreWarnings or:[parseForCode not]]) ifTrue:[
- errorFlag := false.
- ].
-
- ((tokenType ~~ $_) and:[tokenType ~~ #':=']) ifTrue:[
- parseForCode ifFalse:[
- var isInstanceVariable ifTrue:[ self rememberInstVarRead:var name].
- var isClassVariable ifTrue:[ self rememberClassVarRead:var name].
- ].
- ^ var
- ].
- pos2 := tokenPosition + tokenType size - 1.
-
- "/ careful: it could already be an implicit self send
- ImplicitSelfSends ifTrue:[
- var isMessage ifTrue:[
- self nextToken.
- expr := self expression.
- self isSyntaxHighlighter ifFalse:[
- (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
- ].
- selfNode isNil ifTrue:[
- selfNode := SelfNode value:selfValue
- ].
- ^ MessageNode receiver:selfNode selector:('implicit_' , name , ':') asSymbol arg:expr.
- ].
- ].
-
- (var ~~ #Error) ifTrue:[
- t := var type.
- (t ~~ #MethodVariable) ifTrue:[
- (t == #PrivateClass) ifTrue:[
- self parseError:'assignment to private class' position:pos to:pos2.
- ] ifFalse:[
- (t == #MethodArg) ifTrue:[
- self parseError:'assignment to method argument' position:pos to:pos2.
- ] ifFalse:[
- (t == #BlockArg) ifTrue:[
- self parseError:'assignment to block argument' position:pos to:pos2.
- ] ifFalse:[
- (t == #InstanceVariable) ifTrue:[
- name := self classesInstVarNames at:(var index).
-
- "/ ca once did this to `name' and wondered what happened to his class ...
- "/ (not really a beginners bug, but may happen as a typo or missing local variable;
- "/ and is hard to track down later)
-
- warnCommonMistakes ifTrue:[
- classToCompileFor isMeta ifTrue:[
- (classToCompileFor isSubclassOf:Class) ifTrue:[
- (Class allInstVarNames includes:(var name)) ifTrue:[
- self warning:'assignment to a classInstanceVariable\(see hierarchy of `Class'')' withCRs position:pos to:pos2.
- ]
- ]
- ]
- ].
- parseForCode ifFalse:[
- modifiedInstVars isNil ifTrue:[
- modifiedInstVars := Set new
- ].
- modifiedInstVars add:name
- ]
- ] ifFalse:[
- (t == #ClassVariable) ifTrue:[
- name := var name.
- name := name copyFrom:((name indexOf:$:) + 1).
- parseForCode ifFalse:[
- modifiedClassVars isNil ifTrue:[
- modifiedClassVars := Set new
- ].
- modifiedClassVars add:name
- ]
- ] ifFalse:[
- (t == #GlobalVariable) ifTrue:[
- (cls := Smalltalk classNamed:var name) notNil ifTrue:[
- cls name = var name ifTrue:[
- self warning:'assignment to global which refers to a class' position:pos to:pos2.
- ]
- ].
- parseForCode ifFalse:[
- modifiedGlobals isNil ifTrue:[
- modifiedGlobals := Set new
- ].
- modifiedGlobals add:var name
- ]
- ]
- ]
- ]
- ]
- ]
- ]
- ].
- t == #MethodVariable ifTrue:[
- modifiedLocalVars isNil ifTrue:[
- modifiedLocalVars := Set new.
- ].
- modifiedLocalVars add:var name.
- ].
- ].
-
- lnr := tokenLineNr.
-
- self nextToken.
- pos2 := tokenPosition.
- expr := self expression.
-
- "/ a typical beginner error:
- "/ expr ifTrue:[
- "/ var := super
- "/ ] ifFalse:[
- "/ var := something-else
- "/ ].
- "/ var messageSend
- "/
- "/ does not what a beginner might think.
-
- self isSyntaxHighlighter ifTrue:[
- (expr == #Error) ifTrue:[^ #Error].
- ] ifFalse:[
- warnCommonMistakes ifTrue:[
- (expr ~~ #Error and:[expr isSuper]) ifTrue:[
- self warning:'followup messageSends to `' , var name , ''' will have normal send semantics\(i.e. NO super- or here-sends). Use self to avoid confusion.' withCRs position:pos to:pos2.
- ].
- ].
-
- (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
- expr isVariable ifTrue:[
- expr name = var name ifTrue:[
- self warning:('useless assignment to `' , var name, '''' ) position:pos to:pos2-1.
- ].
- ].
- ].
-
- node := AssignmentNode variable:var expression:expr.
- (lineNumberInfo == #full) ifTrue:[node lineNumber:lnr].
- ^ node
+ ^ self primary_identifier
].
((tokenType == #Integer)
@@ -4855,89 +4626,23 @@
or:[(tokenType == #Character)
or:[(tokenType == #Float)
or:[(tokenType == #Symbol)]]]]) ifTrue:[
- "/
- "/ ImmutableStrings are experimental
- "/
- ((tokenType == #String)
- and:[(StringsAreImmutable == true)
- and:[ImmutableString notNil]]) ifTrue:[
- tokenValue := tokenValue copy.
- tokenValue changeClassTo:ImmutableString.
- token := tokenValue
- ].
- (tokenType == #Symbol) ifTrue:[
- parseForCode ifFalse:[
- self rememberSymbolUsed:tokenValue
- ].
- ].
- val := ConstantNode type:tokenType value:tokenValue.
-
- tokenValue isSymbol ifTrue:[
- self markSymbolFrom:tokenPosition to:tokenPosition+tokenValue size-1.
- ].
-
- self nextToken.
- (self noAssignmentAllowed:'assignment to a constant' at:pos) ifFalse:[
- ^ #Error
- ].
- ^ val
+ ^ self primary_simpleLiteral.
].
(tokenType == #Nil) ifTrue:[
- self nextToken.
- (self noAssignmentAllowed:'assignment to ''nil''' at:pos) ifFalse:[
- ^ #Error
- ].
-"/ self markConstantFrom:pos to:pos+2.
- nilNode isNil ifTrue:[
- nilNode := ConstantNode type:#Nil value:nil
- ].
- ^ nilNode
- ].
-
+ ^ self primary_nil.
+ ].
(tokenType == #True) ifTrue:[
- self nextToken.
- (self noAssignmentAllowed:'assignment to ''true''' at:pos) ifFalse:[
- ^ #Error
- ].
- self markBooleanConstantFrom:pos to:pos+3.
- ^ ConstantNode type:#True value:true
+ ^ self primary_true
].
(tokenType == #False) ifTrue:[
- self nextToken.
- (self noAssignmentAllowed:'assignment to ''false''' at:pos) ifFalse:[
- ^ #Error
- ].
- self markBooleanConstantFrom:pos to:pos+4.
- ^ ConstantNode type:#False value:false
- ].
-
+ ^ self primary_false
+ ].
(tokenType == #Super) ifTrue:[
- usesSuper := true.
- self nextToken.
- (self noAssignmentAllowed:'assignment to pseudo variable ''super''' at:pos) ifFalse:[
- ^ #Error
- ].
- (classToCompileFor isNil or:[classToCompileFor superclass isNil]) ifTrue:[
- self warning:'superclass is (currently ?) nil' position:pos to:(pos + 4).
- ].
- superNode isNil ifTrue:[
- superNode := SuperNode value:selfValue inClass:classToCompileFor
- ].
- self markSelfFrom:pos to:pos+4.
- ^ superNode
- ].
-
+ ^ self primary_super.
+ ].
(tokenType == #Here) ifTrue:[
- self nextToken.
- (self noAssignmentAllowed:'assignment to pseudo variable ''here''' at:pos) ifFalse:[
- ^ #Error
- ].
- classToCompileFor isNil ifTrue:[
- 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
+ ^ self primary_here.
].
(tokenType == #ThisContext) ifTrue:[
@@ -4983,24 +4688,7 @@
].
(tokenType == $() ifTrue:[
- self nextToken.
- val := self expression.
- (val == #Error) ifTrue:[^ #Error].
- (tokenType ~~ $) ) ifTrue:[
- tokenType isCharacter ifTrue:[
- eMsg := 'missing '')'' (i.e. ''' , tokenType asString , ''' unexpected)'.
- ] ifFalse:[
- eMsg := 'missing '')'''.
- ].
- self syntaxError:eMsg withCRs position:pos to:tokenPosition.
- ^ #Error
- ].
- self nextToken.
- (self noAssignmentAllowed:'invalid assignment' at:pos) ifFalse:[
- ^ #Error
- ].
- val parenthized:true.
- ^ val
+ ^ self primary_expression.
].
(tokenType == $[ ) ifTrue:[
@@ -5018,39 +4706,7 @@
self parseError:'non-Standard Squeak extension (enable in settings)' position:pos to:tokenPosition.
^ #Error
].
- self nextToken.
- exprList := self squeakComputedArray.
-
- tokenType ~~ $} ifTrue:[
- self parseError:'''}'' expected' position:tokenPosition.
- ^ #Error
- ].
- self nextToken.
- (self noAssignmentAllowed:'invalid assignment' at:pos) ifFalse:[
- ^ #Error
- ].
-
- "/ make it an array creation expression ...
- expr := MessageNode
- receiver:(VariableNode type:#GlobalVariable name:#Array)
- selector:#new:
- arg:(ConstantNode type:#Integer value:(exprList size)).
-
- exprList size == 0 ifTrue:[
- ^ expr.
- ].
- exprList keysAndValuesDo:[:idx :e |
- expr := (idx == 1 ifTrue:[MessageNode] ifFalse:[CascadeNode])
- receiver:expr
- selector:#at:put:
- arg1:(ConstantNode type:#Integer value:idx)
- arg2:e
- fold:false.
- ].
- expr := CascadeNode
- receiver:expr
- selector:#yourself.
- ^ expr
+ ^ self primary_squeakComputedArray.
].
(tokenType == #Primitive) ifTrue:[
@@ -5061,6 +4717,14 @@
^ node
].
+ tokenType == #HashHashLeftParen ifTrue:[
+ AllowDolphinExtensions ifFalse:[
+ self parseError:'non-Standard Dolphin extension (enable in settings)' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ self primary_dolphinComputedLiteral.
+ ].
+
(tokenType == #Error) ifTrue:[^ #Error].
tokenType isCharacter ifTrue:[
self syntaxError:('error in primary; '
@@ -5084,6 +4748,500 @@
"Modified: / 18.8.2000 / 20:51:22 / cg"
!
+primary_dolphinComputedLiteral
+ "parse a dolphin computed literal; return a node-tree, or raise an Error."
+
+ |pos expr val|
+
+ pos := tokenPosition.
+ self nextToken.
+
+ expr := self expression.
+
+ tokenType ~~ $) ifTrue:[
+ self parseError:''')'' expected' position:tokenPosition.
+ ^ #Error
+ ].
+ self nextToken.
+
+ (self noAssignmentAllowed:'invalid assignment' at:pos) ifFalse:[
+ ^ #Error
+ ].
+
+ val := expr evaluate.
+
+ val isLiteral ifTrue:[
+ val isByteArray ifTrue:[
+ ^ ConstantNode type:#ByteArray value:val
+ ].
+ ] ifFalse:[
+ self parseError:'must be representable as a literal (for now)' position:pos.
+ ^ #Error
+ ].
+self halt.
+"/ "/ make it an array creation expression ...
+"/ expr := MessageNode
+"/ receiver:(VariableNode type:#GlobalVariable name:#Array)
+"/ selector:#new:
+"/ arg:(ConstantNode type:#Integer value:(exprList size)).
+"/
+"/ exprList size == 0 ifTrue:[
+"/ ^ expr.
+"/ ].
+"/ exprList keysAndValuesDo:[:idx :e |
+"/ expr := (idx == 1 ifTrue:[MessageNode] ifFalse:[CascadeNode])
+"/ receiver:expr
+"/ selector:#at:put:
+"/ arg1:(ConstantNode type:#Integer value:idx)
+"/ arg2:e
+"/ fold:false.
+"/ ].
+"/ expr := CascadeNode
+"/ receiver:expr
+"/ selector:#yourself.
+"/ ^ expr
+!
+
+primary_expression
+ "parse a parentized expression primary; return a node-tree, or raise an Error."
+
+ |pos val eMsg|
+
+ pos := tokenPosition.
+
+ self nextToken.
+ val := self expression.
+ (val == #Error) ifTrue:[^ #Error].
+ (tokenType ~~ $) ) ifTrue:[
+ tokenType isCharacter ifTrue:[
+ eMsg := 'missing '')'' (i.e. ''' , tokenType asString , ''' unexpected)'.
+ ] ifFalse:[
+ eMsg := 'missing '')'''.
+ ].
+ self syntaxError:eMsg withCRs position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ self nextToken.
+ (self noAssignmentAllowed:'invalid assignment' at:pos) ifFalse:[
+ ^ #Error
+ ].
+ val parenthized:true.
+ ^ val
+!
+
+primary_false
+ "parse a false primary; return a node-tree, or raise an Error."
+
+ |pos|
+
+ pos := tokenPosition.
+
+ self nextToken.
+ (self noAssignmentAllowed:'assignment to ''false''' at:pos) ifFalse:[
+ ^ #Error
+ ].
+ self markBooleanConstantFrom:pos to:pos+4.
+ ^ ConstantNode type:#False value:false
+!
+
+primary_here
+ "parse a here primary; return a node-tree, nil or #Error."
+
+ |pos|
+
+ pos := tokenPosition.
+
+ self nextToken.
+ (self noAssignmentAllowed:'assignment to pseudo variable ''here''' at:pos) ifFalse:[
+ ^ #Error
+ ].
+ classToCompileFor isNil ifTrue:[
+ 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
+!
+
+primary_identifier
+ "parse a false primary; return a node-tree, or raise an Error."
+
+ |pos pos2 expr name rawName var globlName nameSpace nameSpaceGlobal
+ t cls lnr node|
+
+ pos := tokenPosition.
+
+ name := tokenName.
+
+ var := self variable.
+ "/ errorFlag == true ifTrue:[self halt].
+ (var == #Error) ifTrue:[
+ errorFlag := true
+ ].
+ self nextToken.
+
+ (tokenType == #'::') ifTrue:[
+ globlName := rawName := name.
+
+ "is it in a namespace ?"
+ nameSpace := self findNameSpaceWith:globlName.
+ nameSpace notNil ifTrue:[
+ globlName := nameSpace name , '::' , globlName
+ ].
+
+ [tokenType == #'::'] whileTrue:[
+ nameSpace := globlName.
+
+ self nextToken.
+ (tokenType == #Identifier) ifTrue:[
+ ignoreWarnings ifFalse:[
+ warnSTXNameSpaceUse ifTrue:[
+ self warning:'nameSpaces are a nonstandard feature of ST/X'
+ position:pos to:(source position).
+ "
+ only warn once
+ "
+ warnSTXNameSpaceUse := false
+ ]
+ ].
+ name := tokenName.
+
+ globlName := (nameSpace , '::' , name).
+ rawName := (rawName , '::' , name).
+
+ nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
+ nameSpaceGlobal isNil ifTrue:[
+ warnedUnknownNamespaces isNil ifTrue:[
+ warnedUnknownNamespaces := Set new.
+ ].
+ (warnedUnknownNamespaces includes:nameSpace) ifFalse:[
+ self warning:('unknown nameSpace: ', nameSpace)
+ position:pos to:tokenPosition-1.
+"/ self parseError:('unknown nameSpace: ', nameSpace) position:pos to:tokenPosition-1.
+ warnedUnknownNamespaces add:nameSpace.
+ ]
+ ] ifFalse:[
+ nameSpaceGlobal isNameSpace ifTrue:[
+ "/ for now: only Smalltalk is allowed
+ nameSpaceGlobal ~~ Smalltalk ifTrue:[
+"/ self parseError:('(currently) the only valid nameSpace is `Smalltalk''') position:pos to:tokenPosition-1.
+ ] ifFalse:[
+ globlName := name
+ ].
+ ] ifFalse:[
+ nameSpaceGlobal isBehavior ifFalse:[
+ self parseError:('invalid nameSpace: ' , nameSpace) position:pos to:tokenPosition-1.
+ ] ifTrue:[
+ (nameSpaceGlobal privateClassesAt:name asSymbol) isNil ifTrue:[
+ self warning:('no private class: ' , name , ' in class: ' , nameSpace)
+ position:pos to:tokenPosition-1.
+"/ self parseError:('no private class: ' , name , ' in class: ' , nameSpace) position:pos to:tokenPosition-1.
+ ]
+ ]
+ ].
+ ].
+ self nextToken.
+ ].
+ var := VariableNode type:#GlobalVariable name:globlName asSymbol.
+ parseForCode ifFalse:[self rememberGlobalUsed:globlName].
+ ].
+ self markVariable:var from:pos to:pos + rawName size - 1.
+ ].
+
+ var == #Error ifTrue:[
+ ^ #Error
+ ].
+
+ errorFlag ~~ true ifTrue:[
+ self markVariable:var from:pos to:pos + name size - 1.
+ ].
+ (ignoreErrors or:[ignoreWarnings or:[parseForCode not]]) ifTrue:[
+ errorFlag := false.
+ ].
+
+ ((tokenType ~~ $_) and:[tokenType ~~ #':=']) ifTrue:[
+ parseForCode ifFalse:[
+ var isInstanceVariable ifTrue:[ self rememberInstVarRead:var name].
+ var isClassVariable ifTrue:[ self rememberClassVarRead:var name].
+ ].
+ ^ var
+ ].
+ pos2 := tokenPosition + tokenType size - 1.
+
+ "/ careful: it could already be an implicit self send
+ ImplicitSelfSends ifTrue:[
+ var isMessage ifTrue:[
+ self nextToken.
+ expr := self expression.
+ self isSyntaxHighlighter ifFalse:[
+ (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
+ ].
+ selfNode isNil ifTrue:[
+ selfNode := SelfNode value:selfValue
+ ].
+ ^ MessageNode receiver:selfNode selector:('implicit_' , name , ':') asSymbol arg:expr.
+ ].
+ ].
+
+ (var ~~ #Error) ifTrue:[
+ t := var type.
+ (t ~~ #MethodVariable) ifTrue:[
+ (t == #PrivateClass) ifTrue:[
+ self parseError:'assignment to private class' position:pos to:pos2.
+ ] ifFalse:[
+ (t == #MethodArg) ifTrue:[
+ self parseError:'assignment to method argument' position:pos to:pos2.
+ ] ifFalse:[
+ (t == #BlockArg) ifTrue:[
+ self parseError:'assignment to block argument' position:pos to:pos2.
+ ] ifFalse:[
+ (t == #InstanceVariable) ifTrue:[
+ name := self classesInstVarNames at:(var index).
+
+ "/ ca once did this to `name' and wondered what happened to his class ...
+ "/ (not really a beginners bug, but may happen as a typo or missing local variable;
+ "/ and is hard to track down later)
+
+ warnCommonMistakes ifTrue:[
+ classToCompileFor isMeta ifTrue:[
+ (classToCompileFor isSubclassOf:Class) ifTrue:[
+ (Class allInstVarNames includes:(var name)) ifTrue:[
+ self warning:'assignment to a classInstanceVariable\(see hierarchy of `Class'')' withCRs position:pos to:pos2.
+ ]
+ ]
+ ]
+ ].
+ parseForCode ifFalse:[
+ modifiedInstVars isNil ifTrue:[
+ modifiedInstVars := Set new
+ ].
+ modifiedInstVars add:name
+ ]
+ ] ifFalse:[
+ (t == #ClassVariable) ifTrue:[
+ name := var name.
+ name := name copyFrom:((name indexOf:$:) + 1).
+ parseForCode ifFalse:[
+ modifiedClassVars isNil ifTrue:[
+ modifiedClassVars := Set new
+ ].
+ modifiedClassVars add:name
+ ]
+ ] ifFalse:[
+ (t == #GlobalVariable) ifTrue:[
+ (cls := Smalltalk classNamed:var name) notNil ifTrue:[
+ cls name = var name ifTrue:[
+ self warning:'assignment to global which refers to a class' position:pos to:pos2.
+ ]
+ ].
+ parseForCode ifFalse:[
+ modifiedGlobals isNil ifTrue:[
+ modifiedGlobals := Set new
+ ].
+ modifiedGlobals add:var name
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ t == #MethodVariable ifTrue:[
+ modifiedLocalVars isNil ifTrue:[
+ modifiedLocalVars := Set new.
+ ].
+ modifiedLocalVars add:var name.
+ ].
+ ].
+
+ lnr := tokenLineNr.
+
+ self nextToken.
+ pos2 := tokenPosition.
+ expr := self expression.
+
+ "/ a typical beginner error:
+ "/ expr ifTrue:[
+ "/ var := super
+ "/ ] ifFalse:[
+ "/ var := something-else
+ "/ ].
+ "/ var messageSend
+ "/
+ "/ does not what a beginner might think.
+
+ self isSyntaxHighlighter ifTrue:[
+ (expr == #Error) ifTrue:[^ #Error].
+ ] ifFalse:[
+ warnCommonMistakes ifTrue:[
+ (expr ~~ #Error and:[expr isSuper]) ifTrue:[
+ self warning:'followup messageSends to `' , var name , ''' will have normal send semantics\(i.e. NO super- or here-sends). Use self to avoid confusion.' withCRs position:pos to:pos2.
+ ].
+ ].
+
+ (errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
+ expr isVariable ifTrue:[
+ expr name = var name ifTrue:[
+ self warning:('useless assignment to `' , var name, '''' ) position:pos to:pos2-1.
+ ].
+ ].
+ ].
+
+ node := AssignmentNode variable:var expression:expr.
+ (lineNumberInfo == #full) ifTrue:[node lineNumber:lnr].
+ ^ node
+!
+
+primary_nil
+ "parse a nil primary; return a node-tree, nil or #Error."
+
+ |pos|
+
+ pos := tokenPosition.
+
+ self nextToken.
+ (self noAssignmentAllowed:'assignment to ''nil''' at:pos) ifFalse:[
+ ^ #Error
+ ].
+"/ self markConstantFrom:pos to:pos+2.
+ nilNode isNil ifTrue:[
+ nilNode := ConstantNode type:#Nil value:nil
+ ].
+ ^ nilNode
+!
+
+primary_self
+ "parse a self primary; return a node-tree, nil or #Error."
+
+ |pos|
+
+ pos := tokenPosition.
+
+ self nextToken.
+ (self noAssignmentAllowed:'assignment to pseudo variable ''self''' at:pos) ifFalse:[
+ ^ ParseError raise
+ ].
+ selfNode isNil ifTrue:[
+ selfNode := SelfNode value:selfValue
+ ].
+ self markSelfFrom:pos to:pos+3.
+ ^ selfNode
+!
+
+primary_simpleLiteral
+ "parse a simple literal primary; return a node-tree, or raise an Error."
+
+ |pos val|
+
+ pos := tokenPosition.
+
+ "/
+ "/ ImmutableStrings are experimental
+ "/
+ ((tokenType == #String)
+ and:[(StringsAreImmutable == true)
+ and:[ImmutableString notNil]]) ifTrue:[
+ tokenValue := tokenValue copy.
+ tokenValue changeClassTo:ImmutableString.
+ token := tokenValue
+ ].
+ (tokenType == #Symbol) ifTrue:[
+ parseForCode ifFalse:[
+ self rememberSymbolUsed:tokenValue
+ ].
+ ].
+ val := ConstantNode type:tokenType value:tokenValue.
+
+ tokenValue isSymbol ifTrue:[
+ self markSymbolFrom:tokenPosition to:tokenPosition+tokenValue size-1.
+ ].
+
+ self nextToken.
+ (self noAssignmentAllowed:'assignment to a constant' at:pos) ifFalse:[
+ ^ #Error
+ ].
+ ^ val
+!
+
+primary_squeakComputedArray
+ "parse a squeak computed array literal; return a node-tree, or raise an Error."
+
+ |pos exprList expr|
+
+ pos := tokenPosition.
+
+ self nextToken.
+ exprList := self squeakComputedArray.
+
+ tokenType ~~ $} ifTrue:[
+ self parseError:'''}'' expected' position:tokenPosition.
+ ^ #Error
+ ].
+ self nextToken.
+ (self noAssignmentAllowed:'invalid assignment' at:pos) ifFalse:[
+ ^ #Error
+ ].
+
+ "/ make it an array creation expression ...
+ expr := MessageNode
+ receiver:(VariableNode type:#GlobalVariable name:#Array)
+ selector:#new:
+ arg:(ConstantNode type:#Integer value:(exprList size)).
+
+ exprList size == 0 ifTrue:[
+ ^ expr.
+ ].
+ exprList keysAndValuesDo:[:idx :e |
+ expr := (idx == 1 ifTrue:[MessageNode] ifFalse:[CascadeNode])
+ receiver:expr
+ selector:#at:put:
+ arg1:(ConstantNode type:#Integer value:idx)
+ arg2:e
+ fold:false.
+ ].
+ expr := CascadeNode
+ receiver:expr
+ selector:#yourself.
+ ^ expr
+!
+
+primary_super
+ "parse a super primary; return a node-tree, nil or #Error."
+
+ |pos|
+
+ pos := tokenPosition.
+
+ usesSuper := true.
+ self nextToken.
+ (self noAssignmentAllowed:'assignment to pseudo variable ''super''' at:pos) ifFalse:[
+ ^ #Error
+ ].
+ (classToCompileFor isNil or:[classToCompileFor superclass isNil]) ifTrue:[
+ self warning:'superclass is (currently ?) nil' position:pos to:(pos + 4).
+ ].
+ superNode isNil ifTrue:[
+ superNode := SuperNode value:selfValue inClass:classToCompileFor
+ ].
+ self markSelfFrom:pos to:pos+4.
+ ^ superNode
+!
+
+primary_true
+ "parse a true primary; return a node-tree, or raise an Error."
+
+ |pos|
+
+ pos := tokenPosition.
+
+ self nextToken.
+ (self noAssignmentAllowed:'assignment to ''true''' at:pos) ifFalse:[
+ ^ #Error
+ ].
+ self markBooleanConstantFrom:pos to:pos+3.
+ ^ ConstantNode type:#True value:true
+!
+
qualifiedName
"a vw3.x (and later) feature: QualifiedName is #{ id ... id }
and mapped to a global variable here.
@@ -6120,6 +6278,6 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.319 2001-11-27 18:04:03 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.320 2001-12-03 15:31:36 cg Exp $'
! !
Parser initialize!