diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FrameFunctions.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FrameFunctions.java
index 92fcabc74f563da3b458c40e24e9574c08849fc6..5c85b1b9bc29d2fface37cbe6ab4e0064188253a 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FrameFunctions.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/FrameFunctions.java
@@ -608,10 +608,11 @@ public class FrameFunctions {
RCaller currentCall = RArguments.getCall(f);
if (!currentCall.isPromise() && currentCall.getDepth() <= depth) {
int currentCallIdx = currentCall.getDepth() - 1;
- while (currentCall != null && (currentCall.isPromise())) {
- currentCall = currentCall.getParent();
+ RCaller parent = currentCall.getParent();
+ while (parent != null && (parent.isPromise())) {
+ parent = parent.getParent();
}
- result[currentCallIdx] = currentCall == null ? 0 : currentCall.getParent().getDepth();
+ result[currentCallIdx] = parent == null ? 0 : parent.getDepth();
}
return RArguments.getDepth(f) == 1 ? result : null;
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCaller.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCaller.java
index 19b7de0d077f7a4f3a845198579f669bc3883c41..5e73298d56c622ecf1d58e6f8c4edff9ca0b0f04 100644
--- a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCaller.java
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/RCaller.java
@@ -51,17 +51,20 @@ public final class RCaller {
* one, the reason are promises, which may be evaluated somewhere deep down the call stack, but
* their parent call frame from R prespective could be much higher up the actual execution call
* stack.
+ *
+ * Note: this is depth of the frame where this {@link RCaller} is stored, not the depth of the
+ * parent.
*/
private final int depth;
private boolean visibility;
private final RCaller parent;
/**
* The payload can be an RSyntaxNode, a {@link Supplier}, or an {@link RCaller} (which marks
- * promise evaluation frames). Payload represents the syntax (AST) of how the function was
- * invoked. If the function was invoked via regular call node, then the syntax can be that call
- * node (RSyntaxNode case), if the function was invoked by other means and we do not have the
- * actual syntax for the invocation, we only provide it lazily via Supplier, so that we do not
- * have to always construct the AST nodes.
+ * promise evaluation frames, see {@link #isPromise()}). Payload represents the syntax (AST) of
+ * how the function was invoked. If the function was invoked via regular call node, then the
+ * syntax can be that call node (RSyntaxNode case), if the function was invoked by other means
+ * and we do not have the actual syntax for the invocation, we only provide it lazily via
+ * Supplier, so that we do not have to always construct the AST nodes.
*/
private final Object payload;
@@ -102,6 +105,29 @@ public final class RCaller {
return payload != null;
}
+ /**
+ * Promise evaluation frame is artificial frame (does not exist on the R level) that is created
+ * to evaluate a promise in its context.
+ *
+ * Terminology: actual evaluation frame is a frame of the function that created the promise and
+ * the frame in whose context the promise code should be evaluated.
+ *
+ * The artificial promise evaluation frame, marked by the {@link #isPromise()} flag, wraps the
+ * actual evaluation frame in a way that locals are delegated to the actual evaluation frame,
+ * but arguments array is altered. We cannot use the actual evaluation frame as is, because when
+ * there is a function call inside the promise code, the new frame created for the invoked
+ * function will get its {@link #parent} set to {@link RCaller} and {@code depth+1} of its
+ * caller frame. By using wrapped frame for which we set different {@link #depth} than the
+ * actual evaluation frame, we can set the {@link #depth} to the correct value, which is the
+ * {@link #depth} of the code that initiated the promise evaluation.
+ *
+ * Moreover, if the promise code invokes a function, this function should be tricked into
+ * thinking that its caller is the actual evaluation frame. Since this {@link RCaller} will be
+ * used as {@link #parent} inside the frame created for the invoked function, we use
+ * {@link #isPromise()} to find out this is artificial {@link RCaller} and we should follow the
+ * {@link #getParent()} chain until we reach the actual evaluation frame and take the real
+ * parent from there.
+ */
public boolean isPromise() {
return payload instanceof RCaller;
}
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
index 3b787d3e951f582f2b95faf4ad856f155322c935..d638e4150b279cd06bc013971f512f79866b0351 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
@@ -75241,6 +75241,10 @@ NULL
#{ f <- function(x=sys.parents()) x ; g <- function() f() ; h <- function() g() ; h() }
[1] 0 1 2
+##com.oracle.truffle.r.test.builtins.TestBuiltin_sysparents.testSysParents#
+#{ f4 <- function() sys.parents(); f3 <- function(y) y; f2 <- function(x) x; f1 <- function() f2(f3(f4())); f1(); }
+[1] 0 1 1 1
+
##com.oracle.truffle.r.test.builtins.TestBuiltin_sysparents.testSysParents#
#{ sys.parents() }
integer(0)
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_sysparents.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_sysparents.java
index 27d8ecc6134151e99cc500fa4d777b304e6094df..1d0ce81d3adbe2b139d07ce181a3e3e271998673 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_sysparents.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_sysparents.java
@@ -4,7 +4,7 @@
* http://www.gnu.org/licenses/gpl-2.0.html
*
* Copyright (c) 2012-2014, Purdue University
- * Copyright (c) 2013, 2017, Oracle and/or its affiliates
+ * Copyright (c) 2013, 2018, Oracle and/or its affiliates
*
* All rights reserved.
*/
@@ -26,6 +26,7 @@ public class TestBuiltin_sysparents extends TestBase {
assertEval("{ f <- function(x=sys.parents()) x ; g <- function() f() ; h <- function() g() ; h() }");
assertEval("{ f <- function(x) x ; g <- function(y) f(y) ; h <- function(z=sys.parents()) g(z) ; h() }");
+ assertEval("{ f4 <- function() sys.parents(); f3 <- function(y) y; f2 <- function(x) x; f1 <- function() f2(f3(f4())); f1(); }");
assertEval(Ignored.ImplementationError, "{ u <- function() sys.parents() ; f <- function(x) x ; g <- function(y) f(y) ; h <- function(z=u()) g(z) ; h() }");
}