// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- // // api.cpp: Rcpp R/C++ interface class library -- Rcpp api // // Copyright (C) 2012 - 2020 Dirk Eddelbuettel and Romain Francois // Copyright (C) 2021 - 2023 Dirk Eddelbuettel, Romain Francois and IƱaki Ucar // // 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 . #define COMPILING_RCPP #define RCPP_USE_GLOBAL_ROSTREAM #include using namespace Rcpp; #include "internal.h" #include #ifdef RCPP_HAS_DEMANGLING #include #endif namespace Rcpp { // [[Rcpp::register]] Rostream& Rcpp_cout_get() { static Rostream Rcpp_cout; return Rcpp_cout; } // [[Rcpp::register]] Rostream& Rcpp_cerr_get() { static Rostream Rcpp_cerr; return Rcpp_cerr; } Rostream& Rcout = Rcpp_cout_get(); Rostream& Rcerr = Rcpp_cerr_get(); namespace internal { int rngSynchronizationSuspended = 0; // [[Rcpp::register]] unsigned long enterRNGScope() { if (rngSynchronizationSuspended == 0) GetRNGstate(); return 0; } // [[Rcpp::register]] unsigned long exitRNGScope() { if (rngSynchronizationSuspended == 0) PutRNGstate(); return 0; } // [[Rcpp::register]] unsigned long beginSuspendRNGSynchronization() { // #nocov start ++rngSynchronizationSuspended; return rngSynchronizationSuspended; } // [[Rcpp::register]] unsigned long endSuspendRNGSynchronization() { --rngSynchronizationSuspended; return rngSynchronizationSuspended; } // #nocov end // [[Rcpp::register]] char* get_string_buffer() { static char buffer[MAXELTSIZE]; return buffer; } } // [[Rcpp::register]] const char * type2name(SEXP x) { // #nocov start switch (TYPEOF(x)) { case NILSXP: return "NILSXP"; case SYMSXP: return "SYMSXP"; case RAWSXP: return "RAWSXP"; case LISTSXP: return "LISTSXP"; case CLOSXP: return "CLOSXP"; case ENVSXP: return "ENVSXP"; case PROMSXP: return "PROMSXP"; case LANGSXP: return "LANGSXP"; case SPECIALSXP: return "SPECIALSXP"; case BUILTINSXP: return "BUILTINSXP"; case CHARSXP: return "CHARSXP"; case LGLSXP: return "LGLSXP"; case INTSXP: return "INTSXP"; case REALSXP: return "REALSXP"; case CPLXSXP: return "CPLXSXP"; case STRSXP: return "STRSXP"; case DOTSXP: return "DOTSXP"; case ANYSXP: return "ANYSXP"; case VECSXP: return "VECSXP"; case EXPRSXP: return "EXPRSXP"; case BCODESXP: return "BCODESXP"; case EXTPTRSXP: return "EXTPTRSXP"; case WEAKREFSXP: return "WEAKREFSXP"; #if R_VERSION >= R_Version(4,4,0) // replaces S4SXP in R 4.4.0 case OBJSXP: return Rf_isS4(x) ? "S4SXP" : "OBJSXP"; // cf src/main/inspect.c #else case S4SXP: return "S4SXP"; #endif default: return ""; } } // #nocov end } // namespace Rcpp // [[Rcpp::register]] std::string demangle(const std::string& name) { #ifdef RCPP_HAS_DEMANGLING std::string real_class; int status =-1; char *dem = 0; dem = abi::__cxa_demangle(name.c_str(), 0, 0, &status); if (status == 0) { real_class = dem; free(dem); } else { real_class = name; } return real_class; #else return name; #endif } // NOTE: remains registered but this routine is now effectively unused by Rcpp; // we retain it for backwards compatibility with any existing packages which // (explicitly or implicitly) rely on its existence. See also: // https://github.com/RcppCore/Rcpp/issues/1066 // [[Rcpp::register]] const char* short_file_name(const char* file) { // #nocov start static std::string f; f = file; size_t index = f.find("/include/"); if (index != std::string::npos) { f = f.substr(index + 9); } return f.c_str(); } // [[Rcpp::internal]] SEXP as_character_externalptr(SEXP xp) { char buffer[20]; snprintf(buffer, 20, "%p", (void*)R_ExternalPtrAddr(xp)); return Rcpp::wrap((const char*)buffer); } // #nocov end // [[Rcpp::internal]] SEXP rcpp_capabilities() { Shield cap(Rf_allocVector(LGLSXP, 13)); Shield names(Rf_allocVector(STRSXP, 13)); #ifdef HAS_VARIADIC_TEMPLATES LOGICAL(cap)[0] = TRUE; #else LOGICAL(cap)[0] = FALSE; #endif #ifdef HAS_CXX0X_INITIALIZER_LIST LOGICAL(cap)[1] = TRUE; #else LOGICAL(cap)[1] = FALSE; #endif /* exceptions are always supported */ LOGICAL(cap)[2] = TRUE; #ifdef HAS_TR1_UNORDERED_MAP LOGICAL(cap)[3] = TRUE; #else LOGICAL(cap)[3] = FALSE; #endif #ifdef HAS_TR1_UNORDERED_SET LOGICAL(cap)[4] = TRUE; #else LOGICAL(cap)[4] = FALSE; #endif LOGICAL(cap)[5] = TRUE; #ifdef RCPP_HAS_DEMANGLING LOGICAL(cap)[6] = TRUE; #else LOGICAL(cap)[6] = FALSE; #endif LOGICAL(cap)[7] = FALSE; #ifdef RCPP_HAS_LONG_LONG_TYPES LOGICAL(cap)[8] = TRUE; #else LOGICAL(cap)[8] = FALSE; #endif #ifdef HAS_CXX0X_UNORDERED_MAP LOGICAL(cap)[9] = TRUE; #else LOGICAL(cap)[9] = FALSE; #endif #ifdef HAS_CXX0X_UNORDERED_SET LOGICAL(cap)[10] = TRUE; #else LOGICAL(cap)[10] = FALSE; #endif #ifdef RCPP_USING_CXX11 LOGICAL(cap)[11] = TRUE; #else LOGICAL(cap)[11] = FALSE; #endif #ifdef RCPP_NEW_DATE_DATETIME_VECTORS LOGICAL(cap)[12] = TRUE; #else LOGICAL(cap)[12] = FALSE; #endif SET_STRING_ELT(names, 0, Rf_mkChar("variadic templates")); SET_STRING_ELT(names, 1, Rf_mkChar("initializer lists")); SET_STRING_ELT(names, 2, Rf_mkChar("exception handling")); SET_STRING_ELT(names, 3, Rf_mkChar("tr1 unordered maps")); SET_STRING_ELT(names, 4, Rf_mkChar("tr1 unordered sets")); SET_STRING_ELT(names, 5, Rf_mkChar("Rcpp modules")); SET_STRING_ELT(names, 6, Rf_mkChar("demangling")); SET_STRING_ELT(names, 7, Rf_mkChar("classic api")); SET_STRING_ELT(names, 8, Rf_mkChar("long long")); SET_STRING_ELT(names, 9, Rf_mkChar("C++0x unordered maps")); SET_STRING_ELT(names, 10, Rf_mkChar("C++0x unordered sets")); SET_STRING_ELT(names, 11, Rf_mkChar("Full C++11 support")); SET_STRING_ELT(names, 12, Rf_mkChar("new date(time) vectors")); Rf_setAttrib(cap, R_NamesSymbol, names); return cap; } // [[Rcpp::internal]] SEXP rcpp_can_use_cxx0x() { // #nocov start #if defined(HAS_VARIADIC_TEMPLATES) return Rf_ScalarLogical(TRUE); #else return Rf_ScalarLogical(FALSE); #endif } // [[Rcpp::internal]] SEXP rcpp_can_use_cxx11() { #if defined(RCPP_USING_CXX11) return Rf_ScalarLogical(TRUE); #else return Rf_ScalarLogical(FALSE); #endif } // [[Rcpp::register]] SEXP stack_trace(const char* file, int line) { return R_NilValue; } // #nocov end // // [ [ Rcpp::register ] ] // void print(SEXP s) { // Rf_PrintValue(s); // defined in Rinternals.h // } // }}} // [[Rcpp::internal]] SEXP getRcppVersionStrings() { Shield versionstring(Rf_allocVector(STRSXP,2)); SET_STRING_ELT(versionstring, 0, Rf_mkChar(RCPP_VERSION_STRING)); SET_STRING_ELT(versionstring, 1, Rf_mkChar(RCPP_DEV_VERSION_STRING)); return versionstring; }