The Trunk: TemporaryVariableScopeEditor-eem.1.mcz

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!