update predefineds. fix nimbleModels. fix package class generation with R fields.

Author: perrydv

nCompiler/R/NC.R

@@ -217,6 +217,11 @@ nClass <- function(classname,
     Rpublic = NULL # indicates to leave quote(Rpublic)
   )
 
+  # Either we must store this or rebuilding it when writing package code.
+  # To store it, we would need to retain the Rpublic from this function's environment.
+  # Currently the strategy is to rebuild it.
+  # internals$main_class_code <- main_class_code
+
   ## Build the R6 class generator
   NCgenerator <- eval(main_class_code)
   Cpub_generator <- eval(Cpub_class_code)
@@ -261,7 +266,7 @@ make_uncompiled_Cpub_class_code <- function(classname,
 
 make_nClass_code <- function(internals,
                     Cpublic = NULL, # if nFunctions (called from nClass), create method. If R function (called from WP_writeRinterfaces), use that ()
-                    Rpublic = NULL  # If NULL (called from nClass), use quote(Rpbulic. If provided (from WP_writeRinterfaces), deparse.)
+                    Rpublic = NULL  # If NULL (called from nClass), use quote(Rpublic). If provided (from WP_writeRinterfaces), deparse.
                     ) {
   classname <- internals$classname
   inheritQ <- internals$inheritQ
@@ -298,7 +303,7 @@ make_nClass_code <- function(internals,
 
   Rpublic_code <- quote(Rpublic)
   if(!is.null(Rpublic)) {
-    parsedcopy <- \(f) {ans <- substitute(\() BODY, list(BODY=body(f))) |> removeSource(); if(!is.null(formals(f))) ans[[2]] <- formals(f)}
+    parsedcopy <- \(f) {ans <- substitute(\() BODY, list(BODY=body(f))) |> removeSource(); if(!is.null(formals(f))) ans[[2]] <- formals(f); ans}
     Rpublic_code_list <- Rpublic |> lapply(\(x) if(is.function(x)) parsedcopy(x) else x)
     Rpublic_code <- do.call("call", c("list",
                               Rpublic_code_list))

nCompiler/R/nCompile.R

@@ -1114,10 +1114,17 @@ WP_writeRinterfaces <- function(units, unitTypes, interfaces, returnNames, packa
         inherit_obj <- units[[i]] # NCgenerator from which the CncGen_code will inherit
         NCI_inherit <- NCinternals(inherit_obj)
 
+        # deparsed_main_class <- NCI_inherit$main_class_code |> deparse()
+        RpublicMethodNames <- NCI_inherit$RpublicNames[
+          NCI_inherit$RpublicNames %in% names(units[[i]]$public_methods)]
+        RpublicFieldNames <- NCI_inherit$RpublicNames[
+          NCI_inherit$RpublicNames %in% names(units[[i]]$public_fields)]
+        #N.B: Cpublic fields are build from NCI_inherit$fieldNames.
         deparsed_main_class <- make_nClass_code(
           internals = NCI_inherit,
           Cpublic = units[[i]]$public_methods[NCI_inherit$methodNames],
-          Rpublic = units[[i]]$public_methods[NCI_inherit$RpublicNames]
+          Rpublic = c(units[[i]]$public_methods[RpublicMethodNames],
+                      units[[i]]$public_fields[RpublicFieldNames])
         ) |> deparse()
         deparsed_main_class[1] <- paste0(
           generator_name, ' <- ', deparsed_main_class[1]

nCompiler/R/nimbleModels.R

@@ -24,7 +24,8 @@ nodeInstr_nClass <- nClass(
                file.path("nodeInstr_nC")),
   compileInfo=list(interface="full",
                    createFromR = TRUE,
-                   exportName = "nodeInstr_nClass"
+                   exportName = "nodeInstr_nClass_new",
+                   packageNames = c(uncompiled = "nodeInstr_nClass", compiled="nodeInstr_nClass_C")
                    )
 )
 
@@ -38,15 +39,16 @@ calcInstr_nClass <- nClass(
                file.path("calcInstr_nC")),
   compileInfo=list(interface="full",
                    createFromR = TRUE,
-                   # The Hincludes should be picked up automatically but I think it's not 
+                   # The Hincludes should be picked up automatically but I think it's not
                    # because it is in the nList type and that is not being scanned for needed nClasses.
                    # These do need to be in "" not <>, for case of nCompile(...., package=TRUE)
                    Hincludes = '"nodeInstr_nClass_c_.h"',
                    # In the format here, needed_units is a list with either objects (nFunction or nClass (generators),
                    # or names. If names, we will use scoping to look them up and decide what they are.
                    # The list can mix objects and names of nClasses and nFunctions.
                    needed_units = list("nodeInstr_nClass"),
-                   exportName = "calcInstr_nClass"
+                   exportName = "calcInstr_nClass_new",
+                   packageNames = c(uncompiled="calcInstr_nClass", compiled="calcInstr_nClass_C")
                    )
 )
 
@@ -60,7 +62,8 @@ calcInstrList_nClass <- nClass(
   compileInfo=list(interface="full",
                    createFromR = TRUE,
                    Hincludes = '"calcInstr_nClass_c_.h"',
-                   exportName = "calcInstrList_nClass",
+                   exportName = "calcInstrList_nClass_new",
+                   packageNames = c(uncompiled = "calcInstrList_nClass", compiled = "calcInstrList_nClass_C"),
                    needed_units = list("calcInstr_nClass")
                    )
 )
@@ -85,7 +88,9 @@ nodeFxnBase_nClass <- nClass(
                file.path("nodeFxnBase_nC")),
   compileInfo=list(interface="full",
                    createFromR = FALSE,
-                   exportName = "nodeFxnBase_nClass")
+                   exportName = "nodeFxnBase_nClass_new",
+                   packageNames = c(uncompiled="nodeFxnBase_nClass", compiled="nodeFxnBase_nClass_C")
+                   )
 )
 
 # nCompile(nodeFxnBase_nClass, control=list(generate_predefined=TRUE))
@@ -118,15 +123,16 @@ modelBase_nClass <- nClass(
             cppLiteral('Rprintf("modelBase_nClass calculate (should not see this)\\n");'); return(0)},
           virtual=TRUE
         )
-    )  
+    )
   ),
   # See comment above about needing to ensure a virtual destructor
   predefined = quote(system.file(file.path("include","nCompiler", "predef"), package="nCompiler") |> file.path("modelBase_nC")),
   compileInfo=list(interface="full",
                    createFromR = FALSE,
                    Hincludes = c('"nodeFxnBase_nClass_c_.h"', '"calcInstrList_nClass_c_.h"'), # do we need "<nodeFxnBase_nClass_c_.h>" too?
                    needed_units = list("nodeFxnBase_nClass","calcInstrList_nClass"), #do we need nodeFxnBase_nClass here too?
-                   exportName = "modelBase_nClass"
+                   exportName = "modelBase_nClass_new",
+                   packageNames = c(uncompiled="modelBase_nClass", compiled="modelBase_nClass_C")
                    )
 )
 
