Improve the system for handling nClass inheritance

.github/workflows/test-all.yaml

@@ -42,7 +42,7 @@ jobs:
       - name: Package Dependencies
         run: R -q -e 'remotes::install_deps("nCompiler", dependencies=TRUE)'
       - name: Install inline
-        run: R -q -e 'remotes::install_cran("inline")'
+        run: R -q -e 'remotes::install_cran(c("inline", "nimble"))'
       - name: Build Package
         run: |
             R CMD build nCompiler
@@ -53,7 +53,6 @@ jobs:
           testthat::test_dir("nCompiler/tests/testthat/uncompiled_tests", reporter = "summary")
           testthat::test_dir("nCompiler/tests/testthat/nCompile_tests", reporter = "summary")
           testthat::test_dir("nCompiler/tests/testthat/cpp_tests", reporter = "summary")
-          testthat::test_dir("nCompiler/tests/testthat/specificOp_tests", reporter = "summary")
         shell: Rscript {0}
 
   test-nCompile-features:
@@ -77,6 +76,7 @@ jobs:
         run: |
           library(nCompiler)
           testthat::test_dir("nCompiler/tests/testthat/predefined_tests", reporter = "summary")
+          testthat::test_dir("nCompiler/tests/testthat/specificOp_tests", reporter = "summary")
         shell: Rscript {0}
 
   test-nClass:

nCompiler/R/NC.R

@@ -117,7 +117,8 @@ nClass <- function(classname,
     list(exportName = NULL, interface = "full",
          interfaceMembers = NULL,
          depends = list(),
-         inherit = list()),
+         inherit = list(),
+         nClass_inherit = list()),
     compileInfo
   )
   if(missing(classname))
