[Rcpp-devel] [Rcpp-commits] r274 - in pkg: inst inst/unitTests src src/Rcpp

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Jan 4 23:05:44 CET 2010


Author: romain
Date: 2010-01-04 23:05:43 +0100 (Mon, 04 Jan 2010)
New Revision: 274

Added:
   pkg/inst/unitTests/runit.Pairlist.R
   pkg/src/Pairlist.cpp
   pkg/src/Rcpp/Pairlist.h
Modified:
   pkg/inst/ChangeLog
   pkg/src/Rcpp.h
   pkg/src/Rcpp/Language.h
Log:
new class Rcpp::Pairlist

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-04 21:32:18 UTC (rev 273)
+++ pkg/inst/ChangeLog	2010-01-04 22:05:43 UTC (rev 274)
@@ -1,5 +1,13 @@
 2010-01-04  Romain Francois <francoisromain at free.fr>
 
+	* src/Rcpp/Pairlist.h: new class Rcpp::Pairlist to manage dotted
+	pair lists (LISTSXP). unsurprisingly this shares a lot of
+	similarities with Language class
+
+	* src/Pairlist.cpp: implementation
+
+	* inst/unitTests/runit.Pairlist.R: unit tests for Rcpp::Pairlist
+
 	* src/Rcpp/wrap.h: wrap no more a template. this was not a good
 	idea as it prevented implicit conversion to SEXP behavior when 
 	wrap'ing a RObject.

Added: pkg/inst/unitTests/runit.Pairlist.R
===================================================================
--- pkg/inst/unitTests/runit.Pairlist.R	                        (rev 0)
+++ pkg/inst/unitTests/runit.Pairlist.R	2010-01-04 22:05:43 UTC (rev 274)
@@ -0,0 +1,54 @@
+#!/usr/bin/r -t
+#
+# 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/>.
+
+.setUp <- function(){
+	suppressMessages( require( inline ) )
+}
+
+test.Pairlist <- function(){
+	funx <- cfunction(signature(x="ANY"), 'return Pairlist(x) ;', 
+		Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx( pairlist("rnorm") ), pairlist("rnorm" ), msg = "Pairlist( LISTSXP )" )
+	checkEquals( funx( call("rnorm") ), pairlist("rnorm" ), msg = "Pairlist( LANGSXP )" )
+	checkEquals( funx(1:10), as.pairlist(1:10) , msg = "Pairlist( INTSXP) " )
+	checkEquals( funx(TRUE), as.pairlist( TRUE) , msg = "Pairlist( LGLSXP )" )
+	checkEquals( funx(1.3), as.pairlist(1.3), msg = "Pairlist( REALSXP) " )
+	checkEquals( funx(as.raw(1) ), as.pairlist(as.raw(1)), msg = "Pairlist( RAWSXP)" )
+	
+	checkException( funx(funx), msg = "Pairlist not compatible with function" )
+	checkException( funx(new.env()), msg = "Pairlist not compatible with environment" )
+	
+}
+
+test.Pairlist.variadic <- function(){
+	if( Rcpp:::canUseCXX0X() ){
+		funx <- cfunction(signature(), '
+		return Pairlist( "rnorm", 10, 0.0, 2.0 ) ;
+		', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+		checkEquals( funx(), pairlist("rnorm", 10L, 0.0, 2.0 ), 
+			msg = "variadic templates" )
+			
+		funx <- cfunction(signature(), '
+		return Pairlist( "rnorm", 10, Named("mean",0.0), 2.0 ) ;
+		', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+		checkEquals( funx(), pairlist("rnorm", 10L, mean = 0.0, 2.0 ), 
+			msg = "variadic templates (with names)" )
+	}
+}
+

