SEXP rpy_findFun(SEXP symbol, SEXP rho)
{
SEXP vl;
while (rho != R_EmptyEnv) {
/* This is not really right. Any variable can mask a function */
vl = findVarInFrame3(rho, symbol, TRUE);
if (vl != R_UnboundValue) {
if (TYPEOF(vl) == PROMSXP) {
PROTECT(vl);
vl = eval(vl, rho);
UNPROTECT(1);
}
if (TYPEOF(vl) == CLOSXP || TYPEOF(vl) == BUILTINSXP ||
TYPEOF(vl) == SPECIALSXP)
return (vl);
if (vl == R_MissingArg) {
printf("R_MissingArg in rpy_FindFun.\n");
return R_UnboundValue;
}
}
rho = ENCLOS(rho);
}
return R_UnboundValue;
}
SEXP attribute_hidden do_parentenv(SEXP call, SEXP op, SEXP args, SEXP rho)
{
checkArity(op, args);
SEXP arg = CAR(args);
if( !isEnvironment(arg) &&
!isEnvironment((arg = simple_as_environment(arg))))
error( _("argument is not an environment"));
if( arg == R_EmptyEnv )
error(_("the empty environment has no parent"));
return( ENCLOS(arg) );
}
static Rboolean R_IsImportsEnv(SEXP env)
{
if (isNull(env) || !isEnvironment(env))
return FALSE;
if (ENCLOS(env) != R_BaseNamespace)
return FALSE;
SEXP name = getAttrib(env, R_NameSymbol);
if (!isString(name) || length(name) != 1)
return FALSE;
const char *imports_prefix = "imports:";
const char *name_string = CHAR(STRING_ELT(name, 0));
if (!strncmp(name_string, imports_prefix, strlen(imports_prefix)))
return TRUE;
else
return FALSE;
}
/** Returns the enclosing environment of an environment.
*
* @param sexp An R environment.
* @return The enclosing environmnent of the R environment.
*/
CAMLprim value ocamlr_inspect_envsxp_enclos (value sexp) {
return(Val_sexp(ENCLOS(Sexp_val(sexp))));
}
