--- a/Parser.st Thu Jul 25 16:14:36 2002 +0200
+++ b/Parser.st Thu Jul 25 18:46:04 2002 +0200
@@ -28,13 +28,15 @@
alreadyWarnedClassInstVarRefs localBlockVarDefPosition
endOfSelectorPosition startOfBlockPosition primitiveContextInfo
usedLocalVars modifiedLocalVars alreadyWarnedUninitializedVars
- alreadyWarnedUnimplementedSelectors returnedValues currentPackage'
+ alreadyWarnedUnimplementedSelectors returnedValues currentPackage
+ doItTemporaries'
classVariableNames:'PrevClass PrevInstVarNames PrevClassVarNames
PrevClassInstVarNames LazyCompilation ArraysAreImmutable
ImplicitSelfSends WarnST80Directives WarnUnusedVars FoldConstants
LineNumberInfo SuppressDoItCompilation StringsAreImmutable
ParseErrorSignal RestartCompilationSignal
- AllowFunctionCallSyntaxForBlockEvaluation'
+ AllowFunctionCallSyntaxForBlockEvaluation AllowLazyValueExtension
+ AllowVariableReferences'
poolDictionaries:''
category:'System-Compiler'
!
@@ -2137,6 +2139,16 @@
!Parser methodsFor:'error correction'!
+addDoItTemporary:varName
+ |holder|
+
+ doItTemporaries isNil ifTrue:[
+ doItTemporaries := IdentityDictionary new.
+ ].
+ doItTemporaries at:varName asSymbol put:(holder := ValueHolder new).
+ ^ holder
+!
+
askForCorrection:aString fromList:aList
"launch a selection box, which allows user to enter correction.
return newString or nil (for abort)"
@@ -2156,6 +2168,163 @@
^ nil
!
+askForVariableTypeWhenDeclaringUndefined:varName
+ |l how varNameIsLowercase choice holder newClass|
+
+ l := #().
+ how := #().
+
+ varNameIsLowercase := (varName at:1) isLowercase.
+
+ "/ BlockVar, InstVar and classInstVar not yet implemented
+ varNameIsLowercase ifTrue:[
+"/ currentBlock notNil ifTrue:[
+"/ l := l , #( 'Block local' ).
+"/ how := how , #( BlockVariable ).
+"/ ].
+ selector notNil ifTrue:[
+ l := l , #( 'Method Local Variable' ).
+ how := how , #( MethodVariable ).
+ ].
+ (classToCompileFor notNil
+ and:[classToCompileFor isMeta not
+ and:[classToCompileFor isBuiltInClass not
+ and:[selector notNil and:[selector ~~ #doIt]]]]) ifTrue:[
+ l := l copyWith:'Instance Variable'.
+ how := how copyWith: #InstanceVariable.
+ ].
+ ] ifFalse:[
+ l := l , #( 'New Class' 'Global' 'NameSpace' ).
+ how := how , #( NewClass GlobalVariable NameSpace ).
+
+ (classToCompileFor notNil
+ and:[classToCompileFor isBuiltInClass not
+ and:[selector notNil and:[selector ~~ #doIt]]]) ifTrue:[
+ classToCompileFor isMeta ifTrue:[
+ l := l , #('Class Instance Variable').
+ how := how , #( ClassInstanceVariable).
+ ].
+ l := l , #('Class Variable' ).
+ how := how , #( ClassVariable).
+ ]
+ ].
+ (selector isNil or:[selector == #doIt]) ifTrue:[
+ l size > 0 ifTrue:[
+ l := l , #( '-' ).
+ how := how , #( nil ).
+ ].
+ l := l , #( 'Workspace Variable' 'DoIt Temporary').
+ how := how , #( WorkspaceVariable DoItTemporary ).
+ ].
+
+ l size > 0 ifTrue:[
+ l := (Array with:('Declare ' , varName allBold , ' as:')
+ with:'-'
+ ) , l.
+ how := #(nil nil) , how.
+ choice := (PopUpMenu labels:l) startUp.
+ (choice notNil and:[choice > 0]) ifTrue:[
+ choice := how at:choice.
+
+ choice == #WorkspaceVariable ifTrue:[
+ holder := Workspace addWorkspaceVariable:varName.
+ ^ VariableNode type:#WorkspaceVariable holder:holder name:varName
+ ].
+ choice == #DoItTemporary ifTrue:[
+ holder := self addDoItTemporary:varName.
+ ^ VariableNode type:#DoItTemporary holder:holder name:varName
+ ].
+
+ choice == #GlobalVariable ifTrue:[
+ Smalltalk at:varName asSymbol put:nil.
+ ^ VariableNode type:#GlobalVariable name:varName asSymbol
+ ].
+
+ choice == #NewClass ifTrue:[
+ newClass := Object subclass:varName asSymbol
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'* As yet uncategorized *'.
+ ^ VariableNode type:#GlobalVariable name:newClass name asSymbol
+ ].
+
+ choice == #NameSpace ifTrue:[
+ NameSpace name:varName.
+ ^ VariableNode type:#GlobalVariable name:varName asSymbol
+ ].
+
+ choice == #ClassVariable ifTrue:[
+ classToCompileFor theNonMetaclass addClassVarName:varName.
+ ^ VariableNode type:#ClassVariable class:classToCompileFor theNonMetaclass name:varName
+ ].
+
+ choice == #InstanceVariable ifTrue:[
+ classToCompileFor theNonMetaclass addInstVarName:varName.
+ "/ ST/X special - classToCompileFor is obsoleted
+ classToCompileFor := Smalltalk classNamed:(classToCompileFor name).
+ RestartCompilationSignal raise.
+ "/ not reached - restarted compile will not arrive here again
+ self error:'restart compile failed'.
+ ].
+
+ choice == #ClassInstanceVariable ifTrue:[
+ classToCompileFor theMetaclass addInstVarName:varName.
+ "/ ST/X special - classToCompileFor is obsoleted
+ classToCompileFor := Smalltalk classNamed:(classToCompileFor name).
+ RestartCompilationSignal raise.
+ "/ not reached - restarted compile will not arrive here again
+ self error:'restart compile failed'.
+ ].
+
+ choice == #MethodVariable ifTrue:[
+ |varIndex var endLocalsPos posToInsert ins|
+
+ localVarDefPosition size == 2 ifTrue:[
+ endLocalsPos := posToInsert := localVarDefPosition at:2.
+ ins := ' ' , varName.
+ ] ifFalse:[
+ endOfSelectorPosition notNil ifTrue:[
+ posToInsert := endOfSelectorPosition.
+ ins := '|' , varName , '|' , Character cr asString , Character cr asString.
+ ins := ins , (String new:(requestor colOfCharacterPosition:posToInsert)-1).
+ ]
+ ].
+ posToInsert notNil ifTrue:[
+ requestor
+ insertString:ins
+ atCharacterPosition:posToInsert.
+
+ endLocalsPos notNil ifTrue:[
+ localVarDefPosition at:2 put:(endLocalsPos + varName size + 1).
+
+ methodVarNames := methodVarNames copyWith:varName.
+ methodVars := methodVars copyWith:(var := Variable new name:varName).
+ ] ifFalse:[
+ localVarDefPosition := Array with:posToInsert with:posToInsert+varName size+1.
+
+ methodVarNames := Array with:varName.
+ methodVars := Array with:(var := Variable new name:varName).
+ ].
+ correctedSource := requestor currentSourceCode.
+ source := (ReadStream on:correctedSource)
+ position:(source position + ins size).
+
+ varIndex := methodVarNames size.
+ var used:true.
+ ^ VariableNode type:#MethodVariable
+ name:varName
+ token:var
+ index:varIndex
+ ].
+ ].
+ self warning:'Sorry - unimplemented (adding ' , choice , ')'.
+ ].
+ ^ #Error
+ ].
+ ^ nil.
+!
+
checkForEndOfInput
(tokenType ~~ #EOF) ifTrue:[
self parseError:'nothing more expected here' position:tokenPosition to:tokenPosition.
@@ -2348,7 +2517,7 @@
or a ParseNode as returned by variable"
|correctIt varName suggestedNames newName pos1 pos2 rslt
- varNameIsLowercase l how choice holder undeclared newClass boldName|
+ varNameIsLowercase undeclared boldName|
pos1 := tokenPosition.
varName := tokenName.
@@ -2396,144 +2565,10 @@
correctIt == #declare ifTrue:[
"/ declare it
- l := #().
- how := #().
-
- "/ BlockVar, InstVar and classInstVar not yet implemented
- varNameIsLowercase ifTrue:[
-"/ currentBlock notNil ifTrue:[
-"/ l := l , #( 'Block local' ).
-"/ how := how , #( BlockVariable ).
-"/ ].
- selector notNil ifTrue:[
- l := l , #( 'Method Local Variable' ).
- how := how , #( MethodVariable ).
- ].
- (classToCompileFor notNil
- and:[classToCompileFor isMeta not
- and:[classToCompileFor isBuiltInClass not
- and:[selector notNil and:[selector ~~ #doIt]]]]) ifTrue:[
- l := l copyWith:'Instance Variable'.
- how := how copyWith: #InstanceVariable.
- ].
- ] ifFalse:[
- l := l , #( 'New Class' 'Global' 'NameSpace' ).
- how := how , #( NewClass GlobalVariable NameSpace ).
-
- (classToCompileFor notNil
- and:[classToCompileFor isBuiltInClass not
- and:[selector notNil and:[selector ~~ #doIt]]]) ifTrue:[
- classToCompileFor isMeta ifTrue:[
- l := l , #('Class Instance Variable').
- how := how , #( ClassInstanceVariable).
- ].
- l := l , #('Class Variable' ).
- how := how , #( ClassVariable).
- ]
- ].
- (selector isNil or:[selector == #doIt]) ifTrue:[
- l size > 0 ifTrue:[
- l := l , #( '-' ).
- how := how , #( nil ).
- ].
- l := l , #( 'Workspace Variable' ).
- how := how , #( WorkspaceVariable ).
- ].
- l size > 0 ifTrue:[
- l := (Array with:('Declare ' , varName allBold , ' as:')
- with:'-'
- ) , l.
- how := #(nil nil) , how.
- choice := (PopUpMenu labels:l) startUp.
- (choice notNil and:[choice > 0]) ifTrue:[
- choice := how at:choice.
-
- choice == #WorkspaceVariable ifTrue:[
- holder := Workspace addWorkspaceVariable:varName.
- ^ VariableNode type:#WorkspaceVariable holder:holder name:varName
- ].
- choice == #GlobalVariable ifTrue:[
- Smalltalk at:varName asSymbol put:nil.
- ^ VariableNode type:#GlobalVariable name:varName asSymbol
- ].
- choice == #NewClass ifTrue:[
- newClass := Object subclass:varName asSymbol
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'* As yet uncategorized *'.
- ^ VariableNode type:#GlobalVariable name:newClass name asSymbol
- ].
-
- choice == #NameSpace ifTrue:[
- NameSpace name:varName.
- ^ VariableNode type:#GlobalVariable name:varName asSymbol
- ].
- choice == #ClassVariable ifTrue:[
- classToCompileFor theNonMetaclass addClassVarName:varName.
- ^ VariableNode type:#ClassVariable class:classToCompileFor theNonMetaclass name:varName
- ].
- choice == #InstanceVariable ifTrue:[
- classToCompileFor theNonMetaclass addInstVarName:varName.
- "/ ST/X special - classToCompileFor is obsoleted
- classToCompileFor := Smalltalk classNamed:(classToCompileFor name).
- RestartCompilationSignal raise.
- "/ not reached - restarted compile will not arrive here again
- self error:'restart compile failed'.
- ].
- choice == #ClassInstanceVariable ifTrue:[
- classToCompileFor theMetaclass addInstVarName:varName.
- "/ ST/X special - classToCompileFor is obsoleted
- classToCompileFor := Smalltalk classNamed:(classToCompileFor name).
- RestartCompilationSignal raise.
- "/ not reached - restarted compile will not arrive here again
- self error:'restart compile failed'.
- ].
- choice == #MethodVariable ifTrue:[
- |varIndex var endLocalsPos posToInsert ins|
-
- localVarDefPosition size == 2 ifTrue:[
- endLocalsPos := posToInsert := localVarDefPosition at:2.
- ins := ' ' , varName.
- ] ifFalse:[
- endOfSelectorPosition notNil ifTrue:[
- posToInsert := endOfSelectorPosition.
- ins := '|' , varName , '|' , Character cr asString , Character cr asString.
- ins := ins , (String new:(requestor colOfCharacterPosition:posToInsert)-1).
- ]
- ].
- posToInsert notNil ifTrue:[
- requestor
- insertString:ins
- atCharacterPosition:posToInsert.
-
- endLocalsPos notNil ifTrue:[
- localVarDefPosition at:2 put:(endLocalsPos + varName size + 1).
-
- methodVarNames := methodVarNames copyWith:varName.
- methodVars := methodVars copyWith:(var := Variable new name:varName).
- ] ifFalse:[
- localVarDefPosition := Array with:posToInsert with:posToInsert+varName size+1.
-
- methodVarNames := Array with:varName.
- methodVars := Array with:(var := Variable new name:varName).
- ].
- correctedSource := requestor currentSourceCode.
- source := (ReadStream on:correctedSource)
- position:(source position + ins size).
-
- varIndex := methodVarNames size.
- var used:true.
- ^ VariableNode type:#MethodVariable
- name:varName
- token:var
- index:varIndex
- ].
- ].
- self warning:'Sorry - unimplemented (adding ' , choice , ')'.
- ].
- ^ #Error
- ]
+ rslt := self askForVariableTypeWhenDeclaringUndefined:varName.
+ rslt notNil ifTrue:[
+ ^ rslt
+ ].
].
suggestedNames := self findBestVariablesFor:varName.
@@ -4904,14 +4939,15 @@
].
"/ EXPERIMENTAL - may be in next release
-false ifTrue:[
- ((tokenType == #BinaryOperator) and:[token = '&']) ifTrue:[
- self nextToken.
- node := self primary_identifier.
- "/ generate a Reference
- ^ self makeReferenceFor:node
- ].
-].
+ AllowVariableReferences == true ifTrue:[
+ ((tokenType == #BinaryOperator) and:[token = '&']) ifTrue:[
+ self nextToken.
+ node := self primary_identifier.
+ "/ generate a Reference
+ ^ self makeReferenceFor:node
+ ].
+ ].
+
(tokenType == ${ ) ifTrue:[
AllowSqueakExtensions ifFalse:[
self parseError:'non-Standard Squeak extension (enable in settings)' position:pos to:tokenPosition.
@@ -4929,12 +4965,27 @@
].
tokenType == #HashHashLeftParen ifTrue:[
- AllowDolphinExtensions ifFalse:[
+ self nextToken.
+ AllowDolphinExtensions == true ifFalse:[
self parseError:'non-Standard Dolphin extension (enable in settings)' position:pos to:tokenPosition.
^ #Error
].
^ self primary_dolphinComputedLiteral.
].
+ tokenType == #HashHashLeftBrack ifTrue:[
+ self nextToken.
+ AllowLazyValueExtension == true ifFalse:[
+ self parseError:'non-Standard LazyValue extension (enable in classVariable)' position:pos to:tokenPosition.
+ ^ #Error
+ ].
+ ^ self primary_lazyValue.
+ ].
+ tokenType == #HashHash ifTrue:[
+ self warning:'''##'' might parse differently with other smalltalk systems' position:pos to:tokenPosition.
+ tokenType := #Symbol.
+ token := tokenValue := tokenName := '#'.
+ ^ self primary_simpleLiteral.
+ ].
(tokenType == #Error) ifTrue:[^ #Error].
tokenType isCharacter ifTrue:[
@@ -4948,8 +4999,8 @@
' unexpected (missing receiver ?)')
] ifFalse:[
eMsg := ('error in primary; '
- , tokenType printString ,
- ' unexpected')
+ , (token ? '') , ' (', tokenType printString ,
+ ') unexpected')
].
self syntaxError:eMsg position:tokenPosition to:source position
].
@@ -4971,7 +5022,6 @@
|pos expr val|
pos := tokenPosition.
- self nextToken.
expr := self expression.
@@ -4997,6 +5047,12 @@
val isCharacter ifTrue:[
^ ConstantNode type:#Character value:val
].
+ val isInteger ifTrue:[
+ ^ ConstantNode type:#Integer value:val
+ ].
+ val isArray ifTrue:[
+ ^ ConstantNode type:#Array value:val
+ ].
] ifFalse:[
self parseError:'must be representable as a literal (for now)' position:pos.
^ #Error
@@ -5312,6 +5368,26 @@
^ node
!
+primary_lazyValue
+ |pos block expr|
+
+ pos := tokenPosition.
+
+ (tokenType == $: ) ifTrue:[
+ self parseError:'lazyValues have no arguments' position:tokenPosition.
+ ^ #Error
+ ].
+
+ block := self blockBody:#().
+ self nextToken.
+
+ expr := MessageNode
+ receiver:(VariableNode type:#GlobalVariable name:#LazyValue)
+ selector:#'block:'
+ arg:block.
+ ^ expr
+!
+
primary_nil
"parse a nil primary; return a node-tree, nil or #Error."
@@ -5848,16 +5924,31 @@
"/ for the code.
"/ We only care for WorkspaceVars in doIts
(selector isNil or:[selector == #doIt]) ifTrue:[
- Workspace notNil and:[
- (holder := Workspace workspaceVariableAt:varName) notNil ifTrue:[
- ^ VariableNode type:#WorkspaceVariable holder:holder name:varName
- ]
+ (Workspace notNil
+ and:[(holder := Workspace workspaceVariableAt:varName) notNil])
+ ifTrue:[
+ ^ VariableNode type:#WorkspaceVariable holder:holder name:varName
]
]
].
+ "is it a doIt variable ?"
+
+"/ (requestor notNil and:[requestor isStream not]) ifTrue:[
+ "/ when parsing doits, this is done twice;
+ "/ first, for the parse, then as a block-code
+ "/ for the code.
+ "/ We only care for WorkspaceVars in doIts
+
+ (selector isNil or:[selector == #doIt]) ifTrue:[
+ (doItTemporaries notNil
+ and:[(holder := doItTemporaries at:varName asSymbol ifAbsent:nil) notNil])
+ ifTrue:[
+ ^ VariableNode type:#DoItTemporary holder:holder name:varName
+ ]
+ ].
+"/ ].
^ #Error
-
"Modified: / 5.11.2001 / 16:45:35 / cg"
! !
@@ -6574,6 +6665,6 @@
!Parser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.340 2002-07-15 12:02:07 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libcomp/Parser.st,v 1.341 2002-07-25 16:46:04 cg Exp $'
! !
Parser initialize!