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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 17 21:21:10 UTC 2013


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

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

Name: Compiler-nice.268
Author: nice
Time: 17 September 2013, 11:17:38.847 pm
UUID: fda44454-4b2c-4aaf-936a-d62bc9364a43
Ancestors: Compiler-nice.266

Factor a bunch of similar code in Compiler.
Get rid of sourceStream inst. var. in Compiler, there is already a source inst. var. in CompilationCue.
Let source inst. var. in CompilationCue be a ReadStream rather than a String.
Replace CompilationCue>>source usage with sourceStream to reflect this change.
We might have to change the inst var name later...
Introduce CompilationCue>>stringToLog which both isolates and explains some convoluted code.
Use this stringToLog to fix a broken usage of the infamous (ReadStream on:from:to:) contents.

=============== Diff against Compiler-nice.266 ===============

Item was changed:
  ----- Method: CompilationCue>>initializeWithSource:context:receiver:class:environment:category:requestor: (in category 'initialization') -----
  initializeWithSource: aTextOrString context: aContext receiver: recObject class: aClass environment: anEnvironment category: aString requestor: reqObject
  	self initialize.
+ 	source := (aTextOrString isKindOf: PositionableStream)
+ 		ifTrue: [ aTextOrString ]
+ 		ifFalse: [ ReadStream on: aTextOrString asString ].
- 	source := aTextOrString isStream ifTrue: [aTextOrString contents] ifFalse: [aTextOrString].
  	context := aContext.
  	receiver := recObject.
  	class := aClass.
  	environment := anEnvironment.
  	category := aString.
  	requestor := reqObject!

Item was removed:
- ----- Method: CompilationCue>>source (in category 'accessing') -----
- source
- 	^ source!

Item was added:
+ ----- Method: CompilationCue>>sourceStream (in category 'accessing') -----
+ sourceStream
+ 	^source!

