[squeak-dev] The Trunk: Compiler-nice.269.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Sep 18 20:23:46 UTC 2013


Nicolas Cellier uploaded a new version of Compiler to project The Trunk:
http://source.squeak.org/trunk/Compiler-nice.269.mcz

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

Name: Compiler-nice.269
Author: nice
Time: 18 September 2013, 10:23:19.317 pm
UUID: bf291465-8d81-48c5-93e8-e73a254e2e59
Ancestors: Compiler-nice.268

Remove sourceStream inst. var. from Compiler now that it is unused.
Continue the cue refactoring and remove some now unused methods.

Add a newSource instance variable to ReparseAfterSourceEditing so as to enable a compilation restart even in non interactive compilation mode.

Let me remind that non interactive here means that the Compiler does not interact directly with the source code editor. But it can still interact thru a SyntaxError window popping up.

Add a newSource instance variable to SyntaxErrorNotification, because the SyntaxError knows about this notification, it can pass the corrected code thru it.
Add some support method for SyntaxError.

=============== Diff against Compiler-nice.268 ===============

Item was changed:
  Object subclass: #Compiler
+ 	instanceVariableNames: 'parser cue'
- 	instanceVariableNames: 'sourceStream parser cue'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Compiler-Kernel'!
  
  !Compiler commentStamp: 'cwp 12/26/2012 23:17' prior: 0!
  The compiler accepts Smalltalk source code and compiles it with respect to a given class. The user of the compiler supplies a context so that temporary variables are accessible during compilation. If there is an error, a requestor (usually a kind of StringHolderController) is sent the message notify:at:in: so that the error message can be displayed. If there is no error, then the result of compilation is a MethodNode, which is the root of a parse tree whose nodes are kinds of ParseNodes. The parse tree can be sent messages to (1) generate code for a CompiledMethod (this is done for compiling methods or evaluating expressions); (2) pretty-print the code (for formatting); or (3) produce a map from object code back to source code (used by debugger program-counter selection). See also Parser, Encoder, ParseNode.!

Item was changed:
+ ----- Method: Compiler>>compileCue:noPattern:ifFail: (in category 'private') -----
- ----- Method: Compiler>>compileCue:noPattern:ifFail: (in category 'public access') -----
  compileCue: aCue noPattern: aBoolean ifFail: failBlock 
  	"Answer a MethodNode corresponding to cue source.
  	If the MethodNode can not be created, notify the cue requestor.
  	If the cue requestor is nil, evaluate failBlock instead.
  	The MethodNode is the root  of a parse tree.
  	It can be told to generate a CompiledMethod
  	- either to be evaluated in cue context if aBoolean is true, with cue receiver as method receiver,
  	- or to be installed in the method dictionary of the target class specified by the cue if aBoolean is false."
  	
  	self setCue: aCue.
  	^self translateNoPattern: aBoolean	ifFail: failBlock!

Item was changed:
  ----- Method: Compiler>>compiledMethodFor:in:to:notifying:ifFail:logged: (in category 'public access') -----
  compiledMethodFor: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag
  	"Compiles the sourceStream into a parse tree, then generates code
  	 into a method, and answers it.  If receiver is not nil, then the text can
  	 refer to instance variables of that receiver (the Inspector uses this).
  	 If aContext is not nil, the text can refer to temporaries in that context
  	 (the Debugger uses this). If aRequestor is not nil, then it will receive a 
  	 notify:at: message before the attempt to evaluate is aborted."
  
  	| methodNode method theClass |
  	theClass := (aContext == nil ifTrue: [receiver] ifFalse: [aContext receiver]) class.
  	methodNode := self
+ 		compileNoPattern: textOrStream
+ 		in: theClass
+ 		context: aContext
+ 		notifying: aRequestor
- 		compileCue: (CompilationCue
- 			source: textOrStream
- 			context: aContext
- 			class: theClass
- 			requestor: aRequestor)
- 		noPattern: true
  		ifFail: [^failBlock value].
  	method := self interactive
  		ifTrue: [ methodNode generateWithTempNames ] 
  		ifFalse: [ methodNode generate ].
  		
  	logFlag ifTrue:
  		[SystemChangeNotifier uniqueInstance evaluated: cue stringToLog context: aContext].
  	^method!

