--- a/Parser.st Thu May 14 19:35:53 1998 +0200
+++ b/Parser.st Thu May 14 20:26:18 1998 +0200
@@ -2450,166 +2450,6 @@
!Parser methodsFor:'parsing'!
-array
- |arr elements elem pos1|
-
- pos1 := tokenPosition.
- elements := OrderedCollection new:20.
- [tokenType ~~ $) ] whileTrue:[
- elem := self arrayConstant.
- (elem == #Error) ifTrue:[
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'unterminated array-constant; '')'' expected'
- position:pos1 to:tokenPosition
- ].
- ^ #Error
- ].
- elem isSymbol ifTrue:[
- self markSymbolFrom:tokenPosition to:(source position-1).
- ].
- elements add:elem.
- self nextToken
- ].
- arr := Array withAll:elements.
-
- (ArraysAreImmutable and:[ImmutableArray notNil]) ifTrue:[
- arr changeClassTo:ImmutableArray.
- ].
- ^ arr
-
- "Modified: / 14.4.1998 / 17:03:29 / cg"
-!
-
-arrayConstant
- (tokenType == #Nil) ifTrue:[
- ^ nil
- ].
- ((tokenType == #Integer)
- or:[tokenType == #Float]) ifTrue:[
- ^ tokenValue
- ].
- ((tokenType == #String)
- or:[tokenType == #Character]) ifTrue:[
- ^ tokenValue
- ].
- (tokenType == #True) ifTrue:[
- ^ true
- ].
- (tokenType == #False) ifTrue:[
- ^ false
- ].
- (tokenType == #Error) ifTrue:[
- ^ #Error
- ].
- (tokenType == #BinaryOperator) ifTrue:[
- ^ tokenName asSymbol
- ].
-
- "/ some more special symbol consts ...
- (tokenType == $| ) ifTrue:[
- ^ #|
- ].
- (tokenType == #Self ) ifTrue:[
- ^ #'self'
- ].
- (tokenType == #Super ) ifTrue:[
- ^ #'super'
- ].
- (tokenType == #Here ) ifTrue:[
- ^ #'here'
- ].
- (tokenType == #ThisContext ) ifTrue:[
- ^ #'thisContext'
- ].
-
- ((tokenType == #Keyword)
- or:[tokenType == #Identifier]) ifTrue:[
- ^ tokenName asSymbol
- ].
- ((tokenType == $()
- or:[tokenType == #HashLeftParen]) ifTrue:[
- self nextToken.
- ^ self array
- ].
- ((tokenType == $[)
- or:[tokenType == #HashLeftBrack]) ifTrue:[
- self nextToken.
- ^ self byteArray
- ].
- (tokenType == #Symbol) ifTrue:[
- ^ tokenValue
- ].
- (tokenType == #EOF) ifTrue:[
- "just for the better error-hilight; let caller handle error"
- ^ #Error
- ].
- self syntaxError:('error in array-constant; '
- , tokenType printString
- , ' unexpected').
- ^ #Error
-
- "Modified: / 14.4.1998 / 18:22:54 / cg"
-!
-
-binaryExpression
- "parse a binary-expression; return a node-tree, nil or #Error"
-
- |receiver arg sel pos try lno note|
-
- receiver := self unaryExpression.
- (receiver == #Error) ifTrue:[^ #Error].
-
- "special kludge: since Scanner cannot know if -digit is a binary
- expression or a negative constant, handle cases here"
-
- [(tokenType == #BinaryOperator)
- or:[(tokenType == $|)
- or:[((tokenType == #Integer) or:[tokenType == #Float])
- and:[tokenValue < 0]]]
- ] whileTrue:[
- pos := tokenPosition.
-
- lno := tokenLineNr.
-
- "kludge here: bar and minus are not scanned as binop "
- (tokenType == $|) ifTrue:[
- sel := '|'.
- self nextToken
- ] ifFalse:[
- (tokenType == #BinaryOperator) ifTrue:[
- sel := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
- self nextToken
- ] ifFalse:[
- sel := '-'.
- tokenValue := tokenValue negated
- ]
- ].
- self markSelectorFrom:pos to:(pos + sel size - 1).
-
- arg := self unaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- try := BinaryNode receiver:receiver selector:sel arg:arg fold:foldConstants.
- (try isMemberOf:String) ifTrue:[
- self parseError:try position:pos to:tokenPosition.
- errorFlag := false. "ok, user wants it - so he'll get it"
- receiver := BinaryNode receiver:receiver selector:sel arg:arg fold:nil.
- note := receiver plausibilityCheck.
- note notNil ifTrue:[
- self warning:note position:pos to:tokenPosition
- ].
- ] ifFalse:[
- receiver := try
- ].
- receiver lineNumber:lno.
- receiver selectorPosition:pos.
- parseForCode ifFalse:[self rememberSelectorUsed:sel].
- ].
- ^ receiver
-
- "Modified: / 9.1.1998 / 19:05:18 / stefan"
- "Modified: / 31.3.1998 / 18:17:29 / cg"
-!
-
block
"parse a block; return a node-tree, nil or #Error"
@@ -2759,304 +2599,6 @@
^ firstStatement
!
-byteArray
- "started with ST-80 R4 - allow byteArray constants as #[ ... ]"
-
- |bytes index limit newArray elem pos1 pos2|
-
- pos1 := tokenPosition.
- bytes := ByteArray uninitializedNew:5000.
- index := 0. limit := 5000.
- [tokenType ~~ $] ] whileTrue:[
- pos2 := tokenPosition.
- "
- this is not good programming style, but speeds up
- reading of huge byte arrays (i.e. stored Images ...)
- "
- (tokenType == #Integer) ifTrue:[
- elem := tokenValue
- ] ifFalse:[
- elem := self arrayConstant.
- (elem == #Error) ifTrue:[
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'unterminated bytearray-constant; '']'' expected'
- position:pos1 to:tokenPosition
- ].
- ^ #Error
- ].
- ].
- ((elem isMemberOf:SmallInteger) and:[elem between:0 and:255]) ifTrue:[
- index := index + 1.
- bytes at:index put:elem.
- index == limit ifTrue:[
- newArray := ByteArray uninitializedNew:(limit * 2).
- newArray replaceFrom:1 to:limit with:bytes startingAt:1.
- limit := limit * 2.
- bytes := newArray
- ].
- ] ifFalse:[
- self parseError:'invalid ByteArray element' position:pos2 to:tokenPosition - 1
- ].
- self nextToken.
- ].
- newArray := ByteArray uninitializedNew:index.
- newArray replaceFrom:1 to:index with:bytes startingAt:1.
- ^ newArray
-!
-
-degeneratedKeywordExpressionForSelector
- "parse a keyword-expression without receiver - for the selector
- only. return the selector or nil. This is not used in normal parsing,
- but instead to extract the selector from a code fragment.
- (for example, the system browsers implementors-function uses this)"
-
- |sel arg rec|
-
- (tokenType == #Keyword) ifTrue:[
- sel := tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ sel].
- [tokenType == #Keyword] whileTrue:[
- sel := sel , tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ sel].
- ].
- ^ sel
- ].
-
- (rec := self primary) ~~ #Error ifTrue:[
- sel := self degeneratedKeywordExpressionForSelector.
- sel isNil ifTrue:[
- rec isMessage ifTrue:[
- sel := rec selector
- ] ifFalse:[
- rec isAssignment ifTrue:[
- rec expression isMessage ifTrue:[
- sel := rec expression selector
- ]
- ]
- ]
- ]
- ].
- ^ sel
-!
-
-expression
- "parse a cascade-expression; return a node-tree, nil or #Error.
-
- expression ::= keywordExpression
- | keywordExpression cascade
-
- cascade ::= ';' expressionSendPart
- | cascade ';' expressionSendPart
-
- expressionSendPart ::= { KEYWORD binaryExpression }
- | BINARYOPERATOR unaryExpression
- | IDENTIFIER
- "
-
- |receiver arg sel args pos pos2 lno|
-
- pos := tokenPosition.
- receiver := self keywordExpression.
- (receiver == #Error) ifTrue:[^ #Error].
- (tokenType == $;) ifTrue:[
- [tokenType == $;] whileTrue:[
- receiver isMessage ifFalse:[
- self syntaxError:'left side of cascade must be a message expression'
- position:pos to:tokenPosition
- ].
- self nextToken.
- (tokenType == #Identifier) ifTrue:[
- self markSelectorFrom:tokenPosition to:(tokenPosition + tokenName size - 1).
- sel := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
- receiver := CascadeNode receiver:receiver selector:sel.
- receiver lineNumber:tokenLineNr.
- parseForCode ifFalse:[self rememberSelectorUsed:sel].
- self nextToken.
- ] ifFalse:[
- (tokenType == #BinaryOperator) ifTrue:[
- self markSelectorFrom:tokenPosition to:(tokenPosition + tokenName size - 1).
- sel := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
- lno := tokenLineNr.
- self nextToken.
- arg := self unaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- receiver := CascadeNode receiver:receiver selector:sel arg:arg.
- receiver lineNumber:lno.
- parseForCode ifFalse:[self rememberSelectorUsed:sel].
- ] ifFalse:[
- (tokenType == #Keyword) ifTrue:[
- self markSelectorFrom:tokenPosition to:(tokenPosition + tokenName size - 1).
- pos := tokenPosition.
- lno := tokenLineNr.
- sel := tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := Array with:arg.
- [tokenType == #Keyword] whileTrue:[
- self markSelectorFrom:pos to:(tokenPosition + tokenName size - 1).
- sel := sel , tokenName.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := args copyWith:arg.
- pos2 := tokenPosition
- ].
- sel := self selectorCheck:sel for:receiver position:pos to:pos2.
- receiver := CascadeNode receiver:receiver selector:sel args:args.
- receiver lineNumber:lno.
- parseForCode ifFalse:[self rememberSelectorUsed:sel].
- ] ifFalse:[
- (tokenType == #Error) ifTrue:[^ #Error].
- self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
- position:tokenPosition to:source position - 1.
- ^ #Error
- ]
- ]
- ]
- ].
-
- "obscure (unspecified ?) if selector follows; Question:
-
- is
- 'expr sel1; sel2 sel3'
-
- to be parsed as:
- (t := expr.
- t sel1.
- t sel2) sel3
-
- or:
- (t := expr.
- t sel1.
- t sel2 sel3)
- "
- ((tokenType == #Identifier)
- or:[(tokenType == #BinaryOperator)
- or:[tokenType == #Keyword]]) ifTrue:[
- self syntaxError:'ambigous cascade - please group using ( ...)'
- position:tokenPosition to:source position - 1.
- ^ #Error
- ]
- ].
- ^ receiver
-
- "Modified: / 1.4.1998 / 13:16:08 / cg"
-!
-
-inWhichClassIsClassInstVar:aString
- "search class-chain for the class-instance variable named aString
- - return the class or nil if not found"
-
- |aClass|
-
- aClass := classToCompileFor.
- [aClass notNil] whileTrue:[
- (aClass class instVarNames includes:aString) ifTrue:[ ^ aClass].
- aClass := aClass superclass
- ].
- ^ nil
-
- "Modified: 4.1.1997 / 14:42:15 / cg"
-!
-
-inWhichClassIsClassVar:aString
- "search class-chain for the classvariable named aString
- - return the class or nil if not found"
-
- |aClass className baseClass|
-
- aClass := classToCompileFor.
- aClass isMeta ifTrue:[
- className := aClass name copyWithoutLast:6.
- baseClass := Smalltalk at:(className asSymbol).
- baseClass notNil ifTrue:[
- aClass := baseClass
- ]
- ].
- ^ aClass whichClassDefinesClassVar:aString
-
-"/ [aClass notNil] whileTrue:[
-"/ (aClass classVarNames includes:aString) ifTrue:[ ^ aClass].
-"/ aClass := aClass superclass
-"/ ].
-"/ ^ nil
-
- "Modified: 17.6.1996 / 17:18:41 / stefan"
- "Modified: 4.1.1997 / 15:57:11 / cg"
-!
-
-keywordExpression
- "parse a keyword-expression; return a node-tree, nil or #Error.
-
- keywordExpression ::= binaryexpression
- | { KEYWORD-PART binaryExpression }
- "
-
- |receiver sel arg args posR1 posR2 pos1 pos2 try lno note|
-
- posR1 := tokenPosition.
- receiver := self binaryExpression.
- (receiver == #Error) ifTrue:[^ #Error].
- (tokenType == #Keyword) ifTrue:[
- self markSelectorFrom:tokenPosition to:(tokenPosition + tokenName size - 1).
- pos1 := posR2 := tokenPosition.
- pos2 := tokenPosition + tokenName size - 1.
- sel := tokenName.
- lno := tokenLineNr.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := Array with:arg.
- [tokenType == #Keyword] whileTrue:[
- self markSelectorFrom:tokenPosition to:(tokenPosition + tokenName size - 1).
- sel := sel , tokenName.
- pos2 := tokenPosition + tokenName size - 1.
- self nextToken.
- arg := self binaryExpression.
- (arg == #Error) ifTrue:[^ #Error].
- args := args copyWith:arg.
- ].
- sel := self selectorCheck:sel for:receiver position:pos1 to:pos2.
- try := MessageNode receiver:receiver selector:sel args:args fold:foldConstants.
- (try isMemberOf:String) ifTrue:[
- self parseError:try position:pos1 to:pos2.
- errorFlag := false. "ok, user wants it - so he'll get it"
- receiver := MessageNode receiver:receiver selector:sel args:args fold:nil.
- note := receiver plausibilityCheck.
- note notNil ifTrue:[
- self warning:note position:pos1 to:pos2
- ].
- ] ifFalse:[
- receiver := try
- ].
- receiver lineNumber:lno.
- parseForCode ifFalse:[self rememberSelectorUsed:sel].
-
- (sel = #and:
- or:[sel = #or:]) ifTrue:[
- receiver arg1 isBlock ifFalse:[
- self warnCommonMistake:'(possible common mistake) missing block brackets ?'
- position:pos2+1 to:tokenPosition-1
- ]
- ].
- (sel = #whileTrue:
- or:[sel = #whileFalse:]) ifTrue:[
- receiver receiver isBlock ifFalse:[
- self warnCommonMistake:'(possible common mistake) missing block brackets ?'
- position:posR1 to:posR2-1
- ]
- ].
- ].
- ^ receiver
-
- "Modified: / 31.3.1998 / 17:54:16 / cg"
-!
-
parseMethod
"parse a method.
Return the parseTree or #Error.
@@ -3385,6 +2927,568 @@
"Modified: 29.5.1996 / 17:24:09 / cg"
!
+statement
+ "parse a statement; return a node-tree or #Error.
+
+ statement ::= '^' expression
+ | PRIMITIVECODE
+ | expression
+ "
+
+ |expr node lnr|
+
+ (tokenType == $^) ifTrue:[
+ lnr := tokenLineNr.
+ self nextToken.
+ expr := self expression.
+ (expr == #Error) ifTrue:[^ #Error].
+ node := ReturnNode expression:expr.
+ node home:self blockHome:currentBlock.
+ (lineNumberInfo == #full) ifTrue:[node lineNumber:lnr].
+ ^ node
+ ].
+
+ (tokenType == #Primitive) ifTrue:[
+ self nextToken.
+ node := PrimitiveNode code:tokenValue.
+ node isOptional ifFalse:[
+ hasNonOptionalPrimitiveCode := true
+ ].
+ hasPrimitiveCode := true.
+ ^ node
+ ].
+
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'period after last statement'.
+ ^ #Error
+ ].
+
+ expr := self expression.
+ (expr == #Error) ifTrue:[^ #Error].
+
+"/ classToCompileFor notNil ifTrue:[
+"/ currentBlock isNil ifTrue:[
+"/ expr isPrimary ifTrue:[
+"/ self warning:'useless computation - missing ^ ?'
+"/ ]
+"/ ]
+"/ ].
+
+ node := StatementNode expression:expr.
+ (lineNumberInfo == #full) ifTrue:[node lineNumber:lnr].
+ ^ node
+
+ "Modified: / 14.5.1998 / 19:32:17 / cg"
+!
+
+statementList
+ "parse a statementlist; return a node-tree, nil or #Error.
+ Statements must be separated by periods.
+
+ statementList ::= <statement>
+ | <statementList> . <statement>
+ "
+
+ |thisStatement prevStatement firstStatement correctIt periodPos
+ prevExpr|
+
+ thisStatement := self statement.
+ (thisStatement == #Error) ifTrue:[^ #Error].
+ firstStatement := thisStatement.
+ [tokenType == $.] whileTrue:[
+ prevExpr := thisStatement expression.
+ (prevExpr notNil and:[prevExpr isMessage]) ifTrue:[
+ (#(#'=' #'==') includes:prevExpr selector) ifTrue:[
+ self warning:'useless computation - mistyped assignment ?'
+ ].
+ ].
+
+ periodPos := tokenPosition.
+ self nextToken.
+ (tokenType == $]) ifTrue:[
+ currentBlock isNil ifTrue:[
+ self parseError:'block nesting error'.
+ errorFlag := true
+"
+ *** I had a warning here (since it was not defined
+ *** in the blue-book; but PD-code contains a lot of
+ *** code with periods at the end so that the warnings
+ *** became annoying
+
+ ] ifFalse:[
+ self warning:'period after last statement' position:periodPos
+"
+ ].
+ ^ firstStatement
+ ].
+ (tokenType == #EOF) ifTrue:[
+ currentBlock notNil ifTrue:[
+ self parseError:'block nesting error (expected '']'')'.
+ errorFlag := true
+"
+ *** I had a warning here (since it was not defined
+ *** in the blue-book; but PD-code contains a lot of
+ *** code with periods at the end so that the warnings
+ *** became annoying
+
+ ] ifFalse:[
+ self warning:'period after last statement' position:periodPos
+"
+ ].
+ ^ firstStatement
+ ].
+
+ prevStatement := thisStatement.
+ prevStatement isReturnNode ifTrue:[
+ self warning:'statements after return' position:tokenPosition
+ ].
+"
+ periodPos := tokenPosition.
+ self nextToken.
+"
+
+ ((tokenType == $]) or:[tokenType == #EOF]) ifTrue:[
+ (currentBlock isNil and:[tokenType == $]]) ifTrue:[
+ self parseError:'block nesting error'.
+ errorFlag := true
+ ] ifFalse:[
+ correctIt := self correctableError:'period after last statement in block'
+ position:periodPos to:(periodPos + 1).
+ correctIt ifTrue:[
+ (self correctByDeleting == #Error) ifTrue:[
+ errorFlag := true
+ ]
+ ]
+ ].
+ ^ firstStatement
+ ].
+ thisStatement := self statement.
+ (thisStatement == #Error) ifTrue:[^ #Error].
+ prevStatement nextStatement:thisStatement
+ ].
+ ^ firstStatement
+
+ "Modified: 14.4.1997 / 20:46:46 / cg"
+! !
+
+!Parser methodsFor:'parsing-expressions'!
+
+array
+ |arr elements elem pos1|
+
+ pos1 := tokenPosition.
+ elements := OrderedCollection new:20.
+ [tokenType ~~ $) ] whileTrue:[
+ elem := self arrayConstant.
+ (elem == #Error) ifTrue:[
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'unterminated array-constant; '')'' expected'
+ position:pos1 to:tokenPosition
+ ].
+ ^ #Error
+ ].
+ elem isSymbol ifTrue:[
+ self markSymbolFrom:tokenPosition to:(source position-1).
+ ].
+ elements add:elem.
+ self nextToken
+ ].
+ arr := Array withAll:elements.
+
+ (ArraysAreImmutable and:[ImmutableArray notNil]) ifTrue:[
+ arr changeClassTo:ImmutableArray.
+ ].
+ ^ arr
+
+ "Modified: / 14.4.1998 / 17:03:29 / cg"
+!
+
+arrayConstant
+ (tokenType == #Nil) ifTrue:[
+ ^ nil
+ ].
+ ((tokenType == #Integer)
+ or:[tokenType == #Float]) ifTrue:[
+ ^ tokenValue
+ ].
+ ((tokenType == #String)
+ or:[tokenType == #Character]) ifTrue:[
+ ^ tokenValue
+ ].
+ (tokenType == #True) ifTrue:[
+ ^ true
+ ].
+ (tokenType == #False) ifTrue:[
+ ^ false
+ ].
+ (tokenType == #Error) ifTrue:[
+ ^ #Error
+ ].
+ (tokenType == #BinaryOperator) ifTrue:[
+ ^ tokenName asSymbol
+ ].
+
+ "/ some more special symbol consts ...
+ (tokenType == $| ) ifTrue:[
+ ^ #|
+ ].
+ (tokenType == #Self ) ifTrue:[
+ ^ #'self'
+ ].
+ (tokenType == #Super ) ifTrue:[
+ ^ #'super'
+ ].
+ (tokenType == #Here ) ifTrue:[
+ ^ #'here'
+ ].
+ (tokenType == #ThisContext ) ifTrue:[
+ ^ #'thisContext'
+ ].
+
+ ((tokenType == #Keyword)
+ or:[tokenType == #Identifier]) ifTrue:[
+ ^ tokenName asSymbol
+ ].
+ ((tokenType == $()
+ or:[tokenType == #HashLeftParen]) ifTrue:[
+ self nextToken.
+ ^ self array
+ ].
+ ((tokenType == $[)
+ or:[tokenType == #HashLeftBrack]) ifTrue:[
+ self nextToken.
+ ^ self byteArray
+ ].
+ (tokenType == #Symbol) ifTrue:[
+ ^ tokenValue
+ ].
+ (tokenType == #EOF) ifTrue:[
+ "just for the better error-hilight; let caller handle error"
+ ^ #Error
+ ].
+ self syntaxError:('error in array-constant; '
+ , tokenType printString
+ , ' unexpected').
+ ^ #Error
+
+ "Modified: / 14.4.1998 / 18:22:54 / cg"
+!
+
+binaryExpression
+ "parse a binary-expression; return a node-tree, nil or #Error"
+
+ |receiver arg sel pos try lno note|
+
+ receiver := self unaryExpression.
+ (receiver == #Error) ifTrue:[^ #Error].
+
+ "special kludge: since Scanner cannot know if -digit is a binary
+ expression or a negative constant, handle cases here"
+
+ [(tokenType == #BinaryOperator)
+ or:[(tokenType == $|)
+ or:[((tokenType == #Integer) or:[tokenType == #Float])
+ and:[tokenValue < 0]]]
+ ] whileTrue:[
+ pos := tokenPosition.
+
+ lno := tokenLineNr.
+
+ "kludge here: bar and minus are not scanned as binop "
+ (tokenType == $|) ifTrue:[
+ sel := '|'.
+ self nextToken
+ ] ifFalse:[
+ (tokenType == #BinaryOperator) ifTrue:[
+ sel := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
+ self nextToken
+ ] ifFalse:[
+ sel := '-'.
+ tokenValue := tokenValue negated
+ ]
+ ].
+ self markSelectorFrom:pos to:(pos + sel size - 1).
+
+ arg := self unaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ try := BinaryNode receiver:receiver selector:sel arg:arg fold:foldConstants.
+ (try isMemberOf:String) ifTrue:[
+ self parseError:try position:pos to:tokenPosition.
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ receiver := BinaryNode receiver:receiver selector:sel arg:arg fold:nil.
+ note := receiver plausibilityCheck.
+ note notNil ifTrue:[
+ self warning:note position:pos to:tokenPosition
+ ].
+ ] ifFalse:[
+ receiver := try
+ ].
+ receiver lineNumber:lno.
+ receiver selectorPosition:pos.
+ parseForCode ifFalse:[self rememberSelectorUsed:sel].
+ ].
+ ^ receiver
+
+ "Modified: / 9.1.1998 / 19:05:18 / stefan"
+ "Modified: / 31.3.1998 / 18:17:29 / cg"
+!
+
+byteArray
+ "started with ST-80 R4 - allow byteArray constants as #[ ... ]"
+
+ |bytes index limit newArray elem pos1 pos2|
+
+ pos1 := tokenPosition.
+ bytes := ByteArray uninitializedNew:5000.
+ index := 0. limit := 5000.
+ [tokenType ~~ $] ] whileTrue:[
+ pos2 := tokenPosition.
+ "
+ this is not good programming style, but speeds up
+ reading of huge byte arrays (i.e. stored Images ...)
+ "
+ (tokenType == #Integer) ifTrue:[
+ elem := tokenValue
+ ] ifFalse:[
+ elem := self arrayConstant.
+ (elem == #Error) ifTrue:[
+ (tokenType == #EOF) ifTrue:[
+ self syntaxError:'unterminated bytearray-constant; '']'' expected'
+ position:pos1 to:tokenPosition
+ ].
+ ^ #Error
+ ].
+ ].
+ ((elem isMemberOf:SmallInteger) and:[elem between:0 and:255]) ifTrue:[
+ index := index + 1.
+ bytes at:index put:elem.
+ index == limit ifTrue:[
+ newArray := ByteArray uninitializedNew:(limit * 2).
+ newArray replaceFrom:1 to:limit with:bytes startingAt:1.
+ limit := limit * 2.
+ bytes := newArray
+ ].
+ ] ifFalse:[
+ self parseError:'invalid ByteArray element' position:pos2 to:tokenPosition - 1
+ ].
+ self nextToken.
+ ].
+ newArray := ByteArray uninitializedNew:index.
+ newArray replaceFrom:1 to:index with:bytes startingAt:1.
+ ^ newArray
+!
+
+degeneratedKeywordExpressionForSelector
+ "parse a keyword-expression without receiver - for the selector
+ only. return the selector or nil. This is not used in normal parsing,
+ but instead to extract the selector from a code fragment.
+ (for example, the system browsers implementors-function uses this)"
+
+ |sel arg rec|
+
+ (tokenType == #Keyword) ifTrue:[
+ sel := tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ sel].
+ [tokenType == #Keyword] whileTrue:[
+ sel := sel , tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ sel].
+ ].
+ ^ sel
+ ].
+
+ (rec := self primary) ~~ #Error ifTrue:[
+ sel := self degeneratedKeywordExpressionForSelector.
+ sel isNil ifTrue:[
+ rec isMessage ifTrue:[
+ sel := rec selector
+ ] ifFalse:[
+ rec isAssignment ifTrue:[
+ rec expression isMessage ifTrue:[
+ sel := rec expression selector
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ sel
+!
+
+expression
+ "parse a cascade-expression; return a node-tree, nil or #Error.
+
+ expression ::= keywordExpression
+ | keywordExpression cascade
+
+ cascade ::= ';' expressionSendPart
+ | cascade ';' expressionSendPart
+
+ expressionSendPart ::= { KEYWORD binaryExpression }
+ | BINARYOPERATOR unaryExpression
+ | IDENTIFIER
+ "
+
+ |receiver arg sel args pos pos2 lno|
+
+ pos := tokenPosition.
+ receiver := self keywordExpression.
+ (receiver == #Error) ifTrue:[^ #Error].
+ (tokenType == $;) ifTrue:[
+ [tokenType == $;] whileTrue:[
+ receiver isMessage ifFalse:[
+ self syntaxError:'left side of cascade must be a message expression'
+ position:pos to:tokenPosition
+ ].
+ self nextToken.
+ (tokenType == #Identifier) ifTrue:[
+ self markSelectorFrom:tokenPosition to:(tokenPosition + tokenName size - 1).
+ sel := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
+ receiver := CascadeNode receiver:receiver selector:sel.
+ receiver lineNumber:tokenLineNr.
+ parseForCode ifFalse:[self rememberSelectorUsed:sel].
+ self nextToken.
+ ] ifFalse:[
+ (tokenType == #BinaryOperator) ifTrue:[
+ self markSelectorFrom:tokenPosition to:(tokenPosition + tokenName size - 1).
+ sel := self selectorCheck:tokenName for:receiver position:tokenPosition to:(tokenPosition + tokenName size - 1).
+ lno := tokenLineNr.
+ self nextToken.
+ arg := self unaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ receiver := CascadeNode receiver:receiver selector:sel arg:arg.
+ receiver lineNumber:lno.
+ parseForCode ifFalse:[self rememberSelectorUsed:sel].
+ ] ifFalse:[
+ (tokenType == #Keyword) ifTrue:[
+ self markSelectorFrom:tokenPosition to:(tokenPosition + tokenName size - 1).
+ pos := tokenPosition.
+ lno := tokenLineNr.
+ sel := tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := Array with:arg.
+ [tokenType == #Keyword] whileTrue:[
+ self markSelectorFrom:pos to:(tokenPosition + tokenName size - 1).
+ sel := sel , tokenName.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := args copyWith:arg.
+ pos2 := tokenPosition
+ ].
+ sel := self selectorCheck:sel for:receiver position:pos to:pos2.
+ receiver := CascadeNode receiver:receiver selector:sel args:args.
+ receiver lineNumber:lno.
+ parseForCode ifFalse:[self rememberSelectorUsed:sel].
+ ] ifFalse:[
+ (tokenType == #Error) ifTrue:[^ #Error].
+ self syntaxError:('invalid cascade; ' , tokenType printString , ' unexpected')
+ position:tokenPosition to:source position - 1.
+ ^ #Error
+ ]
+ ]
+ ]
+ ].
+
+ "obscure (unspecified ?) if selector follows; Question:
+
+ is
+ 'expr sel1; sel2 sel3'
+
+ to be parsed as:
+ (t := expr.
+ t sel1.
+ t sel2) sel3
+
+ or:
+ (t := expr.
+ t sel1.
+ t sel2 sel3)
+ "
+ ((tokenType == #Identifier)
+ or:[(tokenType == #BinaryOperator)
+ or:[tokenType == #Keyword]]) ifTrue:[
+ self syntaxError:'ambigous cascade - please group using ( ...)'
+ position:tokenPosition to:source position - 1.
+ ^ #Error
+ ]
+ ].
+ ^ receiver
+
+ "Modified: / 1.4.1998 / 13:16:08 / cg"
+!
+
+keywordExpression
+ "parse a keyword-expression; return a node-tree, nil or #Error.
+
+ keywordExpression ::= binaryexpression
+ | { KEYWORD-PART binaryExpression }
+ "
+
+ |receiver sel arg args posR1 posR2 pos1 pos2 try lno note|
+
+ posR1 := tokenPosition.
+ receiver := self binaryExpression.
+ (receiver == #Error) ifTrue:[^ #Error].
+ (tokenType == #Keyword) ifTrue:[
+ self markSelectorFrom:tokenPosition to:(tokenPosition + tokenName size - 1).
+ pos1 := posR2 := tokenPosition.
+ pos2 := tokenPosition + tokenName size - 1.
+ sel := tokenName.
+ lno := tokenLineNr.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := Array with:arg.
+ [tokenType == #Keyword] whileTrue:[
+ self markSelectorFrom:tokenPosition to:(tokenPosition + tokenName size - 1).
+ sel := sel , tokenName.
+ pos2 := tokenPosition + tokenName size - 1.
+ self nextToken.
+ arg := self binaryExpression.
+ (arg == #Error) ifTrue:[^ #Error].
+ args := args copyWith:arg.
+ ].
+ sel := self selectorCheck:sel for:receiver position:pos1 to:pos2.
+ try := MessageNode receiver:receiver selector:sel args:args fold:foldConstants.
+ (try isMemberOf:String) ifTrue:[
+ self parseError:try position:pos1 to:pos2.
+ errorFlag := false. "ok, user wants it - so he'll get it"
+ receiver := MessageNode receiver:receiver selector:sel args:args fold:nil.
+ note := receiver plausibilityCheck.
+ note notNil ifTrue:[
+ self warning:note position:pos1 to:pos2
+ ].
+ ] ifFalse:[
+ receiver := try
+ ].
+ receiver lineNumber:lno.
+ parseForCode ifFalse:[self rememberSelectorUsed:sel].
+
+ (sel = #and:
+ or:[sel = #or:]) ifTrue:[
+ receiver arg1 isBlock ifFalse:[
+ self warnCommonMistake:'(possible common mistake) missing block brackets ?'
+ position:pos2+1 to:tokenPosition-1
+ ]
+ ].
+ (sel = #whileTrue:
+ or:[sel = #whileFalse:]) ifTrue:[
+ receiver receiver isBlock ifFalse:[
+ self warnCommonMistake:'(possible common mistake) missing block brackets ?'
+ position:posR1 to:posR2-1
+ ]
+ ].
+ ].
+ ^ receiver
+
+ "Modified: / 31.3.1998 / 17:54:16 / cg"
+!
+
primary
"parse a primary-expression; return a node-tree, nil or #Error"
@@ -3785,150 +3889,6 @@
"Modified: / 14.5.1998 / 19:32:02 / cg"
!
-statement
- "parse a statement; return a node-tree or #Error.
-
- statement ::= '^' expression
- | PRIMITIVECODE
- | expression
- "
-
- |expr node lnr|
-
- (tokenType == $^) ifTrue:[
- lnr := tokenLineNr.
- self nextToken.
- expr := self expression.
- (expr == #Error) ifTrue:[^ #Error].
- node := ReturnNode expression:expr.
- node home:self blockHome:currentBlock.
- (lineNumberInfo == #full) ifTrue:[node lineNumber:lnr].
- ^ node
- ].
-
- (tokenType == #Primitive) ifTrue:[
- self nextToken.
- node := PrimitiveNode code:tokenValue.
- node isOptional ifFalse:[
- hasNonOptionalPrimitiveCode := true
- ].
- hasPrimitiveCode := true.
- ^ node
- ].
-
- (tokenType == #EOF) ifTrue:[
- self syntaxError:'period after last statement'.
- ^ #Error
- ].
-
- expr := self expression.
- (expr == #Error) ifTrue:[^ #Error].
-
-"/ classToCompileFor notNil ifTrue:[
-"/ currentBlock isNil ifTrue:[
-"/ expr isPrimary ifTrue:[
-"/ self warning:'useless computation - missing ^ ?'
-"/ ]
-"/ ]
-"/ ].
-
- node := StatementNode expression:expr.
- (lineNumberInfo == #full) ifTrue:[node lineNumber:lnr].
- ^ node
-
- "Modified: / 14.5.1998 / 19:32:17 / cg"
-!
-
-statementList
- "parse a statementlist; return a node-tree, nil or #Error.
- Statements must be separated by periods.
-
- statementList ::= <statement>
- | <statementList> . <statement>
- "
-
- |thisStatement prevStatement firstStatement correctIt periodPos
- prevExpr|
-
- thisStatement := self statement.
- (thisStatement == #Error) ifTrue:[^ #Error].
- firstStatement := thisStatement.
- [tokenType == $.] whileTrue:[
- prevExpr := thisStatement expression.
- (prevExpr notNil and:[prevExpr isMessage]) ifTrue:[
- (#(#'=' #'==') includes:prevExpr selector) ifTrue:[
- self warning:'useless computation - mistyped assignment ?'
- ].
- ].
-
- periodPos := tokenPosition.
- self nextToken.
- (tokenType == $]) ifTrue:[
- currentBlock isNil ifTrue:[
- self parseError:'block nesting error'.
- errorFlag := true
-"
- *** I had a warning here (since it was not defined
- *** in the blue-book; but PD-code contains a lot of
- *** code with periods at the end so that the warnings
- *** became annoying
-
- ] ifFalse:[
- self warning:'period after last statement' position:periodPos
-"
- ].
- ^ firstStatement
- ].
- (tokenType == #EOF) ifTrue:[
- currentBlock notNil ifTrue:[
- self parseError:'block nesting error (expected '']'')'.
- errorFlag := true
-"
- *** I had a warning here (since it was not defined
- *** in the blue-book; but PD-code contains a lot of
- *** code with periods at the end so that the warnings
- *** became annoying
-
- ] ifFalse:[
- self warning:'period after last statement' position:periodPos
-"
- ].
- ^ firstStatement
- ].
-
- prevStatement := thisStatement.
- prevStatement isReturnNode ifTrue:[
- self warning:'statements after return' position:tokenPosition
- ].
-"
- periodPos := tokenPosition.
- self nextToken.
-"
-
- ((tokenType == $]) or:[tokenType == #EOF]) ifTrue:[
- (currentBlock isNil and:[tokenType == $]]) ifTrue:[
- self parseError:'block nesting error'.
- errorFlag := true
- ] ifFalse:[
- correctIt := self correctableError:'period after last statement in block'
- position:periodPos to:(periodPos + 1).
- correctIt ifTrue:[
- (self correctByDeleting == #Error) ifTrue:[
- errorFlag := true
- ]
- ]
- ].
- ^ firstStatement
- ].
- thisStatement := self statement.
- (thisStatement == #Error) ifTrue:[^ #Error].
- prevStatement nextStatement:thisStatement
- ].
- ^ firstStatement
-
- "Modified: 14.4.1997 / 20:46:46 / cg"
-!
-
unaryExpression
"parse a unary-expression; return a node-tree, nil or #Error"
@@ -4307,6 +4267,48 @@
"Created: 19.12.1996 / 23:51:02 / cg"
"Modified: 14.10.1997 / 20:56:35 / cg"
+!
+
+inWhichClassIsClassInstVar:aString
+ "search class-chain for the class-instance variable named aString
+ - return the class or nil if not found"
+
+ |aClass|
+
+ aClass := classToCompileFor.
+ [aClass notNil] whileTrue:[
+ (aClass class instVarNames includes:aString) ifTrue:[ ^ aClass].
+ aClass := aClass superclass
+ ].
+ ^ nil
+
+ "Modified: 4.1.1997 / 14:42:15 / cg"
+!
+
+inWhichClassIsClassVar:aString
+ "search class-chain for the classvariable named aString
+ - return the class or nil if not found"
+
+ |aClass className baseClass|
+
+ aClass := classToCompileFor.
+ aClass isMeta ifTrue:[
+ className := aClass name copyWithoutLast:6.
+ baseClass := Smalltalk at:(className asSymbol).
+ baseClass notNil ifTrue:[
+ aClass := baseClass
+ ]
+ ].
+ ^ aClass whichClassDefinesClassVar:aString
+
+"/ [aClass notNil] whileTrue:[
+"/ (aClass classVarNames includes:aString) ifTrue:[ ^ aClass].
+"/ aClass := aClass superclass
+"/ ].
+"/ ^ nil
+
+ "Modified: 17.6.1996 / 17:18:41 / stefan"
+ "Modified: 4.1.1997 / 15:57:11 / cg"
! !
!Parser methodsFor:'queries'!
@@ -4612,6 +4614,6 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.173 1998-05-14 17:35:53 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.174 1998-05-14 18:26:18 cg Exp $'
! !
Parser initialize!