Add OpenMP parallel declarations and iterable handling

AGENTS.md

@@ -39,6 +39,11 @@ EOF
 
 - Prefer extending S7 classes with explicit properties over attaching arbitrary unchecked attributes.
 
+- README.md must only be generated by running:
+```sh
+R -q -e 'devtools::build_readme()'
+```
+
 - Before wrapping up, always run:
 ```sh
 air format .

NEWS.md

@@ -4,6 +4,12 @@
   available (e.g. `brew install flang`). This is optional and can be disabled
   with `options(quickr.prefer_flang = FALSE)`.
 
+- Added OpenMP parallelization via `declare(parallel())`/`declare(omp())` for
+  `for` loops and `sapply()` calls.
+
+- Added support for `abs()` in size expressions used by `declare(type(...))`
+  (e.g. `declare(type(x = integer(abs(end - start) + 1L)))`).
+
 - Improved `for (... in <iterable>)` lowering, including value iteration
   (`for (v in x)`) and support for `rev()` wrappers on supported iterables.
 

R/aaa-utils.R

@@ -119,10 +119,14 @@ drop_last <- function(x) x[-length(x)]
 
 compile_nonreturn_statements <- function(stmts, scope) {
   if (!length(stmts)) {
+    check_pending_parallel_consumed(scope)
     return("")
   }
 
-  compiled <- lapply(stmts, function(stmt) {
+  compiled <- vector("list", length(stmts))
+  for (i in seq_along(stmts)) {
+    stmt <- stmts[[i]]
+    check_pending_parallel_target(stmt, scope)
     stmt_f <- r2f(stmt, scope)
     if (!is.null(stmt_f@value)) {
       stop(
@@ -131,9 +135,10 @@ compile_nonreturn_statements <- function(stmts, scope) {
         call. = FALSE
       )
     }
-    stmt_f
-  })
+    compiled[[i]] <- stmt_f
+  }
 
+  check_pending_parallel_consumed(scope)
   str_flatten_lines(compiled)
 }
 # fmt: skip

R/c-wrapper.R

@@ -238,16 +238,28 @@ closure_arg_size_checks <- function(var, scope) {
       if (as.character(d) == size_name) {
         # self-named size_name is expected to be passed along to subroutine
         return()
+      }
+
+      d_name <- as.character(d)
+      d_var <- get0(d_name, scope)
+      if (inherits(d_var, Variable)) {
+        d_expr <- glue("Rf_asInteger({d_var@name})")
+        d_label <- d_name
+      } else if (is_size_name(d_name)) {
+        d_expr <- d_name
+        d_label <- as_friendly_size_name(d_name)
       } else {
-        # it's a constraint for another size
-        return(glue(
-          '
-            if ({d} != {size_name})
-              Rf_error("{as_friendly_size_name(size_name)} must equal {as_friendly_size_name(d)},"
-                       " but are %0.f and %0.f",
-                        (double){size_name}, (double){d});'
-        ))
+        d_expr <- d_name
+        d_label <- d_name
       }
+
+      return(glue(
+        '
+          if ({d_expr} != {size_name})
+            Rf_error("{as_friendly_size_name(size_name)} must equal {d_label},"
+                     " but are %0.f and %0.f",
+                      (double){size_name}, (double){d_expr});'
+      ))
     }
 
     if (is.call(d)) {
@@ -323,6 +335,9 @@ dims2c_eval_base_env[["*"]] <- function(e1, e2) glue("({e1} * {e2})")
 dims2c_eval_base_env[["/"]] <- function(e1, e2) {
   glue("((double)({e1}) / (double)({e2}))")
 }
+dims2c_eval_base_env[["abs"]] <- function(e1) {
+  glue("(({e1}) < 0 ? -({e1}) : ({e1}))")
+}
 # dividing integers truncates towards 0
 dims2c_eval_base_env[["%/%"]] <- function(e1, e2) {
   glue("((R_xlen_t){e1} / (R_xlen_t){e2})")

R/classes.R

@@ -292,6 +292,8 @@ Variable := new_class(
 
     modified = prop_bool(default = FALSE),
 
+    loop_is_singleton = prop_bool(default = FALSE),
+
     r = new_property(
       NULL | class_language | class_atomic,
       setter = function(self, value) {

R/compiler.R

@@ -93,47 +93,68 @@ quickr_fcompiler_env <- function(
   prefer_flang_force = isTRUE(getOption("quickr.prefer_flang_force")) ||
     quickr_env_is_true("QUICKR_PREFER_FLANG"),
   write_lines = writeLines,
-  sysname = Sys.info()[["sysname"]]
+  sysname = Sys.info()[["sysname"]],
+  use_openmp = FALSE
 ) {
   stopifnot(is.character(build_dir), length(build_dir) == 1L, nzchar(build_dir))
 
-  if (!isTRUE(prefer_flang)) {
-    return(character())
-  }
-  flang <- quickr_flang_path(which = which)
-  if (!nzchar(flang)) {
-    return(character())
-  }
+  use_openmp <- isTRUE(use_openmp)
 
-  flang_runtime <- if (sysname == "Darwin") {
-    quickr_flang_runtime_flags(flang = flang, sysname = sysname)
-  } else {
-    character()
+  flang <- ""
+  flang_runtime <- character()
+  use_flang <- isTRUE(prefer_flang)
+  if (use_flang) {
+    flang <- quickr_flang_path(which = which)
+    if (!nzchar(flang)) {
+      use_flang <- FALSE
+    }
   }
-  if (sysname == "Darwin" && !length(flang_runtime)) {
-    if (isTRUE(prefer_flang_force)) {
-      stop(
-        "quickr was configured to use flang (",
-        flang,
-        ") but could not locate the flang runtime library (libflang_rt.runtime.dylib) to link against.\n",
-        "Either reinstall flang so the runtime is available, or disable flang selection with:\n",
-        "  options(quickr.prefer_flang = FALSE)\n",
-        "or:\n",
-        "  Sys.setenv(QUICKR_PREFER_FLANG = 0)\n"
-      )
+  if (use_openmp && use_flang && !isTRUE(prefer_flang_force)) {
+    use_flang <- FALSE
+    flang <- ""
+  }
+  if (use_flang) {
+    flang_runtime <- if (sysname == "Darwin") {
+      quickr_flang_runtime_flags(flang = flang, sysname = sysname)
+    } else {
+      character()
     }
+    if (sysname == "Darwin" && !length(flang_runtime)) {
+      if (isTRUE(prefer_flang_force)) {
+        stop(
+          "quickr was configured to use flang (",
+          flang,
+          ") but could not locate the flang runtime library (libflang_rt.runtime.dylib) to link against.\n",
+          "Either reinstall flang so the runtime is available, or disable flang selection with:\n",
+          "  options(quickr.prefer_flang = FALSE)\n",
+          "or:\n",
+          "  Sys.setenv(QUICKR_PREFER_FLANG = 0)\n"
+        )
+      }
+      use_flang <- FALSE
+      flang_runtime <- character()
+    }
+  }
+
+  if (!use_flang && !use_openmp) {
     return(character())
   }
 
   makevars_path <- file.path(build_dir, "Makevars.quickr")
+  makevars_lines <- c(
+    if (use_flang) {
+      c(
+        sprintf("FC=%s", flang),
+        sprintf("F77=%s", flang),
+        if (length(flang_runtime)) {
+          paste(c("FLIBS +=", flang_runtime), collapse = " ")
+        }
+      )
+    },
+    if (use_openmp) openmp_makevars_lines()
+  )
   write_lines(
-    c(
-      sprintf("FC=%s", flang),
-      sprintf("F77=%s", flang),
-      if (length(flang_runtime)) {
-        paste(c("FLIBS +=", flang_runtime), collapse = " ")
-      }
-    ),
+    makevars_lines,
     makevars_path
   )
   sprintf("R_MAKEVARS_USER=%s", makevars_path)

R/declare.R

@@ -7,6 +7,17 @@
 #' `declare()` is provided by the base package starting in R 4.4.0; for older
 #' versions of R, quickr exports a compatible backport.
 #'
+#' `declare(parallel())` or `declare(omp())` applies an OpenMP `parallel do`
+#' directive to the next `for` loop or `sapply()` assignment. `for` loops can
+#' iterate values over symbols or index iterables (`1:n`, `seq_len()`,
+#' `seq_along()`, `seq()`), and `sapply()` iterates over vector inputs with a
+#' known length.
+#'
+#' Control the number of OpenMP threads using environment variables such as
+#' `OMP_NUM_THREADS` (threads per region), `OMP_THREAD_LIMIT` (global cap),
+#' and `OMP_DYNAMIC` (disable/enable runtime adjustment). Set them before
+#' calling a compiled function, e.g. `Sys.setenv(OMP_NUM_THREADS = "4")`.
+#'
 #' @param ... Declarations, typically calls like `type(x = double(n))`.
 #' @returns `NULL`, invisibly.
 #' @rawNamespace if (getRversion() < "4.4.0") export(declare)

R/manifest.R

@@ -314,6 +314,7 @@ dims2f_eval_base_env[["%%"]] <- function(e1, e2) {
   glue("mod(int({e1}), int({e2}))")
 }
 dims2f_eval_base_env[["^"]] <- function(e1, e2) glue("({e1})**({e2})")
+dims2f_eval_base_env[["abs"]] <- function(x) glue("abs({x})")
 dims2f_eval_base_env[["length"]] <- function(x) {
   if (is.symbol(x)) {
     glue("size({as.character(x)})")