--- a/Parser.st Sat Dec 11 02:07:55 1993 +0100
+++ b/Parser.st Sat Dec 11 02:09:49 1993 +0100
@@ -23,7 +23,7 @@
localVarDefPosition
evalExitBlock
selfNode superNode primNr logged
- warnedUndefVars'
+ warnedUndefVars'
classVariableNames:'prevClass prevInstVarNames
prevClassVarNames prevClassInstVarNames'
poolDictionaries:''
@@ -43,7 +43,7 @@
a method - this is done by sending parseXXX message to a parser and asking
the parser for referencedXVars or modifiedXVars (see SystemBrowser).
-$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.3 1993-10-13 02:41:36 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.4 1993-12-11 01:09:03 claus Exp $
'!
!Parser class methodsFor:'evaluating expressions'!
@@ -148,13 +148,51 @@
!Parser class methodsFor:'parsing'!
+selectorInExpression:aString
+ "parse an expression - return the selector. Used for
+ SystemBrowsers implementors/senders query-box initial text"
+
+ |tree parser|
+
+ (aString isNil or:[aString isEmpty]) ifTrue:[^ nil].
+
+ tree := self withSelf:nil parseExpression:aString notifying:nil ignoreErrors:true.
+ (tree notNil and:[tree ~~ #Error]) ifTrue:[
+ tree isMessage ifTrue:[
+ ^ tree selector
+ ].
+ ].
+
+ "mhmh, try expression without receiver"
+
+ parser := self for:(ReadStream on:aString).
+ parser ignoreErrors.
+ parser nextToken.
+ ^ parser degeneratedKeywordExpressionForSelector
+
+"
+ Parser selectorInExpression:'foo at:1 put:(5 * bar)'
+ Parser selectorInExpression:'(foo at:1) at:1'
+ Parser selectorInExpression:'1 + 4'
+ Parser selectorInExpression:'1 negated'
+ Parser selectorInExpression:'at:1 put:5'
+"
+!
+
parseExpression:aString
"parse aString as an expression; return the parseTree"
- ^ self withSelf:nil parseExpression:aString notifying:nil
+ ^ self withSelf:nil parseExpression:aString notifying:nil ignoreErrors:false
!
-withSelf:anObject parseExpression:aString notifying:someOne
+withSelf:anObject parseExpression:aString notifying:someOne
+ "parse aString as an expression with self set to anObject;
+ return the parseTree"
+
+ ^ self withSelf:anObject parseExpression:aString notifying:someOne ignoreErrors:false
+!
+
+withSelf:anObject parseExpression:aString notifying:someOne ignoreErrors:ignore
"parse aString as an expression with self set to anObject;
return the parseTree"
@@ -164,6 +202,7 @@
parser := self for:(ReadStream on:aString).
parser setSelf:anObject.
parser notifying:someOne.
+ ignore ifTrue:[parser ignoreErrors].
parser nextToken.
tree := parser expression.
(parser errorFlag or:[tree == #Error]) ifTrue:[^ #Error].
@@ -264,6 +303,20 @@
prevClassInstVarNames := nil.
aClass removeDependent:Parser
]
+!
+
+flush
+ "unconditional flush name caches"
+
+ prevClass notNil ifTrue:[
+ prevClass removeDependent:Parser
+ ].
+ prevClass := nil.
+ prevInstVarNames := nil.
+ prevClassVarNames := nil.
+ prevClassInstVarNames := nil.
+
+ "Parser flush"
! !
!Parser methodsFor:'setup'!
@@ -452,18 +505,18 @@
corrected"
requestor isNil ifTrue:[
- warnedUndefVars notNil ifTrue:[
- (warnedUndefVars includes:aName) ifTrue:[
- "already warned about this one"
- ^ false
- ].
- ].
- self showErrorMessage:('Error: ' , aName , ' is undefined') position:pos1.
- warnedUndefVars isNil ifTrue:[
- warnedUndefVars := Set new.
- ].
- warnedUndefVars add:aName.
- ^ false
+ warnedUndefVars notNil ifTrue:[
+ (warnedUndefVars includes:aName) ifTrue:[
+ "already warned about this one"
+ ^ false
+ ].
+ ].
+ self showErrorMessage:('Error: ' , aName , ' is undefined') position:pos1.
+ warnedUndefVars isNil ifTrue:[
+ warnedUndefVars := Set new.
+ ].
+ warnedUndefVars add:aName.
+ ^ false
].
^ self correctableError:('Error: ' , aName , ' is undefined')
@@ -550,7 +603,7 @@
((tokenType == #BinaryOperator) and:[tokenName = '<']) ifTrue:[
"an ST-80 primitive - parsed but ignored"
self nextToken.
- primNr := self parsePrimitive.
+ primNr := self parseST80Primitive.
(primNr == #Error) ifTrue:[^ #Error].
self warning:'ST-80 primitives not supported - ignored'
].
@@ -608,8 +661,8 @@
^ nil
!
-parsePrimitive
- "parse an ST-80 type primitive;
+parseST80Primitive
+ "parse an ST-80 type primitive as '< primitive: nr >';
return primitive number or #Error"
|primNumber|
@@ -843,6 +896,28 @@
^ receiver
!
+degeneratedKeywordExpressionForSelector
+ "parse a keyword-expression without receiver - for the selector
+ only. return the selector or nil"
+
+ |receiver sel arg args pos1 pos2 try lno note|
+
+ (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
+ ].
+ ^ nil
+!
+
binaryExpression
"parse a binary-expression; return a node-tree, nil or #Error"
@@ -1156,7 +1231,7 @@
"is it a method-variable ?"
methodVars notNil ifTrue:[
instIndex := methodVarNames indexOf:varName.
- (instIndex ~~ 0) ifTrue:[
+ instIndex ~~ 0 ifTrue:[
var := methodVars at:instIndex.
var used:true.
^ PrimaryNode type:#MethodVariable
@@ -1169,7 +1244,7 @@
"is it a method-argument ?"
methodArgs notNil ifTrue:[
instIndex := methodArgNames indexOf:varName.
- (instIndex ~~ 0) ifTrue:[
+ instIndex ~~ 0 ifTrue:[
^ PrimaryNode type:#MethodArg
name:varName
token:(methodArgs at:instIndex)
@@ -1192,9 +1267,8 @@
prevClass addDependent:Parser
].
- instIndex := prevInstVarNames indexOf:varName startingAt:1
- ifAbsent:[nil].
- instIndex notNil ifTrue:[
+ instIndex := prevInstVarNames indexOf:varName startingAt:1.
+ instIndex ~~ 0 ifTrue:[
usedInstVars isNil ifTrue:[
usedInstVars := OrderedCollection new
].
@@ -1220,10 +1294,8 @@
prevClassInstVarNames := classToCompileFor class allInstVarNames
].
- instIndex := prevClassInstVarNames indexOf:varName startingAt:1
- ifAbsent:[nil].
-
- instIndex notNil ifTrue:[
+ instIndex := prevClassInstVarNames indexOf:varName startingAt:1.
+ instIndex ~~ 0 ifTrue:[
aClass := self inWhichClassIsClassInstVar:varName.
aClass notNil ifTrue:[
usedVars isNil ifTrue:[
@@ -1255,10 +1327,8 @@
prevClassVarNames := aClass allClassVarNames
].
- instIndex := prevClassVarNames indexOf:varName startingAt:1
- ifAbsent:[nil].
-
- instIndex notNil ifTrue:[
+ instIndex := prevClassVarNames indexOf:varName startingAt:1.
+ instIndex ~~ 0 ifTrue:[
aClass := self inWhichClassIsClassVar:varName.
aClass notNil ifTrue:[
usedClassVars isNil ifTrue:[
@@ -1346,8 +1416,9 @@
block
"parse a block; return a node-tree, nil or #Error"
- |stats node args var vars pos|
+ |stats node args var vars pos lno b|
+ lno := tokenLineNr.
self nextToken.
(tokenType == $: ) ifTrue:[
[tokenType == $:] whileTrue:[
@@ -1369,7 +1440,9 @@
(tokenType ~~ $| ) ifTrue:[
"ST-80 allows [:arg ]"
(tokenType == $] ) ifTrue:[
- ^ BlockNode arguments:args home:currentBlock variables:nil.
+ b := BlockNode arguments:args home:currentBlock variables:nil.
+ b lineNumber:lno.
+ ^ b
].
self syntaxError:'| expected after block-arg declaration'.
^ #Error
@@ -1395,6 +1468,7 @@
self nextToken
].
node := BlockNode arguments:args home:currentBlock variables:vars.
+ node lineNumber:lno.
currentBlock := node.
stats := self blockStatementList.
node statements:stats.
@@ -1443,7 +1517,7 @@
!
array
- |arr elem pos1 pos2|
+ |arr elem pos1|
pos1 := tokenPosition.
arr := OrderedCollection new:200.
@@ -1463,7 +1537,8 @@
!
byteArray
- "for ST-80 R4 - allow byteArray constants"
+ "started with ST-80 R4 - allow byteArray constants as #[ ... ]"
+
|arr elem pos1 pos2|
pos1 := tokenPosition.
@@ -1590,7 +1665,7 @@
args notNil ifTrue:[
args do:[:aBlockArg |
names add:(aBlockArg name).
- dists add:(aString levenshteinTo:(aBlockArg name))
+ dists add:(aString spellAgainst: "levenshteinTo:"(aBlockArg name))
]
].
@@ -1598,7 +1673,7 @@
vars notNil ifTrue:[
vars do:[:aBlockVar |
names add:(aBlockVar name).
- dists add:(aString levenshteinTo:(aBlockVar name))
+ dists add:(aString spellAgainst: "levenshteinTo:"(aBlockVar name))
]
].
searchBlock := searchBlock home
@@ -1608,7 +1683,7 @@
methodVars notNil ifTrue:[
methodVarNames do:[:methodVarName |
names add:methodVarName.
- dists add:(aString levenshteinTo:methodVarName)
+ dists add:(aString spellAgainst: "levenshteinTo:"methodVarName)
]
].
@@ -1616,7 +1691,7 @@
methodArgs notNil ifTrue:[
methodArgNames do:[:methodArgName |
names add:methodArgName.
- dists add:(aString levenshteinTo:methodArgName)
+ dists add:(aString spellAgainst: "levenshteinTo:"methodArgName)
]
].
@@ -1624,12 +1699,18 @@
classToCompileFor notNil ifTrue:[
prevInstVarNames do:[:instVarName |
names add:instVarName.
- dists add:(aString levenshteinTo:instVarName)
+ dists add:(aString spellAgainst: "levenshteinTo:"instVarName)
]
].
"class-variables"
classToCompileFor notNil ifTrue:[
+ prevClassVarNames do:[:classVarName |
+ names add:classVarName.
+ dists add:(aString spellAgainst: "levenshteinTo:"classVarName)
+ ].
+
+false ifTrue:[
aClass := classToCompileFor.
aClass isMeta ifTrue:[
className := aClass name.
@@ -1642,10 +1723,11 @@
[aClass notNil] whileTrue:[
(aClass classVarNames) do:[:classVarName |
names add:classVarName.
- dists add:(aString levenshteinTo:classVarName)
+ dists add:(aString spellAgainst: "levenshteinTo:"classVarName)
].
aClass := aClass superclass
]
+].
].
"globals"
@@ -1654,21 +1736,21 @@
"only compare strings where length is about right"
((globalVarName size - aString size) abs < 3) ifTrue:[
names add:globalVarName.
- dists add:(aString levenshteinTo:globalVarName)
+ dists add:(aString spellAgainst: "levenshteinTo:"globalVarName)
]
].
"misc"
- #('self' 'super' 'nil') do:[:name |
+ #('self' 'super' 'nil' 'thisContext') do:[:name |
"only compare strings where length is about right"
- ((name size - aString size) abs < 3) ifTrue:[
- names add:name.
- dists add:(aString levenshteinTo:name)
- ]
+ names add:name.
+ dists add:(aString spellAgainst: "levenshteinTo:"name)
].
(dists size ~~ 0) ifTrue:[
dists sortWith:names.
+ dists := dists reverse.
+ names := names reverse.
n := names size min:10.
^ names copyFrom:1 to:n
].
--- a/PrimaryNd.st Sat Dec 11 02:07:55 1993 +0100
+++ b/PrimaryNd.st Sat Dec 11 02:09:49 1993 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Attic/PrimaryNd.st,v 1.3 1993-10-13 02:41:41 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/PrimaryNd.st,v 1.4 1993-12-11 01:09:30 claus Exp $
written 88 by claus
'!
@@ -436,6 +436,10 @@
!PrimaryNode methodsFor:'printing'!
+displayString
+ ^ 'InterpreterVariable(' , self printString , ')'
+!
+
printOn:aStream indent:i
(type == #Self) ifTrue:[
aStream nextPutAll:'self'. ^ self
--- a/PrimaryNode.st Sat Dec 11 02:07:55 1993 +0100
+++ b/PrimaryNode.st Sat Dec 11 02:09:49 1993 +0100
@@ -22,7 +22,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/PrimaryNode.st,v 1.3 1993-10-13 02:41:41 claus Exp $
+$Header: /cvs/stx/stx/libcomp/PrimaryNode.st,v 1.4 1993-12-11 01:09:30 claus Exp $
written 88 by claus
'!
@@ -436,6 +436,10 @@
!PrimaryNode methodsFor:'printing'!
+displayString
+ ^ 'InterpreterVariable(' , self printString , ')'
+!
+
printOn:aStream indent:i
(type == #Self) ifTrue:[
aStream nextPutAll:'self'. ^ self
--- a/Scanner.st Sat Dec 11 02:07:55 1993 +0100
+++ b/Scanner.st Sat Dec 11 02:09:49 1993 +0100
@@ -16,8 +16,8 @@
tokenName tokenLineNr
thisChar peekChar
requestor exitBlock
- errorFlag
- saveComments currentComments'
+ errorFlag ignoreErrors
+ saveComments currentComments'
classVariableNames:'typeArray actionArray'
poolDictionaries:''
category:'System-Compiler'
@@ -29,7 +29,7 @@
All Rights Reserved
Scanner reads from a stream and returns individual smalltalk tokens
-$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.3 1993-10-13 02:41:45 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Scanner.st,v 1.4 1993-12-11 01:09:49 claus Exp $
'!
!Scanner class methodsFor:'instance creation'!
@@ -53,6 +53,7 @@
source := aStream.
currentComments := nil.
saveComments := false.
+ ignoreErrors := false.
actionArray isNil ifTrue:[
actionArray := Array new:256.
@@ -100,6 +101,7 @@
tokenLineNr := 1.
currentComments := nil.
saveComments := false.
+ ignoreErrors := false.
!
notifying:anObject
@@ -108,6 +110,12 @@
requestor := anObject
!
+ignoreErrors
+ "turn off notification of errors"
+
+ ignoreErrors := true
+!
+
backupPosition
"if reading from a stream, at the end we might have read
one token too many"
@@ -122,7 +130,9 @@
showErrorMessage:aMessage position:pos
"show an errormessage on the Transcript"
- Transcript showCr:(pos printString , ' ' , aMessage)
+ ignoreErrors ifFalse:[
+ Transcript showCr:(pos printString , ' ' , aMessage)
+ ]
!
notifyError:aMessage position:position to:endPos
@@ -134,6 +144,7 @@
self showErrorMessage:aMessage position:position.
^ false
].
+
^ requestor error:aMessage position:position to:endPos
!
@@ -190,29 +201,34 @@
!Scanner methodsFor:'reading next token'!
skipComment
- |comment|
+ |comment startPos|
comment := ''.
+ startPos := source position.
source next.
thisChar := source peek.
[thisChar notNil and:[thisChar ~~ (Character doubleQuote)]] whileTrue:[
thisChar == (Character cr) ifTrue:[
tokenLineNr := tokenLineNr + 1.
].
- saveComments ifTrue:[
- comment := comment copyWith:thisChar
- ].
+ saveComments ifTrue:[
+ comment := comment copyWith:thisChar
+ ].
source next.
thisChar := source peek
].
saveComments ifTrue:[
currentComments isNil ifTrue:[
- currentComments := OrderedCollection with:comment
+ currentComments := OrderedCollection with:comment
] ifFalse:[
- currentComments add:comment
+ currentComments add:comment
]
].
+
+ thisChar isNil ifTrue:[
+ self warning:'unclosed comment' position:startPos to:(source position)
+ ].
"skip final dQuote"
source next.
!
@@ -234,9 +250,9 @@
source next
] ifFalse:[
thisChar == (Character doubleQuote) ifTrue:[
- "start of a comment"
+ "start of a comment"
- self skipComment.
+ self skipComment.
thisChar := source peek.
] ifFalse:[
skipping := false
@@ -519,7 +535,7 @@
nextChar := source peek.
(nextChar == $:) ifFalse:[
tokenValue := string asSymbol.
- tokenType := #Symbol.
+ tokenType := #Symbol.
^ tokenType
].
string := string copyWith:nextChar.