Merge pull request #2011 from MarcusDenker/22692-Improve-after-operat…

…ion-for-Array

22692-Improve-after-operation-for-Array

src/Reflectivity-Tests/ReflectivityReificationTest.class.st

@@ -130,8 +130,7 @@ ReflectivityReificationTest >> testReifyArrayOperationAfter [
 
 { #category : #'tests - misc' }
 ReflectivityReificationTest >> testReifyArrayOperationBefore [
-
-	"
+	| sendNode instance |
 	sendNode := (ReflectivityExamples >> #exampleArray) ast body
 		statements first value.
 	link := MetaLink new
@@ -147,13 +146,14 @@ ReflectivityReificationTest >> testReifyArrayOperationBefore [
 	self assert: tag isNil.
 	instance := ReflectivityExamples new.
 	self assert: instance exampleArray equals: #(3).
-	self assert: tag value equals: #(3)"
+	self assert: tag class equals: Array.
+	self assert: tag value equals: #(3)
 ]
 
 { #category : #'tests - misc' }
 ReflectivityReificationTest >> testReifyArrayOperationInstead [
-
-	"sendNode := (ReflectivityExamples >> #exampleArray) ast body
+	| sendNode instance |
+	sendNode := (ReflectivityExamples >> #exampleArray) ast body
 		statements first value.
 	link := MetaLink new
 		metaObject: self;
@@ -168,7 +168,7 @@ ReflectivityReificationTest >> testReifyArrayOperationInstead [
 	self assert: tag isNil.
 	instance := ReflectivityExamples new.
 	self assert: instance exampleArray equals: self.
-	self assert: tag value equals: #(3)"
+	self assert: tag value equals: #(3)
 ]
 
 { #category : #'tests - misc' }
@@ -870,6 +870,28 @@ ReflectivityReificationTest >> testReifyMethodThisContextAfter [
 	self deny: tag isBlockContext.
 ]
 
+{ #category : #'tests - method' }
+ReflectivityReificationTest >> testReifyMethodValue [
+	| sendNode instance |
+	"not working yet. Need to somehow access return value of whole method"
+	self skip.
+	sendNode := (ReflectivityExamples >> #exampleMethod) ast.
+	link := MetaLink new
+		metaObject: self;
+		selector: #tagExec:;
+		control: #after;
+		arguments: #(value).
+	sendNode link: link.
+	self assert: sendNode hasMetalink.
+	self
+		assert: (ReflectivityExamples >> #exampleMethod) class
+		equals: ReflectiveMethod.
+	self assert: tag isNil.
+	instance := ReflectivityExamples new.
+	self assert: instance exampleMethod equals: 5.
+	self assert: tag equals: #exampleMethod
+]
+
 { #category : #'tests - assignment' }
 ReflectivityReificationTest >> testReifyNewValueAssignmentAfter [
 	| varNode instance |
@@ -1059,6 +1081,27 @@ ReflectivityReificationTest >> testReifyOperationSend [
 	self assert: tag value equals: 5
 ]
 
+{ #category : #'tests - operations' }
+ReflectivityReificationTest >> testReifyOperationSendAfter [
+	| sendNode instance |
+	sendNode := (ReflectivityExamples >> #exampleMethod) ast body
+		statements first value.
+	link := MetaLink new
+		metaObject: self;
+		selector: #tagExec:;
+		control: #after;
+		arguments: #(operation).
+	sendNode link: link.
+	self assert: sendNode hasMetalink.
+	self
+		assert: (ReflectivityExamples >> #exampleMethod) class
+		equals: ReflectiveMethod.
+	self assert: tag isNil.
+	instance := ReflectivityExamples new.
+	self assert: instance exampleMethod equals: 5.
+	self assert: tag value equals: 5
+]
+
 { #category : #'tests - operations' }
 ReflectivityReificationTest >> testReifyOperationSendInstead [
 	| sendNode instance |
@@ -1413,7 +1456,6 @@ ReflectivityReificationTest >> testReifySendValue [
 		metaObject: self;
 		selector: #tagExec:;
 		control: #after;
-		option: #(+ optionWeakAfter);
 		arguments: #(value).
 	sendNode link: link.
 	self assert: sendNode hasMetalink.

src/Reflectivity-Tools-Tests/WPDummy.class.st

@@ -12,23 +12,21 @@ Class {
 
 { #category : #examples }
 WPDummy >> exampleAssignment [
-	foo := 1.
+	foo := 1
 
 
 ]
 
 { #category : #examples }
 WPDummy >> exampleAssignment: anObject [
-	foo := anObject.
+	foo := anObject
 
 
 ]
 
 { #category : #examples }
 WPDummy >> exampleMessageSend [
 	self exampleOperation
-
-
 ]
 
 { #category : #examples }

src/Reflectivity/HookGenerator.class.st

@@ -28,12 +28,9 @@ HookGenerator class >> node: aNode [
 
 { #category : #results }
 HookGenerator >> afterHooks [
-	| statements |
-	statements := links 
+	^ links 
 			select: [ :each | each control = #after ] 
 			thenCollect:  [ :link | (self hookFor: link) parent: node].
-
-	^(RBBlockNode body: (RBSequenceNode statements: statements flattened)) parent: node.
 ]
 
 { #category : #results }
@@ -143,6 +140,18 @@ HookGenerator >> plugins [
 	^ plugins
 ]
 
+{ #category : #results }
+HookGenerator >> postamble [
+	| postamble |
+	"This is code executed just before the #after link"
+
+	postamble := OrderedCollection new.
+	links do: [:link |  
+		plugins do: [ :plugin | (link allReifications includes: plugin key) ifTrue: [postamble addAll: ((plugin entity: entity link: link) postamble: entity)]]].
+
+	^postamble
+]
+
 { #category : #results }
 HookGenerator >> preamble [
 	| preamble |

src/Reflectivity/LiteralVariable.extension.st

@@ -115,6 +115,11 @@ LiteralVariable >> methodNode [
 	^nil
 ]
 
+{ #category : #'*Reflectivity' }
+LiteralVariable >> postambles [
+	^ self propertyAt: #postambles ifAbsent: #()
+]
+
 { #category : #'*Reflectivity' }
 LiteralVariable >> preambles [
 	^ self propertyAt: #preambles ifAbsent: #()

src/Reflectivity/RBProgramNode.extension.st

@@ -110,6 +110,11 @@ RBProgramNode >> nodesWithLinks [
 	^ self allChildren select: [ :e | e links isNotNil ]
 ]
 
+{ #category : #'*Reflectivity' }
+RBProgramNode >> postambles [
+	^self propertyAt: #postambles ifAbsent: #()
+]
+
 { #category : #'*Reflectivity' }
 RBProgramNode >> preambles [
 	^self propertyAt: #preambles ifAbsent: #()

src/Reflectivity/RFASTTranslator.class.st

@@ -23,6 +23,7 @@ RFASTTranslator >> emitMessageNode: aMessageNode [
 	aMessageNode isCascaded
 		ifFalse: [ valueTranslator visitNode: aMessageNode receiver ].
 	aMessageNode arguments do: [ :each | valueTranslator visitNode: each ].
+	self emitPreamble: aMessageNode.
 	self emitPrepareLinkAfter: aMessageNode.
 	self emitMetaLinkBefore: aMessageNode.
 	aMessageNode hasMetalinkInstead
@@ -40,29 +41,28 @@ RFASTTranslator >> emitMetaLinkAfter: aNode [
 	aNode allAfterAreWeak ifTrue: [ ^self emitMetaLinkAfterNoEnsure: aNode ].
 
 	methodBuilder blockReturnTop.
-	methodBuilder jumpAheadTarget: #block.		
-	valueTranslator visitNode: aNode afterHooks.
+	methodBuilder jumpAheadTarget: #block.
+	aNode postambles do: [:each | valueTranslator visitNode: each].
+	aNode afterHooks do: [:each | valueTranslator visitNode: each].
 	methodBuilder send: #ensure:.
 ]
 
 { #category : #reflectivity }
 RFASTTranslator >> emitMetaLinkAfterNoEnsure: aNode [
 
 	aNode hasMetalinkAfter ifFalse: [ ^self ].
-	self emitPreamble: aNode.
-	aNode afterHooks do: [ :each | effectTranslator visitNode: each body ].
+	aNode postambles do: [:each | valueTranslator visitNode: each].
+	aNode afterHooks do: [ :each | effectTranslator visitNode: each ].
 ]
 
 { #category : #reflectivity }
 RFASTTranslator >> emitMetaLinkBefore: aNode [
 	aNode hasMetalinkBefore ifFalse: [ ^self ].
-	self emitPreamble: aNode.
 	aNode beforeHooks do: [ :hook | effectTranslator visitNode: hook ].
 ]
 
 { #category : #reflectivity }
 RFASTTranslator >> emitMetaLinkInstead: aNode [
-	self emitPreamble: aNode.
 	valueTranslator visitNode: aNode insteadHooks.
 ]
 
@@ -77,7 +77,6 @@ RFASTTranslator >> emitPrepareLinkAfter: aNode [
 	| copied |
 	copied := #().
 	aNode hasMetalinkAfter ifFalse: [^self].
-	self emitPreamble: aNode.
 	aNode allAfterAreWeak ifTrue: [ ^self ].
 	aNode isMethod ifTrue: [ copied := aNode argumentNames, aNode tempNames ].
 	methodBuilder
@@ -95,6 +94,7 @@ RFASTTranslator >> visitArrayNode: anArrayNode [
 
 	elementNodes := anArrayNode children.
 	elementNodes do: [:node | valueTranslator visitNode: node].
+	self emitPreamble: anArrayNode.
 	self emitMetaLinkBefore: anArrayNode.
 	anArrayNode hasMetalinkInstead
 		ifTrue: [ self emitMetaLinkInstead: anArrayNode ]
@@ -106,10 +106,11 @@ RFASTTranslator >> visitArrayNode: anArrayNode [
 { #category : #'visitor-double dispatching' }
 RFASTTranslator >> visitAssignmentNode: anAssignmentNode [ 
 	valueTranslator visitNode: anAssignmentNode value.
+	self emitPreamble: anAssignmentNode.
 	self emitMetaLinkBefore: anAssignmentNode.
+	self emitPreamble: anAssignmentNode variable.
 	self emitMetaLinkBefore: anAssignmentNode variable.
 
-
 	anAssignmentNode hasMetalinkInstead
 				ifTrue: [ self emitMetaLinkInstead: anAssignmentNode ]
 				ifFalse: [
@@ -144,6 +145,7 @@ RFASTTranslator >> visitBlockNode: aBlockNode [
 			withVars: (aBlockNode scope tempVector collect: [:each| each name]) asArray.
 	].
 	methodBuilder addTemps: tempNames.
+	self emitPreamble: aBlockNode.
 	self emitMetaLinkBefore: aBlockNode.
 	valueTranslator visitNode: aBlockNode body.
 	methodBuilder addBlockReturnTopIfRequired.
@@ -186,12 +188,14 @@ RFASTTranslator >> visitInlinedBlockNode: anOptimizedBlockNode [
 			methodBuilder storeTemp: tempName.
 			methodBuilder popTop.
 		 ]].
+	self emitPreamble: anOptimizedBlockNode.
 	self emitMetaLinkBefore: anOptimizedBlockNode.
 	self visitNode: anOptimizedBlockNode body.
 ]
 
 { #category : #'visitor-double dispatching' }
 RFASTTranslator >> visitLiteralArrayNode: aRBLiteralArrayNode [
+	self emitPreamble: aRBLiteralArrayNode.
 	self emitMetaLinkBefore: aRBLiteralArrayNode.
 	aRBLiteralArrayNode hasMetalinkInstead
 		ifTrue: [ self emitMetaLinkInstead: aRBLiteralArrayNode ]
@@ -203,6 +207,7 @@ RFASTTranslator >> visitLiteralArrayNode: aRBLiteralArrayNode [
 
 { #category : #'visitor-double dispatching' }
 RFASTTranslator >> visitLiteralNode: aLiteralNode [
+	self emitPreamble: aLiteralNode.
 	self emitMetaLinkBefore: aLiteralNode.
 	aLiteralNode hasMetalinkInstead
 		ifTrue: [ self emitMetaLinkInstead: aLiteralNode ]
@@ -227,7 +232,7 @@ RFASTTranslator >> visitMethodNode: aMethodNode [
 	methodBuilder compilationContext: aMethodNode compilationContext.
 	methodBuilder addTemps: aMethodNode scope tempVarNames.
 
-	aMethodNode isPrimitive ifFalse: [self emitMetaLinkBefore: aMethodNode].
+	aMethodNode isPrimitive ifFalse: [self emitPreamble: aMethodNode. self emitMetaLinkBefore: aMethodNode].
 
 	methodBuilder properties: aMethodNode methodProperties.
 	methodBuilder irPrimitive: aMethodNode primitiveFromPragma.
@@ -256,6 +261,7 @@ RFASTTranslator >> visitMethodNode: aMethodNode [
 RFASTTranslator >> visitReturnNode: aReturnNode [ 
 
 	valueTranslator visitNode: aReturnNode value.
+	self emitPreamble: aReturnNode.
 	self emitMetaLinkBefore: aReturnNode.
 	aReturnNode hasMetalinkInstead
 		ifTrue: [ self emitMetaLinkInstead: aReturnNode ]
@@ -283,6 +289,7 @@ RFASTTranslator >> visitStorePopIntoTempNode: aNode [
 
 { #category : #'visitor-double dispatching' }
 RFASTTranslator >> visitVariableNode: aVariableNode [
+	self emitPreamble: aVariableNode.
 	self emitMetaLinkBefore: aVariableNode.
 	aVariableNode hasMetalinkInstead
 				ifTrue: [ self emitMetaLinkInstead: aVariableNode ]
@@ -295,7 +302,7 @@ RFASTTranslator >> visitVariableNode: aVariableNode [
 { #category : #reflectivity }
 RFASTTranslator >> visitVariableValue: aVariable [
 	self flag: #TBD. "needs to be extendend to other kinds of variables and cleaned"
-	((aVariable isKindOf: LiteralVariable) or: [ (aVariable isKindOf: Slot) ]) ifTrue: [ self emitMetaLinkBefore: aVariable. ].
+	((aVariable isKindOf: LiteralVariable) or: [ (aVariable isKindOf: Slot) ]) ifTrue: [ self emitPreamble: aVariable. self emitMetaLinkBefore: aVariable. ].
 	aVariable emitValue: methodBuilder.
 	((aVariable isKindOf: LiteralVariable) or: [ (aVariable isKindOf: Slot) ]) ifTrue: [self emitMetaLinkAfterNoEnsure: aVariable].
 ]

src/Reflectivity/RFASTTranslatorForEffect.class.st

@@ -109,6 +109,7 @@ RFASTTranslatorForEffect >> visitParseErrorNode: anErrorNode [
 
 { #category : #'visitor-double dispatching' }
 RFASTTranslatorForEffect >> visitSequenceNode: aSequenceNode [
+	self emitPreamble: aSequenceNode.
 	self emitMetaLinkBefore: aSequenceNode.
 	self emitPrepareLinkAfter: aSequenceNode.
 
@@ -126,6 +127,7 @@ RFASTTranslatorForEffect >> visitVariableNode: aVariableNode [
 
 	| binding |
 
+	self emitPreamble: aVariableNode.
 	self emitMetaLinkBefore: aVariableNode.
 	self emitPrepareLinkAfter: aVariableNode.
 

src/Reflectivity/RFASTTranslatorForValue.class.st

@@ -67,6 +67,7 @@ RFASTTranslatorForValue >> emitWhileTrue: aMessageNode [
 { #category : #'visitor-double dispatching' }
 RFASTTranslatorForValue >> visitSequenceNode: aSequenceNode [ 
 	| statements |
+	self emitPreamble: aSequenceNode.
 	self emitMetaLinkBefore: aSequenceNode.
 	self emitPrepareLinkAfter: aSequenceNode.
 

src/Reflectivity/RFOldValueReification.class.st

@@ -23,7 +23,6 @@ RFOldValueReification class >> key [
 RFOldValueReification >> genForRBAssignmentNode [
 	| varNode |
 	varNode := entity variable.
-
 	varNode isGlobal ifTrue: [^RFLiteralVariableNode value: entity binding value]. 
 	^RBVariableNode named: varNode name.
 ]
@@ -34,8 +33,3 @@ RFOldValueReification >> genForRBVariableNode [
 	entity isGlobal ifTrue: [^RFLiteralVariableNode value: entity binding value]. 
 	^RBVariableNode named: entity name.
 ]
-
-{ #category : #generate }
-RFOldValueReification >> preamble: aNode [
-		^{}
-]