@@ -147,7 +153,7 @@ nm_addModelDollarSign <- function(expr, exceptionNames = character(0)) {
         if(expr[[1]] == '$'){
             expr[2] <- lapply(expr[2], function(listElement) nm_addModelDollarSign(listElement, exceptionNames))
             return(expr)
-        } 
+        }
         if(expr[[1]] == 'returnType')
             return(expr)
         if(length(expr) > 1) {
@@ -189,8 +195,12 @@ make_node_nClass <- function(varInfo = list(),
   CpublicVars <- names(symbolList) |> lapply(\(x) eval(substitute(quote(T(symbolList$NAME)),
                                                     list(NAME=as.name(x)))))
   names(CpublicVars) <- names(symbolList)
+  # This is a kluge to have a model field in the Cpublic_obj,
+  # needed for uncompiled purposes, and for compiled purposes
+  # we instead use references to model variables. So
+  # the declared type here is arbitrary.
   initFun <- function(){}
-  
+
   if(numVars > 0) {
     ctorArgNames <- paste0(names(symbolList), '_')
     # List used when generating C++ constructor code to allow direct initializers, necessary for references.
@@ -206,8 +216,10 @@ make_node_nClass <- function(varInfo = list(),
 
   # Rpublic method to set the model pointer/reference.
   setModel <- function(model) {
-    if(!isCompiled())
+    if(!isCompiled()) {
       self$model <- model
+      #private$Cpublic_obj$model <- model
+    }
     else
        warning("setModel called on compiled object; no action taken")
   }
@@ -232,9 +244,10 @@ make_node_nClass <- function(varInfo = list(),
           )
         ) |> structure(names = classname),
         CpublicVars,
+        list(model = "RcppList"),
         methods
       ),
-      RPUBLIC = list(model = NULL,
+      RPUBLIC = list(#model = NULL,
                      setModel = setModel),
       CLASSNAME = classname,
       BASECLASS = baseclass
@@ -350,6 +363,7 @@ makeModel_nClass <- function(varInfo,
     # It is not very easy to set debug onto the initialize function, so
     # here is a magic flag.
     if(isTRUE(.GlobalEnv$.debugModelInit)) browser()
+    super$initialize()
     if(isCompiled())
       self$setup_node_mgmt_from_names(self$nodeObjNames)
     if(!isCompiled()) {
@@ -358,7 +372,7 @@ makeModel_nClass <- function(varInfo,
         self[[nodeObj]]$setModel(self)
       }
     }
-    
+
     # First expand any provided or default sizes
     # To-Do possibly merge the argument sizes and defaultSizes by element.
     if(missing(sizes)) sizes <- self$defaultSizes
@@ -372,7 +386,7 @@ makeModel_nClass <- function(varInfo,
   baseclass <- paste0("modelClass_<", classname, ">")
   # CpublicNodeFuns has elements like "node_1 = quote(nodeFxn_1())"
   # We provide it in Cpublic to declare C++ member variables with types.
-  # We also place the list itself in the class so that we can look up for uncompiled execution 
+  # We also place the list itself in the class so that we can look up for uncompiled execution
   # the objects that need to be created in initialize.
   # If we someday make type declarations and initializations more automatic, we can avoid this duplication.
   ans <- substitute(
@@ -390,9 +404,9 @@ makeModel_nClass <- function(varInfo,
     ),
     list(OPDEFS = opDefs,
         # A list of individual elements
-        RPUBLIC = list(initialize=initialize, 
+        RPUBLIC = list(initialize=initialize,
                       nodeObjNames = nodeObjNames,
-                      nodeObjName_2_nodeIndex = nodeObjName_2_nodeIndex, 
+                      nodeObjName_2_nodeIndex = nodeObjName_2_nodeIndex,
                       defaultSizes = sizes,
                       defaultInits = inits,
                       CpublicNodeFuns = CpublicNodeFuns),
@@ -446,12 +460,12 @@ make_stoch_sim_line <- function(LHSrep, RHSrep) {
   if(is.null(sim_code)) stop("Could not find simulation ('r') function for ", BUGSdistName)
   RHSrep[[1]] <- sim_code
   # scoot all named arguments right 1 position
-  if(length(RHSrep) > 1) {    
+  if(length(RHSrep) > 1) {
     for(i in (length(RHSrep)+1):3) {
       RHSrep[i] <- RHSrep[i-1]
       names(RHSrep)[i] <- names(RHSrep)[i-1]
-    } 
-  }    
+    }
+  }
   RHSrep[[2]] <- 1
   names(RHSrep)[2] <- ''
   sim_line <- substitute(
@@ -542,7 +556,7 @@ make_node_methods_from_declInfo <- function(declInfo) {
               make_node_method_nFxn("sim_one", NULL),
             calc_one  = (function(idx) {DETERMCALC; return(invisible(0))}) |>
               make_node_method_nFxn("calc_one"),
-            calcDiff_one = (function(idx) {calc_one(idx);return(invisible(0))}) |> 
+            calcDiff_one = (function(idx) {calc_one(idx);return(invisible(0))}) |>
               make_node_method_nFxn("calcDiff_one"),
             getLogProb_one = (function(idx) {return(0)}) |>
               make_node_method_nFxn("getLogProb_one")
@@ -559,7 +573,7 @@ make_node_methods_from_declInfo <- function(declInfo) {
               make_node_method_nFxn("sim_one", NULL),
             calc_one  = (function(idx) { STOCHCALC;   return(invisible(LOGPROB)) }) |>
               make_node_method_nFxn("calc_one"),
-            calcDiff_one = (function(idx) {STOCHCALC_DIFF; LocalAns_ <- LocalNewLogProb_ - LOGPROB; 
+            calcDiff_one = (function(idx) {STOCHCALC_DIFF; LocalAns_ <- LocalNewLogProb_ - LOGPROB;
                                            LOGPROB <- LocalNewLogProb_; return(invisible(LocalAns_))}) |>
               make_node_method_nFxn("calcDiff_one"),
             getLogProb_one = (function(idx) { return(LOGPROB) }) |>

nCompiler/inst/include/.DS_Store

@@ -17,19 +17,19 @@ using namespace Rcpp;
 RESET_EIGEN_ERRORS
 }
 
-// [[Rcpp::export(name = "new_calcInstrList_nClass")]]
+// [[Rcpp::export(name = "calcInstrList_nClass_new")]]
     SEXP  new_calcInstrList_nClass (  ) {
 RESET_EIGEN_ERRORS
 return CREATE_NEW_NCOMP_OBJECT(calcInstrList_nClass);;
 }
 
-// [[Rcpp::export(name = "set_CnClass_env_new_calcInstrList_nClass")]]
+// [[Rcpp::export(name = "set_CnClass_env_calcInstrList_nClass_new")]]
     void  set_CnClass_env_calcInstrList_nClass ( SEXP env ) {
 RESET_EIGEN_ERRORS
 SET_CNCLASS_ENV(calcInstrList_nClass, env);;
 }
 
-// [[Rcpp::export(name = "get_CnClass_env_new_calcInstrList_nClass")]]
+// [[Rcpp::export(name = "get_CnClass_env_calcInstrList_nClass_new")]]
     Rcpp::Environment  get_CnClass_env_calcInstrList_nClass (  ) {
 RESET_EIGEN_ERRORS
 return GET_CNCLASS_ENV(calcInstrList_nClass);;

nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_cppContent.cpp

@@ -1,4 +1,4 @@
-list(saved_at = structure(1765437409.8481, class = c("POSIXct", 
+list(saved_at = structure(1772141341.98022, class = c("POSIXct", 
 "POSIXt")), packet_name = "calcInstrList_nClass", elements = c("preamble", 
 "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles"
 ), files = list(preamble = "calcInstrList_nClass_preamble.cpp", 

nCompiler/inst/include/nCompiler/predef/calcInstrList_nC/calcInstrList_nClass_manifest.txt

@@ -17,19 +17,19 @@ using namespace Rcpp;
 RESET_EIGEN_ERRORS
 }
 
-// [[Rcpp::export(name = "new_calcInstr_nClass")]]
+// [[Rcpp::export(name = "calcInstr_nClass_new")]]
     SEXP  new_calcInstr_nClass (  ) {
 RESET_EIGEN_ERRORS
 return CREATE_NEW_NCOMP_OBJECT(calcInstr_nClass);;
 }
 
-// [[Rcpp::export(name = "set_CnClass_env_new_calcInstr_nClass")]]
+// [[Rcpp::export(name = "set_CnClass_env_calcInstr_nClass_new")]]
     void  set_CnClass_env_calcInstr_nClass ( SEXP env ) {
 RESET_EIGEN_ERRORS
 SET_CNCLASS_ENV(calcInstr_nClass, env);;
 }
 
-// [[Rcpp::export(name = "get_CnClass_env_new_calcInstr_nClass")]]
+// [[Rcpp::export(name = "get_CnClass_env_calcInstr_nClass_new")]]
     Rcpp::Environment  get_CnClass_env_calcInstr_nClass (  ) {
 RESET_EIGEN_ERRORS
 return GET_CNCLASS_ENV(calcInstr_nClass);;

nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_cppContent.cpp

@@ -1,4 +1,4 @@
-list(saved_at = structure(1765437403.89444, class = c("POSIXct", 
+list(saved_at = structure(1772141071.19335, class = c("POSIXct", 
 "POSIXt")), packet_name = "calcInstr_nClass", elements = c("preamble", 
 "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles"
 ), files = list(preamble = "calcInstr_nClass_preamble.cpp", cppContent = "calcInstr_nClass_cppContent.cpp", 

nCompiler/inst/include/nCompiler/predef/calcInstr_nC/calcInstr_nClass_manifest.txt

@@ -26,13 +26,13 @@ return(0.0);
 RESET_EIGEN_ERRORS
 }
 
-// [[Rcpp::export(name = "set_CnClass_env_new_modelBase_nClass")]]
+// [[Rcpp::export(name = "set_CnClass_env_modelBase_nClass_new")]]
     void  set_CnClass_env_modelBase_nClass ( SEXP env ) {
 RESET_EIGEN_ERRORS
 SET_CNCLASS_ENV(modelBase_nClass, env);;
 }
 
-// [[Rcpp::export(name = "get_CnClass_env_new_modelBase_nClass")]]
+// [[Rcpp::export(name = "get_CnClass_env_modelBase_nClass_new")]]
     Rcpp::Environment  get_CnClass_env_modelBase_nClass (  ) {
 RESET_EIGEN_ERRORS
 return GET_CNCLASS_ENV(modelBase_nClass);;

nCompiler/inst/include/nCompiler/predef/modelBase_nC/modelBase_nClass_cppContent.cpp

@@ -1,4 +1,4 @@
-list(saved_at = structure(1765437502.8499, class = c("POSIXct", 
+list(saved_at = structure(1772143550.30016, class = c("POSIXct", 
 "POSIXt")), packet_name = "modelBase_nClass", elements = c("preamble", 
 "cppContent", "hContent", "filebase", "post_cpp_compiler", "copyFiles"
 ), files = list(preamble = "modelBase_nClass_preamble.cpp", cppContent = "modelBase_nClass_cppContent.cpp",