Smalltalk current createPackage: 'Compiler-Inlining' properties: #{}! IRAssignment subclass: #IRInlinedAssignment instanceVariableNames: '' package: 'Compiler-Inlining'! !IRInlinedAssignment methodsFor: 'testing'! isInlined ^ true ! ! !IRInlinedAssignment methodsFor: 'visiting'! accept: aVisitor ^ aVisitor visitIRInlinedAssignment: self ! ! IRClosure subclass: #IRInlinedClosure instanceVariableNames: 'assignTo' package: 'Compiler-Inlining'! !IRInlinedClosure methodsFor: 'accessing'! assignTo ^ assignTo ! assignTo: aScopeVar assignTo := aScopeVar ! ! !IRInlinedClosure methodsFor: 'testing'! isInlined ^ true ! ! !IRInlinedClosure methodsFor: 'visiting'! accept: aVisitor aVisitor visitIRInlinedClosure: self ! ! IRReturn subclass: #IRInlinedNonLocalReturn instanceVariableNames: '' package: 'Compiler-Inlining'! !IRInlinedNonLocalReturn methodsFor: 'testing'! isInlined ^ true ! ! !IRInlinedNonLocalReturn methodsFor: 'visiting'! accept: aVisitor ^ aVisitor visitIRInlinedNonLocalReturn: self ! ! IRSend subclass: #IRInlinedSend instanceVariableNames: '' package: 'Compiler-Inlining'! !IRInlinedSend methodsFor: 'testing'! isInlined ^ true ! ! !IRInlinedSend methodsFor: 'visiting'! accept: aVisitor aVisitor visitInlinedSend: self ! ! IRInlinedSend subclass: #IRInlinedIfFalse instanceVariableNames: '' package: 'Compiler-Inlining'! !IRInlinedIfFalse methodsFor: 'visiting'! accept: aVisitor aVisitor visitIRInlinedIfFalse: self ! ! IRInlinedSend subclass: #IRInlinedIfTrue instanceVariableNames: '' package: 'Compiler-Inlining'! !IRInlinedIfTrue methodsFor: 'visiting'! accept: aVisitor aVisitor visitIRInlinedIfTrue: self ! ! IRVisitor subclass: #IRInliner instanceVariableNames: '' package: 'Compiler-Inlining'! !IRInliner methodsFor: 'testing'! shouldInlineAssignment: anIRAssignment ^ anIRAssignment isInlined not and: [ anIRAssignment instructions last isSend and: [ self shouldInlineSend: (anIRAssignment instructions last) ]] ! shouldInlineSend: anIRSend ^ anIRSend isInlined not and: [ IRSendInliner inlinedSelectors includes: anIRSend selector ] ! ! !IRInliner methodsFor: 'visiting'! assignmentInliner ^ IRAssignmentInliner new translator: self; yourself ! sendInliner ^ IRSendInliner new translator: self; yourself ! visitIRAssignment: anIRAssignment (self shouldInlineAssignment: anIRAssignment) ifTrue: [ self assignmentInliner inlineAssignment: anIRAssignment ] ifFalse: [ super visitIRAssignment: anIRAssignment ] ! visitIRNonLocalReturn: anIRNonLocalReturn | localReturn | anIRNonLocalReturn scope canInlineNonLocalReturns ifTrue: [ anIRNonLocalReturn scope methodScope removeNonLocalReturn: anIRNonLocalReturn scope. localReturn := IRInlinedNonLocalReturn new scope: anIRNonLocalReturn scope; yourself. anIRNonLocalReturn instructions do: [ :each | localReturn add: each ]. anIRNonLocalReturn replaceWith: localReturn ]. super visitIRNonLocalReturn: anIRNonLocalReturn ! visitIRSend: anIRSend (self shouldInlineSend: anIRSend) ifTrue: [ self sendInliner inlineSend: anIRSend ] ifFalse: [ super visitIRSend: anIRSend ] ! ! IRJSTranslator subclass: #IRInliningJSTranslator instanceVariableNames: '' package: 'Compiler-Inlining'! !IRInliningJSTranslator methodsFor: 'visiting'! visitIRInlinedAssignment: anIRInlinedAssignment self visit: anIRInlinedAssignment instructions last ! visitIRInlinedClosure: anIRInlinedClosure anIRInlinedClosure instructions ifNotEmpty: [ anIRInlinedClosure instructions allButLast do: [ :each | self visit: each ]. (anIRInlinedClosure assignTo notNil and: [ anIRInlinedClosure instructions last canBeAssigned ]) ifTrue: [ self stream nextPutAll: anIRInlinedClosure assignTo variable alias. self stream nextPutAssignment ]. self visit: anIRInlinedClosure instructions last ] ! visitIRInlinedIfFalse: anIRInlinedIfFalse self stream nextPutIf: [ self stream nextPutAll: '!! smalltalk.assert('. self visit: anIRInlinedIfFalse instructions first. self stream nextPutAll: ')' ] with: [ self visit: anIRInlinedIfFalse instructions last ] ! visitIRInlinedIfTrue: anIRInlinedIfTrue self stream nextPutIf: [ self stream nextPutAll: 'smalltalk.assert('. self visit: anIRInlinedIfTrue instructions first. self stream nextPutAll: ')' ] with: [ self visit: anIRInlinedIfTrue instructions last ] ! ! Object subclass: #IRSendInliner instanceVariableNames: 'send translator' package: 'Compiler-Inlining'! !IRSendInliner commentStamp! I inline some message sends and block closure arguments. I heavily rely on #perform: to dispatch inlining methods.! !IRSendInliner methodsFor: 'accessing'! inlinedClosure ^ IRInlinedClosure new ! send ^ send ! send: anIRSend send := anIRSend ! translator ^ translator ! translator: anASTTranslator translator := anASTTranslator ! ! !IRSendInliner methodsFor: 'error handling'! inliningError: aString InliningError signal: aString ! ! !IRSendInliner methodsFor: 'inlining'! ifFalse: anIRInstruction | inlinedSend inlinedClosure | anIRInstruction isClosure ifFalse: [ self inliningError: 'Message argument should be a block' ]. anIRInstruction arguments size = 0 ifFalse: [ self inliningError: 'Inlined block should have zero argument' ]. inlinedClosure := self inlineClosure: anIRInstruction. inlinedSend := IRInlinedIfFalse new. inlinedSend add: self send instructions first; add: inlinedClosure. self send replaceWith: inlinedSend. ^ inlinedSend ! ifTrue: anIRInstruction | inlinedSend inlinedClosure | anIRInstruction isClosure ifFalse: [ self inliningError: 'Message argument should be a block' ]. anIRInstruction arguments size = 0 ifFalse: [ self inliningError: 'Inlined block should have zero argument' ]. inlinedClosure := self inlineClosure: anIRInstruction. inlinedSend := IRInlinedIfTrue new. inlinedSend add: self send instructions first; add: inlinedClosure. self send replaceWith: inlinedSend. ^ inlinedSend ! inlineClosure: anIRClosure | inlinedClosure | inlinedClosure := self inlinedClosure. inlinedClosure scope: anIRClosure scope. anIRClosure instructions first instructions do: [ :each | inlinedClosure add: (self translator visit: each) ]. ^ inlinedClosure ! inlineSend: anIRSend self send: anIRSend. self perform: self send selector withArguments: self send instructions allButFirst ! ! !IRSendInliner class methodsFor: 'accessing'! inlinedSelectors ^ #('ifTrue:' 'ifFalse:') ! ! IRSendInliner subclass: #IRAssignmentInliner instanceVariableNames: 'assignment' package: 'Compiler-Inlining'! !IRAssignmentInliner methodsFor: 'accessing'! assignment ^ assignment ! assignment: aNode assignment := aNode ! inlinedClosure ^ super inlinedClosure assignTo: self assignment instructions first; yourself ! ! !IRAssignmentInliner methodsFor: 'inlining'! inlineAssignment: anIRAssignment | inlinedAssignment | self assignment: anIRAssignment. inlinedAssignment := IRInlinedAssignment new. anIRAssignment instructions do: [ :each | inlinedAssignment add: each ]. anIRAssignment replaceWith: inlinedAssignment. self inlineSend: inlinedAssignment instructions last. ^ inlinedAssignment ! ! CodeGenerator subclass: #InliningCodeGenerator instanceVariableNames: '' package: 'Compiler-Inlining'! !InliningCodeGenerator methodsFor: 'compiling'! compileNode: aNode | ir stream | self semanticAnalyzer visit: aNode. ir := self translator visit: aNode. self inliner visit: ir. ^ self irTranslator visit: ir; contents ! inliner ^ IRInliner new ! irTranslator ^ IRInliningJSTranslator new ! !