Environment.h

Go to the documentation of this file.

/*CXXR $Id: Environment.h 1390 2013-06-11 14:41:41Z 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 RENVIRONMENT_H
#define RENVIRONMENT_H

#include "CXXR/RObject.h"

#ifdef __cplusplus

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

#include "CXXR/Frame.hpp"
#include "CXXR/GCStackRoot.hpp"
#include "CXXR/Symbol.h"

#ifdef DOXYGEN
#define DETACH_LOCAL_FRAMES
#endif

namespace CXXR {
    class FunctionBase;

    class Environment : public RObject {
    public:
        class LoopScope {
        public:
            LoopScope(Environment* env)
                : m_environment(env), m_prev_state(env->m_in_loop)
            {
                env->m_in_loop = true;
            }

            ~LoopScope()
            {
                m_environment->m_in_loop = m_prev_state;
            }
        private:
            GCStackRoot<Environment> m_environment;
            bool m_prev_state;
        };

        class ReturnScope {
        public:
            ReturnScope(Environment* env)
                : m_environment(env), m_prev_state(env->m_can_return)
            {
                env->m_can_return = true;
            }

            ~ReturnScope()
            {
                m_environment->m_can_return = m_prev_state;
            }
        private:
            GCStackRoot<Environment> m_environment;
            bool m_prev_state;
        };

        Environment(Environment* enclosing, Frame* frame)
            : RObject(ENVSXP), m_enclosing(enclosing), m_frame(frame),
              m_single_stepping(false), m_locked(false), m_cached(false),
              m_leaked(false), m_in_loop(false), m_can_return(false)
        {}

        static Environment* base()
        {
            return s_base;
        }

        static Environment* baseNamespace()
        {
            return s_base_namespace;
        }

        bool canReturn() const
        {
            return m_can_return;
        }

        static Environment* empty()
        {
            return s_empty;
        }

        Environment* enclosingEnvironment() const
        {
            return m_enclosing;
        }

#ifdef __GNUC__
        __attribute__((hot,fastcall))
#endif
        std::pair<Environment*, Frame::Binding*>
        findBinding(const Symbol* symbol);

        std::pair<const Environment*, const Frame::Binding*>
        findBinding(const Symbol* symbol) const
        {
            EBPair ebpr = const_cast<Environment*>(this)->findBinding(symbol);
            return std::pair<const Environment*,
                             const Frame::Binding*>(ebpr.first, ebpr.second);
        }

        static Environment* findNamespace(const StringVector* spec);

        static Environment* findPackage(const std::string& name);

        Frame* frame()
        {
            return m_frame;
        }

        const Frame* frame() const
        {
            return m_frame;
        }

        static Environment* global()
        {
            return s_global;
        }

        bool loopActive() const
        {
            return m_in_loop;
        }

        void maybeDetachFrame()
        {
#ifdef DETACH_LOCAL_FRAMES
            if (!m_leaked)
                detachFrame();
#endif
        }

        static void monitorLeaks(const GCNode* node)
        {
#ifdef DETACH_LOCAL_FRAMES
            if (node) {
                LeakMonitor monitor;
                monitor(node);
            }
#endif
        }

        const StringVector* namespaceSpec() const;

        const StringVector* packageName() const;

        void setEnclosingEnvironment(Environment* new_enclos);

        void setSingleStepping(bool on)
        {
            m_single_stepping = on;
        }

        bool singleStepping() const
        {
            return m_single_stepping;
        }

        void slotBehind(Environment* anchor);

        void skipEnclosing();
            
        static const char* staticTypeName()
        {
            return "environment";
        }

        // Virtual functions of RObject:
        unsigned int packGPBits() const;
        const char* typeName() const;
        void unpackGPBits(unsigned int gpbits);

        // Virtual functions of GCNode:
        void visitReferents(const_visitor* v) const;
    protected:
        // Virtual function of GCNode:
        void detachReferents();
    private:
        friend class boost::serialization::access;
        friend class SchwarzCounter<Environment>;
        friend class Frame;

        // PACKAGE_ENV because PACKAGE is defined (to "R") as a macro
        // within config.h .
        enum S11nType {EMPTY = 0, BASE, BASENAMESPACE,
                       GLOBAL, PACKAGE_ENV, NAMESPACE, OTHER};

        struct LeakMonitor : public GCNode::const_visitor {
            LeakMonitor()
            {}

            // Virtual function of const_visitor:
            void operator()(const GCNode* node);
        };

        // The class maintains a cache of Symbol Bindings found along
        // the search path:

        typedef std::pair<Environment*, Frame::Binding*> EBPair;
        typedef
        std::tr1::unordered_map<const Symbol*, EBPair,
                                std::tr1::hash<const Symbol*>,
                                std::equal_to<const Symbol*>,
                                CXXR::Allocator<std::pair<const Symbol*,
                                                          EBPair> >
                                > Cache;

        static Cache* s_cache;

        // Predefined environments:
        static Environment* s_base;
        static Environment* s_base_namespace;
        static Environment* s_empty;
        static Environment* s_global;

        GCEdge<Environment> m_enclosing;
        GCEdge<Frame> m_frame;
        bool m_single_stepping;
        bool m_locked;
        bool m_cached;
        // For local environments, m_leaked is set to true to signify
        // that the environment may continue to be reachable after the
        // return of the Closure call that created it.  It has no
        // particular meaning for non-local environments.
        mutable bool m_leaked;
        bool m_in_loop;
        bool m_can_return;

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

        // Declared private to ensure that Environment objects are
        // created only using 'new':
        ~Environment()
        {
            if (m_cached && m_frame)
                m_frame->decCacheCount();
        }

        static void cleanup();

        void detachFrame();

        // Remove any mapping of 'sym' from the cache.  If called with
        // a null pointer, clear the cache entirely.
        static void flushFromCache(const Symbol* sym);

        static void initialize();

        bool isCachePortal() const
        {
            return (this == s_global);
        }

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

        // Designate this Environment as a participant in the search
        // list cache:
        void makeCached();

        // Warn about package possibly not being available when
        // loading, and extract package name.
        static const char* package_s11n_aux(const StringVector* pkg_name);

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

        template<class Archive>
        void serialize (Archive & ar, const unsigned int version) {
            boost::serialization::split_member(ar, *this, version);
        }
    };

    std::pair<Environment*, FunctionBase*>
    findFunction(const Symbol* symbol, Environment* env, bool inherits = true);

    template <typename UnaryPredicate>
    std::pair<Environment*, RObject*>
    findTestedValue(const Symbol* symbol, Environment* env,
                    UnaryPredicate pred, bool inherits)
    {
        using namespace std;
        pair<Environment*, RObject*> ans(0, 0);
        bool found = false;
        do {
            Frame::Binding* bdg;
            if (!inherits) {
                // Note that the cache is not updated in this case:
                bdg = env->frame()->binding(symbol);
            } else {
                pair<Environment*, Frame::Binding*> pr
                    = env->findBinding(symbol);
                env = pr.first;
                bdg = pr.second;
            }
            if (bdg) {
                pair<RObject*, bool> fpr = bdg->forcedValue();
                RObject* val = fpr.first;
                found = pred(val);
                if (found) {
                    // Invoke read monitor (if any) only if
                    // forcedValue() did not force a Promise.  (If a
                    // Promise was forced, the read monitor will have
                    // been invoked anyway, and 'bdg' may now be
                    // junk.)
                    if (!fpr.second)
                        bdg->rawValue();
                    ans = make_pair(env, val);
                }
                env = env->enclosingEnvironment();
            }
        } while (!found && inherits && env);
        return ans;
    }
}  // namespace CXXR

BOOST_CLASS_EXPORT_KEY(CXXR::Environment)

namespace boost {
    namespace serialization {
        template<class Archive>
        void load_construct_data(Archive& ar, CXXR::Environment* t,
                                 const unsigned int version)
        {
            new (t) CXXR::Environment(0, 0);
        }
    }  // namespace serialization
}  // namespace boost

namespace {
    CXXR::SchwarzCounter<CXXR::Environment> env_schwartz_ctr;
}

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

template<class Archive>
void CXXR::Environment::load(Archive& ar, const unsigned int version)
{
    ar >> BOOST_SERIALIZATION_BASE_OBJECT_NVP(RObject);
    S11nType envtype;
    ar >> BOOST_SERIALIZATION_NVP(envtype);
    Environment* reloc = 0;
    switch(envtype) {
    case EMPTY:
        reloc = s_empty;
        break;
    case BASE:
        reloc = s_base;
        break;
    case BASENAMESPACE:
        reloc = s_base_namespace;
        break;
    case GLOBAL:
        reloc = s_global;
        break;
    case PACKAGE_ENV:
        {
            std::string pkgname;
            ar >> BOOST_SERIALIZATION_NVP(pkgname);
            reloc = findPackage(pkgname);
        }
        break;
    case NAMESPACE:
        {
            GCStackRoot<const StringVector> nsspec;
            GCNPTR_SERIALIZE(ar, nsspec);
            reloc = findNamespace(nsspec);
        }
        break;
    case OTHER:
        {
            GCNPTR_SERIALIZE(ar, m_enclosing);
            GCNPTR_SERIALIZE(ar, m_frame);
            ar >> BOOST_SERIALIZATION_NVP(m_single_stepping);
            ar >> BOOST_SERIALIZATION_NVP(m_locked);
        }
        break;
    }
    if (reloc)
        S11nScope::defineRelocation(this, reloc);
}

template<class Archive>
void CXXR::Environment::save(Archive& ar, const unsigned int version) const
{
    ar << BOOST_SERIALIZATION_BASE_OBJECT_NVP(RObject);
    // EMPTY:
    if (this == s_empty) {
        S11nType envtype = EMPTY;
        ar << BOOST_SERIALIZATION_NVP(envtype);
        return;
    }
    // BASE:
    if  (this == s_base) {
        S11nType envtype = BASE;
        ar << BOOST_SERIALIZATION_NVP(envtype);
        return;
    }
    // BASENAMESPACE:
    if (this == s_base_namespace) {
        S11nType envtype = BASENAMESPACE;
        ar << BOOST_SERIALIZATION_NVP(envtype);
        return;
    }
    // GLOBAL:
    if (this == s_global) {
        S11nType envtype = GLOBAL;
        ar << BOOST_SERIALIZATION_NVP(envtype);
        return;
    }
    // PACKAGE_ENV:
    const StringVector* pkgsv = packageName();
    if (pkgsv) {
        S11nType envtype = PACKAGE_ENV;
        ar << BOOST_SERIALIZATION_NVP(envtype);
        std::string pkgname(package_s11n_aux(pkgsv));
        ar << BOOST_SERIALIZATION_NVP(pkgname);
        return;
    }
    // NAMESPACE:
    const StringVector* nsspec = namespaceSpec();
    if (nsspec) {
        S11nType envtype = NAMESPACE;
        ar << BOOST_SERIALIZATION_NVP(envtype);
        GCNPTR_SERIALIZE(ar, nsspec);
        return;
    }
    // OTHER:
    {
        S11nType envtype = OTHER;
        ar << BOOST_SERIALIZATION_NVP(envtype);
        GCNPTR_SERIALIZE(ar, m_enclosing);
        GCNPTR_SERIALIZE(ar, m_frame);
        ar << BOOST_SERIALIZATION_NVP(m_single_stepping);
        ar << BOOST_SERIALIZATION_NVP(m_locked);
    }
}

extern "C" {
#else /* if not __cplusplus */

    /* In C code, R_varloc_t is an opaque pointer: */
    typedef struct R_varloc_st *R_varloc_t;

