diff --git a/smalltalksrc/Slang-Tests/SLASTTransformationTest.class.st b/smalltalksrc/Slang-Tests/SLASTTransformationTest.class.st index 7c8b8686bd..c925c50171 100644 --- a/smalltalksrc/Slang-Tests/SLASTTransformationTest.class.st +++ b/smalltalksrc/Slang-Tests/SLASTTransformationTest.class.st @@ -12,10 +12,9 @@ Class { SLASTTransformationTest >> setUp [ super setUp. - ccg addClass: SLASTTransformationTestClass. + testClass := SLASTTransformationTestClass. "necessary to get the type of sqInt" SpurMemoryManager initBytesPerWord: 8. - ccg inferTypes. sLExpandASTVisitor := SLExpandASTVisitor new ] @@ -23,9 +22,9 @@ SLASTTransformationTest >> setUp [ SLASTTransformationTest >> testMethodWithBlockValue [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithBlockValue. + tMethod := self addMethodAndMethodCalledBy: #methodWithBlockValue. - sLExpandASTVisitor currentMethod: tMethod . + sLExpandASTVisitor currentMethod: tMethod. sLExpandASTVisitor expandASTInCurrentMethod. translation := self translate: tMethod. @@ -39,9 +38,7 @@ methodWithBlockValue(void) { sqInt arg; - { - 2 + 1; - } + 2 + 1; return 0; }' ] @@ -50,7 +47,7 @@ methodWithBlockValue(void) SLASTTransformationTest >> testMethodWithBlockValueValue [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithBlockValueValue. + tMethod := self addMethodAndMethodCalledBy: #methodWithBlockValueValue. sLExpandASTVisitor currentMethod: tMethod. sLExpandASTVisitor expandASTInCurrentMethod. @@ -68,9 +65,7 @@ methodWithBlockValueValue(void) sqInt arg1; sqInt arg2; - { - 2 + 3; - } + 2 + 3; return 0; }' ] @@ -79,7 +74,7 @@ methodWithBlockValueValue(void) SLASTTransformationTest >> testMethodWithBockInAssignment [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithBockInAssignment. + tMethod := self addMethodAndMethodCalledBy: #methodWithBockInAssignment. sLExpandASTVisitor currentMethod: tMethod. sLExpandASTVisitor expandASTInCurrentMethod. @@ -108,7 +103,7 @@ methodWithBockInAssignment(void) SLASTTransformationTest >> testMethodWithBockValueInAssignment [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithBockValueInAssignment. + tMethod := self addMethodAndMethodCalledBy: #methodWithBockValueInAssignment. sLExpandASTVisitor currentMethod: tMethod. sLExpandASTVisitor expandASTInCurrentMethod. @@ -126,10 +121,8 @@ methodWithBockValueInAssignment(void) sqInt arg; sqInt var; - { - emptyMethod(1); - var = 5; - } + emptyMethod(1); + var = 5; return 0; }' ] @@ -138,7 +131,7 @@ methodWithBockValueInAssignment(void) SLASTTransformationTest >> testMethodWithBockValueValueInAssignment [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithBockValueValueInAssignment. + tMethod := self addMethodAndMethodCalledBy: #methodWithBockValueValueInAssignment. sLExpandASTVisitor currentMethod: tMethod. sLExpandASTVisitor expandASTInCurrentMethod. @@ -157,11 +150,9 @@ methodWithBockValueValueInAssignment(void) sqInt arg2; sqInt var; - { - emptyMethod(1); - emptyMethod(2); - var = 5; - } + emptyMethod(1); + emptyMethod(2); + var = 5; return 0; }' ] @@ -170,7 +161,7 @@ methodWithBockValueValueInAssignment(void) SLASTTransformationTest >> testMethodWithFPrintF [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithFPrintF. + tMethod := self addMethodAndMethodCalledBy: #methodWithFPrintF. sLExpandASTVisitor currentMethod: tMethod. sLExpandASTVisitor expandASTInCurrentMethod. diff --git a/smalltalksrc/Slang-Tests/SLAbstractTranslationTestCase.class.st b/smalltalksrc/Slang-Tests/SLAbstractTranslationTestCase.class.st index bd40270b61..b335db4885 100644 --- a/smalltalksrc/Slang-Tests/SLAbstractTranslationTestCase.class.st +++ b/smalltalksrc/Slang-Tests/SLAbstractTranslationTestCase.class.st @@ -1,10 +1,55 @@ Class { #name : 'SLAbstractTranslationTestCase', #superclass : 'SlangAbstractTestCase', + #instVars : [ + 'testClass' + ], #category : 'Slang-Tests', #package : 'Slang-Tests' } +{ #category : 'helpers' } +SLAbstractTranslationTestCase >> addMethodAndMethodCalledBy: aSelector [ + + ^ self + addMethodAndMethodCalledBy: aSelector + structOrNotBlock: [ :selector | + ccg addMethodFor: testClass selector: selector ] +] + +{ #category : 'helpers' } +SLAbstractTranslationTestCase >> addMethodAndMethodCalledBy: aSelector structOrNotBlock: aBlock [ + + | requiredCalls visited previousSize tMethod classMethodSelectors | + classMethodSelectors := testClass methodDictionary keys. + tMethod := aBlock value: aSelector. + (visited := Set new) add: aSelector. + (requiredCalls := tMethod allCalls) add: tMethod selector. + previousSize := requiredCalls size. + + [ + requiredCalls do: [ :selector | + ((classMethodSelectors includes: selector) and: [ + (visited includes: selector) not ]) ifTrue: [ + tMethod := aBlock value: selector. + visited add: selector. + requiredCalls addAll: tMethod allCalls ] ]. + requiredCalls size > previousSize ] whileTrue: [ + previousSize := requiredCalls size ]. + + ccg inferTypes. + ^ ccg methodNamed: aSelector +] + +{ #category : 'helpers' } +SLAbstractTranslationTestCase >> addStructMethodAndMethodCalledBy: aSelector [ + + ^ self + addMethodAndMethodCalledBy: aSelector + structOrNotBlock: [ :selector | + ccg addStructMethodFor: testClass selector: selector ] +] + { #category : 'helpers' } SLAbstractTranslationTestCase >> astTranslate: tast inStream: aWriteStream [ @@ -15,6 +60,12 @@ SLAbstractTranslationTestCase >> astTranslate: tast inStream: aWriteStream [ cAST acceptVisitor: prettyPrinter. ] +{ #category : 'helpers' } +SLAbstractTranslationTestCase >> doInliningIn: aTMethod [ + + ccg doBasicInlining: true +] + { #category : 'helpers' } SLAbstractTranslationTestCase >> translate: tast [ diff --git a/smalltalksrc/Slang-Tests/SLAnnotatorVisitorTest.class.st b/smalltalksrc/Slang-Tests/SLAnnotatorVisitorTest.class.st new file mode 100644 index 0000000000..5497140d6c --- /dev/null +++ b/smalltalksrc/Slang-Tests/SLAnnotatorVisitorTest.class.st @@ -0,0 +1,1272 @@ +Class { + #name : 'SLAnnotatorVisitorTest', + #superclass : 'SlangAbstractTestCase', + #instVars : [ + 'sLNodeAnnotatorVisitor', + 'nonEffectiveExpressionOrStatementCollection', + 'effectiveExpressionValueCollection' + ], + #category : 'Slang-Tests', + #package : 'Slang-Tests' +} + +{ #category : 'helper' } +SLAnnotatorVisitorTest >> checkEffectiveExpressionValueCollection [ + + ^ effectiveExpressionValueCollection allSatisfy: [ :node | + sLNodeAnnotatorVisitor isInExpression: node ] +] + +{ #category : 'helper' } +SLAnnotatorVisitorTest >> checkNonEffectiveExpressionOrStatementCollection [ + + ^ nonEffectiveExpressionOrStatementCollection allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isEffectiveReturnValue: node) not and: [ + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node) not ] ] +] + +{ #category : 'helper' } +SLAnnotatorVisitorTest >> fillCollectionValue: aTMethod [ + + aTMethod parseTree nodesDo: [ :node | + (sLNodeAnnotatorVisitor isEffectiveExpression: node) + ifTrue: [ effectiveExpressionValueCollection add: node ] + ifFalse: [ nonEffectiveExpressionOrStatementCollection add: node ] ] +] + +{ #category : 'helper' } +SLAnnotatorVisitorTest >> getSendNodeIn: aCollectionOfNode [ + + ^ aCollectionOfNode select: [ :node | node isSend ] +] + +{ #category : 'helper' } +SLAnnotatorVisitorTest >> getValueOfConstantNodeIn: aCollectionOfNode [ + + ^ (aCollectionOfNode select: [ :node | node isConstant ]) collect: [ + :node | node value ] +] + +{ #category : 'assignment' } +SLAnnotatorVisitorTest >> testMethodWithAssignment [ + + | tMethod effectiveConstantExpressionValueSet constant1 constant2And3 send2Add3 assignmentNodes assignmentNodeX assignmentNodeY | + tMethod := ccg methodNamed: #methodWithAssignment. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + effectiveConstantExpressionValueSet := self + getValueOfConstantNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 3. + self assert: effectiveExpressionValueCollection size equals: 6. + + self assert: (effectiveConstantExpressionValueSet includes: 1). + self assert: (effectiveConstantExpressionValueSet includes: 2). + self assert: (effectiveConstantExpressionValueSet includes: 3). + self assert: effectiveConstantExpressionValueSet size equals: 3. + + assignmentNodes := nonEffectiveExpressionOrStatementCollection + select: [ :node | node isAssignment ]. + assignmentNodeX := (assignmentNodes select: [ :node | + node variable name = #x ]) first. + assignmentNodeY := (assignmentNodes select: [ :node | + node variable name = #y ]) first. + + constant1 := (effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value = 1 ] ]) first. + self assert: ((sLNodeAnnotatorVisitor assigningParentFor: constant1) + = assignmentNodeX and: [ + sLNodeAnnotatorVisitor isEffectiveAssignmentValue: constant1 ]). + + constant2And3 := effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value ~= 1 ] ]. + self assert: (constant2And3 allSatisfy: [ :node | + (sLNodeAnnotatorVisitor assigningParentFor: node) + = assignmentNodeY and: [ + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node) not ] ]). + + send2Add3 := (effectiveExpressionValueCollection select: [ :node | + node isSend ]) first. + self assert: + ((sLNodeAnnotatorVisitor isInAssignment: send2Add3) and: [ + (sLNodeAnnotatorVisitor assigningParentFor: send2Add3) + = assignmentNodeY and: [ + sLNodeAnnotatorVisitor isEffectiveAssignmentValue: send2Add3 ] ]). + + effectiveExpressionValueCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInAssignment: node) and: [ + (sLNodeAnnotatorVisitor isInReturn: node) not ]) ]. + + self assert: + (nonEffectiveExpressionOrStatementCollection allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isInExpression: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil ] ] ] ]). + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'return' } +SLAnnotatorVisitorTest >> testMethodWithBlockReturn [ + + | tMethod nonEffectiveExpressionOrStatementConstantSet constant4 returnNode constant2And3 firstStmtList blockNode | + tMethod := ccg methodNamed: #methodWithBlockReturn. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + nonEffectiveExpressionOrStatementConstantSet := self + getValueOfConstantNodeIn: + nonEffectiveExpressionOrStatementCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 5. + self assert: effectiveExpressionValueCollection size equals: 1. + + self + assert: nonEffectiveExpressionOrStatementConstantSet size + equals: 2. + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 2). + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 3). + + returnNode := (nonEffectiveExpressionOrStatementCollection select: [ + :node | node isReturn ]) first. + constant4 := effectiveExpressionValueCollection first. + self assert: constant4 value equals: 4. + self assert: ((sLNodeAnnotatorVisitor isInReturn: constant4) and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: constant4) and: [ + (sLNodeAnnotatorVisitor isInAssignment: constant4) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: constant4) + = returnNode ] ] ]). + + firstStmtList := tMethod parseTree. + { + firstStmtList. + returnNode } do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isInExpression: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil ] ]) ]. + + constant2And3 := nonEffectiveExpressionOrStatementCollection select: [ + :node | node isConstant ]. + blockNode := nonEffectiveExpressionOrStatementCollection select: [ + :node | + node isStatementList and: [ node ~= firstStmtList ] ]. + constant2And3 addAll: blockNode. + constant2And3 do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) and: [ + (sLNodeAnnotatorVisitor isInExpression: node) and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) = returnNode ] ]) ]. + + nonEffectiveExpressionOrStatementCollection do: [ :node | + self assert: (sLNodeAnnotatorVisitor isInAssignment: node) not ]. + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'return' } +SLAnnotatorVisitorTest >> testMethodWithBlockwithExpressionReturn [ + + | tMethod returnNode firstStmtList constant3 constantNodes constant4 constant2 constantTrue variableA assignmentNode | + tMethod := ccg methodNamed: #methodWithBlockwithExpressionReturn. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 7. + self assert: effectiveExpressionValueCollection size equals: 5. + + returnNode := (nonEffectiveExpressionOrStatementCollection select: [ + :node | node isReturn ]) first. + assignmentNode := (nonEffectiveExpressionOrStatementCollection + select: [ :node | node isAssignment ]) first. + constantNodes := effectiveExpressionValueCollection select: [ :node | + node isConstant ]. + + constantTrue := (constantNodes select: [ :node | node value = true ]) + first. + constant2 := (constantNodes select: [ :node | node value = 2 ]) first. + constant3 := (constantNodes select: [ :node | node value = 3 ]) first. + constant4 := (constantNodes select: [ :node | node value = 4 ]) first. + variableA := (effectiveExpressionValueCollection select: [ :node | + node isVariable ]) first. + + { + constant3. + constant4. + constantTrue. + variableA } do: [ :node | + self assert: (sLNodeAnnotatorVisitor isInAssignment: node) ]. + + { + constant3. + constant4 } do: [ :node | + self assert: + ((sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node) and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) + = assignmentNode ]) ]. + + (effectiveExpressionValueCollection reject: [ :node | + { + constant3. + constant4 } includes: node ]) do: [ :node | + self assert: + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node) not ]. + + self assert: + ((sLNodeAnnotatorVisitor isInAssignment: constant2) not and: [ + sLNodeAnnotatorVisitor isEffectiveReturnValue: constant2 ]). + + effectiveExpressionValueCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) = returnNode + and: [ (sLNodeAnnotatorVisitor isInSend: node) not ] ]) ]. + + firstStmtList := tMethod parseTree. + { + firstStmtList. + returnNode } do: [ :node | + self assert: + ((sLNodeAnnotatorVisitor isInExpression: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil ] ] ] ]) ]. + + (nonEffectiveExpressionOrStatementCollection reject: [ :node | + { + firstStmtList. + returnNode } includes: node ]) do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInExpression: node) and: [ + (sLNodeAnnotatorVisitor isInReturn: node) and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) = returnNode ] ]) ]. + + nonEffectiveExpressionOrStatementCollection do: [ :node | + self assert: (sLNodeAnnotatorVisitor isInSend: node) not ]. + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'assignment' } +SLAnnotatorVisitorTest >> testMethodWithConditionalAssignment [ + + | tMethod effectiveConstantExpressionValueSet firstStmtList assignmentNode constant1And2 variableX | + tMethod := ccg methodNamed: #methodWithConditionalAssignment. + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + effectiveConstantExpressionValueSet := self + getValueOfConstantNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 5. + self assert: effectiveExpressionValueCollection size equals: 4. + + self assert: (effectiveConstantExpressionValueSet includes: 1). + self assert: (effectiveConstantExpressionValueSet includes: 2). + self assert: (effectiveConstantExpressionValueSet includes: true). + self assert: effectiveConstantExpressionValueSet size equals: 3. + + assignmentNode := (nonEffectiveExpressionOrStatementCollection + select: [ :node | node isAssignment ]) first. + + constant1And2 := effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value isInteger ] ]. + self assert: (constant1And2 allSatisfy: [ :node | + sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node ]). + + variableX := (effectiveExpressionValueCollection reject: [ :node | + node isConstant ]) first. + self assert: + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: variableX) not. + + effectiveExpressionValueCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) + = assignmentNode and: [ + (sLNodeAnnotatorVisitor isInSend: node) not ] ] ]) ]. + + firstStmtList := tMethod parseTree. + + self assert: + ((nonEffectiveExpressionOrStatementCollection select: [ :node | + node isAssignment not and: [ node ~= firstStmtList ] ]) + allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInAssignment: node) and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) + = assignmentNode and: [ + (sLNodeAnnotatorVisitor isInExpression: node) and: [ + (sLNodeAnnotatorVisitor isInSend: node) not ] ] ] ]). + { + firstStmtList. + assignmentNode } do: [ :node | + self assert: + ((sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor isInExpression: node) not ] ]) ]. + + nonEffectiveExpressionOrStatementCollection do: [ :node | + self assert: (sLNodeAnnotatorVisitor isInReturn: node) not ]. + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'constant' } +SLAnnotatorVisitorTest >> testMethodWithConstant [ + + | tMethod effectiveConstantExpressionValueSet nonEffectiveExpressionOrStatementConstantSet constant5And6 constantTrue returns return5 return6 | + tMethod := ccg methodNamed: #methodWithConstant. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + nonEffectiveExpressionOrStatementConstantSet := self + getValueOfConstantNodeIn: + nonEffectiveExpressionOrStatementCollection. + effectiveConstantExpressionValueSet := self + getValueOfConstantNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 9. + self assert: effectiveExpressionValueCollection size equals: 3. + + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 1). + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 2). + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 3). + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 4). + + self assert: (effectiveConstantExpressionValueSet includes: true). + self assert: (effectiveConstantExpressionValueSet includes: 5). + self assert: (effectiveConstantExpressionValueSet includes: 6). + + constant5And6 := effectiveExpressionValueCollection select: [ :node | + node value isInteger ]. + self assert: (constant5And6 allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInReturn: node) and: [ + sLNodeAnnotatorVisitor isEffectiveReturnValue: node ] ]). + + returns := nonEffectiveExpressionOrStatementCollection select: [ + :node | node isReturn ]. + return5 := (returns select: [ :node | node expression value = 5 ]) + first. + return6 := (returns select: [ :node | node expression value = 6 ]) + first. + + self + assert: (sLNodeAnnotatorVisitor returningParentFor: + (constant5And6 select: [ :node | node value = 5 ]) first) + equals: return5. + self + assert: (sLNodeAnnotatorVisitor returningParentFor: + (constant5And6 select: [ :node | node value = 6 ]) first) + equals: return6. + + constantTrue := (effectiveExpressionValueCollection select: [ :node | + node value = true ]) first. + self assert: + ((sLNodeAnnotatorVisitor isInReturn: constantTrue) not and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: constantTrue) not + and: [ + (sLNodeAnnotatorVisitor returningParentFor: constantTrue) isNil ] ]). + + effectiveExpressionValueCollection do: [ :node | + self assert: (sLNodeAnnotatorVisitor isInAssignment: node) not ]. + + self assert: + (nonEffectiveExpressionOrStatementCollection allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil ] ] ]). + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'iterative' } +SLAnnotatorVisitorTest >> testMethodWithDo [ + "for this method, the AST is modified by asTranslatorNodeIn: for assignment which push down the assignment inside a block " + + | tMethod nonEffectiveExpressionOrStatementSendSet effectiveExpressionValueSendSet doSend blockNode eVariable doReceiver | + tMethod := ccg methodNamed: #methodWithDo. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + nonEffectiveExpressionOrStatementSendSet := self getSendNodeIn: + nonEffectiveExpressionOrStatementCollection. + effectiveExpressionValueSendSet := self getSendNodeIn: + effectiveExpressionValueCollection. + + doSend := tMethod parseTree statements first. + blockNode := doSend arguments first. + eVariable := blockNode statements first. + doReceiver := doSend receiver. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 3. + self assert: effectiveExpressionValueCollection size equals: 2. + + self assert: effectiveExpressionValueSendSet isEmpty. + + self assert: nonEffectiveExpressionOrStatementSendSet size equals: 1. + self assert: + (nonEffectiveExpressionOrStatementSendSet includes: doSend). + + + { + doReceiver. + eVariable } do: [ :node | + self assert: (effectiveExpressionValueCollection includes: node) ]. + + self assert: (sLNodeAnnotatorVisitor isInSend: blockNode). + + effectiveExpressionValueCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil ] ] ]) ]. + + nonEffectiveExpressionOrStatementCollection do: [ :node | + self assert: + ((sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil ] ] ]) ]. + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'return' } +SLAnnotatorVisitorTest >> testMethodWithReturn [ + + | tMethod constant2 returnNode | + tMethod := ccg methodNamed: #methodWithReturn. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 2. + self assert: effectiveExpressionValueCollection size equals: 1. + + constant2 := effectiveExpressionValueCollection first. + self assert: constant2 value equals: 2. + + returnNode := (nonEffectiveExpressionOrStatementCollection select: [ + :node | node isReturn ]) first. + self assert: ((sLNodeAnnotatorVisitor isInReturn: constant2) and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: constant2) and: [ + (sLNodeAnnotatorVisitor returningParentFor: constant2) + = returnNode and: [ + (sLNodeAnnotatorVisitor isInAssignment: constant2) not ] ] ]). + + + self assert: + (nonEffectiveExpressionOrStatementCollection allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor isInExpression: node) not ] ] ] ]). + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'return' } +SLAnnotatorVisitorTest >> testMethodWithReturnInConditional [ + + | tMethod effectiveConstantExpressionValueSet constant2And4 returnNodes return2 return4 constantTrue | + tMethod := ccg methodNamed: #methodWithReturnInConditional. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + effectiveConstantExpressionValueSet := self + getValueOfConstantNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 6. + self assert: effectiveExpressionValueCollection size equals: 3. + + self assert: (effectiveConstantExpressionValueSet includes: 2). + self assert: (effectiveConstantExpressionValueSet includes: 4). + self assert: (effectiveConstantExpressionValueSet includes: true). + + constant2And4 := effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value isInteger ] ]. + self assert: (constant2And4 allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInReturn: node) and: [ + sLNodeAnnotatorVisitor isEffectiveReturnValue: node ] ]). + + + + returnNodes := nonEffectiveExpressionOrStatementCollection select: [ + :node | node isReturn ]. + return2 := (returnNodes select: [ :node | node expression value = 2 ]) + first. + return4 := (returnNodes select: [ :node | node expression value = 4 ]) + first. + + self + assert: (sLNodeAnnotatorVisitor returningParentFor: + (effectiveExpressionValueCollection select: [ :node | + node value = 2 ]) first) + equals: return2. + self + assert: (sLNodeAnnotatorVisitor returningParentFor: + (effectiveExpressionValueCollection select: [ :node | + node value = 4 ]) first) + equals: return4. + + constantTrue := (effectiveExpressionValueCollection select: [ :node | + node value = true ]) first. + self assert: + ((sLNodeAnnotatorVisitor isInReturn: constantTrue) not and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: constantTrue) not + and: [ + (sLNodeAnnotatorVisitor returningParentFor: constantTrue) isNil ] ]). + + effectiveExpressionValueCollection do: [ :node | + self assert: (sLNodeAnnotatorVisitor isInAssignment: node) not ]. + + self assert: + (nonEffectiveExpressionOrStatementCollection allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil ] ] ]). + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'return' } +SLAnnotatorVisitorTest >> testMethodWithReturningConditional [ + + | tMethod effectiveConstantExpressionValueSet constant2And4 returnNode constantTrue firtStmtList | + tMethod := ccg methodNamed: #methodWithReturningConditional. + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + effectiveConstantExpressionValueSet := self + getValueOfConstantNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 5. + self assert: effectiveExpressionValueCollection size equals: 3. + self assert: (effectiveConstantExpressionValueSet includes: 2). + self assert: (effectiveConstantExpressionValueSet includes: 4). + self assert: (effectiveConstantExpressionValueSet includes: true). + + returnNode := (nonEffectiveExpressionOrStatementCollection select: [ + :node | node isReturn ]) first. + constant2And4 := effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value isInteger ] ]. + self assert: (constant2And4 allSatisfy: [ :node | + sLNodeAnnotatorVisitor isEffectiveReturnValue: node ]). + + constantTrue := (effectiveExpressionValueCollection select: [ :node | + node value = true ]) first. + self assert: + (sLNodeAnnotatorVisitor isEffectiveReturnValue: constantTrue) not. + + self assert: + (effectiveExpressionValueCollection allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInReturn: node) and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) = returnNode + and: [ (sLNodeAnnotatorVisitor isInAssignment: node) not ] ] ]). + + firtStmtList := tMethod parseTree. + self assert: + ((nonEffectiveExpressionOrStatementCollection select: [ :node | + node ~= firtStmtList and: [ node ~= returnNode ] ]) allSatisfy: [ + :node | + (sLNodeAnnotatorVisitor isInReturn: node) and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) = returnNode + and: [ sLNodeAnnotatorVisitor isInExpression: node ] ] ]). + { + firtStmtList. + returnNode } do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor isInExpression: node) not ] ]) ]. + + self assert: + (nonEffectiveExpressionOrStatementCollection allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInAssignment: node) not ]). + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'send' } +SLAnnotatorVisitorTest >> testMethodWithSendAsExpression [ + "for this method, the AST is modified by asTranslatorNodeIn: for assignment which push down the assignment inside a block " + + | tMethod nonEffectiveExpressionOrStatementSendSet effectiveExpressionValueSendSet firstSend secondSend thirdSend assignmentNodes assignmentX assignmentY | + tMethod := ccg methodNamed: #methodWithSendAsExpression. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + nonEffectiveExpressionOrStatementSendSet := self getSendNodeIn: + nonEffectiveExpressionOrStatementCollection. + effectiveExpressionValueSendSet := self getSendNodeIn: + effectiveExpressionValueCollection. + + firstSend := ((tMethod parseTree statements at: 1) statements at: 1) + expression. + secondSend := firstSend arguments at: 1. + thirdSend := (tMethod parseTree statements at: 2) expression. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 4. + self assert: effectiveExpressionValueCollection size equals: 8. + + self assert: nonEffectiveExpressionOrStatementSendSet isEmpty. + + self assert: effectiveExpressionValueSendSet size equals: 3. + self assert: (effectiveExpressionValueSendSet includes: firstSend). + self assert: (effectiveExpressionValueSendSet includes: secondSend). + self assert: (effectiveExpressionValueSendSet includes: thirdSend). + + assignmentNodes := nonEffectiveExpressionOrStatementCollection + select: [ :node | node isAssignment ]. + assignmentX := (assignmentNodes select: [ :node | + node variable name = #x ]) first. + assignmentY := (assignmentNodes select: [ :node | + node variable name = #y ]) first. + + { + firstSend. + secondSend } do: [ :node | + self + assert: (sLNodeAnnotatorVisitor assigningParentFor: node) + equals: assignmentX ]. + + self + assert: (sLNodeAnnotatorVisitor assigningParentFor: thirdSend) + equals: assignmentY. + + { + firstSend. + thirdSend } do: [ :node | + self assert: + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node) ]. + + self assert: + ((sLNodeAnnotatorVisitor isEffectiveAssignmentValue: secondSend) not + and: [ sLNodeAnnotatorVisitor isInSend: secondSend ]). + + effectiveExpressionValueCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + sLNodeAnnotatorVisitor isInAssignment: node ]) ]. + + nonEffectiveExpressionOrStatementCollection do: [ :node | + self assert: + ((sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor isInReturn: node) not ] ]) ]. + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'send' } +SLAnnotatorVisitorTest >> testMethodWithSendAsStatement [ + + | tMethod nonEffectiveExpressionOrStatementSendSet effectiveExpressionValueSendSet constant1 firstSend secondSend selfs firstStmtList blockNode | + tMethod := ccg methodNamed: #methodWithSendAsStatement. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + nonEffectiveExpressionOrStatementSendSet := self getSendNodeIn: + nonEffectiveExpressionOrStatementCollection. + effectiveExpressionValueSendSet := self getSendNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 4. + self assert: effectiveExpressionValueCollection size equals: 3. + + constant1 := (effectiveExpressionValueCollection select: [ :node | + node isConstant ]) first. + selfs := effectiveExpressionValueCollection select: [ :node | + node ~= constant1 ]. + self assert: constant1 value equals: 1. + self assert: selfs size equals: 2. + selfs do: [ :node | self assert: node name equals: 'self' ]. + + selfs := effectiveExpressionValueCollection select: [ :node | + node isVariable ]. + selfs do: [ :node | + self assert: (sLNodeAnnotatorVisitor isInSend: node) ]. + + constant1 := (effectiveExpressionValueCollection select: [ :node | + node isConstant ]) first. + self assert: (sLNodeAnnotatorVisitor isInSend: constant1). + + effectiveExpressionValueCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: node) not and: [ + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node) not + and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil ] ] ] ] ]) ]. + + firstSend := (tMethod parseTree statements at: 1) statements at: 1. + secondSend := tMethod parseTree statements at: 2. + self assert: nonEffectiveExpressionOrStatementSendSet size equals: 2. + self assert: + (nonEffectiveExpressionOrStatementSendSet includes: firstSend). + self assert: + (nonEffectiveExpressionOrStatementSendSet includes: secondSend). + + firstStmtList := tMethod parseTree. + self assert: + (nonEffectiveExpressionOrStatementCollection includes: firstStmtList). + blockNode := nonEffectiveExpressionOrStatementCollection reject: [ + :node | + { + firstSend. + secondSend. + firstStmtList } includes: node ]. + self assert: blockNode size equals: 1. + blockNode := blockNode first. + + nonEffectiveExpressionOrStatementCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil ] ] ]) ]. + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'statement-list' } +SLAnnotatorVisitorTest >> testMethodWithStatementList [ + + | tMethod nonEffectiveExpressionOrStatementConstantSet constant11 returnNode blockNodeInReturn constant10 | + tMethod := ccg methodNamed: #methodWithStatementList. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + nonEffectiveExpressionOrStatementConstantSet := self + getValueOfConstantNodeIn: + nonEffectiveExpressionOrStatementCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 10. + self assert: effectiveExpressionValueCollection size equals: 1. + + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 5). + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 6). + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 7). + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 8). + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 9). + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 10). + + returnNode := (nonEffectiveExpressionOrStatementCollection select: [ + :node | node isReturn ]) first. + constant10 := (nonEffectiveExpressionOrStatementCollection select: [ + :node | node isConstant and: [ node value = 10 ] ]) + first. + blockNodeInReturn := returnNode expression. + self assert: (nonEffectiveExpressionOrStatementCollection includes: + blockNodeInReturn). + { + blockNodeInReturn. + constant10 } do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) = returnNode ]) ]. + + self assert: + ((nonEffectiveExpressionOrStatementCollection select: [ :node | + node ~= blockNodeInReturn and: [ node ~= constant10 ] ]) + allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil ] ]). + + nonEffectiveExpressionOrStatementCollection do: [ :node | + self assert: + ((sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil ]) ]. + + constant11 := effectiveExpressionValueCollection first. + self assert: constant11 value equals: 11. + self assert: ((sLNodeAnnotatorVisitor isInReturn: constant11) and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: constant11) and: [ + (sLNodeAnnotatorVisitor isInAssignment: constant11) not ] ]). + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'switch' } +SLAnnotatorVisitorTest >> testMethodWithSwitchAsAssignmentExpression [ + + | tMethod effectiveConstantExpressionValueSet assignmentNode | + tMethod := ccg methodNamed: #methodWithSwitchAsAssignmentExpression. + tMethod prepareMethodIn: ccg. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + effectiveConstantExpressionValueSet := self + getValueOfConstantNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 5. + self assert: effectiveExpressionValueCollection size equals: 6. + + self assert: (effectiveConstantExpressionValueSet includes: 3). + self assert: (effectiveConstantExpressionValueSet includes: 4). + self assert: (effectiveConstantExpressionValueSet includes: 5). + self assert: (effectiveConstantExpressionValueSet includes: 6). + self assert: (effectiveConstantExpressionValueSet includes: 7). + + assignmentNode := (nonEffectiveExpressionOrStatementCollection + select: [ :node | node isAssignment ]) first. + self assert: ((effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value ~= 3 ] ]) allSatisfy: [ :node | + (sLNodeAnnotatorVisitor assigningParentFor: node) = assignmentNode ]). + self assert: ((effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value = 3 ] ]) allSatisfy: [ :node | + (sLNodeAnnotatorVisitor assigningParentFor: node) = assignmentNode ]). + + effectiveExpressionValueCollection do: [ :node | + self + assert: (sLNodeAnnotatorVisitor assigningParentFor: node) + equals: assignmentNode ]. + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection. + + self assert: ((effectiveExpressionValueCollection + addAll: nonEffectiveExpressionOrStatementCollection; + yourself) allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: node) not ] ]) +] + +{ #category : 'switch' } +SLAnnotatorVisitorTest >> testMethodWithSwitchAsReturnExpression [ + + | tMethod nonEffectiveExpressionOrStatementConstantSet effectiveConstantExpressionValueSet firstStmtList | + tMethod := ccg methodNamed: #methodWithSwitchAsReturnExpression. + tMethod prepareMethodIn: ccg. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + nonEffectiveExpressionOrStatementConstantSet := self + getValueOfConstantNodeIn: + nonEffectiveExpressionOrStatementCollection. + effectiveConstantExpressionValueSet := self + getValueOfConstantNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 5. + self assert: effectiveExpressionValueCollection size equals: 5. + + self assert: (effectiveConstantExpressionValueSet includes: 3). + self assert: (effectiveConstantExpressionValueSet includes: 4). + self assert: (effectiveConstantExpressionValueSet includes: 5). + self assert: (effectiveConstantExpressionValueSet includes: 6). + self assert: (effectiveConstantExpressionValueSet includes: 7). + + self assert: ((effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value ~= 3 ] ]) allSatisfy: [ :node | + sLNodeAnnotatorVisitor isInReturn: node "and: [ + sLNodeAnnotatorVisitor isEffectiveReturnValue: node ]" ]). + self assert: ((effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value = 3 ] ]) allSatisfy: [ :node | + sLNodeAnnotatorVisitor isInReturn: node "and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: node) not ]" ]). + + firstStmtList := tMethod parseTree. + + self assert: + ((nonEffectiveExpressionOrStatementCollection select: [ :node | + node isReturn not and: node ~= firstStmtList ]) allSatisfy: [ + :node | sLNodeAnnotatorVisitor isInReturn: node ]). + + self assert: + ((nonEffectiveExpressionOrStatementCollection reject: [ :node | + node isReturn not and: node ~= firstStmtList ]) allSatisfy: [ + :node | (sLNodeAnnotatorVisitor isInReturn: node) not ]). + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection. + + self assert: ((effectiveExpressionValueCollection + addAll: nonEffectiveExpressionOrStatementCollection; + yourself) allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil ] ]) +] + +{ #category : 'switch' } +SLAnnotatorVisitorTest >> testMethodWithSwitchAsStatement [ + + | tMethod nonEffectiveExpressionOrStatementConstantSet effectiveConstantExpressionValueSet | + tMethod := ccg methodNamed: #methodWithSwitchAsStatement. + tMethod prepareMethodIn: ccg. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + nonEffectiveExpressionOrStatementConstantSet := self + getValueOfConstantNodeIn: + nonEffectiveExpressionOrStatementCollection. + effectiveConstantExpressionValueSet := self + getValueOfConstantNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 6. + self assert: effectiveExpressionValueCollection size equals: 3. + + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 6). + self assert: + (nonEffectiveExpressionOrStatementConstantSet includes: 7). + + self assert: (effectiveConstantExpressionValueSet includes: 3). + self assert: (effectiveConstantExpressionValueSet includes: 4). + self assert: (effectiveConstantExpressionValueSet includes: 5). + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection. + + self assert: ((effectiveExpressionValueCollection + addAll: nonEffectiveExpressionOrStatementCollection; + yourself) allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil ] ] ] ]) +] + +{ #category : 'switch' } +SLAnnotatorVisitorTest >> testMethodWithSwitchWithOtherwiseAsAssignmentExpression [ + + | tMethod effectiveConstantExpressionValueSet assignmentNode | + tMethod := ccg methodNamed: + #methodWithSwitchWithOtherwiseAsAssignmentExpression. + tMethod prepareMethodIn: ccg. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + effectiveConstantExpressionValueSet := self + getValueOfConstantNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 6. + self assert: effectiveExpressionValueCollection size equals: 7. + + self assert: (effectiveConstantExpressionValueSet includes: 3). + self assert: (effectiveConstantExpressionValueSet includes: 4). + self assert: (effectiveConstantExpressionValueSet includes: 5). + self assert: (effectiveConstantExpressionValueSet includes: 6). + self assert: (effectiveConstantExpressionValueSet includes: 7). + self assert: (effectiveConstantExpressionValueSet includes: 8). + + assignmentNode := (nonEffectiveExpressionOrStatementCollection + select: [ :node | node isAssignment ]) first. + self assert: ((effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value ~= 3 ] ]) allSatisfy: [ :node | + (sLNodeAnnotatorVisitor assigningParentFor: node) = assignmentNode ]). + self assert: ((effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value = 3 ] ]) allSatisfy: [ :node | + (sLNodeAnnotatorVisitor assigningParentFor: node) = assignmentNode ]). + + effectiveExpressionValueCollection do: [ :node | + self + assert: (sLNodeAnnotatorVisitor assigningParentFor: node) + equals: assignmentNode ]. + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection. + + self assert: ((effectiveExpressionValueCollection + addAll: nonEffectiveExpressionOrStatementCollection; + yourself) allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: node) not ] ]) +] + +{ #category : 'switch' } +SLAnnotatorVisitorTest >> testMethodWithSwitchWithOtherwiseAsReturnExpression [ + + | tMethod nonEffectiveExpressionOrStatementConstantSet effectiveConstantExpressionValueSet firstStmtList | + tMethod := ccg methodNamed: + #methodWithSwitchWithOtherwiseAsReturnExpression. + tMethod prepareMethodIn: ccg. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + nonEffectiveExpressionOrStatementConstantSet := self + getValueOfConstantNodeIn: + nonEffectiveExpressionOrStatementCollection. + effectiveConstantExpressionValueSet := self + getValueOfConstantNodeIn: + effectiveExpressionValueCollection. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 6. + self assert: effectiveExpressionValueCollection size equals: 6. + + self assert: (effectiveConstantExpressionValueSet includes: 3). + self assert: (effectiveConstantExpressionValueSet includes: 4). + self assert: (effectiveConstantExpressionValueSet includes: 5). + self assert: (effectiveConstantExpressionValueSet includes: 6). + self assert: (effectiveConstantExpressionValueSet includes: 7). + self assert: (effectiveConstantExpressionValueSet includes: 8). + + self assert: ((effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value ~= 3 ] ]) allSatisfy: [ :node | + sLNodeAnnotatorVisitor isInReturn: node "and: [ + sLNodeAnnotatorVisitor isEffectiveReturnValue: node ]" ]). + self assert: ((effectiveExpressionValueCollection select: [ :node | + node isConstant and: [ node value = 3 ] ]) allSatisfy: [ :node | + sLNodeAnnotatorVisitor isInReturn: node "and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: node) not ]" ]). + + firstStmtList := tMethod parseTree. + + self assert: + ((nonEffectiveExpressionOrStatementCollection select: [ :node | + node isReturn not and: node ~= firstStmtList ]) allSatisfy: [ + :node | sLNodeAnnotatorVisitor isInReturn: node ]). + + self assert: + ((nonEffectiveExpressionOrStatementCollection reject: [ :node | + node isReturn not and: node ~= firstStmtList ]) allSatisfy: [ + :node | (sLNodeAnnotatorVisitor isInReturn: node) not ]). + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection. + + self assert: ((effectiveExpressionValueCollection + addAll: nonEffectiveExpressionOrStatementCollection; + yourself) allSatisfy: [ :node | + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil ] ]) +] + +{ #category : 'block' } +SLAnnotatorVisitorTest >> testMethodWithValue [ + + | tMethod assigmnentNode constantNodes firstStmtList constant2 constant3 | + tMethod := ccg methodNamed: #methodWithValue. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 4. + self assert: effectiveExpressionValueCollection size equals: 7. + + + assigmnentNode := (nonEffectiveExpressionOrStatementCollection + select: [ :node | node isAssignment ]) first. + constantNodes := effectiveExpressionValueCollection select: [ :node | + node isConstant ]. + + constant2 := (constantNodes select: [ :node | node value = 2 ]) first. + constant3 := (constantNodes select: [ :node | node value = 3 ]) first. + { + constant2. + constant3 } do: [ :node | + self assert: + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node) ]. + + (effectiveExpressionValueCollection reject: [ :node | + { + constant2. + constant3 } includes: node ]) do: [ :node | + self assert: + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node) not ]. + + effectiveExpressionValueCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) + = assigmnentNode and: [ + (sLNodeAnnotatorVisitor isInSend: node) not ] ] ] ] ]) ]. + + firstStmtList := tMethod parseTree. + { + firstStmtList. + assigmnentNode } do: [ :node | + self assert: + ((sLNodeAnnotatorVisitor isInExpression: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil ] ]) ]. + + (nonEffectiveExpressionOrStatementCollection reject: [ :node | + { + firstStmtList. + assigmnentNode } includes: node ]) do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInExpression: node) and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) + = assigmnentNode and: [ + sLNodeAnnotatorVisitor isInAssignment: node ] ]) ]. + + nonEffectiveExpressionOrStatementCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor isInSend: node) not ] ]) ]. + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] + +{ #category : 'block' } +SLAnnotatorVisitorTest >> testMethodWithValueArgument [ + + | tMethod firstStmtList assigmnentNode constantNodes constant3 variableArg | + tMethod := ccg methodNamed: #methodWithValueArgument. + + sLNodeAnnotatorVisitor visit: tMethod parseTree. + + self fillCollectionValue: tMethod. + + self + assert: nonEffectiveExpressionOrStatementCollection size + equals: 4. + self assert: effectiveExpressionValueCollection size equals: 8. + + + assigmnentNode := (nonEffectiveExpressionOrStatementCollection + select: [ :node | node isAssignment ]) first. + constantNodes := effectiveExpressionValueCollection select: [ :node | + node isConstant ]. + + constant3 := (constantNodes select: [ :node | node value = 3 ]) first. + + variableArg := (effectiveExpressionValueCollection select: [ :node | + node isVariable and: [ node name = #arg ] ]) first. + { + variableArg. + constant3 } do: [ :node | + self assert: + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node) ]. + + (effectiveExpressionValueCollection reject: [ :node | + { + variableArg. + constant3 } includes: node ]) do: [ :node | + self assert: + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: node) not ]. + + effectiveExpressionValueCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor isEffectiveReturnValue: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) + = assigmnentNode and: [ + (sLNodeAnnotatorVisitor isInSend: node) not ] ] ] ] ]) ]. + + firstStmtList := tMethod parseTree. + { + firstStmtList. + assigmnentNode } do: [ :node | + self assert: + ((sLNodeAnnotatorVisitor isInExpression: node) not and: [ + (sLNodeAnnotatorVisitor isInAssignment: node) not and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) isNil ] ]) ]. + + (nonEffectiveExpressionOrStatementCollection reject: [ :node | + { + firstStmtList. + assigmnentNode } includes: node ]) do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInExpression: node) and: [ + (sLNodeAnnotatorVisitor assigningParentFor: node) + = assigmnentNode and: [ + sLNodeAnnotatorVisitor isInAssignment: node ] ]) ]. + + nonEffectiveExpressionOrStatementCollection do: [ :node | + self assert: ((sLNodeAnnotatorVisitor isInReturn: node) not and: [ + (sLNodeAnnotatorVisitor returningParentFor: node) isNil and: [ + (sLNodeAnnotatorVisitor isInSend: node) not ] ]) ]. + + self assert: self checkNonEffectiveExpressionOrStatementCollection. + self assert: self checkEffectiveExpressionValueCollection +] diff --git a/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTest.class.st b/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTest.class.st index cbb9ba0eab..fb7e6765c4 100644 --- a/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTest.class.st +++ b/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTest.class.st @@ -13,12 +13,10 @@ Class { SLDeadCodeEliminationTest >> setUp [ super setUp. - ccg addStructClass: SLDeadCodeEliminationTestClass. + testClass := SLDeadCodeEliminationTestClass. "necessary to get the type of sqInt" SpurMemoryManager initBytesPerWord: 8. - ccg inferTypes. - sLDeadCodeElimination := SLDeadCodeElimination new codeGenerator: ccg. - + sLDeadCodeElimination := SLDeadCodeElimination new codeGenerator: ccg ] { #category : 'only-comment' } @@ -26,11 +24,11 @@ SLDeadCodeEliminationTest >> testConditionalWithOnlyCommentNoSendInReceiver [ "currently the only way to get comments in a methods is through inlining, having only comments is equivalent to being empty so it shouldn't change the behavior of the dead code elimination process" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #conditionalWithOnlyCommentNoSendInReceiver. ccg prepareMethods. - ccg doBasicInlining: true. + self doInliningIn: tMethod. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -45,9 +43,7 @@ SLDeadCodeEliminationTest >> testConditionalWithOnlyCommentNoSendInReceiver [ static void conditionalWithOnlyCommentNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_conditionalWithOnlyCommentNoSendInReceiver) { - { - return; - } + return; }' ] @@ -56,10 +52,10 @@ SLDeadCodeEliminationTest >> testConditionalWithOnlyCommentSendInReceiver [ "currently the only way to get comments in a methods is through inlining, having only comments is equivalent to being empty so it shouldn't change the behavior of the dead code elimination process" | translation tMethod | - tMethod := ccg methodNamed: #conditionalWithOnlyCommentSendInReceiver. + tMethod := self addStructMethodAndMethodCalledBy: #conditionalWithOnlyCommentSendInReceiver. ccg prepareMethods. - ccg doBasicInlining: true. + self doInliningIn: tMethod. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -74,12 +70,8 @@ SLDeadCodeEliminationTest >> testConditionalWithOnlyCommentSendInReceiver [ static void conditionalWithOnlyCommentSendInReceiver(SLDeadCodeEliminationTestClass * self_in_conditionalWithOnlyCommentSendInReceiver) { - { - method(self_in_conditionalWithOnlyCommentSendInReceiver, method(self_in_conditionalWithOnlyCommentSendInReceiver)); - } - { - return; - } + method(self_in_conditionalWithOnlyCommentSendInReceiver, method(self_in_conditionalWithOnlyCommentSendInReceiver)); + return; }' ] @@ -87,7 +79,7 @@ conditionalWithOnlyCommentSendInReceiver(SLDeadCodeEliminationTestClass * self_i SLDeadCodeEliminationTest >> testMethodAddingCallInCoerce [ | translation tMethod | - tMethod := ccg methodNamed: #methodAddingCallInCoerce. + tMethod := self addStructMethodAndMethodCalledBy: #methodAddingCallInCoerce. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -103,9 +95,7 @@ static void methodAddingCallInCoerce(SLDeadCodeEliminationTestClass * self_in_methodAddingCallInCoerce) { ((type) ((method(self_in_methodAddingCallInCoerce)) + (method(self_in_methodAddingCallInCoerce))) ); - { - return; - } + return; }' ] @@ -113,7 +103,7 @@ methodAddingCallInCoerce(SLDeadCodeEliminationTestClass * self_in_methodAddingCa SLDeadCodeEliminationTest >> testMethodWithBlockValueAssignmentIntoSameVariableInArguments [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithBlockValueAssignmentIntoSameVariableInArguments. sLDeadCodeElimination currentMethod: tMethod. @@ -134,9 +124,7 @@ methodWithBlockValueAssignmentIntoSameVariableInArguments(SLDeadCodeEliminationT sqInt var; var = 0; - { - method(self_in_methodWithBlockValueAssignmentIntoSameVariableInArguments, var); - } + method(self_in_methodWithBlockValueAssignmentIntoSameVariableInArguments, var); return var; }' ] @@ -145,7 +133,7 @@ methodWithBlockValueAssignmentIntoSameVariableInArguments(SLDeadCodeEliminationT SLDeadCodeEliminationTest >> testMethodWithBlockValueAssignmentNotIntoSameVariableInArguments [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithBlockValueAssignmentNotIntoSameVariableInArguments. sLDeadCodeElimination currentMethod: tMethod. @@ -167,10 +155,8 @@ methodWithBlockValueAssignmentNotIntoSameVariableInArguments(SLDeadCodeEliminati sqInt var2; var2 = 0; - { - method(self_in_methodWithBlockValueAssignmentNotIntoSameVariableInArguments, var2); - var = var2; - } + method(self_in_methodWithBlockValueAssignmentNotIntoSameVariableInArguments, var2); + var = var2; return var; }' ] @@ -180,7 +166,7 @@ SLDeadCodeEliminationTest >> testMethodWithBlockValueValueAssignmentIntoSameVari "remove var = var" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithBlockValueValueAssignmentIntoSameVariableInArguments. sLDeadCodeElimination currentMethod: tMethod. @@ -204,10 +190,8 @@ methodWithBlockValueValueAssignmentIntoSameVariableInArguments(SLDeadCodeElimina var = 0; var2 = 0; - { - method(self_in_methodWithBlockValueValueAssignmentIntoSameVariableInArguments, var2); - method(self_in_methodWithBlockValueValueAssignmentIntoSameVariableInArguments, var); - } + method(self_in_methodWithBlockValueValueAssignmentIntoSameVariableInArguments, var2); + method(self_in_methodWithBlockValueValueAssignmentIntoSameVariableInArguments, var); return var; }' ] @@ -216,7 +200,7 @@ methodWithBlockValueValueAssignmentIntoSameVariableInArguments(SLDeadCodeElimina SLDeadCodeEliminationTest >> testMethodWithBlockValueValueAssignmentNotIntoSameVariableInArguments [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithBlockValueValueAssignmentNotIntoSameVariableInArguments. sLDeadCodeElimination currentMethod: tMethod. @@ -240,14 +224,10 @@ methodWithBlockValueValueAssignmentNotIntoSameVariableInArguments(SLDeadCodeElim var = 0; var2 = 0; - { - method(self_in_methodWithBlockValueValueAssignmentNotIntoSameVariableInArguments, var); - method(self_in_methodWithBlockValueValueAssignmentNotIntoSameVariableInArguments, var2); - var = var2; - } - { - return; - } + method(self_in_methodWithBlockValueValueAssignmentNotIntoSameVariableInArguments, var); + method(self_in_methodWithBlockValueValueAssignmentNotIntoSameVariableInArguments, var2); + var = var2; + return; }' ] @@ -256,7 +236,7 @@ SLDeadCodeEliminationTest >> testMethodWithCallInCoerce [ "the cCoerce is unecessary but is kept anyway" | translation tMethod | - tMethod := ccg methodNamed: #methodWithCallInCoerce. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithCallInCoerce. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -273,9 +253,7 @@ static void methodWithCallInCoerce(SLDeadCodeEliminationTestClass * self_in_methodWithCallInCoerce) { ((type) (method(self_in_methodWithCallInCoerce)) ); - { - return; - } + return; }' ] @@ -283,7 +261,7 @@ methodWithCallInCoerce(SLDeadCodeEliminationTestClass * self_in_methodWithCallIn SLDeadCodeEliminationTest >> testMethodWithConstantInAssignment [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithConstantInAssignment. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithConstantInAssignment. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -310,7 +288,7 @@ methodWithConstantInAssignment(SLDeadCodeEliminationTestClass * self_in_methodWi SLDeadCodeEliminationTest >> testMethodWithConstantInReturn [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithConstantInReturn. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithConstantInReturn. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -334,7 +312,7 @@ methodWithConstantInReturn(SLDeadCodeEliminationTestClass * self_in_methodWithCo SLDeadCodeEliminationTest >> testMethodWithDeadCodeInRepeat [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithDeadCodeInRepeat. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithDeadCodeInRepeat. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -352,9 +330,7 @@ methodWithDeadCodeInRepeat(SLDeadCodeEliminationTestClass * self_in_methodWithDe while (1) { method(self_in_methodWithDeadCodeInRepeat); } - { - return; - } + return; }' ] @@ -362,7 +338,7 @@ methodWithDeadCodeInRepeat(SLDeadCodeEliminationTestClass * self_in_methodWithDe SLDeadCodeEliminationTest >> testMethodWithDeadCodeInTimesRepeat [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithDeadCodeInTimesRepeat. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithDeadCodeInTimesRepeat. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -399,7 +375,7 @@ methodWithDeadCodeInTimesRepeat(SLDeadCodeEliminationTestClass * self_in_methodW SLDeadCodeEliminationTest >> testMethodWithDeadCodeInToByDo [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithDeadCodeInToByDo. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithDeadCodeInToByDo. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -427,7 +403,7 @@ methodWithDeadCodeInToByDo(SLDeadCodeEliminationTestClass * self_in_methodWithDe SLDeadCodeEliminationTest >> testMethodWithDeadCodeInToDo [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithDeadCodeInToDo. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithDeadCodeInToDo. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -455,7 +431,7 @@ methodWithDeadCodeInToDo(SLDeadCodeEliminationTestClass * self_in_methodWithDead SLDeadCodeEliminationTest >> testMethodWithDeadCodeInWhileFalse [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithDeadCodeInWhileFalseLastExpressionIsLeaf. sLDeadCodeElimination currentMethod: tMethod. @@ -474,9 +450,7 @@ methodWithDeadCodeInWhileFalseLastExpressionIsLeaf(SLDeadCodeEliminationTestClas do { method(self_in_methodWithDeadCodeInWhileFalseLastExpressionIsLeaf); } while (!1); - { - return; - } + return; }' ] @@ -484,7 +458,7 @@ methodWithDeadCodeInWhileFalseLastExpressionIsLeaf(SLDeadCodeEliminationTestClas SLDeadCodeEliminationTest >> testMethodWithDeadCodeInWhileFalseBinaryNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithDeadCodeInWhileFalseBinaryNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -508,9 +482,7 @@ methodWithDeadCodeInWhileFalseBinaryNoSendInReceiver(SLDeadCodeEliminationTestCl while (!(var == 1)) { method(self_in_methodWithDeadCodeInWhileFalseBinaryNoSendInReceiver); } - { - return; - } + return; }' ] @@ -518,7 +490,7 @@ methodWithDeadCodeInWhileFalseBinaryNoSendInReceiver(SLDeadCodeEliminationTestCl SLDeadCodeEliminationTest >> testMethodWithDeadCodeInWhileFalseBinarySendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithDeadCodeInWhileFalseBinarySendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -537,9 +509,7 @@ methodWithDeadCodeInWhileFalseBinarySendInReceiver(SLDeadCodeEliminationTestClas while (!(method(self_in_methodWithDeadCodeInWhileFalseBinarySendInReceiver))) { method(self_in_methodWithDeadCodeInWhileFalseBinarySendInReceiver); } - { - return; - } + return; }' ] @@ -547,7 +517,7 @@ methodWithDeadCodeInWhileFalseBinarySendInReceiver(SLDeadCodeEliminationTestClas SLDeadCodeEliminationTest >> testMethodWithDeadCodeInWhileTrue [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithDeadCodeInWhileTrueLastExpressionIsLeaf. sLDeadCodeElimination currentMethod: tMethod. @@ -566,9 +536,7 @@ methodWithDeadCodeInWhileTrueLastExpressionIsLeaf(SLDeadCodeEliminationTestClass do { method(self_in_methodWithDeadCodeInWhileTrueLastExpressionIsLeaf); } while (1); - { - return; - } + return; }' ] @@ -576,7 +544,7 @@ methodWithDeadCodeInWhileTrueLastExpressionIsLeaf(SLDeadCodeEliminationTestClass SLDeadCodeEliminationTest >> testMethodWithDeadCodeInWhileTrueBinaryNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithDeadCodeInWhileTrueBinaryNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -600,9 +568,7 @@ methodWithDeadCodeInWhileTrueBinaryNoSendInReceiver(SLDeadCodeEliminationTestCla while (var == 0) { method(self_in_methodWithDeadCodeInWhileTrueBinaryNoSendInReceiver); } - { - return; - } + return; }' ] @@ -610,7 +576,7 @@ methodWithDeadCodeInWhileTrueBinaryNoSendInReceiver(SLDeadCodeEliminationTestCla SLDeadCodeEliminationTest >> testMethodWithDeadCodeInWhileTrueBinarySendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithDeadCodeInWhileTrueBinarySendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -629,9 +595,7 @@ methodWithDeadCodeInWhileTrueBinarySendInReceiver(SLDeadCodeEliminationTestClass while (method(self_in_methodWithDeadCodeInWhileTrueBinarySendInReceiver)) { method(self_in_methodWithDeadCodeInWhileTrueBinarySendInReceiver); } - { - return; - } + return; }' ] @@ -640,7 +604,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyCaseOfNoSendInReceiver [ "we need to use prepareMethodIn to build switch node, we keep the switch because of the default being an error" | translation tMethod | - tMethod := ccg methodNamed: #methodWithEmptyCaseOfNoSendInReceiver:. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyCaseOfNoSendInReceiver:. tMethod prepareMethodIn: ccg. sLDeadCodeElimination currentMethod: tMethod. @@ -665,9 +629,7 @@ methodWithEmptyCaseOfNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_m default: error("Case not found and no otherwise clause"); } - { - return; - } + return; }' ] @@ -676,7 +638,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyCaseOfOtherwiseNoSendInReceiver "we need to use prepareMethodIn to build switch node, the cases and the otherwise are empty so the node is suppressed" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyCaseOfOtherwiseNoSendInReceiver:. tMethod prepareMethodIn: ccg. @@ -693,9 +655,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyCaseOfOtherwiseNoSendInReceiver static void methodWithEmptyCaseOfOtherwiseNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyCaseOfOtherwiseNoSendInReceiver, sqInt anInt) { - { - return; - } + return; }' ] @@ -704,7 +664,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyCaseOfOtherwiseSendInReceiver [ "we need to use prepareMethodIn to build switch node, we keep the message send but the cases and the otherwise are empty so the node is suppressed " | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyCaseOfOtherwiseSendInReceiver. tMethod prepareMethodIn: ccg. @@ -721,12 +681,8 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyCaseOfOtherwiseSendInReceiver [ static void methodWithEmptyCaseOfOtherwiseSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyCaseOfOtherwiseSendInReceiver) { - { - method(self_in_methodWithEmptyCaseOfOtherwiseSendInReceiver, 2); - } - { - return; - } + method(self_in_methodWithEmptyCaseOfOtherwiseSendInReceiver, 2); + return; }' ] @@ -735,7 +691,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyCaseOfSendInReceiver [ "we need to use prepareMethodIn to build switch node, the cases are empty only the default remains " | translation tMethod | - tMethod := ccg methodNamed: #methodWithEmptyCaseOfSendInReceiver. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyCaseOfSendInReceiver. tMethod prepareMethodIn: ccg. sLDeadCodeElimination currentMethod: tMethod. @@ -761,9 +717,7 @@ methodWithEmptyCaseOfSendInReceiver(SLDeadCodeEliminationTestClass * self_in_met default: error("Case not found and no otherwise clause"); } - { - return; - } + return; }' ] @@ -772,7 +726,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfFalseIfTrueAndNoSendInReceiver "supress the send" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfFalseIfTrueAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -788,9 +742,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfFalseIfTrueAndNoSendInReceiver static void methodWithEmptyIfFalseIfTrueAndNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyIfFalseIfTrueAndNoSendInReceiver) { - { - return; - } + return; }' ] @@ -799,7 +751,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfFalseIfTrueAndSendInReceiver [ "suppress the send and keep the 4 send in the receiver" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfFalseIfTrueAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -815,15 +767,11 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfFalseIfTrueAndSendInReceiver [ static void methodWithEmptyIfFalseIfTrueAndSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver) { - { - method(self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver); - method(self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver, 1); - method(self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver); - method(self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver, method(self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver)); - } - { - return; - } + method(self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver); + method(self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver, 1); + method(self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver); + method(self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver, method(self_in_methodWithEmptyIfFalseIfTrueAndSendInReceiver)); + return; }' ] @@ -832,7 +780,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfFalseInIfFalseIfTrueAndNoSendI "reduce the conditional to an ifTrue" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfFalseInIfFalseIfTrueAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -864,7 +812,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfFalseInIfFalseIfTrueAndSendInR "reduce the conditional to an ifTrue" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfFalseInIfFalseIfTrueAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -894,7 +842,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfFalseInIfTrueIfFalseAndNoSendI "reduce the conditional to an ifTrue" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfFalseInIfTrueIfFalseAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -926,7 +874,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfFalseInIfTrueIfFalseAndSendInR "reduce the conditional to an ifTrue" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfFalseInIfTrueIfFalseAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -956,7 +904,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfNilIfNotNilAndNoSendInReceiver "supress the send" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfNilIfNotNilAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -972,9 +920,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfNilIfNotNilAndNoSendInReceiver static void methodWithEmptyIfNilIfNotNilAndNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyIfNilIfNotNilAndNoSendInReceiver) { - { - return; - } + return; }' ] @@ -983,7 +929,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfNilIfNotNilAndSendInReceiver [ "supress the send and keep the send in the receiver" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfNilIfNotNilAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -999,12 +945,8 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfNilIfNotNilAndSendInReceiver [ static void methodWithEmptyIfNilIfNotNilAndSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyIfNilIfNotNilAndSendInReceiver) { - { - method(self_in_methodWithEmptyIfNilIfNotNilAndSendInReceiver); - } - { - return; - } + method(self_in_methodWithEmptyIfNilIfNotNilAndSendInReceiver); + return; }' ] @@ -1013,7 +955,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfNotNilIfNilAndNoSendInReceiver "supress the send" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfNotNilIfNilAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1029,9 +971,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfNotNilIfNilAndNoSendInReceiver static void methodWithEmptyIfNotNilIfNilAndNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyIfNotNilIfNilAndNoSendInReceiver) { - { - return; - } + return; }' ] @@ -1040,7 +980,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfNotNilIfNilAndSendInReceiver [ "supress the send and keep the send in the receiver" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfNotNilIfNilAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1056,12 +996,8 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfNotNilIfNilAndSendInReceiver [ static void methodWithEmptyIfNotNilIfNilAndSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyIfNotNilIfNilAndSendInReceiver) { - { - method(self_in_methodWithEmptyIfNotNilIfNilAndSendInReceiver); - } - { - return; - } + method(self_in_methodWithEmptyIfNotNilIfNilAndSendInReceiver); + return; }' ] @@ -1070,7 +1006,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfTrueIfFalseAndNoSendInReceiver "supress the send" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfTrueIfFalseAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1086,9 +1022,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfTrueIfFalseAndNoSendInReceiver static void methodWithEmptyIfTrueIfFalseAndNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyIfTrueIfFalseAndNoSendInReceiver) { - { - return; - } + return; }' ] @@ -1097,7 +1031,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfTrueIfFalseAndSendInReceiver [ "supress the send and keep the 4 send in the receiver" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfTrueIfFalseAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1113,15 +1047,11 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfTrueIfFalseAndSendInReceiver [ static void methodWithEmptyIfTrueIfFalseAndSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver) { - { - method(self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver); - method(self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver, 1); - method(self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver); - method(self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver, method(self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver)); - } - { - return; - } + method(self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver); + method(self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver, 1); + method(self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver); + method(self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver, method(self_in_methodWithEmptyIfTrueIfFalseAndSendInReceiver)); + return; }' ] @@ -1130,7 +1060,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfTrueInIfFalseIfTrueAndNoSendIn "reduce the conditional to an ifFalse" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfTrueInIfFalseIfTrueAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1162,7 +1092,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfTrueInIfFalseIfTrueAndSendInRe "reduce the conditional to an ifFalse" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfTrueInIfFalseIfTrueAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1192,7 +1122,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfTrueInIfTrueIfFalseAndNoSendIn "reduce the conditional to an ifFalse" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfTrueInIfTrueIfFalseAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1224,7 +1154,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyIfTrueInIfTrueIfFalseAndSendInRe "reduce the conditional to an ifFalse" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyIfTrueInIfTrueIfFalseAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1253,7 +1183,7 @@ methodWithEmptyIfTrueInIfTrueIfFalseAndSendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithEmptyWhileFalseNoSendInCondition [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyWhileFalseNoSendInCondition. sLDeadCodeElimination currentMethod: tMethod. @@ -1269,9 +1199,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyWhileFalseNoSendInCondition [ static void methodWithEmptyWhileFalseNoSendInCondition(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyWhileFalseNoSendInCondition) { - { - return; - } + return; }' ] @@ -1279,7 +1207,7 @@ methodWithEmptyWhileFalseNoSendInCondition(SLDeadCodeEliminationTestClass * self SLDeadCodeEliminationTest >> testMethodWithEmptyWhileFalseSendInCondition [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithEmptyWhileFalseSendInCondition. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyWhileFalseSendInCondition. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -1294,12 +1222,8 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyWhileFalseSendInCondition [ static void methodWithEmptyWhileFalseSendInCondition(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyWhileFalseSendInCondition) { - { - method(self_in_methodWithEmptyWhileFalseSendInCondition); - } - { - return; - } + method(self_in_methodWithEmptyWhileFalseSendInCondition); + return; }' ] @@ -1307,7 +1231,7 @@ methodWithEmptyWhileFalseSendInCondition(SLDeadCodeEliminationTestClass * self_i SLDeadCodeEliminationTest >> testMethodWithEmptyWhileTrueNoSendInCondition [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyWhileTrueNoSendInCondition. sLDeadCodeElimination currentMethod: tMethod. @@ -1323,9 +1247,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyWhileTrueNoSendInCondition [ static void methodWithEmptyWhileTrueNoSendInCondition(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyWhileTrueNoSendInCondition) { - { - return; - } + return; }' ] @@ -1333,7 +1255,7 @@ methodWithEmptyWhileTrueNoSendInCondition(SLDeadCodeEliminationTestClass * self_ SLDeadCodeEliminationTest >> testMethodWithEmptyWhileTrueSendInCondition [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithEmptyWhileTrueSendInCondition. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyWhileTrueSendInCondition. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -1348,12 +1270,8 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyWhileTrueSendInCondition [ static void methodWithEmptyWhileTrueSendInCondition(SLDeadCodeEliminationTestClass * self_in_methodWithEmptyWhileTrueSendInCondition) { - { - method(self_in_methodWithEmptyWhileTrueSendInCondition); - } - { - return; - } + method(self_in_methodWithEmptyWhileTrueSendInCondition); + return; }' ] @@ -1362,7 +1280,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyifNilInIfNilIfNotNilAndNoSendInR "reduce the conditional to an ifNotNil" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyifNilInIfNilIfNotNilAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1394,7 +1312,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyifNilInIfNilIfNotNilAndSendInRec "reduce the conditional to an ifNotNil" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyifNilInIfNilIfNotNilAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1426,7 +1344,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyifNilInIfNotNilIfNilAndNoSendInR "reduce the conditional to an ifNotNil" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyifNilInIfNotNilIfNilAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1458,7 +1376,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyifNilInIfNotNilIfNilAndSendInRec "reduce the conditional to an ifNotNil" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyifNilInIfNotNilIfNilAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1490,7 +1408,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyifNotNilInIfNilIfNotNilAndNoSend "reduce the conditional to an ifNil" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyifNotNilInIfNilIfNotNilAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1522,7 +1440,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyifNotNilInIfNilIfNotNilAndSendIn "reduce the conditional to an ifNil" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyifNotNilInIfNilIfNotNilAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1554,7 +1472,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyifNotNilInIfNotNilIfNilAndNoSend "reduce the conditional to an ifNil" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyifNotNilInIfNotNilIfNilAndNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1586,7 +1504,7 @@ SLDeadCodeEliminationTest >> testMethodWithEmptyifNotNilInIfNotNilIfNilAndSendIn "reduce the conditional to an ifNil" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithEmptyifNotNilInIfNotNilIfNilAndSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -1617,7 +1535,7 @@ methodWithEmptyifNotNilInIfNotNilIfNilAndSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithInstanceVariableInAssignment [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithInstanceVariableInAssignment. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithInstanceVariableInAssignment. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -1643,7 +1561,7 @@ methodWithInstanceVariableInAssignment(SLDeadCodeEliminationTestClass * self_in_ SLDeadCodeEliminationTest >> testMethodWithInstanceVariableInReturn [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithInstanceVariableInReturn. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithInstanceVariableInReturn. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -1666,7 +1584,7 @@ methodWithInstanceVariableInReturn(SLDeadCodeEliminationTestClass * self_in_meth SLDeadCodeEliminationTest >> testMethodWithNeverUsedLocals [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithNeverUsedLocals. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithNeverUsedLocals. tMethod prepareMethodIn: ccg. sLDeadCodeElimination currentMethod: tMethod. @@ -1696,7 +1614,7 @@ methodWithNeverUsedLocals(SLDeadCodeEliminationTestClass * self_in_methodWithNev SLDeadCodeEliminationTest >> testMethodWithNeverUsedLocalsFromBlock [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithNeverUsedLocalsFromBlock. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithNeverUsedLocalsFromBlock. tMethod prepareMethodIn: ccg. sLDeadCodeElimination currentMethod: tMethod. @@ -1716,9 +1634,7 @@ methodWithNeverUsedLocalsFromBlock(SLDeadCodeEliminationTestClass * self_in_meth int var1; var1 = 5; - { - var1 += 1; - } + var1 += 1; return var1; }' ] @@ -1727,7 +1643,7 @@ methodWithNeverUsedLocalsFromBlock(SLDeadCodeEliminationTestClass * self_in_meth SLDeadCodeEliminationTest >> testMethodWithNeverUsedLocalsFromBlockStatement [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithNeverUsedLocalsFromBlockStatement. tMethod prepareMethodIn: ccg. @@ -1750,9 +1666,7 @@ methodWithNeverUsedLocalsFromBlockStatement(SLDeadCodeEliminationTestClass * sel sqInt var2; var1 = 4; - { - var2 = var1 + 1; - } + var2 = var1 + 1; return var2; }' ] @@ -1761,7 +1675,7 @@ methodWithNeverUsedLocalsFromBlockStatement(SLDeadCodeEliminationTestClass * sel SLDeadCodeEliminationTest >> testMethodWithNeverUsedLocalsFromBlockWithExpressionInArguments [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithNeverUsedLocalsFromBlockWithExpressionInArguments. @@ -1782,10 +1696,8 @@ methodWithNeverUsedLocalsFromBlockWithExpressionInArguments(SLDeadCodeEliminatio sqInt arg1; sqInt var1; - { - arg1 = 5 + 1; - var1 = arg1 + 1; - } + arg1 = 5 + 1; + var1 = arg1 + 1; return var1; }' ] @@ -1794,11 +1706,11 @@ methodWithNeverUsedLocalsFromBlockWithExpressionInArguments(SLDeadCodeEliminatio SLDeadCodeEliminationTest >> testMethodWithNeverUsedLocalsFromBlockasArguments [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithNeverUsedLocalsFromBlockasArguments. ccg prepareMethods. - ccg doBasicInlining: true. + self doInliningIn: tMethod. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -1823,7 +1735,7 @@ methodWithNeverUsedLocalsFromBlockasArguments(SLDeadCodeEliminationTestClass * s SLDeadCodeEliminationTest >> testMethodWithNoRedundantLocalDefinition [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithNoRedundantLocalDefinition. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithNoRedundantLocalDefinition. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -1861,7 +1773,7 @@ SLDeadCodeEliminationTest >> testMethodWithOnlyBlockValueAssignmentIntoSameVaria "all of the body is dead code" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyBlockValueAssignmentIntoSameVariableInArguments. sLDeadCodeElimination currentMethod: tMethod. @@ -1887,7 +1799,7 @@ methodWithOnlyBlockValueAssignmentIntoSameVariableInArguments(SLDeadCodeEliminat SLDeadCodeEliminationTest >> testMethodWithOnlyBlockValueAssignmentNotIntoSameVariableInArguments [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyBlockValueAssignmentNotIntoSameVariableInArguments. sLDeadCodeElimination currentMethod: tMethod. @@ -1908,9 +1820,7 @@ methodWithOnlyBlockValueAssignmentNotIntoSameVariableInArguments(SLDeadCodeElimi sqInt var2; var2 = 0; - { - var = var2; - } + var = var2; return var; }' ] @@ -1920,10 +1830,10 @@ SLDeadCodeEliminationTest >> testMethodWithOnlyComment [ "currently the only way to get comments in a methods is through inlining, having only comments is equivalent to being empty so it shouldn't change the behavior of the dead code elimination process" | translation tMethod | - tMethod := ccg methodNamed: #methodWithOnlyComment. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyComment. ccg prepareMethods. - ccg doBasicInlining: true. + self doInliningIn: tMethod. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -1940,9 +1850,7 @@ methodWithOnlyComment(SLDeadCodeEliminationTestClass * self_in_methodWithOnlyCom { /* begin method */ /* end method */ - { - return; - } + return; }' ] @@ -1950,7 +1858,7 @@ methodWithOnlyComment(SLDeadCodeEliminationTestClass * self_in_methodWithOnlyCom SLDeadCodeEliminationTest >> testMethodWithOnlyDeadCodeInRepeat [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithOnlyDeadCodeInRepeat. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyDeadCodeInRepeat. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -1977,7 +1885,7 @@ methodWithOnlyDeadCodeInRepeat(SLDeadCodeEliminationTestClass * self_in_methodWi SLDeadCodeEliminationTest >> testMethodWithOnlyDeadCodeInWhileFalse [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithOnlyDeadCodeInWhileFalse. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyDeadCodeInWhileFalse. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -2004,7 +1912,7 @@ methodWithOnlyDeadCodeInWhileFalse(SLDeadCodeEliminationTestClass * self_in_meth SLDeadCodeEliminationTest >> testMethodWithOnlyDeadCodeInWhileFalseBinaryNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyDeadCodeInWhileFalseBinaryNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2031,7 +1939,7 @@ methodWithOnlyDeadCodeInWhileFalseBinaryNoSendInReceiver(SLDeadCodeEliminationTe SLDeadCodeEliminationTest >> testMethodWithOnlyDeadCodeInWhileFalseBinarySendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyDeadCodeInWhileFalseBinarySendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2051,9 +1959,7 @@ methodWithOnlyDeadCodeInWhileFalseBinarySendInReceiver(SLDeadCodeEliminationTest sqInt var; var = 0; - { - method(self_in_methodWithOnlyDeadCodeInWhileFalseBinarySendInReceiver); - } + method(self_in_methodWithOnlyDeadCodeInWhileFalseBinarySendInReceiver); return var; }' ] @@ -2062,7 +1968,7 @@ methodWithOnlyDeadCodeInWhileFalseBinarySendInReceiver(SLDeadCodeEliminationTest SLDeadCodeEliminationTest >> testMethodWithOnlyDeadCodeInWhileTrue [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithOnlyDeadCodeInWhileTrue. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyDeadCodeInWhileTrue. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -2089,7 +1995,7 @@ methodWithOnlyDeadCodeInWhileTrue(SLDeadCodeEliminationTestClass * self_in_metho SLDeadCodeEliminationTest >> testMethodWithOnlyDeadCodeInWhileTrueBinaryNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyDeadCodeInWhileTrueBinaryNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2117,7 +2023,7 @@ methodWithOnlyDeadCodeInWhileTrueBinaryNoSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithOnlyDeadCodeInWhileTrueBinarySendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyDeadCodeInWhileTrueBinarySendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2137,9 +2043,7 @@ methodWithOnlyDeadCodeInWhileTrueBinarySendInReceiver(SLDeadCodeEliminationTestC sqInt var; var = 0; - { - method(self_in_methodWithOnlyDeadCodeInWhileTrueBinarySendInReceiver); - } + method(self_in_methodWithOnlyDeadCodeInWhileTrueBinarySendInReceiver); return var; }' ] @@ -2148,7 +2052,7 @@ methodWithOnlyDeadCodeInWhileTrueBinarySendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithOnlyNeverUsedLocals [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithOnlyNeverUsedLocals. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyNeverUsedLocals. tMethod prepareMethodIn: ccg. sLDeadCodeElimination currentMethod: tMethod. @@ -2174,7 +2078,7 @@ methodWithOnlyNeverUsedLocals(SLDeadCodeEliminationTestClass * self_in_methodWit SLDeadCodeEliminationTest >> testMethodWithOnlyUselessAssignment [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithOnlyUselessAssignment. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithOnlyUselessAssignment. tMethod prepareMethodIn: ccg. sLDeadCodeElimination currentMethod: tMethod. @@ -2192,9 +2096,7 @@ SLDeadCodeEliminationTest >> testMethodWithOnlyUselessAssignment [ static void methodWithOnlyUselessAssignment(SLDeadCodeEliminationTestClass * self_in_methodWithOnlyUselessAssignment) { - { - return; - } + return; }' ] @@ -2202,7 +2104,7 @@ methodWithOnlyUselessAssignment(SLDeadCodeEliminationTestClass * self_in_methodW SLDeadCodeEliminationTest >> testMethodWithRedundantLocalDefinition [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithRedundantLocalDefinition. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithRedundantLocalDefinition. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -2238,7 +2140,7 @@ SLDeadCodeEliminationTest >> testMethodWithSelfAssign [ "happens because of polymorphisme or inlining" | translation tMethod | - tMethod := ccg methodNamed: #methodWithSelfAssign. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithSelfAssign. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -2265,7 +2167,7 @@ methodWithSelfAssign(SLDeadCodeEliminationTestClass * self_in_methodWithSelfAssi SLDeadCodeEliminationTest >> testMethodWithSendWithNoSideEffectInCoerce [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithSendWithNoSideEffectInCoerce. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithSendWithNoSideEffectInCoerce. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -2280,9 +2182,7 @@ SLDeadCodeEliminationTest >> testMethodWithSendWithNoSideEffectInCoerce [ static void methodWithSendWithNoSideEffectInCoerce(SLDeadCodeEliminationTestClass * self_in_methodWithSendWithNoSideEffectInCoerce) { - { - return; - } + return; }' ] @@ -2290,7 +2190,7 @@ methodWithSendWithNoSideEffectInCoerce(SLDeadCodeEliminationTestClass * self_in_ SLDeadCodeEliminationTest >> testMethodWithUnusedConstant [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithUnusedConstant. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstant. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -2305,9 +2205,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstant [ static void methodWithUnusedConstant(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstant) { - { - return; - } + return; }' ] @@ -2316,7 +2214,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantAndReturnInCaseOfNoSend "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantAndReturnInCaseOfNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -2341,17 +2239,12 @@ methodWithUnusedConstantAndReturnInCaseOfNoSendInExpression(SLDeadCodeEliminatio break; case 6: { - { - return; - } + return; } - break; default: error("Case not found and no otherwise clause"); } - { - return; - } + return; }' ] @@ -2360,7 +2253,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantAndReturnInCaseOfSendIn "we need to use prepareMethodIn to build switch node." | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantAndReturnInCaseOfSendInExpression. tMethod prepareMethodIn: ccg. @@ -2399,7 +2292,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInCaseOfAndReturnInOthe "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInCaseOfAndReturnInOtherwiseNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -2441,7 +2334,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInCaseOfAndReturnInOthe "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInCaseOfAndReturnInOtherwiseSendInExpression. tMethod prepareMethodIn: ccg. @@ -2482,7 +2375,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInCaseOfAndUnusedConsta "we need to use prepareMethodIn to build switch node, the cases and the otherwise all have unused constant so the node is suppressed" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInCaseOfAndUnusedConstantInOtherwiseNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -2509,7 +2402,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInCaseOfAndUnusedConsta "we need to use prepareMethodIn to build switch node, the cases and the otherwise all have unused constant, the node is suppressed but the message call is kept" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInCaseOfAndUnusedConstantInOtherwiseSendInExpression. tMethod prepareMethodIn: ccg. @@ -2527,9 +2420,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInCaseOfAndUnusedConsta static sqInt methodWithUnusedConstantInCaseOfAndUnusedConstantInOtherwiseSendInExpression(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInCaseOfAndUnusedConstantInOtherwiseSendInExpression) { - { - method(self_in_methodWithUnusedConstantInCaseOfAndUnusedConstantInOtherwiseSendInExpression, 3); - } + method(self_in_methodWithUnusedConstantInCaseOfAndUnusedConstantInOtherwiseSendInExpression, 3); return 0; }' ] @@ -2539,7 +2430,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInCaseOfNoSendInExpress "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInCaseOfNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -2573,7 +2464,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInCaseOfSendInExpressio "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInCaseOfSendInExpression. tMethod prepareMethodIn: ccg. @@ -2606,7 +2497,7 @@ methodWithUnusedConstantInCaseOfSendInExpression(SLDeadCodeEliminationTestClass SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInCoerce [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithUnusedConstantInCoerce. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInCoerce. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -2629,7 +2520,7 @@ methodWithUnusedConstantInCoerce(SLDeadCodeEliminationTestClass * self_in_method SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfFalseIfTrueNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfFalseIfTrueNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2653,7 +2544,7 @@ methodWithUnusedConstantInIfFalseIfTrueNoSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfFalseIfTrueSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfFalseIfTrueSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2669,14 +2560,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfFalseIfTrueSendInRe static void methodWithUnusedConstantInIfFalseIfTrueSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfFalseIfTrueSendInReceiver) { - { - method(self_in_methodWithUnusedConstantInIfFalseIfTrueSendInReceiver); - method(self_in_methodWithUnusedConstantInIfFalseIfTrueSendInReceiver, 3); - method(self_in_methodWithUnusedConstantInIfFalseIfTrueSendInReceiver, method(self_in_methodWithUnusedConstantInIfFalseIfTrueSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedConstantInIfFalseIfTrueSendInReceiver); + method(self_in_methodWithUnusedConstantInIfFalseIfTrueSendInReceiver, 3); + method(self_in_methodWithUnusedConstantInIfFalseIfTrueSendInReceiver, method(self_in_methodWithUnusedConstantInIfFalseIfTrueSendInReceiver)); + return; }' ] @@ -2684,7 +2571,7 @@ methodWithUnusedConstantInIfFalseIfTrueSendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfFalseNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfFalseNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2700,9 +2587,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfFalseNoSendInReceiv static void methodWithUnusedConstantInIfFalseNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfFalseNoSendInReceiver) { - { - return; - } + return; }' ] @@ -2710,7 +2595,7 @@ methodWithUnusedConstantInIfFalseNoSendInReceiver(SLDeadCodeEliminationTestClass SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfFalseSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfFalseSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2726,14 +2611,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfFalseSendInReceiver static void methodWithUnusedConstantInIfFalseSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfFalseSendInReceiver) { - { - method(self_in_methodWithUnusedConstantInIfFalseSendInReceiver); - method(self_in_methodWithUnusedConstantInIfFalseSendInReceiver, 3); - method(self_in_methodWithUnusedConstantInIfFalseSendInReceiver, method(self_in_methodWithUnusedConstantInIfFalseSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedConstantInIfFalseSendInReceiver); + method(self_in_methodWithUnusedConstantInIfFalseSendInReceiver, 3); + method(self_in_methodWithUnusedConstantInIfFalseSendInReceiver, method(self_in_methodWithUnusedConstantInIfFalseSendInReceiver)); + return; }' ] @@ -2741,7 +2622,7 @@ methodWithUnusedConstantInIfFalseSendInReceiver(SLDeadCodeEliminationTestClass * SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNilIfNotNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfNilIfNotNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2757,9 +2638,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNilIfNotNilNoSendIn static void methodWithUnusedConstantInIfNilIfNotNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfNilIfNotNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -2767,7 +2646,7 @@ methodWithUnusedConstantInIfNilIfNotNilNoSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNilIfNotNillSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfNilIfNotNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2783,12 +2662,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNilIfNotNillSendInR static void methodWithUnusedConstantInIfNilIfNotNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfNilIfNotNilSendInReceiver) { - { - method(self_in_methodWithUnusedConstantInIfNilIfNotNilSendInReceiver, method(self_in_methodWithUnusedConstantInIfNilIfNotNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedConstantInIfNilIfNotNilSendInReceiver, method(self_in_methodWithUnusedConstantInIfNilIfNotNilSendInReceiver)); + return; }' ] @@ -2796,7 +2671,7 @@ methodWithUnusedConstantInIfNilIfNotNilSendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2812,9 +2687,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNilNoSendInReceiver static void methodWithUnusedConstantInIfNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -2822,7 +2695,7 @@ methodWithUnusedConstantInIfNilNoSendInReceiver(SLDeadCodeEliminationTestClass * SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2838,12 +2711,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNilSendInReceiver [ static void methodWithUnusedConstantInIfNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfNilSendInReceiver) { - { - method(self_in_methodWithUnusedConstantInIfNilSendInReceiver, method(self_in_methodWithUnusedConstantInIfNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedConstantInIfNilSendInReceiver, method(self_in_methodWithUnusedConstantInIfNilSendInReceiver)); + return; }' ] @@ -2851,7 +2720,7 @@ methodWithUnusedConstantInIfNilSendInReceiver(SLDeadCodeEliminationTestClass * s SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNotNilIfNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfNotNilIfNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2867,9 +2736,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNotNilIfNilNoSendIn static void methodWithUnusedConstantInIfNotNilIfNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfNotNilIfNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -2877,7 +2744,7 @@ methodWithUnusedConstantInIfNotNilIfNilNoSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNotNilIfNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfNotNilIfNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2893,12 +2760,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNotNilIfNilSendInRe static void methodWithUnusedConstantInIfNotNilIfNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfNotNilIfNilSendInReceiver) { - { - method(self_in_methodWithUnusedConstantInIfNotNilIfNilSendInReceiver, method(self_in_methodWithUnusedConstantInIfNotNilIfNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedConstantInIfNotNilIfNilSendInReceiver, method(self_in_methodWithUnusedConstantInIfNotNilIfNilSendInReceiver)); + return; }' ] @@ -2906,7 +2769,7 @@ methodWithUnusedConstantInIfNotNilIfNilSendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNotNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfNotNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2922,9 +2785,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNotNilNoSendInRecei static void methodWithUnusedConstantInIfNotNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfNotNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -2932,7 +2793,7 @@ methodWithUnusedConstantInIfNotNilNoSendInReceiver(SLDeadCodeEliminationTestClas SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNotNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfNotNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2948,12 +2809,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfNotNilSendInReceive static void methodWithUnusedConstantInIfNotNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfNotNilSendInReceiver) { - { - method(self_in_methodWithUnusedConstantInIfNotNilSendInReceiver, method(self_in_methodWithUnusedConstantInIfNotNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedConstantInIfNotNilSendInReceiver, method(self_in_methodWithUnusedConstantInIfNotNilSendInReceiver)); + return; }' ] @@ -2961,7 +2818,7 @@ methodWithUnusedConstantInIfNotNilSendInReceiver(SLDeadCodeEliminationTestClass SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfTrueIfFalseNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfTrueIfFalseNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -2977,9 +2834,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfTrueIfFalseNoSendIn static void methodWithUnusedConstantInIfTrueIfFalseNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfTrueIfFalseNoSendInReceiver) { - { - return; - } + return; }' ] @@ -2987,7 +2842,7 @@ methodWithUnusedConstantInIfTrueIfFalseNoSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfTrueIfFalseSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfTrueIfFalseSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3003,14 +2858,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfTrueIfFalseSendInRe static void methodWithUnusedConstantInIfTrueIfFalseSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfTrueIfFalseSendInReceiver) { - { - method(self_in_methodWithUnusedConstantInIfTrueIfFalseSendInReceiver); - method(self_in_methodWithUnusedConstantInIfTrueIfFalseSendInReceiver, 3); - method(self_in_methodWithUnusedConstantInIfTrueIfFalseSendInReceiver, method(self_in_methodWithUnusedConstantInIfTrueIfFalseSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedConstantInIfTrueIfFalseSendInReceiver); + method(self_in_methodWithUnusedConstantInIfTrueIfFalseSendInReceiver, 3); + method(self_in_methodWithUnusedConstantInIfTrueIfFalseSendInReceiver, method(self_in_methodWithUnusedConstantInIfTrueIfFalseSendInReceiver)); + return; }' ] @@ -3018,7 +2869,7 @@ methodWithUnusedConstantInIfTrueIfFalseSendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfTrueNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfTrueNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3034,9 +2885,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfTrueNoSendInReceive static void methodWithUnusedConstantInIfTrueNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfTrueNoSendInReceiver) { - { - return; - } + return; }' ] @@ -3044,7 +2893,7 @@ methodWithUnusedConstantInIfTrueNoSendInReceiver(SLDeadCodeEliminationTestClass SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfTrueSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantInIfTrueSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3060,14 +2909,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantInIfTrueSendInReceiver static void methodWithUnusedConstantInIfTrueSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedConstantInIfTrueSendInReceiver) { - { - method(self_in_methodWithUnusedConstantInIfTrueSendInReceiver); - method(self_in_methodWithUnusedConstantInIfTrueSendInReceiver, 3); - method(self_in_methodWithUnusedConstantInIfTrueSendInReceiver, method(self_in_methodWithUnusedConstantInIfTrueSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedConstantInIfTrueSendInReceiver); + method(self_in_methodWithUnusedConstantInIfTrueSendInReceiver, 3); + method(self_in_methodWithUnusedConstantInIfTrueSendInReceiver, method(self_in_methodWithUnusedConstantInIfTrueSendInReceiver)); + return; }' ] @@ -3076,7 +2921,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantReturnInCaseOfAndUnused "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantReturnInCaseOfAndUnusedConstantInOtherwiseNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -3116,7 +2961,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedConstantReturnInCaseOfAndUnused "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedConstantReturnInCaseOfAndUnusedConstantInOtherwiseSendInExpression. tMethod prepareMethodIn: ccg. @@ -3154,7 +2999,7 @@ methodWithUnusedConstantReturnInCaseOfAndUnusedConstantInOtherwiseSendInExpressi SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariable [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithUnusedInstanceVariable. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariable. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -3169,9 +3014,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariable [ static void methodWithUnusedInstanceVariable(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariable) { - { - return; - } + return; }' ] @@ -3180,7 +3023,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableAndReturnInCase "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableAndReturnInCaseOfNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -3218,7 +3061,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableAndReturnInCase "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableAndReturnInCaseOfSendInExpression. tMethod prepareMethodIn: ccg. @@ -3256,7 +3099,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInCaseOfAndRetu "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInCaseOfAndReturnInOtherwiseNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -3293,7 +3136,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInCaseOfAndRetu "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInCaseOfAndReturnInOtherwiseSendInExpression. tMethod prepareMethodIn: ccg. @@ -3330,7 +3173,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInCaseOfAndUnus "we need to use prepareMethodIn to build switch node, the cases and the otherwise have unused instance variable, they are all suppressed" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInCaseOfAndUnusedInstanceVariableInOtherwiseNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -3356,7 +3199,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInCaseOfAndUnus "we need to use prepareMethodIn to build switch node, the cases and the otherwise all have unused instance variable, the node is suppressed but the message call is kept" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInCaseOfAndUnusedInstanceVariableInOtherwiseSendInExpression. tMethod prepareMethodIn: ccg. @@ -3373,9 +3216,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInCaseOfAndUnus static sqInt methodWithUnusedInstanceVariableInCaseOfAndUnusedInstanceVariableInOtherwiseSendInExpression(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInCaseOfAndUnusedInstanceVariableInOtherwiseSendInExpression) { - { - method(self_in_methodWithUnusedInstanceVariableInCaseOfAndUnusedInstanceVariableInOtherwiseSendInExpression, 3); - } + method(self_in_methodWithUnusedInstanceVariableInCaseOfAndUnusedInstanceVariableInOtherwiseSendInExpression, 3); return 0; }' ] @@ -3385,7 +3226,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInCaseOfNoSendI "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInCaseOfNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -3410,9 +3251,7 @@ methodWithUnusedInstanceVariableInCaseOfNoSendInExpression(SLDeadCodeElimination default: error("Case not found and no otherwise clause"); } - { - return; - } + return; }' ] @@ -3421,7 +3260,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInCaseOfSendInE "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInCaseOfSendInExpression. tMethod prepareMethodIn: ccg. @@ -3447,9 +3286,7 @@ methodWithUnusedInstanceVariableInCaseOfSendInExpression(SLDeadCodeEliminationTe default: error("Case not found and no otherwise clause"); } - { - return; - } + return; }' ] @@ -3457,7 +3294,7 @@ methodWithUnusedInstanceVariableInCaseOfSendInExpression(SLDeadCodeEliminationTe SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInCoerce [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithUnusedInstanceVariableInCoerce. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInCoerce. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -3472,9 +3309,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInCoerce [ static void methodWithUnusedInstanceVariableInCoerce(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInCoerce) { - { - return; - } + return; }' ] @@ -3482,7 +3317,7 @@ methodWithUnusedInstanceVariableInCoerce(SLDeadCodeEliminationTestClass * self_i SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfFalseIfTrueNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfFalseIfTrueNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3498,9 +3333,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfFalseIfTrue static void methodWithUnusedInstanceVariableInIfFalseIfTrueNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfFalseIfTrueNoSendInReceiver) { - { - return; - } + return; }' ] @@ -3508,7 +3341,7 @@ methodWithUnusedInstanceVariableInIfFalseIfTrueNoSendInReceiver(SLDeadCodeElimin SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3524,14 +3357,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfFalseIfTrue static void methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver) { - { - method(self_in_methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver); - method(self_in_methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver, 3); - method(self_in_methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver); + method(self_in_methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver, 3); + method(self_in_methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver)); + return; }' ] @@ -3539,7 +3368,7 @@ methodWithUnusedInstanceVariableInIfFalseIfTrueSendInReceiver(SLDeadCodeEliminat SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfFalseNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfFalseNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3555,9 +3384,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfFalseNoSend static void methodWithUnusedInstanceVariableInIfFalseNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfFalseNoSendInReceiver) { - { - return; - } + return; }' ] @@ -3565,7 +3392,7 @@ methodWithUnusedInstanceVariableInIfFalseNoSendInReceiver(SLDeadCodeEliminationT SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfFalseSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfFalseSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3581,14 +3408,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfFalseSendIn static void methodWithUnusedInstanceVariableInIfFalseSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfFalseSendInReceiver) { - { - method(self_in_methodWithUnusedInstanceVariableInIfFalseSendInReceiver); - method(self_in_methodWithUnusedInstanceVariableInIfFalseSendInReceiver, 3); - method(self_in_methodWithUnusedInstanceVariableInIfFalseSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfFalseSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedInstanceVariableInIfFalseSendInReceiver); + method(self_in_methodWithUnusedInstanceVariableInIfFalseSendInReceiver, 3); + method(self_in_methodWithUnusedInstanceVariableInIfFalseSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfFalseSendInReceiver)); + return; }' ] @@ -3596,7 +3419,7 @@ methodWithUnusedInstanceVariableInIfFalseSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNilIfNotNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfNilIfNotNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3612,9 +3435,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNilIfNotNil static void methodWithUnusedInstanceVariableInIfNilIfNotNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfNilIfNotNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -3622,7 +3443,7 @@ methodWithUnusedInstanceVariableInIfNilIfNotNilNoSendInReceiver(SLDeadCodeElimin SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNilIfNotNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfNilIfNotNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3638,12 +3459,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNilIfNotNil static void methodWithUnusedInstanceVariableInIfNilIfNotNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfNilIfNotNilSendInReceiver) { - { - method(self_in_methodWithUnusedInstanceVariableInIfNilIfNotNilSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfNilIfNotNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedInstanceVariableInIfNilIfNotNilSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfNilIfNotNilSendInReceiver)); + return; }' ] @@ -3651,7 +3468,7 @@ methodWithUnusedInstanceVariableInIfNilIfNotNilSendInReceiver(SLDeadCodeEliminat SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3667,9 +3484,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNilNoSendIn static void methodWithUnusedInstanceVariableInIfNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -3677,7 +3492,7 @@ methodWithUnusedInstanceVariableInIfNilNoSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3693,12 +3508,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNilSendInRe static void methodWithUnusedInstanceVariableInIfNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfNilSendInReceiver) { - { - method(self_in_methodWithUnusedInstanceVariableInIfNilSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedInstanceVariableInIfNilSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfNilSendInReceiver)); + return; }' ] @@ -3706,7 +3517,7 @@ methodWithUnusedInstanceVariableInIfNilSendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNotNilIfNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfNotNilIfNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3722,9 +3533,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNotNilIfNil static void methodWithUnusedInstanceVariableInIfNotNilIfNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfNotNilIfNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -3732,7 +3541,7 @@ methodWithUnusedInstanceVariableInIfNotNilIfNilNoSendInReceiver(SLDeadCodeElimin SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNotNilIfNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfNotNilIfNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3748,12 +3557,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNotNilIfNil static void methodWithUnusedInstanceVariableInIfNotNilIfNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfNotNilIfNilSendInReceiver) { - { - method(self_in_methodWithUnusedInstanceVariableInIfNotNilIfNilSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfNotNilIfNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedInstanceVariableInIfNotNilIfNilSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfNotNilIfNilSendInReceiver)); + return; }' ] @@ -3761,7 +3566,7 @@ methodWithUnusedInstanceVariableInIfNotNilIfNilSendInReceiver(SLDeadCodeEliminat SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNotNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfNotNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3777,9 +3582,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNotNilNoSen static void methodWithUnusedInstanceVariableInIfNotNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfNotNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -3787,7 +3590,7 @@ methodWithUnusedInstanceVariableInIfNotNilNoSendInReceiver(SLDeadCodeElimination SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNotNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfNotNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3802,12 +3605,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfNotNilSendI static void methodWithUnusedInstanceVariableInIfNotNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfNotNilSendInReceiver) { - { - method(self_in_methodWithUnusedInstanceVariableInIfNotNilSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfNotNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedInstanceVariableInIfNotNilSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfNotNilSendInReceiver)); + return; }' ] @@ -3815,7 +3614,7 @@ methodWithUnusedInstanceVariableInIfNotNilSendInReceiver(SLDeadCodeEliminationTe SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfTrueIfFalseNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfTrueIfFalseNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3831,9 +3630,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfTrueIfFalse static void methodWithUnusedInstanceVariableInIfTrueIfFalseNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfTrueIfFalseNoSendInReceiver) { - { - return; - } + return; }' ] @@ -3841,7 +3638,7 @@ methodWithUnusedInstanceVariableInIfTrueIfFalseNoSendInReceiver(SLDeadCodeElimin SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3857,14 +3654,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfTrueIfFalse static void methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver) { - { - method(self_in_methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver); - method(self_in_methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver, 3); - method(self_in_methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver); + method(self_in_methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver, 3); + method(self_in_methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver)); + return; }' ] @@ -3872,7 +3665,7 @@ methodWithUnusedInstanceVariableInIfTrueIfFalseSendInReceiver(SLDeadCodeEliminat SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfTrueNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfTrueNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3888,9 +3681,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfTrueNoSendI static void methodWithUnusedInstanceVariableInIfTrueNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfTrueNoSendInReceiver) { - { - return; - } + return; }' ] @@ -3898,7 +3689,7 @@ methodWithUnusedInstanceVariableInIfTrueNoSendInReceiver(SLDeadCodeEliminationTe SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfTrueSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableInIfTrueSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -3914,14 +3705,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableInIfTrueSendInR static void methodWithUnusedInstanceVariableInIfTrueSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedInstanceVariableInIfTrueSendInReceiver) { - { - method(self_in_methodWithUnusedInstanceVariableInIfTrueSendInReceiver); - method(self_in_methodWithUnusedInstanceVariableInIfTrueSendInReceiver, 3); - method(self_in_methodWithUnusedInstanceVariableInIfTrueSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfTrueSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedInstanceVariableInIfTrueSendInReceiver); + method(self_in_methodWithUnusedInstanceVariableInIfTrueSendInReceiver, 3); + method(self_in_methodWithUnusedInstanceVariableInIfTrueSendInReceiver, method(self_in_methodWithUnusedInstanceVariableInIfTrueSendInReceiver)); + return; }' ] @@ -3930,7 +3717,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableReturnInCaseOfA "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableReturnInCaseOfAndUnusedInstanceVariableInOtherwiseNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -3954,18 +3741,13 @@ methodWithUnusedInstanceVariableReturnInCaseOfAndUnusedInstanceVariableInOtherwi break; case 6: { - { - return; - } + return; } - break; default: { } } - { - return; - } + return; }' ] @@ -3974,7 +3756,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedInstanceVariableReturnInCaseOfA "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedInstanceVariableReturnInCaseOfAndUnusedInstanceVariableInOtherwiseSendInExpression. tMethod prepareMethodIn: ccg. @@ -3998,18 +3780,13 @@ methodWithUnusedInstanceVariableReturnInCaseOfAndUnusedInstanceVariableInOtherwi break; case 6: { - { - return; - } + return; } - break; default: { } } - { - return; - } + return; }' ] @@ -4017,7 +3794,7 @@ methodWithUnusedInstanceVariableReturnInCaseOfAndUnusedInstanceVariableInOtherwi SLDeadCodeEliminationTest >> testMethodWithUnusedVariable [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithUnusedVariable. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariable. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -4033,9 +3810,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariable [ static void methodWithUnusedVariable(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariable) { - { - return; - } + return; }' ] @@ -4044,7 +3819,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableAndReturnInCaseOfNoSend "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableAndReturnInCaseOfNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -4086,7 +3861,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableAndReturnInCaseOfSendIn "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableAndReturnInCaseOfSendInExpression. tMethod prepareMethodIn: ccg. @@ -4127,7 +3902,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInCaseOfAndReturnInOthe "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInCaseOfAndReturnInOtherwiseNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -4167,7 +3942,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInCaseOfAndReturnInOthe "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInCaseOfAndReturnInOtherwiseSendInExpression. tMethod prepareMethodIn: ccg. @@ -4207,7 +3982,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInCaseOfAndUnusedVariab "we need to use prepareMethodIn to build switch node, the case and the otherwise all have unused variable, the node is suppressed" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInCaseOfAndUnusedVariableInOtherwiseNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -4224,9 +3999,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInCaseOfAndUnusedVariab static void methodWithUnusedVariableInCaseOfAndUnusedVariableInOtherwiseNoSendInExpression(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInCaseOfAndUnusedVariableInOtherwiseNoSendInExpression, sqInt anInt) { - { - return; - } + return; }' ] @@ -4235,7 +4008,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInCaseOfAndUnusedVariab "we need to use prepareMethodIn to build switch node, the cases and the otherwise all have unused variable, the node is suppressed but the message call is kept" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInCaseOfAndUnusedVariableInOtherwiseSendInExpression. tMethod prepareMethodIn: ccg. @@ -4252,12 +4025,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInCaseOfAndUnusedVariab static void methodWithUnusedVariableInCaseOfAndUnusedVariableInOtherwiseSendInExpression(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInCaseOfAndUnusedVariableInOtherwiseSendInExpression) { - { - method(self_in_methodWithUnusedVariableInCaseOfAndUnusedVariableInOtherwiseSendInExpression, 3); - } - { - return; - } + method(self_in_methodWithUnusedVariableInCaseOfAndUnusedVariableInOtherwiseSendInExpression, 3); + return; }' ] @@ -4266,7 +4035,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInCaseOfNoSendInExpress "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInCaseOfNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -4292,9 +4061,7 @@ methodWithUnusedVariableInCaseOfNoSendInExpression(SLDeadCodeEliminationTestClas default: error("Case not found and no otherwise clause"); } - { - return; - } + return; }' ] @@ -4303,7 +4070,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInCaseOfSendInExpressio "we need to use prepareMethodIn to build switch node" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInCaseOfSendInExpression. tMethod prepareMethodIn: ccg. @@ -4328,9 +4095,7 @@ methodWithUnusedVariableInCaseOfSendInExpression(SLDeadCodeEliminationTestClass default: error("Case not found and no otherwise clause"); } - { - return; - } + return; }' ] @@ -4338,7 +4103,7 @@ methodWithUnusedVariableInCaseOfSendInExpression(SLDeadCodeEliminationTestClass SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInCoerce [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithUnusedVariableInCoerce. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInCoerce. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -4353,9 +4118,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInCoerce [ static void methodWithUnusedVariableInCoerce(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInCoerce) { - { - return; - } + return; }' ] @@ -4363,7 +4126,7 @@ methodWithUnusedVariableInCoerce(SLDeadCodeEliminationTestClass * self_in_method SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfFalseIfTrueNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfFalseIfTrueNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4379,9 +4142,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfFalseIfTrueNoSendIn static void methodWithUnusedVariableInIfFalseIfTrueNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfFalseIfTrueNoSendInReceiver) { - { - return; - } + return; }' ] @@ -4389,7 +4150,7 @@ methodWithUnusedVariableInIfFalseIfTrueNoSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfFalseIfTrueSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfFalseIfTrueSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4405,14 +4166,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfFalseIfTrueSendInRe static void methodWithUnusedVariableInIfFalseIfTrueSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfFalseIfTrueSendInReceiver) { - { - method(self_in_methodWithUnusedVariableInIfFalseIfTrueSendInReceiver); - method(self_in_methodWithUnusedVariableInIfFalseIfTrueSendInReceiver, 3); - method(self_in_methodWithUnusedVariableInIfFalseIfTrueSendInReceiver, method(self_in_methodWithUnusedVariableInIfFalseIfTrueSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedVariableInIfFalseIfTrueSendInReceiver); + method(self_in_methodWithUnusedVariableInIfFalseIfTrueSendInReceiver, 3); + method(self_in_methodWithUnusedVariableInIfFalseIfTrueSendInReceiver, method(self_in_methodWithUnusedVariableInIfFalseIfTrueSendInReceiver)); + return; }' ] @@ -4420,7 +4177,7 @@ methodWithUnusedVariableInIfFalseIfTrueSendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfFalseNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfFalseNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4436,9 +4193,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfFalseNoSendInReceiv static void methodWithUnusedVariableInIfFalseNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfFalseNoSendInReceiver) { - { - return; - } + return; }' ] @@ -4446,7 +4201,7 @@ methodWithUnusedVariableInIfFalseNoSendInReceiver(SLDeadCodeEliminationTestClass SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfFalseSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfFalseSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4462,14 +4217,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfFalseSendInReceiver static void methodWithUnusedVariableInIfFalseSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfFalseSendInReceiver) { - { - method(self_in_methodWithUnusedVariableInIfFalseSendInReceiver); - method(self_in_methodWithUnusedVariableInIfFalseSendInReceiver, 3); - method(self_in_methodWithUnusedVariableInIfFalseSendInReceiver, method(self_in_methodWithUnusedVariableInIfFalseSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedVariableInIfFalseSendInReceiver); + method(self_in_methodWithUnusedVariableInIfFalseSendInReceiver, 3); + method(self_in_methodWithUnusedVariableInIfFalseSendInReceiver, method(self_in_methodWithUnusedVariableInIfFalseSendInReceiver)); + return; }' ] @@ -4478,7 +4229,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNilIfNotNilNoSendIn "in case of variable, the definition is still here after the supression process, we need to use removeUnusedTempsAndNilIfRequiredIn: to clean the ast" | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfNilIfNotNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4494,9 +4245,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNilIfNotNilNoSendIn static void methodWithUnusedVariableInIfNilIfNotNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfNilIfNotNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -4504,7 +4253,7 @@ methodWithUnusedVariableInIfNilIfNotNilNoSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNilIfNotNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfNilIfNotNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4520,12 +4269,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNilIfNotNilSendInRe static void methodWithUnusedVariableInIfNilIfNotNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfNilIfNotNilSendInReceiver) { - { - method(self_in_methodWithUnusedVariableInIfNilIfNotNilSendInReceiver, method(self_in_methodWithUnusedVariableInIfNilIfNotNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedVariableInIfNilIfNotNilSendInReceiver, method(self_in_methodWithUnusedVariableInIfNilIfNotNilSendInReceiver)); + return; }' ] @@ -4533,7 +4278,7 @@ methodWithUnusedVariableInIfNilIfNotNilSendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4549,9 +4294,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNilNoSendInReceiver static void methodWithUnusedVariableInIfNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -4559,7 +4302,7 @@ methodWithUnusedVariableInIfNilNoSendInReceiver(SLDeadCodeEliminationTestClass * SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4575,12 +4318,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNilSendInReceiver [ static void methodWithUnusedVariableInIfNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfNilSendInReceiver) { - { - method(self_in_methodWithUnusedVariableInIfNilSendInReceiver, method(self_in_methodWithUnusedVariableInIfNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedVariableInIfNilSendInReceiver, method(self_in_methodWithUnusedVariableInIfNilSendInReceiver)); + return; }' ] @@ -4588,7 +4327,7 @@ methodWithUnusedVariableInIfNilSendInReceiver(SLDeadCodeEliminationTestClass * s SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNotNilIfNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfNotNilIfNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4604,9 +4343,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNotNilIfNilNoSendIn static void methodWithUnusedVariableInIfNotNilIfNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfNotNilIfNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -4614,7 +4351,7 @@ methodWithUnusedVariableInIfNotNilIfNilNoSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNotNilIfNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfNotNilIfNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4630,12 +4367,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNotNilIfNilSendInRe static void methodWithUnusedVariableInIfNotNilIfNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfNotNilIfNilSendInReceiver) { - { - method(self_in_methodWithUnusedVariableInIfNotNilIfNilSendInReceiver, method(self_in_methodWithUnusedVariableInIfNotNilIfNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedVariableInIfNotNilIfNilSendInReceiver, method(self_in_methodWithUnusedVariableInIfNotNilIfNilSendInReceiver)); + return; }' ] @@ -4643,7 +4376,7 @@ methodWithUnusedVariableInIfNotNilIfNilSendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNotNilNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfNotNilNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4659,9 +4392,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNotNilNoSendInRecei static void methodWithUnusedVariableInIfNotNilNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfNotNilNoSendInReceiver) { - { - return; - } + return; }' ] @@ -4669,7 +4400,7 @@ methodWithUnusedVariableInIfNotNilNoSendInReceiver(SLDeadCodeEliminationTestClas SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNotNilSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfNotNilSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4685,12 +4416,8 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfNotNilSendInReceive static void methodWithUnusedVariableInIfNotNilSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfNotNilSendInReceiver) { - { - method(self_in_methodWithUnusedVariableInIfNotNilSendInReceiver, method(self_in_methodWithUnusedVariableInIfNotNilSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedVariableInIfNotNilSendInReceiver, method(self_in_methodWithUnusedVariableInIfNotNilSendInReceiver)); + return; }' ] @@ -4698,7 +4425,7 @@ methodWithUnusedVariableInIfNotNilSendInReceiver(SLDeadCodeEliminationTestClass SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfTrueIfFalseNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfTrueIfFalseNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4714,9 +4441,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfTrueIfFalseNoSendIn static void methodWithUnusedVariableInIfTrueIfFalseNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfTrueIfFalseNoSendInReceiver) { - { - return; - } + return; }' ] @@ -4724,7 +4449,7 @@ methodWithUnusedVariableInIfTrueIfFalseNoSendInReceiver(SLDeadCodeEliminationTes SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfTrueIfFalseSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfTrueIfFalseSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4740,14 +4465,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfTrueIfFalseSendInRe static void methodWithUnusedVariableInIfTrueIfFalseSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfTrueIfFalseSendInReceiver) { - { - method(self_in_methodWithUnusedVariableInIfTrueIfFalseSendInReceiver); - method(self_in_methodWithUnusedVariableInIfTrueIfFalseSendInReceiver, 3); - method(self_in_methodWithUnusedVariableInIfTrueIfFalseSendInReceiver, method(self_in_methodWithUnusedVariableInIfTrueIfFalseSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedVariableInIfTrueIfFalseSendInReceiver); + method(self_in_methodWithUnusedVariableInIfTrueIfFalseSendInReceiver, 3); + method(self_in_methodWithUnusedVariableInIfTrueIfFalseSendInReceiver, method(self_in_methodWithUnusedVariableInIfTrueIfFalseSendInReceiver)); + return; }' ] @@ -4755,7 +4476,7 @@ methodWithUnusedVariableInIfTrueIfFalseSendInReceiver(SLDeadCodeEliminationTestC SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfTrueNoSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfTrueNoSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4771,9 +4492,7 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfTrueNoSendInReceive static void methodWithUnusedVariableInIfTrueNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfTrueNoSendInReceiver) { - { - return; - } + return; }' ] @@ -4781,7 +4500,7 @@ methodWithUnusedVariableInIfTrueNoSendInReceiver(SLDeadCodeEliminationTestClass SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfTrueSendInReceiver [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableInIfTrueSendInReceiver. sLDeadCodeElimination currentMethod: tMethod. @@ -4797,14 +4516,10 @@ SLDeadCodeEliminationTest >> testMethodWithUnusedVariableInIfTrueSendInReceiver static void methodWithUnusedVariableInIfTrueSendInReceiver(SLDeadCodeEliminationTestClass * self_in_methodWithUnusedVariableInIfTrueSendInReceiver) { - { - method(self_in_methodWithUnusedVariableInIfTrueSendInReceiver); - method(self_in_methodWithUnusedVariableInIfTrueSendInReceiver, 3); - method(self_in_methodWithUnusedVariableInIfTrueSendInReceiver, method(self_in_methodWithUnusedVariableInIfTrueSendInReceiver)); - } - { - return; - } + method(self_in_methodWithUnusedVariableInIfTrueSendInReceiver); + method(self_in_methodWithUnusedVariableInIfTrueSendInReceiver, 3); + method(self_in_methodWithUnusedVariableInIfTrueSendInReceiver, method(self_in_methodWithUnusedVariableInIfTrueSendInReceiver)); + return; }' ] @@ -4812,7 +4527,7 @@ methodWithUnusedVariableInIfTrueSendInReceiver(SLDeadCodeEliminationTestClass * SLDeadCodeEliminationTest >> testMethodWithUnusedVariableReturnInCaseOfAndUnusedVariableInOtherwiseNoSendInExpression [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableReturnInCaseOfAndUnusedVariableInOtherwiseNoSendInExpression:. tMethod prepareMethodIn: ccg. @@ -4852,7 +4567,7 @@ methodWithUnusedVariableReturnInCaseOfAndUnusedVariableInOtherwiseNoSendInExpres SLDeadCodeEliminationTest >> testMethodWithUnusedVariableReturnInCaseOfAndUnusedVariableInOtherwiseSendInExpression [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUnusedVariableReturnInCaseOfAndUnusedVariableInOtherwiseSendInExpression. tMethod prepareMethodIn: ccg. @@ -4893,7 +4608,7 @@ methodWithUnusedVariableReturnInCaseOfAndUnusedVariableInOtherwiseSendInExpressi SLDeadCodeEliminationTest >> testMethodWithUselessAssignment [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithUselessAssignment. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUselessAssignment. tMethod prepareMethodIn: ccg. sLDeadCodeElimination currentMethod: tMethod. @@ -4924,7 +4639,7 @@ methodWithUselessAssignment(SLDeadCodeEliminationTestClass * self_in_methodWithU SLDeadCodeEliminationTest >> testMethodWithUselessCodeInBinaryIterativeNoSendInLimit [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithUselessCodeInBinaryIterativeNoSendInLimit. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUselessCodeInBinaryIterativeNoSendInLimit. tMethod prepareMethodIn: ccg. sLDeadCodeElimination currentMethod: tMethod. @@ -4957,7 +4672,7 @@ methodWithUselessCodeInBinaryIterativeNoSendInLimit(SLDeadCodeEliminationTestCla SLDeadCodeEliminationTest >> testMethodWithUselessCodeInBinaryIterativeSendWithNoSideEffectsInLimit [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUselessCodeInBinaryIterativeSendWithNoSideEffectsInLimit. tMethod prepareMethodIn: ccg. @@ -4989,7 +4704,7 @@ methodWithUselessCodeInBinaryIterativeSendWithNoSideEffectsInLimit(SLDeadCodeEli { #category : 'dead-code-in-do-iterative' } SLDeadCodeEliminationTest >> testMethodWithUselessCodeInBinaryIterativeSendWithSideEffectsInLimit [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUselessCodeInBinaryIterativeSendWithSideEffectsInLimit. tMethod prepareMethodIn: ccg. @@ -5023,7 +4738,7 @@ methodWithUselessCodeInBinaryIterativeSendWithSideEffectsInLimit(SLDeadCodeElimi SLDeadCodeEliminationTest >> testMethodWithUselessLocalsDefinitionsWithSameNameInSubBranches [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUselessLocalsDefinitionsWithSameNameInSubBranches. tMethod prepareMethodIn: ccg. @@ -5062,7 +4777,7 @@ methodWithUselessLocalsDefinitionsWithSameNameInSubBranches(SLDeadCodeEliminatio SLDeadCodeEliminationTest >> testMethodWithUselessLocalsInSubBranches [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithUselessLocalsInSubBranches. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUselessLocalsInSubBranches. tMethod prepareMethodIn: ccg. sLDeadCodeElimination currentMethod: tMethod. @@ -5097,7 +4812,7 @@ methodWithUselessLocalsInSubBranches(SLDeadCodeEliminationTestClass * self_in_me SLDeadCodeEliminationTest >> testMethodWithUselessLocalsWithSameNameInSubBranches [ | translation tMethod | - tMethod := ccg methodNamed: + tMethod := self addStructMethodAndMethodCalledBy: #methodWithUselessLocalsWithSameNameInSubBranches. tMethod prepareMethodIn: ccg. @@ -5139,7 +4854,7 @@ methodWithUselessLocalsWithSameNameInSubBranches(SLDeadCodeEliminationTestClass SLDeadCodeEliminationTest >> testMethodWithVariableInAssignment [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithVariableInAssignment. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithVariableInAssignment. sLDeadCodeElimination currentMethod: tMethod. ccg currentMethod: tMethod. @@ -5167,7 +4882,7 @@ methodWithVariableInAssignment(SLDeadCodeEliminationTestClass * self_in_methodWi SLDeadCodeEliminationTest >> testMethodWithVariableInReturn [ | translation tMethod | - tMethod := ccg methodNamed: #methodWithVariableInReturn. + tMethod := self addStructMethodAndMethodCalledBy: #methodWithVariableInReturn. sLDeadCodeElimination currentMethod: tMethod. ccg currentMethod: tMethod. @@ -5195,10 +4910,10 @@ SLDeadCodeEliminationTest >> testSwitchWithOnlyCommentNoSendInReceiver [ "currently the only way to get comments in a methods is through inlining, having only comments is equivalent to being empty so it shouldn't change the behavior of the dead code elimination process" | translation tMethod | - tMethod := ccg methodNamed: #switchWithOnlyCommentNoSendInReceiver:. + tMethod := self addStructMethodAndMethodCalledBy: #switchWithOnlyCommentNoSendInReceiver:. ccg prepareMethods. - ccg doBasicInlining: true. + self doInliningIn: tMethod. sLDeadCodeElimination currentMethod: tMethod. ccg currentMethod: tMethod. @@ -5214,9 +4929,7 @@ SLDeadCodeEliminationTest >> testSwitchWithOnlyCommentNoSendInReceiver [ static void switchWithOnlyCommentNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_switchWithOnlyCommentNoSendInReceiver, sqInt _anInt) { - { - return; - } + return; }' ] @@ -5225,10 +4938,10 @@ SLDeadCodeEliminationTest >> testSwitchWithOnlyCommentSendInReceiver [ "currently the only way to get comments in a methods is through inlining, having only comments is equivalent to being empty so it shouldn't change the behavior of the dead code elimination process" | translation tMethod | - tMethod := ccg methodNamed: #switchWithOnlyCommentSendInReceiver. + tMethod := self addStructMethodAndMethodCalledBy: #switchWithOnlyCommentSendInReceiver. ccg prepareMethods. - ccg doBasicInlining: true. + self doInliningIn: tMethod. sLDeadCodeElimination currentMethod: tMethod. sLDeadCodeElimination removeDeadCodeInCurrentMethod. @@ -5243,11 +4956,7 @@ SLDeadCodeEliminationTest >> testSwitchWithOnlyCommentSendInReceiver [ static void switchWithOnlyCommentSendInReceiver(SLDeadCodeEliminationTestClass * self_in_switchWithOnlyCommentSendInReceiver) { - { - method(self_in_switchWithOnlyCommentSendInReceiver, method(self_in_switchWithOnlyCommentSendInReceiver)); - } - { - return; - } + method(self_in_switchWithOnlyCommentSendInReceiver, method(self_in_switchWithOnlyCommentSendInReceiver)); + return; }' ] diff --git a/smalltalksrc/Slang-Tests/SLInliningTest.class.st b/smalltalksrc/Slang-Tests/SLInliningTest.class.st new file mode 100644 index 0000000000..a10b7070bf --- /dev/null +++ b/smalltalksrc/Slang-Tests/SLInliningTest.class.st @@ -0,0 +1,1604 @@ +Class { + #name : 'SLInliningTest', + #superclass : 'SLAbstractTranslationTestCase', + #instVars : [ + 'sLInliner', + 'inliningStrategy', + 'inliner' + ], + #category : 'Slang-Tests', + #package : 'Slang-Tests' +} + +{ #category : 'building suites' } +SLInliningTest class >> testParameters [ + + ^ ParametrizedTestMatrix new + forSelector: #inliningStrategy + addOptions: + { "#useExtractedInlining." #useNewInlining }; + yourself +] + +{ #category : 'accessing' } +SLInliningTest >> inliningStrategy: aString [ + + inliningStrategy := aString +] + +{ #category : 'inlining-simple' } +SLInliningTest >> test2ChainInlining [ + + | method translation | + method := self addMethodAndMethodCalledBy: #methodC. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: '/* SLMockInliningTestClass>>#methodC */ +static sqInt +methodC(void) +{ + 3 + 3; + /* begin methodA */ + 1 + 1; + /* begin methodB */ + 2 + 2; + /* end methodB */ + /* end methodA */ + return 0; +}' +] + +{ #category : 'inlining-assignment' } +SLInliningTest >> test2ChainInliningAssignOnReturn [ + + | method translation | + method := self addMethodAndMethodCalledBy: #methodCAssignOnReturn. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: '/* SLMockInliningTestClass>>#methodCAssignOnReturn */ +static sqInt +methodCAssignOnReturn(void) +{ + sqInt a; + + 3 + 3; + /* begin methodAAssignOnReturn */ + 1 + 1; + a = 2 + 2; + /* end methodAAssignOnReturn */ + return 0; +}' +] + +{ #category : 'inline-arguments' } +SLInliningTest >> test2ChainInliningEmptyMethodAWithArgumentsInlined [ + "a bug present since old version, vm works but it would be nice to fix it one day" + + | method translation | + method := self addMethodAndMethodCalledBy: + #emptyMethodAWithArgumentsInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#emptyMethodAWithArgumentsInlined */ +static sqInt +emptyMethodAWithArgumentsInlined(void) +{ + sqInt arg; + + /* begin emptyMethod: */ + /* begin methodCAlwaysInlined */ + 3 + 3; + /* begin methodA */ + 1 + 1; + /* begin methodB */ + 2 + 2; + /* end methodB */ + /* end methodA */ + arg = null; + /* end methodCAlwaysInlined */ + /* end emptyMethod: */ + return 0; +}' +] + +{ #category : 'inline-arguments' } +SLInliningTest >> test2ChainInliningEmptyMethodAWithSimpleArgumentsInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #emptyMethodAWithSimpleArgumentsInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#emptyMethodAWithSimpleArgumentsInlined */ +static sqInt +emptyMethodAWithSimpleArgumentsInlined(void) +{ + sqInt arg; + + /* begin emptyMethod: */ + arg = 2 + 2; + /* end emptyMethod: */ + return 0; +}' +] + +{ #category : 'inline-arguments' } +SLInliningTest >> test2ChainInliningMethodAWithArgumentsInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAWithArgumentsInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAWithArgumentsInlined */ +static sqInt +methodAWithArgumentsInlined(void) +{ + return methodB((/* begin methodCAlwaysInlined */ 3 + 3, /* begin methodA */ 1 + 1, /* begin methodB */ 2 + 2 /* end methodB */, null /* end methodA */ /* end methodCAlwaysInlined */)); +}' +] + +{ #category : 'inline-arguments' } +SLInliningTest >> test2ChainInliningMethodAWithReturningSendArgumentsInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAWithReturningSendArgumentsInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAWithReturningSendArgumentsInlined */ +static sqInt +methodAWithReturningSendArgumentsInlined(void) +{ + return methodB((/* begin methodCAlwaysInlined */ 3 + 3, /* begin methodA */ 1 + 1, /* begin methodB */ 2 + 2 /* end methodB */, null /* end methodA */ /* end methodCAlwaysInlined */)); +}' +] + +{ #category : 'inlining-returning-arguments' } +SLInliningTest >> test2ChainInliningMethodAWithReturningSendReturningArgumentsInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAWithReturningSendWithMethodWithMultipleReturnInArgumentsInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAWithReturningSendWithMethodWithMultipleReturnInArgumentsInlined */ +static sqInt +methodAWithReturningSendWithMethodWithMultipleReturnInArgumentsInlined(void) +{ + return methodB(methodAMultipleReturnInlined()); +}' +] + +{ #category : 'inline-arguments' } +SLInliningTest >> test2ChainInliningMethodAWithSimpleArgumentsInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAWithSimpleArgumentsInlined. + + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAWithSimpleArgumentsInlined */ +static sqInt +methodAWithSimpleArgumentsInlined(void) +{ + methodB(2 + 2); + return 0; +}' +] + +{ #category : 'inlining-jump' } +SLInliningTest >> test2ChainInliningMultipleReturn [ + + | method translation | + method := self addMethodAndMethodCalledBy: #methodAMultipleReturn. + + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: '/* SLMockInliningTestClass>>#methodAMultipleReturn */ +static sqInt +methodAMultipleReturn(void) +{ + /* begin methodBMultipleReturn */ + if (methodB()) { + goto l3; + } + /* begin methodCMultipleReturn */ + if (methodC()) { + goto l2; + } + 3 + 3; + l2: + ; + /* end methodCMultipleReturn */ + 2 + 2; + l3: + ; + /* end methodBMultipleReturn */ + return 1 + 1; +}' +] + +{ #category : 'inlining-jump' } +SLInliningTest >> test2ChainInliningMultipleReturnAsAssignmentExpression [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAMultipleReturnAsAssignmentExpression. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAMultipleReturnAsAssignmentExpression */ +static sqInt +methodAMultipleReturnAsAssignmentExpression(void) +{ + sqInt x; + + /* begin methodBMultipleReturn */ + if (methodB()) { + x = 0; + goto l3; + } + /* begin methodCMultipleReturn */ + if (methodC()) { + goto l2; + } + 3 + 3; + l2: + ; + /* end methodCMultipleReturn */ + x = 2 + 2; + l3: + ; + /* end methodBMultipleReturn */ + return 0; +}' +] + +{ #category : 'inlining-jump' } +SLInliningTest >> test2ChainInliningMultipleReturnAsReturnExpression [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAMultipleReturnAsReturnExpression. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAMultipleReturnAsReturnExpression */ +static sqInt +methodAMultipleReturnAsReturnExpression(void) +{ + /* begin methodBMultipleReturn */ + if (methodB()) { + return 0; + } + /* begin methodCMultipleReturn */ + if (methodC()) { + goto l2; + } + 3 + 3; + l2: + ; + /* end methodCMultipleReturn */ + return 2 + 2; + /* end methodBMultipleReturn */ +}' +] + +{ #category : 'inlining-jump' } +SLInliningTest >> test2ChainInliningMultipleReturnAsReturnExpressionAndStatement [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAMultipleReturnAsReturnExpressionAndStatement. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAMultipleReturnAsReturnExpressionAndStatement */ +static sqInt +methodAMultipleReturnAsReturnExpressionAndStatement(void) +{ + if (methodB()) { + return 2; + } else { + /* begin methodCMultipleReturn */ + if (methodC()) { + return 1; + } + return 3 + 3; + /* end methodCMultipleReturn */ + } +}' +] + +{ #category : 'inlining-assignment' } +SLInliningTest >> test2ChainInliningReturnOnAssignment [ + + | method translation | + method := self addMethodAndMethodCalledBy: #methodCReturnOnAssignment. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: '/* SLMockInliningTestClass>>#methodCReturnOnAssignment */ +static sqInt +methodCReturnOnAssignment(void) +{ + sqInt var; + int var2; + sqInt x; + + 3 + 3; + /* begin methodAReturnOnAssignment */ + 1 + 1; + /* begin methodBReturnOnAssignment: */ + var2 = 2 + 2; + return (var = var2); + /* end methodBReturnOnAssignment: */ + /* end methodAReturnOnAssignment */ +}' +] + +{ #category : 'inlining-jump' } +SLInliningTest >> test2ChainInliningSimpleReturn [ + + | method translation | + method := self addMethodAndMethodCalledBy: #methodASimpleReturn. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: '/* SLMockInliningTestClass>>#methodASimpleReturn */ +static sqInt +methodASimpleReturn(void) +{ + /* begin methodBSimpleReturn */ + 3 + 3; + 2 + 2; + /* end methodBSimpleReturn */ + return 1 + 1; +}' +] + +{ #category : 'inlining-simple' } +SLInliningTest >> testInlineInSwitchRemovesReturnStatement [ + + | method codeGenerator methodToBeInlined theSwitch firstCaseConstantExpression firstCase firstCaseLabels | + method := (Spur64BitMemoryManager lookupSelector: + #numSlotsForShortening:toIndexableSize:) + asTranslationMethodOfClass: TMethod. + methodToBeInlined := (Spur64BitMemoryManager lookupSelector: + #arrayFormat) asTranslationMethodOfClass: + TMethod. + + codeGenerator := CCodeGeneratorGlobalStructure new. + codeGenerator addMethod: method. + codeGenerator addMethod: methodToBeInlined. + codeGenerator prepareMethods. + codeGenerator inferTypes. + codeGenerator doInlining: true. + + theSwitch := method parseTree children first expression. + firstCase := theSwitch cases first. + firstCaseLabels := firstCase first. + "The first case should have a single label" + self assert: firstCaseLabels size equals: 1. + firstCaseConstantExpression := firstCaseLabels first. + self assert: firstCaseConstantExpression parent equals: theSwitch +] + +{ #category : 'inlining-assignment' } +SLInliningTest >> testMethodAInlineIfFalseReturningIfTrueInAssignement [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineIfFalseReturningIfTrueInAssignement. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineIfFalseReturningIfTrueInAssignement */ +static sqInt +methodAInlineIfFalseReturningIfTrueInAssignement(void) +{ + sqInt a; + + /* begin methodBIfFalseReturningIfTrue */ + if (methodB()) { + a = 0; + goto l2; + } else { + } + a = 1; + l2: + ; + /* end methodBIfFalseReturningIfTrue */ + return 0; +}' +] + +{ #category : 'inlining-assignment' } +SLInliningTest >> testMethodAInlineMultipleIfFalseReturningIfTrueInAssignment [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineMultipleIfFalseReturningIfTrueInAssignment. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineMultipleIfFalseReturningIfTrueInAssignment */ +static sqInt +methodAInlineMultipleIfFalseReturningIfTrueInAssignment(void) +{ + sqInt a; + + if (methodB()) { + /* begin methodBIfFalseReturningIfTrue */ + if (methodB()) { + a = 0; + goto l3; + } else { + } + a = 1; + l3: + ; + /* end methodBIfFalseReturningIfTrue */ + } + else { + /* begin methodBIfFalseReturningIfTrue */ + if (methodB()) { + a = 0; + goto l2; + } else { + } + a = 1; + l2: + ; + /* end methodBIfFalseReturningIfTrue */ + } + return 0; +}' +] + +{ #category : 'inlining-returning-conditional' } +SLInliningTest >> testMethodAInlineMultipleIfFalseReturningIfTrueInReturn [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineMultipleIfFalseReturningIfTrueInReturn. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineMultipleIfFalseReturningIfTrueInReturn */ +static sqInt +methodAInlineMultipleIfFalseReturningIfTrueInReturn(void) +{ + if (methodB()) { + /* begin methodBIfFalseReturningIfTrue */ + if (methodB()) { + return 0; + } else { + } + return 1; + /* end methodBIfFalseReturningIfTrue */ + } + else { + /* begin methodBIfFalseReturningIfTrue */ + if (methodB()) { + return 0; + } else { + } + return 1; + /* end methodBIfFalseReturningIfTrue */ + } +}' +] + +{ #category : 'inlining-returning-conditional' } +SLInliningTest >> testMethodAInlineReturningIfTrue [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineReturningIfTrueInReturn. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineReturningIfTrueInReturn */ +static sqInt +methodAInlineReturningIfTrueInReturn(void) +{ + return ((methodB()) + ? 1 + : 0); +}' +] + +{ #category : 'inlining-assignment' } +SLInliningTest >> testMethodAInlineReturningIfTrueIfFalseInAssignment [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineReturningIfTrueIfFalseInAssignment. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineReturningIfTrueIfFalseInAssignment */ +static sqInt +methodAInlineReturningIfTrueIfFalseInAssignment(void) +{ + sqInt a; + + a = ((methodB()) + ? 1 + : 2); + return 0; +}' +] + +{ #category : 'inlining-returning-conditional' } +SLInliningTest >> testMethodAInlineReturningIfTrueIfFalseInReturn [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineReturningIfTrueIfFalseInReturn. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineReturningIfTrueIfFalseInReturn */ +static sqInt +methodAInlineReturningIfTrueIfFalseInReturn(void) +{ + return ((methodB()) + ? 1 + : 2); +}' +] + +{ #category : 'inlining-assignment' } +SLInliningTest >> testMethodAInlineReturningIfTrueInAssignment [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineReturningIfTrueInAssignment. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineReturningIfTrueInAssignment */ +static sqInt +methodAInlineReturningIfTrueInAssignment(void) +{ + sqInt a; + + a = ((methodB()) + ? 1 + : 0); + return 0; +}' +] + +{ #category : 'inlining-assignment' } +SLInliningTest >> testMethodAInlineReturningInlinedIfTrueIfFalseInAssignment [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineReturningInlinedIfTrueIfFalseInAssignment. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineReturningInlinedIfTrueIfFalseInAssignment */ +static sqInt +methodAInlineReturningInlinedIfTrueIfFalseInAssignment(void) +{ + sqInt a; + + if (methodB()) { + /* begin methodB */ + 2 + 2; + a = null; + /* end methodB */ + } else { + /* begin methodA */ + 1 + 1; + /* begin methodB */ + 2 + 2; + /* end methodB */ + a = null; + /* end methodA */ + } + return 0; +}' +] + +{ #category : 'inlining-returning-conditional' } +SLInliningTest >> testMethodAInlineReturningInlinedIfTrueIfFalseInReturn [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineReturningInlinedIfTrueIfFalseInReturn. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineReturningInlinedIfTrueIfFalseInReturn */ +static sqInt +methodAInlineReturningInlinedIfTrueIfFalseInReturn(void) +{ + if (methodB()) { + /* begin methodB */ + 2 + 2; + return null; + /* end methodB */ + } else { + /* begin methodA */ + 1 + 1; + /* begin methodB */ + 2 + 2; + /* end methodB */ + return null; + /* end methodA */ + } +}' +] + +{ #category : 'inlining-assignment' } +SLInliningTest >> testMethodAInlineReturningInlinedIfTrueInAssignment [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineReturningInlinedIfTrueInAssignment. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineReturningInlinedIfTrueInAssignment */ +static sqInt +methodAInlineReturningInlinedIfTrueInAssignment(void) +{ + sqInt a; + + if (methodB()) { + /* begin methodB */ + 2 + 2; + a = null; + /* end methodB */ + } else { + a = 0; + } + return 0; +}' +] + +{ #category : 'inlining-returning-conditional' } +SLInliningTest >> testMethodAInlineReturningInlinedIfTrueInReturn [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineReturningInlinedIfTrueInReturn. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineReturningInlinedIfTrueInReturn */ +static sqInt +methodAInlineReturningInlinedIfTrueInReturn(void) +{ + if (methodB()) { + /* begin methodB */ + 2 + 2; + return null; + /* end methodB */ + } + return 0; +}' +] + +{ #category : 'inlining-returning-conditional' } +SLInliningTest >> testMethodAInlineifFalseReturningIfTrueInReturn [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAInlineIfFalseReturningIfTrueInReturn. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAInlineIfFalseReturningIfTrueInReturn */ +static sqInt +methodAInlineIfFalseReturningIfTrueInReturn(void) +{ + /* begin methodBIfFalseReturningIfTrue */ + if (methodB()) { + return 0; + } else { + } + return 1; + /* end methodBIfFalseReturningIfTrue */ +}' +] + +{ #category : 'inlining-assignment' } +SLInliningTest >> testMethodAReturnAssignment [ + + | method translation | + method := self addMethodAndMethodCalledBy: #methodAReturnAssignment. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: '/* SLMockInliningTestClass>>#methodAReturnAssignment */ +static sqInt +methodAReturnAssignment(void) +{ + sqInt a; + + return (a = methodB()); +}' +] + +{ #category : 'inlining-assignment' } +SLInliningTest >> testMethodAReturnBlockAssignment [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAReturnBlockAssignment. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAReturnBlockAssignment */ +static sqInt +methodAReturnBlockAssignment(void) +{ + sqInt a; + + /* begin methodB */ + 2 + 2; + return (a = null); + /* end methodB */ +}' +] + +{ #category : 'inlining-returning-arguments' } +SLInliningTest >> testMethodAWithReturningSendWithReturningIfInArgumentsInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAWithReturningSendWithReturningIfInArgumentsInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAWithReturningSendWithReturningIfInArgumentsInlined */ +static sqInt +methodAWithReturningSendWithReturningIfInArgumentsInlined(void) +{ + return methodB(((methodB()) + ? 1 + : 2)); +}' +] + +{ #category : 'inlining-returning-arguments' } +SLInliningTest >> testMethodAWithReturningSendWithReturningIfInSendInArgumentsInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodAWithReturningSendWithReturningIfInSendInArgumentsInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodAWithReturningSendWithReturningIfInSendInArgumentsInlined */ +static sqInt +methodAWithReturningSendWithReturningIfInSendInArgumentsInlined(void) +{ + return methodB(methodB(((methodB()) + ? 1 + : 2))); +}' +] + +{ #category : 'inlining-variable' } +SLInliningTest >> testMethodInlineVariableWithSameName [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodInlineVariableWithSameName. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodInlineVariableWithSameName */ +static sqInt +methodInlineVariableWithSameName(void) +{ + sqInt a; + int a2; + + /* begin methodWithVariableA */ + a2 = 2; + a = 3; + /* end methodWithVariableA */ + return 0; +}' +] + +{ #category : 'inlining-iterative' } +SLInliningTest >> testMethodWithAssignmentOnRepeatInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithAssignmentOnRepeatInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithAssignmentOnRepeatInlined */ +static sqInt +methodWithAssignmentOnRepeatInlined(void) +{ + sqInt a; + + /* begin methodWithRepeat */ + while (1) { + if (methodB()) { + a = 5; + goto l2; + } + /* begin methodB */ + 2 + 2; + /* end methodB */ + } + l2: + ; + /* end methodWithRepeat */ + return 0; +}' +] + +{ #category : 'inlining-iterative' } +SLInliningTest >> testMethodWithAssignmentOnToByDoInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithAssignmentOnToByDoInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithAssignmentOnToByDoInlined */ +static sqInt +methodWithAssignmentOnToByDoInlined(void) +{ + sqInt a; + sqInt i; + + /* begin methodWithToByDo */ + for (i = 1; i <= 4; i += 2) { + if (methodB(i)) { + a = 5; + goto l2; + } + /* begin methodB */ + 2 + 2; + /* end methodB */ + } + l2: + ; + /* end methodWithToByDo */ + return 0; +}' +] + +{ #category : 'inlining-iterative' } +SLInliningTest >> testMethodWithAssignmentOnToDoInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithAssignmentOnToDoInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithAssignmentOnToDoInlined */ +static sqInt +methodWithAssignmentOnToDoInlined(void) +{ + sqInt a; + sqInt i; + + /* begin methodWithToDo */ + for (i = 1; i <= 2; i += 1) { + if (methodB(i)) { + a = 5; + goto l2; + } + /* begin methodB */ + 2 + 2; + /* end methodB */ + } + l2: + ; + /* end methodWithToDo */ + return 0; +}' +] + +{ #category : 'inlining-iterative' } +SLInliningTest >> testMethodWithAssignmentOnWhileTrueBinaryInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithAssignmentOnWhileTrueBinaryInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithAssignmentOnWhileTrueBinaryInlined */ +static sqInt +methodWithAssignmentOnWhileTrueBinaryInlined(void) +{ + sqInt a; + + /* begin methodWithWhileTrueBinary */ + while (1) { + if (methodB()) { + a = 5; + goto l2; + } + /* begin methodB */ + 2 + 2; + /* end methodB */ + } + l2: + ; + /* end methodWithWhileTrueBinary */ + return 0; +}' +] + +{ #category : 'inlining-iterative' } +SLInliningTest >> testMethodWithAssignmentOnWhileTrueInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithAssignmentOnWhileTrueInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithAssignmentOnWhileTrueInlined */ +static sqInt +methodWithAssignmentOnWhileTrueInlined(void) +{ + sqInt a; + + /* begin methodWithWhileTrue */ + do { + if (methodB()) { + a = 5; + goto l2; + } + /* begin methodB */ + 2 + 2; + /* end methodB */ + } while (1); + l2: + ; + /* end methodWithWhileTrue */ + return 0; +}' +] + +{ #category : 'collect-statements-for-inlining' } +SLInliningTest >> testMethodWithAvoidedSelectors [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithAvoidedSelectors. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: '/* SLMockInliningTestClass>>#methodWithAvoidedSelectors */ +static sqInt +methodWithAvoidedSelectors(void) +{ + /* begin methodB */ + 2 + 2; + /* end methodB */ + method(); + method(methodB(), 2, 3); + +# if methodB() + { + /* begin methodB */ + 2 + 2; + /* end methodB */ + } +# else /* methodB() */ + { + /* begin methodB */ + 2 + 2; + /* end methodB */ + } +# endif /* methodB() */ + ((/* begin methodB */ 2 + 2, null /* end methodB */)) && 0; + 0 || (methodB()); + if (methodB()) { + /* begin methodB */ + 2 + 2; + /* end methodB */ + } + return 0; +}' +] + +{ #category : 'inlining-block' } +SLInliningTest >> testMethodWithBlockArgumentInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithBlockArgumentInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithBlockArgumentInlined */ +static sqInt +methodWithBlockArgumentInlined(void) +{ + sqInt a; + + /* begin methodWithBlockArgument: */ + { + a = 2; + } + /* end methodWithBlockArgument: */ + return 0; +}' +] + +{ #category : 'inlining-block' } +SLInliningTest >> testMethodWithBlockWithReturningIfArgumentInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithBlockWithReturningIfArgumentInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithBlockWithReturningIfArgumentInlined */ +static sqInt +methodWithBlockWithReturningIfArgumentInlined(void) +{ + sqInt a; + + /* begin methodWithBlockArgument: */ + { + if (methodB()) { + /* begin methodB */ + 2 + 2; + a = null; + /* end methodB */ + } else { + /* begin methodA */ + 1 + 1; + /* begin methodB */ + 2 + 2; + /* end methodB */ + a = null; + /* end methodA */ + } + } + /* end methodWithBlockArgument: */ + return 0; +}' +] + +{ #category : 'inlining-block' } +SLInliningTest >> testMethodWithBlockWithReturningIfWithGotoInlinedArgumentInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithBlockWithReturningIfWithGotoInlinedArgumentInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithBlockWithReturningIfWithGotoInlinedArgumentInlined */ +static sqInt +methodWithBlockWithReturningIfWithGotoInlinedArgumentInlined(void) +{ + sqInt a; + + /* begin methodWithBlockArgument: */ + { + /* begin methodBMultipleReturn */ + if (methodB()) { + a = 0; + goto l4; + } + /* begin methodCMultipleReturn */ + if (methodC()) { + goto l5; + } + 3 + 3; + l5: + ; + /* end methodCMultipleReturn */ + a = 2 + 2; + l4: + ; + /* end methodBMultipleReturn */ + } + /* end methodWithBlockArgument: */ + return 0; +}' +] + +{ #category : 'inlining-block' } +SLInliningTest >> testMethodWithBlockWithReturningIfWithInlinedArgumentInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithBlockWithReturningIfWithInlinedArgumentInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithBlockWithReturningIfWithInlinedArgumentInlined */ +static sqInt +methodWithBlockWithReturningIfWithInlinedArgumentInlined(void) +{ + sqInt a; + + /* begin methodWithBlockArgument: */ + { + if (methodB()) { + a = 2; + } else { + /* begin methodCMultipleReturn */ + if (methodC()) { + a = 1; + goto l3; + } + a = 3 + 3; + l3: + ; + /* end methodCMultipleReturn */ + } + } + /* end methodWithBlockArgument: */ + return 0; +}' +] + +{ #category : 'inlining-conditional-receiver' } +SLInliningTest >> testMethodWithIfTrueReceiverInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithIfTrueReceiverInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithIfTrueReceiverInlined */ +static sqInt +methodWithIfTrueReceiverInlined(void) +{ + /* begin methodWithMultipleBooleanReturn */ + if (methodB()) { + goto l2; + } + /* begin methodCMultipleReturn */ + if (methodC()) { + goto l3; + } + 3 + 3; + l3: + ; + /* end methodCMultipleReturn */ + /* end methodWithMultipleBooleanReturn; fall through */ + /* end methodWithMultipleBooleanReturn */ + /* begin methodB */ + 2 + 2; + /* end methodB */ + l2: + return 1; +}' +] + +{ #category : 'inlining-conditional-receiver' } +SLInliningTest >> testMethodWithReturningIfTrueReceiverInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithReturningIfTrueReceiverInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithReturningIfTrueReceiverInlined */ +static sqInt +methodWithReturningIfTrueReceiverInlined(void) +{ + /* begin methodWithMultipleBooleanReturn */ + if (methodB()) { + goto l2; + } + /* begin methodCMultipleReturn */ + if (methodC()) { + goto l3; + } + 3 + 3; + l3: + ; + /* end methodCMultipleReturn */ + /* end methodWithMultipleBooleanReturn; fall through */ + /* end methodWithMultipleBooleanReturn */ + /* begin methodB */ + 2 + 2; + /* end methodB */ + return 0; + l2: + return 1; +}' +] + +{ #category : 'inlining-jump' } +SLInliningTest >> testMethodWithReturningIfWithReturnPartiallyPushedDownInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithReturningIfWithReturnPartiallyPushedDownInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithReturningIfWithReturnPartiallyPushedDownInlined */ +static sqInt +methodWithReturningIfWithReturnPartiallyPushedDownInlined(void) +{ + methodB(((methodB()) + ? 2 + : 3)); + return 0; +}' +] + +{ #category : 'inlining-jump' } +SLInliningTest >> testMethodWithReturningIfWithReturnPushedDownInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithReturningIfWithReturnPushedDownInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithReturningIfWithReturnPushedDownInlined */ +static sqInt +methodWithReturningIfWithReturnPushedDownInlined(void) +{ + methodB(((methodB()) + ? 2 + : 3)); + return 0; +}' +] + +{ #category : 'inlining-simple' } +SLInliningTest >> testSimpleInlining [ + + | method sendStatements | + method := self addMethodAndMethodCalledBy: #methodA. + self doInliningIn: method. + + sendStatements := method parseTree statements select: #isSend. + self assert: sendStatements size equals: 2. + self assert: sendStatements first selector equals: #+. + self assert: sendStatements second selector equals: #+ +] + +{ #category : 'inlining-perform-send' } +SLInliningTest >> testmethodWithPerformSend [ + + | method translation | + method := self addMethodAndMethodCalledBy: #methodWithPerformSend. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: '/* SLMockInliningTestClass>>#methodWithPerformSend */ +static sqInt +methodWithPerformSend(void) +{ + return 4; +}' +] + +{ #category : 'inlining-perform-send' } +SLInliningTest >> testmethodWithPerformSendAsReceiver [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithPerformSendAsReceiver. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithPerformSendAsReceiver */ +static sqInt +methodWithPerformSendAsReceiver(void) +{ + return 4 + 2; +}' +] + +{ #category : 'inlining-perform-send' } +SLInliningTest >> testmethodWithPerformSendAsReceiverNotInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithPerformSendAsReceiverNotInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithPerformSendAsReceiverNotInlined */ +static sqInt +methodWithPerformSendAsReceiverNotInlined(void) +{ + return (methodB()) + 2; +}' +] + +{ #category : 'inlining-perform-send' } +SLInliningTest >> testmethodWithPerformSendNotInlined [ + + | method translation | + method := self addMethodAndMethodCalledBy: + #methodWithPerformSendNotInlined. + self doInliningIn: method. + + translation := self translate: method. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLMockInliningTestClass>>#methodWithPerformSendNotInlined */ +static sqInt +methodWithPerformSendNotInlined(void) +{ + return methodB(); +}' +] + +{ #category : 'parameters' } +SLInliningTest >> useExtractedInlining [ + + inliner := SLInliner new +] + +{ #category : 'parameters' } +SLInliningTest >> useNewInlining [ + + inliner := SLInlinerWithAnnotation new +] diff --git a/smalltalksrc/Slang-Tests/SLMockInliningTestClass.class.st b/smalltalksrc/Slang-Tests/SLMockInliningTestClass.class.st index ceb4a48870..0c96917603 100644 --- a/smalltalksrc/Slang-Tests/SLMockInliningTestClass.class.st +++ b/smalltalksrc/Slang-Tests/SLMockInliningTestClass.class.st @@ -11,12 +11,24 @@ SLMockInliningTestClass >> emptyMethod: arg [ ] +{ #category : 'inlining-arguments' } +SLMockInliningTestClass >> emptyMethodAWithArgumentsInlined [ + + self emptyMethod: self methodCAlwaysInlined +] + { #category : 'inlining-arguments' } SLMockInliningTestClass >> emptyMethodAWithSimpleArgumentsInlined [ self emptyMethod: self methodBAlwaysInlined ] +{ #category : 'helpers' } +SLMockInliningTestClass >> functionalMethod [ + + ^ 4 +] + { #category : 'inlining-simple' } SLMockInliningTestClass >> methodA [ @@ -55,6 +67,16 @@ SLMockInliningTestClass >> methodAInlineMultipleIfFalseReturningIfTrueInAssignme self methodBIfFalseReturningIfTrue ] ] +{ #category : 'inlining-returning-conditional' } +SLMockInliningTestClass >> methodAInlineMultipleIfFalseReturningIfTrueInReturn [ + + ^ self methodB + ifFalse: [ self methodBIfFalseReturningIfTrue ] + ifTrue: [ + 5. + self methodBIfFalseReturningIfTrue ] +] + { #category : 'inlining-assignment' } SLMockInliningTestClass >> methodAInlineReturningIfTrueIfFalseInAssignment [ @@ -81,6 +103,19 @@ SLMockInliningTestClass >> methodAInlineReturningIfTrueInReturn [ ^ self methodBReturningIfTrue ] +{ #category : 'inlining-assignment' } +SLMockInliningTestClass >> methodAInlineReturningInlinedIfTrueIfFalseInAssignment [ + + | a | + a := self methodBReturningInlinedIfTrueIfFalse +] + +{ #category : 'inlining-returning-conditional' } +SLMockInliningTestClass >> methodAInlineReturningInlinedIfTrueIfFalseInReturn [ + + ^ self methodBReturningInlinedIfTrueIfFalse +] + { #category : 'inlining-assignment' } SLMockInliningTestClass >> methodAInlineReturningInlinedIfTrueInAssignment [ @@ -88,6 +123,12 @@ SLMockInliningTestClass >> methodAInlineReturningInlinedIfTrueInAssignment [ a := self methodBReturningInlinedIfTrue ] +{ #category : 'inlining-returning-conditional' } +SLMockInliningTestClass >> methodAInlineReturningInlinedIfTrueInReturn [ + + ^ self methodBReturningInlinedIfTrue +] + { #category : 'inlining-jump' } SLMockInliningTestClass >> methodAMultipleReturn [ @@ -108,6 +149,12 @@ SLMockInliningTestClass >> methodAMultipleReturnAsReturnExpression [ ^ self methodBMultipleReturn ] +{ #category : 'inlining-jump' } +SLMockInliningTestClass >> methodAMultipleReturnAsReturnExpressionAndStatement [ + + ^ self methodBMultipleReturnExpressionAndStatement +] + { #category : 'inlining-jump' } SLMockInliningTestClass >> methodAMultipleReturnExpression [ @@ -115,6 +162,13 @@ SLMockInliningTestClass >> methodAMultipleReturnExpression [ ^ 1 + 1 ] +{ #category : 'inlining-jump' } +SLMockInliningTestClass >> methodAMultipleReturnInlined [ + + self methodBMultipleReturn. + ^ 1 + 1 +] + { #category : 'inlining-assignment' } SLMockInliningTestClass >> methodAReturnAssignment [ @@ -122,6 +176,13 @@ SLMockInliningTestClass >> methodAReturnAssignment [ ^ a := self methodB ] +{ #category : 'inlining-assignment' } +SLMockInliningTestClass >> methodAReturnBlockAssignment [ + + | a | + ^ a := [ self methodB ] +] + { #category : 'inlining-assignment-helpers' } SLMockInliningTestClass >> methodAReturnOnAssignment [ @@ -151,6 +212,24 @@ SLMockInliningTestClass >> methodAWithReturningSendArgumentsInlined [ ^ self methodB: self methodCAlwaysInlined ] +{ #category : 'inlining-returning-arguments' } +SLMockInliningTestClass >> methodAWithReturningSendWithMethodWithMultipleReturnInArgumentsInlined [ + + ^ self methodB: self methodAMultipleReturnInlined +] + +{ #category : 'inlining-returning-arguments' } +SLMockInliningTestClass >> methodAWithReturningSendWithReturningIfInArgumentsInlined [ + + ^ self methodB: self methodBReturningIfTrueIfFalse +] + +{ #category : 'inlining-returning-arguments' } +SLMockInliningTestClass >> methodAWithReturningSendWithReturningIfInSendInArgumentsInlined [ + + ^ self methodB: self methodBReturningIfTrueIfFalseInSend +] + { #category : 'inlining-arguments' } SLMockInliningTestClass >> methodAWithSimpleArgumentsInlined [ @@ -200,6 +279,38 @@ SLMockInliningTestClass >> methodBMultipleReturn [ ^ 2 + 2 ] +{ #category : 'inlining-jump-helpers' } +SLMockInliningTestClass >> methodBMultipleReturnExpressionAndStatement [ + + ^ self methodB + ifTrue: [ 2 ] + ifFalse: [ self methodCMultipleReturn ] +] + +{ #category : 'inlining-jump-helpers' } +SLMockInliningTestClass >> methodBMultipleReturnExpressionAndStatementInlined [ + + ^ self methodB + ifTrue: [ 2 ] + ifFalse: [ self methodBReturningInlinedIfTrueIfFalse ] +] + +{ #category : 'inlining-jump-helpers' } +SLMockInliningTestClass >> methodBMultipleReturningIfWithReturnPartiallyPushedDown [ + + ^ self methodB + ifTrue: [ ^ [ 2 ] ] + ifFalse: [ 3 ] +] + +{ #category : 'inlining-jump-helpers' } +SLMockInliningTestClass >> methodBMultipleReturningIfWithReturnPushedDown [ + + self methodB + ifTrue: [ ^ 2 ] + ifFalse: [ ^ 3 ] +] + { #category : 'inlining-assignment-helpers' } SLMockInliningTestClass >> methodBReturnOnAssignment [ @@ -227,12 +338,26 @@ SLMockInliningTestClass >> methodBReturningIfTrueIfFalse [ ^ self methodB ifTrue: [ 1 ] ifFalse: [ 2 ] ] +{ #category : 'inlining-returning-arguments-helpers' } +SLMockInliningTestClass >> methodBReturningIfTrueIfFalseInSend [ + + ^ self methodB: (self methodB + ifTrue: [ 1 ] + ifFalse: [ 2 ]) +] + { #category : 'inlining-returning-conditional-helpers' } SLMockInliningTestClass >> methodBReturningInlinedIfTrue [ ^ self methodB ifTrue: [ self methodB ] ] +{ #category : 'inlining-returning-conditional-helpers' } +SLMockInliningTestClass >> methodBReturningInlinedIfTrueIfFalse [ + + ^ self methodB ifTrue: [ self methodB ] ifFalse: [ self methodA ] +] + { #category : 'inlining-jump-helpers' } SLMockInliningTestClass >> methodBSimpleReturn [ @@ -283,14 +408,222 @@ SLMockInliningTestClass >> methodCSimpleReturn [ ^ 3 + 3 ] +{ #category : 'inlining-variable' } +SLMockInliningTestClass >> methodInlineVariableWithSameName [ + | a | + a := self methodWithVariableA. +] + +{ #category : 'inlining-iterative' } +SLMockInliningTestClass >> methodWithAssignmentOnRepeatInlined [ + + | a | + a := self methodWithRepeat +] + +{ #category : 'inlining-iterative' } +SLMockInliningTestClass >> methodWithAssignmentOnToByDoInlined [ + + | a | + a := self methodWithToByDo +] + +{ #category : 'inlining-iterative' } +SLMockInliningTestClass >> methodWithAssignmentOnToDoInlined [ + + | a | + a := self methodWithToDo +] + +{ #category : 'inlining-iterative' } +SLMockInliningTestClass >> methodWithAssignmentOnWhileTrueBinaryInlined [ + + | a | + a := self methodWithWhileTrueBinary +] + +{ #category : 'inlining-iterative' } +SLMockInliningTestClass >> methodWithAssignmentOnWhileTrueInlined [ + + | a | + a := self methodWithWhileTrue +] + { #category : 'collect-statements-for-inlining' } SLMockInliningTestClass >> methodWithAvoidedSelectors [ - self cCode: [ ] inSmalltalk: [ ]. + self cCode: [ self methodB ] inSmalltalk: [ self methodB ]. self cCall: 'method'. - self cCall: 'method' withArguments: { 1. 2. 3 }. - self cppIf: ['cppCond'. true] ifTrue: [ 'in cppIfTrue'. false ] ifFalse: [ 'in cppIfFalse'. true ]. - [ 'and receiver'. true ] and: [ 'and argument'. false ]. - [ 'or receiver' . false ] or: [ 'or argument'. true ]. - [ 'ifTrue receiver'. false ] ifTrue: ['ifTrue argument' . true ] + self cCall: 'method' withArguments: { + self methodB. + 2. + 3 }. + self + cppIf: [ self methodB ] + ifTrue: [ self methodB ] + ifFalse: [ self methodB ]. + [ self methodB ] and: [ false ]. + [ false ] or: [ self methodB ]. + [ self methodB ] ifTrue: [ self methodB ] +] + +{ #category : 'inlining-block-helpers' } +SLMockInliningTestClass >> methodWithBlockArgument: aBlock [ + + | a | + a := aBlock value +] + +{ #category : 'inlining-block' } +SLMockInliningTestClass >> methodWithBlockArgumentInlined [ + + self methodWithBlockArgument: [ 2 ] +] + +{ #category : 'inlining-block' } +SLMockInliningTestClass >> methodWithBlockWithReturningIfArgumentInlined [ + + self methodWithBlockArgument: [ + self methodBReturningInlinedIfTrueIfFalse ] +] + +{ #category : 'inlining-block' } +SLMockInliningTestClass >> methodWithBlockWithReturningIfWithGotoInlinedArgumentInlined [ + + self methodWithBlockArgument: [ self methodBMultipleReturn ] +] + +{ #category : 'inlining-block' } +SLMockInliningTestClass >> methodWithBlockWithReturningIfWithInlinedArgumentInlined [ + + self methodWithBlockArgument: [ + self methodBMultipleReturnExpressionAndStatement ] +] + +{ #category : 'inlining-assignment-helpers' } +SLMockInliningTestClass >> methodWithConditionalReturnPlusAssignment [ + + | b x y | + b := x > y + ifTrue: [ ^ 7 ] + ifFalse: [ 0 ]. + ^ b + 1 +] + +{ #category : 'inlining-assignment' } +SLMockInliningTestClass >> methodWithDoubleAssignment [ + + | a | + a := self methodWithConditionalReturnPlusAssignment +] + +{ #category : 'inlining-conditional-receiver' } +SLMockInliningTestClass >> methodWithIfTrueReceiverInlined [ + + self methodWithMultipleBooleanReturn ifTrue: [ self methodB ]. + ^ 1 +] + +{ #category : 'inlining-conditional-receiver-helpers' } +SLMockInliningTestClass >> methodWithMultipleBooleanReturn [ + + + self methodB ifTrue: [ ^ false ]. + self methodCMultipleReturn. + ^ true +] + +{ #category : 'inlining-perform-send' } +SLMockInliningTestClass >> methodWithPerformSend [ + + ^ self perform: #functionalMethod +] + +{ #category : 'inlining-perform-send' } +SLMockInliningTestClass >> methodWithPerformSendAsReceiver [ + + ^ (self perform: #functionalMethod) + 2 +] + +{ #category : 'inlining-perform-send' } +SLMockInliningTestClass >> methodWithPerformSendAsReceiverNotInlined [ + + ^ (self perform: #methodB) + 2 +] + +{ #category : 'inlining-perform-send' } +SLMockInliningTestClass >> methodWithPerformSendNotInlined [ + + ^ self perform: #methodB +] + +{ #category : 'inlining-iterative-helpers' } +SLMockInliningTestClass >> methodWithRepeat [ + + [ + self methodB ifTrue: [ ^ 5 ]. + self methodB ] repeat +] + +{ #category : 'inlining-conditional-receiver' } +SLMockInliningTestClass >> methodWithReturningIfTrueReceiverInlined [ + + self methodWithMultipleBooleanReturn ifTrue: [ + self methodB. + ^ 0 ]. + ^ 1 +] + +{ #category : 'inlining-jump' } +SLMockInliningTestClass >> methodWithReturningIfWithReturnPartiallyPushedDownInlined [ + + self methodB: + self methodBMultipleReturningIfWithReturnPartiallyPushedDown +] + +{ #category : 'inlining-jump' } +SLMockInliningTestClass >> methodWithReturningIfWithReturnPushedDownInlined [ + + self methodB: self methodBMultipleReturningIfWithReturnPushedDown +] + +{ #category : 'inlining-iterative-helpers' } +SLMockInliningTestClass >> methodWithToByDo [ + + 1 to: 4 by: 2 do: [ :i | + (self methodB: i) ifTrue: [ ^ 5 ]. + self methodB ] +] + +{ #category : 'inlining-iterative-helpers' } +SLMockInliningTestClass >> methodWithToDo [ + + 1 to: 2 do: [ :i | + (self methodB: i) ifTrue: [ ^ 5 ]. + self methodB ] +] + +{ #category : 'inlinng-variable-helpers' } +SLMockInliningTestClass >> methodWithVariableA [ + + | a | + a := 2. + ^ 3 +] + +{ #category : 'inlining-iterative-helpers' } +SLMockInliningTestClass >> methodWithWhileTrue [ + + [ + self methodB ifTrue: [ ^ 5 ]. + self methodB. + true ] whileTrue +] + +{ #category : 'inlining-iterative-helpers' } +SLMockInliningTestClass >> methodWithWhileTrueBinary [ + + [ true ] whileTrue: [ + self methodB ifTrue: [ ^ 5 ]. + self methodB ] ] diff --git a/smalltalksrc/Slang-Tests/SLNodeAnnotatorVisitorTestClass.class.st b/smalltalksrc/Slang-Tests/SLNodeAnnotatorVisitorTestClass.class.st new file mode 100644 index 0000000000..1862111c10 --- /dev/null +++ b/smalltalksrc/Slang-Tests/SLNodeAnnotatorVisitorTestClass.class.st @@ -0,0 +1,179 @@ +Class { + #name : 'SLNodeAnnotatorVisitorTestClass', + #superclass : 'SlangClass', + #category : 'Slang-Tests', + #package : 'Slang-Tests' +} + +{ #category : 'helpers' } +SLNodeAnnotatorVisitorTestClass >> emptyMethod [ +] + +{ #category : 'helpers' } +SLNodeAnnotatorVisitorTestClass >> emptyMethod: arg [ +] + +{ #category : 'assignment' } +SLNodeAnnotatorVisitorTestClass >> methodWithAssignment [ + + | x y | + x := 1. + y := 2 + 3 +] + +{ #category : 'return' } +SLNodeAnnotatorVisitorTestClass >> methodWithBlockReturn [ + + ^ [ + 2. + 3. + 4 ] +] + +{ #category : 'return' } +SLNodeAnnotatorVisitorTestClass >> methodWithBlockwithExpressionReturn [ + + | a | + ^ [ + a := true + ifTrue: [ 3 ] + ifFalse: [ 4 ]. + 2 ] +] + +{ #category : 'assignment' } +SLNodeAnnotatorVisitorTestClass >> methodWithConditionalAssignment [ + + | x | + x := true + ifTrue: [ 1 ] + ifFalse: [ 2 ] +] + +{ #category : 'constant' } +SLNodeAnnotatorVisitorTestClass >> methodWithConstant [ + + 1. + 2. + 3. + true ifTrue: [ + 4. + ^ 5 ]. + ^ 6 +] + +{ #category : 'iterative' } +SLNodeAnnotatorVisitorTestClass >> methodWithDo [ + + #( ) do: [ :e | e ] +] + +{ #category : 'return' } +SLNodeAnnotatorVisitorTestClass >> methodWithReturn [ + + ^ 2 +] + +{ #category : 'return' } +SLNodeAnnotatorVisitorTestClass >> methodWithReturnInConditional [ + + true + ifTrue: [ ^ 2 ] + ifFalse: [ ^ 4 ] +] + +{ #category : 'return' } +SLNodeAnnotatorVisitorTestClass >> methodWithReturningConditional [ + + ^ true + ifTrue: [ 2 ] + ifFalse: [ 4 ] +] + +{ #category : 'send' } +SLNodeAnnotatorVisitorTestClass >> methodWithSendAsExpression [ + + | x y | + x := [ self emptyMethod: self emptyMethod ]. + y := self emptyMethod +] + +{ #category : 'send' } +SLNodeAnnotatorVisitorTestClass >> methodWithSendAsStatement [ + + [ self emptyMethod: 1 ]. + self emptyMethod +] + +{ #category : 'statement-list' } +SLNodeAnnotatorVisitorTestClass >> methodWithStatementList [ + + 5. + 6. + 7. + [ 8. 9 ]. + ^ [ 10. 11 ] +] + +{ #category : 'switch' } +SLNodeAnnotatorVisitorTestClass >> methodWithSwitchAsAssignmentExpression [ + + | x | + x := 3 caseOf: { + ([ 4 ] -> [ 6 ]). + ([ 5 ] -> [ 7 ]) } +] + +{ #category : 'switch' } +SLNodeAnnotatorVisitorTestClass >> methodWithSwitchAsReturnExpression [ + + ^ 3 caseOf: { + ([ 4 ] -> [ 6 ]). + ([ 5 ] -> [ 7 ]) } +] + +{ #category : 'switch' } +SLNodeAnnotatorVisitorTestClass >> methodWithSwitchAsStatement [ + + 3 caseOf: { + ([ 4 ] -> [ 6 ]). + ([ 5 ] -> [ 7 ]) } +] + +{ #category : 'switch' } +SLNodeAnnotatorVisitorTestClass >> methodWithSwitchWithOtherwiseAsAssignmentExpression [ + + | x | + x := 3 + caseOf: { + ([ 4 ] -> [ 6 ]). + ([ 5 ] -> [ 7 ]) } + otherwise: [ 8 ] +] + +{ #category : 'switch' } +SLNodeAnnotatorVisitorTestClass >> methodWithSwitchWithOtherwiseAsReturnExpression [ + + ^ 3 + caseOf: { + ([ 4 ] -> [ 6 ]). + ([ 5 ] -> [ 7 ]) } + otherwise: [ 8 ] +] + +{ #category : 'block' } +SLNodeAnnotatorVisitorTestClass >> methodWithValue [ + + | a | + a := [ true ifTrue: [ 2 ] ifFalse: [ 3 ] ] value. +] + +{ #category : 'block' } +SLNodeAnnotatorVisitorTestClass >> methodWithValueArgument [ + + | a | + a := [ :arg | + true + ifTrue: [ arg ] + ifFalse: [ 3 ] ] value: 2 +] diff --git a/smalltalksrc/Slang-Tests/SlangAbstractTestCase.class.st b/smalltalksrc/Slang-Tests/SlangAbstractTestCase.class.st index 113b1f1ff2..32c305805c 100644 --- a/smalltalksrc/Slang-Tests/SlangAbstractTestCase.class.st +++ b/smalltalksrc/Slang-Tests/SlangAbstractTestCase.class.st @@ -1,6 +1,6 @@ Class { #name : 'SlangAbstractTestCase', - #superclass : 'TestCase', + #superclass : 'ParametrizedTestCase', #instVars : [ 'ccg' ], diff --git a/smalltalksrc/Slang-Tests/SlangBasicTranslationTest.class.st b/smalltalksrc/Slang-Tests/SlangBasicTranslationTest.class.st index 8ee0c03cb1..58fcb36139 100644 --- a/smalltalksrc/Slang-Tests/SlangBasicTranslationTest.class.st +++ b/smalltalksrc/Slang-Tests/SlangBasicTranslationTest.class.st @@ -1639,8 +1639,8 @@ switchInReturn(void) } default: error("Case not found and no otherwise clause"); - return -1; } + return 0; }' ] diff --git a/smalltalksrc/Slang-Tests/SlangInliningTest.class.st b/smalltalksrc/Slang-Tests/SlangInliningTest.class.st deleted file mode 100644 index 7aac1a9887..0000000000 --- a/smalltalksrc/Slang-Tests/SlangInliningTest.class.st +++ /dev/null @@ -1,656 +0,0 @@ -Class { - #name : 'SlangInliningTest', - #superclass : 'SLAbstractTranslationTestCase', - #instVars : [ - 'sLInliner' - ], - #category : 'Slang-Tests', - #package : 'Slang-Tests' -} - -{ #category : 'inlining-simple' } -SlangInliningTest >> test2ChainInlining [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodC. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: '/* SLMockInliningTestClass>>#methodC */ -static sqInt -methodC(void) -{ - 3 + 3; - /* begin methodA */ - 1 + 1; - /* begin methodB */ - 2 + 2; - /* end methodB */ - /* end methodA */ - return 0; -}' -] - -{ #category : 'inlining-assignment' } -SlangInliningTest >> test2ChainInliningAssignOnReturn [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodCAssignOnReturn. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: '/* SLMockInliningTestClass>>#methodCAssignOnReturn */ -static sqInt -methodCAssignOnReturn(void) -{ - sqInt a; - - 3 + 3; - /* begin methodAAssignOnReturn */ - 1 + 1; - a = 2 + 2; - /* end methodAAssignOnReturn */ - return 0; -}' -] - -{ #category : 'inline-arguments' } -SlangInliningTest >> test2ChainInliningEmptyMethodAWithSimpleArgumentsInlined [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #emptyMethodAWithSimpleArgumentsInlined. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#emptyMethodAWithSimpleArgumentsInlined */ -static sqInt -emptyMethodAWithSimpleArgumentsInlined(void) -{ - sqInt arg; - - /* begin emptyMethod: */ - arg = 2 + 2; - /* end emptyMethod: */ - return 0; -}' -] - -{ #category : 'inline-arguments' } -SlangInliningTest >> test2ChainInliningMethodAWithArgumentsInlined [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodAWithArgumentsInlined. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAWithArgumentsInlined */ -static sqInt -methodAWithArgumentsInlined(void) -{ - return methodB((3 + 3, /* begin methodA */ 1 + 1, /* begin methodB */ 2 + 2 /* end methodB */ /* end methodA */)); -}' -] - -{ #category : 'inline-arguments' } -SlangInliningTest >> test2ChainInliningMethodAWithReturningSendArgumentsInlined [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodAWithReturningSendArgumentsInlined. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAWithReturningSendArgumentsInlined */ -static sqInt -methodAWithReturningSendArgumentsInlined(void) -{ - return methodB((3 + 3, /* begin methodA */ 1 + 1, /* begin methodB */ 2 + 2 /* end methodB */ /* end methodA */)); -}' -] - -{ #category : 'inline-arguments' } -SlangInliningTest >> test2ChainInliningMethodAWithSimpleArgumentsInlined [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodAWithSimpleArgumentsInlined. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAWithSimpleArgumentsInlined */ -static sqInt -methodAWithSimpleArgumentsInlined(void) -{ - methodB(2 + 2); - return 0; -}' -] - -{ #category : 'inlining-jump' } -SlangInliningTest >> test2ChainInliningMultipleReturn [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodAMultipleReturn. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: '/* SLMockInliningTestClass>>#methodAMultipleReturn */ -static sqInt -methodAMultipleReturn(void) -{ - /* begin methodBMultipleReturn */ - if (methodB()) { - goto l3; - } - /* begin methodCMultipleReturn */ - if (methodC()) { - goto l2; - } - 3 + 3; - l2: - ; - /* end methodCMultipleReturn */ - 2 + 2; - l3: - ; - /* end methodBMultipleReturn */ - return 1 + 1; -}' -] - -{ #category : 'inlining-jump' } -SlangInliningTest >> test2ChainInliningMultipleReturnAsAssignmentExpression [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: - #methodAMultipleReturnAsAssignmentExpression. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAMultipleReturnAsAssignmentExpression */ -static sqInt -methodAMultipleReturnAsAssignmentExpression(void) -{ - sqInt x; - - /* begin methodBMultipleReturn */ - if (methodB()) { - x = 0; - goto l3; - } - /* begin methodCMultipleReturn */ - if (methodC()) { - goto l2; - } - 3 + 3; - l2: - ; - /* end methodCMultipleReturn */ - x = 2 + 2; - l3: - ; - /* end methodBMultipleReturn */ - return 0; -}' -] - -{ #category : 'inlining-jump' } -SlangInliningTest >> test2ChainInliningMultipleReturnAsReturnExpression [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodAMultipleReturnAsReturnExpression. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAMultipleReturnAsReturnExpression */ -static sqInt -methodAMultipleReturnAsReturnExpression(void) -{ - /* begin methodBMultipleReturn */ - if (methodB()) { - return 0; - } - /* begin methodCMultipleReturn */ - if (methodC()) { - goto l2; - } - 3 + 3; - l2: - ; - /* end methodCMultipleReturn */ - return 2 + 2; - /* end methodBMultipleReturn */ -}' -] - -{ #category : 'inlining-assignment' } -SlangInliningTest >> test2ChainInliningReturnOnAssignment [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodCReturnOnAssignment. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: '/* SLMockInliningTestClass>>#methodCReturnOnAssignment */ -static sqInt -methodCReturnOnAssignment(void) -{ - sqInt var; - int var2; - sqInt x; - - 3 + 3; - /* begin methodAReturnOnAssignment */ - 1 + 1; - /* begin methodBReturnOnAssignment: */ - var2 = 2 + 2; - return (var = var2); - /* end methodBReturnOnAssignment: */ - /* end methodAReturnOnAssignment */ -}' -] - -{ #category : 'inlining-jump' } -SlangInliningTest >> test2ChainInliningSimpleReturn [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodASimpleReturn. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: '/* SLMockInliningTestClass>>#methodASimpleReturn */ -static sqInt -methodASimpleReturn(void) -{ - /* begin methodBSimpleReturn */ - 3 + 3; - 2 + 2; - /* end methodBSimpleReturn */ - return 1 + 1; -}' -] - -{ #category : 'collect-statements-for-inlining' } -SlangInliningTest >> testCollectStatementsForInliningInMethodWithAvoidedSelector [ - "this method collect statements list for inlining, some specific selectors have special comportment regarding inlining strategy like avoiding inlining he receiver or the some arguments" - - | method statementsForInlining | - method := ccg methodNamed: #methodWithAvoidedSelectors. - sLInliner currentMethod: method. - sLInliner codeGenerator: ccg. - - statementsForInlining := sLInliner - statementsListsForInliningInCurrentMethod. - self assert: statementsForInlining size equals: 6. -] - -{ #category : 'inlining-simple' } -SlangInliningTest >> testInlineInSwitchRemovesReturnStatement [ - - | method codeGenerator methodToBeInlined theSwitch firstCaseConstantExpression firstCase firstCaseLabels | - method := (Spur64BitMemoryManager lookupSelector: - #numSlotsForShortening:toIndexableSize:) - asTranslationMethodOfClass: TMethod. - methodToBeInlined := (Spur64BitMemoryManager lookupSelector: - #arrayFormat) asTranslationMethodOfClass: - TMethod. - - codeGenerator := CCodeGeneratorGlobalStructure new. - codeGenerator addMethod: method. - codeGenerator addMethod: methodToBeInlined. - codeGenerator prepareMethods. - codeGenerator inferTypes. - codeGenerator doInlining: true. - - theSwitch := method parseTree children first expression. - firstCase := theSwitch cases first. - firstCaseLabels := firstCase first. - "The first case should have a single label" - self assert: firstCaseLabels size equals: 1. - firstCaseConstantExpression := firstCaseLabels first. - self assert: firstCaseConstantExpression parent equals: theSwitch -] - -{ #category : 'inlining-assignment' } -SlangInliningTest >> testMethodAInlineIfFalseReturningIfTrueInAssignement [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: - #methodAInlineIfFalseReturningIfTrueInAssignement. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAInlineIfFalseReturningIfTrueInAssignement */ -static sqInt -methodAInlineIfFalseReturningIfTrueInAssignement(void) -{ - sqInt a; - - /* begin methodBIfFalseReturningIfTrue */ - if (methodB()) { - a = 0; - goto l2; - } else { - } - a = 1; - l2: - ; - /* end methodBIfFalseReturningIfTrue */ - return 0; -}' -] - -{ #category : 'inlining-assignment' } -SlangInliningTest >> testMethodAInlineMultipleIfFalseReturningIfTrueInAssignment [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: - #methodAInlineMultipleIfFalseReturningIfTrueInAssignment. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAInlineMultipleIfFalseReturningIfTrueInAssignment */ -static sqInt -methodAInlineMultipleIfFalseReturningIfTrueInAssignment(void) -{ - sqInt a; - - if (methodB()) { - /* begin methodBIfFalseReturningIfTrue */ - if (methodB()) { - a = 0; - goto l3; - } else { - } - a = 1; - l3: - ; - /* end methodBIfFalseReturningIfTrue */ - } - else { - /* begin methodBIfFalseReturningIfTrue */ - if (methodB()) { - a = 0; - goto l2; - } else { - } - a = 1; - l2: - ; - /* end methodBIfFalseReturningIfTrue */ - } - return 0; -}' -] - -{ #category : 'inlining-returning-conditional' } -SlangInliningTest >> testMethodAInlineReturningIfTrue [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodAInlineReturningIfTrueInReturn. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAInlineReturningIfTrueInReturn */ -static sqInt -methodAInlineReturningIfTrueInReturn(void) -{ - return ((methodB()) - ? 1 - : 0); -}' -] - -{ #category : 'inlining-assignment' } -SlangInliningTest >> testMethodAInlineReturningIfTrueIfFalseInAssignment [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: - #methodAInlineReturningIfTrueIfFalseInAssignment. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAInlineReturningIfTrueIfFalseInAssignment */ -static sqInt -methodAInlineReturningIfTrueIfFalseInAssignment(void) -{ - sqInt a; - - a = ((methodB()) - ? 1 - : 2); - return 0; -}' -] - -{ #category : 'inlining-returning-conditional' } -SlangInliningTest >> testMethodAInlineReturningIfTrueIfFalseInReturn [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: - #methodAInlineReturningIfTrueIfFalseInReturn. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAInlineReturningIfTrueIfFalseInReturn */ -static sqInt -methodAInlineReturningIfTrueIfFalseInReturn(void) -{ - return ((methodB()) - ? 1 - : 2); -}' -] - -{ #category : 'inlining-assignment' } -SlangInliningTest >> testMethodAInlineReturningIfTrueInAssignment [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: - #methodAInlineReturningIfTrueInAssignment. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAInlineReturningIfTrueInAssignment */ -static sqInt -methodAInlineReturningIfTrueInAssignment(void) -{ - sqInt a; - - a = ((methodB()) - ? 1 - : 0); - return 0; -}' -] - -{ #category : 'inlining-assignment' } -SlangInliningTest >> testMethodAInlineReturningInlinedIfTrueInAssignment [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: - #methodAInlineReturningInlinedIfTrueInAssignment. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAInlineReturningInlinedIfTrueInAssignment */ -static sqInt -methodAInlineReturningInlinedIfTrueInAssignment(void) -{ - sqInt a; - - a = ((methodB()) - ? (/* begin methodB */ 2 + 2 /* end methodB */) - : 0); - return 0; -}' -] - -{ #category : 'inlining-returning-conditional' } -SlangInliningTest >> testMethodAInlineifFalseReturningIfTrueInReturn [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: - #methodAInlineIfFalseReturningIfTrueInReturn. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: - '/* SLMockInliningTestClass>>#methodAInlineIfFalseReturningIfTrueInReturn */ -static sqInt -methodAInlineIfFalseReturningIfTrueInReturn(void) -{ - /* begin methodBIfFalseReturningIfTrue */ - if (methodB()) { - return 0; - } else { - } - return 1; - /* end methodBIfFalseReturningIfTrue */ -}' -] - -{ #category : 'inlining-assignment' } -SlangInliningTest >> testMethodAReturnAssignment [ - - | method translation | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodAReturnAssignment. - - translation := self translate: method. - translation := translation trimBoth. - - self - assert: translation - equals: '/* SLMockInliningTestClass>>#methodAReturnAssignment */ -static sqInt -methodAReturnAssignment(void) -{ - sqInt a; - - return (a = methodB()); -}' -] - -{ #category : 'inlining-simple' } -SlangInliningTest >> testSimpleInlining [ - - | method sendStatements | - ccg doBasicInlining: true. - - method := ccg methodNamed: #methodA. - - sendStatements := method parseTree statements select: #isSend. - self assert: sendStatements size equals: 2. - self assert: sendStatements first selector equals: #+. - self assert: sendStatements second selector equals: #+ - - -] diff --git a/smalltalksrc/Slang/CCodeGenerator.class.st b/smalltalksrc/Slang/CCodeGenerator.class.st index cf7ceb2c5a..37972c8396 100644 --- a/smalltalksrc/Slang/CCodeGenerator.class.st +++ b/smalltalksrc/Slang/CCodeGenerator.class.st @@ -43,7 +43,9 @@ Class { 'castTranslationDict', 'castAsArgumentTranslationDict', 'wordSize', - 'structInstanceVariableTranslations' + 'structInstanceVariableTranslations', + 'inlineStrategy', + 'inliner' ], #classVars : [ 'NoRegParmsInAssertVMs' @@ -1026,11 +1028,9 @@ CCodeGenerator >> doBasicInlining: inlineFlagOrSymbol [ "Inline the bodies of all methods that are suitable for inlining. This method does only the basic inlining suitable for both the core VM and plugins - no bytecode inlining etc" - | pass progress inliner | + | pass progress | self collectInlineList: inlineFlagOrSymbol. - inliner := SLInliner new - codeGenerator: self; - yourself. + pass := 0. progress := true. [ progress ] whileTrue: [ "repeatedly attempt to inline methods until no further progress is made" @@ -3177,6 +3177,7 @@ CCodeGenerator >> initAutoLocalizationOfVariablesIn: selector [ { #category : 'initialize-release' } CCodeGenerator >> initialize [ + translationDict := Dictionary new. inlineList := Array new. constants := Dictionary new: 100. @@ -3190,7 +3191,9 @@ CCodeGenerator >> initialize [ useSymbolicConstants := true. generateDeadCode := true. scopeStack := OrderedCollection new. - logger := (ProvideAnswerNotification new tag: #logger; signal) ifNil: [Transcript]. + logger := (ProvideAnswerNotification new + tag: #logger; + signal) ifNil: [ Transcript ]. pools := IdentitySet new. selectorTranslations := IdentityDictionary new. structInstanceVariableTranslations := IdentityDictionary new. @@ -3199,9 +3202,13 @@ CCodeGenerator >> initialize [ previousCommenter := nil. breakSrcInlineSelectors := IdentitySet new. breakDestInlineSelectors := IdentitySet new. - + stopOnErrors := false. - wordSize := 4 + wordSize := 4. + + inliner := SLInlinerWithAnnotation new + codeGenerator: self; + yourself ] { #category : 'C translation support' } @@ -3443,6 +3450,17 @@ CCodeGenerator >> inlineDispatchesInMethodNamed: selector [ method: m ] ] ] +{ #category : 'inlining' } +CCodeGenerator >> inlineStrategy: aSLInlineStrategy [ + + inlineStrategy := aSLInlineStrategy +] + +{ #category : 'accessing' } +CCodeGenerator >> inliner: anInlineStrategy [ + inliner := anInlineStrategy +] + { #category : 'utilities' } CCodeGenerator >> instVarNamesForClass: aClass [ ^ aClass instVarNames diff --git a/smalltalksrc/Slang/MLStatementListBuider.class.st b/smalltalksrc/Slang/MLStatementListBuider.class.st index 281701a71d..95107fdd98 100644 --- a/smalltalksrc/Slang/MLStatementListBuider.class.st +++ b/smalltalksrc/Slang/MLStatementListBuider.class.st @@ -65,23 +65,30 @@ MLStatementListBuider >> addStatement: aStatement [ ] { #category : 'transforming' } -MLStatementListBuider >> assignLastExpressionOf: aNode toVariable: aTVariableNode [ - +MLStatementListBuider >> assignLastExpressionOf: aNode toVariable: aTVariableNode [ "We need to take the expression and find its last expression recursively. We should rewrite it to add an assignment to its last expression" - + | worklist | worklist := OrderedCollection with: aNode. - [ worklist isEmpty ] whileFalse: [ | current | + [ worklist isEmpty ] whileFalse: [ + | current | current := worklist removeLast. - current isStatementList ifTrue: [ - worklist add: current lastNonCommentStatement - ] ifFalse: [ | replacement parentBeforeReplacement | + current isStatementList + ifTrue: [ + worklist add: current lastNonCommentOrGoToOrLabelStatement ] + ifFalse: [ + | replacement parentBeforeReplacement | self flag: #polymorphism. parentBeforeReplacement := current parent. replacement := (current isSend and: [ current isConditionalSend ]) - ifTrue: [ self transformControlFlowNodeForValue: current withVariable: aTVariableNode copy ] - ifFalse: [ current assignLastExpressionTo: aTVariableNode copy ]. + ifTrue: [ + self + transformControlFlowNodeForValue: current + withVariable: aTVariableNode copy ] + ifFalse: [ + current assignLastExpressionTo: + aTVariableNode copy ]. parentBeforeReplacement replaceChild: current with: replacement ] ]. ^ aNode ] diff --git a/smalltalksrc/Slang/RBCascadeNode.extension.st b/smalltalksrc/Slang/RBCascadeNode.extension.st index a9de1f2aff..ff42b80d52 100644 --- a/smalltalksrc/Slang/RBCascadeNode.extension.st +++ b/smalltalksrc/Slang/RBCascadeNode.extension.st @@ -21,6 +21,6 @@ RBCascadeNode >> asTranslatorNodeIn: aTMethod [ expression: receiverNode). receiverNode := varNode]. messages do: - [ :msg | s nextPut: ((msg asTranslatorNodeIn: aTMethod) receiver: receiverNode)]]); + [ :msg | s nextPut: ((msg asTranslatorNodeIn: aTMethod) receiver: receiverNode copy)]]); comment: self commentOrNil ] diff --git a/smalltalksrc/Slang/SLInliner.class.st b/smalltalksrc/Slang/SLInliner.class.st index 6acf08cd31..a38724dd8f 100644 --- a/smalltalksrc/Slang/SLInliner.class.st +++ b/smalltalksrc/Slang/SLInliner.class.st @@ -51,12 +51,6 @@ SLInliner >> codeGenerator [ ^ codeGenerator ] -{ #category : 'accessing' } -SLInliner >> codeGenerator: aCodeGenerator [ - - codeGenerator := aCodeGenerator -] - { #category : 'accessing' } SLInliner >> currentMethod [ @@ -73,7 +67,6 @@ SLInliner >> currentMethod: aTMethod [ SLInliner >> doInliningIn: aTMethod [ self currentMethod: aTMethod. - self codeGenerator: codeGenerator. ^ self tryToInlineMethodsInCurrentMethod ] @@ -467,10 +460,12 @@ SLInliner >> isInlineableConditional: aSendNode [ { #category : 'inlining-decision' } SLInliner >> isInlineableFunctionCall: aNode [ - "Answer if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted." + "Answer if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted. + if a method is marked as always inlined and complete, the method also returns true" codeGenerator maybeBreakForTestToInline: aNode in: self. aNode isSend ifFalse: [ ^ false ]. + ^ (codeGenerator methodNamed: aNode selector) ifNil: [ aNode asTransformedConstantPerform @@ -494,9 +489,11 @@ SLInliner >> isInlineableSend: aNode [ | m | codeGenerator maybeBreakForTestToInline: aNode in: self. aNode isSend ifFalse: [ ^ false ]. + m := codeGenerator methodNamed: aNode selector. "nil if builtin or external function" + ^ m isNotNil and: [ - m ~~ self and: [ + m ~~ currentMethod and: [ m mayBeInlined and: [ (m isComplete and: [ codeGenerator mayInline: m selector ]) or: [ m checkForRequiredInlinability ] ] ] ] @@ -789,6 +786,7 @@ SLInliner >> tryToInlineMethodsInCurrentMethod [ "marking a method complete is progress" currentMethod isComplete ifFalse: [ self checkForCompletenessFor: currentMethod. - currentMethod isComplete ifTrue: [ didSomething := true ] ]. "marking a method complete is progress" + currentMethod isComplete ifTrue: [ didSomething := true ] ]. + ^ didSomething ] diff --git a/smalltalksrc/Slang/SLInlinerWithAnnotation.class.st b/smalltalksrc/Slang/SLInlinerWithAnnotation.class.st new file mode 100644 index 0000000000..557e4eef39 --- /dev/null +++ b/smalltalksrc/Slang/SLInlinerWithAnnotation.class.st @@ -0,0 +1,1229 @@ +Class { + #name : 'SLInlinerWithAnnotation', + #superclass : 'SLAbstractInlineStrategy', + #instVars : [ + 'currentMethod', + 'sLNodeAnnotatorVisitor', + 'sendsForInlining', + 'conditionalForInlining', + 'performSendForInlining' + ], + #category : 'Slang', + #package : 'Slang' +} + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> addBeginAndEndCommentsFor: aTStatementList selector: aSelector exitLabel: aLabel [ + + aTStatementList addFirst: + (TLabeledCommentNode new setComment: 'begin ' , aSelector). + aLabel + ifNotNil: [ + aTStatementList addLast: + (TLabeledCommentNode new + setLabel: aLabel + comment: 'end ' , aSelector) ] + ifNil: [ + aTStatementList addLast: + (TLabeledCommentNode new setComment: 'end ' , aSelector) ] +] + +{ #category : 'preparation-function-call' } +SLInlinerWithAnnotation >> addToConditionalInlining: aSendNode [ + + | indexesToRemove | + (self isInlineableConditional: aSendNode) ifFalse: [ ^ self ]. + + indexesToRemove := OrderedCollection new. + sendsForInlining doWithIndex: [ :dictionary :index | + (dictionary values includes: aSendNode receiver) ifTrue: [ + indexesToRemove add: index ] ]. + + sendsForInlining := sendsForInlining reject: [ :dictionary | + dictionary values includes: aSendNode receiver ]. + + sendsForInlining add: (IdentityDictionary new + at: self conditionalInliningString put: aSendNode; + yourself) +] + +{ #category : 'preparation-function-call' } +SLInlinerWithAnnotation >> addToPerformSendlInlining: aSendNode from: anOtherSendNode [ + + sendsForInlining add: (IdentityDictionary new + at: self functionCallFromBuitinInliningString + put: anOtherSendNode -> aSendNode; + yourself) +] + +{ #category : 'preparation-function-call' } +SLInlinerWithAnnotation >> addToSendlInlining: aSendNode [ + + sendsForInlining add: (IdentityDictionary new + at: self functionCallInliningString put: aSendNode; + yourself) +] + +{ #category : 'preparation' } +SLInlinerWithAnnotation >> annotateCurrentMethod [ + + sLNodeAnnotatorVisitor cleanInfo. + sLNodeAnnotatorVisitor visit: currentMethod parseTree +] + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> argAssignmentsFor: meth send: aSendNode except: elidedArgs [ + "Return a collection of assignment nodes that assign the given argument expressions to the formal parameter variables of the given method." + + "Optimization: If the actual parameters are either constants or local variables in the target method (the receiver), substitute them directly into the body of meth. Note that global variables cannot be subsituted because the inlined method might depend on the exact ordering of side effects to the globals." + + | stmtList substitutionDict argList | + meth args size > (argList := aSendNode arguments) size ifTrue: [ + self assert: (meth args first beginsWith: 'self_in_'). + argList := { aSendNode receiver } , aSendNode arguments ]. + + stmtList := OrderedCollection new: argList size. + substitutionDict := Dictionary new: argList size. + meth args with: argList do: [ :argName :exprNode | + (currentMethod + isNode: exprNode + substitutableFor: argName + inMethod: meth + in: codeGenerator) + ifTrue: [ + substitutionDict at: argName put: (codeGenerator + node: exprNode + typeCompatibleWith: argName + inliningInto: meth + in: currentMethod). + + currentMethod + removeLocal: argName + ifAbsent: [ self assert: (argName beginsWith: 'self_in_') ]. + currentMethod declarations removeKey: argName ifAbsent: nil ] + ifFalse: [ "Add an assignment for anything except an unused self_in_foo argument" + (elidedArgs includes: argName) ifFalse: [ + stmtList addLast: (TAssignmentNode new + setVariable: (TVariableNode new setName: argName) + expression: (codeGenerator + node: exprNode copy + typeCompatibleWith: argName + inliningInto: meth + in: currentMethod)) ] ] ]. + + meth parseTree addAllFirst: stmtList. + ^ substitutionDict +] + +{ #category : 'preparation-function-call-string' } +SLInlinerWithAnnotation >> builtinString [ + + ^ #builtinString +] + +{ #category : 'testing-node' } +SLInlinerWithAnnotation >> canBeInlineInExpression: aNode replacement: aTMethod [ + "for now" + + | parseTree | + (sLNodeAnnotatorVisitor isInSend: aNode) ifFalse: [ ^ true ]. + parseTree := aTMethod parseTree. + ^ sLNodeAnnotatorVisitor + do: [ + (sLNodeAnnotatorVisitor hasGotoOrMultipleReturn: parseTree) not ] + visit: parseTree +] + +{ #category : 'testing-method' } +SLInlinerWithAnnotation >> checkForCompletenessFor: aTMethod [ + "Set the complete flag if the parse tree contains no further candidates for inlining." + + | foundIncompleteSend stmtsForInlining | + codeGenerator maybeBreakForTestOfInliningOf: aTMethod selector. + stmtsForInlining := self statementsListsForInliningInCurrentMethod. + self fillSendForInliningInCurrentMethod. + (sendsForInlining isNotEmpty or: [ stmtsForInlining isNotEmpty ]) + ifTrue: [ ^ self ]. + foundIncompleteSend := false. + + + aTMethod parseTree + nodesDo: [ :node | + (node isSend and: [ node selector ~= currentMethod selector ]) + ifTrue: [ + (aTMethod + methodIsEffectivelyComplete: node selector + in: codeGenerator) ifFalse: [ foundIncompleteSend := true ] ] ] + unless: [ :node | + node isSend and: [ + node selector == #cCode:inSmalltalk: or: [ + codeGenerator isAssertSelector: node selector ] ] ]. + foundIncompleteSend ifFalse: [ aTMethod complete: true ] +] + +{ #category : 'testing-method' } +SLInlinerWithAnnotation >> checkForFlagIn: aTStatementList [ + + (aTStatementList sizeWithoutComments > 1 and: [ + |firstStatement| + firstStatement := aTStatementList firstNonCommentStatement. +firstStatement isSend and: [ + firstStatement selector == #flag: ] ]) + ifTrue: [ aTStatementList removeFirstNonCommentStatement ] +] + +{ #category : 'accessing' } +SLInlinerWithAnnotation >> codeGenerator [ + + ^ codeGenerator +] + +{ #category : 'preparation-function-call-string' } +SLInlinerWithAnnotation >> conditionalInliningString [ + + ^ #conditionalInliningString +] + +{ #category : 'accessing' } +SLInlinerWithAnnotation >> currentMethod [ + + ^ currentMethod +] + +{ #category : 'accessing' } +SLInlinerWithAnnotation >> currentMethod: aTMethod [ + + currentMethod := aTMethod +] + +{ #category : 'inlining' } +SLInlinerWithAnnotation >> doInliningIn: aTMethod [ + + self currentMethod: aTMethod. + ^ self tryToInlineMethodsInCurrentMethod +] + +{ #category : 'preparation' } +SLInlinerWithAnnotation >> ensureConditionalAssignmentsAreTransformedInCurrentMethod [ + "Make passes transforming + foo := expr ifTrue: [a] ifFalse: [b] + into + expr ifTrue: [foo := a] ifFalse: [foo := b] + until no such instances exist in the tree. This is needed for correct inlining + given the limitations of inlineCodeOrNilForStatement:returningNodes:in:" + + | transformedAssignments | + [ + transformedAssignments := Dictionary new. + currentMethod parseTree + nodesDo: [ :node | + (self transformConditionalAssignment: node) ifNotNil: [ + :replacement | transformedAssignments at: node put: replacement ] ] + unless: [ :node | "Don't inline the arguments to asserts to keep the asserts readable" + node isSend and: [ + node selector == #cCode:inSmalltalk: or: [ + codeGenerator isAssertSelector: node selector ] ] ]. + transformedAssignments notEmpty and: [ + currentMethod replaceNodesIn: transformedAssignments. + true ] ] whileTrue +] + +{ #category : 'preparation-function-call' } +SLInlinerWithAnnotation >> fillConditionalSendOrTryPerformSearchForInlining: aNode transformedConstantFrom: originalNodeForVisitorInfo [ + + aNode asTransformedConstantPerform + ifNil: [ self addToConditionalInlining: aNode ] + ifNotNil: [ :node | "when going through transformation, the new node n take the place of aNode but not in the visitor so we keep track of the old node " + self + fillSendForInlining: node + transformedConstantFrom: originalNodeForVisitorInfo ] +] + +{ #category : 'preparation-function-call' } +SLInlinerWithAnnotation >> fillSendForInlining: aNode [ + + ^ self fillSendForInlining: aNode transformedConstantFrom: nil +] + +{ #category : 'preparation-function-call' } +SLInlinerWithAnnotation >> fillSendForInlining: aNode transformedConstantFrom: anOtherNodeOrNil [ + "Answer if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted. + if a method is marked as always inlined and complete, the method also returns true" + + | originalNodeForVisitorInfo tMethod | + codeGenerator maybeBreakForTestToInline: aNode in: self. + aNode isSend ifFalse: [ ^ false ]. + + originalNodeForVisitorInfo := anOtherNodeOrNil + ifNil: [ aNode ] + ifNotNil: [ anOtherNodeOrNil ]. + tMethod := codeGenerator methodNamed: aNode selector. + tMethod ifNil: [ + self + fillConditionalSendOrTryPerformSearchForInlining: aNode + transformedConstantFrom: originalNodeForVisitorInfo. + ^ self ]. + self + fillSendOrPerformSendForInlining: aNode + method: tMethod + transformedConstantFrom: originalNodeForVisitorInfo +] + +{ #category : 'preparation-function-call' } +SLInlinerWithAnnotation >> fillSendForInliningInCurrentMethod [ + + sendsForInlining := OrderedCollection new. + + currentMethod parseTree + nodesDo: [ :node | self fillSendForInlining: node ] + unless: [ :node | "Don't inline the arguments to asserts to keep the asserts readable" + node isSend and: [ + node selector == #cCode:inSmalltalk: or: [ + codeGenerator isAssertSelector: node selector ] ] ] +] + +{ #category : 'preparation-function-call' } +SLInlinerWithAnnotation >> fillSendOrPerformSendForInlining: aNode method: aTMethod transformedConstantFrom: originalNodeForVisitorInfo [ + + | isInlineableSend | + isInlineableSend := (aTMethod ~~ currentMethod and: [ + ((self isFunctional: aTMethod) or: [ + aTMethod mustBeInlined and: [ + aTMethod isComplete ] ]) and: [ + aTMethod mayBeInlined and: [ + (codeGenerator mayInline: aTMethod selector) + and: [ + (aNode arguments allSatisfy: [ :a | + self + isSubstitutableNode: a + intoMethod: aTMethod ]) and: [ + self + canBeInlineInExpression: + originalNodeForVisitorInfo + replacement: aTMethod ] ] ] ] ]) or: [ + aTMethod checkForRequiredInlinability ]. + isInlineableSend ifFalse: [ ^ self ]. + aNode == originalNodeForVisitorInfo + ifTrue: [ self addToSendlInlining: aNode ] + ifFalse: [ + self + addToPerformSendlInlining: aNode + from: originalNodeForVisitorInfo ] +] + +{ #category : 'preparation-statement' } +SLInlinerWithAnnotation >> filterStmtForInliningIn: tStmtListNodeLists [ + + | stmtsList | + stmtsList := OrderedCollection new. + tStmtListNodeLists do: [ :tStmtList | + tStmtList statements do: [ :stmt | + | expression | + expression := stmt. + (stmt isReturn or: [ stmt isAssignment ]) ifTrue: [ + expression := stmt expression ]. + + (self isInlineableSend: expression) ifTrue: [ + stmtsList add: expression ] ] ]. + + ^ stmtsList +] + +{ #category : 'preparation-function-call-string' } +SLInlinerWithAnnotation >> functionCallFromBuitinInliningString [ + + ^ #functionCallFromBuitinInliningString +] + +{ #category : 'preparation-function-call-string' } +SLInlinerWithAnnotation >> functionCallInliningString [ + + ^ #functionCallInliningString +] + +{ #category : 'initialization' } +SLInlinerWithAnnotation >> initialize [ + + super initialize. + sLNodeAnnotatorVisitor := SLNodeAnnotatorVisitor new +] + +{ #category : 'conditional' } +SLInlinerWithAnnotation >> inlineConditional: aSendNode [ + "If possible answer the inlining of a conditional, otherwise answer nil. + Currently the only pattern we support is + aSend ifTrue:/ifFalse: [...] + where aSend is marked inline and always answers booleans." + + self assert: (self isInlineableConditional: aSendNode). + self assert: aSendNode arguments first isStatementList. + ^ (aSendNode arguments first sizeWithoutComments = 1 and: [ + aSendNode arguments first lastNonCommentStatement isReturn ]) + ifTrue: [ self inlineReturningConditional: aSendNode ] + ifFalse: [ self inlineGuardingConditional: aSendNode ] +] + +{ #category : 'conditional' } +SLInlinerWithAnnotation >> inlineConditionalGuardingOrConditionalInit: aSendNode isGuarding: isGuarding [ + "init data for inlining conditional" + + | data | + self assert: currentMethod == codeGenerator currentMethod. + self assert: (self isInlineableConditional: aSendNode). + codeGenerator maybeBreakForInlineOf: aSendNode in: self. + + data := Dictionary new. + data at: #isIfTrue put: aSendNode selector = #ifTrue:. + + data + at: #method + put: (codeGenerator methodNamed: aSendNode receiver selector) copy. + + self + inlineFunctionCall: aSendNode receiver + inInlineableConditional: true. + + data at: #returnReplacement put: (isGuarding + ifTrue: [ + TLabeledCommentNode new setLabel: + (currentMethod unusedLabelForInlining: (data at: #method)) ] + ifFalse: [ aSendNode arguments first ]). + + ^ data +] + +{ #category : 'function-call' } +SLInlinerWithAnnotation >> inlineFunctionCall: aSendNode [ + + ^ self + inlineFunctionCall: aSendNode + inInlineableConditional: false + fromBuiltin: nil +] + +{ #category : 'function-call' } +SLInlinerWithAnnotation >> inlineFunctionCall: aSendNode fromBuiltin: aNOdeOrNil [ + + ^ self + inlineFunctionCall: aSendNode + inInlineableConditional: false + fromBuiltin: aNOdeOrNil +] + +{ #category : 'function-call' } +SLInlinerWithAnnotation >> inlineFunctionCall: aSendNode inInlineableConditional: aBoolean [ + + ^ self + inlineFunctionCall: aSendNode + inInlineableConditional: aBoolean + fromBuiltin: nil +] + +{ #category : 'function-call' } +SLInlinerWithAnnotation >> inlineFunctionCall: aSendNode inInlineableConditional: aBoolean fromBuiltin: aNodeOrNil [ + "Answer the body of the called function, substituting the actual + parameters for the formal argument variables in the method body. + Assume caller has established that: + 1. the method arguments are all substitutable nodes, and + 2. the method to be inlined contains no additional embedded returns." + + | selector meth parametersToReplaceByArgument argsForInlining substitutionDict parseTree | + selector := aSendNode selector. + meth := (codeGenerator methodNamed: selector) copy. + + parseTree := meth parseTree. + parametersToReplaceByArgument := Set withAll: currentMethod args. + argsForInlining := aSendNode argumentsForInliningCodeGenerator: + codeGenerator. + meth args with: argsForInlining do: [ :argName :exprNode | + exprNode isLeaf ifTrue: [ + parametersToReplaceByArgument add: argName ] ]. + self checkForFlagIn: parseTree. + + self + renameVarsAndLabelsForInliningIntoCurrentMethodOf: meth + except: parametersToReplaceByArgument. + + substitutionDict := Dictionary new: meth args size * 2. + meth args with: argsForInlining do: [ :argName :exprNode | + substitutionDict at: argName put: exprNode. + (parametersToReplaceByArgument includes: argName) ifFalse: [ + currentMethod removeLocal: argName ] ]. + parseTree bindVariablesIn: substitutionDict. + "copyWithoutReturn does it implictly, avoid duplicating them and in addition if meth end up in an expressionList, they won't appear which might cause bug, + see asCASTIn: vs asCASTExpressionIn: for stmtList. + " + meth locals: Set new. + aBoolean ifFalse: [ SLNodeAnnotatorVisitor copyWithoutReturn: meth ]. + + "same 'optimization' as before but with comments if possible" + (parseTree children size = 1 and: [ aBoolean not ]) + ifTrue: [ + meth parseTree: parseTree last. + parseTree := parseTree last ] + ifFalse: [ + self + addBeginAndEndCommentsFor: parseTree + selector: selector + exitLabel: nil ]. + + "visiting is done just after" + aBoolean ifTrue: [ + aSendNode parent replaceChild: aSendNode with: parseTree. + ^ self ]. + sLNodeAnnotatorVisitor + visitFromBranchStartingAt: (aNodeOrNil ifNil: [ aSendNode ]) + replacement: parseTree +] + +{ #category : 'conditional' } +SLInlinerWithAnnotation >> inlineGuardingConditional: aSendNode [ + "Inline + aSend ifTrue:/ifFalse: [statements] + where aSend is inlineable and always answers booleans. We convert + the boolean returns in aSend to jumps." + + | data evaluateIfTrue replacementTree map lastNode evaluateLabel skipLabel selector inlineStmts skipLabelStmt | + selector := aSendNode receiver selector. + + data := self + inlineConditionalGuardingOrConditionalInit: aSendNode + isGuarding: true. + evaluateIfTrue := data at: #isIfTrue. + replacementTree := aSendNode receiver. + skipLabel := data at: #returnReplacement. + map := Dictionary new. + + (replacementTree lastExpression allSatisfy: [ :node | + node isReturn and: [ node expression value = evaluateIfTrue ] ]) + ifTrue: [ lastNode := replacementTree lastExpression ]. + + replacementTree nodesDo: [ :node | + | expr | + node isReturn ifTrue: [ + expr := node expression. + self assert: + (expr isConstant and: [ #( true false ) includes: expr value ]). + map at: node put: (expr value ~~ evaluateIfTrue + ifTrue: [ TGoToNode label: skipLabel label ] + ifFalse: [ + (lastNode isNotNil and: [ lastNode includes: node ]) + ifTrue: [ + TLabeledCommentNode new setComment: + 'end ' , selector , '; fall through' ] + ifFalse: [ + evaluateLabel ifNil: [ + evaluateLabel := TLabeledCommentNode new setLabel: + (currentMethod unusedLabelForInlining: + (data at: #method)) ]. + TGoToNode label: evaluateLabel label ] ]) ] ]. + + data at: #map put: map. + self replaceNodeIn: aSendNode with: data. + + replacementTree isComment ifTrue: [ + replacementTree statements: { }. + skipLabel := nil ]. + (replacementTree sizeWithoutComments = 1 and: [ + replacementTree lastNonCommentStatement label = skipLabel label ]) + ifTrue: [ + replacementTree statements: { }. + aSendNode arguments first statements: { }. + skipLabel := nil ]. + + skipLabelStmt := skipLabel + ifNotNil: [ { skipLabel } ] + ifNil: [ { } ]. + inlineStmts := TStatementListNode new + setArguments: #( ) + statements: (evaluateLabel + ifNil: [ + replacementTree statements + , aSendNode arguments first statements + , skipLabelStmt ] + ifNotNil: [ + replacementTree statements , { evaluateLabel } + , aSendNode arguments first statements + , skipLabelStmt ]). + + sLNodeAnnotatorVisitor + visitFromBranchStartingAt: aSendNode + replacement: inlineStmts +] + +{ #category : 'conditional' } +SLInlinerWithAnnotation >> inlineReturningConditional: aSendNode [ + "Inline + aSend ifTrue:/ifFalse: [^expr] + where aSend is inlineable and always answers booleans. We inline ^expr + into aSend." + + | data returnIfTrue returnNode replacementTree map lastNode label selector inlineStmts | + selector := aSendNode receiver selector. + data := self + inlineConditionalGuardingOrConditionalInit: aSendNode + isGuarding: false. + returnIfTrue := data at: #isIfTrue. + replacementTree := aSendNode receiver. + returnNode := data at: #returnReplacement. + map := Dictionary new. + + "The last node is either a return or a boolean constant." + lastNode := replacementTree lastNonCommentStatement. + lastNode isReturn + ifTrue: [ + lastNode expression value == returnIfTrue ifTrue: [ + lastNode := nil "i.e. take the fall-through path and /don't/ return" ] ] + ifFalse: [ + self assert: + (lastNode isConstant and: [ + #( true false ) includes: lastNode value ]). + lastNode value == returnIfTrue ifTrue: [ "i.e. /do/ return" + map at: lastNode put: returnNode ] ]. + replacementTree nodesDo: [ :node | + | expr | + node isReturn ifTrue: [ + expr := node expression. + self assert: + (expr isConstant and: [ #( true false ) includes: expr value ]). + map at: node put: (expr value == returnIfTrue + ifTrue: [ returnNode ] + ifFalse: [ + node == lastNode + ifTrue: [ + TLabeledCommentNode new setComment: + 'end ' , selector , '; fall through' ] + ifFalse: [ + label ifNil: [ + label := TLabeledCommentNode new setLabel: + (currentMethod unusedLabelForInlining: + (data at: #method)) ]. + TGoToNode label: label label ] ]) ] ]. + + data at: #map put: map. + self replaceNodeIn: aSendNode with: data. + + inlineStmts := label ifNil: [ replacementTree ] ifNotNil: [ + TStatementListNode new + setArguments: #( ) + statements: { + replacementTree. + label } ]. + + sLNodeAnnotatorVisitor + visitFromBranchStartingAt: aSendNode + replacement: inlineStmts +] + +{ #category : 'statement' } +SLInlinerWithAnnotation >> inlineSend: aSendNode [ + "Answer a collection of statements to replace the given send. directReturn indicates + that the send is the expression in a return statement, so returns can be left in the + body of the inlined method. If exitVar is nil, the value returned by the send is not + used; thus, returns need not assign to the output variable. + + Types are propagated to as-yet-untyped variables when inlining a send that is assigned, + otherwise the assignee variable type must match the return type of the inlinee. Return + types are not propagated." + + | selector callee exitLabel inlineStmts omittedParameters calleeParameters exitVar directReturn isUsedExpression assigningParent argumentsSubstitutionDict | + selector := aSendNode selector. + callee := codeGenerator methodNamed: selector. + directReturn := sLNodeAnnotatorVisitor isEffectiveReturnValue: + aSendNode. + (sLNodeAnnotatorVisitor isEffectiveAssignmentValue: aSendNode) + ifTrue: [ + assigningParent := sLNodeAnnotatorVisitor assigningParentFor: + aSendNode. + exitVar := assigningParent variable name ]. + "for goTo in block management" + isUsedExpression := (sLNodeAnnotatorVisitor isEffectiveExpression: + aSendNode) and: [ + directReturn not and: [ + exitVar isNil or: [ + sLNodeAnnotatorVisitor isEffectiveExpression: + assigningParent ] ] ]. + + "convenient for debugging..." + codeGenerator maybeBreakForInlineOf: aSendNode in: self. + + [ :res | + omittedParameters := res first. + calleeParameters := res second ] value: + (self trimArgumentsIn: callee). + calleeParameters size = aSendNode arguments size ifFalse: [ ^ self ]. + callee := callee copy. + inlineStmts := callee parseTree. + + self checkForFlagIn: inlineStmts. + + self + propagateReturnTypeDirectReturn: directReturn + exitVar: exitVar + callee: callee. + self + propagateArgumentTypeArguments: calleeParameters + in: callee + from: aSendNode. + + self + renameVarsAndLabelsForInliningIntoCurrentMethodOf: callee + except: omittedParameters. + + exitLabel := self + replaceReturnWithGoToIfNeededIn: callee + directReturn: directReturn. + + argumentsSubstitutionDict := self + argAssignmentsFor: callee + send: aSendNode + except: omittedParameters. + + self + addBeginAndEndCommentsFor: inlineStmts + selector: selector + exitLabel: exitLabel. + + inlineStmts isComment ifTrue: [ "Nuke empty methods; e.g. override of flushAtCache" + inlineStmts statements: OrderedCollection new ]. + + self + moveDownReturnsAndAssignmentsFor: aSendNode + including: inlineStmts. + self replaceVariableIn: argumentsSubstitutionDict for: inlineStmts. + + isUsedExpression ifFalse: [ + inlineStmts nodesDo: [ :node | + node isGoTo ifTrue: [ node indicateAnExitPointInlined ] ] ] +] + +{ #category : 'testing-node' } +SLInlinerWithAnnotation >> isConditionalToBeTransformedForAssignment: aSend [ + "Answer if a send is of the form + e1 + ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] + ifFalse: [self m3] + such that at least one of the sends mN may be inlined.." + + ^ (#( #ifTrue:ifFalse: #ifFalse:ifTrue: ) includes: aSend selector) + and: [ + aSend arguments anySatisfy: [ :arg | + | stmt | + self assert: arg isStatementList. + arg statements size > 1 or: [ + (stmt := arg firstNonCommentStatement) isSwitch or: [ + stmt isSend and: [ + (codeGenerator mayInline: stmt selector) or: [ + self isConditionalToBeTransformedForAssignment: stmt ] ] ] ] ] ] +] + +{ #category : 'testing-method' } +SLInlinerWithAnnotation >> isFunctional: aTMethod [ + "Answer if the receiver is a functional method. That is, if it + consists of a single return statement of an expression or an assert or flag followed by + such a statement. + + Answer false for methods with return types other than the simple + integer types to work around bugs in the inliner." + + | parseTree last size | + parseTree := aTMethod parseTree. + size := parseTree sizeWithoutComments. + + size = 1 ifFalse: [ + (size = 2 and: [ + | first | + first := parseTree firstNonCommentStatement. + first isSend and: [ + first selector == #flag: or: [ + (codeGenerator isAssertSelector: first selector) and: [ + first selector ~~ #asserta: ] ] ] ]) ifFalse: [ ^ false ] ]. + last := parseTree lastNonCommentStatement. + (last isReturn or: [ + sLNodeAnnotatorVisitor + do: [ sLNodeAnnotatorVisitor isReturningIf: last ] + visit: last ]) ifFalse: [ ^ false ]. + + ^ #( int #'unsigned int' #long #'unsigned long' #'long long' + #'unsigned long long' sqInt usqInt #sqIntptr_t #usqIntptr_t + sqLong usqLong #'int *' #'unsigned int *' #'sqInt *' #'usqInt *' + #'sqLong *' #'usqLong *' #'char *' #'CogMethod *' #'AbstractInstruction *' + #'FILE *' ) includes: aTMethod returnType +] + +{ #category : 'testing-node' } +SLInlinerWithAnnotation >> isInlineableConditional: aSendNode [ + "Answer if the given send node is of the form aSend [ifTrue:|ifFalse:] [statements] + where the method for aSend is marked as inline and all returns within it answer booleans." + + | method | + ^ (#( ifTrue: ifFalse: ) includes: aSendNode selector) and: [ + aSendNode receiver isSend and: [ + (method := codeGenerator anyMethodNamed: + aSendNode receiver selector) notNil and: [ + method inline == true and: [ + method parseTree lastNonCommentStatement isReturn and: [ + method parseTree allSatisfy: [ :node | + node isReturn not or: [ + node expression isDefine not and: [ + node expression isConstant and: [ + #( true false ) includes: node expression value ] ] ] ] ] ] ] ] ] +] + +{ #category : 'testing-node' } +SLInlinerWithAnnotation >> isInlineableFunctionCall: aNode [ + + ^ self isInlineableFunctionCall: aNode transformedConstantFrom: nil +] + +{ #category : 'testing-node' } +SLInlinerWithAnnotation >> isInlineableFunctionCall: aNode transformedConstantFrom: anOtherNodeOrNil [ + "Answer if the given send node is a call to a 'functional' method--a method whose body is a single return statement of some expression and whose actual parameters can all be directly substituted. + if a method is marked as always inlined and complete, the method also returns true" + + | nodeForVisitorInfo | + codeGenerator maybeBreakForTestToInline: aNode in: self. + aNode isSend ifFalse: [ ^ false ]. + nodeForVisitorInfo := anOtherNodeOrNil + ifNil: [ aNode ] + ifNotNil: [ anOtherNodeOrNil ]. + ^ (codeGenerator methodNamed: aNode selector) + ifNil: [ + aNode asTransformedConstantPerform + ifNil: [ self isInlineableConditional: aNode ] + ifNotNil: [ :n | "when going through transformation, the new node n take the place of aNode but not in the visitor so we keep track of the old node " + self + isInlineableFunctionCall: n + transformedConstantFrom: nodeForVisitorInfo ] ] + ifNotNil: [ :m | + (m ~~ currentMethod and: [ + ((m isFunctionalIn: codeGenerator) or: [ + m mustBeInlined and: [ m isComplete ] ]) and: [ + m mayBeInlined and: [ + (codeGenerator mayInline: m selector) and: [ + (aNode arguments allSatisfy: [ :a | + self isSubstitutableNode: a intoMethod: m ]) and: [ + self + canBeInlineInExpression: nodeForVisitorInfo + replacement: m ] ] ] ] ]) or: [ + m checkForRequiredInlinability ] ] +] + +{ #category : 'testing-node' } +SLInlinerWithAnnotation >> isInlineableSend: aNode [ + "Answer if the given expresssion node is a call to a method that can be inlined." + + | m | + codeGenerator maybeBreakForTestToInline: aNode in: self. + aNode isSend ifFalse: [ ^ false ]. + + m := codeGenerator methodNamed: aNode selector. "nil if builtin or external function" + m ifNil: [ ^ false ]. + + ^ m ~~ currentMethod and: [ + m mayBeInlined and: [ + (m isComplete and: [ + (codeGenerator mayInline: m selector) and: [ + self canBeInlineInExpression: aNode replacement: m ] ]) or: [ + m checkForRequiredInlinability ] ] ] +] + +{ #category : 'testing-node' } +SLInlinerWithAnnotation >> isSubstitutableNode: aNode intoMethod: targetMeth [ + "Answer true if the given parameter node is either a constant, a local variable, or a formal parameter of the receiver. Such parameter nodes may be substituted directly into the body of the method during inlining. Note that global variables cannot be subsituted into methods with possible side effects (i.e., methods that may assign to global variables) because the inlined method might depend on having the value of the global variable captured when it is passed in as an argument." + + | var | + aNode isConstant ifTrue: [ ^ true ]. + + aNode isVariable ifTrue: [ + var := aNode name. + ((currentMethod locals includes: var) or: [ + currentMethod args includes: var ]) ifTrue: [ ^ true ]. + var = #self ifTrue: [ ^ true ]. + (targetMeth maySubstituteGlobal: var in: codeGenerator) ifTrue: [ + ^ true ] ]. + + "For now allow literal blocks to be substituted. They better be accessed only + with value[:value:*] messages though!" + aNode isStatementList ifTrue: [ ^ true ]. + + (aNode isSend and: [ + codeGenerator isStructAccessorWithNoSideEffect: aNode ]) ifTrue: [ + ^ true ]. + + "scan expression tree; must contain only constants, builtin ops, and inlineable vars" + aNode nodesDo: [ :node | + node isSend ifTrue: [ + ((codeGenerator isBuiltinSelector: node selector) or: [ + codeGenerator isStructAccessorWithNoSideEffect: node ]) ifFalse: [ + ^ false ] ]. + node isVariable ifTrue: [ + var := node name. + ((currentMethod locals includes: var) or: [ + (currentMethod args includes: var) or: [ + var = #self or: [ + targetMeth maySubstituteGlobal: var in: codeGenerator ] ] ]) + ifFalse: [ ^ false ] ]. + (node isConstant or: [ node isVariable or: [ node isSend ] ]) + ifFalse: [ ^ false ] ]. + + ^ true +] + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> label: exitLabel for: aTMethod [ + "Replace each return statement in this method with an assignment to the + exit variable followed by either a return or a goto to the given label. + Answer if a goto was generated." + + "Optimization: If exitVar is nil, the return value of the inlined method is not being used, so don't add the assignment statement." + + | labelUsed map eliminateReturnSelfs definingClass | + labelUsed := false. + map := Dictionary new. + + "Conceivably one might ^self from a struct class and mean it. In most cases though + ^self means `get me outta here, fast'. So unless this method is from a VMStruct class, + elide any ^self's" + definingClass := aTMethod definingClass. + eliminateReturnSelfs := ((definingClass inheritsFrom: SlangClass) + and: [ definingClass isStructClass ]) not + and: [ + #( #void #sqInt ) includes: + aTMethod returnType ]. + + aTMethod parseTree nodesDo: [ :node | + | replacement | + node isReturn ifTrue: [ + aTMethod + transformReturnSubExpression: node + toAssignmentOf: nil + andGoto: exitLabel + unless: eliminateReturnSelfs + into: [ :rep :labelWasUsed | + replacement := rep. + labelWasUsed ifTrue: [ labelUsed := true ] ]. + + map at: node put: (replacement ifNil: [ + TLabeledCommentNode new setComment: + 'return ' , node expression printString ]) ] ]. + map isEmpty ifTrue: [ + aTMethod deny: labelUsed. + ^ false ]. + + "Now do a top-down replacement for all returns that should be mapped to assignments and gotos" + aTMethod parseTree replaceNodesIn: map. + + "Now flatten any new statement lists..." + aTMethod parseTree nodesDo: [ :node | + | list | + (node isStatementList and: [ + node isComment not and: [ + node lastNonCommentStatement isStatementList ] ]) ifTrue: [ + list := node lastNonCommentStatement statements. + node replaceChild: node lastNonCommentStatement withList: list ] ]. + ^ labelUsed +] + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> moveDownReturnsAndAssignmentsFor: aSendNode including: aTStatementList [ + + sLNodeAnnotatorVisitor + visitFromBranchStartingAt: aSendNode + replacement: aTStatementList. + + sLNodeAnnotatorVisitor moveDownAssigningParentFrom: aTStatementList. + sLNodeAnnotatorVisitor moveDownReturningParentFrom: aTStatementList +] + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> propagateArgumentTypeArguments: calleeParameters in: callee from: aSendNode [ + "Propagate any unusual argument types to untyped argument variables" + + calleeParameters with: aSendNode arguments do: [ :formal :actual | + (callee declarationAt: formal ifAbsent: nil) ifNil: [ + | type | + (actual isVariable and: [ + (type := currentMethod typeFor: actual name in: codeGenerator) + notNil ]) ifTrue: [ + type ~= #sqInt ifTrue: [ + callee declarationAt: formal put: (type last = $* + ifTrue: [ type , formal ] + ifFalse: [ type , ' ' , formal ]) ] ] ] ] +] + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> propagateReturnTypeDirectReturn: directReturn exitVar: exitVar callee: callee [ + "Propagate the return type of an inlined method" + + | exitType | + (directReturn or: [ exitVar notNil ]) ifFalse: [ ^ self ]. + exitType := directReturn + ifTrue: [ currentMethod returnType ] + ifFalse: [ + (currentMethod typeFor: exitVar in: codeGenerator) + ifNil: [ #sqInt ] ]. + (exitType = #void or: [ exitType = callee returnType ]) ifFalse: [ + callee propagateReturnIn: codeGenerator ] +] + +{ #category : 'preparation-statement' } +SLInlinerWithAnnotation >> removeNonSupportedStmtForInliningIn: stmtLists [ + + currentMethod parseTree nodesDo: [ :node | + node isSend ifTrue: [ + node selector = #cCode:inSmalltalk: ifTrue: [ + node nodesDo: [ :ccisNode | + stmtLists remove: ccisNode ifAbsent: [ ] ] ]. + node selector = #cCall: ifTrue: [ + node nodesDo: [ :ccisNode | + stmtLists remove: ccisNode ifAbsent: [ ] ] ]. + node selector = #cCall:withArguments: ifTrue: [ + node nodesDo: [ :ccisNode | + stmtLists remove: ccisNode ifAbsent: [ ] ] ]. + (#( #cppIf:ifTrue:ifFalse: #cppIf:ifTrue: ) includes: node selector) + ifTrue: [ + node arguments first nodesDo: [ :inCondNode | + stmtLists remove: inCondNode ifAbsent: [ ] ] ]. + (#( #and: #or: ) includes: node selector) ifTrue: [ "Note: the PP 2.3 compiler produces two arg nodes for these selectors" + stmtLists remove: node arguments first ifAbsent: [ ]. + stmtLists remove: node arguments last ifAbsent: [ ] ]. + (#( #ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue: + #ifNil: #ifNotNil: #ifNil:ifNotNil: #ifNotNil:ifNil: ) + includes: node selector) ifTrue: [ + stmtLists remove: node receiver ifAbsent: [ ] ]. + (#( whileTrue whileTrue: whilefalse whileFalse: ) includes: + node selector) ifTrue: [ "Allow inlining if it is a [...] whileTrue/whileFalse. + This is identified by having more than one statement in the + receiver block in which case the C code wouldn't work anyways" + node receiver sizeWithoutComments = 1 ifTrue: [ + stmtLists remove: node receiver ifAbsent: [ ] ] ]. + node selector = #to:do: ifTrue: [ + stmtLists remove: node receiver ifAbsent: [ ]. + stmtLists remove: node args first ifAbsent: [ ] ]. + node selector = #to:by:do: ifTrue: [ + stmtLists remove: node receiver ifAbsent: [ ]. + stmtLists remove: node arguments first ifAbsent: [ ]. + stmtLists remove: node arguments second ifAbsent: [ ] ] ]. + node isCaseStmt ifTrue: [ "don't inline cases" + node cases do: [ :case | stmtLists remove: case ifAbsent: [ ] ] ] ] +] + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> renameVarsAndLabelsForInliningIntoCurrentMethodOf: aTMethod except: varsToNotRename [ + + aTMethod + renameVarsForInliningInto: currentMethod + except: varsToNotRename + in: codeGenerator. + aTMethod renameLabelsForInliningInto: currentMethod. + currentMethod + addVarsDeclarationsAndLabelsOf: aTMethod + except: varsToNotRename +] + +{ #category : 'conditional' } +SLInlinerWithAnnotation >> replaceNodeIn: aSendNode with: data [ + + | method | + method := data at: #method. + + self replaceNodesIn: (data at: #map) for: aSendNode receiver. + + currentMethod + addVarsDeclarationsAndLabelsOf: method + except: method args +] + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> replaceNodesIn: aReplacementDictionary for: aNode [ + + | replacement | + aReplacementDictionary isEmpty ifTrue: [ ^ self ]. + aNode nodesDo: [ :node | + (aReplacementDictionary + at: node + ifPresent: [ true ] + ifAbsent: [ false ]) ifTrue: [ + replacement := (aReplacementDictionary at: node) copy. + node parent replaceChild: node with: replacement ] ] +] + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> replaceReturnWithGoToIfNeededIn: callee directReturn: directReturn [ + + | exitLabel | + callee hasReturn + ifTrue: [ + directReturn ifFalse: [ + exitLabel := currentMethod unusedLabelForInliningInto: + currentMethod. + (self label: exitLabel for: callee) + ifTrue: [ currentMethod labels add: exitLabel ] + ifFalse: [ "is label used?" ^ nil ] ] ] + ifFalse: [ + callee parseTree addLast: (TConstantNode new setValue: nil) ]. + ^ exitLabel +] + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> replaceVariableIn: aReplacementDictionary for: aNode [ + + | replacement | + aReplacementDictionary isEmpty ifTrue: [ ^ self ]. + aNode nodesDo: [ :node | + (node isVariable and: [ + aReplacementDictionary + at: node name + ifPresent: [ true ] + ifAbsent: [ false ] ]) ifTrue: [ + replacement := (aReplacementDictionary at: node name) copy. + + sLNodeAnnotatorVisitor + visitFromBranchStartingAt: node + replacement: replacement. + sLNodeAnnotatorVisitor moveDownAssigningParentFrom: replacement ] ] +] + +{ #category : 'preparation-statement' } +SLInlinerWithAnnotation >> statementsListsForInliningInCurrentMethod [ + "Answer a collection of statement list nodes that are candidates for inlining. + Currently, we cannot inline into the argument blocks of and: and or: messages. + We do not want to inline code strings within cCode:inSmalltalk: blocks (those with a + proper block for the cCode: argument are inlined in MessageNode>>asTranslatorNodeIn:). + We do not want to inline code within assert: sends (because we want the assert to read nicely)." + + | tStmtListNodeLists | + tStmtListNodeLists := OrderedCollection new: 10. + + currentMethod parseTree + nodesDo: [ :node | + node isStatementList ifTrue: [ tStmtListNodeLists add: node ] ] + unless: [ :node | + node isSend and: [ + node selector == #cCode:inSmalltalk: or: [ + node selector == #cCall: or: [ + node selector == #cCall:withArguments: or: [ + codeGenerator isAssertSelector: node selector ] ] ] ] ]. + + self removeNonSupportedStmtForInliningIn: tStmtListNodeLists. + + ^ self filterStmtForInliningIn: tStmtListNodeLists +] + +{ #category : 'preparation' } +SLInlinerWithAnnotation >> transformConditionalAssignment: node [ + "If possible answer the transformation of code of the form + var := e1 + ifTrue: [e2 ifTrue: [self m1] ifFalse: [self m2]] + ifFalse: [self m3] + into + e1 + ifTrue: [e2 ifTrue: [var := self m1] ifFalse: [var := self m2]] + ifFalse: [var := self m3] + to allow inlining of m1, m2, et al. Otherwise answer nil." + + | expr | + ^ (node isAssignment and: [ + (expr := node expression) isSend and: [ + (#( #ifTrue:ifFalse: #ifFalse:ifTrue: ) includes: expr selector) + and: [ self isConditionalToBeTransformedForAssignment: expr ] ] ]) + ifTrue: [ + expr copy + arguments: (expr arguments collect: [ :stmtList | + stmtList copy assignLastExpressionTo: node variable ]); + yourself ] +] + +{ #category : 'transformation' } +SLInlinerWithAnnotation >> trimArgumentsIn: aTMethod [ + + | calleeParameters omittedParameters varNode | + calleeParameters := aTMethod args. + omittedParameters := #( ). + (calleeParameters notEmpty and: [ + calleeParameters first beginsWith: 'self_in_' ]) ifFalse: [ + ^ OrderedCollection new + add: omittedParameters; + add: calleeParameters; + yourself ]. + "If the first arg is not used we can and should elide it." + varNode := TVariableNode new setName: calleeParameters first. + (aTMethod parseTree noneSatisfy: [ :node | varNode isSameAs: node ]) + ifTrue: [ omittedParameters := { calleeParameters first } ]. + + calleeParameters := calleeParameters allButFirst. + ^ OrderedCollection new + add: omittedParameters; + add: calleeParameters; + yourself +] + +{ #category : 'inlining' } +SLInlinerWithAnnotation >> tryToInlineMethodExpressionsInCurrentMethod [ + "Expand any (complete) inline methods sent by this method as receivers or parameters. + Answer if anything was inlined." + + self fillSendForInliningInCurrentMethod. + sendsForInlining isEmpty ifTrue: [ ^ false ]. + + codeGenerator pushScope: currentMethod while: [ + sendsForInlining do: [ :dictionary | + dictionary at: self functionCallInliningString ifPresent: [ + self inlineFunctionCall: + (dictionary at: self functionCallInliningString) ]. + dictionary + at: self functionCallFromBuitinInliningString + ifPresent: [ + | nodes | + nodes := dictionary at: self functionCallFromBuitinInliningString. + self inlineFunctionCall: nodes value fromBuiltin: nodes key ]. + dictionary at: self conditionalInliningString ifPresent: [ + self inlineConditional: + (dictionary at: self conditionalInliningString) ] ] ]. + + ^ true +] + +{ #category : 'inlining' } +SLInlinerWithAnnotation >> tryToInlineMethodStatementsListsInCurrentMethod [ + "Expand any (complete) inline methods sent by this method as top-level statements. + Answer if anything was inlined." + + | stmtLists | + stmtLists := self statementsListsForInliningInCurrentMethod. + stmtLists isEmpty ifTrue: [ ^ false ]. + + stmtLists do: [ :stmt | self inlineSend: stmt ]. + + ^ true +] + +{ #category : 'inlining' } +SLInlinerWithAnnotation >> tryToInlineMethodsInCurrentMethod [ + "Expand any (complete) inline methods sent by this method. + Set the complete flag when all inlining has been done. + Answer if something was inlined." + + | didSomething | + currentMethod definedAsMacro ifTrue: [ + currentMethod isComplete ifTrue: [ ^ false ]. + ^ currentMethod complete: true ]. + + currentMethod isComplete ifTrue: [ ^ false ]. + + self ensureConditionalAssignmentsAreTransformedInCurrentMethod. + self annotateCurrentMethod. + didSomething := self tryToInlineMethodStatementsListsInCurrentMethod. + didSomething := self tryToInlineMethodExpressionsInCurrentMethod or: [ + didSomething ]. + + didSomething ifTrue: [ currentMethod writtenToGlobalVarsCache: nil ]. + + "marking a method complete is progress" + currentMethod isComplete ifFalse: [ + self checkForCompletenessFor: currentMethod. + currentMethod isComplete ifTrue: [ didSomething := true ] ]. + + ^ didSomething +] diff --git a/smalltalksrc/Slang/SLNodeAnnotatorVisitor.class.st b/smalltalksrc/Slang/SLNodeAnnotatorVisitor.class.st new file mode 100644 index 0000000000..a3c76c778f --- /dev/null +++ b/smalltalksrc/Slang/SLNodeAnnotatorVisitor.class.st @@ -0,0 +1,1165 @@ +Class { + #name : 'SLNodeAnnotatorVisitor', + #superclass : 'Object', + #instVars : [ + 'info', + 'inExpressionStack', + 'inSendStack', + 'searchForAssignValueStack', + 'searchForReturnValueStack', + 'searchForExpressionValueStack', + 'searchForStmtListValue', + 'currentShouldBePartiallyIgnored' + ], + #category : 'Slang', + #package : 'Slang' +} + +{ #category : 'transformation' } +SLNodeAnnotatorVisitor class >> copyWithoutReturn: aTMethod [ + + | parseTree returns | + parseTree := aTMethod parseTree. + returns := parseTree allReturns. + returns do: [ :return | + return parent replaceChild: return with: return expression ] +] + +{ #category : 'helpers-stack-operation' } +SLNodeAnnotatorVisitor >> activateCurrentSouldBePartiallyIgnored [ + + currentShouldBePartiallyIgnored := true +] + +{ #category : 'annotate' } +SLNodeAnnotatorVisitor >> addAssignmentInfoFor: aNode [ + "when an assignment has been met, the effective exitVar is not all of the nodes in it, often it is just a single node (or more if conditionals) the nodes have a link to theirs assignment + true or nil on the stack indicate if the node is the effective exitVar" + + self + processValueSourceFor: aNode + from: searchForAssignValueStack + constantString: self assignmentString + ignoredString: self isEffectivelyIgnoredInAssignmentString +] + +{ #category : 'annotate' } +SLNodeAnnotatorVisitor >> addReturnInfoFor: aNode [ + "mark the given node has being inside a return expression, it doesn't mean that the node itself is the exit value + true or false on the stack only indicate if the node is the effective value of the returning expression or not" + + self + processValueSourceFor: aNode + from: searchForReturnValueStack + constantString: self returnString + ignoredString: self isEffectivelyIgnoredInReturnString +] + +{ #category : 'annotate' } +SLNodeAnnotatorVisitor >> addToEffectiveExpressionOrNot: aNode [ + + | entry isAnEffectiveExpression isEffectivelyIgnored | + entry := info at: aNode. + isAnEffectiveExpression := false. + isEffectivelyIgnored := false. + + (currentShouldBePartiallyIgnored not and: [ + (self topOfStack: searchForExpressionValueStack) or: [ + self isEffectiveExpression: aNode ] ]) ifTrue: [ + isAnEffectiveExpression := true ]. + + (searchForStmtListValue isNotEmpty and: [ + searchForStmtListValue top key ]) ifTrue: [ + isAnEffectiveExpression := true ]. + + "for stacks restoration" + (currentShouldBePartiallyIgnored and: [ + self topOfStack: searchForExpressionValueStack ]) ifTrue: [ + isEffectivelyIgnored := true ]. + + entry at: self isEffectivelyIgnoredString put: isEffectivelyIgnored. + entry at: self expressionString put: isAnEffectiveExpression +] + +{ #category : 'annotate' } +SLNodeAnnotatorVisitor >> addToFromSearchStmtList: aNode [ + "for stacks restoration only, indicate if we are in a statement or expression list" + + (info at: aNode) + at: self fromSearchStmtListString + put: (searchForStmtListValue isEmpty + ifTrue: [ nil ] + ifFalse: [ searchForStmtListValue top value ]) +] + +{ #category : 'annotate' } +SLNodeAnnotatorVisitor >> addToInExpression: aNode [ + + self + addToInStack: aNode + stack: inExpressionStack + entry: self inExpressionString +] + +{ #category : 'annotate' } +SLNodeAnnotatorVisitor >> addToInSend: aNode [ + + self addToInStack: aNode stack: inSendStack entry: self inSendString +] + +{ #category : 'annotate-helpers' } +SLNodeAnnotatorVisitor >> addToInStack: aNode stack: aStack entry: aString [ + + aStack isEmpty ifTrue: [ ^ self ]. + (info at: aNode) at: aString put: true +] + +{ #category : 'annotate' } +SLNodeAnnotatorVisitor >> annotateNodeState: aNode [ + + | top | + self ensureEntryInInfoDictFor: aNode. + + self addToInExpression: aNode. + self addToInSend: aNode. + + self addReturnInfoFor: aNode. + self addAssignmentInfoFor: aNode. + self addToEffectiveExpressionOrNot: aNode. + + self addToFromSearchStmtList: aNode. + + currentShouldBePartiallyIgnored ifTrue: [ + self deActivateCurrentSouldBePartiallyIgnored. + ^ self ]. + + searchForStmtListValue isEmpty ifTrue: [ ^ self ]. + top := searchForStmtListValue pop. + searchForStmtListValue push: false -> top value +] + +{ #category : 'visiting-main-API-helpers' } +SLNodeAnnotatorVisitor >> assertStacksAreEmpty [ + + self assert: searchForAssignValueStack isEmpty. + self assert: searchForReturnValueStack isEmpty. + self assert: searchForExpressionValueStack isEmpty. + self assert: inExpressionStack isEmpty. + self assert: inSendStack isEmpty. + self assert: searchForStmtListValue isEmpty +] + +{ #category : 'accessing' } +SLNodeAnnotatorVisitor >> assigningParentFor: aNode [ + + ^ self associationValueInfoFor: aNode entry: self assignmentString +] + +{ #category : 'helpers-info-entry-string' } +SLNodeAnnotatorVisitor >> assignmentString [ + + ^ #assignment +] + +{ #category : 'accessing-info-helpers' } +SLNodeAnnotatorVisitor >> associationKeyInfoFor: aNode entry: aString [ + + ^ (info at: aNode) + at: aString + ifPresent: [ :assoc | assoc key ] + ifAbsent: [ false ] +] + +{ #category : 'accessing-info-helpers' } +SLNodeAnnotatorVisitor >> associationValueInfoFor: aNode entry: aString [ + + ^ (info at: aNode) + at: aString + ifPresent: [ :assoc | assoc value ] + ifAbsent: [ nil ] +] + +{ #category : 'accessing-info-helpers' } +SLNodeAnnotatorVisitor >> booleanInfoFor: aNode entry: aString [ + + ^ (info at: aNode) + at: aString + ifPresent: [ :bool | bool ] + ifAbsent: [ false ] +] + +{ #category : 'cleanup' } +SLNodeAnnotatorVisitor >> cleanBranchInfoFrom: aNode [ + + aNode children do: [ :child | + child nodesDo: [ :node | + info at: node ifPresent: [ info removeKey: node ] ] ] +] + +{ #category : 'cleanup' } +SLNodeAnnotatorVisitor >> cleanInfo [ + + self initialize +] + +{ #category : 'cleanup' } +SLNodeAnnotatorVisitor >> cleanInfoAndBranchInfoFrom: aNode [ + + self cleanInfoFrom: aNode. + self cleanBranchInfoFrom: aNode +] + +{ #category : 'cleanup' } +SLNodeAnnotatorVisitor >> cleanInfoFrom: aNode [ + + info removeKey: aNode +] + +{ #category : 'helpers-stack-operation' } +SLNodeAnnotatorVisitor >> deActivateCurrentSouldBePartiallyIgnored [ + + currentShouldBePartiallyIgnored := false +] + +{ #category : 'visiting-main-API' } +SLNodeAnnotatorVisitor >> do: aBlock visit: aNode [ + "do a block after visiting aNode, clean the info after" + + | blockResult | + self visit: aNode. + blockResult := aBlock value. + self cleanInfoAndBranchInfoFrom: aNode. + ^ blockResult +] + +{ #category : 'annotate-helpers' } +SLNodeAnnotatorVisitor >> ensureEntryInInfoDictFor: aNode [ + + info at: aNode ifAbsentPut: [ IdentityDictionary new ] +] + +{ #category : 'helpers-info-entry-string' } +SLNodeAnnotatorVisitor >> expressionString [ + + ^ #expression +] + +{ #category : 'helpers-info-entry-stack-restoration' } +SLNodeAnnotatorVisitor >> fromSearchStmtListString [ + "use for restoration only" + + ^ #fromSearchStmtList +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> giveStacksInfoForMultipleBranches: aCollectionOfNode [ + "re give the informations for each branch after using it" + + | tops size | + tops := OrderedCollection new. + size := aCollectionOfNode size. + aCollectionOfNode doWithIndex: [ :arg :index | + self stacksForSpecificValueHolder do: [ :stack | + stack isEmpty ifFalse: [ tops add: stack top -> stack ] ]. + arg accept: self. + index ~= size ifTrue: [ + tops do: [ :assoc | + assoc value pop. + assoc value push: assoc key ] ] ] +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> handleConditionalSend: aSendNode [ + + aSendNode isConditionalSend ifTrue: [ + self visitConditionalSend: aSendNode. + ^ true ]. + + aSendNode isCppConditional ifTrue: [ + self visitCppConditional: aSendNode. + ^ true ]. + + ^ false +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> handleIterativeSend: aSendNode [ + "in Slang, iterative are not considered as expression but rather as statement to be closer to C" + + aSendNode isUnaryIterativeSend ifTrue: [ + self visitUnaryIterativeSend: aSendNode. + ^ true ]. + + aSendNode isUnaryIterativeSendWithImportantLastStatement ifTrue: [ + self visitUnaryIterativeSendWithImportantLastStatement: aSendNode. + ^ true ]. + + aSendNode isBinaryIterativeSend ifTrue: [ + self visitBinaryIterativeSend: aSendNode. + ^ true ]. + + aSendNode isDoIterativeSend ifTrue: [ + self visitDoIterativeSend: aSendNode. + ^ true ]. + + ^ false +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> hasEffectiveReturnValue: aNode [ + + aNode nodesDo: [ :node | + (self isEffectiveReturnValue: node) ifTrue: [ ^ true ] ]. + ^ false +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> hasGotoOrMultipleReturn: aNode [ + + | returnCounter | + returnCounter := 0. + + ^ self hasGotoOrMultipleReturn: aNode counterBlock: [ :bool | + bool ifTrue: [ returnCounter := returnCounter + 1 ]. + returnCounter ] +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> hasGotoOrMultipleReturn: aNode counterBlock: aBlock [ + + | stopToExplore returnCounter | + aNode children reverseDo: [ :child | + stopToExplore := child isReturn or: [ self isReturningIf: child ]. + returnCounter := aBlock value: stopToExplore. + + (child isGoTo or: [ returnCounter > 1 ]) ifTrue: [ ^ true ]. + stopToExplore ifFalse: [ + ^ self hasGotoOrMultipleReturn: child counterBlock: aBlock ] ]. + ^ false +] + +{ #category : 'helpers-info-entry-string' } +SLNodeAnnotatorVisitor >> inExpressionString [ + "value doesn't actually matter, but the stack need elements" + + ^ #inExpression +] + +{ #category : 'helpers-info-entry-string' } +SLNodeAnnotatorVisitor >> inSendString [ + + ^ #inSend +] + +{ #category : 'initialization' } +SLNodeAnnotatorVisitor >> initialize [ + + super initialize. + + "empty, true or false on top depending of if the parent needs an expression as a dependance" + searchForExpressionValueStack := Stack new. + "either empty or have something on top depending if the children are in the expression of one of their parents" + inExpressionStack := Stack new. + + "similar to inExpression but specific to send" + inSendStack := Stack new. + + "empty or true/false -> returningParent on top depending on if the parent has found its return value or not" + searchForReturnValueStack := Stack new. + + "empty or true/false -> assigningParent on top depending on if the parent has found its assigning value or not" + searchForAssignValueStack := Stack new. + + "StmtList through jump can end up having multiple value point, this stack is re updated when crossing goToNode. + it has true/false -> true/false on top depending on if we are currently searching for one of the values the second boolean indicate if the value of the stmtList is use in the first place so we do not re update the stack if not necessary" + searchForStmtListValue := Stack new. + + "when searching for the deepest node that give the expression value, some nodes can be pass through like conditionals and stmtLists or statement only node (goTos, comments or labels) + inactivate the search... stack" + currentShouldBePartiallyIgnored := false. + + "collect all the informations gathered for a given node" + info := IdentityDictionary new +] + +{ #category : 'helpers-stack-operation' } +SLNodeAnnotatorVisitor >> invalidateSearchStacksAfterReturn [ + "in an expression like a := exp1 ifTrue: [^ exp2] ifFalse: [exp3], the return node must not be simply ignored, it must correct the stacks so the exploration of exp2 does not mark nodes as used expression for the node a := ..." + + | top | + searchForAssignValueStack isNotEmpty ifTrue: [ + top := searchForAssignValueStack pop. + "keeping the assignment does mean that if a goTo is in the return expression it will incorrectly mark it but Slang/C doesnt authorized goTo in return and will not compile so keeping it is safe" + searchForAssignValueStack push: false -> top value ]. + + searchForReturnValueStack isNotEmpty ifTrue: [ + top := searchForReturnValueStack pop. + searchForReturnValueStack push: false -> top value ]. + + searchForStmtListValue isNotEmpty ifFalse: [ ^ false ]. + top := searchForStmtListValue pop. + searchForStmtListValue push: false -> false. + + ^ top value +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> isEffectiveAssignmentValue: aNode [ + + ^ self associationKeyInfoFor: aNode entry: self assignmentString +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> isEffectiveExpression: aNode [ + + ^ (self isEffectiveReturnValue: aNode) or: [ + (self isEffectiveAssignmentValue: aNode) or: [ + self booleanInfoFor: aNode entry: self expressionString ] ] +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> isEffectiveReturnValue: aNode [ + + ^ self associationKeyInfoFor: aNode entry: self returnString +] + +{ #category : 'testing-stack-restoration' } +SLNodeAnnotatorVisitor >> isEffectivelyIgnored: aNode [ + "for stack restoration" + + ^ self booleanInfoFor: aNode entry: self isEffectivelyIgnoredString +] + +{ #category : 'testing-stack-restoration' } +SLNodeAnnotatorVisitor >> isEffectivelyIgnoredInAssignment: aNode [ + "for stack restoration" + + ^ self + booleanInfoFor: aNode + entry: self isEffectivelyIgnoredInAssignmentString +] + +{ #category : 'helpers-info-entry-stack-restoration' } +SLNodeAnnotatorVisitor >> isEffectivelyIgnoredInAssignmentString [ + + ^ #isEffectivelyIgnoredInAssignment +] + +{ #category : 'testing-stack-restoration' } +SLNodeAnnotatorVisitor >> isEffectivelyIgnoredInReturn: aNode [ + "for stack restoration" + + ^ self + booleanInfoFor: aNode + entry: self isEffectivelyIgnoredInReturnString +] + +{ #category : 'helpers-info-entry-stack-restoration' } +SLNodeAnnotatorVisitor >> isEffectivelyIgnoredInReturnString [ + + ^ #isEffectivelyIgnoredInReturn +] + +{ #category : 'helpers-info-entry-stack-restoration' } +SLNodeAnnotatorVisitor >> isEffectivelyIgnoredString [ + + ^ #isEffectivelyIgnored +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> isInAssignment: aNode [ + + ^ self presenceInfoFor: aNode entry: self assignmentString +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> isInExpression: aNode [ + + ^ self presenceInfoFor: aNode entry: self inExpressionString +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> isInReturn: aNode [ + + ^ self presenceInfoFor: aNode entry: self returnString +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> isInSend: aNode [ + + ^ self presenceInfoFor: aNode entry: self inSendString +] + +{ #category : 'testing' } +SLNodeAnnotatorVisitor >> isReturningIf: aNode [ + + | isReturningIf | + isReturningIf := aNode isConditionalSend and: [ + (self isEffectivelyIgnoredInReturn: aNode) or: [ + aNode arguments allSatisfy: [ :arg | + self hasEffectiveReturnValue: arg ] ] ]. + + isReturningIf := isReturningIf or: [ + aNode isCppConditional and: [ + (self isEffectivelyIgnoredInReturn: aNode) or: [ + aNode arguments allButFirst allSatisfy: [ :arg | + self hasEffectiveReturnValue: arg ] ] ] ]. + + ^ isReturningIf +] + +{ #category : 'transformation' } +SLNodeAnnotatorVisitor >> moveDownAssigningParentFrom: aNode [ + "use in inlining to put assignment down the ast : x = { ... exp} -> {x = ... exp}" + + | assignment | + assignment := self assigningParentFor: aNode. + assignment ifNil: [ ^ self ]. + + self moveDownAssignmentFrom: assignment assignment: assignment. + + self + visitFromBranchStartingAt: assignment + replacement: assignment expression +] + +{ #category : 'transformation' } +SLNodeAnnotatorVisitor >> moveDownAssignmentFrom: parentNode assignment: assignmentNode [ + "recursively go throught the ast to transfrom expression of assignment + a = exp ifTrue: [exp] ifFalse [exp] -> ifTrue: [a = exp] ifFalse [a = exp]" + + parentNode children do: [ :child | + ((self isEffectiveAssignmentValue: child) and: [ + (self assigningParentFor: child) == assignmentNode ]) + ifTrue: [ + child parent replaceChild: child with: (TAssignmentNode new + variable: assignmentNode variable copy; + expression: child; + yourself) ] + ifFalse: [ + self moveDownAssignmentFrom: child assignment: assignmentNode. + (self isEffectivelyIgnoredInAssignment: child) ifTrue: [ + self + moveDownSingleBranchConditional: child + newBranch: (TAssignmentNode + variable: assignmentNode variable copy + expression: (TConstantNode value: 0)) ] ] ] +] + +{ #category : 'transformation' } +SLNodeAnnotatorVisitor >> moveDownReturnFrom: parentNode return: returnNode [ + "recursively go throught the ast to move down returnNode + ^ exp ifTrue: [exp] ifFalse [exp] -> ifTrue: [^exp] ifFalse [^exp]" + + parentNode children do: [ :child | + ((self isEffectiveReturnValue: child) and: [ + (self returningParentFor: child) = returnNode ]) + ifTrue: [ + child parent replaceChild: child with: child asReturnNode ] + ifFalse: [ + child isReturn ifTrue: [ "already got a return for this branch" + ^ self ]. + self moveDownReturnFrom: child return: returnNode ] ] +] + +{ #category : 'transformation' } +SLNodeAnnotatorVisitor >> moveDownReturningParentFrom: aNode [ + "use in inlining for redondant return : return {return exp} -> {return exp}" + + | returningParent | + returningParent := self returningParentFor: aNode. + returningParent ifNil: [ ^ self ]. + + self moveDownReturnFrom: returningParent return: returningParent. + + self + visitFromBranchStartingAt: returningParent + replacement: returningParent expression +] + +{ #category : 'transformation-helpers' } +SLNodeAnnotatorVisitor >> moveDownSingleBranchConditional: aNode newBranch: anOtherNode [ + "does nothing is the node isnt a single branch conditional. + when moving down a assignment/return in a single branch conditional, we need to consider the missing branch which Slang would have consider is the conditional was still an argument, see generateCASTIfNotNilAsArgument: for exemple and the other methods related to single conditional as arguments" + + | newSelector | + aNode isSend ifFalse: [ ^ self ]. + + aNode selector = #ifTrue: ifTrue: [ newSelector := #ifTrue:ifFalse: ]. + + aNode selector = #ifFalse: ifTrue: [ newSelector := #ifFalse:ifTrue: ]. + + aNode selector = #ifNotNil: ifTrue: [ + newSelector := #ifNotNil:ifNil: ]. + + + aNode selector = #ifNil: ifTrue: [ + newSelector := #ifNil:ifNotNil:. + anOtherNode expression: aNode receiver ]. + + newSelector ifNotNil: [ + | newArgument last | + newArgument := TStatementListNode statements: { anOtherNode }. + last := aNode arguments first lastNonCommentStatement. + last isGoTo ifTrue: [ ^ self ]. + aNode + selector: newSelector; + arguments: aNode arguments , { newArgument } ] +] + +{ #category : 'accessing-info-helpers' } +SLNodeAnnotatorVisitor >> presenceInfoFor: aNode entry: aString [ + + ^ (info at: aNode) + at: aString + ifPresent: [ true ] + ifAbsent: [ false ] +] + +{ #category : 'annotate-helpers' } +SLNodeAnnotatorVisitor >> processValueSourceFor: aNode from: aStack constantString: constantString ignoredString: ignoredString [ + + | entry assoc isEffectivelyIgnored | + aStack isEmpty ifTrue: [ ^ self ]. + + assoc := aStack top copy. + entry := info at: aNode. + isEffectivelyIgnored := false. + + currentShouldBePartiallyIgnored + ifTrue: [ + assoc key ifTrue: [ + assoc := false -> assoc value. + isEffectivelyIgnored := true ] ] + ifFalse: [ + aStack pop. + aStack push: false -> assoc value ]. + + entry at: ignoredString put: isEffectivelyIgnored. + entry at: constantString put: assoc +] + +{ #category : 'helpers-stack-operation' } +SLNodeAnnotatorVisitor >> pushInExpressionStack [ + "value doesn't matter for this stack " + + inExpressionStack push: true +] + +{ #category : 'helpers-stack-operation' } +SLNodeAnnotatorVisitor >> pushInSendStack [ + "value doesn't matter for this stack " + + inSendStack push: true +] + +{ #category : 'helpers-stack-operation' } +SLNodeAnnotatorVisitor >> resetSearchStacksAfterReturn: hasInvalidateAStmtSearch [ + "unlike other nodes, search in statementList are from bottom to top, so after invalidating the stacks for a return exploration, we need to undo the modification done, meaning we might repush a false -> true on the stmtList stack, true indicating an active search, false indicating that the next node is not an used expression (we're waiting for a jump)" + + | top | + hasInvalidateAStmtSearch ifFalse: [ ^ self ]. + + top := searchForStmtListValue pop. + searchForStmtListValue push: false -> true +] + +{ #category : 'helpers-stack-restoration' } +SLNodeAnnotatorVisitor >> restoreInStacksFrom: aNode [ + + | restoredStacks | + restoredStacks := OrderedCollection new. + (self presenceInfoFor: aNode entry: self inExpressionString) ifTrue: [ + self pushInExpressionStack. + restoredStacks add: inExpressionStack ]. + + (self presenceInfoFor: aNode entry: self inSendString) ifTrue: [ + self pushInSendStack. + restoredStacks add: inSendStack ]. + + ^ restoredStacks +] + +{ #category : 'helpers-stack-restoration' } +SLNodeAnnotatorVisitor >> restoreSearchFoGeneralValueStacksFrom: aNode [ + + | entry restoredStacks | + restoredStacks := OrderedCollection new. + ((self isEffectiveExpression: aNode) or: [ + self isEffectivelyIgnored: aNode ]) ifTrue: [ + searchForExpressionValueStack push: true. + restoredStacks add: searchForExpressionValueStack ]. + + entry := (info at: aNode) at: self fromSearchStmtListString. + entry ifNil: [ ^ restoredStacks ]. + entry + ifFalse: [ searchForStmtListValue push: false -> entry ] + ifTrue: [ + searchForStmtListValue push: + (self topOfStack: searchForExpressionValueStack) -> entry. + searchForExpressionValueStack isNotEmpty + ifTrue: [ searchForExpressionValueStack pop ] + ifFalse: [ restoredStacks add: searchForExpressionValueStack ]. + searchForExpressionValueStack push: false ]. + restoredStacks add: searchForStmtListValue. + + ^ restoredStacks +] + +{ #category : 'helpers-stack-restoration' } +SLNodeAnnotatorVisitor >> restoreSearchForSpecificValueStacksFrom: aNode [ + + | restoredStacks | + restoredStacks := OrderedCollection new. + (self isInReturn: aNode) ifTrue: [ + searchForReturnValueStack push: + ((self isEffectiveReturnValue: aNode) or: [ + self isEffectivelyIgnoredInReturn: aNode ]) + -> (self returningParentFor: aNode). + restoredStacks add: searchForReturnValueStack ]. + + (self isInAssignment: aNode) ifTrue: [ + searchForAssignValueStack push: + ((self isEffectiveAssignmentValue: aNode) or: [ + self isEffectivelyIgnoredInAssignment: aNode ]) + -> (self assigningParentFor: aNode). + restoredStacks add: searchForAssignValueStack ]. + + ^ restoredStacks +] + +{ #category : 'visiting-main-API-helpers' } +SLNodeAnnotatorVisitor >> restoreStackStateFrom: aNode [ + "to just revisit a branch and not the whole AST, we need to restore the different stacks using the info dictionary" + + | restoredStacks | + restoredStacks := OrderedCollection new. + restoredStacks addAll: (self restoreInStacksFrom: aNode). + restoredStacks addAll: + (self restoreSearchForSpecificValueStacksFrom: aNode). + restoredStacks addAll: (self restoreSearchFoGeneralValueStacksFrom: aNode). +" 1 halt." + ^ restoredStacks +] + +{ #category : 'helpers-info-entry-string' } +SLNodeAnnotatorVisitor >> returnString [ + + ^ #return +] + +{ #category : 'accessing' } +SLNodeAnnotatorVisitor >> returningParentFor: aNode [ + + ^ self associationValueInfoFor: aNode entry: self returnString +] + +{ #category : 'accessing' } +SLNodeAnnotatorVisitor >> stacksForSpecificValueHolder [ + + ^ { + searchForAssignValueStack. + searchForReturnValueStack } +] + +{ #category : 'helpers-stack-operation' } +SLNodeAnnotatorVisitor >> topOfStack: aStack [ + "return the top value of a boolean stack" + + ^ aStack isNotEmpty and: [ aStack top ] +] + +{ #category : 'visiting-main-API' } +SLNodeAnnotatorVisitor >> visit: aNode [ + + aNode accept: self. + self assertStacksAreEmpty +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitAssignmentNode: anAssignmentNode [ + + self annotateNodeState: anAssignmentNode. + + searchForExpressionValueStack push: true. + self pushInExpressionStack. + + searchForAssignValueStack push: true -> anAssignmentNode. + + anAssignmentNode expression accept: self. + anAssignmentNode variable accept: self. + + inExpressionStack pop. + searchForExpressionValueStack pop. + + searchForAssignValueStack pop +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> visitBinaryIterativeSend: aSendNode [ + + | hasInvalidateAStmtSearch | + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aSendNode. + + hasInvalidateAStmtSearch := self invalidateSearchStacksAfterReturn. + + self pushInExpressionStack. + searchForExpressionValueStack push: true. + + aSendNode arguments first accept: self. + aSendNode receiver accept: self. + + searchForExpressionValueStack pop. + inExpressionStack pop. + self resetSearchStacksAfterReturn: hasInvalidateAStmtSearch +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitBraceCaseNode: aTBraceCaseNode [ + "shouldn't be reachable in real condition, TBraceCaseNode are translated to switch before going through any operation. + it can be reach throught tests as a side effect since inlining goes for all knowned methods in the codeGenerator even if they are not the tests focuss" + + +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitCaseStatementNode: aCaseStmtNode [ + + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aCaseStmtNode. + + searchForExpressionValueStack push: true. + inExpressionStack push: true. + + self giveStacksInfoForMultipleBranches: aCaseStmtNode cases. + aCaseStmtNode expression accept: self. + + inExpressionStack pop. + searchForExpressionValueStack pop +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> visitConditionalSend: aSendNode [ + "conditionals are control-flow node and thus treated differently from the other sends" + + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aSendNode. + + self giveStacksInfoForMultipleBranches: aSendNode arguments. + + self pushInExpressionStack. + searchForExpressionValueStack push: true. + aSendNode receiver accept: self. + searchForExpressionValueStack pop. + + inExpressionStack pop +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitConstantNode: aConstantNode [ + + self annotateNodeState: aConstantNode +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> visitCppConditional: aSendNode [ + "conditionals are control-flow node and thus treated differently from the other sends" + + | arguments | + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aSendNode. + + arguments := aSendNode arguments. + self giveStacksInfoForMultipleBranches: arguments allButFirst. + + self pushInExpressionStack. + searchForExpressionValueStack push: true. + aSendNode receiver accept: self. + arguments first accept: self. + searchForExpressionValueStack pop. + + inExpressionStack pop +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> visitDoIterativeSend: aSendNode [ + + | arguments hasInvalidateAStmtSearch | + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aSendNode. + + hasInvalidateAStmtSearch := self invalidateSearchStacksAfterReturn. + + self pushInExpressionStack. + searchForExpressionValueStack push: true. + + arguments := aSendNode arguments. + arguments last accept: self. + arguments allButLast do: [ :node | node accept: self ]. + aSendNode receiver accept: self. + + searchForExpressionValueStack pop. + inExpressionStack pop. + self resetSearchStacksAfterReturn: hasInvalidateAStmtSearch +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> visitExitPointSend: aSendNode [ + + | hasInvalidateAStmtSearch | + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aSendNode. + + hasInvalidateAStmtSearch := self invalidateSearchStacksAfterReturn. + searchForExpressionValueStack push: true. + self pushInExpressionStack. + self pushInSendStack. + + aSendNode receiver accept: self. + aSendNode arguments do: [ :arg | arg accept: self ]. + + searchForExpressionValueStack pop. + inExpressionStack pop. + inSendStack pop. + self resetSearchStacksAfterReturn: hasInvalidateAStmtSearch +] + +{ #category : 'visiting-main-API' } +SLNodeAnnotatorVisitor >> visitFromBranchStartingAt: aNode [ + + | restoredStacks | + self cleanBranchInfoFrom: aNode. + restoredStacks := self restoreStackStateFrom: aNode. + self cleanInfoFrom: aNode. + aNode accept: self. + restoredStacks do: [ :stack | stack pop ]. + self assertStacksAreEmpty +] + +{ #category : 'visiting-main-API' } +SLNodeAnnotatorVisitor >> visitFromBranchStartingAt: aNode replacement: aReplacementNode [ + + | restoredStacks | + aNode parent replaceChild: aNode with: aReplacementNode. + + self cleanBranchInfoFrom: aNode. + restoredStacks := self restoreStackStateFrom: aNode. + self cleanInfoFrom: aNode. + aReplacementNode accept: self. + restoredStacks do: [ :stack | stack pop ]. + self assertStacksAreEmpty +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitGoToNode: aTGotoNode [ + + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aTGotoNode. + + (aTGotoNode isAnExitPointInlined or: [ + searchForStmtListValue top value not ]) ifTrue: [ ^ self ]. + + searchForStmtListValue top value ifTrue: [ + searchForStmtListValue pop. + searchForStmtListValue push: true -> true ]. + + self stacksForSpecificValueHolder do: [ :stack | + stack isNotEmpty ifTrue: [ + | top | + top := stack pop. + stack push: true -> top value ] ] +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitInlineNode: anInlineNode [ + + self annotateNodeState: anInlineNode. + + anInlineNode method parseTree accept: self +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitLabeledCommentNode: aLabeledCommentNode [ + + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aLabeledCommentNode +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitReturnNode: aReturnNode [ + + | hasInvalidateAStmtSearch | + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aReturnNode. + + hasInvalidateAStmtSearch := self invalidateSearchStacksAfterReturn. + + searchForExpressionValueStack push: true. + searchForReturnValueStack push: true -> aReturnNode. + self pushInExpressionStack. + + aReturnNode expression accept: self. + + inExpressionStack pop. + searchForExpressionValueStack pop. + searchForReturnValueStack pop. + self resetSearchStacksAfterReturn: hasInvalidateAStmtSearch +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitSendNode: aSendNode [ + + (self visitSpecialSend: aSendNode) ifTrue: [ ^ self ]. + + self annotateNodeState: aSendNode. + + searchForExpressionValueStack push: true. + self pushInExpressionStack. + self pushInSendStack. + + aSendNode receiver accept: self. + aSendNode arguments do: [ :arg | arg accept: self ]. + + searchForExpressionValueStack pop. + inExpressionStack pop. + inSendStack pop +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> visitSpecialSend: aSendNode [ + + (self handleConditionalSend: aSendNode) ifTrue: [ ^ true ]. + + (self handleIterativeSend: aSendNode) ifTrue: [ ^ true ]. + + (aSendNode selector keywords allSatisfy: [ :k | + #( 'value' 'value:' ) includes: k ]) ifTrue: [ + self visitValueExpansionSend: aSendNode. + ^ true ]. + + aSendNode isExitPoint ifTrue: [ self visitExitPointSend: aSendNode ]. + + ^ false +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitStatementListNode: aStatementsListNode [ + + | stmts searchForValue searchForStmtListValueEntry inUsedStmtList | + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aStatementsListNode. + + stmts := aStatementsListNode statements. + + searchForStmtListValueEntry := false -> false. + searchForStmtListValue isNotEmpty ifTrue: [ + searchForStmtListValueEntry := searchForStmtListValue top ]. + searchForValue := (self topOfStack: searchForExpressionValueStack) + or: [ searchForStmtListValueEntry key ]. + "if we are going to met a goTo" + inUsedStmtList := searchForStmtListValueEntry value or: + searchForValue. + + searchForExpressionValueStack push: false. + searchForStmtListValue push: searchForValue -> inUsedStmtList. + stmts reverse do: [ :stmt | stmt accept: self ]. + + searchForExpressionValueStack pop. + searchForStmtListValue pop +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitSwitchStatementNode: aSwitchStatementNode [ + + | caseStatementsAndOtherWiseOrNilCollection | + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aSwitchStatementNode. + + caseStatementsAndOtherWiseOrNilCollection := aSwitchStatementNode + cases collect: [ :case | + case second ]. + aSwitchStatementNode otherwiseOrNil ifNotNil: [ :o | + caseStatementsAndOtherWiseOrNilCollection add: o ]. + + self giveStacksInfoForMultipleBranches: + caseStatementsAndOtherWiseOrNilCollection. + + searchForExpressionValueStack push: true. + self pushInExpressionStack. + + aSwitchStatementNode cases do: [ :case | + | caseLabels | + caseLabels := case first. + + caseLabels do: [ :label | label accept: self ] ]. + + + aSwitchStatementNode expression accept: self. + + inExpressionStack pop. + searchForExpressionValueStack pop +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> visitUnaryIterativeSend: aSendNode [ + + | hasInvalidateAStmtSearch | + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aSendNode. + + hasInvalidateAStmtSearch := self invalidateSearchStacksAfterReturn. + + self pushInExpressionStack. + searchForExpressionValueStack push: true. + + aSendNode receiver accept: self. + + searchForExpressionValueStack pop. + inExpressionStack pop. + self resetSearchStacksAfterReturn: hasInvalidateAStmtSearch +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> visitUnaryIterativeSendWithImportantLastStatement: aSendNode [ + + | hasInvalidateAStmtSearch | + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aSendNode. + + hasInvalidateAStmtSearch := self invalidateSearchStacksAfterReturn. + + self pushInExpressionStack. + searchForExpressionValueStack push: true. + + aSendNode receiver accept: self. + + searchForExpressionValueStack pop. + inExpressionStack pop. + + hasInvalidateAStmtSearch := self invalidateSearchStacksAfterReturn +] + +{ #category : 'visiting-helpers' } +SLNodeAnnotatorVisitor >> visitValueExpansionSend: aSendNode [ + + self activateCurrentSouldBePartiallyIgnored. + self annotateNodeState: aSendNode. + + self pushInExpressionStack. + + searchForExpressionValueStack push: true. + + aSendNode receiver accept: self. + aSendNode arguments do: [ :arg | arg accept: self ]. + + inExpressionStack pop. + + searchForExpressionValueStack pop +] + +{ #category : 'visiting' } +SLNodeAnnotatorVisitor >> visitVariableNode: aVariableNode [ + + self annotateNodeState: aVariableNode +] diff --git a/smalltalksrc/Slang/TAssignmentNode.class.st b/smalltalksrc/Slang/TAssignmentNode.class.st index 2006c6f107..60515bd989 100644 --- a/smalltalksrc/Slang/TAssignmentNode.class.st +++ b/smalltalksrc/Slang/TAssignmentNode.class.st @@ -3,7 +3,8 @@ Class { #superclass : 'TParseNode', #instVars : [ 'variable', - 'expression' + 'expression', + 'metInInlining' ], #category : 'Slang-AST', #package : 'Slang', @@ -260,6 +261,13 @@ TAssignmentNode >> expression: anExpression [ expression parent: self. ] +{ #category : 'initialization' } +TAssignmentNode >> initialize [ + + super initialize. + metInInlining := false +] + { #category : 'testing' } TAssignmentNode >> isAssignment [ diff --git a/smalltalksrc/Slang/TGoToNode.class.st b/smalltalksrc/Slang/TGoToNode.class.st index e7f860455a..b4af9ffe54 100644 --- a/smalltalksrc/Slang/TGoToNode.class.st +++ b/smalltalksrc/Slang/TGoToNode.class.st @@ -2,7 +2,8 @@ Class { #name : 'TGoToNode', #superclass : 'TParseNode', #instVars : [ - 'label' + 'label', + 'indicateAnExitPointInlined' ], #category : 'Slang-AST', #package : 'Slang', @@ -39,6 +40,30 @@ TGoToNode >> children [ ^ #() ] +{ #category : 'accessing' } +TGoToNode >> indicateAnExitPointInlined [ + "goTo only comes from inlining to keep the execution flow correct where a return was. + since inlining goes through multiple phases, static analysis may become flawed, for example : + 'a := [... methodWithReturn … b]' gives 'a = [... c . goTo l ... l ... b]' is equivalent (and should be transform to) '[ ... c . goTo l ... l ... a := b]' + 'a := methodeWithMultipleReturn' gives 'a = [... c . goTo l ... l ... b]' is equivalent (and should be transform to) '[ ... a := c . goTo l ... l ... a := b]' + so after an inlining phases we might invalidate goTo generated so that they do not 'indicate an active exit point' anymore" + + indicateAnExitPointInlined := true +] + +{ #category : 'initialization' } +TGoToNode >> initialize [ + + super initialize. + indicateAnExitPointInlined := false +] + +{ #category : 'accessing' } +TGoToNode >> isAnExitPointInlined [ + + ^ indicateAnExitPointInlined +] + { #category : 'testing' } TGoToNode >> isGoTo [ diff --git a/smalltalksrc/Slang/TMethod.class.st b/smalltalksrc/Slang/TMethod.class.st index 63947d6dc7..f71087915f 100644 --- a/smalltalksrc/Slang/TMethod.class.st +++ b/smalltalksrc/Slang/TMethod.class.st @@ -444,13 +444,6 @@ TMethod >> asInlineNodeInto: atMethod in: aCodeGen [ ^ TInlineNode new method: self ] -{ #category : 'transformations' } -TMethod >> bindClassVariablesIn: constantDictionary [ - "Class variables are used as constants. This method replaces all references to class variables in the body of this method with the corresponding constant looked up in the class pool dictionary of the source class. The source class class variables should be initialized before this method is called." - - self parseTree: (parseTree bindVariablesIn: constantDictionary) -] - { #category : 'transformations' } TMethod >> bindVariableUsesIn: aDictionary [ @@ -2095,7 +2088,7 @@ TMethod >> removeUnusedTempsAndNilIfRequiredIn: aCodeGen [ (d beginsWith: 'extern') or: [ (d beginsWith: 'static') or: [ (d includes: $[) or: [ d includes: $= ] ] ] ]. - parseTree addAllFirst: + parseTree addAllFirstKeepingFirstComments: (readBeforeAssigned asSortedCollection collect: [ :var | | varNode varType zeroNode | varNode := TVariableNode new @@ -2549,31 +2542,31 @@ TMethod >> terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream [ { #category : 'inlining' } TMethod >> transformReturnSubExpression: node toAssignmentOf: exitVar andGoto: exitLabel unless: eliminateReturnSelfs into: aBinaryBlock [ + | expr replacement | - expr := node isReturn ifTrue: [node expression] ifFalse: [node]. - replacement := (expr isVariable "Eliminate ^self's" - and: [expr name = 'self' - and: [eliminateReturnSelfs]]) - ifTrue: [nil] - ifFalse: - [exitVar - ifNil: [expr] - ifNotNil: [TAssignmentNode new - setVariable: (TVariableNode new setName: exitVar) - expression: expr]]. - node == parseTree lastNonCommentStatement - ifTrue: - [aBinaryBlock value: replacement value: false] - ifFalse: - [replacement := replacement - ifNil: [TGoToNode label: exitLabel] - ifNotNil: - [TStatementListNode new - setArguments: #() - statements: {replacement. - TGoToNode label: exitLabel}; - yourself]. - aBinaryBlock value: replacement value: true] + expr := node isReturn + ifTrue: [ node expression ] + ifFalse: [ node ]. + replacement := (expr isVariable and: [ + expr name = 'self' and: [ eliminateReturnSelfs ] ]) + ifTrue: [ nil ] + ifFalse: [ + exitVar ifNil: [ expr ] ifNotNil: [ + TAssignmentNode new + setVariable: (TVariableNode new setName: exitVar) + expression: expr ] ]. "Eliminate ^self's" + (parseTree lastExpression includes: node) + ifTrue: [ aBinaryBlock value: replacement value: false ] + ifFalse: [ + replacement := replacement + ifNil: [ TGoToNode label: exitLabel ] + ifNotNil: [ + TStatementListNode new + setArguments: #( ) statements: { + replacement. + (TGoToNode label: exitLabel) }; + yourself ]. + aBinaryBlock value: replacement value: true ] ] { #category : 'type inference' } diff --git a/smalltalksrc/Slang/TParseNode.class.st b/smalltalksrc/Slang/TParseNode.class.st index dd87a4fb17..99f72af359 100644 --- a/smalltalksrc/Slang/TParseNode.class.st +++ b/smalltalksrc/Slang/TParseNode.class.st @@ -35,6 +35,16 @@ TParseNode >> allCalls [ ^calls ] +{ #category : 'utilities' } +TParseNode >> allReturns [ + "Answer a collection of returns in this parse tree." + + | returns | + returns := Set new: 32. + self nodesDo: [ :node | node isReturn ifTrue: [ returns add: node ] ]. + ^ returns +] + { #category : 'enumerating' } TParseNode >> allSatisfy: aBlock [ self nodesDo: [:n| (aBlock value: n) ifFalse: [^false]]. @@ -250,6 +260,12 @@ TParseNode >> isConstant [ ^false ] +{ #category : 'testing' } +TParseNode >> isCppConditional [ + + ^ false +] + { #category : 'testing' } TParseNode >> isDefine [ @@ -355,6 +371,12 @@ TParseNode >> isVariable [ ^false ] +{ #category : 'accessing' } +TParseNode >> lastExpression [ + + ^ { self } asIdentitySet +] + { #category : 'accessing' } TParseNode >> nameOrValue [ diff --git a/smalltalksrc/Slang/TSendNode.class.st b/smalltalksrc/Slang/TSendNode.class.st index 2403b280da..f98fa7b21a 100644 --- a/smalltalksrc/Slang/TSendNode.class.st +++ b/smalltalksrc/Slang/TSendNode.class.st @@ -437,12 +437,25 @@ TSendNode >> isConditionalSend [ ifNil:ifNotNil: ifNotNil:ifNil: ifNil: ifNotNil:) includes: selector ] +{ #category : 'testing' } +TSendNode >> isCppConditional [ + + ^ selector beginsWith: #cppIf: +] + { #category : 'dead-code-elimination' } TSendNode >> isDoIterativeSend [ ^ #( #to:do: #to:by:do: ) includes: selector ] +{ #category : 'testing' } +TSendNode >> isExitPoint [ + "useful for error() or abort()" + + ^ #( #error: #abort ) includes: selector +] + { #category : 'testing' } TSendNode >> isExpression [ @@ -540,6 +553,16 @@ TSendNode >> isValueExpansion [ and: [selector keywords allSatisfy: [:k| #('value' 'value:') includes: k]] ] +{ #category : 'accessing' } +TSendNode >> lastExpression [ + + | lastExpressions | + self isConditionalSend ifFalse: [ ^ super lastExpression ]. + lastExpressions := IdentitySet new. + arguments do: [ :arg | lastExpressions addAll: arg lastExpression ]. + ^ lastExpressions +] + { #category : 'accessing' } TSendNode >> name [ diff --git a/smalltalksrc/Slang/TStatementListNode.class.st b/smalltalksrc/Slang/TStatementListNode.class.st index 64e7874fd7..9971cf79f4 100644 --- a/smalltalksrc/Slang/TStatementListNode.class.st +++ b/smalltalksrc/Slang/TStatementListNode.class.st @@ -69,6 +69,12 @@ TStatementListNode >> accept: aVisitor [ { #category : 'adding' } TStatementListNode >> addAllFirst: aListOfStatement [ + self statements: aListOfStatement , statements +] + +{ #category : 'adding' } +TStatementListNode >> addAllFirstKeepingFirstComments: aListOfStatement [ + (statements isNotEmpty and: [ statements first isComment ]) ifFalse: [ self statements: aListOfStatement , statements ] ifTrue: [ @@ -80,8 +86,10 @@ TStatementListNode >> addAllFirst: aListOfStatement [ statements do: [ :e | actualFirstMet ifFalse: [ - firstComments add: e. - actualFirstMet := e == actualFirst ] + actualFirstMet := e == actualFirst. + actualFirstMet + ifTrue: [ allWithoutFirstComments add: e ] + ifFalse: [ firstComments add: e ] ] ifTrue: [ allWithoutFirstComments add: e ] ]. self statements: firstComments , aListOfStatement , allWithoutFirstComments ] @@ -133,6 +141,14 @@ TStatementListNode >> addFirst: aNode [ self statements: (OrderedCollection new add: aNode ; yourself) , statements ] +{ #category : 'adding' } +TStatementListNode >> addLast: aNode [ + + self statements: statements , (OrderedCollection new + add: aNode; + yourself) +] + { #category : 'utilities' } TStatementListNode >> addReadBeforeAssignedIn: variables to: readBeforeAssigned assignments: assigned in: aCodeGen [ "Add any variables in variables that are read before written to readBeforeAssigned. @@ -462,8 +478,7 @@ TStatementListNode >> endsWithReturn [ "Answer true if the last statement of this lock is a return." ^ statements notEmpty and: [ - self lastNonCommentStatement isReturn or: [ - self lastNonCommentStatement isReturningIf ] ] + self lastNonCommentStatement endsWithReturn ] ] { #category : 'accessing' } @@ -478,7 +493,7 @@ TStatementListNode >> firstNonCommentStatement [ | first indexOfFirst limitIndex | first := statements first. - indexOfFirst := 1. + indexOfFirst := 0. limitIndex := statements size. [ first isComment ] whileTrue: [ indexOfFirst := indexOfFirst + 1. @@ -558,6 +573,28 @@ TStatementListNode >> last [ ^ self statements last ] +{ #category : 'accessing' } +TStatementListNode >> lastExpression [ + + ^ self lastNonCommentStatement lastExpression +] + +{ #category : 'accessing' } +TStatementListNode >> lastNonCommentOrGoToOrLabelStatement [ + "the last statement can be a comment if the TStatementList has been through inlining, return the actual last statement" + + | last indexOfLast | + last := statements last. + indexOfLast := statements size. + [ last isComment or: [ last isGoTo or: [ last isLabel ] ] ] + whileTrue: [ + indexOfLast := indexOfLast - 1. + indexOfLast = 0 ifTrue: [ ^ nil ]. + last := statements at: indexOfLast ]. + + ^ last +] + { #category : 'accessing' } TStatementListNode >> lastNonCommentStatement [ "the last statement can be a comment if the TStatementList has been through inlining, return the actual last statement" @@ -633,7 +670,7 @@ TStatementListNode >> parameterNames [ TStatementListNode >> postCopy [ arguments := arguments copy. - self statements: (statements collect: [ :s | s copy parent: self ]) + self statements: (statements collect: [ :s | s copy ]) ] { #category : 'printing' } @@ -745,10 +782,14 @@ TStatementListNode >> renameLocalVariablesGivenClassVariables: classVariables gl { #category : 'transformations' } TStatementListNode >> replaceChild: aNode with: bNode [ + bNode isStatementList ifTrue: [ + self replaceChild: aNode withList: bNode statements. + ^ self ]. + self statements: (statements collect: [ :node | - node == aNode - ifTrue: [ bNode ] - ifFalse: [ node ] ]) + node == aNode + ifTrue: [ bNode ] + ifFalse: [ node ] ]) ] { #category : 'transformations' } diff --git a/smalltalksrc/Slang/TSwitchStmtNode.class.st b/smalltalksrc/Slang/TSwitchStmtNode.class.st index feb309b610..bee5e80d03 100644 --- a/smalltalksrc/Slang/TSwitchStmtNode.class.st +++ b/smalltalksrc/Slang/TSwitchStmtNode.class.st @@ -520,6 +520,23 @@ TSwitchStmtNode >> renameLocalVariablesGivenClassVariables: classVariables globa collectingChangesIn: changedVariables ] ] +{ #category : 'transformations' } +TSwitchStmtNode >> replaceChild: aNode with: aReplacementNode [ + + expression == aNode ifTrue: [ self expression: aReplacementNode ]. + otherwiseOrNil == aNode ifTrue: [ + self otherwiseOrNil: aReplacementNode ]. + self cases: (cases collect: [ :case | + { + (case first collect: [ :label | + label == aNode + ifTrue: [ aReplacementNode ] + ifFalse: [ label ] ]). + (case second == aNode + ifTrue: [ aReplacementNode ] + ifFalse: [ case second ]) } ]) +] + { #category : 'transformations' } TSwitchStmtNode >> replaceNodesIn: aDictionary [ diff --git a/smalltalksrc/Slang/TVariableNode.class.st b/smalltalksrc/Slang/TVariableNode.class.st index 7ed6945389..31ed6c2e4d 100644 --- a/smalltalksrc/Slang/TVariableNode.class.st +++ b/smalltalksrc/Slang/TVariableNode.class.st @@ -130,6 +130,7 @@ TVariableNode >> renameLocalVariablesGivenClassVariables: classVariables globalV "Answer either the receiver, if it is not a reference to one of the given variables, or the replacement if it is. classVariables is a Dictionary and globalsVariables is a collection" "'self', 'self_in...', 'super' and 'cascade are reserved variable names" + (name = #super or: [ (name beginsWith: #self) or: [ name beginsWith: #cascade ] ]) ifTrue: [ ^ self ]. @@ -145,7 +146,7 @@ TVariableNode >> renameLocalVariablesGivenClassVariables: classVariables globalV classVariables at: name ifPresent: [ :replacement | - replacement shouldBeGenerated ifTrue: [ ^ replacement ]. + replacement shouldBeGenerated ifTrue: [ ^ replacement copy ]. "in case of library name don't redefine them" ^ self ] ifAbsent: [ "the variable is local, we update its name with an _ and add it to the changedVariables collection which will change all its appearance in the TMethods/parseTree " diff --git a/smalltalksrc/VMMaker/SLAnnotatorVisitorTest.extension.st b/smalltalksrc/VMMaker/SLAnnotatorVisitorTest.extension.st new file mode 100644 index 0000000000..38461cd388 --- /dev/null +++ b/smalltalksrc/VMMaker/SLAnnotatorVisitorTest.extension.st @@ -0,0 +1,14 @@ +Extension { #name : 'SLAnnotatorVisitorTest' } + +{ #category : '*VMMaker' } +SLAnnotatorVisitorTest >> setUp [ + + super setUp. + sLNodeAnnotatorVisitor := SLNodeAnnotatorVisitor new. + ccg addClass: SLNodeAnnotatorVisitorTestClass. + nonEffectiveExpressionOrStatementCollection := OrderedCollection new. + effectiveExpressionValueCollection := OrderedCollection new. + "necessary to get the type of sqInt" + SpurMemoryManager initBytesPerWord: 8. + ccg inferTypes +] diff --git a/smalltalksrc/VMMaker/SLInliningTest.extension.st b/smalltalksrc/VMMaker/SLInliningTest.extension.st new file mode 100644 index 0000000000..b9a6fbc68f --- /dev/null +++ b/smalltalksrc/VMMaker/SLInliningTest.extension.st @@ -0,0 +1,16 @@ +Extension { #name : 'SLInliningTest' } + +{ #category : '*VMMaker' } +SLInliningTest >> setUp [ + + super setUp. + + self perform: inliningStrategy. + inliner codeGenerator: ccg. + ccg inliner: inliner. + testClass := SLMockInliningTestClass. + + "necessary to get the type of sqInt" + SpurMemoryManager initBytesPerWord: 8. + sLInliner := SLInlinerWithAnnotation new +] diff --git a/smalltalksrc/VMMaker/SlangInliningTest.extension.st b/smalltalksrc/VMMaker/SlangInliningTest.extension.st deleted file mode 100644 index c6b5def57e..0000000000 --- a/smalltalksrc/VMMaker/SlangInliningTest.extension.st +++ /dev/null @@ -1,12 +0,0 @@ -Extension { #name : 'SlangInliningTest' } - -{ #category : '*VMMaker' } -SlangInliningTest >> setUp [ - - super setUp. - ccg addClass: SLMockInliningTestClass. - "necessary to get the type of sqInt" - SpurMemoryManager initBytesPerWord: 8. - ccg inferTypes. - sLInliner := SLInliner new -]