Model basic infrastructure

nCompiler/NAMESPACE

@@ -7,6 +7,9 @@ export(NCinternals)
 export(NFinternals)
 export(argType2Cpp)
 export(build_compiled_nClass)
+export(calcInputList_to_calcInstrList)
+export(calcInstr_nClass)
+export(calcInstrList_nClass)
 export(cloglog)
 export(check_Rcpp_for_nCompiler)
 export(compileNimble)
@@ -80,6 +83,8 @@ export(nInteger)
 export(nList)
 export(nLogical)
 export(nMatrix)
+export(nodeFxnBase_nClass)
+export(nodeInstr_nClass)
 export(nArray)
 export(nOptions)
 export(nParse)

nCompiler/R/NC_Compile.R

@@ -48,8 +48,18 @@ nCompile_nClass <- function(NC,
   is_predefined <- !isFALSE(NCinternals(NC)$predefined)
   if(is_predefined) {
     predefined_dir <-  NCinternals(NC)$predefined
+    # predefined can be character, quoted expression, or function.
+    # The latter two allow delayed evaluation, useful if an nClass is defined
+    # in an R package and the predefined argument should not get build-system
+    # paths baked in but rather delay until evaluation on the when running.
+    if(is.call(predefined_dir)) {
+      predefined_dir <- eval(predefined_dir, envir = NCinternals(NC)$env)
+    }
+    if(is.function(predefined_dir)) {
+      predefined_dir <- predefined_dir()
+    }
     if(!is.character(predefined_dir))
-      stop("There is a predefined nClass whose predefined field is not character. ",
+      stop("There is a predefined nClass whose predefined field is not (and does not evaluate to) character. ",
        "It should give the directory path of the predefined nClass. ",
        "The classname argument to nClass gives the base for filenames in that directory.")
      regular_filename <-  NCinternals(NC)$cpp_classname
@@ -71,8 +81,11 @@ nCompile_nClass <- function(NC,
     ## Get the cppDef
     cppDef <- NC_Compiler$cppDef
     if(is_predefined) {
+      predefined_gen_dir <- NCinternals(NC)$compileInfo$predefined_output_dir
+      if(is.null(predefined_gen_dir))
+        predefined_gen_dir <- predefined_dir      
       RcppPacket <- cppDefs_2_RcppPacket(cppDef)
-      saveRcppPacket(RcppPacket, predefined_dir, regular_filename)
+      saveRcppPacket(RcppPacket, predefined_gen_dir, regular_filename)
       # Now add interface calls if necessary for this live compilation, having
       # kept them out of the written packet code.
       cppDef$buildGenericInterface(interfaceCalls=TRUE, interface=FALSE)

nCompiler/R/NC_InternalsClass.R

@@ -24,7 +24,7 @@ NC_InternalsClass <- R6::R6Class(
     isOnlyC = FALSE, ## somewhat redundant but perhaps convenient - TBD.
     enableDerivs = NULL,
     enableSaving = NULL,
-    predefined = FALSE,
+    predefined = FALSE, # directory for reading and (default) writing predefined nClass saved RcppPacket. Writing location can be over-ridden by compileInfo$predefined_output_dir
     inheritNCinternals = NULL,
     env = NULL,
     inheritQ = NULL,

nCompiler/R/NF_Compile.R

@@ -60,8 +60,18 @@ nCompile_nFunction <- function(NF,
   is_predefined <- !isFALSE(NFinternals(NF)$predefined)
   if(is_predefined) {
     predefined_dir <-  NFinternals(NF)$predefined
+    # predefined can be character, quoted expression, or function.
+    # The latter two allow delayed evaluation, useful if an nClass is defined
+    # in an R package and the predefined argument should not get build-system
+    # paths baked in but rather delay until evaluation on the when running.
+    if(is.call(predefined_dir)) {
+      predefined_dir <- eval(predefined_dir, envir = NFinternals(NF)$where)
+    }
+    if(is.function(predefined_dir)) {
+      predefined_dir <- predefined_dir()
+    }
     if(!is.character(predefined_dir))
-      stop("There is a predefined nFunction whose predefined field is not character. ",
+      stop("There is a predefined nFunction whose predefined field is not (and does not evaluate to) character. ",
        "It should give the directory path of the predefined nFunction. ",
        "The name argument to nFunction gives the base for filenames in that directory.")
     regular_filename <-  NFinternals(NF)$cpp_code_name
@@ -83,6 +93,9 @@ nCompile_nFunction <- function(NF,
       return(NF_Compiler)
     }
     if(is_predefined) {
+      predefined_gen_dir <- NFinternals(NF)$compileInfo$predefined_output_dir
+      if(is.null(predefined_gen_dir))
+        predefined_gen_dir <- predefined_dir
       RcppPacket <- cppDefs_2_RcppPacket(NF_Compiler$cppDef)
       saveRcppPacket(RcppPacket, predefined_dir, regular_filename)
     }

nCompiler/R/NF_InternalsClass.R

@@ -26,7 +26,7 @@ NF_InternalsClass <- R6::R6Class(
     # needed_nFunctions = list(), ## formerly neededRCfuns
     ADcontent = NULL,
     isAD = FALSE,
-    predefined = FALSE,
+    predefined = FALSE, # Location for reading and (default) writing predefined nFunction saved RcppPacket. Writing location can be over-ridden by compileInfo$predefined_output_dir
     compileInfo = list(),
     R_fun = NULL, #used only if compileInfo$C_fun is provided.
     ## Next two "includes" were only needed for making external calls:

nCompiler/R/Rcpp_nCompiler.R

@@ -489,11 +489,11 @@ saveRcppPacket <- function(RcppPacket, dir, name = NULL) {
       if (all(c("opener", "body") %in% names(content))) {
         # Write as separate sections
         con <- file(filepath, "w")
-        writeLines("### OPENER ###", con)
+        writeLines("/* OPENER (Do not edit this comment) */", con)
         if (length(content$opener) > 0) {
           writeLines(content$opener, con)
         }
-        writeLines("### BODY ###", con)
+        writeLines("/* BODY (Do not edit this comment) */", con)
         if (length(content$body) > 0) {
           writeLines(content$body, con)
         }
@@ -509,9 +509,9 @@ saveRcppPacket <- function(RcppPacket, dir, name = NULL) {
   }
 
   # Write each element to its own file
-  writePacketElement(RcppPacket$preamble, paste0(name, "_preamble.txt"))
-  writePacketElement(RcppPacket$cppContent, paste0(name, "_cppContent.txt"))
-  writePacketElement(RcppPacket$hContent, paste0(name, "_hContent.txt"))
+  writePacketElement(RcppPacket$preamble, paste0(name, "_preamble.cpp"))
+  writePacketElement(RcppPacket$cppContent, paste0(name, "_cppContent.cpp"))
+  writePacketElement(RcppPacket$hContent, paste0(name, "_hContent.h"))
   writePacketElement(RcppPacket$filebase, paste0(name, "_filebase.txt"))
   writePacketElement(RcppPacket$post_cpp_compiler, paste0(name, "_post_cpp_compiler.txt"))
   writePacketElement(RcppPacket$copyFiles, paste0(name, "_copyFiles.txt"))
@@ -522,9 +522,9 @@ saveRcppPacket <- function(RcppPacket, dir, name = NULL) {
     packet_name = name,
     elements = names(RcppPacket),
     files = list(
-      preamble = paste0(name, "_preamble.txt"),
-      cppContent = paste0(name, "_cppContent.txt"),
-      hContent = paste0(name, "_hContent.txt"),
+      preamble = paste0(name, "_preamble.cpp"),
+      cppContent = paste0(name, "_cppContent.cpp"),
+      hContent = paste0(name, "_hContent.h"),
       filebase = paste0(name, "_filebase.txt"),
       post_cpp_compiler = paste0(name, "_post_cpp_compiler.txt"),
       copyFiles = paste0(name, "_copyFiles.txt")
@@ -568,9 +568,9 @@ loadRcppPacket <- function(dir, name) {
   } else {
     warning("No manifest file found. Attempting to load standard files.")
     manifest <- list(files = list(
-      preamble = paste0(name, "_preamble.txt"),
-      cppContent = paste0(name, "_cppContent.txt"),
-      hContent = paste0(name, "_hContent.txt"),
+      preamble = paste0(name, "_preamble.cpp"),
+      cppContent = paste0(name, "_cppContent.cpp"),
+      hContent = paste0(name, "_hContent.h"),
       filebase = paste0(name, "_filebase.txt"),
       post_cpp_compiler = paste0(name, "_post_cpp_compiler.txt"),
       copyFiles = paste0(name, "_copyFiles.txt")
@@ -597,10 +597,10 @@ loadRcppPacket <- function(dir, name) {
     }
 
     # Check if it's a structured file (cppContent/hContent)
-    if (first_line == "### OPENER ###") {
+    if (first_line == "/* OPENER (Do not edit this comment) */") {
       lines <- readLines(filepath, warn = FALSE)
-      opener_start <- which(lines == "### OPENER ###")
-      body_start <- which(lines == "### BODY ###")
+      opener_start <- which(lines == "/* OPENER (Do not edit this comment) */")
+      body_start <- which(lines == "/* BODY (Do not edit this comment) */")
 
       if (length(opener_start) == 1 && length(body_start) == 1) {
         opener_lines <- if (body_start > opener_start + 1) {

nCompiler/R/all_utils.R

@@ -43,6 +43,8 @@ resetLabelFunctionCreators <- function() {
 }
 
 ADtapeMgrLabelCreator <- labelFunctionCreator("ADtapeMgr")
+nodeFxnLabelCreator <- labelFunctionCreator("nodeFxn")
+modelLabelCreator <- labelFunctionCreator("model")
 
 # no longer documented in Rd
 # Generates a valid C++ name from an R Name

nCompiler/R/cppDefs_utils.R

@@ -29,7 +29,7 @@ putCodeLinesInBrackets <- function(codeLines) {
 
 # This is the location of the RcppUtils.cpp, etc. files.
 IncludeCodeDir <- character()
-NimbleCodeDir <- system.file("CppCode", package = "nCompiler")
+# NimbleCodeDir <- system.file("CppCode", package = "nCompiler")
 
 nCompilerIncludeFile <- function(file, path = IncludeCodeDir)
 {