automatically include other nClass and nFunction units in nCompile calls (#94)

* nCompile automated inclusion (optionally) of needed units

* fix nFunctions method gather_neeeded_nFunctions

* clean up and finish gathering of needed units

* add test-nCompile_auto_include and fixed issues along the way

* fix new test-nCompile_auto_include

Author: perrydv

nCompiler/R/NC.R

@@ -90,6 +90,7 @@ nClass <- function(classname,
   #   All inheritance provided by compileInfo$inherit should include any
   #   accessor specifier, typically "public", e.g. "public some_class".
   #   Similarly, template arguments (include CRTP) should be in the text explicitly.
+  # needed_units: list of needed nClasses and nFunctions to include, by name or object
   #
   # constructor(s) and destructor:
   #

nCompiler/R/NC_Compile.R

@@ -46,6 +46,10 @@ nCompile_nClass <- function(NC,
     control
   )
   is_predefined <- !isFALSE(NCinternals(NC)$predefined)
+  gather_needed_units <- isTRUE(controlFull$always_include_units)
+  needed_units <- list(needed_nClasses = list(),
+                       needed_nFunctions = list())
+  allow_write_predefined <- FALSE
   if(is_predefined) {
     predefined_dir <-  NCinternals(NC)$predefined
     # predefined can be character, quoted expression, or function.
@@ -62,14 +66,18 @@ nCompile_nClass <- function(NC,
       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
+    regular_filename <-  NCinternals(NC)$cpp_classname
+    if(gather_needed_units)
+      needed_units <- nCompile_process_manual_needed_units(NCinternals(NC),
+                                                                NC$parent_env, isNC = TRUE)
+    allow_write_predefined <- !isTRUE(compileInfo$auto_included)
   }
   if(is_predefined && isFALSE(controlFull$generate_predefined)) {
     RcppPacket <- loadRcppPacket(predefined_dir, regular_filename)
     cppDef <- cppRcppPacket$new(RcppPacket = RcppPacket)
     cppDef$externalCppDefs <- c(cppDef$externalCppDefs,
                                 get_R_interface_cppDef()) #might not be needed, but doesn't hurt to add and we don't have the details on whether it is needed from the loaded RcppPacket.
-  } else {
+ } else {
     if(is.null(compileInfo)) compileInfo <- NCinternals(NC)$compileInfo
     ## Make a new compiler object
     NC_Compiler <- NC_CompilerClass$new(NC,
@@ -80,7 +88,7 @@ nCompile_nClass <- function(NC,
                           interfaceCalls = !is_predefined) ## We don't retain NC in NC_Compiler in order to simplify many environments pointing to each other.
     ## Get the cppDef
     cppDef <- NC_Compiler$cppDef
-    if(is_predefined) {
+    if(is_predefined && allow_write_predefined) {
       predefined_gen_dir <- NCinternals(NC)$compileInfo$predefined_output_dir
       if(is.null(predefined_gen_dir))
         predefined_gen_dir <- predefined_dir      
@@ -89,6 +97,10 @@ nCompile_nClass <- function(NC,
       # 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)
+      # To do: check that there aren't any detected needed units that are not in the compileInfo$needed_units
+      # because for a predefined, needed units must be provided manually by compileInfo.
+    } else {
+      if(gather_needed_units) needed_units <- NC_Compiler$gather_needed_units()
     }
 
     ##
@@ -101,8 +113,10 @@ nCompile_nClass <- function(NC,
       return(NC_Compiler)
   }
 
-  if(stopAfterCppDef) return(cppDef)
-
+  if(stopAfterCppDef) {
+    if(gather_needed_units) return(list(cppDef = cppDef, needed_units = needed_units))
+    else return(cppDef)
+  }
   # We might deprecate from here onward.
   # Then nCompile_nClass would only be called via nCompile
   filebase <- controlFull$filename

nCompiler/R/NC_CompilerClass.R

@@ -115,6 +115,107 @@ NC_CompilerClass <- R6::R6Class(
                           NCgenerator)
         setupMethodSymbolTables()
       }
+    },
+    gather_needed_units = function() {
+      # This gathers from member variables and methods.
+      # It DOES NOT include an inherit nClass, because we could only access
+      #   the inheritNCinternals, but we need the generator object.
+      # Hence this is collected from nCompile_nClass.
+      # list() |> unlist() returns NULL so we have to catch that and give list() instead.
+      # list() |> unique() retruns list(), what we want.
+      needed_nClasses1 <- nCompile_gather_needed_nClasses(cppDef, self$symbolTable)
+      needed_nClasses2 <- lapply(NFcompilers,
+                                  \(x) x$gather_needed_nClasses()) |> 
+                          unlist(recursive = FALSE) |> unique()
+      needed_nFunctions <- lapply(NFcompilers,
+                                  \(x) x$gather_needed_nFunctions()) |> 
+                          unlist(recursive = FALSE) |> unique()
+      compileInfo_needed_units <- nCompile_process_manual_needed_units(
+                                    NCinternals(self$NCgenerator),
+                                    self$NCgenerator$parent_env, isNC = TRUE)
+      list(
+        needed_nClasses = unique(c(needed_nClasses1, needed_nClasses2 %||% list(),
+                                   compileInfo_needed_units$needed_nClasses)),
+        needed_nFunctions = unique(c(needed_nFunctions %||% list(), 
+                                     compileInfo_needed_units$needed_nFunctions))
+      )
     }
   )
 )
+
+nCompile_process_manual_needed_units <- function(internals, 
+                                                      where = internals$where, # NFinternals case
+                                                      isNC = FALSE) {
+  # This function collects two forms of "manual" needed units (nClasses and nFunctions):
+  # those provided via compileInfo$needed_units and also (in the case of nClass)
+  # an inherited nClass.
+  #
+  # A little awkwardness on the input arguments:
+  # It would be nice to pass either just the internals (NCinternals(NC) or NFinternals(NF))
+  # OR just the NC or NF object.
+  # But neither case is consistent between nClass and nFunction.
+  # We would need the nClass generator to get the where (parent_env), and the NCinternals doesn't have that.
+  # Conversely, we could pass the objects, but the NF_CompilerClass (a calling point) does not have the NF object.
+  # Therefore, we make this harder to read and pass both internals and where and indicate which case we're in with isNC.
+  # The defaults are for the case of NF, where internals is NFinternals(NF).
+  name <- if(isNC) internals$classname else internals$uniqueName
+
+  needed_units <- internals$compileInfo$needed_units
+  results_nClasses <- list()
+  results_nFunctions <- list()
+  for(i in seq_along(needed_units)) {
+    if(is.character(needed_units[[i]])) {
+      obj <- nGet(needed_units[[i]], where)
+      if(is.null(obj))
+        stop(paste0("In processing compileInfo$needed_units for ", name, ", could not find object named '",
+                    needed_units[[i]], "' in the environment of the source unit."))
+    } else {
+      obj <- needed_units[[i]]
+    }
+    if(isNCgenerator(obj)) {
+      results_nClasses[[length(results_nClasses) + 1]] <- obj
+    } else if(isNF(obj)) {
+      results_nFunctions[[length(results_nFunctions) + 1]] <- obj
+    } else {
+      stop(paste0("In processing compileInfo$needed_units for ", name, ", object '",
+                  needed_units[[i]], "' is neither an nClass generator nor an nFunction."))
+    }
+  }
+
+  if(isNC) {
+    # Get inherited nClass as a needed unit
+    if(!is.null(internals$inheritQ)) {
+      inherit_obj <- eval(internals$inheritQ, envir = internals$env) # see connect_inherit
+      if(!isNCgenerator(inherit_obj))
+        stop("An inherit argument that was provided to nClass does not evaluate to an nClass generator.")
+      results_nClasses[[length(results_nClasses) + 1]] <- inherit_obj
+    }
+  }
+
+  list(needed_nClasses = results_nClasses,
+       needed_nFunctions = results_nFunctions)
+}
+
+nCompile_gather_needed_nClasses <- function(cppDef,
+                                            symTab,
+                                            NF_Compiler = NULL) {
+  # Collect nClass generators needed by this symbol table
+  new_needed <- list()
+  for(i in seq_along(symTab$symbols)) {
+    if(inherits(symTab$symbols[[i]], "symbolNC")) {
+      new_needed[[length(new_needed) + 1]] <-
+        symTab$symbols[[i]]$NCgenerator
+    }
+  }
+  # For an nFunction, collection nClass generators identified
+  # from processing the code.
+  if(!is.null(NF_Compiler)) {
+    auxEnv_needed_nClasses <- NF_Compiler$auxEnv$needed_nClasses
+    if(length(auxEnv_needed_nClasses)) {
+      bool_NCgen <- lapply(auxEnv_needed_nClasses, isNCgenerator) |> unlist()
+      new_needed <- c(new_needed,
+                      auxEnv_needed_nClasses[bool_NCgen])
+    }
+  }
+  unique(new_needed)
+}

nCompiler/R/NC_InternalsClass.R

@@ -27,7 +27,7 @@ NC_InternalsClass <- R6::R6Class(
     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,
+    inheritQ = NULL, # quoted inherit expression, to defer access to the inherited nClass generator itself.
     process_inherit_done = FALSE,
     virtualMethodNames_self = character(), # will be used when checking inherited method validity, only for locally implemented methods
     virtualMethodNames = character(),
@@ -101,7 +101,7 @@ NC_InternalsClass <- R6::R6Class(
       if(!is.null(self$inheritQ)) {
         inherit_obj <- eval(self$inheritQ, envir = self$env) #inheritQ can be an expression but it must always return the same generator object
         if(!isNCgenerator(inherit_obj))
-          stop("An inherit argument that was provided to nClass is not nClass generator.")
+          stop("An inherit argument that was provided to nClass does not evaluate to an nClass generator.")
         self$inheritNCinternals <- NCinternals(inherit_obj)
         message("add check that base class has interface 'none'")
         if(!self$inherit_base_provided) {

nCompiler/R/NF_Compile.R

@@ -58,6 +58,10 @@ nCompile_nFunction <- function(NF,
   if(is.null(compileInfo)) compileInfo <- NFinternals(NF)$compileInfo
 
   is_predefined <- !isFALSE(NFinternals(NF)$predefined)
+  gather_needed_units <- isTRUE(controlFull$always_include_units)
+  needed_units <- list(needed_nClasses = list(),
+                       needed_nFunctions = list())
+  allow_write_predefined <- FALSE
   if(is_predefined) {
     predefined_dir <-  NFinternals(NF)$predefined
     # predefined can be character, quoted expression, or function.
@@ -75,6 +79,9 @@ nCompile_nFunction <- function(NF,
        "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
+    if(gather_needed_units) 
+      needed_units <- nCompile_process_manual_needed_units(NFinternals(NF))
+    allow_write_predefined <- !isTRUE(compileInfo$auto_included)
   }
   if(is_predefined && isFALSE(controlFull$generate_predefined)) {
     RcppPacket <- loadRcppPacket(predefined_dir, regular_filename)
@@ -92,12 +99,14 @@ nCompile_nFunction <- function(NF,
                        NF_Compiler$stageCompleted))
       return(NF_Compiler)
     }
-    if(is_predefined) {
+    if(is_predefined && allow_write_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)
+    } else {
+      if(gather_needed_units) needed_units <- NF_Compiler$gather_needed_units()
     }
     stageName <- 'makeRcppPacket'
     if (logging) logBeforeStage(stageName)
@@ -106,8 +115,10 @@ nCompile_nFunction <- function(NF,
 
     cppDef <- NF_Compiler$cppDef
   }
-  if(stopAfterCppDef) return(cppDef)
-
+  if(stopAfterCppDef) {
+    if(gather_needed_units) return(list(needed_units = needed_units, cppDef = cppDef))
+    else return(cppDef)
+  }
   # We might deprecate from here down and make all usages start from nCompile.
 
   stop("Entering deprecated portion of nCompile_nFunction. Check what is going on.")

nCompiler/R/NF_CompilerClass.R

@@ -139,10 +139,32 @@ NF_CompilerClass <- R6::R6Class(
                       doKeywords,
                       .nCompilerProject,
                       initialTypeInferenceOnly)
+    },
+    gather_needed_units = function() {
+      compileInfo_needed_units <- nCompile_process_manual_needed_units(self$NFinternals)
+      list(
+        needed_nClasses = c(self$gather_needed_nClasses(), 
+                           compileInfo_needed_units$needed_nClasses),
+        needed_nFunctions = c(self$gather_needed_nFunctions(),
+                              compileInfo_needed_units$needed_nFunctions)
+      )
+    },
+    gather_needed_nClasses = function() {
+      nCompile_gather_needed_nClasses(cppDef, self$symbolTable, self)
+    },
+    gather_needed_nFunctions = function() {
+      nCompile_gather_needed_nFunctions(cppDef, self)
     }
   )
 )
 
+nCompile_gather_needed_nFunctions <- function(cppDef,
+                                              NF_Compiler) {
+  lapply(NF_Compiler$auxEnv$needed_nFunctions,
+         function(x)
+           nGet(x[[1]], where = x[[2]])) |> unique()
+}
+
 processNFstages <- function(NFcompiler,
                             control = list(),
                             sourceObj = NULL,

nCompiler/R/cppDefs_nFunction.R

@@ -199,7 +199,7 @@ cpp_include_needed_nClasses <- function(cppDef,
     }
   }
   new_Hincludes <- unique(new_Hincludes)  
-  cppDef$Hincludes <- c(cppDef$Hincludes, new_Hincludes)
+  cppDef$Hincludes <- unique(c(cppDef$Hincludes, new_Hincludes))
   invisible(NULL)
 }