[Rcpp-commits] r301 - in pkg: inst src src/Rcpp

[noreply at r-forge.r-project.org]

Author: romain
Date: 2010-01-07 16:16:32 +0100 (Thu, 07 Jan 2010)
New Revision: 301

Added:
   pkg/src/Promise.cpp
   pkg/src/Rcpp/Promise.h
Modified:
   pkg/inst/ChangeLog
   pkg/src/RObject.cpp
Log:
+ Rcpp::Promise

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-07 14:30:29 UTC (rev 300)
+++ pkg/inst/ChangeLog	2010-01-07 15:16:32 UTC (rev 301)
@@ -1,5 +1,10 @@
 2010-01-07  Romain Francois <francoisromain at free.fr>
 
+	* src/Rcpp/Promise.h: new class Rcpp::Promise to manage
+	promises (PROMSXP). only read access so far (no way to force
+	the promise)
+	* src/Promise.cpp: implementation
+
 	* src/Rcpp/RObject.h: the result of attr is now an RObject
 	rather than a SEXP. This does not change previous behavior
 	because of the implicit conversion

Added: pkg/src/Promise.cpp
===================================================================
--- pkg/src/Promise.cpp	                        (rev 0)
+++ pkg/src/Promise.cpp	2010-01-07 15:16:32 UTC (rev 301)
@@ -0,0 +1,55 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Promise.h: Rcpp R/C++ interface class library -- promises (PROMSXP)
+//
+// Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp 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 of the License, or
+// (at your option) any later version.
+//
+// Rcpp 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 General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#include <Rcpp/Promise.h>
+#include <Rcpp/wrap.h>
+#include <Rcpp/RObject.h>
+#include <Rcpp/Environment.h>
+#include <Rcpp/ExpressionVector.h>
+
+namespace Rcpp {
+
+	Promise::Promise(SEXP x) throw(not_compatible) : RObject(){
+		if( TYPEOF(x) == PROMSXP ){
+			setSEXP( x ) ;
+		} else{
+			throw not_compatible("not a promise") ;
+		}
+	}
+
+	int Promise::seen(){
+		return PRSEEN(m_sexp);
+	}
+
+	RObject Promise::value() const{
+		return wrap( PRVALUE(m_sexp) ) ;
+	}
+
+	Environment Promise::environment() const {
+		return Environment(PRENV(m_sexp)) ;
+	}
+
+	ExpressionVector Promise::expression() const {
+		return ExpressionVector(PRCODE(m_sexp)) ;
+	}
+	
+} // namespace
+

Modified: pkg/src/RObject.cpp
===================================================================
--- pkg/src/RObject.cpp	2010-01-07 14:30:29 UTC (rev 300)
+++ pkg/src/RObject.cpp	2010-01-07 15:16:32 UTC (rev 301)
@@ -99,7 +99,7 @@
     return false; /* give up */
 }
 
-SEXP RObject::attr( const std::string& name) const{
+RObject RObject::attr( const std::string& name) const{
 	return wrap( Rf_getAttrib( m_sexp, Rf_install( name.c_str() ) ) );
 }
 

Added: pkg/src/Rcpp/Promise.h
===================================================================
--- pkg/src/Rcpp/Promise.h	                        (rev 0)
+++ pkg/src/Rcpp/Promise.h	2010-01-07 15:16:32 UTC (rev 301)
@@ -0,0 +1,61 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Promise.h: Rcpp R/C++ interface class library -- promises (PROMSXP)
+//
+// Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp 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 of the License, or
+// (at your option) any later version.
+//
+// Rcpp 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 General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp_Promise_h
+#define Rcpp_Promise_h
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+#include <Rcpp/ExpressionVector.h>
+#include <Rcpp/Environment.h>
+
+
+namespace Rcpp{ 
+
+class Promise : public RObject {     
+public:
+	Promise( SEXP x) throw(not_compatible) ;
+	
+	/** 
+	 * Return the result of the PRSEEN macro
+	 */
+	int seen() ;
+	
+	/**
+	 * Return the result of the PRVALUE macro on the promise
+	 */
+	RObject value() const ;
+
+	/**
+	 * The promise expression: PRCODE
+	 */
+	ExpressionVector expression() const ;
+
+	/**
+	 * The promise environment : PRENV
+	 */
+	Environment environment() const ;
+	
+} ;
+
+} // namespace
+
+#endif