CXXR (C++ R)
RObject.h
Go to the documentation of this file.
1 /*CXXR $Id: RObject.h 1351 2013-03-08 15:12:28Z 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-2007 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 
42 #ifndef ROBJECT_H
43 #define ROBJECT_H
44 
45 #include "R_ext/Boolean.h"
46 #include "CXXR/SEXPTYPE.h"
47 
48 #ifdef __cplusplus
49 
50 #include <boost/serialization/access.hpp>
51 #include <boost/serialization/base_object.hpp>
52 #include <boost/serialization/nvp.hpp>
53 
54 #include "CXXR/GCNode_PtrS11n.hpp"
55 #include "CXXR/RHandle.hpp"
56 #include "CXXR/uncxxr.h"
57 
62 namespace CXXR {
63  class Environment;
64  class PairList;
65  class Symbol;
66 
169  class RObject : public GCNode {
170  public:
176  struct DoNothing {
179  static void initialize(RObject*)
180  {}
181  };
182 
191  virtual const PairList* attributes() const;
192 
195  virtual void clearAttributes();
196 
221  virtual RObject* clone() const
222  {
223  return 0;
224  }
225 
236  template <class T>
237  static T* clone(const T* pattern)
238  {
239  return pattern ? static_cast<T*>(pattern->clone()) : 0;
240  }
241 
252  void copyAttribute(const Symbol* name, const RObject* source)
253  {
254  RObject* att = source->getAttribute(name);
255  if (att)
256  setAttribute(name, att);
257  }
258 
269  void copyAttributes(const RObject* source, bool copyS4);
270 
278  virtual RObject* evaluate(Environment* env);
279 
292  virtual RObject* getAttribute(const Symbol* name) const;
293 
302  virtual bool hasAttributes() const
303  {
304  return RObject::attributes() != 0;
305  }
306 
311  bool hasClass() const
312  {
313  return m_type < 0;
314  }
315 
320  bool isS4Object() const
321  {
322  return (m_type & s_S4_mask);
323  }
324 
342  void maybeTraceMemory(const RObject* src)
343  {
344 #ifdef R_MEMORY_PROFILING
345  if (src->memoryTraced())
346  traceMemory(src, 0, 0);
347 #endif
348  }
349 
368  void maybeTraceMemory(const RObject* src1,
369  const RObject* src2)
370  {
371 #ifdef R_MEMORY_PROFILING
372  if (src1->memoryTraced() || src2->memoryTraced())
373  traceMemory(src1, src2, 0);
374 #endif
375  }
376 
397  void maybeTraceMemory(const RObject* src1,
398  const RObject* src2,
399  const RObject* src3)
400  {
401 #ifdef R_MEMORY_PROFILING
402  if (src1->memoryTraced()
403  || src2->memoryTraced()
404  || src3->memoryTraced())
405  traceMemory(src1, src2, src3);
406 #endif
407  }
408 
422  bool memoryTraced() const
423  {
424  return m_memory_traced;
425  }
426 
442  virtual unsigned int packGPBits() const;
443 
456  virtual void setAttribute(const Symbol* name, RObject* value);
457 
474  void setAttributes(const PairList* new_attributes);
475 
490  void setMemoryTracing(bool on)
491  {
492  m_memory_traced = on;
493  }
494 
503  void setS4Object(bool on);
504 
510  {
511  return SEXPTYPE(m_type & s_sexptype_mask);
512  }
513 
519  virtual const char* typeName() const;
520 
536  virtual void unpackGPBits(unsigned int gpbits);
537 
538  // Virtual functions of GCNode:
540  {
541  m_attrib.detach();
542  }
543 
544  void visitReferents(const_visitor* v) const;
545  protected:
549  explicit RObject(SEXPTYPE stype = CXXSXP)
550  : m_type(stype & s_sexptype_mask), m_named(0),
551  m_memory_traced(false), m_missing(0), m_argused(0),
552  m_active_binding(false), m_binding_locked(false)
553  {}
554 
559  RObject(const RObject& pattern);
560 
561  virtual ~RObject() {}
562  private:
563  friend class boost::serialization::access;
564 
565  static const unsigned char s_sexptype_mask = 0x3f;
566  static const unsigned char s_S4_mask = 0x40;
567  static const unsigned char s_class_mask = 0x80;
568  signed char m_type; // The least-significant six bits hold
569  // the SEXPTYPE. The sign bit is set if the object has a
570  // class attribute. Bit 6 is set to denote an S4 object.
571  public:
572  // To be private in future:
573  unsigned char m_named;
574  private:
575  // The following field is used in connection with R functions
576  // such as tracemem, and has effect only if CXXR is built with
577  // R_MEMORY_PROFILING defined. When set, it signifies that
578  // when a copy is made of this object, or - more generally -
579  // some comparably sized object is derived from this object,
580  // this fact should be reported, and the m_memory_traced
581  // property propagated to the new object. Setting of this
582  // field is not preserved in CXXR-style serialization.
583  bool m_memory_traced : 1;
584  public:
585  // The following field is used only in connection with objects
586  // inheriting from class ConsCell (and fairly rarely then), so
587  // it would more logically be placed in that class (and
588  // formerly was within CXXR). It is placed here so that the
589  // ubiquitous PairList objects can be squeezed into 32 bytes
590  // (on 32-bit architecture), for improved cache efficiency.
591  // This field is obsolescent in any case, and should be got
592  // rid of entirely in due course:
593 
594  // 'Scratchpad' field used in handling argument lists,
595  // formerly hosted in the 'gp' field of sxpinfo_struct.
596  // Setting of this field is not preserved in CXXR-style
597  // serialization.
598  unsigned m_missing : 2;
599 
600  // Similarly the following three obsolescent fields squeezed
601  // in here are used only in connection with objects of class
602  // PairList (and only rarely then), so they would more
603  // logically be placed in that class (and formerly were within
604  // CXXR).
605  // 'Scratchpad' field used in handling argument lists,
606  // formerly hosted in the 'gp' field of sxpinfo_struct.
607  // Setting of this field is not preserved in CXXR-style
608  // serialization.
609  unsigned m_argused : 2;
610 
611  // Used when the contents of an Environment are represented as
612  // a PairList, for example during serialization and
613  // deserialization, and formerly hosted in the gp field of
614  // sxpinfo_struct. Setting of these fields is not preserved
615  // in CXXR-style serialization.
616  bool m_active_binding : 1;
617  bool m_binding_locked : 1;
618  private:
619  RHandle<PairList> m_attrib;
620 
621  template<class Archive>
622  void serialize(Archive& ar, const unsigned int version);
623 
624 #ifdef R_MEMORY_PROFILING
625  // This function implements maybeTraceMemory() (qv.) when
626  // memory profiling is enabled.
627  void traceMemory(const RObject* src1, const RObject* src2,
628  const RObject* src3);
629 #endif
630  };
631 } // namespace CXXR
632 
633 // ***** Implementation of non-inlined templated members *****
634 
635 // Fields not serialized here are handled in the constructor:
636 template<class Archive>
637 void CXXR::RObject::serialize(Archive& ar, const unsigned int version)
638 {
639  ar & BOOST_SERIALIZATION_BASE_OBJECT_NVP(GCNode);
640  unsigned int type = m_type;
641  ar & BOOST_SERIALIZATION_NVP(type);
642  m_type = type;
643  GCNPTR_SERIALIZE(ar, m_attrib);
644 }
645 
658 
659 extern "C" {
660 #else /* if not __cplusplus */
661  // Opaque pointer (SEXPREC doesn't exist in CXXR):
662  typedef struct SEXPREC *SEXP;
663 
664 #endif /* __cplusplus */
665 
673  SEXP ATTRIB(SEXP x);
674 
683  void DUPLICATE_ATTRIB(SEXP to, SEXP from);
684 
692 #ifndef __cplusplus
693  Rboolean IS_S4_OBJECT(SEXP x);
694 #else
695  inline Rboolean IS_S4_OBJECT(SEXP x)
696  {
697  return Rboolean(x && x->isS4Object());
698  }
699 #endif
700 
703 #ifdef __cplusplus
704  inline int LEVELS(SEXP x) {return x->packGPBits();}
705 #endif
706 
714 #ifndef __cplusplus
715  int NAMED(SEXP x);
716 #else
717  inline int NAMED(SEXP x) {return x ? x->m_named : 0;}
718 #endif
719 
727 #ifndef __cplusplus
728  Rboolean OBJECT(SEXP x);
729 #else
730  inline Rboolean OBJECT(SEXP x)
731  {
732  return Rboolean(x && x->hasClass());
733  }
734 #endif
735 
738 #ifdef __cplusplus
739  inline int SETLEVELS(SEXP x, int v)
740  {
741  x->unpackGPBits(v);
742  return v;
743  }
744 #endif
745 
764  void SET_ATTRIB(SEXP x, SEXP v);
765 
775 #ifndef __cplusplus
776  void SET_NAMED(SEXP x, int v);
777 #else
778  inline void SET_NAMED(SEXP x, int v)
779  {
780  if (!x) return;
781  x->m_named = v;
782  }
783 #endif
784 
788 #ifndef __cplusplus
789  void SET_S4_OBJECT(SEXP x);
790 #else
791  inline void SET_S4_OBJECT(SEXP x) {x->setS4Object(true);}
792 #endif
793 
800 #ifndef __cplusplus
801  SEXPTYPE TYPEOF(SEXP x);
802 #else
803  inline SEXPTYPE TYPEOF(SEXP x) {return x ? x->sexptype() : NILSXP;}
804 #endif
805 
809 #ifndef __cplusplus
810  void UNSET_S4_OBJECT(SEXP x);
811 #else
812  inline void UNSET_S4_OBJECT(SEXP x) {x->setS4Object(false);}
813 #endif
814 
832  void Rf_copyMostAttrib(SEXP inp, SEXP ans);
833 
851  SEXP Rf_getAttrib(SEXP vec, SEXP name);
852 
861 #ifndef __cplusplus
862  Rboolean Rf_isNull(SEXP s);
863 #else
864  inline Rboolean Rf_isNull(SEXP s)
865  {
866  return Rboolean(!s || TYPEOF(s) == NILSXP);
867  }
868 #endif
869 
877 #ifndef __cplusplus
878  Rboolean Rf_isObject(SEXP s);
879 #else
880  inline Rboolean Rf_isObject(SEXP s)
881  {
882  return OBJECT(s);
883  }
884 #endif
885 
907  SEXP Rf_setAttrib(SEXP vec, SEXP name, SEXP val);
908 
919  void maybeTraceMemory1(SEXP dest, SEXP src);
920 
933  void maybeTraceMemory2(SEXP dest, SEXP src1, SEXP src2);
934 
943  const char* Rf_type2char(SEXPTYPE st);
944 
945 #ifdef __cplusplus
946 }
947 #endif
948 
949 #endif /* ROBJECT_H */