00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022 #include <Rcpp/Environment.h>
00023
00024 namespace Rcpp {
00025
00026
00027
00028 struct safeAssign_s {
00029 SEXP sym, val, rho;
00030 };
00031 static void safeAssign(void *data) {
00032 struct safeAssign_s *s = (struct safeAssign_s*) data;
00033 Rf_defineVar(s->sym, s->val, s->rho);
00034 }
00035
00036 struct safeFindNamespace_s {
00037 SEXP sym, val ;
00038 };
00039 static void safeFindNamespace(void *data) {
00040 struct safeFindNamespace_s *s = (struct safeFindNamespace_s*) data;
00041 s->val = R_FindNamespace(s->sym);
00042 }
00043
00044
00045 Environment::Environment( SEXP m_sexp = R_GlobalEnv) : RObject::RObject(m_sexp){
00046 if( TYPEOF(m_sexp) != ENVSXP ){
00047 throw std::runtime_error( "not an environment" ) ;
00048 }
00049 }
00050
00051 Environment::~Environment(){
00052 logTxt( "~Environment" ) ;
00053 }
00054
00055 SEXP Environment::ls( bool all = true) const {
00056 if( is_user_database() ){
00057 R_ObjectTable *tb = (R_ObjectTable*)
00058 R_ExternalPtrAddr(HASHTAB(m_sexp));
00059 return tb->objects(tb) ;
00060 } else{
00061 Rboolean get_all = all ? TRUE : FALSE ;
00062 return R_lsInternal( m_sexp, get_all ) ;
00063 }
00064 return R_NilValue ;
00065 }
00066
00067 SEXP Environment::get( const std::string& name) const {
00068 SEXP res = Rf_findVarInFrame( m_sexp, Rf_install(name.c_str()) ) ;
00069
00070 if( res == R_UnboundValue ) return R_NilValue ;
00071
00072
00073 if( TYPEOF(res) == PROMSXP){
00074 res = Rf_eval( res, m_sexp ) ;
00075 }
00076 return res ;
00077 }
00078
00079 bool Environment::exists( const std::string& name) const{
00080 SEXP res = Rf_findVarInFrame( m_sexp, Rf_install(name.c_str()) ) ;
00081 return res != R_UnboundValue ;
00082 }
00083
00084 bool Environment::assign( const std::string& name, SEXP x = R_NilValue) const throw(binding_is_locked){
00085 if( exists( name) && bindingIsLocked(name) ) throw binding_is_locked(name) ;
00086
00087
00088
00089
00090
00091
00092 struct safeAssign_s s;
00093 s.sym = Rf_install( name.c_str() ) ;
00094 if( !s.sym || s.sym == R_NilValue ) return false ;
00095
00096 s.rho = m_sexp ;
00097 s.val = x ;
00098 return static_cast<bool>( R_ToplevelExec(safeAssign, (void*) &s) );
00099 }
00100
00101 bool Environment::isLocked() const{
00102 return R_EnvironmentIsLocked(m_sexp);
00103 }
00104
00105 bool Environment::bindingIsActive(const std::string& name) const throw(no_such_binding) {
00106 if( !exists( name) ) throw no_such_binding(name) ;
00107 return R_BindingIsActive(Rf_install(name.c_str()), m_sexp) ;
00108 }
00109
00110 bool Environment::bindingIsLocked(const std::string& name) const throw(no_such_binding) {
00111 if( !exists( name) ) throw no_such_binding(name) ;
00112 return R_BindingIsLocked(Rf_install(name.c_str()), m_sexp) ;
00113 }
00114
00115 void Environment::lock( bool bindings = false ) {
00116 R_LockEnvironment( m_sexp, bindings ? TRUE: FALSE ) ;
00117 }
00118
00119 void Environment::lockBinding(const std::string& name) throw(no_such_binding) {
00120 if( !exists( name) ) throw no_such_binding(name) ;
00121 R_LockBinding( Rf_install( name.c_str() ), m_sexp );
00122 }
00123
00124 void Environment::unlockBinding(const std::string& name) throw(no_such_binding) {
00125 if( !exists( name) ) throw no_such_binding(name) ;
00126 R_unLockBinding( Rf_install( name.c_str() ), m_sexp );
00127 }
00128
00129 bool Environment::is_user_database() const {
00130 return OBJECT(m_sexp) && Rf_inherits(m_sexp, "UserDefinedDatabase") ;
00131 }
00132
00133
00134
00135 Environment Environment::global_env() throw() {
00136 return Environment(R_GlobalEnv) ;
00137 }
00138
00139 Environment Environment::empty_env() throw() {
00140 return Environment(R_GlobalEnv) ;
00141 }
00142
00143 Environment Environment::base_env() throw(){
00144 return Environment(R_BaseEnv) ;
00145 }
00146
00147 Environment Environment::base_namespace() throw() {
00148 return Environment(R_BaseNamespace) ;
00149 }
00150
00151 Environment Environment::namespace_env(const std::string& package) throw(no_such_namespace) {
00152 struct safeFindNamespace_s s;
00153 s.sym = Rf_mkString( package.c_str() ) ;
00154 if( !s.sym || s.sym == R_NilValue || !R_ToplevelExec(safeFindNamespace, (void*) &s) ){
00155 throw no_such_namespace(package) ;
00156 }
00157 return s.val ;
00158 }
00159
00160
00161
00162 Environment::no_such_binding::no_such_binding(const std::string& binding) :
00163 message( "no such binding : '" + binding + "'" ) {}
00164 const char* Environment::no_such_binding::what() const throw(){
00165 return message.c_str() ;
00166 }
00167 Environment::no_such_binding::~no_such_binding() throw() {}
00168
00169 Environment::binding_is_locked::binding_is_locked(const std::string& binding) :
00170 message("binding is locked : '" + binding + "'" ) {}
00171 const char* Environment::binding_is_locked::what() const throw(){
00172 return message.c_str() ;
00173 }
00174 Environment::binding_is_locked::~binding_is_locked() throw() {}
00175
00176 Environment::no_such_namespace::no_such_namespace(const std::string& package) :
00177 message("no such namespace : '" + package + "'" ) {}
00178 const char* Environment::no_such_namespace::what() const throw(){
00179 return message.c_str() ;
00180 }
00181 Environment::no_such_namespace::~no_such_namespace() throw() {}
00182
00183 }
00184