Support nimble2 with various features

.gitignore

@@ -35,3 +35,5 @@ nCompiler.Rproj
 sketches/
 .vscode/
 .positai
+# devtools::load_all() convenience symlink (inst/include -> include)
+nCompiler/include

nCompiler/.Rbuildignore

@@ -1,2 +1,3 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
+^include$

nCompiler/R/NC_Compile.R

@@ -70,7 +70,8 @@ nCompile_nClass <- function(NC,
     regular_filename <-  NCinternals(NC)$cpp_classname
     if(gather_needed_units)
       needed_units <- nCompile_process_manual_needed_units(NCinternals(NC),
-                                                                NC$parent_env, isNC = TRUE)
+                                                                NC$parent_env, isNC = TRUE,
+                                                                project_env = project_env)
     allow_write_predefined <- !isTRUE(compileInfo$auto_included)
   }
   if(is_predefined && (isFALSE(controlFull$generate_predefined) || !allow_write_predefined)) {
@@ -82,7 +83,8 @@ nCompile_nClass <- function(NC,
     if(is.null(compileInfo)) compileInfo <- NCinternals(NC)$compileInfo
     ## Make a new compiler object
     NC_Compiler <- NC_CompilerClass$new(NC,
-                                        compileInfo = compileInfo)
+                                        compileInfo = compileInfo,
+                                        project_env = project_env)
     ## Use the compiler to generate a cppDef
     class_env <- new.env()
     NC_Compiler$createCpp(control = controlFull,

nCompiler/R/NC_CompilerClass.R

@@ -6,6 +6,7 @@ NC_CompilerClass <- R6::R6Class(
   portable = FALSE,
   public = list(
     NCgenerator = NULL
+  , inheritInfo = NULL
   , NFcompilers = list() ## list of NF_CompilerClass objects for methods
   , symbolTable = NULL
   , cppDef = NULL
@@ -14,7 +15,8 @@ NC_CompilerClass <- R6::R6Class(
   , neededTypes = list(),
     initialize = function(NC = NULL,
                           className = NULL,
-                          compileInfo = NULL) {
+                          compileInfo = NULL,
+                          project_env = new.env()) {
       if(!isNCgenerator(NC)) {
         if(isNC(NC))
           stop(paste0("nClass object was provided to NCvirtual_CompilerClass. ",
@@ -25,14 +27,16 @@ NC_CompilerClass <- R6::R6Class(
              call. = FALSE)
       }
       NCgenerator <<- NC
+      nClass_info <- register_known_nClass(NCgenerator, project_env = project_env)
+      inheritInfo <<- nClass_info$inheritInfo
       myNCinternals <- NCinternals(NCgenerator)
       if(is.null(className)) {
         name <<- myNCinternals$cpp_classname
       } else {
         name <<- className
       }
       if(is.null(compileInfo))
-        self$compileInfo <- myNCinternals$compileInfo
+        self$compileInfo <- myNCinternals$compileInfo # will fail if there is inheritance, but normally compileInfo is provided
       else
         self$compileInfo <- compileInfo
       if(length(compileInfo$exportName)==0) {
@@ -56,7 +60,7 @@ NC_CompilerClass <- R6::R6Class(
           #NFinternals(thisMethod)$cpp_code_name <- self$name
           NFinternals(thisMethod)$cpp_code_name <- self$name
         } else {
-          thisName <- myNCinternals$all_methodName_to_cpp_code_name[[m]]
+          thisName <- self$inheritInfo$all_methodName_to_cpp_code_name[[m]]
         }
         NFcompilers[[m]] <<- NF_CompilerClass$new(f = thisMethod,
                                                   name = thisName)
@@ -121,11 +125,13 @@ NC_CompilerClass <- R6::R6Class(
     },
     makeSymbolTables = function(project_env = new.env()) {
       if(is.null(symbolTable)) {
-        symbolTable <<- NCinternals(NCgenerator)$symbolTable$clone(deep = TRUE)
-        ## Update any symbolTBD symbols by scoped lookup
-        resolveTBDsymbols(symbolTable,
-                          NCgenerator,
-                          project_env = project_env)
+        nClass_info <- register_known_nClass(self$NCgenerator, project_env = project_env)
+        symbolTable <<- nClass_info$symbolTable
+        # symbolTable <<- NCinternals(NCgenerator)$symbolTable$clone(deep = TRUE)
+        # ## Update any symbolTBD symbols by scoped lookup
+        # resolveTBDsymbols(symbolTable,
+        #                   NCgenerator,
+        #                   project_env = project_env)
         ## Add 'self' so method bodies can reference the current object.
         ## genCppVar() gives a special cppVar case where generate() returns ""
         ## and generateUse returns "nC_shared_from_this()".

nCompiler/R/NC_InternalsClass.R

@@ -6,14 +6,14 @@ NC_InternalsClass <- R6::R6Class(
     symbolTable = NULL,
     cppSymbolNames = NULL,
     methodNames = character(),
-    allMethodNames = character(), # including inherited methods
+    #allMethodNames = character(), # including inherited methods
     allMethodNames_self = character(), # not including inherited methods
     fieldNames = character(),
-    allFieldNames = character(), # including inherited methods
+    #allFieldNames = character(), # including inherited methods
     allFieldNames_self = character(), # not including inherited methods
     classname = character(),
     cpp_classname = character(),
-    all_methodName_to_cpp_code_name = list(),
+    #all_methodName_to_cpp_code_name = list(),
     orig_methodName_to_cpp_code_name = list(),
     compileInfo = list(),
     inherit_base_provided = FALSE,
@@ -25,13 +25,13 @@ NC_InternalsClass <- R6::R6Class(
     enableDerivs = NULL,
     enableSaving = NULL,
     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,
+    # inheritNCinternals = NULL,
     env = NULL,
     inheritQ = NULL, # quoted inherit expression, to defer access to the inherited nClass generator itself.
-    process_inherit_done = FALSE,
+    # process_inherit_done = FALSE,
     virtualMethodNames_self = character(), # will be used when checking inherited method validity, only for locally implemented methods
-    virtualMethodNames = character(),
-    check_inherit_done = FALSE,
+    # virtualMethodNames = character(),
+    #check_inherit_done = FALSE,
     classID = NULL,
     #Cpub_class_code = NULL,
     #main_class_code = NULL,
@@ -71,7 +71,7 @@ NC_InternalsClass <- R6::R6Class(
           }
         }
         has_Cpublic_init <- "initialize" %in% names(Cpublic)
-        self$virtualMethodNames <- names(Cpublic)[isVirtual]
+        #self$virtualMethodNames <- names(Cpublic)[isVirtual]
         self$symbolTable <- typeList2symbolTable(Cpublic[!isMethod], where = env)
         self$cppSymbolNames <- Rname2CppName(symbolTable$getSymbolNames())
         self$methodNames <- names(Cpublic)[isMethod]
@@ -83,16 +83,22 @@ NC_InternalsClass <- R6::R6Class(
         }
         self$allMethodNames_self <- methodNames
         self$virtualMethodNames_self <- names(Cpublic)[isVirtual]
-        self$allMethodNames <- methodNames
+        #self$allMethodNames <- methodNames
         self$fieldNames <- names(Cpublic)[!isMethod]
         if(has_Cpublic_init) self$fieldNames <- setdiff(self$fieldNames, "initialize")
         self$allFieldNames_self <- fieldNames
-        self$allFieldNames <- fieldNames
+        #self$allFieldNames <- fieldNames
         self$orig_methodName_to_cpp_code_name <- structure(vector("list", length=length(methodNames)),
                                                        names = methodNames)
         for(mN in methodNames) {
           self$orig_methodName_to_cpp_code_name[[mN]] <- NFinternals(Cpublic[[mN]])$cpp_code_name
         }
+        # The next three are normally set up during inheritance processing below,
+        # but if an nClass is predefined and used in wierd compilation workflow 
+        # like in nimble2, then we need defaults set up, and here they are:
+        # self$allMethodNames <- self$allMethodNames_self. # already done above
+        #self$all_methodName_to_cpp_code_name <- self$orig_methodName_to_cpp_code_name
+        # self$allFieldNames <- self$allFieldNames_self. # already done above
       }
       # An over-riding base class can be provided either through inherit or nClass_inherit.
       if(!is.null(self$compileInfo$inherit$base) || !is.null(self$compileInfo$nClass_inherit$base))
@@ -122,43 +128,64 @@ NC_InternalsClass <- R6::R6Class(
       self$predefined <- predefined
       self$enableSaving <- enableSaving
     },
-    connect_inherit = function() {
-      # These are steps that need to be done after all classes are defined
-      # and do not require recursion up the inheritance tree.
-      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 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) {
-          self$compileInfo$nClass_inherit$base <- self$inheritNCinternals$cpp_classname # don't paste "public" because it will go in interface_resolver<
-        }
-      }
-      self$process_inherit_done <- FALSE
-      self$check_inherit_done <- FALSE
-    },
-    process_inherit = function() {
+    # connect_inherit = function(inheritInfo, symbolTable, project_env) {
+    #   # These are steps that need to be done after all classes are defined
+    #   # and do not require recursion up the inheritance tree.
+    #   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 does not evaluate to an nClass generator.")
+    #     # self$inheritNCinternals <- NCinternals(inherit_obj)
+    #     parent_nClass_Info <- register_known_nClass(inherit_obj, project_env)
+    #     symbolTable$setParentST(parent_nClass_Info$symbolTable)
+    #     inheritInfo$inheritNCinternals <- NCinternals(inherit_obj)
+    #     inheritInfo$nClass_inherit <- self$compileInfo$nClass_inherit
+    #     if(!self$inherit_base_provided) {
+    #       #self$compileInfo$nClass_inherit$base <- self$inheritNCinternals$cpp_classname # don't paste "public" because it will go in interface_resolver<
+    #       inheritInfo$nClass_inherit$base <- self$inheritNCinternals$cpp_classname
+    #     }
+    #   }
+    #   inheritInfo$process_inherit_done <- FALSE
+    #   inheritInfo$check_inherit_done <- FALSE
+    # },
+    process_inherit = function(inheritInfo, symbolTable, project_env) {
       # These are steps that need to be done after connect_inherit
       # and require recursion up the inheritance tree, using flags.
       # TO-DO: Error trap in methods of same name but different argument signatures.
-      if(self$process_inherit_done) return()
+      if(isTRUE(inheritInfo$process_inherit_done)) return()
       if(!is.null(self$inheritQ)) {
-        self$inheritNCinternals$process_inherit()
-        self$symbolTable$setParentST(self$inheritNCinternals$symbolTable)
+        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 does not evaluate to an nClass generator.")
+        # self$inheritNCinternals <- NCinternals(inherit_obj)
+        parent_nClass_Info <- register_known_nClass(inherit_obj, project_env)
+        symbolTable$setParentST(parent_nClass_Info$symbolTable)
+        inheritInfo$inheritNCinternals <- NCinternals(inherit_obj)
+        inheritInfo$nClass_inherit <- self$compileInfo$nClass_inherit
+        # if(!self$inherit_base_provided) {
+        #   #self$compileInfo$nClass_inherit$base <- self$inheritNCinternals$cpp_classname # don't paste "public" because it will go in interface_resolver<
+        #   inheritInfo$nClass_inherit$base <- inheritInfo$inheritNCinternals$cpp_classname
+        # }
+        #self$inheritNCinternals$process_inherit()
+        #self$symbolTable$setParentST(self$inheritNCinternals$symbolTable)
         newMethodNames <- setdiff(self$allMethodNames_self,
-                                  self$inheritNCinternals$allMethodNames)
-        self$allMethodNames <- c(newMethodNames, self$inheritNCinternals$allMethodNames)
-        self$all_methodName_to_cpp_code_name <- c(self$orig_methodName_to_cpp_code_name[newMethodNames],
-                                                self$inheritNCinternals$all_methodName_to_cpp_code_name)
-        self$allFieldNames <- c(self$allFieldNames_self, self$inheritNCinternals$allFieldNames)
+                                  parent_nClass_Info$inheritInfo$allMethodNames)
+        inheritInfo$allMethodNames <- c(newMethodNames, parent_nClass_Info$inheritInfo$allMethodNames)
+        inheritInfo$all_methodName_to_cpp_code_name <- c(self$orig_methodName_to_cpp_code_name[newMethodNames],
+                                                parent_nClass_Info$inheritInfo$all_methodName_to_cpp_code_name)
+        inheritInfo$allFieldNames <- c(self$allFieldNames_self, parent_nClass_Info$inheritInfo$allFieldNames)
+        # self$allMethodNames <- c(newMethodNames, self$inheritNCinternals$allMethodNames)
+        # self$all_methodName_to_cpp_code_name <- c(self$orig_methodName_to_cpp_code_name[newMethodNames],
+        #                                         self$inheritNCinternals$all_methodName_to_cpp_code_name)
+        # self$allFieldNames <- c(self$allFieldNames_self, self$inheritNCinternals$allFieldNames)
       } else {
-        self$allMethodNames <- self$allMethodNames_self
-        self$all_methodName_to_cpp_code_name <- self$orig_methodName_to_cpp_code_name
-        self$allFieldNames <- self$allFieldNames_self
-        self$symbolTable$setParentST(NULL)
+        inheritInfo$allMethodNames <- self$allMethodNames_self
+        inheritInfo$all_methodName_to_cpp_code_name <- self$orig_methodName_to_cpp_code_name
+        inheritInfo$allFieldNames <- self$allFieldNames_self
+        symbolTable$setParentST(NULL)
       } 
-      self$process_inherit_done <- TRUE
+      inheritInfo$process_inherit_done <- TRUE
+      inheritInfo$check_inherit_done <- FALSE
     }
   )
 )

nCompiler/R/NC_SimpleInterface.R

@@ -46,13 +46,15 @@ value <- function(obj, name) {
 
 #' @export
 `value<-` <- function(obj, name = NULL, value) {
-   if(inherits(obj, "nClass"))
+   if(inherits(obj, "nClass")) {
     if(obj$isCompiled())
-      obj <- obj$private$Cpublic_obj$private$CppObj # obj$private$CppObj
+      work_obj <- obj$private$Cpublic_obj$private$CppObj # obj$private$CppObj
     else 
       stop("value<-() can only be used on compiled nClass objects.")
-  DLLenv <- get_DLLenv(obj)
-  extptr <- getExtptr(obj)
+   } else 
+     work_obj <- obj # should be a loadedObjectEnv (we lack error-trapping to confirm this.)
+  DLLenv <- get_DLLenv(work_obj)
+  extptr <- getExtptr(work_obj)
   DLLenv$set_value(extptr, name, value)
   obj
 }

nCompiler/R/NC_Utils.R

@@ -158,7 +158,7 @@ NC_find_method <- function(NCgenerator, name, inherits=TRUE) {
 # the case in an R6 class hierarchy, so we disallow it unless a user allows it by option).
 #
 # The previous calls will have initialized NCint$check_inherit_done to FALSE
-NC_check_inheritance <- function(NCgenerator) {
+NC_check_inheritance <- function(NCgenerator, inheritInfo, project_env) {
   allow_method_overloading <- isTRUE(get_nOption('allow_method_overloading'))
   allow_inherited_field_duplicates <- isTRUE(get_nOption('allow_inherited_field_duplicates'))
   if(allow_method_overloading && allow_inherited_field_duplicates) return(invisible(NULL))
@@ -168,29 +168,31 @@ NC_check_inheritance <- function(NCgenerator) {
   NCint <- NCinternals(NCgenerator)
 
   if(is.null(NCint$inheritQ)) {
-    NCint$check_inherit_done <- TRUE
-    NCint$virtualMethodNames <- NCint$virtualMethodNames_self
-    return(NCint$virtualMethodNames_self)
+    inheritInfo$check_inherit_done <- TRUE
+    inheritInfo$virtualMethodNames <- NCint$virtualMethodNames_self
+    return(inheritInfo$virtualMethodNames)
   }
-  if(NCint$check_inherit_done) return(NCint$virtualMethodNames)
+  if(inheritInfo$check_inherit_done) return(inheritInfo$virtualMethodNames)
   # At this point, we have inheritance and have checked this NCgenerator yet.
-  inheritNCinternals <- NCint$inheritNCinternals
+  inheritNCinternals <- inheritInfo$inheritNCinternals
   inheritNCgenerator <- eval(NCint$inheritQ, envir = NCint$env)
+  parent_nClass_Info <- register_known_nClass(inheritNCgenerator, project_env = project_env)
   # Recurse up the inheritance ladder
   # A design dilemma here was that the virtual marker is in the NFinternals,
   # which can be accessed from the NCgenerator but not the NCinternals.
   # That is why this function is not a method of NCinternals.
-  inherit_virtualMethodNames <- NC_check_inheritance(inheritNCgenerator)
+  inherit_virtualMethodNames <- NC_check_inheritance(inheritNCgenerator, parent_nClass_Info$inheritInfo,
+                                                      project_env = project_env)
   new_virtualMethodNames <- character()
 
   if(!allow_method_overloading) {
     local_virtualMethodNames <- NCint$virtualMethodNames_self
     # default: check for disallowed method overloading
-    allMethodNames <- NCint$allMethodNames
+    allMethodNames <- inheritInfo$allMethodNames
     for(mN in allMethodNames) {
       # if a method is not in the self method names, it was inherited, so there is nothing to check
       if(!(mN %in% NCint$allMethodNames_self)) next
-      if(!(mN %in% inheritNCinternals$allMethodNames)) {
+      if(!(mN %in% parent_nClass_Info$inheritInfo$allMethodNames)) {
         # current level is the first one with this method name, so here we tag its virtual status
         new_virtualMethodNames <- c(new_virtualMethodNames, mN)
         next
@@ -223,15 +225,15 @@ NC_check_inheritance <- function(NCgenerator) {
     #
     # If any of my own field names already existed from my inherited classes,
     # that's not allowed
-    badFields <- NCint$allFieldNames_self %in% inheritNCinternals$allFieldNames
+    badFields <- NCint$allFieldNames_self %in% parent_nClass_Info$inheritInfo$allFieldNames
     if(any(badFields))
       stop(paste0("Problem with field(s): ", paste(NCint$allFieldNames_self[badFields], collapse = ", "),
                   ". Fields with the same name are not allowed in base and inherited classes.",
                   " (If you want to allow local fields of the same name in C++ by turning off this requirement,",
                 " set nOptions(allow_inherited_field_duplicates=TRUE)"),
            call. = FALSE  )
   }
-  NCint$check_inherit_done <- TRUE
+  inheritInfo$check_inherit_done <- TRUE
   c(new_virtualMethodNames, inherit_virtualMethodNames)
 }
 

nCompiler/R/NF_CompilerClass.R

@@ -306,7 +306,8 @@ processNFstages <- function(NFcompiler,
                       env = NFcompiler$auxEnv[['where']],
                       project_env = project_env)
     NFcompiler$returnSymbol <- resolveOneTBDsymbol(NFcompiler$returnSymbol,
-                                                   env = NFcompiler$auxEnv[['where']])
+                                                   env = NFcompiler$auxEnv[['where']],
+                                                   project_env = project_env)
     if(inherits(NFcompiler$returnSymbol, "symbolNC")) {
       NFcompiler$auxEnv$needed_nClasses <- c(NFcompiler$auxEnv$needed_nClasses, NFcompiler$returnSymbol$NCgenerator)
     }