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);
}
SmokeObject::~SmokeObject() {
#ifdef MEM_DEBUG
qDebug("%p: destructing", this);
#endif
if (_sexp) {
#ifdef MEM_DEBUG
qDebug("%p: orphaned sexp %p", this, _sexp);
#endif
orphanTable(HASHTAB(_sexp));
}
if (_internalTable) {
#ifdef MEM_DEBUG
qDebug("%p: orphaned internal table %p", this, _internalTable);
#endif
orphanTable(_internalTable);
}
if (_fieldEnv)
R_ReleaseObject(_fieldEnv);
instances.remove(_ptr);
}
SmokeObject * SmokeObject::fromSexp(SEXP sexp)
{
if (!isEnvironment(sexp))
error("Expected an environment");
return InstanceObjectTable::instanceFromSexp(HASHTAB(sexp));
}
/** Returns the hash table of an environment.
*
* @param sexp An R environment.
* @return The hash table of the R environment.
*/
CAMLprim value ocamlr_inspect_envsxp_hashtab (value sexp) {
return(Val_sexp(HASHTAB(Sexp_val(sexp))));
}