[squeak-dev] The Trunk: Compiler-cwp.73.mcz

Andreas Raab uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-cwp.73.mcz

==================== Summary ====================

Name: Compiler-cwp.73
Author: cwp
Time: 25 August 2009, 8:45:22 am
UUID: 0fc4552f-d0c6-481a-8fa0-2bea842240b2
Ancestors: Compiler-rss.72

The compiler now uses notifications to signal that a correctable error has been found in the method source, rather than interacting directly with the user.

=============== Diff against Compiler-rss.72 ===============

Item was added:
+ ----- Method: ParserNotification>>setName: (in category 'as yet unclassified') -----
+ setName: aString
+ name _ aString!

Item was changed:
  SystemOrganization addCategory: #'Compiler-Kernel'!
  SystemOrganization addCategory: #'Compiler-ParseNodes'!
  SystemOrganization addCategory: #'Compiler-Support'!
  SystemOrganization addCategory: #'Compiler-Tests'!
  SystemOrganization addCategory: #'Compiler-Syntax'!
+ SystemOrganization addCategory: #'Compiler-Exceptions'!

Item was added:
+ TestCase subclass: #CompilerExceptionsTest
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Compiler-Tests'!

Item was added:
+ ----- Method: ParserNotification>>defaultAction (in category 'as yet unclassified') -----
+ defaultAction
+
+ self openMenuIn:
+ [:labels :lines :caption |
+ UIManager default chooseFrom: labels lines: lines title: caption]!

Item was added:
+ ----- Method: UndeclaredVariable class>>signalFor:name:inRange: (in category 'as yet unclassified') -----
+ signalFor: aParser name: aString inRange: anInterval
+ ^ (self new setParser: aParser name: aString range: anInterval) signal!

Item was added:
+ ----- Method: ParserNotification>>openMenuIn: (in category 'as yet unclassified') -----
+ openMenuIn: aBlock
+ self subclassResponsibility!

Item was changed:
  ----- Method: Parser>>correctSelector:wordIntervals:exprInterval:ifAbort: (in category 'error correction') -----
  correctSelector: proposedKeyword wordIntervals: spots exprInterval: expInt ifAbort: abortAction
  "Correct the proposedKeyword to some selector symbol, correcting the original text if such action is indicated.  abortAction is invoked if the proposedKeyword couldn't be converted into a valid selector.  Spots is an ordered collection of intervals within the test stream of the for each of the keyword parts."
 
+ | correctSelector userSelection |
- | alternatives aStream choice correctSelector userSelection lines firstLine |
  "If we can't ask the user, assume that the keyword will be defined later"
  self interactive ifFalse: [ ^ proposedKeyword asSymbol ].
 
+ userSelection _ requestor selectionInterval.
- userSelection := requestor selectionInterval.
  requestor selectFrom: spots first first to: spots last last.
  requestor select.
- alternatives := Symbol possibleSelectorsFor: proposedKeyword.
- self flag: #toBeFixed.
- "alternatives addAll: (MultiSymbol possibleSelectorsFor: proposedKeyword)."
 
+ correctSelector _ UnknownSelector name: proposedKeyword.
+ correctSelector ifNil: [ ^ abortAction value ].
- aStream := WriteStream on: (String new: 200).
- aStream nextPutAll: (proposedKeyword contractTo: 35); cr.
- firstLine := 1.
-   alternatives do:
- [:sel | aStream nextPutAll: (sel contractTo: 35); nextPut: Character cr].
- aStream nextPutAll: 'cancel'.
- lines := Array with: firstLine with: (alternatives size + firstLine).
-
- choice := (UIManager default
- chooseFrom: (aStream contents substrings)
- lines: lines
- title: 'Unknown selector, please\confirm, correct, or cancel' withCRs).
-
- (choice = 0) | (choice > (lines at: 2))
- ifTrue: [ ^ abortAction value ].
 
  requestor deselect.
  requestor selectInvisiblyFrom: userSelection first to: userSelection last.
 
- choice = 1 ifTrue: [ ^ proposedKeyword asSymbol ].
- correctSelector := alternatives at: choice - 1.
  self substituteSelector: correctSelector keywords wordIntervals: spots.
