[Pkg] The Trunk: TemporaryVariableScopeEditor-eem.1.mcz

Thu Apr 5 16:57:26 UTC 2012

Eliot Miranda uploaded a new version of TemporaryVariableScopeEditor to project The Trunk:
http://source.squeak.org/trunk/TemporaryVariableScopeEditor-eem.1.mcz

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

Name: TemporaryVariableScopeEditor-eem.1
Author: eem
Time: 5 April 2012, 9:57:16.567 am
UUID: 3d601f26-29f5-4223-bd26-e890d5b765f0
Ancestors: 

A useful utility to move method-level temps used in blocks
into their smallest enclosing block scope.  See the class side
of TempScopeEditor.  Extracted from the Cog package.

==================== Snapshot ====================

SystemOrganization addCategory: #TemporaryVariableScopeEditor!

ParseNodeVisitor subclass: #BlockNodeCollectingVisitor
	instanceVariableNames: 'blockNodes'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TemporaryVariableScopeEditor'!

!BlockNodeCollectingVisitor commentStamp: 'eem 4/3/2012 09:41' prior: 0!
A BlockNodeCollectingVisitor answers the BlockNodes in a parse tree in depth-first order.

Instance Variables
	blockNodes:		<OrderedCollection | nil>

blockNodes
	- the sequence of block nodes in depth-first order.
!

----- Method: BlockNodeCollectingVisitor>>blockNodes (in category 'accessing') -----
blockNodes
	^blockNodes!

----- Method: BlockNodeCollectingVisitor>>visitBlockNode: (in category 'visiting') -----
visitBlockNode: aBlockNode
	(blockNodes ifNil: [blockNodes := OrderedCollection new]) addLast: aBlockNode.
	super visitBlockNode: aBlockNode!

ParseNodeVisitor subclass: #ReadBeforeWrittenVisitor
	instanceVariableNames: 'readBeforeWritten written'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TemporaryVariableScopeEditor'!

!ReadBeforeWrittenVisitor commentStamp: '<historical>' prior: 0!
Answer the set of temporary variables that are read before they are written.!

----- Method: ReadBeforeWrittenVisitor>>readBeforeWritten (in category 'accessing') -----
readBeforeWritten
	^readBeforeWritten ifNil: [IdentitySet new]!

----- Method: ReadBeforeWrittenVisitor>>visitAssignmentNode: (in category 'visiting') -----
visitAssignmentNode: anAssignmentNode
	anAssignmentNode value accept: self.
	anAssignmentNode variable isTemp
		ifTrue:
			[written ifNil: [written := IdentitySet new].
			 written add: anAssignmentNode variable]
		ifFalse:
			[anAssignmentNode variable accept: self]!

----- Method: ReadBeforeWrittenVisitor>>visitBlockNode: (in category 'visiting') -----
visitBlockNode: aBlockNode
	| savedWritten |
	savedWritten := written copy.
	super visitBlockNode: aBlockNode.
	written := savedWritten!

----- Method: ReadBeforeWrittenVisitor>>visitTempVariableNode: (in category 'visiting') -----
visitTempVariableNode: aTempVariableNode
	(aTempVariableNode isArg
	 or: [written notNil
		and: [written includes: aTempVariableNode]]) ifTrue:
		[^self].
	readBeforeWritten ifNil:
		[readBeforeWritten := IdentitySet new].
	readBeforeWritten add: aTempVariableNode!

Object subclass: #TempScopeEditor
	instanceVariableNames: 'method methodNode out tempMap blockNodes sourceString soFar'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'TemporaryVariableScopeEditor'!

!TempScopeEditor commentStamp: 'eem 4/5/2012 09:55' prior: 0!
A TempScopeEditor is a utility that makes a pass over code looking for temporaries that are declared at method level that could be declared at block level, i.e. variables that are only used within a block, and are assigned-to before they are read.  It rewrites any methods it finds fitting this pattern.  See the class-side methods edit and editPackage:.

Instance Variables
	blockNodes:	<(SequenceableCollection of: BlockNode) | nil>
	method:		<CompiledMethod>
	methodNode:	<MethodNode>
	out:				<WriteStream on: String>
	soFar:			<Integer>
	sourceString:	<String>
	tempMap:		<IdentityDictionary of: TempVariableNode ->BlockNode>

blockNodes
	- the block nodes in the current method

method
	- the current method

methodNode
	- the current method's parse tree

