SEXP do_substitute_direct(SEXP f, SEXP env)
{
SEXP s;
if (TYPEOF(env) == VECSXP)
env = NewEnvironment(R_NilValue, VectorToPairList(env), R_NilValue);
else if (TYPEOF(env) == LISTSXP)
env = NewEnvironment(R_NilValue, duplicate(env), R_NilValue);
if(TYPEOF(env) != ENVSXP)
error(_("invalid list for substitution"));
PROTECT(env);
PROTECT(f);
s = substitute(f, env);
UNPROTECT(2);
return(s);
}
/** do_newenv() : .Internal(new.env(hash, parent, size))
*
* @return a newly created environment()
*/
SEXP attribute_hidden do_newenv(SEXP call, SEXP op, SEXP args, SEXP rho)
{
SEXP enclos, size, ans;
int hash;
checkArity(op, args);
hash = asInteger(CAR(args));
args = CDR(args);
enclos = CAR(args);
if (isNull(enclos)) {
error(_("use of NULL environment is defunct"));
enclos = R_BaseEnv;
} else
if( !isEnvironment(enclos) &&
!isEnvironment((enclos = simple_as_environment(enclos))))
error(_("'enclos' must be an environment"));
if( hash ) {
args = CDR(args);
PROTECT(size = coerceVector(CAR(args), INTSXP));
if (INTEGER(size)[0] == NA_INTEGER)
INTEGER(size)[0] = 0; /* so it will use the internal default */
ans = R_NewHashedEnv(enclos, size);
UNPROTECT(1);
} else
ans = NewEnvironment(R_NilValue, R_NilValue, enclos);
return ans;
}
static pSlipEnvironment setup_environment(pSlip gd, pSlipEnvironment parent, pSlipObject params, pSlipObject args)
{
pSlipEnvironment env;
env = NewEnvironment();
dlist_ins(gd->lstGlobalEnvironment, env);
env->parent = parent;
// propagate args+params across time and space!
while (args != gd->singleton_EmptyList && params != gd->singleton_EmptyList)
{
define_variable(gd, car(params), car(args), env);
args = cdr(args);
params = cdr(params);
}
return env;
}