+ ((proposedKeyword last ~~ $:) and: [correctSelector last == $:]) ifTrue: [
- ((proposedKeyword last ~= $:) and: [correctSelector last == $:]) ifTrue: [
  ^ abortAction value].
  ^ correctSelector.
  !

Item was added:
+ ----- Method: UnknownSelector>>openMenuIn: (in category 'as yet unclassified') -----
+ openMenuIn: aBlock
+ | alternatives labels lines caption choice |
+ alternatives _ Symbol possibleSelectorsFor: name.
+ labels _ Array streamContents:
+ [:s | s nextPut: name; nextPutAll: alternatives; nextPut: 'cancel'].
+ lines _ {1. alternatives size + 1}.
+ caption _ 'Unknown selector, please\confirm, correct, or cancel' withCRs.
+
+ choice _ aBlock value: labels value: lines value: caption.
+ choice = 0 ifTrue: [self resume: nil].
+ choice = 1 ifTrue: [self resume: name asSymbol].
+ choice = labels size ifTrue: [self resume: nil].
+ self resume: (alternatives at: choice - 1).!

Item was added:
+ ParserNotification subclass: #UnknownSelector
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Compiler-Exceptions'!

Item was changed:
  ----- Method: Parser>>queryUndefined (in category 'error correction') -----
  queryUndefined
  | varStart varName |
+ varName _ parseNode key.
+ varStart _ self endOfLastToken + requestorOffset - varName size + 1.
- varName := parseNode key.
- varStart := self endOfLastToken + requestorOffset - varName size + 1.
  requestor selectFrom: varStart to: varStart + varName size - 1; select.
+ (UndefinedVariable name: varName) ifFalse: [^ self fail]!
- (UIManager default chooseFrom: #('yes' 'no') title:
- ((varName , ' appears to be
- undefined at this point.
- Proceed anyway?') asText makeBoldFrom: 1 to: varName size))
- = 1 ifFalse: [^ self fail]!

Item was added:
+ ----- Method: CompilerExceptionsTest>>selectFrom:to: (in category 'emulating') -----
+ selectFrom: start to: end
+ !

Item was added:
+ ----- Method: ParserNotification class>>name: (in category 'as yet unclassified') -----
+ name: aString
+ ^ (self new setName: aString) signal!

Item was added:
+ ----- Method: CompilerExceptionsTest>>testUnknownSelector (in category 'tests') -----
+ testUnknownSelector
+ self
+ should:
+ [self class
+ compile: 'griffle self reallyHopeThisIsntImplementedAnywhere'
+ notifying: self]
+ raise: UnknownSelector!

Item was changed:
  ----- Method: Parser>>correctVariable:interval: (in category 'error correction') -----
+ correctVariable: proposedVariable interval: spot
- correctVariable: proposedVariable interval: spot
  "Correct the proposedVariable to a known variable, or declare it as a new
  variable if such action is requested.  We support declaring lowercase
  variables as temps or inst-vars, and uppercase variables as Globals or
  ClassVars, depending on whether the context is nil (class=UndefinedObject).
  Spot is the interval within the test stream of the variable.
  rr 3/4/2004 10:26 : adds the option to define a new class. "
 
- | tempIvar labels actions lines alternatives binding userSelection choice action |
-
  "Check if this is an i-var, that has been corrected already (ugly)"
- (encoder classEncoding allInstVarNames includes: proposedVariable) ifTrue: [
- ^InstanceVariableNode new
- name: proposedVariable
- index: (encoder classEncoding allInstVarNames indexOf: proposedVariable)].
-
- "If we can't ask the user for correction, make it undeclared"
- self interactive
- ifFalse: [ ^encoder undeclared: proposedVariable ].
-
- "First check to see if the requestor knows anything about the variable"
- tempIvar := proposedVariable first canBeNonGlobalVarInitial.
- (tempIvar and: [ (binding := requestor bindingOf: proposedVariable) notNil ])
- ifTrue: [ ^encoder global: binding name: proposedVariable ].
- userSelection := requestor selectionInterval.
- requestor selectFrom: spot first to: spot last.
- requestor select.
-
- "Build the menu with alternatives"
- labels := OrderedCollection new. actions := OrderedCollection new. lines := OrderedCollection new.
- alternatives := encoder possibleVariablesFor: proposedVariable.
- tempIvar
- ifTrue: [
- labels add: 'declare temp'.
- actions add: [ self declareTempAndPaste: proposedVariable ].
- labels add: 'declare instance'.
- actions add: [ self declareInstVar: proposedVariable ] ]
- ifFalse: [
- labels add: 'define new class'.
- actions add: [self defineClass: proposedVariable].
- labels add: 'declare global'.
- actions add: [ self declareGlobal: proposedVariable ].
- encoder classEncoding == UndefinedObject ifFalse: [
- labels add: 'declare class variable'.
- actions add: [ self declareClassVar: proposedVariable ] ] ].
- lines add: labels size.
- alternatives do: [ :each |
- labels add: each.
- actions add: [
- self substituteWord: each wordInterval: spot offset: 0.
- encoder encodeVariable: each ] fixTemps ].
- lines add: labels size.
- labels add: 'cancel'.
 
  "Display the pop-up menu"
+
+ | tempIvar binding userSelection action |
+ (encoder classEncoding instVarNames includes: proposedVariable)
+ ifTrue:
+ [^(LiteralVariableNode new)
+ name: proposedVariable
+ index: (encoder classEncoding instVarNames indexOf: proposedVariable) - 1
+ type: 1;
+ yourself].
+
+ "If we can't ask the user for correction, make it undeclared"
+ self interactive ifFalse: [^encoder undeclared: proposedVariable].
+
+ "First check to see if the requestor knows anything about the variable"
+ tempIvar := proposedVariable first isLowercase.
+ (tempIvar and: [(binding := requestor bindingOf: proposedVariable) notNil])
+ ifTrue: [^encoder global: binding name: proposedVariable].
+ userSelection := requestor selectionInterval.
+ requestor selectFrom: spot first to: spot last.
+ requestor select.
+
+ "Build the menu with alternatives"
+ action := UndeclaredVariable
+ signalFor: self
+ name: proposedVariable
+ inRange: spot.
+ action ifNil: [^self fail].
- choice := (UIManager default chooseFrom: labels asArray lines: lines asArray
- title:  'Unknown variable: ', proposedVariable, ' please correct, or cancel:').
- action := actions at: choice ifAbsent: [ ^self fail ].
 
  "Execute the selected action"
  requestor deselect.
  requestor selectInvisiblyFrom: userSelection first to: userSelection last.
  ^action value!

Item was added:
+ ParserNotification subclass: #UndeclaredVariable
+ instanceVariableNames: 'parser interval'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Compiler-Exceptions'!

Item was added:
+ ParserNotification subclass: #UndefinedVariable
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Compiler-Exceptions'!

Item was added:
+ Notification subclass: #ParserNotification
+ instanceVariableNames: 'name'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Compiler-Exceptions'!

Item was added:
+ ----- Method: UndeclaredVariable>>openMenuIn: (in category 'as yet unclassified') -----
+ openMenuIn: aBlock
+ | alternatives labels actions lines caption choice |
+ alternatives := parser possibleVariablesFor: name.
+ labels := OrderedCollection new.
+ actions := OrderedCollection new.
+ lines := OrderedCollection new.
+ name first isLowercase
+ ifTrue:
+ [labels add: 'declare temp'.
+ actions add: [parser declareTempAndPaste: name].
+ labels add: 'declare instance'.
+ actions add: [parser declareInstVar: name]]
+ ifFalse:
+ [labels add: 'define new class'.
+ actions add: [parser defineClass: name].
+ labels add: 'declare global'.
+ actions add: [parser declareGlobal: name].
+ parser canDeclareClassVariable
+ ifTrue:
+ [labels add: 'declare class variable'.
+ actions add: [parser declareClassVar: name]]].
+ lines add: labels size.
+ alternatives do:
+ [:each |
+ labels add: each.
+ actions add: [parser subsituteVariable: each atInterval: interval] fixTemps].
+ lines add: labels size.
+ labels add: 'cancel'.
+ caption := 'Unknown variable: ' , name , ' please correct, or cancel:'.
+ choice := aBlock value: labels value: lines value: caption.
+ self resume: (actions at: choice ifAbsent: [nil])!

Item was added:
+ ----- Method: CompilerExceptionsTest>>select (in category 'emulating') -----
+ select
+ !

Item was added:
+ ----- Method: Parser>>canDeclareClassVariable (in category 'error correction') -----
+ canDeclareClassVariable
+ ^encoder classEncoding ~~ UndefinedObject!

Item was added:
+ ----- Method: UndefinedVariable>>openMenuIn: (in category 'as yet unclassified') -----
+ openMenuIn: aBlock
+ | labels caption index |
+ labels _ #('yes' 'no').
+ caption _ name, ' appears to be
+ undefined at this point.
+ Proceed anyway?'.
+
+ index _ aBlock value: labels value: #() value: caption.
+ ^ self resume: index = 1!

Item was added:
+ ----- Method: CompilerExceptionsTest>>selectionInterval (in category 'emulating') -----
+ selectionInterval
+ ^ 1 to: 0!

Item was added:
+ ----- Method: CompilerExceptionsTest>>griffle (in category 'as yet unclassified') -----
+ griffle | goo |!

Item was changed:
  ----- Method: Parser>>removeUnusedTemps (in category 'error correction') -----
  removeUnusedTemps
  "Scan for unused temp names, and prompt the user about the prospect of removing each one found"
 
  | str end start madeChanges |
+ madeChanges _ false.
+ str _ requestor text string.
- madeChanges := false.
- str := requestor text string.
  ((tempsMark between: 1 and: str size)
  and: [(str at: tempsMark) = $|]) ifFalse: [^ self].
  encoder unusedTempNames do:
  [:temp |
+ (UnusedVariable name: temp) ifTrue:
- (UIManager default chooseFrom: #('yes' 'no') title:
- ((temp , ' appears to be\unused in this method.\OK to remove it?' withCRs) asText makeBoldFrom: 1 to: temp size))
- = 1
- ifTrue:
  [(encoder encodeVariable: temp) isUndefTemp
  ifTrue:
+ [end _ tempsMark.
- [end := tempsMark.
  ["Beginning at right temp marker..."
+ start _ end - temp size + 1.
- start := end - temp size + 1.
  end < temp size or: [temp = (str copyFrom: start to: end)
  and: [(str at: start-1) isSeparator & (str at: end+1) isSeparator]]]
+ whileFalse:
+ ["Search left for the unused temp"
+ end _ requestor nextTokenFrom: end direction: -1].
- whileFalse:
- ["Search left for the unused temp"
- end := requestor nextTokenFrom: end direction: -1].
  end < temp size ifFalse:
+ [(str at: start-1) = $  ifTrue: [start _ start-1].
- [(str at: start-1) = $  ifTrue: [start := start-1].
  requestor correctFrom: start to: end with: ''.
+ str _ str copyReplaceFrom: start to: end with: ''.
+ madeChanges _ true.
+ tempsMark _ tempsMark - (end-start+1)]]
- str := str copyReplaceFrom: start to: end with: ''.
- madeChanges := true.
- tempsMark := tempsMark - (end-start+1)]]
  ifFalse:
  [self inform:
+ 'You''ll first have to remove the
+ statement where it''s stored into']]].
+ madeChanges ifTrue: [ParserRemovedUnusedTemps signal]!
- 'You''ll first have to remove the\statement where it''s stored into' withCRs]]].
- madeChanges ifTrue: [ReparseAfterSourceEditing signal]!

Item was added:
+ ParserNotification subclass: #UnusedVariable
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Compiler-Exceptions'!

Item was added:
+ ----- Method: CompilerExceptionsTest>>testUndeclaredVariable (in category 'tests') -----
+ testUndeclaredVariable
+ self
+ should:
+ [self class
+ compile: 'griffle ^ goo'
+ notifying: self]
+ raise: UndeclaredVariable!

Item was added:
+ ----- Method: UnusedVariable>>openMenuIn: (in category 'as yet unclassified') -----
+ openMenuIn: aBlock
+ | labels caption index |
+ labels _ #('yes' 'no').
+ caption _ name , ' appears to be
+ unused in this method.
+ OK to remove it?'.
+
+ index _ aBlock value: labels value: #() value: caption.
+ self resume: index = 1!

Item was added:
+ ----- Method: CompilerExceptionsTest>>testUndefinedVariable (in category 'tests') -----
+ testUndefinedVariable
+ self
+ should:
+ [self class
+ compile: 'griffle | goo | ^ goo'
+ notifying: self]
+ raise: UndefinedVariable!

Item was added:
+ ----- Method: Parser>>subsituteVariable:atInterval: (in category 'error correction') -----
+ subsituteVariable: each atInterval: anInterval
+ self
+ substituteWord: each
+ wordInterval: anInterval
+ offset: 0.
+ ^encoder encodeVariable: each!

Item was added:
+ ----- Method: CompilerExceptionsTest>>unusedVariableSource (in category 'private') -----
+ unusedVariableSource
+ ^ 'griffle
+ | goo |
+ ^ nil'!

Item was added:
+ ----- Method: UndeclaredVariable>>setParser:name:range: (in category 'as yet unclassified') -----
+ setParser: aParser name: aString range: anInterval
+ parser := aParser.
+ name := aString.
+ interval := anInterval!

Item was added:
+ ----- Method: CompilerExceptionsTest>>text (in category 'emulating') -----
+ text
+ ^ self unusedVariableSource!

Item was added:
+ ----- Method: Parser>>possibleVariablesFor: (in category 'error correction') -----
+ possibleVariablesFor: proposedVariable
+ ^encoder possibleVariablesFor: proposedVariable!

Item was added:
+ ----- Method: CompilerExceptionsTest>>testUnusedVariable (in category 'tests') -----
+ testUnusedVariable
+ self
+ should:
+ [self class
+ compile: self unusedVariableSource
+ notifying: self]
+ raise: UnusedVariable!