@@ -163,8 +164,6 @@ nClass <- function(classname,
   # so if provided in the nClass call, we stick it in new_env.
   # (That is not the only reason for new_env.)
   # Also note that the inherit arg is for nClass inheritance. The compileInfo$inherit element is for hard-coded C++ inheritance statements.
-  inheritQ <- substitute(inherit)
-  inherit_provided <- !is.null(inheritQ)
   #if(!is.null(inherit)) new_env$.inherit_obj <- inherit
   new_env$.NCinternals <- internals
   # Uncompiled behavior for Cpublic fields needs to be handled.

nCompiler/R/NC_CompilerClass.R

@@ -51,10 +51,15 @@ NC_CompilerClass <- R6::R6Class(
       methodNames <- myNCinternals$methodNames
       for(m in methodNames) {
         thisMethod <- NCgenerator$public_methods[[m]]
+        thisName <- NULL
         if(isConstructor(thisMethod)) {
+          #NFinternals(thisMethod)$cpp_code_name <- self$name
           NFinternals(thisMethod)$cpp_code_name <- self$name
+        } else {
+          thisName <- myNCinternals$all_methodName_to_cpp_code_name[[m]]
         }
-        NFcompilers[[m]] <<- NF_CompilerClass$new(f = thisMethod)
+        NFcompilers[[m]] <<- NF_CompilerClass$new(f = thisMethod,
+                                                  name = thisName)
       }
     },
     setupMethodSymbolTables = function() {

nCompiler/R/NC_InternalsClass.R

@@ -13,6 +13,8 @@ NC_InternalsClass <- R6::R6Class(
     allFieldNames_self = character(), # not including inherited methods
     classname = character(),
     cpp_classname = character(),
+    all_methodName_to_cpp_code_name = list(),
+    orig_methodName_to_cpp_code_name = list(),
     compileInfo = list(),
     inherit_base_provided = FALSE,
     # compileInfo will include interface ("full", "generic", or "none"),
@@ -27,6 +29,9 @@ NC_InternalsClass <- R6::R6Class(
     env = NULL,
     inheritQ = NULL,
     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,
     initialize = function(classname,
                           Cpublic,
                           isOnlyC = FALSE,
@@ -45,10 +50,12 @@ NC_InternalsClass <- R6::R6Class(
       numEntries <- length(Cpublic)
       if(numEntries) {
         isMethod <- rep(FALSE, numEntries)
+        isVirtual <- rep(FALSE, numEntries)
         for(i in seq_along(Cpublic)) {
           if(isNF(Cpublic[[i]])) {
             isMethod[i] <- TRUE
-            NFinternals(Cpublic[[i]])$isMethod <- TRUE
+            isVirtual[i] <- isTRUE(NFinternals(Cpublic[[i]])$compileInfo$virtual)
+            # NFinternals(Cpublic[[i]])$isMethod <- TRUE 
             next;
           }
           if(is.function(Cpublic[[i]])) {
@@ -57,17 +64,25 @@ NC_InternalsClass <- R6::R6Class(
                  call. = FALSE)
           }
         }
+        self$virtualMethodNames <- names(Cpublic)[isVirtual]
         self$symbolTable <- argTypeList2symbolTable(Cpublic[!isMethod], evalEnv = env)
         self$cppSymbolNames <- Rname2CppName(symbolTable$getSymbolNames())
         self$methodNames <- names(Cpublic)[isMethod]
         self$allMethodNames_self <- methodNames
+        self$virtualMethodNames_self <- names(Cpublic)[isVirtual]
         self$allMethodNames <- methodNames
         self$fieldNames <- names(Cpublic)[!isMethod]
         self$allFieldNames_self <- fieldNames
         self$allFieldNames <- fieldNames
-        if(!is.null(self$compileInfo$inherit$base))
-          self$inherit_base_provided <- TRUE
+        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
+        }
       }
+      # 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))
+          self$inherit_base_provided <- TRUE
       if(!is.null(enableDerivs)) {
         if(!is.list(enableDerivs))
           enableDerivs <- as.list(enableDerivs)
@@ -84,29 +99,38 @@ NC_InternalsClass <- R6::R6Class(
       # 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)
+        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.")
         self$inheritNCinternals <- NCinternals(inherit_obj)
         message("add check that base class has interface 'none'")
-        if(!self$inherit_base_provided)
-          self$compileInfo$inherit$base <- paste("public",
-                                            self$inheritNCinternals$cpp_classname)
-        process_inherit_done <- FALSE
-      } else {
-        process_inherit_done <- TRUE
+        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() {
       # 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(!is.null(self$inheritQ)) {
         self$inheritNCinternals$process_inherit()
         self$symbolTable$setParentST(self$inheritNCinternals$symbolTable)
-        self$allMethodNames <- c(self$allMethodNames_self, self$inheritNCinternals$allMethodNames)
+        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)
-      }
+      } 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)
+      } 
       self$process_inherit_done <- TRUE
     }
   )

nCompiler/R/NC_Utils.R

@@ -103,4 +103,94 @@ NC_find_method <- function(NCgenerator, name, inherits=TRUE) {
     }
   }
   method
