What if we want to implement the function to be optimized as R code. This is certainly more convenient to our work flow as we do not have to step away from R and write the code in C, compile and debug it and then load it. We might have our likelihood function as something like

lik = function(theta) 
        sum(log(dexp(data, theta)))

or using a closure to avoid the global variable data

likGenerator = 
 function(data)
    function(theta) 
        sum(log(dexp(data, theta)))

and the

myLik = likGenerator(myData)

We want to pass this as the

userData

argument to optimize and arrange for the C routine we pass as the C routine pointer argument -

fun

- to take the candidate value and the user data (the R function) and to turn this into a call to the R function which will evaluate the likelihood. To do this, we need to create this C routine to call our function. If we were to write it by hand, it might look something like the following:

double
R_myFun(double val, void *data)
{
    SEXP call, ans;
    PROTECT( call = allocVector(LANGSXP, 2));
    SETCAR(call, (SEXP) data);
    SETCAR(CDR(call), ScalarReal(val));
    ans = Rf_eval(call, R_GlobalEnv);
    UNPROTECT(1);
    return(asReal(ans));
}

This creates a call to a function and inserts the function and the candidate value as R objects. Then it evaluates the call and converts the result to a numeric scalar and returns the value.

We can use this in our call to optimize as

fun.ptr =  getNativeSymbolInfo("R_myFun")$address
callCIF(cif, "optimize", 2.3, fun.ptr, myLik)

The optimize routine has no knowledge that R was called to evaluate the function. Instead it has merely invoked our routine R_myFun.

Note that the routine R_myFun was created to have the same signature as the function pointer expected by optimize. Furthermore, the body of the routine would be different and more involved if there were additional parameters of different types in the routine that in turn had to be passed to the R function. So what we would like is a mechanism to automate the create of such a wrapper routine. We can do this with a description of the signature and data types in the function pointer. But we cannot arrange to have the routine called unless we compile and load it.

We can generate the code in R from the CIF types or from the translation unit description of the function pointer. After we do this and write it to a file, we then compile and load the code and continue as if we had written the code manually, as above. So let's now focus on how we generate this routine using functionality in RGCCTranslationUnit.

See funPtrTU.R We will write a function that takes an description of a function pointer from the translation unit and generates a wrapper routine that calls an R function. The function needs the description of the function pointer, the name of the new routine to create and may require the caller to specify which parameter refers to the R function, i.e. the user data passed to the routine. The function generates code very similar to that in the R_myFun code above. It creates an R data structure to represent the call with one less arguments than the number of parameters passed to the actual routine. This is because we don't pass the user data to R since this is the R function object. Our routine then adds the corresponding R value for each of the parameters in the routine to the call. Then it invokes the call with Rf_eval. The final step is to convert the R object returned from the R function to the appropriate C representation. Within the code, there are declarations of local variables and simple R memory management.

# This is for runFunPtr in ../../src/test.c - not the optimize() in the paper.

createCallRFunctionWrapper =
function(funPtr,    # the description of the function pointer - class FunctionPointer
         funcName,  # name of the routine we create
                    # index of parameter that is the user data containing the R function SEXP
         userDataParam = findUserDataParam(funPtr),
                    # names to use for the parameters of the routine
         paramNames = names(funPtr@parmeters))
{
        # So we have an explicit representation for a FunctionPointer
        # We have the return type and the parameters. From these we can
        # define our wrapper routine
  if(length(names(funPtr@parameters)) == 0)  #?  NULL since the TU loses them - yes!
      names(funPtr@parameters) = paste("x", seq(along = funPtr@parameters), sep = "")


     # Now create the body of the routine first.
   params = funPtr@parameters
   body = c(
                  # local variables
             "SEXP call, ans, ptr;", 

                  # create the call
             sprintf("PROTECT(ptr = call = allocVector(LANGSXP, %d));", length(params)),

                  # put the function into the first element of the call
             sprintf("SETCAR(ptr, (SEXP) %s); ptr = CDR(ptr);", names(params)[ userDataParam ]),
                  # add each of the parameters, except the userDataParam
             mapply(function(id, parm)
                       sprintf("SETCAR(ptr, %s); ptr = CDR(ptr);", convertValueToR(id, parm@type)),
                    names(params)[ - userDataParam], params[ - userDataParam]),

                  # invoke the call
             "ans = Rf_eval(call, R_GlobalEnv);",
  
             "UNPROTECT(1);",
                  # conver the result back to a C value
             sprintf("return(%s);", gsub(";$", "", convertRValue("",  "ans", funPtr@returnType)))
            )

       # Now we have to get its declaration or signature to add to the top of the body
   ret = getNativeDeclaration("", funPtr@returnType, addSemiColon = FALSE)
   decl = mapply(getNativeDeclaration, names(params),
                                       lapply(params, function(x) x@type),
                  MoreArgs = list(addSemiColon = FALSE))


       # put the pieces of the code together into a character vector
  c(ret,
      sprintf("%s(%s)", funcName, paste(decl, collapse = ", ")),
      "{",
      paste("    ", body),
      "}")

}