out
	- the edited code stream

soFar
	- the point in the sourceString from which code has been copied to out

sourceString
	- the method's source code

tempMap
	- a map from indirect temps to their smallest enclosing scope
!

----- Method: TempScopeEditor class>>edit (in category 'as yet unclassified') -----
edit
	"Trawl the system for methods containing misdeclared temps and correct these methods."
	SystemNavigation default allSelect:
		[:m| | scanner |
		(m isQuick not
		and: [(scanner := InstructionStream on: m) scanFor:
				[:b| b = 143 and: [scanner followingByte >= 16]]]) ifTrue:
			[(self new forMethod: m) edit].
		false]!

----- Method: TempScopeEditor class>>editPackage: (in category 'as yet unclassified') -----
editPackage: packageInfoOrName
	"Trawl the given package for methods containing misdeclared temps and correct these methods."
	"self editPackage: #Cassowary"
	SystemNavigation new
		allMethodsSelect:
			[:m| | scanner |
			(m isQuick not
			and: [(scanner := InstructionStream on: m) scanFor:
					[:b| b = 143 and: [scanner followingByte >= 16]]]) ifTrue:
				[(self new forMethod: m) edit].
			false]
		localToPackage: packageInfoOrName!

----- Method: TempScopeEditor>>anyScopes:outsideExtent: (in category 'editing') -----
anyScopes: referenceScopeDict outsideExtent: blockExtent
	^referenceScopeDict notNil
	   and: [referenceScopeDict notEmpty
	   and: [referenceScopeDict anySatisfy:
			[:set|
			set anySatisfy: [:location| (blockExtent rangeIncludes: location) not]]]]!

----- Method: TempScopeEditor>>blockNode:isEnclosingScopeFor: (in category 'editing') -----
blockNode: aBlockNode isEnclosingScopeFor: aTempVariableNode 
	^((self
		anyScopes: (aTempVariableNode instVarNamed: 'readingScopes')
		outsideExtent: aBlockNode blockExtent)
	or: [self
		anyScopes: (aTempVariableNode instVarNamed: 'writingScopes')
		outsideExtent: aBlockNode blockExtent]) not!

----- Method: TempScopeEditor>>buildTempMap (in category 'editing') -----
buildTempMap
	"Build the map for moving remote temps. Each remote temp
	 that should be moved is entered into the map referencing its
	 smallest enclosing scope.  This may seem backwards but it
	 means that the map is one-to-one, not one-to-many."
	| readBeforeWritten |
	readBeforeWritten := (methodNode accept: ReadBeforeWrittenVisitor new) readBeforeWritten.
	blockNodes do:
		[:blockNode|
		(blockNode temporaries notEmpty
		 and: [blockNode temporaries last isIndirectTempVector]) ifTrue:
			[blockNode temporaries last remoteTemps do:
				[:remoteTemp| | enclosingScopes smallestEnclosingBlockScope |
				 (readBeforeWritten includes: remoteTemp) ifFalse:
				 	[enclosingScopes := blockNodes select: [:blockScope|
															self blockNode: blockScope
																isEnclosingScopeFor: remoteTemp].
					 enclosingScopes notEmpty ifTrue:
						[smallestEnclosingBlockScope := enclosingScopes last.
						 smallestEnclosingBlockScope ~~ blockNode ifTrue:
							 [tempMap at: remoteTemp put: smallestEnclosingBlockScope]]]]]]!

----- Method: TempScopeEditor>>copyMethodMovingTemps (in category 'editing') -----
copyMethodMovingTemps
	| methodBodyStart tempsToKeep tempsStart tempsEnd |
	methodBodyStart := method methodClass parserClass new
							parseMethodComment: sourceString setPattern: [:ignored|];
							startOfNextToken.
	tempsStart := sourceString indexOf: $| startingAt: methodBodyStart.
	tempsEnd := sourceString indexOf: $| startingAt: tempsStart + 1.
	(tempsToKeep := self tempsToKeepAtMethodLevel) isEmpty
		ifTrue:
			[| startOfFirstBlock |
			 startOfFirstBlock := (methodNode encoder sourceRangeFor: blockNodes second closureCreationNode) first.
			 tempsStart < startOfFirstBlock
				ifTrue:
					 [out next: tempsStart - 1 putAll: sourceString.
					  soFar := tempsEnd + 1]
				ifFalse:
					[soFar := 1]]
		ifFalse:
			[out next: tempsStart putAll: sourceString.
			 tempsToKeep do: [:t| out space; nextPutAll: t name].
			 soFar := tempsEnd.
			 (sourceString at: soFar - 1) isSeparator ifTrue:
				[soFar := soFar - 1]].
	blockNodes allButFirst do:
		[:blockNode|
		self processBlockNode: blockNode].
	out next: sourceString size - soFar + 1 putAll: sourceString startingAt: soFar!

