Skip to content

Commit 972d987

Browse files
perrydvperrydv
authored
Improve the system for handling nClass inheritance (#90)
* adjust tests * interface_resolver<> works. * Make wrap for shared_ptr<T> work for multiple inheritance of loadedObjectHookC * reworking internal naming to support virtual inheritance * inheritance fixed up, error-trapped, and tested. cpp_code_name change still in interim names. * put back generate_predefined option. finish rearranging cpp_code_name * fix nimbleModel prototype for now
1 parent 6ad78d7 commit 972d987

20 files changed

Lines changed: 816 additions & 111 deletions

File tree

‎.github/workflows/test-all.yaml‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ jobs:
4242
- name: Package Dependencies
4343
run: R -q -e 'remotes::install_deps("nCompiler", dependencies=TRUE)'
4444
- name: Install inline
45-
run: R -q -e 'remotes::install_cran("inline")'
45+
run: R -q -e 'remotes::install_cran(c("inline", "nimble"))'
4646
- name: Build Package
4747
run: |
4848
R CMD build nCompiler
@@ -53,7 +53,6 @@ jobs:
5353
testthat::test_dir("nCompiler/tests/testthat/uncompiled_tests", reporter = "summary")
5454
testthat::test_dir("nCompiler/tests/testthat/nCompile_tests", reporter = "summary")
5555
testthat::test_dir("nCompiler/tests/testthat/cpp_tests", reporter = "summary")
56-
testthat::test_dir("nCompiler/tests/testthat/specificOp_tests", reporter = "summary")
5756
shell: Rscript {0}
5857

5958
test-nCompile-features:
@@ -77,6 +76,7 @@ jobs:
7776
run: |
7877
library(nCompiler)
7978
testthat::test_dir("nCompiler/tests/testthat/predefined_tests", reporter = "summary")
79+
testthat::test_dir("nCompiler/tests/testthat/specificOp_tests", reporter = "summary")
8080
shell: Rscript {0}
8181

8282
test-nClass:

‎nCompiler/R/NC.R‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -117,7 +117,8 @@ nClass <- function(classname,
117117
list(exportName = NULL, interface = "full",
118118
interfaceMembers = NULL,
119119
depends = list(),
120-
inherit = list()),
120+
inherit = list(),
121+
nClass_inherit = list()),
121122
compileInfo
122123
)
123124
if(missing(classname))
@@ -163,8 +164,6 @@ nClass <- function(classname,
163164
# so if provided in the nClass call, we stick it in new_env.
164165
# (That is not the only reason for new_env.)
165166
# Also note that the inherit arg is for nClass inheritance. The compileInfo$inherit element is for hard-coded C++ inheritance statements.
166-
inheritQ <- substitute(inherit)
167-
inherit_provided <- !is.null(inheritQ)
168167
#if(!is.null(inherit)) new_env$.inherit_obj <- inherit
169168
new_env$.NCinternals <- internals
170169
# Uncompiled behavior for Cpublic fields needs to be handled.

‎nCompiler/R/NC_CompilerClass.R‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,10 +51,15 @@ NC_CompilerClass <- R6::R6Class(
5151
methodNames <- myNCinternals$methodNames
5252
for(m in methodNames) {
5353
thisMethod <- NCgenerator$public_methods[[m]]
54+
thisName <- NULL
5455
if(isConstructor(thisMethod)) {
56+
#NFinternals(thisMethod)$cpp_code_name <- self$name
5557
NFinternals(thisMethod)$cpp_code_name <- self$name
58+
} else {
59+
thisName <- myNCinternals$all_methodName_to_cpp_code_name[[m]]
5660
}
57-
NFcompilers[[m]] <<- NF_CompilerClass$new(f = thisMethod)
61+
NFcompilers[[m]] <<- NF_CompilerClass$new(f = thisMethod,
62+
name = thisName)
5863
}
5964
},
6065
setupMethodSymbolTables = function() {

‎nCompiler/R/NC_InternalsClass.R‎

Lines changed: 36 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -13,6 +13,8 @@ NC_InternalsClass <- R6::R6Class(
1313
allFieldNames_self = character(), # not including inherited methods
1414
classname = character(),
1515
cpp_classname = character(),
16+
all_methodName_to_cpp_code_name = list(),
17+
orig_methodName_to_cpp_code_name = list(),
1618
compileInfo = list(),
1719
inherit_base_provided = FALSE,
1820
# compileInfo will include interface ("full", "generic", or "none"),
@@ -27,6 +29,9 @@ NC_InternalsClass <- R6::R6Class(
2729
env = NULL,
2830
inheritQ = NULL,
2931
process_inherit_done = FALSE,
32+
virtualMethodNames_self = character(), # will be used when checking inherited method validity, only for locally implemented methods
33+
virtualMethodNames = character(),
34+
check_inherit_done = FALSE,
3035
initialize = function(classname,
3136
Cpublic,
3237
isOnlyC = FALSE,
@@ -45,10 +50,12 @@ NC_InternalsClass <- R6::R6Class(
4550
numEntries <- length(Cpublic)
4651
if(numEntries) {
4752
isMethod <- rep(FALSE, numEntries)
53+
isVirtual <- rep(FALSE, numEntries)
4854
for(i in seq_along(Cpublic)) {
4955
if(isNF(Cpublic[[i]])) {
5056
isMethod[i] <- TRUE
51-
NFinternals(Cpublic[[i]])$isMethod <- TRUE
57+
isVirtual[i] <- isTRUE(NFinternals(Cpublic[[i]])$compileInfo$virtual)
58+
# NFinternals(Cpublic[[i]])$isMethod <- TRUE
5259
next;
5360
}
5461
if(is.function(Cpublic[[i]])) {
@@ -57,17 +64,25 @@ NC_InternalsClass <- R6::R6Class(
5764
call. = FALSE)
5865
}
5966
}
67+
self$virtualMethodNames <- names(Cpublic)[isVirtual]
6068
self$symbolTable <- argTypeList2symbolTable(Cpublic[!isMethod], evalEnv = env)
6169
self$cppSymbolNames <- Rname2CppName(symbolTable$getSymbolNames())
6270
self$methodNames <- names(Cpublic)[isMethod]
6371
self$allMethodNames_self <- methodNames
72+
self$virtualMethodNames_self <- names(Cpublic)[isVirtual]
6473
self$allMethodNames <- methodNames
6574
self$fieldNames <- names(Cpublic)[!isMethod]
6675
self$allFieldNames_self <- fieldNames
6776
self$allFieldNames <- fieldNames
68-
if(!is.null(self$compileInfo$inherit$base))
69-
self$inherit_base_provided <- TRUE
77+
self$orig_methodName_to_cpp_code_name <- structure(vector("list", length=length(methodNames)),
78+
names = methodNames)
79+
for(mN in methodNames) {
80+
self$orig_methodName_to_cpp_code_name[[mN]] <- NFinternals(Cpublic[[mN]])$cpp_code_name
81+
}
7082
}
83+
# An over-riding base class can be provided either through inherit or nClass_inherit.
84+
if(!is.null(self$compileInfo$inherit$base) || !is.null(self$compileInfo$nClass_inherit$base))
85+
self$inherit_base_provided <- TRUE
7186
if(!is.null(enableDerivs)) {
7287
if(!is.list(enableDerivs))
7388
enableDerivs <- as.list(enableDerivs)
@@ -84,29 +99,38 @@ NC_InternalsClass <- R6::R6Class(
8499
# These are steps that need to be done after all classes are defined
85100
# and do not require recursion up the inheritance tree.
86101
if(!is.null(self$inheritQ)) {
87-
inherit_obj <- eval(self$inheritQ, envir = self$env)
102+
inherit_obj <- eval(self$inheritQ, envir = self$env) #inheritQ can be an expression but it must always return the same generator object
88103
if(!isNCgenerator(inherit_obj))
89104
stop("An inherit argument that was provided to nClass is not nClass generator.")
90105
self$inheritNCinternals <- NCinternals(inherit_obj)
91106
message("add check that base class has interface 'none'")
92-
if(!self$inherit_base_provided)
93-
self$compileInfo$inherit$base <- paste("public",
94-
self$inheritNCinternals$cpp_classname)
95-
process_inherit_done <- FALSE
96-
} else {
97-
process_inherit_done <- TRUE
107+
if(!self$inherit_base_provided) {
108+
self$compileInfo$nClass_inherit$base <- self$inheritNCinternals$cpp_classname # don't paste "public" because it will go in interface_resolver<
109+
}
98110
}
111+
self$process_inherit_done <- FALSE
112+
self$check_inherit_done <- FALSE
99113
},
100114
process_inherit = function() {
101115
# These are steps that need to be done after connect_inherit
102116
# and require recursion up the inheritance tree, using flags.
117+
# TO-DO: Error trap in methods of same name but different argument signatures.
103118
if(self$process_inherit_done) return()
104119
if(!is.null(self$inheritQ)) {
105120
self$inheritNCinternals$process_inherit()
106121
self$symbolTable$setParentST(self$inheritNCinternals$symbolTable)
107-
self$allMethodNames <- c(self$allMethodNames_self, self$inheritNCinternals$allMethodNames)
122+
newMethodNames <- setdiff(self$allMethodNames_self,
123+
self$inheritNCinternals$allMethodNames)
124+
self$allMethodNames <- c(newMethodNames, self$inheritNCinternals$allMethodNames)
125+
self$all_methodName_to_cpp_code_name <- c(self$orig_methodName_to_cpp_code_name[newMethodNames],
126+
self$inheritNCinternals$all_methodName_to_cpp_code_name)
108127
self$allFieldNames <- c(self$allFieldNames_self, self$inheritNCinternals$allFieldNames)
109-
}
128+
} else {
129+
self$allMethodNames <- self$allMethodNames_self
130+
self$all_methodName_to_cpp_code_name <- self$orig_methodName_to_cpp_code_name
131+
self$allFieldNames <- self$allFieldNames_self
132+
self$symbolTable$setParentST(NULL)
133+
}
110134
self$process_inherit_done <- TRUE
111135
}
112136
)

‎nCompiler/R/NC_Utils.R‎

Lines changed: 90 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -103,4 +103,94 @@ NC_find_method <- function(NCgenerator, name, inherits=TRUE) {
103103
}
104104
}
105105
method
106+
}
107+
108+
# This function will be called from nCompile after going through the
109+
# NCinternals for all units and calling connect_inherit and then process_inherit
110+
# (with all connect_inherits called before all process_inherits)
111+
# At that point we are ready to check for disallowed method overloading
112+
# (we don't allow the same method name in different levels of the hierarchy unless it is virtual
113+
# and all signatures match, i.e. we don't allow C-style overloading because it wouldn't work in
114+
# uncompiled (R) execution. This can be changed by an option, indicating one wants only the
115+
# compiled behavior and doesn't care about uncompiled inconsistency.)
116+
# and disallowed duplicate member variable names (for a similar reason: In C++
117+
# different levels of a hierarchy could each have their own "x", but that is not
118+
# the case in an R6 class hierarchy, so we disallow it unless a user allows it by option).
119+
#
120+
# The previous calls will have initialized NCint$check_inherit_done to FALSE
121+
NC_check_inheritance <- function(NCgenerator) {
122+
allow_method_overloading <- isTRUE(get_nOption('allow_method_overloading'))
123+
allow_inherited_field_duplicates <- isTRUE(get_nOption('allow_inherited_field_duplicates'))
124+
if(allow_method_overloading && allow_inherited_field_duplicates) return(invisible(NULL))
125+
126+
if(!isNCgenerator(NCgenerator))
127+
stop("Input to NC_check_inheritance must be a nClass generator.")
128+
NCint <- NCinternals(NCgenerator)
129+
130+
if(is.null(NCint$inheritQ)) {
131+
NCint$check_inherit_done <- TRUE
132+
NCint$virtualMethodNames <- NCint$virtualMethodNames_self
133+
return(NCint$virtualMethodNames_self)
134+
}
135+
if(NCint$check_inherit_done) return(NCint$virtualMethodNames)
136+
# At this point, we have inheritance and have checked this NCgenerator yet.
137+
inheritNCinternals <- NCint$inheritNCinternals
138+
inheritNCgenerator <- eval(NCint$inheritQ, envir = NCint$env)
139+
# Recurse up the inheritance ladder
140+
# A design dilemma here was that the virtual marker is in the NFinternals,
141+
# which can be accessed from the NCgenerator but not the NCinternals.
142+
# That is why this function is not a method of NCinternals.
143+
inherit_virtualMethodNames <- NC_check_inheritance(inheritNCgenerator)
144+
new_virtualMethodNames <- character()
145+
146+
if(!allow_method_overloading) {
147+
local_virtualMethodNames <- NCint$virtualMethodNames_self
148+
# default: check for disallowed method overloading
149+
allMethodNames <- NCint$allMethodNames
150+
for(mN in allMethodNames) {
151+
# if a method is not in the self method names, it was inherited, so there is nothing to check
152+
if(!(mN %in% NCint$allMethodNames_self)) next
153+
if(!(mN %in% inheritNCinternals$allMethodNames)) {
154+
# current level is the first one with this method name, so here we tag its virtual status
155+
new_virtualMethodNames <- c(new_virtualMethodNames, mN)
156+
next
157+
}
158+
# At this point the current level has the method and it is inherited
159+
localMethod <- NCgenerator$public_methods[[mN]]
160+
inheritMethod <- NC_find_method(inheritNCgenerator, mN)
161+
if(is.null(inheritMethod))
162+
stop("Problem finding inherited method ", mN, " in NC_check_inheritance.", call. = FALSE)
163+
if(!NF_types_match(localMethod, inheritMethod))
164+
stop(paste0("Method ", mN, " does not have the same arguments names,",
165+
" and/or argument types, and/or returnType as a base class method of the same name.",
166+
" Methods of the same name in an nClass hierarchy must have all of these the same",
167+
" and the top-level one must be marked with compileInfo(virtual=TRUE).",
168+
" (If you want to allow method overloading in C++ by turning off these requirements,",
169+
" set nOptions(allow_method_overloading=TRUE)"),
170+
call. = FALSE)
171+
if(!(mN %in% inherit_virtualMethodNames))
172+
stop(paste0("Method ", mN, " is inherited, so",
173+
" it must be marked with compileInfo(virtual=TRUE) in the top-level nClass that includes it.",
174+
" That does not appear to be the case.",
175+
" (If you want to allow method over-loading in C++ by turning off this requirement,",
176+
" set nOptions(allow_method_overloading=TRUE)"),
177+
call. = FALSE)
178+
}
179+
}
180+
if(!allow_inherited_field_duplicates) {
181+
# This would be slightly more efficient to do in NC_InternalsClass::process_inherit
182+
# but we keep it here so all the checking is together here.
183+
#
184+
# If any of my own field names already existed from my inherited classes,
185+
# that's not allowed
186+
badFields <- NCint$allFieldNames_self %in% inheritNCinternals$allFieldNames
187+
if(any(badFields))
188+
stop(paste0("Problem with field(s): ", paste(NCint$allFieldNames_self[badFields], collapse = ", "),
189+
". Fields with the same name are not allowed in base and inherited classes.",
190+
" (If you want to allow local fields of the same name in C++ by turning off this requirement,",
191+
" set nOptions(allow_inherited_field_duplicates=TRUE)"),
192+
call. = FALSE )
193+
}
194+
NCint$check_inherit_done <- TRUE
195+
c(new_virtualMethodNames, inherit_virtualMethodNames)
106196
}

‎nCompiler/R/NF_CompilerClass.R‎

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -27,8 +27,7 @@ NF_CompilerClass <- R6::R6Class(
2727
derivsContent = list(),
2828
initialTypeInferenceDone = FALSE,
2929
initialize = function(f = NULL,
30-
## funName,
31-
# const = FALSE,
30+
name = NULL, # Allow an nClass to set the name of its method.
3231
useUniqueNameInCpp = FALSE,
3332
compileInfo = NULL) {
3433
self$auxEnv <- new.env()
@@ -45,9 +44,14 @@ NF_CompilerClass <- R6::R6Class(
4544
} else {
4645
self$NFinternals <- NFinternals(f)
4746
}
48-
self$origName <- NFinternals$uniqueName
49-
if (useUniqueNameInCpp) self$name <- NFinternals$uniqueName
50-
else self$name <- NFinternals$cpp_code_name
47+
self$origName <- NFinternals$uniqueName2
48+
if(!is.null(name)) {
49+
self$name <- name
50+
} else {
51+
if (useUniqueNameInCpp) self$name <- NFinternals$uniqueName2
52+
# NB If this is a method of a nClass, its cpp_code_name may be intercepted later but will not be changed here.
53+
else self$name <- NFinternals$cpp_code_name
54+
}
5155
self$origRcode <- NFinternals$code
5256
self$newRcode <- NFinternals$code
5357
self$isAD <- NFinternals$isAD

‎nCompiler/R/NF_InternalsClass.R‎

Lines changed: 36 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -12,8 +12,10 @@ NF_InternalsClass <- R6::R6Class(
1212
returnSym = NULL,
1313
control = list(),
1414
where = NULL,
15-
isMethod = FALSE,
15+
#isMethod = FALSE,
1616
uniqueName = character(),
17+
uniqueName2 = character(),
18+
#cpp_code_name = character(),
1719
cpp_code_name = character(),
1820
## template = NULL, replaced with default_matchDef
1921
default_matchDef = NULL,
@@ -46,9 +48,17 @@ NF_InternalsClass <- R6::R6Class(
4648
## setupVarNames = NULL, ## Ditto
4749
where = parent.frame()
4850
) {
51+
## name is required and is generated by NF() if not provided.
4952
## uniqueName is only needed if this is not a method of a nClass.
50-
if(!missing(name))
51-
self$uniqueName <- name
53+
if(!missing(name)) {
54+
self$uniqueName <- name
55+
self$uniqueName2 <- paste(name,
56+
nFunctionIDMaker(),
57+
sep = "_")
58+
} else {
59+
stop("NF_InternalsClass needs a name argument.", call. = FALSE)
60+
}
61+
## uniqueName2 is needed even for methods, to serve as unique keys.
5262
if(is.null(compileInfo$C_fun)) {
5363
fun_to_use <- fun
5464
} else {
@@ -85,8 +95,6 @@ NF_InternalsClass <- R6::R6Class(
8595
## e.g. 'print' to 'nPrint'; see 'nKeyWords' list in
8696
## changeKeywords.R
8797
self$code <- body(fun_to_use)
88-
if(isTRUE(control$changeKeywords))
89-
self$code <- nf_changeKeywords(self$code)
9098
if(code[[1]] != '{')
9199
self$code <- substitute({CODE}, list(CODE=code))
92100
## check all code except.nCompiler package nFunctions
@@ -115,17 +123,33 @@ NF_InternalsClass <- R6::R6Class(
115123
self$returnSym <- argType2symbol(returnTypeDecl,
116124
origName = "returnType",
117125
evalEnv = where)
126+
127+
# It is important to do this after getting the returnType info
128+
# because this will change integer to nInteger, even in returnType
129+
if(isTRUE(control$changeKeywords))
130+
self$code <- nf_changeKeywords(self$code)
131+
118132
## We set the cpp_code_name here so that other nFunctions
119133
## that call this one can determine, during compilation,
120-
## what this one's cpp function name will be:
121-
if(!is.null(compileInfo$cpp_code_name))
134+
## what this one's cpp function name will be.
135+
## However, if this nFunction is used as a method of a nClass,
136+
## and if that nClass inherits from another nClass and this
137+
## nFunction is actually virtual, then the base class's
138+
## cpp_code_name will be used instead.
139+
## However, we do not modify it in this NFinternals because
140+
## it is permitted to use this elsewhere, e.g. on its own
141+
## or to provide a method to a different nClass.
142+
if(!is.null(compileInfo$cpp_code_name)) {
143+
#self$cpp_code_name <- compileInfo$cpp_code_name
122144
self$cpp_code_name <- compileInfo$cpp_code_name
123-
else {
145+
} else {
146+
#self$cpp_code_name <- Rname2CppName(name)
124147
self$cpp_code_name <- Rname2CppName(name)
125-
if(isFALSE(predefined))
126-
self$cpp_code_name <- paste(self$cpp_code_name,
127-
nFunctionIDMaker(),
128-
sep = "_")
148+
# do not uniquify cpp_code_name
149+
# if(isFALSE(predefined))
150+
# self$cpp_code_name <- paste(self$cpp_code_name,
151+
# nFunctionIDMaker(),
152+
# sep = "_")
129153
}
130154
## Unpack enableDerivs into AD
131155
self$isAD <- FALSE

0 commit comments

Comments
 (0)