[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
More information about the Rcpp-commits
mailing list