We can now call this code for our particular example and then test it.

library(RGCCTranslationUnit)
 # read the TU file
tu = parseTU("../TU/test.c.001t.tu")
 # find only the routines in files that start with test
r = getRoutines(tu, "test")
 # get the routine of interest
f = r$runFunPtr
 # resolve all the data types referenced in the routine
f = resolveType(f, tu)

 # Verify the types interactively
sapply(f$parameters, class)
sapply(f$parameters, function(x) class(x$type))

 # Get the function pointer type parameter
funPtr = f$parameters[["fun"]]$type
class(funPtr) == "FunctionPointer"

  # Now we generate the wrapper routine, sourceing the function to do this
  # and then invoking it with the relevant arguments.
source("funPtrTU.R")
code = createCallRFunctionWrapper(funPtr, "R_myFun2", 2, paramNames = c("value", "userData"))
  # Write the generated code along with the necessary C header files
cat("#include <Rdefines.h>",
    code,
    sep = "\n", file = "foo.c")


    # Compile the foo.c into a DSO
  system(sprintf("%s/bin/R CMD SHLIB foo.c", R.home()))

    # load the resulting DSO
  dyn.load("foo.so")
    # get a reference to the newly generated routine which we
    # can pass as the function pointer argument.
  f = getNativeSymbolInfo("R_myFun2")$address

     # Define the R function that will be called each iteration
  myFun = function(val)
               val + 1

    # Now we can invoke the original C routine and pass our function pointer - R_myFun2
    # and our R function - myFun. We create the CIF first and then invoke it.
  library(Rffi)
  cif = CIF(doubleType, list(sint32Type, doubleType, pointerType, pointerType), rep(FALSE, 4))

  ans = callCIF(cif, "runFunPtr", 3, pi, f, myFun)
  print(ans)

We want to illustrate a different approach than generating C code via RGCCTranslationUnit. Instead of assuming the machine has a compiler such as gcc and having to invoke it and get the compilation and linker flags set appropriately or call the SHLIB command in R, we want to compile and load the code directly within in R. The Rllvm package allows us to do this.

Rllvm is an interface to the low-level virtual machine software that can portably generate machine code on different computer architectures. Within R, we can create descriptions of the definitions (not just declarations) of native routines and have llvm generate the machine code to implement those within the R process. So we can generate the implementation of of R_myFun as we would write it above and then use the routine directly within R without calls to a compiler, etc. And we can do this for arbitrary function pointer signatures.

Using the C code above as a template, we can generate the Rllvm code to define the equivalent routine.

There is no doubt that this is a complex task. We are working with the instruction set of a low-level virtual machine. This makes writing C code seem terse, let alone R code. The point of this example is not to suggest this is how R users should consider writing wrapper routines for passing R functions as C function pointers. Instead, the aim is to illustrate that this can be automated using RGCCTranslationUnit and Rllvm and can be used via Rllvm. My hope is that advanced users will be able to explore additional uses of these powerful underlying technologies and the R interfaces to them.