#endif

    /* C-visible names for predefined environments */
    extern SEXP R_EmptyEnv;
    extern SEXP R_BaseEnv;
    extern SEXP R_GlobalEnv;
    extern SEXP R_BaseNamespace;

#ifndef __cplusplus
    Rboolean Rf_isEnvironment(SEXP s);
#else
    inline Rboolean Rf_isEnvironment(SEXP s)
    {
        return Rboolean(s && TYPEOF(s) == ENVSXP);
    }
#endif

#ifndef __cplusplus
    SEXP ENCLOS(SEXP x);
#else
    inline SEXP ENCLOS(SEXP x)
    {
        using namespace CXXR;
        const Environment& env = *SEXP_downcast<Environment*>(x);
        return env.enclosingEnvironment();
    }
#endif

#ifndef __cplusplus
    Rboolean ENV_DEBUG(SEXP x);
#else
    inline Rboolean ENV_DEBUG(SEXP x)
    {
        using namespace CXXR;
        const Environment& env = *SEXP_downcast<const Environment*>(x);
        return Rboolean(env.singleStepping());
    }
#endif

#ifndef __cplusplus
    SEXP FRAME(SEXP x);
#else
    inline SEXP FRAME(SEXP x)
    {
        using namespace CXXR;
        Environment* env = SEXP_downcast<Environment*>(x);
        return env->frame()->asPairList();
    }
#endif

#ifndef __cplusplus
    void SET_ENV_DEBUG(SEXP x, Rboolean v);
#else
    inline void SET_ENV_DEBUG(SEXP x, Rboolean v)
    {
        using namespace CXXR;
        Environment& env = *SEXP_downcast<Environment*>(x);
        env.setSingleStepping(v);
    }
#endif

#ifndef __cplusplus
    void SET_SYMVALUE(SEXP x, SEXP val);
#else
    inline void SET_SYMVALUE(SEXP x, SEXP val)
    {
        using namespace CXXR;
        const Symbol* sym = SEXP_downcast<Symbol*>(x);
        Environment::base()->frame()->obtainBinding(sym)->setValue(val);
    }
#endif

#ifndef __cplusplus
    SEXP SYMVALUE(SEXP x);
#else
    inline SEXP SYMVALUE(SEXP x)
    {
        using namespace CXXR;
        const Symbol* sym = SEXP_downcast<Symbol*>(x);
        Frame::Binding* bdg = Environment::base()->frame()->binding(sym);
        return bdg ? bdg->value() : Symbol::unboundValue();
    }
#endif

#ifdef __cplusplus
}
#endif

#endif /* RENVIRONMENT_H */