Added: pkg/src/Pairlist.cpp
===================================================================
--- pkg/src/Pairlist.cpp	                        (rev 0)
+++ pkg/src/Pairlist.cpp	2010-01-04 22:05:43 UTC (rev 274)
@@ -0,0 +1,64 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Language.cpp: Rcpp R/C++ interface class library -- Language objects ( calls )
+//
+// 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/Pairlist.h>
+#include <Rcpp/Evaluator.h>
+#include <Rcpp/RObject.h>
+#include <Rcpp/Language.h>
+#include <RcppCommon.h>
+
+namespace Rcpp {
+	
+	Pairlist::Pairlist( SEXP x = R_NilValue ) throw(not_compatible) : RObject::RObject( ){
+		
+		if( x != R_NilValue ){
+			if( TYPEOF( x ) == LISTSXP ){
+				// bingo 
+				setSEXP( x ) ;
+			} else if( TYPEOF( x) == LANGSXP ){
+				// almost
+				SET_TYPEOF(x, LISTSXP);
+				setSEXP( x) ;
+			} else {
+				Evaluator evaluator( Language("as.pairlist", x ) ) ;
+				evaluator.run() ;
+				if( evaluator.successfull() ){
+    					setSEXP( evaluator.getResult().asSexp() ) ;
+    				} else{
+    					throw not_compatible( ) ; 
+    				}
+			}
+		}
+		
+		
+	};
+	
+	Pairlist::~Pairlist(){}
+	
+	Pairlist::not_compatible::not_compatible() throw() {}
+    	const char* Pairlist::not_compatible::what() const throw(){
+    		return "cannot convert to pair list" ;
+    	}
+    	Pairlist::not_compatible::~not_compatible() throw() {}
+    
+	
+	
+} // namespace Rcpp

Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h	2010-01-04 21:32:18 UTC (rev 273)
+++ pkg/src/Rcpp/Language.h	2010-01-04 22:05:43 UTC (rev 274)
@@ -25,7 +25,6 @@
 #include <RcppCommon.h>
 #include <Rcpp/RObject.h>
 #include <Rcpp/Symbol.h>
-#include <Rcpp/Named.h>
 #include <Rcpp/pairlist.h>
 
 namespace Rcpp{ 

Added: pkg/src/Rcpp/Pairlist.h
===================================================================
--- pkg/src/Rcpp/Pairlist.h	                        (rev 0)
+++ pkg/src/Rcpp/Pairlist.h	2010-01-04 22:05:43 UTC (rev 274)
@@ -0,0 +1,88 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Pairlist.h: Rcpp R/C++ interface class library -- pair lists objects (LISTSXP)
+//
+// 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_Pairlist_h
+#define Rcpp_Pairlist_h
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+#include <Rcpp/pairlist.h>
+
+namespace Rcpp{ 
+
+/** 
+ * C++ wrapper around calls (LANGSXP SEXP)
+ *
+ * This represents calls that can be evaluated
+ */
+class Pairlist : public RObject{
+public:
+	/**
+	 * Exception thrown when attempting to convert a SEXP to 
+	 * a pair list using as.pairlist
+	 */
+	class not_compatible: public std::exception{
+		public:
+			not_compatible() throw() ;
+			
+			/**
+			 * The message: cannot convert to call 
+			 */
+			const char* what() const throw() ;
+			
+			~not_compatible() throw() ;
+		
+	} ;
+  	
+	/**
+	 * Attempts to convert the SEXP to a pair list
+	 *
+	 * @throw not_compatible if the SEXP could not be converted
+	 * to a pair list using as.pairlist
+	 */
+	Pairlist(SEXP lang) throw(not_compatible) ;
+	
+	/**
+	 * Creates a pairlist by wrapping the variable number of arguments
+	 * using the pairlist template
+	 *
+	 * @param ...Args variable length argument list. The type of each 
+	 *        argument must be wrappable, meaning there need to be 
+	 *        a wrap function that takes this type as its parameter
+	 * 
+	 * @example Pairlist( 10, std::string("foobar"), "rnorm" ) 
+	 * will create the same pair list as
+	 * > pairlist( 10L, "foobar", "rnorm" )
+	 */
+#ifdef CXX0X
+template<typename... Args> 
+	Pairlist( const Args&... args) : RObject() {
+		/* TODO: should we first allocate and protect the list  ?*/
+		setSEXP( pairlist( args... ) );
+	}
+#endif	
+	
+	~Pairlist() ;
+};
+
+} // namespace Rcpp
+
+#endif

Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h	2010-01-04 21:32:18 UTC (rev 273)
+++ pkg/src/Rcpp.h	2010-01-04 22:05:43 UTC (rev 274)
@@ -54,5 +54,6 @@
 #include <Rcpp/Symbol.h>
 #include <Rcpp/Language.h>
 #include <Rcpp/Named.h>
+#include <Rcpp/Pairlist.h>
 
 #endif

_______________________________________________
Rcpp-commits mailing list
Rcpp-commits at lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-commits


More information about the Rcpp-devel mailing list