--- a/Parser.st Fri Nov 15 16:21:35 2002 +0100
+++ b/Parser.st Mon Nov 18 11:06:45 2002 +0100
@@ -29,7 +29,7 @@
endOfSelectorPosition startOfBlockPosition primitiveContextInfo
usedLocalVars modifiedLocalVars alreadyWarnedUninitializedVars
alreadyWarnedUnimplementedSelectors returnedValues currentPackage
- doItTemporaries'
+ doItTemporaries inFunctionCallArgument'
classVariableNames:'PrevClass PrevInstVarNames PrevClassVarNames
PrevClassInstVarNames LazyCompilation ArraysAreImmutable
ImplicitSelfSends WarnST80Directives WarnUnusedVars FoldConstants
@@ -2570,40 +2570,16 @@
^ nil
!
-correctVariable
+correctVariable:varName atPosition:pos1 to:pos2
"notify error and correct if user wants to;
return #Error if there was no correction
or a ParseNode as returned by variable"
- |correctIt varName suggestedNames newName pos1 pos2 rslt
- varNameIsLowercase undeclared boldName holder|
-
- pos1 := tokenPosition.
- varName := tokenName.
- pos2 := pos1 + varName size - 1.
+ |correctIt suggestedNames newName rslt
+ varNameIsLowercase undeclared boldName|
varNameIsLowercase := (varName at:1) isLowercase.
-"OLD:
- varNameIsLowercase ifTrue:[
- correctIt := self undefError:varName position:pos1 to:pos2.
- correctIt ifFalse:[^ #Error]
- ] ifFalse:[
- correctIt := self warning:('''' , varName , ''' is undefined') position:pos1 to:pos2.
- correctIt ifFalse:[
- ^ VariableNode globalNamed:varName
- ]
- ].
-"
- (selector isNil or:[selector == #doIt]) ifTrue:[
- (requestor askFor:#isWorkspace) ifTrue:[
- UserPreferences current autoDefineWorkspaceVariables ifTrue:[
- holder := Workspace addWorkspaceVariable:varName.
- ^ VariableNode type:#WorkspaceVariable holder:holder name:varName
- ]
- ]
- ].
-
correctIt := self undefError:varName position:pos1 to:pos2.
(correctIt == false or:[correctIt == #continue]) ifTrue:[
"/ no correction wanted.
@@ -2998,26 +2974,14 @@
err := self checkSelector:sym inClass:selClass.
].
- receiver isConstant ifTrue:[
- "
- if the receiver is a constant, we can check if it responds
- to this selector
- "
+ (receiver isConstant or:[receiver isBlock]) ifTrue:[
err notNil ifTrue:[
- err := err, ' (message to ' , selClass nameWithArticle , ')'.
- ].
- ] ifFalse:[receiver isBlock ifTrue:[
- "/ this should help with typos, sending #ifTrue to blocks ...
- err notNil ifTrue:[
- err := err, ' (message to ' , selClass nameWithArticle , ')'.
+ err := err, ' in ' , selClass name , ' or any of its superclasses'.
].
] ifFalse:[(((recType := receiver type) == #GlobalVariable)
or:[recType == #PrivateClass]) ifTrue:[
- "if the receiver is a global, we check it too ..."
-
rec := receiver evaluate.
- "/ dont check autoloaded classes
- "/ - it may work after loading
+ "/ dont check autoloaded classes - it may work after loading
(rec isNil
or:[rec isBehavior and:[rec isLoaded not]]) ifTrue:[
^ aSelectorString
@@ -3032,7 +2996,6 @@
]
].
] ifFalse:[receiver isSuper ifTrue:[
- "if its a super- or here-send, we can do more checking"
receiver isHere ifFalse:[
err notNil ifTrue:[
err := err, ' in superclass chain'.
@@ -3103,7 +3066,7 @@
err notNil ifTrue:[
err := err, ' (message to ' , selClass nameWithArticle , ')'.
].
- ]]]]]]].
+ ]]]]]].
]
].
@@ -3127,7 +3090,7 @@
].
].
Text notNil ifTrue:[
- err := aSelectorString allItalic, ' ', err
+ err := '"' , aSelectorString allBold "allItalic" , '" ', err
] ifFalse:[
err := aSelectorString , ' ', err
].
@@ -4563,13 +4526,20 @@
or:[((tokenType == #Integer) or:[tokenType == #Float])
and:[tokenValue < 0]]]
] whileTrue:[
+ "/ kludge alarm: in a function-call argList, #, is not a binarySelector
+ inFunctionCallArgument == true ifTrue:[
+ ((tokenType == #BinaryOperator) and:[tokenName = ',']) ifTrue:[
+ ^ receiver
+ ].
+ ].
+
pos := tokenPosition.
-
lno := tokenLineNr.
- "kludge here: bar and minus are not scanned as binop "
+ "/ kludge alarm: bar and minus are not scanned as binop
(tokenType == $|) ifTrue:[
sel := '|'.
+ sel := self selectorCheck:sel for:receiver position:tokenPosition to:tokenPosition.
self nextToken
] ifFalse:[
(tokenType == #BinaryOperator) ifTrue:[
@@ -4828,64 +4798,83 @@
"Modified: / 19.1.2000 / 16:22:16 / cg"
!
+functionCallArgList
+ |argList arg prevInFunctionCallArgument|
+
+ self nextToken.
+ tokenType == $) ifTrue:[ self nextToken. ^ #() ].
+
+ argList := OrderedCollection new.
+ [ true ] whileTrue:[
+ prevInFunctionCallArgument := inFunctionCallArgument.
+ inFunctionCallArgument := true.
+
+ arg := self expression.
+ argList add:arg.
+
+ inFunctionCallArgument := prevInFunctionCallArgument.
+
+ tokenType == $) ifTrue:[
+ self nextToken.
+ ^ argList
+ ].
+ ((tokenType == #BinaryOperator) and:[tokenName = ',']) ifFalse:[
+ self parseError:'"," or ")" expected'.
+ ].
+ self nextToken.
+ ].
+!
+
functionCallExpression
"parse a functionCall; this is an st/x extension.
- foo(x) is syntactic sugar for foo value:x
- "
-
- |receiver numArgs argList arg|
+ foo(x) is syntactic sugar for foo value:x"
+
+ |receiver numArgs argList evalSelectors|
receiver := self primary.
- AllowFunctionCallSyntaxForBlockEvaluation == true ifFalse:[
- ^ receiver.
- ].
-
+ tokenType == $( ifFalse:[^ receiver].
+ AllowFunctionCallSyntaxForBlockEvaluation == true ifFalse:[^ receiver.].
(receiver == #Error) ifTrue:[^ #Error].
- tokenType == $( ifTrue:[
- self nextToken.
- argList := OrderedCollection new.
- [ true ] whileTrue:[
- tokenType == $) ifTrue:[
- self nextToken.
- "/ make it a block evaluation
- numArgs := argList size.
- numArgs == 0 ifTrue:[
- ^ UnaryNode
- receiver:receiver
- selector:#value
- ].
- numArgs <= 8 ifTrue:[
- selector := #( #'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:'
- ) at:numArgs.
- ^ MessageNode
- receiver:receiver
- selector:selector
- args:argList.
- ].
- "/ argument vector
- ^ MessageNode
- receiver:receiver
- selector:#valueWithArguments:
- args:(self genMakeArrayWith:argList).
- ].
- arg := self expression.
- tokenType == $. ifTrue:[
- self nextToken
- ].
- argList add:arg.
- ].
- self halt:'not yet implemented'.
- ].
- ^ receiver
-
- "AllowFunctionCallSyntaxForBlockEvaluation := true."
+
+ receiver isVariable ifFalse:[
+ ((receiver isMessage or:[receiver isAssignment]) and:[receiver parenthized]) ifFalse:[
+ receiver isBlock ifFalse:[
+ ^ receiver
+ ]
+ ].
+ ].
+
+ argList := self functionCallArgList.
+
+ "/ make it a block evaluation
+ numArgs := argList size.
+ numArgs == 0 ifTrue:[
+ ^ UnaryNode receiver:receiver selector:#eval
+ ].
+ evalSelectors := #( #'evalWith:'
+ #'evalWith:with:'
+ #'evalWith:with:with:'
+ #'evalWith:with:with:with:'
+ #'evalWith:with:with:with:with:'
+ ).
+
+ numArgs <= evalSelectors size ifTrue:[
+ selector := evalSelectors at:numArgs.
+ ^ MessageNode
+ receiver:receiver
+ selector:selector
+ args:argList.
+ ].
+ "/ gen argument vector
+ ^ MessageNode
+ receiver:receiver
+ selector:#evalWithArguments:
+ args:(self genMakeArrayWith:argList).
+
+ "
+ AllowFunctionCallSyntaxForBlockEvaluation := true.
+ "
+
"
|foo|
@@ -5159,11 +5148,9 @@
"
warnSTXHereExtensionUsed := false
].
+ ^ self primary_here.
]
- ]
- ].
-
- (tokenType == #Identifier) ifTrue:[
+ ].
^ self primary_identifier
].
@@ -5187,9 +5174,6 @@
(tokenType == #Super) ifTrue:[
^ self primary_super.
].
- (tokenType == #Here) ifTrue:[
- ^ self primary_here.
- ].
(tokenType == #ThisContext) ifTrue:[
^ self primary_thisContext
@@ -5269,6 +5253,7 @@
].
tokenType == #HashHashLeftParen ifTrue:[
+self halt.
self nextToken.
AllowDolphinExtensions == true ifFalse:[
self parseError:'non-Standard Dolphin extension: ##(..). Enable in settings.' position:pos to:tokenPosition.
@@ -5451,22 +5436,39 @@
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.
+ |pos1 pos2 expr varName rawName var globlName nameSpace nameSpaceGlobal
+ t cls lnr node holder|
+
+ pos1 := tokenPosition.
+ pos2 := tokenPosition + tokenName size - 1.
+
+ varName := tokenName.
+
+ ((selector isNil or:[selector == #doIt])
+ and:[(requestor askFor:#isWorkspace)
+ and:[UserPreferences current autoDefineWorkspaceVariables]]) ifTrue:[
+ var := self variableOrError:varName.
+ self nextToken.
+ (var == #Error) ifTrue:[
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ holder := Workspace addWorkspaceVariable:varName.
+ var := VariableNode type:#WorkspaceVariable holder:holder name:varName
+ ] ifFalse:[
+ var := self correctVariable:varName atPosition:pos1 to:pos2.
+ ].
+ ]
+ ] ifFalse:[
+ var := self variable.
+ self nextToken.
+ ].
+
"/ errorFlag == true ifTrue:[self halt].
(var == #Error) ifTrue:[
errorFlag := true
].
- self nextToken.
(tokenType == #'::') ifTrue:[
- globlName := rawName := name.
+ globlName := rawName := varName.
"is it in a namespace ?"
nameSpace := self findNameSpaceWith:globlName.
@@ -5482,17 +5484,17 @@
ignoreWarnings ifFalse:[
warnSTXNameSpaceUse ifTrue:[
self warning:'nameSpaces are a nonstandard feature of ST/X'
- position:pos to:(source position).
+ position:pos1 to:(source position).
"
only warn once
"
warnSTXNameSpaceUse := false
]
].
- name := tokenName.
-
- globlName := (nameSpace , '::' , name).
- rawName := (rawName , '::' , name).
+ varName := tokenName.
+
+ globlName := (nameSpace , '::' , varName).
+ rawName := (rawName , '::' , varName).
nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
nameSpaceGlobal isNil ifTrue:[
@@ -5501,7 +5503,7 @@
].
(warnedUnknownNamespaces includes:nameSpace) ifFalse:[
self warning:('unknown nameSpace: ', nameSpace)
- position:pos to:tokenPosition-1.
+ position:pos1 to:tokenPosition-1.
"/ self parseError:('unknown nameSpace: ', nameSpace) position:pos to:tokenPosition-1.
warnedUnknownNamespaces add:nameSpace.
]
@@ -5511,15 +5513,15 @@
nameSpaceGlobal ~~ Smalltalk ifTrue:[
"/ self parseError:('(currently) the only valid nameSpace is `Smalltalk''') position:pos to:tokenPosition-1.
] ifFalse:[
- globlName := name
+ globlName := varName
].
] ifFalse:[
nameSpaceGlobal isBehavior ifFalse:[
- self parseError:('invalid nameSpace: ' , nameSpace) position:pos to:tokenPosition-1.
+ self parseError:('invalid nameSpace: ' , nameSpace) position:pos1 to:tokenPosition-1.
] ifTrue:[
- (nameSpaceGlobal privateClassesAt:name asSymbol) isNil ifTrue:[
- self warning:('no private class: ' , name , ' in class: ' , nameSpace)
- position:pos to:tokenPosition-1.
+ (nameSpaceGlobal privateClassesAt:varName asSymbol) isNil ifTrue:[
+ self warning:('no private class: ' , varName , ' in class: ' , nameSpace)
+ position:pos1 to:tokenPosition-1.
"/ self parseError:('no private class: ' , name , ' in class: ' , nameSpace) position:pos to:tokenPosition-1.
]
]
@@ -5530,7 +5532,7 @@
var := VariableNode globalNamed:globlName.
parseForCode ifFalse:[self rememberGlobalUsed:globlName].
].
- self markVariable:var from:pos to:pos + rawName size - 1.
+ self markVariable:var from:pos1 to:pos1 + rawName size - 1.
].
var == #Error ifTrue:[
@@ -5538,7 +5540,7 @@
].
errorFlag ~~ true ifTrue:[
- self markVariable:var from:pos to:pos + name size - 1.
+ self markVariable:var from:pos1 to:pos1 + varName size - 1.
].
(ignoreErrors or:[ignoreWarnings or:[parseForCode not]]) ifTrue:[
errorFlag := false.
@@ -5551,7 +5553,6 @@
].
^ var
].
- pos2 := tokenPosition + tokenType size - 1.
"/ careful: it could already be an implicit self send
ImplicitSelfSends ifTrue:[
@@ -5561,7 +5562,7 @@
self isSyntaxHighlighter ifFalse:[
(errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
].
- ^ MessageNode receiver:(self selfNode) selector:('__' , name , ':') asSymbol arg:expr.
+ ^ MessageNode receiver:(self selfNode) selector:('__' , varName , ':') asSymbol arg:expr.
].
].
@@ -5569,16 +5570,16 @@
t := var type.
(t ~~ #MethodVariable) ifTrue:[
(t == #PrivateClass) ifTrue:[
- self parseError:'assignment to private class' position:pos to:pos2.
+ self parseError:'assignment to private class' position:pos1 to:pos2.
] ifFalse:[
(t == #MethodArg) ifTrue:[
- self parseError:'assignment to method argument' position:pos to:pos2.
+ self parseError:'assignment to method argument' position:pos1 to:pos2.
] ifFalse:[
(t == #BlockArg) ifTrue:[
- self parseError:'assignment to block argument' position:pos to:pos2.
+ self parseError:'assignment to block argument' position:pos1 to:pos2.
] ifFalse:[
(t == #InstanceVariable) ifTrue:[
- name := self classesInstVarNames at:(var index).
+ varName := 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;
@@ -5588,7 +5589,7 @@
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.
+ self warning:'assignment to a classInstanceVariable\(see hierarchy of `Class'')' withCRs position:pos1 to:pos2.
]
]
]
@@ -5597,23 +5598,23 @@
modifiedInstVars isNil ifTrue:[
modifiedInstVars := Set new
].
- modifiedInstVars add:name
+ modifiedInstVars add:varName
]
] ifFalse:[
(t == #ClassVariable) ifTrue:[
- name := var name.
- name := name copyFrom:((name indexOf:$:) + 1).
+ varName := var name.
+ varName := varName copyFrom:((varName indexOf:$:) + 1).
parseForCode ifFalse:[
modifiedClassVars isNil ifTrue:[
modifiedClassVars := Set new
].
- modifiedClassVars add:name
+ modifiedClassVars add:varName
]
] ifFalse:[
(t == #GlobalVariable) ifTrue:[
(cls := Smalltalk classNamed:var name) notNil ifTrue:[
cls name = var name ifTrue:[
- self warning:'assignment to global which refers to a class' position:pos to:pos2.
+ self warning:'assignment to global which refers to a class' position:pos1 to:pos2.
]
].
parseForCode ifFalse:[
@@ -5658,14 +5659,14 @@
] 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.
+ self warning:'followup messageSends to `' , var name , ''' will have normal send semantics\(i.e. NO super- or here-sends). Use self to avoid confusion.' withCRs position:pos1 to:pos2.
].
].
(errorFlag or:[expr == #Error]) ifTrue:[^ #Error].
expr isVariable ifTrue:[
expr name = var name ifTrue:[
- self warning:('useless assignment to `' , var name, '''' ) position:pos to:pos2-1.
+ self warning:('useless assignment to `' , var name, '''' ) position:pos1 to:pos2-1.
].
].
].
@@ -6003,7 +6004,7 @@
self markUnknownIdentifierFrom:pos1 to:pos2.
parseForCode == true ifTrue:[
- v := self correctVariable.
+ v := self correctVariable:tokenName atPosition:pos1 to:pos2.
(v ~~ #Error) ifTrue:[^ v].
].
@@ -6977,7 +6978,7 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.356 2002-11-15 15:21:35 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.357 2002-11-18 10:06:45 cg Exp $'
! !
Parser initialize!