RObject.h

Go to the documentation of this file.

/*CXXR $Id: RObject.h 1351 2013-03-08 15:12:28Z arr $
 *CXXR
 *CXXR This file is part of CXXR, a project to refactor the R interpreter
 *CXXR into C++.  It may consist in whole or in part of program code and
 *CXXR documentation taken from the R project itself, incorporated into
 *CXXR CXXR (and possibly MODIFIED) under the terms of the GNU General Public
 *CXXR Licence.
 *CXXR 
 *CXXR CXXR is Copyright (C) 2008-13 Andrew R. Runnalls, subject to such other
 *CXXR copyrights and copyright restrictions as may be stated below.
 *CXXR 
 *CXXR CXXR is not part of the R project, and bugs and other issues should
 *CXXR not be reported via r-bugs or other R project channels; instead refer
 *CXXR to the CXXR website.
 *CXXR */

/*
 *  R : A Computer Language for Statistical Data Analysis
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
 *  Copyright (C) 1999-2007   The R Development Core Team.
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2.1 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU Lesser General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, a copy is available at
 *  http://www.r-project.org/Licenses/
 */

#ifndef ROBJECT_H
#define ROBJECT_H

#include "R_ext/Boolean.h"
#include "CXXR/SEXPTYPE.h"

#ifdef __cplusplus

#include <boost/serialization/access.hpp>
#include <boost/serialization/base_object.hpp>
#include <boost/serialization/nvp.hpp>

#include "CXXR/GCNode_PtrS11n.hpp"
#include "CXXR/RHandle.hpp"
#include "CXXR/uncxxr.h"

namespace CXXR {
    class Environment;
    class PairList;
    class Symbol;

    class RObject : public GCNode {
    public:
        struct DoNothing {
            static void initialize(RObject*)
            {}
        };

        virtual const PairList* attributes() const;

        virtual void clearAttributes();

        virtual RObject* clone() const
        {
            return 0;
        }

        template <class T>
        static T* clone(const T* pattern)
        {
            return pattern ? static_cast<T*>(pattern->clone()) : 0;
        }

        void copyAttribute(const Symbol* name, const RObject* source)
        {
            RObject* att = source->getAttribute(name);
            if (att)
                setAttribute(name, att);
        }

        void copyAttributes(const RObject* source, bool copyS4);

        virtual RObject* evaluate(Environment* env);

        virtual RObject* getAttribute(const Symbol* name) const;

        virtual bool hasAttributes() const
        {
            return RObject::attributes() != 0;
        }

        bool hasClass() const
        {
            return m_type < 0;
        }

        bool isS4Object() const
        {
            return (m_type & s_S4_mask);
        }

        void maybeTraceMemory(const RObject* src)
        {
#ifdef R_MEMORY_PROFILING
            if (src->memoryTraced())
                traceMemory(src, 0, 0);
#endif
        }

        void maybeTraceMemory(const RObject* src1,
                              const RObject* src2)
        {
#ifdef R_MEMORY_PROFILING
            if (src1->memoryTraced() || src2->memoryTraced())
                traceMemory(src1, src2, 0);
#endif
        }

        void maybeTraceMemory(const RObject* src1,
                              const RObject* src2,
                              const RObject* src3)
        {
#ifdef R_MEMORY_PROFILING
            if (src1->memoryTraced()
                || src2->memoryTraced()
                || src3->memoryTraced())
                traceMemory(src1, src2, src3);
#endif
        }

        bool memoryTraced() const
        {
            return m_memory_traced;
        }

        virtual unsigned int packGPBits() const;

        virtual void setAttribute(const Symbol* name, RObject* value);

        void setAttributes(const PairList* new_attributes);

        void setMemoryTracing(bool on)
        {
            m_memory_traced = on;
        }

        void setS4Object(bool on);

        SEXPTYPE sexptype() const
        {
            return SEXPTYPE(m_type & s_sexptype_mask);
        }

        virtual const char* typeName() const;

        virtual void unpackGPBits(unsigned int gpbits);

        // Virtual functions of GCNode:
        void detachReferents()
        {
            m_attrib.detach();
        }

        void visitReferents(const_visitor* v) const;
    protected:
        explicit RObject(SEXPTYPE stype = CXXSXP)
            : m_type(stype & s_sexptype_mask), m_named(0),
              m_memory_traced(false), m_missing(0), m_argused(0),
              m_active_binding(false), m_binding_locked(false)
        {}

        RObject(const RObject& pattern);

        virtual ~RObject() {}
    private:
        friend class boost::serialization::access;

        static const unsigned char s_sexptype_mask = 0x3f;
        static const unsigned char s_S4_mask = 0x40;
        static const unsigned char s_class_mask = 0x80;
        signed char m_type;  // The least-significant six bits hold
          // the SEXPTYPE.  The sign bit is set if the object has a
          // class attribute.  Bit 6 is set to denote an S4 object.
    public:
        // To be private in future:
        unsigned char m_named;
    private:
        // The following field is used in connection with R functions
        // such as tracemem, and has effect only if CXXR is built with
        // R_MEMORY_PROFILING defined.  When set, it signifies that
        // when a copy is made of this object, or - more generally -
        // some comparably sized object is derived from this object,
        // this fact should be reported, and the m_memory_traced
        // property propagated to the new object.  Setting of this
        // field is not preserved in CXXR-style serialization.
        bool m_memory_traced : 1;
    public:
        // The following field is used only in connection with objects
        // inheriting from class ConsCell (and fairly rarely then), so
        // it would more logically be placed in that class (and
        // formerly was within CXXR).  It is placed here so that the
        // ubiquitous PairList objects can be squeezed into 32 bytes
        // (on 32-bit architecture), for improved cache efficiency.
        // This field is obsolescent in any case, and should be got
        // rid of entirely in due course:

        // 'Scratchpad' field used in handling argument lists,
        // formerly hosted in the 'gp' field of sxpinfo_struct.
        // Setting of this field is not preserved in CXXR-style
        // serialization.
        unsigned m_missing     : 2;
        
        // Similarly the following three obsolescent fields squeezed
        // in here are used only in connection with objects of class
        // PairList (and only rarely then), so they would more
        // logically be placed in that class (and formerly were within
        // CXXR).
        // 'Scratchpad' field used in handling argument lists,
        // formerly hosted in the 'gp' field of sxpinfo_struct.
        // Setting of this field is not preserved in CXXR-style
        // serialization.
        unsigned m_argused    : 2;

        // Used when the contents of an Environment are represented as
        // a PairList, for example during serialization and
        // deserialization, and formerly hosted in the gp field of
        // sxpinfo_struct.  Setting of these fields is not preserved
        // in CXXR-style serialization.
        bool m_active_binding : 1;
        bool m_binding_locked : 1;
    private:
        RHandle<PairList> m_attrib;

        template<class Archive>
        void serialize(Archive& ar, const unsigned int version);

#ifdef R_MEMORY_PROFILING
        // This function implements maybeTraceMemory() (qv.) when
        // memory profiling is enabled.
        void traceMemory(const RObject* src1, const RObject* src2,
                         const RObject* src3);
#endif  
    };
}  // namespace CXXR

// ***** Implementation of non-inlined templated members *****

// Fields not serialized here are handled in the constructor:
template<class Archive>
void CXXR::RObject::serialize(Archive& ar, const unsigned int version)
{
    ar & BOOST_SERIALIZATION_BASE_OBJECT_NVP(GCNode);
    unsigned int type = m_type;
    ar & BOOST_SERIALIZATION_NVP(type);
    m_type = type;
    GCNPTR_SERIALIZE(ar, m_attrib);
}

typedef CXXR::RObject *SEXP;

extern "C" {
#else /* if not __cplusplus */
    // Opaque pointer (SEXPREC doesn't exist in CXXR):
    typedef struct SEXPREC *SEXP;

#endif /* __cplusplus */

    SEXP ATTRIB(SEXP x);

    void DUPLICATE_ATTRIB(SEXP to, SEXP from);

#ifndef __cplusplus
    Rboolean IS_S4_OBJECT(SEXP x);
#else
    inline Rboolean IS_S4_OBJECT(SEXP x)
    {
        return Rboolean(x && x->isS4Object());
    }
#endif

#ifdef __cplusplus
    inline int LEVELS(SEXP x) {return x->packGPBits();}
#endif

#ifndef __cplusplus
    int NAMED(SEXP x);
#else
    inline int NAMED(SEXP x) {return x ? x->m_named : 0;}
#endif

#ifndef __cplusplus
    Rboolean OBJECT(SEXP x);
#else
    inline Rboolean OBJECT(SEXP x)
    {
        return Rboolean(x && x->hasClass());
    }
#endif

#ifdef __cplusplus
    inline int SETLEVELS(SEXP x, int v)
    {
        x->unpackGPBits(v);
        return v;
    }
#endif

    void SET_ATTRIB(SEXP x, SEXP v);

#ifndef __cplusplus
    void SET_NAMED(SEXP x, int v);
#else
    inline void SET_NAMED(SEXP x, int v)
    {
        if (!x) return;
        x->m_named = v;
    }
#endif

#ifndef __cplusplus
    void SET_S4_OBJECT(SEXP x);
#else
    inline void SET_S4_OBJECT(SEXP x)  {x->setS4Object(true);}
#endif

#ifndef __cplusplus
    SEXPTYPE TYPEOF(SEXP x);
#else
    inline SEXPTYPE TYPEOF(SEXP x)  {return x ? x->sexptype() : NILSXP;}
#endif

#ifndef __cplusplus
    void UNSET_S4_OBJECT(SEXP x);
#else
    inline void UNSET_S4_OBJECT(SEXP x)  {x->setS4Object(false);}
#endif

    void Rf_copyMostAttrib(SEXP inp, SEXP ans);

    SEXP Rf_getAttrib(SEXP vec, SEXP name);

#ifndef __cplusplus
    Rboolean Rf_isNull(SEXP s);
#else
    inline Rboolean Rf_isNull(SEXP s)
    {
        return Rboolean(!s || TYPEOF(s) == NILSXP);
    }
#endif

#ifndef __cplusplus
    Rboolean Rf_isObject(SEXP s);
#else
    inline Rboolean Rf_isObject(SEXP s)
    {
        return OBJECT(s);
    }
#endif

    SEXP Rf_setAttrib(SEXP vec, SEXP name, SEXP val);

    void maybeTraceMemory1(SEXP dest, SEXP src);

    void maybeTraceMemory2(SEXP dest, SEXP src1, SEXP src2);

    const char* Rf_type2char(SEXPTYPE st);

#ifdef __cplusplus
}
#endif

#endif /* ROBJECT_H */