Item was changed:
+ ----- Method: Compiler>>evaluateCue:ifFail:logged: (in category 'private') -----
- ----- Method: Compiler>>evaluateCue:ifFail:logged: (in category 'public access') -----
  evaluateCue: aCue ifFail: failBlock logged: logFlag
  	"Compiles the cue source into a parse tree, then generates code into
  	a method. Finally, the compiled method is invoked from here via 	withArgs:executeMethod:, hence the system no longer creates Doit method
  	litter on errors."
  
  	| methodNode method value |
  	methodNode := self compileCue: aCue noPattern: true ifFail: [^failBlock value].
  
  	method := self interactive
  				ifTrue: [methodNode generateWithTempNames]
  				ifFalse: [methodNode generate].
  
  	value := cue receiver
  				withArgs: (cue context ifNil: [#()] ifNotNil: [{cue context}])
  				executeMethod: method.
  
  	logFlag ifTrue:
  		[SystemChangeNotifier uniqueInstance evaluated: cue stringToLog context: cue context].
  	^ value
  !

Item was changed:
+ ----- Method: Compiler>>format:in:notifying: (in category 'private') -----
- ----- Method: Compiler>>format:in:notifying: (in category 'public access') -----
  format: textOrStream in: aClass notifying: aRequestor
  	"Compile a parse tree from the argument, textOrStream. Answer a string containing the original code, formatted nicely.  If aBoolean is true, then decorate the resulting text with color and hypertext actions"
  
  	| aNode |
  	self from: textOrStream
  		class: aClass
  		context: nil
  		notifying: aRequestor.
  	aNode := self formatNoPattern: false ifFail: [^ nil].
  
  	"aSymbol == #colorPrint ifTrue:
  		[^aNode asColorizedSmalltalk80Text]." "deprecating #colorPrint in favor of Shout --Ron Spengler"
  
  	^aNode decompileString!

Item was changed:
  ----- Method: Compiler>>notify:at: (in category 'error handling') -----
  notify: aString at: location
  	"Refer to the comment in Object|notify:."
  
  	^ cue requestor == nil
+ 		ifTrue: [(SyntaxErrorNotification
- 		ifTrue: [SyntaxErrorNotification
  					inClass: cue getClass
  					category: cue category
  					withCode: 
  						(cue sourceStream contents
  							copyReplaceFrom: location
  							to: location - 1
  							with: aString)
  					doitFlag: false
  					errorMessage: aString
+ 					location: location) signal]
- 					location: location]
  		ifFalse: [cue requestor
  					notify: aString
  					at: location
  					in: cue sourceStream]!

Item was changed:
  ----- Method: Parser>>notify:at: (in category 'error handling') -----
  notify: string at: location
  	cue requestor isNil
+ 		ifTrue: [| notification |
+ 			(encoder == self or: [encoder isNil]) ifTrue: [^ self fail  "failure setting up syntax error"].
+ 			(notification := SyntaxErrorNotification
- 		ifTrue: [(encoder == self or: [encoder isNil]) ifTrue: [^ self fail  "failure setting up syntax error"].
- 				SyntaxErrorNotification
  					inClass: encoder classEncoding
  					category: cue category
  					withCode: 
  						(source contents asText
  							copyReplaceFrom: location
  							to: location - 1
  							with: ((string , ' ->') asText allBold 
  								addAttribute: TextColor red; yourself))
  					doitFlag: doitFlag
  					errorMessage: string
+ 					location: location) signal.
+ 			notification tryNewSourceIfAvailable]
- 					location: location]
  		ifFalse: [cue requestor
  					notify: string , ' ->'
  					at: location
  					in: source].
  	^self fail!

Item was changed:
  ----- Method: Parser>>parse:class:category:noPattern:context:notifying:ifFail: (in category 'public access') -----
  parse: sourceStream class: class category: aCategory noPattern: noPattern context: aContext notifying: req ifFail: aBlock 
  	| c |
  	c := CompilationCue
  			source: sourceStream
  			context: aContext
  			class: class
  			category: aCategory
  			requestor: req.
  	^ self 
+ 		parseCue: c 
- 		parse: sourceStream 
- 		cue: c 
  		noPattern: noPattern 
  		ifFail: aBlock!

Item was removed:
- ----- Method: Parser>>parse:cue:noPattern:ifFail: (in category 'public access') -----
- parse: sourceStream cue: aCue noPattern: noPattern ifFail: aBlock 
- 	"Answer a MethodNode for the argument, sourceStream, that is the root of
- 	 a parse tree. Parsing is done with respect to the CompilationCue to 
- 	 resolve variables. Errors in parsing are reported to the cue's requestor; 
- 	 otherwise aBlock is evaluated. The argument noPattern is a Boolean that is
- 	 true if the the sourceStream does not contain a method header (i.e., for DoIts)."
- 
- 	| methNode repeatNeeded myStream s p subSelection |
- 	myStream := sourceStream.
- 	[repeatNeeded := false.
- 	 p := myStream position.
- 	 s := myStream upToEnd.
- 	 myStream position: p.
- 	 subSelection := aCue requestor notNil and: [aCue requestor selectionInterval = (p + 1 to: p + s size)].
- 	 self encoder init: aCue notifying: self.
- 	 self init: myStream cue: aCue failBlock: [^ aBlock value].
- 	 doitFlag := noPattern.
- 	 failBlock:= aBlock.
- 	 [methNode := self method: noPattern context: cue context] 
- 		on: ReparseAfterSourceEditing 
- 		do:	[ :ex |
- 			repeatNeeded := true.
- 			myStream := subSelection
- 							ifTrue:
- 								[ReadStream
- 									on: cue requestor text string
- 									from: cue requestor selectionInterval first
- 									to: cue requestor selectionInterval last]
- 							ifFalse:
- 								[ReadStream on: cue requestor text string]].
- 	 repeatNeeded] whileTrue:
- 		[encoder := self encoder class new].
- 	methNode sourceText: s.
- 	^methNode
- !

Item was changed:
  ----- Method: Parser>>parseCue:noPattern:ifFail: (in category 'public access') -----
  parseCue: aCue noPattern: noPattern ifFail: aBlock 
  	"Answer a MethodNode for the argument, sourceStream, that is the root of
  	 a parse tree. Parsing is done with respect to the CompilationCue to 
  	 resolve variables. Errors in parsing are reported to the cue's requestor; 
  	 otherwise aBlock is evaluated. The argument noPattern is a Boolean that is
  	 true if the the sourceStream does not contain a method header (i.e., for DoIts)."
  
  	| methNode repeatNeeded myStream s p subSelection |
  	myStream := aCue sourceStream.
  	[repeatNeeded := false.
  	 p := myStream position.
  	 s := myStream upToEnd.
  	 myStream position: p.
  	 subSelection := aCue requestor notNil and: [aCue requestor selectionInterval = (p + 1 to: p + s size)].
  	 self encoder init: aCue notifying: self.
  	 self init: myStream cue: aCue failBlock: [^ aBlock value].
  	 doitFlag := noPattern.
  	 failBlock:= aBlock.
  	 [methNode := self method: noPattern context: cue context] 
  		on: ReparseAfterSourceEditing 
  		do:	[ :ex |
  			repeatNeeded := true.
+ 			myStream := ex newSource 
+ 				ifNil: [subSelection
- 			myStream := subSelection
  							ifTrue:
  								[ReadStream
  									on: cue requestor text string
  									from: cue requestor selectionInterval first
  									to: cue requestor selectionInterval last]
  							ifFalse:
+ 								[ReadStream on: cue requestor text string]]
+ 				ifNotNil: [:src | myStream := src readStream]].
- 								[ReadStream on: cue requestor text string]].
  	 repeatNeeded] whileTrue:
  		[encoder := self encoder class new].
  	methNode sourceText: s.
  	^methNode
  !

Item was changed:
  Notification subclass: #ReparseAfterSourceEditing
+ 	instanceVariableNames: 'newSource'
- 	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Compiler-Support'!
+ 
+ !ReparseAfterSourceEditing commentStamp: 'nice 9/18/2013 22:05' prior: 0!
+ A ReparseAfterSourceEditing is a Notification used to restart the syntax parsing phase of a compilation after a source code edition.
+ 
+ Instance Variables
+ 	newSource:		<UndefinedObject | String | Text | Stream>
+ 
+ newSource
+ 	- this is the new source code to be used for restarting compilation if non interactive
+ 
+ In case of interactive compilation, newSource variable is nil because source code edition is performed directly in the source code editor, and the new source code will be picked directly there by the compiler.
+ 
+ In case of non interactive compilation, source code edition typically occurs in a SyntaxError window popping up. But the compiler has no direct access to this object, so newSource has to be passed by our intermediate.
+ !

Item was added:
+ ----- Method: ReparseAfterSourceEditing class>>withNewSource: (in category 'instance creation') -----
+ withNewSource: aStringOrStream
+ 	^(self new withNewSource: aStringOrStream) signal!

Item was added:
+ ----- Method: ReparseAfterSourceEditing>>newSource (in category 'accessing') -----
+ newSource
+ 	^newSource!

Item was added:
+ ----- Method: ReparseAfterSourceEditing>>withNewSource: (in category 'initialize-release') -----
+ withNewSource: aStringOrStream
+ 	newSource := aStringOrStream!

Item was changed:
  Error subclass: #SyntaxErrorNotification
+ 	instanceVariableNames: 'inClass code category doitFlag errorMessage location newSource'
- 	instanceVariableNames: 'inClass code category doitFlag errorMessage location'
  	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Compiler-Exceptions'!
+ 
+ !SyntaxErrorNotification commentStamp: 'nice 9/18/2013 22:16' prior: 0!
+ A SyntaxErrorNotification is an Exception occuring when compiling a Smalltalk source code with incorrect syntax.
+ Note that in interactive mode, this exception is not raised because the Compiler will interact directly with source code editor.
+ The defaultAction is to raise a SyntaxError pop up window so as to enable interactive handling even in non interactive mode.
+ 
+ Instance Variables
+ 	category:		<String | nil>
+ 	code:		<String | Text | Stream>
+ 	doitFlag:		<Boolean>
+ 	errorMessage:		<String>
+ 	inClass:		<Behavior>
+ 	location:		<Integer>
+ 	newSource:		<String | Text | Stream | nil>
+ 
+ category
+ 	- the category in which the method will be classified
+ 
+ code
+ 	- the source code to be compiled or evaluated
+ 
+ doitFlag
+ 	- true if this is a doIt (code to evaluate), false if this is a method (code of a method to be compiled)
+ 
+ errorMessage
+ 	- contains information about the syntax error
+ 
+ inClass
+ 	- target class in which to compile the method
+ 
+ location
+ 	- position in the source code where the syntax error occured
+ 
+ newSource
+ 	- eventually hold a source code replacement typically passed by the SyntaxError window
+ !

Item was removed:
- ----- Method: SyntaxErrorNotification class>>inClass:category:withCode:doitFlag: (in category 'exceptionInstantiator') -----
- inClass: aClass category: aCategory withCode: codeString doitFlag: doitFlag 
- 	^ (self new
- 		setClass: aClass
- 		category: aCategory 
- 		code: codeString
- 		doitFlag: doitFlag) signal!

Item was changed:
  ----- Method: SyntaxErrorNotification class>>inClass:category:withCode:doitFlag:errorMessage:location: (in category 'exceptionInstantiator') -----
  inClass: aClass category: aCategory withCode: codeString doitFlag: doitFlag errorMessage: errorString location: location
+ 	^self new
- 	^ (self new
  		setClass: aClass
  		category: aCategory 
  		code: codeString
  		doitFlag: doitFlag
  		errorMessage: errorString
+ 		location: location!
- 		location: location) signal!

Item was added:
+ ----- Method: SyntaxErrorNotification>>newSource (in category 'accessing') -----
+ newSource
+ 	^newSource!

Item was added:
+ ----- Method: SyntaxErrorNotification>>newSource: (in category 'accessing') -----
+ newSource: aTextOrString
+ 	newSource := aTextOrString!

Item was added:
+ ----- Method: SyntaxErrorNotification>>reparse:notifying:ifFail: (in category 'accessing') -----
+ reparse: aString notifying: aController ifFail: failBlock
+ 	"Try to parse if aString has correct syntax, but do not evaluate/install any code.
+ 	In case of incorrect syntax, execute failBlock and let a Compiler interact with the requestor.
+ 	In case of correct syntax, set newSource."
+ 	doitFlag
+ 		ifTrue: [nil class newCompiler compileNoPattern: aString in: nil class context: nil notifying: aController ifFail: failBlock]
+ 		ifFalse: [inClass newCompiler compile: aString in: inClass classified: category notifying: aController ifFail: failBlock].
+ 	newSource := aString!

Item was added:
+ ----- Method: SyntaxErrorNotification>>tryNewSourceIfAvailable (in category 'accessing') -----
+ tryNewSourceIfAvailable
+ 	newSource ifNotNil: [ReparseAfterSourceEditing withNewSource: newSource]!



More information about the Squeak-dev mailing list