[Rcpp-commits] r509 - in pkg: inst src src/Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jan 28 19:46:01 CET 2010
Author: romain
Date: 2010-01-28 19:46:01 +0100 (Thu, 28 Jan 2010)
New Revision: 509
Added:
pkg/src/DottedPair.cpp
pkg/src/Pairlist.cpp
Modified:
pkg/inst/ChangeLog
pkg/src/Language.cpp
pkg/src/Rcpp/DottedPair.h
pkg/src/Rcpp/Language.h
pkg/src/Rcpp/Pairlist.h
pkg/src/Rcpp/SimpleVector.h
Log:
DottedPair does not need to be a template
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2010-01-28 17:06:45 UTC (rev 508)
+++ pkg/inst/ChangeLog 2010-01-28 18:46:01 UTC (rev 509)
@@ -1,8 +1,8 @@
2010-01-28 Romain Francois <francoisromain at free.fr>
- * src/Rcpp/DottedPair.h: factored out Language and Pairlist
- into the new DottedPaitr template, parameterized by the
- SEXP type (LANGSXP or LISTSXP)
+ * src/Rcpp/DottedPair.h: Pairlist and Language are now derived
+ from the new virtual class DottedPair since both class were
+ almost identical
* src/Rcpp/SimpleVector.h: simple vectors gain a range
based assign method and a range based assign constructor
Added: pkg/src/DottedPair.cpp
===================================================================
--- pkg/src/DottedPair.cpp (rev 0)
+++ pkg/src/DottedPair.cpp 2010-01-28 18:46:01 UTC (rev 509)
@@ -0,0 +1,103 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// DottedPair.cpp: Rcpp R/C++ interface class library -- dotted pair lists
+// base class of Language and Pairlist
+//
+// 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/DottedPair.h>
+
+namespace Rcpp {
+ DottedPair::~DottedPair(){}
+ DottedPair::DottedPair() : RObject(){}
+
+ void DottedPair::remove( const size_t& index ) throw(index_out_of_bounds) {
+ if( index < 0 || index >= static_cast<size_t>(Rf_length(m_sexp)) ) throw index_out_of_bounds() ;
+ if( index == 0 ){
+ setSEXP( CDR( m_sexp) ) ;
+ } else{
+ SEXP x = m_sexp ;
+ size_t i=1;
+ while( i<index ){ x = CDR(x) ; i++; }
+ SETCDR( x, CDDR(x) ) ;
+ }
+ }
+
+ DottedPair::Proxy::Proxy( DottedPair& v, const size_t& index_ ) :
+ parent(v), index(index_){}
+
+ DottedPair::Proxy& DottedPair::Proxy::operator=(const Proxy& rhs){
+ if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+ size_t i = 0 ;
+ SEXP x = parent.asSexp() ;
+ while( i < index ) {
+ x = CDR(x) ;
+ i++ ;
+ }
+ SEXP y = rhs ; /* implicit conversion */
+ SETCAR( x, y ) ;
+ // if( index != 0 ) SET_TAG( x, Rf_install( rhs.getTag() ) ) ;
+ return *this ;
+ }
+
+ DottedPair::Proxy& DottedPair::Proxy::operator=(SEXP rhs){
+ if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+ SEXP x = parent.asSexp() ;
+ size_t i = 0 ;
+ while( i < index ) {
+ x = CDR(x) ;
+ i++ ;
+ }
+ SETCAR( x, rhs) ;
+ return *this ;
+ }
+
+ DottedPair::Proxy& DottedPair::Proxy::operator=(const Named& rhs){
+ if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+ size_t i = 0 ;
+ SEXP x = parent.asSexp() ;
+ while( i < index ) {
+ x = CDR(x) ;
+ i++ ;
+ }
+ SEXP y = rhs.getSEXP() ;
+ SETCAR( x, y ) ;
+ if( index != 0 ) SET_TAG( x, Symbol( rhs.getTag() ) ) ;
+ return *this ;
+ }
+
+ DottedPair::Proxy::operator SEXP() {
+ if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
+ SEXP x = parent.asSexp() ;
+ size_t i = 0 ;
+ while( i < index ) {
+ x = CDR(x) ;
+ i++ ;
+ }
+ return CAR(x) ;
+ }
+
+ const DottedPair::Proxy DottedPair::operator[]( int i ) const {
+ return Proxy( const_cast<DottedPair&>(*this), i) ;
+ }
+ DottedPair::Proxy DottedPair::operator[]( int i ) {
+ return Proxy( *this, i );
+ }
+
+
+} // namespace Rcpp
Modified: pkg/src/Language.cpp
===================================================================
--- pkg/src/Language.cpp 2010-01-28 17:06:45 UTC (rev 508)
+++ pkg/src/Language.cpp 2010-01-28 18:46:01 UTC (rev 509)
@@ -23,13 +23,13 @@
namespace Rcpp {
- Language::Language() : Language_Base() {};
+ Language::Language() : DottedPair() {};
- Language::Language( SEXP lang ) throw(not_compatible) : Language_Base(lang){
- update() ;
+ Language::Language( SEXP x ) throw(not_compatible) : DottedPair(){
+ setSEXP( r_cast<LANGSXP>(x) ) ;
};
- Language::Language( const std::string& symbol ): Language_Base() {
+ Language::Language( const std::string& symbol ): DottedPair() {
setSEXP( Rf_lcons( Symbol(symbol), R_NilValue ) );
}
Added: pkg/src/Pairlist.cpp
===================================================================
--- pkg/src/Pairlist.cpp (rev 0)
+++ pkg/src/Pairlist.cpp 2010-01-28 18:46:01 UTC (rev 509)
@@ -0,0 +1,33 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Pairlist.cpp: Rcpp R/C++ interface class library -- Pairlist objects
+//
+// 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>
+
+namespace Rcpp {
+
+ Pairlist::Pairlist() : DottedPair() {};
+ Pairlist::Pairlist( SEXP x ) throw(not_compatible) : DottedPair(){
+ setSEXP( r_cast<LISTSXP>(x) );
+ };
+ Pairlist::~Pairlist(){}
+
+
+} // namespace Rcpp
Modified: pkg/src/Rcpp/DottedPair.h
===================================================================
--- pkg/src/Rcpp/DottedPair.h 2010-01-28 17:06:45 UTC (rev 508)
+++ pkg/src/Rcpp/DottedPair.h 2010-01-28 18:46:01 UTC (rev 509)
@@ -27,18 +27,15 @@
#include <Rcpp/Symbol.h>
#include <Rcpp/grow.h>
#include <Rcpp/wrap.h>
+#include <Rcpp/Named.h>
namespace Rcpp{
-template <int RTYPE> class DottedPair : public RObject{
+class DottedPair : public RObject{
public:
- DottedPair() : RObject(){}
+ DottedPair() ;
- DottedPair(SEXP x) throw(not_compatible) : RObject(){
- setSEXP( r_cast<RTYPE>(x) ) ;
- }
-
#ifdef HAS_VARIADIC_TEMPLATES
template<typename... Args>
DottedPair( const Args&... args) : RObject() {
@@ -138,78 +135,25 @@
*
* @param index position where the element is to be removed
*/
- void remove( const int& index ) throw(index_out_of_bounds){
- if( index < 0 || index >= Rf_length(m_sexp) ) throw index_out_of_bounds() ;
- if( index == 0 ){
- setSEXP( CDR( m_sexp) ) ;
- } else{
- SEXP x = m_sexp ;
- int i=1;
- while( i<index ){ x = CDR(x) ; i++; }
- SETCDR( x, CDDR(x) ) ;
- }
- }
+ void remove( const size_t& index ) throw(index_out_of_bounds) ;
class Proxy {
public:
- Proxy( DottedPair<RTYPE>& v, const size_t& index_ ) : parent(v), index(index_){}
+ Proxy( DottedPair& v, const size_t& index_ ) ;
/* lvalue uses */
- Proxy& operator=(const Proxy& rhs){
- if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
- size_t i = 0 ;
- SEXP x = parent.asSexp() ;
- while( i < index ) {
- x = CDR(x) ;
- i++ ;
- }
- SEXP y = rhs ;
- SETCAR( x, y ) ;
- // if( index != 0 ) SET_TAG( x, Rf_install( rhs.getTag() ) ) ;
- return *this ;
- }
- Proxy& operator=(SEXP rhs){
- if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
- SEXP x = parent.asSexp() ;
- size_t i = 0 ;
- while( i < index ) {
- x = CDR(x) ;
- i++ ;
- }
- SETCAR( x, rhs) ;
- return *this ;
- }
+ Proxy& operator=(const Proxy& rhs) ;
+ Proxy& operator=(SEXP rhs) ;
template <typename T>
Proxy& operator=(const T& rhs){
parent.replace( index, rhs ) ;
return *this ;
}
- Proxy& operator=(const Named& rhs){
- if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
- size_t i = 0 ;
- SEXP x = parent.asSexp() ;
- while( i < index ) {
- x = CDR(x) ;
- i++ ;
- }
- SEXP y = rhs ;
- SETCAR( x, y ) ;
- // if( index != 0 ) SET_TAG( x, Symbol( rhs.getTag() ) ) ;
- return *this ;
- }
+ Proxy& operator=(const Named& rhs) ;
/* rvalue use */
- operator SEXP() {
- if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
- SEXP x = parent.asSexp() ;
- size_t i = 0 ;
- while( i < index ) {
- x = CDR(x) ;
- i++ ;
- }
- return CAR(x) ;
- }
+ operator SEXP() ;
template <typename T> operator T() const {
if( index < 0 || index >= parent.length() ) throw index_out_of_bounds() ;
@@ -223,20 +167,16 @@
}
private:
- DottedPair<RTYPE>& parent;
+ DottedPair& parent;
size_t index ;
} ;
- const Proxy operator[]( int i ) const {
- return Proxy( const_cast<DottedPair<RTYPE>&>(*this), i) ;
- }
- Proxy operator[]( int i ) {
- return Proxy( *this, i );
- }
+ const Proxy operator[]( int i ) const ;
+ Proxy operator[]( int i ) ;
friend class Proxy;
- virtual ~DottedPair() {};
+ virtual ~DottedPair() = 0 ;
};
Modified: pkg/src/Rcpp/Language.h
===================================================================
--- pkg/src/Rcpp/Language.h 2010-01-28 17:06:45 UTC (rev 508)
+++ pkg/src/Rcpp/Language.h 2010-01-28 18:46:01 UTC (rev 509)
@@ -31,15 +31,12 @@
namespace Rcpp{
-/* lazy typedef */
-typedef DottedPair<LANGSXP> Language_Base ;
-
/**
* C++ wrapper around calls (LANGSXP SEXP)
*
* This represents calls that can be evaluated
*/
-class Language : public Language_Base {
+class Language : public DottedPair {
public:
Language() ;
@@ -92,7 +89,7 @@
*/
#ifdef HAS_VARIADIC_TEMPLATES
template<typename... Args>
-Language( const std::string& symbol, const Args&... args) : Language_Base(Rf_install(symbol.c_str()), args...) {
+Language( const std::string& symbol, const Args&... args) : DottedPair(Rf_install(symbol.c_str()), args...) {
update() ;
}
#endif
Modified: pkg/src/Rcpp/Pairlist.h
===================================================================
--- pkg/src/Rcpp/Pairlist.h 2010-01-28 17:06:45 UTC (rev 508)
+++ pkg/src/Rcpp/Pairlist.h 2010-01-28 18:46:01 UTC (rev 509)
@@ -26,6 +26,19 @@
#include <Rcpp/DottedPair.h>
namespace Rcpp{
- typedef DottedPair<LISTSXP> Pairlist ;
+
+class Pairlist : public DottedPair {
+public:
+ Pairlist();
+ Pairlist(SEXP x) throw(not_compatible) ;
+
+#ifdef HAS_VARIADIC_TEMPLATES
+template<typename... Args>
+ Pairlist( const Args&... args) : DottedPair(args...) {}
+#endif
+ ~Pairlist() ;
+
+} ;
+
}
#endif
Modified: pkg/src/Rcpp/SimpleVector.h
===================================================================
--- pkg/src/Rcpp/SimpleVector.h 2010-01-28 17:06:45 UTC (rev 508)
+++ pkg/src/Rcpp/SimpleVector.h 2010-01-28 18:46:01 UTC (rev 509)
@@ -29,13 +29,9 @@
#include <Rcpp/Dimension.h>
namespace Rcpp{
-
+
template <int RTYPE,typename CTYPE> CTYPE get_zero(){ return static_cast<CTYPE>(0) ; } ;
-// template<> double get_zero<REALSXP,double>() ;
-// template<> int get_zero<INTSXP,int>() ;
-// template<> int get_zero<LGLSXP,int>() ;
template<> Rcomplex get_zero<CPLXSXP,Rcomplex>() ;
-// template<> Rbyte get_zero<RAWSXP,Rbyte>() ;
template <int sexptype, typename T> T* get_pointer(SEXP x){ throw std::exception( "not implemented" ) ; return static_cast<T*>(0); }
template<> double* get_pointer<REALSXP,double>(SEXP x) ;
More information about the Rcpp-commits
mailing list