ConsCell.h

Go to the documentation of this file.

/*CXXR $Id: ConsCell.h 1353 2013-03-18 16:59:38Z 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-2006   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 CONSCELL_H
#define CONSCELL_H

#include "CXXR/RObject.h"

#ifdef __cplusplus

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

#include "CXXR/GCRoot.h"
#include "CXXR/SEXP_downcast.hpp"

namespace CXXR {
    class PairList;

    class ConsCell : public RObject {
    public:
        class iterator
            : public std::iterator<std::forward_iterator_tag, ConsCell> {
        public:
            explicit iterator(ConsCell* cc = 0)
                : m_cc(cc)
            {}

            ConsCell& operator*() const
            {
                return *m_cc;
            }

            ConsCell* operator->() const
            {
                return m_cc;
            }

            ConsCell& operator++()
            {
                advance();
                return *m_cc;
            }

            ConsCell& operator++(int)
            {
                ConsCell& ans = *m_cc;
                advance();
                return ans;
            }
        private:
            ConsCell* m_cc;

            void advance();
        };

        class const_iterator
            : public std::iterator<std::forward_iterator_tag, const ConsCell> {
        public:
            explicit const_iterator(const ConsCell* cc = 0)
                : m_cc(cc)
            {}

            const ConsCell& operator*() const
            {
                return *m_cc;
            }

            const ConsCell* operator->() const
            {
                return m_cc;
            }

            const ConsCell& operator++()
            {
                advance();
                return *m_cc;
            }

            const ConsCell& operator++(int)
            {
                const ConsCell& ans = *m_cc;
                advance();
                return ans;
            }
        private:
            const ConsCell* m_cc;

            void advance();
        };

        iterator begin()
        {
            return iterator(this);
        }

        const_iterator begin() const
        {
            return const_iterator(this);
        }

        RObject* car() const
        {
            return m_car;
        }

        template <class T>
        static T* convert(ConsCell* cc)
        {
            if (!cc)
                return 0;
            if (T* ccc = dynamic_cast<T*>(cc))
                return ccc;
            T* ans = new T(cc->car(), cc->tail(), cc->tag());
            ans->setAttributes(cc->attributes());
            return expose(ans);
        }

        iterator end()
        {
            return iterator();
        }

        const_iterator end() const
        {
            return const_iterator();
        }

        void setCar(RObject* cr)
        {
            m_car = cr;
        }

        void setTag(const RObject* tg)
        {
            m_tag = tg;
        }

        void setTail(PairList* tl);
        // Implemented inline in CXXR/PairList.h

        static const char* staticTypeName()
        {
            return "(pairlist type)";
        }

        const RObject* tag() const
        {
            return m_tag;
        }

        const PairList* tail() const;

        PairList* tail();

        // Virtual function of GCNode:
        void visitReferents(const_visitor* v) const;
    protected:
        explicit ConsCell(SEXPTYPE st,
                          RObject* cr = 0, PairList* tl = 0,
                          const RObject* tg = 0);

        ConsCell(const ConsCell& pattern);

        ConsCell(const ConsCell& pattern, int dummy);

        ~ConsCell() {}

        // Virtual function of GCNode:
        void detachReferents();
    private:
        friend class boost::serialization::access;
        friend class PairList;

        RHandle<> m_car;
        GCEdge<PairList> m_tail;
        GCEdge<const RObject> m_tag;

        // Not implemented yet.  Declared to prevent
        // compiler-generated version:
        ConsCell& operator=(const ConsCell&);

        // Check that st is a legal SEXPTYPE for a ConsCell:
        static void checkST(SEXPTYPE st);

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

    template<class Archive>
    void CXXR::ConsCell::serialize(Archive & ar, const unsigned int version) {
        ar & BOOST_SERIALIZATION_BASE_OBJECT_NVP(RObject);
        GCNPTR_SERIALIZE(ar, m_tag);
        GCNPTR_SERIALIZE(ar, m_car);
        GCNPTR_SERIALIZE(ar, m_tail);
    }

    inline bool operator==(ConsCell::iterator l, ConsCell::iterator r)
    {
        return &(*l) == &(*r);
    }

    inline bool operator!=(ConsCell::iterator l, ConsCell::iterator r)
    {
        return !(l == r);
    }

    inline bool operator==(ConsCell::const_iterator l,
                           ConsCell::const_iterator r)
    {
        return &(*l) == &(*r);
    }

    inline bool operator!=(ConsCell::const_iterator l,
                           ConsCell::const_iterator r)
    {
        return !(l == r);
    }

    inline RObject* car0(ConsCell* cc)
    {
        return cc ? cc->car() : 0;
    }

    void ccdump(std::ostream& os, const ConsCell& cc, size_t margin = 0);

    inline size_t listLength(const ConsCell* start)
    {
        return (start ? std::distance(start->begin(), start->end()) : 0);
    }

    inline PairList* tail0(ConsCell* cc)
    {
        return cc ? cc->tail() : 0;
    }

    class PairList : public ConsCell {
    public:
        explicit PairList(RObject* cr = 0, PairList* tl = 0,
                          const RObject* tg = 0)
            : ConsCell(LISTSXP, cr, tl, tg)
        {}

        PairList(const PairList& pattern);

        static PairList* cons(RObject* cr, PairList* tl=0,
                              const RObject* tag = 0)
        {
            // We call MemoryBank::allocate() directly here, rather
            // than GCNode::operator new(), to avoid giving rise to
            // any garbage collection, and thus avoiding (a) the need
            // to protect the arguments from GC, and (b) the
            // possibility of reentrant calls to this function (from
            // object destructors).  However, calling code should not
            // rely on the fact that no GC will occur, because the
            // implementation may change in the future.
            void* pad = MemoryBank::allocate(sizeof(PairList));
            return expose(new (pad) PairList(cr, tl, tag));
        }

        static PairList* make(size_t sz) throw (std::bad_alloc);

        static const char* staticTypeName()
        {
            return "pairlist";
        }

        // Virtual functions of RObject:
        PairList* clone() const;
        unsigned int packGPBits() const;
        const char* typeName() const;
        void unpackGPBits(unsigned int gpbits);
    private:
        friend class boost::serialization::access;

        // Tailless copy constructor.  Copies the node without copying
        // its tail.  Used in implementing the copy constructor
        // proper.  The second parameter is simply to provide a
        // distinct signature, and its value is ignored.
        PairList(const PairList& pattern, int)
            : ConsCell(pattern, 0)
        {}

        // Declared private to ensure that PairList objects are
        // allocated only using 'new':
#ifdef __GNUG__
        __attribute__((hot))
#endif
        ~PairList();

        // Not implemented yet.  Declared to prevent
        // compiler-generated version:
        PairList& operator=(const PairList&);

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

    inline void ConsCell::iterator::advance()
    {
        m_cc = m_cc->tail();
    }

    inline void ConsCell::const_iterator::advance()
    {
        m_cc = m_cc->tail();
    }

    inline ConsCell::ConsCell(SEXPTYPE st, RObject* cr,
                              PairList* tl, const RObject* tg)
        : RObject(st), m_car(cr), m_tail(tl), m_tag(tg)
    {
        // checkST(st);
    }

    inline ConsCell::ConsCell(const ConsCell& pattern)
        : RObject(pattern), m_car(pattern.m_car),
          m_tail(clone(pattern.tail())), m_tag(pattern.tag())
    {}
    
    inline ConsCell::ConsCell(const ConsCell& pattern, int)
        : RObject(pattern), m_car(pattern.m_car), m_tail(0),
          m_tag(pattern.tag())
    {}
    
    inline void ConsCell::setTail(PairList* tl)
    {
        m_tail = tl;
    }

    inline const PairList* ConsCell::tail() const
    {
        return m_tail;
    }

    inline PairList* ConsCell::tail()
    {
        return m_tail;
    }
} // namespace CXXR

BOOST_CLASS_EXPORT_KEY(CXXR::PairList)

extern "C" {

#ifndef __cplusplus
    SEXP CAR(SEXP e);
#else
    inline SEXP CAR(SEXP e)
    {
        using namespace CXXR;
        return car0(SEXP_downcast<ConsCell*>(e));
    }
#endif

#ifndef __cplusplus
    SEXP CAAR(SEXP e);
#else
    inline SEXP CAAR(SEXP e) {return CAR(CAR(e));}
#endif

    // Used in argument handling (within envir.cpp, eval.cpp and
    // match.cpp).  Note comments in the 'R Internals' document.
    inline int MISSING(SEXP x)
    {
        using namespace CXXR;
        return SEXP_downcast<ConsCell*>(x)->m_missing;
    }

    SEXP SETCAR(SEXP x, SEXP y);

    // Used in argument handling (within envir.cpp, eval.cpp and
    // match.cpp).  Note comments in the 'R Internals' document.
    inline void SET_MISSING(SEXP x, int v)
    {
        using namespace CXXR;
        SEXP_downcast<ConsCell*>(x)->m_missing = v;
    }
#endif  /* __cplusplus */

#ifndef __cplusplus
    SEXP TAG(SEXP e);
#else
    inline SEXP TAG(SEXP e)
    {
        using namespace CXXR;
        if (!e) return 0;
        ConsCell& cc = *SEXP_downcast<ConsCell*>(e);
        return const_cast<RObject*>(cc.tag());
    }
#endif

    void SET_TAG(SEXP x, SEXP y);

    SEXP Rf_allocSExp(SEXPTYPE t);

#ifdef __cplusplus
}
#endif

#endif /* CONSCELL_H */