Search code examples
crrcpp

passing unevaluated expressions to C/C++


I'd like to pass a variable number of arguments from a function to C/C++, but would like to leave the arguments unevaluated and at the same time don't want to do any computations in R (aside from calling the C/C++ function), i.e. I don't want to call substitute in my R function. One option for this that I thought I could use is .External and doing smth like this:

R_fn = function(...) .External("cpp_fn", ...)

...
# and in C code:
SEXP cpp_fn (SEXP arglist) {
}

However .External is evaluating arguments in ..., so if I try something like

rm(x, y) # just making sure these don't exist

R_fn(x*y)

I get an error because R is trying to evaluate x*y before sending it to the function.

To contrast, the following works in R:

f = function(...) g(...)
g = function(x, ...) print(substitute(x))

f(x*y*z)
# x * y * z

What other options do I have? Clearly it's possible to do as R itself does it for a number of functions, e.g. substitute itself, but I don't understand how to do it. I added the rcpp tag because my eventual usage of this is going to be in Rcpp.


Solution

  • One possibility is to do what match.call does (thanks to Ricardo Saporta for pointing me in that direction). This requires copy-pasting a few definitions from R source code that I won't do here, but the basic idea is to get the calling function from R_GlobalContext and then extract the function arguments from there. The rough sketch is as follows:

    R_fn = function(...) .Call("cpp_fn")
    
    // and in C++ code
    Language cpp_fn() {
      SEXP sysp = ((RCNTXT*)R_GlobalContext)->sysparent;
      RCNTXT *cptr = (RCNTXT*)R_GlobalContext;
    
      while (cptr != NULL) {
        if (cptr->callflag & CTXT_FUNCTION && cptr->cloenv == sysp)
          break;
        cptr = cptr->nextcontext;
      }
      cptr = cptr->nextcontext; // because this is called from .Call and not from R_fn
    
      // and now cptr->promargs has the unevaluated arguments to do as one pleases
      // e.g.
      Language firstArg(R_PromiseExpr(CAR(cptr->promargs)));
    
      return firstArg;
    }