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

commits at source.squeak.org commits at source.squeak.org
Wed Aug 26 04:27:44 UTC 2009


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!




More information about the Squeak-dev mailing list