CXXR (C++ R)
Closure.h
Go to the documentation of this file.
1 /*CXXR $Id: Closure.h 1353 2013-03-18 16:59:38Z 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 RCLOSURE_H
42 #define RCLOSURE_H
43 
44 #include "CXXR/FunctionBase.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 #include <boost/serialization/split_member.hpp>
52 
53 #include "CXXR/ArgMatcher.hpp"
54 #include "CXXR/Environment.h"
55 #include "CXXR/PairList.h"
56 
57 namespace CXXR {
58  class ClosureContext;
59 
68  class Closure : public FunctionBase {
69  public:
82  Closure(const PairList* formal_args, RObject* body,
84 
89  Closure(const Closure& pattern)
90  : FunctionBase(pattern), m_debug(false),
91  m_matcher(pattern.m_matcher), m_body(pattern.m_body),
92  m_environment(pattern.m_environment)
93  {}
94 
99  const RObject* body() const
100  {
101  return m_body;
102  }
103 
109  bool debugging() const
110  {
111  return m_debug;
112  }
113 
119  {
120  return m_environment;
121  }
122 
140  RObject* execute(Environment* env) const;
141 
167  RObject* invoke(Environment* env, const ArgList* arglist,
168  const Expression* call,
169  const Frame* method_bindings = 0) const;
170 
175  const ArgMatcher* matcher() const
176  {
177  return m_matcher;
178  }
179 
185  void setDebugging(bool on)
186  {
187  m_debug = on;
188  }
189 
197  {
198  m_environment = new_env;
199  }
200 
205  static const char* staticTypeName()
206  {
207  return "closure";
208  }
209 
220  void stripFormals(Frame* input_frame) const
221  {
222  m_matcher->stripFormals(input_frame);
223  }
224 
225  // Virtual function of FunctionBase:
226  RObject* apply(ArgList* arglist, Environment* env,
227  const Expression* call) const;
228 
229  // Virtual functions of RObject:
230  Closure* clone() const;
231  const char* typeName() const;
232 
233  // Virtual function of GCNode:
234  void visitReferents(const_visitor* v) const;
235  protected:
236  // Virtual function of GCNode:
237  void detachReferents();
238  private:
239  friend class boost::serialization::access;
240 
254  class DebugScope {
255  public:
265  DebugScope(const Closure* closure)
266  : m_closure(closure)
267  {
268  if (m_closure->debugging())
269  startDebugging();
270  }
271 
272  ~DebugScope()
273  {
274  if (m_closure->debugging())
275  endDebugging();
276  }
277  private:
278  const Closure* m_closure;
279 
280  void startDebugging() const;
281  void endDebugging() const;
282  };
283 
284  bool m_debug;
285  GCEdge<const ArgMatcher> m_matcher;
286  GCEdge<> m_body;
287  GCEdge<Environment> m_environment;
288 
289  // Declared private to ensure that Environment objects are
290  // created only using 'new':
291  ~Closure() {}
292 
293  // Not (yet) implemented. Declared to prevent
294  // compiler-generated versions:
295  Closure& operator=(const Closure&);
296 
297  template<class Archive>
298  void load(Archive & ar, const unsigned int version);
299 
300  template<class Archive>
301  void save(Archive & ar, const unsigned int version) const;
302 
303  template<class Archive>
304  void serialize(Archive & ar, const unsigned int version) {
305  boost::serialization::split_member(ar, *this, version);
306  }
307  };
308 } // namespace CXXR
309 
310 BOOST_CLASS_EXPORT_KEY(CXXR::Closure)
311 
312 // ***** Implementation of non-inlined templated members *****
313 
314 template<class Archive>
315 void CXXR::Closure::load(Archive& ar, const unsigned int version)
316 {
317  ar & BOOST_SERIALIZATION_BASE_OBJECT_NVP(RObject);
318  GCStackRoot<const PairList> formal_args;
319  GCNPTR_SERIALIZE(ar, formal_args);
320  m_matcher=expose(new ArgMatcher(formal_args));
321  GCNPTR_SERIALIZE(ar, m_body);
322  GCNPTR_SERIALIZE(ar, m_environment);
323 }
324 
325 template<class Archive>
326 void CXXR::Closure::save(Archive& ar, const unsigned int version) const
327 {
328  ar & BOOST_SERIALIZATION_BASE_OBJECT_NVP(RObject);
329  GCStackRoot<const PairList> formal_args(m_matcher->formalArgs());
330  GCNPTR_SERIALIZE(ar, formal_args);
331  GCNPTR_SERIALIZE(ar, m_body);
332  GCNPTR_SERIALIZE(ar, m_environment);
333 }
334 
335 // ***** boost serialization object construction *****
336 
337 namespace boost {
338  namespace serialization {
356  template<class Archive>
357  void load_construct_data(Archive& ar, CXXR::Closure* t,
358  const unsigned int version)
359  {
360  new (t) CXXR::Closure(0, 0);
361  }
362  } // namespace serialization
363 } // namespace boost
364 
365 extern "C" {
366 #endif /* __cplusplus */
367 
383  SEXP Rf_mkCLOSXP(SEXP formal_args, SEXP body, SEXP env);
384 
391 #ifndef __cplusplus
392  SEXP BODY(SEXP x);
393 #else
394  inline SEXP BODY(SEXP x)
395  {
396  using namespace CXXR;
397  const Closure& clo = *SEXP_downcast<Closure*>(x);
398  return const_cast<RObject*>(clo.body());
399  }
400 #endif
401 
408 #ifndef __cplusplus
409  SEXP CLOENV(SEXP x);
410 #else
411  inline SEXP CLOENV(SEXP x)
412  {
413  using namespace CXXR;
414  Closure& clo = *SEXP_downcast<Closure*>(x);
415  return clo.environment();
416  }
417 #endif
418 
425 #ifndef __cplusplus
426  SEXP FORMALS(SEXP x);
427 #else
428  inline SEXP FORMALS(SEXP x)
429  {
430  using namespace CXXR;
431  const Closure* clos = SEXP_downcast<Closure*>(x);
432  return const_cast<PairList*>(clos->matcher()->formalArgs());
433  }
434 #endif
435 
447 #ifndef __cplusplus
448  Rboolean RDEBUG(SEXP x);
449 #else
450  inline Rboolean RDEBUG(SEXP x)
451  {
452  using namespace CXXR;
453  const Closure& clos = *SEXP_downcast<const Closure*>(x);
454  return Rboolean(clos.debugging());
455  }
456 #endif
457 
458 #ifndef __cplusplus
459  int RSTEP(SEXP x);
460 #else
461  inline int RSTEP(SEXP x)
462  {
463  return 0;
464  }
465 #endif
466 
475 #ifndef __cplusplus
476  void SET_CLOENV(SEXP x, SEXP v);
477 #else
478  inline void SET_CLOENV(SEXP x, SEXP v)
479  {
480  using namespace CXXR;
481  Closure& clos = *SEXP_downcast<Closure*>(x);
482  Environment* env = SEXP_downcast<Environment*>(v);
483  clos.setEnvironment(env);
484  }
485 #endif
486 
498 #ifndef __cplusplus
499  void SET_RDEBUG(SEXP x, Rboolean v);
500 #else
501  inline void SET_RDEBUG(SEXP x, Rboolean v)
502  {
503  using namespace CXXR;
504  Closure& clos = *SEXP_downcast<Closure*>(x);
505  clos.setDebugging(v);
506  }
507 #endif
508 
509 #ifndef __cplusplus
510  void SET_RSTEP(SEXP x, int v);
511 #else
512  inline void SET_RSTEP(SEXP x, int v)
513  {
514  }
515 #endif
516 
517 #ifdef __cplusplus
518 }
519 #endif
520 
521 #endif /* RCLOSURE_H */