https://github.com/cran/Rcpp
Revision 3f7b115399f60e3ad5ba2a79d98d674e1546e815 authored by Dirk Eddelbuettel and Romain Francois on 17 February 2012, 07:38:36 UTC, committed by cran-robot on 17 February 2012, 07:38:36 UTC
1 parent 5f773c6
Tip revision: 3f7b115399f60e3ad5ba2a79d98d674e1546e815 authored by Dirk Eddelbuettel and Romain Francois on 17 February 2012, 07:38:36 UTC
version 0.9.10
version 0.9.10
Tip revision: 3f7b115
Reference.cpp
// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
//
// S4.cpp: Rcpp R/C++ interface class library -- S4 objects
//
// Copyright (C) 2010 - 2011 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/Reference.h>
#include <Rcpp/exceptions.h>
#include <Rcpp/Vector.h>
namespace Rcpp {
Reference::Reference() : S4(){}
Reference::Reference(SEXP x) : S4(){
set( x) ;
}
Reference::Reference( const Reference& other) : S4(){
setSEXP( other.asSexp() ) ;
}
Reference::Reference( const RObject::SlotProxy& proxy ) : S4() {
set( proxy ) ;
}
Reference::Reference( const RObject::AttributeProxy& proxy ) : S4() {
set( proxy ) ;
}
Reference& Reference::operator=( const Reference& other){
setSEXP( other.asSexp() ) ;
return *this ;
}
Reference& Reference::operator=( SEXP other ) {
set( other ) ;
return *this ;
}
Reference::Reference( const std::string& klass ) : S4(){
// using callback to R as apparently R_do_new_object always makes the same environment
SEXP newSym = Rf_install("new");
SEXP call = PROTECT( Rf_lang2( newSym, Rf_mkString( klass.c_str() ) ) ) ;
setSEXP( Rcpp::internal::try_catch( call ) ) ;
UNPROTECT(1) ; // call
}
void Reference::set( SEXP x) {
// TODO: check that x is of a reference class
if( ! ::Rf_isS4(x) ){
throw not_reference() ;
} else{
setSEXP( x) ;
}
}
Reference::FieldProxy::FieldProxy( const Reference& v, const std::string& name) :
parent(v), field_name(name) {}
Reference::FieldProxy& Reference::FieldProxy::operator=(const FieldProxy& rhs){
set( rhs.get() ) ;
return *this ;
}
SEXP Reference::FieldProxy::get() const {
// TODO: get the field
SEXP call = PROTECT( Rf_lang3(
R_DollarSymbol,
const_cast<Reference&>(parent).asSexp(),
Rf_mkString( field_name.c_str() )
) ) ;
return Rcpp::internal::try_catch( call ) ;
UNPROTECT(1) ;
}
void Reference::FieldProxy::set( SEXP x) const {
PROTECT(x);
SEXP dollarGetsSym = Rf_install( "$<-");
SEXP call = PROTECT( Rf_lang4(
dollarGetsSym,
const_cast<Reference&>(parent).asSexp(),
Rf_mkString( field_name.c_str() ),
x
) ) ;
const_cast<Reference&>(parent).setSEXP( Rf_eval( call, R_GlobalEnv ) );
UNPROTECT(2) ;
}
Reference::FieldProxy Reference::field( const std::string& name) const {
return FieldProxy( *this, name );
}
} // namespace Rcpp
Computing file changes ...