SEXP attribute_hidden do_parentenvgets(SEXP call, SEXP op, SEXP args, SEXP rho) { SEXP env, parent; checkArity(op, args); env = CAR(args); if (isNull(env)) { error(_("use of NULL environment is defunct")); env = R_BaseEnv; } else if( !isEnvironment(env) && !isEnvironment((env = simple_as_environment(env)))) error(_("argument is not an environment")); if( env == R_EmptyEnv ) error(_("can not set parent of the empty environment")); if (R_EnvironmentIsLocked(env) && R_IsNamespaceEnv(env)) error(_("can not set the parent environment of a namespace")); if (R_EnvironmentIsLocked(env) && R_IsImportsEnv(env)) error(_("can not set the parent environment of package imports")); parent = CADR(args); if (isNull(parent)) { error(_("use of NULL environment is defunct")); parent = R_BaseEnv; } else if( !isEnvironment(parent) && !isEnvironment((parent = simple_as_environment(parent)))) error(_("'parent' is not an environment")); SET_ENCLOS(env, parent); return( CAR(args) ); }
SEXP SmokeObject::createSexp(SEXP parentEnv) { SEXP env; PROTECT(env = allocSExp(ENVSXP)); SET_ENCLOS(env, parentEnv); castSexp(env); UNPROTECT(1); return env; }
SEXP SmokeObject::fieldEnv() const { if (!_fieldEnv) { _fieldEnv = allocSExp(ENVSXP); SET_ENCLOS(_fieldEnv, R_EmptyEnv); SET_FRAME(_fieldEnv, R_NilValue); R_PreserveObject(_fieldEnv); } return _fieldEnv; }
SEXP newRClosureTable(SEXP handlers) { R_ObjectTable *tb; SEXP val, klass, env; tb = (R_ObjectTable *) malloc(sizeof(R_ObjectTable)); if(!tb) error("cannot allocate space for an internal R object table"); tb->type = 15; tb->cachedNames = NULL; tb->active = TRUE; R_PreserveObject(handlers); tb->privateData = handlers; tb->exists = RClosureTable_exists; tb->get = RClosureTable_get; tb->remove = RClosureTable_remove; tb->assign = RClosureTable_assign; tb->objects = RClosureTable_objects; tb->canCache = RClosureTable_canCache; tb->onAttach = NULL; tb->onDetach = NULL; PROTECT(val = R_MakeExternalPtr(tb, Rf_install("UserDefinedDatabase"), R_NilValue)); PROTECT(klass = NEW_CHARACTER(1)); SET_STRING_ELT(klass, 0, COPY_TO_USER_STRING("UserDefinedDatabase")); SET_CLASS(val, klass); env = allocSExp(ENVSXP); SET_HASHTAB(env, val); SET_ENCLOS(env, R_GlobalEnv); setAttrib(env, R_ClassSymbol, getAttrib(HASHTAB(env), R_ClassSymbol)); UNPROTECT(2); return(env); }