----- Method: TempScopeEditor>>edit (in category 'editing') -----
edit
	self buildTempMap.
	tempMap notEmpty ifTrue:
		[| mr |
		 mr := method methodReference.
		 self copyMethodMovingTemps.
		 Transcript cr; show: mr actualClass name, ' >> ', mr methodSymbol.
		 method methodClass compile: out contents classified: mr category]!

----- Method: TempScopeEditor>>editNoCompile (in category 'editing') -----
editNoCompile
	self buildTempMap.
	^tempMap isEmpty ifFalse:
		[self copyMethodMovingTemps.
		 out contents]!

----- Method: TempScopeEditor>>forMethod: (in category 'initialize-release') -----
forMethod: aCompiledMethod
	method := aCompiledMethod.
	sourceString := aCompiledMethod getSourceFromFile asString.
	methodNode := method methodClass parserClass new
						parse: sourceString
						class: method methodClass.
	methodNode ensureClosureAnalysisDone.
	blockNodes := (methodNode accept: BlockNodeCollectingVisitor new)
						blockNodes reject: [:bn| bn optimized].
	out := (String new: sourceString size) writeStream.
	tempMap := IdentityDictionary new

	"(TempScopeEditor new forMethod: SARInstaller class>>#ensurePackageWithId:) edit"!

----- Method: TempScopeEditor>>processBlockNode: (in category 'editing') -----
processBlockNode: blockNode
	| tempsToMoveHere startOfBlock endOfArgs maybeBlockTempsStart blockTempsInSource |
	tempsToMoveHere := (tempMap select: [:aBlockNode| aBlockNode == blockNode]) keys.
	tempsToMoveHere isEmpty ifTrue: [^self].
	startOfBlock := (methodNode encoder sourceRangeFor: blockNode closureCreationNode) first.
	endOfArgs := blockNode arguments isEmpty
					ifTrue: [startOfBlock]
					ifFalse: [sourceString indexOf: $| startingAt: startOfBlock].
	out next: endOfArgs - soFar + 1 putAll: sourceString startingAt: soFar.
	maybeBlockTempsStart := sourceString indexOf: $| startingAt: endOfArgs + 1 ifAbsent: sourceString size + 1.
	blockTempsInSource := (sourceString copyFrom: endOfArgs + 1 to: maybeBlockTempsStart - 1) allSatisfy:
								[:c| c isSeparator].
	blockTempsInSource
		ifTrue:
			[out next: maybeBlockTempsStart - endOfArgs putAll: sourceString startingAt: endOfArgs + 1.
			 (self tempsToKeepFor: blockNode) do:
				[:tempNode| out space; nextPutAll: tempNode name].
			 tempsToMoveHere do: [:t| out space; nextPutAll: t name].
			 soFar := sourceString indexOf: $| startingAt: maybeBlockTempsStart + 1.
			 (sourceString at: soFar - 1) isSeparator ifTrue:
				[soFar := soFar - 1]]
		ifFalse:
			[out space; nextPut: $|.
			 tempsToMoveHere do: [:t| out space; nextPutAll: t name].
			 out space; nextPut: $|.
			 soFar := endOfArgs + 1]!

----- Method: TempScopeEditor>>tempsToKeepAtMethodLevel (in category 'editing') -----
tempsToKeepAtMethodLevel
	^(self tempsToKeepFor: blockNodes first) select:
		[:t|t scope >= 0]!

----- Method: TempScopeEditor>>tempsToKeepFor: (in category 'editing') -----
tempsToKeepFor: blockNode
	| tempsToKeep |
	tempsToKeep := OrderedCollection new.
	blockNode temporaries do:
		[:t|
		t isIndirectTempVector
			ifTrue:
				[t remoteTemps do:
					[:rt|
					(tempMap includesKey: rt) ifFalse:
						[tempsToKeep addLast: rt]]]
			ifFalse:
				[tempsToKeep addLast: t]].
	^tempsToKeep!