|
Rcpp Version 0.9.10
|
00001 // -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- 00002 // 00003 // Function.cpp: Rcpp R/C++ interface class library -- functions 00004 // 00005 // Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois 00006 // 00007 // This file is part of Rcpp. 00008 // 00009 // Rcpp is free software: you can redistribute it and/or modify it 00010 // under the terms of the GNU General Public License as published by 00011 // the Free Software Foundation, either version 2 of the License, or 00012 // (at your option) any later version. 00013 // 00014 // Rcpp is distributed in the hope that it will be useful, but 00015 // WITHOUT ANY WARRANTY; without even the implied warranty of 00016 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 00017 // GNU General Public License for more details. 00018 // 00019 // You should have received a copy of the GNU General Public License 00020 // along with Rcpp. If not, see <http://www.gnu.org/licenses/>. 00021 00022 #include <Rcpp/Function.h> 00023 00024 namespace Rcpp { 00025 00026 Function::Function( SEXP x = R_NilValue ) : RObject( ){ 00027 switch( TYPEOF(x) ){ 00028 case CLOSXP: 00029 case SPECIALSXP: 00030 case BUILTINSXP: 00031 setSEXP(x); 00032 break; 00033 default: 00034 throw not_compatible("cannot convert to function") ; 00035 } 00036 } 00037 00038 Function::Function(const std::string& name) : RObject() { 00039 SEXP nameSym = Rf_install( name.c_str() ); // cannot be gc()'ed once in symbol table 00040 SEXP x = PROTECT( Rf_findFun( nameSym, R_GlobalEnv ) ) ; 00041 setSEXP( x ) ; 00042 UNPROTECT(1) ; 00043 } 00044 00045 Function::Function(const Function& other) : RObject(){ 00046 setSEXP( other.asSexp() ); 00047 } 00048 00049 Function& Function::operator=(const Function& other){ 00050 setSEXP( other.asSexp() ); 00051 return *this ; 00052 } 00053 00054 Function::~Function(){} 00055 00056 SEXP Function::environment() const { 00057 if( TYPEOF(m_sexp) != CLOSXP ) { 00058 throw not_a_closure() ; 00059 } 00060 return CLOENV(m_sexp) ; 00061 } 00062 00063 SEXP Function::body() const { 00064 return BODY( m_sexp ) ; 00065 } 00066 00067 } // namespace Rcpp