[Rcpp-devel] Resolving NativeSymbolInfos from Rcpp (revisited)

[Iñaki Úcar]

2017-07-30 14:15 GMT+02:00 Dirk Eddelbuettel <edd at debian.org>:
>
> On 30 July 2017 at 02:38, Iñaki Úcar wrote:
> | One last question: would you consider adding a cppXPtr() function to
> | Rcpp? It would work as cppFunction(), but it would return a XPtr
> | instead of the function. I have a working example if you are
> | interested.
>
> "Possibly" -- API and functionality extensions are easier than changes; it
> still adds extra documentation and testing.
>
> Can you detail what you are proposing some more, show an example etc pp?

Of course. RcppDE would be a use case for this (and my simulator,
another one). Currently, the user must provide not only the C++
function, but also the adapter: a getter that instantiates an XPtr and
pushes it to R space. It is not difficult, but 1) it's not so
immediate nor intuitive, you need to instruct the user about this, and
2) it's repetitive and a nuisance.

So my proposal is to automate this. A new cppXPtr() function would
accept a single C++ function, just like cppFunction, but instead of
exporting it, it would:

- Detect the function signature. This is easy to do with some regexp,
because it should be C-compatible and you won't have to deal with more
complicated stuff like templates, etc. Example: "SEXP foo(int n,
double l) { return rexp(n, l); }" would produce

    - name: foo
    - args: (int n, double l)
    - retv: SEXP

- Construct and append a getter. For the example above,

    SEXP getXPtr() {
        typedef SEXP (*funcPtr)(int n, double l);
        return XPtr<funcPtr>(new funcPtr(&foo));
    }

- Export the getter, call it, remove the getter from the environment
and return the externalptr.

An initial implementation, reusing code (omitted) from cppFunction,
would be (please, find attached a complete example):

cppXPtr <- function(...) { # same args as cppFunction
  # get signature
  func <- strsplit(code, "[[:space:]]*\\{")[[1]][[1]]
  func <- strsplit(func, "[[:space:]]*\\(")[[1]]
  args <- func[[2]]
  func <- strsplit(func, "[[:space:]]+")[[1]]
  name <- func[[length(func)]]
  retv <- func[seq_len(length(func)-1)]

  # process depends
  # process plugins
  # remainder of scaffolding
  # prepend scaffolding to code

  # append a getter
  code <- paste(c(
    code,
    "// [[Rcpp::export]]",
    "SEXP getXPtr() {",
    paste("  typedef", retv, "(*funcPtr)(", args, ";"),
    paste("  return XPtr<funcPtr>(new funcPtr(&", name, "));"),
    "}"), collapse="\n")

  # print the generated code if we are in verbose mode
  # source cpp into specified environment

  # verify that two functions were exported and return the XPtr
  if (length(exported$functions) == 0)
    stop("No function definition found")
  else if (length(exported$functions) > 2)
    stop("More than one function definition")
  else {
    ptr <- env$getXPtr()
    rm(list=exported$functions, envir = env)
    ptr
  }
}

Iñaki
-------------- next part --------------
A non-text attachment was scrubbed...
Name: core.cpp
Type: text/x-c++src
Size: 208 bytes
Desc: not available
URL: <http://lists.r-forge.r-project.org/pipermail/rcpp-devel/attachments/20170730/17bf5085/attachment.cpp>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: cppXPtr.R
Type: application/octet-stream
Size: 3408 bytes
Desc: not available
URL: <http://lists.r-forge.r-project.org/pipermail/rcpp-devel/attachments/20170730/17bf5085/attachment.obj>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: main.R
Type: application/octet-stream
Size: 129 bytes
Desc: not available
URL: <http://lists.r-forge.r-project.org/pipermail/rcpp-devel/attachments/20170730/17bf5085/attachment-0001.obj>