Merge pull request #2012 from MarcusDenker/22695-Make-value-for-work-…

…method-after

22695-Make-value-for-work-method-after

src/Reflectivity-Tests/ReflectivityControlTest.class.st

@@ -196,6 +196,24 @@ ReflectivityControlTest >> testAfterMethod [
 	self assert: (ReflectivityExamples >> #exampleMethod) class equals: CompiledMethod
 ]
 
+{ #category : #'tests - after' }
+ReflectivityControlTest >> testAfterMethod2 [
+	| methodNode instance |
+	methodNode := (ReflectivityExamples >> #exampleMethod2) ast.
+	link := MetaLink new
+		metaObject: self;
+		selector: #tagExec;
+		control: #after.
+	methodNode link: link.
+	self assert: methodNode hasMetalink.
+	self assert: (ReflectivityExamples >> #exampleMethod2) class equals: ReflectiveMethod.
+	self assert: tag isNil.
+	instance := ReflectivityExamples new.
+	self assert: instance exampleMethod2 equals: instance.
+	self assert: tag equals: #yes.
+	self assert: (ReflectivityExamples >> #exampleMethod2) class equals: CompiledMethod
+]
+
 { #category : #'tests - level' }
 ReflectivityControlTest >> testAfterMethodLevel [
 	| methodNode |

src/Reflectivity-Tests/ReflectivityExamples.class.st

@@ -107,6 +107,12 @@ ReflectivityExamples >> exampleMethod [
 	^ 2 + 3
 ]
 
+{ #category : #examples }
+ReflectivityExamples >> exampleMethod2 [
+
+	2 + 3
+]
+
 { #category : #examples }
 ReflectivityExamples >> exampleMethodMultipleSites [
 	Transcript show: Object new.

src/Reflectivity-Tests/ReflectivityReificationTest.class.st

@@ -872,24 +872,22 @@ ReflectivityReificationTest >> testReifyMethodThisContextAfter [
 
 { #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.
+	| methodNode instance |
+	methodNode := (ReflectivityExamples >> #exampleMethod) ast.
 	link := MetaLink new
 		metaObject: self;
 		selector: #tagExec:;
 		control: #after;
 		arguments: #(value).
-	sendNode link: link.
-	self assert: sendNode hasMetalink.
+	methodNode link: link.
+	self assert: methodNode 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
+	self assert: tag equals: 5
 ]
 
 { #category : #'tests - assignment' }

src/Reflectivity/RFASTTranslator.class.st

@@ -24,15 +24,14 @@ RFASTTranslator >> emitMessageNode: aMessageNode [
 		ifFalse: [ valueTranslator visitNode: aMessageNode receiver ].
 	aMessageNode arguments do: [ :each | valueTranslator visitNode: each ].
 	self emitPreamble: aMessageNode.
-	self emitPrepareLinkAfter: aMessageNode.
 	self emitMetaLinkBefore: aMessageNode.
 	aMessageNode hasMetalinkInstead
 		ifTrue: [ self emitMetaLinkInstead: aMessageNode ]
 		ifFalse: [ 
 			aMessageNode isSuperSend
 				ifTrue: [ methodBuilder send: aMessageNode selector toSuperOf: self compilationContext getClass ]
 				ifFalse: [ methodBuilder send: aMessageNode selector ] ].
-	self emitMetaLinkAfter: aMessageNode.
+	self emitMetaLinkAfterNoEnsure: aMessageNode.
 ]
 
 { #category : #reflectivity }
@@ -239,8 +238,6 @@ RFASTTranslator >> visitMethodNode: aMethodNode [
 	aMethodNode pragmas do: [:each | self visitPragmaNode: each].
 	methodBuilder numArgs: aMethodNode arguments size.
 
-	self emitPrepareLinkAfter: aMethodNode.
-
 	(aMethodNode hasMetalinkInstead and: [ aMethodNode isPrimitive not ])
 				ifTrue: [ self emitMetaLinkInstead: aMethodNode. methodBuilder returnTop.
 						^self. ].
@@ -251,9 +248,9 @@ RFASTTranslator >> visitMethodNode: aMethodNode [
 			withVars: (aMethodNode scope tempVector collect: [:each| each name]) asArray.
 	].
 	effectTranslator visitNode: aMethodNode body.
+	aMethodNode isPrimitive ifFalse: [self emitMetaLinkAfterNoEnsure: aMethodNode].
+	(aMethodNode hasProperty: #wrappedPrimitive) ifTrue: [methodBuilder pushTemp: #RFValueReificationVar; returnTop].
 	aMethodNode body lastIsReturn ifFalse:  [methodBuilder pushReceiver; returnTop].
-	self emitMetaLinkAfter: aMethodNode.
-	aMethodNode hasMetalinkAfter ifTrue: [methodBuilder returnTop].
 
 ]
 

src/Reflectivity/RFASTTranslatorForEffect.class.st

@@ -129,7 +129,6 @@ RFASTTranslatorForEffect >> visitVariableNode: aVariableNode [
 
 	self emitPreamble: aVariableNode.
 	self emitMetaLinkBefore: aVariableNode.
-	self emitPrepareLinkAfter: aVariableNode.
 
 	aVariableNode hasMetalinkInstead
 		ifTrue: [ self emitMetaLinkInstead: aVariableNode ].
@@ -139,6 +138,6 @@ RFASTTranslatorForEffect >> visitVariableNode: aVariableNode [
 	(binding isLiteralVariable or: [ binding isUndeclared ])
 		ifTrue: [ methodBuilder addLiteral: binding assoc ].
 
-	self emitMetaLinkAfter: aVariableNode.
+	self emitMetaLinkAfterNoEnsure: aVariableNode.
 
 ]

src/Reflectivity/RFSemanticAnalyzer.class.st

@@ -72,6 +72,7 @@ RFSemanticAnalyzer >> visitMethodNode: aMethodNode [
 	aMethodNode scope: scope.  scope node: aMethodNode.
 	aMethodNode arguments do: [:node | self declareArgumentNode: node ].
 	aMethodNode pragmas do: [:each | self visitNode: each].
+	self declareVariableNode: (RBVariableNode named: #RFValueReificationVar).
 	self analyseForLinksForNodes: aMethodNode.
 	self visitNode: aMethodNode body.
 

src/Reflectivity/RFValueReification.class.st

@@ -71,7 +71,7 @@ RFValueReification >> genForRBMessageNode [
 
 { #category : #generate }
 RFValueReification >> genForRBMethodNode [
-	^RBVariableNode named: #RFReifyValueVar
+	^RBTemporaryNode named: #RFValueReificationVar
 ]
 
 { #category : #generate }
@@ -88,7 +88,6 @@ RFValueReification >> genForRBVariableNode [
 { #category : #generate }
 RFValueReification >> postamble: aNode [
 	(aNode isKindOf: RBProgramNode) ifFalse: [ ^#() ].
-	aNode isMethod ifTrue: [^RFStoreIntoTempNode named: 'RFReifyValueVar'. ].
 	aNode isMessage ifTrue: [^RFStoreIntoTempNode named: 'RFReifyValueVar'. ].
 	^super postamble: aNode.
 

src/Reflectivity/ReflectiveMethod.class.st

@@ -34,9 +34,9 @@ ReflectiveMethod >> ast [
 
 { #category : #evaluation }
 ReflectiveMethod >> compileAndInstallCompiledMethod [
-	(compiledMethod isRealPrimitive and: [ast hasMetalink]) ifTrue: [ self generatePrimitiveWrapper ].
+	self wrapperNeeded ifTrue: [ self generatePrimitiveWrapper ].
 	self recompileAST.
-	self installCompiledMethod.
+	self installCompiledMethod. 
 ]
 
 { #category : #accessing }
@@ -90,7 +90,7 @@ ReflectiveMethod >> flushCache [
 
 { #category : #evaluation }
 ReflectiveMethod >> generatePrimitiveWrapper [
-	| wrappedMethod send wrapperMethod |
+	| wrappedMethod send wrapperMethod assignmentNode |
 	OCASTSemanticCleaner clean: ast.
 	ast compilationContext 
 		semanticAnalyzerClass: RFSemanticAnalyzer;
@@ -103,10 +103,14 @@ ReflectiveMethod >> generatePrimitiveWrapper [
 		selector:  #rFwithArgs:executeMethod:
 		arguments: {RBArrayNode statements: ast arguments . (RFLiteralVariableNode value: wrappedMethod)}.
 
+	assignmentNode := RBAssignmentNode 
+		variable: (RBVariableNode named: #RFValueReificationVar)
+		value: send.
+
 	wrapperMethod := RBMethodNode
 		selector: ast selector
 		arguments: ast arguments 
-		body: (RBReturnNode value: send) asSequenceNode.
+		body: assignmentNode asSequenceNode.
 
 	wrapperMethod methodClass: ast methodClass.
 	wrapperMethod propertyAt: #wrappedPrimitive put: true.
@@ -330,3 +334,11 @@ ReflectiveMethod >> spotterPreviewCodeIn: aComposite [
 ReflectiveMethod >> spotterSelectFor: aStep [
 	self compiledMethod spotterSelectFor: aStep
 ]
+
+{ #category : #evaluation }
+ReflectiveMethod >> wrapperNeeded [
+	ast hasMetalink ifFalse: [ ^false ].
+	compiledMethod isRealPrimitive ifTrue: [ ^true ].
+	ast hasMetalinkAfter ifTrue: [ ^true ].
+	^false.
+]