SETTER_CALL

client/rsh/src/bc2c/runtime.h

@@ -1616,7 +1616,7 @@ static INLINE void Rsh_SetterCall(Value *lhs, Value rhs, Value fun,
 
   switch (TYPEOF(fun_sxp)) {
   case BUILTINSXP:
-    // push RGS onto arguments with value tag
+    // append RHS top arguments with value tag
     RSH_LIST_APPEND_EX(args_head, args_tail, rhs, FALSE);
     RSH_SET_TAG(args_tail, SXP_TO_VAL(Rsh_ValueSym));
     RSH_CALL_ARGS_DECREMENT_LINKS(args);
@@ -1628,11 +1628,12 @@ static INLINE void Rsh_SetterCall(Value *lhs, Value rhs, Value fun,
     break;
   case SPECIALSXP: {
     PROTECT(args = Rf_duplicate(CDR(call)));
-    // insert evaluated promise for LHS as first argument
+    // replace the first argument with evaluated promise containing LHS
     // promise won't be captured so don't track references
+    // that is why we have to use the _NR version of mkEVPROMISE
     SEXP prom = R_mkEVPROMISE_NR(Rsh_TmpvalSym, lhs_sxp);
     SETCAR(args, prom);
-    // set the evalated promise for RHS as the last argument
+    // append the evalated promise for RHS as the last argument
     SEXP last = args;
     while (CDR(last) != R_NilValue) {
       last = CDR(last);
@@ -1644,6 +1645,19 @@ static INLINE void Rsh_SetterCall(Value *lhs, Value rhs, Value fun,
     UNPROTECT(1);
     break;
   }
+  case CLOSXP: {
+    // unlike in SPECIALSXP case, we need to use a RC promise
+    SEXP prom = R_mkEVPROMISE(vexpr, val_as_sexp(rhs));
+    // append RHS to arguments with value tag
+    RSH_LIST_APPEND_EX(args_head, args_tail, SXP_TO_VAL(prom), FALSE);
+    RSH_SET_TAG(args_tail, SXP_TO_VAL(Rsh_ValueSym));
+    // replace first argument with LHS value as *tmp*
+    prom = R_mkEVPROMISE(Rsh_TmpvalSym, lhs_sxp);
+    SETCAR(args, prom);
+    // call the closure
+    value = Rf_applyClosure(call, fun_sxp, args, rho, R_NilValue, TRUE);
+    break;
+  }
   default:
     Rf_error("bad function");
   }

client/rsh/src/bc2c/runtime_internals.h

@@ -64,7 +64,10 @@ int tryAssignDispatch(const char *generic, SEXP call, SEXP lhs, SEXP rhs,
                       SEXP rho, SEXP *pv);
 SEXP do_subassign_dflt(SEXP call, SEXP op, SEXP args, SEXP rho);
 SEXP do_subassign2_dflt(SEXP call, SEXP op, SEXP args, SEXP rho);
+// creates a new evaluated promise without reference counting
 SEXP R_mkEVPROMISE_NR(SEXP expr, SEXP val);
+// creates a new evaluated promise with reference counting
+SEXP R_mkEVPROMISE(SEXP expr, SEXP val);
 
 #define INTEGER_TO_LOGICAL(x)                                                  \
   ((x) == NA_INTEGER ? NA_LOGICAL : (x) ? TRUE : FALSE)

server/src/test/java/org/prlprg/bc2c/BC2CCompilerTest.java

@@ -239,6 +239,8 @@ public void testSetterCalls(BC2CSnapshot snapshot) {
         snapshot.verify("x <- c(1,2,3); names(x) <- c('a', 'b', 'c'); x");
         // test SETTER_CALL with special
         snapshot.verify("setClass('C', slots = list(x = 'numeric')); o <- new('C', x = 1); o@x <- 42; str(o)");
+        // test SETTER_CALL with closure
+        snapshot.verify("x <- data.frame(a=1); colnames(x) <- 'b'; x");
     }
 
     private TestResultCheck fastArith() {