Clean up generated code: scalar-matrix broadcast, literal hoists, trailing whitespace

Three deferred micro-cleanups, held out of the op-table refactor's
zero-snapshot-drift gate:

- matrix(scalar, m, n) as an elementwise operand against a genuine
  rank-2 array now compiles to its scalar (native Fortran broadcast)
  instead of materializing an O(m*n) temporary; the claimed dims are
  still enforced -- compile error when statically wrong, runtime guard
  spelled from the dim expressions when symbolic. All other contexts
  keep the materialization paths, so no scalar with claimed array dims
  escapes.
- hoist_unless_name() leaves literal constants alone (splicing a
  literal has no side effects), retiring runif()'s caller-side
  is.atomic() workaround and the temporaries floor()/ceiling()/%/%
  spent on constants.
- The extern C signature joined newline-prefixed argument lines with
  ', ', leaving a trailing space on every line; it joins with a bare
  comma now. A test helper cat()-ing a space before newline is fixed
  the same way; the unused str_flatten_args() helper is deleted.

Snapshot churn is mechanical: extern signatures lose their trailing
space, two bind messages lose theirs. git diff --check is clean.

Author: mns-nordicals

R/aaa-utils.R

@@ -274,16 +274,6 @@ str_flatten_commas <- function(...) {
   paste0(unlist(c(character(), ...), use.names = FALSE), collapse = ", ")
 }
 
-str_flatten_args <- function(..., multiline = length(dots) >= 3) {
-  dots <- unlist(c(character(), ...), use.names = FALSE)
-  if (multiline) {
-    dots <- paste0("\n  ", dots, collapse = ",")
-    paste(dots, "\n")
-  } else {
-    paste0(dots, collapse = ",")
-  }
-}
-
 interleave <- function(x, y) {
   stopifnot(is.atomic(x), is.atomic(y), length(y) == 1L, typeof(x) == typeof(y))
   drop_last(as.vector(rbind(x, y, deparse.level = 0L)))

R/c-wrapper.R

@@ -800,9 +800,13 @@ fsub_extern_decl <- function(fsub) {
       glue("{fsub_arg_var_c_type(var)} {var@name}__")
     }
   })
-  if (length(fsub_c_sig) >= 3L) {
-    fsub_c_sig <- paste0("\n  ", fsub_c_sig)
+  args_sig <- if (length(fsub_c_sig) >= 3L) {
+    # one arg per line; join with a bare comma -- joining "\n  "-prefixed
+    # elements with ", " leaves a trailing space on every line
+    paste0("\n  ", fsub_c_sig, collapse = ",")
+  } else {
+    str_flatten_commas(fsub_c_sig)
   }
 
-  glue("extern void {fsub@name}({str_flatten_commas(fsub_c_sig)});")
+  glue("extern void {fsub@name}({args_sig});")
 }

R/r2f-aab-core.R

@@ -77,16 +77,20 @@ new_hoist <- function(scope) {
 }
 
 # Hoist `x` into a temporary variable unless it already renders as a bare
