diff --git a/packages/nimble/R/cppDefs_nimbleFunction.R b/packages/nimble/R/cppDefs_nimbleFunction.R index 32a13d9f0..1bf4fe943 100644 --- a/packages/nimble/R/cppDefs_nimbleFunction.R +++ b/packages/nimble/R/cppDefs_nimbleFunction.R @@ -1204,7 +1204,7 @@ makeCopyFromRobjectDef <- function(cppCopyTypes, quote = TRUE ) } else { - unprotectCount <- 2 + length(copyCalls) ## 2 from SETUP_S_xData + unprotectCount <- length(copyCalls) ## 0 extra from SETUP_S_xData (1 PROTECT, covered by the +1 below) allRcode <- do.call('call', c(list('{'), list(cppLiteral("SETUP_S_xData;")), diff --git a/packages/nimble/R/cppDefs_nimbleList.R b/packages/nimble/R/cppDefs_nimbleList.R index 2865633ec..b36db2e97 100644 --- a/packages/nimble/R/cppDefs_nimbleList.R +++ b/packages/nimble/R/cppDefs_nimbleList.R @@ -228,12 +228,6 @@ cppNimbleListClass <- setRefClass('cppNimbleListClass', conditionalClauseStart <- list(quote(cppLiteral('if (!RCopiedFlag){'))) conditionalClauseEnd <- list(quote(cppLiteral('}'))) - environmentCPPName <- Rname2CppName('S_.xData') ## create SEXP for ref class environment - listElementTable$addSymbol(cppSEXP(name = environmentCPPName)) - envLine <- substitute({PROTECT(ENVNAME <- Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(ENVNAME, 0, PROTECT(Rf_mkChar(".xData")));}, - list(ENVNAME = as.name(environmentCPPName))) - for(i in seq_along(elementNames)){ Snames[i] <- Rname2CppName(paste0('S_', elementNames[i])) listElementTable$addSymbol(cppSEXP(name = Snames[i])) @@ -241,18 +235,17 @@ cppNimbleListClass <- setRefClass('cppNimbleListClass', conditionalLineList <- c(conditionalLineList, generateConditionalLines(nimCompProc$symTab$getSymbolObject(elementNames[i]), listElementTable$getSymbolObject(Snames[i]))) - copyToListLines[[i]] <- substitute(Rf_defineVar(Rf_install(ELEMENTNAME), VALUE, PROTECT(GET_SLOT(ROBJ, XDATA))), + copyToListLines[[i]] <- substitute(Rf_defineVar(Rf_install(ELEMENTNAME), VALUE, PROTECT(R_do_slot(ROBJ, Rf_install(".xData")))), list(ELEMENTNAME = elementNames[i], VALUE = as.name(Snames[i]), - ROBJ = as.name('RObjectPointer'), - XDATA = as.name(environmentCPPName))) + ROBJ = as.name('RObjectPointer'))) } setFlagLine <- list(substitute(RCopiedFlag <- true, list())) returnLine <- list(substitute(return(ROBJ), list(ROBJ = as.name('RObjectPointer')))) - unprotectLine <- list(substitute(UNPROTECT(N), list(N = 2 * numElements + 1 + 1))) - allCode <- embedListInRbracket(c(conditionalClauseStart, list(envLine), conditionalLineList, + unprotectLine <- list(substitute(UNPROTECT(N), list(N = 2 * numElements))) + allCode <- embedListInRbracket(c(conditionalClauseStart, conditionalLineList, copyToListLines, setFlagLine, unprotectLine, conditionalClauseEnd, returnLine)) functionDefs[[paste0(name, "_copyTo")]] <<- cppFunctionDef(name = "copyToSEXP", @@ -276,26 +269,19 @@ cppNimbleListClass <- setRefClass('cppNimbleListClass', listElementTable <- symbolTable() storeSexpLine <- list(quote(cppLiteral('R_PreserveObject(RObjectPointer = S_nimList_);'))) - environmentCPPName <- Rname2CppName('S_.xData') ## create SEXP for ref class environment - listElementTable$addSymbol(cppSEXP(name = environmentCPPName)) - envLine <- substitute({PROTECT(ENVNAME <- Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(ENVNAME, 0, PROTECT(Rf_mkChar(".xData")));}, - list(ENVNAME = as.name(environmentCPPName))) - for(i in seq_along(argNames)) { Snames[i] <- Rname2CppName(paste0('S_', argNames[i])) listElementTable$addSymbol(cppSEXP(name = Snames[i])) - copyFromListLines[[i]] <- substitute(PROTECT(SVAR <- NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, XDATA)), Rf_install(ARGNAME))), + copyFromListLines[[i]] <- substitute(PROTECT(SVAR <- NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install(ARGNAME))), list(ARGNAME = argNames[i], - SVAR = as.name(Snames[i]), - XDATA = as.name(environmentCPPName))) + SVAR = as.name(Snames[i]))) copyLine <- buildCopyLineFromSEXP(listElementTable$getSymbolObject(Snames[i]), nimCompProc$symTab$getSymbolObject(argNames[i])) copyLines <- c(copyLines, copyLine) } numArgs <- length(argNames) - unprotectLine <- substitute(UNPROTECT(N), list(N = 2 * numArgs + 1 + 1)) - allCode <- embedListInRbracket(c(storeSexpLine, envLine, + unprotectLine <- substitute(UNPROTECT(N), list(N = 2 * numArgs)) + allCode <- embedListInRbracket(c(storeSexpLine, copyFromListLines, copyLines, list(unprotectLine))) functionDefs[[paste0(name, "_copyFrom")]] <<- cppFunctionDef(name = "copyFromSEXP", diff --git a/packages/nimble/inst/CppCode/RcppNimbleUtils.cpp b/packages/nimble/inst/CppCode/RcppNimbleUtils.cpp index 2da7514d0..77469cc16 100644 --- a/packages/nimble/inst/CppCode/RcppNimbleUtils.cpp +++ b/packages/nimble/inst/CppCode/RcppNimbleUtils.cpp @@ -54,16 +54,13 @@ SEXP setDoublePtrFromSinglePtr(SEXP SdoublePtr, SEXP SsinglePtr) { void setNimbleFxnPtr_copyFromRobject(void *nf_to, SEXP S_NF_from) { void **doublePtr = static_cast(nf_to); SEXP Scnf, SsinglePtr; - SEXP S_pxData; - PROTECT(S_pxData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S_pxData, 0, Rf_mkChar(".xData")); // environment(modelVar)$.CobjectInterface - PROTECT(Scnf = NIM_FINDVARINFRAME(PROTECT(GET_SLOT( + PROTECT(Scnf = NIM_FINDVARINFRAME(PROTECT(R_do_slot( S_NF_from, - S_pxData)), + Rf_install(".xData"))), Rf_install(".CobjectInterface")) ); - int unprotectCount = 3; + int unprotectCount = 2; if(Rf_isNewList(Scnf)) { // multi-interface //Cnf[[1]]$basePtrList[[ Cnf[[2]] ]] @@ -72,10 +69,10 @@ void setNimbleFxnPtr_copyFromRobject(void *nf_to, SEXP S_NF_from) { int index = (Rf_isInteger(Sindex) ? INTEGER(Sindex)[0] : REAL(Sindex)[0]); index--; // From 1-based to 0-based indexing PROTECT(SsinglePtr = VECTOR_ELT( - NIM_FINDVARINFRAME(PROTECT(GET_SLOT( + NIM_FINDVARINFRAME(PROTECT(R_do_slot( VECTOR_ELT(Scnf, 0), - S_pxData)), + Rf_install(".xData"))), Rf_install("basePtrList")), index ) @@ -85,9 +82,9 @@ void setNimbleFxnPtr_copyFromRobject(void *nf_to, SEXP S_NF_from) { // printf("in non-list\n"); // full interface // Cnf$.basePtr - PROTECT(SsinglePtr = NIM_FINDVARINFRAME(PROTECT(GET_SLOT( + PROTECT(SsinglePtr = NIM_FINDVARINFRAME(PROTECT(R_do_slot( Scnf, - S_pxData)), + Rf_install(".xData"))), Rf_install(".basePtr"))); unprotectCount += 2; } diff --git a/packages/nimble/inst/CppCode/RcppUtils.cpp b/packages/nimble/inst/CppCode/RcppUtils.cpp index 7a448a731..1a6185f66 100644 --- a/packages/nimble/inst/CppCode/RcppUtils.cpp +++ b/packages/nimble/inst/CppCode/RcppUtils.cpp @@ -49,7 +49,10 @@ vector getSEXPdims(SEXP Sx) { vector ans; ans.resize(1); ans[0] = LENGTH(Sx); return(ans); } - return(SEXP_2_vectorInt(Rf_getAttrib(Sx, R_DimSymbol), 0)); + SEXP dims = PROTECT(Rf_getAttrib(Sx, R_DimSymbol)); + vector result = SEXP_2_vectorInt(dims, 0); + UNPROTECT(1); + return result; } string STRSEXP_2_string(SEXP Ss, int i) { @@ -858,7 +861,7 @@ SEXP varAndIndices_2_LANGSXP(const varAndIndicesClass &varAndInds) { Sans = PROTECT(Rf_install(varAndInds.varName.c_str())); } else { t = Sans = PROTECT(Rf_allocVector(LANGSXP, ansLen)); - SETCAR(t, R_BracketSymbol); t = CDR(t); + SETCAR(t, Rf_install("[")); t = CDR(t); SETCAR(t, Rf_install(varAndInds.varName.c_str())); t = CDR(t); for(size_t i = 0; i < varAndInds.indices.size(); ++i) { if(varAndInds.indices[i].size() == 0) { // blank diff --git a/packages/nimble/inst/CppCode/accessorClasses.cpp b/packages/nimble/inst/CppCode/accessorClasses.cpp index 467e3a492..64e5885d5 100644 --- a/packages/nimble/inst/CppCode/accessorClasses.cpp +++ b/packages/nimble/inst/CppCode/accessorClasses.cpp @@ -920,27 +920,24 @@ void populateNodeFxnVectorNew_internal_forDerivs(NodeVectorClassNew_derivs* nfv, void populateNodeFxnVectorNew_copyFromRobject_forDerivs(void *nodeFxnVec_to, SEXP S_nodeFxnVec_from ) { SEXP S_indexingInfo; - SEXP S_pxData; - PROTECT(S_pxData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S_pxData, 0, Rf_mkChar(".xData")); PROTECT(S_indexingInfo = VECTOR_ELT(S_nodeFxnVec_from, 1)); SEXP S_declIDs; PROTECT(S_declIDs = VECTOR_ELT(S_indexingInfo, 0)); SEXP S_rowIndices; PROTECT(S_rowIndices = VECTOR_ELT(S_indexingInfo, 1)); SEXP S_numberedPtrs; - PROTECT(S_numberedPtrs = PROTECT(NIM_FINDVARINFRAME(PROTECT(GET_SLOT( - PROTECT(NIM_FINDVARINFRAME(PROTECT(GET_SLOT( - PROTECT(NIM_FINDVARINFRAME(PROTECT(GET_SLOT( + PROTECT(S_numberedPtrs = PROTECT(NIM_FINDVARINFRAME(PROTECT(R_do_slot( + PROTECT(NIM_FINDVARINFRAME(PROTECT(R_do_slot( + PROTECT(NIM_FINDVARINFRAME(PROTECT(R_do_slot( VECTOR_ELT(S_nodeFxnVec_from, 2 ), - S_pxData)), + Rf_install(".xData"))), Rf_install("CobjectInterface") )), - S_pxData)), + Rf_install(".xData"))), Rf_install(".nodeFxnPointers_byDeclID"))), - S_pxData)), + Rf_install(".xData"))), Rf_install(".ptr") )) ); @@ -948,7 +945,7 @@ void populateNodeFxnVectorNew_copyFromRobject_forDerivs(void *nodeFxnVec_to, SEX PROTECT(SderivInfo = VECTOR_ELT(S_nodeFxnVec_from, 3)); NodeVectorClassNew_derivs* nfv_derivs = static_cast(nodeFxnVec_to); populateNodeFxnVectorNew_internal_forDerivs(nfv_derivs, S_declIDs, S_numberedPtrs, S_rowIndices, SderivInfo); - UNPROTECT(12); + UNPROTECT(11); } SEXP populateNodeFxnVectorNew_byDeclID_forDerivs(SEXP SnodeFxnVec, SEXP S_GIDs, SEXP SnumberedObj, SEXP S_ROWINDS, SEXP SderivInfo){ @@ -979,9 +976,6 @@ void populateNodeFxnVectorNew_internal(NodeVectorClassNew* nfv, SEXP S_GIDs, SEX void populateNodeFxnVectorNew_copyFromRobject(void *nodeFxnVec_to, SEXP S_nodeFxnVec_from ) { SEXP S_indexingInfo; - SEXP S_pxData; - S_pxData = PROTECT(Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S_pxData, 0, Rf_mkChar(".xData")); S_indexingInfo = PROTECT(VECTOR_ELT(S_nodeFxnVec_from, 1)); SEXP S_declIDs; S_declIDs = PROTECT(VECTOR_ELT(S_indexingInfo, 0)); @@ -990,24 +984,24 @@ void populateNodeFxnVectorNew_copyFromRobject(void *nodeFxnVec_to, SEXP S_nodeFx SEXP S_numberedPtrs; // equivalent to S_nodeFxnVec_from[["model"]]$CobjectInterface$.nodeFxnPointers_byDeclID$.ptr // implemented by S_nodeFxnVec_from[[2]]@.xData[["CobjectInterface"]]@.xData[[".nodeFxnPointers_byDeclID"]]@.xData[[".ptr"]] - S_numberedPtrs = PROTECT(NIM_FINDVARINFRAME(PROTECT(GET_SLOT( - PROTECT(NIM_FINDVARINFRAME(PROTECT(GET_SLOT( - PROTECT(NIM_FINDVARINFRAME(PROTECT(GET_SLOT( + S_numberedPtrs = PROTECT(NIM_FINDVARINFRAME(PROTECT(R_do_slot( + PROTECT(NIM_FINDVARINFRAME(PROTECT(R_do_slot( + PROTECT(NIM_FINDVARINFRAME(PROTECT(R_do_slot( VECTOR_ELT(S_nodeFxnVec_from, 2 ), - S_pxData)), + Rf_install(".xData"))), Rf_install("CobjectInterface") )), - S_pxData)), + Rf_install(".xData"))), Rf_install(".nodeFxnPointers_byDeclID"))), - S_pxData)), + Rf_install(".xData"))), Rf_install(".ptr") ) ); NodeVectorClassNew* nfv = static_cast(nodeFxnVec_to); populateNodeFxnVectorNew_internal(nfv, S_declIDs, S_numberedPtrs, S_rowIndices); - UNPROTECT(10); + UNPROTECT(9); } SEXP populateNodeFxnVectorNew_byDeclID(SEXP SnodeFxnVec, SEXP S_GIDs, SEXP SnumberedObj, SEXP S_ROWINDS){ diff --git a/packages/nimble/inst/CppCode/eigenUsingClasses.cpp b/packages/nimble/inst/CppCode/eigenUsingClasses.cpp index 97db77ffc..fec0b92a6 100644 --- a/packages/nimble/inst/CppCode/eigenUsingClasses.cpp +++ b/packages/nimble/inst/CppCode/eigenUsingClasses.cpp @@ -71,17 +71,14 @@ void SEXP_2_NimArr<1>(SEXP Sn, NimArr<1, int> &ans) { /*EIGEN_EIGEN class functions below */ SEXP EIGEN_EIGENCLASS_R::copyToSEXP ( ) { - SEXP S_pxData; SEXP S_values; SEXP S_vectors; - PROTECT(S_pxData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S_pxData, 0, Rf_mkChar(".xData")); PROTECT(S_values = NimArr_2_SEXP<1>(values)); PROTECT(S_vectors = NimArr_2_SEXP<2>(vectors)); - Rf_defineVar(Rf_install("values"), S_values, PROTECT(GET_SLOT(RObjectPointer, S_pxData))); - Rf_defineVar(Rf_install("vectors"), S_vectors, PROTECT(GET_SLOT(RObjectPointer, S_pxData))); - UNPROTECT(5); + Rf_defineVar(Rf_install("values"), S_values, PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); + Rf_defineVar(Rf_install("vectors"), S_vectors, PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); + UNPROTECT(4); return(RObjectPointer); } @@ -97,36 +94,30 @@ void EIGEN_EIGENCLASS_R::createNewSEXP ( ) { } void EIGEN_EIGENCLASS_R::copyFromSEXP ( SEXP S_nimList_ ) { - SEXP S_pxData; SEXP S_values; SEXP S_vectors; RObjectPointer = S_nimList_; - PROTECT(S_pxData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S_pxData, 0, Rf_mkChar(".xData")); - PROTECT(S_values = NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S_pxData)), Rf_install("values"))); - PROTECT(S_vectors = NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S_pxData)), Rf_install("vectors"))); + PROTECT(S_values = NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("values"))); + PROTECT(S_vectors = NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("vectors"))); SEXP_2_NimArr<1>(S_values, values); SEXP_2_NimArr<2>(S_vectors, vectors); - UNPROTECT(5); + UNPROTECT(4); } /*EIGEN_SVD class functions below */ SEXP EIGEN_SVDCLASS_R::copyToSEXP ( ) { - SEXP S_pxData; SEXP S_d; SEXP S_u; SEXP S_v; - PROTECT(S_pxData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S_pxData, 0, Rf_mkChar(".xData")); PROTECT(S_d = NimArr_2_SEXP<1>(d)); PROTECT(S_u = NimArr_2_SEXP<2>(u)); PROTECT(S_v = NimArr_2_SEXP<2>(v)); - Rf_defineVar(Rf_install("d"), S_d, PROTECT(GET_SLOT(RObjectPointer, S_pxData))); - Rf_defineVar(Rf_install("u"), S_u, PROTECT(GET_SLOT(RObjectPointer, S_pxData))); - Rf_defineVar(Rf_install("v"), S_v, PROTECT(GET_SLOT(RObjectPointer, S_pxData))); - UNPROTECT(7); + Rf_defineVar(Rf_install("d"), S_d, PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); + Rf_defineVar(Rf_install("u"), S_u, PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); + Rf_defineVar(Rf_install("v"), S_v, PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); + UNPROTECT(6); return(RObjectPointer); } @@ -142,20 +133,17 @@ void EIGEN_EIGENCLASS_R::copyFromSEXP ( SEXP S_nimList_ ) { } void EIGEN_SVDCLASS_R::copyFromSEXP ( SEXP S_nimList_ ) { - SEXP S_pxData; SEXP S_d; SEXP S_v; SEXP S_u; RObjectPointer = S_nimList_; - PROTECT(S_pxData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S_pxData, 0, Rf_mkChar(".xData")); - PROTECT(S_d = NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S_pxData)), Rf_install("d"))); - PROTECT(S_v = NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S_pxData)), Rf_install("v"))); - PROTECT(S_u = NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S_pxData)), Rf_install("u"))); + PROTECT(S_d = NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("d"))); + PROTECT(S_v = NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("v"))); + PROTECT(S_u = NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("u"))); SEXP_2_NimArr<1>(S_d, d); SEXP_2_NimArr<2>(S_v, v); SEXP_2_NimArr<2>(S_u, u); - UNPROTECT(7); + UNPROTECT(6); } SEXP C_nimEigen(SEXP S_x, SEXP S_symmetric, SEXP S_valuesOnly, SEXP returnList) { diff --git a/packages/nimble/inst/CppCode/predefinedNimbleLists.cpp b/packages/nimble/inst/CppCode/predefinedNimbleLists.cpp index 014831546..7dc7e3b54 100644 --- a/packages/nimble/inst/CppCode/predefinedNimbleLists.cpp +++ b/packages/nimble/inst/CppCode/predefinedNimbleLists.cpp @@ -101,7 +101,6 @@ SEXP EIGEN_SVDCLASS_castDerivedPtrPtrToPairOfPtrsSEXP(SEXP input) { } void OptimResultNimbleList::copyFromSEXP(SEXP S_nimList_) { - SEXP S__dot_xData; SEXP S_par; SEXP S_value; SEXP S_counts; @@ -109,24 +108,23 @@ void OptimResultNimbleList::copyFromSEXP(SEXP S_nimList_) { SEXP S_message; SEXP S_hessian; R_PreserveObject(RObjectPointer = S_nimList_); - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); - PROTECT(S_par = NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + + PROTECT(S_par = NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("par"))); PROTECT(S_value = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("value"))); PROTECT(S_counts = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("counts"))); PROTECT(S_convergence = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("convergence"))); PROTECT(S_message = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("message"))); PROTECT(S_hessian = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("hessian"))); SEXP_2_NimArr<1>(S_par, par); value = SEXP_2_double(S_value); @@ -134,10 +132,9 @@ void OptimResultNimbleList::copyFromSEXP(SEXP S_nimList_) { convergence = SEXP_2_int(S_convergence); message = STRSEXP_2_string(S_message); SEXP_2_NimArr<2>(S_hessian, hessian); - UNPROTECT(14); + UNPROTECT(12); } SEXP OptimResultNimbleList::copyToSEXP() { - SEXP S__dot_xData; SEXP S_par; SEXP S_value; SEXP S_counts; @@ -145,8 +142,7 @@ SEXP OptimResultNimbleList::copyToSEXP() { SEXP S_message; SEXP S_hessian; if (!RCopiedFlag) { - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_par = NimArr_2_SEXP<1>(par)); PROTECT(S_value = double_2_SEXP(value)); PROTECT(S_counts = NimArr_2_SEXP<1>(counts)); @@ -154,19 +150,19 @@ SEXP OptimResultNimbleList::copyToSEXP() { PROTECT(S_message = string_2_STRSEXP(message)); PROTECT(S_hessian = NimArr_2_SEXP<2>(hessian)); Rf_defineVar(Rf_install("par"), S_par, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("value"), S_value, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("counts"), S_counts, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("convergence"), S_convergence, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("message"), S_message, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("hessian"), S_hessian, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); RCopiedFlag = true; - UNPROTECT(14); + UNPROTECT(12); } return (RObjectPointer); } @@ -191,7 +187,7 @@ void OptimResultNimbleList::copyFromRobject(SEXP Robject) { COPY_NUMERIC_VECTOR_FROM_R_OBJECT("counts"); COPY_INTEGER_SCALAR_FROM_R_OBJECT("convergence"); COPY_NUMERIC_VECTOR_FROM_R_OBJECT("hessian"); - UNPROTECT(8); + UNPROTECT(6); } OptimResultNimbleList::OptimResultNimbleList() { RCopiedFlag = false; @@ -251,7 +247,6 @@ SEXP OptimResultNimbleList_castDerivedPtrPtrToPairOfPtrsSEXP(SEXP input) { } void OptimControlNimbleList::copyFromSEXP(SEXP S_nimList_) { - SEXP S__dot_xData; SEXP S_trace; SEXP S_fnscale; SEXP S_parscale; @@ -270,54 +265,53 @@ void OptimControlNimbleList::copyFromSEXP(SEXP S_nimList_) { SEXP S_temp; SEXP S_tmax; R_PreserveObject(RObjectPointer = S_nimList_); - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_trace = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("trace"))); PROTECT(S_fnscale = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("fnscale"))); PROTECT(S_parscale = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("parscale"))); PROTECT(S_ndeps = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("ndeps"))); PROTECT(S_maxit = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("maxit"))); PROTECT(S_abstol = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("abstol"))); PROTECT(S_reltol = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("reltol"))); PROTECT(S_alpha = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("alpha"))); PROTECT(S_beta = NIM_FINDVARINFRAME( - PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), Rf_install("beta"))); + PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("beta"))); PROTECT(S_gamma = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("gamma"))); PROTECT(S_REPORT = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("REPORT"))); PROTECT(S_type = NIM_FINDVARINFRAME( - PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), Rf_install("type"))); - PROTECT(S_lmm = NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("type"))); + PROTECT(S_lmm = NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("lmm"))); PROTECT(S_factr = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("factr"))); PROTECT(S_pgtol = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("pgtol"))); PROTECT(S_temp = NIM_FINDVARINFRAME( - PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), Rf_install("temp"))); + PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("temp"))); PROTECT(S_tmax = NIM_FINDVARINFRAME( - PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), Rf_install("tmax"))); + PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("tmax"))); trace = SEXP_2_int(S_trace); fnscale = SEXP_2_double(S_fnscale); SEXP_2_NimArr<1>(S_parscale, parscale); @@ -335,10 +329,9 @@ void OptimControlNimbleList::copyFromSEXP(SEXP S_nimList_) { pgtol = SEXP_2_double(S_pgtol); temp = SEXP_2_double(S_temp); tmax = SEXP_2_int(S_tmax); - UNPROTECT(36); + UNPROTECT(34); } SEXP OptimControlNimbleList::copyToSEXP() { - SEXP S__dot_xData; SEXP S_trace; SEXP S_fnscale; SEXP S_parscale; @@ -357,8 +350,7 @@ SEXP OptimControlNimbleList::copyToSEXP() { SEXP S_temp; SEXP S_tmax; if (!RCopiedFlag) { - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_trace = int_2_SEXP(trace)); PROTECT(S_fnscale = double_2_SEXP(fnscale)); PROTECT(S_parscale = NimArr_2_SEXP<1>(parscale)); @@ -377,41 +369,41 @@ SEXP OptimControlNimbleList::copyToSEXP() { PROTECT(S_temp = double_2_SEXP(temp)); PROTECT(S_tmax = int_2_SEXP(tmax)); Rf_defineVar(Rf_install("trace"), S_trace, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("fnscale"), S_fnscale, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("parscale"), S_parscale, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("ndeps"), S_ndeps, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("maxit"), S_maxit, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("abstol"), S_abstol, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("reltol"), S_reltol, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("alpha"), S_alpha, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("beta"), S_beta, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("gamma"), S_gamma, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("REPORT"), S_REPORT, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("type"), S_type, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("lmm"), S_lmm, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("factr"), S_factr, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("pgtol"), S_pgtol, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("temp"), S_temp, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("tmax"), S_tmax, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); RCopiedFlag = true; - UNPROTECT(36); + UNPROTECT(34); } return (RObjectPointer); } @@ -448,7 +440,7 @@ void OptimControlNimbleList::copyFromRobject(SEXP Robject) { COPY_DOUBLE_SCALAR_FROM_R_OBJECT("pgtol"); COPY_DOUBLE_SCALAR_FROM_R_OBJECT("temp"); COPY_INTEGER_SCALAR_FROM_R_OBJECT("tmax"); - UNPROTECT(20); + UNPROTECT(18); } OptimControlNimbleList::OptimControlNimbleList() { RCopiedFlag = false; @@ -519,47 +511,43 @@ SEXP OptimControlNimbleList_castDerivedPtrPtrToPairOfPtrsSEXP(SEXP input) { } void NIMBLE_ADCLASS::copyFromSEXP(SEXP S_nimList_) { - SEXP S__dot_xData; SEXP S_value; SEXP S_jacobian; SEXP S_hessian; R_PreserveObject(RObjectPointer = S_nimList_); - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_value = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("value"))); PROTECT(S_jacobian = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("jacobian"))); PROTECT(S_hessian = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("hessian"))); SEXP_2_NimArr<1>(S_value, value); SEXP_2_NimArr<2>(S_jacobian, jacobian); SEXP_2_NimArr<3>(S_hessian, hessian); - UNPROTECT(8); + UNPROTECT(6); } SEXP NIMBLE_ADCLASS::copyToSEXP() { PROTECT(RObjectPointer); - SEXP S__dot_xData; SEXP S_value; SEXP S_jacobian; SEXP S_hessian; if (!RCopiedFlag) { - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_value = NimArr_2_SEXP<1>(value)); PROTECT(S_jacobian = NimArr_2_SEXP<2>(jacobian)); PROTECT(S_hessian = NimArr_2_SEXP<3>(hessian)); Rf_defineVar(PROTECT(Rf_install("value")), S_value, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(PROTECT(Rf_install("jacobian")), S_jacobian, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(PROTECT(Rf_install("hessian")), S_hessian, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); RCopiedFlag = true; - UNPROTECT(11); + UNPROTECT(9); } UNPROTECT(1); return (RObjectPointer); @@ -584,7 +572,7 @@ void NIMBLE_ADCLASS::copyFromRobject(SEXP Robject) { COPY_NUMERIC_VECTOR_FROM_R_OBJECT("value"); COPY_NUMERIC_VECTOR_FROM_R_OBJECT("jacobian"); COPY_NUMERIC_VECTOR_FROM_R_OBJECT("hessian"); - UNPROTECT(6); + UNPROTECT(4); } NIMBLE_ADCLASS::NIMBLE_ADCLASS() { @@ -642,44 +630,40 @@ SEXP NIMBLE_ADCLASS_castDerivedPtrPtrToPairOfPtrsSEXP(SEXP input) { } void waicNimbleList::copyFromSEXP(SEXP S_nimList_) { - SEXP S__dot_xData; SEXP S_WAIC; SEXP S_lppd; SEXP S_pWAIC; R_PreserveObject(RObjectPointer = S_nimList_); - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_WAIC = NIM_FINDVARINFRAME( - PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), Rf_install("WAIC"))); + PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("WAIC"))); PROTECT(S_lppd = NIM_FINDVARINFRAME( - PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), Rf_install("lppd"))); + PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("lppd"))); PROTECT(S_pWAIC = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("pWAIC"))); WAIC = SEXP_2_double(S_WAIC); lppd = SEXP_2_double(S_lppd); pWAIC = SEXP_2_double(S_pWAIC); - UNPROTECT(8); + UNPROTECT(6); } SEXP waicNimbleList::copyToSEXP() { - SEXP S__dot_xData; SEXP S_WAIC; SEXP S_lppd; SEXP S_pWAIC; if (!RCopiedFlag) { - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_WAIC = double_2_SEXP(WAIC)); PROTECT(S_lppd = double_2_SEXP(lppd)); PROTECT(S_pWAIC = double_2_SEXP(pWAIC)); Rf_defineVar(Rf_install("WAIC"), S_WAIC, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("lppd"), S_lppd, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("pWAIC"), S_pWAIC, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); RCopiedFlag = true; - UNPROTECT(8); + UNPROTECT(6); } return (RObjectPointer); } @@ -702,7 +686,7 @@ void waicNimbleList::copyFromRobject(SEXP Robject) { COPY_DOUBLE_SCALAR_FROM_R_OBJECT("WAIC"); COPY_DOUBLE_SCALAR_FROM_R_OBJECT("lppd"); COPY_DOUBLE_SCALAR_FROM_R_OBJECT("pWAIC"); - UNPROTECT(6); + UNPROTECT(4); } waicNimbleList::waicNimbleList() { RCopiedFlag = false; @@ -758,7 +742,6 @@ SEXP waicNimbleList_castDerivedPtrPtrToPairOfPtrsSEXP(SEXP input) { } void waicDetailsNimbleList::copyFromSEXP(SEXP S_nimList_) { - SEXP S__dot_xData; SEXP S_marginal; SEXP S_niterMarginal; SEXP S_thin; @@ -772,42 +755,41 @@ void waicDetailsNimbleList::copyFromSEXP(SEXP S_nimList_) { SEXP S_lppd_elements; SEXP S_pWAIC_elements; R_PreserveObject(RObjectPointer = S_nimList_); - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_marginal = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("marginal"))); PROTECT(S_niterMarginal = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("niterMarginal"))); PROTECT(S_thin = NIM_FINDVARINFRAME( - PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), Rf_install("thin"))); + PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("thin"))); PROTECT(S_online = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("online"))); PROTECT(S_nburnin_extra = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("nburnin_extra"))); PROTECT(S_WAIC_partialMC = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("WAIC_partialMC"))); PROTECT(S_lppd_partialMC = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("lppd_partialMC"))); PROTECT(S_pWAIC_partialMC = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("pWAIC_partialMC"))); PROTECT(S_niterMarginal_partialMC = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("niterMarginal_partialMC"))); PROTECT(S_WAIC_elements = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("WAIC_elements"))); PROTECT(S_lppd_elements = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("lppd_elements"))); PROTECT(S_pWAIC_elements = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("pWAIC_elements"))); marginal = SEXP_2_bool(S_marginal); niterMarginal = SEXP_2_double(S_niterMarginal); @@ -821,10 +803,9 @@ void waicDetailsNimbleList::copyFromSEXP(SEXP S_nimList_) { SEXP_2_NimArr<1>(S_WAIC_elements, WAIC_elements); SEXP_2_NimArr<1>(S_lppd_elements, lppd_elements); SEXP_2_NimArr<1>(S_pWAIC_elements, pWAIC_elements); - UNPROTECT(26); + UNPROTECT(24); } SEXP waicDetailsNimbleList::copyToSEXP() { - SEXP S__dot_xData; SEXP S_marginal; SEXP S_niterMarginal; SEXP S_thin; @@ -838,8 +819,7 @@ SEXP waicDetailsNimbleList::copyToSEXP() { SEXP S_lppd_elements; SEXP S_pWAIC_elements; if (!RCopiedFlag) { - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_marginal = bool_2_SEXP(marginal)); PROTECT(S_niterMarginal = double_2_SEXP(niterMarginal)); PROTECT(S_thin = bool_2_SEXP(thin)); @@ -854,32 +834,32 @@ SEXP waicDetailsNimbleList::copyToSEXP() { PROTECT(S_lppd_elements = NimArr_2_SEXP<1>(lppd_elements)); PROTECT(S_pWAIC_elements = NimArr_2_SEXP<1>(pWAIC_elements)); Rf_defineVar(Rf_install("marginal"), S_marginal, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("niterMarginal"), S_niterMarginal, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("thin"), S_thin, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("online"), S_online, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("nburnin_extra"), S_nburnin_extra, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("WAIC_partialMC"), S_WAIC_partialMC, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("lppd_partialMC"), S_lppd_partialMC, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("pWAIC_partialMC"), S_pWAIC_partialMC, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("niterMarginal_partialMC"), S_niterMarginal_partialMC, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("WAIC_elements"), S_WAIC_elements, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("lppd_elements"), S_lppd_elements, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("pWAIC_elements"), S_pWAIC_elements, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); RCopiedFlag = true; - UNPROTECT(26); + UNPROTECT(24); } return (RObjectPointer); } @@ -912,7 +892,7 @@ void waicDetailsNimbleList::copyFromRobject(SEXP Robject) { COPY_NUMERIC_VECTOR_FROM_R_OBJECT("WAIC_elements"); COPY_NUMERIC_VECTOR_FROM_R_OBJECT("lppd_elements"); COPY_NUMERIC_VECTOR_FROM_R_OBJECT("pWAIC_elements"); - UNPROTECT(15); + UNPROTECT(13); } waicDetailsNimbleList::waicDetailsNimbleList() { RCopiedFlag = false; @@ -979,47 +959,43 @@ SEXP waicDetailsNimbleList_castDerivedPtrPtrToPairOfPtrsSEXP(SEXP input) { // Hand-coded based on above patterns void AGHQuad_params::copyFromSEXP(SEXP S_nimList_) { - SEXP S__dot_xData; SEXP S_names; SEXP S_estimate; SEXP S_stdError; R_PreserveObject(RObjectPointer = S_nimList_); - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_names = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("names"))); PROTECT(S_estimate = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("estimate"))); PROTECT(S_stdError = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("stdError"))); STRSEXP_2_vectorString(S_names, names); SEXP_2_NimArr<1>(S_estimate, estimate); SEXP_2_NimArr<1>(S_stdError, stdError); - UNPROTECT(8); + UNPROTECT(6); } SEXP AGHQuad_params::copyToSEXP() { - SEXP S__dot_xData; SEXP S_names; SEXP S_estimate; SEXP S_stdError; if (!RCopiedFlag) { - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_names = vectorString_2_STRSEXP(names)); PROTECT(S_estimate = NimArr_2_SEXP<1>(estimate)); PROTECT(S_stdError = NimArr_2_SEXP<1>(stdError)); Rf_defineVar(Rf_install("names"), S_names, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("estimate"), S_estimate, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); Rf_defineVar(Rf_install("stdError"), S_stdError, - PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); RCopiedFlag = true; - UNPROTECT(8); + UNPROTECT(6); } return (RObjectPointer); } @@ -1047,7 +1023,7 @@ void AGHQuad_params::copyFromRobject(SEXP Robject) { *static_cast< std::vector* >(getObjectPtr(svarName))); COPY_NUMERIC_VECTOR_FROM_R_OBJECT("estimate"); COPY_NUMERIC_VECTOR_FROM_R_OBJECT("stdError"); - UNPROTECT(6); + UNPROTECT(4); } AGHQuad_params::AGHQuad_params() { RCopiedFlag = false; @@ -1105,25 +1081,23 @@ SEXP AGHQuad_params_castDerivedPtrPtrToPairOfPtrsSEXP(SEXP input) { // Also hand-coded void AGHQuad_summary::copyFromSEXP(SEXP S_nimList_) { - SEXP S__dot_xData; SEXP S_params; SEXP S_randomEffects; SEXP S_vcov; SEXP S_originalScale; R_PreserveObject(RObjectPointer = S_nimList_); - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + PROTECT(S_params = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("params"))); PROTECT(S_randomEffects = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("randomEffects"))); PROTECT(S_vcov = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("vcov"))); PROTECT(S_originalScale = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(S_nimList_, S__dot_xData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(S_nimList_, Rf_install(".xData"))), Rf_install("originalScale"))); params = new AGHQuad_params; params->copyFromSEXP(S_params); @@ -1131,30 +1105,28 @@ void AGHQuad_summary::copyFromSEXP(SEXP S_nimList_) { randomEffects->copyFromSEXP(S_randomEffects); SEXP_2_NimArr<2>(S_vcov, vcov); originalScale = SEXP_2_bool(S_originalScale); - UNPROTECT(10); + UNPROTECT(8); } SEXP AGHQuad_summary::copyToSEXP ( ) { - SEXP S__dot_xData; SEXP S_params; SEXP S_randomEffects; SEXP S_vcov; SEXP S_originalScale; if (!RCopiedFlag){ - PROTECT(S__dot_xData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(S__dot_xData, 0, PROTECT(Rf_mkChar(".xData"))); + if (!(*params).RObjectPointer) params->createNewSEXP(); PROTECT(S_params = params->copyToSEXP()); if (!(*randomEffects).RObjectPointer) randomEffects->createNewSEXP(); PROTECT(S_randomEffects = randomEffects->copyToSEXP()); PROTECT(S_vcov = NimArr_2_SEXP<2>(vcov)); PROTECT(S_originalScale = bool_2_SEXP(originalScale)); - Rf_defineVar(Rf_install("params"), S_params, PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); - Rf_defineVar(Rf_install("randomEffects"), S_randomEffects, PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); - Rf_defineVar(Rf_install("vcov"), S_vcov, PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); - Rf_defineVar(Rf_install("originalScale"), S_originalScale, PROTECT(GET_SLOT(RObjectPointer, S__dot_xData))); + Rf_defineVar(Rf_install("params"), S_params, PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); + Rf_defineVar(Rf_install("randomEffects"), S_randomEffects, PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); + Rf_defineVar(Rf_install("vcov"), S_vcov, PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); + Rf_defineVar(Rf_install("originalScale"), S_originalScale, PROTECT(R_do_slot(RObjectPointer, Rf_install(".xData")))); RCopiedFlag = true; - UNPROTECT(10); + UNPROTECT(8); } return(RObjectPointer); } @@ -1183,7 +1155,7 @@ void AGHQuad_summary::copyFromRobject ( SEXP Robject ) { // copyFromRobject scheme)? COPY_NUMERIC_VECTOR_FROM_R_OBJECT("vcov"); COPY_LOGICAL_SCALAR_FROM_R_OBJECT("originalScale"); - UNPROTECT(5); + UNPROTECT(3); } AGHQuad_summary::AGHQuad_summary ( ) { RCopiedFlag = false; diff --git a/packages/nimble/inst/include/nimble/RcppNimbleUtils.h b/packages/nimble/inst/include/nimble/RcppNimbleUtils.h index 31096b0c8..14d149e3b 100644 --- a/packages/nimble/inst/include/nimble/RcppNimbleUtils.h +++ b/packages/nimble/inst/include/nimble/RcppNimbleUtils.h @@ -28,11 +28,8 @@ /* The following two macros are for use by copyFromRobject methods in compiled nimbleFunctions. */ #define SETUP_S_xData \ - SEXP S_string_xData; \ SEXP S_xData; \ - PROTECT(S_string_xData = Rf_allocVector(STRSXP, 1)); \ - SET_STRING_ELT(S_string_xData, 0, PROTECT(Rf_mkChar(".xData"))); \ - PROTECT(S_xData = GET_SLOT(Robject, S_string_xData)); + PROTECT(S_xData = R_do_slot(Robject, Rf_install(".xData"))); #define COPY_NUMERIC_VECTOR_FROM_R_OBJECT(varName) \ { \ diff --git a/packages/nimble/inst/include/nimble/Utils.h b/packages/nimble/inst/include/nimble/Utils.h index 1d7bb5567..e7332f8fc 100644 --- a/packages/nimble/inst/include/nimble/Utils.h +++ b/packages/nimble/inst/include/nimble/Utils.h @@ -52,7 +52,7 @@ static inline SEXP NIM_FINDVAR(SEXP Senv, SEXP Ssym) { #else // #define NIM_FINDVARINFRAME(env, sym) \ // SEXP sym_ = TYPEOF(sym) == SYMSXP ? (sym) : Rf_install(CHAR(Rf_asChar(sym))); \ -// R_getVarEx(sym_, env, FALSE, R_UnboundValue) +// R_getVar(sym_, env, FALSE) // #define NIM_FINDVAR(env, sym) \ // SEXP sym_ = TYPEOF(sym) == SYMSXP ? (sym) : Rf_install(CHAR(Rf_asChar(sym))); \ // R_getVar(sym_, env, TRUE) @@ -62,7 +62,7 @@ static inline SEXP NIM_FINDVARINFRAME(SEXP Senv, SEXP Ssym) { Rf_type2char(TYPEOF(Senv))); } SEXP sym__ = TYPEOF(Ssym) == SYMSXP ? Ssym : Rf_install(CHAR(Rf_asChar(Ssym))); - return R_getVarEx(sym__, Senv, FALSE, R_UnboundValue); + return R_getVar(sym__, Senv, FALSE); } static inline SEXP NIM_FINDVAR(SEXP Ssym, SEXP Senv) { if (TYPEOF(Senv) != ENVSXP) { diff --git a/packages/nimble/inst/include/nimble/accessorClasses.h b/packages/nimble/inst/include/nimble/accessorClasses.h index 2113b632c..99ab9ed65 100644 --- a/packages/nimble/inst/include/nimble/accessorClasses.h +++ b/packages/nimble/inst/include/nimble/accessorClasses.h @@ -794,27 +794,23 @@ class NodeVectorClassNew_derivs : public NodeVectorClassNew { /* // 6. Sift derivatives into return object */ /* } */ void populateDerivsInfo(SEXP SderivsInfo) { - SEXP SpxData; SEXP Smodel, SCobjInt, SbasePtr, SADptrs, SbasePtrAD; - PROTECT(SpxData = Rf_allocVector(STRSXP, 1)); - SET_STRING_ELT(SpxData, 0, Rf_mkChar(".xData")); - //Smodel <- SderivsInfo$model PROTECT(Smodel = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(SderivsInfo, SpxData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(SderivsInfo, Rf_install(".xData"))), Rf_install("model"))); //SCobjInt <- Smodel$CobjectInterface PROTECT(SCobjInt = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(Smodel, SpxData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(Smodel, Rf_install(".xData"))), Rf_install("CobjectInterface"))); // SbasePtr <- SCobjInt$.basePtr PROTECT(SbasePtr = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(SCobjInt, SpxData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(SCobjInt, Rf_install(".xData"))), Rf_install(".basePtr"))); // SADptrs <- SCobjInt$.ADptrs PROTECT(SADptrs = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(SCobjInt, SpxData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(SCobjInt, Rf_install(".xData"))), Rf_install(".ADptrs"))); // SbasePtrAD <- SADptrs[[".ADptrs"]] PROTECT(SbasePtrAD = @@ -825,7 +821,7 @@ class NodeVectorClassNew_derivs : public NodeVectorClassNew { SEXP Swrt; SEXP SwrtNodeNames, SwrtSizesAndNdims; PROTECT(Swrt = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(SderivsInfo, SpxData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(SderivsInfo, Rf_install(".xData"))), Rf_install("wrtMapInfo"))); // SwrtNodeNames = Swrt[[1]] PROTECT(SwrtNodeNames = VECTOR_ELT(Swrt, 0)); @@ -846,7 +842,7 @@ class NodeVectorClassNew_derivs : public NodeVectorClassNew { SEXP SextraInput; SEXP SextraInputNodeNames, SextraInputSizesAndNdims; PROTECT(SextraInput = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(SderivsInfo, SpxData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(SderivsInfo, Rf_install(".xData"))), Rf_install("extraInputMapInfo"))); // SextraInputNodeNames = SextraInput[[1]] PROTECT(SextraInputNodeNames = VECTOR_ELT(SextraInput, 0)); @@ -867,7 +863,7 @@ class NodeVectorClassNew_derivs : public NodeVectorClassNew { SEXP SmodelOutput; SEXP SmodelOutputNodeNames, SmodelOutputSizesAndNdims; PROTECT(SmodelOutput = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(SderivsInfo, SpxData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(SderivsInfo, Rf_install(".xData"))), Rf_install("modelOutputMapInfo"))); // SmodelOutputNodeNames = SmodelOutput[[1]] PROTECT(SmodelOutputNodeNames = VECTOR_ELT(SmodelOutput, 0)); @@ -888,7 +884,7 @@ class NodeVectorClassNew_derivs : public NodeVectorClassNew { SEXP Sconstant; SEXP SconstantNodeNames, SconstantSizesAndNdims; PROTECT(Sconstant = - NIM_FINDVARINFRAME(PROTECT(GET_SLOT(SderivsInfo, SpxData)), + NIM_FINDVARINFRAME(PROTECT(R_do_slot(SderivsInfo, Rf_install(".xData"))), Rf_install("constantMapInfo"))); // SconstantNodeNames = Sconstant[[1]] PROTECT(SconstantNodeNames = VECTOR_ELT(Sconstant, 0)); @@ -906,7 +902,7 @@ class NodeVectorClassNew_derivs : public NodeVectorClassNew { SbasePtrAD); - UNPROTECT(26); + UNPROTECT(25); } };