Item was added:
+ ----- Method: CompilationCue>>stringToLog (in category 'accessing') -----
+ stringToLog
+ 	"Answer a string to be logged in a change log.
+ 	Implementation note:
+ 	If the requestor is a TextEditor, preferably take its selection.
+ 	This convoluted code is presumably crafted to avoid broken contents
+ 	(ReadStream on: '123456' from: 3 to: 4) contents -> '1234'
+ 	As long as selectionAsStream is using such construct this might be required."
+ 	| itsSelection itsSelectionString |
+ 	^((requestor respondsTo: #selection)  
+ 			and:[(itsSelection := requestor selection) notNil
+ 			and:[(itsSelectionString := itsSelection asString) isEmptyOrNil not]])
+ 				ifTrue:[itsSelectionString]
+ 				ifFalse:[self sourceStream contents]!

Item was changed:
  ----- Method: Compiler class>>evaluate:environment:logged: (in category 'evaluating') -----
  evaluate: aString environment: anEnvironment logged: aBoolean
- 	| cue |
- 	cue := CompilationCue
- 		source: aString
- 		environment: anEnvironment.
- 		
  	^ self new
+ 		evaluateCue: (CompilationCue
+ 			source: aString
+ 			environment: anEnvironment)
- 		evaluate: aString
- 		cue: cue
  		ifFail: [^ nil]
  		logged: aBoolean!

Item was changed:
  ----- Method: Compiler>>compile:ifFail: (in category 'public access') -----
  compile: aCue ifFail: failBlock 
  	"Answer a MethodNode. If the MethodNode can not be created, notify 
  	the requestor in the contxt. If the requestor is nil, evaluate failBlock 
  	instead. The MethodNode is the root  of a parse tree. It can be told 
  	to generate a CompiledMethod to be installed in the method dictionary 
  	of the class specified by the context."
  	
- 	self setCue: aCue.
- 	self source: cue source.
  	^self
+ 		compileCue: aCue
- 		translate: sourceStream
  		noPattern: false
+ 		ifFail: failBlock !
- 		ifFail: failBlock!

Item was changed:
  ----- Method: Compiler>>compile:in:classified:notifying:ifFail: (in category 'public access') -----
  compile: textOrStream in: aClass classified: aCategory notifying: aRequestor ifFail: failBlock 
  	"Answer a MethodNode for the argument, textOrStream. If the 
  	MethodNode can not be created, notify the argument, aRequestor; if 
  	aRequestor is nil, evaluate failBlock instead. The MethodNode is the root 
  	of a parse tree. It can be told to generate a CompiledMethod to be 
  	installed in the method dictionary of the argument, aClass."
  
- 	self from: textOrStream
- 		class: aClass
- 		classified: aCategory 
- 		context: nil
- 		notifying: aRequestor.
  	^self
+ 		compileCue: (CompilationCue
+ 			source: textOrStream
+ 			context: nil
+ 			class: aClass
+ 			category: aCategory
+ 			requestor: aRequestor)
- 		translate: sourceStream
  		noPattern: false
  		ifFail: failBlock
  !

Item was added:
+ ----- 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>>compileNoPattern:in:context:notifying:ifFail: (in category 'public access') -----
  compileNoPattern: textOrStream in: aClass context: aContext notifying: aRequestor ifFail: failBlock
  	"Similar to #compile:in:notifying:ifFail:, but the compiled code is
  	expected to be a do-it expression, with no message pattern."
  
- 	self from: textOrStream
- 		class: aClass
- 		context: aContext
- 		notifying: aRequestor.
  	^self
+ 		compileCue: (CompilationCue
+ 			source: textOrStream
+ 			context: aContext
+ 			class: aClass
+ 			requestor: aRequestor)
- 		translate: sourceStream
  		noPattern: true
+ 		ifFail: failBlock
+ !
- 		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
+ 		compileCue: (CompilationCue
+ 			source: textOrStream
+ 			context: aContext
+ 			class: theClass
+ 			requestor: aRequestor)
+ 		noPattern: true
+ 		ifFail: [^failBlock value].
+ 	method := self interactive
+ 		ifTrue: [ methodNode generateWithTempNames ] 
+ 		ifFalse: [ methodNode generate ].
- 	self from: textOrStream class: theClass context: aContext notifying: aRequestor.
- 	methodNode := self translate: sourceStream noPattern: true ifFail: [^failBlock value].
- 	method := self interactive ifTrue: [ 	methodNode generateWithTempNames ] 
- 		ifFalse: [methodNode generate].
  		
  	logFlag ifTrue:
+ 		[SystemChangeNotifier uniqueInstance evaluated: cue stringToLog context: aContext].
- 		[SystemChangeNotifier uniqueInstance evaluated: sourceStream contents context: aContext].
  	^method!

Item was removed:
- ----- Method: Compiler>>evaluate:cue:ifFail:logged: (in category 'public access') -----
- evaluate: textOrStream cue: aCue ifFail: failBlock logged: logFlag
- 	"Compiles the sourceStream 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 toLog itsSelection itsSelectionString |
- 	self setCue: aCue.
- 	self source: textOrStream.
- 	methodNode := self translate: sourceStream 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:
- 		[toLog := ((cue requestor respondsTo: #selection)  
- 			and:[(itsSelection := cue requestor selection) notNil
- 			and:[(itsSelectionString := itsSelection asString) isEmptyOrNil not]])
- 				ifTrue:[itsSelectionString]
- 				ifFalse:[sourceStream contents].
- 		SystemChangeNotifier uniqueInstance evaluated: toLog context: cue context].
- 	^ value
- !

Item was changed:
  ----- Method: Compiler>>evaluate:in:to:notifying:ifFail:logged: (in category 'public access') -----
  evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag
  	"Compiles the sourceStream into a parse tree, then generates code into
  	 a method. 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. Finally, the 
  	 compiled method is invoked from here via withArgs:executeMethod:, hence
  	 the system no longer creates Doit method litter on errors."
  	
  	| theClass |
  	theClass := ((aContext == nil ifTrue: [receiver] ifFalse: [aContext receiver]) class).
+ 	^self
+ 		evaluateCue: (CompilationCue
+ 			source: textOrStream
+ 			context: aContext
+ 			receiver: receiver
+ 			class: theClass
+ 			environment: theClass environment
+ 			category: nil
+ 			requestor: aRequestor)
+ 		ifFail: failBlock
+ 		logged: logFlag!
- 	self setCue: (CompilationCue
- 		source: textOrStream
- 		context: aContext
- 		receiver: receiver
- 		class: theClass
- 		environment: theClass environment
- 		category: nil
- 		requestor: aRequestor).
- 	^ self evaluate: textOrStream cue: cue ifFail: failBlock logged: logFlag!

Item was added:
+ ----- 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 '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].
- 	aNode := self format: sourceStream noPattern: false ifFail: [^ nil].
  
  	"aSymbol == #colorPrint ifTrue:
  		[^aNode asColorizedSmalltalk80Text]." "deprecating #colorPrint in favor of Shout --Ron Spengler"
  
  	^aNode decompileString!

Item was changed:
  ----- Method: Compiler>>format:in:notifying:decorated: (in category 'public access') -----
  format: textOrStream in: aClass notifying: aRequestor decorated: aBoolean
  	"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].
- 	aNode := self format: sourceStream noPattern: false ifFail: [^ nil].
  	^ aBoolean
  		ifTrue: [aNode decompileText]
  		ifFalse: [aNode decompileString]!

Item was removed:
- ----- Method: Compiler>>format:noPattern:ifFail: (in category 'private') -----
- format: aStream noPattern: noPattern ifFail: failBlock
- 	^(self parser
- 		parse: aStream
- 		cue: cue 
- 		noPattern: noPattern
- 		ifFail: [^failBlock value]) preen!

Item was added:
+ ----- Method: Compiler>>formatNoPattern:ifFail: (in category 'private') -----
+ formatNoPattern: noPattern ifFail: failBlock
+ 	^(self parser
+ 		parseCue: cue 
+ 		noPattern: noPattern
+ 		ifFail: [^failBlock value]) preen!

Item was removed:
- ----- Method: Compiler>>from:class:classified:context:notifying: (in category 'public access') -----
- from: textOrStream class: aClass classified: aCategory context: aContext notifying: req
- 	self source: textOrStream.
- 	self setCue: 
- 		(CompilationCue
- 			source: textOrStream
- 			context: aContext
- 			class: aClass
- 			category: aCategory
- 			requestor: req)!

Item was changed:
  ----- Method: Compiler>>from:class:context:notifying: (in category 'private') -----
  from: textOrStream class: aClass context: aContext notifying: req
- 	self source: textOrStream.
  	self setCue:
  		(CompilationCue
  			source: textOrStream
  			context: aContext
  			class: aClass
  			requestor: req)
  !

Item was changed:
  ----- Method: Compiler>>notify: (in category 'error handling') -----
  notify: aString 
  	"Refer to the comment in Object|notify:."
  
+ 	^self notify: aString at: cue sourceStream position + 1!
- 	^self notify: aString at: sourceStream position + 1!

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
  					inClass: cue getClass
  					category: cue category
  					withCode: 
+ 						(cue sourceStream contents
- 						(sourceStream contents
  							copyReplaceFrom: location
  							to: location - 1
  							with: aString)
  					doitFlag: false
  					errorMessage: aString
  					location: location]
  		ifFalse: [cue requestor
  					notify: aString
  					at: location
+ 					in: cue sourceStream]!
- 					in: sourceStream]!

Item was changed:
  ----- Method: Compiler>>parse:in:notifying: (in category 'public access') -----
  parse: textOrStream in: aClass notifying: req
  	"Compile the argument, textOrStream, with respect to the class, aClass, and
  	 answer the MethodNode that is the root of the resulting parse tree.  Notify the
  	 argument, req, if an error occurs. The failBlock is defaulted to an empty block."
  
  	self from: textOrStream class: aClass context: nil notifying: req.
  	^self parser
+ 		parseCue: cue
- 		parse: sourceStream
- 		cue: cue
  		noPattern: false
  		ifFail: []!

Item was changed:
  ----- Method: Compiler>>setCue: (in category 'private') -----
  setCue: aCue
  	cue := aCue!

Item was removed:
- ----- Method: Compiler>>source: (in category 'private') -----
- source: textOrStream
- 	sourceStream := (textOrStream isKindOf: PositionableStream)
- 		ifTrue: [ textOrStream ]
- 		ifFalse: [ ReadStream on: textOrStream asString ]!

Item was changed:
  ----- Method: Compiler>>translate:noPattern:ifFail: (in category 'private') -----
+ translate: ignored noPattern: noPattern ifFail: failBlock
+ 	^self translateNoPattern: noPattern ifFail: failBlock!
- translate: aStream noPattern: noPattern ifFail: failBlock
- 	^self parser
- 		parse: aStream
- 		cue: cue 
- 		noPattern: noPattern
- 		ifFail: [^failBlock value]!

Item was changed:
  ----- Method: Compiler>>translate:noPattern:ifFail:parser: (in category 'public access') -----
  translate: aStream noPattern: noPattern ifFail: failBlock parser: parser
  	| tree |
  	tree := parser
+ 			parseCue: cue 
- 			parse: aStream
- 			cue: cue 
  			noPattern: noPattern
  			ifFail: [^ failBlock value].
  	^ tree!

Item was added:
+ ----- Method: Compiler>>translateNoPattern:ifFail: (in category 'private') -----
+ translateNoPattern: noPattern ifFail: failBlock
+ 	^self parser
+ 		parseCue: cue 
+ 		noPattern: noPattern
+ 		ifFail: [^failBlock value]!

Item was added:
+ ----- 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 := 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
+ !



More information about the Squeak-dev mailing list