Skip to content

Commit 42f026e

Browse files
perrydvperrydv
committed
Establish cachedOpInfo in code$auxEnv so that user-defined opDefs can occur at various levels.
1 parent 3f640cc commit 42f026e

10 files changed

Lines changed: 263 additions & 192 deletions

‎nCompiler/R/NF_InternalsClass.R‎

Lines changed: 3 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,8 @@ NF_InternalsClass <- R6::R6Class(
1515
isMethod = FALSE,
1616
uniqueName = character(),
1717
cpp_code_name = character(),
18-
## template = NULL, replaced with compileInfo$matchDef
18+
## template = NULL, replaced with default_matchDef
19+
default_matchDef = NULL,
1920
code = NULL,
2021
RcppPacket = NULL,
2122
Rwrapper = NULL,
@@ -96,13 +97,7 @@ NF_InternalsClass <- R6::R6Class(
9697
## in the "decoration" system. They could be put in "value" argument.
9798
## Either a named "value" or a ... is in all types.
9899

99-
## not used until much later
100-
if(is.null(self$compileInfo$opDef))
101-
self$compileInfo$opDef <- list()
102-
if(is.null(self$compileInfo$opDef$matchDef)) {
103-
self$compileInfo$opDef$matchDef <- Rarguments_2_function(arguments, body = quote({}))
104-
}
105-
# self$template <- Rarguments_2_function(arguments, body = quote({})) ## generateTemplate()
100+
self$default_matchDef <- Rarguments_2_function(arguments, body = quote({})) ## generateTemplate()
106101
returnTypeInfo <- nf_extractReturnType(code)
107102
returnTypeDecl <- returnTypeInfo$returnType
108103
if(is.null(returnTypeDecl)) {

‎nCompiler/R/NF_Utils.R‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -50,8 +50,9 @@ nGet <- function(name, where) {
5050
## switch where to be the generator's parent_env
5151
where <- where$parent_env
5252
}
53-
if(exists(name, envir = where, inherits = TRUE))
54-
get(name, envir = where, inherits = TRUE)
55-
else
56-
NULL
53+
get0(name, envir = where)
54+
# if(exists(name, envir = where, inherits = TRUE))
55+
# get(name, envir = where, inherits = TRUE)
56+
# else
57+
# NULL
5758
}

‎nCompiler/R/compile_aaa_operatorLists.R‎

Lines changed: 24 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -94,12 +94,19 @@ updateOperatorDef <- function(ops, field, subfield = NULL, val) {
9494
}
9595
}
9696

97+
getOperatorField <- function(opDef, field = NULL, subfield = NULL) {
98+
if (is.null(opDef)) return(NULL)
99+
if (is.null(field)) return(opDef)
100+
if (is.null(opDef[[field]])) return(NULL)
101+
if (is.null(subfield)) return(opDef[[field]])
102+
opDef[[field]][[subfield]]
103+
}
104+
97105
getOperatorDef <- function(op, field = NULL, subfield = NULL) {
98-
opInfo <- get0(op, envir=operatorDefUserEnv)
99-
# opInfo <- operatorDefEnv[[op]]
100-
if (is.null(opInfo) || is.null(field)) return(opInfo)
101-
if (is.null(opInfo[[field]]) || is.null(subfield)) return(opInfo[[field]])
102-
return(opInfo[[field]][[subfield]])
106+
opDef <- get0(op, envir=operatorDefUserEnv)
107+
# opDef <- operatorDefEnv[[op]]
108+
if(is.null(opDef)) return(NULL)
109+
getOperatorField(opDef, field, subfield)
103110
}
104111

105112
assignOperatorDef(
@@ -122,7 +129,7 @@ assignOperatorDef(
122129
)
123130

124131
assignOperatorDef(
125-
'NFCALL_', # This is used for non-method nFunctions in normalizeCalls and for any (including method) nFunctions after normalizeCalls
132+
'nFunction_default', # This is used for non-method nFunctions in normalizeCalls and for any (including method) nFunctions after normalizeCalls
126133
list(
127134
labelAbstractTypes = list(
128135
handler = 'nFunction_or_method_call'),
@@ -133,17 +140,17 @@ assignOperatorDef(
133140
)
134141
)
135142

136-
assignOperatorDef(
137-
'NCMETHOD_', # This is a transient label that only exists within normalizeCalls
138-
list(
139-
## labelAbstractTypes = list(
140-
## handler = 'nFunction_or_method_call'),
141-
normalizeCalls = list(
142-
handler = 'nFunction_or_method_call')#, # becomes NFCALL_
143-
## cppOutput = list(
144-
## handler = 'Generic_nFunction')
145-
)
146-
)
143+
# assignOperatorDef(
144+
# 'NCMETHOD_', # This is a transient label that only exists within normalizeCalls
145+
# list(
146+
# ## labelAbstractTypes = list(
147+
# ## handler = 'nFunction_or_method_call'),
148+
# normalizeCalls = list(
149+
# handler = 'nFunction_or_method_call')#, # becomes NFCALL_
150+
# ## cppOutput = list(
151+
# ## handler = 'Generic_nFunction')
152+
# )
153+
# )
147154

148155
assignOperatorDef(
149156
c('dim'),

‎nCompiler/R/compile_eigenization.R‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,9 @@ compile_eigenize <- function(code,
7373
return(invisible(NULL))
7474
}
7575

76-
handlingInfo <- getOperatorDef(code$name, "eigenImpl")
76+
opInfo <- check_cachedOpInfo(code, where=auxEnv$where, update=TRUE)
77+
handlingInfo <- getOperatorField(opInfo$opDef, "eigenImpl")
78+
# handlingInfo <- getOperatorDef(code$name, "eigenImpl")
7779
# operatorDefEnv[[code$name]]
7880
# if(!is.null(opInfo)) {
7981
# handlingInfo <- opInfo[["eigenImpl"]]

‎nCompiler/R/compile_generateCpp.R‎

Lines changed: 14 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -85,7 +85,18 @@ compile_generateCpp <- function(code,
8585
ans[[length(code$args) + 2]] <- paste0(indent, '}')
8686
return(ans)
8787
}
88-
handler <- getOperatorDef(code$name, "cppOutput", "handler")
88+
# All calls must have valid opInfo or be a core DSL operator
89+
# This compiler stage is called from cppDefs' generate() methods,
90+
# so where$auxEnv is not available.
91+
# This means that any penultimate compiler stages that changed the
92+
# call name to something non-core (and hence potentially the handler)
93+
# must update the cachedOpInfo.
94+
# or we must add a final pass to do so.
95+
# An example is changes made in eigenization, such as inserting `index[`.
96+
# This is a core operator so it will be found in the check_cachedOpInfo with update=TRUE.
97+
opInfo <- check_cachedOpInfo(code, where=baseenv(), update=TRUE, allowFail = TRUE)
98+
handler <- getOperatorField(opInfo$opDef, "cppOutput", "handler")
99+
# handler <- getOperatorDef(code$name, "cppOutput", "handler")
89100
# opInfo <- operatorDefEnv[[code$name]]
90101
# if(!is.null(opInfo)) {
91102
# handlingInfo <- opInfo[["cppOutput"]]
@@ -165,10 +176,9 @@ inGenCppEnv(
165176

166177
inGenCppEnv(
167178
Generic_nFunction <- function(code, symTab) {
168-
innerCode <- code$args[['call']]
169-
cpp_code_name <- code$aux$cpp_code_name
179+
cpp_code_name <- code$aux$cachedOpInfo$obj_internals$cpp_code_name
170180
paste0(cpp_code_name,
171-
'(', paste0(unlist(lapply(innerCode$args,
181+
'(', paste0(unlist(lapply(code$args,
172182
compile_generateCpp,
173183
symTab,
174184
asArg = TRUE) ),

‎nCompiler/R/compile_labelAbstractTypes.R‎

Lines changed: 8 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -100,7 +100,10 @@ compile_labelAbstractTypes <- function(code,
100100
return(invisible(NULL))
101101
}
102102

103-
handlingInfo <- getOperatorDef(code$name, "labelAbstractTypes")
103+
opInfo <- check_cachedOpInfo(code, where=auxEnv$where, update=TRUE)
104+
handlingInfo <- getOperatorField(opInfo$opDef, "labelAbstractTypes")
105+
106+
# handlingInfo <- getOperatorDef(code$name, "labelAbstractTypes")
104107
# opInfo <- operatorDefEnv[[code$name]]
105108
# if(!is.null(opInfo)) {
106109
# handlingInfo <- opInfo[["labelAbstractTypes"]]
@@ -406,24 +409,11 @@ inLabelAbstractTypesEnv(
406409
inLabelAbstractTypesEnv(
407410
nFunction_or_method_call <-
408411
function(code, symTab, auxEnv, handlingInfo) {
409-
# We have code = NFCALL_(foo(x, y))
410-
# innerCall if foo(x,y)
411-
# We'll set innerCall$type to symbolNF
412-
# and we'll set code$type to the returnType of foo(x, y)
413-
innerCall <- code$args[['call']]
414-
if(is.null(innerCall))
415-
stop(
416-
exprClassProcessingErrorMsg(
417-
code, paste('In nFunction_or_method_call: the nFunction (or method) ',
418-
code$name,
419-
' has NULL content.')
420-
), call. = FALSE
421-
)
422-
inserts <- recurse_labelAbstractTypes(innerCall, symTab, auxEnv,
412+
inserts <- recurse_labelAbstractTypes(code, symTab, auxEnv,
423413
handlingInfo)
424-
obj_internals <- code$aux$obj_internals
425-
nFunctionName <- code$aux$nFunctionName
426-
innerCall$type <- symbolNF$new(name = nFunctionName)
414+
obj_internals <- code$aux$cachedOpInfo$obj_internals
415+
# nFunctionName <- obj_internals$nFunctionName
416+
# code$aux$symbolNF <- symbolNF$new(name = nFunctionName)
427417
returnSym <- obj_internals$returnSym
428418
if(is.null(returnSym))
429419
stop(
@@ -435,24 +425,6 @@ inLabelAbstractTypesEnv(
435425
)
436426
code$type <- returnSym$clone() ## Not sure if a clone is needed, but it seems safer to make one.
437427
inserts
438-
439-
# useArgs <- c(FALSE, rep(TRUE, length(code$args)-1))
440-
# inserts <- recurse_labelAbstractTypes(code, symTab, auxEnv,
441-
# handlingInfo, useArgs)
442-
# obj_internals <- code$args[[1]]$aux$obj_internals
443-
# nFunctionName <- code$args[[1]]$aux$nFunctionName
444-
# code$args[[1]]$type <- symbolNF$new(name = nFunctionName)
445-
# returnSym <- obj_internals$returnSym
446-
# if(is.null(returnSym))
447-
# stop(
448-
# exprClassProcessingErrorMsg(
449-
# code, paste('In nFunction_or_method_call: the nFunction (or method) ',
450-
# code$name,
451-
# ' does not have a valid returnType.')
452-
# ), call. = FALSE
453-
# )
454-
# code$type <- returnSym$clone() ## Not sure if a clone is needed, but it seems safer to make one.
455-
# invisible(NULL)
456428
}
457429
)
458430

0 commit comments

Comments
 (0)