#pragma once
#include // for strcmp
#include // for string, basic_string
#include // for forward
#include "cpp11/R.hpp" // for SEXP, SEXPREC, CDR, Rf_install, SETCAR
#include "cpp11/as.hpp" // for as_sexp
#include "cpp11/named_arg.hpp" // for named_arg
#include "cpp11/protect.hpp" // for protect, protect::function, safe
#include "cpp11/sexp.hpp" // for sexp
namespace cpp11 {
class function {
public:
function(SEXP data) : data_(data) {}
template
sexp operator()(Args&&... args) const {
// Size of the arguments plus one for the function name itself
R_xlen_t num_args = sizeof...(args) + 1;
sexp call(safe[Rf_allocVector](LANGSXP, num_args));
construct_call(call, data_, std::forward(args)...);
return safe[Rf_eval](call, R_GlobalEnv);
}
private:
SEXP data_;
template
SEXP construct_call(SEXP val, const named_arg& arg, Args&&... args) const {
SETCAR(val, arg.value());
SET_TAG(val, safe[Rf_install](arg.name()));
val = CDR(val);
return construct_call(val, std::forward(args)...);
}
// Construct the call recursively, each iteration adds an Arg to the pairlist.
// We need
template
SEXP construct_call(SEXP val, const T& arg, Args&&... args) const {
SETCAR(val, as_sexp(arg));
val = CDR(val);
return construct_call(val, std::forward(args)...);
}
// Base case, just return
SEXP construct_call(SEXP val) const { return val; }
};
class package {
public:
package(const char* name) : data_(get_namespace(name)) {}
package(const std::string& name) : data_(get_namespace(name.c_str())) {}
function operator[](const char* name) {
return safe[Rf_findFun](safe[Rf_install](name), data_);
}
function operator[](const std::string& name) { return operator[](name.c_str()); }
private:
static SEXP get_namespace(const char* name) {
if (strcmp(name, "base") == 0) {
return R_BaseEnv;
}
sexp name_sexp = safe[Rf_install](name);
return safe[Rf_findVarInFrame](R_NamespaceRegistry, name_sexp);
}
SEXP data_;
};
} // namespace cpp11