WIP: Allow private R and C members in nClass

nCompiler/R/NC.R

@@ -24,6 +24,11 @@ CnClassClass <- R6::R6Class(
 #' @param Cpublic list of public data (with type declarations) and methods
 #'   (nFunctions) that can be turned into C++ via \link{nCompile_nClass}. As in
 #'   R6 classes (see \link{R6Class}), data and methods go in the same list.
+#' @param Rprivate list of private data and methods (functions) for use from R
+#'   only.
+#' @param Cprivate list of private data (with type declarations) and methods
+#'   (nFunctions) that can be turned into C++ via \link{nCompile_nClass}. As in
+#'   R6 classes (see \link{R6Class}), data and methods go in the same list.
 #' @param enableDerivs list or character vector of methods in Cpublic for which
 #'   derivatives should be enabled.
 #' @param enableSaving logical indicating whether C++ should include support for
@@ -68,6 +73,8 @@ CnClassClass <- R6::R6Class(
 nClass <- function(classname,
                    Rpublic = list(),
                    Cpublic = list(),
+                   Rprivate = NULL,
+                   Cprivate = NULL,
                    enableDerivs = character(),
                    enableSaving = get_nOption("enableSaving"),
                    inherit = NULL,
@@ -147,9 +154,14 @@ nClass <- function(classname,
   inheritQ <- substitute(inherit)
   inherit_provided <- !is.null(inheritQ)
 
+  isPrivate <- c(rep(FALSE, length(Cpublic)), rep(TRUE, length(Cprivate)),
+                 rep(FALSE, length(Rpublic)), rep(TRUE, length(Rprivate)))
+  names(isPrivate) <- c(names(Cpublic), names(Cprivate), names(Rpublic), names(Rprivate))  
   internals = NC_InternalsClass$new(classname = classname,
                                     Cpublic = Cpublic,
-                                    isOnlyC = length(Rpublic) == 0,
+                                    Cprivate = Cprivate,
+                                    isPrivate = isPrivate,
+                                    isOnlyC = length(Rpublic) == 0 && length(Rprivate) == 0,
                                     enableDerivs = enableDerivs,
                                     enableSaving = enableSaving,
                                     inheritQ = inheritQ,
@@ -174,6 +186,7 @@ nClass <- function(classname,
   eval(substitute(
     result <- R6::R6Class(
       classname = classname,
+      private = c(Rprivate, Cprivate),                
       public = c(Rpublic, Cpublic, builtIn),
       portable = FALSE,
       inherit = INHERIT,

nCompiler/R/NC_CompilerClass.R

@@ -50,7 +50,7 @@ NC_CompilerClass <- R6::R6Class(
 
       methodNames <- myNCinternals$methodNames
       for(m in methodNames) {
-        thisMethod <- NCgenerator$public_methods[[m]]
+        thisMethod <- c(NCgenerator$public_methods, NCgenerator$private_methods)[[m]]
         thisName <- NULL
         if(isConstructor(thisMethod)) {
           #NFinternals(thisMethod)$cpp_code_name <- self$name
@@ -218,4 +218,4 @@ nCompile_gather_needed_nClasses <- function(cppDef,
     }
   }
   unique(new_needed)
-}
+}

nCompiler/R/NC_FullCompiledInterface.R

@@ -68,14 +68,14 @@ build_compiled_nClass <- function(NCgenerator,
   #  the current class except for those overloaded in the current class.
   #  All inherited member variables are pulled down, with no
   #  possibility of the same member variable being distinct at different
-  #  levels of a class hierarchy.
+                                        #  levels of a class hierarchy.
   NCI <- NCinternals(NCgenerator)
   # Make C interface methods
   CmethodNames <- NCI$methodNames
   recurse_make_Cmethods <- function(NCgenerator, CmethodNames,
                                     derivedNames = character()) {
     interfaceMethods <-  mapply(buildMethod_for_compiled_nClass,
-                                NCgenerator$public_methods[CmethodNames],
+                                c(NCgenerator$public_methods, NCgenerator$private_methods)[CmethodNames],
                                 CmethodNames)
     inherit_obj <- NCgenerator$get_inherit()
     if(isNCgenerator(inherit_obj)) {
@@ -94,17 +94,17 @@ build_compiled_nClass <- function(NCgenerator,
   }
   CinterfaceMethods <- recurse_make_Cmethods(NCgenerator, CmethodNames)
   # Make R interface methods
-  RmethodNames <- setdiff(names(NCgenerator$public_methods),
+  RmethodNames <- setdiff(c(names(NCgenerator$public_methods), names(NCgenerator$private_methods)),
                           c(CmethodNames, 'clone'))
   recurse_make_Rmethods <- function(NCgenerator, RmethodNames,
                                     derivedNames = character()) {
-    interfaceMethods <- NCgenerator$public_methods[RmethodNames]
+    interfaceMethods <- c(NCgenerator$public_methods, NCgenerator$private_methods)[RmethodNames]
     inherit_obj <- NCgenerator$get_inherit()
     if(isNCgenerator(inherit_obj)) {
       derivedNames <- c(derivedNames, RmethodNames)
       baseNCgen <- inherit_obj
       baseCmethodNames <- NCinternals(baseNCgen)$methodNames
-      baseRmethodNames <- setdiff(names(baseNCgen$public_methods),
+      baseRmethodNames <- setdiff(c(names(baseNCgen$public_methods), names(baseNCgen$private_methods)),
                                   c(baseCmethodNames, 'clone'))
       baseRmethodNames <- setdiff(baseRmethodNames, derivedNames)
       baseInterfaceMethods <- recurse_make_Rmethods(baseNCgen,
@@ -162,19 +162,19 @@ build_compiled_nClass <- function(NCgenerator,
     activeBindingResults
   }
   CfieldNames <- NCI$fieldNames
-  activeBindingResults <- recurse_make_activeBindings(NCgenerator, CfieldNames)
+  activeBindingResults <- recurse_make_activeBindings(NCgenerator, CfieldNames[!NCI$compileInfo$isPrivate[CfieldNames]])
   activeBindings <- activeBindingResults$activeBindings
   internal_fields <- activeBindingResults$newFields
 
   recurse_make_Rfields <- function(NCgenerator, RfieldNames,
                                     derivedNames = character()) {
-    interfaceFields <- NCgenerator$public_fields[RfieldNames]
+    interfaceFields <- c(NCgenerator$public_fields, NCgenerator$private_fields)[RfieldNames]
     inherit_obj <- NCgenerator$get_inherit()
     if(isNCgenerator(inherit_obj)) {
       derivedNames <- c(derivedNames, RfieldNames)
       baseNCgen <- inherit_obj
       baseCfieldNames <- NCinternals(baseNCgen)$fieldNames
-      baseRfieldNames <- setdiff(names(baseNCgen$public_fields),
+      baseRfieldNames <- setdiff(c(names(baseNCgen$public_fields),names(baseNCgen$private_fields)),
                                   c(baseCfieldNames, 'clone'))
       baseRfieldNames <- setdiff(baseRfieldNames, derivedNames)
       baseInterfaceFields <- recurse_make_Rfields(baseNCgen,
@@ -184,7 +184,7 @@ build_compiled_nClass <- function(NCgenerator,
     }
     interfaceFields
   }
-  RfieldNames <- setdiff(names(NCgenerator$public_fields),
+  RfieldNames <- setdiff(c(names(NCgenerator$public_fields), names(NCgenerator$private_fields)),
                          CfieldNames)
   RinterfaceFields <- recurse_make_Rfields(NCgenerator, RfieldNames)
 
@@ -237,12 +237,46 @@ build_compiled_nClass <- function(NCgenerator,
     if(!omit_automatic_Cpp_construction)
        RinterfaceMethods[["initialize"]] <- function(CppObj) {initializeCpp(CppObj)} 
   }
+
+  methodNames <- names(RinterfaceMethods)
+  nonMembers <- methodNames[!methodNames %in% names(NCI$compileInfo$isPrivate)]
+  members <- methodNames[methodNames %in% names(NCI$compileInfo$isPrivate)]
+  RprivateMethods <- members[NCI$compileInfo$isPrivate[members]]
+  RpublicMethods <- c(nonMembers, members[!NCI$compileInfo$isPrivate[members]])
+  fieldNames <- names(RinterfaceFields)
+  nonMembers <- fieldNames[!fieldNames %in% names(NCI$compileInfo$isPrivate)]
+  members <- fieldNames[fieldNames %in% names(NCI$compileInfo$isPrivate)]
+  RprivateFields <- members[NCI$compileInfo$isPrivate[members]]
+  RpublicFields <- c(nonMembers, members[!NCI$compileInfo$isPrivate[members]])
+  methodNames <- names(CinterfaceMethods)
+  nonMembers <- methodNames[!methodNames %in% names(NCI$compileInfo$isPrivate)]
+  members <- methodNames[methodNames %in% names(NCI$compileInfo$isPrivate)]
+  CprivateMethods <- members[NCI$compileInfo$isPrivate[members]]
+  CpublicMethods <- c(nonMembers, members[!NCI$compileInfo$isPrivate[members]])
+
+  ## Named lists or NULL cause problems when eval'ing the code to construct the R6Class; this avoids those.
+  RFIELDS_PRIVATE <- parse(text = deparse(
+                               RinterfaceFields[RprivateFields] 
+                           ), keep.source = FALSE)[[1]]
+  if(!length(RinterfaceFields[RprivateFields])) RFIELDS_PRIVATE <- list()
+  RPRIVATE <- parse(text = deparse(
+                        RinterfaceMethods[RprivateMethods] 
+                    ), keep.source = FALSE)[[1]]
+  if(!length(RinterfaceMethods[RprivateMethods])) RPRIVATE <- list()
+  CINTERFACE_PRIVATE <- parse(text = deparse(
+                                  CinterfaceMethods[CprivateMethods]
+                              ), keep.source = FALSE)[[1]]
+  if(!length(CinterfaceMethods[CprivateMethods])) CINTERFACE_PRIVATE <- list()
+
   ans <- substitute(
     expr = R6::R6Class(
       classname = CLASSNAME,
-      private = list(
-        CppObj = NULL,
-        DLLenv = NULL
+      private = c(
+        list(CppObj = NULL,
+        DLLenv = NULL),
+        RPRIVATE,
+        RFIELDS_PRIVATE,
+        CINTERFACE_PRIVATE
       ),
       public = c(
         RPUBLIC,
@@ -256,15 +290,18 @@ build_compiled_nClass <- function(NCgenerator,
     env = list(
       CLASSNAME = classname,
       RPUBLIC = parse(text = deparse(
-        RinterfaceMethods #NCgenerator$public_methods[RmethodNames]
+        RinterfaceMethods[RpublicMethods] #NCgenerator$public_methods[RmethodNames]
       ), keep.source = FALSE)[[1]],
       RFIELDS = parse(text = deparse(
 #        c(NCgenerator$public_fields[RfieldNames], internal_fields)
-        c(RinterfaceFields, internal_fields)
+        c(RinterfaceFields[RpublicFields], internal_fields)
       ), keep.source = FALSE)[[1]],
+      RPRIVATE = RPRIVATE,
+      RFIELDS_PRIVATE = RFIELDS_PRIVATE,
       CINTERFACE = parse(text = deparse(
-        CinterfaceMethods
-      ), keep.source = FALSE)[[1]],
+                             CinterfaceMethods[CpublicMethods]),
+                         keep.source = FALSE)[[1]],
+      CINTERFACE_PRIVATE = CINTERFACE_PRIVATE,
       ACTIVEBINDINGS = parse(text = deparse(activeBindings))[[1]]
     )
   )
@@ -422,7 +459,7 @@ build_generic_fns_for_compiled_nClass <- function(NCgenerator) {
   recurse_make_Cmethods <- function(NCgenerator, CmethodNames,
                                     derivedNames = character()) {
     interfaceFns <-  mapply(build_generic_fn_for_compiled_nClass_method,
-                                NCgenerator$public_methods[CmethodNames],
+                                c(NCgenerator$public_methods, NCgenerator$private_methods)[CmethodNames],
                                 CmethodNames)
     inherit_obj <- NCgenerator$get_inherit()
     if(isNCgenerator(inherit_obj)) {

nCompiler/R/NC_InternalsClass.R

@@ -34,6 +34,8 @@ NC_InternalsClass <- R6::R6Class(
     check_inherit_done = FALSE,
     initialize = function(classname,
                           Cpublic,
+                          Cprivate,
+                          isPrivate,
                           isOnlyC = FALSE,
                           enableDerivs = NULL,
                           enableSaving = get_nOption("enableSaving"),
@@ -47,37 +49,40 @@ NC_InternalsClass <- R6::R6Class(
       self$classname <- classname
       self$cpp_classname <- Rname2CppName(classname)
       self$isOnlyC = isOnlyC
-      numEntries <- length(Cpublic)
+
+      Cmembers <- c(Cpublic, Cprivate)
+      numEntries <- length(Cmembers)
       if(numEntries) {
         isMethod <- rep(FALSE, numEntries)
         isVirtual <- rep(FALSE, numEntries)
-        for(i in seq_along(Cpublic)) {
-          if(isNF(Cpublic[[i]])) {
+        for(i in seq_along(Cmembers)) {
+          if(isNF(Cmembers[[i]])) {
             isMethod[i] <- TRUE
-            isVirtual[i] <- isTRUE(NFinternals(Cpublic[[i]])$compileInfo$virtual)
+            isVirtual[i] <- isTRUE(NFinternals(Cmembers[[i]])$compileInfo$virtual)
             # NFinternals(Cpublic[[i]])$isMethod <- TRUE 
             next;
           }
-          if(is.function(Cpublic[[i]])) {
-            stop(paste0('Cpublic methods should be provided as nFunctions, ',
-                        'not functions. ', names(Cpublic)[i], ' is a function.'),
+          if(is.function(Cmembers[[i]])) {
+            stop(paste0('Cpublic and Cprivate methods should be provided as nFunctions, ',
+                        'not functions. ', names(Cmembers)[i], ' is a function.'),
                  call. = FALSE)
           }
         }
-        self$virtualMethodNames <- names(Cpublic)[isVirtual]
-        self$symbolTable <- argTypeList2symbolTable(Cpublic[!isMethod], evalEnv = env)
+        self$virtualMethodNames <- names(Cmembers)[isVirtual]
+        self$symbolTable <- argTypeList2symbolTable(Cmembers[!isMethod], evalEnv = env)
         self$cppSymbolNames <- Rname2CppName(symbolTable$getSymbolNames())
-        self$methodNames <- names(Cpublic)[isMethod]
+        self$methodNames <- names(Cmembers)[isMethod]
         self$allMethodNames_self <- methodNames
-        self$virtualMethodNames_self <- names(Cpublic)[isVirtual]
+        self$virtualMethodNames_self <- names(Cmembers)[isVirtual]
         self$allMethodNames <- methodNames
-        self$fieldNames <- names(Cpublic)[!isMethod]
+        self$fieldNames <- names(Cmembers)[!isMethod]
         self$allFieldNames_self <- fieldNames
         self$allFieldNames <- fieldNames
+        self$compileInfo$isPrivate <- isPrivate
         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
+          self$orig_methodName_to_cpp_code_name[[mN]] <- NFinternals(Cmembers[[mN]])$cpp_code_name
         }
       }
       # An over-riding base class can be provided either through inherit or nClass_inherit.
@@ -88,7 +93,7 @@ NC_InternalsClass <- R6::R6Class(
           enableDerivs <- as.list(enableDerivs)
         for(i in enableDerivs) {
           if(!(i %in% self$methodNames))
-            stop(paste0('enableDerivs entry ', i, ' is not a method in Cpublic.'))
+            stop(paste0('enableDerivs entry ', i, ' is not a method in Cmembers.'))
         }
         self$enableDerivs <- enableDerivs
       }

nCompiler/R/NC_Utils.R

@@ -84,15 +84,18 @@ NCinternals <- function(x) {
 
 # Utility function to allow searching up an inheritance
 # ladder to find a method.
-NC_find_method <- function(NCgenerator, name, inherits=TRUE) {
+NC_find_method <- function(NCgenerator, name, inherits=TRUE, includePrivate = TRUE) {
   if(!isNCgenerator(NCgenerator))
     stop("Input must be a nClass generator.")
   current_NCgen <- NCgenerator
   done <- FALSE
   method <- NULL
   while(!done) {
     if(name %in% NCinternals(current_NCgen)$methodNames) {
-      method <- current_NCgen$public_methods[[name]]
+      method <- c(current_NCgen$public_methods,
+                  if(includePrivate) current_NCgen$private_methods else NULL)[[name]]
+      if(!includePrivate && name %in% names(current_NCgen$private_methods))
+          warning(name, " is a private method not available in the calling context")  # TODO: use new messaging system.
       done <- TRUE
     } else {
       if(inherits)  {
@@ -193,4 +196,4 @@ NC_check_inheritance <- function(NCgenerator) {
   }
   NCint$check_inherit_done <- TRUE
   c(new_virtualMethodNames, inherit_virtualMethodNames)
-}
+}

nCompiler/R/NF_derivs.R

@@ -129,7 +129,7 @@ setup_wrt <- function(nFxn = NA, dropArgs = NA, wrt = NULL, NC = NULL) {
     fxn <- eval(fxnCall, envir = parent.frame())
     fxnName <- fxnCall[[3]]
     if (!is.character(fxnName)) fxnName <- deparse(fxnName)
-    nf <- NC$public_methods[[fxnName]]
+    nf <- c(NC$public_methods, NC$private_methods)[[fxnName]]
     fxnArgs <- NFinternals(nf)$argSymTab$symbols
 
   } else if (is.call(fxnCall) && fxnCall[[1]] == 'method') {
@@ -154,10 +154,10 @@ setup_wrt <- function(nFxn = NA, dropArgs = NA, wrt = NULL, NC = NULL) {
 
     fxnName <- fxnCall[[3]]
 
-    nf <- NC$public_methods[[fxnName]]
+    nf <- c(NC$public_methods, NC$private_methods)[[fxnName]]
     if (is.null(nf))
       stop(paste0(
-        "The 'NC' argument provided to 'setup_wrt' has no public method named ",
+        "The 'NC' argument provided to 'setup_wrt' has no method named ",
         fxnName, "."))
 
     fxnArgs <- NFinternals(nf)$argSymTab$symbols
@@ -575,7 +575,7 @@ nDerivs_full <- function(fxnCall = NULL, order = c(0, 1, 2), dropArgs = NA,
 
   fxnName <- fxnCall[[1]][[3]]
   if (is.symbol(fxnName)) fxnName <- deparse(fxnName)
-  nf <- NC$public_methods[[fxnName]]
+  nf <- c(NC$public_methods, NC$private_methods)[[fxnName]]
   fxnArgs <- NFinternals(nf)$argSymTab$symbols
   fxnCall[[1]] <- derivFxnCall
   fxnCall$order <- order
@@ -603,10 +603,10 @@ nDerivs_generic <- function(fxnCall = NULL, order = c(0, 1, 2), dropArgs = NA,
       "The 'NC' argument to 'nDerivs' must be an nClass generator (returned",
       "from a call to 'nClass')."))
 
-  nf <- NC$public_methods[[fxnName]]
+  nf <- c(NC$public_methods, NC$private_methods)[[fxnName]]
   if (is.null(nf))
     stop(paste0(
-      "The 'NC' argument provided to 'nDerivs' has no public method named ",
+      "The 'NC' argument provided to 'nDerivs' has no method named ",
       fxnName, "."))
 
   fxnArgs <- NFinternals(nf)$argSymTab$symbols

nCompiler/R/compile_labelAbstractTypes.R

@@ -282,7 +282,10 @@ inLabelAbstractTypesEnv(
       ## 1. Check if RHS is a method
       ## 2. Check if RHS is a field
       innerName <- code$args[[2]]$name
-      method <- NC_find_method(code$args[[1]]$type$NCgenerator, innerName, inherits=TRUE)
+      ## Calling context must be the same class as the method being invoked.
+      includePrivate <- inherits(auxEnv$where, "R6ClassGenerator") && auxEnv$where$class &&
+        auxEnv$where$classname == code$args[[1]]$type$NCgenerator$classname
+      method <- NC_find_method(code$args[[1]]$type$NCgenerator, innerName, inherits=TRUE, includePrivate = includePrivate)
       if(!is.null(method)) { ## Is RHS a method?
         obj_internals <- NFinternals(method)
         returnSym <- symbolNF$new(
@@ -303,6 +306,15 @@ inLabelAbstractTypesEnv(
         obj_internals <- NULL
       } else {  ## Is RHS a field?
         symbol <- NCinternals(code$args[[1]]$type$NCgenerator)$symbolTable$getSymbol(innerName, inherits=TRUE)
+        if(!is.null(symbol)) {  # Check for improper use of private field.
+          if(!(inherits(auxEnv$where, "R6ClassGenerator") && auxEnv$where$class &&
+               auxEnv$where$classname == code$args[[1]]$type$NCgenerator$classname) &&
+             NCinternals(code$args[[1]]$type$NCgenerator)$compileInfo$isPrivate[symbol$name])
+             stop(exprClassProcessingErrorMsg(
+                  code,
+                  paste0(nDeparse(code$args[[2]]), " is a private field.")
+              ), call. = FALSE)
+        }
         if(is.null(symbol))
           stop(exprClassProcessingErrorMsg(
             code,