+}
+
+# This function will be called from nCompile after going through the 
+# NCinternals for all units and calling connect_inherit and then process_inherit
+# (with all connect_inherits called before all process_inherits)
+# At that point we are ready to check for disallowed method overloading
+# (we don't allow the same method name in different levels of the hierarchy unless it is virtual
+# and all signatures match, i.e. we don't allow C-style overloading because it wouldn't work in 
+# uncompiled (R) execution. This can be changed by an option, indicating one wants only the
+# compiled behavior and doesn't care about uncompiled inconsistency.)
+# and disallowed duplicate member variable names (for a similar reason: In C++
+# different levels of a hierarchy could each have their own "x", but that is not
+# 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) {
+  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))
+
+  if(!isNCgenerator(NCgenerator))
+    stop("Input to NC_check_inheritance must be a nClass generator.")
+  NCint <- NCinternals(NCgenerator)
+
+  if(is.null(NCint$inheritQ)) {
+    NCint$check_inherit_done <- TRUE
+    NCint$virtualMethodNames <- NCint$virtualMethodNames_self
+    return(NCint$virtualMethodNames_self)
+  }
+  if(NCint$check_inherit_done) return(NCint$virtualMethodNames)
+  # At this point, we have inheritance and have checked this NCgenerator yet.
+  inheritNCinternals <- NCint$inheritNCinternals
+  inheritNCgenerator <- eval(NCint$inheritQ, envir = NCint$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)
+  new_virtualMethodNames <- character()
+
+  if(!allow_method_overloading) {
+    local_virtualMethodNames <- NCint$virtualMethodNames_self
+    # default: check for disallowed method overloading
+    allMethodNames <- NCint$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)) {
+        # current level is the first one with this method name, so here we tag its virtual status
+        new_virtualMethodNames <- c(new_virtualMethodNames, mN)
+        next
+      }
+      # At this point the current level has the method and it is inherited
+      localMethod <- NCgenerator$public_methods[[mN]]
+      inheritMethod <- NC_find_method(inheritNCgenerator, mN)
+      if(is.null(inheritMethod))
+        stop("Problem finding inherited method ", mN, " in NC_check_inheritance.", call. = FALSE)
+      if(!NF_types_match(localMethod, inheritMethod))
+        stop(paste0("Method ", mN, " does not have the same arguments names,", 
+                    " and/or argument types, and/or returnType as a base class method of the same name.",
+                    " Methods of the same name in an nClass hierarchy must have all of these the same",
+                    " and the top-level one must be marked with compileInfo(virtual=TRUE).",
+                    " (If you want to allow method overloading in C++ by turning off these requirements,",
+                    " set nOptions(allow_method_overloading=TRUE)"),
+             call. = FALSE)
+      if(!(mN %in% inherit_virtualMethodNames))
+        stop(paste0("Method ", mN, " is inherited, so", 
+                " it must be marked with compileInfo(virtual=TRUE) in the top-level nClass that includes it.",
+                " That does not appear to be the case.",
+                " (If you want to allow method over-loading in C++ by turning off this requirement,",
+                " set nOptions(allow_method_overloading=TRUE)"),
+          call. = FALSE)
+    }
+  }
+  if(!allow_inherited_field_duplicates) {
+    # This would be slightly more efficient to do in NC_InternalsClass::process_inherit
+    # but we keep it here so all the checking is together here.
+    #
+    # If any of my own field names already existed from my inherited classes, 
+    # that's not allowed
+    badFields <- NCint$allFieldNames_self %in% inheritNCinternals$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
+  c(new_virtualMethodNames, inherit_virtualMethodNames)
 }

nCompiler/R/NF_CompilerClass.R