-# variable name. Use this whenever the same operand is spliced into generated
-# code more than once: Fortran evaluates intrinsic actual arguments before the
-# call, so repeating an expression duplicates its side effects (e.g. RNG
-# state via runif()).
+# variable name or a literal constant. Use this whenever the same operand is
+# spliced into generated code more than once: Fortran evaluates intrinsic
+# actual arguments before the call, so repeating an expression duplicates
+# its side effects (e.g. RNG state via runif()) -- which names and literals
+# don't have.
 hoist_unless_name <- function(x, hoist) {
   stopifnot(inherits(x, Fortran), inherits(x@value, Variable))
   code <- trimws(as.character(x))
   if (!is.null(x@value@name) && identical(code, x@value@name)) {
     return(x)
   }
+  if (grepl("^-?[0-9]+(\\.[0-9]+)?(_c_(int|double))?$", code)) {
+    return(x)
+  }
   tmp <- hoist$declare_tmp(
     mode = x@value@mode,
     dims = x@value@dims,

R/r2f-operators.R

@@ -119,6 +119,93 @@ cast_binop_operands <- function(spec, op, left, right) {
   )
 }
 
+# Match `matrix(<scalar>, nrow, ncol)`: data a length-1 literal or a
+# declared scalar, no byrow/dimnames. Returns the matched arguments or
+# NULL. Used by compile_binop_operands() to lower the fill to a native
+# scalar broadcast instead of the O(nrow * ncol) temporary the matrix()
+# handler would otherwise materialize.
+matrix_scalar_fill_args <- function(e, scope) {
+  if (!is.call(e) || !identical(e[[1L]], quote(matrix))) {
+    return(NULL)
+  }
+  mc <- tryCatch(match.call(matrix, e), error = function(...) NULL)
+  if (is.null(mc)) {
+    return(NULL)
+  }
+  margs <- as.list(mc)[-1L]
+  if (
+    !setequal(names(margs), c("data", "nrow", "ncol")) ||
+      any(map_lgl(margs, is_missing))
+  ) {
+    return(NULL)
+  }
+  data <- margs$data
+  data_is_scalar <- (is.atomic(data) && length(data) == 1L && !is.na(data)) ||
+    (is.symbol(data) &&
+      {
+        var <- get0(as.character(data), scope)
+        inherits(var, Variable) && passes_as_scalar(var)
+      })
+  if (!data_is_scalar) {
+    return(NULL)
+  }
+  margs
+}
+
+# Compile the two operands of an elementwise binary op. The one special
+# case: `matrix(scalar, m, n)` against a genuine rank-2 array broadcasts
+# natively -- compile just the scalar and enforce the claimed dims against
+# the other operand (compile error when statically wrong, runtime guard
+# when symbolic, spelled from the dim expressions since the fill has no
+# array to size()). Everything else compiles as written.
+compile_binop_operands <- function(args, scope, ..., hoist = NULL) {
+  fills <- lapply(args, matrix_scalar_fill_args, scope = scope)
+  fill_idx <- which(!map_lgl(fills, is.null))
+
+  if (length(fill_idx) == 1L && !is.null(hoist)) {
+    j <- fill_idx
+    other <- r2f(args[[3L - j]], scope, ..., hoist = hoist)
+    fill_dims <- r2dims(list(fills[[j]]$nrow, fills[[j]]$ncol), scope)
+    fill_dims_f <- map_chr(fill_dims, \(d) dims2f(list(d), scope))
+    broadcastable <- inherits(other, Fortran) &&
+      !is.null(other@value) &&
+      other@value@rank == 2L &&
+      !passes_as_scalar(other@value) &&
+      !any(map_lgl(fill_dims, is_scalar_na)) &&
+      all(nzchar(fill_dims_f)) &&
+      !any(grepl(":", fill_dims_f, fixed = TRUE))
+    if (broadcastable) {
+      other_dims <- matrix_dims(other)
+      for (axis in 1:2) {
+        other_dim <- if (axis == 1L) other_dims$rows else other_dims$cols
+        verdict <- check_elementwise_lengths(fill_dims[[axis]], other_dim)
+        if (!verdict$ok) {
+          stop(
+            "elementwise matrix operations require matching dimensions",
+            call. = FALSE
+          )
+        }
+        if (verdict$unknown) {
+          emit_quickr_error_if(
+            glue("({fill_dims_f[[axis]]}) /= size({other}, {axis})"),
+            "elementwise matrix operations require matching dimensions",
+            hoist,
+            scope
+          )
+        }
+      }
+      fill <- r2f(fills[[j]]$data, scope, ..., hoist = hoist)
+      out <- list(fill, other)
+      return(if (j == 1L) out else rev(out))
+    }
+    fallback <- r2f(args[[j]], scope, ..., hoist = hoist)
+    out <- list(fallback, other)
+    return(if (j == 1L) out else rev(out))
+  }
+
+  lapply(args, r2f, scope, ..., hoist = hoist)
+}
+
 # Render one table row over cast, shape-resolved operands. `var` is the
 # conformed result Variable (floor_divide branches on its mode and hoists
 # a quotient temporary with its dims).
@@ -164,7 +251,7 @@ compile_binop <- function(args, scope, ..., hoist = NULL) {
     return(Fortran(glue("({op}{x})"), Variable(x@value@mode, x@value@dims)))
   }
 
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- compile_binop_operands(args, scope, ..., hoist = hoist)
 
   .[left, right] <- cast_binop_operands(spec, op, left, right)
 

R/r2f-random.R

@@ -17,9 +17,9 @@ r2f_handlers[["runif"]] <- function(args, scope, ..., hoist = NULL) {
   # R evaluates runif() bounds exactly once, but `min` is spliced twice below
   # and the implied-do re-evaluates the whole expression per element; hoist
   # non-trivial bounds (e.g. an impure runif(1)) so they are evaluated once.
+  # (hoist_unless_name() leaves names and literals alone.)
   bound <- function(r_arg) {
-    b <- r2f(r_arg, scope, ..., hoist = hoist)
-    if (is.atomic(r_arg)) b else hoist_unless_name(b, hoist)
+    hoist_unless_name(r2f(r_arg, scope, ..., hoist = hoist), hoist)
   }
 
   if (default_min && default_max) {

tests/testthat/_snaps/bind.md

@@ -3,9 +3,9 @@
     Code
       capture_bind_error(r2f(bad_cbind))
     Output
-      cbind() only supports rank 0-2 inputs 
+      cbind() only supports rank 0-2 inputs
     Code
       capture_bind_error(r2f(bad_rbind))
     Output
-      rbind() only supports rank 0-2 inputs 
+      rbind() only supports rank 0-2 inputs
 

tests/testthat/_snaps/blas-guards.md

@@ -61,10 +61,10 @@
       
       
       extern void fn(
-        const double* const m__, 
-        const double* const x__, 
-        double* const out___, 
-        const R_xlen_t x__len_, 
+        const double* const m__,
+        const double* const x__,
+        double* const out___,
+        const R_xlen_t x__len_,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {

tests/testthat/_snaps/block-scopes.md

@@ -127,9 +127,9 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const out__, 
-        const R_len_t x__dim_1_, 
+        const double* const x__,
+        double* const out__,
+        const R_len_t x__dim_1_,
         const R_len_t x__dim_2_);
       
       SEXP fn_(SEXP _args) {

tests/testthat/_snaps/c-bridge-hoist.md

@@ -52,10 +52,10 @@
       
       
       extern void fn(
-        const int* const n__, 
-        const int* const m__, 
-        const double* const a__, 
-        const double* const b__, 
+        const int* const n__,
+        const int* const m__,
+        const double* const a__,
+        const double* const b__,
         double* const out__);
       
       SEXP fn_(SEXP _args) {

tests/testthat/_snaps/closure-hoist-snapshots.md

@@ -68,8 +68,8 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const out__, 
+        const double* const x__,
+        double* const out__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -166,8 +166,8 @@
       
       
       extern void fn(
-        const int* const nx__, 
-        const int* const ny__, 
+        const int* const nx__,
+        const int* const ny__,
         double* const temp__);
       
       SEXP fn_(SEXP _args) {