CachedExtractVector node evaluates promises extracted from environments.

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/access/vector/CachedExtractVectorNode.java

@@ -37,6 +37,7 @@ import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetDimNa
 import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetNamesAttributeNode;
 import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.SetDimAttributeNode;
 import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.SetDimNamesAttributeNode;
+import com.oracle.truffle.r.nodes.function.PromiseHelperNode;
 import com.oracle.truffle.r.nodes.profile.AlwaysOnBranchProfile;
 import com.oracle.truffle.r.nodes.profile.VectorLengthProfile;
 import com.oracle.truffle.r.runtime.RError;
@@ -49,6 +50,7 @@ import com.oracle.truffle.r.runtime.data.RLanguage;
 import com.oracle.truffle.r.runtime.data.RList;
 import com.oracle.truffle.r.runtime.data.RLogical;
 import com.oracle.truffle.r.runtime.data.RNull;
+import com.oracle.truffle.r.runtime.data.RPromise;
 import com.oracle.truffle.r.runtime.data.RString;
 import com.oracle.truffle.r.runtime.data.RStringVector;
 import com.oracle.truffle.r.runtime.data.RTypedValue;
@@ -86,6 +88,7 @@ final class CachedExtractVectorNode extends CachedVectorNode {
     @Child private ExtractDimNamesNode extractDimNames;
 
     private final ConditionProfile resultHasDimensions = ConditionProfile.createBinaryProfile();
+    private final ConditionProfile promiseInEnvironment = ConditionProfile.createBinaryProfile();
 
     /**
      * Profile if any metadata was applied at any point in time. This is useful extract primitive
@@ -254,6 +257,9 @@ final class CachedExtractVectorNode extends CachedVectorNode {
         String positionString = tryCastSingleString(positionsCheckNode, positions);
         if (positionString != null) {
             Object obj = env.get(positionString);
+            if (promiseInEnvironment.profile(obj instanceof RPromise)) {
+                obj = PromiseHelperNode.evaluateSlowPath(null, (RPromise) obj);
+            }
             return obj == null ? RNull.instance : obj;
         }
         throw error(RError.Message.WRONG_ARGS_SUBSET_ENV);

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/builtin/InternalNode.java

@@ -43,6 +43,7 @@ import com.oracle.truffle.r.runtime.context.RContext;
 import com.oracle.truffle.r.runtime.data.RArgsValuesAndNames;
 import com.oracle.truffle.r.runtime.data.REmpty;
 import com.oracle.truffle.r.runtime.data.RFunction;
+import com.oracle.truffle.r.runtime.data.RPromise;
 import com.oracle.truffle.r.runtime.data.model.RAbstractStringVector;
 import com.oracle.truffle.r.runtime.nodes.RBaseNode;
 import com.oracle.truffle.r.runtime.nodes.RNode;
@@ -245,6 +246,7 @@ public abstract class InternalNode extends OperatorNode {
             Object[] args = new Object[arguments.length];
             for (int i = 0; i < args.length; i++) {
                 args[i] = arguments[i].execute(frame);
+                assert !(args[i] instanceof RPromise);
             }
             return args;
         }
@@ -273,6 +275,7 @@ public abstract class InternalNode extends OperatorNode {
                     value = forcePromises(frame, (RArgsValuesAndNames) value);
                 }
                 args[i] = value;
+                assert !(args[i] instanceof RPromise);
             }
             return args;
         }
@@ -281,6 +284,7 @@ public abstract class InternalNode extends OperatorNode {
             Object[] array = new Object[varArgs.getLength()];
             for (int i = 0; i < array.length; i++) {
                 array[i] = promiseHelper.checkEvaluate(frame, varArgs.getArgument(i));
+                assert !(array[i] instanceof RPromise);
             }
             return new RArgsValuesAndNames(array, varArgs.getSignature());
         }
@@ -303,10 +307,12 @@ public abstract class InternalNode extends OperatorNode {
 
             for (int i = 0; i < args.length - 1; i++) {
                 args[i] = arguments[i].execute(frame);
+                assert !(args[i] instanceof RPromise);
             }
             Object[] varArgs = new Object[arguments.length - (factory.getSignature().getLength() - 1)];
             for (int i = 0; i < varArgs.length; i++) {
                 varArgs[i] = arguments[args.length - 1 + i].execute(frame);
+                assert !(varArgs[i] instanceof RPromise);
             }
             args[args.length - 1] = new RArgsValuesAndNames(varArgs, ArgumentsSignature.empty(varArgs.length));
             return args;

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test

@@ -78624,6 +78624,14 @@ Error in rm("foo", envir = baseenv()) :
 #{ x <- 1; lockBinding("x", globalenv()); x <- 1 }
 Error: cannot change value of locked binding for 'x'
+##com.oracle.truffle.r.test.library.base.TestEnvironments.testFrameToEnv#
+#{ makefun <- function(f) function(a) f(a); .Internal(islistfactor(environment(makefun(function(b) 2*b))$f, F)); }
+[1] FALSE
+
+##com.oracle.truffle.r.test.library.base.TestEnvironments.testFrameToEnv#
+#{ makefun <- function(f,s) function(a) f(a); s <- function() cat('side effect'); .Internal(islistfactor(environment(makefun(function(b) 2*b, s()))$f, F)); }
+[1] FALSE
+
 ##com.oracle.truffle.r.test.library.base.TestEnvironments.testFrames#
 #{ t1 <- function() {  aa <- 1; t2 <- function() { cat("current frame is", sys.nframe(), "; "); cat("parents are frame numbers", sys.parents(), "; "); print(ls(envir = sys.frame(-1))) };  t2() }; t1() }
 current frame is 2 ; parents are frame numbers 0 1 ; [1] "aa" "t2"
@@ -130695,7 +130703,7 @@ Error in attr(to, "a") <- "a" : external object cannot be attributed
 #if (length(grep("FastR", R.Version()$version.string)) != 1) { cat('Error in attr(to, which = "a") : external object cannot be attributed<<<NEWLINE>>>') } else { to <- .fastr.interop.new(.fastr.java.class('com.oracle.truffle.r.test.library.fastr.TestJavaInterop$TestClass')); attr(to, which = 'a') }
 Error in attr(to, which = "a") : external object cannot be attributed
-##com.oracle.truffle.r.test.library.fastr.TestJavaInterop.testClassAsParameter#
+##com.oracle.truffle.r.test.library.fastr.TestJavaInterop.testClassAsParameter#Ignored.ImplementationError#
 #if (length(grep("FastR", R.Version()$version.string)) != 1) { "com.oracle.truffle.r.test.library.fastr.TestJavaInterop$TestClass" } else { tc <- .fastr.java.class('com.oracle.truffle.r.test.library.fastr.TestJavaInterop$TestClass'); t <- .fastr.interop.new(tc); t$classAsArg(tc) }
 [1] "com.oracle.truffle.r.test.library.fastr.TestJavaInterop$TestClass"

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/base/TestEnvironments.java

@@ -4,7 +4,7 @@
  * http://www.gnu.org/licenses/gpl-2.0.html
  *
  * Copyright (c) 2012-2014, Purdue University
- * Copyright (c) 2013, 2016, Oracle and/or its affiliates
+ * Copyright (c) 2013, 2017, Oracle and/or its affiliates
  *
  * All rights reserved.
  */
@@ -285,4 +285,12 @@ public class TestEnvironments extends TestBase {
         assertEval("{ e <- new.env(); assign(\"x\", 1, e); attach(e, 2); x; detach(2); x }");
         assertEval("{ detach(\"missing\"); x }");
     }
+
+    @Test
+    public void testFrameToEnv() {
+        // Note: islistfactor is internal and should fail if it gets promise directly
+        assertEval("{ makefun <- function(f) function(a) f(a); .Internal(islistfactor(environment(makefun(function(b) 2*b))$f, F)); }");
+        // Turning frame into an environment should not evaluate all the promises:
+        assertEval("{ makefun <- function(f,s) function(a) f(a); s <- function() cat('side effect'); .Internal(islistfactor(environment(makefun(function(b) 2*b, s()))$f, F)); }");
+    }
 }