@@ -27,8 +27,7 @@ NF_CompilerClass <- R6::R6Class(
     derivsContent = list(),
     initialTypeInferenceDone = FALSE,
     initialize = function(f = NULL,
-                          ## funName,
-                          # const = FALSE,
+                          name = NULL, # Allow an nClass to set the name of its method.
                           useUniqueNameInCpp = FALSE,
                           compileInfo = NULL) {
       self$auxEnv <- new.env()
@@ -45,9 +44,14 @@ NF_CompilerClass <- R6::R6Class(
         } else {
           self$NFinternals <- NFinternals(f)
         }
-        self$origName <- NFinternals$uniqueName
-        if (useUniqueNameInCpp) self$name <- NFinternals$uniqueName
-        else self$name <- NFinternals$cpp_code_name
+        self$origName <- NFinternals$uniqueName2
+        if(!is.null(name)) {
+          self$name <- name
+        } else {
+          if (useUniqueNameInCpp) self$name <- NFinternals$uniqueName2
+          # NB If this is a method of a nClass, its cpp_code_name may be intercepted later but will not be changed here.
+          else self$name <- NFinternals$cpp_code_name
+        }
         self$origRcode <- NFinternals$code
         self$newRcode <- NFinternals$code
         self$isAD <- NFinternals$isAD

nCompiler/R/NF_InternalsClass.R

@@ -12,8 +12,10 @@ NF_InternalsClass <- R6::R6Class(
     returnSym = NULL,
     control = list(),
     where = NULL,
-    isMethod = FALSE,
+    #isMethod = FALSE,
     uniqueName = character(),
+    uniqueName2 = character(),
+    #cpp_code_name = character(),
     cpp_code_name = character(),
     ## template = NULL, replaced with default_matchDef
     default_matchDef = NULL,
@@ -46,9 +48,17 @@ NF_InternalsClass <- R6::R6Class(
                           ## setupVarNames = NULL, ## Ditto
                           where = parent.frame()
                           ) {
+      ## name is required and is generated by NF() if not provided.
       ## uniqueName is only needed if this is not a method of a nClass.
-      if(!missing(name))
-        self$uniqueName <- name
+      if(!missing(name)) {
+        self$uniqueName <- name       
+        self$uniqueName2 <- paste(name,
+                                  nFunctionIDMaker(),
+                                  sep = "_")  
+      } else {
+        stop("NF_InternalsClass needs a name argument.", call. = FALSE)
+      }
+      ## uniqueName2 is needed even for methods, to serve as unique keys.
       if(is.null(compileInfo$C_fun)) {
         fun_to_use <- fun
       } else {
@@ -85,8 +95,6 @@ NF_InternalsClass <- R6::R6Class(
       ## e.g. 'print' to 'nPrint'; see 'nKeyWords' list in
       ## changeKeywords.R
       self$code <- body(fun_to_use)
-      if(isTRUE(control$changeKeywords))
-        self$code <- nf_changeKeywords(self$code)
       if(code[[1]] != '{')
         self$code <- substitute({CODE}, list(CODE=code))
       ## check all code except.nCompiler package nFunctions
@@ -115,17 +123,33 @@ NF_InternalsClass <- R6::R6Class(
       self$returnSym <- argType2symbol(returnTypeDecl,
                                        origName = "returnType",
                                        evalEnv = where)
+
+      # It is important to do this after getting the returnType info
+      # because this will change integer to nInteger, even in returnType
+      if(isTRUE(control$changeKeywords))
+        self$code <- nf_changeKeywords(self$code)
+
       ## We set the cpp_code_name here so that other nFunctions
       ## that call this one can determine, during compilation,
-      ## what this one's cpp function name will be:
-      if(!is.null(compileInfo$cpp_code_name))
+      ## what this one's cpp function name will be.
+      ## However, if this nFunction is used as a method of a nClass,
+      ## and if that nClass inherits from another nClass and this
+      ## nFunction is actually virtual, then the base class's
+      ## cpp_code_name will be used instead.
+      ## However, we do not modify it in this NFinternals because
+      ## it is permitted to use this elsewhere, e.g. on its own
+      ## or to provide a method to a different nClass.
+      if(!is.null(compileInfo$cpp_code_name)) {
+        #self$cpp_code_name <- compileInfo$cpp_code_name
         self$cpp_code_name <- compileInfo$cpp_code_name
-      else {
+      } else {
+        #self$cpp_code_name <- Rname2CppName(name)
         self$cpp_code_name <- Rname2CppName(name)
-        if(isFALSE(predefined))
-          self$cpp_code_name <- paste(self$cpp_code_name,
-                                      nFunctionIDMaker(),
-                                      sep = "_")
+        # do not uniquify cpp_code_name
+        # if(isFALSE(predefined))
+        #   self$cpp_code_name <- paste(self$cpp_code_name,
+        #                               nFunctionIDMaker(),
+        #                               sep = "_")
       }
       ## Unpack enableDerivs into AD
       self$isAD <- FALSE