diff --git a/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTest.class.st b/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTest.class.st index f2e6879da7..fa931dfc07 100644 --- a/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTest.class.st +++ b/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTest.class.st @@ -27,6 +27,66 @@ SLDeadCodeEliminationTest >> setUp [ ] +{ #category : 'only-comment' } +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: #conditionalWithOnlyCommentNoSendInReceiver. + + ccg doBasicInlining: true. + ccg currentMethod: tMethod. + + sLDeadCodeEliminationVisitor visit: tMethod parseTree. + + translation := self translate: tMethod. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLDeadCodeEliminationTestClass>>#conditionalWithOnlyCommentNoSendInReceiver */ +static void +conditionalWithOnlyCommentNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_conditionalWithOnlyCommentNoSendInReceiver) +{ + { + return; + } +}' +] + +{ #category : 'only-comment' } +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. + + ccg doBasicInlining: true. + ccg currentMethod: tMethod. + + sLDeadCodeEliminationVisitor visit: tMethod parseTree. + + translation := self translate: tMethod. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLDeadCodeEliminationTestClass>>#conditionalWithOnlyCommentSendInReceiver */ +static void +conditionalWithOnlyCommentSendInReceiver(SLDeadCodeEliminationTestClass * self_in_conditionalWithOnlyCommentSendInReceiver) +{ + { + method(self_in_conditionalWithOnlyCommentSendInReceiver, method(self_in_conditionalWithOnlyCommentSendInReceiver)); + } + { + return; + } +}' +] + { #category : 'method-in-c-coerce' } SLDeadCodeEliminationTest >> testMethodAddingCallInCoerce [ @@ -1053,6 +1113,34 @@ methodWithInstanceVariableInReturn(SLDeadCodeEliminationTestClass * self_in_meth }' ] +{ #category : 'only-comment' } +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. + ccg doBasicInlining: true. + ccg currentMethod: tMethod. + sLDeadCodeEliminationVisitor visit: tMethod parseTree. + + translation := self translate: tMethod. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLDeadCodeEliminationTestClass>>#methodWithOnlyComment */ +static void +methodWithOnlyComment(SLDeadCodeEliminationTestClass * self_in_methodWithOnlyComment) +{ + /* begin method */ + /* end method */ + { + return; + } +}' +] + { #category : 'unused-leaf' } SLDeadCodeEliminationTest >> testMethodWithUnusedConstant [ @@ -3705,6 +3793,63 @@ methodWithVariableInReturn(SLDeadCodeEliminationTestClass * self_in_methodWithVa }' ] +{ #category : 'only-comment' } +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 prepareMethodIn: ccg. + ccg doBasicInlining: true. + ccg currentMethod: tMethod. + sLDeadCodeEliminationVisitor visit: tMethod parseTree. + + translation := self translate: tMethod. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLDeadCodeEliminationTestClass>>#switchWithOnlyCommentNoSendInReceiver: */ +static void +switchWithOnlyCommentNoSendInReceiver(SLDeadCodeEliminationTestClass * self_in_switchWithOnlyCommentNoSendInReceiver, sqInt anInt) +{ + { + return; + } +}' +] + +{ #category : 'only-comment' } +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 prepareMethodIn: ccg. + ccg doBasicInlining: true. + ccg currentMethod: tMethod. + sLDeadCodeEliminationVisitor visit: tMethod parseTree. + + translation := self translate: tMethod. + translation := translation trimBoth. + + self + assert: translation + equals: + '/* SLDeadCodeEliminationTestClass>>#switchWithOnlyCommentSendInReceiver */ +static void +switchWithOnlyCommentSendInReceiver(SLDeadCodeEliminationTestClass * self_in_switchWithOnlyCommentSendInReceiver) +{ + { + method(self_in_switchWithOnlyCommentSendInReceiver, method(self_in_switchWithOnlyCommentSendInReceiver)); + } + { + return; + } +}' +] + { #category : 'helpers' } SLDeadCodeEliminationTest >> translate: tast [ diff --git a/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTestClass.class.st b/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTestClass.class.st index 692faa5313..42a788a6eb 100644 --- a/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTestClass.class.st +++ b/smalltalksrc/Slang-Tests/SLDeadCodeEliminationTestClass.class.st @@ -17,6 +17,24 @@ SLDeadCodeEliminationTestClass class >> instVarNamesAndTypesForTranslationDo: aB otherwise: [ #sqInt ]) ] ] +{ #category : 'only-comment' } +SLDeadCodeEliminationTestClass >> conditionalWithOnlyCommentNoSendInReceiver [ + + + true + ifTrue: [ self method ] + ifFalse: [ self method ] +] + +{ #category : 'only-comment' } +SLDeadCodeEliminationTestClass >> conditionalWithOnlyCommentSendInReceiver [ + + + (self method: self method) + ifTrue: [ self method ] + ifFalse: [ self method ] +] + { #category : 'accessing' } SLDeadCodeEliminationTestClass >> instancesVariable [ ^ instancesVariable @@ -24,6 +42,9 @@ SLDeadCodeEliminationTestClass >> instancesVariable [ { #category : 'helpers' } SLDeadCodeEliminationTestClass >> method [ + + + ] { #category : 'helpers' } @@ -332,6 +353,13 @@ SLDeadCodeEliminationTestClass >> methodWithInstanceVariableInReturn [ ^ instancesVariable ] +{ #category : 'only-comment' } +SLDeadCodeEliminationTestClass >> methodWithOnlyComment [ + + + self method +] + { #category : 'unused-leaf' } SLDeadCodeEliminationTestClass >> methodWithUnusedConstant [ @@ -1123,3 +1151,25 @@ SLDeadCodeEliminationTestClass >> methodWithVariableInReturn [ i. ^ i ] + +{ #category : 'only-comment' } +SLDeadCodeEliminationTestClass >> switchWithOnlyCommentNoSendInReceiver: anInt [ + + + anInt + caseOf: { + ([ 5 ] -> [ self method ]). + ([ 6 ] -> [ self method ]) } + otherwise: [ self method ] +] + +{ #category : 'only-comment' } +SLDeadCodeEliminationTestClass >> switchWithOnlyCommentSendInReceiver [ + + + (self method: self method) + caseOf: { + ([ 5 ] -> [ self method ]). + ([ 6 ] -> [ self method ]) } + otherwise: [ self method ] +] diff --git a/smalltalksrc/Slang/SlangReturnTypeConflictException.class.st b/smalltalksrc/Slang/SlangReturnTypeConflictException.class.st index f5f92ec24d..7f4e15fc5c 100644 --- a/smalltalksrc/Slang/SlangReturnTypeConflictException.class.st +++ b/smalltalksrc/Slang/SlangReturnTypeConflictException.class.st @@ -1,10 +1,11 @@ Class { - #name : #SlangReturnTypeConflictException, - #superclass : #SlangTyperException, - #category : #Slang + #name : 'SlangReturnTypeConflictException', + #superclass : 'SlangTyperException', + #category : 'Slang', + #package : 'Slang' } -{ #category : #exceptions } +{ #category : 'exceptions' } SlangReturnTypeConflictException class >> signalConflictIn: aMethod with: aCollectionOfType [ | message | diff --git a/smalltalksrc/Slang/SlangTyperException.class.st b/smalltalksrc/Slang/SlangTyperException.class.st index 963cf9b573..8e16869539 100644 --- a/smalltalksrc/Slang/SlangTyperException.class.st +++ b/smalltalksrc/Slang/SlangTyperException.class.st @@ -1,5 +1,6 @@ Class { - #name : #SlangTyperException, - #superclass : #Error, - #category : #Slang + #name : 'SlangTyperException', + #superclass : 'Error', + #category : 'Slang', + #package : 'Slang' } diff --git a/smalltalksrc/Slang/TStatementListNode.class.st b/smalltalksrc/Slang/TStatementListNode.class.st index f7f77ef1df..e612f7208f 100644 --- a/smalltalksrc/Slang/TStatementListNode.class.st +++ b/smalltalksrc/Slang/TStatementListNode.class.st @@ -437,9 +437,9 @@ TStatementListNode >> isComment [ { #category : 'testing' } TStatementListNode >> isEmptyStmtListNode [ - "return true if the statement node is empty or has just a nil in it" + "return true if the statement node is empty orContains only comments" - statements isEmpty ifTrue: [ ^ true ]. + (statements isEmpty or: [ self isComment ]) ifTrue: [ ^ true ]. ^ false ] @@ -586,6 +586,13 @@ TStatementListNode >> removeAssertions [ self setStatements: newStatements asArray ] +{ #category : 'transformations' } +TStatementListNode >> removeLast [ + "the last statement can be a comment if the TStatementList has been through inlining, remove the actual last statement" + + statements := self allButLastNonCommentStatement +] + { #category : 'dead-code-elimination' } TStatementListNode >> removeUnusedNodesInBranch: aChild [ "this method should be only called when cleaning an AST tree after an unused expression was found, remove aChild from the list of statements" @@ -595,13 +602,6 @@ TStatementListNode >> removeUnusedNodesInBranch: aChild [ self parent removeUnusedNodesInBranch: self ] ] -{ #category : 'transformations' } -TStatementListNode >> removeLast [ - "the last statement can be a comment if the TStatementList has been through inlining, remove the actual last statement" - - statements := self allButLastNonCommentStatement -] - { #category : 'inlining support' } TStatementListNode >> renameLabelsForInliningInto: aTMethod [ "TMethod already has a method for this; hijack it..." diff --git a/smalltalksrc/Slang/TSwitchStmtNode.class.st b/smalltalksrc/Slang/TSwitchStmtNode.class.st index 5881d98755..9fc9e3ebb5 100644 --- a/smalltalksrc/Slang/TSwitchStmtNode.class.st +++ b/smalltalksrc/Slang/TSwitchStmtNode.class.st @@ -460,10 +460,10 @@ TSwitchStmtNode >> removeAssertions [ { #category : 'dead-code-elimination' } TSwitchStmtNode >> removeUnusedNodesInBranch: aChild [ "when removing a node from a switch, we have to be careful of if it comes from a caseOf: or a caseOf:otherwise:. if it comes from a caseOf:, otherwise is nil and must be kept it will be translated as a no case found error. To indicate that otherwise does nothing Slang use an empty TStatementListNode, hence the following code" - + cases := cases select: [ :each | each second ~~ aChild ]. - (cases isEmpty or: [ self casesHasNothingButComments ]) - ifFalse: [ ^ self ]. + (cases isEmpty or: [ self casesHasNothingButComments ]) ifFalse: [ + ^ self ]. "we're from a caseOf: so we keep the node" otherwiseOrNil ifNil: [ ^ self ]. "otherwiseOrNil may have been empty from the start or during the cleaning process, either way the node is now completely empty so we can supress it"