extensive update to TBB functionality to extend/fix (replaces PR #171)

nCompiler/R/Rexecution.R

@@ -14,6 +14,18 @@ parallel_for <- function(index, range, body, ...) {
 
 #' @export
 parallel_reduce <- function(f, x, init, ...) {
+  if(is.character(f)) {  # Not clear how to convert to char ...
+    operatorDef <- operatorDefEnv[[f]]
+    if(!is.null(operatorDef) && is.null(operatorDef$reduction))
+        stop("`", f, "` is not a valid reduction function/operator")
+  }
+  if(missing(init)) {
+    if(!is.character(f) || is.null(operatorDef) || is.null(operatorDef$reduction))
+      stop("`init` argument is missing and no default value provided for reduction function/operator")
+    init <- operatorDef$reduction
+  }
+  if(identical(f, "pairmin")) f <- "pmin"
+  if(identical(f, "pairmax")) f <- "pmax"
   Reduce(f, x, init)
 }
 
@@ -406,18 +418,18 @@ nRep <- function(x, ...) {
 }
 
 #' Sequence Generation
-#'
+#' 
 #' In a \code{nFunction}, \code{nSeq} is (mostly) equivalent to \code{base::seq}
 #'
-#' @details This function is similar to R's \code{\link{seq}} function, but
-#'   can be used in a nFunction and compiled using \code{nCompile}.
-#'
+#' @details This function is similar to R's \code{\link{seq}} function, but 
+#'   can be used in a nFunction and compiled using \code{nCompile}.  
+#' 
 #' @param from the starting value of the sequence.
-#'
+#' 
 #' @param to the ending value of the sequence.
-#'
+#' 
 #' @param by increment of the sequence
-#'
+#' 
 #' @param length.out desired length of the sequence
 #'
 #' @details
@@ -428,7 +440,6 @@ nRep <- function(x, ...) {
 #' There are no nCompiler versions of \code{seq.int}, \code{seq_along} or \code{seq_len}.
 
 #' @export
-#'
 nSeq <- function(...) {
   base::seq(...)
 }
@@ -513,6 +524,6 @@ nVar <- function(x) {
 #' Wrapper for sd
 #'
 #' @export
-nSd <- function(x) {
-  sd(x)
+nSd <- function(x) { 
+  sd(x) 
 }

nCompiler/R/compile_aaa_operatorLists.R

@@ -12,6 +12,8 @@ returnTypeCodes <- list(
   promoteToDoubleOrAD = 6L,
   promoteNoLogical = 7L)
 
+liftedBlockOperatorsArg <- c("parallel_for" = 3, "parallel_reduce" = 1) # These are used for flagging when methods in lifted code block will need to have their object reference them explicitly via `obj__.<methodname>`. The values are the argID where the method needs to occur.
+
 returnTypeString2Code <- function(returnTypeString) {
   if(is.character(returnTypeString))
     do.call('switch', c(list("double"), returnTypeCodes))
@@ -162,6 +164,16 @@ assignOperatorDef(
   )
 )
 
+assignOperatorDef(
+  'nClass_method_in_lifted', # This is used for local method calls in the body of lifted code blocks (currently `parallel_{for,reduce}`).
+  list(
+    labelAbstractTypes = list(
+      handler = 'nFunction_or_method_call'),
+    cppOutput = list(
+      handler = 'nClass_method_in_lifted')
+  )
+)
+
 assignOperatorDef(
   'custom_default',
   list(
@@ -238,6 +250,10 @@ updateOperatorDef(
   c('nMatrix', 'nArray'),
   'labelAbstractTypes', 'returnTypeCode', returnTypeCodes$promote
 )
+updateOperatorDef(
+  'nMatrix',
+  'matchDef', val = function(value = 0, nrow = NA, ncol = NA, init = TRUE, fillZeros = TRUE, recycle = TRUE, type = 'double') {}
+)
 
 assignOperatorDef(
   'type_is',
@@ -301,20 +317,26 @@ assignOperatorDef(
 assignOperatorDef(
   c('parallel_for'),
   list(
+    matchDef = function(index, range, body, copyVars, shareVars, nThreads=0) {},
     labelAbstractTypes = list(
       handler = 'ParallelFor'),
     finalTransformations = list(
-      handler = "ParallelFor") ## Creates GeneralFor in the parallel_loop_body class
+      handler = "ParallelFor"), ## Creates GeneralFor in the parallel_loop_body class
+    cppOutput = list(
+      handler = 'ParallelExpr')  
   )
 )
 
 assignOperatorDef(
   c('parallel_reduce'),
-  list(
+  list(  
+    matchDef = function(operator, object, init, nThreads=0) {},
     labelAbstractTypes = list(
       handler = 'ParallelReduce'),
     finalTransformations = list(
-      handler = 'ParallelReduce')
+      handler = 'ParallelReduce'),
+    cppOutput = list(
+      handler = 'ParallelExpr')      
   )
 )
 
@@ -554,9 +576,11 @@ assignOperatorDef(
           )
         ),
         cppOutput = list(
-          handler = 'BinaryOrUnary')
+          handler = 'BinaryOrUnary'),
+        reduction = 0
     )
 )
+updateOperatorDef('-', 'reduction', val = NULL)
 
 assignOperatorDef(
   c('inprod'),
@@ -603,11 +627,13 @@ assignOperatorDef(
     labelAbstractTypes = list(
         handler = 'BinaryCwise',
         returnTypeCode = returnTypeCodes$promoteNoLogical),
-    cppOutput = list()
+    cppOutput = list(),
+    reduction = Inf
   )
 )
 updateOperatorDef('pairmax', 'cppOutput', 'cppString', 'std::max')
 updateOperatorDef('pairmin', 'cppOutput', 'cppString', 'std::min')
+updateOperatorDef('pairmax', 'reduction', val = -Inf)
 
 assignOperatorDef(
   c('pmin', 'pmax'),
@@ -984,7 +1010,8 @@ assignOperatorDef(
       )
     ),
     cppOutput = list(
-      handler = 'MidOperator')
+      handler = 'MidOperator'),
+    reduction = 1
   )
 )
 

nCompiler/R/compile_eigenization.R

@@ -5,7 +5,8 @@
 eigenizeUseArgs <- c(
     list(
         setWhich = c(FALSE, TRUE),
-        setRepVectorTimes = c(FALSE, TRUE, TRUE)
+        setRepVectorTimes = c(FALSE, TRUE, TRUE),
+        parallel_reduce = c(FALSE, TRUE, TRUE)
         ))
 
 eigenizeEnv <- new.env()

nCompiler/R/compile_exprClass.R

@@ -218,6 +218,7 @@ wrapExprClassOperator <- function(code, funName, isName = FALSE, isCall = TRUE,
   newExpr
 }
 
+
 insertIndexingBracket <- function(code, argID, index) {
   insertExprClassLayer(code, argID, 'index[')
   setArg(code$args[[argID]], 2, index)