--- a/Parser.st Fri Jan 16 16:06:45 1998 +0100
+++ b/Parser.st Sat Jan 17 15:10:23 1998 +0100
@@ -447,13 +447,15 @@
If the failBlock argument is non-nil, it is evaluated if an error occurs."
^ self
- evaluate:aStringOrStream
- in:nil
- 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"
!
evaluate:aStringOrStream in:aContext receiver:anObject notifying:requestor logged:logged ifFail:failBlock
@@ -488,52 +490,55 @@
|parser tree mustBackup loggedString chgStream value s sReal spc|
aStringOrStream isNil ifTrue:[
- EmptySourceNotificationSignal raise.
- ^ nil
+ EmptySourceNotificationSignal raise.
+ ^ nil
].
(mustBackup := aStringOrStream isStream) ifTrue:[
- s := aStringOrStream.
+ s := aStringOrStream.
] ifFalse:[
- loggedString := aStringOrStream.
- s := ReadStream on:aStringOrStream.
+ loggedString := aStringOrStream.
+ s := ReadStream on:aStringOrStream.
].
parser := self for:s.
parser parseForCode.
parser foldConstants:nil.
parser setSelf:anObject.
parser setContext:aContext.
+ aContext notNil ifTrue:[
+ parser setSelf:(aContext receiver)
+ ].
parser notifying:requestor.
parser nextToken.
tree := parser parseMethodBodyOrEmpty.
"if reading from a stream, backup for next expression"
mustBackup ifTrue:[
- parser backupPosition
+ parser backupPosition
].
(parser errorFlag or:[tree == #Error]) ifTrue:[
- failBlock notNil ifTrue:[
- ^ failBlock value
- ].
- ^ #Error
+ failBlock notNil ifTrue:[
+ ^ failBlock value
+ ].
+ ^ #Error
].
tree isNil ifTrue:[
- EmptySourceNotificationSignal raise.
- ^ nil
+ EmptySourceNotificationSignal raise.
+ ^ nil
].
(logged
and:[loggedString notNil
and:[Smalltalk logDoits]]) ifTrue:[
- Class updateChangeFileQuerySignal raise ifTrue:[
- chgStream := Class changesStream.
- chgStream notNil ifTrue:[
- chgStream nextChunkPut:loggedString.
- chgStream cr.
- chgStream close
- ]
- ].
+ Class updateChangeFileQuerySignal raise ifTrue:[
+ chgStream := Class changesStream.
+ chgStream notNil ifTrue:[
+ chgStream nextChunkPut:loggedString.
+ chgStream cr.
+ chgStream close
+ ]
+ ].
].
"
@@ -544,98 +549,99 @@
"
spc := parser getNameSpace.
spc isNil ifTrue:[
- (requestor respondsTo:#currentNameSpace) ifTrue:[
- spc := requestor currentNameSpace
- ] ifFalse:[
- spc := Class nameSpaceQuerySignal raise.
- ]
+ (requestor respondsTo:#currentNameSpace) ifTrue:[
+ spc := requestor currentNameSpace
+ ] ifFalse:[
+ spc := Class nameSpaceQuerySignal raise.
+ ]
].
Class nameSpaceQuerySignal answer:spc
do:[
- |method|
-
- "
- if compile is false, or the parse tree is that of a constant,
- or a variable, quickly return its value.
- This is used for example, when reading simple objects
- via #readFrom:.
- The overhead of compiling a method is avoided in this case.
- "
- ((SuppressDoItCompilation == true)
- or:[compile not
- or:[tree isConstant
- or:[tree isVariable
- or:[aStringOrStream isStream]]]]) ifTrue:[
- ^ tree evaluate
- ].
-
- "
- if I am the ByteCodeCompiler,
- generate a dummy method, execute it and return the value.
- otherwise, just evaluate the tree; slower, but not too bad ...
-
- This allows systems to be delivered without the ByteCodeCompiler,
- and still evaluate expressions
- (needed to read resource files or to process .rc files).
- "
- self == Parser ifTrue:[
- parser evalExitBlock:[:value | parser release. ^ value].
- value := tree evaluate.
- parser evalExitBlock:nil.
- ] ifFalse:[
- aStringOrStream isStream ifTrue:[
- s := parser collectedSource. "/ does not work yet ...
- ] ifFalse:[
- s := aStringOrStream
- ].
-
- "/ actually, its a block, to allow
- "/ easy return ...
-
- sReal := 'doIt ^[\' withCRs , s , '\] value' withCRs.
-
- method := self
- compile:sReal
- forClass:anObject class
- inCategory:'_temporary_'
- notifying:requestor
- install:false
- skipIfSame:false
- silent:true
- foldConstants:false.
-
- method notNil ifTrue:[
- method ~~ #Error ifTrue:[
- "
- fake: patch the source string, to what the user expects
- in the browser
- "
- method source:' \' withCRs , s .
- "
- dont do any just-in-time compilation on it.
- "
- method checked:true.
-
- value := method
- valueWithReceiver:anObject
- arguments:nil "/ (Array with:m)
- selector:#doIt "/ #doIt:
- search:nil
- sender:nil.
- ] ifFalse:[
- parser evalExitBlock:[:value | parser release. ^ value].
- value := tree evaluate.
- parser evalExitBlock:nil.
- ]
- ].
- ]
+ |method|
+
+ "
+ if compile is false, or the parse tree is that of a constant,
+ or a variable, quickly return its value.
+ This is used for example, when reading simple objects
+ via #readFrom:.
+ The overhead of compiling a method is avoided in this case.
+ "
+ ((SuppressDoItCompilation == true)
+ or:[compile not
+ or:[tree isConstant
+ or:[tree isVariable
+ or:[aStringOrStream isStream
+ or:[aContext notNil]]]]]) ifTrue:[
+ ^ tree evaluate
+ ].
+
+ "
+ if I am the ByteCodeCompiler,
+ generate a dummy method, execute it and return the value.
+ otherwise, just evaluate the tree; slower, but not too bad ...
+
+ This allows systems to be delivered without the ByteCodeCompiler,
+ and still evaluate expressions
+ (needed to read resource files or to process .rc files).
+ "
+ self == Parser ifTrue:[
+ parser evalExitBlock:[:value | parser release. ^ value].
+ value := tree evaluate.
+ parser evalExitBlock:nil.
+ ] ifFalse:[
+ aStringOrStream isStream ifTrue:[
+ s := parser collectedSource. "/ does not work yet ...
+ ] ifFalse:[
+ s := aStringOrStream
+ ].
+
+ "/ actually, its a block, to allow
+ "/ easy return ...
+
+ sReal := 'doIt ^[\' withCRs , s , '\] value' withCRs.
+
+ method := self
+ compile:sReal
+ forClass:anObject class
+ inCategory:'_temporary_'
+ notifying:requestor
+ install:false
+ skipIfSame:false
+ silent:true
+ foldConstants:false.
+
+ method notNil ifTrue:[
+ method ~~ #Error ifTrue:[
+ "
+ fake: patch the source string, to what the user expects
+ in the browser
+ "
+ method source:' \' withCRs , s .
+ "
+ dont do any just-in-time compilation on it.
+ "
+ method checked:true.
+
+ value := method
+ valueWithReceiver:anObject
+ arguments:nil "/ (Array with:m)
+ selector:#doIt "/ #doIt:
+ search:nil
+ sender:nil.
+ ] ifFalse:[
+ parser evalExitBlock:[:value | parser release. ^ value].
+ value := tree evaluate.
+ parser evalExitBlock:nil.
+ ]
+ ].
+ ]
].
parser release.
^ value
- "Created: 8.2.1997 / 19:34:44 / cg"
- "Modified: 14.10.1997 / 17:03:08 / cg"
+ "Created: / 8.2.1997 / 19:34:44 / cg"
+ "Modified: / 17.1.1998 / 04:07:10 / cg"
!
evaluate:aStringOrStream logged:logged
@@ -754,6 +760,105 @@
compile:compile
! !
+!Parser class methodsFor:'general helpers'!
+
+argAndVarNamesForContext:aContext
+ "helper: given a context, return a collection of arg&var names"
+
+ |homeContext method numArgs numVars m src
+ blockNode argNames varNames vars sel isDoIt|
+
+ numArgs := aContext numArgs.
+ numVars := aContext numVars.
+ (numArgs == 0 and:[numVars == 0]) ifTrue:[^ #()].
+
+ homeContext := aContext methodHome.
+ sel := homeContext selector.
+ method := homeContext method.
+
+ "/ #doIt needs special handling below
+ isDoIt := (sel == #doIt) or:[sel == #doIt:].
+ aContext isBlockContext ifFalse:[
+ isDoIt ifTrue:[
+ method notNil ifTrue:[
+ "/ special for #doIt
+ m := nil.
+ src := ('[' , method source , '\]') withCRs.
+ blockNode := Compiler
+ blockAtLine:(aContext lineNumber)
+ in:m
+ orSource:src
+ numArgs:numArgs
+ numVars:numVars.
+ blockNode notNil ifTrue:[
+ argNames := #().
+ varNames := #().
+
+ numArgs > 0 ifTrue:[
+ vars := blockNode arguments.
+ vars size > 0 ifTrue:[
+ argNames := vars collect:[:var | var name]
+ ]
+ ].
+ numVars > 0 ifTrue:[
+ vars := blockNode variables.
+ vars size > 0 ifTrue:[
+ varNames := vars collect:[:var | var name].
+ ]
+ ].
+ ^ argNames , varNames
+ ].
+ ]
+ ].
+
+ method notNil ifTrue:[
+ ^ method methodArgAndVarNames.
+ ].
+ ^ #()
+ ].
+
+ method notNil ifTrue:[
+ isDoIt ifTrue:[
+ "/ special for #doIt
+ "/ my source is found in the method.
+ m := nil.
+ src := ('[' , method source , '\]') withCRs.
+ ] ifFalse:[
+ m := method.
+ src := nil.
+ ].
+ blockNode := Compiler
+ blockAtLine:(aContext lineNumber)
+ in:m
+ orSource:src
+ numArgs:numArgs
+ numVars:numVars.
+
+ blockNode notNil ifTrue:[
+ argNames := #().
+ varNames := #().
+
+ numArgs > 0 ifTrue:[
+ vars := blockNode arguments.
+ vars size > 0 ifTrue:[
+ argNames := vars collect:[:var | var name]
+ ]
+ ].
+ numVars > 0 ifTrue:[
+ vars := blockNode variables.
+ vars size > 0 ifTrue:[
+ varNames := vars collect:[:var | var name].
+ ]
+ ].
+ ^ argNames , varNames
+ ].
+ ].
+ ^ #()
+
+ "Created: / 17.1.1998 / 03:18:05 / cg"
+ "Modified: / 17.1.1998 / 03:55:44 / cg"
+! !
+
!Parser class methodsFor:'initialization '!
initialize
@@ -3214,219 +3319,219 @@
pos := tokenPosition.
(tokenType == #Self) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to self' position:pos to:tokenPosition.
- ^ #Error
- ].
- selfNode isNil ifTrue:[
- selfNode := SelfNode value:selfValue
- ].
- ^ selfNode
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to self' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ selfNode isNil ifTrue:[
+ selfNode := SelfNode value:selfValue
+ ].
+ ^ selfNode
].
(tokenType == #Identifier) ifTrue:[
- "
- must check for variable first, to be backward compatible
- with other smalltalks.
- "
- tokenName = 'here' ifTrue:[
- (self variableOrError:tokenName) == #Error ifTrue:[
- tokenType := #Here.
- warnSTXHereExtensionUsed ifTrue:[
- self warning:'here-sends are a nonstandard feature of ST/X'
- position:pos to:pos+3.
- "
- only warn once
- "
- warnSTXHereExtensionUsed := false
- ]
- ]
- ]
+ "
+ must check for variable first, to be backward compatible
+ with other smalltalks.
+ "
+ tokenName = 'here' ifTrue:[
+ (self variableOrError:tokenName) == #Error ifTrue:[
+ tokenType := #Here.
+ warnSTXHereExtensionUsed ifTrue:[
+ self warning:'here-sends are a nonstandard feature of ST/X'
+ position:pos to:pos+3.
+ "
+ only warn once
+ "
+ warnSTXHereExtensionUsed := false
+ ]
+ ]
+ ]
].
(tokenType == #Identifier) ifTrue:[
- name := tokenName.
-
- var := self variable.
- (var == #Error) ifTrue:[
- errorFlag := true
- ].
- self nextToken.
-
- (tokenType == #'::') ifTrue:[
- globlName := 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).
-
- nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
- nameSpaceGlobal isNil ifTrue:[
- self parseError:('unknown nameSpace: ', nameSpace) position:pos to:tokenPosition-1.
- errorFlag := true
- ] ifFalse:[
- nameSpaceGlobal isNamespace ifTrue:[
- "/ for now: only Smalltalk is allowed
- nameSpaceGlobal ~~ Smalltalk ifTrue:[
+ name := tokenName.
+
+ var := self variable.
+ (var == #Error) ifTrue:[
+ errorFlag := true
+ ].
+ self nextToken.
+
+ (tokenType == #'::') ifTrue:[
+ globlName := 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).
+
+ nameSpaceGlobal := Smalltalk at:nameSpace asSymbol ifAbsent:nil.
+ nameSpaceGlobal isNil ifTrue:[
+ self parseError:('unknown nameSpace: ', nameSpace) position:pos to:tokenPosition-1.
+ errorFlag := true
+ ] 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.
"/ errorFlag := true
- ] ifFalse:[
- globlName := name
- ].
- ] ifFalse:[
- nameSpaceGlobal isBehavior ifFalse:[
- self parseError:('invalid nameSpace: ' , nameSpace) position:pos to:tokenPosition-1.
- errorFlag := true
- ] ifTrue:[
- (nameSpaceGlobal privateClassesAt:name asSymbol) isNil ifTrue:[
- self parseError:('no private class: ' , name , ' in class: ' , nameSpace) position:pos to:tokenPosition-1.
- errorFlag := true
- ]
- ]
- ].
- ].
- self nextToken.
- ].
- var := VariableNode
- type:#GlobalVariable
- name:globlName asSymbol.
- parseForCode ifFalse:[self rememberGlobalUsed:globlName].
- ]
- ].
-
- ((tokenType == $_) or:[tokenType == #':=']) ifFalse:[
- ^ var
- ].
-
- "/ careful: it could already be an implicit self send
- ImplicitSelfSends ifTrue:[
- var isMessage ifTrue:[
- self nextToken.
- expr := self expression.
- (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 ~~ #MethodVar) ifTrue:[
- (t == #PrivateClass) ifTrue:[
- self parseError:'assignment to private class' position:pos to:tokenPosition.
- errorFlag := true
- ] ifFalse:[
- (t == #MethodArg) ifTrue:[
- self parseError:'assignment to method argument' position:pos to:tokenPosition.
- errorFlag := true
- ] ifFalse:[
- (t == #BlockArg) ifTrue:[
- self parseError:'assignment to block argument' position:pos to:tokenPosition.
- errorFlag := true
- ] 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:tokenPosition+1.
- ]
- ]
- ]
- ].
- 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:tokenPosition.
- ]
- ].
- parseForCode ifFalse:[
- modifiedGlobals isNil ifTrue:[
- modifiedGlobals := Set new
- ].
- modifiedGlobals 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.
-
- 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].
- node := AssignmentNode variable:var expression:expr.
- (lineNumberInfo == #full) ifTrue:[node lineNr:lnr].
- ^ node
+ ] ifFalse:[
+ globlName := name
+ ].
+ ] ifFalse:[
+ nameSpaceGlobal isBehavior ifFalse:[
+ self parseError:('invalid nameSpace: ' , nameSpace) position:pos to:tokenPosition-1.
+ errorFlag := true
+ ] ifTrue:[
+ (nameSpaceGlobal privateClassesAt:name asSymbol) isNil ifTrue:[
+ self parseError:('no private class: ' , name , ' in class: ' , nameSpace) position:pos to:tokenPosition-1.
+ errorFlag := true
+ ]
+ ]
+ ].
+ ].
+ self nextToken.
+ ].
+ var := VariableNode
+ type:#GlobalVariable
+ name:globlName asSymbol.
+ parseForCode ifFalse:[self rememberGlobalUsed:globlName].
+ ]
+ ].
+
+ ((tokenType == $_) or:[tokenType == #':=']) ifFalse:[
+ ^ var
+ ].
+
+ "/ careful: it could already be an implicit self send
+ ImplicitSelfSends ifTrue:[
+ var isMessage ifTrue:[
+ self nextToken.
+ expr := self expression.
+ (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 ~~ #MethodVar) ifTrue:[
+ (t == #PrivateClass) ifTrue:[
+ self parseError:'assignment to private class' position:pos to:tokenPosition.
+ errorFlag := true
+ ] ifFalse:[
+ (t == #MethodArg) ifTrue:[
+ self parseError:'assignment to method argument' position:pos to:tokenPosition.
+ errorFlag := true
+ ] ifFalse:[
+ (t == #BlockArg) ifTrue:[
+ self parseError:'assignment to block argument' position:pos to:tokenPosition.
+ errorFlag := true
+ ] 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:tokenPosition+1.
+ ]
+ ]
+ ]
+ ].
+ 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:tokenPosition.
+ ]
+ ].
+ parseForCode ifFalse:[
+ modifiedGlobals isNil ifTrue:[
+ modifiedGlobals := Set new
+ ].
+ modifiedGlobals 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.
+
+ 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].
+ node := AssignmentNode variable:var expression:expr.
+ (lineNumberInfo == #full) ifTrue:[node lineNr:lnr].
+ ^ node
].
((tokenType == #Integer)
@@ -3434,153 +3539,157 @@
or:[(tokenType == #Character)
or:[(tokenType == #Float)
or:[(tokenType == #Symbol)]]]]) ifTrue:[
- val := ConstantNode type:tokenType value:tokenValue.
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to a constant' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ val
+ val := ConstantNode type:tokenType value:tokenValue.
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to a constant' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ val
].
(tokenType == #Nil) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to nil' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#Nil value:nil
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to nil' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#Nil value:nil
].
(tokenType == #True) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to true' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#True value:true
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to true' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#True value:true
].
(tokenType == #False) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to false' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#False value:false
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to false' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#False value:false
].
(tokenType == #Super) ifTrue:[
- usesSuper := true.
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to super' position:pos to:tokenPosition.
- ^ #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
- ].
- ^ superNode
+ usesSuper := true.
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to super' position:pos to:tokenPosition.
+ ^ #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
+ ].
+ ^ superNode
].
(tokenType == #Here) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to here' position:pos to:tokenPosition.
- ^ #Error
- ].
- classToCompileFor isNil ifTrue:[
- self warning:'in which class are you ?' position:pos to:(pos + 3).
- ].
- ^ SuperNode value:selfValue inClass:classToCompileFor here:true
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to here' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ classToCompileFor isNil ifTrue:[
+ self warning:'in which class are you ?' position:pos to:(pos + 3).
+ ].
+ ^ SuperNode value:selfValue inClass:classToCompileFor here:true
].
(tokenType == #ThisContext) ifTrue:[
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to thisContext' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ VariableNode type:#ThisContext
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to thisContext' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ contextToEvaluateIn notNil ifTrue:[
+ ^ VariableNode type:#ThisContext context:contextToEvaluateIn
+ ] ifFalse:[
+ ^ VariableNode type:#ThisContext
+ ]
].
(tokenType == #HashLeftParen) ifTrue:[
- self nextToken.
- val := self array.
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to a constant' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#Array value:val
+ self nextToken.
+ val := self array.
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to a constant' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#Array value:val
].
(tokenType == #HashLeftBrack) ifTrue:[
- self nextToken.
- val := self byteArray.
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'assignment to a constant' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ ConstantNode type:#Array value:val
+ self nextToken.
+ val := self byteArray.
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'assignment to a constant' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ ConstantNode type:#Array value:val
].
(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.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'invalid assignment' position:pos to:tokenPosition.
- ^ #Error
- ].
- val parenthized:true.
- ^ val
+ 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.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'invalid assignment' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ val parenthized:true.
+ ^ val
].
(tokenType == $[ ) ifTrue:[
- val := self block.
- self nextToken.
- ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
- self parseError:'invalid assignment' position:pos to:tokenPosition.
- ^ #Error
- ].
- ^ val
+ val := self block.
+ self nextToken.
+ ((tokenType == $_) or:[tokenType == #':=']) ifTrue:[
+ self parseError:'invalid assignment' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ val
].
(tokenType == #Primitive) ifTrue:[
- self nextToken.
- node := PrimitiveNode code:tokenValue.
- hasNonOptionalPrimitiveCode := true.
- hasPrimitiveCode := true.
- ^ node
+ self nextToken.
+ node := PrimitiveNode code:tokenValue.
+ hasNonOptionalPrimitiveCode := true.
+ hasPrimitiveCode := true.
+ ^ node
].
(tokenType == #Error) ifTrue:[^ #Error].
tokenType isCharacter ifTrue:[
- self syntaxError:('error in primary; '
- , tokenType printString ,
- ' unexpected') position:tokenPosition to:tokenPosition
+ self syntaxError:('error in primary; '
+ , tokenType printString ,
+ ' unexpected') position:tokenPosition to:tokenPosition
] ifFalse:[
- (#(BinaryOperator Keyword) includes:tokenType) ifTrue:[
- eMsg := ('error in primary; '
- , tokenType printString , '(' , tokenName , ') ' ,
- ' unexpected')
- ] ifFalse:[
- eMsg := ('error in primary; '
- , tokenType printString ,
- ' unexpected')
- ].
- self syntaxError:eMsg
+ (#(BinaryOperator Keyword) includes:tokenType) ifTrue:[
+ eMsg := ('error in primary; '
+ , tokenType printString , '(' , tokenName , ') ' ,
+ ' unexpected')
+ ] ifFalse:[
+ eMsg := ('error in primary; '
+ , tokenType printString ,
+ ' unexpected')
+ ].
+ self syntaxError:eMsg
].
^ #Error
- "Created: 13.9.1995 / 12:50:50 / claus"
- "Modified: 8.4.1997 / 10:11:46 / cg"
+ "Created: / 13.9.1995 / 12:50:50 / claus"
+ "Modified: / 17.1.1998 / 04:08:05 / cg"
!
statement
@@ -3791,7 +3900,7 @@
variableOrError:varName
"parse a variable; return a node-tree, nil or #Error"
- |var instIndex aClass searchBlock args vars
+ |var varIndex aClass searchBlock args vars
tokenSymbol space classVarIndex|
"is it a block-arg or block-var ?"
@@ -3799,12 +3908,12 @@
[searchBlock notNil] whileTrue:[
vars := searchBlock variables.
vars notNil ifTrue:[
- instIndex := vars findFirst:[:aBlockVar | aBlockVar name = varName].
- instIndex ~~ 0 ifTrue:[
+ varIndex := vars findFirst:[:aBlockVar | aBlockVar name = varName].
+ varIndex ~~ 0 ifTrue:[
^ VariableNode type:#BlockVariable
name:varName
- token:(vars at:instIndex)
- index:instIndex
+ token:(vars at:varIndex)
+ index:varIndex
block:searchBlock
from:currentBlock
].
@@ -3812,12 +3921,12 @@
args := searchBlock arguments.
args notNil ifTrue:[
- instIndex := args findFirst:[:aBlockArg | aBlockArg name = varName].
- instIndex ~~ 0 ifTrue:[
+ varIndex := args findFirst:[:aBlockArg | aBlockArg name = varName].
+ varIndex ~~ 0 ifTrue:[
^ VariableNode type:#BlockArg
name:varName
- token:(args at:instIndex)
- index:instIndex
+ token:(args at:varIndex)
+ index:varIndex
block:searchBlock
from:currentBlock
].
@@ -3829,33 +3938,53 @@
"is it a method-variable ?"
methodVars notNil ifTrue:[
- instIndex := methodVarNames indexOf:varName.
- instIndex ~~ 0 ifTrue:[
- var := methodVars at:instIndex.
+ varIndex := methodVarNames indexOf:varName.
+ varIndex ~~ 0 ifTrue:[
+ var := methodVars at:varIndex.
var used:true.
^ VariableNode type:#MethodVariable
name:varName
token:var
- index:instIndex
+ index:varIndex
]
].
"is it a method-argument ?"
methodArgs notNil ifTrue:[
- instIndex := methodArgNames indexOf:varName.
- instIndex ~~ 0 ifTrue:[
+ varIndex := methodArgNames indexOf:varName.
+ varIndex ~~ 0 ifTrue:[
^ VariableNode type:#MethodArg
name:varName
- token:(methodArgs at:instIndex)
- index:instIndex
+ token:(methodArgs at:varIndex)
+ index:varIndex
]
].
+ contextToEvaluateIn notNil ifTrue:[
+ |con varNames|
+
+ "/
+ "/ search names of the context.
+ "/
+ con := contextToEvaluateIn.
+ [con notNil] whileTrue:[
+ varNames := self class argAndVarNamesForContext:con.
+ varIndex := varNames lastIndexOf:varName.
+ varIndex ~~ 0 ifTrue:[
+ ^ VariableNode type:#ContextVariable
+ name:varName
+ context:con
+ index:varIndex
+ ].
+ con := con home.
+ ].
+ ].
+
classToCompileFor notNil ifTrue:[
"is it an instance-variable ?"
- instIndex := (self classesInstVarNames) lastIndexOf:varName.
- instIndex ~~ 0 ifTrue:[
+ varIndex := (self classesInstVarNames) lastIndexOf:varName.
+ varIndex ~~ 0 ifTrue:[
classToCompileFor isMeta ifTrue:[
classVarIndex := (self classesClassVarNames) lastIndexOf:varName.
classVarIndex ~~ 0 ifTrue:[
@@ -3866,7 +3995,7 @@
parseForCode ifFalse:[self rememberInstVarUsed:varName].
^ VariableNode type:#InstanceVariable
name:varName
- index:instIndex
+ index:varIndex
selfValue:selfValue
].
@@ -3880,8 +4009,8 @@
"/ from instance methods ...
"/ (used to be in previous ST/X versions)
"/
- instIndex := (self classesClassInstVarNames) lastIndexOf:varName.
- instIndex ~~ 0 ifTrue:[
+ varIndex := (self classesClassInstVarNames) lastIndexOf:varName.
+ varIndex ~~ 0 ifTrue:[
aClass := self inWhichClassIsClassInstVar:varName.
aClass notNil ifTrue:[
classToCompileFor isMeta ifFalse:[
@@ -3901,7 +4030,7 @@
"/ parseForCode ifFalse:[self rememberClassVarUsed:varName].
"/ ^ VariableNode type:#ClassInstanceVariable
"/ name:varName
-"/ index:instIndex
+"/ index:varIndex
"/ selfClass:aClass
"/ ].
]
@@ -3909,8 +4038,8 @@
"is it a class-variable ?"
- instIndex := classVarIndex.
- instIndex ~~ 0 ifTrue:[
+ varIndex := classVarIndex.
+ varIndex ~~ 0 ifTrue:[
aClass := self inWhichClassIsClassVar:varName.
aClass notNil ifTrue:[
parseForCode ifFalse:[self rememberClassVarUsed:varName].
@@ -3953,7 +4082,7 @@
^ #Error
- "Modified: / 25.10.1997 / 21:35:00 / cg"
+ "Modified: / 17.1.1998 / 03:56:35 / cg"
! !
!Parser methodsFor:'private'!
@@ -4340,6 +4469,6 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.152 1998-01-09 19:01:30 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.153 1998-01-17 14:10:23 cg Exp $'
! !
Parser initialize!