CXXR (C++ R) API
Environment.h
Go to the documentation of this file.
1 /*CXXR $Id: Environment.h 1390 2013-06-11 14:41:41Z arr $
2  *CXXR
3  *CXXR This file is part of CXXR, a project to refactor the R interpreter
4  *CXXR into C++. It may consist in whole or in part of program code and
5  *CXXR documentation taken from the R project itself, incorporated into
6  *CXXR CXXR (and possibly MODIFIED) under the terms of the GNU General Public
7  *CXXR Licence.
8  *CXXR
9  *CXXR CXXR is Copyright (C) 2008-13 Andrew R. Runnalls, subject to such other
10  *CXXR copyrights and copyright restrictions as may be stated below.
11  *CXXR
12  *CXXR CXXR is not part of the R project, and bugs and other issues should
13  *CXXR not be reported via r-bugs or other R project channels; instead refer
14  *CXXR to the CXXR website.
15  *CXXR */
16 
17 /*
18  * R : A Computer Language for Statistical Data Analysis
19  * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka
20  * Copyright (C) 1999-2006 The R Development Core Team.
21  *
22  * This program is free software; you can redistribute it and/or modify
23  * it under the terms of the GNU General Public License as published by
24  * the Free Software Foundation; either version 2.1 of the License, or
25  * (at your option) any later version.
26  *
27  * This program is distributed in the hope that it will be useful,
28  * but WITHOUT ANY WARRANTY; without even the implied warranty of
29  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
30  * GNU Lesser General Public License for more details.
31  *
32  * You should have received a copy of the GNU General Public License
33  * along with this program; if not, a copy is available at
34  * http://www.r-project.org/Licenses/
35  */
36 
41 #ifndef RENVIRONMENT_H
42 #define RENVIRONMENT_H
43 
44 #include "CXXR/RObject.h"
45 
46 #ifdef __cplusplus
47 
48 #include <boost/serialization/access.hpp>
49 #include <boost/serialization/base_object.hpp>
50 #include <boost/serialization/nvp.hpp>
51 
52 #include "CXXR/Frame.hpp"
53 #include "CXXR/GCStackRoot.hpp"
54 #include "CXXR/Symbol.h"
55 
70 #ifdef DOXYGEN
71 #define DETACH_LOCAL_FRAMES
72 #endif
73 
74 namespace CXXR {
75  class FunctionBase;
76 
94  class Environment : public RObject {
95  public:
106  class LoopScope {
107  public:
113  LoopScope(Environment* env)
114  : m_environment(env), m_prev_state(env->m_in_loop)
115  {
116  env->m_in_loop = true;
117  }
118 
119  ~LoopScope()
120  {
121  m_environment->m_in_loop = m_prev_state;
122  }
123  private:
124  GCStackRoot<Environment> m_environment;
125  bool m_prev_state;
126  };
127 
140  class ReturnScope {
141  public:
147  ReturnScope(Environment* env)
148  : m_environment(env), m_prev_state(env->m_can_return)
149  {
150  env->m_can_return = true;
151  }
152 
153  ~ReturnScope()
154  {
155  m_environment->m_can_return = m_prev_state;
156  }
157  private:
158  GCStackRoot<Environment> m_environment;
159  bool m_prev_state;
160  };
161 
169  Environment(Environment* enclosing, Frame* frame)
170  : RObject(ENVSXP), m_enclosing(enclosing), m_frame(frame),
171  m_single_stepping(false), m_locked(false), m_cached(false),
172  m_leaked(false), m_in_loop(false), m_can_return(false)
173  {}
174 
179  static Environment* base()
180  {
181  return s_base;
182  }
183 
188  static Environment* baseNamespace()
189  {
190  return s_base_namespace;
191  }
192 
200  bool canReturn() const
201  {
202  return m_can_return;
203  }
204 
225  static Environment* empty()
226  {
227  return s_empty;
228  }
229 
234  Environment* enclosingEnvironment() const
235  {
236  return m_enclosing;
237  }
238 
254 #ifdef __GNUC__
255  __attribute__((hot,fastcall))
256 #endif
257  std::pair<Environment*, Frame::Binding*>
258  findBinding(const Symbol* symbol);
259 
275  std::pair<const Environment*, const Frame::Binding*>
276  findBinding(const Symbol* symbol) const
277  {
278  EBPair ebpr = const_cast<Environment*>(this)->findBinding(symbol);
279  return std::pair<const Environment*,
280  const Frame::Binding*>(ebpr.first, ebpr.second);
281  }
282 
298  static Environment* findNamespace(const StringVector* spec);
299 
310  static Environment* findPackage(const std::string& name);
311 
316  Frame* frame()
317  {
318  return m_frame;
319  }
320 
325  const Frame* frame() const
326  {
327  return m_frame;
328  }
329 
334  static Environment* global()
335  {
336  return s_global;
337  }
338 
344  bool loopActive() const
345  {
346  return m_in_loop;
347  }
348 
364  void maybeDetachFrame()
365  {
366 #ifdef DETACH_LOCAL_FRAMES
367  if (!m_leaked)
368  detachFrame();
369 #endif
370  }
371 
389  static void monitorLeaks(const GCNode* node)
390  {
391 #ifdef DETACH_LOCAL_FRAMES
392  if (node) {
393  LeakMonitor monitor;
394  monitor(node);
395  }
396 #endif
397  }
398 
405  const StringVector* namespaceSpec() const;
406 
414  const StringVector* packageName() const;
415 
427  void setEnclosingEnvironment(Environment* new_enclos);
428 
434  void setSingleStepping(bool on)
435  {
436  m_single_stepping = on;
437  }
438 
444  bool singleStepping() const
445  {
446  return m_single_stepping;
447  }
448 
463  void slotBehind(Environment* anchor);
464 
474  void skipEnclosing();
475 
480  static const char* staticTypeName()
481  {
482  return "environment";
483  }
484 
485  // Virtual functions of RObject:
486  unsigned int packGPBits() const;
487  const char* typeName() const;
488  void unpackGPBits(unsigned int gpbits);
489 
490  // Virtual functions of GCNode:
491  void visitReferents(const_visitor* v) const;
492  protected:
493  // Virtual function of GCNode:
494  void detachReferents();
495  private:
496  friend class boost::serialization::access;
497  friend class SchwarzCounter<Environment>;
498  friend class Frame;
499 
500  // PACKAGE_ENV because PACKAGE is defined (to "R") as a macro
501  // within config.h .
502  enum S11nType {EMPTY = 0, BASE, BASENAMESPACE,
503  GLOBAL, PACKAGE_ENV, NAMESPACE, OTHER};
504 
505  struct LeakMonitor : public GCNode::const_visitor {
506  LeakMonitor()
507  {}
508 
509  // Virtual function of const_visitor:
510  void operator()(const GCNode* node);
511  };
512 
513  // The class maintains a cache of Symbol Bindings found along
514  // the search path:
515 
516  typedef std::pair<Environment*, Frame::Binding*> EBPair;
517  typedef
518  std::tr1::unordered_map<const Symbol*, EBPair,
519  std::tr1::hash<const Symbol*>,
520  std::equal_to<const Symbol*>,
521  CXXR::Allocator<std::pair<const Symbol*,
522  EBPair> >
523  > Cache;
524 
525  static Cache* s_cache;
526 
527  // Predefined environments:
528  static Environment* s_base;
529  static Environment* s_base_namespace;
530  static Environment* s_empty;
531  static Environment* s_global;
532 
533  GCEdge<Environment> m_enclosing;
534  GCEdge<Frame> m_frame;
535  bool m_single_stepping;
536  bool m_locked;
537  bool m_cached;
538  // For local environments, m_leaked is set to true to signify
539  // that the environment may continue to be reachable after the
540  // return of the Closure call that created it. It has no
541  // particular meaning for non-local environments.
542  mutable bool m_leaked;
543  bool m_in_loop;
544  bool m_can_return;
545 
546  // Not (yet) implemented. Declared to prevent
547  // compiler-generated versions:
548  Environment(const Environment&);
549  Environment& operator=(const Environment&);
550 
551  // Declared private to ensure that Environment objects are
552  // created only using 'new':
553  ~Environment()
554  {
555  if (m_cached && m_frame)
556  m_frame->decCacheCount();
557  }
558 
559  static void cleanup();
560 
561  void detachFrame();
562 
563  // Remove any mapping of 'sym' from the cache. If called with
564  // a null pointer, clear the cache entirely.
565  static void flushFromCache(const Symbol* sym);
566 
567  static void initialize();
568 
569  bool isCachePortal() const
570  {
571  return (this == s_global);
572  }
573 
574  template<class Archive>
575  void load(Archive& ar, const unsigned int version);
576 
577  // Designate this Environment as a participant in the search
578  // list cache:
579  void makeCached();
580 
581  // Warn about package possibly not being available when
582  // loading, and extract package name.
583  static const char* package_s11n_aux(const StringVector* pkg_name);
584 
585  template<class Archive>
586  void save(Archive& ar, const unsigned int version) const;
587 
588  template<class Archive>
589  void serialize (Archive & ar, const unsigned int version) {
590  boost::serialization::split_member(ar, *this, version);
591  }
592  };
593 
636  std::pair<Environment*, FunctionBase*>
637  findFunction(const Symbol* symbol, Environment* env, bool inherits = true);
638 
684  template <typename UnaryPredicate>
685  std::pair<Environment*, RObject*>
686  findTestedValue(const Symbol* symbol, Environment* env,
687  UnaryPredicate pred, bool inherits)
688  {
689  using namespace std;
690  pair<Environment*, RObject*> ans(0, 0);
691  bool found = false;
692  do {
693  Frame::Binding* bdg;
694  if (!inherits) {
695  // Note that the cache is not updated in this case:
696  bdg = env->frame()->binding(symbol);
697  } else {
698  pair<Environment*, Frame::Binding*> pr
699  = env->findBinding(symbol);
700  env = pr.first;
701  bdg = pr.second;
702  }
703  if (bdg) {
704  pair<RObject*, bool> fpr = bdg->forcedValue();
705  RObject* val = fpr.first;
706  found = pred(val);
707  if (found) {
708  // Invoke read monitor (if any) only if
709  // forcedValue() did not force a Promise. (If a
710  // Promise was forced, the read monitor will have
711  // been invoked anyway, and 'bdg' may now be
712  // junk.)
713  if (!fpr.second)
714  bdg->rawValue();
715  ans = make_pair(env, val);
716  }
717  env = env->enclosingEnvironment();
718  }
719  } while (!found && inherits && env);
720  return ans;
721  }
722 } // namespace CXXR
723 
724 BOOST_CLASS_EXPORT_KEY(CXXR::Environment)
725 
726 namespace boost {
727  namespace serialization {
745  template<class Archive>
746  void load_construct_data(Archive& ar, CXXR::Environment* t,
747  const unsigned int version)
748  {
749  new (t) CXXR::Environment(0, 0);
750  }
751  } // namespace serialization
752 } // namespace boost
753 
754 namespace {
755  CXXR::SchwarzCounter<CXXR::Environment> env_schwartz_ctr;
756 }
757 
758 // ***** Implementation of non-inlined templated members *****
759 
760 template<class Archive>
761 void CXXR::Environment::load(Archive& ar, const unsigned int version)
762 {
763  ar >> BOOST_SERIALIZATION_BASE_OBJECT_NVP(RObject);
764  S11nType envtype;
765  ar >> BOOST_SERIALIZATION_NVP(envtype);
766  Environment* reloc = 0;
767  switch(envtype) {
768  case EMPTY:
769  reloc = s_empty;
770  break;
771  case BASE:
772  reloc = s_base;
773  break;
774  case BASENAMESPACE:
775  reloc = s_base_namespace;
776  break;
777  case GLOBAL:
778  reloc = s_global;
779  break;
780  case PACKAGE_ENV:
781  {
782  std::string pkgname;
783  ar >> BOOST_SERIALIZATION_NVP(pkgname);
784  reloc = findPackage(pkgname);
785  }
786  break;
787  case NAMESPACE:
788  {
789  GCStackRoot<const StringVector> nsspec;
790  GCNPTR_SERIALIZE(ar, nsspec);
791  reloc = findNamespace(nsspec);
792  }
793  break;
794  case OTHER:
795  {
796  GCNPTR_SERIALIZE(ar, m_enclosing);
797  GCNPTR_SERIALIZE(ar, m_frame);
798  ar >> BOOST_SERIALIZATION_NVP(m_single_stepping);
799  ar >> BOOST_SERIALIZATION_NVP(m_locked);
800  }
801  break;
802  }
803  if (reloc)
804  S11nScope::defineRelocation(this, reloc);
805 }
806 
807 template<class Archive>
808 void CXXR::Environment::save(Archive& ar, const unsigned int version) const
809 {
810  ar << BOOST_SERIALIZATION_BASE_OBJECT_NVP(RObject);
811  // EMPTY:
812  if (this == s_empty) {
813  S11nType envtype = EMPTY;
814  ar << BOOST_SERIALIZATION_NVP(envtype);
815  return;
816  }
817  // BASE:
818  if (this == s_base) {
819  S11nType envtype = BASE;
820  ar << BOOST_SERIALIZATION_NVP(envtype);
821  return;
822  }
823  // BASENAMESPACE:
824  if (this == s_base_namespace) {
825  S11nType envtype = BASENAMESPACE;
826  ar << BOOST_SERIALIZATION_NVP(envtype);
827  return;
828  }
829  // GLOBAL:
830  if (this == s_global) {
831  S11nType envtype = GLOBAL;
832  ar << BOOST_SERIALIZATION_NVP(envtype);
833  return;
834  }
835  // PACKAGE_ENV:
836  const StringVector* pkgsv = packageName();
837  if (pkgsv) {
838  S11nType envtype = PACKAGE_ENV;
839  ar << BOOST_SERIALIZATION_NVP(envtype);
840  std::string pkgname(package_s11n_aux(pkgsv));
841  ar << BOOST_SERIALIZATION_NVP(pkgname);
842  return;
843  }
844  // NAMESPACE:
845  const StringVector* nsspec = namespaceSpec();
846  if (nsspec) {
847  S11nType envtype = NAMESPACE;
848  ar << BOOST_SERIALIZATION_NVP(envtype);
849  GCNPTR_SERIALIZE(ar, nsspec);
850  return;
851  }
852  // OTHER:
853  {
854  S11nType envtype = OTHER;
855  ar << BOOST_SERIALIZATION_NVP(envtype);
856  GCNPTR_SERIALIZE(ar, m_enclosing);
857  GCNPTR_SERIALIZE(ar, m_frame);
858  ar << BOOST_SERIALIZATION_NVP(m_single_stepping);
859  ar << BOOST_SERIALIZATION_NVP(m_locked);
860  }
861 }
862 
863 extern "C" {
864 #else /* if not __cplusplus */
865 
866  /* In C code, R_varloc_t is an opaque pointer: */
867  typedef struct R_varloc_st *R_varloc_t;
868 
869 #endif
870 
871  /* C-visible names for predefined environments */
872  extern SEXP R_EmptyEnv;
873  extern SEXP R_BaseEnv;
874  extern SEXP R_GlobalEnv;
875  extern SEXP R_BaseNamespace;
876 
883 #ifndef __cplusplus
884  Rboolean Rf_isEnvironment(SEXP s);
885 #else
886  inline Rboolean Rf_isEnvironment(SEXP s)
887  {
888  return Rboolean(s && TYPEOF(s) == ENVSXP);
889  }
890 #endif
891 
898 #ifndef __cplusplus
899  SEXP ENCLOS(SEXP x);
900 #else
901  inline SEXP ENCLOS(SEXP x)
902  {
903  using namespace CXXR;
904  const Environment& env = *SEXP_downcast<Environment*>(x);
905  return env.enclosingEnvironment();
906  }
907 #endif
908 
916 #ifndef __cplusplus
917  Rboolean ENV_DEBUG(SEXP x);
918 #else
919  inline Rboolean ENV_DEBUG(SEXP x)
920  {
921  using namespace CXXR;
922  const Environment& env = *SEXP_downcast<const Environment*>(x);
923  return Rboolean(env.singleStepping());
924  }
925 #endif
926 
940 #ifndef __cplusplus
941  SEXP FRAME(SEXP x);
942 #else
943  inline SEXP FRAME(SEXP x)
944  {
945  using namespace CXXR;
946  Environment* env = SEXP_downcast<Environment*>(x);
947  return env->frame()->asPairList();
948  }
949 #endif
950 
957 #ifndef __cplusplus
958  void SET_ENV_DEBUG(SEXP x, Rboolean v);
959 #else
960  inline void SET_ENV_DEBUG(SEXP x, Rboolean v)
961  {
962  using namespace CXXR;
963  Environment& env = *SEXP_downcast<Environment*>(x);
964  env.setSingleStepping(v);
965  }
966 #endif
967 
978 #ifndef __cplusplus
979  void SET_SYMVALUE(SEXP x, SEXP val);
980 #else
981  inline void SET_SYMVALUE(SEXP x, SEXP val)
982  {
983  using namespace CXXR;
984  const Symbol* sym = SEXP_downcast<Symbol*>(x);
985  Environment::base()->frame()->obtainBinding(sym)->setValue(val);
986  }
987 #endif
988 
997 #ifndef __cplusplus
998  SEXP SYMVALUE(SEXP x);
999 #else
1000  inline SEXP SYMVALUE(SEXP x)
1001  {
1002  using namespace CXXR;
1003  const Symbol* sym = SEXP_downcast<Symbol*>(x);
1004  Frame::Binding* bdg = Environment::base()->frame()->binding(sym);
1005  return bdg ? bdg->value() : Symbol::unboundValue();
1006  }
1007 #endif
1008 
1009 #ifdef __cplusplus
1010 }
1011 #endif
1012 
1013 #endif /* RENVIRONMENT_H */
Generated by   doxygen 1.8.1