From dea0ed9f93ac6c256855a01e7a572ed73a2f2114 Mon Sep 17 00:00:00 2001 From: renaud Date: Tue, 13 Aug 2024 11:47:19 +0200 Subject: [PATCH 1/2] prepare comment support --- smalltalksrc/Slang/TParseNode.class.st | 9 ++++++++- smalltalksrc/Slang/TSendNode.class.st | 9 ++++++++- smalltalksrc/Slang/TStatementListNode.class.st | 8 +++++++- smalltalksrc/Slang/TSwitchStmtNode.class.st | 10 +++++++++- 4 files changed, 32 insertions(+), 4 deletions(-) diff --git a/smalltalksrc/Slang/TParseNode.class.st b/smalltalksrc/Slang/TParseNode.class.st index 674fb93d7a..11896d43f1 100644 --- a/smalltalksrc/Slang/TParseNode.class.st +++ b/smalltalksrc/Slang/TParseNode.class.st @@ -201,6 +201,13 @@ TParseNode >> hasExplicitReturn [ ^false ] +{ #category : 'testing' } +TParseNode >> hasNothingButComments [ + "an alternative to isEmpty related to inlining" + + ^ self children allSatisfy: [ :child | child isComment ] +] + { #category : 'testing' } TParseNode >> hasSideEffect [ "Answer if the parse tree rooted at this node has a side-effect or not. By default assume it has. Nodes that don't override." @@ -452,7 +459,7 @@ TParseNode >> removeUnusedNodesInBranch: aChild [ "this method should be only called when cleaning an AST tree after an unused expression was found" self children remove: aChild. - self children isEmpty ifTrue: [ + (self children isEmpty or: [ self hasNothingButComments ]) ifTrue: [ self parent removeUnusedNodesInBranch: self ] ] diff --git a/smalltalksrc/Slang/TSendNode.class.st b/smalltalksrc/Slang/TSendNode.class.st index 3334a7204f..3bc494c956 100644 --- a/smalltalksrc/Slang/TSendNode.class.st +++ b/smalltalksrc/Slang/TSendNode.class.st @@ -76,6 +76,13 @@ TSendNode >> argumentsForInliningCodeGenerator: aCodeGen [ ifFalse: [arguments] ] +{ #category : 'testing' } +TSendNode >> argumentsHasNothingButComments [ + "related to dead code elimination and inlining, see if the cases has nothing but comment meaning they are empty" + + ^ arguments allSatisfy: [ :arg | arg isComment ] +] + { #category : 'tranforming' } TSendNode >> asCASTAsFieldReferenceIn: aCodeGen [ @@ -567,7 +574,7 @@ TSendNode >> removeUnusedNodesInBranch: aChild [ | branchIndex | branchIndex := arguments indexOf: aChild. arguments := arguments select: [ :e | e ~= aChild ]. - arguments isEmpty + (arguments isEmpty or: [ self argumentsHasNothingButComments ]) ifTrue: [ self transformReceiverAfterEmptyArguments. self parent removeUnusedNodesInBranch: self ] diff --git a/smalltalksrc/Slang/TStatementListNode.class.st b/smalltalksrc/Slang/TStatementListNode.class.st index 648f115ea2..31f41b28a4 100644 --- a/smalltalksrc/Slang/TStatementListNode.class.st +++ b/smalltalksrc/Slang/TStatementListNode.class.st @@ -372,6 +372,12 @@ TStatementListNode >> initialize [ arguments := #() ] +{ #category : 'testing' } +TStatementListNode >> isComment [ + + ^ self hasNothingButComments +] + { #category : 'testing' } TStatementListNode >> isEmptyStmtListNode [ "return true if the statement node is empty or has just a nil in it" @@ -513,7 +519,7 @@ 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" statements := statements select: [ :stmt | stmt ~~ aChild ]. - statements isEmpty ifTrue: [ + (statements isEmpty or: [ self hasNothingButComments ]) ifTrue: [ self parent removeUnusedNodesInBranch: self ] ] diff --git a/smalltalksrc/Slang/TSwitchStmtNode.class.st b/smalltalksrc/Slang/TSwitchStmtNode.class.st index 4f10b0fac9..5881d98755 100644 --- a/smalltalksrc/Slang/TSwitchStmtNode.class.st +++ b/smalltalksrc/Slang/TSwitchStmtNode.class.st @@ -244,6 +244,13 @@ TSwitchStmtNode >> cases: anObject [ cases := anObject ] +{ #category : 'testing' } +TSwitchStmtNode >> casesHasNothingButComments [ + "related to dead code elimination and inlining, see if the cases has nothing but comment meaning they are empty" + + ^ cases allSatisfy: [ :case | case second isComment ] +] + { #category : 'accessing' } TSwitchStmtNode >> children [ @@ -455,7 +462,8 @@ 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 ]. - self cases isEmpty 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" From d9798ac5536c7a42e6b528596458cb2b98f0a857 Mon Sep 17 00:00:00 2001 From: renaud Date: Wed, 14 Aug 2024 12:08:54 +0200 Subject: [PATCH 2/2] change in removeUnusedNodesInBranch: to handle comments --- .../SLDeadCodeEliminationTest.class.st | 145 ++++++++++++++++++ .../SLDeadCodeEliminationTestClass.class.st | 50 ++++++ .../SlangReturnTypeConflictException.class.st | 9 +- .../Slang/SlangTyperException.class.st | 7 +- .../Slang/TStatementListNode.class.st | 18 +-- smalltalksrc/Slang/TSwitchStmtNode.class.st | 6 +- 6 files changed, 216 insertions(+), 19 deletions(-) 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"