hg/stx-libcomp: comparison Parser.st

equal deleted inserted replaced

-:b9c13d91d6fe
+:1f8f2e633587
 class setSuperclass: InlineObject.
 class setInstanceVariableString:(names asStringWith:Character space).
 class instSize: names size.
 names keysAndValuesDo:[:idx :instVarName |
-	idx <= InlineObjectPrototype instSize ifTrue:[
+idx <= InlineObjectPrototype instSize ifTrue:[
-	    class basicAddSelector:(instVarName asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1' bindWith:idx) asSymbol).
+class basicAddSelector:(instVarName asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1' bindWith:idx) asSymbol).
-	    inlineObjectsAreReadonly ifFalse:[
+inlineObjectsAreReadonly ifFalse:[
-		class basicAddSelector:((instVarName,':') asSymbol) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1:' bindWith:idx) asSymbol).
+class basicAddSelector:(instVarName asMutator) withMethod:(InlineObjectPrototype compiledMethodAt:('i%1:' bindWith:idx) asSymbol).
-	    ].
+].
-	] ifFalse:[
+] ifFalse:[
-	    Class withoutUpdatingChangesDo:[
+Class withoutUpdatingChangesDo:[
-		Compiler compile:('%1 ^%1' bindWith:instVarName) forClass:class.
+Compiler compile:('%1 ^%1' bindWith:instVarName) forClass:class.
-		inlineObjectsAreReadonly ifFalse:[
+inlineObjectsAreReadonly ifFalse:[
-		    Compiler compile:('%1:something %1 := something' bindWith:instVarName) forClass:class.
+Compiler compile:('%1:something %1 := something' bindWith:instVarName) forClass:class.
-		].
+].
-	    ].
+].
-	].
+].
 ].
 instance := class new.
 1 to:names size do:[:idx | instance instVarAt:idx put:(values at:idx) ].
 ^ instance
 (self isDoIt
 and:[ currentBlock isNil
 and:[ requestor notNil
 and:[ (autoHow := requestor perform:#autoDefineVariables ifNotUnderstood:nil) notNil]]]) ifTrue:[
-	var := self variableOrError:varName.
+var := self variableOrError:varName.
-	self nextToken.
+self nextToken.
-	(var == #Error) ifTrue:[
+(var == #Error) ifTrue:[
-	    ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
-		autoHow == #workspace ifTrue:[
+autoHow == #workspace ifTrue:[
-		    holder := Workspace addWorkspaceVariable:varName.
+holder := Workspace addWorkspaceVariable:varName.
-		    var := VariableNode type:#WorkspaceVariable holder:holder name:varName.
+var := VariableNode type:#WorkspaceVariable holder:holder name:varName.
-		] ifFalse:[
+] ifFalse:[
-		    holder := self addDoItTemporary:varName.
+holder := self addDoItTemporary:varName.
-		    var := VariableNode type:#DoItTemporary holder:holder name:varName.
+var := VariableNode type:#DoItTemporary holder:holder name:varName.
-		].
+].
-	    ] ifFalse:[
+] ifFalse:[
-		var := self correctVariable:varName atPosition:pos1 to:pos2.
+var := self correctVariable:varName atPosition:pos1 to:pos2.
-	    ].
+].
-	    var startPosition: pos1 endPosition: pos2.
+var startPosition: pos1 endPosition: pos2.
-	]
+]
 ] ifFalse:[
-	var := self variable.
+var := self variable.
-	self nextToken.
+self nextToken.
 ].
 "/ errorFlag == true ifTrue:[self halt].
 (var == #Error) ifTrue:[
-	errorFlag := true
+errorFlag := true
 ].
 (tokenType == #'::') ifTrue:[
-	globlName := rawName := varName.
+globlName := rawName := varName.
-	"is it in a namespace ?"
+"is it in a namespace ?"
-	nameSpace := self findNameSpaceWith:globlName.
+nameSpace := self findNameSpaceWith:globlName.
-	nameSpace notNil ifTrue:[
+nameSpace notNil ifTrue:[
-	    globlName := nameSpace name , '::' , globlName
+globlName := nameSpace name , '::' , globlName
-	].
+].
-	[tokenType == #'::'] whileTrue:[
+[tokenType == #'::'] whileTrue:[
-	    nameSpace := globlName.
+nameSpace := globlName.
-	    self nextToken.
+self nextToken.
-	    (tokenType == #Identifier) ifTrue:[
+(tokenType == #Identifier) ifTrue:[
-		self warnSTXNameSpaceUseAt:pos1.
+self warnSTXNameSpaceUseAt:pos1.
-		varName := tokenName.
+varName := tokenName.
-		globlName := (nameSpace , '::' , varName).
+globlName := (nameSpace , '::' , varName).
-		rawName := (rawName , '::' , varName).
+rawName := (rawName , '::' , varName).
-		nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
+nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
-		nameSpaceGlobal isNil ifTrue:[
+nameSpaceGlobal isNil ifTrue:[
-		    warnedUnknownNamespaces isNil ifTrue:[
+warnedUnknownNamespaces isNil ifTrue:[
-			warnedUnknownNamespaces := Set new.
+warnedUnknownNamespaces := Set new.
-		    ].
+].
-		    (warnedUnknownNamespaces includes:nameSpace) ifFalse:[
+(warnedUnknownNamespaces includes:nameSpace) ifFalse:[
 "/ not needed; already warned.
 "/                        "correctIt :=" requestor
 "/                                        correctableError:('Unknown nameSpace: "', nameSpace,'"')
 "/                                        position:pos1 to:tokenPosition-1 from:self.
 "/                        self warning:('unknown nameSpace: ', nameSpace)
 "/                             position:pos1 to:tokenPosition-1.
 "/                            self parseError:('unknown nameSpace: ', nameSpace) position:pos to:tokenPosition-1.
-			warnedUnknownNamespaces add:nameSpace.
+warnedUnknownNamespaces add:nameSpace.
-		    ]
+]
-		] ifFalse:[
+] ifFalse:[
-		    nameSpaceGlobal isNameSpace ifTrue:[
+nameSpaceGlobal isNameSpace ifTrue:[
-			"/ for now: only Smalltalk is allowed
+"/ for now: only Smalltalk is allowed
-			nameSpaceGlobal ~~ Smalltalk ifTrue:[
+nameSpaceGlobal ~~ Smalltalk ifTrue:[
 "/                                self parseError:('(currently) the only valid nameSpace is `Smalltalk''') position:pos to:tokenPosition-1.
-			] ifFalse:[
+] ifFalse:[
-			    globlName := varName
+globlName := varName
-			].
+].
-		    ] ifFalse:[
+] ifFalse:[
-			nameSpaceGlobal isBehavior ifFalse:[
+nameSpaceGlobal isBehavior ifFalse:[
-			    self parseError:('invalid nameSpace: ' , nameSpace)  position:pos1 to:tokenPosition-1.
+self parseError:('invalid nameSpace: ' , nameSpace)  position:pos1 to:tokenPosition-1.
-			] ifTrue:[
+] ifTrue:[
-			    nameSpaceGlobal isLoaded ifTrue:[
+nameSpaceGlobal isLoaded ifTrue:[
-				(nameSpaceGlobal privateClassesAt:varName asSymbol) isNil ifTrue:[
+(nameSpaceGlobal privateClassesAt:varName asSymbol) isNil ifTrue:[
-				    (Smalltalk at:rawName asSymbol) notNil ifTrue:[
+(Smalltalk at:rawName asSymbol) notNil ifTrue:[
-					self warning:('Possible name clash (global: ' , rawName , ' vs. private: ' , (nameSpace , '::', varName) , ') - assume globl.')
+self warning:('Possible name clash (global: ' , rawName , ' vs. private: ' , (nameSpace , '::', varName) , ') - assume globl.')
-					     position:pos1 to:source position "tokenPosition-1".
+position:pos1 to:source position "tokenPosition-1".
-					globlName := rawName asSymbol.
+globlName := rawName asSymbol.
-				    ] ifFalse:[
+] ifFalse:[
-					self warning:('no private class: ' , varName allBold , ' in class: ' , nameSpace)
+self warning:('no private class: ' , varName allBold , ' in class: ' , nameSpace)
-					     position:pos1 to:source position "tokenPosition-1".
+position:pos1 to:source position "tokenPosition-1".
 "/                                        self parseError:('no private class: ' , name , ' in class: ' , nameSpace)  position:pos to:tokenPosition-1.
-				    ]
+]
-				] ifFalse:[
+] ifFalse:[
-				    "/ reference to a private class
+"/ reference to a private class
-				    (classToCompileFor notNil and:[nameSpaceGlobal ~~ classToCompileFor theNonMetaclass]) ifTrue:[
+(classToCompileFor notNil and:[nameSpaceGlobal ~~ classToCompileFor theNonMetaclass]) ifTrue:[
-					self classToCompileFor notNil ifTrue:[
+self classToCompileFor notNil ifTrue:[
-					    self isDoIt ifFalse:[
+self isDoIt ifFalse:[
-						parserFlags warnAboutReferenceToPrivateClass ifTrue:[
+parserFlags warnAboutReferenceToPrivateClass ifTrue:[
-						    self warning:('Referring to private class ''' , varName allBold , ''' here.')
+self warning:('Referring to private class ''' , varName allBold , ''' here.')
-							 doNotShowAgainAction:[ ParserFlags warnAboutReferenceToPrivateClass:false.
+doNotShowAgainAction:[ ParserFlags warnAboutReferenceToPrivateClass:false.
-										parserFlags warnAboutReferenceToPrivateClass:false. ]
+parserFlags warnAboutReferenceToPrivateClass:false. ]
-							 position:pos1 to:source position " tokenPosition-1".
+position:pos1 to:source position " tokenPosition-1".
-						].
+].
-						Tools::ToDoListBrowser notNil ifTrue:[
+Tools::ToDoListBrowser notNil ifTrue:[
-						    self
+self
-							notifyTodo:('Referring to private class ''' , varName allBold , ''' here.') position:pos1
+notifyTodo:('Referring to private class ''' , varName allBold , ''' here.') position:pos1
-							className:(self classToCompileFor name) selector:selector
+className:(self classToCompileFor name) selector:selector
-							severity:#warning priority:#medium
+severity:#warning priority:#medium
-							equalityParameter:nil
+equalityParameter:nil
-							checkAction:nil.
+checkAction:nil.
-						].
+].
-					    ].
+].
-					].
+].
-				    ]
+]
-				].
+].
-			    ]
+]
-			]
+]
-		    ].
+].
-		].
+].
-		pos2 := source position.
+pos2 := source position.
-		self nextToken.
+self nextToken.
-	    ].
+].
-	    var := VariableNode globalNamed:globlName.
+var := VariableNode globalNamed:globlName.
-	    var startPosition: pos1 endPosition: pos2.
+var startPosition: pos1 endPosition: pos2.
-	    parseForCode ifFalse:[self rememberGlobalUsed:globlName].
+parseForCode ifFalse:[self rememberGlobalUsed:globlName].
-	].
+].
-	self markVariable:var from:pos1 to:pos1 + rawName size - 1 assigned:false.
+self markVariable:var from:pos1 to:pos1 + rawName size - 1 assigned:false.
 ].
 var == #Error ifTrue:[
-	^ #Error
+^ #Error
 ].
 "/    errorFlag ~~ true ifTrue:[
 "/        self markVariable:var from:pos1 to:pos1 + varName size - 1.
 "/    ].
 (ignoreErrors or:[parseForCode not and:[ignoreWarnings]]) ifTrue:[
-	errorFlag := false.
+errorFlag := false.
 ].
 ((tokenType ~~ $_) and:[tokenType ~~ #':=']) ifTrue:[
-	parseForCode ifFalse:[
+parseForCode ifFalse:[
-	    var isInstanceVariable ifTrue:[ self rememberInstVarRead:var name].
+var isInstanceVariable ifTrue:[ self rememberInstVarRead:var name].
-	    var isClassVariable ifTrue:[ self rememberClassVarRead:var name].
+var isClassVariable ifTrue:[ self rememberClassVarRead:var name].
-	    var isPoolVariable ifTrue:[ self rememberPoolVarRead:var name].
+var isPoolVariable ifTrue:[ self rememberPoolVarRead:var name].
-	    var isGlobalVariable ifTrue:[ self rememberGlobalRead:var name].
+var isGlobalVariable ifTrue:[ self rememberGlobalRead:var name].
-	].
+].
-	^ var
+^ var
 ].
 "/ assignment...
 (usedGlobals notNil and:[usedGlobals includes:(Smalltalk undeclaredPrefix,var name)]) ifFalse:[
-	self markAssignedVariable:var from:pos1 to:pos1 + var name size - 1.
+self markAssignedVariable:var from:pos1 to:pos1 + var name size - 1.
 ].
 "/ careful: it could already be an implicit self send
 parserFlags implicitSelfSends ifTrue:[
-	var isMessage ifTrue:[
+var isMessage ifTrue:[
-	    self nextToken.
+self nextToken.
-	    expr := self expression.
+expr := self expression.
-	    self isSyntaxHighlighter ifFalse:[
+self isSyntaxHighlighter ifFalse:[
-		(errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
+(errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
-	    ].
+].
-	    ^ MessageNode receiver:(self selfNode) selector:('__' , varName , ':') asSymbol arg:expr.
+^ MessageNode receiver:(self selfNode) selector:('__' , varName) asMutator arg:expr.
-	].
+].
 ].
 assignmentAllowed := true.
 (var ~~ #Error) ifTrue:[
-	t := var type.
+t := var type.
-	t == #MethodVariable ifTrue:[
+t == #MethodVariable ifTrue:[
-	    self rememberLocalModified:var name.
+self rememberLocalModified:var name.
-	] ifFalse:[ (t == #InstanceVariable) ifTrue:[
+] ifFalse:[ (t == #InstanceVariable) ifTrue:[
-	    varName := self classesInstVarNames at:(var index).
+varName := self classesInstVarNames at:(var index).
-	    classToCompileFor isMeta ifTrue:[
+classToCompileFor isMeta ifTrue:[
-		"/ ca once assigned to "name" on the class side and wondered what happened to his class ...
+"/ ca once assigned to "name" on the class side and wondered what happened to his class ...
-		"/ (not really a beginners bug, but may happen as a typo or missing local variable;
+"/ (not really a beginners bug, but may happen as a typo or missing local variable;
-		"/  and is hard to track down later)
+"/  and is hard to track down later)
-		ignoreWarnings ifFalse:[
+ignoreWarnings ifFalse:[
-		    parserFlags warnings ifTrue:[
+parserFlags warnings ifTrue:[
-			parserFlags warnCommonMistakes ifTrue:[
+parserFlags warnCommonMistakes ifTrue:[
-			    (classToCompileFor isSubclassOf:Class) ifTrue:[
+(classToCompileFor isSubclassOf:Class) ifTrue:[
-				(Class allInstVarNames includes:(var name)) ifTrue:[
+(Class allInstVarNames includes:(var name)) ifTrue:[
-				    self warning:'assignment to a classInstanceVariable\(see hierarchy of "Class")' withCRs position:pos1 to:pos2.
+self warning:'assignment to a classInstanceVariable\(see hierarchy of "Class")' withCRs position:pos1 to:pos2.
-				]
+]
-			    ]
+]
-			]
+]
-		    ].
+].
-		].
+].
-	    ].
+].
-	    parseForCode ifFalse:[
+parseForCode ifFalse:[
-		self rememberInstVarModified:varName
+self rememberInstVarModified:varName
-	    ]
+]
-	] ifFalse:[ (t == #ClassVariable) ifTrue:[
+] ifFalse:[ (t == #ClassVariable) ifTrue:[
-	    varName := var name.
+varName := var name.
-	    varName := varName copyFrom:((varName indexOf:$:) + 1).
+varName := varName copyFrom:((varName indexOf:$:) + 1).
-	    parseForCode ifFalse:[
+parseForCode ifFalse:[
-		self rememberClassVarModified:varName
+self rememberClassVarModified:varName
-	    ]
+]
-	] ifFalse:[ (t == #GlobalVariable) ifTrue:[
+] ifFalse:[ (t == #GlobalVariable) ifTrue:[
-	    (cls := Smalltalk classNamed:var name) notNil ifTrue:[
+(cls := Smalltalk classNamed:var name) notNil ifTrue:[
-		cls name = var name ifTrue:[
+cls name = var name ifTrue:[
-		    self warning:'assignment to global which refers to a class' position:pos1 to:pos2.
+self warning:'assignment to global which refers to a class' position:pos1 to:pos2.
-		]
+]
-	    ].
+].
-	    parseForCode ifFalse:[
+parseForCode ifFalse:[
-		self rememberGlobalModified:var name
+self rememberGlobalModified:var name
-	    ]
+]
-	] ifFalse:[
+] ifFalse:[
-	    (t == #PrivateClass) ifTrue:[
+(t == #PrivateClass) ifTrue:[
-		assignmentAllowed := false.
+assignmentAllowed := false.
-		self parseError:'assignment to private class' position:pos1 to:pos2.
+self parseError:'assignment to private class' position:pos1 to:pos2.
-	    ] ifFalse:[ (t == #MethodArg) ifTrue:[
+] ifFalse:[ (t == #MethodArg) ifTrue:[
-		(assignmentAllowed := parserFlags allowAssignmentToMethodArgument) ifTrue:[
+(assignmentAllowed := parserFlags allowAssignmentToMethodArgument) ifTrue:[
-		    parserFlags warnAssignmentToMethodArgument ifTrue:[
+parserFlags warnAssignmentToMethodArgument ifTrue:[
-			DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
-			    parserFlags warnAssignmentToMethodArgument:false.
+parserFlags warnAssignmentToMethodArgument:false.
-			    parserFlags warnAssignmentToMethodArgument:false.
+parserFlags warnAssignmentToMethodArgument:false.
-			    ex proceed.
+ex proceed.
-			] do:[
+] do:[
-			    self warning:'assignment to method argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
+self warning:'assignment to method argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
-			]
+]
-		    ]
+]
-		] ifFalse:[
+] ifFalse:[
-		    DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
-			parserFlags allowAssignmentToMethodArgument:true.
+parserFlags allowAssignmentToMethodArgument:true.
-			ParserFlags allowAssignmentToMethodArgument:true.
+ParserFlags allowAssignmentToMethodArgument:true.
-			ex proceed.
+ex proceed.
-		    ] do:[
+] do:[
-			self parseError:'assignment to method argument.' withCRs position:pos1 to:pos2.
+self parseError:'assignment to method argument.' withCRs position:pos1 to:pos2.
-			errorFlag := false. "ok, user wants it - so he'll get it"
+errorFlag := false. "ok, user wants it - so he'll get it"
-			assignmentAllowed := true.  "/ if proceeded
+assignmentAllowed := true.  "/ if proceeded
-		    ].
+].
-		]
+]
-	    ] ifFalse:[ (t == #BlockArg) ifTrue:[
+] ifFalse:[ (t == #BlockArg) ifTrue:[
-		(assignmentAllowed := parserFlags allowAssignmentToBlockArgument) ifTrue:[
+(assignmentAllowed := parserFlags allowAssignmentToBlockArgument) ifTrue:[
-		    parserFlags warnAssignmentToBlockArgument ifTrue:[
+parserFlags warnAssignmentToBlockArgument ifTrue:[
-			DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
-			    parserFlags warnAssignmentToBlockArgument:false.
+parserFlags warnAssignmentToBlockArgument:false.
-			    parserFlags warnAssignmentToBlockArgument:false.
+parserFlags warnAssignmentToBlockArgument:false.
-			    ex proceed.
+ex proceed.
-			] do:[
+] do:[
-			    self warning:'assignment to block argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
+self warning:'assignment to block argument.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
-			]
+]
-		    ].
+].
-		] ifFalse:[
+] ifFalse:[
-		    DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
-			parserFlags allowAssignmentToBlockArgument:true.
+parserFlags allowAssignmentToBlockArgument:true.
-			ParserFlags allowAssignmentToBlockArgument:true.
+ParserFlags allowAssignmentToBlockArgument:true.
-			ex proceed.
+ex proceed.
-		    ] do:[
+] do:[
-			self parseError:'assignment to block argument.' position:pos1 to:pos2.
+self parseError:'assignment to block argument.' position:pos1 to:pos2.
-		    ]
+]
-		].
+].
-		errorFlag := false. "ok, user wants it - so he'll get it"
+errorFlag := false. "ok, user wants it - so he'll get it"
-		assignmentAllowed := true.  "/ if proceeded
+assignmentAllowed := true.  "/ if proceeded
-	    ] ifFalse:[ (t == #PoolVariable) ifTrue:[
+] ifFalse:[ (t == #PoolVariable) ifTrue:[
-		self isDoIt ifTrue:[
+self isDoIt ifTrue:[
-		    self warning:'assignment to pool variable.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
+self warning:'assignment to pool variable.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
-		    assignmentAllowed := true.
+assignmentAllowed := true.
-		] ifFalse:[
+] ifFalse:[
-		    (assignmentAllowed := parserFlags allowAssignmentToPoolVariable) ifTrue:[
+(assignmentAllowed := parserFlags allowAssignmentToPoolVariable) ifTrue:[
-			parserFlags warnAssignmentToPoolVariable ifTrue:[
+parserFlags warnAssignmentToPoolVariable ifTrue:[
-			    DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
-				parserFlags warnAssignmentToPoolVariable:false.
+parserFlags warnAssignmentToPoolVariable:false.
-				ParserFlags warnAssignmentToPoolVariable:false.
+ParserFlags warnAssignmentToPoolVariable:false.
-				ex proceed.
+ex proceed.
-			    ] do:[
+] do:[
-				self warning:'assignment to pool variable.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
+self warning:'assignment to pool variable.\\Not all Smalltalk dialects allow this.' withCRs position:pos1 to:pos2.
-			    ]
+]
-			]
+]
-		    ] ifFalse:[
+] ifFalse:[
-			DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
+DoNotShowCompilerWarningAgainActionQuery handle:[:ex |
-			    parserFlags allowAssignmentToPoolVariable:true.
+parserFlags allowAssignmentToPoolVariable:true.
-			    ParserFlags allowAssignmentToPoolVariable:true.
+ParserFlags allowAssignmentToPoolVariable:true.
-			    ex proceed.
+ex proceed.
-			] do:[
+] do:[
-			    self parseError:'assignment to pool variable' position:pos1 to:pos2.
+self parseError:'assignment to pool variable' position:pos1 to:pos2.
-			].
+].
-			errorFlag := false. "ok, user wants it - so he'll get it"
+errorFlag := false. "ok, user wants it - so he'll get it"
-			assignmentAllowed := true. "/ if proceeded
+assignmentAllowed := true. "/ if proceeded
-			parseForCode ifFalse:[
+parseForCode ifFalse:[
-			    self rememberPoolVarModified:var name
+self rememberPoolVarModified:var name
-			]
+]
-		    ].
+].
-		]
+]
-	    ]]]]]]]
+]]]]]]]
-	].
+].
 ].
 lnr := tokenLineNr.
 self nextToken.
 "/   var messageSend
 "/
 "/   does not what a beginner might think.
 self isSyntaxHighlighter ifTrue:[
-	(expr == #Error) ifTrue:[^ #Error].
+(expr == #Error) ifTrue:[^ #Error].
 ] ifFalse:[
-	(errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
+(errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
-	(ignoreWarnings not
+(ignoreWarnings not
-	and:[ parserFlags warnings ]) ifTrue:[
+and:[ parserFlags warnings ]) ifTrue:[
-	    parserFlags warnCommonMistakes ifTrue:[
+parserFlags warnCommonMistakes ifTrue:[
-		(expr ~~ #Error and:[expr isSuper]) ifTrue:[
+(expr ~~ #Error and:[expr isSuper]) ifTrue:[
-		    self warning:'followup messageSends to "' , var name , '" will have normal send semantics\(i.e. NO super- or here-sends). Use self to avoid confusion.' withCRs position:pos1 to:pos2.
+self warning:'followup messageSends to "' , var name , '" will have normal send semantics\(i.e. NO super- or here-sends). Use self to avoid confusion.' withCRs position:pos1 to:pos2.
-		].
+].
-	    ].
+].
-	    expr isVariable ifTrue:[
+expr isVariable ifTrue:[
-		expr name = var name ifTrue:[
+expr name = var name ifTrue:[
-		    self warning:('useless assignment to "' , var name, '"' ) position:pos1 to:pos2-1.
+self warning:('useless assignment to "' , var name, '"' ) position:pos1 to:pos2-1.
-		].
+].
-	    ].
+].
-	].
+].
 ].
 assignmentAllowed ifTrue:[
-	node := AssignmentNode variable:var expression:expr.
+node := AssignmentNode variable:var expression:expr.
-	parserFlags fullLineNumberInfo ifTrue:[node lineNumber:lnr].
+parserFlags fullLineNumberInfo ifTrue:[node lineNumber:lnr].
-	node := self assignmentRewriteHookFor:node.
+node := self assignmentRewriteHookFor:node.
 ] ifFalse:[
-	self parseError:('assignment to "' , var name, '" suppressed' ) position:pos1 to:pos2-1.
+self parseError:('assignment to "' , var name, '" suppressed' ) position:pos1 to:pos2-1.
-	node := expr.
+node := expr.
 ].
 ^ node
 "Modified: / 20-08-2011 / 23:32:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 "Modified: / 05-10-2011 / 15:36:55 / az"
 |type flagValue|
 type := token.
 type ~= 'pragma:' ifTrue:[
-	self parseError:'pragma expected'.
+self parseError:'pragma expected'.
-	^ #self
+^ #self
 ].
 self nextToken.
 ((token = '+') or:[token = '-']) ifTrue:[
-	flagValue := (token = '+').
+flagValue := (token = '+').
-	self nextToken.
+self nextToken.
-	(tokenType == #Identifier) ifTrue:[
+(tokenType == #Identifier) ifTrue:[
-	    token = 'arrayIndexSyntaxExtension' ifTrue:[
+token = 'arrayIndexSyntaxExtension' ifTrue:[
-		parserFlags perform:('allow',token asUppercaseFirst,':') asSymbol with:flagValue.
+parserFlags perform:('allow',token asUppercaseFirst) asMutator with:flagValue.
-		self nextToken.
+self nextToken.
-		self checkForClosingAngle.
+self checkForClosingAngle.
-		^ self.
+^ self.
-	    ].
+].
-	].
+].
-	self breakPoint:#cg.
+self breakPoint:#cg.
-	self parseError:'unknown pragma'.
+self parseError:'unknown pragma'.
-	^  self
+^  self
 ].
 self parseError:'+/- expected'.
 ^ self
 !
 ! !
 !Parser class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.813 2014-03-05 16:25:03 cg Exp $'
+^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.814 2014-03-05 22:12:46 cg Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.813 2014-03-05 16:25:03 cg Exp $'
+^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.814 2014-03-05 22:12:46 cg Exp $'
 !
 version_SVN
 ^ '$ Id $'
 ! !

changeset 3402	1f8f2e633587
parent 3400	d8fc074a046c
child 3404	f181370f72db