Add private variables to openMP loops

R/parallel.R

@@ -87,14 +87,44 @@ is_parallel_decl_call <- function(e) {
 parse_parallel_decl <- function(e) {
   stopifnot(is_parallel_decl_call(e))
   args <- as.list(e)[-1L]
-  if (length(args)) {
-    stop(
-      as.character(e[[1L]]),
-      "() does not accept arguments yet.",
-      call. = FALSE
-    )
+  arg_names <- names(args) %||% rep("", length(args))
+
+  private <- NULL
+  for (i in seq_along(args)) {
+    nm <- arg_names[i]
+    val <- args[[i]]
+    if (nm == "private") {
+      if (is_call(val, quote(c))) {
+        elems <- as.list(val)[-1L]
+        if (!all(vapply(elems, is.symbol, logical(1L)))) {
+          stop(
+            "private must be a symbol or c() of symbols, got: ",
+            deparse(val),
+            call. = FALSE
+          )
+        }
+        private <- vapply(elems, as.character, character(1L))
+      } else if (is.symbol(val)) {
+        private <- as.character(val)
+      } else {
+        stop(
+          "private must be a symbol or c() of symbols, got: ",
+          deparse(val),
+          call. = FALSE
+        )
+      }
+    } else {
+      stop(
+        "unknown argument to ",
+        as.character(e[[1L]]),
+        "(): ",
+        if (nzchar(nm)) nm else deparse(val),
+        call. = FALSE
+      )
+    }
   }
-  list(backend = "omp", source = as.character(e[[1L]]))
+
+  list(backend = "omp", source = as.character(e[[1L]]), private = private)
 }
 
 unwrap_parens <- function(x) {
@@ -193,6 +223,31 @@ openmp_config_value <- local({
   }
 })
 
+validate_parallel_private <- function(private, scope) {
+  if (is.null(private) || !length(private)) {
+    return(invisible(TRUE))
+  }
+  stopifnot(inherits(scope, "quickr_scope"))
+  private <- unique(as.character(private))
+  unknown <- private[
+    !vapply(
+      private,
+      function(name) inherits(get0(name, scope), Variable),
+      logical(1L)
+    )
+  ]
+  if (length(unknown)) {
+    stop(
+      "could not resolve private symbol",
+      if (length(unknown) > 1L) "s" else "",
+      ": ",
+      str_flatten_commas(unknown),
+      call. = FALSE
+    )
+  }
+  invisible(TRUE)
+}
+
 openmp_fflags <- function() {
   env_flags <- trimws(Sys.getenv("QUICKR_OPENMP_FFLAGS", ""))
   if (nzchar(env_flags)) {

R/r2f-control-flow.R

@@ -175,6 +175,9 @@ r2f_handlers[["for"]] <- function(args, scope, ...) {
     }
     body <- r2f(body, scope, ...)
     check_pending_parallel_consumed(scope)
+    if (!is.null(parallel)) {
+      validate_parallel_private(parallel$private, scope)
+    }
     loop_stmts <- str_flatten_lines(glue("{var_name} = {element_expr}"), body)
 
     loop_header <- if (iterable_reversed) {
@@ -183,7 +186,15 @@ r2f_handlers[["for"]] <- function(args, scope, ...) {
       glue("do {idx@name} = 1_c_int, {end}")
     }
 
-    directives <- openmp_directives(parallel, private = var_name)
+    extra_private <- vapply(
+      parallel$private %||% character(),
+      fortranize_name,
+      character(1L)
+    )
+    directives <- openmp_directives(
+      parallel,
+      private = c(var_name, extra_private)
+    )
     if (!is.null(parallel)) {
       mark_openmp_used(scope)
     }
@@ -220,8 +231,16 @@ r2f_handlers[["for"]] <- function(args, scope, ...) {
   }
   body <- r2f(body, scope, ...)
   check_pending_parallel_consumed(scope)
+  if (!is.null(parallel)) {
+    validate_parallel_private(parallel$private, scope)
+  }
 
-  directives <- openmp_directives(parallel)
+  extra_private <- vapply(
+    parallel$private %||% character(),
+    fortranize_name,
+    character(1L)
+  )
+  directives <- openmp_directives(parallel, private = extra_private)
   if (!is.null(parallel)) {
     mark_openmp_used(scope)
   }

tests/testthat/test-openmp-parallelization.R

@@ -72,7 +72,7 @@ test_that("parallel loop uses multiple threads", {
       type(iters = integer(1)),
       type(out = double(n))
     )
-    declare(parallel())
+    declare(parallel(private = c(v, k)))
     for (i in seq_len(n)) {
       v <- x[i]
       for (k in seq_len(iters)) {

tests/testthat/test-openmp-utils.R

@@ -72,14 +72,120 @@ test_that("take_pending_parallel returns NULL for NULL or non-scope", {
   expect_null(quickr:::take_pending_parallel(list()))
 })
 
-test_that("parse_parallel_decl errors when arguments provided", {
+test_that("parse_parallel_decl errors on unknown arguments", {
   e <- quote(parallel(foo))
   expect_error(
     quickr:::parse_parallel_decl(e),
-    "does not accept arguments"
+    "unknown argument to parallel"
   )
 })
 
+test_that("parse_parallel_decl parses private argument", {
+  e <- quote(parallel(private = c(x, y)))
+  result <- quickr:::parse_parallel_decl(e)
+  expect_equal(result$backend, "omp")
+  expect_equal(result$private, c("x", "y"))
+
+  # Single symbol
+  e2 <- quote(parallel(private = z))
+  result2 <- quickr:::parse_parallel_decl(e2)
+  expect_equal(result2$private, "z")
+})
+
+test_that("parse_parallel_decl errors on invalid private values", {
+  expect_error(
+    quickr:::parse_parallel_decl(quote(parallel(private = 1))),
+    "private must be a symbol or c\\(\\) of symbols"
+  )
+
+  expect_error(
+    quickr:::parse_parallel_decl(quote(parallel(private = c(x, 1)))),
+    "private must be a symbol or c\\(\\) of symbols"
+  )
+})
+
+test_that("parallel private validates declared symbols (rolling mean)", {
+  fn <- function(x, window) {
+    declare(
+      type(x = double(n)),
+      type(window = double(j))
+    )
+
+    out <- double(length(x) - length(window) + 1)
+
+    window_size <- as.double(length(window))
+
+    declare(parallel(private = c(acc, j)))
+    for (i in seq_along(out)) {
+      acc <- 0
+      for (j in seq_along(window)) {
+        acc <- acc + x[(i + j - 1)] * window[j]
+      }
+      out[i] <- acc * window_size
+    }
+    out
+  }
+
+  skip_if_no_openmp()
+  expect_quick_identical(
+    fn,
+    list(x = as.double(1:10), window = as.double(1:3))
+  )
+})
+
+test_that("parallel private errors on undeclared symbols (rolling mean)", {
+  fn <- function(x, window) {
+    declare(
+      type(x = double(n)),
+      type(window = double(j))
+    )
+
+    out <- double(length(x) - length(window) + 1)
+
+    window_size <- as.double(length(window))
+
+    declare(parallel(private = c(qwerty, j)))
+    for (i in seq_along(out)) {
+      acc <- 0
+      for (j in seq_along(window)) {
+        acc <- acc + x[(i + j - 1)] * window[j]
+      }
+      out[i] <- acc * window_size
+    }
+    out
+  }
+
+  expect_error(
+    r2f(fn),
+    "could not resolve private symbol"
+  )
+})
+
+test_that("parallel private ignores scalars assigned inside loop", {
+  fn <- function(x, window) {
+    declare(
+      type(x = double(n)),
+      type(window = double(j))
+    )
+
+    out <- double(length(x) - length(window) + 1)
+
+    window_size <- as.double(length(window))
+
+    declare(parallel(private = j))
+    for (i in seq_along(out)) {
+      acc <- 0
+      for (j in seq_along(window)) {
+        acc <- acc + x[(i + j - 1)] * window[j]
+      }
+      out[i] <- acc * window_size
+    }
+    out
+  }
+
+  expect_no_error(r2f(fn))
+})
+
 test_that("is_parallel_target_stmt handles edge cases", {
   # non-call