From 289ab59ba117a0e8e31d381b3ba5c09d0ec4f2f4 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 4 Jul 2026 11:08:17 +0200
Subject: [PATCH 01/97] Reject R-style recycling in elementwise ops, guard
 unknown lengths

check_recyclable_pair() blessed known unequal-but-divisible lengths
(longer %% shorter == 0) for recycling that was never implemented, and
its unknown verdict for differing symbolic lengths was ignored: with
a = double(n), b = double(m), `a + b` lowered to `out = (a + b)` sized
by `a`, silently truncating to min(n, m) where R recycles. Comparison
operators, & and |, %%, and %/% consulted no length check at all.

The replacement, check_elementwise_lengths(), returns a three-valued
verdict applied uniformly by maybe_reshape_vector_matrix(), which every
binary elementwise handler now routes through:

- known lengths must be equal and nonzero, else compile error
  ("elementwise vector operations require equal lengths or a scalar
  operand; R-style recycling is not supported"); quickr cannot
  represent length-0 results, and implementing recycling would need
  per-element modulo indexing for little value
- lengths not comparable statically (symbolic vs symbolic or constant,
  NA dims -- two unknown lengths are never the same quantity) emit one
  statement-level runtime size() guard via emit_quickr_error_if()
- provably equal lengths and scalar broadcast stay guard-free

Matrix-matrix operands get the same verdict per axis (previously the
unknown case proceeded unchecked). Vector-matrix operands with
unverifiable dims, previously a compile-time rejection, now compile
with a size(vec) /= size(mat, 1) guard: strictly more programs
compile, all safely.
---
 R/r2f-arithmetic.R                         |  40 +++---
 R/r2f-logical.R                            |  35 +++--
 R/r2f-operators-helpers.R                  | 152 ++++++++++++++++-----
 tests/testthat/_snaps/example-roll_mean.md |  37 ++++-
 tests/testthat/_snaps/recycling.md         | 113 +++++++++++++++
 tests/testthat/test-codecov-coverage.R     |   2 +-
 tests/testthat/test-matrix.R               |   2 +-
 tests/testthat/test-recycling.R            | 112 +++++++++++++++
 8 files changed, 420 insertions(+), 73 deletions(-)
 create mode 100644 tests/testthat/_snaps/recycling.md
 create mode 100644 tests/testthat/test-recycling.R

diff --git a/R/r2f-arithmetic.R b/R/r2f-arithmetic.R
index 4b13622e..3efd573b 100644
--- a/R/r2f-arithmetic.R
+++ b/R/r2f-arithmetic.R
@@ -3,53 +3,53 @@
 
 # --- Handlers ---
 
-r2f_handlers[["+"]] <- function(args, scope, ...) {
+r2f_handlers[["+"]] <- function(args, scope, ..., hoist = NULL) {
   # Support both binary and unary plus
   if (length(args) == 1L) {
-    x <- r2f(args[[1L]], scope, ...)
+    x <- r2f(args[[1L]], scope, ..., hoist = hoist)
     # R: +TRUE is 1L
     x <- cast_to_mode(x, arith_join_mode(x), "unary +")
     Fortran(glue("(+{x})"), Variable(x@value@mode, x@value@dims))
   } else {
-    .[left, right] <- lapply(args, r2f, scope, ...)
+    .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
     .[left, right] <- promote_arith_pair(left, right, "+")
-    .[left, right] <- maybe_reshape_vector_matrix(left, right)
+    .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
     Fortran(glue("({left} + {right})"), conform(left@value, right@value))
   }
 }
 
-r2f_handlers[["-"]] <- function(args, scope, ...) {
+r2f_handlers[["-"]] <- function(args, scope, ..., hoist = NULL) {
   # Support both binary and unary minus
   if (length(args) == 1L) {
-    x <- r2f(args[[1L]], scope, ...)
+    x <- r2f(args[[1L]], scope, ..., hoist = hoist)
     # R: -TRUE is -1L
     x <- cast_to_mode(x, arith_join_mode(x), "unary -")
     Fortran(glue("(-{x})"), Variable(x@value@mode, x@value@dims))
   } else {
-    .[left, right] <- lapply(args, r2f, scope, ...)
+    .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
     .[left, right] <- promote_arith_pair(left, right, "-")
-    .[left, right] <- maybe_reshape_vector_matrix(left, right)
+    .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
     Fortran(glue("({left} - {right})"), conform(left@value, right@value))
   }
 }
 
-r2f_handlers[["*"]] <- function(args, scope = NULL, ...) {
-  .[left, right] <- lapply(args, r2f, scope, ...)
+r2f_handlers[["*"]] <- function(args, scope = NULL, ..., hoist = NULL) {
+  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   .[left, right] <- promote_arith_pair(left, right, "*")
-  .[left, right] <- maybe_reshape_vector_matrix(left, right)
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   Fortran(glue("({left} * {right})"), conform(left@value, right@value))
 }
 
-r2f_handlers[["/"]] <- function(args, scope = NULL, ...) {
-  .[left, right] <- lapply(args, r2f, scope, ...)
+r2f_handlers[["/"]] <- function(args, scope = NULL, ..., hoist = NULL) {
+  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   left <- maybe_cast_double(left)
   right <- maybe_cast_double(right)
-  .[left, right] <- maybe_reshape_vector_matrix(left, right)
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   Fortran(glue("({left} / {right})"), conform(left@value, right@value))
 }
 
-r2f_handlers[["^"]] <- function(args, scope, ...) {
-  .[left, right] <- lapply(args, r2f, scope, ...)
+r2f_handlers[["^"]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R's ^ always returns double (R_pow), so cast the base. Keep an integer
   # exponent as integer: Fortran `real ** int` is exact and, unlike
   # `real ** real`, defined for negative bases -- matching R, which
@@ -58,7 +58,7 @@ r2f_handlers[["^"]] <- function(args, scope, ...) {
   if (identical(right@value@mode, "logical")) {
     right <- cast_to_mode(right, "integer", "^")
   }
-  .[left, right] <- maybe_reshape_vector_matrix(left, right)
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   mode <- reduce_promoted_mode(left, right)
   if (!identical(mode, "complex")) {
     mode <- "double"
@@ -83,13 +83,14 @@ r2f_handlers[["^"]] <- function(args, scope, ...) {
 #   - FLOOR(x)      : greatest integer <= x      (real)
 #   - AINT(x)       : truncation toward 0       (real)
 
-r2f_handlers[["%%"]] <- function(args, scope, ...) {
-  .[left, right] <- lapply(args, r2f, scope, ...)
+r2f_handlers[["%%"]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # `modulo` requires same-typed arguments, so cast both operands to the
   # join (logical joins as integer: R's TRUE %% TRUE is 0L).
   mode <- arith_join_mode(left, right)
   left <- cast_to_mode(left, mode, "%%")
   right <- cast_to_mode(right, mode, "%%")
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   out_val <- conform(left@value, right@value)
   # MODULO gives result with sign(right) - matches R %% behaviour
   Fortran(glue("modulo({left}, {right})"), out_val)
@@ -98,6 +99,7 @@ r2f_handlers[["%%"]] <- function(args, scope, ...) {
 r2f_handlers[["%/%"]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   .[left, right] <- promote_arith_pair(left, right, "%/%")
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   out_val <- conform(left@value, right@value)
 
   expr <- switch(
diff --git a/R/r2f-logical.R b/R/r2f-logical.R
index 794fe5aa..25b0d992 100644
--- a/R/r2f-logical.R
+++ b/R/r2f-logical.R
@@ -5,55 +5,61 @@
 
 # ---- comparison operators ----
 
-r2f_handlers[[">="]] <- function(args, scope, ...) {
-  .[left, right] <- lapply(args, r2f, scope, ...)
+r2f_handlers[[">="]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} >= {right})"), var)
 }
 
-r2f_handlers[[">"]] <- function(args, scope, ...) {
-  .[left, right] <- lapply(args, r2f, scope, ...)
+r2f_handlers[[">"]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} > {right})"), var)
 }
 
-r2f_handlers[["<"]] <- function(args, scope, ...) {
-  .[left, right] <- lapply(args, r2f, scope, ...)
+r2f_handlers[["<"]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} < {right})"), var)
 }
 
-r2f_handlers[["<="]] <- function(args, scope, ...) {
-  .[left, right] <- lapply(args, r2f, scope, ...)
+r2f_handlers[["<="]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} <= {right})"), var)
 }
 
-r2f_handlers[["=="]] <- function(args, scope, ...) {
-  .[left, right] <- lapply(args, r2f, scope, ...)
+r2f_handlers[["=="]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} == {right})"), var)
 }
 
-r2f_handlers[["!="]] <- function(args, scope, ...) {
-  .[left, right] <- lapply(args, r2f, scope, ...)
+r2f_handlers[["!="]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
+  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} /= {right})"), var)
@@ -101,8 +107,8 @@ register_r2f_handler(
 #   `merge(1_c_int, 0_c_int, <lgl>)` to cast logical to int.
 register_r2f_handler(
   c("&", "&&", "|", "||"),
-  function(args, scope, ...) {
-    args <- lapply(args, r2f, scope, ...)
+  function(args, scope, ..., hoist = NULL) {
+    args <- lapply(args, r2f, scope, ..., hoist = hoist)
     args <- lapply(args, function(a) {
       if (a@value@mode != "logical") {
         stop("must be logical")
@@ -112,6 +118,7 @@ register_r2f_handler(
     .[left, right] <- args
     left <- booleanize_logical_as_int(left)
     right <- booleanize_logical_as_int(right)
+    .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
 
     operator <- switch(
       last(list(...)$calls),
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 307ae989..39d139f8 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -146,27 +146,67 @@ dims_match <- function(left, right) {
   identical(left, right)
 }
 
-# Check if two lengths recycle without warnings.
-# Used by: r2f-arithmetic.R, r2f-logical.R
-check_recyclable_pair <- function(left, right) {
+# Three-valued conformability verdict for one axis of an elementwise op:
+# ok+known (no guard needed), not-ok+known (compile error at the caller),
+# or unknown (caller emits a runtime guard). Known lengths must be equal
+# and nonzero -- R-style recycling is never implemented, and quickr cannot
+# represent length-0 results. NA dims are always unknown: two unknown
+# lengths are not the same quantity.
+# Used by: maybe_reshape_vector_matrix()
+check_elementwise_lengths <- function(left, right) {
   if (is_wholenumber(left) && is_wholenumber(right)) {
     left <- as.integer(left)
     right <- as.integer(right)
-    if (left == 0L || right == 0L) {
+    return(list(ok = left == right && left > 0L, unknown = FALSE))
+  }
+  if (
+    (is_wholenumber(left) && as.integer(left) == 0L) ||
+      (is_wholenumber(right) && as.integer(right) == 0L)
+  ) {
+    return(list(ok = FALSE, unknown = FALSE))
+  }
+  if (!is_scalar_na(left) && !is_scalar_na(right)) {
+    left_norm <- fortranize_expr_symbols(left)
+    right_norm <- fortranize_expr_symbols(right)
+    if (identical(left_norm, right_norm)) {
       return(list(ok = TRUE, unknown = FALSE))
     }
-    longer <- max(left, right)
-    shorter <- min(left, right)
-    return(list(ok = (longer %% shorter) == 0L, unknown = FALSE))
-  }
-  left_norm <- fortranize_expr_symbols(left)
-  right_norm <- fortranize_expr_symbols(right)
-  if (identical(left_norm, right_norm)) {
-    return(list(ok = TRUE, unknown = FALSE))
   }
   list(ok = TRUE, unknown = TRUE)
 }
 
+# Emit a statement-level runtime check that two elementwise operands have
+# equal size along the given axes (whole size when an axis is NULL).
+# size() is an inquiry, so applying it to operand expression text does not
+# evaluate the operands.
+# Used by: maybe_reshape_vector_matrix()
+emit_elementwise_size_guard <- function(
+  left,
+  right,
+  hoist,
+  scope,
+  message,
+  left_axis = NULL,
+  right_axis = left_axis
+) {
+  if (is.null(hoist)) {
+    stop(
+      "cannot emit a runtime length guard here; ",
+      "operand lengths must match statically",
+      call. = FALSE
+    )
+  }
+  size_of <- function(x, axis) {
+    if (is.null(axis)) glue("size({x})") else glue("size({x}, {axis})")
+  }
+  emit_quickr_error_if(
+    glue("{size_of(left, left_axis)} /= {size_of(right, right_axis)}"),
+    message,
+    hoist,
+    scope
+  )
+}
+
 # Reshape a vector to match a matrix's dimensions.
 # Used by: r2f-arithmetic.R, r2f-logical.R
 reshape_vector_for_matrix <- function(vec, rows, cols) {
@@ -191,9 +231,13 @@ scalarize_matrix <- function(mat) {
   Fortran(glue("{mat}(1, 1)"), out_val)
 }
 
-# Reshape vector/matrix operands to match ranks for binary operations.
+# Reshape vector/matrix operands to match ranks for binary operations, and
+# enforce the elementwise conformability policy: known-mismatched lengths
+# are compile errors (R-style recycling is not supported; scalar broadcast
+# is native), lengths that cannot be compared statically get a runtime
+# size guard through `hoist`.
 # Used by: r2f-arithmetic.R, r2f-logical.R
-maybe_reshape_vector_matrix <- function(left, right) {
+maybe_reshape_vector_matrix <- function(left, right, hoist = NULL, scope = NULL) {
   if (
     !inherits(left, Fortran) ||
       !inherits(right, Fortran) ||
@@ -223,50 +267,90 @@ maybe_reshape_vector_matrix <- function(left, right) {
   }
 
   if (left_rank == 1L && right_rank == 1L) {
-    conform <- check_recyclable_pair(
+    vector_msg <- paste0(
+      "elementwise vector operations require equal lengths or ",
+      "a scalar operand; R-style recycling is not supported"
+    )
+    conform <- check_elementwise_lengths(
       dim_or_one(left, 1L),
       dim_or_one(right, 1L)
     )
     if (!conform$ok) {
-      stop(
-        "elementwise vector operations require lengths that recycle cleanly unless one operand is scalar",
-        call. = FALSE
-      )
+      stop(vector_msg, call. = FALSE)
+    }
+    if (conform$unknown) {
+      emit_elementwise_size_guard(left, right, hoist, scope, vector_msg)
     }
   }
 
   if (left_rank == 2L && right_rank == 2L) {
+    matrix_msg <- "elementwise matrix operations require matching dimensions"
     left_dims <- matrix_dims(left)
     right_dims <- matrix_dims(right)
-    row_conform <- check_conformable(left_dims$rows, right_dims$rows)
-    col_conform <- check_conformable(left_dims$cols, right_dims$cols)
+    row_conform <- check_elementwise_lengths(left_dims$rows, right_dims$rows)
+    col_conform <- check_elementwise_lengths(left_dims$cols, right_dims$cols)
     if (!row_conform$ok || !col_conform$ok) {
-      stop(
-        "elementwise matrix operations require matching dimensions",
-        call. = FALSE
+      stop(matrix_msg, call. = FALSE)
+    }
+    if (row_conform$unknown) {
+      emit_elementwise_size_guard(
+        left,
+        right,
+        hoist,
+        scope,
+        matrix_msg,
+        left_axis = 1L
+      )
+    }
+    if (col_conform$unknown) {
+      emit_elementwise_size_guard(
+        left,
+        right,
+        hoist,
+        scope,
+        matrix_msg,
+        left_axis = 2L
       )
     }
   }
 
+  vec_mat_msg <- paste0(
+    "elementwise vector-matrix operations require a scalar or ",
+    "a vector length equal to the matrix first dimension (nrow)"
+  )
   if (left_rank == 1L && right_rank == 2L) {
     right_dims <- matrix_dims(right)
     left_len <- dim_or_one(left, 1L)
-    row_conform <- check_conformable(left_len, right_dims$rows)
-    if (!row_conform$ok || row_conform$unknown) {
-      stop(
-        "elementwise vector-matrix operations require a scalar or a vector length equal to the matrix first dimension (nrow)",
-        call. = FALSE
+    row_conform <- check_elementwise_lengths(left_len, right_dims$rows)
+    if (!row_conform$ok) {
+      stop(vec_mat_msg, call. = FALSE)
+    }
+    if (row_conform$unknown) {
+      emit_elementwise_size_guard(
+        left,
+        right,
+        hoist,
+        scope,
+        vec_mat_msg,
+        right_axis = 1L
       )
     }
     left <- reshape_vector_for_matrix(left, right_dims$rows, right_dims$cols)
   } else if (left_rank == 2L && right_rank == 1L) {
     left_dims <- matrix_dims(left)
     right_len <- dim_or_one(right, 1L)
-    row_conform <- check_conformable(right_len, left_dims$rows)
-    if (!row_conform$ok || row_conform$unknown) {
-      stop(
-        "elementwise vector-matrix operations require a scalar or a vector length equal to the matrix first dimension (nrow)",
-        call. = FALSE
+    row_conform <- check_elementwise_lengths(right_len, left_dims$rows)
+    if (!row_conform$ok) {
+      stop(vec_mat_msg, call. = FALSE)
+    }
+    if (row_conform$unknown) {
+      emit_elementwise_size_guard(
+        right,
+        left,
+        hoist,
+        scope,
+        vec_mat_msg,
+        right_axis = 1L
       )
     }
     right <- reshape_vector_for_matrix(right, left_dims$rows, left_dims$cols)
diff --git a/tests/testthat/_snaps/example-roll_mean.md b/tests/testthat/_snaps/example-roll_mean.md
index da122d2a..26179dce 100644
--- a/tests/testthat/_snaps/example-roll_mean.md
+++ b/tests/testthat/_snaps/example-roll_mean.md
@@ -24,8 +24,8 @@
     Code
       cat(fsub)
     Output
-      subroutine fn(x, weights, normalize, out, weights__len_, x__len_) bind(c)
-        use iso_c_binding, only: c_double, c_int, c_ptrdiff_t
+      subroutine fn(x, weights, normalize, out, weights__len_, x__len_, quickr_err_msg) bind(c)
+        use iso_c_binding, only: c_char, c_double, c_int, c_null_char, c_ptrdiff_t
         implicit none
       
         ! manifest start
@@ -33,6 +33,9 @@
         integer(c_ptrdiff_t), intent(in), value :: x__len_
         integer(c_ptrdiff_t), intent(in), value :: weights__len_
       
+        ! error
+        character(kind=c_char), intent(inout) :: quickr_err_msg(256)
+      
         ! args
         real(c_double), intent(in) :: x(x__len_)
         real(c_double), intent(in out) :: weights(weights__len_)
@@ -51,8 +54,25 @@
           weights = ((weights / sum(weights)) * size(weights))
         end if
         do i = 1, size(out)
+          if (size(x(i:(((i + n) - 1_c_int)):sign(1, (((i + n) - 1_c_int))-i))) /= size(weights)) then
+      call quickr_set_error_msg("elementwise vector operations require equal lengths or a scalar operand; R-style recycling is not&
+      & supported")
+            return
+          end if
           out(i) = (sum((x(i:(((i + n) - 1_c_int)):sign(1, (((i + n) - 1_c_int))-i)) * weights)) / real(size(weights), kind=c_double))
         end do
+      
+        contains
+          subroutine quickr_set_error_msg(msg)
+            character(len=*), intent(in) :: msg
+            integer :: i
+            integer :: n
+            if (quickr_err_msg(1) == c_null_char) then
+              n = min(len(msg), 256 - 1)
+              quickr_err_msg(1:n) = [(msg(i:i), i = 1, n)]
+              quickr_err_msg(n + 1) = c_null_char
+            end if
+          end subroutine quickr_set_error_msg
       end subroutine
     Code
       cat(cwrapper)
@@ -68,7 +88,8 @@
         const int* const normalize__, 
         double* const out__, 
         const R_xlen_t weights__len_, 
-        const R_xlen_t x__len_);
+        const R_xlen_t x__len_, 
+        char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
         // x
@@ -107,13 +128,21 @@
         SEXP out = PROTECT(Rf_allocVector(REALSXP, out__len_));
         double* out__ = REAL(out);
         
+        char quickr_err_msg[256];
+        quickr_err_msg[0] = '\0';
+        
+        
         fn(
           x__,
           weights__,
           normalize__,
           out__,
           weights__len_,
-          x__len_);
+          x__len_,
+          quickr_err_msg);
+        if (quickr_err_msg[0] != '\0') {
+          Rf_error("%s", quickr_err_msg);
+        }
         
         UNPROTECT(1);
         return out;
diff --git a/tests/testthat/_snaps/recycling.md b/tests/testthat/_snaps/recycling.md
new file mode 100644
index 00000000..48363f9b
--- /dev/null
+++ b/tests/testthat/_snaps/recycling.md
@@ -0,0 +1,113 @@
+# guard text is pinned (one snapshot per mechanism)
+
+    Code
+      cat("# Snapshot note: ", note, "\n", sep = "")
+    Output
+      # Snapshot note: Symbolic differing lengths emit one statement-level size guard.
+    Code
+      fn
+    Output
+      function(a, b) {
+          declare(type(a = double(n)), type(b = double(m)))
+          a + b
+        }
+      <environment: 0x0>
+    Code
+      cat(fsub)
+    Output
+      subroutine fn(a, b, out_, a__len_, b__len_, quickr_err_msg) bind(c)
+        use iso_c_binding, only: c_char, c_double, c_null_char, c_ptrdiff_t
+        implicit none
+      
+        ! manifest start
+        ! sizes
+        integer(c_ptrdiff_t), intent(in), value :: a__len_
+        integer(c_ptrdiff_t), intent(in), value :: b__len_
+      
+        ! error
+        character(kind=c_char), intent(inout) :: quickr_err_msg(256)
+      
+        ! args
+        real(c_double), intent(in) :: a(a__len_)
+        real(c_double), intent(in) :: b(b__len_)
+        real(c_double), intent(out) :: out_(a__len_)
+        ! manifest end
+      
+      
+        if (size(a) /= size(b)) then
+      call quickr_set_error_msg("elementwise vector operations require equal lengths or a scalar operand; R-style recycling is not&
+      & supported")
+          return
+        end if
+        out_ = (a + b)
+      
+        contains
+          subroutine quickr_set_error_msg(msg)
+            character(len=*), intent(in) :: msg
+            integer :: i
+            integer :: n
+            if (quickr_err_msg(1) == c_null_char) then
+              n = min(len(msg), 256 - 1)
+              quickr_err_msg(1:n) = [(msg(i:i), i = 1, n)]
+              quickr_err_msg(n + 1) = c_null_char
+            end if
+          end subroutine quickr_set_error_msg
+      end subroutine
+    Code
+      cat(cwrapper)
+    Output
+      #define R_NO_REMAP
+      #include <R.h>
+      #include <Rinternals.h>
+      
+      
+      extern void fn(
+        const double* const a__, 
+        const double* const b__, 
+        double* const out___, 
+        const R_xlen_t a__len_, 
+        const R_xlen_t b__len_, 
+        char* quickr_err_msg);
+      
+      SEXP fn_(SEXP _args) {
+        // a
+        _args = CDR(_args);
+        SEXP a = CAR(_args);
+        if (TYPEOF(a) != REALSXP) {
+          Rf_error("typeof(a) must be 'double', not '%s'", Rf_type2char(TYPEOF(a)));
+        }
+        const double* const a__ = REAL(a);
+        const R_xlen_t a__len_ = Rf_xlength(a);
+        
+        // b
+        _args = CDR(_args);
+        SEXP b = CAR(_args);
+        if (TYPEOF(b) != REALSXP) {
+          Rf_error("typeof(b) must be 'double', not '%s'", Rf_type2char(TYPEOF(b)));
+        }
+        const double* const b__ = REAL(b);
+        const R_xlen_t b__len_ = Rf_xlength(b);
+        
+        const R_xlen_t out___len_ = a__len_;
+        SEXP out_ = PROTECT(Rf_allocVector(REALSXP, out___len_));
+        double* out___ = REAL(out_);
+        
+        char quickr_err_msg[256];
+        quickr_err_msg[0] = '\0';
+        
+        
+        fn(
+          a__,
+          b__,
+          out___,
+          a__len_,
+          b__len_,
+          quickr_err_msg);
+        if (quickr_err_msg[0] != '\0') {
+          Rf_error("%s", quickr_err_msg);
+        }
+        
+        UNPROTECT(1);
+        return out_;
+      }
+
diff --git a/tests/testthat/test-codecov-coverage.R b/tests/testthat/test-codecov-coverage.R
index 14c0f064..f55b8bf2 100644
--- a/tests/testthat/test-codecov-coverage.R
+++ b/tests/testthat/test-codecov-coverage.R
@@ -883,7 +883,7 @@ test_that("elementwise vector lengths must recycle cleanly", {
 
   expect_error(
     quick(fn),
-    "elementwise vector operations require lengths that recycle cleanly",
+    "elementwise vector operations require equal lengths",
     fixed = TRUE
   )
 })
diff --git a/tests/testthat/test-matrix.R b/tests/testthat/test-matrix.R
index 95057972..e4457626 100644
--- a/tests/testthat/test-matrix.R
+++ b/tests/testthat/test-matrix.R
@@ -212,7 +212,7 @@ test_that("elementwise vector operations require matching lengths", {
 
   expect_error(
     quick(fn),
-    "elementwise vector operations require lengths that recycle cleanly unless one operand is scalar",
+    "elementwise vector operations require equal lengths or a scalar operand; R-style recycling is not supported",
     fixed = TRUE
   )
 })
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
new file mode 100644
index 00000000..c490f99a
--- /dev/null
+++ b/tests/testthat/test-recycling.R
@@ -0,0 +1,112 @@
+# Elementwise conformability: R-style recycling is rejected (compile error
+# for known mismatches, runtime guard for unknown), fill constructors spread
+# inside c(), and matrix(scalar, m, n) materializes a real array.
+
+skip_on_cran()
+
+test_that("known unequal vector lengths are a compile error", {
+  # divisible lengths were previously blessed and silently mis-lowered
+  divisible <- function(a, b) {
+    declare(type(a = double(2)), type(b = double(4)))
+    a + b
+  }
+  expect_error(quick(divisible), "equal lengths")
+
+  ragged <- function(a, b) {
+    declare(type(a = double(2)), type(b = double(3)))
+    a * b
+  }
+  expect_error(quick(ragged), "equal lengths")
+
+  zero_len <- function(a, b) {
+    declare(type(a = double(0)), type(b = double(4)))
+    a + b
+  }
+  expect_error(quick(zero_len), "equal lengths")
+})
+
+test_that("length checks cover comparisons, logical ops, and modulo", {
+  comparison <- function(a, b) {
+    declare(type(a = double(2)), type(b = double(4)))
+    a < b
+  }
+  expect_error(quick(comparison), "equal lengths")
+
+  logical_op <- function(a, b) {
+    declare(type(a = logical(2)), type(b = logical(4)))
+    a & b
+  }
+  expect_error(quick(logical_op), "equal lengths")
+
+  modulo <- function(a, b) {
+    declare(type(a = integer(2)), type(b = integer(4)))
+    a %% b
+  }
+  expect_error(quick(modulo), "equal lengths")
+})
+
+test_that("symbolic differing lengths get a runtime guard", {
+  fn <- function(a, b) {
+    declare(type(a = double(n)), type(b = double(m)))
+    a + b
+  }
+  qfn <- quick(fn)
+  expect_identical(qfn(c(1, 2), c(10, 20)), c(11, 22))
+  # was: silent truncation to c(11, 22)
+  expect_error(qfn(c(1, 2), c(10, 20, 30, 40)), "equal lengths")
+})
+
+test_that("identical symbolic lengths stay guard-free and work", {
+  fn <- function(a, b) {
+    declare(type(a = double(n)), type(b = double(n)))
+    a - b
+  }
+  fsub <- r2f(fn)
+  expect_no_match(fsub, "quickr_set_error_msg", fixed = TRUE)
+  expect_quick_identical(fn, list(c(1, 2, 3), c(10, 20, 30)))
+})
+
+test_that("scalar broadcast is unaffected", {
+  fn <- function(a, b) {
+    declare(type(a = double(n)), type(b = double(1)))
+    a + b
+  }
+  fsub <- r2f(fn)
+  expect_no_match(fsub, "quickr_set_error_msg", fixed = TRUE)
+  expect_quick_identical(fn, list(c(1, 2, 3), 10))
+})
+
+test_that("matrix-matrix elementwise ops guard unknown dims per axis", {
+  fn <- function(a, b) {
+    declare(type(a = double(n, k)), type(b = double(m, j)))
+    a * b
+  }
+  qfn <- quick(fn)
+  m1 <- matrix(as.double(1:6), 2, 3)
+  m2 <- matrix(as.double(6:1), 2, 3)
+  expect_identical(qfn(m1, m2), m1 * m2)
+  expect_error(qfn(m1, t(m2)), "matching dimensions")
+})
+
+test_that("vector-matrix ops with unknown dims guard instead of rejecting", {
+  fn <- function(vec, mat) {
+    declare(type(vec = double(n)), type(mat = double(m, k)))
+    vec + mat
+  }
+  qfn <- quick(fn)
+  mat <- matrix(as.double(1:6), 2, 3)
+  vec <- c(10, 20)
+  expect_identical(qfn(vec, mat), vec + mat)
+  expect_error(qfn(c(10, 20, 30), mat), "matrix first dimension")
+})
+
+test_that("guard text is pinned (one snapshot per mechanism)", {
+  fn <- function(a, b) {
+    declare(type(a = double(n)), type(b = double(m)))
+    a + b
+  }
+  expect_translation_snapshots(
+    fn,
+    note = "Symbolic differing lengths emit one statement-level size guard."
+  )
+})

From 40a9f78669eeed1d5bdb2ca5ca13603a4edab487 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 4 Jul 2026 11:08:18 +0200
Subject: [PATCH 02/97] Spread c() fills as implied-dos; materialize
 matrix(scalar, m, n)

Fill constructors (logical(k), integer(k), double(k), numeric(k)) lower
to a single scalar literal whose Variable claims length k. c() spliced
that literal as one element while sizing the result from the claimed
dims, so c(numeric(2), x) emitted [ 0, x ] with a declared length of
2 + length(x) -- today a build failure only because the bare integer 0
next to a double x also made a mixed-type constructor. The c() handler
now renders fill elements as implied-do spreads,
[(0.0_c_double, i=1, int(2)), x], the same pattern array() already
used for its fill branch (the detection is extracted into a shared
is_fill_constructor_call()). The fill handlers also emit mode-correct
literals (0.0_c_double, 0_c_int) so spliced or promoted fills carry
the type their Variable claims.

matrix(scalar, m, n) rebadged the scalar's Variable with rank-2 dims
and returned the scalar text, which is only valid where Fortran's
scalar broadcast applies: sum(matrix(2, 2, 3)) emitted the invalid
sum(2.0_c_double). The scalar is now materialized into a hoisted
rank-2 temporary in expression contexts; direct assignment keeps the
free broadcast (m <- matrix(0, n, k) still emits m = 0.0_c_double).

Snapshot churn is the typed fill literals (out = 0 becoming
out = 0.0_c_double / 0_c_int).
---
 R/r2f-constructors.R                          | 74 +++++++++++++++----
 tests/testthat/_snaps/c-bridge-hoist.md       |  2 +-
 .../_snaps/closure-hoist-snapshots.md         |  2 +-
 tests/testthat/_snaps/dims2f.md               |  6 +-
 tests/testthat/_snaps/example-convolve.md     |  2 +-
 tests/testthat/_snaps/example-roll_mean.md    |  2 +-
 tests/testthat/_snaps/example-viterbi.md      |  4 +-
 tests/testthat/_snaps/logical-indexing.md     |  8 +-
 tests/testthat/_snaps/sapply-closures.md      |  6 +-
 tests/testthat/test-recycling.R               | 51 +++++++++++++
 10 files changed, 125 insertions(+), 32 deletions(-)

diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index a8e085e1..6b981918 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -2,6 +2,18 @@
 # Handlers for value constructors: c, logical, integer, double, numeric,
 # character, raw, matrix, array
 
+# --- Helpers ---
+
+# TRUE for calls to the zero-fill constructors: logical(k), integer(k),
+# double(k), numeric(k). These lower to a single scalar literal carrying
+# array dims, so splicing contexts must spread them explicitly.
+# Used by: c(), array()
+is_fill_constructor_call <- function(e) {
+  is.call(e) &&
+    is.symbol(e[[1L]]) &&
+    as.character(e[[1L]]) %in% c("logical", "integer", "double", "numeric")
+}
+
 # --- Handlers ---
 
 r2f_handlers[["c"]] <- function(args, scope = NULL, ...) {
@@ -12,6 +24,31 @@ r2f_handlers[["c"]] <- function(args, scope = NULL, ...) {
   promoted <- promote_operands(ff, context = "c()")
   ff <- promoted$args
   mode <- promoted$mode
+  # Fill constructors are one scalar literal claiming length k; spread them
+  # as implied-dos so the emitted element count matches the claimed length.
+  fill_idx <- which(map_lgl(args, is_fill_constructor_call))
+  if (length(fill_idx)) {
+    spread_var <- NULL
+    for (j in fill_idx) {
+      len_f <- dims2f(ff[[j]]@value@dims, scope)
+      if (!nzchar(len_f)) {
+        next # statically length 1: a single spliced scalar is already right
+      }
+      if (grepl(":", len_f, fixed = TRUE)) {
+        stop(
+          "the length of ",
+          deparse1(args[[j]]),
+          " inside c() must be known",
+          call. = FALSE
+        )
+      }
+      spread_var <- spread_var %||% scope_unique_var(scope, "integer")
+      ff[[j]] <- Fortran(
+        glue("({ff[[j]]}, {spread_var}=1, int({len_f}))"),
+        ff[[j]]@value
+      )
+    }
+  }
   s <- glue("[ {str_flatten_commas(ff)} ]")
   lens <- lapply(ff[order(map_int(ff, \(f) f@value@rank))], function(e) {
     rank <- e@value@rank
@@ -117,7 +154,7 @@ register_r2f_handler(
 register_r2f_handler(
   "integer",
   function(args, scope, ...) {
-    Fortran("0", Variable(mode = "integer", dims = r2dims(args, scope)))
+    Fortran("0_c_int", Variable(mode = "integer", dims = r2dims(args, scope)))
   },
   match_fun = FALSE
 )
@@ -125,7 +162,10 @@ register_r2f_handler(
 register_r2f_handler(
   c("double", "numeric"),
   function(args, scope, ...) {
-    Fortran("0", Variable(mode = "double", dims = r2dims(args, scope)))
+    Fortran(
+      "0.0_c_double",
+      Variable(mode = "double", dims = r2dims(args, scope))
+    )
   },
   match_fun = FALSE
 )
@@ -154,10 +194,22 @@ r2f_handlers[["matrix"]] <- function(args, scope = NULL, ..., hoist = NULL) {
   dims <- r2dims(list(args$nrow, args$ncol), scope)
   out_val <- Variable(mode = src@value@mode, dims = dims)
 
-  # Scalars can be broadcast into an array on assignment, so keep them as-is.
+  # A scalar broadcasts natively on direct whole-array assignment, so keep
+  # it as-is there; in any other context (sum(...), %*%, ...) the expression
+  # must be a real rank-2 array, so materialize it into a hoisted temporary.
   if (passes_as_scalar(src@value)) {
-    src@value <- out_val
-    return(src)
+    calls <- list(...)$calls
+    parent_call <- if (length(calls) >= 2L) calls[[length(calls) - 1L]] else ""
+    if (parent_call %in% c("<-", "=", "<<-")) {
+      src@value <- out_val
+      return(src)
+    }
+    if (is.null(hoist)) {
+      stop("internal error: matrix() requires hoist context", call. = FALSE)
+    }
+    tmp <- hoist$declare_tmp(mode = src@value@mode, dims = dims)
+    hoist$emit(glue("{tmp@name} = {src}"))
+    return(Fortran(tmp@name, tmp))
   }
 
   rows <- dims[[1L]]
@@ -282,17 +334,7 @@ r2f_handlers[["array"]] <- function(args, scope = NULL, ..., hoist = NULL) {
       }
       shape <- glue("int([{dims_f}])")
 
-      data_r <- args$data
-      is_fill_constructor <-
-        is.call(data_r) &&
-        is.symbol(data_r[[1L]]) &&
-        as.character(data_r[[1L]]) %in%
-          c(
-            "logical",
-            "integer",
-            "double",
-            "numeric"
-          )
+      is_fill_constructor <- is_fill_constructor_call(args$data)
 
       axis_terms <- vapply(
         target_dims,
diff --git a/tests/testthat/_snaps/c-bridge-hoist.md b/tests/testthat/_snaps/c-bridge-hoist.md
index b866a3b1..281f6da7 100644
--- a/tests/testthat/_snaps/c-bridge-hoist.md
+++ b/tests/testthat/_snaps/c-bridge-hoist.md
@@ -38,7 +38,7 @@
         ! manifest end
       
       
-        out = 0
+        out = 0.0_c_double
         do i = 1, size(out)
           out(i) = (a(i) + b(i))
         end do
diff --git a/tests/testthat/_snaps/closure-hoist-snapshots.md b/tests/testthat/_snaps/closure-hoist-snapshots.md
index e2fe6a3c..1d9f0b5e 100644
--- a/tests/testthat/_snaps/closure-hoist-snapshots.md
+++ b/tests/testthat/_snaps/closure-hoist-snapshots.md
@@ -34,7 +34,7 @@
         ! manifest end
       
       
-        out = 0
+        out = 0.0_c_double
         do tmp1_ = 1_c_int, x__len_
           call closure1_(tmp1_, out(tmp1_))
       
diff --git a/tests/testthat/_snaps/dims2f.md b/tests/testthat/_snaps/dims2f.md
index dcbc0081..7881bc1c 100644
--- a/tests/testthat/_snaps/dims2f.md
+++ b/tests/testthat/_snaps/dims2f.md
@@ -31,8 +31,8 @@
         allocate(y((n - 1)))
       
       
-        x = 0
-        y = 0
+        x = 0.0_c_double
+        y = 0.0_c_double
         out_ = (size(x) + size(y))
       end subroutine
     Code
@@ -98,7 +98,7 @@
         allocate(out((int(n) / int(2) + mod(int(n), int(2)))))
       
       
-        out = 0
+        out = 0.0_c_double
         out_ = size(out)
       end subroutine
     Code
diff --git a/tests/testthat/_snaps/example-convolve.md b/tests/testthat/_snaps/example-convolve.md
index 2894c0e8..a4d791fa 100644
--- a/tests/testthat/_snaps/example-convolve.md
+++ b/tests/testthat/_snaps/example-convolve.md
@@ -40,7 +40,7 @@
       
       
       
-        ab = 0
+        ab = 0.0_c_double
         do i = 1, size(a)
           do j = 1, size(b)
             ab(((i + j) - 1_c_int)) = (ab(((i + j) - 1_c_int)) + (a(i) * b(j)))
diff --git a/tests/testthat/_snaps/example-roll_mean.md b/tests/testthat/_snaps/example-roll_mean.md
index 26179dce..24e951e6 100644
--- a/tests/testthat/_snaps/example-roll_mean.md
+++ b/tests/testthat/_snaps/example-roll_mean.md
@@ -48,7 +48,7 @@
         ! manifest end
       
       
-        out = 0
+        out = 0.0_c_double
         n = size(weights)
         if ((normalize/=0)) then
           weights = ((weights / sum(weights)) * size(weights))
diff --git a/tests/testthat/_snaps/example-viterbi.md b/tests/testthat/_snaps/example-viterbi.md
index ae2961b6..487d8bbb 100644
--- a/tests/testthat/_snaps/example-viterbi.md
+++ b/tests/testthat/_snaps/example-viterbi.md
@@ -122,7 +122,7 @@
             backpointer(current_state, step) = maxloc(probabilities, 1)
           end do
         end do
-        path = 0
+        path = 0_c_int
         path(num_steps) = maxloc(trellis(:, num_steps), 1)
         do step = ((num_steps - 1_c_int)), 1_c_int, sign(1, 1_c_int-((num_steps - 1_c_int)))
           path(step) = backpointer(path((step + 1_c_int)), (step + 1_c_int))
@@ -337,7 +337,7 @@
             backpointer(current_state, step) = maxloc(probabilities, 1)
           end do
         end do
-        path = 0
+        path = 0_c_int
         path(size(observations)) = maxloc(trellis(:, size(observations)), 1)
         do step = (size(observations) - 1_c_int), 1_c_int, sign(1, 1_c_int-(size(observations) - 1_c_int))
           path(step) = backpointer(path((step + 1_c_int)), (step + 1_c_int))
diff --git a/tests/testthat/_snaps/logical-indexing.md b/tests/testthat/_snaps/logical-indexing.md
index aef45ec5..e9304524 100644
--- a/tests/testthat/_snaps/logical-indexing.md
+++ b/tests/testthat/_snaps/logical-indexing.md
@@ -28,7 +28,7 @@
         ! manifest end
       
       
-        out = 0
+        out = 0.0_c_double
         out = merge(1.0_c_double, 0.0_c_double, (pred(2_c_int, 3_c_int) /= 0))
       end subroutine
     Code
@@ -104,7 +104,7 @@
         ! manifest end
       
       
-        out = 0
+        out = 0.0_c_double
         block
           logical :: btmp1_(3, 4) ! logical
       
@@ -185,7 +185,7 @@
         ! manifest end
       
       
-        out = 0
+        out = 0.0_c_double
         block
           logical :: btmp1_(3, 4) ! logical
       
@@ -274,7 +274,7 @@
         ! manifest end
       
       
-        out = 0
+        out = 0.0_c_double
         out = sum(((x + y)), mask = (z > a))
       end subroutine
     Code
diff --git a/tests/testthat/_snaps/sapply-closures.md b/tests/testthat/_snaps/sapply-closures.md
index ffa1f67f..80d060cb 100644
--- a/tests/testthat/_snaps/sapply-closures.md
+++ b/tests/testthat/_snaps/sapply-closures.md
@@ -35,7 +35,7 @@
         ! manifest end
       
       
-        out = 0
+        out = 0.0_c_double
       
         do tmp1_ = 1_c_int, x__len_
           call f(tmp1_, out(tmp1_))
@@ -230,7 +230,7 @@
         ! manifest end
       
       
-        out = 0
+        out = 0_c_int
         do tmp1_ = 1_c_int, x__len_
           call closure1_(tmp1_, out(tmp1_))
       
@@ -1050,7 +1050,7 @@
         ! manifest end
       
       
-        out = 0
+        out = 0.0_c_double
         do tmp1_ = 1_c_int, 12_c_int
           call closure1_(tmp1_, out(tmp1_))
       
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index c490f99a..51b59f62 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -110,3 +110,54 @@ test_that("guard text is pinned (one snapshot per mechanism)", {
     note = "Symbolic differing lengths emit one statement-level size guard."
   )
 })
+
+test_that("fill constructors spread inside c()", {
+  known <- function(x) {
+    declare(type(x = double(3)))
+    c(numeric(2), x)
+  }
+  expect_quick_identical(known, list(as.double(1:3)))
+
+  symbolic <- function(x, k) {
+    declare(type(x = double(3)), type(k = integer(1)))
+    c(numeric(k), x)
+  }
+  expect_quick_identical(symbolic, list(as.double(1:3), 2L))
+  expect_quick_identical(symbolic, list(as.double(1:3), 0L))
+
+  promoted <- function(x) {
+    declare(type(x = double(1)))
+    c(integer(2), x)
+  }
+  expect_quick_identical(promoted, list(1.5))
+
+  logical_fill <- function(x) {
+    declare(type(x = logical(2)))
+    c(logical(3), x)
+  }
+  expect_quick_identical(logical_fill, list(c(TRUE, FALSE)))
+})
+
+test_that("matrix(scalar, m, n) materializes where an array is required", {
+  reduced <- function() {
+    sum(matrix(2, 2, 3))
+  }
+  expect_quick_identical(reduced, list())
+
+  transposed <- function() {
+    t(matrix(1, 2, 3))
+  }
+  expect_quick_identical(transposed, list())
+})
+
+test_that("matrix(scalar, m, n) keeps the broadcast fast path on assignment", {
+  fn <- function(n, k) {
+    declare(type(n = integer(1)), type(k = integer(1)))
+    m <- matrix(0, n, k)
+    m
+  }
+  fsub <- r2f(fn)
+  # no hoisted temp: the scalar broadcasts straight into the target
+  expect_match(fsub, "m = 0.0_c_double", fixed = TRUE)
+  expect_quick_identical(fn, list(2L, 3L))
+})

From 649529b8808c29cf3ee1d00753d2a057aa2b168f Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sun, 5 Jul 2026 13:47:38 +0200
Subject: [PATCH 03/97] Follow R's split on 1x1-matrix recycling; hoist casts
 before scalarizing

Found by the conformability grid: a 1x1 matrix operand that needed a
cast or booleanization was scalarized by appending (1, 1) to the cast
expression text -- real(b, kind=c_double)(1, 1) -- which gfortran
rejects as unclassifiable. Hoist non-name 1x1 operands to a temporary
before subscripting.

R only recycles length-1 arrays in *arithmetic* (deprecated but live);
comparisons and & | error with "dims [product 1] do not match the
length of object". quickr's uniform scalarization answered where R
refuses. Comparisons and & | now pass scalarize_one_by_one = FALSE so
the 1x1 falls through to the vector-matrix rule: known longer vectors
are a compile error, unknown lengths get the runtime guard (length 1
still conforms, as in R).
---
 R/r2f-logical.R                 | 56 ++++++++++++++++++++++++++++-----
 R/r2f-operators-helpers.R       | 42 ++++++++++++++++++++++---
 tests/testthat/test-recycling.R | 49 +++++++++++++++++++++++++++++
 3 files changed, 135 insertions(+), 12 deletions(-)

diff --git a/R/r2f-logical.R b/R/r2f-logical.R
index 25b0d992..dea03b5e 100644
--- a/R/r2f-logical.R
+++ b/R/r2f-logical.R
@@ -9,7 +9,13 @@ r2f_handlers[[">="]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
+  .[left, right] <- maybe_reshape_vector_matrix(
+    left,
+    right,
+    hoist,
+    scope,
+    scalarize_one_by_one = FALSE
+  )
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} >= {right})"), var)
@@ -19,7 +25,13 @@ r2f_handlers[[">"]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
+  .[left, right] <- maybe_reshape_vector_matrix(
+    left,
+    right,
+    hoist,
+    scope,
+    scalarize_one_by_one = FALSE
+  )
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} > {right})"), var)
@@ -29,7 +41,13 @@ r2f_handlers[["<"]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
+  .[left, right] <- maybe_reshape_vector_matrix(
+    left,
+    right,
+    hoist,
+    scope,
+    scalarize_one_by_one = FALSE
+  )
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} < {right})"), var)
@@ -39,7 +57,13 @@ r2f_handlers[["<="]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
+  .[left, right] <- maybe_reshape_vector_matrix(
+    left,
+    right,
+    hoist,
+    scope,
+    scalarize_one_by_one = FALSE
+  )
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} <= {right})"), var)
@@ -49,7 +73,13 @@ r2f_handlers[["=="]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
+  .[left, right] <- maybe_reshape_vector_matrix(
+    left,
+    right,
+    hoist,
+    scope,
+    scalarize_one_by_one = FALSE
+  )
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} == {right})"), var)
@@ -59,7 +89,13 @@ r2f_handlers[["!="]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
+  .[left, right] <- maybe_reshape_vector_matrix(
+    left,
+    right,
+    hoist,
+    scope,
+    scalarize_one_by_one = FALSE
+  )
   var <- conform(left@value, right@value)
   var@mode <- "logical"
   Fortran(glue("({left} /= {right})"), var)
@@ -118,7 +154,13 @@ register_r2f_handler(
     .[left, right] <- args
     left <- booleanize_logical_as_int(left)
     right <- booleanize_logical_as_int(right)
-    .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
+    .[left, right] <- maybe_reshape_vector_matrix(
+      left,
+      right,
+      hoist,
+      scope,
+      scalarize_one_by_one = FALSE
+    )
 
     operator <- switch(
       last(list(...)$calls),
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 39d139f8..69f480c2 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -236,8 +236,20 @@ scalarize_matrix <- function(mat) {
 # are compile errors (R-style recycling is not supported; scalar broadcast
 # is native), lengths that cannot be compared statically get a runtime
 # size guard through `hoist`.
+#
+# `scalarize_one_by_one` mirrors R's split over length-1 arrays: arithmetic
+# recycles a 1x1 matrix against a longer vector (deprecated in R but still
+# the behavior), while comparisons and & | error. Strict callers pass FALSE
+# so the 1x1 falls through to the vector-matrix rule and is rejected or
+# guarded like any other 1-row matrix.
 # Used by: r2f-arithmetic.R, r2f-logical.R
-maybe_reshape_vector_matrix <- function(left, right, hoist = NULL, scope = NULL) {
+maybe_reshape_vector_matrix <- function(
+  left,
+  right,
+  hoist = NULL,
+  scope = NULL,
+  scalarize_one_by_one = TRUE
+) {
   if (
     !inherits(left, Fortran) ||
       !inherits(right, Fortran) ||
@@ -252,16 +264,36 @@ maybe_reshape_vector_matrix <- function(left, right, hoist = NULL, scope = NULL)
   left_rank <- if (left_scalar) 0L else left@value@rank
   right_rank <- if (right_scalar) 0L else right@value@rank
 
-  if (left_rank == 2L && right_rank == 1L && is_one_by_one(left)) {
+  # Casts and booleanization wrap operands in expression text that Fortran
+  # cannot index (`real(x, kind=c_double)(1, 1)` is invalid), so hoist
+  # anything that is not a bare name before subscripting it.
+  scalarize_via_hoist <- function(x) {
+    if (!is.null(hoist)) {
+      x <- hoist_unless_name(x, hoist)
+    }
+    scalarize_matrix(x)
+  }
+
+  if (
+    scalarize_one_by_one &&
+      left_rank == 2L &&
+      right_rank == 1L &&
+      is_one_by_one(left)
+  ) {
     right_len <- dim_or_one(right, 1L)
     if (!dim_is_one(right_len)) {
-      left <- scalarize_matrix(left)
+      left <- scalarize_via_hoist(left)
       left_rank <- 0L
     }
-  } else if (left_rank == 1L && right_rank == 2L && is_one_by_one(right)) {
+  } else if (
+    scalarize_one_by_one &&
+      left_rank == 1L &&
+      right_rank == 2L &&
+      is_one_by_one(right)
+  ) {
     left_len <- dim_or_one(left, 1L)
     if (!dim_is_one(left_len)) {
-      right <- scalarize_matrix(right)
+      right <- scalarize_via_hoist(right)
       right_rank <- 0L
     }
   }
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index 51b59f62..048f4d4e 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -100,6 +100,55 @@ test_that("vector-matrix ops with unknown dims guard instead of rejecting", {
   expect_error(qfn(c(10, 20, 30), mat), "matrix first dimension")
 })
 
+test_that("1x1 matrix operands follow R: arithmetic scalarizes, strict ops reject", {
+  # Arithmetic: R recycles a length-1 array against a longer vector
+  # (deprecated, hence suppressWarnings, but still R's answer). A 1x1
+  # operand that needs a cast used to emit unindexable expression text
+  # (`real(b, kind=c_double)(1, 1)`), a gfortran syntax error; it is now
+  # hoisted to a temporary before subscripting.
+  cast_fn <- function(a, b) {
+    declare(type(a = double(3)), type(b = logical(1, 1)))
+    a + b
+  }
+  qfn <- quick(cast_fn)
+  a <- c(1.5, 2.5, 3.5)
+  b <- matrix(TRUE)
+  expect_identical(qfn(a, b), suppressWarnings(cast_fn(a, b)))
+
+  div_fn <- function(a, b) {
+    declare(type(a = double(3)), type(b = logical(1, 1)))
+    a / b
+  }
+  qdiv <- quick(div_fn)
+  expect_identical(qdiv(a, b), suppressWarnings(div_fn(a, b)))
+
+  # Comparisons and & | do not get R's length-1 array recycling: R errors
+  # ("dims [product 1] do not match the length of object"). Scalarizing
+  # here would answer where R refuses, so the 1x1 is treated as an
+  # ordinary one-row matrix and rejected.
+  cmp_fn <- function(a, b) {
+    declare(type(a = double(3)), type(b = double(1, 1)))
+    a < b
+  }
+  expect_error(quick(cmp_fn), "matrix first dimension")
+
+  and_fn <- function(a, b) {
+    declare(type(a = logical(3)), type(b = logical(1, 1)))
+    a & b
+  }
+  expect_error(quick(and_fn), "matrix first dimension")
+
+  # Unknown vector length against a 1x1: strict ops guard at runtime
+  # (length 1 conforms, like R; anything longer is the R error above)
+  sym_cmp <- function(a, b) {
+    declare(type(a = double(NA)), type(b = double(1, 1)))
+    a < b
+  }
+  qcmp <- quick(sym_cmp)
+  expect_identical(qcmp(3, matrix(5)), 3 < matrix(5))
+  expect_error(qcmp(c(1, 2, 3), matrix(5)), "matrix first dimension")
+})
+
 test_that("guard text is pinned (one snapshot per mechanism)", {
   fn <- function(a, b) {
     declare(type(a = double(n)), type(b = double(m)))

From 28c6ebe37d9272ecef1a5141609029858d9e551b Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 12:01:40 +0200
Subject: [PATCH 04/97] Add NEWS entries for recycling rejection and 1x1-matrix
 split

---
 NEWS.md | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index b27319aa..fcd22065 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -7,6 +7,21 @@
 * Successful flang availability checks are now reused for the rest of the R
   session. Restart R after changing the flang toolchain.
 
+- Elementwise operations (arithmetic, comparisons, `&`, `|`) now require
+  operand lengths to match, unless one operand is a scalar or a vector is
+  combined column-wise with a matrix whose rows it spans. R-style partial
+  recycling was never implemented: expressions like `x + y` with
+  `length(x) == 4`, `length(y) == 2` previously compiled to code that read
+  out of bounds. Statically unequal lengths are now a compile-time error;
+  lengths that cannot be verified at compile time are checked at run time.
+
+- `1x1`-matrix operands now follow R's rules: in arithmetic they are
+  treated as scalars (which R allows, with a deprecation warning), while in
+  comparisons and `&`/`|` they are treated as one-row matrices, so
+  mismatched shapes are rejected — matching R, which raises an error.
+  Previously a `1x1` matrix was treated as a scalar everywhere, so e.g.
+  `x < m` with `m` a `1x1` matrix returned answers where R errors.
+
 # quickr 0.3.0
 
 This release adds major new support for linear algebra, local functions,

From 0fc7d25a76cbda2b5e8217654f3afd9509c1337c Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 14:03:34 +0200
Subject: [PATCH 05/97] Materialize fill constructors outside broadcast and
 spread contexts

A zero-fill constructor (numeric(k), integer(k), ...) lowers to one
scalar literal carrying array dims. Whole-array assignment broadcasts
that correctly and c()/array()/matrix() spread or pad it explicitly, but
any other consumer saw a scalar where the dims claimed an array:
c(numeric(2) + 1, x) emitted three elements where the length arithmetic
counted four (build failure), and sum(numeric(2) + 3) returned 3 instead
of 6 (silent wrong answer). Fill handlers now materialize into a hoisted
temporary in every other context.
---
 R/r2f-constructors.R            | 44 +++++++++++++++++++++++++++------
 tests/testthat/test-recycling.R | 24 ++++++++++++++++++
 2 files changed, 61 insertions(+), 7 deletions(-)

diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index 6b981918..a1f7c563 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -143,28 +143,58 @@ r2f_handlers[["rep.int"]] <- function(args, scope, ..., hoist = NULL) {
 }
 
 
+# Compile a zero-fill constructor call: a single scalar literal carrying
+# array dims. Whole-array assignment broadcasts that correctly, and
+# c()/array()/matrix() spread or pad it explicitly, so those contexts keep
+# the scalar form. Any other consumer (elementwise ops, reductions, ...)
+# needs a real array expression -- an expression like `numeric(2) + 1`
+# would otherwise contribute one element where its dims claim two -- so
+# materialize the fill into a hoisted temporary there.
+fill_constructor_value <- function(literal, mode, args, scope, ..., hoist) {
+  var <- Variable(mode = mode, dims = r2dims(args, scope))
+  out <- Fortran(literal, var)
+  if (passes_as_scalar(var)) {
+    return(out)
+  }
+  calls <- list(...)$calls
+  parent_call <- if (length(calls) >= 2L) calls[[length(calls) - 1L]] else ""
+  if (parent_call %in% c("<-", "=", "<<-", "c", "array", "matrix")) {
+    return(out)
+  }
+  if (is.null(hoist)) {
+    stop("internal error: fill constructor requires hoist context", call. = FALSE)
+  }
+  tmp <- hoist$declare_tmp(mode = mode, dims = var@dims)
+  hoist$emit(glue("{tmp@name} = {literal}"))
+  Fortran(tmp@name, tmp)
+}
+
 register_r2f_handler(
   "logical",
-  function(args, scope, ...) {
-    Fortran(".false.", Variable(mode = "logical", dims = r2dims(args, scope)))
+  function(args, scope, ..., hoist = NULL) {
+    fill_constructor_value(".false.", "logical", args, scope, ..., hoist = hoist)
   },
   match_fun = FALSE
 )
 
 register_r2f_handler(
   "integer",
-  function(args, scope, ...) {
-    Fortran("0_c_int", Variable(mode = "integer", dims = r2dims(args, scope)))
+  function(args, scope, ..., hoist = NULL) {
+    fill_constructor_value("0_c_int", "integer", args, scope, ..., hoist = hoist)
   },
   match_fun = FALSE
 )
 
 register_r2f_handler(
   c("double", "numeric"),
-  function(args, scope, ...) {
-    Fortran(
+  function(args, scope, ..., hoist = NULL) {
+    fill_constructor_value(
       "0.0_c_double",
-      Variable(mode = "double", dims = r2dims(args, scope))
+      "double",
+      args,
+      scope,
+      ...,
+      hoist = hoist
     )
   },
   match_fun = FALSE
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index 048f4d4e..3f7cd0f3 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -187,6 +187,30 @@ test_that("fill constructors spread inside c()", {
   expect_quick_identical(logical_fill, list(c(TRUE, FALSE)))
 })
 
+test_that("fill constructors materialize where an array is required", {
+  # A fill reaching c() through an expression is a real array, not a
+  # scalar literal with claimed dims (which emitted one element where the
+  # length arithmetic counted two).
+  through_op <- function(x) {
+    declare(type(x = double(2)))
+    c(numeric(2) + 1, x)
+  }
+  expect_quick_identical(through_op, list(c(5, 6)))
+
+  # Same leak as a silent wrong answer: sum() over a fill expression saw
+  # one scalar instead of the filled length.
+  reduced <- function() {
+    sum(numeric(2) + 3)
+  }
+  expect_quick_identical(reduced, list())
+
+  symbolic <- function(x, k) {
+    declare(type(x = double(2)), type(k = integer(1)))
+    c(integer(k) + 1L, x)
+  }
+  expect_quick_identical(symbolic, list(c(5, 6), 3L))
+})
+
 test_that("matrix(scalar, m, n) materializes where an array is required", {
   reduced <- function() {
     sum(matrix(2, 2, 3))

From 732a8571a2f8a39bd1a90619e45ef07dd911bbdf Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 11:43:28 +0200
Subject: [PATCH 06/97] Extract parent_call_name() and materialize_via_hoist()
 helpers

fill_constructor_value() and the matrix() scalar case duplicated both
the parent-call sniff (positional indexing into the calls stack) and the
declare_tmp/emit/Fortran materialize triplet. One copy of each now.

Review finding (fable-final-review.md #5); no behavior change.
---
 R/r2f-constructors.R | 41 ++++++++++++++++++++++++-----------------
 1 file changed, 24 insertions(+), 17 deletions(-)

diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index a1f7c563..d25c3a93 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -14,6 +14,26 @@ is_fill_constructor_call <- function(e) {
     as.character(e[[1L]]) %in% c("logical", "integer", "double", "numeric")
 }
 
+# Name of the call one frame above the current handler ("" at top level).
+# The materialization decisions below branch on it: a fill constructor or
+# matrix(scalar, ...) may stay a scalar only where the parent broadcasts,
+# spreads, or pads it.
+parent_call_name <- function(calls) {
+  if (length(calls) >= 2L) calls[[length(calls) - 1L]] else ""
+}
+
+# Materialize `code` into a hoisted temporary and return the temporary.
+# `what` names the construct for the internal-error message when no hoist
+# context is available.
+materialize_via_hoist <- function(code, mode, dims, hoist, what) {
+  if (is.null(hoist)) {
+    stop("internal error: ", what, " requires hoist context", call. = FALSE)
+  }
+  tmp <- hoist$declare_tmp(mode = mode, dims = dims)
+  hoist$emit(glue("{tmp@name} = {code}"))
+  Fortran(tmp@name, tmp)
+}
+
 # --- Handlers ---
 
 r2f_handlers[["c"]] <- function(args, scope = NULL, ...) {
@@ -156,17 +176,11 @@ fill_constructor_value <- function(literal, mode, args, scope, ..., hoist) {
   if (passes_as_scalar(var)) {
     return(out)
   }
-  calls <- list(...)$calls
-  parent_call <- if (length(calls) >= 2L) calls[[length(calls) - 1L]] else ""
+  parent_call <- parent_call_name(list(...)$calls)
   if (parent_call %in% c("<-", "=", "<<-", "c", "array", "matrix")) {
     return(out)
   }
-  if (is.null(hoist)) {
-    stop("internal error: fill constructor requires hoist context", call. = FALSE)
-  }
-  tmp <- hoist$declare_tmp(mode = mode, dims = var@dims)
-  hoist$emit(glue("{tmp@name} = {literal}"))
-  Fortran(tmp@name, tmp)
+  materialize_via_hoist(literal, mode, var@dims, hoist, "fill constructor")
 }
 
 register_r2f_handler(
@@ -228,18 +242,11 @@ r2f_handlers[["matrix"]] <- function(args, scope = NULL, ..., hoist = NULL) {
   # it as-is there; in any other context (sum(...), %*%, ...) the expression
   # must be a real rank-2 array, so materialize it into a hoisted temporary.
   if (passes_as_scalar(src@value)) {
-    calls <- list(...)$calls
-    parent_call <- if (length(calls) >= 2L) calls[[length(calls) - 1L]] else ""
-    if (parent_call %in% c("<-", "=", "<<-")) {
+    if (parent_call_name(list(...)$calls) %in% c("<-", "=", "<<-")) {
       src@value <- out_val
       return(src)
     }
-    if (is.null(hoist)) {
-      stop("internal error: matrix() requires hoist context", call. = FALSE)
-    }
-    tmp <- hoist$declare_tmp(mode = src@value@mode, dims = dims)
-    hoist$emit(glue("{tmp@name} = {src}"))
-    return(Fortran(tmp@name, tmp))
+    return(materialize_via_hoist(src, src@value@mode, dims, hoist, "matrix()"))
   }
 
   rows <- dims[[1L]]

From 6906f16ff65f5881b52bd6d1e5b0d25921162f03 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 13:30:52 +0200
Subject: [PATCH 07/97] Guard symbolic-length vectors against 1x1 matrices
 instead of scalarizing

R's length-1-array recycling drops the array dims only when the vector's
length is not 1; for a length-1 vector the 1x1 dims are kept. Scalarizing
whenever the length was not *provably* 1 answered the compile-time
question "is the length 1?" with "no" when the truth was "unknown", so
a symbolic-length vector that turned out to have length 1 at run time
returned a dimensionless vector where R returns a 1x1 matrix -- a silent
shape divergence.

Scalarize only when the length is statically known and not 1 (the cases
where R itself drops the dims, including length 0). Symbolic lengths fall
through to the vector-matrix rule: a runtime guard requires length 1, the
result is a 1x1 matrix, and longer vectors raise an error where R would
recycle (a deprecated behavior in R).

Found by codex review (fable-final round); reproduces on upstream main.
---
 NEWS.md                         | 22 ++++++++++++++++------
 R/r2f-operators-helpers.R       | 24 ++++++++++++++++++------
 tests/testthat/test-recycling.R | 25 +++++++++++++++++++++++++
 3 files changed, 59 insertions(+), 12 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index fcd22065..aa90b7d5 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -15,12 +15,22 @@
   out of bounds. Statically unequal lengths are now a compile-time error;
   lengths that cannot be verified at compile time are checked at run time.
 
-- `1x1`-matrix operands now follow R's rules: in arithmetic they are
-  treated as scalars (which R allows, with a deprecation warning), while in
-  comparisons and `&`/`|` they are treated as one-row matrices, so
-  mismatched shapes are rejected — matching R, which raises an error.
-  Previously a `1x1` matrix was treated as a scalar everywhere, so e.g.
-  `x < m` with `m` a `1x1` matrix returned answers where R errors.
+- `1x1`-matrix operands now follow R's rules: in arithmetic against a
+  vector of statically known length other than 1 they are treated as
+  scalars and the result is a plain vector (which R allows, with a
+  deprecation warning), while in comparisons and `&`/`|` they are treated
+  as one-row matrices, so mismatched shapes are rejected — matching R,
+  which raises an error. When the vector's length is only known at run
+  time, the result's shape would depend on that value (R keeps the `1x1`
+  dims for a length-1 vector and drops them otherwise), so arithmetic
+  also takes the one-row-matrix rule: a runtime check requires length 1
+  and the result is a `1x1` matrix; longer vectors raise an error where
+  R would recycle. Previously a `1x1` matrix was scalarized in arithmetic
+  and not shape-checked at all in comparisons and `&`/`|`, so e.g.
+  `x < m` with `m` a `1x1` matrix failed to build with a Fortran rank
+  mismatch instead of a quickr error, an operand needing a cast failed to
+  build even in arithmetic, and a symbolic-length `x + m` returned a plain
+  vector where R returns a `1x1` matrix.
 
 # quickr 0.3.0
 
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 69f480c2..ff4b3430 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -128,6 +128,13 @@ dim_is_one <- function(x) {
   is_wholenumber(x) && identical(as.integer(x), 1L)
 }
 
+# Check if a dimension expression is statically known and not 1. Symbolic
+# dimensions are FALSE: "not provably 1" is not "provably not 1".
+# Used by: maybe_reshape_vector_matrix()
+dim_known_not_one <- function(x) {
+  is_wholenumber(x) && !identical(as.integer(x), 1L)
+}
+
 # Check if a Fortran value is a 1x1 matrix.
 # Used by: r2f-arithmetic.R, r2f-logical.R
 is_one_by_one <- function(x) {
@@ -238,10 +245,15 @@ scalarize_matrix <- function(mat) {
 # size guard through `hoist`.
 #
 # `scalarize_one_by_one` mirrors R's split over length-1 arrays: arithmetic
-# recycles a 1x1 matrix against a longer vector (deprecated in R but still
-# the behavior), while comparisons and & | error. Strict callers pass FALSE
-# so the 1x1 falls through to the vector-matrix rule and is rejected or
-# guarded like any other 1-row matrix.
+# recycles a 1x1 matrix against a vector of statically known length != 1
+# (deprecated in R but still the behavior: R drops the array dims). When
+# the vector's length is only known at run time, the result's shape would
+# depend on that value -- R keeps the 1x1 dims for a length-1 vector and
+# drops them otherwise -- so the 1x1 falls through to the vector-matrix
+# rule: a runtime guard requires length 1 and the result is a 1x1 matrix,
+# an error where R would recycle. Comparisons and & | error in R itself,
+# so strict callers pass FALSE and the 1x1 always takes the vector-matrix
+# path.
 # Used by: r2f-arithmetic.R, r2f-logical.R
 maybe_reshape_vector_matrix <- function(
   left,
@@ -281,7 +293,7 @@ maybe_reshape_vector_matrix <- function(
       is_one_by_one(left)
   ) {
     right_len <- dim_or_one(right, 1L)
-    if (!dim_is_one(right_len)) {
+    if (dim_known_not_one(right_len)) {
       left <- scalarize_via_hoist(left)
       left_rank <- 0L
     }
@@ -292,7 +304,7 @@ maybe_reshape_vector_matrix <- function(
       is_one_by_one(right)
   ) {
     left_len <- dim_or_one(left, 1L)
-    if (!dim_is_one(left_len)) {
+    if (dim_known_not_one(left_len)) {
       right <- scalarize_via_hoist(right)
       right_rank <- 0L
     }
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index 3f7cd0f3..ca2165df 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -149,6 +149,31 @@ test_that("1x1 matrix operands follow R: arithmetic scalarizes, strict ops rejec
   expect_error(qcmp(c(1, 2, 3), matrix(5)), "matrix first dimension")
 })
 
+test_that("1x1 matrix with a symbolic-length vector keeps R's shape", {
+  # The result's shape depends on the runtime length: R keeps the 1x1
+  # dims for a length-1 vector and drops them for any other length, so no
+  # static decision can be right for both. Scalarizing regardless (the
+  # old behavior) silently returned a dimensionless vector where R
+  # returns a 1x1 matrix. Symbolic lengths now take the vector-matrix
+  # rule instead: a runtime guard requires length 1 and the result is a
+  # 1x1 matrix; longer vectors error where R would recycle (deprecated).
+  fn <- function(m, x) {
+    declare(type(m = double(1, 1)), type(x = double(n)))
+    m + x
+  }
+  qfn <- quick(fn)
+  expect_identical(qfn(matrix(2), 3), fn(matrix(2), 3))
+  expect_error(qfn(matrix(2), c(1, 2, 3)), "matrix first dimension")
+
+  rev_fn <- function(x, m) {
+    declare(type(x = double(n)), type(m = double(1, 1)))
+    x + m
+  }
+  qrev <- quick(rev_fn)
+  expect_identical(qrev(3, matrix(2)), rev_fn(3, matrix(2)))
+  expect_error(qrev(c(1, 2, 3), matrix(2)), "matrix first dimension")
+})
+
 test_that("guard text is pinned (one snapshot per mechanism)", {
   fn <- function(a, b) {
     declare(type(a = double(n)), type(b = double(m)))

From 06f705736105ab01840332c8e556124945cb3f0e Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 11 Jul 2026 10:45:33 +0200
Subject: [PATCH 08/97] Format with air

---
 R/r2f-constructors.R | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index d25c3a93..14ff9f4a 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -186,7 +186,14 @@ fill_constructor_value <- function(literal, mode, args, scope, ..., hoist) {
 register_r2f_handler(
   "logical",
   function(args, scope, ..., hoist = NULL) {
-    fill_constructor_value(".false.", "logical", args, scope, ..., hoist = hoist)
+    fill_constructor_value(
+      ".false.",
+      "logical",
+      args,
+      scope,
+      ...,
+      hoist = hoist
+    )
   },
   match_fun = FALSE
 )
@@ -194,7 +201,14 @@ register_r2f_handler(
 register_r2f_handler(
   "integer",
   function(args, scope, ..., hoist = NULL) {
-    fill_constructor_value("0_c_int", "integer", args, scope, ..., hoist = hoist)
+    fill_constructor_value(
+      "0_c_int",
+      "integer",
+      args,
+      scope,
+      ...,
+      hoist = hoist
+    )
   },
   match_fun = FALSE
 )

From 7358165dc17fcd115855654780c2f0cfc6f3b105 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sun, 2 Aug 2026 14:16:00 +0200
Subject: [PATCH 09/97] Cover the length-0 verdict and closure-return
 materialization

Two paths added by this PR had no test reaching them.

check_elementwise_lengths() rejects a known length-0 operand separately
from the both-lengths-known case, for when the other length is not a
number it can be compared to. The existing zero-length test declares
double(0) against double(4), which takes the both-known branch, so the
separate verdict was never exercised. Add the symbolic and NA-dim
counterparts (numeric(0) + x with x of length n, and double(NA) - double(0)),
where R answers numeric(0) and quickr has no length-0 result to return.

The fill/matrix materialization decision reads the enclosing call to
decide whether the scalar-with-dims form is understood, and falls back to
"no enclosing call" when the stack is empty. A function body must be
braced, so that fallback is unreachable at top level -- but a local
closure's return expression is compiled on its own, with no calls stack,
so a closure returning numeric(k) or matrix(scalar, m, n) lands there and
has to materialize. Both compile and match R.

Reported by codecov (PR 142 patch coverage).
---
 tests/testthat/test-recycling.R | 50 +++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)

diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index ca2165df..5404967e 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -25,6 +25,36 @@ test_that("known unequal vector lengths are a compile error", {
   expect_error(quick(zero_len), "equal lengths")
 })
 
+test_that("a known length-0 operand is rejected against an unknown length", {
+  # R answers numeric(0) here; quickr has no length-0 result to return, so
+  # the zero is rejected even when the other operand's length is not a
+  # number the compiler can compare it to.
+  fill_left <- function(x) {
+    declare(type(x = double(n)))
+    numeric(0) + x
+  }
+  expect_error(quick(fill_left), "equal lengths")
+
+  fill_right <- function(x) {
+    declare(type(x = double(n)))
+    x > numeric(0)
+  }
+  expect_error(quick(fill_right), "equal lengths")
+
+  declared <- function(a, b) {
+    declare(type(a = double(0)), type(b = double(n)))
+    a * b
+  }
+  expect_error(quick(declared), "equal lengths")
+
+  # An NA dim is unknown, not "matches anything"
+  unspecified <- function(a, b) {
+    declare(type(a = double(NA)), type(b = double(0)))
+    a - b
+  }
+  expect_error(quick(unspecified), "equal lengths")
+})
+
 test_that("length checks cover comparisons, logical ops, and modulo", {
   comparison <- function(a, b) {
     declare(type(a = double(2)), type(b = double(4)))
@@ -248,6 +278,26 @@ test_that("matrix(scalar, m, n) materializes where an array is required", {
   expect_quick_identical(transposed, list())
 })
 
+test_that("a closure's return expression materializes fills and matrix()", {
+  # A local closure's return expression is compiled on its own, with no
+  # enclosing call: the materialization decision sees an empty call stack,
+  # so nothing is broadcasting, spreading, or padding the scalar-with-dims
+  # form and it has to become a real array.
+  fill <- function(x) {
+    declare(type(x = double(3)))
+    zeros <- function() numeric(3)
+    x + zeros()
+  }
+  expect_quick_identical(fill, list(c(1, 2, 3)))
+
+  mat <- function(x) {
+    declare(type(x = double(2, 2)))
+    ones <- function() matrix(1, 2, 2)
+    x + ones()
+  }
+  expect_quick_identical(mat, list(matrix(as.double(1:4), 2, 2)))
+})
+
 test_that("matrix(scalar, m, n) keeps the broadcast fast path on assignment", {
   fn <- function(n, k) {
     declare(type(n = integer(1)), type(k = integer(1)))

From 6150f57f266eaf5783bbd0d3f659f7b39ddef140 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sun, 2 Aug 2026 14:16:10 +0200
Subject: [PATCH 10/97] Assert the hoist invariant instead of handling a NULL
 hoist

emit_elementwise_size_guard() and materialize_via_hoist() each opened with
a NULL-hoist branch raising a compile error. Neither is reachable: r2f()
opens a hoist per statement before dispatching to a handler, and every
operator and constructor handler forwards the one it received, so no R
program can put a NULL there. The branches only showed up as uncovered
patch lines.

Drop both. emit_quickr_error_if() already asserts the hoist is an
environment, so the guard needed nothing in its place;
materialize_via_hoist() gets a stopifnot() and loses its `what` argument,
which existed only to name the construct in the removed message.
maybe_reshape_vector_matrix() drops its hoist/scope defaults for the same
reason -- all callers pass both, and the defaults implied a caller that
cannot exist.

Reported by codecov (PR 142 patch coverage).
---
 R/r2f-constructors.R      | 14 ++++++--------
 R/r2f-operators-helpers.R | 15 ++++++---------
 2 files changed, 12 insertions(+), 17 deletions(-)

diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index 14ff9f4a..ba362548 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -23,12 +23,10 @@ parent_call_name <- function(calls) {
 }
 
 # Materialize `code` into a hoisted temporary and return the temporary.
-# `what` names the construct for the internal-error message when no hoist
-# context is available.
-materialize_via_hoist <- function(code, mode, dims, hoist, what) {
-  if (is.null(hoist)) {
-    stop("internal error: ", what, " requires hoist context", call. = FALSE)
-  }
+# `hoist` is always available in a handler: r2f() opens one per statement
+# before dispatching, and the constructor handlers forward what they got.
+materialize_via_hoist <- function(code, mode, dims, hoist) {
+  stopifnot(is.environment(hoist))
   tmp <- hoist$declare_tmp(mode = mode, dims = dims)
   hoist$emit(glue("{tmp@name} = {code}"))
   Fortran(tmp@name, tmp)
@@ -180,7 +178,7 @@ fill_constructor_value <- function(literal, mode, args, scope, ..., hoist) {
   if (parent_call %in% c("<-", "=", "<<-", "c", "array", "matrix")) {
     return(out)
   }
-  materialize_via_hoist(literal, mode, var@dims, hoist, "fill constructor")
+  materialize_via_hoist(literal, mode, var@dims, hoist)
 }
 
 register_r2f_handler(
@@ -260,7 +258,7 @@ r2f_handlers[["matrix"]] <- function(args, scope = NULL, ..., hoist = NULL) {
       src@value <- out_val
       return(src)
     }
-    return(materialize_via_hoist(src, src@value@mode, dims, hoist, "matrix()"))
+    return(materialize_via_hoist(src, src@value@mode, dims, hoist))
   }
 
   rows <- dims[[1L]]
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index ff4b3430..8cfd1cb4 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -186,6 +186,10 @@ check_elementwise_lengths <- function(left, right) {
 # equal size along the given axes (whole size when an axis is NULL).
 # size() is an inquiry, so applying it to operand expression text does not
 # evaluate the operands.
+#
+# `hoist` is always available here: r2f() opens one per statement before
+# dispatching to a handler, and every operator handler forwards the one it
+# received. emit_quickr_error_if() asserts it.
 # Used by: maybe_reshape_vector_matrix()
 emit_elementwise_size_guard <- function(
   left,
@@ -196,13 +200,6 @@ emit_elementwise_size_guard <- function(
   left_axis = NULL,
   right_axis = left_axis
 ) {
-  if (is.null(hoist)) {
-    stop(
-      "cannot emit a runtime length guard here; ",
-      "operand lengths must match statically",
-      call. = FALSE
-    )
-  }
   size_of <- function(x, axis) {
     if (is.null(axis)) glue("size({x})") else glue("size({x}, {axis})")
   }
@@ -258,8 +255,8 @@ scalarize_matrix <- function(mat) {
 maybe_reshape_vector_matrix <- function(
   left,
   right,
-  hoist = NULL,
-  scope = NULL,
+  hoist,
+  scope,
   scalarize_one_by_one = TRUE
 ) {
   if (

From bf7c91e53783024aea635e4b19fed200229df84a Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 4 Jul 2026 11:46:30 +0200
Subject: [PATCH 11/97] Guard BLAS conformability at runtime; drop warning and
 crossprod stop

Linear-algebra lowerings had three reactions to dims they could not
verify at compile time, none of which stopped the bad call: %*%, the
gemv/gemm paths, triangular solve, solve() right-hand sides, and the
square-matrix checks warned at compile time and proceeded (dgemv with a
short x silently read out of bounds; other shapes died with a cryptic
"BLAS/LAPACK routine 'DGEMM ' gave error code -10"); crossprod and
tcrossprod hard-errored at compile time, rejecting programs that are
fine at run time; and two operands both declared with NA dims skipped
every check, because identical(NA, NA) is TRUE.

One policy now, the same one the elementwise operators follow: a
statically known mismatch is a compile error; anything unverifiable
gets a statement-level runtime guard -- one scalar size() comparison
emitted immediately before the BLAS/LAPACK call, raising the error R
raises ("non-conformable arguments in %*%"). The compile-time warning
is retired (it fired once per call site for a condition only the run
time can decide); crossprod relaxes to the guard, so strictly more
programs compile, all safely; NA dims are always treated as
unverified, never equal.

guard_conformable_dims() + guard_dim_f() in r2f-matrix-blas.R replace
the warn/assert patchwork (assert_conformable_dims and
warn_conformability_unknown are deleted; assert_square_matrix becomes
a wrapper that also takes the operand and hoist/scope). A literal dim
renders as the literal; anything else as size(operand[, axis]), an
inquiry that does not evaluate operand expressions. check_conformable
survives only where the verdict steers codegen rather than safety:
lapack_solve's square-vs-rectangular dispatch, and bind_common_dim,
whose unknown-dims compile error is deliberate (the common dim is
needed to declare the cbind/rbind output) and now documented.

Message change for statically known non-square triangular solves:
"triangular solve requires a square matrix" (was "non-conformable
arguments in triangular solve"), matching the other square checks.
---
 R/r2f-matrix-blas.R                    | 157 +++++++++++++------------
 R/r2f-matrix.R                         |  78 ++++++------
 tests/testthat/_snaps/blas-guards.md   | 130 ++++++++++++++++++++
 tests/testthat/test-blas-guards.R      | 105 +++++++++++++++++
 tests/testthat/test-matrix-inference.R |  31 +++--
 5 files changed, 383 insertions(+), 118 deletions(-)
 create mode 100644 tests/testthat/_snaps/blas-guards.md
 create mode 100644 tests/testthat/test-blas-guards.R

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 46d27196..fc0ee2c6 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -61,15 +61,50 @@ assert_rhs_rank <- function(
   invisible(TRUE)
 }
 
-# Assert conformability and warn on unknown.
-assert_conformable_dims <- function(left, right, context, err_msg) {
-  stopifnot(is_string(context), is_string(err_msg))
-  conform <- check_conformable(left, right)
+# Render one side of a dim-comparison guard: a literal dim as the literal,
+# anything else as the operand's actual extent. size() is an inquiry, so
+# applying it to operand expression text does not evaluate the operand.
+guard_dim_f <- function(dim, operand, axis = NULL) {
+  if (is_wholenumber(dim)) {
+    return(as.character(as.integer(dim)))
+  }
+  if (is.null(axis)) {
+    glue("size({operand})")
+  } else {
+    glue("size({operand}, {axis})")
+  }
+}
+
+# The one conformability policy for BLAS/LAPACK lowerings: a statically
+# known mismatch is a compile error; dims that cannot be compared
+# statically get a statement-level runtime guard emitted before the BLAS
+# call; provably equal dims need nothing. Never warn-and-proceed. `axis`
+# NULL compares the operand's whole size (rank-1 operands).
+guard_conformable_dims <- function(
+  left_dim,
+  right_dim,
+  message,
+  hoist,
+  scope,
+  left,
+  right,
+  left_axis = NULL,
+  right_axis = NULL
+) {
+  stopifnot(is_string(message))
+  conform <- check_elementwise_lengths(left_dim, right_dim)
   if (!conform$ok) {
-    stop(err_msg, call. = FALSE)
+    stop(message, call. = FALSE)
   }
   if (conform$unknown) {
-    warn_conformability_unknown(left, right, context)
+    emit_quickr_error_if(
+      glue(
+        "{guard_dim_f(left_dim, left, left_axis)} /= {guard_dim_f(right_dim, right, right_axis)}"
+      ),
+      message,
+      hoist,
+      scope
+    )
   }
   invisible(TRUE)
 }
@@ -176,33 +211,21 @@ check_conformable <- function(left, right) {
   list(ok = TRUE, unknown = TRUE)
 }
 
-warn_conformability_unknown <- function(left, right, context) {
-  left_txt <- if (is.null(left)) "NULL" else deparse(left)
-  right_txt <- if (is.null(right)) "NULL" else deparse(right)
-  warning(
-    "cannot verify conformability in ",
-    context,
-    " at compile time: ",
-    left_txt,
-    " vs ",
-    right_txt,
-    call. = FALSE
+# Enforce that `dims` describe a square matrix: a known mismatch is a
+# compile error; unverifiable dims get a runtime guard on the operand's
+# actual extents.
+assert_square_matrix <- function(dims, operand, context, hoist, scope) {
+  guard_conformable_dims(
+    dims$rows,
+    dims$cols,
+    paste0(context, " requires a square matrix"),
+    hoist,
+    scope,
+    left = operand,
+    right = operand,
+    left_axis = 1L,
+    right_axis = 2L
   )
-  invisible(FALSE)
-}
-
-# Assert that dimensions represent a square matrix (rows == cols).
-# Throws an error if dimensions are known to be non-conformable,
-# and warns if conformability cannot be verified at compile time.
-assert_square_matrix <- function(rows, cols, context) {
-  conform <- check_conformable(rows, cols)
-  if (!conform$ok) {
-    stop(context, " requires a square matrix", call. = FALSE)
-  }
-  if (conform$unknown) {
-    warn_conformability_unknown(rows, cols, context)
-  }
-  invisible(TRUE)
 }
 
 # ---- BLAS emitters ----
@@ -566,13 +589,7 @@ triangular_solve <- function(
   assert_rank2_matrix(A, "triangular solve expects a matrix")
 
   a_dims <- matrix_dims(A)
-  conform <- check_conformable(a_dims$rows, a_dims$cols)
-  if (!conform$ok) {
-    stop("non-conformable arguments in triangular solve", call. = FALSE)
-  }
-  if (conform$unknown) {
-    warn_conformability_unknown(a_dims$rows, a_dims$cols, "triangular solve")
-  }
+  assert_square_matrix(a_dims, A, "triangular solve", hoist, scope)
   n <- a_dims$rows
 
   b_rank <- B@value@rank
@@ -581,23 +598,17 @@ triangular_solve <- function(
     err_scalar = "triangular solve expects a vector or matrix right-hand side",
     err_high = "triangular solve only supports vector or matrix right-hand sides"
   )
-  if (b_rank == 1L) {
-    b_len <- dim_or_one(B, 1L)
-    assert_conformable_dims(
-      n,
-      b_len,
-      context = "triangular solve",
-      err_msg = "non-conformable arguments in triangular solve"
-    )
-  } else {
-    b_rows <- dim_or_one(B, 1L)
-    assert_conformable_dims(
-      n,
-      b_rows,
-      context = "triangular solve",
-      err_msg = "non-conformable arguments in triangular solve"
-    )
-  }
+  guard_conformable_dims(
+    n,
+    dim_or_one(B, 1L),
+    "non-conformable arguments in triangular solve",
+    hoist,
+    scope,
+    left = A,
+    right = B,
+    left_axis = 1L,
+    right_axis = if (b_rank == 1L) NULL else 1L
+  )
 
   A_name <- ensure_blas_operand_name(A, hoist)
   B_input_name <- symbol_name_or_null(B)
@@ -675,23 +686,17 @@ lapack_solve <- function(
     call_high = FALSE
   )
 
-  if (b_rank == 1L) {
-    b_len <- dim_or_one(B, 1L)
-    assert_conformable_dims(
-      m,
-      b_len,
-      context = context,
-      err_msg = paste0("non-conformable arguments in ", context)
-    )
-  } else {
-    b_rows <- dim_or_one(B, 1L)
-    assert_conformable_dims(
-      m,
-      b_rows,
-      context = context,
-      err_msg = paste0("non-conformable arguments in ", context)
-    )
-  }
+  guard_conformable_dims(
+    m,
+    dim_or_one(B, 1L),
+    paste0("non-conformable arguments in ", context),
+    hoist,
+    scope,
+    left = A,
+    right = B,
+    left_axis = 1L,
+    right_axis = if (b_rank == 1L) NULL else 1L
+  )
 
   A_name <- ensure_blas_operand_name(A, hoist)
   B_input_name <- ensure_blas_operand_name(B, hoist)
@@ -987,7 +992,7 @@ lapack_inverse <- function(A, scope, hoist, dest = NULL, context = "solve") {
   assert_rank2_matrix(A, paste0(context, " expects a matrix for `a`"))
 
   a_dims <- matrix_dims(A)
-  assert_square_matrix(a_dims$rows, a_dims$cols, context)
+  assert_square_matrix(a_dims, A, context, hoist, scope)
   n <- a_dims$rows
 
   A_name <- ensure_blas_operand_name(A, hoist)
@@ -1061,7 +1066,7 @@ lapack_chol <- function(A, scope, hoist, dest = NULL, context = "chol") {
   assert_rank2_matrix(A, paste0(context, " expects a matrix"))
 
   a_dims <- matrix_dims(A)
-  assert_square_matrix(a_dims$rows, a_dims$cols, context)
+  assert_square_matrix(a_dims, A, context, hoist, scope)
   n <- a_dims$rows
 
   A_name <- ensure_blas_operand_name(A, hoist)
@@ -1124,7 +1129,7 @@ lapack_chol2inv <- function(
   assert_rank2_matrix(R, paste0(context, " expects a matrix"))
 
   r_dims <- matrix_dims(R)
-  assert_square_matrix(r_dims$rows, r_dims$cols, context)
+  assert_square_matrix(r_dims, R, context, hoist, scope)
   n <- r_dims$rows
 
   R_name <- ensure_blas_operand_name(R, hoist)
diff --git a/R/r2f-matrix.R b/R/r2f-matrix.R
index 6615f46c..9fc5c233 100644
--- a/R/r2f-matrix.R
+++ b/R/r2f-matrix.R
@@ -53,13 +53,16 @@ register_r2f_handler(
     # Matrix-Vector: use GEMV
     if (left_rank == 2 && right_rank == 1) {
       expected_len <- if (left_trans == "N") left_dims$cols else left_dims$rows
-      conform <- check_conformable(expected_len, right_dims$rows)
-      if (!conform$ok) {
-        stop("non-conformable arguments in %*%", call. = FALSE)
-      }
-      if (conform$unknown) {
-        warn_conformability_unknown(expected_len, right_dims$rows, "%*%")
-      }
+      guard_conformable_dims(
+        expected_len,
+        right_dims$rows,
+        "non-conformable arguments in %*%",
+        hoist,
+        scope,
+        left = left,
+        right = right,
+        left_axis = if (left_trans == "N") 2L else 1L
+      )
       out_len <- if (left_trans == "N") left_dims$rows else left_dims$cols
       return(gemv(
         transA = left_trans,
@@ -79,13 +82,16 @@ register_r2f_handler(
     if (left_rank == 1 && right_rank == 2) {
       transA <- if (right_trans == "N") "T" else "N"
       expected_len <- if (transA == "N") right_dims$cols else right_dims$rows
-      conform <- check_conformable(left_dims$cols, expected_len)
-      if (!conform$ok) {
-        stop("non-conformable arguments in %*%", call. = FALSE)
-      }
-      if (conform$unknown) {
-        warn_conformability_unknown(left_dims$cols, expected_len, "%*%")
-      }
+      guard_conformable_dims(
+        left_dims$cols,
+        expected_len,
+        "non-conformable arguments in %*%",
+        hoist,
+        scope,
+        left = left,
+        right = right,
+        right_axis = if (transA == "N") 2L else 1L
+      )
       out_len <- if (transA == "N") right_dims$rows else right_dims$cols
       return(gemv(
         transA = transA,
@@ -102,13 +108,17 @@ register_r2f_handler(
       ))
     }
 
-    conform <- check_conformable(k, right_eff$rows)
-    if (!conform$ok) {
-      stop("non-conformable arguments in %*%", call. = FALSE)
-    }
-    if (conform$unknown) {
-      warn_conformability_unknown(k, right_eff$rows, "%*%")
-    }
+    guard_conformable_dims(
+      k,
+      right_eff$rows,
+      "non-conformable arguments in %*%",
+      hoist,
+      scope,
+      left = left,
+      right = right,
+      left_axis = if (left_trans == "N") 2L else 1L,
+      right_axis = if (right_trans == "N") 1L else 2L
+    )
 
     # Matrix-Matrix
     gemm(
@@ -244,6 +254,9 @@ bind_dim_sum <- function(values, context, label) {
   reduce(values, \(a, b) call("+", a, b))
 }
 
+# Unlike the BLAS conformability checks, unknown dims here stay a compile
+# error: the common dim is needed to declare the cbind/rbind output, and a
+# runtime guard cannot conjure a declaration.
 bind_common_dim <- function(dim_list, scalar_flags, context, label) {
   non_scalar <- which(!scalar_flags)
   if (!length(non_scalar)) {
@@ -916,18 +929,17 @@ crossprod_like <- function(
   x_eff <- effective_dims(x_dims, opA)
   y_eff <- effective_dims(y_dims, opB)
 
-  conform <- check_conformable(x_eff$cols, y_eff$rows)
-  if (!conform$ok) {
-    stop("non-conformable arguments in ", context, call. = FALSE)
-  }
-  if (conform$unknown) {
-    stop(
-      "cannot verify conformability in ",
-      context,
-      " at compile time",
-      call. = FALSE
-    )
-  }
+  guard_conformable_dims(
+    x_eff$cols,
+    y_eff$rows,
+    paste0("non-conformable arguments in ", context),
+    hoist,
+    scope,
+    left = x,
+    right = y,
+    left_axis = if (opA == "N") 2L else 1L,
+    right_axis = if (opB == "N") 1L else 2L
+  )
 
   m <- x_eff$rows
   n <- y_eff$cols
diff --git a/tests/testthat/_snaps/blas-guards.md b/tests/testthat/_snaps/blas-guards.md
new file mode 100644
index 00000000..11256717
--- /dev/null
+++ b/tests/testthat/_snaps/blas-guards.md
@@ -0,0 +1,130 @@
+# guard text is pinned (one snapshot per mechanism)
+
+    Code
+      cat("# Snapshot note: ", note, "\n", sep = "")
+    Output
+      # Snapshot note: Unverifiable BLAS dims emit one size guard before the call.
+    Code
+      fn
+    Output
+      function(m, x) {
+          declare(type(m = double(3, 3)), type(x = double(NA)))
+          m %*% x
+        }
+      <environment: 0x0>
+    Code
+      cat(fsub)
+    Output
+      subroutine fn(m, x, out_, x__len_, quickr_err_msg) bind(c)
+        use iso_c_binding, only: c_char, c_double, c_int, c_null_char, c_ptrdiff_t
+        implicit none
+      
+        ! manifest start
+        ! sizes
+        integer(c_ptrdiff_t), intent(in), value :: x__len_
+      
+        ! error
+        character(kind=c_char), intent(inout) :: quickr_err_msg(256)
+      
+        ! args
+        real(c_double), intent(in) :: m(3, 3)
+        real(c_double), intent(in) :: x(x__len_)
+        real(c_double), intent(out) :: out_(3, 1)
+        ! manifest end
+      
+      
+        if (3 /= size(x)) then
+          call quickr_set_error_msg("non-conformable arguments in %*%")
+          return
+        end if
+      call dgemv('N', int(3, kind=c_int), int(3, kind=c_int), 1.0_c_double, m, int(3, kind=c_int), x, 1_c_int, 0.0_c_double, out_,&
+      & 1_c_int)
+      
+        contains
+          subroutine quickr_set_error_msg(msg)
+            character(len=*), intent(in) :: msg
+            integer :: i
+            integer :: n
+            if (quickr_err_msg(1) == c_null_char) then
+              n = min(len(msg), 256 - 1)
+              quickr_err_msg(1:n) = [(msg(i:i), i = 1, n)]
+              quickr_err_msg(n + 1) = c_null_char
+            end if
+          end subroutine quickr_set_error_msg
+      end subroutine
+    Code
+      cat(cwrapper)
+    Output
+      #define R_NO_REMAP
+      #include <R.h>
+      #include <Rinternals.h>
+      
+      
+      extern void fn(
+        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) {
+        // m
+        _args = CDR(_args);
+        SEXP m = CAR(_args);
+        if (TYPEOF(m) != REALSXP) {
+          Rf_error("typeof(m) must be 'double', not '%s'", Rf_type2char(TYPEOF(m)));
+        }
+        const double* const m__ = REAL(m);
+        const int* const m__dim_ = ({
+        SEXP dim_ = Rf_getAttrib(m, R_DimSymbol);
+        if (Rf_length(dim_) != 2) Rf_error(
+          "m must be a 2D-array, but length(dim(m)) is %i",
+          (int) Rf_length(dim_));
+        INTEGER(dim_);});
+        const int m__dim_1_ = m__dim_[0];
+        const int m__dim_2_ = m__dim_[1];
+        
+        // x
+        _args = CDR(_args);
+        SEXP x = CAR(_args);
+        if (TYPEOF(x) != REALSXP) {
+          Rf_error("typeof(x) must be 'double', not '%s'", Rf_type2char(TYPEOF(x)));
+        }
+        const double* const x__ = REAL(x);
+        const R_xlen_t x__len_ = Rf_xlength(x);
+        
+        if (m__dim_1_ != 3)
+          Rf_error("dim(m)[1] must be 3, not %0.f",
+                    (double)m__dim_1_);
+        if (m__dim_2_ != 3)
+          Rf_error("dim(m)[2] must be 3, not %0.f",
+                    (double)m__dim_2_);
+        const R_xlen_t out___len_ = (3) * (1);
+        SEXP out_ = PROTECT(Rf_allocVector(REALSXP, out___len_));
+        double* out___ = REAL(out_);
+        {
+          const SEXP _dim_sexp = PROTECT(Rf_allocVector(INTSXP, 2));
+          int* const _dim = INTEGER(_dim_sexp);
+          _dim[0] = 3;
+          _dim[1] = 1;
+          Rf_dimgets(out_, _dim_sexp);
+        }
+        
+        char quickr_err_msg[256];
+        quickr_err_msg[0] = '\0';
+        
+        
+        fn(
+          m__,
+          x__,
+          out___,
+          x__len_,
+          quickr_err_msg);
+        if (quickr_err_msg[0] != '\0') {
+          Rf_error("%s", quickr_err_msg);
+        }
+        
+        UNPROTECT(2);
+        return out_;
+      }
+
diff --git a/tests/testthat/test-blas-guards.R b/tests/testthat/test-blas-guards.R
new file mode 100644
index 00000000..6d81bcf1
--- /dev/null
+++ b/tests/testthat/test-blas-guards.R
@@ -0,0 +1,105 @@
+# Runtime conformability guards in BLAS/LAPACK lowerings: dims that cannot
+# be verified at compile time get a size() check before the BLAS call
+# (never a compile-time warning, never an unchecked call).
+
+skip_on_cran()
+
+test_that("matrix-vector %*% guards an unknown vector length", {
+  fn <- function(m, x) {
+    declare(type(m = double(3, 3)), type(x = double(NA)))
+    m %*% x
+  }
+  qfn <- expect_no_warning(quick(fn))
+  expect_equal(qfn(diag(3), as.double(1:3)), diag(3) %*% 1:3)
+  # was: dgemv read past the end of x, returning garbage
+  expect_error(qfn(diag(3), as.double(1:2)), "non-conformable arguments in %*%", fixed = TRUE)
+})
+
+test_that("vector-matrix %*% guards an unknown vector length", {
+  fn <- function(x, m) {
+    declare(type(x = double(NA)), type(m = double(3, 3)))
+    t(x) %*% m
+  }
+  qfn <- expect_no_warning(quick(fn))
+  expect_equal(qfn(as.double(1:3), diag(3)), t(as.double(1:3)) %*% diag(3))
+  expect_error(qfn(as.double(1:5), diag(3)), "non-conformable arguments in %*%", fixed = TRUE)
+})
+
+test_that("triangular solve guards squareness and RHS length", {
+  fn <- function(l, x) {
+    declare(type(l = double(n, k)), type(x = double(NA)))
+    forwardsolve(l, x)
+  }
+  qfn <- expect_no_warning(quick(fn))
+  l <- matrix(c(1, 2, 0, 3), 2, 2)
+  expect_equal(qfn(l, c(1, 5)), forwardsolve(l, c(1, 5)))
+  expect_error(
+    qfn(l, c(1, 5, 9)),
+    "non-conformable arguments in triangular solve"
+  )
+  expect_error(
+    qfn(matrix(as.double(1:6), 2, 3), c(1, 5)),
+    "triangular solve requires a square matrix"
+  )
+})
+
+test_that("solve() guards an unknown RHS length", {
+  fn <- function(a, b) {
+    declare(type(a = double(2, 2)), type(b = double(NA)))
+    solve(a, b)
+  }
+  qfn <- expect_no_warning(quick(fn))
+  expect_equal(qfn(diag(2), c(1, 2)), c(1, 2))
+  expect_error(qfn(diag(2), c(1, 2, 3)), "non-conformable arguments in solve")
+})
+
+test_that("solve(a) and chol() guard squareness", {
+  inv <- function(a) {
+    declare(type(a = double(n, k)))
+    solve(a)
+  }
+  qinv <- expect_no_warning(quick(inv))
+  expect_equal(qinv(diag(2)), diag(2))
+  expect_error(
+    qinv(matrix(as.double(1:6), 2, 3)),
+    "solve requires a square matrix"
+  )
+
+  chol_fn <- function(a) {
+    declare(type(a = double(n, k)))
+    chol(a)
+  }
+  qchol <- expect_no_warning(quick(chol_fn))
+  expect_equal(qchol(diag(2)), diag(2))
+  expect_error(
+    qchol(matrix(as.double(1:6), 2, 3)),
+    "chol requires a square matrix"
+  )
+})
+
+test_that("NA dims are never treated as equal", {
+  fn <- function(a, b) {
+    declare(type(a = double(NA, NA)), type(b = double(NA, NA)))
+    a %*% b
+  }
+  qfn <- expect_no_warning(quick(fn))
+  m <- matrix(as.double(1:4), 2, 2)
+  expect_equal(qfn(m, m), m %*% m)
+  # was: identical(NA, NA) blessed the pair with no check at all
+  expect_error(
+    qfn(m, matrix(as.double(1:6), 3, 2)),
+    "non-conformable arguments in %*%",
+    fixed = TRUE
+  )
+})
+
+test_that("guard text is pinned (one snapshot per mechanism)", {
+  fn <- function(m, x) {
+    declare(type(m = double(3, 3)), type(x = double(NA)))
+    m %*% x
+  }
+  expect_translation_snapshots(
+    fn,
+    note = "Unverifiable BLAS dims emit one size guard before the call."
+  )
+})
diff --git a/tests/testthat/test-matrix-inference.R b/tests/testthat/test-matrix-inference.R
index 7fd39231..0af431ed 100644
--- a/tests/testthat/test-matrix-inference.R
+++ b/tests/testthat/test-matrix-inference.R
@@ -137,7 +137,7 @@ test_that("matrix ops infer destination sizes for assignments", {
   expect_quick_equal(chol2inv_infer, list(A = A_pd))
 })
 
-test_that("crossprod requires conformability at compile time", {
+test_that("crossprod with unverifiable dims compiles and guards at runtime", {
   fn <- function(x, y, n, p, m, k) {
     declare(
       type(n = integer(1)),
@@ -150,10 +150,17 @@ test_that("crossprod requires conformability at compile time", {
     crossprod(x, y)
   }
 
+  # was: hard compile error "cannot verify conformability in crossprod"
+  qfn <- quick(fn)
+  x <- matrix(as.double(1:6), 2, 3)
+  y <- matrix(as.double(6:1), 2, 3)
+  expect_equal(
+    qfn(x, y, 2L, 2L, 3L, 3L),
+    crossprod(x, y)
+  )
   expect_error(
-    quick(fn),
-    "cannot verify conformability in crossprod",
-    fixed = TRUE
+    qfn(x, matrix(as.double(1:6), 3, 2), 2L, 3L, 3L, 2L),
+    "non-conformable arguments in crossprod"
   )
 })
 
@@ -212,8 +219,8 @@ test_that("matrix helpers report unsupported inputs", {
   expect_error(quick(back_bad_B), "triangular solve only supports vector")
 })
 
-test_that("matrix conformability warnings are surfaced", {
-  matmul_warn <- function(A, B, n, m, k) {
+test_that("unverifiable %*% dims compile without warning and guard at runtime", {
+  matmul_unknown <- function(A, B, n, m, k) {
     declare(
       type(n = integer(1)),
       type(m = integer(1)),
@@ -224,8 +231,14 @@ test_that("matrix conformability warnings are surfaced", {
     A %*% B
   }
 
-  expect_warning(
-    quick(matmul_warn),
-    "cannot verify conformability in %\\*%"
+  # was: compile-time R warning, then an unchecked BLAS call
+  qfn <- expect_no_warning(quick(matmul_unknown))
+  A <- matrix(as.double(1:6), 2, 3)
+  B <- matrix(as.double(6:1), 3, 2)
+  expect_equal(qfn(A, B, 2L, 3L, 3L), A %*% B)
+  expect_error(
+    qfn(A, matrix(as.double(1:4), 2, 2), 2L, 3L, 2L),
+    "non-conformable arguments in %*%",
+    fixed = TRUE
   )
 })

From b34e832e62a74d08bd8aa3fc040f31e3d888e0c9 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sun, 5 Jul 2026 11:19:26 +0200
Subject: [PATCH 12/97] Guard vector %*% vector by whole size, not rank-2 axes

The fallthrough %*% guard (reached by vector-vector products after the
gemv special cases) hardcoded rank-2 axes, emitting size(x, 2) on a
rank-1 array -- a gfortran error that made conformable unknown-length
dot products fail to compile. Compare whole vector sizes for rank-1
operands instead.

Also document why lapack_solve()'s squareness check is routing, not a
guard: rectangular solve(a, b) deliberately falls through to least
squares, a tested divergence from base R.
---
 R/r2f-matrix-blas.R               |  6 ++++++
 R/r2f-matrix.R                    |  8 ++++++--
 tests/testthat/test-blas-guards.R | 18 ++++++++++++++++++
 3 files changed, 30 insertions(+), 2 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index fc0ee2c6..baab43cc 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -703,6 +703,12 @@ lapack_solve <- function(
 
   nrhs <- if (b_rank == 1L) 1L else dim_or_one(B, 2L)
 
+  # solve(a, b) with a rectangular `a` deliberately falls through to the
+  # least-squares branch below -- a divergence from base R (which requires
+  # a square `a`), locked by the "least-squares" tests in
+  # test-matrix-lapack.R. Squareness is a routing decision here, not a
+  # correctness guard: unknown squareness routes to dgels, which solves
+  # square systems exactly too.
   square <- check_conformable(m, n)
   if (square$ok && !square$unknown && !identical(context, "qr.solve")) {
     A_work <- hoist$declare_tmp(mode = "double", dims = list(m, m))
diff --git a/R/r2f-matrix.R b/R/r2f-matrix.R
index 9fc5c233..e588e7c7 100644
--- a/R/r2f-matrix.R
+++ b/R/r2f-matrix.R
@@ -108,6 +108,8 @@ register_r2f_handler(
       ))
     }
 
+    # Vector operands (vector %*% vector reaches here) are rank-1: their
+    # extent is their whole size, not a rank-2 axis.
     guard_conformable_dims(
       k,
       right_eff$rows,
@@ -116,8 +118,10 @@ register_r2f_handler(
       scope,
       left = left,
       right = right,
-      left_axis = if (left_trans == "N") 2L else 1L,
-      right_axis = if (right_trans == "N") 1L else 2L
+      left_axis = if (left_rank == 1) NULL else if (left_trans == "N") 2L else
+        1L,
+      right_axis = if (right_rank == 1) NULL else if (right_trans == "N") 1L
+      else 2L
     )
 
     # Matrix-Matrix
diff --git a/tests/testthat/test-blas-guards.R b/tests/testthat/test-blas-guards.R
index 6d81bcf1..f881cdd5 100644
--- a/tests/testthat/test-blas-guards.R
+++ b/tests/testthat/test-blas-guards.R
@@ -43,6 +43,23 @@ test_that("triangular solve guards squareness and RHS length", {
   )
 })
 
+test_that("vector %*% vector guards unknown lengths as whole sizes", {
+  fn <- function(x, y) {
+    declare(type(x = double(NA)), type(y = double(NA)))
+    x %*% y
+  }
+  # was: the fallthrough guard hardcoded rank-2 axes, emitting size(x, 2)
+  # on a rank-1 array -- a gfortran error that made a conformable
+  # unknown-length dot product fail to compile at all
+  qfn <- expect_no_warning(quick(fn))
+  expect_equal(qfn(c(1, 2, 3), c(4, 5, 6)), c(1, 2, 3) %*% c(4, 5, 6))
+  expect_error(
+    qfn(c(1, 2), c(4, 5, 6)),
+    "non-conformable arguments in %*%",
+    fixed = TRUE
+  )
+})
+
 test_that("solve() guards an unknown RHS length", {
   fn <- function(a, b) {
     declare(type(a = double(2, 2)), type(b = double(NA)))
@@ -53,6 +70,7 @@ test_that("solve() guards an unknown RHS length", {
   expect_error(qfn(diag(2), c(1, 2, 3)), "non-conformable arguments in solve")
 })
 
+
 test_that("solve(a) and chol() guard squareness", {
   inv <- function(a) {
     declare(type(a = double(n, k)))

From 94d81c351a84999ac2dcb146c95b78372b83a7f9 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sun, 5 Jul 2026 13:42:18 +0200
Subject: [PATCH 13/97] Add combinatorial conformability grid tests

Transcribe the mode and shape contract tables into an expected-outcome
function and check every (mode pair, shape pair, op) cell against plain
R: valid cells must match values, typeof(), and shape; statically
invalid cells must fail with the documented compile message; symbolic
cells must guard at runtime. Cells sharing a shape pair pack into one
compiled function per op family, so the default deterministic sample
costs ~20 gfortran runs; QUICKR_FULL_GRID=1 compiles every shape pair.
---
 tests/testthat/test-conformability-grid.R | 871 ++++++++++++++++++++++
 1 file changed, 871 insertions(+)
 create mode 100644 tests/testthat/test-conformability-grid.R

diff --git a/tests/testthat/test-conformability-grid.R b/tests/testthat/test-conformability-grid.R
new file mode 100644
index 00000000..9e354881
--- /dev/null
+++ b/tests/testthat/test-conformability-grid.R
@@ -0,0 +1,871 @@
+# Combinatorial enforcement of the conformability contract: every cell of
+#   mode(left) x mode(right) x shape(left) x shape(right) x op
+# is checked against plain R as the oracle.
+
+skip_on_cran()
+
+# Valid cells must match R exactly
+# (values, typeof(), shape); statically invalid cells must fail to compile
+# with the documented message; statically undecidable cells must compile a
+# runtime guard that matches R on conformable inputs and raises the
+# documented error on nonconformable ones.
+#
+# Compile-cost control: cells sharing a shape pair are packed into one
+# compiled function with one statement per (op, mode pair, operand order),
+# so one gfortran invocation covers up to ~90 cells. Ops split into two
+# packed families because both operand orders appear in one function, so
+# every operand is also a divisor/exponent somewhere:
+#   gen: + - * < == & |   -- safe for any values (zeros, FALSE, negatives)
+#   div: / ^ %% %/%       -- operands chosen zero-free and pow-safe, since
+#        R answers the unsafe cells with NA/NaN (documented not-supported)
+#        or traps SIGFPE in Fortran integer division
+# Value edges ride along as input choices: negative dividends/divisors and
+# bases (%% sign semantics, integer-exponent ^), magnitudes past 2^24 and
+# 2^31 (%/% in the real domain), descending ranges, TRUE/FALSE arithmetic,
+# and equal positions so == has TRUE cells.
+#
+# The default run compiles a fixed representative sample of shape pairs;
+# set QUICKR_FULL_GRID=1 to compile every pair. Sampling is deterministic
+# (a tier per pair, no randomness) so failures always reproduce.
+# Compile-error cells never reach gfortran and always run.
+
+run_full_grid <- Sys.getenv("QUICKR_FULL_GRID") %in%
+  c("1", "true", "TRUE", "yes")
+
+skip_unless_full_grid <- function() {
+  if (!run_full_grid) {
+    skip("representative sample only; set QUICKR_FULL_GRID=1 for the full grid")
+  }
+}
+
+# --- Axes ---------------------------------------------------------------
+
+grid_modes <- c(l = "logical", i = "integer", d = "double")
+
+grid_shapes <- list(
+  scl = list(decl = "1", kind = "scalar", n = 1L),
+  vec3 = list(decl = "3", kind = "vec", len = 3L, n = 3L),
+  vec4 = list(decl = "4", kind = "vec", len = 4L, n = 4L),
+  mat32 = list(decl = "3, 2", kind = "mat", dims = c(3L, 2L), n = 6L),
+  mat11 = list(decl = "1, 1", kind = "mat", dims = c(1L, 1L), n = 1L),
+  sym = list(decl = "NA", kind = "vec", len = NA_integer_, n = 3L)
+)
+
+grid_op_families <- list(
+  gen = c(
+    add = "+",
+    sub = "-",
+    mul = "*",
+    lt = "<",
+    eq = "==",
+    and = "&",
+    or = "|"
+  ),
+  div = c(div = "/", pow = "^", mod = "%%", idv = "%/%")
+)
+
+# quickr requires logical operands for & and | (R would coerce numerics);
+# an error divergence, pinned in its own test below.
+grid_logical_only_ops <- c("and", "or")
+
+grid_mode_pairs <- function(opname) {
+  if (opname %in% grid_logical_only_ops) {
+    return(list(c("l", "l")))
+  }
+  pairs <- expand.grid(
+    names(grid_modes),
+    names(grid_modes),
+    stringsAsFactors = FALSE
+  )
+  lapply(seq_len(nrow(pairs)), function(i) c(pairs[i, 2L], pairs[i, 1L]))
+}
+
+# --- Values -------------------------------------------------------------
+
+# Six values per (family, set, role, mode); shapes take a prefix (scalars
+# and 1x1 matrices position 1, vec3/sym positions 1:3, mat32 all six).
+grid_value_pool <- list(
+  gen = list(
+    primary = list(
+      a = list(
+        l = c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE),
+        i = c(-5L, 3L, 0L, 9L, 2L, -4L),
+        d = c(1.5, 0, -100, 8.25, -2, 0.125)
+      ),
+      b = list(
+        l = c(TRUE, TRUE, FALSE, FALSE, TRUE, FALSE),
+        i = c(2L, -3L, 4L, 0L, 2L, -7L),
+        d = c(1.5, -2, 3, 0, -2, 8)
+      )
+    ),
+    # extremes (products stay inside int32), descending runs, equal positions
+    edge = list(
+      a = list(
+        l = c(FALSE, TRUE, TRUE, FALSE, FALSE, TRUE),
+        i = c(40000L, -40000L, 6L, 5L, 4L, 3L),
+        d = c(1e10, -1e10, 2.5, 2.5, -0.5, 0)
+      ),
+      b = list(
+        l = c(FALSE, FALSE, TRUE, TRUE, FALSE, TRUE),
+        i = c(40000L, 40000L, -6L, 5L, -4L, 0L),
+        d = c(1e10, 1e10, -2.5, 2.5, 0.5, -8)
+      )
+    )
+  ),
+  div = list(
+    # No zeros anywhere (either operand may be a divisor); doubles paired so
+    # a negative base only ever meets a whole-valued exponent (R answers the
+    # fractional case NaN, which is out of scope).
+    primary = list(
+      a = list(
+        l = rep(TRUE, 6L),
+        i = c(-5L, 3L, 7L, 9L, 2L, -4L),
+        d = c(1.5, 3, 100, 8.25, 2, 2)
+      ),
+      b = list(
+        l = rep(TRUE, 6L),
+        i = c(2L, -3L, 4L, 3L, 2L, -7L),
+        d = c(2, 3, 2, 4, 2, 3)
+      )
+    ),
+    # 1e10: %/% quotient past both 2^24 and 2^31, exact in doubles, so the
+    # old FLOOR()-to-int32 overflow would surface without float noise.
+    edge = list(
+      a = list(
+        l = rep(TRUE, 6L),
+        i = c(9L, 7L, 5L, -3L, 2L, 12L),
+        d = c(1e10, -7.25, 4, 0.25, 9.5, 2)
+      ),
+      b = list(
+        l = rep(TRUE, 6L),
+        i = c(1L, 2L, -2L, 4L, 2L, 1L),
+        d = c(1, 2, 2, 4, 3, 2)
+      )
+    )
+  )
+)
+
+grid_operand <- function(role, family, set, mode, shape, sym_len = 3L) {
+  pool <- grid_value_pool[[family]][[set]][[role]][[mode]]
+  s <- grid_shapes[[shape]]
+  n <- if (identical(shape, "sym")) sym_len else s$n
+  x <- rep_len(pool, n)
+  if (s$kind == "mat") {
+    x <- matrix(x, nrow = s$dims[1L], ncol = s$dims[2L])
+  }
+  x
+}
+
+grid_pair_args <- function(
+  sa,
+  sb,
+  family,
+  set,
+  sym_len_a = 3L,
+  sym_len_b = 3L
+) {
+  args <- list()
+  for (m in names(grid_modes)) {
+    args[[paste0("a", m)]] <- grid_operand("a", family, set, m, sa, sym_len_a)
+    args[[paste0("b", m)]] <- grid_operand("b", family, set, m, sb, sym_len_b)
+  }
+  args
+}
+
+# Length a `sym` operand must have to conform with its partner shape.
+grid_sym_ok_len <- function(partner) {
+  p <- grid_shapes[[partner]]
+  if (p$kind == "vec" && !is.na(p$len)) {
+    p$len
+  } else if (p$kind == "mat" && !all(p$dims == 1L)) {
+    p$dims[1L]
+  } else {
+    3L
+  }
+}
+
+# --- Generators ---------------------------------------------------------
+
+# One function per (shape pair, op family): one statement per
+# (op, mode pair, operand order), returning every result in a named list.
+make_grid_pair_fn <- function(sa, sb, family) {
+  decls <- c(
+    vapply(
+      names(grid_modes),
+      function(m) {
+        paste0(
+          "type(a",
+          m,
+          " = ",
+          grid_modes[[m]],
+          "(",
+          grid_shapes[[sa]]$decl,
+          "))"
+        )
+      },
+      ""
+    ),
+    vapply(
+      names(grid_modes),
+      function(m) {
+        paste0(
+          "type(b",
+          m,
+          " = ",
+          grid_modes[[m]],
+          "(",
+          grid_shapes[[sb]]$decl,
+          "))"
+        )
+      },
+      ""
+    )
+  )
+  ids <- character()
+  stmts <- character()
+  ops <- grid_op_families[[family]]
+  pair_verdict <- grid_pair_verdict(sa, sb)
+  for (opname in names(ops)) {
+    if (!identical(grid_cell_verdict(sa, sb, opname), pair_verdict)) {
+      next # strict-op 1x1 rows: covered by the compile-error sweep
+    }
+    for (p in grid_mode_pairs(opname)) {
+      for (ord in c("ab", "ba")) {
+        id <- paste0("r_", ord, "_", opname, "_", p[1L], p[2L])
+        expr <- if (identical(ord, "ab")) {
+          paste0("a", p[1L], " ", ops[[opname]], " b", p[2L])
+        } else {
+          paste0("b", p[2L], " ", ops[[opname]], " a", p[1L])
+        }
+        ids <- c(ids, id)
+        stmts <- c(stmts, paste0("  ", id, " <- ", expr))
+      }
+    }
+  }
+  src <- paste0(
+    "function(al, ai, ad, bl, bi, bd) {\n",
+    "  declare(\n    ",
+    paste(decls, collapse = ",\n    "),
+    "\n  )\n",
+    paste(stmts, collapse = "\n"),
+    "\n  list(\n    ",
+    paste(paste0(ids, " = ", ids), collapse = ",\n    "),
+    "\n  )\n}"
+  )
+  eval(parse(text = src)[[1L]])
+}
+
+# A one-cell function, for cells whose expected outcome is a compile error.
+make_grid_cell_fn <- function(sa, sb, op, ma, mb) {
+  src <- paste0(
+    "function(a, b) {\n",
+    "  declare(type(a = ",
+    grid_modes[[ma]],
+    "(",
+    grid_shapes[[sa]]$decl,
+    ")), ",
+    "type(b = ",
+    grid_modes[[mb]],
+    "(",
+    grid_shapes[[sb]]$decl,
+    ")))\n",
+    "  a ",
+    op,
+    " b\n",
+    "}"
+  )
+  eval(parse(text = src)[[1L]])
+}
+
+# --- The expected-outcome function --------------------------------------
+# Direct transcription of the shape-contract table, per cell:
+#   1. scalar op anything                    -> allow, no guard
+#   2. identical known shapes                -> allow, no guard
+#   3. vec(n) op mat(n, k)                   -> allow (column-major recycling)
+#   4. known mismatch (incl. length 0)       -> compile error
+#   5. not statically decidable (NA dims)    -> runtime guard
+# One op-class split, mirroring R: *arithmetic* recycles a 1x1 matrix
+# against a vector (deprecated in R but still its answer, so quickr
+# scalarizes), while comparisons and & | error there -- for those the 1x1
+# is an ordinary one-row matrix and the vector-matrix rule applies (the
+# runtime-guard flavor is pinned in test-recycling.R).
+
+grid_strict_ops <- c("lt", "eq", "and", "or")
+
+grid_cell_verdict <- function(sa, sb, opname) {
+  A <- grid_shapes[[sa]]
+  B <- grid_shapes[[sb]]
+  is_1x1 <- function(s) s$kind == "mat" && all(s$dims == 1L)
+  ok <- list(outcome = "ok")
+  guard <- function(msg) list(outcome = "guard", guard_msg = msg)
+  err <- function(msg) list(outcome = "error", msg = msg)
+
+  if (A$kind == "scalar" || B$kind == "scalar") {
+    return(ok)
+  }
+  if ((is_1x1(A) && B$kind == "vec") || (is_1x1(B) && A$kind == "vec")) {
+    if (!(opname %in% grid_strict_ops)) {
+      return(ok) # scalarized 1x1: R's length-1 array recycling
+    }
+    vec <- if (A$kind == "vec") A else B
+    if (is.na(vec$len)) {
+      return(guard("matrix first dimension"))
+    }
+    if (vec$len == 1L) {
+      return(ok)
+    }
+    return(err("matrix first dimension"))
+  }
+  if (A$kind == "vec" && B$kind == "vec") {
+    if (is.na(A$len) || is.na(B$len)) {
+      return(guard("equal lengths"))
+    }
+    if (A$len == B$len) {
+      return(ok)
+    }
+    return(err("equal lengths"))
+  }
+  if (A$kind == "mat" && B$kind == "mat") {
+    if (all(A$dims == B$dims)) {
+      return(ok)
+    }
+    return(err("matching dimensions"))
+  }
+  # vector op matrix: vector length against nrow
+  vec <- if (A$kind == "vec") A else B
+  mat <- if (A$kind == "mat") A else B
+  if (is.na(vec$len)) {
+    return(guard("matrix first dimension"))
+  }
+  if (vec$len == mat$dims[1L]) {
+    return(ok)
+  }
+  err("matrix first dimension")
+}
+
+# Shape-pair verdict for packing: the arithmetic-class verdict. Cells whose
+# own verdict differs (the strict-op 1x1 rows) are excluded from the packed
+# function and land in the compile-error sweep instead.
+grid_pair_verdict <- function(sa, sb) {
+  grid_cell_verdict(sa, sb, "add")
+}
+
+# Which shape pairs compile in the default run. Every non-error pair must
+# be listed: adding a shape without deciding its tier is an error.
+grid_pair_tiers <- c(
+  "scl.scl" = "full",
+  "scl.vec3" = "core",
+  "scl.vec4" = "full",
+  "scl.mat32" = "full",
+  "scl.mat11" = "full",
+  "scl.sym" = "full",
+  "vec3.vec3" = "core",
+  "vec3.mat32" = "core",
+  "vec3.mat11" = "full",
+  "vec3.sym" = "core",
+  "vec4.vec4" = "full",
+  "vec4.mat11" = "full",
+  "vec4.sym" = "full",
+  "mat32.mat32" = "core",
+  "mat32.sym" = "core",
+  "mat11.mat11" = "full",
+  "mat11.sym" = "full",
+  "sym.sym" = "core"
+)
+
+# --- Oracle comparison --------------------------------------------------
+
+# suppressWarnings: R deprecation-warns on 1x1-array-vs-vector recycling
+# (mat11 pairs); values still match, which is what the contract pins.
+expect_grid_cells_match <- function(qfn, fn, args, context) {
+  r_res <- suppressWarnings(do.call(fn, args))
+  q_res <- do.call(qfn, args)
+  expect_identical(names(q_res), names(r_res))
+  for (nm in names(r_res)) {
+    expect_equal(
+      q_res[[nm]],
+      r_res[[nm]],
+      label = paste0(context, " ", nm, " (quickr)"),
+      expected.label = "R"
+    )
+    expect_identical(
+      typeof(q_res[[nm]]),
+      typeof(r_res[[nm]]),
+      label = paste0(context, " ", nm, " typeof (quickr)"),
+      expected.label = "typeof (R)"
+    )
+  }
+}
+
+# --- Elementwise grid: valid and guarded shape pairs ---------------------
+
+grid_pair_names <- names(grid_shapes)
+for (i in seq_along(grid_pair_names)) {
+  for (j in seq.int(i, length(grid_pair_names))) {
+    local({
+      sa <- grid_pair_names[[i]]
+      sb <- grid_pair_names[[j]]
+      verdict <- grid_pair_verdict(sa, sb)
+      if (identical(verdict$outcome, "error")) {
+        return() # handled in the compile-error section below
+      }
+      pair_id <- paste0(sa, ".", sb)
+      tier <- grid_pair_tiers[[pair_id]]
+      stopifnot(tier %in% c("core", "full"))
+
+      for (family in names(grid_op_families)) {
+        test_that(paste0("elementwise grid ", pair_id, " [", family, "]"), {
+          if (identical(tier, "full")) {
+            skip_unless_full_grid()
+          }
+          fn <- make_grid_pair_fn(sa, sb, family)
+          dll_paths_before <- loaded_dll_paths()
+          on.exit(cleanup_new_quick_dlls(dll_paths_before), add = TRUE)
+          qfn <- quick(fn)
+
+          sym_a <- if (identical(sa, "sym")) grid_sym_ok_len(sb) else 3L
+          sym_b <- if (identical(sb, "sym")) grid_sym_ok_len(sa) else 3L
+          for (set in c("primary", "edge")) {
+            args <- grid_pair_args(sa, sb, family, set, sym_a, sym_b)
+            expect_grid_cells_match(
+              qfn,
+              fn,
+              args,
+              context = paste0(pair_id, "/", set)
+            )
+          }
+
+          if (identical(verdict$outcome, "guard")) {
+            # bump one symbolic operand's length; the guard must raise the
+            # documented error where R errors and BLAS-free Fortran would
+            # read or write out of bounds
+            bad_b <- if (identical(sb, "sym")) sym_b + 1L else sym_b
+            bad_a <- if (identical(sb, "sym")) sym_a else sym_a + 1L
+            args_bad <- grid_pair_args(sa, sb, family, "primary", bad_a, bad_b)
+            expect_error(
+              do.call(qfn, args_bad),
+              verdict$guard_msg,
+              fixed = TRUE
+            )
+          }
+        })
+      }
+    })
+  }
+}
+
+# --- Elementwise grid: statically rejected shape pairs -------------------
+# Compile errors never reach gfortran, so every op and both operand orders
+# are cheap enough to always run.
+
+test_that("statically nonconformable cells are compile errors for every op", {
+  for (i in seq_along(grid_pair_names)) {
+    for (j in seq.int(i, length(grid_pair_names))) {
+      sa <- grid_pair_names[[i]]
+      sb <- grid_pair_names[[j]]
+      for (family in names(grid_op_families)) {
+        ops <- grid_op_families[[family]]
+        for (opname in names(ops)) {
+          verdict <- grid_cell_verdict(sa, sb, opname)
+          if (!identical(verdict$outcome, "error")) {
+            next
+          }
+          modes <- if (opname %in% grid_logical_only_ops) {
+            c("l", "l")
+          } else {
+            c("d", "d")
+          }
+          for (ord in list(c(sa, sb), c(sb, sa))) {
+            fn <- make_grid_cell_fn(
+              ord[1L],
+              ord[2L],
+              ops[[opname]],
+              modes[1L],
+              modes[2L]
+            )
+            expect_error(
+              quick(fn),
+              verdict$msg,
+              fixed = TRUE,
+              label = paste0(
+                "quick() for ",
+                ord[1L],
+                " ",
+                ops[[opname]],
+                " ",
+                ord[2L]
+              )
+            )
+          }
+        }
+      }
+    }
+  }
+})
+
+test_that("known length-0 operands are compile errors", {
+  fn <- eval(parse(
+    text = paste0(
+      "function(a, b) {\n",
+      "  declare(type(a = double(0)), type(b = double(4)))\n",
+      "  a + b\n}"
+    )
+  )[[1L]])
+  expect_error(quick(fn), "equal lengths", fixed = TRUE)
+})
+
+test_that("& and | require logical operands (R would coerce: error divergence)", {
+  for (op in c("&", "|")) {
+    for (ma in names(grid_modes)) {
+      for (mb in names(grid_modes)) {
+        if (identical(ma, "l") && identical(mb, "l")) {
+          next
+        }
+        fn <- make_grid_cell_fn("vec3", "vec3", op, ma, mb)
+        expect_error(
+          quick(fn),
+          "must be logical",
+          fixed = TRUE,
+          label = paste0(
+            "quick() for ",
+            grid_modes[[ma]],
+            " ",
+            op,
+            " ",
+            grid_modes[[mb]]
+          )
+        )
+      }
+    }
+  }
+})
+
+# --- c(): mode join over all elements, constructive lengths --------------
+
+test_that("c() grid: lattice join across modes, known and mixed lengths", {
+  ids <- character()
+  stmts <- character()
+  for (ma in names(grid_modes)) {
+    for (mb in names(grid_modes)) {
+      id_ab <- paste0("r_c_", ma, mb)
+      id_sb <- paste0("r_cs_", ma, mb)
+      ids <- c(ids, id_ab, id_sb)
+      stmts <- c(
+        stmts,
+        paste0("  ", id_ab, " <- c(a", ma, ", b", mb, ")"),
+        paste0("  ", id_sb, " <- c(s", ma, ", b", mb, ")")
+      )
+    }
+  }
+  ids <- c(ids, "r_c3")
+  stmts <- c(stmts, "  r_c3 <- c(sl, ai, bd)") # three-mode join
+  src <- paste0(
+    "function(al, ai, ad, bl, bi, bd, sl, si, sd) {\n",
+    "  declare(\n",
+    "    type(al = logical(3)), type(ai = integer(3)), type(ad = double(3)),\n",
+    "    type(bl = logical(4)), type(bi = integer(4)), type(bd = double(4)),\n",
+    "    type(sl = logical(1)), type(si = integer(1)), type(sd = double(1))\n",
+    "  )\n",
+    paste(stmts, collapse = "\n"),
+    "\n  list(\n    ",
+    paste(paste0(ids, " = ", ids), collapse = ",\n    "),
+    "\n  )\n}"
+  )
+  fn <- eval(parse(text = src)[[1L]])
+  dll_paths_before <- loaded_dll_paths()
+  on.exit(cleanup_new_quick_dlls(dll_paths_before), add = TRUE)
+  qfn <- quick(fn)
+  for (set in c("primary", "edge")) {
+    args <- c(
+      grid_pair_args("vec3", "vec4", "gen", set),
+      list(
+        sl = grid_operand("a", "gen", set, "l", "scl"),
+        si = grid_operand("a", "gen", set, "i", "scl"),
+        sd = grid_operand("a", "gen", set, "d", "scl")
+      )
+    )
+    expect_grid_cells_match(qfn, fn, args, context = paste0("c()/", set))
+  }
+})
+
+test_that("c() grid: symbolic lengths are constructive (no guard)", {
+  src <- paste0(
+    "function(al, ai, ad, bl, bi, bd) {\n",
+    "  declare(\n",
+    "    type(al = logical(NA)), type(ai = integer(NA)), type(ad = double(NA)),\n",
+    "    type(bl = logical(NA)), type(bi = integer(NA)), type(bd = double(NA))\n",
+    "  )\n",
+    "  r_ll <- c(al, bl)\n",
+    "  r_id <- c(ai, bd)\n",
+    "  r_dl <- c(ad, bl)\n",
+    "  r_dd <- c(ad, bd)\n",
+    "  list(r_ll = r_ll, r_id = r_id, r_dl = r_dl, r_dd = r_dd)\n",
+    "}"
+  )
+  fn <- eval(parse(text = src)[[1L]])
+  dll_paths_before <- loaded_dll_paths()
+  on.exit(cleanup_new_quick_dlls(dll_paths_before), add = TRUE)
+  qfn <- quick(fn)
+  # unequal lengths are fine for c(): lengths add, nothing to conform
+  args <- grid_pair_args(
+    "sym",
+    "sym",
+    "gen",
+    "primary",
+    sym_len_a = 3L,
+    sym_len_b = 4L
+  )
+  expect_grid_cells_match(qfn, fn, args, context = "c()/sym")
+})
+
+test_that("c() rejects rank-2 args (R would flatten: error divergence)", {
+  fn <- eval(parse(
+    text = paste0(
+      "function(a) {\n",
+      "  declare(type(a = double(3, 2)))\n",
+      "  c(a, 1.0)\n}"
+    )
+  )[[1L]])
+  expect_error(quick(fn), "scalars or 1-d arrays", fixed = TRUE)
+})
+
+# --- Multi-arg min()/max()/sum(): join across args, shapes independent ----
+
+test_that("multi-arg min/max/sum grid: modes join, arg shapes independent", {
+  ids <- character()
+  stmts <- character()
+  for (fname in c("min", "max", "sum")) {
+    for (ma in names(grid_modes)) {
+      for (mb in names(grid_modes)) {
+        id <- paste0("r_", fname, "_", ma, mb)
+        ids <- c(ids, id)
+        stmts <- c(
+          stmts,
+          paste0("  ", id, " <- ", fname, "(a", ma, ", b", mb, ")")
+        )
+      }
+    }
+  }
+  ids <- c(ids, "r_min3", "r_max3")
+  stmts <- c(
+    stmts,
+    "  r_min3 <- min(al, bi, sd)",
+    "  r_max3 <- max(al, bi, sd)"
+  )
+  src <- paste0(
+    "function(al, ai, ad, bl, bi, bd, sd) {\n",
+    "  declare(\n",
+    "    type(al = logical(3)), type(ai = integer(3)), type(ad = double(3)),\n",
+    "    type(bl = logical(4)), type(bi = integer(4)), type(bd = double(4)),\n",
+    "    type(sd = double(1))\n",
+    "  )\n",
+    paste(stmts, collapse = "\n"),
+    "\n  list(\n    ",
+    paste(paste0(ids, " = ", ids), collapse = ",\n    "),
+    "\n  )\n}"
+  )
+  fn <- eval(parse(text = src)[[1L]])
+  dll_paths_before <- loaded_dll_paths()
+  on.exit(cleanup_new_quick_dlls(dll_paths_before), add = TRUE)
+  qfn <- quick(fn)
+  for (set in c("primary", "edge")) {
+    args <- c(
+      grid_pair_args("vec3", "vec4", "gen", set),
+      list(sd = grid_operand("a", "gen", set, "d", "scl"))
+    )
+    expect_grid_cells_match(
+      qfn,
+      fn,
+      args,
+      context = paste0("min/max/sum/", set)
+    )
+  }
+})
+
+# --- ifelse(): branch-mode join, shape from `test` ------------------------
+
+test_that("ifelse grid: branch mode pairs join; scalars broadcast against vector test", {
+  ids <- character()
+  stmts <- character()
+  for (my in names(grid_modes)) {
+    for (mn in names(grid_modes)) {
+      for (combo in c("vv", "sv", "vs", "ss")) {
+        id <- paste0("r_", combo, "_", my, mn)
+        yes <- if (substr(combo, 1L, 1L) == "v") {
+          paste0("y", my)
+        } else {
+          paste0("p", my)
+        }
+        no <- if (substr(combo, 2L, 2L) == "v") {
+          paste0("n", mn)
+        } else {
+          paste0("q", mn)
+        }
+        ids <- c(ids, id)
+        stmts <- c(
+          stmts,
+          paste0("  ", id, " <- ifelse(t3, ", yes, ", ", no, ")")
+        )
+      }
+    }
+  }
+  src <- paste0(
+    "function(t3, yl, yi, yd, nl, ni, nd, pl, pi, pd, ql, qi, qd) {\n",
+    "  declare(\n",
+    "    type(t3 = logical(3)),\n",
+    "    type(yl = logical(3)), type(yi = integer(3)), type(yd = double(3)),\n",
+    "    type(nl = logical(3)), type(ni = integer(3)), type(nd = double(3)),\n",
+    "    type(pl = logical(1)), type(pi = integer(1)), type(pd = double(1)),\n",
+    "    type(ql = logical(1)), type(qi = integer(1)), type(qd = double(1))\n",
+    "  )\n",
+    paste(stmts, collapse = "\n"),
+    "\n  list(\n    ",
+    paste(paste0(ids, " = ", ids), collapse = ",\n    "),
+    "\n  )\n}"
+  )
+  fn <- eval(parse(text = src)[[1L]])
+  dll_paths_before <- loaded_dll_paths()
+  on.exit(cleanup_new_quick_dlls(dll_paths_before), add = TRUE)
+  qfn <- quick(fn)
+  for (set in c("primary", "edge")) {
+    # `test` must stay mixed TRUE/FALSE: with a one-sided test R's ifelse
+    # never materializes the untaken branch, so its result type becomes
+    # value-dependent -- not representable statically (step-9 divergence)
+    args <- list(t3 = c(TRUE, FALSE, TRUE))
+    for (m in names(grid_modes)) {
+      args[[paste0("y", m)]] <- grid_operand("a", "gen", set, m, "vec3")
+      args[[paste0("n", m)]] <- grid_operand("b", "gen", set, m, "vec3")
+      args[[paste0("p", m)]] <- grid_operand("a", "gen", set, m, "scl")
+      args[[paste0("q", m)]] <- grid_operand("b", "gen", set, m, "scl")
+    }
+    expect_grid_cells_match(qfn, fn, args, context = paste0("ifelse/", set))
+  }
+})
+
+test_that("ifelse grid: symbolic branch lengths get a runtime guard", {
+  ids <- character()
+  stmts <- character()
+  for (my in names(grid_modes)) {
+    for (mn in names(grid_modes)) {
+      id <- paste0("r_", my, mn)
+      ids <- c(ids, id)
+      stmts <- c(
+        stmts,
+        paste0("  ", id, " <- ifelse(t1, y", my, ", n", mn, ")")
+      )
+    }
+  }
+  src <- paste0(
+    "function(t1, yl, yi, yd, nl, ni, nd) {\n",
+    "  declare(\n",
+    "    type(t1 = logical(NA)),\n",
+    "    type(yl = logical(NA)), type(yi = integer(NA)), type(yd = double(NA)),\n",
+    "    type(nl = logical(NA)), type(ni = integer(NA)), type(nd = double(NA))\n",
+    "  )\n",
+    paste(stmts, collapse = "\n"),
+    "\n  list(\n    ",
+    paste(paste0(ids, " = ", ids), collapse = ",\n    "),
+    "\n  )\n}"
+  )
+  fn <- eval(parse(text = src)[[1L]])
+  dll_paths_before <- loaded_dll_paths()
+  on.exit(cleanup_new_quick_dlls(dll_paths_before), add = TRUE)
+  qfn <- quick(fn)
+
+  make_args <- function(len_n) {
+    args <- list(t1 = c(TRUE, FALSE, TRUE))
+    for (m in names(grid_modes)) {
+      args[[paste0("y", m)]] <- grid_operand(
+        "a",
+        "gen",
+        "primary",
+        m,
+        "sym",
+        3L
+      )
+      args[[paste0("n", m)]] <- grid_operand(
+        "b",
+        "gen",
+        "primary",
+        m,
+        "sym",
+        len_n
+      )
+    }
+    args
+  }
+  args_ok <- make_args(3L)
+  expect_grid_cells_match(qfn, fn, args_ok, context = "ifelse/sym")
+  # was: unguarded merge() reading past the shorter branch
+  expect_error(
+    do.call(qfn, make_args(4L)),
+    "must be scalars or match the shape",
+    fixed = TRUE
+  )
+})
+
+test_that("ifelse grid: matrix test shapes the result", {
+  skip_unless_full_grid()
+  src <- paste0(
+    "function(tm, ym, nm, yi, pd) {\n",
+    "  declare(\n",
+    "    type(tm = logical(3, 2)),\n",
+    "    type(ym = double(3, 2)), type(nm = double(3, 2)),\n",
+    "    type(yi = integer(3, 2)), type(pd = double(1))\n",
+    "  )\n",
+    "  r_dd <- ifelse(tm, ym, nm)\n",
+    "  r_id <- ifelse(tm, yi, nm)\n",
+    "  r_sd <- ifelse(tm, pd, nm)\n",
+    "  list(r_dd = r_dd, r_id = r_id, r_sd = r_sd)\n",
+    "}"
+  )
+  fn <- eval(parse(text = src)[[1L]])
+  dll_paths_before <- loaded_dll_paths()
+  on.exit(cleanup_new_quick_dlls(dll_paths_before), add = TRUE)
+  qfn <- quick(fn)
+  args <- list(
+    tm = matrix(c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE), 3L, 2L),
+    ym = grid_operand("a", "gen", "primary", "d", "mat32"),
+    nm = grid_operand("b", "gen", "primary", "d", "mat32"),
+    yi = grid_operand("a", "gen", "primary", "i", "mat32"),
+    pd = grid_operand("a", "gen", "primary", "d", "scl")
+  )
+  expect_grid_cells_match(qfn, fn, args, context = "ifelse/mat")
+})
+
+test_that("ifelse contract violations are compile errors", {
+  scalar_test <- eval(parse(
+    text = paste0(
+      "function(t1, y, n) {\n",
+      "  declare(type(t1 = logical(1)), type(y = double(3)), type(n = double(3)))\n",
+      "  ifelse(t1, y, n)\n}"
+    )
+  )[[1L]])
+  expect_error(quick(scalar_test), "scalar test is not supported", fixed = TRUE)
+
+  known_mismatch <- eval(parse(
+    text = paste0(
+      "function(t3, y, n) {\n",
+      "  declare(type(t3 = logical(3)), type(y = double(4)), type(n = double(3)))\n",
+      "  ifelse(t3, y, n)\n}"
+    )
+  )[[1L]])
+  expect_error(
+    quick(known_mismatch),
+    "must be scalars or match the shape",
+    fixed = TRUE
+  )
+
+  rank_mismatch <- eval(parse(
+    text = paste0(
+      "function(t3, y, n) {\n",
+      "  declare(type(t3 = logical(3)), type(y = double(3, 2)), type(n = double(3)))\n",
+      "  ifelse(t3, y, n)\n}"
+    )
+  )[[1L]])
+  expect_error(
+    quick(rank_mismatch),
+    "must be scalars or match the shape",
+    fixed = TRUE
+  )
+})

From bd879cfe5e593a170f48de4f38009c97df946470 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 11 Jul 2026 10:45:33 +0200
Subject: [PATCH 14/97] Format with air

---
 R/r2f-matrix.R                    | 18 ++++++++++++++----
 tests/testthat/test-blas-guards.R | 12 ++++++++++--
 2 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/R/r2f-matrix.R b/R/r2f-matrix.R
index e588e7c7..d2526987 100644
--- a/R/r2f-matrix.R
+++ b/R/r2f-matrix.R
@@ -118,10 +118,20 @@ register_r2f_handler(
       scope,
       left = left,
       right = right,
-      left_axis = if (left_rank == 1) NULL else if (left_trans == "N") 2L else
-        1L,
-      right_axis = if (right_rank == 1) NULL else if (right_trans == "N") 1L
-      else 2L
+      left_axis = if (left_rank == 1) {
+        NULL
+      } else if (left_trans == "N") {
+        2L
+      } else {
+        1L
+      },
+      right_axis = if (right_rank == 1) {
+        NULL
+      } else if (right_trans == "N") {
+        1L
+      } else {
+        2L
+      }
     )
 
     # Matrix-Matrix
diff --git a/tests/testthat/test-blas-guards.R b/tests/testthat/test-blas-guards.R
index f881cdd5..3009c852 100644
--- a/tests/testthat/test-blas-guards.R
+++ b/tests/testthat/test-blas-guards.R
@@ -12,7 +12,11 @@ test_that("matrix-vector %*% guards an unknown vector length", {
   qfn <- expect_no_warning(quick(fn))
   expect_equal(qfn(diag(3), as.double(1:3)), diag(3) %*% 1:3)
   # was: dgemv read past the end of x, returning garbage
-  expect_error(qfn(diag(3), as.double(1:2)), "non-conformable arguments in %*%", fixed = TRUE)
+  expect_error(
+    qfn(diag(3), as.double(1:2)),
+    "non-conformable arguments in %*%",
+    fixed = TRUE
+  )
 })
 
 test_that("vector-matrix %*% guards an unknown vector length", {
@@ -22,7 +26,11 @@ test_that("vector-matrix %*% guards an unknown vector length", {
   }
   qfn <- expect_no_warning(quick(fn))
   expect_equal(qfn(as.double(1:3), diag(3)), t(as.double(1:3)) %*% diag(3))
-  expect_error(qfn(as.double(1:5), diag(3)), "non-conformable arguments in %*%", fixed = TRUE)
+  expect_error(
+    qfn(as.double(1:5), diag(3)),
+    "non-conformable arguments in %*%",
+    fixed = TRUE
+  )
 })
 
 test_that("triangular solve guards squareness and RHS length", {

From 079341468c6a9578c202ee694c2386937c7c6474 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 13:36:00 +0200
Subject: [PATCH 15/97] Grid: symbolic-vector-vs-1x1 cells are runtime guards
 for every op class

The 02-2 fix routes arithmetic on a 1x1 matrix and a symbolic-length
vector through the vector-matrix rule (guard on length 1, 1x1 result)
instead of scalarizing at compile time, closing the shape divergence the
review found: at runtime length 1, R keeps the 1x1 dims. Encode that in
the verdict function, and give sym operands facing a 1x1 partner the
conforming length 1 so the ok-path is exercised at the shape the guard
admits. The old sym_len = 3 cells never ran the length-1 branch.
---
 tests/testthat/test-conformability-grid.R | 24 ++++++++++++++---------
 1 file changed, 15 insertions(+), 9 deletions(-)

diff --git a/tests/testthat/test-conformability-grid.R b/tests/testthat/test-conformability-grid.R
index 9e354881..cade22c5 100644
--- a/tests/testthat/test-conformability-grid.R
+++ b/tests/testthat/test-conformability-grid.R
@@ -173,11 +173,13 @@ grid_pair_args <- function(
 }
 
 # Length a `sym` operand must have to conform with its partner shape.
+# For a matrix partner that is the vector-matrix rule's nrow -- including
+# the 1x1 matrix, whose symbolic-vector cells guard on length 1.
 grid_sym_ok_len <- function(partner) {
   p <- grid_shapes[[partner]]
   if (p$kind == "vec" && !is.na(p$len)) {
     p$len
-  } else if (p$kind == "mat" && !all(p$dims == 1L)) {
+  } else if (p$kind == "mat") {
     p$dims[1L]
   } else {
     3L
@@ -285,10 +287,14 @@ make_grid_cell_fn <- function(sa, sb, op, ma, mb) {
 #   4. known mismatch (incl. length 0)       -> compile error
 #   5. not statically decidable (NA dims)    -> runtime guard
 # One op-class split, mirroring R: *arithmetic* recycles a 1x1 matrix
-# against a vector (deprecated in R but still its answer, so quickr
-# scalarizes), while comparisons and & | error there -- for those the 1x1
-# is an ordinary one-row matrix and the vector-matrix rule applies (the
-# runtime-guard flavor is pinned in test-recycling.R).
+# against a vector of statically known length != 1 (deprecated in R but
+# still its answer, so quickr scalarizes), while comparisons and & | error
+# there -- for those the 1x1 is an ordinary one-row matrix and the
+# vector-matrix rule applies. A *symbolic* vector length takes the
+# vector-matrix rule for every op class: the result's shape depends on the
+# runtime length (R keeps the 1x1 dims only for a length-1 vector), so a
+# runtime guard requires length 1 and longer vectors error where R would
+# recycle (both flavors are pinned in test-recycling.R).
 
 grid_strict_ops <- c("lt", "eq", "and", "or")
 
@@ -304,9 +310,6 @@ grid_cell_verdict <- function(sa, sb, opname) {
     return(ok)
   }
   if ((is_1x1(A) && B$kind == "vec") || (is_1x1(B) && A$kind == "vec")) {
-    if (!(opname %in% grid_strict_ops)) {
-      return(ok) # scalarized 1x1: R's length-1 array recycling
-    }
     vec <- if (A$kind == "vec") A else B
     if (is.na(vec$len)) {
       return(guard("matrix first dimension"))
@@ -314,7 +317,10 @@ grid_cell_verdict <- function(sa, sb, opname) {
     if (vec$len == 1L) {
       return(ok)
     }
-    return(err("matrix first dimension"))
+    if (opname %in% grid_strict_ops) {
+      return(err("matrix first dimension"))
+    }
+    return(ok) # scalarized 1x1: R's length-1 array recycling
   }
   if (A$kind == "vec" && B$kind == "vec") {
     if (is.na(A$len) || is.na(B$len)) {

From 6a763ef7e56cf9349bd964b4de1b83e1ff416609 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 14:15:15 +0200
Subject: [PATCH 16/97] Require a square matrix in solve(), matching R

solve(a, b) with a rectangular a fell through to a least-squares dgels
call, returning qr.solve()'s answer where R raises "'a' (m x n) must be
square". Statically rectangular systems are now a compile error and
symbolic squareness is guarded at run time before the dgesv call, via
the assert_square_matrix() helper the other LAPACK lowerings already
use. The now-unreachable rectangular tail of lapack_solve() (dgels, and
a dgelsy branch qr.solve() never reached) is deleted; qr.solve() keeps
its least-squares behavior.

The solve output follows ncol(a) while b follows nrow(a); when ncol is
statically 1 the output declares as a Fortran scalar, so a
symbolic-length b is copied elementwise instead of by whole-array
assignment.
---
 NEWS.md                             |   7 ++
 R/r2f-matrix-blas.R                 | 140 ++++------------------------
 R/r2f-operators-helpers.R           |   2 +-
 tests/testthat/test-matrix-lapack.R |  83 ++++++-----------
 4 files changed, 56 insertions(+), 176 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index aa90b7d5..ee3a66ea 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -32,6 +32,13 @@
   build even in arithmetic, and a symbolic-length `x + m` returned a plain
   vector where R returns a `1x1` matrix.
 
+- `solve(a, b)` now requires a square `a`, matching R. A rectangular `a`
+  previously fell through to a least-squares solve (dgels), returning an
+  answer where R raises `'a' (m x n) must be square`. Statically
+  rectangular systems are now a compile-time error; when squareness is not
+  known at compile time it is checked at run time. Use `qr.solve()` for
+  least-squares solutions of rectangular systems (unchanged).
+
 # quickr 0.3.0
 
 This release adds major new support for linear algebra, local functions,
diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index cb0a46b6..c5b1fa5a 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -643,13 +643,12 @@ lapack_solve <- function(
 
   nrhs <- if (b_rank == 1L) 1L else dim_or_one(B, 2L)
 
-  # solve(a, b) with a rectangular `a` deliberately falls through to the
-  # least-squares branch below -- a divergence from base R (which requires
-  # a square `a`), locked by the "least-squares" tests in
-  # test-matrix-lapack.R. Squareness is a routing decision here, not a
-  # correctness guard: unknown squareness routes to dgels, which solves
-  # square systems exactly too.
-  if (dims_match(m, n) && !identical(context, "qr.solve")) {
+  # R's solve() requires a square `a`; least squares is qr.solve()'s job.
+  # Statically rectangular `a` is a compile error, symbolic dims get a
+  # runtime guard before the dgesv call. (A rectangular `a` used to fall
+  # through to a dgels least-squares solve -- an answer where R errors.)
+  if (!identical(context, "qr.solve")) {
+    assert_square_matrix(a_dims, A, context, hoist, scope)
     A_work <- hoist$declare_tmp(mode = "double", dims = list(m, m))
     hoist$emit(glue("{A_work@name} = {A_name}"))
 
@@ -671,7 +670,17 @@ lapack_solve <- function(
       out_var <- hoist$declare_tmp(mode = "double", dims = expected_dims)
       out_name <- out_var@name
     }
-    hoist$emit(glue("{out_name} = {B_input_name}"))
+    # The output length follows ncol(a) (R's contract) while `b` follows
+    # nrow(a); the two are only runtime-equal. When ncol is statically 1
+    # the output declares as a scalar, so a symbolic-length `b` must be
+    # copied elementwise, not by whole-array assignment.
+    b_src <- if (passes_as_scalar(out_var) && !passes_as_scalar(B@value)) {
+      subs <- str_flatten_commas(rep("1", b_rank))
+      glue("{B_input_name}({subs})")
+    } else {
+      B_input_name
+    }
+    hoist$emit(glue("{out_name} = {b_src}"))
 
     ipiv <- hoist$declare_tmp(mode = "integer", dims = list(m))
     info <- hoist$declare_tmp(mode = "integer", dims = NULL)
@@ -813,121 +822,6 @@ end do"
     }
     return(out)
   }
-
-  A_work <- hoist$declare_tmp(mode = "double", dims = list(m, n))
-  hoist$emit(glue("{A_work@name} = {A_name}"))
-
-  max_mn <- call("max", m, n)
-
-  B_work <- hoist$declare_tmp(mode = "double", dims = list(max_mn, nrhs))
-  m_f <- dims2f(list(m), scope)
-  if (!nzchar(m_f)) {
-    m_f <- "1"
-  }
-  n_f <- dims2f(list(n), scope)
-  if (!nzchar(n_f)) {
-    n_f <- "1"
-  }
-  nrhs_f <- dims2f(list(nrhs), scope)
-  if (!nzchar(nrhs_f)) {
-    nrhs_f <- "1"
-  }
-  hoist$emit(glue("{B_work@name} = 0.0_c_double"))
-  if (b_rank == 1L) {
-    hoist$emit(glue("{B_work@name}(1:{m_f}, 1) = {B_input_name}"))
-  } else {
-    hoist$emit(glue("{B_work@name}(1:{m_f}, 1:{nrhs_f}) = {B_input_name}"))
-  }
-
-  info <- hoist$declare_tmp(mode = "integer", dims = NULL)
-
-  mn <- call("min", m, n)
-  if (identical(context, "qr.solve")) {
-    jpvt <- hoist$declare_tmp(mode = "integer", dims = list(n))
-    hoist$emit(glue("{jpvt@name} = 0_c_int"))
-
-    rcond <- if (is.null(tol)) "1e-7_c_double" else as.character(tol)
-    rank <- hoist$declare_tmp(mode = "integer", dims = NULL)
-
-    lwork <- call(
-      "max",
-      1L,
-      call("+", mn, call("max", mn, nrhs)),
-      call("+", call("*", 2L, mn), call("*", 64L, call("+", n, 1L))),
-      call("+", mn, call("*", 2L, n))
-    )
-    work <- hoist$declare_tmp(mode = "double", dims = list(lwork))
-
-    hoist$emit(glue(
-      "call dgelsy({blas_int(m)}, {blas_int(n)}, {blas_int(nrhs)}, {A_work@name}, {blas_int(m)}, {B_work@name}, {blas_int(max_mn)}, {jpvt@name}, {rcond}, {rank@name}, {work@name}, {blas_int(lwork)}, {info@name})"
-    ))
-    emit_quickr_error_if(
-      condition = glue("{info@name} < 0_c_int"),
-      message = "Lapack routine dgelsy: illegal argument",
-      hoist = hoist,
-      scope = scope
-    )
-    emit_quickr_error_if(
-      condition = glue("{info@name} > 0_c_int"),
-      message = "Lapack routine dgelsy failed to converge",
-      hoist = hoist,
-      scope = scope
-    )
-    emit_quickr_error_if(
-      condition = glue("{rank@name} < {blas_int(n)}"),
-      message = "rank deficient matrix in qr.solve",
-      hoist = hoist,
-      scope = scope
-    )
-  } else {
-    lwork <- call("max", 1L, call("+", mn, call("max", mn, nrhs)))
-    work <- hoist$declare_tmp(mode = "double", dims = list(lwork))
-
-    hoist$emit(glue(
-      "call dgels('N', {blas_int(m)}, {blas_int(n)}, {blas_int(nrhs)}, {A_work@name}, {blas_int(m)}, {B_work@name}, {blas_int(max_mn)}, {work@name}, {blas_int(lwork)}, {info@name})"
-    ))
-    emit_quickr_error_if(
-      condition = glue("{info@name} < 0_c_int"),
-      message = "Lapack routine dgels: illegal argument",
-      hoist = hoist,
-      scope = scope
-    )
-  }
-
-  expected_dims <- if (b_rank == 1L) list(n) else list(n, nrhs)
-  writes_to_dest <- FALSE
-  if (
-    can_use_output(
-      dest,
-      input_names = c(A_name, B_input_name),
-      expected_dims = expected_dims,
-      context = context,
-      allow_alias = B_input_name
-    )
-  ) {
-    out_var <- dest
-    out_name <- dest@name
-    writes_to_dest <- TRUE
-  } else {
-    out_var <- hoist$declare_tmp(mode = "double", dims = expected_dims)
-    out_name <- out_var@name
-  }
-
-  if (b_rank == 1L) {
-    if (passes_as_scalar(out_var)) {
-      hoist$emit(glue("{out_name} = {B_work@name}(1, 1)"))
-    } else {
-      hoist$emit(glue("{out_name} = {B_work@name}(1:{n_f}, 1)"))
-    }
-  } else {
-    hoist$emit(glue("{out_name} = {B_work@name}(1:{n_f}, 1:{nrhs_f})"))
-  }
-
-  out <- Fortran(out_name, out_var)
-  if (writes_to_dest) {
-    out@writes_to_dest <- TRUE
-  }
-  out
 }
 
 lapack_inverse <- function(A, scope, hoist, dest = NULL, context = "solve") {
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 093ebac6..4561adbe 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -149,7 +149,7 @@ is_one_by_one <- function(x) {
 # check_elementwise_lengths(): no zero-length policy, no symbol
 # normalization -- callers use it for routing/declaration decisions, not
 # for the conformability contract.
-# Used by: r2f-matrix.R (bind_common_dim), r2f-matrix-blas.R (solve routing)
+# Used by: r2f-matrix.R (bind_common_dim)
 dims_match <- function(left, right) {
   if (is_wholenumber(left) && is_wholenumber(right)) {
     return(identical(as.integer(left), as.integer(right)))
diff --git a/tests/testthat/test-matrix-lapack.R b/tests/testthat/test-matrix-lapack.R
index a8b76d6b..db805b50 100644
--- a/tests/testthat/test-matrix-lapack.R
+++ b/tests/testthat/test-matrix-lapack.R
@@ -62,8 +62,9 @@ test_that("solve handles column RHS matrices and 1x1 systems", {
   expect_quick_equal(solve_scalar, list(A = matrix(2.5, 1L, 1L), b = 1.25))
 })
 
-test_that("solve supports least-squares for rectangular systems", {
-  solve_ls_vec <- function(X, y) {
+test_that("solve requires a square coefficient matrix, like R", {
+  # Squareness unknown at compile time: a runtime guard runs before dgesv.
+  solve_sym <- function(X, y) {
     declare(
       type(X = double(n, k)),
       type(y = double(n))
@@ -71,48 +72,37 @@ test_that("solve supports least-squares for rectangular systems", {
     solve(X, y)
   }
 
-  solve_ls_mat <- function(X, Y) {
-    declare(
-      type(X = double(n, k)),
-      type(Y = double(n, p))
-    )
-    solve(X, Y)
-  }
-
   set.seed(123)
   n <- 20
   k <- 5
-  p <- 3
   X <- matrix(rnorm(n * k), n, k)
   y <- rnorm(n)
-  Y <- matrix(rnorm(n * p), n, p)
 
-  q_solve_ls_vec <- expect_warning(quick(solve_ls_vec), NA)
-  q_solve_ls_mat <- expect_warning(quick(solve_ls_mat), NA)
+  q_solve_sym <- quick(solve_sym)
+  expect_error(q_solve_sym(X, y), "solve requires a square matrix")
+  expect_error(solve(X, y), "must be square") # the R oracle errors too
 
-  expect_equal(q_solve_ls_vec(X, y), qr.solve(X, y))
-  expect_equal(q_solve_ls_mat(X, Y), qr.solve(X, Y))
-})
+  base <- matrix(rnorm(n * n), n, n)
+  A <- crossprod(base) + diag(n)
+  expect_equal(q_solve_sym(A, y), solve(A, y))
 
-test_that("solve supports least-squares for single-column systems", {
-  solve_ls_col <- function(X, y) {
+  # One statically known axis still guards the symbolic one.
+  solve_col <- function(X, y) {
     declare(
       type(X = double(n, 1L)),
       type(y = double(n))
     )
     solve(X, y)
   }
-
-  set.seed(125)
-  n <- 20
-  X <- matrix(rnorm(n), n, 1L)
-  y <- rnorm(n)
-
-  q_solve_ls_col <- expect_warning(quick(solve_ls_col), NA)
-  expect_equal(q_solve_ls_col(X, y), qr.solve(X, y))
+  q_solve_col <- quick(solve_col)
+  expect_error(q_solve_col(X[, 1L, drop = FALSE], y), "square matrix")
+  expect_equal(
+    q_solve_col(matrix(2.5, 1L, 1L), 1.25),
+    solve(matrix(2.5, 1L, 1L), 1.25)
+  )
 })
 
-test_that("solve compiles 1-row least-squares systems", {
+test_that("solve rejects statically rectangular systems at compile time", {
   solve_one_row <- function(X, y) {
     declare(
       type(X = double(1L, 2L)),
@@ -120,8 +110,7 @@ test_that("solve compiles 1-row least-squares systems", {
     )
     solve(X, y)
   }
-
-  expect_no_error(r2f(solve_one_row))
+  expect_error(r2f(solve_one_row), "solve requires a square matrix")
 })
 
 test_that("qr.solve matches R for vectors and matrices", {
@@ -195,7 +184,7 @@ test_that("qr.solve uses QR with pivoting for known square systems", {
   expect_false(has_call(square_fortran, "dgesv"))
 })
 
-test_that("solve uses dgesv for known square and dgels for rectangular systems", {
+test_that("solve always uses dgesv, guarding squareness when symbolic", {
   solve_square <- function(A, b) {
     declare(
       type(A = double(n, n)),
@@ -212,12 +201,7 @@ test_that("solve uses dgesv for known square and dgels for rectangular systems",
     solve(A, b)
   }
 
-  solve_rect <- function(A, b) {
-    declare(type(A = double(3, 2)), type(b = double(3)))
-    solve(A, b)
-  }
-
-  solve_rect_named <- function(A, b) {
+  solve_sym <- function(A, b) {
     declare(
       type(A = double(n, k)),
       type(b = double(n))
@@ -233,12 +217,8 @@ test_that("solve uses dgesv for known square and dgels for rectangular systems",
     capture.output(cat(r2f(solve_square_fixed))),
     collapse = "\n"
   )
-  rect_fixed_fortran <- paste(
-    capture.output(cat(r2f(solve_rect))),
-    collapse = "\n"
-  )
-  rect_named_fortran <- paste(
-    capture.output(cat(r2f(solve_rect_named))),
+  sym_fortran <- paste(
+    capture.output(cat(r2f(solve_sym))),
     collapse = "\n"
   )
 
@@ -246,19 +226,18 @@ test_that("solve uses dgesv for known square and dgels for rectangular systems",
     any(grepl(paste0("call ", routine, "("), tolower(code), fixed = TRUE))
   }
 
-  # Search emitted Fortran to ensure solve() chooses LU (dgesv) for proven-square
-  # systems and least-squares (dgels) for rectangular systems.
+  # solve() is LU (dgesv) only; least squares is qr.solve()'s job. Provably
+  # square systems get no guard, symbolic squareness is checked at run time.
   expect_true(has_call(square_named_fortran, "dgesv"))
   expect_false(has_call(square_named_fortran, "dgels"))
+  expect_false(grepl("square matrix", square_named_fortran, fixed = TRUE))
 
   expect_true(has_call(square_fixed_fortran, "dgesv"))
   expect_false(has_call(square_fixed_fortran, "dgels"))
 
-  expect_true(has_call(rect_fixed_fortran, "dgels"))
-  expect_false(has_call(rect_fixed_fortran, "dgesv"))
-
-  expect_true(has_call(rect_named_fortran, "dgels"))
-  expect_false(has_call(rect_named_fortran, "dgesv"))
+  expect_true(has_call(sym_fortran, "dgesv"))
+  expect_false(has_call(sym_fortran, "dgels"))
+  expect_match(sym_fortran, "solve requires a square matrix", fixed = TRUE)
 })
 
 test_that("chol and chol2inv match R", {
@@ -415,7 +394,7 @@ test_that("Test bad path in lapack functions", {
   }
 
   expect_error(quick(solve_bad_rank), "expects a matrix")
-  expect_warning(quick(solve_non_square), NA)
+  expect_error(quick(solve_non_square), "requires a square matrix")
   expect_error(quick(solve_bad_rhs), "only supports vector or matrix")
   expect_error(quick(chol_bad_rank), "expects a matrix")
   expect_error(quick(chol_pivot), "pivot = TRUE")
@@ -446,7 +425,7 @@ test_that("lapack functions test non-square matrix errors", {
     chol2inv(R)
   }
 
-  expect_warning(quick(solve_rect), NA)
+  expect_error(quick(solve_rect), "requires a square matrix")
   expect_error(quick(chol_rect), "requires a square matrix")
   expect_error(quick(chol2inv_rect), "requires a square matrix")
 })

From eb9c2a474ef5225888fdc3aa5b5f377430d33aec Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sun, 2 Aug 2026 12:18:50 +0200
Subject: [PATCH 17/97] Extract the shared conformability helpers

Three duplications across the elementwise operators, ifelse() and the
BLAS/LAPACK lowerings collapse into one helper each, all in
r2f-operators-helpers.R:

- guard_conformable_dims() becomes the single guard emitter for the
  conformability policy -- a statically known mismatch is a compile
  error, dims that cannot be compared statically get a statement-level
  runtime guard, provably equal dims need nothing. It moves out of
  r2f-matrix-blas.R (with guard_dim_f) and absorbs both private
  copies: emit_elementwise_size_guard() and ifelse()'s
  ifelse_axis_verdict() plus its inline .or. guard.
- check_conformable() was dims_match() written in list form; both call
  sites (bind_common_dim, solve routing) now say so, and the weaker
  helper's contract is spelled out next to it.
- real_floor_expr() carries the real-domain floor spelling shared by
  floor() and double %/%, so the aint/merge trick lives in one place.

Behavior-neutral: zero snapshot churn and a full QUICKR_FULL_GRID=1
pass at 14207 assertions.
---
 R/r2f-arithmetic.R        |   9 +-
 R/r2f-conditionals.R      |  61 +++---------
 R/r2f-math.R              |  12 +--
 R/r2f-matrix-blas.R       |  63 +------------
 R/r2f-matrix.R            |  15 +--
 R/r2f-operators-helpers.R | 191 +++++++++++++++++++++-----------------
 6 files changed, 130 insertions(+), 221 deletions(-)

diff --git a/R/r2f-arithmetic.R b/R/r2f-arithmetic.R
index 3efd573b..d45ee337 100644
--- a/R/r2f-arithmetic.R
+++ b/R/r2f-arithmetic.R
@@ -108,16 +108,13 @@ r2f_handlers[["%/%"]] <- function(args, scope, ..., hoist = NULL) {
       "int(floor(real({left}, kind=c_double) / real({right}, kind=c_double)), kind=c_int)"
     ),
     double = {
-      # Fortran FLOOR() returns an integer, so a large double quotient
-      # (e.g. 1e20 %/% 3) would silently overflow. Stay in the real domain
-      # as the floor() handler does; the quotient is spliced three times,
-      # so hoist it to evaluate once.
+      # The quotient is spliced three times by real_floor_expr(), so
+      # hoist it to evaluate once.
       q <- hoist_unless_name(
         Fortran(glue("({left} / {right})"), out_val),
         hoist
       )
-      aint <- glue("aint({q})")
-      glue("({aint} - merge(1.0_c_double, 0.0_c_double, ({q} < {aint})))")
+      real_floor_expr(q)
     },
     stop("%/% only implemented for numeric types")
   )
diff --git a/R/r2f-conditionals.R b/R/r2f-conditionals.R
index 9e767617..746d4548 100644
--- a/R/r2f-conditionals.R
+++ b/R/r2f-conditionals.R
@@ -8,34 +8,14 @@ ifelse_branch_shape_msg <- paste0(
   "R-style recycling is not supported"
 )
 
-# Three-valued conformability verdict for one axis of an ifelse() branch
-# against `test`: ok+known (no guard), not-ok+known (compile error), or
-# unknown (runtime guard). NA dims are always unknown: two unknown lengths
-# are not the same quantity.
-ifelse_axis_verdict <- function(test_dim, branch_dim) {
-  if (is_wholenumber(test_dim) && is_wholenumber(branch_dim)) {
-    return(list(
-      ok = identical(as.integer(test_dim), as.integer(branch_dim)),
-      unknown = FALSE
-    ))
-  }
-  if (!is_scalar_na(test_dim) && !is_scalar_na(branch_dim)) {
-    test_norm <- fortranize_expr_symbols(test_dim)
-    branch_norm <- fortranize_expr_symbols(branch_dim)
-    if (identical(test_norm, branch_norm)) {
-      return(list(ok = TRUE, unknown = FALSE))
-    }
-  }
-  list(ok = TRUE, unknown = TRUE)
-}
-
 # Enforce the shape contract for one ifelse() branch: scalars broadcast
 # natively; a non-scalar branch must match `test`'s shape, because
 # merge() requires conformable arguments and a runtime mismatch would
-# read past the shorter branch. Statically unequal dims are a compile
-# error; symbolic dims get a statement-level runtime size guard, emitted into
-# `hoist` -- always a live hoist context, since r2f() substitutes a fresh one
-# before dispatching to any handler.
+# read past the shorter branch. Per axis, guard_conformable_dims()
+# applies the framework policy: statically unequal dims are a compile
+# error; symbolic dims get a statement-level runtime size guard, emitted
+# into `hoist` -- always a live hoist context, since r2f() substitutes a
+# fresh one before dispatching to any handler.
 check_ifelse_branch_shape <- function(branch, mask, hoist, scope) {
   if (passes_as_scalar(branch@value)) {
     return(invisible())
@@ -43,32 +23,19 @@ check_ifelse_branch_shape <- function(branch, mask, hoist, scope) {
   if (branch@value@rank != mask@value@rank) {
     stop(ifelse_branch_shape_msg, call. = FALSE)
   }
-  unknown_axes <- integer()
   for (axis in seq_len(mask@value@rank)) {
-    verdict <- ifelse_axis_verdict(
+    guard_conformable_dims(
+      dim_or_one(branch, axis),
       dim_or_one(mask, axis),
-      dim_or_one(branch, axis)
+      ifelse_branch_shape_msg,
+      hoist,
+      scope,
+      left = branch,
+      right = mask,
+      left_axis = axis,
+      right_axis = axis
     )
-    if (!verdict$ok) {
-      stop(ifelse_branch_shape_msg, call. = FALSE)
-    }
-    if (verdict$unknown) {
-      unknown_axes <- c(unknown_axes, axis)
-    }
   }
-  if (!length(unknown_axes)) {
-    return(invisible())
-  }
-  # size() is an inquiry, so applying it to operand expression text does
-  # not evaluate the operands.
-  condition <- str_flatten(
-    map_chr(
-      unknown_axes,
-      function(axis) glue("size({branch}, {axis}) /= size({mask}, {axis})")
-    ),
-    " .or. "
-  )
-  emit_quickr_error_if(condition, ifelse_branch_shape_msg, hoist, scope)
   invisible()
 }
 
diff --git a/R/r2f-math.R b/R/r2f-math.R
index b69fb60d..926bad0a 100644
--- a/R/r2f-math.R
+++ b/R/r2f-math.R
@@ -55,15 +55,9 @@ r2f_handlers[["floor"]] <- function(args, scope, ..., hoist = NULL) {
   }
   out_val <- Variable("double", arg@value@dims)
 
-  # Avoid Fortran FLOOR() overflow (it returns an integer) by staying in the
-  # real domain:
-  # - aint(x) truncates toward 0 (real result)
-  # - adjust by -1 where trunc differs from floor (negative non-integers)
-  aint <- glue("aint({arg})")
-  Fortran(
-    glue("({aint} - merge(1.0_c_double, 0.0_c_double, ({arg} < {aint})))"),
-    out_val
-  )
+  # Avoid Fortran FLOOR() overflow (it returns an integer) by staying in
+  # the real domain; real_floor_expr() shares the spelling with `%/%`.
+  Fortran(real_floor_expr(arg), out_val)
 }
 
 r2f_handlers[["ceiling"]] <- function(args, scope, ..., hoist = NULL) {
diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index baab43cc..cb0a46b6 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -61,54 +61,6 @@ assert_rhs_rank <- function(
   invisible(TRUE)
 }
 
-# Render one side of a dim-comparison guard: a literal dim as the literal,
-# anything else as the operand's actual extent. size() is an inquiry, so
-# applying it to operand expression text does not evaluate the operand.
-guard_dim_f <- function(dim, operand, axis = NULL) {
-  if (is_wholenumber(dim)) {
-    return(as.character(as.integer(dim)))
-  }
-  if (is.null(axis)) {
-    glue("size({operand})")
-  } else {
-    glue("size({operand}, {axis})")
-  }
-}
-
-# The one conformability policy for BLAS/LAPACK lowerings: a statically
-# known mismatch is a compile error; dims that cannot be compared
-# statically get a statement-level runtime guard emitted before the BLAS
-# call; provably equal dims need nothing. Never warn-and-proceed. `axis`
-# NULL compares the operand's whole size (rank-1 operands).
-guard_conformable_dims <- function(
-  left_dim,
-  right_dim,
-  message,
-  hoist,
-  scope,
-  left,
-  right,
-  left_axis = NULL,
-  right_axis = NULL
-) {
-  stopifnot(is_string(message))
-  conform <- check_elementwise_lengths(left_dim, right_dim)
-  if (!conform$ok) {
-    stop(message, call. = FALSE)
-  }
-  if (conform$unknown) {
-    emit_quickr_error_if(
-      glue(
-        "{guard_dim_f(left_dim, left, left_axis)} /= {guard_dim_f(right_dim, right, right_axis)}"
-      ),
-      message,
-      hoist,
-      scope
-    )
-  }
-  invisible(TRUE)
-}
-
 # Return the R symbol name if operand is a bare symbol; otherwise NULL.
 symbol_name_or_null <- function(x) {
   stopifnot(inherits(x, Fortran))
@@ -199,18 +151,6 @@ effective_dims <- function(dims, trans) {
   }
 }
 
-# Return conformability status (ok/unknown) without side-effects.
-check_conformable <- function(left, right) {
-  if (is_wholenumber(left) && is_wholenumber(right)) {
-    ok <- identical(as.integer(left), as.integer(right))
-    return(list(ok = ok, unknown = FALSE))
-  }
-  if (identical(left, right)) {
-    return(list(ok = TRUE, unknown = FALSE))
-  }
-  list(ok = TRUE, unknown = TRUE)
-}
-
 # Enforce that `dims` describe a square matrix: a known mismatch is a
 # compile error; unverifiable dims get a runtime guard on the operand's
 # actual extents.
@@ -709,8 +649,7 @@ lapack_solve <- function(
   # test-matrix-lapack.R. Squareness is a routing decision here, not a
   # correctness guard: unknown squareness routes to dgels, which solves
   # square systems exactly too.
-  square <- check_conformable(m, n)
-  if (square$ok && !square$unknown && !identical(context, "qr.solve")) {
+  if (dims_match(m, n) && !identical(context, "qr.solve")) {
     A_work <- hoist$declare_tmp(mode = "double", dims = list(m, m))
     hoist$emit(glue("{A_work@name} = {A_name}"))
 
diff --git a/R/r2f-matrix.R b/R/r2f-matrix.R
index d2526987..57dabee8 100644
--- a/R/r2f-matrix.R
+++ b/R/r2f-matrix.R
@@ -288,17 +288,10 @@ bind_common_dim <- function(dim_list, scalar_flags, context, label) {
   }
   if (length(non_scalar) > 1L) {
     for (idx in non_scalar[-1L]) {
-      conform <- check_conformable(target, dim_list[[idx]])
-      if (!conform$ok) {
-        stop(
-          context,
-          " requires inputs with a common ",
-          label,
-          " count",
-          call. = FALSE
-        )
-      }
-      if (conform$unknown) {
+      # A dim that is not provably equal to the common one is an error
+      # either way: the declaration needs the dim, so "unknown" cannot be
+      # deferred to a runtime guard here.
+      if (!dims_match(target, dim_list[[idx]])) {
         stop(
           context,
           " requires inputs with a common ",
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 8cfd1cb4..093ebac6 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -144,8 +144,12 @@ is_one_by_one <- function(x) {
     dim_is_one(x@value@dims[[2L]])
 }
 
-# Check if two dimension expressions match.
-# Used by: r2f-arithmetic.R, r2f-logical.R
+# Check if two dimension expressions provably match (both known and
+# equal, or the identical symbolic expression). Weaker than
+# check_elementwise_lengths(): no zero-length policy, no symbol
+# normalization -- callers use it for routing/declaration decisions, not
+# for the conformability contract.
+# Used by: r2f-matrix.R (bind_common_dim), r2f-matrix-blas.R (solve routing)
 dims_match <- function(left, right) {
   if (is_wholenumber(left) && is_wholenumber(right)) {
     return(identical(as.integer(left), as.integer(right)))
@@ -159,7 +163,7 @@ dims_match <- function(left, right) {
 # and nonzero -- R-style recycling is never implemented, and quickr cannot
 # represent length-0 results. NA dims are always unknown: two unknown
 # lengths are not the same quantity.
-# Used by: maybe_reshape_vector_matrix()
+# Used by: guard_conformable_dims()
 check_elementwise_lengths <- function(left, right) {
   if (is_wholenumber(left) && is_wholenumber(right)) {
     left <- as.integer(left)
@@ -182,33 +186,60 @@ check_elementwise_lengths <- function(left, right) {
   list(ok = TRUE, unknown = TRUE)
 }
 
-# Emit a statement-level runtime check that two elementwise operands have
-# equal size along the given axes (whole size when an axis is NULL).
-# size() is an inquiry, so applying it to operand expression text does not
-# evaluate the operands.
+# Render one side of a dim-comparison guard: a literal dim as the literal,
+# anything else as the operand's actual extent (whole size when `axis` is
+# NULL). size() is an inquiry, so applying it to operand expression text
+# does not evaluate the operand.
+# Used by: guard_conformable_dims()
+guard_dim_f <- function(dim, operand, axis = NULL) {
+  if (is_wholenumber(dim)) {
+    return(as.character(as.integer(dim)))
+  }
+  if (is.null(axis)) {
+    glue("size({operand})")
+  } else {
+    glue("size({operand}, {axis})")
+  }
+}
+
+# The one conformability policy, shared by elementwise ops, ifelse(), and
+# the BLAS/LAPACK lowerings: a statically known mismatch is a compile
+# error; dims that cannot be compared statically get a statement-level
+# runtime guard emitted before the consuming statement; provably equal
+# dims need nothing. Never warn-and-proceed. `axis` NULL compares the
+# operand's whole size (rank-1 operands).
 #
-# `hoist` is always available here: r2f() opens one per statement before
-# dispatching to a handler, and every operator handler forwards the one it
-# received. emit_quickr_error_if() asserts it.
-# Used by: maybe_reshape_vector_matrix()
-emit_elementwise_size_guard <- function(
-  left,
-  right,
+# `hoist` is always live: r2f() opens one per statement before dispatching
+# to a handler, and every caller forwards the one it received.
+# emit_quickr_error_if() asserts it.
+# Used by: maybe_reshape_vector_matrix(), r2f-conditionals.R, r2f-matrix*.R
+guard_conformable_dims <- function(
+  left_dim,
+  right_dim,
+  message,
   hoist,
   scope,
-  message,
+  left,
+  right,
   left_axis = NULL,
-  right_axis = left_axis
+  right_axis = NULL
 ) {
-  size_of <- function(x, axis) {
-    if (is.null(axis)) glue("size({x})") else glue("size({x}, {axis})")
+  stopifnot(is_string(message))
+  conform <- check_elementwise_lengths(left_dim, right_dim)
+  if (!conform$ok) {
+    stop(message, call. = FALSE)
   }
-  emit_quickr_error_if(
-    glue("{size_of(left, left_axis)} /= {size_of(right, right_axis)}"),
-    message,
-    hoist,
-    scope
-  )
+  if (conform$unknown) {
+    emit_quickr_error_if(
+      glue(
+        "{guard_dim_f(left_dim, left, left_axis)} /= {guard_dim_f(right_dim, right, right_axis)}"
+      ),
+      message,
+      hoist,
+      scope
+    )
+  }
+  invisible(TRUE)
 }
 
 # Reshape a vector to match a matrix's dimensions.
@@ -227,6 +258,17 @@ reshape_vector_for_matrix <- function(vec, rows, cols) {
   Fortran(out_expr, out_val)
 }
 
+# Floor a double expression while staying in the real domain: Fortran
+# FLOOR() returns an integer, so a large double (e.g. 1e20) would
+# silently overflow. aint(x) truncates toward 0 (real result); adjust by
+# -1 where truncation differs from floor (negative non-integers). `x` is
+# spliced three times, so callers hoist non-trivial expressions first.
+# Used by: r2f-math.R (floor), r2f-arithmetic.R (double %/%)
+real_floor_expr <- function(x) {
+  aint <- glue("aint({x})")
+  glue("({aint} - merge(1.0_c_double, 0.0_c_double, ({x} < {aint})))")
+}
+
 # Convert a 1x1 matrix to a scalar.
 # Used by: r2f-arithmetic.R, r2f-logical.R
 scalarize_matrix <- function(mat) {
@@ -236,10 +278,10 @@ scalarize_matrix <- function(mat) {
 }
 
 # Reshape vector/matrix operands to match ranks for binary operations, and
-# enforce the elementwise conformability policy: known-mismatched lengths
-# are compile errors (R-style recycling is not supported; scalar broadcast
-# is native), lengths that cannot be compared statically get a runtime
-# size guard through `hoist`.
+# enforce the elementwise conformability policy via guard_conformable_dims()
+# -- known-mismatched lengths are compile errors (R-style recycling is not
+# supported; scalar broadcast is native), lengths that cannot be compared
+# statically get a runtime size guard through `hoist`.
 #
 # `scalarize_one_by_one` mirrors R's split over length-1 arrays: arithmetic
 # recycles a 1x1 matrix against a vector of statically known length != 1
@@ -312,45 +354,32 @@ maybe_reshape_vector_matrix <- function(
       "elementwise vector operations require equal lengths or ",
       "a scalar operand; R-style recycling is not supported"
     )
-    conform <- check_elementwise_lengths(
+    guard_conformable_dims(
       dim_or_one(left, 1L),
-      dim_or_one(right, 1L)
+      dim_or_one(right, 1L),
+      vector_msg,
+      hoist,
+      scope,
+      left = left,
+      right = right
     )
-    if (!conform$ok) {
-      stop(vector_msg, call. = FALSE)
-    }
-    if (conform$unknown) {
-      emit_elementwise_size_guard(left, right, hoist, scope, vector_msg)
-    }
   }
 
   if (left_rank == 2L && right_rank == 2L) {
     matrix_msg <- "elementwise matrix operations require matching dimensions"
     left_dims <- matrix_dims(left)
     right_dims <- matrix_dims(right)
-    row_conform <- check_elementwise_lengths(left_dims$rows, right_dims$rows)
-    col_conform <- check_elementwise_lengths(left_dims$cols, right_dims$cols)
-    if (!row_conform$ok || !col_conform$ok) {
-      stop(matrix_msg, call. = FALSE)
-    }
-    if (row_conform$unknown) {
-      emit_elementwise_size_guard(
-        left,
-        right,
-        hoist,
-        scope,
+    for (axis in 1:2) {
+      guard_conformable_dims(
+        if (axis == 1L) left_dims$rows else left_dims$cols,
+        if (axis == 1L) right_dims$rows else right_dims$cols,
         matrix_msg,
-        left_axis = 1L
-      )
-    }
-    if (col_conform$unknown) {
-      emit_elementwise_size_guard(
-        left,
-        right,
         hoist,
         scope,
-        matrix_msg,
-        left_axis = 2L
+        left = left,
+        right = right,
+        left_axis = axis,
+        right_axis = axis
       )
     }
   }
@@ -361,39 +390,29 @@ maybe_reshape_vector_matrix <- function(
   )
   if (left_rank == 1L && right_rank == 2L) {
     right_dims <- matrix_dims(right)
-    left_len <- dim_or_one(left, 1L)
-    row_conform <- check_elementwise_lengths(left_len, right_dims$rows)
-    if (!row_conform$ok) {
-      stop(vec_mat_msg, call. = FALSE)
-    }
-    if (row_conform$unknown) {
-      emit_elementwise_size_guard(
-        left,
-        right,
-        hoist,
-        scope,
-        vec_mat_msg,
-        right_axis = 1L
-      )
-    }
+    guard_conformable_dims(
+      dim_or_one(left, 1L),
+      right_dims$rows,
+      vec_mat_msg,
+      hoist,
+      scope,
+      left = left,
+      right = right,
+      right_axis = 1L
+    )
     left <- reshape_vector_for_matrix(left, right_dims$rows, right_dims$cols)
   } else if (left_rank == 2L && right_rank == 1L) {
     left_dims <- matrix_dims(left)
-    right_len <- dim_or_one(right, 1L)
-    row_conform <- check_elementwise_lengths(right_len, left_dims$rows)
-    if (!row_conform$ok) {
-      stop(vec_mat_msg, call. = FALSE)
-    }
-    if (row_conform$unknown) {
-      emit_elementwise_size_guard(
-        right,
-        left,
-        hoist,
-        scope,
-        vec_mat_msg,
-        right_axis = 1L
-      )
-    }
+    guard_conformable_dims(
+      dim_or_one(right, 1L),
+      left_dims$rows,
+      vec_mat_msg,
+      hoist,
+      scope,
+      left = right,
+      right = left,
+      right_axis = 1L
+    )
     right <- reshape_vector_for_matrix(right, left_dims$rows, left_dims$cols)
   }
 

From f77a07af85e8ee1f81dd2030279064e5e5867ad7 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 11:46:10 +0200
Subject: [PATCH 18/97] Unify lapack_solve's branch structure and output
 selection

The dgesv branch ended in return(), leaving the qr.solve condition that
followed always-true (and the function textually able to fall off the
end). The branches are a plain if/else now, converging on one tail. The
identical output-target selection is one shared spelling (dest_usable),
still evaluated at each branch's original write point so declaration
order and error order in the emitted block are unchanged.

Review finding (fable-final-review.md #2); no behavior change.
---
 R/r2f-matrix-blas.R | 77 ++++++++++++++++++---------------------------
 1 file changed, 31 insertions(+), 46 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index c5b1fa5a..d2846b14 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -643,6 +643,21 @@ lapack_solve <- function(
 
   nrhs <- if (b_rank == 1L) 1L else dim_or_one(B, 2L)
 
+  # Both lowerings write a solution shaped by R's contract: length follows
+  # ncol(a), width follows the right-hand side. Each branch resolves the
+  # output target at its own write point (declaration order matters for
+  # the emitted block) with the one shared spelling below.
+  expected_dims <- if (b_rank == 1L) list(n) else list(n, nrhs)
+  dest_usable <- function() {
+    can_use_output(
+      dest,
+      input_names = c(A_name, B_input_name),
+      expected_dims = expected_dims,
+      context = context,
+      allow_alias = B_input_name
+    )
+  }
+
   # R's solve() requires a square `a`; least squares is qr.solve()'s job.
   # Statically rectangular `a` is a compile error, symbolic dims get a
   # runtime guard before the dgesv call. (A rectangular `a` used to fall
@@ -652,24 +667,13 @@ lapack_solve <- function(
     A_work <- hoist$declare_tmp(mode = "double", dims = list(m, m))
     hoist$emit(glue("{A_work@name} = {A_name}"))
 
-    expected_dims <- if (b_rank == 1L) list(n) else list(n, nrhs)
-    writes_to_dest <- FALSE
-    if (
-      can_use_output(
-        dest,
-        input_names = c(A_name, B_input_name),
-        expected_dims = expected_dims,
-        context = context,
-        allow_alias = B_input_name
-      )
-    ) {
-      out_var <- dest
-      out_name <- dest@name
-      writes_to_dest <- TRUE
+    use_dest <- dest_usable()
+    out_var <- if (use_dest) {
+      dest
     } else {
-      out_var <- hoist$declare_tmp(mode = "double", dims = expected_dims)
-      out_name <- out_var@name
+      hoist$declare_tmp(mode = "double", dims = expected_dims)
     }
+    out_name <- out_var@name
     # The output length follows ncol(a) (R's contract) while `b` follows
     # nrow(a); the two are only runtime-equal. When ncol is statically 1
     # the output declares as a scalar, so a symbolic-length `b` must be
@@ -700,15 +704,7 @@ lapack_solve <- function(
       hoist = hoist,
       scope = scope
     )
-
-    out <- Fortran(out_name, out_var)
-    if (writes_to_dest) {
-      out@writes_to_dest <- TRUE
-    }
-    return(out)
-  }
-
-  if (identical(context, "qr.solve")) {
+  } else {
     A_work <- hoist$declare_tmp(mode = "double", dims = list(m, n))
     hoist$emit(glue("{A_work@name} = {A_name}"))
 
@@ -771,24 +767,13 @@ end do"
       scope = scope
     )
 
-    expected_dims <- if (b_rank == 1L) list(n) else list(n, nrhs)
-    writes_to_dest <- FALSE
-    if (
-      can_use_output(
-        dest,
-        input_names = c(A_name, B_input_name),
-        expected_dims = expected_dims,
-        context = context,
-        allow_alias = B_input_name
-      )
-    ) {
-      out_var <- dest
-      out_name <- dest@name
-      writes_to_dest <- TRUE
+    use_dest <- dest_usable()
+    out_var <- if (use_dest) {
+      dest
     } else {
-      out_var <- hoist$declare_tmp(mode = "double", dims = expected_dims)
-      out_name <- out_var@name
+      hoist$declare_tmp(mode = "double", dims = expected_dims)
     }
+    out_name <- out_var@name
 
     if (passes_as_scalar(out_var)) {
       hoist$emit(glue("{out_name} = {coef_work@name}(1, 1)"))
@@ -815,13 +800,13 @@ end do"
         ))
       }
     }
+  }
 
-    out <- Fortran(out_name, out_var)
-    if (writes_to_dest) {
-      out@writes_to_dest <- TRUE
-    }
-    return(out)
+  out <- Fortran(out_name, out_var)
+  if (use_dest) {
+    out@writes_to_dest <- TRUE
   }
+  out
 }
 
 lapack_inverse <- function(A, scope, hoist, dest = NULL, context = "solve") {

From 5446a3fba1468c74860652233ca356d9f5b203c0 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sun, 2 Aug 2026 15:29:42 +0200
Subject: [PATCH 19/97] Resolve named handlers by name at dispatch, like
 dest_infer

`register_r2f_handler()` stores the handler as a function object captured at
build time. covr rebinds its instrumented copies into the namespace after the
package has loaded, so a handler registered as a top-level named function keeps
dispatching the copy taken at registration: the instrumented copy never runs and
the handler reads as 0% covered however well it is tested. Its callees still
read as covered, because their names resolve from the namespace at call time --
which is what makes the pattern recognisable.

The file already documents this hazard and works around it for `dest_infer`, by
recording `dest_infer_name` and resolving it at call time. Do the same for the
handler itself: record `fun_name` at registration and let `get_r2f_handler()`
swap in the current namespace binding.

The object stays authoritative. Of the registrations in the tree, 27 pass an
anonymous function literal, which has no name to resolve; the name is a
supplement for the ones that don't. Recording it is deliberately stricter than
`dest_infer_name`: the argument must be a symbol *and* name this same function
in a namespace, since that is the only environment covr rebinds into. That
excludes the local `handler` closure built by `register_unary_intrinsic()`,
whose name means something else on the next call, and `r2f_handlers[["<-"]]`,
which is not a symbol at all. `dest_infer` is left as it is; it is advisory,
whereas the handler is called, so a wrong resolution there would be a bug.

No handler in the tree is currently registered by name, so nothing changes
today. It is what lets a handler be extracted into a named function without
the extraction reading as untested.
---
 R/classes.R                        |  3 ++
 R/r2f-aaa-registry.R               | 34 +++++++++++++++
 R/r2f-aab-core.R                   | 25 ++++++++++-
 tests/testthat/test-r2f-registry.R | 69 ++++++++++++++++++++++++++++++
 4 files changed, 130 insertions(+), 1 deletion(-)

diff --git a/R/classes.R b/R/classes.R
index cb6fb765..7e414e2b 100644
--- a/R/classes.R
+++ b/R/classes.R
@@ -426,6 +426,9 @@ R2FHandler := new_class(
     dest_supported = prop_bool(default = FALSE),
     dest_infer = new_property(NULL | class_function),
     dest_infer_name = prop_string(default = NULL, allow_null = TRUE),
+    # Set when the handler was registered as a namespace-level named function,
+    # so dispatch can re-resolve it by name. See register_r2f_handler().
+    fun_name = prop_string(default = NULL, allow_null = TRUE),
     # When NULL, r2f will resolve the callable by name and use match.call().
     # When FALSE, r2f will not attempt match.call().
     match_fun = new_property(
diff --git a/R/r2f-aaa-registry.R b/R/r2f-aaa-registry.R
index 04a71f0d..c3d4efbe 100644
--- a/R/r2f-aaa-registry.R
+++ b/R/r2f-aaa-registry.R
@@ -14,6 +14,15 @@ register_r2f_handler <- function(
 
   handler <- if (inherits(fun, R2FHandler)) fun else R2FHandler(fun)
 
+  # Same hazard as `dest_infer` below, for the handler itself: the function
+  # object is captured here, at build time, while covr rebinds its instrumented
+  # copies into the namespace after the package has loaded. A handler registered
+  # as a top-level named function would keep dispatching the copy taken here and
+  # read as 0% covered however well it is tested. Record the name so
+  # get_r2f_handler() can re-resolve it; the object stays authoritative, since
+  # most handlers are anonymous literals with no name to resolve.
+  handler@fun_name <- registered_fun_name(substitute(fun), fun)
+
   if (!is.null(dest_supported)) {
     handler@dest_supported <- isTRUE(dest_supported)
   }
@@ -47,3 +56,28 @@ register_r2f_handler <- function(
   }
   invisible(handler)
 }
+
+
+# The name to re-resolve a registered handler by, or NULL if there isn't one.
+#
+# `expr` is the unevaluated `fun` argument and `fun` its value. A name is only
+# usable if `expr` is a symbol *and* it names this same function in a namespace
+# -- the only environment covr rebinds into. That rules out the two non-literal
+# registrations that are not namespace-level functions: the local `handler`
+# closure built by register_unary_intrinsic() (a symbol, but bound in a call
+# frame, where the name would mean something else on a later call) and
+# `r2f_handlers[["<-"]]` (not a symbol at all).
+registered_fun_name <- function(expr, fun) {
+  if (!is.symbol(expr)) {
+    return(NULL)
+  }
+  name <- as.character(expr)
+  env <- environment(fun)
+  if (!is.environment(env) || !isNamespace(env)) {
+    return(NULL)
+  }
+  if (!identical(get0(name, envir = env, mode = "function"), fun)) {
+    return(NULL)
+  }
+  name
+}
diff --git a/R/r2f-aab-core.R b/R/r2f-aab-core.R
index d462e449..af222e03 100644
--- a/R/r2f-aab-core.R
+++ b/R/r2f-aab-core.R
@@ -380,8 +380,31 @@ num2fortran <- function(x) {
 
 get_r2f_handler <- function(name) {
   stopifnot("All functions called must be named as symbols" = is.symbol(name))
-  get0(name, r2f_handlers) %||%
+  handler <- get0(name, r2f_handlers) %||%
     stop("Unsupported function: ", name, call. = FALSE)
+  resolve_handler_fun(handler)
+}
+
+
+# Swap in the handler's current namespace binding, so an instrumented or
+# otherwise rebound copy is dispatched instead of the one captured at
+# registration. Only handlers registered as namespace-level named functions
+# carry a `fun_name`; for every other handler this is a property read and a
+# return. See register_r2f_handler() for why the name is recorded.
+resolve_handler_fun <- function(handler) {
+  if (!inherits(handler, R2FHandler)) {
+    return(handler)
+  }
+  name <- handler@fun_name
+  if (!is_string(name)) {
+    return(handler)
+  }
+  current <- get0(name, envir = environment(handler), mode = "function")
+  if (is.null(current) || identical(current, S7_data(handler))) {
+    return(handler)
+  }
+  S7_data(handler) <- current
+  handler
 }
 
 
diff --git a/tests/testthat/test-r2f-registry.R b/tests/testthat/test-r2f-registry.R
index 137d3eaf..c2a89eef 100644
--- a/tests/testthat/test-r2f-registry.R
+++ b/tests/testthat/test-r2f-registry.R
@@ -62,6 +62,75 @@ test_that("register_r2f_handler does not set match.fun when TRUE", {
   expect_null(result@match_fun)
 })
 
+test_that("register_r2f_handler records the name of a namespace-level handler", {
+  withr::defer(
+    rm(list = "test_handler_named", envir = quickr:::r2f_handlers),
+    envir = environment()
+  )
+  # Passed as a bare symbol, the way the package's own top-level registrations
+  # do it -- `quickr:::last` would be a call, with no name to record.
+  result <- quickr:::register_r2f_handler("test_handler_named", last)
+  expect_identical(result@fun_name, "last")
+})
+
+test_that("register_r2f_handler leaves anonymous and local handlers unnamed", {
+  local_handler <- function(e, scope, ...) NULL
+  withr::defer(
+    rm(
+      list = c("test_handler_unnamed_anon", "test_handler_unnamed_local"),
+      envir = quickr:::r2f_handlers
+    ),
+    envir = environment()
+  )
+  anon <- quickr:::register_r2f_handler(
+    "test_handler_unnamed_anon",
+    function(e, scope, ...) NULL
+  )
+  # A symbol, but bound in a call frame rather than a namespace, so the name
+  # would mean something else the next time the frame is entered.
+  local <- quickr:::register_r2f_handler(
+    "test_handler_unnamed_local",
+    local_handler
+  )
+  expect_null(anon@fun_name)
+  expect_null(local@fun_name)
+})
+
+test_that("dispatch re-resolves a named handler's namespace binding", {
+  # covr rebinds its instrumented copies into the namespace after the package
+  # has loaded -- that is, after registration captured the function object.
+  # Mocking the binding reproduces that sequence exactly.
+  original <- last
+  withr::defer(
+    rm(list = "test_handler_rebound", envir = quickr:::r2f_handlers),
+    envir = environment()
+  )
+  registered <- quickr:::register_r2f_handler("test_handler_rebound", last)
+  expect_identical(registered@fun_name, "last")
+
+  local_mocked_bindings(last = function(x) "rebound")
+  resolved <- quickr:::get_r2f_handler(quote(test_handler_rebound))
+  expect_identical(resolved("ignored"), "rebound")
+
+  # Resolving hands back a copy; the registry still holds what was registered.
+  expect_identical(
+    S7::S7_data(quickr:::r2f_handlers[["test_handler_rebound"]]),
+    original
+  )
+})
+
+test_that("dispatch leaves unnamed handlers alone", {
+  handler <- function(e, scope, ...) "anonymous"
+  withr::defer(
+    rm(list = "test_handler_untouched", envir = quickr:::r2f_handlers),
+    envir = environment()
+  )
+  quickr:::register_r2f_handler("test_handler_untouched", handler)
+  resolved <- quickr:::get_r2f_handler(quote(test_handler_untouched))
+  expect_null(resolved@fun_name)
+  expect_identical(S7::S7_data(resolved), handler)
+})
+
 test_that("register_r2f_handler registers multiple names", {
   handler <- function(e, scope, ...) NULL
   withr::defer(

From 4b26653d101dfb4d1996f08b01174fd39abae73e Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 17:45:31 +0200
Subject: [PATCH 20/97] Share the BLAS/LAPACK output-resolution and info-guard
 boilerplate

Every BLAS/LAPACK emitter hand-rolled the same dance: try can_use_output(),
fall back to a hoisted temp, and finish by wrapping the result and setting
writes_to_dest. gemm/gemv/dger even duplicated their full call strings in
both branches. resolve_blas_output() + blas_output_fortran() now spell it
once; emit_lapack_info_guards() replaces the six copies of the info >0/<0
guard pair (dgesdd keeps its negative-first order). lapack_solve()'s two
disjoint lowerings split into lapack_solve_gesv()/lapack_solve_qr() behind
the shared preamble. assert_rhs_rank() drops its never-used call_scalar/
call_high parameters. Emitted Fortran is unchanged.
---
 R/r2f-matrix-blas.R | 867 +++++++++++++++++++++-----------------------
 1 file changed, 413 insertions(+), 454 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 3b693279..d1d09665 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -38,25 +38,13 @@ assert_rank_leq2 <- function(x, message) {
 }
 
 # Assert right-hand side rank is vector or matrix.
-assert_rhs_rank <- function(
-  rank,
-  err_scalar,
-  err_high,
-  call_scalar = FALSE,
-  call_high = FALSE
-) {
-  stopifnot(
-    is_wholenumber(rank),
-    is_string(err_scalar),
-    is_string(err_high),
-    is_bool(call_scalar),
-    is_bool(call_high)
-  )
+assert_rhs_rank <- function(rank, err_scalar, err_high) {
+  stopifnot(is_wholenumber(rank), is_string(err_scalar), is_string(err_high))
   if (rank > 2L) {
-    stop(err_high, call. = call_high)
+    stop(err_high, call. = FALSE)
   }
   if (rank == 0L) {
-    stop(err_scalar, call. = call_scalar)
+    stop(err_scalar, call. = FALSE)
   }
   invisible(TRUE)
 }
@@ -233,6 +221,89 @@ can_use_output <- function(
   !output_name %in% disallowed
 }
 
+# Resolve where a BLAS/LAPACK emitter writes its result: the assignment
+# destination when can_use_output() allows it, otherwise a hoisted
+# temporary declared with the expected dims. Returns list(var, name,
+# use_dest); wrap up with blas_output_fortran().
+resolve_blas_output <- function(
+  dest,
+  hoist,
+  input_names,
+  expected_dims,
+  context,
+  allow_alias = character(),
+  mode = "double",
+  logical_is_c_int = FALSE
+) {
+  if (
+    can_use_output(
+      dest,
+      input_names = input_names,
+      expected_dims = expected_dims,
+      context = context,
+      allow_alias = allow_alias,
+      mode = mode,
+      logical_is_c_int = logical_is_c_int
+    )
+  ) {
+    return(list(var = dest, name = dest@name, use_dest = TRUE))
+  }
+  var <- hoist$declare_tmp(
+    mode = mode,
+    dims = expected_dims,
+    logical_as_int = logical_is_c_int
+  )
+  list(var = var, name = var@name, use_dest = FALSE)
+}
+
+# Wrap a resolved output as the emitter's return value, marking
+# destination writes so the assignment handler skips the copy.
+blas_output_fortran <- function(out) {
+  f <- Fortran(out$name, out$var)
+  if (out$use_dest) {
+    f@writes_to_dest <- TRUE
+  }
+  f
+}
+
+# Emit the guard pair for a LAPACK `info` result: a routine-specific
+# message when info > 0 and the uniform illegal-argument message when
+# info < 0. dgesdd checks the negative case first; the per-site order is
+# preserved so the emitted guards (and snapshots) are unchanged.
+emit_lapack_info_guards <- function(
+  info,
+  routine,
+  positive_msg,
+  hoist,
+  scope,
+  negative_first = FALSE
+) {
+  emit_positive <- function() {
+    emit_quickr_error_if(
+      condition = glue("{info} > 0_c_int"),
+      message = positive_msg,
+      hoist = hoist,
+      scope = scope
+    )
+  }
+  emit_negative <- function() {
+    emit_quickr_error_if(
+      condition = glue("{info} < 0_c_int"),
+      message = glue("Lapack routine {routine}: illegal argument"),
+      hoist = hoist,
+      scope = scope
+    )
+  }
+  if (negative_first) {
+    emit_negative()
+    emit_positive()
+  } else {
+    emit_positive()
+    emit_negative()
+  }
+  invisible(TRUE)
+}
+
 # Ensure a BLAS operand is named, hoisting into a temp if needed.
 ensure_blas_operand_name <- function(x, hoist) {
   name <- symbol_name_or_null(x)
@@ -260,8 +331,7 @@ blas_int <- function(x) {
   glue("int({x_str}, kind=c_int)")
 }
 
-# Centralized GEMM emission with optional destination
-# gemm: centralized BLAS GEMM emission.
+# gemm: centralized BLAS GEMM emission with optional destination.
 # - 'hoist' is required and provided by r2f(); handlers thread it through so
 #   helpers can pre-emit temporary assignments and BLAS calls.
 gemm <- function(
@@ -284,31 +354,20 @@ gemm <- function(
   A_name <- ensure_blas_operand_name(left, hoist)
   B_name <- ensure_blas_operand_name(right, hoist)
 
-  if (
-    can_use_output(
-      dest,
-      input_names = c(A_name, B_name),
-      expected_dims = list(m, n),
-      context = context
-    )
-  ) {
-    hoist$emit(glue(
-      "call dgemm('{opA}','{opB}', {blas_int(m)}, {blas_int(n)}, {blas_int(k)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {B_name}, {blas_int(ldb)}, 0.0_c_double, {dest@name}, {blas_int(ldc_expr)})"
-    ))
-    out <- Fortran(dest@name, dest)
-    out@writes_to_dest <- TRUE
-    return(out)
-  }
-
-  output_var <- hoist$declare_tmp(mode = "double", dims = list(m, n))
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = c(A_name, B_name),
+    expected_dims = list(m, n),
+    context = context
+  )
   hoist$emit(glue(
-    "call dgemm('{opA}','{opB}', {blas_int(m)}, {blas_int(n)}, {blas_int(k)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {B_name}, {blas_int(ldb)}, 0.0_c_double, {output_var@name}, {blas_int(ldc_expr)})"
+    "call dgemm('{opA}','{opB}', {blas_int(m)}, {blas_int(n)}, {blas_int(k)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {B_name}, {blas_int(ldb)}, 0.0_c_double, {out$name}, {blas_int(ldc_expr)})"
   ))
-  Fortran(output_var@name, output_var)
+  blas_output_fortran(out)
 }
 
-# Centralized GEMV emission with optional destination
-# gemv: centralized BLAS GEMV emission.
+# gemv: centralized BLAS GEMV emission with optional destination.
 # - 'hoist' is required and provided by r2f(); handlers thread it through so
 #   helpers can pre-emit temporary assignments and BLAS calls.
 gemv <- function(
@@ -328,28 +387,17 @@ gemv <- function(
   A_name <- ensure_blas_operand_name(A, hoist)
   x_name <- ensure_blas_operand_name(x, hoist)
 
-  if (
-    can_use_output(
-      dest,
-      input_names = c(A_name, x_name),
-      expected_dims = out_dims,
-      context = context
-    )
-  ) {
-    # Assign output to output destination
-    hoist$emit(glue(
-      "call dgemv('{transA}', {blas_int(m)}, {blas_int(n)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {x_name}, 1_c_int, 0.0_c_double, {dest@name}, 1_c_int)"
-    ))
-    out <- Fortran(dest@name, dest)
-    out@writes_to_dest <- TRUE
-    return(out)
-  }
-  # Else assign to a temporary variable
-  output_var <- hoist$declare_tmp(mode = "double", dims = out_dims)
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = c(A_name, x_name),
+    expected_dims = out_dims,
+    context = context
+  )
   hoist$emit(glue(
-    "call dgemv('{transA}', {blas_int(m)}, {blas_int(n)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {x_name}, 1_c_int, 0.0_c_double, {output_var@name}, 1_c_int)"
+    "call dgemv('{transA}', {blas_int(m)}, {blas_int(n)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {x_name}, 1_c_int, 0.0_c_double, {out$name}, 1_c_int)"
   ))
-  Fortran(output_var@name, output_var)
+  blas_output_fortran(out)
 }
 
 symmetrize_upper_to_lower <- function(target, n, hoist) {
@@ -428,36 +476,20 @@ syrk <- function(
   lda <- x_dims$rows
 
   # Output is symmetric n x n matrix
-  writes_to_dest <- FALSE
-  out_var <- NULL
-  out_name <- NULL
-
-  if (
-    can_use_output(
-      dest,
-      input_names = X_name,
-      expected_dims = list(n, n),
-      context = context
-    )
-  ) {
-    writes_to_dest <- TRUE
-    out_var <- dest
-    out_name <- dest@name
-  } else {
-    out_var <- hoist$declare_tmp(mode = "double", dims = list(n, n))
-    out_name <- out_var@name
-  }
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = X_name,
+    expected_dims = list(n, n),
+    context = context
+  )
 
   hoist$emit(glue(
-    "call dsyrk('U', '{trans}', {blas_int(n)}, {blas_int(k)}, 1.0_c_double, {X_name}, {blas_int(lda)}, 0.0_c_double, {out_name}, {blas_int(n)})"
+    "call dsyrk('U', '{trans}', {blas_int(n)}, {blas_int(k)}, 1.0_c_double, {X_name}, {blas_int(lda)}, 0.0_c_double, {out$name}, {blas_int(n)})"
   ))
-  symmetrize_upper_to_lower(out_name, n, hoist = hoist)
+  symmetrize_upper_to_lower(out$name, n, hoist = hoist)
 
-  out <- Fortran(out_name, out_var)
-  if (writes_to_dest) {
-    out@writes_to_dest <- TRUE
-  }
-  out
+  blas_output_fortran(out)
 }
 
 # Emit BLAS outer product for vectors or scalars with optional destination.
@@ -484,29 +516,18 @@ outer_mul <- function(
   x_name <- ensure_blas_operand_name(x, hoist)
   y_name <- ensure_blas_operand_name(y, hoist)
 
-  if (
-    can_use_output(
-      dest,
-      input_names = c(x_name, y_name),
-      expected_dims = list(m, n),
-      context = context
-    )
-  ) {
-    hoist$emit(glue("{dest@name} = 0.0_c_double"))
-    hoist$emit(glue(
-      "call dger({blas_int(m)}, {blas_int(n)}, 1.0_c_double, {x_name}, 1_c_int, {y_name}, 1_c_int, {dest@name}, {blas_int(m)})"
-    ))
-    out <- Fortran(dest@name, dest)
-    out@writes_to_dest <- TRUE
-    return(out)
-  }
-
-  output_var <- hoist$declare_tmp(mode = "double", dims = list(m, n))
-  hoist$emit(glue("{output_var@name} = 0.0_c_double"))
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = c(x_name, y_name),
+    expected_dims = list(m, n),
+    context = context
+  )
+  hoist$emit(glue("{out$name} = 0.0_c_double"))
   hoist$emit(glue(
-    "call dger({blas_int(m)}, {blas_int(n)}, 1.0_c_double, {x_name}, 1_c_int, {y_name}, 1_c_int, {output_var@name}, {blas_int(m)})"
+    "call dger({blas_int(m)}, {blas_int(n)}, 1.0_c_double, {x_name}, 1_c_int, {y_name}, 1_c_int, {out$name}, {blas_int(m)})"
   ))
-  Fortran(output_var@name, output_var)
+  blas_output_fortran(out)
 }
 
 # Emit triangular solve (vector or matrix RHS) with optional destination.
@@ -553,28 +574,19 @@ triangular_solve <- function(
   A_name <- ensure_blas_operand_name(A, hoist)
   B_input_name <- symbol_name_or_null(B)
 
-  if (
-    can_use_output(
-      dest,
-      input_names = c(A_name, B_input_name),
-      expected_dims = B@value@dims,
-      context = context,
-      allow_alias = B_input_name
-    )
-  ) {
-    hoist$emit(glue("{dest@name} = {B}"))
-    B_name <- dest@name
-    out_var <- dest
-    writes_to_dest <- TRUE
-  } else {
-    out_var <- hoist$declare_tmp(
-      mode = B@value@mode %||% "double",
-      dims = B@value@dims
-    )
-    hoist$emit(glue("{out_var@name} = {B}"))
-    B_name <- out_var@name
-    writes_to_dest <- FALSE
-  }
+  # The solve routines overwrite their right-hand side, so the output
+  # (dest or temp) doubles as the B argument after copying B into it.
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = c(A_name, B_input_name),
+    expected_dims = B@value@dims,
+    context = context,
+    allow_alias = B_input_name,
+    mode = B@value@mode %||% "double"
+  )
+  hoist$emit(glue("{out$name} = {B}"))
+  B_name <- out$name
 
   if (b_rank <= 1L) {
     hoist$emit(glue(
@@ -587,11 +599,7 @@ triangular_solve <- function(
     ))
   }
 
-  out <- Fortran(B_name, out_var)
-  if (writes_to_dest) {
-    out@writes_to_dest <- TRUE
-  }
-  out
+  blas_output_fortran(out)
 }
 
 lapack_solve <- function(
@@ -621,9 +629,7 @@ lapack_solve <- function(
     err_high = paste0(
       context,
       " only supports vector or matrix right-hand sides"
-    ),
-    call_scalar = FALSE,
-    call_high = FALSE
+    )
   )
 
   guard_conformable_dims(
@@ -644,169 +650,219 @@ lapack_solve <- function(
   nrhs <- if (b_rank == 1L) 1L else dim_or_one(B, 2L)
 
   # Both lowerings write a solution shaped by R's contract: length follows
-  # ncol(a), width follows the right-hand side. Each branch resolves the
+  # ncol(a), width follows the right-hand side. Each lowering resolves the
   # output target at its own write point (declaration order matters for
-  # the emitted block) with the one shared spelling below.
+  # the emitted block) via resolve_blas_output().
   expected_dims <- if (b_rank == 1L) list(n) else list(n, nrhs)
-  dest_usable <- function() {
-    can_use_output(
-      dest,
-      input_names = c(A_name, B_input_name),
+
+  if (identical(context, "qr.solve")) {
+    lapack_solve_qr(
+      A_name = A_name,
+      B_input_name = B_input_name,
+      m = m,
+      n = n,
+      nrhs = nrhs,
+      b_rank = b_rank,
       expected_dims = expected_dims,
+      dest = dest,
       context = context,
-      allow_alias = B_input_name
-    )
-  }
-
-  # R's solve() requires a square `a`; least squares is qr.solve()'s job.
-  # Statically rectangular `a` is a compile error, symbolic dims get a
-  # runtime guard before the dgesv call. (A rectangular `a` used to fall
-  # through to a dgels least-squares solve -- an answer where R errors.)
-  if (!identical(context, "qr.solve")) {
-    assert_square_matrix(a_dims, A, context, hoist, scope)
-    A_work <- hoist$declare_tmp(mode = "double", dims = list(m, m))
-    hoist$emit(glue("{A_work@name} = {A_name}"))
-
-    use_dest <- dest_usable()
-    out_var <- if (use_dest) {
-      dest
-    } else {
-      hoist$declare_tmp(mode = "double", dims = expected_dims)
-    }
-    out_name <- out_var@name
-    # The output length follows ncol(a) (R's contract) while `b` follows
-    # nrow(a); the two are only runtime-equal. When ncol is statically 1
-    # the output declares as a scalar, so a symbolic-length `b` must be
-    # copied elementwise, not by whole-array assignment.
-    b_src <- if (passes_as_scalar(out_var) && !passes_as_scalar(B@value)) {
-      subs <- str_flatten_commas(rep("1", b_rank))
-      glue("{B_input_name}({subs})")
-    } else {
-      B_input_name
-    }
-    hoist$emit(glue("{out_name} = {b_src}"))
-
-    ipiv <- hoist$declare_tmp(mode = "integer", dims = list(m))
-    info <- hoist$declare_tmp(mode = "integer", dims = NULL)
-
-    hoist$emit(glue(
-      "call dgesv({blas_int(m)}, {blas_int(nrhs)}, {A_work@name}, {blas_int(m)}, {ipiv@name}, {out_name}, {blas_int(m)}, {info@name})"
-    ))
-    emit_quickr_error_if(
-      condition = glue("{info@name} > 0_c_int"),
-      message = "Lapack routine dgesv: system is exactly singular",
+      tol = tol,
       hoist = hoist,
       scope = scope
     )
-    emit_quickr_error_if(
-      condition = glue("{info@name} < 0_c_int"),
-      message = "Lapack routine dgesv: illegal argument",
+  } else {
+    lapack_solve_gesv(
+      A = A,
+      a_dims = a_dims,
+      A_name = A_name,
+      B = B,
+      B_input_name = B_input_name,
+      m = m,
+      nrhs = nrhs,
+      b_rank = b_rank,
+      expected_dims = expected_dims,
+      dest = dest,
+      context = context,
       hoist = hoist,
       scope = scope
     )
+  }
+}
+
+# Square solve via dgesv. R's solve() requires a square `a`; least
+# squares is qr.solve()'s job. Statically rectangular `a` is a compile
+# error, symbolic dims get a runtime guard before the dgesv call. (A
+# rectangular `a` used to fall through to a dgels least-squares solve --
+# an answer where R errors.)
+lapack_solve_gesv <- function(
+  A,
+  a_dims,
+  A_name,
+  B,
+  B_input_name,
+  m,
+  nrhs,
+  b_rank,
+  expected_dims,
+  dest,
+  context,
+  hoist,
+  scope
+) {
+  assert_square_matrix(a_dims, A, context, hoist, scope)
+  A_work <- hoist$declare_tmp(mode = "double", dims = list(m, m))
+  hoist$emit(glue("{A_work@name} = {A_name}"))
+
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = c(A_name, B_input_name),
+    expected_dims = expected_dims,
+    context = context,
+    allow_alias = B_input_name
+  )
+  # The output length follows ncol(a) (R's contract) while `b` follows
+  # nrow(a); the two are only runtime-equal. When ncol is statically 1
+  # the output declares as a scalar, so a symbolic-length `b` must be
+  # copied elementwise, not by whole-array assignment.
+  b_src <- if (passes_as_scalar(out$var) && !passes_as_scalar(B@value)) {
+    subs <- str_flatten_commas(rep("1", b_rank))
+    glue("{B_input_name}({subs})")
   } else {
-    A_work <- hoist$declare_tmp(mode = "double", dims = list(m, n))
-    hoist$emit(glue("{A_work@name} = {A_name}"))
+    B_input_name
+  }
+  hoist$emit(glue("{out$name} = {b_src}"))
 
-    B_work <- hoist$declare_tmp(mode = "double", dims = list(m, nrhs))
-    m_f <- dims2f(list(m), scope)
-    if (!nzchar(m_f)) {
-      m_f <- "1"
-    }
-    nrhs_f <- dims2f(list(nrhs), scope)
-    if (!nzchar(nrhs_f)) {
-      nrhs_f <- "1"
-    }
-    hoist$emit(glue("{B_work@name} = 0.0_c_double"))
-    if (b_rank == 1L) {
-      hoist$emit(glue("{B_work@name}(1:{m_f}, 1) = {B_input_name}"))
-    } else {
-      hoist$emit(glue("{B_work@name}(1:{m_f}, 1:{nrhs_f}) = {B_input_name}"))
-    }
+  ipiv <- hoist$declare_tmp(mode = "integer", dims = list(m))
+  info <- hoist$declare_tmp(mode = "integer", dims = NULL)
 
-    qraux <- hoist$declare_tmp(mode = "double", dims = list(n))
-    jpvt <- hoist$declare_tmp(mode = "integer", dims = list(n))
-    work <- hoist$declare_tmp(mode = "double", dims = list(n, 2L))
-    rank <- hoist$declare_tmp(mode = "integer", dims = NULL)
-    idx <- hoist$declare_tmp(mode = "integer", dims = NULL)
+  hoist$emit(glue(
+    "call dgesv({blas_int(m)}, {blas_int(nrhs)}, {A_work@name}, {blas_int(m)}, {ipiv@name}, {out$name}, {blas_int(m)}, {info@name})"
+  ))
+  emit_lapack_info_guards(
+    info@name,
+    "dgesv",
+    "Lapack routine dgesv: system is exactly singular",
+    hoist,
+    scope
+  )
+  blas_output_fortran(out)
+}
 
-    hoist$emit(glue(
-      "
+# Least-squares solve via the LINPACK dqrdc2/dqrcf pair (R's own qr()
+# routines), permuting the rank-truncated coefficients back through the
+# pivot vector.
+lapack_solve_qr <- function(
+  A_name,
+  B_input_name,
+  m,
+  n,
+  nrhs,
+  b_rank,
+  expected_dims,
+  dest,
+  context,
+  tol,
+  hoist,
+  scope
+) {
+  A_work <- hoist$declare_tmp(mode = "double", dims = list(m, n))
+  hoist$emit(glue("{A_work@name} = {A_name}"))
+
+  B_work <- hoist$declare_tmp(mode = "double", dims = list(m, nrhs))
+  m_f <- dims2f(list(m), scope)
+  if (!nzchar(m_f)) {
+    m_f <- "1"
+  }
+  nrhs_f <- dims2f(list(nrhs), scope)
+  if (!nzchar(nrhs_f)) {
+    nrhs_f <- "1"
+  }
+  hoist$emit(glue("{B_work@name} = 0.0_c_double"))
+  if (b_rank == 1L) {
+    hoist$emit(glue("{B_work@name}(1:{m_f}, 1) = {B_input_name}"))
+  } else {
+    hoist$emit(glue("{B_work@name}(1:{m_f}, 1:{nrhs_f}) = {B_input_name}"))
+  }
+
+  qraux <- hoist$declare_tmp(mode = "double", dims = list(n))
+  jpvt <- hoist$declare_tmp(mode = "integer", dims = list(n))
+  work <- hoist$declare_tmp(mode = "double", dims = list(n, 2L))
+  rank <- hoist$declare_tmp(mode = "integer", dims = NULL)
+  idx <- hoist$declare_tmp(mode = "integer", dims = NULL)
+
+  hoist$emit(glue(
+    "
 do {idx@name} = 1_c_int, {blas_int(n)}
   {jpvt@name}({idx@name}) = {idx@name}
 end do"
-    ))
+  ))
 
-    tol_value <- if (is.null(tol)) "1e-7_c_double" else as.character(tol)
-    mn <- call("min", m, n)
-    hoist$emit(glue(
-      "call dqrdc2({A_work@name}, {blas_int(m)}, {blas_int(m)}, {blas_int(n)}, {tol_value}, {rank@name}, {qraux@name}, {jpvt@name}, {work@name})"
-    ))
+  tol_value <- if (is.null(tol)) "1e-7_c_double" else as.character(tol)
+  mn <- call("min", m, n)
+  hoist$emit(glue(
+    "call dqrdc2({A_work@name}, {blas_int(m)}, {blas_int(m)}, {blas_int(n)}, {tol_value}, {rank@name}, {qraux@name}, {jpvt@name}, {work@name})"
+  ))
 
-    emit_quickr_error_if(
-      condition = glue("{rank@name} < {blas_int(mn)}"),
-      message = "rank deficient matrix in qr.solve",
-      hoist = hoist,
-      scope = scope
-    )
+  emit_quickr_error_if(
+    condition = glue("{rank@name} < {blas_int(mn)}"),
+    message = "rank deficient matrix in qr.solve",
+    hoist = hoist,
+    scope = scope
+  )
 
-    coef_work <- hoist$declare_tmp(
-      mode = "double",
-      dims = list(mn, nrhs)
-    )
-    hoist$emit(glue("{coef_work@name} = 0.0_c_double"))
-    info <- hoist$declare_tmp(mode = "integer", dims = NULL)
+  coef_work <- hoist$declare_tmp(
+    mode = "double",
+    dims = list(mn, nrhs)
+  )
+  hoist$emit(glue("{coef_work@name} = 0.0_c_double"))
+  info <- hoist$declare_tmp(mode = "integer", dims = NULL)
 
-    hoist$emit(glue(
-      "call dqrcf({A_work@name}, {blas_int(m)}, {rank@name}, {qraux@name}, {B_work@name}, {blas_int(nrhs)}, {coef_work@name}, {info@name})"
-    ))
-    emit_quickr_error_if(
-      condition = glue("{info@name} /= 0_c_int"),
-      message = "exact singularity in 'qr.coef'",
-      hoist = hoist,
-      scope = scope
-    )
+  hoist$emit(glue(
+    "call dqrcf({A_work@name}, {blas_int(m)}, {rank@name}, {qraux@name}, {B_work@name}, {blas_int(nrhs)}, {coef_work@name}, {info@name})"
+  ))
+  emit_quickr_error_if(
+    condition = glue("{info@name} /= 0_c_int"),
+    message = "exact singularity in 'qr.coef'",
+    hoist = hoist,
+    scope = scope
+  )
 
-    use_dest <- dest_usable()
-    out_var <- if (use_dest) {
-      dest
-    } else {
-      hoist$declare_tmp(mode = "double", dims = expected_dims)
-    }
-    out_name <- out_var@name
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = c(A_name, B_input_name),
+    expected_dims = expected_dims,
+    context = context,
+    allow_alias = B_input_name
+  )
 
-    if (passes_as_scalar(out_var)) {
-      hoist$emit(glue("{out_name} = {coef_work@name}(1, 1)"))
-    } else {
-      hoist$emit(glue("{out_name} = 0.0_c_double"))
-      if (b_rank == 1L) {
-        idx <- hoist$declare_tmp(mode = "integer", dims = NULL)
-        hoist$emit(glue(
-          "
+  if (passes_as_scalar(out$var)) {
+    hoist$emit(glue("{out$name} = {coef_work@name}(1, 1)"))
+  } else {
+    hoist$emit(glue("{out$name} = 0.0_c_double"))
+    if (b_rank == 1L) {
+      idx <- hoist$declare_tmp(mode = "integer", dims = NULL)
+      hoist$emit(glue(
+        "
 do {idx@name} = 1_c_int, {rank@name}
-  {out_name}({jpvt@name}({idx@name})) = {coef_work@name}({idx@name}, 1)
+  {out$name}({jpvt@name}({idx@name})) = {coef_work@name}({idx@name}, 1)
 end do"
-        ))
-      } else {
-        idx_i <- hoist$declare_tmp(mode = "integer", dims = NULL)
-        idx_j <- hoist$declare_tmp(mode = "integer", dims = NULL)
-        hoist$emit(glue(
-          "
+      ))
+    } else {
+      idx_i <- hoist$declare_tmp(mode = "integer", dims = NULL)
+      idx_j <- hoist$declare_tmp(mode = "integer", dims = NULL)
+      hoist$emit(glue(
+        "
 do {idx_j@name} = 1_c_int, {blas_int(nrhs)}
   do {idx_i@name} = 1_c_int, {rank@name}
-    {out_name}({jpvt@name}({idx_i@name}), {idx_j@name}) = {coef_work@name}({idx_i@name}, {idx_j@name})
+    {out$name}({jpvt@name}({idx_i@name}), {idx_j@name}) = {coef_work@name}({idx_i@name}, {idx_j@name})
   end do
 end do"
-        ))
-      }
+      ))
     }
   }
-
-  out <- Fortran(out_name, out_var)
-  if (use_dest) {
-    out@writes_to_dest <- TRUE
-  }
-  out
+  blas_output_fortran(out)
 }
 
 lapack_inverse <- function(A, scope, hoist, dest = NULL, context = "solve") {
@@ -821,66 +877,43 @@ lapack_inverse <- function(A, scope, hoist, dest = NULL, context = "solve") {
 
   A_name <- ensure_blas_operand_name(A, hoist)
 
-  writes_to_dest <- FALSE
-  if (
-    can_use_output(
-      dest,
-      input_names = A_name,
-      expected_dims = list(n, n),
-      context = context,
-      allow_alias = A_name
-    )
-  ) {
-    out_var <- dest
-    out_name <- dest@name
-    writes_to_dest <- TRUE
-  } else {
-    out_var <- hoist$declare_tmp(mode = "double", dims = list(n, n))
-    out_name <- out_var@name
-  }
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = A_name,
+    expected_dims = list(n, n),
+    context = context,
+    allow_alias = A_name
+  )
 
-  hoist$emit(glue("{out_name} = {A_name}"))
+  hoist$emit(glue("{out$name} = {A_name}"))
 
   ipiv <- hoist$declare_tmp(mode = "integer", dims = list(n))
   info <- hoist$declare_tmp(mode = "integer", dims = NULL)
   work <- hoist$declare_tmp(mode = "double", dims = list(n))
 
   hoist$emit(glue(
-    "call dgetrf({blas_int(n)}, {blas_int(n)}, {out_name}, {blas_int(n)}, {ipiv@name}, {info@name})"
+    "call dgetrf({blas_int(n)}, {blas_int(n)}, {out$name}, {blas_int(n)}, {ipiv@name}, {info@name})"
   ))
-  emit_quickr_error_if(
-    condition = glue("{info@name} > 0_c_int"),
-    message = "Lapack routine dgetrf: system is exactly singular",
-    hoist = hoist,
-    scope = scope
-  )
-  emit_quickr_error_if(
-    condition = glue("{info@name} < 0_c_int"),
-    message = "Lapack routine dgetrf: illegal argument",
-    hoist = hoist,
-    scope = scope
+  emit_lapack_info_guards(
+    info@name,
+    "dgetrf",
+    "Lapack routine dgetrf: system is exactly singular",
+    hoist,
+    scope
   )
   hoist$emit(glue(
-    "call dgetri({blas_int(n)}, {out_name}, {blas_int(n)}, {ipiv@name}, {work@name}, {blas_int(n)}, {info@name})"
+    "call dgetri({blas_int(n)}, {out$name}, {blas_int(n)}, {ipiv@name}, {work@name}, {blas_int(n)}, {info@name})"
   ))
-  emit_quickr_error_if(
-    condition = glue("{info@name} > 0_c_int"),
-    message = "Lapack routine dgetri: system is exactly singular",
-    hoist = hoist,
-    scope = scope
-  )
-  emit_quickr_error_if(
-    condition = glue("{info@name} < 0_c_int"),
-    message = "Lapack routine dgetri: illegal argument",
-    hoist = hoist,
-    scope = scope
+  emit_lapack_info_guards(
+    info@name,
+    "dgetri",
+    "Lapack routine dgetri: system is exactly singular",
+    hoist,
+    scope
   )
 
-  out <- Fortran(out_name, out_var)
-  if (writes_to_dest) {
-    out@writes_to_dest <- TRUE
-  }
-  out
+  blas_output_fortran(out)
 }
 
 lapack_chol <- function(A, scope, hoist, dest = NULL, context = "chol") {
@@ -895,49 +928,31 @@ lapack_chol <- function(A, scope, hoist, dest = NULL, context = "chol") {
 
   A_name <- ensure_blas_operand_name(A, hoist)
 
-  writes_to_dest <- FALSE
-  if (
-    can_use_output(
-      dest,
-      input_names = A_name,
-      expected_dims = list(n, n),
-      context = context,
-      allow_alias = A_name
-    )
-  ) {
-    out_var <- dest
-    out_name <- dest@name
-    writes_to_dest <- TRUE
-  } else {
-    out_var <- hoist$declare_tmp(mode = "double", dims = list(n, n))
-    out_name <- out_var@name
-  }
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = A_name,
+    expected_dims = list(n, n),
+    context = context,
+    allow_alias = A_name
+  )
 
-  hoist$emit(glue("{out_name} = {A_name}"))
+  hoist$emit(glue("{out$name} = {A_name}"))
 
   info <- hoist$declare_tmp(mode = "integer", dims = NULL)
   hoist$emit(glue(
-    "call dpotrf('U', {blas_int(n)}, {out_name}, {blas_int(n)}, {info@name})"
+    "call dpotrf('U', {blas_int(n)}, {out$name}, {blas_int(n)}, {info@name})"
   ))
-  emit_quickr_error_if(
-    condition = glue("{info@name} > 0_c_int"),
-    message = "Lapack routine dpotrf: leading minor is not positive definite",
-    hoist = hoist,
-    scope = scope
-  )
-  emit_quickr_error_if(
-    condition = glue("{info@name} < 0_c_int"),
-    message = "Lapack routine dpotrf: illegal argument",
-    hoist = hoist,
-    scope = scope
+  emit_lapack_info_guards(
+    info@name,
+    "dpotrf",
+    "Lapack routine dpotrf: leading minor is not positive definite",
+    hoist,
+    scope
   )
-  zero_lower_triangle(out_name, n, hoist = hoist)
+  zero_lower_triangle(out$name, n, hoist = hoist)
 
-  out <- Fortran(out_name, out_var)
-  if (writes_to_dest) {
-    out@writes_to_dest <- TRUE
-  }
-  out
+  blas_output_fortran(out)
 }
 
 lapack_chol2inv <- function(
@@ -958,49 +973,31 @@ lapack_chol2inv <- function(
 
   R_name <- ensure_blas_operand_name(R, hoist)
 
-  writes_to_dest <- FALSE
-  if (
-    can_use_output(
-      dest,
-      input_names = R_name,
-      expected_dims = list(n, n),
-      context = context,
-      allow_alias = R_name
-    )
-  ) {
-    out_var <- dest
-    out_name <- dest@name
-    writes_to_dest <- TRUE
-  } else {
-    out_var <- hoist$declare_tmp(mode = "double", dims = list(n, n))
-    out_name <- out_var@name
-  }
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = R_name,
+    expected_dims = list(n, n),
+    context = context,
+    allow_alias = R_name
+  )
 
-  hoist$emit(glue("{out_name} = {R_name}"))
+  hoist$emit(glue("{out$name} = {R_name}"))
 
   info <- hoist$declare_tmp(mode = "integer", dims = NULL)
   hoist$emit(glue(
-    "call dpotri('U', {blas_int(n)}, {out_name}, {blas_int(n)}, {info@name})"
+    "call dpotri('U', {blas_int(n)}, {out$name}, {blas_int(n)}, {info@name})"
   ))
-  emit_quickr_error_if(
-    condition = glue("{info@name} > 0_c_int"),
-    message = "Lapack routine dpotri: matrix is not positive definite",
-    hoist = hoist,
-    scope = scope
-  )
-  emit_quickr_error_if(
-    condition = glue("{info@name} < 0_c_int"),
-    message = "Lapack routine dpotri: illegal argument",
-    hoist = hoist,
-    scope = scope
+  emit_lapack_info_guards(
+    info@name,
+    "dpotri",
+    "Lapack routine dpotri: matrix is not positive definite",
+    hoist,
+    scope
   )
-  symmetrize_upper_to_lower(out_name, n, hoist = hoist)
+  symmetrize_upper_to_lower(out$name, n, hoist = hoist)
 
-  out <- Fortran(out_name, out_var)
-  if (writes_to_dest) {
-    out@writes_to_dest <- TRUE
-  }
-  out
+  blas_output_fortran(out)
 }
 
 diag_extract <- function(x, scope, hoist, dest = NULL, context = "diag") {
@@ -1016,42 +1013,25 @@ diag_extract <- function(x, scope, hoist, dest = NULL, context = "diag") {
   x_name <- ensure_blas_operand_name(x, hoist)
   logical_is_c_int <- logical_as_int(x@value)
 
-  writes_to_dest <- FALSE
-  if (
-    can_use_output(
-      dest,
-      input_names = x_name,
-      expected_dims = list(diag_len),
-      context = context,
-      mode = x@value@mode,
-      logical_is_c_int = logical_is_c_int
-    )
-  ) {
-    out_var <- dest
-    out_name <- dest@name
-    writes_to_dest <- TRUE
-  } else {
-    out_var <- hoist$declare_tmp(
-      mode = x@value@mode,
-      dims = list(diag_len),
-      logical_as_int = logical_is_c_int
-    )
-    out_name <- out_var@name
-  }
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = x_name,
+    expected_dims = list(diag_len),
+    context = context,
+    mode = x@value@mode,
+    logical_is_c_int = logical_is_c_int
+  )
 
   idx_i <- hoist$declare_tmp(mode = "integer", dims = NULL)
   hoist$emit(glue(
     "
 do {idx_i@name} = 1_c_int, {blas_int(diag_len)}
-  {out_name}({idx_i@name}) = {x_name}({idx_i@name}, {idx_i@name})
+  {out$name}({idx_i@name}) = {x_name}({idx_i@name}, {idx_i@name})
 end do"
   ))
 
-  out <- Fortran(out_name, out_var)
-  if (writes_to_dest) {
-    out@writes_to_dest <- TRUE
-  }
-  out
+  blas_output_fortran(out)
 }
 
 diag_matrix <- function(
@@ -1078,38 +1058,25 @@ diag_matrix <- function(
 
   x_name <- ensure_blas_operand_name(x, hoist)
 
-  writes_to_dest <- FALSE
-  if (
-    can_use_output(
-      dest,
-      input_names = x_name,
-      expected_dims = list(nrow, ncol),
-      context = context,
-      mode = mode,
-      logical_is_c_int = logical_is_c_int
-    )
-  ) {
-    out_var <- dest
-    out_name <- dest@name
-    writes_to_dest <- TRUE
-  } else {
-    out_var <- hoist$declare_tmp(
-      mode = mode,
-      dims = list(nrow, ncol),
-      logical_as_int = logical_is_c_int
-    )
-    out_name <- out_var@name
-  }
+  out <- resolve_blas_output(
+    dest,
+    hoist,
+    input_names = x_name,
+    expected_dims = list(nrow, ncol),
+    context = context,
+    mode = mode,
+    logical_is_c_int = logical_is_c_int
+  )
 
   zero <- switch(
     mode,
     double = "0.0_c_double",
     integer = "0_c_int",
-    logical = if (logical_as_int(out_var)) "0_c_int" else ".false.",
+    logical = if (logical_as_int(out$var)) "0_c_int" else ".false.",
     complex = "(0.0_c_double, 0.0_c_double)",
     stop(context, " does not support mode ", mode, call. = FALSE)
   )
-  hoist$emit(glue("{out_name} = {zero}"))
+  hoist$emit(glue("{out$name} = {zero}"))
 
   idx_i <- hoist$declare_tmp(mode = "integer", dims = NULL)
   value_expr <- if (x_scalar) {
@@ -1124,15 +1091,11 @@ diag_matrix <- function(
   hoist$emit(glue(
     "
 do {idx_i@name} = 1_c_int, {blas_int(diag_len)}
-  {out_name}({idx_i@name}, {idx_i@name}) = {value_expr}
+  {out$name}({idx_i@name}, {idx_i@name}) = {value_expr}
 end do"
   ))
 
-  out <- Fortran(out_name, out_var)
-  if (writes_to_dest) {
-    out@writes_to_dest <- TRUE
-  }
-  out
+  blas_output_fortran(out)
 }
 
 svd_dims <- function(A, context = "svd") {
@@ -1197,17 +1160,13 @@ lapack_svd <- function(
   hoist$emit(glue(
     "call dgesdd('S', {blas_int(m)}, {blas_int(n)}, {A_work@name}, {blas_int(m)}, {d@name}, {u@name}, {blas_int(m)}, {vt@name}, {blas_int(mn)}, {work@name}, {lwork@name}, {iwork@name}, {info@name})"
   ))
-  emit_quickr_error_if(
-    glue("{info@name} < 0_c_int"),
-    "Lapack routine dgesdd: illegal argument",
-    hoist,
-    scope
-  )
-  emit_quickr_error_if(
-    glue("{info@name} > 0_c_int"),
+  emit_lapack_info_guards(
+    info@name,
+    "dgesdd",
     "Lapack routine dgesdd failed to converge",
     hoist,
-    scope
+    scope,
+    negative_first = TRUE
   )
   hoist$emit(glue("{v@name} = transpose({vt@name})"))
 

From e66439fa679571964bb5937efcd7a0c527802195 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 17:49:34 +0200
Subject: [PATCH 21/97] Merge the cbind/rbind twins and share diag()'s argument
 matching

cbind() and rbind() were 115 near-identical lines differing only in
orientation; compile_bind() (registered for both, reading the direction
from the call like compile_binop) and bind_piece_expr() spell the shared
skeleton once. diag()'s ~30-line named/positional x/nrow/ncol extraction
existed verbatim in the handler and in infer_dest_diag() -- exactly the
pair that drifts -- and now both call diag_call_args(); the two identical
missing-nrow stops collapse to one. infer_dest_chol2inv() is an alias of
the byte-identical infer_dest_chol(). crossprod_like()'s trans_single/
opA/opB were fully determined by one flag, now derived from `trans`.
bind_output_mode() gains a comment saying why it is not on the shared
mode lattice (raw support, complex-mixing refusal). Emitted Fortran is
unchanged.
---
 R/r2f-matrix-infer.R |  47 ++++----
 R/r2f-matrix.R       | 260 ++++++++++++++++---------------------------
 2 files changed, 121 insertions(+), 186 deletions(-)

diff --git a/R/r2f-matrix-infer.R b/R/r2f-matrix-infer.R
index e4eba9fd..d112ae7d 100644
--- a/R/r2f-matrix-infer.R
+++ b/R/r2f-matrix-infer.R
@@ -200,7 +200,8 @@ infer_dest_solve <- function(args, scope) {
   NULL
 }
 
-# Infer destination dimensions for chol().
+# Infer destination dimensions for chol() and chol2inv(): both return a
+# square double matrix shaped like `x`.
 infer_dest_chol <- function(args, scope) {
   x_arg <- args$x %||% args[[1L]]
   if (is.null(x_arg)) {
@@ -214,19 +215,7 @@ infer_dest_chol <- function(args, scope) {
   Variable("double", list(x_dims$rows, x_dims$cols))
 }
 
-# Infer destination dimensions for chol2inv().
-infer_dest_chol2inv <- function(args, scope) {
-  x_arg <- args$x %||% args[[1L]]
-  if (is.null(x_arg)) {
-    return(NULL)
-  }
-  X <- infer_symbol_var(x_arg, scope)
-  if (is.null(X) || X@rank != 2L) {
-    return(NULL)
-  }
-  x_dims <- matrix_dims_var(X)
-  Variable("double", list(x_dims$rows, x_dims$cols))
-}
+infer_dest_chol2inv <- infer_dest_chol
 
 # Helper to infer a size from a literal or symbol.
 infer_size <- function(arg, scope) {
@@ -255,10 +244,11 @@ infer_size <- function(arg, scope) {
   NULL
 }
 
-# Infer destination dimensions for diag().
-infer_dest_diag <- function(args, scope) {
-  # R signature: diag(x = 1, nrow, ncol, names = TRUE)
-  # Handle both named and positional arguments
+# Match diag()'s x/nrow/ncol arguments, named or positional.
+# R signature: diag(x = 1, nrow, ncol, names = TRUE). Shared by the
+# diag() handler and infer_dest_diag() so lowering and dest inference
+# cannot drift. The returned `x` is never the missing arg (NULL instead).
+diag_call_args <- function(args) {
   arg_names <- names(args)
   if (is.null(arg_names)) {
     arg_names <- rep("", length(args))
@@ -288,11 +278,26 @@ infer_dest_diag <- function(args, scope) {
     ncol_arg <- args[[unnamed_idx[[3L]]]]
   }
 
-  has_nrow <- !is.null(nrow_arg) && !is_missing(nrow_arg)
-  has_ncol <- !is.null(ncol_arg) && !is_missing(ncol_arg)
+  list(
+    x = x_arg,
+    nrow = nrow_arg,
+    ncol = ncol_arg,
+    has_nrow = !is.null(nrow_arg) && !is_missing(nrow_arg),
+    has_ncol = !is.null(ncol_arg) && !is_missing(ncol_arg)
+  )
+}
+
+# Infer destination dimensions for diag().
+infer_dest_diag <- function(args, scope) {
+  margs <- diag_call_args(args)
+  x_arg <- margs$x
+  nrow_arg <- margs$nrow
+  ncol_arg <- margs$ncol
+  has_nrow <- margs$has_nrow
+  has_ncol <- margs$has_ncol
 
   # Case: no x, just nrow (identity matrix)
-  if (is.null(x_arg) || is_missing(x_arg)) {
+  if (is.null(x_arg)) {
     if (!has_nrow) {
       return(NULL)
     }
diff --git a/R/r2f-matrix.R b/R/r2f-matrix.R
index 7fedffe4..16c0d3ed 100644
--- a/R/r2f-matrix.R
+++ b/R/r2f-matrix.R
@@ -215,6 +215,9 @@ register_r2f_handler(
   }
 )
 
+# Join the input modes for cbind/rbind. Hand-rolled rather than
+# reduce_promoted_mode(): binds also support "raw" (not on the mode
+# lattice) and refuse mixing complex with other modes.
 bind_output_mode <- function(values, context) {
   modes <- unique(vapply(
     values,
@@ -321,14 +324,22 @@ bind_dim_int <- function(dim) {
   paste0("int(", bind_dim_string(dim), ")")
 }
 
-bind_col_matrix_expr <- function(value, rows, is_scalar, context) {
-  rows_int <- bind_dim_int(rows)
+# Reshape one cbind/rbind input to a matrix piece along the bind axis:
+# scalars spread to the common dim, vectors reshape to a single column
+# (cbind) or row (rbind), matrices pass through.
+bind_piece_expr <- function(value, common, is_scalar, context, direction) {
+  common_int <- bind_dim_int(common)
+  shape <- if (direction == "cbind") {
+    glue("[{common_int}, 1]")
+  } else {
+    glue("[1, {common_int}]")
+  }
   if (is_scalar) {
-    vec <- glue("spread({value}, 1, {rows_int})")
-    return(glue("reshape({vec}, [{rows_int}, 1])"))
+    vec <- glue("spread({value}, 1, {common_int})")
+    return(glue("reshape({vec}, {shape})"))
   }
   if (value@value@rank == 1L) {
-    return(glue("reshape({value}, [{rows_int}, 1])"))
+    return(glue("reshape({value}, {shape})"))
   }
   if (value@value@rank == 2L) {
     return(as.character(value))
@@ -336,135 +347,84 @@ bind_col_matrix_expr <- function(value, rows, is_scalar, context) {
   stop(context, " only supports rank 0-2 inputs", call. = FALSE)
 }
 
-bind_row_matrix_expr <- function(value, cols, is_scalar, context) {
-  cols_int <- bind_dim_int(cols)
-  if (is_scalar) {
-    vec <- glue("spread({value}, 1, {cols_int})")
-    return(glue("reshape({vec}, [1, {cols_int}])"))
-  }
-  if (value@value@rank == 1L) {
-    return(glue("reshape({value}, [1, {cols_int}])"))
+# cbind()/rbind() share one skeleton: clean the args, join input modes,
+# require a known common dim (bind_common_dim) and sum the other, then
+# assemble the pieces. Only the orientation differs; rbind builds the
+# transpose and flips it at the end so the array constructor still fills
+# column-major.
+compile_bind <- function(args, scope, ..., hoist = NULL) {
+  direction <- last(list(...)$calls)
+  context <- paste0(direction, "()")
+
+  if (!is.null(args$deparse.level) && !is_missing(args$deparse.level)) {
+    args$deparse.level <- NULL
   }
-  if (value@value@rank == 2L) {
-    return(as.character(value))
+  args <- args[!vapply(args, is_missing, logical(1))]
+  args <- args[
+    !vapply(
+      args,
+      \(x) is.null(x) || identical(x, quote(NULL)),
+      logical(1)
+    )
+  ]
+  if (!length(args)) {
+    stop(context, " requires at least one argument", call. = FALSE)
   }
-  stop(context, " only supports rank 0-2 inputs", call. = FALSE)
-}
-
-register_r2f_handler(
-  "cbind",
-  function(args, scope, ..., hoist = NULL) {
-    context <- "cbind()"
-    if (!is.null(args$deparse.level) && !is_missing(args$deparse.level)) {
-      args$deparse.level <- NULL
-    }
-    args <- args[!vapply(args, is_missing, logical(1))]
-    args <- args[
-      !vapply(
-        args,
-        \(x) is.null(x) || identical(x, quote(NULL)),
-        logical(1)
-      )
-    ]
-    if (!length(args)) {
-      stop("cbind() requires at least one argument", call. = FALSE)
-    }
 
-    values <- lapply(args, r2f, scope, ..., hoist = hoist)
-    for (val in values) {
-      if (is.null(val@value) || is.null(val@value@mode)) {
-        stop(context, " inputs must have a value", call. = FALSE)
-      }
-      assert_rank_leq2(val, paste0(context, " only supports rank 0-2 inputs"))
+  values <- lapply(args, r2f, scope, ..., hoist = hoist)
+  for (val in values) {
+    if (is.null(val@value) || is.null(val@value@mode)) {
+      stop(context, " inputs must have a value", call. = FALSE)
     }
+    assert_rank_leq2(val, paste0(context, " only supports rank 0-2 inputs"))
+  }
 
-    mode <- bind_output_mode(values, context)
-    values <- lapply(values, cast_to_mode, mode = mode, context = context)
+  mode <- bind_output_mode(values, context)
+  values <- lapply(values, cast_to_mode, mode = mode, context = context)
 
-    dims <- lapply(values, matrix_dims, orientation = "colvec")
-    scalar_flags <- map_lgl(values, \(val) passes_as_scalar(val@value))
-    row_sizes <- lapply(dims, `[[`, "rows")
-    col_sizes <- lapply(dims, `[[`, "cols")
+  orientation <- if (direction == "cbind") "colvec" else "rowvec"
+  dims <- lapply(values, matrix_dims, orientation = orientation)
+  scalar_flags <- map_lgl(values, \(val) passes_as_scalar(val@value))
+  row_sizes <- lapply(dims, `[[`, "rows")
+  col_sizes <- lapply(dims, `[[`, "cols")
 
-    rows <- bind_common_dim(row_sizes, scalar_flags, context, "row")
+  if (direction == "cbind") {
+    common <- bind_common_dim(row_sizes, scalar_flags, context, "row")
+    rows <- common
     cols <- bind_dim_sum(col_sizes, context, "column")
+  } else {
+    common <- bind_common_dim(col_sizes, scalar_flags, context, "column")
+    cols <- common
+    rows <- bind_dim_sum(row_sizes, context, "row")
+  }
 
-    col_exprs <- vector("list", length(values))
-    for (i in seq_along(values)) {
-      col_exprs[[i]] <- bind_col_matrix_expr(
-        value = values[[i]],
-        rows = rows,
-        is_scalar = scalar_flags[[i]],
-        context = context
-      )
-    }
-
-    data_expr <- glue("[{str_flatten_commas(col_exprs)}]")
-    out_expr <- glue(
-      "reshape({data_expr}, [{bind_dim_int(rows)}, {bind_dim_int(cols)}])"
+  pieces <- vector("list", length(values))
+  for (i in seq_along(values)) {
+    pieces[[i]] <- bind_piece_expr(
+      value = values[[i]],
+      common = common,
+      is_scalar = scalar_flags[[i]],
+      context = context,
+      direction = direction
     )
-    Fortran(out_expr, Variable(mode, list(rows, cols)))
   }
-)
-
-register_r2f_handler(
-  "rbind",
-  function(args, scope, ..., hoist = NULL) {
-    context <- "rbind()"
-    if (!is.null(args$deparse.level) && !is_missing(args$deparse.level)) {
-      args$deparse.level <- NULL
-    }
-    args <- args[!vapply(args, is_missing, logical(1))]
-    args <- args[
-      !vapply(
-        args,
-        \(x) is.null(x) || identical(x, quote(NULL)),
-        logical(1)
-      )
-    ]
-    if (!length(args)) {
-      stop("rbind() requires at least one argument", call. = FALSE)
-    }
-
-    values <- lapply(args, r2f, scope, ..., hoist = hoist)
-    for (val in values) {
-      if (is.null(val@value) || is.null(val@value@mode)) {
-        stop(context, " inputs must have a value", call. = FALSE)
-      }
-      assert_rank_leq2(val, paste0(context, " only supports rank 0-2 inputs"))
-    }
-
-    mode <- bind_output_mode(values, context)
-    values <- lapply(values, cast_to_mode, mode = mode, context = context)
-
-    dims <- lapply(values, matrix_dims, orientation = "rowvec")
-    scalar_flags <- map_lgl(values, \(val) passes_as_scalar(val@value))
-    row_sizes <- lapply(dims, `[[`, "rows")
-    col_sizes <- lapply(dims, `[[`, "cols")
-
-    cols <- bind_common_dim(col_sizes, scalar_flags, context, "column")
-    rows <- bind_dim_sum(row_sizes, context, "row")
-
-    row_exprs <- vector("list", length(values))
-    for (i in seq_along(values)) {
-      row_exprs[[i]] <- bind_row_matrix_expr(
-        value = values[[i]],
-        cols = cols,
-        is_scalar = scalar_flags[[i]],
-        context = context
-      )
-    }
-    transposed <- lapply(row_exprs, \(expr) glue("transpose({expr})"))
 
+  out_expr <- if (direction == "cbind") {
+    data_expr <- glue("[{str_flatten_commas(pieces)}]")
+    glue("reshape({data_expr}, [{bind_dim_int(rows)}, {bind_dim_int(cols)}])")
+  } else {
+    transposed <- lapply(pieces, \(expr) glue("transpose({expr})"))
     data_expr <- glue("[{str_flatten_commas(transposed)}]")
     combined <- glue(
       "reshape({data_expr}, [{bind_dim_int(cols)}, {bind_dim_int(rows)}])"
     )
-    out_expr <- glue("transpose({combined})")
-
-    Fortran(out_expr, Variable(mode, list(rows, cols)))
+    glue("transpose({combined})")
   }
-)
+
+  Fortran(out_expr, Variable(mode, list(rows, cols)))
+}
+
+register_r2f_handler(c("cbind", "rbind"), compile_bind)
 
 
 # Handle crossprod(), using SYRK for single-arg and GEMM for two-arg forms.
@@ -480,9 +440,7 @@ register_r2f_handler(
       ...,
       hoist = hoist,
       dest = dest,
-      trans_single = "T",
-      opA = "T",
-      opB = "N",
+      trans = "T",
       context = "crossprod"
     )
   },
@@ -504,9 +462,7 @@ register_r2f_handler(
       ...,
       hoist = hoist,
       dest = dest,
-      trans_single = "N",
-      opA = "N",
-      opB = "T",
+      trans = "N",
       context = "tcrossprod"
     )
   },
@@ -705,49 +661,19 @@ register_r2f_handler(
 register_r2f_handler(
   "diag",
   function(args, scope, ..., hoist = NULL, dest = NULL) {
-    # R signature: diag(x = 1, nrow, ncol, names = TRUE)
-    # Handle both named and positional arguments
-    arg_names <- names(args)
-    if (is.null(arg_names)) {
-      arg_names <- rep("", length(args))
-    }
-    unnamed_idx <- which(!nzchar(arg_names) | is.na(arg_names))
-
-    # Extract x (named or position 1)
-    x_arg <- NULL
-    if (!is.null(args$x) && !is_missing(args$x)) {
-      x_arg <- args$x
-    } else if (length(unnamed_idx) >= 1L) {
-      candidate <- args[[unnamed_idx[[1L]]]]
-      if (!is_missing(candidate)) {
-        x_arg <- candidate
-      }
-    }
-
-    # Extract nrow (named or position 2)
-    nrow_arg <- args$nrow
-    if (is.null(nrow_arg) && length(unnamed_idx) >= 2L) {
-      nrow_arg <- args[[unnamed_idx[[2L]]]]
-    }
-
-    # Extract ncol (named or position 3)
-    ncol_arg <- args$ncol
-    if (is.null(ncol_arg) && length(unnamed_idx) >= 3L) {
-      ncol_arg <- args[[unnamed_idx[[3L]]]]
-    }
+    margs <- diag_call_args(args)
+    x_arg <- margs$x
+    nrow_arg <- margs$nrow
+    ncol_arg <- margs$ncol
+    has_nrow <- margs$has_nrow
+    has_ncol <- margs$has_ncol
 
     if (!is.null(args$names) && !is_missing(args$names)) {
       logical_arg_or_default(args, "names", TRUE, "diag()")
     }
 
-    has_nrow <- !is.null(nrow_arg) && !is_missing(nrow_arg)
-    has_ncol <- !is.null(ncol_arg) && !is_missing(ncol_arg)
-
-    if (is.null(x_arg) || is_missing(x_arg)) {
-      if (!has_nrow && !has_ncol) {
-        stop("argument \"nrow\" is missing, with no default", call. = FALSE)
-      }
-      if (!has_nrow && has_ncol) {
+    if (is.null(x_arg)) {
+      if (!has_nrow) {
         stop("argument \"nrow\" is missing, with no default", call. = FALSE)
       }
       x_val <- Fortran("1.0_c_double", Variable("double"))
@@ -906,6 +832,9 @@ register_r2f_handler(
 )
 
 # Shared crossprod/tcrossprod logic for one- and two-argument forms.
+# `trans` says which side of the product is transposed: "T" for
+# crossprod (t(x) %*% y), "N" for tcrossprod (x %*% t(y)); it fully
+# determines the syrk form and both gemm op flags.
 crossprod_like <- function(
   x_arg,
   y_arg,
@@ -913,17 +842,18 @@ crossprod_like <- function(
   ...,
   hoist,
   dest,
-  trans_single,
-  opA,
-  opB,
+  trans,
   context
 ) {
+  opA <- trans
+  opB <- if (identical(trans, "T")) "N" else "T"
+
   x <- r2f(x_arg, scope, ..., hoist = hoist)
   x <- cast_linalg_double(x, context)
 
   if (is.null(y_arg)) {
     return(syrk(
-      trans = trans_single,
+      trans = trans,
       X = x,
       scope = scope,
       hoist = hoist,

From 1be575634ad2411f29cce0404494c7e8a0b0aecf Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 17:54:34 +0200
Subject: [PATCH 22/97] Unify the read/write subscript lowering and
 superassignment validation

The `[` handler and compile_subset_designator() carried three verbatim
copies of the same logic: the missing-arg/double-coercion pass, the
scalar-[1]-is-a-no-op check, and the inline c_ptrdiff_t cast (spelled
four times). lower_subscript_args(), subscript_is_scalar_noop(), and
subscript_as_index_int() in r2f-subscript.R now serve both sides, so
read and write subscripts cannot drift. `<<-`, `[<<-`, and
compile_subscript_lhs()'s host branch triplicated the superassignment
target validation (formals shadow, output-variable, host resolution,
modified-flag writeback); resolve_superassign_target() spells it once.

Also: check_assignment_compatible()/check_reassignment_narrowing() move
from scope.R (environment plumbing) to r2f-operators-helpers.R next to
the mode lattice they consult; the `[` handler's truncated contract
comment is completed and its commented-out placeholder arms deleted;
Variable("int", ...) spelled "integer" (charmatch made it work by
accident); a dead warning() directly before a stop() in scope.R is
dropped; a stray design musing in r2f-assign.R is removed. Emitted
Fortran is unchanged.
---
 R/r2f-assign.R            |  80 +++++++++------------
 R/r2f-closures.R          |  54 ++++----------
 R/r2f-operators-helpers.R |  52 +++++++++++++-
 R/r2f-subscript.R         | 148 +++++++++++++++++++++-----------------
 R/scope.R                 |  47 ------------
 5 files changed, 180 insertions(+), 201 deletions(-)

diff --git a/R/r2f-assign.R b/R/r2f-assign.R
index 8cca99c5..102cce83 100644
--- a/R/r2f-assign.R
+++ b/R/r2f-assign.R
@@ -71,9 +71,6 @@ register_r2f_handler(
       return(out)
     }
 
-    # It sure seems like it's be nice if the Fortran() constructor
-    # took mode and dims as args directly,
-    # without needing to go through Variable...
     stopifnot(is.symbol(target))
     name <- as.character(target)
 
@@ -270,6 +267,37 @@ register_r2f_handler(
   }
 )
 
+# Validate and resolve the target of a superassignment (`x <<- v`,
+# `x[i] <<- v`) to its host-scope Variable: the name must not shadow a
+# closure formal or the closure's output variable, and must already exist
+# in the enclosing quick() scope. Marks the host variable modified.
+# Used by: `<<-`, `[<<-`, compile_subscript_lhs() (r2f-closures.R)
+resolve_superassign_target <- function(name, scope) {
+  formal_names <- names(formals(scope_closure(scope))) %||% character()
+  if (name %in% formal_names) {
+    stop("<<- targets must not shadow closure formals: ", name)
+  }
+
+  forbidden <- scope_forbid_superassign(scope)
+  if (name %in% forbidden) {
+    stop("closure must not superassign to its output variable: ", name)
+  }
+
+  host_scope <- scope_host_scope(scope) %||%
+    stop("internal error: missing host scope")
+  host_var <- get0(name, host_scope)
+  if (!inherits(host_var, Variable)) {
+    stop(
+      "<<- targets must resolve to an existing variable in the enclosing quick() scope: ",
+      name
+    )
+  }
+
+  host_var@modified <- TRUE
+  host_scope[[name]] <- host_var
+  host_var
+}
+
 register_r2f_handler(
   "<<-",
   function(args, scope, ..., hoist = NULL) {
@@ -296,28 +324,7 @@ register_r2f_handler(
     stopifnot(is.symbol(target))
     name <- as.character(target)
 
-    formal_names <- names(formals(scope_closure(scope))) %||% character()
-    if (name %in% formal_names) {
-      stop("<<- targets must not shadow closure formals: ", name)
-    }
-
-    forbidden <- scope_forbid_superassign(scope)
-    if (name %in% forbidden) {
-      stop("closure must not superassign to its output variable: ", name)
-    }
-
-    host_scope <- scope_host_scope(scope) %||%
-      stop("internal error: missing host scope")
-    host_var <- get0(name, host_scope)
-    if (!inherits(host_var, Variable)) {
-      stop(
-        "<<- targets must resolve to an existing variable in the enclosing quick() scope: ",
-        name
-      )
-    }
-
-    host_var@modified <- TRUE
-    host_scope[[name]] <- host_var
+    host_var <- resolve_superassign_target(name, scope)
 
     value <- r2f(args[[2L]], scope, ..., hoist = hoist)
     check_reassignment_narrowing(name, host_var, value@value)
@@ -343,28 +350,7 @@ register_r2f_handler(
     }
     name <- as.character(base)
 
-    formal_names <- names(formals(scope_closure(scope))) %||% character()
-    if (name %in% formal_names) {
-      stop("<<- targets must not shadow closure formals: ", name)
-    }
-
-    forbidden <- scope_forbid_superassign(scope)
-    if (name %in% forbidden) {
-      stop("closure must not superassign to its output variable: ", name)
-    }
-
-    host_scope <- scope_host_scope(scope) %||%
-      stop("internal error: missing host scope")
-    host_var <- get0(name, host_scope)
-    if (!inherits(host_var, Variable)) {
-      stop(
-        "<<- targets must resolve to an existing variable in the enclosing quick() scope: ",
-        name
-      )
-    }
-
-    host_var@modified <- TRUE
-    host_scope[[name]] <- host_var
+    host_var <- resolve_superassign_target(name, scope)
 
     lhs <- compile_subscript_lhs(
       subset_call,
diff --git a/R/r2f-closures.R b/R/r2f-closures.R
index f2f31e92..cc193021 100644
--- a/R/r2f-closures.R
+++ b/R/r2f-closures.R
@@ -1394,38 +1394,16 @@ compile_subset_designator <- function(
   # silent out-of-bounds Fortran writes.
   check_subscript_exprs(base_var, idx_args)
 
-  idxs <- whole_doubles_to_ints(idx_args)
-  idxs <- imap(idxs, function(idx, i) {
-    if (is_missing(idx)) {
-      Fortran(":", Variable("integer", base_var@dims[[i]]))
-    } else {
-      sub <- r2f(idx, scope, ..., hoist = hoist)
-      if (sub@value@mode == "double") {
-        Fortran(
-          glue("int({sub}, kind=c_ptrdiff_t)"),
-          Variable("integer", sub@value@dims)
-        )
-      } else {
-        sub
-      }
-    }
-  })
+  idxs <- lower_subscript_args(
+    idx_args,
+    base_var@dims,
+    scope,
+    ...,
+    hoist = hoist
+  )
 
-  # Indexing a scalar (rank-1 length-1) with `[1]` is valid in R, but Fortran
-  # scalars cannot be subscripted. Treat it as a no-op.
-  if (
-    passes_as_scalar(base_var) &&
-      length(idxs) == 1 &&
-      idxs[[1]]@value@mode == "integer" &&
-      passes_as_scalar(idxs[[1]]@value)
-  ) {
-    idx_r <- attr(idxs[[1]], "r", exact = TRUE)
-    if (identical(idx_r, 1L) || identical(idx_r, 1)) {
-      return(base_name)
-    }
-    if (isTRUE(idxs[[1]]@value@loop_is_singleton)) {
-      return(base_name)
-    }
+  if (subscript_is_scalar_noop(base_var, idxs)) {
+    return(base_name)
   }
 
   # R-style linear indexing for rank>1 arrays: x[i]
@@ -1462,13 +1440,13 @@ compile_subset_designator <- function(
         mask <- booleanize_logical_as_int(subscript)
         it <- scope_unique_var(scope, "integer")
         f <- glue("pack([({it}, {it}=1, size({mask}))], {mask})")
-        Fortran(f, Variable("int", NA))
+        Fortran(f, Variable("integer", NA))
       },
       integer0 = {
         if (drop) {
           subscript
         } else {
-          Fortran(glue("{subscript}:{subscript}"), Variable("int", 1))
+          Fortran(glue("{subscript}:{subscript}"), Variable("integer", 1))
         }
       },
       integer1 = {
@@ -1570,15 +1548,7 @@ compile_subscript_lhs <- function(
   }
   name <- as.character(base)
 
-  host_scope <- scope_host_scope(scope) %||%
-    stop("internal error: missing host scope")
-  host_var <- get0(name, host_scope)
-  if (!inherits(host_var, Variable)) {
-    stop(
-      "<<- targets must resolve to an existing variable in the enclosing quick() scope: ",
-      name
-    )
-  }
+  host_var <- resolve_superassign_target(name, scope)
 
   idx_args <- as.list(subset_call)[-1L]
   idx_args <- idx_args[-1L]
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 8126e3a8..c214fcb8 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -542,11 +542,61 @@ maybe_reshape_vector_matrix <- function(
 mode_lattice <- c("logical", "integer", "double", "complex")
 
 # Rank of a mode on the lattice (NA for modes outside it, e.g. character).
-# Used by: reduce_promoted_mode(), scope.R (check_reassignment_narrowing)
+# Used by: reduce_promoted_mode(), check_reassignment_narrowing()
 mode_rank <- function(mode) {
   match(mode, mode_lattice)
 }
 
+# Sanity-check that an assignment's value can be stored in its target
+# (rank matches unless one side is scalar).
+# Used by: r2f-assign.R, scope.R
+check_assignment_compatible <- function(target, value) {
+  if (is.null(value)) {
+    return()
+  }
+  stopifnot(exprs = {
+    inherits(target, Variable)
+    inherits(value, Variable)
+    passes_as_scalar(target) ||
+      passes_as_scalar(value) ||
+      target@rank == value@rank
+  })
+}
+
+# Reassignment cannot re-type a Fortran variable the way R promotes an R
+# binding, so a value whose mode sits above the variable's on the lattice
+# would be silently truncated by the assignment. Refuse at compile time
+# instead.
+# Used by: r2f-assign.R
+check_reassignment_narrowing <- function(name, target, value) {
+  if (
+    !inherits(target, Variable) ||
+      !inherits(value, Variable) ||
+      is.null(target@mode) ||
+      is.null(value@mode)
+  ) {
+    return()
+  }
+  target_rank <- mode_rank(target@mode)
+  value_rank <- mode_rank(value@mode)
+  if (is.na(target_rank) || is.na(value_rank) || value_rank <= target_rank) {
+    return()
+  }
+  stop(
+    "cannot reassign `",
+    name,
+    "`: assignment would narrow ",
+    value@mode,
+    " to ",
+    target@mode,
+    "; R would promote `",
+    name,
+    "` to ",
+    value@mode,
+    call. = FALSE
+  )
+}
+
 # Determine the promoted mode from a list of Fortran values.
 # Used by: r2f-arithmetic.R, r2f-constructors.R
 reduce_promoted_mode <- function(...) {
diff --git a/R/r2f-subscript.R b/R/r2f-subscript.R
index 9f377210..6cd98f62 100644
--- a/R/r2f-subscript.R
+++ b/R/r2f-subscript.R
@@ -1,6 +1,63 @@
 # r2f-subscript.R
 # Handlers for subscripting operations: [
 
+# --- Shared subscript lowering ---
+# The read side (the `[` handler below) and the write side
+# (compile_subset_designator() in r2f-closures.R) lower subscripts with
+# the same helpers so the two paths cannot drift.
+
+# Fortran subscripts must be integers; coerce a double subscript
+# expression with a c_ptrdiff_t cast. (Not cast_to_mode(), which refuses
+# narrowing casts by design.)
+subscript_as_index_int <- function(sub) {
+  if (sub@value@mode == "double") {
+    Fortran(
+      glue("int({sub}, kind=c_ptrdiff_t)"),
+      Variable("integer", sub@value@dims)
+    )
+  } else {
+    sub
+  }
+}
+
+# Lower raw subscript args: a missing arg becomes a full-axis `:`
+# section, everything else compiles through r2f(). Passing the
+# per-statement hoist along matters: subscript expressions that need
+# temporaries (e.g. rev(seq_len(n))) would otherwise self-render as an
+# inline `block ... end block` *expression*, which is invalid Fortran
+# inside an array designator.
+lower_subscript_args <- function(idx_args, base_dims, scope, ..., hoist) {
+  idxs <- whole_doubles_to_ints(idx_args)
+  imap(idxs, function(idx, i) {
+    if (is_missing(idx)) {
+      Fortran(":", Variable("integer", base_dims[[i]]))
+    } else {
+      subscript_as_index_int(r2f(idx, scope, ..., hoist = hoist))
+    }
+  })
+}
+
+# Indexing a scalar (rank-1 length-1) with `[1]` (or the singleton loop
+# index) is valid in R, but Fortran scalars cannot be subscripted;
+# callers treat it as a no-op.
+subscript_is_scalar_noop <- function(base_value, idxs) {
+  if (
+    passes_as_scalar(base_value) &&
+      length(idxs) == 1 &&
+      idxs[[1]]@value@mode == "integer" &&
+      passes_as_scalar(idxs[[1]]@value)
+  ) {
+    idx_r <- attr(idxs[[1]], "r", exact = TRUE)
+    if (identical(idx_r, 1L) || identical(idx_r, 1)) {
+      return(TRUE)
+    }
+    if (isTRUE(idxs[[1]]@value@loop_is_singleton)) {
+      return(TRUE)
+    }
+  }
+  FALSE
+}
+
 # --- Handlers ---
 
 r2f_handlers[["["]] <- function(
@@ -10,11 +67,15 @@ r2f_handlers[["["]] <- function(
   hoist_mask = function(mask) FALSE,
   hoist = NULL
 ) {
-  # only a subset of R's x[...] features can be translated here. `...` can only be:
-  # - a single logical mask, of the same rank as `x`. returns a rank 1 vector.
-  # - a number of arguments matching the rank of `x`, with each being
-  #   an integer of rank 0 or 1. In this case, a rank 1 logical becomes
-  #   converted to an integer with
+  # Only a subset of R's x[...] features can be translated here. `...`
+  # can be:
+  # - a single logical mask of the same rank as `x`: lowers to pack(),
+  #   returning a rank-1 vector.
+  # - a single scalar integer subscript on a rank>1 `x`: R-style linear
+  #   indexing.
+  # - one subscript per axis of `x`, each logical or integer of rank 0
+  #   or 1 (a logical vector becomes integer positions, as R's which();
+  #   double subscripts coerce to integer).
 
   var <- args[[1]]
   var <- r2f(var, scope, ..., hoist = hoist)
@@ -25,27 +86,13 @@ r2f_handlers[["["]] <- function(
 
   check_subscript_exprs(var@value, idx_args)
 
-  idxs <- whole_doubles_to_ints(idx_args)
-  idxs <- imap(idxs, function(idx, i) {
-    if (is_missing(idx)) {
-      Fortran(":", Variable("integer", var@value@dims[[i]]))
-    } else {
-      # Important: pass along the per-statement hoist context, otherwise
-      # subscript expressions that need temporaries (e.g. rev(seq_len(n)))
-      # will self-render as an inline `block ... end block` *expression*,
-      # which is invalid Fortran inside an array designator.
-      sub <- r2f(idx, scope, ..., hoist = hoist)
-      if (sub@value@mode == "double") {
-        # Fortran subscripts must be integers; coerce numeric expressions
-        Fortran(
-          glue("int({sub}, kind=c_ptrdiff_t)"),
-          Variable("integer", sub@value@dims)
-        )
-      } else {
-        sub
-      }
-    }
-  })
+  idxs <- lower_subscript_args(
+    idx_args,
+    var@value@dims,
+    scope,
+    ...,
+    hoist = hoist
+  )
 
   if (
     length(idxs) == 1 &&
@@ -63,21 +110,8 @@ r2f_handlers[["["]] <- function(
     ))
   }
 
-  # Indexing a scalar (rank-1 length-1) with `[1]` is valid in R, but Fortran
-  # scalars cannot be subscripted. Treat it as a no-op.
-  if (
-    passes_as_scalar(var@value) &&
-      length(idxs) == 1 &&
-      idxs[[1]]@value@mode == "integer" &&
-      passes_as_scalar(idxs[[1]]@value)
-  ) {
-    idx_r <- attr(idxs[[1]], "r", exact = TRUE)
-    if (identical(idx_r, 1L) || identical(idx_r, 1)) {
-      return(var)
-    }
-    if (isTRUE(idxs[[1]]@value@loop_is_singleton)) {
-      return(var)
-    }
+  if (subscript_is_scalar_noop(var@value, idxs)) {
+    return(var)
   }
 
   # R-style linear indexing for rank>1 arrays: x[i]
@@ -113,9 +147,6 @@ r2f_handlers[["["]] <- function(
   }
 
   idxs <- imap(idxs, function(subscript, i) {
-    # if (!idx@value@rank %in% 0:1)
-    #   stop("all args to x[...] must have rank 0 or 1",
-    #        deparse1(as.call(c(quote(`[`,args )))))
     switch(
       paste0(subscript@value@mode, subscript@value@rank),
       logical0 = {
@@ -125,13 +156,13 @@ r2f_handlers[["["]] <- function(
         # we convert to a temp integer vector, doing the equivalent of R's which()
         i <- scope_unique_var(scope, "integer")
         f <- glue("pack([({i}, {i}=1, size({subscript}))], {subscript})")
-        return(Fortran(f, Variable("int", NA)))
+        return(Fortran(f, Variable("integer", NA)))
       },
       integer0 = {
         if (drop) {
           subscript
         } else {
-          Fortran(glue("{subscript}:{subscript}"), Variable("int", 1))
+          Fortran(glue("{subscript}:{subscript}"), Variable("integer", 1))
         }
       },
       integer1 = {
@@ -150,14 +181,9 @@ r2f_handlers[["["]] <- function(
           }
 
           if (is_call(r, quote(`:`)) && length(r) == 3L) {
-            scalar <- r2f(r[[2L]], scope, ..., hoist = hoist)
-            if (scalar@value@mode == "double") {
-              scalar <- Fortran(
-                glue("int({scalar}, kind=c_ptrdiff_t)"),
-                Variable("integer", scalar@value@dims)
-              )
-            }
-            return(scalar)
+            return(subscript_as_index_int(
+              r2f(r[[2L]], scope, ..., hoist = hoist)
+            ))
           }
 
           if (is_call(r, quote(seq_len)) && length(r) == 2L) {
@@ -173,21 +199,15 @@ r2f_handlers[["["]] <- function(
 
           if (is_call(r, quote(seq))) {
             info <- seq_like_parse("seq", as.list(r)[-1L], scope)
-            scalar <- r2f(info$from, scope, ..., hoist = hoist)
-            if (scalar@value@mode == "double") {
-              scalar <- Fortran(
-                glue("int({scalar}, kind=c_ptrdiff_t)"),
-                Variable("integer", scalar@value@dims)
-              )
-            }
-            return(scalar)
+            return(subscript_as_index_int(
+              r2f(info$from, scope, ..., hoist = hoist)
+            ))
           }
         }
 
         subscript
       },
-      # double0 = { },
-      # double1 = { },
+      # Doubles were already coerced to integer by lower_subscript_args().
       stop(
         "all args to x[...] must be logical or integer of rank 0 or 1",
         deparse1(as.call(c(list(as.name("[")), args)))
diff --git a/R/scope.R b/R/scope.R
index 0423e5a1..4e432ef5 100644
--- a/R/scope.R
+++ b/R/scope.R
@@ -37,7 +37,6 @@ names.quickr_ordered_env <- function(x) {
   all_names <- ls(envir = x, sorted = FALSE)
   ordered_names <- attr(x, "ordered_names", TRUE)
   if (!setequal(all_names, ordered_names)) {
-    warning("untracked name")
     stop("untracked name")
   }
   ordered_names
@@ -56,52 +55,6 @@ print.quickr_ordered_env <- function(x, ...) {
 }
 
 
-check_assignment_compatible <- function(target, value) {
-  if (is.null(value)) {
-    return()
-  }
-  stopifnot(exprs = {
-    inherits(target, Variable)
-    inherits(value, Variable)
-    passes_as_scalar(target) ||
-      passes_as_scalar(value) ||
-      target@rank == value@rank
-  })
-}
-
-# Reassignment cannot re-type a Fortran variable the way R promotes an R
-# binding, so a value whose mode sits above the variable's on the lattice
-# (logical < integer < double < complex) would be silently truncated by the
-# assignment. Refuse at compile time instead.
-check_reassignment_narrowing <- function(name, target, value) {
-  if (
-    !inherits(target, Variable) ||
-      !inherits(value, Variable) ||
-      is.null(target@mode) ||
-      is.null(value@mode)
-  ) {
-    return()
-  }
-  target_rank <- mode_rank(target@mode)
-  value_rank <- mode_rank(value@mode)
-  if (is.na(target_rank) || is.na(value_rank) || value_rank <= target_rank) {
-    return()
-  }
-  stop(
-    "cannot reassign `",
-    name,
-    "`: assignment would narrow ",
-    value@mode,
-    " to ",
-    target@mode,
-    "; R would promote `",
-    name,
-    "` to ",
-    value@mode,
-    call. = FALSE
-  )
-}
-
 new_scope <- function(closure, parent = emptyenv()) {
   scope <- new_ordered_env(parent = parent)
   class(scope) <- unique(c("quickr_scope", class(scope)))

From 19167af7f5e5e9faa60d99d987c510a44c0b4842 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 18:07:07 +0200
Subject: [PATCH 23/97] Consolidate the hoist-materialization idiom and core
 dispatch accessors

The declare-tmp/emit-assign/rewrap idiom existed at six sites while
materialize_via_hoist() already encapsulated it -- but lived in
r2f-constructors.R where the other consumers could not naturally see it.
It moves to the hoisting infrastructure in r2f-aab-core.R (alongside
parent_call_name), gains a logical_as_int passthrough, and now backs
hoist_unless_name()'s tail, both subscript-base hoists, rev(), and
array()'s scalar-target branch. array()'s hand-rolled recycling guard
routes through emit_quickr_error_if() like every other runtime guard,
and matrix()'s reshape-with-pad spelling reuses
reshape_vector_for_matrix(). array()'s 90 lines of nested helpers lift
to file level as array_dim_to_dims()/known_dims_prod().

In the dispatch core, unwrap_parens() replaces three hand-rolled paren
loops, handler_field()/handler_for_call() replace four copies of the
R2FHandler-vs-attribute accessor dance, and the dead (and subtly buggy)
r2f_default_handler() is deleted along with the stale commented-out
'object' branch. The for handler's OpenMP prologue/epilogue, duplicated
verbatim across its two iteration paths, becomes compile_for_body().
The any/all handler's four hand-rolled array-constructor probes share
renders_as_array_ctor()/is_declared_len1(), and the reduction handlers
compute their call name once. Emitted Fortran is unchanged.
---
 R/r2f-aab-core.R     | 127 +++++++++++-----------
 R/r2f-constructors.R | 252 +++++++++++++++++++++----------------------
 R/r2f-control-flow.R |  99 +++++++++--------
 R/r2f-reductions.R   |  61 ++++++-----
 R/r2f-rev.R          |   6 +-
 R/r2f-subscript.R    |  18 ++--
 6 files changed, 287 insertions(+), 276 deletions(-)

diff --git a/R/r2f-aab-core.R b/R/r2f-aab-core.R
index 473793bf..2694cf72 100644
--- a/R/r2f-aab-core.R
+++ b/R/r2f-aab-core.R
@@ -76,6 +76,28 @@ new_hoist <- function(scope) {
   )
 }
 
+# Materialize `code` into a hoisted temporary and return the temporary.
+# `hoist` is always available in a handler: r2f() opens one per statement
+# before dispatching, and every caller forwards the one it received.
+# Used by: hoist_unless_name(), r2f-constructors.R, r2f-subscript.R,
+#          r2f-rev.R
+materialize_via_hoist <- function(
+  code,
+  mode,
+  dims,
+  hoist,
+  logical_as_int = FALSE
+) {
+  stopifnot(is.environment(hoist))
+  tmp <- hoist$declare_tmp(
+    mode = mode,
+    dims = dims,
+    logical_as_int = logical_as_int
+  )
+  hoist$emit(glue("{tmp@name} = {code}"))
+  Fortran(tmp@name, tmp)
+}
+
 # Hoist `x` into a temporary variable unless it already renders as a bare
 # variable name or a literal constant. Use this whenever the same operand is
 # spliced into generated code more than once: Fortran evaluates intrinsic
@@ -91,13 +113,22 @@ hoist_unless_name <- function(x, hoist) {
   if (grepl("^-?[0-9]+(\\.[0-9]+)?(_c_(int|double))?$", code)) {
     return(x)
   }
-  tmp <- hoist$declare_tmp(
+  materialize_via_hoist(
+    x,
     mode = x@value@mode,
     dims = x@value@dims,
+    hoist = hoist,
     logical_as_int = logical_as_int(x@value)
   )
-  hoist$emit(glue("{tmp@name} = {x}"))
-  Fortran(tmp@name, tmp)
+}
+
+# Name of the call one frame above the current handler ("" at top level).
+# Materialization decisions branch on it: a fill constructor or
+# matrix(scalar, ...) may stay a scalar only where the parent broadcasts,
+# spreads, or pads it.
+# Used by: r2f-constructors.R, r2f-operators.R
+parent_call_name <- function(calls) {
+  if (length(calls) >= 2L) calls[[length(calls) - 1L]] else ""
 }
 
 
@@ -164,13 +195,7 @@ lang2fortran <- r2f <- function(
     language = {
       # a call
       callable <- e[[1L]]
-      callable_unwrapped <- callable
-      while (
-        is_call(callable_unwrapped, quote(`(`)) &&
-          length(callable_unwrapped) == 2L
-      ) {
-        callable_unwrapped <- callable_unwrapped[[2L]]
-      }
+      callable_unwrapped <- unwrap_parens(callable)
 
       if (!is.null(scope)) {
         maybe_lower_local_closure_call(
@@ -183,11 +208,7 @@ lang2fortran <- r2f <- function(
           {
             handler <- get_r2f_handler(callable_unwrapped)
 
-            match.fun <- if (inherits(handler, R2FHandler)) {
-              handler@match_fun
-            } else {
-              attr(handler, "match.fun", TRUE)
-            }
+            match.fun <- handler_field(handler, "match_fun", "match.fun")
             if (is.null(match.fun)) {
               match.fun <- get0(
                 callable_unwrapped,
@@ -295,15 +316,9 @@ lang2fortran <- r2f <- function(
       }
     },
 
-    ## handling 'object' and 'closure' here are both bad ideas,
-    ## TODO: delete both
-    # "object" = {
-    #   if (inherits(e, Variable))
-    #     e <- Fortran(character(), e)
-    #   stopifnot(inherits(e, Fortran))
-    #   e
-    # },
-
+    # Top-level entry only: quick() hands the user's closure to r2f() to
+    # start translation (new_fortran_subroutine()); expressions inside
+    # compiled code never produce a closure here.
     closure = {
       if (is.null(name <- attr(e, "name", TRUE))) {
         name <- if (is.symbol(name <- substitute(e))) {
@@ -419,47 +434,43 @@ resolve_handler_fun <- function(handler) {
 
 # --- Destination Helpers ---
 
-dest_supported_for_call <- function(call) {
-  if (!is.call(call)) {
-    return(FALSE)
-  }
-  unwrapped <- call
-  while (is_call(unwrapped, "(") && length(unwrapped) == 2L) {
-    unwrapped <- unwrapped[[2L]]
-  }
-  if (!is.call(unwrapped) || !is.symbol(unwrapped[[1L]])) {
-    return(FALSE)
-  }
-  handler <- get0(as.character(unwrapped[[1L]]), r2f_handlers, inherits = FALSE)
+# Read a handler property, whether the handler is an R2FHandler object or
+# a bare function carrying attributes. `attr_name` covers the one legacy
+# spelling difference (the "match.fun" attr vs the match_fun property).
+# NULL handlers read as NULL.
+handler_field <- function(handler, name, attr_name = name) {
   if (inherits(handler, R2FHandler)) {
-    isTRUE(handler@dest_supported)
+    prop(handler, name)
   } else {
-    isTRUE(attr(handler, "dest_supported", exact = TRUE))
+    attr(handler, attr_name, exact = TRUE)
   }
 }
 
-dest_infer_for_call <- function(call, scope) {
+# Resolve the registered handler for a (possibly parenthesized) call, or
+# NULL when it is not a named-symbol call or has no handler.
+handler_for_call <- function(call) {
   if (!is.call(call)) {
     return(NULL)
   }
-  unwrapped <- call
-  while (is_call(unwrapped, "(") && length(unwrapped) == 2L) {
-    unwrapped <- unwrapped[[2L]]
-  }
-  if (!is.call(unwrapped) || !is.symbol(unwrapped[[1L]])) {
+  call <- unwrap_parens(call)
+  if (!is.call(call) || !is.symbol(call[[1L]])) {
     return(NULL)
   }
-  handler <- get0(as.character(unwrapped[[1L]]), r2f_handlers, inherits = FALSE)
-  infer <- if (inherits(handler, R2FHandler)) {
-    handler@dest_infer
-  } else {
-    attr(handler, "dest_infer", exact = TRUE)
-  }
-  infer_name <- if (inherits(handler, R2FHandler)) {
-    handler@dest_infer_name
-  } else {
-    attr(handler, "dest_infer_name", exact = TRUE)
+  get0(as.character(call[[1L]]), r2f_handlers, inherits = FALSE)
+}
+
+dest_supported_for_call <- function(call) {
+  isTRUE(handler_field(handler_for_call(call), "dest_supported"))
+}
+
+dest_infer_for_call <- function(call, scope) {
+  handler <- handler_for_call(call)
+  if (is.null(handler)) {
+    return(NULL)
   }
+  unwrapped <- unwrap_parens(call)
+  infer <- handler_field(handler, "dest_infer")
+  infer_name <- handler_field(handler, "dest_infer_name")
 
   infer_fun <- NULL
   if (is_string(infer_name)) {
@@ -483,14 +494,6 @@ dest_infer_for_call <- function(call, scope) {
 
 # --- Default Handlers ---
 
-r2f_default_handler <- function(args, scope = NULL, ..., calls) {
-  # stopifnot(is.call(e), is.symbol(e[[1L]]))
-
-  x <- lapply(args, r2f, scope = scope, calls = calls, ...)
-  s <- sprintf("%s(%s)", last(calls), str_flatten_commas(x[-1]))
-  Fortran(s)
-}
-
 .r2f_handler_not_implemented_yet <- function(e, scope, ...) {
   stop(
     gettextf("'%s' is not implemented yet", as.character(e[[1L]])),
diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index 817b1bd5..5b0e6cf1 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -14,22 +14,106 @@ is_fill_constructor_call <- function(e) {
     as.character(e[[1L]]) %in% c("logical", "integer", "double", "numeric")
 }
 
-# Name of the call one frame above the current handler ("" at top level).
-# The materialization decisions below branch on it: a fill constructor or
-# matrix(scalar, ...) may stay a scalar only where the parent broadcasts,
-# spreads, or pads it.
-parent_call_name <- function(calls) {
-  if (length(calls) >= 2L) calls[[length(calls) - 1L]] else ""
+# (parent_call_name() and materialize_via_hoist(), which the handlers
+# below build on, live with the hoisting infrastructure in
+# r2f-aab-core.R.)
+
+# Parse array(dim=)'s argument to a dims list: literal vectors, literal
+# `a:b` sequences, and symbols bound to a known literal vector; anything
+# else falls through to r2dims().
+# Used by: array()
+array_dim_to_dims <- function(dim_arg, scope) {
+  if (
+    is.atomic(dim_arg) &&
+      typeof(dim_arg) %in% c("integer", "double")
+  ) {
+    if (!length(dim_arg) || anyNA(dim_arg)) {
+      stop(
+        "array(dim=) must be non-empty and must not contain NA",
+        call. = FALSE
+      )
+    }
+    dim_arg <- vapply(
+      dim_arg,
+      function(x) {
+        if (!is_wholenumber(x)) {
+          stop(
+            "array(dim=) must be whole numbers, found: ",
+            x,
+            call. = FALSE
+          )
+        }
+        as.integer(x)
+      },
+      integer(1L)
+    )
+    return(as.list(dim_arg))
+  }
+
+  if (is.call(dim_arg) && is.symbol(dim_arg[[1L]])) {
+    op <- as.character(dim_arg[[1L]])
+    if (op == ":") {
+      if (length(dim_arg) != 3L) {
+        stop("bad dim sequence", call. = FALSE)
+      }
+      from <- dim_arg[[2L]]
+      to <- dim_arg[[3L]]
+      if (
+        !(is.atomic(from) && length(from) == 1L && is_wholenumber(from)) ||
+          !(is.atomic(to) && length(to) == 1L && is_wholenumber(to))
+      ) {
+        stop(
+          "array(dim=) only supports literal sequences like 2:4",
+          call. = FALSE
+        )
+      }
+      return(as.list(seq.int(as.integer(from), as.integer(to))))
+    }
+  }
+
+  if (is.symbol(dim_arg)) {
+    var <- get0(as.character(dim_arg), scope)
+    if (
+      inherits(var, Variable) &&
+        var@mode %in% c("integer", "double") &&
+        var@rank == 1L &&
+        (is.language(var@r) || is.atomic(var@r)) &&
+        !identical(var@r, dim_arg)
+    ) {
+      return(array_dim_to_dims(var@r, scope))
+    }
+  }
+
+  r2dims(dim_arg, scope)
 }
 
-# Materialize `code` into a hoisted temporary and return the temporary.
-# `hoist` is always available in a handler: r2f() opens one per statement
-# before dispatching, and the constructor handlers forward what they got.
-materialize_via_hoist <- function(code, mode, dims, hoist) {
-  stopifnot(is.environment(hoist))
-  tmp <- hoist$declare_tmp(mode = mode, dims = dims)
-  hoist$emit(glue("{tmp@name} = {code}"))
-  Fortran(tmp@name, tmp)
+# Product of a dims list when every dim is a known whole number, NA_real_
+# otherwise (in double to dodge integer overflow on large dims).
+# Used by: array()
+known_dims_prod <- function(dims) {
+  if (is.null(dims) || !length(dims)) {
+    return(1)
+  }
+  vals <- vapply(
+    dims,
+    function(d) {
+      if (
+        is.atomic(d) &&
+          length(d) == 1L &&
+          !is.na(d) &&
+          is_wholenumber(d)
+      ) {
+        as.double(d)
+      } else {
+        NA_real_
+      }
+    },
+    double(1L)
+  )
+  if (anyNA(vals)) {
+    return(NA_real_)
+  }
+  prod(vals)
 }
 
 # --- Handlers ---
@@ -262,17 +346,12 @@ r2f_handlers[["matrix"]] <- function(args, scope = NULL, ..., hoist = NULL) {
     return(materialize_via_hoist(src, src@value@mode, dims, hoist))
   }
 
-  rows <- dims[[1L]]
-  cols <- dims[[2L]]
-
-  # Avoid double-evaluating non-trivial expressions when used in both the
-  # `source` and `pad` args.
-  source <- glue("{hoist_unless_name(src, hoist)}")
-  Fortran(
-    glue(
-      "reshape({source}, [{bind_dim_int(rows)}, {bind_dim_int(cols)}], pad = {source})"
-    ),
-    out_val
+  # reshape_vector_for_matrix() splices its source into both the `source`
+  # and `pad` args; hoist non-trivial expressions so they evaluate once.
+  reshape_vector_for_matrix(
+    hoist_unless_name(src, hoist),
+    dims[[1L]],
+    dims[[2L]]
   )
 }
 
@@ -285,73 +364,8 @@ r2f_handlers[["array"]] <- function(args, scope = NULL, ..., hoist = NULL) {
     stop("array(dimnames=) not supported")
   }
 
-  dim_to_dims <- function(dim_arg) {
-    if (
-      is.atomic(dim_arg) &&
-        typeof(dim_arg) %in% c("integer", "double")
-    ) {
-      if (!length(dim_arg) || anyNA(dim_arg)) {
-        stop(
-          "array(dim=) must be non-empty and must not contain NA",
-          call. = FALSE
-        )
-      }
-      dim_arg <- vapply(
-        dim_arg,
-        function(x) {
-          if (!is_wholenumber(x)) {
-            stop(
-              "array(dim=) must be whole numbers, found: ",
-              x,
-              call. = FALSE
-            )
-          }
-          as.integer(x)
-        },
-        integer(1L)
-      )
-      return(as.list(dim_arg))
-    }
-
-    if (is.call(dim_arg) && is.symbol(dim_arg[[1L]])) {
-      op <- as.character(dim_arg[[1L]])
-      if (op == ":") {
-        if (length(dim_arg) != 3L) {
-          stop("bad dim sequence", call. = FALSE)
-        }
-        from <- dim_arg[[2L]]
-        to <- dim_arg[[3L]]
-        if (
-          !(is.atomic(from) && length(from) == 1L && is_wholenumber(from)) ||
-            !(is.atomic(to) && length(to) == 1L && is_wholenumber(to))
-        ) {
-          stop(
-            "array(dim=) only supports literal sequences like 2:4",
-            call. = FALSE
-          )
-        }
-        return(as.list(seq.int(as.integer(from), as.integer(to))))
-      }
-    }
-
-    if (is.symbol(dim_arg)) {
-      var <- get0(as.character(dim_arg), scope)
-      if (
-        inherits(var, Variable) &&
-          var@mode %in% c("integer", "double") &&
-          var@rank == 1L &&
-          (is.language(var@r) || is.atomic(var@r)) &&
-          !identical(var@r, dim_arg)
-      ) {
-        return(dim_to_dims(var@r))
-      }
-    }
-
-    r2dims(dim_arg, scope)
-  }
-
   out <- r2f(args$data, scope, ..., hoist = hoist)
-  target_dims <- dim_to_dims(args$dim)
+  target_dims <- array_dim_to_dims(args$dim, scope)
   if (!length(target_dims)) {
     stop("array(dim=) must not be empty", call. = FALSE)
   }
@@ -364,15 +378,16 @@ r2f_handlers[["array"]] <- function(args, scope = NULL, ..., hoist = NULL) {
     if (scalar_target) {
       # `dim = 1` is scalar-like in quickr (rank-1 length-1 is declared scalar).
       # Avoid `reshape(..., [1])` (rank-1) and instead return the first element.
-      if (is.null(hoist)) {
-        stop("internal error: array() requires hoist context", call. = FALSE)
-      }
       target_dims <- list(1L)
-      tmp <- hoist$declare_tmp(mode = out@value@mode, dims = out@value@dims)
-      hoist$emit(glue("{tmp@name} = {out}"))
+      tmp <- materialize_via_hoist(
+        out,
+        mode = out@value@mode,
+        dims = out@value@dims,
+        hoist = hoist
+      )
       idxs <- rep("1", out@value@rank)
       out <- Fortran(
-        glue("{tmp@name}({str_flatten_commas(idxs)})"),
+        glue("{tmp}({str_flatten_commas(idxs)})"),
         Variable(mode = out@value@mode, dims = list(1L))
       )
     } else {
@@ -404,38 +419,12 @@ r2f_handlers[["array"]] <- function(args, scope = NULL, ..., hoist = NULL) {
         paste0("(", paste0("(", axis_terms, ")", collapse = " * "), ")")
       }
 
-      known_prod <- function(dims) {
-        if (is.null(dims) || !length(dims)) {
-          return(1)
-        }
-        vals <- vapply(
-          dims,
-          function(d) {
-            if (
-              is.atomic(d) &&
-                length(d) == 1L &&
-                !is.na(d) &&
-                is_wholenumber(d)
-            ) {
-              as.double(d)
-            } else {
-              NA_real_
-            }
-          },
-          double(1L)
-        )
-        if (anyNA(vals)) {
-          return(NA_real_)
-        }
-        prod(vals)
-      }
-
       source <- if (is_fill_constructor) {
         i <- scope_unique_var(scope, "integer")
         glue("[({out}, {i}=1, int({n_expr}))]")
       } else {
-        n_target <- known_prod(target_dims)
-        n_source <- known_prod(out@value@dims)
+        n_target <- known_dims_prod(target_dims)
+        n_source <- known_dims_prod(out@value@dims)
         if (!is.na(n_target) && !is.na(n_source) && n_target > n_source) {
           stop(
             "array() reshape does not support recycling: prod(dim)=",
@@ -446,14 +435,15 @@ r2f_handlers[["array"]] <- function(args, scope = NULL, ..., hoist = NULL) {
           )
         }
         if (!is.null(hoist)) {
-          mark_scope_uses_errors(scope)
-          err <- quickr_error_fortran_lines(
-            "array() reshape does not support recycling (data shorter than prod(dim))",
+          emit_quickr_error_if(
+            condition = glue("int({n_expr}) > size({out})"),
+            message = paste0(
+              "array() reshape does not support recycling ",
+              "(data shorter than prod(dim))"
+            ),
+            hoist = hoist,
             scope = scope
           )
-          hoist$emit(glue("if (int({n_expr}) > size({out})) then"))
-          hoist$emit(paste0("  ", err))
-          hoist$emit("end if")
         }
 
         # RESHAPE() requires `SOURCE` to be an array expression; array constructors
diff --git a/R/r2f-control-flow.R b/R/r2f-control-flow.R
index e46afe8c..2905763f 100644
--- a/R/r2f-control-flow.R
+++ b/R/r2f-control-flow.R
@@ -102,6 +102,41 @@ r2f_handlers[["while"]] <- function(args, scope, ..., hoist = NULL) {
 }
 
 # ---- for ----
+
+# Compile a `for` body in its own per-statement hoist (see the `while`
+# handler: forwarding the enclosing statement's hoist would emit a
+# single-statement body's hoisted code once, before the loop), entering
+# an OpenMP scope around the compile when the loop is parallel. Returns
+# the compiled body together with the loop's OpenMP directives and
+# post-loop error check, which must be computed while the OpenMP scope is
+# still entered.
+compile_for_body <- function(body, scope, ..., parallel, private = NULL) {
+  if (!is.null(parallel)) {
+    previous_openmp <- enter_openmp_scope(scope)
+    on.exit(exit_openmp_scope(scope, previous_openmp), add = TRUE)
+  }
+  body <- r2f(body, scope, ..., hoist = NULL)
+  check_pending_parallel_consumed(scope)
+
+  directives <- openmp_directives(parallel, private = private)
+  if (!is.null(parallel)) {
+    mark_openmp_used(scope)
+  }
+  error_check_after <- if (!is.null(parallel)) {
+    quickr_error_return_if_set(
+      scope,
+      openmp_depth = scope_openmp_depth(scope) - 1L
+    )
+  } else {
+    ""
+  }
+  list(
+    body = body,
+    directives = directives,
+    error_check_after = error_check_after
+  )
+}
+
 r2f_handlers[["for"]] <- function(args, scope, ..., hoist = NULL) {
   .[var, iterable, body] <- args
   stopifnot(is.symbol(var))
@@ -195,16 +230,17 @@ r2f_handlers[["for"]] <- function(args, scope, ..., hoist = NULL) {
       }
     }
 
-    if (!is.null(parallel)) {
-      previous_openmp <- enter_openmp_scope(scope)
-      on.exit(exit_openmp_scope(scope, previous_openmp), add = TRUE)
-    }
-    # The body is a distinct execution region and needs its own hoist target.
-    # Otherwise a single-expression body reuses the enclosing statement's
-    # target and emits loop-dependent setup before the loop.
-    body <- r2f(body, scope, ..., hoist = NULL)
-    check_pending_parallel_consumed(scope)
-    loop_stmts <- str_flatten_lines(glue("{var_name} = {element_expr}"), body)
+    compiled <- compile_for_body(
+      body,
+      scope,
+      ...,
+      parallel = parallel,
+      private = var_name
+    )
+    loop_stmts <- str_flatten_lines(
+      glue("{var_name} = {element_expr}"),
+      compiled$body
+    )
 
     loop_header <- if (iterable_reversed) {
       glue("do {idx@name} = {end}, 1_c_int, -1_c_int")
@@ -212,25 +248,13 @@ r2f_handlers[["for"]] <- function(args, scope, ..., hoist = NULL) {
       glue("do {idx@name} = 1_c_int, {end}")
     }
 
-    directives <- openmp_directives(parallel, private = var_name)
-    if (!is.null(parallel)) {
-      mark_openmp_used(scope)
-    }
-    error_check_after <- if (!is.null(parallel)) {
-      quickr_error_return_if_set(
-        scope,
-        openmp_depth = scope_openmp_depth(scope) - 1L
-      )
-    } else {
-      ""
-    }
     return(Fortran(glue(
       "
       {iterable_tmp_assign}
-      {str_flatten_lines(directives$prefix, loop_header)}
+      {str_flatten_lines(compiled$directives$prefix, loop_header)}
       {indent(loop_stmts)}
       end do
-      {str_flatten_lines(directives$suffix, error_check_after)}
+      {str_flatten_lines(compiled$directives$suffix, compiled$error_check_after)}
       "
     )))
   }
@@ -243,33 +267,14 @@ r2f_handlers[["for"]] <- function(args, scope, ..., hoist = NULL) {
   scope[[var]] <- loop_var
 
   iterable <- r2f_for_iterable(iterable, scope, ..., hoist = hoist)
-  if (!is.null(parallel)) {
-    previous_openmp <- enter_openmp_scope(scope)
-    on.exit(exit_openmp_scope(scope, previous_openmp), add = TRUE)
-  }
-  # See the value-iteration path above: body-local setup must run inside the
-  # loop even when the R body is not wrapped in braces.
-  body <- r2f(body, scope, ..., hoist = NULL)
-  check_pending_parallel_consumed(scope)
+  compiled <- compile_for_body(body, scope, ..., parallel = parallel)
 
-  directives <- openmp_directives(parallel)
-  if (!is.null(parallel)) {
-    mark_openmp_used(scope)
-  }
-  error_check_after <- if (!is.null(parallel)) {
-    quickr_error_return_if_set(
-      scope,
-      openmp_depth = scope_openmp_depth(scope) - 1L
-    )
-  } else {
-    ""
-  }
   loop_header <- glue("do {var_name} = {iterable}")
   Fortran(glue(
-    "{str_flatten_lines(directives$prefix, loop_header)}
-    {indent(body)}
+    "{str_flatten_lines(compiled$directives$prefix, loop_header)}
+    {indent(compiled$body)}
     end do
-    {str_flatten_lines(directives$suffix, error_check_after)}
+    {str_flatten_lines(compiled$directives$suffix, compiled$error_check_after)}
     "
   ))
 }
diff --git a/R/r2f-reductions.R b/R/r2f-reductions.R
index 8cc2c74d..867d407a 100644
--- a/R/r2f-reductions.R
+++ b/R/r2f-reductions.R
@@ -4,6 +4,23 @@
 # - logical: any, all
 # - index: which.max, which.min
 
+# --- Helpers ---
+
+# A c(TRUE)-style literal lowers to a rank-1 Fortran array constructor
+# ("[ ... ]") even when its value passes as a scalar; any()/all() must
+# wrap such values to reduce them back to a scalar expression.
+# Used by: any/all handler
+renders_as_array_ctor <- function(f) {
+  startsWith(trimws(as.character(f)), "[")
+}
+
+# TRUE for values declared length-1 (rank-1, dims list(1L)): scalar in
+# the ABI, but not a Fortran scalar expression.
+# Used by: any/all handler
+is_declared_len1 <- function(f) {
+  !is.null(f@value) && identical(f@value@dims, list(1L))
+}
+
 # --- Handlers ---
 
 register_r2f_handler(
@@ -23,8 +40,9 @@ register_r2f_handler(
       )
     }
 
+    call_name <- last(list(...)$calls)
     intrinsic <- switch(
-      last(list(...)$calls),
+      call_name,
       max = "maxval",
       min = "minval",
       sum = "sum",
@@ -52,11 +70,7 @@ register_r2f_handler(
       }
       # R's numeric reductions treat logicals as integers (sum(TRUE) is 1L),
       # and Fortran's sum/product/minval/maxval reject logical arrays.
-      x <- cast_to_mode(
-        x,
-        arith_join_mode(x),
-        sprintf("%s()", last(dots$calls))
-      )
+      x <- cast_to_mode(x, arith_join_mode(x), sprintf("%s()", call_name))
       if (x@value@is_scalar) {
         return(x)
       }
@@ -80,10 +94,14 @@ register_r2f_handler(
       # don't strictly need it, but one code path beats two. Logical
       # operands join as integer (R: max(TRUE, FALSE) is 1L).
       mode <- arith_join_mode(args)
-      context <- sprintf("%s()", last(list(...)$calls))
-      args <- lapply(args, cast_to_mode, mode = mode, context = context)
+      args <- lapply(
+        args,
+        cast_to_mode,
+        mode = mode,
+        context = sprintf("%s()", call_name)
+      )
       s <- switch(
-        last(list(...)$calls),
+        call_name,
         max = glue("max({str_flatten_commas(args)})"),
         min = glue("min({str_flatten_commas(args)})"),
         sum = glue("({str_flatten(args, ' + ')})"),
@@ -146,8 +164,7 @@ register_r2f_handler(
         if (is.null(hoisted_mask)) {
           # `c(FALSE)` lowers to a 1-element Fortran array constructor
           # (`[.false.]`) but any()/all() must still return scalars.
-          x_code <- trimws(as.character(x))
-          if (startsWith(x_code, "[")) {
+          if (renders_as_array_ctor(x)) {
             return(Fortran(glue("{intrinsic}({x})"), Variable("logical")))
           }
           return(x)
@@ -161,16 +178,12 @@ register_r2f_handler(
         #
         # Conversely, literal masks like `c(FALSE)` compile to array constructors
         # (e.g. `[ .false. ]`) and must be reduced to a scalar condition.
-        mask_code <- trimws(as.character(hoisted_mask))
-        is_array_ctor <- startsWith(mask_code, "[")
         mask_is_scalar <-
           !is.null(hoisted_mask@value) &&
           passes_as_scalar(hoisted_mask@value) &&
-          !is_array_ctor
+          !renders_as_array_ctor(hoisted_mask)
 
-        mask_len1 <-
-          !is.null(hoisted_mask@value) &&
-          identical(hoisted_mask@value@dims, list(1L))
+        mask_len1 <- is_declared_len1(hoisted_mask)
 
         if (!mask_is_scalar && !mask_len1) {
           stop(
@@ -190,8 +203,7 @@ register_r2f_handler(
         # - any(logical(0)) == FALSE
         # - all(logical(0)) == TRUE
         identity <- if (identical(call_name, "any")) ".false." else ".true."
-        x_code <- trimws(as.character(x))
-        x_scalar <- if (startsWith(x_code, "[")) {
+        x_scalar <- if (renders_as_array_ctor(x)) {
           glue("{intrinsic}({x})")
         } else {
           glue("{x}")
@@ -213,12 +225,8 @@ register_r2f_handler(
         # Note: A length-1 mask constructor like `c(TRUE)` compiles to a rank-1
         # array constructor (`[ .true. ]`). In R, this is recycled as a scalar
         # mask, so we must scalarize it to keep elementwise ops conformable.
-        mask_code <- trimws(as.character(hoisted_mask))
-        mask_is_array_ctor <- startsWith(mask_code, "[")
         mask_ctor_len1 <-
-          mask_is_array_ctor &&
-          !is.null(hoisted_mask@value) &&
-          identical(hoisted_mask@value@dims, list(1L))
+          renders_as_array_ctor(hoisted_mask) && is_declared_len1(hoisted_mask)
         mask_expr <- if (mask_ctor_len1) {
           glue("any({hoisted_mask})")
         } else {
@@ -248,6 +256,7 @@ register_r2f_handler(
 r2f_handlers[["which.max"]] <- r2f_handlers[["which.min"]] <-
   function(args, scope = NULL, ...) {
     stopifnot(length(args) == 1)
+    call_name <- last(list(...)$calls)
     x <- r2f(args[[1L]], scope, ...)
     stopifnot(
       "Values passed to which.max()/which.min() must be 1d arrays" = x@value@rank ==
@@ -273,8 +282,6 @@ r2f_handlers[["which.max"]] <- r2f_handlers[["which.min"]] <-
       #   while retaining early-exit.
       # Results are compiler/runtime dependent; the relative pattern was stable.
       #
-      call_name <- last(list(...)$calls)
-
       has_var_name <- inherits(x@value, Variable) && !is.null(x@value@name)
       use_lgl_storage <- has_var_name && !logical_as_int(x@value)
       int_backed_expr <-
@@ -302,7 +309,7 @@ r2f_handlers[["which.max"]] <- r2f_handlers[["which.min"]] <-
       f <- glue("max(1_c_int, {loc})")
     } else {
       intrinsic <- switch(
-        last(list(...)$calls),
+        call_name,
         which.max = "maxloc",
         which.min = "minloc"
       )
diff --git a/R/r2f-rev.R b/R/r2f-rev.R
index f1806ce5..e69a8ef2 100644
--- a/R/r2f-rev.R
+++ b/R/r2f-rev.R
@@ -30,13 +30,13 @@ r2f_handlers[["rev"]] <- function(args, scope, ..., hoist = NULL) {
 
   # Fortran array sections require an array designator; hoist array expressions.
   if (is.null(x@value@name)) {
-    tmp <- hoist$declare_tmp(
+    x <- materialize_via_hoist(
+      x,
       mode = x@value@mode,
       dims = x@value@dims,
+      hoist = hoist,
       logical_as_int = logical_as_int(x@value)
     )
-    hoist$emit(glue("{tmp@name} = {x}"))
-    x <- Fortran(tmp@name, tmp)
   }
 
   base_name <- x@value@name %||%
diff --git a/R/r2f-subscript.R b/R/r2f-subscript.R
index 6cd98f62..5a04f45b 100644
--- a/R/r2f-subscript.R
+++ b/R/r2f-subscript.R
@@ -123,9 +123,12 @@ r2f_handlers[["["]] <- function(
   ) {
     # Hoist array expressions before subscripting (no invalid (expr)(i)).
     if (!passes_as_scalar(var@value) && is.null(var@value@name)) {
-      tmp <- hoist$declare_tmp(mode = var@value@mode, dims = var@value@dims)
-      hoist$emit(glue("{tmp@name} = {var}"))
-      var <- Fortran(tmp@name, tmp)
+      var <- materialize_via_hoist(
+        var,
+        mode = var@value@mode,
+        dims = var@value@dims,
+        hoist = hoist
+      )
     }
 
     base_name <- var@value@name %||% stop("missing array name for subscripting")
@@ -231,9 +234,12 @@ r2f_handlers[["["]] <- function(
     !passes_as_scalar(var@value) &&
       is.null(var@value@name)
   ) {
-    tmp <- hoist$declare_tmp(mode = var@value@mode, dims = var@value@dims)
-    hoist$emit(glue("{tmp@name} = {var}"))
-    var <- Fortran(tmp@name, tmp)
+    var <- materialize_via_hoist(
+      var,
+      mode = var@value@mode,
+      dims = var@value@dims,
+      hoist = hoist
+    )
   }
 
   # External logicals are passed as integer storage (0/1) and are "booleanized"

From e939141d595c0a91296dff0519ca2f6e45d5c49d Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 22:33:22 +0200
Subject: [PATCH 24/97] Drop an inherited hoist_mask in any()/all() like the
 numeric reductions

max/min/sum/prod rebuild their r2f() call from dots$calls/dots$hoist so
an enclosing reduction's hoist_mask is not forwarded alongside their
own; any()/all() splatted `...`, so a nested masked any()/all() handed
the `[` handler two hoist_mask arguments and died with R's "matched by
multiple actual arguments". Both handlers now share
reduce_arg_with_mask(), which installs exactly one mask hoister per
reduction context (and spells the conflict error once).
---
 R/r2f-reductions-helpers.R       | 25 +++++++++++++++++++++++++
 R/r2f-reductions.R               | 26 ++------------------------
 tests/testthat/test-hoist-mask.R | 23 +++++++++++++++++++++++
 3 files changed, 50 insertions(+), 24 deletions(-)

diff --git a/R/r2f-reductions-helpers.R b/R/r2f-reductions-helpers.R
index e0d602fe..e6565b54 100644
--- a/R/r2f-reductions-helpers.R
+++ b/R/r2f-reductions-helpers.R
@@ -30,6 +30,31 @@ create_mask_hoist <- function() {
   environment()
 }
 
+# Lower one reduction argument under a fresh mask hoister. Nested
+# reductions (e.g. sum(x * as.double(any(x[m] > 1)))) can thread an
+# existing hoist_mask through `...`; each reduction context installs
+# exactly one mask hoister, so the inherited one is dropped rather than
+# forwarded -- forwarding both would hand the `[` handler two hoist_mask
+# arguments. A conflicting second mask within the same context is a
+# clean compile error.
+# Used by: r2f-reductions.R (max/min/sum/prod and any/all)
+reduce_arg_with_mask <- function(arg, scope, mask_hoist, dots) {
+  x <- r2f(
+    arg,
+    scope,
+    calls = dots$calls,
+    hoist = dots$hoist,
+    hoist_mask = mask_hoist$try_set
+  )
+  if (mask_hoist$has_conflict()) {
+    stop(
+      "reduction expressions only support a single logical mask",
+      call. = FALSE
+    )
+  }
+  x
+}
+
 # Convert a linear 1D index to multi-dimensional subscripts.
 # Used by: r2f-reductions.R, r2f-subscript.R, r2f-control-flow.R
 linear_subscripts_from_1d <- function(base_name, rank, idx) {
diff --git a/R/r2f-reductions.R b/R/r2f-reductions.R
index 867d407a..f477b774 100644
--- a/R/r2f-reductions.R
+++ b/R/r2f-reductions.R
@@ -51,23 +51,7 @@ register_r2f_handler(
 
     reduce_arg <- function(arg) {
       mask_hoist <- create_mask_hoist()
-      # Nested reductions (e.g., min(max(...), ...)) can thread an existing
-      # hoist_mask through `...`. We always want a single mask hoister per
-      # reduction context, so we ignore any inherited one and install ours.
-      dots <- list(...)
-      x <- r2f(
-        arg,
-        scope,
-        calls = dots$calls,
-        hoist = dots$hoist,
-        hoist_mask = mask_hoist$try_set
-      )
-      if (mask_hoist$has_conflict()) {
-        stop(
-          "reduction expressions only support a single logical mask",
-          call. = FALSE
-        )
-      }
+      x <- reduce_arg_with_mask(arg, scope, mask_hoist, list(...))
       # R's numeric reductions treat logicals as integers (sum(TRUE) is 1L),
       # and Fortran's sum/product/minval/maxval reject logical arrays.
       x <- cast_to_mode(x, arith_join_mode(x), sprintf("%s()", call_name))
@@ -145,13 +129,7 @@ register_r2f_handler(
 
     reduce_arg <- function(arg) {
       mask_hoist <- create_mask_hoist()
-      x <- r2f(arg, scope, ..., hoist_mask = mask_hoist$try_set)
-      if (mask_hoist$has_conflict()) {
-        stop(
-          "reduction expressions only support a single logical mask",
-          call. = FALSE
-        )
-      }
+      x <- reduce_arg_with_mask(arg, scope, mask_hoist, list(...))
 
       if (!identical(x@value@mode, "logical")) {
         stop("any()/all() only implemented for logical", call. = FALSE)
diff --git a/tests/testthat/test-hoist-mask.R b/tests/testthat/test-hoist-mask.R
index b4c7ed70..fe4b103b 100644
--- a/tests/testthat/test-hoist-mask.R
+++ b/tests/testthat/test-hoist-mask.R
@@ -50,3 +50,26 @@ test_that("hoist mask", {
   expect_equal(qfn(x), fn(x))
   # bench::mark(qfn(x), fn(x), relative = T)
 })
+
+test_that("any()/all() drop an inherited hoist_mask from an enclosing reduction", {
+  # An enclosing numeric reduction threads its own hoist_mask through
+  # `...`; any()/all() must install a fresh mask hoister for their own
+  # argument instead of forwarding both (which handed the `[` handler
+  # two hoist_mask arguments).
+  fn <- function(x, m) {
+    declare(type(x = double(n)), type(m = logical(n)))
+    out <- sum(x * as.double(any(x[m] > 1)))
+    out
+  }
+  x <- c(0.5, 2, 3)
+  expect_quick_identical(fn, list(x, c(TRUE, FALSE, TRUE)))
+  expect_quick_identical(fn, list(x, c(TRUE, FALSE, FALSE)))
+
+  fn_all <- function(x, m) {
+    declare(type(x = double(n)), type(m = logical(n)))
+    out <- sum(x * as.double(all(x[m] > 1)))
+    out
+  }
+  expect_quick_identical(fn_all, list(x, c(FALSE, TRUE, TRUE)))
+  expect_quick_identical(fn_all, list(x, c(TRUE, FALSE, TRUE)))
+})

From 02f63d87f04d55785c3be6590ed0cf61d07b8921 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 22:34:44 +0200
Subject: [PATCH 25/97] Fix check_type_call()'s inverted mode check

The check stopped with "only atomic modes are supported" precisely when
the declared mode *was* an atomic name spelled without dims
(type(x = double)), while a non-atomic mode sailed past and died later
on an internal subscript (symbol modes) or an S7 property dump (call
modes). The mode name (call head or bare symbol) is now required to be
atomic, with the offending name in the message; a bare atomic symbol
gets a form error showing the required type(x = double(<dims>)) call.
---
 R/sizes.R                    | 18 ++++++++++++++++--
 tests/testthat/test-errors.R | 29 ++++++++++++++++++++++++++---
 2 files changed, 42 insertions(+), 5 deletions(-)

diff --git a/R/sizes.R b/R/sizes.R
index 68b75497..2335e736 100644
--- a/R/sizes.R
+++ b/R/sizes.R
@@ -6,8 +6,22 @@ check_type_call <- function(cl) {
   if (length(names(args)) != 1) {
     stop("name must be provided as: type(<name> = <mode>(<<dims>>)")
   }
-  if (!is.call(args[[1]]) && as.character(args[[1]]) %in% .atomic_type_names) {
-    stop("only atomic modes are supported")
+  mode_expr <- args[[1]]
+  mode_sym <- if (is.call(mode_expr)) mode_expr[[1L]] else mode_expr
+  if (
+    !is.symbol(mode_sym) ||
+      !as.character(mode_sym) %in% .atomic_type_names
+  ) {
+    stop("only atomic modes are supported, not: ", deparse1(mode_sym))
+  }
+  if (!is.call(mode_expr)) {
+    stop(
+      "the mode must be a call with dimensions, as in: type(",
+      names(args),
+      " = ",
+      as.character(mode_sym),
+      "(<dims>))"
+    )
   }
 }
 
diff --git a/tests/testthat/test-errors.R b/tests/testthat/test-errors.R
index fda1e248..49174738 100644
--- a/tests/testthat/test-errors.R
+++ b/tests/testthat/test-errors.R
@@ -159,13 +159,36 @@ test_that("declare() type() calls validate syntax", {
     fixed = TRUE
   )
 
-  bad_mode <- function(x) {
+  # A bare atomic mode symbol is a form error (dims are missing), not a
+  # mode error; the old check fired "only atomic modes are supported"
+  # precisely when the mode *was* atomic.
+  missing_dims <- function(x) {
     declare(type(x = double))
     x
   }
   expect_error(
-    quick(bad_mode),
-    "only atomic modes are supported",
+    quick(missing_dims),
+    "the mode must be a call with dimensions, as in: type(x = double(<dims>))",
+    fixed = TRUE
+  )
+
+  bad_mode_call <- function(x) {
+    declare(type(x = foo(1)))
+    x
+  }
+  expect_error(
+    quick(bad_mode_call),
+    "only atomic modes are supported, not: foo",
+    fixed = TRUE
+  )
+
+  bad_mode_symbol <- function(x) {
+    declare(type(x = foo))
+    x
+  }
+  expect_error(
+    quick(bad_mode_symbol),
+    "only atomic modes are supported, not: foo",
     fixed = TRUE
   )
 })

From 3ce83e0795cdddd689f854861a0b523349647631 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 22:37:02 +0200
Subject: [PATCH 26/97] Delete the dead set_once/allow_na property plumbing in
 classes.R

No package property ever enabled these knobs, and the plumbing was
inconsistent where it looked available: new_setter() silently dropped
set_once whenever coerce was NULL (the prop_bool path),
prop_string()/prop_wholenumber() accepted allow_na but never passed it
to their validators, and new_scalar_validator() declared an env
parameter its body ignored. Rather than fix machinery nothing uses,
delete it: setters exist only to coerce, scalar validators always
refuse NA, and the stale `set_once = FALSE #TRUE` comment on
Variable@name goes with it. The unit tests that existed to exercise
the knobs are updated to the surviving surface.
---
 R/classes.R                   | 66 ++++++++++-------------------------
 tests/testthat/test-classes.R | 12 +++----
 2 files changed, 23 insertions(+), 55 deletions(-)

diff --git a/R/classes.R b/R/classes.R
index 7e414e2b..4e0baf75 100644
--- a/R/classes.R
+++ b/R/classes.R
@@ -4,10 +4,9 @@ NULL
 new_setter <- function(
   coerce = NULL,
   coerce_null = FALSE,
-  set_once = FALSE,
   env = parent.frame(2L)
 ) {
-  if (is.null(coerce) || isFALSE(coerce) && isFALSE(set_once)) {
+  if (is.null(coerce) || isFALSE(coerce)) {
     return()
   }
 
@@ -15,18 +14,8 @@ new_setter <- function(
     name <- as.character(last(attr(self, ".setting_prop", TRUE)))
   )
 
-  check_set_once <- if (set_once) {
-    quote(
-      if (!is.null(prop(self, name))) {
-        stop(name, " can only be set once")
-      }
-    )
-  }
-
   rebind_coerced_value <-
-    if (is.null(coerce) || isFALSE(coerce)) {
-      NULL
-    } else if (isTRUE(coerce)) {
+    if (isTRUE(coerce)) {
       quote(
         value <- convert(
           from = value,
@@ -57,7 +46,6 @@ new_setter <- function(
     body = as.call(c(
       quote(`{`),
       bind_name,
-      check_set_once,
       rebind_coerced_value,
       set
     )),
@@ -68,14 +56,12 @@ new_setter <- function(
 
 new_scalar_validator <- function(
   allow_null = FALSE,
-  allow_na = FALSE,
-  additional_checks = NULL,
-  env = parent.frame(2L)
+  additional_checks = NULL
 ) {
   checks <- c(
     if (allow_null) quote(if (is.null(value)) return()),
     quote(if (length(value) != 1L) return("must be a scalar")),
-    if (!allow_na) quote(if (anyNA(value)) return("must not be NA")),
+    quote(if (anyNA(value)) return("must not be NA")),
     additional_checks
   )
 
@@ -89,19 +75,13 @@ new_scalar_validator <- function(
 
 prop_bool <- function(
   default,
-  allow_null = FALSE,
-  allow_na = FALSE,
-  set_once = FALSE
+  allow_null = FALSE
 ) {
-  stopifnot(is_bool(set_once), is_bool(allow_null), is_bool(allow_na))
+  stopifnot(is_bool(allow_null))
 
   new_property(
     class = if (allow_null) NULL | class_logical else class_logical,
-    setter = new_setter(set_once = set_once),
-    validator = new_scalar_validator(
-      allow_null = allow_null,
-      allow_na = allow_na
-    ),
+    validator = new_scalar_validator(allow_null = allow_null),
     default = default
   )
 }
@@ -110,11 +90,9 @@ prop_bool <- function(
 prop_string <- function(
   default = NULL,
   allow_null = FALSE,
-  allow_na = FALSE,
-  coerce = FALSE,
-  set_once = FALSE
+  coerce = FALSE
 ) {
-  stopifnot(is_bool(set_once), is_bool(allow_null), is_bool(allow_na))
+  stopifnot(is_bool(allow_null))
 
   if (isTRUE(coerce)) {
     coerce <- quote(as.character)
@@ -126,8 +104,7 @@ prop_string <- function(
     validator = new_scalar_validator(allow_null = allow_null),
     setter = new_setter(
       coerce = coerce,
-      coerce_null = !allow_null,
-      set_once = set_once
+      coerce_null = !allow_null
     )
   )
 }
@@ -136,11 +113,9 @@ prop_string <- function(
 prop_wholenumber <- function(
   default = NULL,
   allow_null = FALSE,
-  allow_na = FALSE,
-  coerce = TRUE,
-  set_once = FALSE
+  coerce = TRUE
 ) {
-  stopifnot(is_bool(set_once), is_bool(allow_null), is_bool(allow_na))
+  stopifnot(is_bool(allow_null))
 
   if (isTRUE(coerce)) {
     coerce <- quote(
@@ -157,8 +132,7 @@ prop_wholenumber <- function(
     default = as.integer(default),
     setter = new_setter(
       coerce = coerce,
-      coerce_null = !allow_null,
-      set_once = set_once
+      coerce_null = !allow_null
     ),
     validator = new_scalar_validator(allow_null = allow_null)
   )
@@ -169,8 +143,7 @@ prop_enum <- function(
   values,
   nullable = FALSE,
   default = if (nullable) NULL else values[1],
-  exact = FALSE,
-  set_once = FALSE
+  exact = FALSE
 ) {
   stopifnot(
     "values must be a character vector of length >= 2 without any NA" = is.character(
@@ -211,8 +184,7 @@ prop_enum <- function(
     class = if (nullable) NULL | class_character else class_character,
     setter = new_setter(
       coerce = coerce,
-      coerce_null = !nullable,
-      set_once = set_once
+      coerce_null = !nullable
     ),
     validator = validator,
     default = default
@@ -233,7 +205,7 @@ prop_enum <- function(
 # the print method for this should only print non-null values
 Variable := new_class(
   properties = list(
-    mode = prop_enum(.atomic_type_names, nullable = TRUE, set_once = FALSE),
+    mode = prop_enum(.atomic_type_names, nullable = TRUE),
 
     dims = new_property(
       # NULL means scalar
@@ -282,8 +254,7 @@ Variable := new_class(
         typeof(value),
         symbol = as.character(value),
         value
-      )),
-      set_once = FALSE #TRUE
+      ))
     ),
 
     r_name = prop_string(
@@ -292,8 +263,7 @@ Variable := new_class(
         typeof(value),
         symbol = as.character(value),
         value
-      )),
-      set_once = FALSE
+      ))
     ),
 
     rank = new_property(
diff --git a/tests/testthat/test-classes.R b/tests/testthat/test-classes.R
index b2ab3f58..b038fb17 100644
--- a/tests/testthat/test-classes.R
+++ b/tests/testthat/test-classes.R
@@ -2,15 +2,14 @@
 
 skip_on_cran()
 
-test_that("prop helpers implement coercion, validation and set-once behavior", {
+test_that("prop helpers implement coercion and validation", {
   Test <- S7::new_class(
     name = "Test",
     properties = list(
       s = quickr:::prop_string(
         default = NULL,
         allow_null = TRUE,
-        coerce = TRUE,
-        set_once = TRUE
+        coerce = TRUE
       ),
       n = quickr:::prop_wholenumber(
         default = 1,
@@ -29,7 +28,6 @@ test_that("prop helpers implement coercion, validation and set-once behavior", {
 
   obj@s <- 123
   expect_identical(obj@s, "123")
-  expect_error(obj@s <- "again", "can only be set once")
 
   obj@n <- 2
   expect_identical(obj@n, 2L)
@@ -77,13 +75,13 @@ test_that("Fortran validates length and prints non-null properties", {
   expect_true(any(grepl("@r:", out, fixed = TRUE)))
 })
 
-test_that("new_setter returns NULL when no coercion or set_once", {
-  result <- quickr:::new_setter(coerce = FALSE, set_once = FALSE)
+test_that("new_setter returns NULL when no coercion", {
+  result <- quickr:::new_setter(coerce = FALSE)
   expect_null(result)
 })
 
 test_that("new_setter handles coerce = NULL correctly", {
-  result <- quickr:::new_setter(coerce = NULL, set_once = FALSE)
+  result <- quickr:::new_setter(coerce = NULL)
   expect_null(result)
 })
 

From 8e5d635eb8e7bdc3978a1a667b4187a8ac38d761 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 22:39:14 +0200
Subject: [PATCH 27/97] Fold literal dims in the qr work-size and tidy the
 length-1 spellings

lapack_solve_qr() built call("min", m, n) even for literal dims where
diag_length_expr() and svd_dims() fold to the literal; it now uses
diag_length_expr(), which also turns an unknowable (NA) dimension into
a clean "requires known dimensions" error instead of deparsing min(NA,
n) into the Fortran. symmetrize_upper_to_lower()'s loop-index temps
drop their dims = list(1L) spelling for the same dims = NULL scalars
zero_lower_triangle() uses (list(1L) already *declared* scalars, so
the emitted text is unchanged). lapack_svd()'s work-query `1 + 0` dims
turn out to be load-bearing -- list(1L) is quickr's scalar spelling
and the query must stay a subscriptable length-1 array -- so that one
is documented in place rather than "cleaned".
---
 R/r2f-matrix-blas.R | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index d1d09665..90274050 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -404,8 +404,8 @@ symmetrize_upper_to_lower <- function(target, n, hoist) {
   stopifnot(is_string(target))
   assert_hoist_env(hoist)
 
-  idx_i <- hoist$declare_tmp(mode = "integer", dims = list(1L))
-  idx_j <- hoist$declare_tmp(mode = "integer", dims = list(1L))
+  idx_i <- hoist$declare_tmp(mode = "integer", dims = NULL)
+  idx_j <- hoist$declare_tmp(mode = "integer", dims = NULL)
   n_int <- blas_int(n)
   hoist$emit(glue(
     "
@@ -799,7 +799,7 @@ end do"
   ))
 
   tol_value <- if (is.null(tol)) "1e-7_c_double" else as.character(tol)
-  mn <- call("min", m, n)
+  mn <- diag_length_expr(m, n, context)
   hoist$emit(glue(
     "call dqrdc2({A_work@name}, {blas_int(m)}, {blas_int(m)}, {blas_int(n)}, {tol_value}, {rank@name}, {qraux@name}, {jpvt@name}, {work@name})"
   ))
@@ -1138,6 +1138,9 @@ lapack_svd <- function(
 
   info <- hoist$declare_tmp(mode = "integer", dims = NULL)
   lwork <- hoist$declare_tmp(mode = "integer", dims = NULL)
+  # dims list(1L) is quickr's *scalar* spelling (see Variable@is_scalar),
+  # but the work query must be a length-1 array so `work_query(1)` is
+  # subscriptable; the unfoldable `1 + 0` keeps the array declaration.
   work_query <- hoist$declare_tmp(
     mode = "double",
     dims = list(call("+", 1L, 0L))

From d2ea324b188f3931c113617aaa3b80c30e52c373 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 22:41:24 +0200
Subject: [PATCH 28/97] Share the %*% shape computation between the handler and
 dest inference

The effective-shape dance (vector orientation, transpose swap, result
extents) was spelled twice -- in the %*% handler and in
infer_dest_matmul() -- the same handler/inference drift hazard
diag_call_args() closed for diag(). matmul_shapes() now computes
left_eff/right_eff/out_dims once; the result is left_eff$rows x
right_eff$cols in every case (the gemv branches' literal 1 extents
come from the vector orientations), so the inference's three-branch
tail collapses to one line and the handler's per-branch out_len
respellings go away. Guard axes and the raw-dims BLAS arguments
(m/n/lda) stay at the call sites. Emitted code unchanged.
---
 R/r2f-matrix-blas.R  | 33 +++++++++++++++++++++++++++++++++
 R/r2f-matrix-infer.R | 31 +++++++++----------------------
 R/r2f-matrix.R       | 32 ++++++++++++++------------------
 3 files changed, 56 insertions(+), 40 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 90274050..4ca9eb20 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -139,6 +139,39 @@ effective_dims <- function(dims, trans) {
   }
 }
 
+# Effective operand and result shapes for %*%. `left_dims`/`right_dims`
+# come from matrix_dims*() with vectors oriented as a row (left) or
+# column (right) vector; transposes apply to matrix operands only (a
+# transposed vector is already reoriented by its dims). The result is
+# left_eff$rows x right_eff$cols in every case -- the gemv cases keep
+# their literal 1 extent from the vector orientation. Shared by the
+# %*% handler and infer_dest_matmul() so lowering and dest inference
+# cannot drift.
+matmul_shapes <- function(
+  left_rank,
+  left_dims,
+  left_trans,
+  right_rank,
+  right_dims,
+  right_trans
+) {
+  left_eff <- if (left_rank == 2L) {
+    effective_dims(left_dims, left_trans)
+  } else {
+    left_dims
+  }
+  right_eff <- if (right_rank == 2L) {
+    effective_dims(right_dims, right_trans)
+  } else {
+    right_dims
+  }
+  list(
+    left_eff = left_eff,
+    right_eff = right_eff,
+    out_dims = list(left_eff$rows, right_eff$cols)
+  )
+}
+
 # Enforce that `dims` describe a square matrix: a known mismatch is a
 # compile error; unverifiable dims get a runtime guard on the operand's
 # actual extents.
diff --git a/R/r2f-matrix-infer.R b/R/r2f-matrix-infer.R
index d112ae7d..8bc4082a 100644
--- a/R/r2f-matrix-infer.R
+++ b/R/r2f-matrix-infer.R
@@ -72,28 +72,15 @@ infer_dest_matmul <- function(args, scope) {
     orientation = if (right_rank == 1L) "colvec" else "matrix"
   )
 
-  left_eff <- if (left_rank == 2L) {
-    effective_dims(left_dims, left_trans)
-  } else {
-    left_dims
-  }
-  right_eff <- if (right_rank == 2L) {
-    effective_dims(right_dims, right_trans)
-  } else {
-    right_dims
-  }
-
-  if (left_rank == 2L && right_rank == 1L) {
-    out_len <- if (left_trans == "N") left_dims$rows else left_dims$cols
-    return(Variable("double", list(out_len, 1L)))
-  }
-  if (left_rank == 1L && right_rank == 2L) {
-    transA <- if (right_trans == "N") "T" else "N"
-    out_len <- if (transA == "N") right_dims$rows else right_dims$cols
-    return(Variable("double", list(1L, out_len)))
-  }
-
-  Variable("double", list(left_eff$rows, right_eff$cols))
+  shapes <- matmul_shapes(
+    left_rank,
+    left_dims,
+    left_trans,
+    right_rank,
+    right_dims,
+    right_trans
+  )
+  Variable("double", shapes$out_dims)
 }
 
 # Shared inference for crossprod/tcrossprod destination sizes.
diff --git a/R/r2f-matrix.R b/R/r2f-matrix.R
index 16c0d3ed..786a895b 100644
--- a/R/r2f-matrix.R
+++ b/R/r2f-matrix.R
@@ -29,16 +29,16 @@ register_r2f_handler(
       orientation = if (right_rank == 1) "colvec" else "matrix"
     )
 
-    left_eff <- if (left_rank == 2) {
-      effective_dims(left_dims, left_trans)
-    } else {
-      left_dims
-    }
-    right_eff <- if (right_rank == 2) {
-      effective_dims(right_dims, right_trans)
-    } else {
-      right_dims
-    }
+    shapes <- matmul_shapes(
+      left_rank,
+      left_dims,
+      left_trans,
+      right_rank,
+      right_dims,
+      right_trans
+    )
+    left_eff <- shapes$left_eff
+    right_eff <- shapes$right_eff
 
     # Compute effective shapes
     m <- left_eff$rows
@@ -52,9 +52,8 @@ register_r2f_handler(
 
     # Matrix-Vector: use GEMV
     if (left_rank == 2 && right_rank == 1) {
-      expected_len <- if (left_trans == "N") left_dims$cols else left_dims$rows
       guard_conformable_dims(
-        expected_len,
+        left_eff$cols,
         right_dims$rows,
         "non-conformable arguments in %*%",
         hoist,
@@ -63,7 +62,6 @@ register_r2f_handler(
         right = right,
         left_axis = if (left_trans == "N") 2L else 1L
       )
-      out_len <- if (left_trans == "N") left_dims$rows else left_dims$cols
       return(gemv(
         transA = left_trans,
         A = left,
@@ -71,7 +69,7 @@ register_r2f_handler(
         m = left_dims$rows,
         n = left_dims$cols,
         lda = left_dims$rows,
-        out_dims = list(out_len, 1L),
+        out_dims = shapes$out_dims,
         scope = scope,
         hoist = hoist,
         dest = dest,
@@ -81,10 +79,9 @@ register_r2f_handler(
     # Vector-Matrix: use GEMV with transpose
     if (left_rank == 1 && right_rank == 2) {
       transA <- if (right_trans == "N") "T" else "N"
-      expected_len <- if (transA == "N") right_dims$cols else right_dims$rows
       guard_conformable_dims(
         left_dims$cols,
-        expected_len,
+        right_eff$rows,
         "non-conformable arguments in %*%",
         hoist,
         scope,
@@ -92,7 +89,6 @@ register_r2f_handler(
         right = right,
         right_axis = if (transA == "N") 2L else 1L
       )
-      out_len <- if (transA == "N") right_dims$rows else right_dims$cols
       return(gemv(
         transA = transA,
         A = right,
@@ -100,7 +96,7 @@ register_r2f_handler(
         m = right_dims$rows,
         n = right_dims$cols,
         lda = right_dims$rows,
-        out_dims = list(1L, out_len),
+        out_dims = shapes$out_dims,
         scope = scope,
         hoist = hoist,
         dest = dest,

From 7c9a03abd82ce8997f43fc68d1eb72092ad14fc0 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 22:50:30 +0200
Subject: [PATCH 29/97] Normalize matrix()'s argument policy in one place

The elementwise scalar-fill fast path (matrix_scalar_fill_args()) and
the matrix() handler each carried their own syntactic matcher for the
matrix() call family -- the drift risk grows with every vectorization
context that learns about matrix(). matrix_call_args() now validates
data/nrow/ncol/byrow/dimnames once; the handler consumes it directly
and the fast path applies its narrower scalar-data policy on top,
falling back to the handler for the real diagnostics. One behavior
change surfaced by the merge: matrix(dimnames=) was silently dropped
(R keeps the names) and is now refused, matching array()'s policy.
---
 R/r2f-aab-core.R             |  2 +-
 R/r2f-constructors.R         | 34 +++++++++++++++++++++++++++-------
 R/r2f-operators-helpers.R    | 23 +++++++++++++----------
 tests/testthat/test-matrix.R | 23 +++++++++++++++++++++++
 4 files changed, 64 insertions(+), 18 deletions(-)

diff --git a/R/r2f-aab-core.R b/R/r2f-aab-core.R
index 2694cf72..a897cd3e 100644
--- a/R/r2f-aab-core.R
+++ b/R/r2f-aab-core.R
@@ -126,7 +126,7 @@ hoist_unless_name <- function(x, hoist) {
 # Materialization decisions branch on it: a fill constructor or
 # matrix(scalar, ...) may stay a scalar only where the parent broadcasts,
 # spreads, or pads it.
-# Used by: r2f-constructors.R, r2f-operators.R
+# Used by: r2f-constructors.R
 parent_call_name <- function(calls) {
   if (length(calls) >= 2L) calls[[length(calls) - 1L]] else ""
 }
diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index 5b0e6cf1..b5d57e79 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -316,23 +316,43 @@ r2f_handlers[["character"]] <- r2f_handlers[["raw"]] <-
   .r2f_handler_not_implemented_yet
 
 
-r2f_handlers[["matrix"]] <- function(args, scope = NULL, ..., hoist = NULL) {
-  args$data %||% stop("matrix(data=) must be provided, cannot be NA")
+# Validate matrix()'s matched arguments once for every consumer: the
+# matrix() handler and the elementwise scalar-fill fast path
+# (match_scalar_matrix_fill() in r2f-operators-helpers.R), so the two cannot
+# drift as more vectorization contexts are added. The shared policy:
+# data is required, byrow=TRUE and dimnames are unsupported, and
+# nrow/ncol are both required. (R can infer one dimension, but quickr's
+# lowering keeps this strict to avoid surprising recycling rules.)
+# Returns list(data, nrow, ncol) or stops.
+matrix_call_args <- function(args) {
+  data <- args$data
+  if (is.null(data) || is_missing(data)) {
+    stop("matrix(data=) must be provided, cannot be NA", call. = FALSE)
+  }
   if (!is.null(args$byrow) && !is_missing(args$byrow) && !isFALSE(args$byrow)) {
     stop("matrix(byrow=TRUE) is not supported", call. = FALSE)
   }
-
-  # Require explicit dims for now. (R can infer one dimension, but quickr's
-  # lowering keeps this strict to avoid surprising recycling rules.)
+  if (
+    !is.null(args$dimnames) &&
+      !is_missing(args$dimnames) &&
+      !identical(args$dimnames, quote(NULL))
+  ) {
+    stop("matrix(dimnames=) not supported", call. = FALSE)
+  }
   if (is.null(args$nrow) || is_missing(args$nrow)) {
     stop("matrix(nrow=) must be provided", call. = FALSE)
   }
   if (is.null(args$ncol) || is_missing(args$ncol)) {
     stop("matrix(ncol=) must be provided", call. = FALSE)
   }
+  list(data = data, nrow = args$nrow, ncol = args$ncol)
+}
+
+r2f_handlers[["matrix"]] <- function(args, scope = NULL, ..., hoist = NULL) {
+  margs <- matrix_call_args(args)
 
-  src <- r2f(args$data, scope, ..., hoist = hoist)
-  dims <- r2dims(list(args$nrow, args$ncol), scope)
+  src <- r2f(margs$data, scope, ..., hoist = hoist)
+  dims <- r2dims(list(margs$nrow, margs$ncol), scope)
   out_val <- Variable(mode = src@value@mode, dims = dims)
 
   # A scalar broadcasts natively on direct whole-array assignment, so keep
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index c214fcb8..a6b8e85b 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -140,11 +140,14 @@ promote_arith_pair <- function(left, right, context = "arithmetic") {
   list(left = left, right = 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 lower_elementwise_operands() to lower the fill to a native
-# scalar broadcast instead of the O(nrow * ncol) temporary the matrix()
-# handler would otherwise materialize.
+# Match `matrix(<scalar>, nrow, ncol)`: a matrix() call
+# matrix_call_args() accepts (data/nrow/ncol present, no
+# byrow/dimnames) whose data is a length-1 literal or a declared
+# scalar. Returns the matched arguments or NULL. Used by
+# lower_elementwise_operands() to lower the fill to a native scalar
+# broadcast instead of the O(nrow * ncol) temporary the matrix()
+# handler would otherwise materialize; anything it declines falls back
+# to the matrix() handler, which raises the real diagnostics.
 match_scalar_matrix_fill <- function(e, scope) {
   if (!is.call(e) || !identical(e[[1L]], quote(matrix))) {
     return(NULL)
@@ -153,11 +156,11 @@ match_scalar_matrix_fill <- function(e, scope) {
   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))
-  ) {
+  margs <- tryCatch(
+    matrix_call_args(as.list(mc)[-1L]),
+    error = function(...) NULL
+  )
+  if (is.null(margs)) {
     return(NULL)
   }
   data <- margs$data
diff --git a/tests/testthat/test-matrix.R b/tests/testthat/test-matrix.R
index e4457626..cc22033e 100644
--- a/tests/testthat/test-matrix.R
+++ b/tests/testthat/test-matrix.R
@@ -391,3 +391,26 @@ test_that("diag() initializes integer-backed logical outputs as integers", {
   expect_translation_snapshots(fn)
   expect_quick_identical(fn, list(c(TRUE, FALSE)))
 })
+
+test_that("matrix() refuses byrow=TRUE and dimnames cleanly", {
+  fn_byrow <- function() {
+    m <- matrix(1, nrow = 2, ncol = 2, byrow = TRUE)
+    m
+  }
+  expect_error(
+    quick(fn_byrow),
+    "matrix(byrow=TRUE) is not supported",
+    fixed = TRUE
+  )
+
+  # dimnames used to be silently dropped (R keeps them); refuse like array()
+  fn_dimnames <- function() {
+    m <- matrix(1, nrow = 2, ncol = 2, dimnames = list(c("a", "b"), NULL))
+    m
+  }
+  expect_error(
+    quick(fn_dimnames),
+    "matrix(dimnames=) not supported",
+    fixed = TRUE
+  )
+})

From 0235ae75eb1d9afae7cb9d3af2f04601d75bfb75 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 23:09:27 +0200
Subject: [PATCH 30/97] Check reassignment shape compatibility axis by axis

check_assignment_compatible() accepted any same-rank reassignment, so
`x <- numeric(2); x <- numeric(3)` silently kept the old shape (R
returns length 3), a matrix fill re-shaped the same way, and
non-broadcast array RHSs fell through to the Fortran compiler. Quickr
cannot re-declare a Fortran variable to R's new shape -- this is the
shape analogue of the narrowing check -- so the conformability policy
now applies per axis: statically known mismatches (and rank changes)
are compile errors, dims that cannot be compared statically get a
statement-level runtime guard spelled from the dim expressions, and
provably equal dims need nothing.

Two deliberate exemptions keep today's R-matching behavior: scalar
RHSs broadcast natively, and deferred-shape locals (declared with NA
dims) reallocate on whole-array assignment. Guards are only emitted
when both sides are spellable: a self-size symbol (`a__len_`,
`a__dim_1_`) exists in the generated Fortran only for external
variables, and the manifest's twice-spelled test for phantom
self-sizes is now the shared has_self_size_dims(). NEWS entry added.
---
 NEWS.md                                |  10 ++
 R/manifest.R                           |  30 +-----
 R/r2f-assign.R                         |  16 ++-
 R/r2f-operators-helpers.R              | 138 ++++++++++++++++++++++---
 R/scope.R                              |   2 +-
 R/sizes.R                              |  20 ++++
 tests/testthat/test-assignment-shape.R |  87 ++++++++++++++++
 tests/testthat/test-internal-utils.R   |   2 +-
 8 files changed, 261 insertions(+), 44 deletions(-)
 create mode 100644 tests/testthat/test-assignment-shape.R

diff --git a/NEWS.md b/NEWS.md
index 7d04bfc3..d80c930c 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -6,6 +6,16 @@
 
 * Successful flang availability checks are now reused for the rest of the R
   session. Restart R after changing the flang toolchain.
+- Reassigning a variable now requires the new value's shape to be
+  compatible with the declared shape, extending the existing rank check
+  to every dimension: quickr cannot re-declare a Fortran variable the
+  way R rebinds a symbol. A statically known mismatch (e.g.
+  `x <- numeric(2); x <- numeric(3)`) is a compile-time error;
+  dimensions that cannot be compared at compile time are checked at run
+  time. Previously such reassignments silently kept the old shape or
+  produced invalid Fortran. Assigning a scalar into an array variable
+  (native Fortran broadcast) is unchanged, as are locals declared with
+  unknown (`NA`) dims, which reallocate on assignment like R.
 
 - Elementwise operations (arithmetic, comparisons, `&`, `|`) now require
   operand lengths to match, unless one operand is a scalar or a vector is
diff --git a/R/manifest.R b/R/manifest.R
index e6a4d1f3..6667b6cd 100644
--- a/R/manifest.R
+++ b/R/manifest.R
@@ -109,21 +109,7 @@ subroutine_local_allocatable <- function(
   # For declarations like `type(a = double(NA, NA))`, substitute_declared_sizes()
   # rewrites NA axes to `a__dim_*` symbols. Those sizes are not available for
   # explicit allocation, so treat these as implicitly-sized locals.
-  self_size_names <- vapply(
-    seq_along(var@dims),
-    function(i) get_size_name(var, axis = as.integer(i)),
-    character(1)
-  )
-  if (
-    any(vapply(
-      seq_along(var@dims),
-      function(i) {
-        d <- var@dims[[i]]
-        is.symbol(d) && identical(as.character(d), self_size_names[[i]])
-      },
-      logical(1)
-    ))
-  ) {
+  if (has_self_size_dims(var)) {
     return(FALSE)
   }
 
@@ -401,19 +387,7 @@ r2f.scope <- function(scope, include_errors = FALSE) {
 
     # In subroutines, locals declared with unspecified dims (NA -> `a__dim_*`)
     # are emitted as deferred-shape allocatables and rely on implicit allocation.
-    if (
-      is.null(intent) &&
-        !is.null(dims) &&
-        any(vapply(
-          seq_along(var@dims),
-          function(i) {
-            d <- var@dims[[i]]
-            is.symbol(d) &&
-              identical(as.character(d), get_size_name(var, axis = i))
-          },
-          logical(1)
-        ))
-    ) {
+    if (is.null(intent) && !is.null(dims) && has_self_size_dims(var)) {
       dims <- sprintf("(%s)", str_flatten_commas(rep(":", var@rank)))
     }
 
diff --git a/R/r2f-assign.R b/R/r2f-assign.R
index 102cce83..200a581e 100644
--- a/R/r2f-assign.R
+++ b/R/r2f-assign.R
@@ -220,7 +220,13 @@ register_r2f_handler(
         var@dims <- value@value@dims
       }
       check_reassignment_narrowing(name, var, value@value)
-      check_assignment_compatible(var, value@value)
+      check_assignment_compatible(
+        name,
+        var,
+        value@value,
+        hoist = hoist,
+        scope = scope
+      )
       var@modified <- TRUE
       # could probably drop this @modified property, and instead track
       # if the var populated by declare is identical at the end (e.g., perhaps by
@@ -328,7 +334,13 @@ register_r2f_handler(
 
     value <- r2f(args[[2L]], scope, ..., hoist = hoist)
     check_reassignment_narrowing(name, host_var, value@value)
-    check_assignment_compatible(host_var, value@value)
+    check_assignment_compatible(
+      name,
+      host_var,
+      value@value,
+      hoist = hoist,
+      scope = scope
+    )
 
     Fortran(glue("{host_var@name} = {value}"))
   }
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index a6b8e85b..ca449740 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -550,20 +550,134 @@ mode_rank <- function(mode) {
   match(mode, mode_lattice)
 }
 
-# Sanity-check that an assignment's value can be stored in its target
-# (rank matches unless one side is scalar).
+# A dim expression can be spelled in a runtime guard only if every
+# self-size symbol it references (`foo__len_`, `foo__dim_1_`) belongs
+# to an external variable -- those arrive as size dummies; a local's
+# self-sizes are phantoms backing implicit allocation and do not exist
+# in the generated Fortran.
+# Used by: check_assignment_compatible()
+dim_guard_spellable <- function(dim, scope) {
+  if (!is.language(dim)) {
+    return(TRUE)
+  }
+  if (is.null(scope)) {
+    return(FALSE)
+  }
+  matches <- regmatches(
+    syms <- all.vars(dim),
+    regexec("^(.*)__(dim_[0-9]+|len)_$", syms)
+  )
+  all(vapply(
+    matches,
+    function(match) {
+      if (!length(match)) {
+        return(TRUE) # not a self-size symbol
+      }
+      var <- get0(match[[2L]], scope)
+      inherits(var, Variable) && var@is_external
+    },
+    logical(1)
+  ))
+}
+
+# Reassignment cannot re-declare a Fortran variable to a new shape the
+# way R rebinds a symbol, so rank and every extent must stay
+# compatible. Scalars broadcast natively into an array target (an
+# existing divergence: R rebinds the symbol to the scalar), and a
+# deferred-shape local (declared with NA dims) reallocates on
+# whole-array assignment, matching R, so it is exempt. Per axis, the
+# conformability policy applies: a statically known mismatch is a
+# compile error, dims that cannot be compared statically get a
+# statement-level runtime guard through `hoist` (spelled from the dim
+# expressions, when spellable), and provably equal dims need nothing.
+# Callers with no statement context (no hoist) get the static checks
+# only.
 # Used by: r2f-assign.R, scope.R
-check_assignment_compatible <- function(target, value) {
-  if (is.null(value)) {
-    return()
+check_assignment_compatible <- function(
+  name,
+  target,
+  value,
+  hoist = NULL,
+  scope = NULL
+) {
+  if (
+    is.null(value) ||
+      !inherits(target, Variable) ||
+      !inherits(value, Variable)
+  ) {
+    return(invisible())
+  }
+  if (passes_as_scalar(target) || passes_as_scalar(value)) {
+    return(invisible())
+  }
+  if (!target@is_external && has_self_size_dims(target)) {
+    # deferred-shape local: implicit (re)allocation matches R's rebind
+    return(invisible())
+  }
+  if (target@rank != value@rank) {
+    stop(
+      "cannot reassign `",
+      name,
+      "`: replacement rank (",
+      value@rank,
+      ") differs from the declared rank (",
+      target@rank,
+      "); R would rebind `",
+      name,
+      "` to the new shape",
+      call. = FALSE
+    )
+  }
+  for (axis in seq_len(target@rank)) {
+    t_dim <- target@dims[[axis]]
+    v_dim <- value@dims[[axis]]
+    if (is_scalar_na(t_dim) || is_scalar_na(v_dim)) {
+      next
+    }
+    if (is_wholenumber(t_dim) && is_wholenumber(v_dim)) {
+      if (!identical(as.integer(t_dim), as.integer(v_dim))) {
+        stop(
+          "cannot reassign `",
+          name,
+          "`: dimension ",
+          axis,
+          " would change from ",
+          as.integer(t_dim),
+          " to ",
+          as.integer(v_dim),
+          "; R would rebind `",
+          name,
+          "` to the new shape",
+          call. = FALSE
+        )
+      }
+      next
+    }
+    if (
+      identical(
+        fortranize_expr_symbols(t_dim),
+        fortranize_expr_symbols(v_dim)
+      )
+    ) {
+      next
+    }
+    if (
+      is.null(hoist) ||
+        !dim_guard_spellable(t_dim, scope) ||
+        !dim_guard_spellable(v_dim, scope)
+    ) {
+      next
+    }
+    emit_quickr_error_if(
+      glue(
+        "({dims2f(list(t_dim), scope)}) /= ({dims2f(list(v_dim), scope)})"
+      ),
+      sprintf("reassignment must preserve the shape of `%s`", name),
+      hoist,
+      scope
+    )
   }
-  stopifnot(exprs = {
-    inherits(target, Variable)
-    inherits(value, Variable)
-    passes_as_scalar(target) ||
-      passes_as_scalar(value) ||
-      target@rank == value@rank
-  })
+  invisible()
 }
 
 # Reassignment cannot re-type a Fortran variable the way R promotes an R
diff --git a/R/scope.R b/R/scope.R
index 4e432ef5..a1321596 100644
--- a/R/scope.R
+++ b/R/scope.R
@@ -101,7 +101,7 @@ new_scope <- function(closure, parent = emptyenv()) {
     name <- as.character(name)
     existing <- get0(name, scope)
     if (inherits(existing, Variable)) {
-      check_assignment_compatible(existing, value)
+      check_assignment_compatible(name, existing, value)
     }
     value@name <- name
     assign(name, value, scope)
diff --git a/R/sizes.R b/R/sizes.R
index 2335e736..c3dd840d 100644
--- a/R/sizes.R
+++ b/R/sizes.R
@@ -296,6 +296,26 @@ get_size_name <- function(var, axis = NULL, name = var@name, rank = var@rank) {
   }
 }
 
+# TRUE when any of `var`'s dims is its own self-size symbol
+# (`a__dim_1_`, `a__len_`), i.e. the variable was declared with unknown
+# (NA) sizes that substitute_declared_sizes() rewrote. External
+# variables receive those sizes as dummies; for locals they are
+# phantoms, so the manifest declares such locals deferred-shape and
+# relies on implicit allocation.
+# Used by: manifest.R, check_assignment_compatible()
+has_self_size_dims <- function(var) {
+  stopifnot(inherits(var, Variable))
+  any(vapply(
+    seq_along(var@dims),
+    function(i) {
+      d <- var@dims[[i]]
+      is.symbol(d) &&
+        identical(as.character(d), get_size_name(var, axis = i))
+    },
+    logical(1)
+  ))
+}
+
 # TODO: allow syntax like:
 #   declare(type(a, b, c = integer(1)))
 # or:
diff --git a/tests/testthat/test-assignment-shape.R b/tests/testthat/test-assignment-shape.R
new file mode 100644
index 00000000..363b717b
--- /dev/null
+++ b/tests/testthat/test-assignment-shape.R
@@ -0,0 +1,87 @@
+# Reassignment shape compatibility: quickr cannot re-declare a Fortran
+# variable to R's new shape, so rank and every extent must stay
+# compatible (the shape analogue of the narrowing check).
+
+skip_on_cran()
+
+test_that("reassignment to a statically different shape is a compile error", {
+  fn_vec <- function() {
+    x <- numeric(2)
+    x <- numeric(3)
+    x
+  }
+  expect_error(
+    quick(fn_vec),
+    "cannot reassign `x`: dimension 1 would change from 2 to 3",
+    fixed = TRUE
+  )
+
+  fn_mat <- function() {
+    x <- matrix(0, 2, 2)
+    x <- matrix(1, 2, 3)
+    x
+  }
+  expect_error(
+    quick(fn_mat),
+    "cannot reassign `x`: dimension 2 would change from 2 to 3",
+    fixed = TRUE
+  )
+
+  fn_c <- function() {
+    x <- c(1, 2)
+    x <- c(1, 2, 3)
+    x
+  }
+  expect_error(
+    quick(fn_c),
+    "cannot reassign `x`: dimension 1 would change from 2 to 3",
+    fixed = TRUE
+  )
+
+  fn_rank <- function(a) {
+    declare(type(a = double(2, 2)))
+    x <- c(1, 2)
+    x <- a
+    x
+  }
+  expect_error(
+    quick(fn_rank),
+    "cannot reassign `x`: replacement rank (2) differs from the declared rank (1)",
+    fixed = TRUE
+  )
+})
+
+test_that("reassignment with symbolic dims gets a runtime shape guard", {
+  fn <- function(a, b) {
+    declare(type(a = double(n)), type(b = double(m)))
+    x <- a
+    x <- b
+    x
+  }
+  qfn := quick(fn)
+  expect_identical(qfn(c(1, 2), c(3, 4)), c(3, 4))
+  expect_error(
+    qfn(c(1, 2), c(3, 4, 5)),
+    "reassignment must preserve the shape of `x`"
+  )
+})
+
+test_that("shape-preserving reassignments still compile", {
+  # same symbolic dims: provably equal, no guard needed
+  fn_same <- function(a) {
+    declare(type(a = double(n)))
+    x <- a
+    x <- a * 2
+    x
+  }
+  expect_quick_identical(fn_same, c(1, 2, 3))
+
+  # scalar broadcast into an array target keeps working
+  fn_scalar <- function(a) {
+    declare(type(a = double(n)))
+    x <- a
+    x <- 0
+    sum(x)
+  }
+  expect_no_error(r2f(fn_scalar))
+})
diff --git a/tests/testthat/test-internal-utils.R b/tests/testthat/test-internal-utils.R
index 96baaf78..30a0169e 100644
--- a/tests/testthat/test-internal-utils.R
+++ b/tests/testthat/test-internal-utils.R
@@ -235,7 +235,7 @@ test_that("print.quickr_ordered_env outputs bindings", {
 
 test_that("check_assignment_compatible handles NULL value", {
   target <- quickr:::Variable("double", list(1L))
-  expect_silent(quickr:::check_assignment_compatible(target, NULL))
+  expect_silent(quickr:::check_assignment_compatible("x", target, NULL))
 })
 
 test_that("r2size() warns, not crashes, on a deferred-mode Variable", {

From b1b81f4ae57506916e10d9575b54acfe0388802d Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 23:16:52 +0200
Subject: [PATCH 31/97] Require proven dims before reusing an assignment target
 for BLAS output

can_use_output() only rejected a destination on a *literal* dimension
mismatch: a symbolic mismatch was accepted, so
`out <- matrix(0, m, m); out <- crossprod(x)` with x = double(n, 3)
declared out(m, m) but called dsyrk with n=3/ldc=3 -- a corrupted
result for m > 3 and an out-of-bounds write for m < 3. A destination is
now used directly only when its rank and every extent are *proven*
equal to the result shape (dims_proven_equal(): literal-equal or
structurally identical after symbol normalization; NA never proven).
Anything unproven routes through a hoisted temp, and the assignment
shape check (added in the previous commit) emits the runtime guard or
the compile error. Inferred destinations are computed from the same
inputs, so they stay proven and the emitted code is unchanged (zero
snapshot drift); only pre-declared mismatched targets change. The two
"reject incompatible destination" tests now assert the unified
reassignment-shape message, and duplicate per-axis guards (square dest
vs square result) are de-duplicated before emission.
---
 R/r2f-matrix-blas.R              | 42 +++++++++++++++-----------------
 R/r2f-operators-helpers.R        | 31 ++++++++++++++++++++---
 tests/testthat/test-matrix-mul.R | 32 ++++++++++++++++++++++--
 3 files changed, 78 insertions(+), 27 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 4ca9eb20..5fb53812 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -191,29 +191,25 @@ assert_square_matrix <- function(dims, operand, context, hoist, scope) {
 
 # ---- BLAS emitters ----
 
-# Check that destination dimensions match expected output dimensions.
-assert_dest_dims_compatible <- function(dest, expected_dims, context) {
-  if (is.null(dest) || is.null(expected_dims)) {
-    return(invisible(TRUE))
-  }
-  expected_rank <- length(expected_dims)
-  if (dest@rank != expected_rank) {
-    stop("assignment target has incompatible rank for ", context, call. = FALSE)
+# TRUE when the destination's declared shape is *proven* to match the
+# expected output shape: rank equal and every extent proven equal
+# (dims_proven_equal()). Anything unproven -- symbolic dims that merely
+# fail to be refuted, NA dims -- is FALSE: the emitter then routes
+# through a hoisted temporary and the assignment shape check guards (or
+# refuses) the copy. Accepting an unproven dest passed wrong leading
+# dimensions to the BLAS call and could write past the allocation.
+dest_dims_proven <- function(dest, expected_dims) {
+  if (is.null(expected_dims)) {
+    return(FALSE)
   }
-  for (i in seq_len(expected_rank)) {
-    dest_dim <- dest@dims[[i]]
-    expected_dim <- expected_dims[[i]]
-    if (is_wholenumber(dest_dim) && is_wholenumber(expected_dim)) {
-      if (!identical(as.integer(dest_dim), as.integer(expected_dim))) {
-        stop(
-          "assignment target has incompatible dimensions for ",
-          context,
-          call. = FALSE
-        )
-      }
-    }
+  if (dest@rank != length(expected_dims)) {
+    return(FALSE)
   }
-  invisible(TRUE)
+  all(vapply(
+    seq_along(expected_dims),
+    function(i) dims_proven_equal(dest@dims[[i]], expected_dims[[i]]),
+    logical(1)
+  ))
 }
 
 # Determine if output can safely write into dest without aliasing.
@@ -239,7 +235,9 @@ can_use_output <- function(
   if (!identical(logical_as_int(dest), logical_is_c_int)) {
     return(FALSE)
   }
-  assert_dest_dims_compatible(dest, expected_dims, context)
+  if (!dest_dims_proven(dest, expected_dims)) {
+    return(FALSE)
+  }
   output_name <- dest@name
   if (is.null(output_name) || !nzchar(output_name)) {
     return(FALSE)
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index ca449740..510b044e 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -263,6 +263,23 @@ dims_match <- function(left, right) {
   identical(left, right)
 }
 
+# Check if two dimension expressions are *proven* equal: both known and
+# equal, or structurally identical after symbol normalization. NA dims
+# are never proven (two unknown lengths are not the same quantity).
+# Stronger than dims_match() (normalizes symbols), stricter than
+# check_elementwise_lengths() (an incomparable pair is FALSE, not a
+# deferred runtime guard).
+# Used by: r2f-matrix-blas.R (dest_dims_proven)
+dims_proven_equal <- function(left, right) {
+  if (is_scalar_na(left) || is_scalar_na(right)) {
+    return(FALSE)
+  }
+  if (is_wholenumber(left) && is_wholenumber(right)) {
+    return(identical(as.integer(left), as.integer(right)))
+  }
+  identical(fortranize_expr_symbols(left), fortranize_expr_symbols(right))
+}
+
 # Three-valued conformability verdict for one axis of an elementwise op:
 # ok+known (no guard needed), not-ok+known (compile error at the caller),
 # or unknown (caller emits a runtime guard). Known lengths must be equal
@@ -628,6 +645,7 @@ check_assignment_compatible <- function(
       call. = FALSE
     )
   }
+  emitted <- character()
   for (axis in seq_len(target@rank)) {
     t_dim <- target@dims[[axis]]
     v_dim <- value@dims[[axis]]
@@ -668,10 +686,17 @@ check_assignment_compatible <- function(
     ) {
       next
     }
+    condition <- glue(
+      "({dims2f(list(t_dim), scope)}) /= ({dims2f(list(v_dim), scope)})"
+    )
+    # Different axes can spell the same guard (e.g. a square dest vs a
+    # square result, m/=k on both axes); emit each condition once.
+    if (condition %in% emitted) {
+      next
+    }
+    emitted <- c(emitted, condition)
     emit_quickr_error_if(
-      glue(
-        "({dims2f(list(t_dim), scope)}) /= ({dims2f(list(v_dim), scope)})"
-      ),
+      condition,
       sprintf("reassignment must preserve the shape of `%s`", name),
       hoist,
       scope
diff --git a/tests/testthat/test-matrix-mul.R b/tests/testthat/test-matrix-mul.R
index 7bf6b69c..33758176 100644
--- a/tests/testthat/test-matrix-mul.R
+++ b/tests/testthat/test-matrix-mul.R
@@ -227,7 +227,13 @@ test_that("matrix multiplication rejects incompatible destinations", {
     x
   }
 
-  expect_error(quick(dest_mismatch), "incompatible rank for %\\*%")
+  # The destination's declared rank no longer matches the result; the
+  # reassignment shape check rejects it (routing through a temp first).
+  expect_error(
+    quick(dest_mismatch),
+    "replacement rank (2) differs",
+    fixed = TRUE
+  )
 })
 
 test_that("BLAS matrix ops coerce integer and logical inputs to double", {
@@ -460,7 +466,29 @@ test_that("crossprod rejects incompatible destination dimensions", {
 
   expect_error(
     quick(crossprod_bad_dest),
-    "assignment target has incompatible dimensions"
+    "dimension 1 would change from 2 to 3",
+    fixed = TRUE
+  )
+})
+
+test_that("BLAS output routes through a temp when the dest shape is unproven", {
+  # A pre-declared destination whose symbolic dims are not *proven* equal
+  # to the BLAS result shape must not be written directly (that passed the
+  # wrong leading dimensions to dsyrk and could corrupt or overflow the
+  # output). crossprod(x) here is 3x3; the (m, m) dest gets a runtime
+  # shape guard instead of a silent direct write.
+  fn <- function(x, m) {
+    declare(type(x = double(n, 3)), type(m = integer(1)))
+    out <- matrix(0, m, m)
+    out <- crossprod(x)
+    out
+  }
+  qfn := quick(fn)
+  x <- matrix(as.double(1:6), nrow = 2L)
+  expect_equal(qfn(x, 3L), crossprod(x))
+  expect_error(
+    qfn(x, 4L),
+    "reassignment must preserve the shape of `out`"
   )
 })
 

From d6e59f0cfd667e8fc8b021cadc79db94d8f9f912 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 23:29:47 +0200
Subject: [PATCH 32/97] Support c(matrix) and as.vector(); share one
 flatten-to-vector helper

as.double(<matrix>) and as.integer(<matrix>) already dropped dims, but
each hand-rolled the same value_length_expr()/dims2f()/reshape([len])
block, and c(matrix) / as.vector() -- both observable R semantics --
were unsupported (errors "all args passed to c() must be scalars or
1-d arrays" and "Unsupported function: as.vector"). flatten_to_vector()
now spells the column-major drop-dims reshape once; as.double(),
as.integer(), the new as.vector() handler, and c()'s argument
normalization all use it. as.vector() preserves the mode by default
and delegates numeric-mode coercion to as.double()/as.integer(). This
also fixes a latent case: as.integer() of an int-backed logical matrix
returned early and kept the matrix dims; it now flattens like every
other array. NEWS entry; the grid's c()-rejects-rank-2 divergence test
becomes a flatten correctness check.
---
 NEWS.md                                   |  6 ++
 R/r2f-coercions.R                         | 87 +++++++++++++----------
 R/r2f-constructors.R                      |  4 ++
 R/r2f-iterables-helpers.R                 | 29 ++++++++
 tests/testthat/test-conformability-grid.R |  4 +-
 tests/testthat/test-flatten-vector.R      | 73 +++++++++++++++++++
 6 files changed, 164 insertions(+), 39 deletions(-)
 create mode 100644 tests/testthat/test-flatten-vector.R

diff --git a/NEWS.md b/NEWS.md
index d80c930c..e03c8f34 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -6,6 +6,12 @@
 
 * Successful flang availability checks are now reused for the rest of the R
   session. Restart R after changing the flang toolchain.
+- `c()` now accepts matrix and array arguments, flattening them in
+  column-major order like R (previously `c(m)` for a matrix `m` errored
+  with "all args passed to c() must be scalars or 1-d arrays"). `as.vector()`
+  is now supported: it drops dimensions (mode `"any"`, the default,
+  preserves the type; `mode = "double"`/`"integer"`/`"numeric"` coerce).
+
 - Reassigning a variable now requires the new value's shape to be
   compatible with the declared shape, extending the existing rank check
   to every dimension: quickr cannot re-declare a Fortran variable the
diff --git a/R/r2f-coercions.R b/R/r2f-coercions.R
index e4362d58..ac0a8a58 100644
--- a/R/r2f-coercions.R
+++ b/R/r2f-coercions.R
@@ -1,5 +1,5 @@
 # r2f-coercions.R
-# Handlers for type coercions: as.double, as.integer
+# Handlers for type coercions: as.double, as.integer, as.vector
 
 # --- Handlers ---
 
@@ -9,24 +9,7 @@ r2f_handlers[["as.double"]] <- function(args, scope = NULL, ...) {
   x <- maybe_cast_double(x)
 
   # R drops dimensions for as.double(<array>): the result is a vector.
-  if (!passes_as_scalar(x@value) && x@value@rank > 1L) {
-    len_expr <- value_length_expr(x@value)
-    len_str <- if (is_scalar_na(len_expr)) {
-      glue("size({x})")
-    } else {
-      # dims2f() returns "" for a scalar "1", but we need a literal length.
-      out <- dims2f(list(len_expr), scope)
-      if (!nzchar(out)) "1" else out
-    }
-
-    out_val <- Variable(
-      "double",
-      list(if (is_scalar_na(len_expr)) NA else len_expr)
-    )
-    return(Fortran(glue("reshape({x}, [{len_str}])"), out_val))
-  }
-
-  x
+  flatten_to_vector(x, scope)
 }
 
 r2f_handlers[["as.integer"]] <- function(args, scope = NULL, ...) {
@@ -45,32 +28,62 @@ r2f_handlers[["as.integer"]] <- function(args, scope = NULL, ...) {
     double = Fortran(glue("int({arg}, kind=c_int)"), out_val),
     logical = {
       # External logicals are integer-backed (0/1/NA) under bind(c); if the
-      # expression preserves that storage (e.g. rev(m)), return it directly.
+      # expression preserves that storage (e.g. rev(m)), reuse it directly.
       if (logical_as_int(arg@value)) {
-        src <- arg@value@name %||% as.character(arg)
-        return(Fortran(src, out_val))
+        Fortran(arg@value@name %||% as.character(arg), out_val)
+      } else {
+        arg <- booleanize_logical_as_int(arg)
+        Fortran(glue("merge(1_c_int, 0_c_int, {arg})"), out_val)
       }
-      arg <- booleanize_logical_as_int(arg)
-      Fortran(glue("merge(1_c_int, 0_c_int, {arg})"), out_val)
     },
     stop("as.integer() only implemented for logical, integer, and double")
   )
 
   # R drops dimensions for as.integer(<array>): the result is a vector.
-  if (!passes_as_scalar(out@value) && out@value@rank > 1L) {
-    len_expr <- value_length_expr(out@value)
-    len_str <- if (is_scalar_na(len_expr)) {
-      glue("size({out})")
-    } else {
-      out_len <- dims2f(list(len_expr), scope)
-      if (!nzchar(out_len)) "1" else out_len
-    }
-    out_val <- Variable(
-      "integer",
-      list(if (is_scalar_na(len_expr)) NA else len_expr)
+  flatten_to_vector(out, scope)
+}
+
+r2f_handlers[["as.vector"]] <- function(args, scope = NULL, ...) {
+  x_arg <- args$x %||% args[[1L]]
+  if (is.null(x_arg) || is_missing(x_arg)) {
+    stop("as.vector() expects `x`", call. = FALSE)
+  }
+
+  # `mode` selects the coercion; "any" (the default) preserves the type
+  # and only drops dimensions. Numeric modes delegate to the dedicated
+  # coercion handlers so the cast spellings stay in one place.
+  mode_arg <- args$mode %||% if (length(args) >= 2L) args[[2L]] else NULL
+  mode <- if (is.null(mode_arg) || is_missing(mode_arg)) {
+    "any"
+  } else if (is.character(mode_arg) && length(mode_arg) == 1L) {
+    mode_arg
+  } else {
+    stop("as.vector() `mode` must be a string constant", call. = FALSE)
+  }
+
+  if (mode %in% c("double", "numeric")) {
+    return(r2f(as.call(list(quote(as.double), x_arg)), scope, ...))
+  }
+  if (mode == "integer") {
+    return(r2f(as.call(list(quote(as.integer), x_arg)), scope, ...))
+  }
+  if (!mode %in% c("any", "logical", "complex")) {
+    stop(
+      "as.vector() does not support mode = ",
+      encodeString(mode, quote = "\""),
+      call. = FALSE
     )
-    return(Fortran(glue("reshape({out}, [{len_str}])"), out_val))
   }
 
-  out
+  x <- r2f(x_arg, scope, ...)
+  if (mode != "any" && !identical(x@value@mode, mode)) {
+    stop(
+      "as.vector(x, mode = ",
+      encodeString(mode, quote = "\""),
+      ") requires an operand already of that mode; casting is only ",
+      "supported for numeric modes",
+      call. = FALSE
+    )
+  }
+  flatten_to_vector(x, scope)
 }
diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index b5d57e79..19ad5124 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -120,6 +120,10 @@ known_dims_prod <- function(dims) {
 
 r2f_handlers[["c"]] <- function(args, scope = NULL, ...) {
   ff <- lapply(args, r2f, scope, ...)
+  # R's c() flattens matrix/array arguments column-major; drop their dims
+  # to a rank-1 view before joining (fill constructors are already
+  # rank-1, so they pass through untouched for the spread below).
+  ff <- lapply(ff, flatten_to_vector, scope = scope)
   # Fortran array constructors require uniform element types; cast every
   # element whose mode differs from the promoted mode (R: c(1L, 2.5) is
   # double, c(TRUE, 2L) is integer).
diff --git a/R/r2f-iterables-helpers.R b/R/r2f-iterables-helpers.R
index f77270f7..cf00fbc7 100644
--- a/R/r2f-iterables-helpers.R
+++ b/R/r2f-iterables-helpers.R
@@ -19,6 +19,35 @@ r2f_iterable_context <- function(calls) {
   }
 }
 
+# Flatten a rank>1 value to a rank-1 vector, matching R's column-major
+# drop-dims semantics for as.double()/as.integer()/as.vector() and
+# matrix arguments to c(). Scalars and rank-1 values pass through
+# unchanged. The canonical `reshape(source, [len])` spelling lives here
+# so every flatten site shares it; the output length is
+# value_length_expr(x@value) (NA -> a runtime size() query). The output
+# mode is x's own mode -- callers cast before flattening if they want a
+# different one.
+# Used by: r2f-coercions.R, r2f-constructors.R
+flatten_to_vector <- function(x, scope) {
+  stopifnot(inherits(x, Fortran))
+  if (passes_as_scalar(x@value) || x@value@rank <= 1L) {
+    return(x)
+  }
+  len_expr <- value_length_expr(x@value)
+  len_str <- if (is_scalar_na(len_expr)) {
+    glue("size({x})")
+  } else {
+    # dims2f() returns "" for a scalar "1", but we need a literal length.
+    out <- dims2f(list(len_expr), scope)
+    if (!nzchar(out)) "1" else out
+  }
+  out_val <- Variable(
+    x@value@mode,
+    list(if (is_scalar_na(len_expr)) NA else len_expr)
+  )
+  Fortran(glue("reshape({x}, [{len_str}])"), out_val)
+}
+
 # Compute the length expression for a Variable value.
 # Used by: r2f-sequences.R, r2f-control-flow.R
 value_length_expr <- function(value) {
diff --git a/tests/testthat/test-conformability-grid.R b/tests/testthat/test-conformability-grid.R
index ae1acbf2..33c90dca 100644
--- a/tests/testthat/test-conformability-grid.R
+++ b/tests/testthat/test-conformability-grid.R
@@ -624,7 +624,7 @@ test_that("c() grid: symbolic lengths are constructive (no guard)", {
   expect_grid_cells_match(qfn, fn, args, context = "c()/sym")
 })
 
-test_that("c() rejects rank-2 args (R would flatten: error divergence)", {
+test_that("c() flattens rank-2 args column-major, like R", {
   fn <- eval(parse(
     text = paste0(
       "function(a) {\n",
@@ -632,7 +632,7 @@ test_that("c() rejects rank-2 args (R would flatten: error divergence)", {
       "  c(a, 1.0)\n}"
     )
   )[[1L]])
-  expect_error(quick(fn), "scalars or 1-d arrays", fixed = TRUE)
+  expect_quick_identical(fn, list(matrix(as.double(1:6), 3, 2)))
 })
 
 # --- Multi-arg min()/max()/sum(): join across args, shapes independent ----
diff --git a/tests/testthat/test-flatten-vector.R b/tests/testthat/test-flatten-vector.R
new file mode 100644
index 00000000..367c4870
--- /dev/null
+++ b/tests/testthat/test-flatten-vector.R
@@ -0,0 +1,73 @@
+# c(matrix), as.vector(), and as.integer()/as.double() of arrays all
+# flatten column-major, matching R's drop-dims semantics.
+
+skip_on_cran()
+
+test_that("c() flattens matrix and array arguments column-major", {
+  c_mat <- function(m) {
+    declare(type(m = double(2, 3)))
+    c(m)
+  }
+  expect_quick_identical(c_mat, list(matrix(as.double(1:6), 2, 3)))
+
+  c_mixed <- function(m, v) {
+    declare(type(m = double(2, 2)), type(v = double(3)))
+    c(m, v)
+  }
+  expect_quick_identical(
+    c_mixed,
+    list(matrix(as.double(1:4), 2, 2), c(7, 8, 9))
+  )
+
+  c_two_mats <- function(a, b) {
+    declare(type(a = integer(2, 2)), type(b = integer(1, 3)))
+    c(a, b)
+  }
+  expect_quick_identical(
+    c_two_mats,
+    list(matrix(1:4, 2, 2), matrix(7:9, 1, 3))
+  )
+})
+
+test_that("as.vector() drops dimensions, preserving or coercing the mode", {
+  # default mode preserves type
+  av_dbl <- function(m) {
+    declare(type(m = double(2, 3)))
+    as.vector(m)
+  }
+  expect_quick_identical(av_dbl, list(matrix(as.double(1:6), 2, 3)))
+
+  av_lgl <- function(m) {
+    declare(type(m = logical(2, 2)))
+    as.vector(m)
+  }
+  expect_quick_identical(av_lgl, list(matrix(c(TRUE, FALSE, TRUE, TRUE), 2, 2)))
+
+  # mode = "double" delegates to as.double()
+  av_coerce <- function(m) {
+    declare(type(m = integer(2, 2)))
+    as.vector(m, mode = "double")
+  }
+  expect_quick_identical(av_coerce, list(matrix(1:4, 2, 2)))
+})
+
+test_that("as.vector() refuses unsupported modes and non-constant modes", {
+  bad_mode <- function(m) {
+    declare(type(m = double(2)))
+    as.vector(m, mode = "list")
+  }
+  expect_error(quick(bad_mode), "as.vector() does not support mode", fixed = TRUE)
+})
+
+test_that("as.integer() drops dimensions for an int-backed logical matrix", {
+  # External logical args are integer-backed; the flatten must still apply
+  # (it used to be skipped by an early return, keeping the matrix dims).
+  fn <- function(m) {
+    declare(type(m = logical(2, 3)))
+    as.integer(m)
+  }
+  expect_quick_identical(
+    fn,
+    list(matrix(c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE), 2, 3))
+  )
+})

From 4a92d0184d398630102332a65efbcae116aa3d3e Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 11 Jul 2026 10:39:08 +0200
Subject: [PATCH 33/97] Validate deferred-shape ranks and empty as.vector()
 calls

Check replacement rank before exempting deferred-shape locals so rank-changing assignments fail during translation. Guard empty as.vector() argument lookup and add public-API regressions for both cases.
---
 R/r2f-coercions.R                      |  2 +-
 R/r2f-operators-helpers.R              | 16 ++++++++--------
 tests/testthat/test-assignment-shape.R | 11 +++++++++++
 tests/testthat/test-flatten-vector.R   | 15 ++++++++++++++-
 4 files changed, 34 insertions(+), 10 deletions(-)

diff --git a/R/r2f-coercions.R b/R/r2f-coercions.R
index ac0a8a58..40ecf92e 100644
--- a/R/r2f-coercions.R
+++ b/R/r2f-coercions.R
@@ -44,7 +44,7 @@ r2f_handlers[["as.integer"]] <- function(args, scope = NULL, ...) {
 }
 
 r2f_handlers[["as.vector"]] <- function(args, scope = NULL, ...) {
-  x_arg <- args$x %||% args[[1L]]
+  x_arg <- args$x %||% if (length(args) >= 1L) args[[1L]] else NULL
   if (is.null(x_arg) || is_missing(x_arg)) {
     stop("as.vector() expects `x`", call. = FALSE)
   }
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 510b044e..00941bd1 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -601,10 +601,10 @@ dim_guard_spellable <- function(dim, scope) {
 # way R rebinds a symbol, so rank and every extent must stay
 # compatible. Scalars broadcast natively into an array target (an
 # existing divergence: R rebinds the symbol to the scalar), and a
-# deferred-shape local (declared with NA dims) reallocates on
-# whole-array assignment, matching R, so it is exempt. Per axis, the
-# conformability policy applies: a statically known mismatch is a
-# compile error, dims that cannot be compared statically get a
+# deferred-shape local (declared with NA dims) reallocates extents on
+# same-rank whole-array assignment, matching R, so it is exempt. Per
+# axis, the conformability policy applies: a statically known mismatch
+# is a compile error, dims that cannot be compared statically get a
 # statement-level runtime guard through `hoist` (spelled from the dim
 # expressions, when spellable), and provably equal dims need nothing.
 # Callers with no statement context (no hoist) get the static checks
@@ -627,10 +627,6 @@ check_assignment_compatible <- function(
   if (passes_as_scalar(target) || passes_as_scalar(value)) {
     return(invisible())
   }
-  if (!target@is_external && has_self_size_dims(target)) {
-    # deferred-shape local: implicit (re)allocation matches R's rebind
-    return(invisible())
-  }
   if (target@rank != value@rank) {
     stop(
       "cannot reassign `",
@@ -645,6 +641,10 @@ check_assignment_compatible <- function(
       call. = FALSE
     )
   }
+  if (!target@is_external && has_self_size_dims(target)) {
+    # deferred-shape local: implicit (re)allocation matches R's rebind
+    return(invisible())
+  }
   emitted <- character()
   for (axis in seq_len(target@rank)) {
     t_dim <- target@dims[[axis]]
diff --git a/tests/testthat/test-assignment-shape.R b/tests/testthat/test-assignment-shape.R
index 363b717b..51bb86cb 100644
--- a/tests/testthat/test-assignment-shape.R
+++ b/tests/testthat/test-assignment-shape.R
@@ -49,6 +49,17 @@ test_that("reassignment to a statically different shape is a compile error", {
     "cannot reassign `x`: replacement rank (2) differs from the declared rank (1)",
     fixed = TRUE
   )
+
+  fn_deferred_rank <- function(a) {
+    declare(type(a = double(2, 2)), type(x = double(NA)))
+    x <- a
+    1
+  }
+  expect_error(
+    quick(fn_deferred_rank),
+    "cannot reassign `x`: replacement rank (2) differs from the declared rank (1)",
+    fixed = TRUE
+  )
 })
 
 test_that("reassignment with symbolic dims gets a runtime shape guard", {
diff --git a/tests/testthat/test-flatten-vector.R b/tests/testthat/test-flatten-vector.R
index 367c4870..7fe2e30a 100644
--- a/tests/testthat/test-flatten-vector.R
+++ b/tests/testthat/test-flatten-vector.R
@@ -52,11 +52,24 @@ test_that("as.vector() drops dimensions, preserving or coercing the mode", {
 })
 
 test_that("as.vector() refuses unsupported modes and non-constant modes", {
+  missing_x <- function() {
+    as.vector()
+  }
+  expect_error(
+    quick(missing_x),
+    "as.vector() expects `x`",
+    fixed = TRUE
+  )
+
   bad_mode <- function(m) {
     declare(type(m = double(2)))
     as.vector(m, mode = "list")
   }
-  expect_error(quick(bad_mode), "as.vector() does not support mode", fixed = TRUE)
+  expect_error(
+    quick(bad_mode),
+    "as.vector() does not support mode",
+    fixed = TRUE
+  )
 })
 
 test_that("as.integer() drops dimensions for an int-backed logical matrix", {

From 0a3b0e30747ca80460872164011432c2ff6d4455 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 12:08:00 +0200
Subject: [PATCH 34/97] Add semantics vignette: the type/shape contract and
 differences from R

Documents the compilation contract (quick(f)(x) returns exactly what
f(x) returns, or errors), the result-type rules, the conformability
policy (compile-time error / runtime check / allowed), and every
deliberate divergence from R: no NA, no partial recycling, zero-length
handling, fixed variable types, partial subscript bounds checking,
ifelse() type/shape rules, rectangular solve(), eager closure
arguments, and unreproduced deprecation warnings.

Adds the vignette infrastructure (VignetteBuilder: knitr; Suggests
knitr, rmarkdown). All chunks are eval=FALSE with outputs pasted from
verified runs, so building the vignette needs no Fortran toolchain and
adds nothing to check time.
---
 DESCRIPTION                    |   3 +
 vignettes/.gitignore           |   2 +
 vignettes/quickr-semantics.Rmd | 306 +++++++++++++++++++++++++++++++++
 3 files changed, 311 insertions(+)
 create mode 100644 vignettes/.gitignore
 create mode 100644 vignettes/quickr-semantics.Rmd

diff --git a/DESCRIPTION b/DESCRIPTION
index dbefb6a5..7c8c4dab 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -23,10 +23,13 @@ Imports:
 Suggests:
     bench,
     cli,
+    knitr,
     pkgload (>= 1.4.0),
     rlang,
+    rmarkdown,
     testthat (>= 3.0.0),
     withr
+VignetteBuilder: knitr
 Config/testthat/edition: 3
 Config/testthat/parallel: true
 Config/testthat/start-first: unary-intrinsics, loops
diff --git a/vignettes/.gitignore b/vignettes/.gitignore
new file mode 100644
index 00000000..097b2416
--- /dev/null
+++ b/vignettes/.gitignore
@@ -0,0 +1,2 @@
+*.html
+*.R
diff --git a/vignettes/quickr-semantics.Rmd b/vignettes/quickr-semantics.Rmd
new file mode 100644
index 00000000..2c861a18
--- /dev/null
+++ b/vignettes/quickr-semantics.Rmd
@@ -0,0 +1,306 @@
+---
+title: "quickr semantics: types, shapes, and differences from R"
+output: rmarkdown::html_vignette
+vignette: >
+  %\VignetteIndexEntry{quickr semantics: types, shapes, and differences from R}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>",
+  eval = FALSE
+)
+```
+
+quickr compiles a subset of R. This vignette documents the semantics of
+that subset: what type a result has, when shapes are checked, and every
+place where a compiled function deliberately behaves differently from R.
+All differences take the same form — an error where R would return a
+value — never a different value.
+
+## The contract
+
+> `quick(f)(x)` either returns exactly what `f(x)` returns — same values,
+> same `typeof()`, same shape — or raises an error. Never a third thing.
+
+When quickr cannot reproduce R's behavior, it refuses. It prefers to
+refuse at compile time, when `quick()` is called; when the decision
+depends on values only known at run time (for example, sizes declared as
+`NA` or as symbolic constraints like `double(n)`), the compiled function
+performs a cheap runtime check and raises an error on mismatch. The text
+of these error messages differs from R's.
+
+The rest of this vignette is that contract in detail: first result
+*types*, then operand *shapes*, then the list of deliberate divergences.
+
+## Types
+
+Value types follow R's promotion order for the supported atomic modes:
+
+```
+logical < integer < double < complex
+```
+
+An operation's result type is the "join" of its operands' types — the
+highest type among them — except where R fixes the result type, which
+quickr then matches:
+
+| Operation | Result type |
+|---|---|
+| `+` `-` `*` (and unary `+` `-`) | join of the operand types; logicals count as integers (in R, `TRUE + TRUE` is `2L`) |
+| `/` | always double |
+| `^` | always double (see note below) |
+| `%%`, `%/%` | join of the operand types; logicals count as integers |
+| `<` `<=` `>` `>=` `==` `!=` | logical |
+| `&`, `|`, `!` | logical |
+| `c()`, and multi-argument `min()` / `max()` / `sum()` / `prod()` | join of all argument types |
+| single-argument reductions (`sum(x)`, ...), `abs()` | type of `x`; logical counts as integer |
+| `ifelse(test, yes, no)` | join of `yes` and `no` (but see [ifelse](#ifelse) below) |
+| `%*%`, `crossprod()`, `solve()`, and other linear algebra | always double, as in R |
+| `t(x)`, `diag(x)` | same type as `x`; the identity forms `diag(n)` are double, as in R |
+| `cbind()` / `rbind()` | join of all argument types |
+
+For example, mixing integer and double promotes:
+
+```{r}
+f <- quick(function(x, y) {
+  declare(type(x = integer(1)), type(y = integer(1)))
+  x / y
+})
+f(5L, 2L)
+#> [1] 2.5
+```
+
+and logical arithmetic produces integers, as in R:
+
+```{r}
+f <- quick(function(x, y) {
+  declare(type(x = logical(1)), type(y = logical(1)))
+  x + y
+})
+r <- f(TRUE, TRUE)
+r
+#> [1] 2
+typeof(r)
+#> [1] "integer"
+```
+
+**A note on `^`:** the result is always double, as in R, but when the
+exponent is a whole number quickr computes the power with an integer
+exponent. This is exact, and well-defined for negative bases:
+`(-2) ^ 3L` is exactly `-8`.
+
+### Reassignment cannot narrow a type
+
+R happily re-binds a name to a value of a wider type: after
+`x <- x + 0.5`, an integer `x` becomes double. Compiled code cannot
+re-type a variable, and silently truncating the value would change
+results, so quickr makes this a compile-time error:
+
+```{r}
+quick(function(x) {
+  declare(type(x = integer(1)))
+  x <- x + 0.5
+  x
+})
+#> Error: cannot reassign `x`: assignment would narrow double to integer;
+#>   R would promote `x` to double
+```
+
+The same check applies to subassignment (`x[i] <- ...`) and
+superassignment (`x <<- ...`, `x[i] <<- ...`). Widening in the other
+direction (assigning an integer value to a double variable) is fine and
+inserts the conversion R would perform.
+
+## Shapes
+
+Every operation that combines two or more values checks that their
+shapes are compatible. A shape question has one of three answers, and
+each answer has a fixed consequence:
+
+- **Provably compatible** at compile time — allowed, no check emitted.
+- **Provably incompatible** at compile time — compile error.
+- **Unknown** at compile time (sizes declared `NA`, or symbolic sizes
+  that cannot be proven equal) — the compiled function checks at run
+  time and raises an error on mismatch.
+
+There is no case where a mismatch is silently accepted.
+
+For elementwise operations (arithmetic, comparisons, `&`, `|`),
+"compatible" means:
+
+| Operands | Behavior |
+|---|---|
+| scalar with anything | allowed; the scalar is broadcast |
+| identical shapes | allowed |
+| vector with matrix, `length(vec) == nrow(mat)` | allowed; the vector is recycled column-wise, exactly as in R |
+| a `1x1` matrix in *arithmetic* | treated as a scalar (R allows this, with a deprecation warning) |
+| a `1x1` matrix in comparisons and `&` / `|` | treated as a one-row matrix; mismatched shapes are rejected, and R errors here too |
+| anything else — unequal lengths, even when one divides the other | **error**: R-style recycling is not supported |
+
+The last row is the important one. In R, `1:6 + c(10, 20)` recycles the
+shorter vector. quickr never does this:
+
+```{r}
+quick(function(x, y) {
+  declare(type(x = double(4)), type(y = double(2)))
+  x + y
+})
+#> Error: elementwise vector operations require equal lengths or a scalar
+#>   operand; R-style recycling is not supported
+```
+
+When lengths are not known at compile time, the same rule is enforced at
+run time:
+
+```{r}
+f <- quick(function(x, y) {
+  declare(type(x = double(n)), type(y = double(m)))
+  x + y
+})
+f(c(1, 2), c(3, 4))
+#> [1] 4 6
+f(c(1, 2, 3), c(1, 2))
+#> Error: elementwise vector operations require equal lengths or a scalar
+#>   operand; R-style recycling is not supported
+```
+
+The two recycling forms that quickr *does* support — scalars, and a
+vector spanning the rows of a matrix — are exactly the ones with an
+exact, non-partial interpretation:
+
+```{r}
+f <- quick(function(x, m) {
+  declare(type(x = double(3)), type(m = double(3, 2)))
+  x * m
+})
+f(c(1, 10, 100), matrix(as.double(1:6), 3, 2))
+#>      [,1] [,2]
+#> [1,]    1    4
+#> [2,]   20   50
+#> [3,]  300  600
+```
+
+### Matrix multiplication and linear algebra
+
+`%*%`, `crossprod()`, `tcrossprod()`, `solve()`, and the triangular
+solvers check conformability like R does. Dimensions known at compile
+time are checked at compile time; unknown dimensions are checked at run
+time before the underlying BLAS/LAPACK routine is called:
+
+```{r}
+f <- quick(function(a, b) {
+  declare(type(a = double(n, k)), type(b = double(m, j)))
+  a %*% b
+})
+f(matrix(1, 2, 3), matrix(1, 2, 2))
+#> Error: non-conformable arguments in %*%
+```
+
+## Differences from R
+
+Everything listed here is an *error* divergence: a compiled function
+refuses where plain R would produce a value. If you find a case where a
+compiled function silently returns something different from R, that is a
+bug — please report it.
+
+### No `NA`
+
+`NA` values are not supported, in inputs or as literals. quickr does not
+implement R's missing-value semantics, and compiled code does not detect
+`NA` in inputs — passing `NA` produces undefined results. (For doubles,
+`NaN` and `Inf` flow through arithmetic per IEEE rules as they do in R,
+but no guarantees are made for code that branches on them.)
+
+### No partial recycling
+
+As described above: operand lengths must match exactly or one operand
+must be a scalar (or a vector spanning a matrix's rows). R's general
+recycling rule — including the case where one length divides the other,
+which R accepts without a warning — is a compile-time error or a runtime
+error instead.
+
+### Zero-length operands do not recycle to zero-length results
+
+R arithmetic with a zero-length operand returns a zero-length result
+regardless of the other operand's length: `numeric(0) + 1:3` is
+`numeric(0)`. In quickr, a zero length is a length like any other: an
+operand *known* at compile time to be zero-length is a compile error,
+and at run time a zero-length operand errors unless the other operand's
+length is also zero (two zero-length operands produce a zero-length
+result, as in R).
+
+### A variable's type cannot change
+
+`x <- x + 0.5` on an integer `x` is a compile-time error, as described
+under [Types](#reassignment-cannot-narrow-a-type). R instead promotes
+the variable to double.
+
+### Subscript bounds are only partially checked
+
+R validates every subscript: `x[0]` drops elements, negative subscripts
+exclude, and out-of-range reads pad with `NA`. None of those have a
+Fortran equivalent, and per-element bounds checks inside hot loops would
+defeat the purpose of compiling, so quickr's contract is:
+
+- Subscripts that are provably out of range at compile time (literal
+  values, ranges provably outside a known extent) are compile errors.
+  Zero and negative literal subscripts are rejected.
+- A subscript whose value is only known at run time — a scalar `x[i]`,
+  or a range `x[a:b]` with symbolic bounds — is **not** checked,
+  matching Fortran's own contract: reading or writing out of bounds is
+  undefined behavior, as in C. It will not return `NA`-padded results
+  the way R does.
+
+If you need R's bounds behavior, validate indices before the loop.
+
+### `ifelse()` {#ifelse}
+
+Three differences:
+
+- **Result type.** In R, `ifelse()`'s result type can depend on which
+  branches are actually reached at run time:
+  `ifelse(c(TRUE, TRUE), 1:2, c(0.5, 0.5))` is integer, because the `no`
+  branch never materializes. quickr always promotes to the join of both
+  branch types (double here), regardless of `test`'s values.
+- **Result shape.** The result takes the shape of `test`, as in R. A
+  scalar `test` with array-valued branches (where R would return a
+  length-1 result sliced out of the array) is a compile error.
+- **Branch lengths.** Branches shorter than `test` are recycled by R;
+  quickr requires each branch to be a scalar or match `test`'s length
+  (checked at run time when lengths are unknown). A branch known to be
+  zero-length is a compile error.
+
+```{r}
+quick(function(t, a, b) {
+  declare(type(t = logical(1)), type(a = double(3)), type(b = double(3)))
+  ifelse(t, a, b)
+})
+#> Error: ifelse() result takes the shape of `test`; array-valued yes/no
+#>   with scalar test is not supported
+```
+
+### `solve(a, b)` with a rectangular `a` solves least squares
+
+R's `solve()` requires a square matrix. When `a`'s squareness is not
+known at compile time, quickr lowers `solve(a, b)` to a solver that
+handles both the square case (like R's `solve()`) and the rectangular
+case as a least-squares problem (like R's `qr.solve()`). So for
+rectangular `a`, `solve(a, b)` returns the least-squares solution where
+R raises `'a' (3 x 2) must be square`.
+
+### Closure arguments are evaluated eagerly
+
+R evaluates function arguments lazily. Local closures inside compiled
+functions (including functions passed to `sapply()`) evaluate their
+arguments eagerly. Code that relies on an argument never being evaluated
+will behave differently.
+
+### Deprecation warnings are not reproduced
+
+Where R accepts an operation but warns — recycling a `1x1` matrix in
+arithmetic is the one such case in the supported subset — quickr
+performs the operation without a warning.

From 8f025ccb864c3bccd913fcd35ec0ee9c32fe4602 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 11 Jul 2026 11:47:20 +0200
Subject: [PATCH 35/97] Share the comparison and logical operand lowering

The six comparison handlers repeated the same four-step preamble --
lower operands, refuse complex ordering, promote logicals as integers,
conform shapes -- and `&`/`|` shared a registration whose body then
switched on the operator to pick `.and.`/`.or.`. Both collapse into one
lowering helper each (lower_comparison_operands(),
lower_logical_operands()), leaving every handler as its Fortran spelling
plus the result mode. `&` and `|` become separate handlers, so nothing
dispatches on the call name.

The short-circuit trio is renamed to say what it does rather than which
operators reach it: check_short_circuit_operand(),
is_eager_safe_condition(), and lower_short_circuit_operator(), which
`&&` and `||` now both delegate to.

check_ordered_operands(), added with the complex-ordering refusal, is
absorbed into lower_comparison_operands() -- the refusal was the only
thing it shared. Emitted Fortran is unchanged.
---
 R/r2f-logical.R | 326 ++++++++++++++++++++++--------------------------
 1 file changed, 152 insertions(+), 174 deletions(-)

diff --git a/R/r2f-logical.R b/R/r2f-logical.R
index b39aed58..4a94a87d 100644
--- a/R/r2f-logical.R
+++ b/R/r2f-logical.R
@@ -1,109 +1,145 @@
 # r2f-logical.R
-# Handlers for logical and comparison operators: !, &, |, >=, >, <, <=, ==, !=
-# plus the scalar short-circuit forms && and || (compile_andor below).
+# Handlers for comparison and logical operators, plus is.null().
 
 # --- Handlers ---
 
-# ---- comparison operators ----
+# ---- unary logical not ----
 
-# R supports equality on complex values but refuses ordering. Refuse it
-# here rather than handing gfortran an invalid comparison; shared by the
-# four ordering handlers below (== and /= stay legal, as in R).
-check_ordered_operands <- function(left, right) {
-  if ("complex" %in% c(left@value@mode, right@value@mode)) {
-    stop("invalid comparison with complex values", call. = FALSE)
+r2f_handlers[["!"]] <- function(args, scope, ...) {
+  stopifnot(length(args) == 1L)
+  x <- r2f(args[[1L]], scope, ...)
+  if (x@value@mode != "logical") {
+    stop("'!' expects a logical value; numeric coercions not yet supported")
   }
-  invisible(TRUE)
+  x <- booleanize_logical_as_int(x)
+  Fortran(glue("(.not. {x})"), Variable("logical", x@value@dims))
 }
 
-r2f_handlers[[">="]] <- function(args, scope, ..., hoist = NULL) {
+register_r2f_handler(
+  "is.null",
+  function(args, scope, ...) {
+    stopifnot(length(args) == 1L)
+    arg <- args[[1L]]
+    if (!is.symbol(arg)) {
+      stop("is.null() is only supported on symbols", call. = FALSE)
+    }
+    var <- get0(as.character(arg), scope)
+    if (!inherits(var, Variable) || is.null(var@optional_dummy)) {
+      stop(
+        "is.null() is only supported for optional arguments with NULL defaults",
+        call. = FALSE
+      )
+    }
+    Fortran(glue("(.not. present({var@optional_dummy}))"), Variable("logical"))
+  }
+)
+
+lower_comparison_operands <- function(args, scope, op, ..., hoist = NULL) {
   .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
-  check_ordered_operands(left, right)
-  # R compares logicals as integers; Fortran has no logical comparison.
+  if (
+    op %in%
+      c("<", "<=", ">", ">=") &&
+      "complex" %in% c(left@value@mode, right@value@mode)
+  ) {
+    stop("invalid comparison with complex values", call. = FALSE)
+  }
   .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(
+  maybe_reshape_vector_matrix(
     left,
     right,
     hoist,
     scope,
     scalarize_one_by_one = FALSE
   )
-  var <- conform(left@value, right@value)
-  var@mode <- "logical"
-  Fortran(glue("({left} >= {right})"), var)
 }
 
-r2f_handlers[[">"]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
-  check_ordered_operands(left, right)
-  # R compares logicals as integers; Fortran has no logical comparison.
-  .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(
-    left,
-    right,
-    hoist,
+r2f_handlers[["<"]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lower_comparison_operands(
+    args,
     scope,
-    scalarize_one_by_one = FALSE
+    "<",
+    ...,
+    hoist = hoist
   )
-  var <- conform(left@value, right@value)
-  var@mode <- "logical"
-  Fortran(glue("({left} > {right})"), var)
+  value <- conform(left@value, right@value)
+  value@mode <- "logical"
+  Fortran(glue("({left} < {right})"), value)
 }
 
-r2f_handlers[["<"]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
-  check_ordered_operands(left, right)
-  # R compares logicals as integers; Fortran has no logical comparison.
-  .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(
-    left,
-    right,
-    hoist,
+r2f_handlers[["<="]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lower_comparison_operands(
+    args,
     scope,
-    scalarize_one_by_one = FALSE
+    "<=",
+    ...,
+    hoist = hoist
   )
-  var <- conform(left@value, right@value)
-  var@mode <- "logical"
-  Fortran(glue("({left} < {right})"), var)
+  value <- conform(left@value, right@value)
+  value@mode <- "logical"
+  Fortran(glue("({left} <= {right})"), value)
 }
 
-r2f_handlers[["<="]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
-  check_ordered_operands(left, right)
-  # R compares logicals as integers; Fortran has no logical comparison.
-  .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(
-    left,
-    right,
-    hoist,
+r2f_handlers[[">"]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lower_comparison_operands(
+    args,
     scope,
-    scalarize_one_by_one = FALSE
+    ">",
+    ...,
+    hoist = hoist
+  )
+  value <- conform(left@value, right@value)
+  value@mode <- "logical"
+  Fortran(glue("({left} > {right})"), value)
+}
+
+r2f_handlers[[">="]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lower_comparison_operands(
+    args,
+    scope,
+    ">=",
+    ...,
+    hoist = hoist
   )
-  var <- conform(left@value, right@value)
-  var@mode <- "logical"
-  Fortran(glue("({left} <= {right})"), var)
+  value <- conform(left@value, right@value)
+  value@mode <- "logical"
+  Fortran(glue("({left} >= {right})"), value)
 }
 
 r2f_handlers[["=="]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
-  # R compares logicals as integers; Fortran has no logical comparison.
-  .[left, right] <- promote_arith_pair(left, right, "comparison")
-  .[left, right] <- maybe_reshape_vector_matrix(
-    left,
-    right,
-    hoist,
+  .[left, right] <- lower_comparison_operands(
+    args,
     scope,
-    scalarize_one_by_one = FALSE
+    "==",
+    ...,
+    hoist = hoist
   )
-  var <- conform(left@value, right@value)
-  var@mode <- "logical"
-  Fortran(glue("({left} == {right})"), var)
+  value <- conform(left@value, right@value)
+  value@mode <- "logical"
+  Fortran(glue("({left} == {right})"), value)
 }
 
 r2f_handlers[["!="]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lower_comparison_operands(
+    args,
+    scope,
+    "!=",
+    ...,
+    hoist = hoist
+  )
+  value <- conform(left@value, right@value)
+  value@mode <- "logical"
+  Fortran(glue("({left} /= {right})"), value)
+}
+
+lower_logical_operands <- function(args, scope, op, ..., hoist = NULL) {
   .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
-  # R compares logicals as integers; Fortran has no logical comparison.
-  .[left, right] <- promote_arith_pair(left, right, "comparison")
+  for (operand in list(left, right)) {
+    if (operand@value@mode != "logical") {
+      stop("`", op, "` requires logical operands", call. = FALSE)
+    }
+  }
+  left <- booleanize_logical_as_int(left)
+  right <- booleanize_logical_as_int(right)
   .[left, right] <- maybe_reshape_vector_matrix(
     left,
     right,
@@ -111,87 +147,38 @@ r2f_handlers[["!="]] <- function(args, scope, ..., hoist = NULL) {
     scope,
     scalarize_one_by_one = FALSE
   )
-  var <- conform(left@value, right@value)
-  var@mode <- "logical"
-  Fortran(glue("({left} /= {right})"), var)
+  list(left, right)
 }
 
-# ---- unary logical not ----
-
-r2f_handlers[["!"]] <- function(args, scope, ...) {
-  stopifnot(length(args) == 1L)
-  x <- r2f(args[[1L]], scope, ...)
-  if (x@value@mode != "logical") {
-    stop("'!' expects a logical value; numeric coercions not yet supported")
-  }
-  x <- booleanize_logical_as_int(x)
-  Fortran(glue("(.not. {x})"), Variable("logical", x@value@dims))
+r2f_handlers[["&"]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lower_logical_operands(
+    args,
+    scope,
+    "&",
+    ...,
+    hoist = hoist
+  )
+  value <- conform(left@value, right@value)
+  value@mode <- "logical"
+  Fortran(glue("{left} .and. {right}"), value)
 }
 
-register_r2f_handler(
-  "is.null",
-  function(args, scope, ...) {
-    stopifnot(length(args) == 1L)
-    arg <- args[[1L]]
-    if (!is.symbol(arg)) {
-      stop("is.null() is only supported on symbols", call. = FALSE)
-    }
-    var <- get0(as.character(arg), scope)
-    if (!inherits(var, Variable) || is.null(var@optional_dummy)) {
-      stop(
-        "is.null() is only supported for optional arguments with NULL defaults",
-        call. = FALSE
-      )
-    }
-    Fortran(glue("(.not. present({var@optional_dummy}))"), Variable("logical"))
-  }
-)
-
-
-# ---- binary logical operators ----
-
-# TODO: gfortran supports implicit casting that of logical to integer when
-# assigning a logical to a variable declared integer, converting `.true.` to `1`,
-# but this is not a standard language feature, and Intel's `ifort` uses `-1` for `.true`.
-# We should explicitly use
-#   `merge(1_c_int, 0_c_int, <lgl>)` to cast logical to int.
-register_r2f_handler(
-  c("&", "|"),
-  function(args, scope, ..., hoist = NULL) {
-    args <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
-    op <- last(list(...)$calls)
-    args <- lapply(args, function(a) {
-      if (a@value@mode != "logical") {
-        stop("`", op, "` requires logical operands", call. = FALSE)
-      }
-      a
-    })
-    .[left, right] <- args
-    left <- booleanize_logical_as_int(left)
-    right <- booleanize_logical_as_int(right)
-    .[left, right] <- maybe_reshape_vector_matrix(
-      left,
-      right,
-      hoist,
-      scope,
-      scalarize_one_by_one = FALSE
-    )
-
-    operator <- switch(op, `&` = ".and.", `|` = ".or.")
-
-    s <- glue("{left} {operator} {right}")
-    val <- conform(left@value, right@value)
-    val@mode <- "logical"
-    Fortran(s, val)
-  }
-)
-
-# ---- scalar short-circuit operators: && and || ----
+r2f_handlers[["|"]] <- function(args, scope, ..., hoist = NULL) {
+  .[left, right] <- lower_logical_operands(
+    args,
+    scope,
+    "|",
+    ...,
+    hoist = hoist
+  )
+  value <- conform(left@value, right@value)
+  value@mode <- "logical"
+  Fortran(glue("{left} .or. {right}"), value)
+}
 
-# && and || are R's *scalar* control operators: operands must be length 1
-# (R errors otherwise), and the right operand is evaluated only when the
-# left side does not already decide the answer.
-check_andor_operand <- function(x, op) {
+# && and || are scalar control operators. The right operand is conditionally
+# lowered when eager evaluation could be observable.
+check_short_circuit_operand <- function(x, op) {
   if (is.null(x@value) || !identical(x@value@mode, "logical")) {
     stop("`", op, "` requires logical operands", call. = FALSE)
   }
@@ -208,12 +195,7 @@ check_andor_operand <- function(x, op) {
   invisible(TRUE)
 }
 
-# TRUE when evaluating `e` eagerly is indistinguishable from R's lazy
-# right-operand evaluation: no side effects, no errors, no traps. A
-# conservative whitelist -- names, literals, and compositions of pure
-# non-trapping operations. Anything else (subscripts, %%/%/%, function
-# calls, ...) gets the conditional lowering.
-is_pure_scalar_condition <- function(e) {
+is_eager_safe_condition <- function(e) {
   if (is.symbol(e) || (is.atomic(e) && length(e) == 1L)) {
     return(TRUE)
   }
@@ -240,51 +222,47 @@ is_pure_scalar_condition <- function(e) {
     "/",
     "abs"
   )
-  if (!op %in% pure_ops) {
-    return(FALSE)
-  }
-  all(vapply(as.list(e)[-1L], is_pure_scalar_condition, logical(1L)))
+  op %in%
+    pure_ops &&
+    all(vapply(as.list(e)[-1L], is_eager_safe_condition, logical(1L)))
 }
 
-compile_andor <- function(args, scope, ..., hoist = NULL) {
-  op <- last(list(...)$calls)
+lower_short_circuit_operator <- function(args, scope, op, ..., hoist = NULL) {
   stopifnot(length(args) == 2L, op %in% c("&&", "||"))
 
-  # R always evaluates the left operand: its hoists stay unconditional.
   left <- r2f(args[[1L]], scope, ..., hoist = hoist)
-  check_andor_operand(left, op)
+  check_short_circuit_operand(left, op)
   left <- booleanize_logical_as_int(left)
+  fortran_op <- if (op == "&&") ".and." else ".or."
 
-  f <- if (op == "&&") ".and." else ".or."
-
-  if (is_pure_scalar_condition(args[[2L]])) {
-    # Fortran may evaluate both operands of .and./.or.; for a pure right
-    # operand that is indistinguishable from short-circuiting, so keep
-    # the compact infix form.
+  if (is_eager_safe_condition(args[[2L]])) {
     right <- r2f(args[[2L]], scope, ..., hoist = hoist)
-    check_andor_operand(right, op)
+    check_short_circuit_operand(right, op)
     right <- booleanize_logical_as_int(right)
-    return(Fortran(glue("{left} {f} {right}"), Variable("logical")))
+    return(Fortran(glue("{left} {fortran_op} {right}"), Variable("logical")))
   }
 
-  # The right operand can error or have side effects; R reaches it only
-  # when the left side does not decide. Compile it into its own hoist and
-  # emit everything inside the conditional.
   if (is.null(hoist)) {
     stop("internal error: `", op, "` requires hoist context", call. = FALSE)
   }
   sub <- new_hoist(scope)
   right <- r2f(args[[2L]], scope, ..., hoist = sub)
-  check_andor_operand(right, op)
+  check_short_circuit_operand(right, op)
   right <- booleanize_logical_as_int(right)
 
   tmp <- hoist$declare_tmp(mode = "logical", dims = NULL)
   hoist$emit(glue("{tmp@name} = {left}"))
-  cond <- if (op == "&&") tmp@name else glue(".not. {tmp@name}")
-  hoist$emit(glue("if ({cond}) then"))
+  condition <- if (op == "&&") tmp@name else glue(".not. {tmp@name}")
+  hoist$emit(glue("if ({condition}) then"))
   hoist$emit(indent(sub$render(glue("{tmp@name} = {right}"))))
   hoist$emit("end if")
   Fortran(tmp@name, tmp)
 }
 
-register_r2f_handler(c("&&", "||"), compile_andor)
+r2f_handlers[["&&"]] <- function(args, scope, ..., hoist = NULL) {
+  lower_short_circuit_operator(args, scope, "&&", ..., hoist = hoist)
+}
+
+r2f_handlers[["||"]] <- function(args, scope, ..., hoist = NULL) {
+  lower_short_circuit_operator(args, scope, "||", ..., hoist = hoist)
+}

From 82707b010fa3734176283bfa7daafd2e472dd293 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 14:22:38 +0200
Subject: [PATCH 36/97] Make && and || scalar short-circuit operators, matching
 R

&& and || compiled exactly like & and |: elementwise over vectors
(answering where R errors) and with both operands always evaluated
(Fortran .and./.or. leave evaluation order unspecified). Now operands
must be length-1 logicals -- non-scalar or non-logical operands are
compile errors -- and the right operand is evaluated only when the left
side does not decide, lowering to a conditional whenever the right side
could error or have side effects. Provably pure right operands keep the
compact infix form, so existing snapshots are unchanged.

while conditions get the matching fix: statements hoisted by the
condition's translation were emitted before the loop and evaluated
once; the loop now lowers to do + exit-check when the condition hoists
anything, so while (i <= n && x[i] > 0) re-evaluates per iteration and
never reads x(n + 1).
---
 NEWS.md                          |   9 ++
 R/r2f-control-flow.R             |  26 ++++-
 R/r2f-logical.R                  | 117 +++++++++++++++++++--
 tests/testthat/_snaps/logical.md | 173 +++++++++++++++++++++++++++++++
 tests/testthat/test-logical.R    |  63 +++++++++++
 5 files changed, 374 insertions(+), 14 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index ee3a66ea..33f9ccae 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -32,6 +32,15 @@
   build even in arithmetic, and a symbolic-length `x + m` returned a plain
   vector where R returns a `1x1` matrix.
 
+- `&&` and `||` now behave like R's scalar control operators. They
+  require length-1 logical operands (longer operands are a compile-time
+  error, as they are a runtime error in R; use `&`/`|` for elementwise
+  logic), and they short-circuit: the right operand is evaluated only when
+  the left side does not decide the answer, so idioms like
+  `while (i <= n && x[i] > 0)` are safe. Previously they compiled exactly
+  like `&`/`|` — elementwise over vectors (returning answers where R
+  errors) and with both sides always evaluated.
+
 - `solve(a, b)` now requires a square `a`, matching R. A rectangular `a`
   previously fell through to a least-squares solve (dgels), returning an
   answer where R raises `'a' (m x n) must be square`. Statically
diff --git a/R/r2f-control-flow.R b/R/r2f-control-flow.R
index 68f51f39..065ac18f 100644
--- a/R/r2f-control-flow.R
+++ b/R/r2f-control-flow.R
@@ -63,13 +63,31 @@ r2f_handlers[["next"]] <- function(args, scope, ...) {
 }
 
 # ---- while ----
-r2f_handlers[["while"]] <- function(args, scope, ...) {
+r2f_handlers[["while"]] <- function(args, scope, ..., hoist = NULL) {
   stopifnot(length(args) == 2L)
-  cond <- r2f(args[[1]], scope, ...)
-  body <- r2f(args[[2]], scope, ...) ## should we set a new hoist target here?
+  # The condition is re-evaluated every iteration, so any statements its
+  # translation hoists (e.g. the conditional lowering of `&&`/`||`) must
+  # re-run inside the loop -- the enclosing statement's hoist would
+  # evaluate them once, before the loop. Collect them separately and, when
+  # present, lower to an explicit exit check at the top of the loop body.
+  cond_hoist <- new_hoist(scope)
+  cond <- r2f(args[[1]], scope, ..., hoist = cond_hoist)
+  body <- r2f(args[[2]], scope, ..., hoist = hoist)
   check_pending_parallel_consumed(scope)
+  exit_check <- glue("if (.not. ({cond})) exit")
+  cond_code <- cond_hoist$render(exit_check)
+  if (identical(as.character(cond_code), as.character(exit_check))) {
+    # nothing hoisted: keep the plain do-while form
+    return(Fortran(glue(
+      "do while ({cond})
+      {indent(body)}
+      end do
+      "
+    )))
+  }
   Fortran(glue(
-    "do while ({cond})
+    "do
+    {indent(cond_code)}
     {indent(body)}
     end do
     "
diff --git a/R/r2f-logical.R b/R/r2f-logical.R
index dea03b5e..bf79129e 100644
--- a/R/r2f-logical.R
+++ b/R/r2f-logical.R
@@ -1,5 +1,6 @@
 # r2f-logical.R
-# Handlers for logical and comparison operators: !, &, &&, |, ||, >=, >, <, <=, ==, !=
+# Handlers for logical and comparison operators: !, &, |, >=, >, <, <=, ==, !=
+# plus the scalar short-circuit forms && and || (compile_andor below).
 
 # --- Handlers ---
 
@@ -135,14 +136,13 @@ register_r2f_handler(
 
 # ---- binary logical operators ----
 
-# TODO: the scalar || probably need some more type checking.
 # TODO: gfortran supports implicit casting that of logical to integer when
 # assigning a logical to a variable declared integer, converting `.true.` to `1`,
 # but this is not a standard language feature, and Intel's `ifort` uses `-1` for `.true`.
 # We should explicitly use
 #   `merge(1_c_int, 0_c_int, <lgl>)` to cast logical to int.
 register_r2f_handler(
-  c("&", "&&", "|", "||"),
+  c("&", "|"),
   function(args, scope, ..., hoist = NULL) {
     args <- lapply(args, r2f, scope, ..., hoist = hoist)
     args <- lapply(args, function(a) {
@@ -162,13 +162,7 @@ register_r2f_handler(
       scalarize_one_by_one = FALSE
     )
 
-    operator <- switch(
-      last(list(...)$calls),
-      `&` = ,
-      `&&` = ".and.",
-      `|` = ,
-      `||` = ".or."
-    )
+    operator <- switch(last(list(...)$calls), `&` = ".and.", `|` = ".or.")
 
     s <- glue("{left} {operator} {right}")
     val <- conform(left@value, right@value)
@@ -176,3 +170,106 @@ register_r2f_handler(
     Fortran(s, val)
   }
 )
+
+# ---- scalar short-circuit operators: && and || ----
+
+# && and || are R's *scalar* control operators: operands must be length 1
+# (R errors otherwise), and the right operand is evaluated only when the
+# left side does not already decide the answer.
+check_andor_operand <- function(x, op) {
+  if (is.null(x@value) || !identical(x@value@mode, "logical")) {
+    stop("`", op, "` requires logical operands", call. = FALSE)
+  }
+  if (!passes_as_scalar(x@value)) {
+    stop(
+      "`",
+      op,
+      "` requires length-1 operands; use `",
+      if (op == "&&") "&" else "|",
+      "` for elementwise operations",
+      call. = FALSE
+    )
+  }
+  invisible(TRUE)
+}
+
+# TRUE when evaluating `e` eagerly is indistinguishable from R's lazy
+# right-operand evaluation: no side effects, no errors, no traps. A
+# conservative whitelist -- names, literals, and compositions of pure
+# non-trapping operations. Anything else (subscripts, %%/%/%, function
+# calls, ...) gets the conditional lowering.
+is_pure_scalar_condition <- function(e) {
+  if (is.symbol(e) || (is.atomic(e) && length(e) == 1L)) {
+    return(TRUE)
+  }
+  if (!is.call(e) || !is.symbol(e[[1L]])) {
+    return(FALSE)
+  }
+  op <- as.character(e[[1L]])
+  pure_ops <- c(
+    "(",
+    "!",
+    "&&",
+    "||",
+    "&",
+    "|",
+    "<",
+    "<=",
+    ">",
+    ">=",
+    "==",
+    "!=",
+    "+",
+    "-",
+    "*",
+    "/",
+    "abs"
+  )
+  if (!op %in% pure_ops) {
+    return(FALSE)
+  }
+  all(vapply(as.list(e)[-1L], is_pure_scalar_condition, logical(1L)))
+}
+
+compile_andor <- function(args, scope, ..., hoist = NULL) {
+  op <- last(list(...)$calls)
+  stopifnot(length(args) == 2L, op %in% c("&&", "||"))
+
+  # R always evaluates the left operand: its hoists stay unconditional.
+  left <- r2f(args[[1L]], scope, ..., hoist = hoist)
+  check_andor_operand(left, op)
+  left <- booleanize_logical_as_int(left)
+
+  f <- if (op == "&&") ".and." else ".or."
+
+  if (is_pure_scalar_condition(args[[2L]])) {
+    # Fortran may evaluate both operands of .and./.or.; for a pure right
+    # operand that is indistinguishable from short-circuiting, so keep
+    # the compact infix form.
+    right <- r2f(args[[2L]], scope, ..., hoist = hoist)
+    check_andor_operand(right, op)
+    right <- booleanize_logical_as_int(right)
+    return(Fortran(glue("{left} {f} {right}"), Variable("logical")))
+  }
+
+  # The right operand can error or have side effects; R reaches it only
+  # when the left side does not decide. Compile it into its own hoist and
+  # emit everything inside the conditional.
+  if (is.null(hoist)) {
+    stop("internal error: `", op, "` requires hoist context", call. = FALSE)
+  }
+  sub <- new_hoist(scope)
+  right <- r2f(args[[2L]], scope, ..., hoist = sub)
+  check_andor_operand(right, op)
+  right <- booleanize_logical_as_int(right)
+
+  tmp <- hoist$declare_tmp(mode = "logical", dims = NULL)
+  hoist$emit(glue("{tmp@name} = {left}"))
+  cond <- if (op == "&&") tmp@name else glue(".not. {tmp@name}")
+  hoist$emit(glue("if ({cond}) then"))
+  hoist$emit(indent(sub$render(glue("{tmp@name} = {right}"))))
+  hoist$emit("end if")
+  Fortran(tmp@name, tmp)
+}
+
+register_r2f_handler(c("&&", "||"), compile_andor)
diff --git a/tests/testthat/_snaps/logical.md b/tests/testthat/_snaps/logical.md
index af76936d..7f869fbe 100644
--- a/tests/testthat/_snaps/logical.md
+++ b/tests/testthat/_snaps/logical.md
@@ -602,3 +602,176 @@
         return out_;
       }
 
+# && and || short-circuit like R's scalar operators
+
+    Code
+      fn
+    Output
+      function(i, x) {
+          declare(type(i = integer(1)), type(x = double(3)))
+          out <- 0
+          if (i <= 3L && x[i] > 0) {
+            out <- 1
+          }
+          out
+        }
+      <environment: 0x0>
+    Code
+      cat(fsub)
+    Output
+      subroutine fn(i, x, out) bind(c)
+        use iso_c_binding, only: c_double, c_int
+        implicit none
+      
+        ! manifest start
+        ! args
+        integer(c_int), intent(in) :: i
+        real(c_double), intent(in) :: x(3)
+        real(c_double), intent(out) :: out
+        ! manifest end
+      
+      
+        out = 0.0_c_double
+        block
+          logical :: btmp1_ ! logical
+      
+          btmp1_ = (i <= 3_c_int)
+          if (btmp1_) then
+            btmp1_ = (x(i) > 0.0_c_double)
+          end if
+          if (btmp1_) then
+            out = 1.0_c_double
+          end if
+        end block
+      end subroutine
+    Code
+      cat(cwrapper)
+    Output
+      #define R_NO_REMAP
+      #include <R.h>
+      #include <Rinternals.h>
+      
+      
+      extern void fn(
+        const int* const i__, 
+        const double* const x__, 
+        double* const out__);
+      
+      SEXP fn_(SEXP _args) {
+        // i
+        _args = CDR(_args);
+        SEXP i = CAR(_args);
+        if (TYPEOF(i) != INTSXP) {
+          Rf_error("typeof(i) must be 'integer', not '%s'", Rf_type2char(TYPEOF(i)));
+        }
+        const int* const i__ = INTEGER(i);
+        const R_xlen_t i__len_ = Rf_xlength(i);
+        
+        // x
+        _args = CDR(_args);
+        SEXP x = CAR(_args);
+        if (TYPEOF(x) != REALSXP) {
+          Rf_error("typeof(x) must be 'double', not '%s'", Rf_type2char(TYPEOF(x)));
+        }
+        const double* const x__ = REAL(x);
+        const R_xlen_t x__len_ = Rf_xlength(x);
+        
+        if (i__len_ != 1)
+          Rf_error("length(i) must be 1, not %0.f",
+                    (double)i__len_);
+        if (x__len_ != 3)
+          Rf_error("length(x) must be 3, not %0.f",
+                    (double)x__len_);
+        const R_xlen_t out__len_ = (1);
+        SEXP out = PROTECT(Rf_allocVector(REALSXP, out__len_));
+        double* out__ = REAL(out);
+        
+        fn(i__, x__, out__);
+        
+        UNPROTECT(1);
+        return out;
+      }
+
+# while re-evaluates hoisted condition code every iteration
+
+    Code
+      fn
+    Output
+      function(x) {
+          declare(type(x = double(n)))
+          i <- 1L
+          n <- length(x)
+          while (i <= n && x[i] > 0) {
+            i <- i + 1L
+          }
+          i
+        }
+      <environment: 0x0>
+    Code
+      cat(fsub)
+    Output
+      subroutine fn(x, i, x__len_) bind(c)
+        use iso_c_binding, only: c_double, c_int, c_ptrdiff_t
+        implicit none
+      
+        ! manifest start
+        ! sizes
+        integer(c_ptrdiff_t), intent(in), value :: x__len_
+      
+        ! args
+        real(c_double), intent(in) :: x(x__len_)
+        integer(c_int), intent(out) :: i
+      
+        ! locals
+        integer(c_int) :: n
+        ! manifest end
+      
+      
+        i = 1_c_int
+        n = size(x)
+        do
+          block
+            logical :: btmp1_ ! logical
+      
+            btmp1_ = (i <= n)
+            if (btmp1_) then
+              btmp1_ = (x(i) > 0.0_c_double)
+            end if
+            if (.not. (btmp1_)) exit
+          end block
+          i = (i + 1_c_int)
+        end do
+      end subroutine
+    Code
+      cat(cwrapper)
+    Output
+      #define R_NO_REMAP
+      #include <R.h>
+      #include <Rinternals.h>
+      
+      
+      extern void fn(
+        const double* const x__, 
+        int* const i__, 
+        const R_xlen_t x__len_);
+      
+      SEXP fn_(SEXP _args) {
+        // x
+        _args = CDR(_args);
+        SEXP x = CAR(_args);
+        if (TYPEOF(x) != REALSXP) {
+          Rf_error("typeof(x) must be 'double', not '%s'", Rf_type2char(TYPEOF(x)));
+        }
+        const double* const x__ = REAL(x);
+        const R_xlen_t x__len_ = Rf_xlength(x);
+        
+        const R_xlen_t i__len_ = (1);
+        SEXP i = PROTECT(Rf_allocVector(INTSXP, i__len_));
+        int* i__ = INTEGER(i);
+        
+        fn(x__, i__, x__len_);
+        
+        UNPROTECT(1);
+        return i;
+      }
+
diff --git a/tests/testthat/test-logical.R b/tests/testthat/test-logical.R
index bd157f52..484a7312 100644
--- a/tests/testthat/test-logical.R
+++ b/tests/testthat/test-logical.R
@@ -110,3 +110,66 @@ test_that("parentheses preserve logical precedence", {
   expect_quick_identical(fn_a, !!!cases)
   expect_quick_identical(fn_b, !!!cases)
 })
+
+test_that("&& and || require length-1 operands, like R", {
+  vec_and <- function(x, y) {
+    declare(type(x = logical(3)), type(y = logical(3)))
+    x && y
+  }
+  expect_error(quick(vec_and), "length-1 operands")
+
+  vec_or <- function(x, y) {
+    declare(type(x = logical(n)), type(y = logical(n)))
+    x || y
+  }
+  expect_error(quick(vec_or), "length-1 operands")
+
+  numeric_and <- function(a, b) {
+    declare(type(a = double(1)), type(b = double(1)))
+    a && b
+  }
+  expect_error(quick(numeric_and), "logical operands")
+})
+
+test_that("&& and || short-circuit like R's scalar operators", {
+  # The right operand indexes past the end of x whenever the left side
+  # already decides; R never evaluates it.
+  guarded_index <- function(i, x) {
+    declare(type(i = integer(1)), type(x = double(3)))
+    out <- 0
+    if (i <= 3L && x[i] > 0) {
+      out <- 1
+    }
+    out
+  }
+  expect_translation_snapshots(guarded_index)
+  expect_quick_identical(guarded_index, list(5L, c(1, 2, 3)))
+  expect_quick_identical(guarded_index, list(2L, c(1, 2, 3)))
+  expect_quick_identical(guarded_index, list(2L, c(1, -2, 3)))
+
+  or_guarded <- function(a, x, i) {
+    declare(type(a = logical(1)), type(x = double(2)), type(i = integer(1)))
+    out <- a || x[i] > 0
+    out
+  }
+  expect_quick_identical(or_guarded, list(TRUE, c(1, 2), 9L))
+  expect_quick_identical(or_guarded, list(FALSE, c(-1, 2), 2L))
+})
+
+test_that("while re-evaluates hoisted condition code every iteration", {
+  # The canonical scan idiom: the && lowering hoists statements, which
+  # must re-run per iteration, not once before the loop.
+  scan_positive <- function(x) {
+    declare(type(x = double(n)))
+    i <- 1L
+    n <- length(x)
+    while (i <= n && x[i] > 0) {
+      i <- i + 1L
+    }
+    i
+  }
+  expect_translation_snapshots(scan_positive)
+  expect_quick_identical(scan_positive, list(c(1, 2, -1, 5)))
+  expect_quick_identical(scan_positive, list(c(1, 2, 3)))
+  expect_quick_identical(scan_positive, list(c(-1, 2)))
+})

From d70b883e5c4cd115575ae50481ab7eeb31b65141 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 14:55:44 +0200
Subject: [PATCH 37/97] Update the semantics vignette for the 08a-08d behavior
 changes

solve() with a rectangular a is no longer a documented divergence -- it
now errors like R, stated in the linear-algebra section. New divergence
section: logical operators require logical operands, with &&/||'s
scalar short-circuit semantics. The types section states the character
and complex boundaries as clean errors (matching R where R errors too).
---
 vignettes/quickr-semantics.Rmd | 30 ++++++++++++++++++++++--------
 1 file changed, 22 insertions(+), 8 deletions(-)

diff --git a/vignettes/quickr-semantics.Rmd b/vignettes/quickr-semantics.Rmd
index 2c861a18..4c61ff16 100644
--- a/vignettes/quickr-semantics.Rmd
+++ b/vignettes/quickr-semantics.Rmd
@@ -44,6 +44,11 @@ Value types follow R's promotion order for the supported atomic modes:
 logical < integer < double < complex
 ```
 
+Character values are not supported (declaring a `character` argument is
+a compile error). Complex values support arithmetic and equality
+comparisons; order comparisons (`<`, `<=`, `>`, `>=`) and `%%` are
+errors, exactly as they are in R.
+
 An operation's result type is the "join" of its operands' types — the
 highest type among them — except where R fixes the result type, which
 quickr then matches:
@@ -55,7 +60,7 @@ quickr then matches:
 | `^` | always double (see note below) |
 | `%%`, `%/%` | join of the operand types; logicals count as integers |
 | `<` `<=` `>` `>=` `==` `!=` | logical |
-| `&`, `|`, `!` | logical |
+| `&`, `|`, `!`, `&&`, `||` | logical (see [logical operators](#logical-operators) below) |
 | `c()`, and multi-argument `min()` / `max()` / `sum()` / `prod()` | join of all argument types |
 | single-argument reductions (`sum(x)`, ...), `abs()` | type of `x`; logical counts as integer |
 | `ifelse(test, yes, no)` | join of `yes` and `no` (but see [ifelse](#ifelse) below) |
@@ -200,6 +205,11 @@ f(matrix(1, 2, 3), matrix(1, 2, 2))
 #> Error: non-conformable arguments in %*%
 ```
 
+`solve(a, b)` requires a square `a`, as in R: a statically rectangular
+system is a compile error, and when squareness depends on runtime sizes
+it is checked before the solve. Use `qr.solve()` for least-squares
+solutions of rectangular systems.
+
 ## Differences from R
 
 Everything listed here is an *error* divergence: a compiled function
@@ -283,14 +293,18 @@ quick(function(t, a, b) {
 #>   with scalar test is not supported
 ```
 
-### `solve(a, b)` with a rectangular `a` solves least squares
+### Logical operators require logical operands {#logical-operators}
+
+R coerces numeric operands to logical (`1 & 2` is `TRUE`); quickr
+requires the operands of `&`, `|`, `&&`, and `||` to already be logical
+and errors otherwise.
 
-R's `solve()` requires a square matrix. When `a`'s squareness is not
-known at compile time, quickr lowers `solve(a, b)` to a solver that
-handles both the square case (like R's `solve()`) and the rectangular
-case as a least-squares problem (like R's `qr.solve()`). So for
-rectangular `a`, `solve(a, b)` returns the least-squares solution where
-R raises `'a' (3 x 2) must be square`.
+`&&` and `||` otherwise follow R's scalar semantics: operands must be
+length 1 (a compile error in quickr; R raises the equivalent error at
+run time), and they short-circuit — the right operand is evaluated only
+when the left side does not decide the answer, so a guarded access like
+`i <= n && x[i] > 0` never evaluates `x[i]` out of range. For
+elementwise logic over vectors, use `&` and `|`.
 
 ### Closure arguments are evaluated eagerly
 

From bc857e200f6e8f1e2532ec19a398e9303e4d2248 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 11 Jul 2026 12:15:07 +0200
Subject: [PATCH 38/97] Clarify lowering and inference helper names

---
 R/r2f-arithmetic.R         | 40 +++++++++++++++++++++++++-------------
 R/r2f-constructors.R       | 12 ++++++------
 R/r2f-logical.R            | 20 +++++++++----------
 R/r2f-matrix-blas.R        | 38 ++++++++++++++++++------------------
 R/r2f-operators-helpers.R  | 39 ++++++++++++++++++-------------------
 R/r2f-reductions-helpers.R |  2 +-
 R/r2f-reductions.R         | 15 +++++++-------
 R/r2f-subscript.R          |  8 ++++----
 8 files changed, 93 insertions(+), 81 deletions(-)

diff --git a/R/r2f-arithmetic.R b/R/r2f-arithmetic.R
index 7f69f5b0..bcf176b1 100644
--- a/R/r2f-arithmetic.R
+++ b/R/r2f-arithmetic.R
@@ -18,8 +18,11 @@ r2f_handlers[["+"]] <- function(args, scope, ..., hoist = NULL) {
       hoist = hoist
     )
     .[left, right] <- promote_arith_pair(left, right, "+")
-    .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
-    Fortran(glue("({left} + {right})"), conform(left@value, right@value))
+    .[left, right] <- conform_elementwise_operands(left, right, hoist, scope)
+    Fortran(
+      glue("({left} + {right})"),
+      infer_result_variable(left@value, right@value)
+    )
   }
 }
 
@@ -38,24 +41,33 @@ r2f_handlers[["-"]] <- function(args, scope, ..., hoist = NULL) {
       hoist = hoist
     )
     .[left, right] <- promote_arith_pair(left, right, "-")
-    .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
-    Fortran(glue("({left} - {right})"), conform(left@value, right@value))
+    .[left, right] <- conform_elementwise_operands(left, right, hoist, scope)
+    Fortran(
+      glue("({left} - {right})"),
+      infer_result_variable(left@value, right@value)
+    )
   }
 }
 
 r2f_handlers[["*"]] <- function(args, scope = NULL, ..., hoist = NULL) {
   .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   .[left, right] <- promote_arith_pair(left, right, "*")
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
-  Fortran(glue("({left} * {right})"), conform(left@value, right@value))
+  .[left, right] <- conform_elementwise_operands(left, right, hoist, scope)
+  Fortran(
+    glue("({left} * {right})"),
+    infer_result_variable(left@value, right@value)
+  )
 }
 
 r2f_handlers[["/"]] <- function(args, scope = NULL, ..., hoist = NULL) {
   .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   left <- maybe_cast_double(left)
   right <- maybe_cast_double(right)
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
-  Fortran(glue("({left} / {right})"), conform(left@value, right@value))
+  .[left, right] <- conform_elementwise_operands(left, right, hoist, scope)
+  Fortran(
+    glue("({left} / {right})"),
+    infer_result_variable(left@value, right@value)
+  )
 }
 
 r2f_handlers[["^"]] <- function(args, scope, ..., hoist = NULL) {
@@ -68,7 +80,7 @@ r2f_handlers[["^"]] <- function(args, scope, ..., hoist = NULL) {
   if (identical(right@value@mode, "logical")) {
     right <- cast_to_mode(right, "integer", "^")
   }
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
+  .[left, right] <- conform_elementwise_operands(left, right, hoist, scope)
   mode <- reduce_promoted_mode(left, right)
   if (!identical(mode, "complex")) {
     mode <- "double"
@@ -76,7 +88,7 @@ r2f_handlers[["^"]] <- function(args, scope, ..., hoist = NULL) {
   # Parenthesizing the exponent avoids non-standard `** -1_c_int`.
   Fortran(
     glue("({left} ** ({right}))"),
-    conform(left@value, right@value, mode = mode)
+    infer_result_variable(left@value, right@value, mode = mode)
   )
 }
 
@@ -104,8 +116,8 @@ r2f_handlers[["%%"]] <- function(args, scope, ..., hoist = NULL) {
   }
   left <- cast_to_mode(left, mode, "%%")
   right <- cast_to_mode(right, mode, "%%")
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
-  out_val <- conform(left@value, right@value)
+  .[left, right] <- conform_elementwise_operands(left, right, hoist, scope)
+  out_val <- infer_result_variable(left@value, right@value)
   # MODULO gives result with sign(right) - matches R %% behaviour
   Fortran(glue("modulo({left}, {right})"), out_val)
 }
@@ -113,8 +125,8 @@ r2f_handlers[["%%"]] <- function(args, scope, ..., hoist = NULL) {
 r2f_handlers[["%/%"]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   .[left, right] <- promote_arith_pair(left, right, "%/%")
-  .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
-  out_val <- conform(left@value, right@value)
+  .[left, right] <- conform_elementwise_operands(left, right, hoist, scope)
+  out_val <- infer_result_variable(left@value, right@value)
 
   expr <- switch(
     out_val@mode,
diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index 19ad5124..4350b9cc 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -22,7 +22,7 @@ is_fill_constructor_call <- function(e) {
 # `a:b` sequences, and symbols bound to a known literal vector; anything
 # else falls through to r2dims().
 # Used by: array()
-array_dim_to_dims <- function(dim_arg, scope) {
+parse_array_dims <- function(dim_arg, scope) {
   if (
     is.atomic(dim_arg) &&
       typeof(dim_arg) %in% c("integer", "double")
@@ -80,7 +80,7 @@ array_dim_to_dims <- function(dim_arg, scope) {
         (is.language(var@r) || is.atomic(var@r)) &&
         !identical(var@r, dim_arg)
     ) {
-      return(array_dim_to_dims(var@r, scope))
+      return(parse_array_dims(var@r, scope))
     }
   }
 
@@ -90,7 +90,7 @@ array_dim_to_dims <- function(dim_arg, scope) {
 # Product of a dims list when every dim is a known whole number, NA_real_
 # otherwise (in double to dodge integer overflow on large dims).
 # Used by: array()
-known_dims_prod <- function(dims) {
+known_dims_product <- function(dims) {
   if (is.null(dims) || !length(dims)) {
     return(1)
   }
@@ -389,7 +389,7 @@ r2f_handlers[["array"]] <- function(args, scope = NULL, ..., hoist = NULL) {
   }
 
   out <- r2f(args$data, scope, ..., hoist = hoist)
-  target_dims <- array_dim_to_dims(args$dim, scope)
+  target_dims <- parse_array_dims(args$dim, scope)
   if (!length(target_dims)) {
     stop("array(dim=) must not be empty", call. = FALSE)
   }
@@ -447,8 +447,8 @@ r2f_handlers[["array"]] <- function(args, scope = NULL, ..., hoist = NULL) {
         i <- scope_unique_var(scope, "integer")
         glue("[({out}, {i}=1, int({n_expr}))]")
       } else {
-        n_target <- known_dims_prod(target_dims)
-        n_source <- known_dims_prod(out@value@dims)
+        n_target <- known_dims_product(target_dims)
+        n_source <- known_dims_product(out@value@dims)
         if (!is.na(n_target) && !is.na(n_source) && n_target > n_source) {
           stop(
             "array() reshape does not support recycling: prod(dim)=",
diff --git a/R/r2f-logical.R b/R/r2f-logical.R
index 4a94a87d..4300d9f5 100644
--- a/R/r2f-logical.R
+++ b/R/r2f-logical.R
@@ -44,7 +44,7 @@ lower_comparison_operands <- function(args, scope, op, ..., hoist = NULL) {
     stop("invalid comparison with complex values", call. = FALSE)
   }
   .[left, right] <- promote_arith_pair(left, right, "comparison")
-  maybe_reshape_vector_matrix(
+  conform_elementwise_operands(
     left,
     right,
     hoist,
@@ -61,7 +61,7 @@ r2f_handlers[["<"]] <- function(args, scope, ..., hoist = NULL) {
     ...,
     hoist = hoist
   )
-  value <- conform(left@value, right@value)
+  value <- infer_result_variable(left@value, right@value)
   value@mode <- "logical"
   Fortran(glue("({left} < {right})"), value)
 }
@@ -74,7 +74,7 @@ r2f_handlers[["<="]] <- function(args, scope, ..., hoist = NULL) {
     ...,
     hoist = hoist
   )
-  value <- conform(left@value, right@value)
+  value <- infer_result_variable(left@value, right@value)
   value@mode <- "logical"
   Fortran(glue("({left} <= {right})"), value)
 }
@@ -87,7 +87,7 @@ r2f_handlers[[">"]] <- function(args, scope, ..., hoist = NULL) {
     ...,
     hoist = hoist
   )
-  value <- conform(left@value, right@value)
+  value <- infer_result_variable(left@value, right@value)
   value@mode <- "logical"
   Fortran(glue("({left} > {right})"), value)
 }
@@ -100,7 +100,7 @@ r2f_handlers[[">="]] <- function(args, scope, ..., hoist = NULL) {
     ...,
     hoist = hoist
   )
-  value <- conform(left@value, right@value)
+  value <- infer_result_variable(left@value, right@value)
   value@mode <- "logical"
   Fortran(glue("({left} >= {right})"), value)
 }
@@ -113,7 +113,7 @@ r2f_handlers[["=="]] <- function(args, scope, ..., hoist = NULL) {
     ...,
     hoist = hoist
   )
-  value <- conform(left@value, right@value)
+  value <- infer_result_variable(left@value, right@value)
   value@mode <- "logical"
   Fortran(glue("({left} == {right})"), value)
 }
@@ -126,7 +126,7 @@ r2f_handlers[["!="]] <- function(args, scope, ..., hoist = NULL) {
     ...,
     hoist = hoist
   )
-  value <- conform(left@value, right@value)
+  value <- infer_result_variable(left@value, right@value)
   value@mode <- "logical"
   Fortran(glue("({left} /= {right})"), value)
 }
@@ -140,7 +140,7 @@ lower_logical_operands <- function(args, scope, op, ..., hoist = NULL) {
   }
   left <- booleanize_logical_as_int(left)
   right <- booleanize_logical_as_int(right)
-  .[left, right] <- maybe_reshape_vector_matrix(
+  .[left, right] <- conform_elementwise_operands(
     left,
     right,
     hoist,
@@ -158,7 +158,7 @@ r2f_handlers[["&"]] <- function(args, scope, ..., hoist = NULL) {
     ...,
     hoist = hoist
   )
-  value <- conform(left@value, right@value)
+  value <- infer_result_variable(left@value, right@value)
   value@mode <- "logical"
   Fortran(glue("{left} .and. {right}"), value)
 }
@@ -171,7 +171,7 @@ r2f_handlers[["|"]] <- function(args, scope, ..., hoist = NULL) {
     ...,
     hoist = hoist
   )
-  value <- conform(left@value, right@value)
+  value <- infer_result_variable(left@value, right@value)
   value@mode <- "logical"
   Fortran(glue("{left} .or. {right}"), value)
 }
diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 5fb53812..e2de10ca 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -38,7 +38,7 @@ assert_rank_leq2 <- function(x, message) {
 }
 
 # Assert right-hand side rank is vector or matrix.
-assert_rhs_rank <- function(rank, err_scalar, err_high) {
+assert_vector_or_matrix_rhs <- function(rank, err_scalar, err_high) {
   stopifnot(is_wholenumber(rank), is_string(err_scalar), is_string(err_high))
   if (rank > 2L) {
     stop(err_high, call. = FALSE)
@@ -198,7 +198,7 @@ assert_square_matrix <- function(dims, operand, context, hoist, scope) {
 # through a hoisted temporary and the assignment shape check guards (or
 # refuses) the copy. Accepting an unproven dest passed wrong leading
 # dimensions to the BLAS call and could write past the allocation.
-dest_dims_proven <- function(dest, expected_dims) {
+dest_dims_proven_equal <- function(dest, expected_dims) {
   if (is.null(expected_dims)) {
     return(FALSE)
   }
@@ -235,7 +235,7 @@ can_use_output <- function(
   if (!identical(logical_as_int(dest), logical_is_c_int)) {
     return(FALSE)
   }
-  if (!dest_dims_proven(dest, expected_dims)) {
+  if (!dest_dims_proven_equal(dest, expected_dims)) {
     return(FALSE)
   }
   output_name <- dest@name
@@ -255,7 +255,7 @@ can_use_output <- function(
 # Resolve where a BLAS/LAPACK emitter writes its result: the assignment
 # destination when can_use_output() allows it, otherwise a hoisted
 # temporary declared with the expected dims. Returns list(var, name,
-# use_dest); wrap up with blas_output_fortran().
+# use_dest); wrap up with finalize_blas_output().
 resolve_blas_output <- function(
   dest,
   hoist,
@@ -289,7 +289,7 @@ resolve_blas_output <- function(
 
 # Wrap a resolved output as the emitter's return value, marking
 # destination writes so the assignment handler skips the copy.
-blas_output_fortran <- function(out) {
+finalize_blas_output <- function(out) {
   f <- Fortran(out$name, out$var)
   if (out$use_dest) {
     f@writes_to_dest <- TRUE
@@ -395,7 +395,7 @@ gemm <- function(
   hoist$emit(glue(
     "call dgemm('{opA}','{opB}', {blas_int(m)}, {blas_int(n)}, {blas_int(k)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {B_name}, {blas_int(ldb)}, 0.0_c_double, {out$name}, {blas_int(ldc_expr)})"
   ))
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 # gemv: centralized BLAS GEMV emission with optional destination.
@@ -428,7 +428,7 @@ gemv <- function(
   hoist$emit(glue(
     "call dgemv('{transA}', {blas_int(m)}, {blas_int(n)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {x_name}, 1_c_int, 0.0_c_double, {out$name}, 1_c_int)"
   ))
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 symmetrize_upper_to_lower <- function(target, n, hoist) {
@@ -520,7 +520,7 @@ syrk <- function(
   ))
   symmetrize_upper_to_lower(out$name, n, hoist = hoist)
 
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 # Emit BLAS outer product for vectors or scalars with optional destination.
@@ -558,7 +558,7 @@ outer_mul <- function(
   hoist$emit(glue(
     "call dger({blas_int(m)}, {blas_int(n)}, 1.0_c_double, {x_name}, 1_c_int, {y_name}, 1_c_int, {out$name}, {blas_int(m)})"
   ))
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 # Emit triangular solve (vector or matrix RHS) with optional destination.
@@ -585,7 +585,7 @@ triangular_solve <- function(
   n <- a_dims$rows
 
   b_rank <- B@value@rank
-  assert_rhs_rank(
+  assert_vector_or_matrix_rhs(
     b_rank,
     err_scalar = "triangular solve expects a vector or matrix right-hand side",
     err_high = "triangular solve only supports vector or matrix right-hand sides"
@@ -630,7 +630,7 @@ triangular_solve <- function(
     ))
   }
 
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 lapack_solve <- function(
@@ -654,7 +654,7 @@ lapack_solve <- function(
   n <- a_dims$cols
 
   b_rank <- B@value@rank
-  assert_rhs_rank(
+  assert_vector_or_matrix_rhs(
     b_rank,
     err_scalar = paste0(context, " expects a vector or matrix right-hand side"),
     err_high = paste0(
@@ -777,7 +777,7 @@ lapack_solve_gesv <- function(
     hoist,
     scope
   )
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 # Least-squares solve via the LINPACK dqrdc2/dqrcf pair (R's own qr()
@@ -893,7 +893,7 @@ end do"
       ))
     }
   }
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 lapack_inverse <- function(A, scope, hoist, dest = NULL, context = "solve") {
@@ -944,7 +944,7 @@ lapack_inverse <- function(A, scope, hoist, dest = NULL, context = "solve") {
     scope
   )
 
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 lapack_chol <- function(A, scope, hoist, dest = NULL, context = "chol") {
@@ -983,7 +983,7 @@ lapack_chol <- function(A, scope, hoist, dest = NULL, context = "chol") {
   )
   zero_lower_triangle(out$name, n, hoist = hoist)
 
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 lapack_chol2inv <- function(
@@ -1028,7 +1028,7 @@ lapack_chol2inv <- function(
   )
   symmetrize_upper_to_lower(out$name, n, hoist = hoist)
 
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 diag_extract <- function(x, scope, hoist, dest = NULL, context = "diag") {
@@ -1062,7 +1062,7 @@ do {idx_i@name} = 1_c_int, {blas_int(diag_len)}
 end do"
   ))
 
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 diag_matrix <- function(
@@ -1126,7 +1126,7 @@ do {idx_i@name} = 1_c_int, {blas_int(diag_len)}
 end do"
   ))
 
-  blas_output_fortran(out)
+  finalize_blas_output(out)
 }
 
 svd_dims <- function(A, context = "svd") {
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 00941bd1..47406b01 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -29,8 +29,7 @@ booleanize_logical_as_int <- function(x) {
 # The only place cast spellings live; errors on casts it cannot spell
 # (complex/character operands, or any narrowing) so an unsupported mode is
 # a clean diagnostic instead of invalid generated Fortran.
-# Used by: r2f-arithmetic.R, r2f-logical.R, r2f-constructors.R,
-#          r2f-reductions.R, r2f-matrix.R
+# Used by: r2f-arithmetic.R, r2f-math.R, r2f-reductions.R, r2f-subscript.R
 cast_to_mode <- function(x, mode, context = "operand") {
   stopifnot(inherits(x, Fortran))
   if (
@@ -107,7 +106,7 @@ cast_linalg_double <- function(x, context) {
 # each one whose mode differs. For contexts where Fortran requires uniform
 # argument types: array constructors (c()), min/max, merge, modulo.
 # Returns list(args = <cast operands>, mode = <join>).
-# Used by: r2f-arithmetic.R, r2f-constructors.R, r2f-reductions.R
+# Used by: r2f-conditionals.R, r2f-constructors.R
 promote_operands <- function(args, context = "operator") {
   mode <- reduce_promoted_mode(args)
   list(
@@ -229,20 +228,20 @@ lower_elementwise_operands <- function(args, scope, ..., hoist = NULL) {
 }
 
 # Check if a dimension expression equals 1.
-# Used by: r2f-arithmetic.R, r2f-logical.R
+# Used by: r2f-matrix.R, is_one_by_one()
 dim_is_one <- function(x) {
   is_wholenumber(x) && identical(as.integer(x), 1L)
 }
 
 # Check if a dimension expression is statically known and not 1. Symbolic
 # dimensions are FALSE: "not provably 1" is not "provably not 1".
-# Used by: maybe_reshape_vector_matrix()
+# Used by: conform_elementwise_operands()
 dim_known_not_one <- function(x) {
   is_wholenumber(x) && !identical(as.integer(x), 1L)
 }
 
 # Check if a Fortran value is a 1x1 matrix.
-# Used by: r2f-arithmetic.R, r2f-logical.R
+# Used by: conform_elementwise_operands()
 is_one_by_one <- function(x) {
   stopifnot(inherits(x, Fortran))
   x@value@rank == 2L &&
@@ -269,7 +268,7 @@ dims_match <- function(left, right) {
 # Stronger than dims_match() (normalizes symbols), stricter than
 # check_elementwise_lengths() (an incomparable pair is FALSE, not a
 # deferred runtime guard).
-# Used by: r2f-matrix-blas.R (dest_dims_proven)
+# Used by: r2f-matrix-blas.R (dest_dims_proven_equal)
 dims_proven_equal <- function(left, right) {
   if (is_scalar_na(left) || is_scalar_na(right)) {
     return(FALSE)
@@ -321,7 +320,7 @@ elementwise_matrix_msg <-
 # inquiry, so applying it to operand expression text does not evaluate the
 # operand.
 # Used by: guard_conformable_dims()
-guard_dim_f <- function(dim, operand, axis = NULL, f = NULL) {
+dimension_guard_expr <- function(dim, operand, axis = NULL, f = NULL) {
   if (!is.null(f)) {
     return(f)
   }
@@ -345,9 +344,9 @@ guard_dim_f <- function(dim, operand, axis = NULL, f = NULL) {
 # `hoist` is always live: r2f() opens one per statement before dispatching
 # to a handler, and every caller forwards the one it received.
 # emit_quickr_error_if() asserts it.
-# Used by: maybe_reshape_vector_matrix(), lower_elementwise_operands(),
+# Used by: conform_elementwise_operands(), lower_elementwise_operands(),
 # r2f-conditionals.R, r2f-matrix*.R. `left_f`/`right_f` override that
-# side's guard spelling (see guard_dim_f()); its `left`/`right` operand is
+# side's guard spelling (see dimension_guard_expr()); its `left`/`right` operand is
 # then unused and may be NULL.
 guard_conformable_dims <- function(
   left_dim,
@@ -363,14 +362,14 @@ guard_conformable_dims <- function(
   right_f = NULL
 ) {
   stopifnot(is_string(message))
-  conform <- check_elementwise_lengths(left_dim, right_dim)
-  if (!conform$ok) {
+  length_check <- check_elementwise_lengths(left_dim, right_dim)
+  if (!length_check$ok) {
     stop(message, call. = FALSE)
   }
-  if (conform$unknown) {
+  if (length_check$unknown) {
     emit_quickr_error_if(
       glue(
-        "{guard_dim_f(left_dim, left, left_axis, left_f)} /= {guard_dim_f(right_dim, right, right_axis, right_f)}"
+        "{dimension_guard_expr(left_dim, left, left_axis, left_f)} /= {dimension_guard_expr(right_dim, right, right_axis, right_f)}"
       ),
       message,
       hoist,
@@ -381,7 +380,7 @@ guard_conformable_dims <- function(
 }
 
 # Reshape a vector to match a matrix's dimensions.
-# Used by: r2f-arithmetic.R, r2f-logical.R
+# Used by: r2f-constructors.R, conform_elementwise_operands()
 reshape_vector_for_matrix <- function(vec, rows, cols) {
   stopifnot(inherits(vec, Fortran))
   out_val <- Variable(vec@value@mode, list(rows, cols))
@@ -408,7 +407,7 @@ real_floor_expr <- function(x) {
 }
 
 # Convert a 1x1 matrix to a scalar.
-# Used by: r2f-arithmetic.R, r2f-logical.R
+# Used by: r2f-matrix.R, conform_elementwise_operands()
 scalarize_matrix <- function(mat) {
   stopifnot(inherits(mat, Fortran))
   out_val <- Variable(mat@value@mode)
@@ -432,7 +431,7 @@ scalarize_matrix <- function(mat) {
 # so strict callers pass FALSE and the 1x1 always takes the vector-matrix
 # path.
 # Used by: r2f-arithmetic.R, r2f-logical.R
-maybe_reshape_vector_matrix <- function(
+conform_elementwise_operands <- function(
   left,
   right,
   hoist,
@@ -740,7 +739,7 @@ check_reassignment_narrowing <- function(name, target, value) {
 }
 
 # Determine the promoted mode from a list of Fortran values.
-# Used by: r2f-arithmetic.R, r2f-constructors.R
+# Used by: r2f-arithmetic.R, r2f-matrix.R
 reduce_promoted_mode <- function(...) {
   getmode <- function(d) {
     if (inherits(d, Fortran)) {
@@ -764,8 +763,8 @@ reduce_promoted_mode <- function(...) {
 }
 
 # Create a Variable with conforming dimensions from multiple inputs.
-# Used by: r2f-arithmetic.R, r2f-logical.R, r2f-constructors.R, r2f-conditionals.R
-conform <- function(..., mode = NULL) {
+# Used by: r2f-arithmetic.R, r2f-logical.R
+infer_result_variable <- function(..., mode = NULL) {
   vars <- drop_nulls(list(...))
   # Report the promoted (lattice-join) mode: the emitted expression already
   # promotes (Fortran's rules match R for numeric mixes), and `<-` copies
diff --git a/R/r2f-reductions-helpers.R b/R/r2f-reductions-helpers.R
index e6565b54..0c082693 100644
--- a/R/r2f-reductions-helpers.R
+++ b/R/r2f-reductions-helpers.R
@@ -38,7 +38,7 @@ create_mask_hoist <- function() {
 # arguments. A conflicting second mask within the same context is a
 # clean compile error.
 # Used by: r2f-reductions.R (max/min/sum/prod and any/all)
-reduce_arg_with_mask <- function(arg, scope, mask_hoist, dots) {
+lower_masked_reduction_arg <- function(arg, scope, mask_hoist, dots) {
   x <- r2f(
     arg,
     scope,
diff --git a/R/r2f-reductions.R b/R/r2f-reductions.R
index f477b774..af5a09c9 100644
--- a/R/r2f-reductions.R
+++ b/R/r2f-reductions.R
@@ -10,7 +10,7 @@
 # ("[ ... ]") even when its value passes as a scalar; any()/all() must
 # wrap such values to reduce them back to a scalar expression.
 # Used by: any/all handler
-renders_as_array_ctor <- function(f) {
+renders_as_array_constructor <- function(f) {
   startsWith(trimws(as.character(f)), "[")
 }
 
@@ -51,7 +51,7 @@ register_r2f_handler(
 
     reduce_arg <- function(arg) {
       mask_hoist <- create_mask_hoist()
-      x <- reduce_arg_with_mask(arg, scope, mask_hoist, list(...))
+      x <- lower_masked_reduction_arg(arg, scope, mask_hoist, list(...))
       # R's numeric reductions treat logicals as integers (sum(TRUE) is 1L),
       # and Fortran's sum/product/minval/maxval reject logical arrays.
       x <- cast_to_mode(x, arith_join_mode(x), sprintf("%s()", call_name))
@@ -129,7 +129,7 @@ register_r2f_handler(
 
     reduce_arg <- function(arg) {
       mask_hoist <- create_mask_hoist()
-      x <- reduce_arg_with_mask(arg, scope, mask_hoist, list(...))
+      x <- lower_masked_reduction_arg(arg, scope, mask_hoist, list(...))
 
       if (!identical(x@value@mode, "logical")) {
         stop("any()/all() only implemented for logical", call. = FALSE)
@@ -142,7 +142,7 @@ register_r2f_handler(
         if (is.null(hoisted_mask)) {
           # `c(FALSE)` lowers to a 1-element Fortran array constructor
           # (`[.false.]`) but any()/all() must still return scalars.
-          if (renders_as_array_ctor(x)) {
+          if (renders_as_array_constructor(x)) {
             return(Fortran(glue("{intrinsic}({x})"), Variable("logical")))
           }
           return(x)
@@ -159,7 +159,7 @@ register_r2f_handler(
         mask_is_scalar <-
           !is.null(hoisted_mask@value) &&
           passes_as_scalar(hoisted_mask@value) &&
-          !renders_as_array_ctor(hoisted_mask)
+          !renders_as_array_constructor(hoisted_mask)
 
         mask_len1 <- is_declared_len1(hoisted_mask)
 
@@ -181,7 +181,7 @@ register_r2f_handler(
         # - any(logical(0)) == FALSE
         # - all(logical(0)) == TRUE
         identity <- if (identical(call_name, "any")) ".false." else ".true."
-        x_scalar <- if (renders_as_array_ctor(x)) {
+        x_scalar <- if (renders_as_array_constructor(x)) {
           glue("{intrinsic}({x})")
         } else {
           glue("{x}")
@@ -204,7 +204,8 @@ register_r2f_handler(
         # array constructor (`[ .true. ]`). In R, this is recycled as a scalar
         # mask, so we must scalarize it to keep elementwise ops conformable.
         mask_ctor_len1 <-
-          renders_as_array_ctor(hoisted_mask) && is_declared_len1(hoisted_mask)
+          renders_as_array_constructor(hoisted_mask) &&
+          is_declared_len1(hoisted_mask)
         mask_expr <- if (mask_ctor_len1) {
           glue("any({hoisted_mask})")
         } else {
diff --git a/R/r2f-subscript.R b/R/r2f-subscript.R
index 5a04f45b..ba37801e 100644
--- a/R/r2f-subscript.R
+++ b/R/r2f-subscript.R
@@ -9,7 +9,7 @@
 # Fortran subscripts must be integers; coerce a double subscript
 # expression with a c_ptrdiff_t cast. (Not cast_to_mode(), which refuses
 # narrowing casts by design.)
-subscript_as_index_int <- function(sub) {
+cast_subscript_to_integer <- function(sub) {
   if (sub@value@mode == "double") {
     Fortran(
       glue("int({sub}, kind=c_ptrdiff_t)"),
@@ -32,7 +32,7 @@ lower_subscript_args <- function(idx_args, base_dims, scope, ..., hoist) {
     if (is_missing(idx)) {
       Fortran(":", Variable("integer", base_dims[[i]]))
     } else {
-      subscript_as_index_int(r2f(idx, scope, ..., hoist = hoist))
+      cast_subscript_to_integer(r2f(idx, scope, ..., hoist = hoist))
     }
   })
 }
@@ -184,7 +184,7 @@ r2f_handlers[["["]] <- function(
           }
 
           if (is_call(r, quote(`:`)) && length(r) == 3L) {
-            return(subscript_as_index_int(
+            return(cast_subscript_to_integer(
               r2f(r[[2L]], scope, ..., hoist = hoist)
             ))
           }
@@ -202,7 +202,7 @@ r2f_handlers[["["]] <- function(
 
           if (is_call(r, quote(seq))) {
             info <- seq_like_parse("seq", as.list(r)[-1L], scope)
-            return(subscript_as_index_int(
+            return(cast_subscript_to_integer(
               r2f(info$from, scope, ..., hoist = hoist)
             ))
           }

From b92efe7dca5abd499d24970271d01539d4aee397 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 11:48:34 +0200
Subject: [PATCH 39/97] Give single-statement while/repeat bodies their own
 hoist target

while and repeat forwarded the enclosing statement's hoist into the loop
body. A `{` body is unaffected (each statement gets its own hoist), but
a single-statement body's hoisted code -- BLAS calls, temporaries,
runtime guards -- was emitted once, before the loop:

    while (m[1, 1] < 8) m <- m %*% m

compiled the dgemm call ahead of `do while` with `m = btmp1_` as the
loop body, an infinite loop (or stale result) where R terminates. Both
bodies now compile with their own per-statement hoist, exactly as `{`
bodies, the `if` handler's branches and (since #141) the `for` handler
already do. Pre-existing bug (predates this branch), surfaced by review
(fable-final-review.md #1); the condition-side fix in the previous
commit made the pattern obvious.
---
 R/r2f-control-flow.R           |  14 ++-
 tests/testthat/_snaps/loops.md | 150 +++++++++++++++++++++++++++++++++
 tests/testthat/test-loops.R    |  25 ++++++
 3 files changed, 186 insertions(+), 3 deletions(-)

diff --git a/R/r2f-control-flow.R b/R/r2f-control-flow.R
index 065ac18f..47ac8bd6 100644
--- a/R/r2f-control-flow.R
+++ b/R/r2f-control-flow.R
@@ -38,9 +38,13 @@ r2f_handlers[["if"]] <- function(args, scope, ..., hoist = NULL) {
 # TODO: return
 
 # ---- repeat ----
-r2f_handlers[["repeat"]] <- function(args, scope, ...) {
+r2f_handlers[["repeat"]] <- function(args, scope, ..., hoist = NULL) {
   stopifnot(length(args) == 1L)
-  body <- r2f(args[[1]], scope, ...)
+  # The body gets its own hoist target: forwarding the enclosing
+  # statement's hoist would emit a single-statement body's hoisted code
+  # (BLAS calls, temporaries, guards) once, before the loop, instead of
+  # per iteration. (`{` bodies already isolate each statement.)
+  body <- r2f(args[[1]], scope, ..., hoist = NULL)
   check_pending_parallel_consumed(scope)
   Fortran(glue(
     "do
@@ -72,7 +76,11 @@ r2f_handlers[["while"]] <- function(args, scope, ..., hoist = NULL) {
   # present, lower to an explicit exit check at the top of the loop body.
   cond_hoist <- new_hoist(scope)
   cond <- r2f(args[[1]], scope, ..., hoist = cond_hoist)
-  body <- r2f(args[[2]], scope, ..., hoist = hoist)
+  # The body gets its own hoist target for the same reason: forwarding the
+  # enclosing statement's hoist would emit a single-statement body's
+  # hoisted code (BLAS calls, temporaries, guards) once, before the loop.
+  # (`{` bodies already isolate each statement.)
+  body <- r2f(args[[2]], scope, ..., hoist = NULL)
   check_pending_parallel_consumed(scope)
   exit_check <- glue("if (.not. ({cond})) exit")
   cond_code <- cond_hoist$render(exit_check)
diff --git a/tests/testthat/_snaps/loops.md b/tests/testthat/_snaps/loops.md
index da481538..76977e15 100644
--- a/tests/testthat/_snaps/loops.md
+++ b/tests/testthat/_snaps/loops.md
@@ -461,3 +461,153 @@
         return out_;
       }
 
+# single-statement while/repeat bodies re-run their hoisted statements
+
+    Code
+      fn
+    Output
+      function(m) {
+          declare(type(m = double(2, 2)))
+          while (m[1, 1] < 100) m <- m %*% m
+          m
+        }
+      <environment: 0x0>
+    Code
+      cat(fsub)
+    Output
+      subroutine fn(m) bind(c)
+        use iso_c_binding, only: c_double, c_int
+        implicit none
+      
+        ! manifest start
+        ! args
+        real(c_double), intent(in out) :: m(2, 2)
+        ! manifest end
+      
+      
+        do while ((m(1_c_int, 1_c_int) < 100.0_c_double))
+          block
+            real(c_double) :: btmp1_(2, 2)
+      
+      call dgemm('N','N', int(2, kind=c_int), int(2, kind=c_int), int(2, kind=c_int), 1.0_c_double, m, int(2, kind=c_int), m, int(2,&
+      & kind=c_int), 0.0_c_double, btmp1_, int(2, kind=c_int))
+            m = btmp1_
+          end block
+        end do
+      end subroutine
+    Code
+      cat(cwrapper)
+    Output
+      #define R_NO_REMAP
+      #include <R.h>
+      #include <Rinternals.h>
+      
+      
+      extern void fn(double* const m__);
+      
+      SEXP fn_(SEXP _args) {
+        // m
+        _args = CDR(_args);
+        SEXP m = CAR(_args);
+        if (TYPEOF(m) != REALSXP) {
+          Rf_error("typeof(m) must be 'double', not '%s'", Rf_type2char(TYPEOF(m)));
+        }
+        m = Rf_duplicate(m);
+        SETCAR(_args, m);
+        double* const m__ = REAL(m);
+        const int* const m__dim_ = ({
+        SEXP dim_ = Rf_getAttrib(m, R_DimSymbol);
+        if (Rf_length(dim_) != 2) Rf_error(
+          "m must be a 2D-array, but length(dim(m)) is %i",
+          (int) Rf_length(dim_));
+        INTEGER(dim_);});
+        const int m__dim_1_ = m__dim_[0];
+        const int m__dim_2_ = m__dim_[1];
+        
+        if (m__dim_1_ != 2)
+          Rf_error("dim(m)[1] must be 2, not %0.f",
+                    (double)m__dim_1_);
+        if (m__dim_2_ != 2)
+          Rf_error("dim(m)[2] must be 2, not %0.f",
+                    (double)m__dim_2_);
+        
+        fn(m__);
+        
+        return m;
+      }
+
+---
+
+    Code
+      fn
+    Output
+      function(m) {
+          declare(type(m = double(2, 2)))
+          repeat m <- m %*% m
+          m
+        }
+      <environment: 0x0>
+    Code
+      cat(fsub)
+    Output
+      subroutine fn(m) bind(c)
+        use iso_c_binding, only: c_double, c_int
+        implicit none
+      
+        ! manifest start
+        ! args
+        real(c_double), intent(in out) :: m(2, 2)
+        ! manifest end
+      
+      
+        do
+          block
+            real(c_double) :: btmp1_(2, 2)
+      
+      call dgemm('N','N', int(2, kind=c_int), int(2, kind=c_int), int(2, kind=c_int), 1.0_c_double, m, int(2, kind=c_int), m, int(2,&
+      & kind=c_int), 0.0_c_double, btmp1_, int(2, kind=c_int))
+            m = btmp1_
+          end block
+        end do
+      end subroutine
+    Code
+      cat(cwrapper)
+    Output
+      #define R_NO_REMAP
+      #include <R.h>
+      #include <Rinternals.h>
+      
+      
+      extern void fn(double* const m__);
+      
+      SEXP fn_(SEXP _args) {
+        // m
+        _args = CDR(_args);
+        SEXP m = CAR(_args);
+        if (TYPEOF(m) != REALSXP) {
+          Rf_error("typeof(m) must be 'double', not '%s'", Rf_type2char(TYPEOF(m)));
+        }
+        m = Rf_duplicate(m);
+        SETCAR(_args, m);
+        double* const m__ = REAL(m);
+        const int* const m__dim_ = ({
+        SEXP dim_ = Rf_getAttrib(m, R_DimSymbol);
+        if (Rf_length(dim_) != 2) Rf_error(
+          "m must be a 2D-array, but length(dim(m)) is %i",
+          (int) Rf_length(dim_));
+        INTEGER(dim_);});
+        const int m__dim_1_ = m__dim_[0];
+        const int m__dim_2_ = m__dim_[1];
+        
+        if (m__dim_1_ != 2)
+          Rf_error("dim(m)[1] must be 2, not %0.f",
+                    (double)m__dim_1_);
+        if (m__dim_2_ != 2)
+          Rf_error("dim(m)[2] must be 2, not %0.f",
+                    (double)m__dim_2_);
+        
+        fn(m__);
+        
+        return m;
+      }
+
diff --git a/tests/testthat/test-loops.R b/tests/testthat/test-loops.R
index 78968368..3104cc66 100644
--- a/tests/testthat/test-loops.R
+++ b/tests/testthat/test-loops.R
@@ -103,3 +103,28 @@ test_that("expr return value", {
   expect_translation_snapshots(fn)
   expect_quick_identical(fn, 1:10)
 })
+
+test_that("single-statement while/repeat bodies re-run their hoisted statements", {
+  # A non-`{` loop body whose lone statement hoists code (here a BLAS
+  # call) must emit that code inside the loop; hoisting it out of the
+  # loop would freeze the body's work at its first evaluation. `for` is
+  # covered in test-for-iterables.R.
+  #
+  # Run-tested only via the snapshots: a regression in either would
+  # compute the product once before the loop and never terminate.
+  squarings_while <- function(m) {
+    declare(type(m = double(2, 2)))
+    while (m[1, 1] < 100) m <- m %*% m
+    m
+  }
+
+  expect_translation_snapshots(squarings_while)
+
+  squarings_repeat <- function(m) {
+    declare(type(m = double(2, 2)))
+    repeat m <- m %*% m
+    m
+  }
+
+  expect_translation_snapshots(squarings_repeat)
+})

From 3e5855f66a4159255a15605e6928488bbc3fba8f Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 16:43:00 +0200
Subject: [PATCH 40/97] Align the vignette's complex, zero-length, and
 subscript claims with the code

External review found the vignette promising more than the
implementation delivers:

- The type table said `/`, `^`, and linear algebra are "always double";
  complex division/powers return complex (as in R), and complex linalg
  operands are now a compile error. New "complex values are
  elementwise-only" divergence section: type joins (c(), ifelse(),
  cbind()/rbind()) refuse mixing complex with other types, and the
  linear-algebra surface refuses complex operands outright.
- The zero-length section claimed any known-zero-length operand is a
  compile error; scalar broadcast over one compiles and returns a
  zero-length result, matching R. Stated precisely.
- The subscript-bounds section's compile-error claims now hold (literal
  upper bounds validated, writes share the read-side validation); noted
  that reads and writes validate identically.
---
 vignettes/quickr-semantics.Rmd | 47 +++++++++++++++++++++++++---------
 1 file changed, 35 insertions(+), 12 deletions(-)

diff --git a/vignettes/quickr-semantics.Rmd b/vignettes/quickr-semantics.Rmd
index 4c61ff16..b16f0bd0 100644
--- a/vignettes/quickr-semantics.Rmd
+++ b/vignettes/quickr-semantics.Rmd
@@ -45,9 +45,11 @@ logical < integer < double < complex
 ```
 
 Character values are not supported (declaring a `character` argument is
-a compile error). Complex values support arithmetic and equality
-comparisons; order comparisons (`<`, `<=`, `>`, `>=`) and `%%` are
-errors, exactly as they are in R.
+a compile error). Complex values support elementwise arithmetic and
+equality comparisons; order comparisons (`<`, `<=`, `>`, `>=`) and `%%`
+are errors, exactly as they are in R. Outside elementwise operations,
+complex support is narrower than the lattice suggests — see
+[complex values](#complex) under the differences below.
 
 An operation's result type is the "join" of its operands' types — the
 highest type among them — except where R fixes the result type, which
@@ -56,15 +58,15 @@ quickr then matches:
 | Operation | Result type |
 |---|---|
 | `+` `-` `*` (and unary `+` `-`) | join of the operand types; logicals count as integers (in R, `TRUE + TRUE` is `2L`) |
-| `/` | always double |
-| `^` | always double (see note below) |
+| `/` | double (complex when an operand is complex, as in R) |
+| `^` | double (complex when an operand is complex, as in R; see note below) |
 | `%%`, `%/%` | join of the operand types; logicals count as integers |
 | `<` `<=` `>` `>=` `==` `!=` | logical |
 | `&`, `|`, `!`, `&&`, `||` | logical (see [logical operators](#logical-operators) below) |
 | `c()`, and multi-argument `min()` / `max()` / `sum()` / `prod()` | join of all argument types |
 | single-argument reductions (`sum(x)`, ...), `abs()` | type of `x`; logical counts as integer |
 | `ifelse(test, yes, no)` | join of `yes` and `no` (but see [ifelse](#ifelse) below) |
-| `%*%`, `crossprod()`, `solve()`, and other linear algebra | always double, as in R |
+| `%*%`, `crossprod()`, `solve()`, and other linear algebra | always double, as in R; complex operands are a compile error (see [complex values](#complex)) |
 | `t(x)`, `diag(x)` | same type as `x`; the identity forms `diag(n)` are double, as in R |
 | `cbind()` / `rbind()` | join of all argument types |
 
@@ -237,11 +239,13 @@ error instead.
 
 R arithmetic with a zero-length operand returns a zero-length result
 regardless of the other operand's length: `numeric(0) + 1:3` is
-`numeric(0)`. In quickr, a zero length is a length like any other: an
-operand *known* at compile time to be zero-length is a compile error,
-and at run time a zero-length operand errors unless the other operand's
-length is also zero (two zero-length operands produce a zero-length
-result, as in R).
+`numeric(0)`. In quickr, a zero length is a length like any other. An
+operand *known* at compile time to be zero-length combines only with a
+scalar (`double(0) + 1` is `numeric(0)`, matching R); combining it with
+any other vector — even another known-zero-length one — is a compile
+error. When lengths are only known at run time, a zero-length operand
+errors unless the other operand's length is also zero (two zero-length
+operands produce a zero-length result, as in R).
 
 ### A variable's type cannot change
 
@@ -249,6 +253,24 @@ result, as in R).
 under [Types](#reassignment-cannot-narrow-a-type). R instead promotes
 the variable to double.
 
+### Complex values are elementwise-only {#complex}
+
+Elementwise arithmetic and equality comparisons handle complex values
+natively, including mixed operands: `complex + double` promotes to
+complex, as in R. Everything else refuses:
+
+- **Type joins.** `c()`, `ifelse()`, and `cbind()`/`rbind()` do not mix
+  complex with other types — `c(x, y)` with a complex `x` and a double
+  `y` is a compile error where R returns a complex vector.
+- **Linear algebra.** `%*%`, `crossprod()`, `solve()`, `chol()`, and the
+  rest of the linear-algebra surface refuse complex operands at compile
+  time; quickr's lowerings are double-only, where R computes complex
+  results.
+
+(`t(x)` and `diag(x)` are mode-preserving and keep working on complex
+values; order comparisons and `%%` on complex values are errors in R
+itself, so refusing them is not a divergence.)
+
 ### Subscript bounds are only partially checked
 
 R validates every subscript: `x[0]` drops elements, negative subscripts
@@ -258,7 +280,8 @@ defeat the purpose of compiling, so quickr's contract is:
 
 - Subscripts that are provably out of range at compile time (literal
   values, ranges provably outside a known extent) are compile errors.
-  Zero and negative literal subscripts are rejected.
+  Zero and negative literal subscripts are rejected. Read and write
+  subscripts (`x[i]` and `x[i] <- v`) get the same validation.
 - A subscript whose value is only known at run time — a scalar `x[i]`,
   or a range `x[a:b]` with symbolic bounds — is **not** checked,
   matching Fortran's own contract: reading or writing out of bounds is

From 92b7e4219c0d1b1d307abd1cead5b5241ed035e8 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 14:30:53 +0200
Subject: [PATCH 41/97] Refuse unsupported modes and complex operations with
 clean errors

Character declarations died in the manifest generator with a full S7
object dump; they are now rejected at declare() with a one-line
not-supported message, and the manifest's three 'unrecognized kind'
sites share a backstop that names the variable and mode. Complex order
comparisons and complex %% were handed to gfortran, which rejected the
emitted Fortran with a compiler dump; both are now refused at the
operator with R's own messages ('invalid comparison with complex
values', 'unimplemented complex operation'). Complex ==//= keeps
working, as in R. The &/| non-logical refusal message also gains the
operator name.

No behavior changes: every input that errored still errors; only the
error text changed.
---
 R/manifest.R                              | 21 ++++++++++++++++---
 R/r2f-arithmetic.R                        |  4 ++++
 R/r2f-logical.R                           | 19 +++++++++++++++--
 R/sizes.R                                 | 13 +++++++++++-
 tests/testthat/test-conformability-grid.R |  2 +-
 tests/testthat/test-declare-type.R        | 11 ++++++++++
 tests/testthat/test-errors.R              | 25 +++++++++++++++++++++++
 7 files changed, 88 insertions(+), 7 deletions(-)

diff --git a/R/manifest.R b/R/manifest.R
index f80e5f1e..e6a4d1f3 100644
--- a/R/manifest.R
+++ b/R/manifest.R
@@ -39,6 +39,21 @@ logical_as_int <- function(var) {
   identical(var@mode, "logical") && isTRUE(var@logical_as_int)
 }
 
+# A mode with no Fortran translation reached the code generator. Declared
+# modes are validated at declare() time; this is the backstop for values
+# created mid-translation, so it must still read as a user-facing message,
+# not an internal object dump.
+stop_unsupported_mode <- function(var) {
+  name <- var@r_name %||% var@name
+  stop(
+    if (is.null(name)) "" else paste0("variable `", name, "`: "),
+    "mode '",
+    var@mode %||% "?",
+    "' is not supported by quickr",
+    call. = FALSE
+  )
+}
+
 block_tmp_allocatable_threshold <- 16L
 
 subroutine_local_allocatable_threshold_bytes <- 256L * 1024L
@@ -200,7 +215,7 @@ iso_c_binding_symbols <- function(
           complex = "c_double_complex",
           logical = if (isTRUE(logical_is_c_int(var))) "c_int",
           raw = "c_int8_t",
-          stop("unrecognized kind: ", format(var))
+          stop_unsupported_mode(var)
         ),
         lapply(var@dims, function(size) {
           syms <- all.vars(size)
@@ -266,7 +281,7 @@ emit_decl_line <- function(
     complex = "complex(c_double_complex)",
     logical = if (logical_as_int(var)) "integer(c_int)" else "logical",
     raw = "integer(c_int8_t)",
-    stop("unrecognized kind: ", format(var))
+    stop_unsupported_mode(var)
   )
 
   # Block-scoped temporaries are explicitly marked allocatable so we can
@@ -375,7 +390,7 @@ r2f.scope <- function(scope, include_errors = FALSE) {
       complex = "complex(c_double_complex)",
       logical = if (logical_as_int(var)) "integer(c_int)" else "logical",
       raw = "integer(c_int8_t)",
-      stop("unrecognized kind: ", format(var))
+      stop_unsupported_mode(var)
     )
 
     dims <- if (passes_as_scalar(var)) {
diff --git a/R/r2f-arithmetic.R b/R/r2f-arithmetic.R
index d45ee337..1295c77f 100644
--- a/R/r2f-arithmetic.R
+++ b/R/r2f-arithmetic.R
@@ -88,6 +88,10 @@ r2f_handlers[["%%"]] <- function(args, scope, ..., hoist = NULL) {
   # `modulo` requires same-typed arguments, so cast both operands to the
   # join (logical joins as integer: R's TRUE %% TRUE is 0L).
   mode <- arith_join_mode(left, right)
+  if (identical(mode, "complex")) {
+    # Fortran modulo() has no complex form; R refuses too.
+    stop("unimplemented complex operation", call. = FALSE)
+  }
   left <- cast_to_mode(left, mode, "%%")
   right <- cast_to_mode(right, mode, "%%")
   .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
diff --git a/R/r2f-logical.R b/R/r2f-logical.R
index bf79129e..23ab897e 100644
--- a/R/r2f-logical.R
+++ b/R/r2f-logical.R
@@ -6,8 +6,19 @@
 
 # ---- comparison operators ----
 
+# R supports equality on complex values but refuses ordering. Refuse it
+# here rather than handing gfortran an invalid comparison; shared by the
+# four ordering handlers below (== and /= stay legal, as in R).
+check_ordered_operands <- function(left, right) {
+  if ("complex" %in% c(left@value@mode, right@value@mode)) {
+    stop("invalid comparison with complex values", call. = FALSE)
+  }
+  invisible(TRUE)
+}
+
 r2f_handlers[[">="]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  check_ordered_operands(left, right)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
   .[left, right] <- maybe_reshape_vector_matrix(
@@ -24,6 +35,7 @@ r2f_handlers[[">="]] <- function(args, scope, ..., hoist = NULL) {
 
 r2f_handlers[[">"]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  check_ordered_operands(left, right)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
   .[left, right] <- maybe_reshape_vector_matrix(
@@ -40,6 +52,7 @@ r2f_handlers[[">"]] <- function(args, scope, ..., hoist = NULL) {
 
 r2f_handlers[["<"]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  check_ordered_operands(left, right)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
   .[left, right] <- maybe_reshape_vector_matrix(
@@ -56,6 +69,7 @@ r2f_handlers[["<"]] <- function(args, scope, ..., hoist = NULL) {
 
 r2f_handlers[["<="]] <- function(args, scope, ..., hoist = NULL) {
   .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  check_ordered_operands(left, right)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
   .[left, right] <- maybe_reshape_vector_matrix(
@@ -145,9 +159,10 @@ register_r2f_handler(
   c("&", "|"),
   function(args, scope, ..., hoist = NULL) {
     args <- lapply(args, r2f, scope, ..., hoist = hoist)
+    op <- last(list(...)$calls)
     args <- lapply(args, function(a) {
       if (a@value@mode != "logical") {
-        stop("must be logical")
+        stop("`", op, "` requires logical operands", call. = FALSE)
       }
       a
     })
@@ -162,7 +177,7 @@ register_r2f_handler(
       scalarize_one_by_one = FALSE
     )
 
-    operator <- switch(last(list(...)$calls), `&` = ".and.", `|` = ".or.")
+    operator <- switch(op, `&` = ".and.", `|` = ".or.")
 
     s <- glue("{left} {operator} {right}")
     val <- conform(left@value, right@value)
diff --git a/R/sizes.R b/R/sizes.R
index bbf336da..68b75497 100644
--- a/R/sizes.R
+++ b/R/sizes.R
@@ -15,10 +15,21 @@ check_type_call <- function(cl) {
 type_call_to_var <- function(cl) {
   check_type_call(cl)
   r_name <- names(cl)[-1]
+  mode <- as.character(cl[[2L]][[1L]])
+  if (identical(mode, "character")) {
+    # No Fortran translation exists; refuse at the declaration instead of
+    # surfacing an internal error from the code generator.
+    stop(
+      "in declare(type(",
+      r_name,
+      " = character(...))): character values are not supported by quickr",
+      call. = FALSE
+    )
+  }
   Variable(
     name = fortranize_name(r_name),
     r_name = r_name,
-    mode = as.character(cl[[2L]][[1L]]),
+    mode = mode,
     dims = unname(as.list(cl[[2]])[-1])
   )
 }
diff --git a/tests/testthat/test-conformability-grid.R b/tests/testthat/test-conformability-grid.R
index cade22c5..ae1acbf2 100644
--- a/tests/testthat/test-conformability-grid.R
+++ b/tests/testthat/test-conformability-grid.R
@@ -530,7 +530,7 @@ test_that("& and | require logical operands (R would coerce: error divergence)",
         fn <- make_grid_cell_fn("vec3", "vec3", op, ma, mb)
         expect_error(
           quick(fn),
-          "must be logical",
+          "requires logical operands",
           fixed = TRUE,
           label = paste0(
             "quick() for ",
diff --git a/tests/testthat/test-declare-type.R b/tests/testthat/test-declare-type.R
index 9c54eb4b..10dc4375 100644
--- a/tests/testthat/test-declare-type.R
+++ b/tests/testthat/test-declare-type.R
@@ -49,3 +49,14 @@ test_that("declare(type()) variants", {
   })
   expect_quick_identical(quick_seq, list(1L, 5L))
 })
+
+test_that("character declarations are refused with a clean message", {
+  fn <- function(x) {
+    declare(type(x = character(1)))
+    x
+  }
+  expect_error(
+    quick(fn),
+    "character values are not supported by quickr"
+  )
+})
diff --git a/tests/testthat/test-errors.R b/tests/testthat/test-errors.R
index eea0460f..94e8c80b 100644
--- a/tests/testthat/test-errors.R
+++ b/tests/testthat/test-errors.R
@@ -198,3 +198,28 @@ test_that("assigning an expression that produces no value errors cleanly", {
     fixed = TRUE
   )
 })
+
+test_that("unsupported complex operations are refused with R's messages", {
+  # Order comparisons on complex values: R errors, so must quickr -- with
+  # a clean message, not a raw gfortran failure.
+  complex_lt <- function(x, y) {
+    declare(type(x = complex(1)), type(y = complex(1)))
+    x < y
+  }
+  expect_error(quick(complex_lt), "invalid comparison with complex values")
+
+  # Equality is supported, as in R.
+  complex_eq <- function(x, y) {
+    declare(type(x = complex(1)), type(y = complex(1)))
+    x == y
+  }
+  expect_quick_identical(complex_eq, list(1i, 1i))
+  expect_quick_identical(complex_eq, list(1i, 2i))
+
+  # modulo() has no complex form in Fortran; R refuses too.
+  complex_mod <- function(x, y) {
+    declare(type(x = complex(1)), type(y = complex(1)))
+    x %% y
+  }
+  expect_error(quick(complex_mod), "unimplemented complex operation")
+})

From d8a65c4a3f14fb3e8795d80a2dda8f1e67911a21 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 14:53:37 +0200
Subject: [PATCH 42/97] Clean up generated code: scalar-matrix broadcast,
 literal hoists, trailing whitespace

Three deferred micro-cleanups, held out of the shared-helpers commit'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. lower_elementwise_operands() carries this and becomes the
  operand-compilation entry point for every elementwise handler.
- 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.
---
 R/aaa-utils.R                                 |  10 --
 R/c-wrapper.R                                 |  10 +-
 R/r2f-aab-core.R                              |  12 +-
 R/r2f-arithmetic.R                            |  24 +++-
 R/r2f-logical.R                               |  14 +-
 R/r2f-operators-helpers.R                     |  88 ++++++++++++
 R/r2f-random.R                                |   4 +-
 tests/testthat/_snaps/bind.md                 |   4 +-
 tests/testthat/_snaps/blas-guards.md          |   8 +-
 tests/testthat/_snaps/block-scopes.md         |   6 +-
 tests/testthat/_snaps/c-bridge-hoist.md       |   8 +-
 .../_snaps/closure-hoist-snapshots.md         |   8 +-
 tests/testthat/_snaps/dims2c-length.md        |  18 +--
 tests/testthat/_snaps/div-cast.md             |  32 ++---
 tests/testthat/_snaps/div-mod.md              |  20 +--
 tests/testthat/_snaps/drop.md                 |  16 +--
 tests/testthat/_snaps/error-handling.md       |   8 +-
 tests/testthat/_snaps/example-convolve.md     |   8 +-
 .../testthat/_snaps/example-heat_diffusion.md |  28 ++--
 tests/testthat/_snaps/example-roll_mean.md    |  12 +-
 tests/testthat/_snaps/example-viterbi.md      |  32 ++---
 tests/testthat/_snaps/float-to-int.md         |  18 +--
 tests/testthat/_snaps/hoist-mask.md           |   8 +-
 tests/testthat/_snaps/ifelse.md               |  20 +--
 tests/testthat/_snaps/logical-indexing.md     |   8 +-
 tests/testthat/_snaps/logical.md              |  42 +++---
 tests/testthat/_snaps/loops.md                |   4 +-
 tests/testthat/_snaps/matrix.md               |   6 +-
 .../testthat/_snaps/openmp-error-snapshots.md |   8 +-
 tests/testthat/_snaps/parentheses.md          |  14 +-
 tests/testthat/_snaps/qr-solve.md             |  22 +--
 tests/testthat/_snaps/recycling.md            |  10 +-
 tests/testthat/_snaps/runif.md                |  18 +--
 tests/testthat/_snaps/sapply-closures.md      |  70 +++++-----
 tests/testthat/_snaps/size-constraint.md      |   4 +-
 tests/testthat/_snaps/subscript-validation.md |   6 +-
 .../_snaps/superassignment-snapshots.md       |  20 +--
 tests/testthat/_snaps/svd.md                  |   4 +-
 tests/testthat/_snaps/type-promotion.md       |  30 ++--
 tests/testthat/_snaps/unary-intrinsics.md     | 132 +++++++++---------
 tests/testthat/_snaps/which.md                |  12 +-
 tests/testthat/test-bind.R                    |   2 +-
 tests/testthat/test-internal-utils.R          |  10 +-
 tests/testthat/test-recycling.R               |  56 ++++++++
 44 files changed, 519 insertions(+), 375 deletions(-)

diff --git a/R/aaa-utils.R b/R/aaa-utils.R
index 3c806dcb..502112d3 100644
--- a/R/aaa-utils.R
+++ b/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)))
diff --git a/R/c-wrapper.R b/R/c-wrapper.R
index a1892e5c..cf547300 100644
--- a/R/c-wrapper.R
+++ b/R/c-wrapper.R
@@ -837,9 +837,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});")
 }
diff --git a/R/r2f-aab-core.R b/R/r2f-aab-core.R
index d467217a..473793bf 100644
--- a/R/r2f-aab-core.R
+++ b/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,
diff --git a/R/r2f-arithmetic.R b/R/r2f-arithmetic.R
index 1295c77f..7f69f5b0 100644
--- a/R/r2f-arithmetic.R
+++ b/R/r2f-arithmetic.R
@@ -11,7 +11,12 @@ r2f_handlers[["+"]] <- function(args, scope, ..., hoist = NULL) {
     x <- cast_to_mode(x, arith_join_mode(x), "unary +")
     Fortran(glue("(+{x})"), Variable(x@value@mode, x@value@dims))
   } else {
-    .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+    .[left, right] <- lower_elementwise_operands(
+      args,
+      scope,
+      ...,
+      hoist = hoist
+    )
     .[left, right] <- promote_arith_pair(left, right, "+")
     .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
     Fortran(glue("({left} + {right})"), conform(left@value, right@value))
@@ -26,7 +31,12 @@ r2f_handlers[["-"]] <- function(args, scope, ..., hoist = NULL) {
     x <- cast_to_mode(x, arith_join_mode(x), "unary -")
     Fortran(glue("(-{x})"), Variable(x@value@mode, x@value@dims))
   } else {
-    .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+    .[left, right] <- lower_elementwise_operands(
+      args,
+      scope,
+      ...,
+      hoist = hoist
+    )
     .[left, right] <- promote_arith_pair(left, right, "-")
     .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
     Fortran(glue("({left} - {right})"), conform(left@value, right@value))
@@ -34,14 +44,14 @@ r2f_handlers[["-"]] <- function(args, scope, ..., hoist = NULL) {
 }
 
 r2f_handlers[["*"]] <- function(args, scope = NULL, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   .[left, right] <- promote_arith_pair(left, right, "*")
   .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   Fortran(glue("({left} * {right})"), conform(left@value, right@value))
 }
 
 r2f_handlers[["/"]] <- function(args, scope = NULL, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   left <- maybe_cast_double(left)
   right <- maybe_cast_double(right)
   .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
@@ -49,7 +59,7 @@ r2f_handlers[["/"]] <- function(args, scope = NULL, ..., hoist = NULL) {
 }
 
 r2f_handlers[["^"]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   # R's ^ always returns double (R_pow), so cast the base. Keep an integer
   # exponent as integer: Fortran `real ** int` is exact and, unlike
   # `real ** real`, defined for negative bases -- matching R, which
@@ -84,7 +94,7 @@ r2f_handlers[["^"]] <- function(args, scope, ..., hoist = NULL) {
 #   - AINT(x)       : truncation toward 0       (real)
 
 r2f_handlers[["%%"]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   # `modulo` requires same-typed arguments, so cast both operands to the
   # join (logical joins as integer: R's TRUE %% TRUE is 0L).
   mode <- arith_join_mode(left, right)
@@ -101,7 +111,7 @@ r2f_handlers[["%%"]] <- function(args, scope, ..., hoist = NULL) {
 }
 
 r2f_handlers[["%/%"]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   .[left, right] <- promote_arith_pair(left, right, "%/%")
   .[left, right] <- maybe_reshape_vector_matrix(left, right, hoist, scope)
   out_val <- conform(left@value, right@value)
diff --git a/R/r2f-logical.R b/R/r2f-logical.R
index 23ab897e..b39aed58 100644
--- a/R/r2f-logical.R
+++ b/R/r2f-logical.R
@@ -17,7 +17,7 @@ check_ordered_operands <- function(left, right) {
 }
 
 r2f_handlers[[">="]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   check_ordered_operands(left, right)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
@@ -34,7 +34,7 @@ r2f_handlers[[">="]] <- function(args, scope, ..., hoist = NULL) {
 }
 
 r2f_handlers[[">"]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   check_ordered_operands(left, right)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
@@ -51,7 +51,7 @@ r2f_handlers[[">"]] <- function(args, scope, ..., hoist = NULL) {
 }
 
 r2f_handlers[["<"]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   check_ordered_operands(left, right)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
@@ -68,7 +68,7 @@ r2f_handlers[["<"]] <- function(args, scope, ..., hoist = NULL) {
 }
 
 r2f_handlers[["<="]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   check_ordered_operands(left, right)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
@@ -85,7 +85,7 @@ r2f_handlers[["<="]] <- function(args, scope, ..., hoist = NULL) {
 }
 
 r2f_handlers[["=="]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
   .[left, right] <- maybe_reshape_vector_matrix(
@@ -101,7 +101,7 @@ r2f_handlers[["=="]] <- function(args, scope, ..., hoist = NULL) {
 }
 
 r2f_handlers[["!="]] <- function(args, scope, ..., hoist = NULL) {
-  .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+  .[left, right] <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
   # R compares logicals as integers; Fortran has no logical comparison.
   .[left, right] <- promote_arith_pair(left, right, "comparison")
   .[left, right] <- maybe_reshape_vector_matrix(
@@ -158,7 +158,7 @@ register_r2f_handler(
 register_r2f_handler(
   c("&", "|"),
   function(args, scope, ..., hoist = NULL) {
-    args <- lapply(args, r2f, scope, ..., hoist = hoist)
+    args <- lower_elementwise_operands(args, scope, ..., hoist = hoist)
     op <- last(list(...)$calls)
     args <- lapply(args, function(a) {
       if (a@value@mode != "logical") {
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 33db9808..6b9e207d 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -140,6 +140,94 @@ promote_arith_pair <- function(left, right, context = "arithmetic") {
   list(left = left, right = 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 lower_elementwise_operands() to lower the fill to a native
+# scalar broadcast instead of the O(nrow * ncol) temporary the matrix()
+# handler would otherwise materialize.
+match_scalar_matrix_fill <- 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.
+# Used by: r2f-arithmetic.R, r2f-logical.R
+lower_elementwise_operands <- function(args, scope, ..., hoist = NULL) {
+  fills <- lapply(args, match_scalar_matrix_fill, 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)
+}
+
 # Check if a dimension expression equals 1.
 # Used by: r2f-arithmetic.R, r2f-logical.R
 dim_is_one <- function(x) {
diff --git a/R/r2f-random.R b/R/r2f-random.R
index a3aa27aa..a798fe7d 100644
--- a/R/r2f-random.R
+++ b/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) {
diff --git a/tests/testthat/_snaps/bind.md b/tests/testthat/_snaps/bind.md
index d6458b0e..c49b8752 100644
--- a/tests/testthat/_snaps/bind.md
+++ b/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
 
diff --git a/tests/testthat/_snaps/blas-guards.md b/tests/testthat/_snaps/blas-guards.md
index 11256717..535b1de6 100644
--- a/tests/testthat/_snaps/blas-guards.md
+++ b/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) {
diff --git a/tests/testthat/_snaps/block-scopes.md b/tests/testthat/_snaps/block-scopes.md
index 4f923501..c4dc8fdd 100644
--- a/tests/testthat/_snaps/block-scopes.md
+++ b/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) {
diff --git a/tests/testthat/_snaps/c-bridge-hoist.md b/tests/testthat/_snaps/c-bridge-hoist.md
index 281f6da7..73991e89 100644
--- a/tests/testthat/_snaps/c-bridge-hoist.md
+++ b/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) {
diff --git a/tests/testthat/_snaps/closure-hoist-snapshots.md b/tests/testthat/_snaps/closure-hoist-snapshots.md
index 1d9f0b5e..cab59e0e 100644
--- a/tests/testthat/_snaps/closure-hoist-snapshots.md
+++ b/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) {
diff --git a/tests/testthat/_snaps/dims2c-length.md b/tests/testthat/_snaps/dims2c-length.md
index 2ce55d8b..dacc88d7 100644
--- a/tests/testthat/_snaps/dims2c-length.md
+++ b/tests/testthat/_snaps/dims2c-length.md
@@ -41,8 +41,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) {
@@ -109,9 +109,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) {
@@ -193,8 +193,8 @@
       
       
       extern void fn(
-        const int* const n__, 
-        const int* const m__, 
+        const int* const n__,
+        const int* const m__,
         double* const out__);
       
       SEXP fn_(SEXP _args) {
@@ -282,8 +282,8 @@
       
       
       extern void fn(
-        const int* const n__, 
-        const int* const m__, 
+        const int* const n__,
+        const int* const m__,
         double* const out__);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/div-cast.md b/tests/testthat/_snaps/div-cast.md
index 1b13ef56..7ef66ab5 100644
--- a/tests/testthat/_snaps/div-cast.md
+++ b/tests/testthat/_snaps/div-cast.md
@@ -37,9 +37,9 @@
       
       
       extern void fn(
-        const int* const a__, 
-        const int* const b__, 
-        double* const out___, 
+        const int* const a__,
+        const int* const b__,
+        double* const out___,
         const R_xlen_t a__len_);
       
       SEXP fn_(SEXP _args) {
@@ -118,9 +118,9 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const int* const b__, 
-        double* const out___, 
+        const double* const a__,
+        const int* const b__,
+        double* const out___,
         const R_xlen_t a__len_);
       
       SEXP fn_(SEXP _args) {
@@ -199,9 +199,9 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const int* const b__, 
-        double* const out___, 
+        const double* const a__,
+        const int* const b__,
+        double* const out___,
         const R_xlen_t a__len_);
       
       SEXP fn_(SEXP _args) {
@@ -277,8 +277,8 @@
       
       
       extern void fn(
-        const int* const a__, 
-        const int* const b__, 
+        const int* const a__,
+        const int* const b__,
         double* const out___);
       
       SEXP fn_(SEXP _args) {
@@ -355,9 +355,9 @@
       
       
       extern void fn(
-        const Rcomplex* const a__, 
-        const Rcomplex* const b__, 
-        Rcomplex* const out___, 
+        const Rcomplex* const a__,
+        const Rcomplex* const b__,
+        Rcomplex* const out___,
         const R_xlen_t a__len_);
       
       SEXP fn_(SEXP _args) {
@@ -436,8 +436,8 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const mu__, 
+        const double* const x__,
+        double* const mu__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/div-mod.md b/tests/testthat/_snaps/div-mod.md
index ab5e66bc..81128559 100644
--- a/tests/testthat/_snaps/div-mod.md
+++ b/tests/testthat/_snaps/div-mod.md
@@ -37,9 +37,9 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
-        double* const out___, 
+        const double* const a__,
+        const double* const b__,
+        double* const out___,
         const R_xlen_t a__len_);
       
       SEXP fn_(SEXP _args) {
@@ -124,9 +124,9 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
-        double* const out___, 
+        const double* const a__,
+        const double* const b__,
+        double* const out___,
         const R_xlen_t a__len_);
       
       SEXP fn_(SEXP _args) {
@@ -202,8 +202,8 @@
       
       
       extern void fn(
-        const int* const a__, 
-        const int* const b__, 
+        const int* const a__,
+        const int* const b__,
         int* const out___);
       
       SEXP fn_(SEXP _args) {
@@ -282,8 +282,8 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
+        const double* const a__,
+        const double* const b__,
         double* const out___);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/drop.md b/tests/testthat/_snaps/drop.md
index 3891d243..c12c9614 100644
--- a/tests/testthat/_snaps/drop.md
+++ b/tests/testthat/_snaps/drop.md
@@ -174,8 +174,8 @@
       
       
       extern void fn(
-        const double* const A__, 
-        double* const out___, 
+        const double* const A__,
+        double* const out___,
         const R_len_t A__dim_2_);
       
       SEXP fn_(SEXP _args) {
@@ -246,8 +246,8 @@
       
       
       extern void fn(
-        const double* const A__, 
-        double* const out___, 
+        const double* const A__,
+        double* const out___,
         const R_len_t A__dim_1_);
       
       SEXP fn_(SEXP _args) {
@@ -318,8 +318,8 @@
       
       
       extern void fn(
-        const double* const A__, 
-        const int* const n__, 
+        const double* const A__,
+        const int* const n__,
         double* const out___);
       
       SEXP fn_(SEXP _args) {
@@ -407,8 +407,8 @@
       
       
       extern void fn(
-        const double* const A__, 
-        const int* const n__, 
+        const double* const A__,
+        const int* const n__,
         double* const out___);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/error-handling.md b/tests/testthat/_snaps/error-handling.md
index 292eaa06..95f2e98c 100644
--- a/tests/testthat/_snaps/error-handling.md
+++ b/tests/testthat/_snaps/error-handling.md
@@ -59,8 +59,8 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const out___, 
+        const double* const x__,
+        double* const out___,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
@@ -151,8 +151,8 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const out___, 
+        const double* const x__,
+        double* const out___,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/example-convolve.md b/tests/testthat/_snaps/example-convolve.md
index a4d791fa..820432f4 100644
--- a/tests/testthat/_snaps/example-convolve.md
+++ b/tests/testthat/_snaps/example-convolve.md
@@ -56,10 +56,10 @@
       
       
       extern void slow_convolve(
-        const double* const a__, 
-        const double* const b__, 
-        double* const ab__, 
-        const R_xlen_t a__len_, 
+        const double* const a__,
+        const double* const b__,
+        double* const ab__,
+        const R_xlen_t a__len_,
         const R_xlen_t b__len_);
       
       SEXP slow_convolve_(SEXP _args) {
diff --git a/tests/testthat/_snaps/example-heat_diffusion.md b/tests/testthat/_snaps/example-heat_diffusion.md
index a12feeae..abab20dd 100644
--- a/tests/testthat/_snaps/example-heat_diffusion.md
+++ b/tests/testthat/_snaps/example-heat_diffusion.md
@@ -150,13 +150,13 @@
       
       
       extern void diffuse_heat(
-        const int* const nx__, 
-        const int* const ny__, 
-        const int* const dx__, 
-        const int* const dy__, 
-        const double* const dt__, 
-        const double* const k__, 
-        const int* const steps__, 
+        const int* const nx__,
+        const int* const ny__,
+        const int* const dx__,
+        const int* const dy__,
+        const double* const dt__,
+        const double* const k__,
+        const int* const steps__,
         double* const temp__);
       
       SEXP diffuse_heat_(SEXP _args) {
@@ -406,13 +406,13 @@
       
       
       extern void diffuse_heat(
-        const int* const nx__, 
-        const int* const ny__, 
-        const int* const dx__, 
-        const int* const dy__, 
-        const double* const dt__, 
-        const double* const k__, 
-        const int* const steps__, 
+        const int* const nx__,
+        const int* const ny__,
+        const int* const dx__,
+        const int* const dy__,
+        const double* const dt__,
+        const double* const k__,
+        const int* const steps__,
         double* const temp__);
       
       SEXP diffuse_heat_(SEXP _args) {
diff --git a/tests/testthat/_snaps/example-roll_mean.md b/tests/testthat/_snaps/example-roll_mean.md
index 24e951e6..ccb6de66 100644
--- a/tests/testthat/_snaps/example-roll_mean.md
+++ b/tests/testthat/_snaps/example-roll_mean.md
@@ -83,12 +83,12 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const weights__, 
-        const int* const normalize__, 
-        double* const out__, 
-        const R_xlen_t weights__len_, 
-        const R_xlen_t x__len_, 
+        const double* const x__,
+        double* const weights__,
+        const int* const normalize__,
+        double* const out__,
+        const R_xlen_t weights__len_,
+        const R_xlen_t x__len_,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/example-viterbi.md b/tests/testthat/_snaps/example-viterbi.md
index 487d8bbb..45a0f310 100644
--- a/tests/testthat/_snaps/example-viterbi.md
+++ b/tests/testthat/_snaps/example-viterbi.md
@@ -138,14 +138,14 @@
       
       
       extern void viterbi(
-        const int* const observations__, 
-        const int* const states__, 
-        const double* const initial_probs__, 
-        const double* const transition_probs__, 
-        const double* const emission_probs__, 
-        int* const out__, 
-        const R_len_t emission_probs__dim_2_, 
-        const R_xlen_t observations__len_, 
+        const int* const observations__,
+        const int* const states__,
+        const double* const initial_probs__,
+        const double* const transition_probs__,
+        const double* const emission_probs__,
+        int* const out__,
+        const R_len_t emission_probs__dim_2_,
+        const R_xlen_t observations__len_,
         const R_xlen_t states__len_);
       
       SEXP viterbi_(SEXP _args) {
@@ -353,14 +353,14 @@
       
       
       extern void viterbi(
-        const int* const observations__, 
-        const int* const states__, 
-        const double* const initial_probs__, 
-        const double* const transition_probs__, 
-        const double* const emission_probs__, 
-        int* const out__, 
-        const R_len_t emission_probs__dim_2_, 
-        const R_xlen_t observations__len_, 
+        const int* const observations__,
+        const int* const states__,
+        const double* const initial_probs__,
+        const double* const transition_probs__,
+        const double* const emission_probs__,
+        int* const out__,
+        const R_len_t emission_probs__dim_2_,
+        const R_xlen_t observations__len_,
         const R_xlen_t states__len_);
       
       SEXP viterbi_(SEXP _args) {
diff --git a/tests/testthat/_snaps/float-to-int.md b/tests/testthat/_snaps/float-to-int.md
index b8cc9c12..ea67958c 100644
--- a/tests/testthat/_snaps/float-to-int.md
+++ b/tests/testthat/_snaps/float-to-int.md
@@ -37,8 +37,8 @@
       
       
       extern void fn(
-        const double* const x__, 
-        int* const out__, 
+        const double* const x__,
+        int* const out__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -100,8 +100,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) {
@@ -163,8 +163,8 @@
       
       
       extern void fn(
-        const int* const x__, 
-        double* const out__, 
+        const int* const x__,
+        double* const out__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -227,9 +227,9 @@
       
       
       extern void fn(
-        const int* const a__, 
-        const int* const b__, 
-        int* const out__, 
+        const int* const a__,
+        const int* const b__,
+        int* const out__,
         const R_xlen_t a__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/hoist-mask.md b/tests/testthat/_snaps/hoist-mask.md
index 306ea922..e0f1df1b 100644
--- a/tests/testthat/_snaps/hoist-mask.md
+++ b/tests/testthat/_snaps/hoist-mask.md
@@ -37,8 +37,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) {
@@ -100,8 +100,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) {
diff --git a/tests/testthat/_snaps/ifelse.md b/tests/testthat/_snaps/ifelse.md
index f9798be7..8d74e77e 100644
--- a/tests/testthat/_snaps/ifelse.md
+++ b/tests/testthat/_snaps/ifelse.md
@@ -37,9 +37,9 @@
       
       
       extern void fn(
-        const int* const c__, 
-        const double* const a__, 
-        double* const out___, 
+        const int* const c__,
+        const double* const a__,
+        double* const out___,
         const R_xlen_t c__len_);
       
       SEXP fn_(SEXP _args) {
@@ -146,13 +146,13 @@
       
       
       extern void fn(
-        const int* const c__, 
-        const double* const a__, 
-        const double* const b__, 
-        double* const out___, 
-        const R_xlen_t a__len_, 
-        const R_xlen_t b__len_, 
-        const R_xlen_t c__len_, 
+        const int* const c__,
+        const double* const a__,
+        const double* const b__,
+        double* const out___,
+        const R_xlen_t a__len_,
+        const R_xlen_t b__len_,
+        const R_xlen_t c__len_,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/logical-indexing.md b/tests/testthat/_snaps/logical-indexing.md
index e9304524..591a0e5c 100644
--- a/tests/testthat/_snaps/logical-indexing.md
+++ b/tests/testthat/_snaps/logical-indexing.md
@@ -286,10 +286,10 @@
       
       
       extern void fn(
-        const double* const x__, 
-        const double* const y__, 
-        const double* const z__, 
-        const double* const a__, 
+        const double* const x__,
+        const double* const y__,
+        const double* const z__,
+        const double* const a__,
         double* const out__);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/logical.md b/tests/testthat/_snaps/logical.md
index 7f869fbe..a239f7c1 100644
--- a/tests/testthat/_snaps/logical.md
+++ b/tests/testthat/_snaps/logical.md
@@ -43,10 +43,10 @@
       
       
       extern void fn(
-        const double* const x__, 
-        const double* const left__, 
-        const double* const right__, 
-        int* const out__, 
+        const double* const x__,
+        const double* const left__,
+        const double* const right__,
+        int* const out__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -161,8 +161,8 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
+        const double* const a__,
+        const double* const b__,
         int* const out__);
       
       SEXP fn_(SEXP _args) {
@@ -246,8 +246,8 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
+        const double* const a__,
+        const double* const b__,
         int* const out__);
       
       SEXP fn_(SEXP _args) {
@@ -322,8 +322,8 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
+        const double* const a__,
+        const double* const b__,
         int* const out__);
       
       SEXP fn_(SEXP _args) {
@@ -401,9 +401,9 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
-        int* const out__, 
+        const double* const a__,
+        const double* const b__,
+        int* const out__,
         const R_xlen_t a__len_);
       
       SEXP fn_(SEXP _args) {
@@ -480,8 +480,8 @@
       
       
       extern void fn(
-        const int* const x__, 
-        const int* const y__, 
+        const int* const x__,
+        const int* const y__,
         int* const cond__);
       
       SEXP fn_(SEXP _args) {
@@ -563,8 +563,8 @@
       
       
       extern void fn(
-        const int* const x__, 
-        const int* const y__, 
+        const int* const x__,
+        const int* const y__,
         int* const out___);
       
       SEXP fn_(SEXP _args) {
@@ -653,8 +653,8 @@
       
       
       extern void fn(
-        const int* const i__, 
-        const double* const x__, 
+        const int* const i__,
+        const double* const x__,
         double* const out__);
       
       SEXP fn_(SEXP _args) {
@@ -751,8 +751,8 @@
       
       
       extern void fn(
-        const double* const x__, 
-        int* const i__, 
+        const double* const x__,
+        int* const i__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/loops.md b/tests/testthat/_snaps/loops.md
index 76977e15..a419c182 100644
--- a/tests/testthat/_snaps/loops.md
+++ b/tests/testthat/_snaps/loops.md
@@ -437,8 +437,8 @@
       
       
       extern void fn(
-        const int* const x__, 
-        int* const out___, 
+        const int* const x__,
+        int* const out___,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/matrix.md b/tests/testthat/_snaps/matrix.md
index 8fa7d818..711d6a6a 100644
--- a/tests/testthat/_snaps/matrix.md
+++ b/tests/testthat/_snaps/matrix.md
@@ -178,9 +178,9 @@
       
       
       extern void fn(
-        const double* const a1__, 
-        const double* const a2__, 
-        double* const out__, 
+        const double* const a1__,
+        const double* const a2__,
+        double* const out__,
         const R_xlen_t a1__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/openmp-error-snapshots.md b/tests/testthat/_snaps/openmp-error-snapshots.md
index daa24124..be7e9716 100644
--- a/tests/testthat/_snaps/openmp-error-snapshots.md
+++ b/tests/testthat/_snaps/openmp-error-snapshots.md
@@ -73,8 +73,8 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const out___, 
+        const double* const x__,
+        double* const out___,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
@@ -194,8 +194,8 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const out___, 
+        const double* const x__,
+        double* const out___,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/parentheses.md b/tests/testthat/_snaps/parentheses.md
index c4affb4c..a55c3edc 100644
--- a/tests/testthat/_snaps/parentheses.md
+++ b/tests/testthat/_snaps/parentheses.md
@@ -42,10 +42,10 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
-        const double* const c__, 
-        const double* const d__, 
+        const double* const a__,
+        const double* const b__,
+        const double* const c__,
+        const double* const d__,
         double* const out___);
       
       SEXP fn_(SEXP _args) {
@@ -151,9 +151,9 @@
       
       
       extern void fn(
-        const double* const x__, 
-        const double* const y__, 
-        double* const out___, 
+        const double* const x__,
+        const double* const y__,
+        double* const out___,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/qr-solve.md b/tests/testthat/_snaps/qr-solve.md
index 88996bd4..a2fd1703 100644
--- a/tests/testthat/_snaps/qr-solve.md
+++ b/tests/testthat/_snaps/qr-solve.md
@@ -100,11 +100,11 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
-        double* const out___, 
-        const R_len_t a__dim_1_, 
-        const R_len_t a__dim_2_, 
+        const double* const a__,
+        const double* const b__,
+        double* const out___,
+        const R_len_t a__dim_1_,
+        const R_len_t a__dim_2_,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
@@ -266,12 +266,12 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
-        double* const out___, 
-        const R_len_t a__dim_1_, 
-        const R_len_t a__dim_2_, 
-        const R_len_t b__dim_2_, 
+        const double* const a__,
+        const double* const b__,
+        double* const out___,
+        const R_len_t a__dim_1_,
+        const R_len_t a__dim_2_,
+        const R_len_t b__dim_2_,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/recycling.md b/tests/testthat/_snaps/recycling.md
index 48363f9b..55d2948a 100644
--- a/tests/testthat/_snaps/recycling.md
+++ b/tests/testthat/_snaps/recycling.md
@@ -62,11 +62,11 @@
       
       
       extern void fn(
-        const double* const a__, 
-        const double* const b__, 
-        double* const out___, 
-        const R_xlen_t a__len_, 
-        const R_xlen_t b__len_, 
+        const double* const a__,
+        const double* const b__,
+        double* const out___,
+        const R_xlen_t a__len_,
+        const R_xlen_t b__len_,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/runif.md b/tests/testthat/_snaps/runif.md
index 508a128a..77a5e5a1 100644
--- a/tests/testthat/_snaps/runif.md
+++ b/tests/testthat/_snaps/runif.md
@@ -117,8 +117,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) {
@@ -192,8 +192,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) {
@@ -270,9 +270,9 @@
       
       
       extern void fn(
-        const int* const n__, 
-        const double* const a__, 
-        const double* const b__, 
+        const int* const n__,
+        const double* const a__,
+        const double* const b__,
         double* const out___);
       
       SEXP fn_(SEXP _args) {
@@ -379,8 +379,8 @@
       
       
       extern void fn(
-        const int* const n__, 
-        const double* const b__, 
+        const int* const n__,
+        const double* const b__,
         double* const out___);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/sapply-closures.md b/tests/testthat/_snaps/sapply-closures.md
index 80d060cb..eb026d3e 100644
--- a/tests/testthat/_snaps/sapply-closures.md
+++ b/tests/testthat/_snaps/sapply-closures.md
@@ -64,8 +64,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) {
@@ -153,9 +153,9 @@
       
       
       extern void fn(
-        const double* const x__, 
-        const double* const thresh__, 
-        int* const out__, 
+        const double* const x__,
+        const double* const thresh__,
+        int* const out__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -258,8 +258,8 @@
       
       
       extern void fn(
-        const double* const x__, 
-        int* const out__, 
+        const double* const x__,
+        int* const out__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -347,9 +347,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) {
@@ -456,10 +456,10 @@
       
       
       extern void fn(
-        const double* const x__, 
-        const double* const thresh__, 
-        int* const out__, 
-        const R_len_t x__dim_1_, 
+        const double* const x__,
+        const double* const thresh__,
+        int* const out__,
+        const R_len_t x__dim_1_,
         const R_len_t x__dim_2_);
       
       SEXP fn_(SEXP _args) {
@@ -579,10 +579,10 @@
       
       
       extern void fn(
-        const double* const x__, 
-        const int* const k__, 
-        double* const out__, 
-        const R_len_t x__dim_1_, 
+        const double* const x__,
+        const int* const k__,
+        double* const out__,
+        const R_len_t x__dim_1_,
         const R_len_t x__dim_2_);
       
       SEXP fn_(SEXP _args) {
@@ -713,10 +713,10 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const out__, 
-        const R_len_t x__dim_1_, 
-        const R_len_t x__dim_2_, 
+        const double* const x__,
+        double* const out__,
+        const R_len_t x__dim_1_,
+        const R_len_t x__dim_2_,
         const R_len_t x__dim_3_);
       
       SEXP fn_(SEXP _args) {
@@ -836,11 +836,11 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const out__, 
-        const R_len_t x__dim_1_, 
-        const R_len_t x__dim_2_, 
-        const R_len_t x__dim_3_, 
+        const double* const x__,
+        double* const out__,
+        const R_len_t x__dim_1_,
+        const R_len_t x__dim_2_,
+        const R_len_t x__dim_3_,
         const R_len_t x__dim_4_);
       
       SEXP fn_(SEXP _args) {
@@ -954,11 +954,11 @@
       
       
       extern void fn(
-        const double* const x__, 
-        const int* const k__, 
-        double* const out__, 
-        const R_len_t x__dim_1_, 
-        const R_len_t x__dim_2_, 
+        const double* const x__,
+        const int* const k__,
+        double* const out__,
+        const R_len_t x__dim_1_,
+        const R_len_t x__dim_2_,
         const R_len_t x__dim_3_);
       
       SEXP fn_(SEXP _args) {
@@ -1187,9 +1187,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) {
diff --git a/tests/testthat/_snaps/size-constraint.md b/tests/testthat/_snaps/size-constraint.md
index 553b661b..a019af2f 100644
--- a/tests/testthat/_snaps/size-constraint.md
+++ b/tests/testthat/_snaps/size-constraint.md
@@ -37,8 +37,8 @@
       
       
       extern void fn(
-        double* const a__, 
-        const double* const b__, 
+        double* const a__,
+        const double* const b__,
         const R_xlen_t a__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/subscript-validation.md b/tests/testthat/_snaps/subscript-validation.md
index 9e50c2b5..68563f16 100644
--- a/tests/testthat/_snaps/subscript-validation.md
+++ b/tests/testthat/_snaps/subscript-validation.md
@@ -37,9 +37,9 @@
       
       
       extern void fn(
-        const double* const x__, 
-        const int* const n__, 
-        double* const out___, 
+        const double* const x__,
+        const int* const n__,
+        double* const out___,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/superassignment-snapshots.md b/tests/testthat/_snaps/superassignment-snapshots.md
index 150886be..e23b68d1 100644
--- a/tests/testthat/_snaps/superassignment-snapshots.md
+++ b/tests/testthat/_snaps/superassignment-snapshots.md
@@ -64,8 +64,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) {
@@ -179,8 +179,8 @@
       
       
       extern void fn(
-        double* const x__, 
-        double* const out__, 
+        double* const x__,
+        double* const out__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -277,9 +277,9 @@
       
       
       extern void fn(
-        const int* const nx__, 
-        const int* const ny__, 
-        const int* const nz__, 
+        const int* const nx__,
+        const int* const ny__,
+        const int* const nz__,
         double* const a__);
       
       SEXP fn_(SEXP _args) {
@@ -414,9 +414,9 @@
       
       
       extern void fn(
-        double* const x__, 
-        double* const out__, 
-        const R_len_t x__dim_1_, 
+        double* const x__,
+        double* const out__,
+        const R_len_t x__dim_1_,
         const R_len_t x__dim_2_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/svd.md b/tests/testthat/_snaps/svd.md
index df02a59f..93efafcc 100644
--- a/tests/testthat/_snaps/svd.md
+++ b/tests/testthat/_snaps/svd.md
@@ -80,8 +80,8 @@
       
       
       extern void fn(
-        const double* const x__, 
-        double* const out___, 
+        const double* const x__,
+        double* const out___,
         char* quickr_err_msg);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/type-promotion.md b/tests/testthat/_snaps/type-promotion.md
index f7e25eba..8a81766c 100644
--- a/tests/testthat/_snaps/type-promotion.md
+++ b/tests/testthat/_snaps/type-promotion.md
@@ -36,8 +36,8 @@
       
       
       extern void fn(
-        const int* const x__, 
-        double* const out___, 
+        const int* const x__,
+        double* const out___,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -167,8 +167,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) {
@@ -231,8 +231,8 @@
       
       
       extern void fn(
-        const int* const x__, 
-        double* const out___, 
+        const int* const x__,
+        double* const out___,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -293,8 +293,8 @@
       
       
       extern void fn(
-        const int* const x__, 
-        double* const out___, 
+        const int* const x__,
+        double* const out___,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -356,9 +356,9 @@
       
       
       extern void fn(
-        const int* const a__, 
-        const double* const b__, 
-        double* const out___, 
+        const int* const a__,
+        const double* const b__,
+        double* const out___,
         const R_xlen_t a__len_);
       
       SEXP fn_(SEXP _args) {
@@ -493,8 +493,8 @@
       
       
       extern void fn(
-        const int* const a__, 
-        const int* const b__, 
+        const int* const a__,
+        const int* const b__,
         int* const out___);
       
       SEXP fn_(SEXP _args) {
@@ -570,8 +570,8 @@
       
       
       extern void fn(
-        const int* const x__, 
-        int* const out___, 
+        const int* const x__,
+        int* const out___,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/unary-intrinsics.md b/tests/testthat/_snaps/unary-intrinsics.md
index 57e11fc1..56aeb399 100644
--- a/tests/testthat/_snaps/unary-intrinsics.md
+++ b/tests/testthat/_snaps/unary-intrinsics.md
@@ -38,8 +38,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) {
@@ -102,8 +102,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 double* const x__, 
-        double* const out__, 
+        const double* const x__,
+        double* const out__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -230,8 +230,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) {
@@ -294,8 +294,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) {
@@ -358,8 +358,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) {
@@ -422,8 +422,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) {
@@ -486,8 +486,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) {
@@ -550,8 +550,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) {
@@ -614,8 +614,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) {
@@ -678,8 +678,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) {
@@ -742,8 +742,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) {
@@ -806,8 +806,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) {
@@ -870,8 +870,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) {
@@ -934,8 +934,8 @@
       
       
       extern void fn(
-        const int* const x__, 
-        int* const out__, 
+        const int* const x__,
+        int* const out__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
@@ -998,8 +998,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1062,8 +1062,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1126,8 +1126,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1190,8 +1190,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1254,8 +1254,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1318,8 +1318,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1382,8 +1382,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1446,8 +1446,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1510,8 +1510,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1574,8 +1574,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1638,8 +1638,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1702,8 +1702,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        double* const out__, 
+        const Rcomplex* const z__,
+        double* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1766,8 +1766,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        double* const out__, 
+        const Rcomplex* const z__,
+        double* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1830,8 +1830,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        double* const out__, 
+        const Rcomplex* const z__,
+        double* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1894,8 +1894,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        double* const out__, 
+        const Rcomplex* const z__,
+        double* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -1958,8 +1958,8 @@
       
       
       extern void fn(
-        const Rcomplex* const z__, 
-        Rcomplex* const out__, 
+        const Rcomplex* const z__,
+        Rcomplex* const out__,
         const R_xlen_t z__len_);
       
       SEXP fn_(SEXP _args) {
@@ -2021,8 +2021,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) {
@@ -2091,8 +2091,8 @@
       
       
       extern void fn(
-        const int* const x__, 
-        int* const out__, 
+        const int* const x__,
+        int* const out__,
         const R_xlen_t x__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/_snaps/which.md b/tests/testthat/_snaps/which.md
index 62d07976..f9d32b68 100644
--- a/tests/testthat/_snaps/which.md
+++ b/tests/testthat/_snaps/which.md
@@ -170,12 +170,12 @@
       
       
       extern void fn(
-        const int* const lgl1__, 
-        const int* const int1__, 
-        const double* const dbl1__, 
-        int* const out__, 
-        const R_xlen_t dbl1__len_, 
-        const R_xlen_t int1__len_, 
+        const int* const lgl1__,
+        const int* const int1__,
+        const double* const dbl1__,
+        int* const out__,
+        const R_xlen_t dbl1__len_,
+        const R_xlen_t int1__len_,
         const R_xlen_t lgl1__len_);
       
       SEXP fn_(SEXP _args) {
diff --git a/tests/testthat/test-bind.R b/tests/testthat/test-bind.R
index a580aa2f..cac2abb1 100644
--- a/tests/testthat/test-bind.R
+++ b/tests/testthat/test-bind.R
@@ -104,7 +104,7 @@ test_that("cbind/rbind enforce common lengths", {
 
 test_that("cbind/rbind reject rank > 2 inputs with clear errors", {
   capture_bind_error <- function(expr) {
-    tryCatch(expr, error = function(e) cat(conditionMessage(e), "\n"))
+    tryCatch(expr, error = function(e) cat(conditionMessage(e), "\n", sep = ""))
   }
 
   bad_cbind <- function(x) {
diff --git a/tests/testthat/test-internal-utils.R b/tests/testthat/test-internal-utils.R
index 977a8052..96baaf78 100644
--- a/tests/testthat/test-internal-utils.R
+++ b/tests/testthat/test-internal-utils.R
@@ -66,17 +66,9 @@ test_that("discard and drop_nulls behave as expected", {
   expect_identical(names(quickr:::drop_nulls(x, c("a", "c"))), c("b", "c"))
 })
 
-test_that("new_function and str_flatten_args are usable", {
+test_that("new_function is usable", {
   f <- quickr:::new_function(args = alist(x = ), body = quote(x + 1L))
   expect_identical(f(1L), 2L)
-
-  expect_identical(
-    quickr:::str_flatten_args("a", "b", multiline = FALSE),
-    "a,b"
-  )
-  expect_true(
-    grepl("\n", quickr:::str_flatten_args("a", "b", "c", multiline = TRUE))
-  )
 })
 
 test_that("parent.pkg detects namespaces and set_names mutates names", {
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index 5404967e..21de0a38 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -309,3 +309,59 @@ test_that("matrix(scalar, m, n) keeps the broadcast fast path on assignment", {
   expect_match(fsub, "m = 0.0_c_double", fixed = TRUE)
   expect_quick_identical(fn, list(2L, 3L))
 })
+
+test_that("matrix(scalar, m, n) broadcasts natively in elementwise ops", {
+  # Against a genuine rank-2 array the fill compiles to its scalar --
+  # no O(m*n) temporary is materialized.
+  broadcast <- function(x, n) {
+    declare(type(x = double(n, n)), type(n = integer(1)))
+    x + matrix(1, n, n)
+  }
+  expect_false(grepl("allocate", r2f(broadcast), fixed = TRUE))
+  expect_quick_identical(broadcast, list(matrix(as.double(1:4), 2, 2), 2L))
+
+  scalar_var_data <- function(x, s, n) {
+    declare(type(x = double(n, n)), type(s = double(1)), type(n = integer(1)))
+    x * matrix(s, n, n)
+  }
+  expect_quick_identical(
+    scalar_var_data,
+    list(matrix(as.double(1:4), 2, 2), 3, 2L)
+  )
+
+  # The claimed dims still participate in the conformability contract.
+  static_mismatch <- function(x) {
+    declare(type(x = double(2, 2)))
+    x + matrix(1, 3, 3)
+  }
+  expect_error(quick(static_mismatch), "matching dimensions")
+
+  symbolic <- function(x, k) {
+    declare(type(x = double(2, 2)), type(k = integer(1)))
+    x + matrix(1, k, k)
+  }
+  q_symbolic <- quick(symbolic)
+  expect_error(
+    q_symbolic(matrix(as.double(1:4), 2, 2), 3L),
+    "matching dimensions"
+  )
+  expect_identical(
+    q_symbolic(matrix(as.double(1:4), 2, 2), 2L),
+    symbolic(matrix(as.double(1:4), 2, 2), 2L)
+  )
+
+  # Two fills meeting each other still materialize (no scalar result
+  # with claimed array dims may escape).
+  both_fills <- function(n) {
+    declare(type(n = integer(1)))
+    sum(matrix(2, n, n) + matrix(3, n, n))
+  }
+  expect_quick_identical(both_fills, list(2L))
+
+  # A vector operand keeps the vector-matrix reshape rule.
+  vec_operand <- function(v) {
+    declare(type(v = double(2)))
+    v + matrix(1, 2, 3)
+  }
+  expect_quick_identical(vec_operand, list(c(1, 2)))
+})

From b538036f622a9212f2ac0cb85c096094493eaf8f Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 25 Jul 2026 01:45:24 +0200
Subject: [PATCH 43/97] Refuse reassignment between scalar and array shapes

check_assignment_compatible() exempted any assignment where either side
was length 1, so the two shape changes R handles by rebinding the symbol
went undiagnosed in both directions:

  x <- numeric(n); x <- 0   broadcast 0 across every element (R: length 1)
  x <- 1; x <- numeric(3)   kept only the first element (R: length 3)

Only the both-sides-length-1 case is genuinely compatible (a declared
double(1) is rank 1, a literal is rank 0), so exempt that and let
everything else reach the shape checks. Deferred-shape locals still
reallocate for an array value, as before.

Three declare()-size-expression tests assigned a scalar into an array
target as a way of reaching the size validator; they now use the same
size expression on both sides, which reaches the intended error without
depending on the exemption.
---
 NEWS.md                                       |  9 ++--
 R/r2f-operators-helpers.R                     | 33 ++++++++++++-
 tests/testthat/_snaps/size-constraint.md      |  4 +-
 tests/testthat/test-assignment-shape.R        | 49 +++++++++++++++++--
 tests/testthat/test-size-constraint.R         |  6 ++-
 tests/testthat/test-size-expr-abs.R           |  2 +-
 tests/testthat/test-size-expr-dim-nrow-ncol.R |  6 +--
 7 files changed, 93 insertions(+), 16 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index e03c8f34..4148926c 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -19,9 +19,12 @@
   `x <- numeric(2); x <- numeric(3)`) is a compile-time error;
   dimensions that cannot be compared at compile time are checked at run
   time. Previously such reassignments silently kept the old shape or
-  produced invalid Fortran. Assigning a scalar into an array variable
-  (native Fortran broadcast) is unchanged, as are locals declared with
-  unknown (`NA`) dims, which reallocate on assignment like R.
+  produced invalid Fortran. This also covers reassignment between a scalar
+  and an array in either direction: `x <- numeric(n); x <- 0` used to
+  broadcast the scalar across every element, and assigning an array to a
+  scalar variable used to keep only its first element, where R rebinds the
+  symbol in both cases. Locals declared with unknown (`NA`) dims still
+  reallocate on assignment, like R.
 
 - Elementwise operations (arithmetic, comparisons, `&`, `|`) now require
   operand lengths to match, unless one operand is a scalar or a vector is
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 47406b01..3fa425f8 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -623,9 +623,38 @@ check_assignment_compatible <- function(
   ) {
     return(invisible())
   }
-  if (passes_as_scalar(target) || passes_as_scalar(value)) {
+  target_scalar <- passes_as_scalar(target)
+  value_scalar <- passes_as_scalar(value)
+  # Two length-1 values conform whatever their ranks (a declared `double(1)`
+  # is rank 1; a literal is rank 0).
+  if (target_scalar && value_scalar) {
     return(invisible())
   }
+  deferred_local <- !target@is_external && has_self_size_dims(target)
+  if (target_scalar || value_scalar) {
+    # A deferred-shape local can genuinely take a new array shape.
+    if (deferred_local && !value_scalar) {
+      return(invisible())
+    }
+    # Otherwise one side is length 1 and the other is a real array. R
+    # rebinds the symbol to the new shape; Fortran cannot, and would
+    # silently broadcast a scalar across the array (or drop all but the
+    # first element of an array into a scalar).
+    stop(
+      "cannot reassign `",
+      name,
+      "`: replacement is ",
+      if (value_scalar) "a scalar" else "an array",
+      " but `",
+      name,
+      "` is ",
+      if (target_scalar) "a scalar" else "an array",
+      "; R would rebind `",
+      name,
+      "` to the new shape",
+      call. = FALSE
+    )
+  }
   if (target@rank != value@rank) {
     stop(
       "cannot reassign `",
@@ -640,7 +669,7 @@ check_assignment_compatible <- function(
       call. = FALSE
     )
   }
-  if (!target@is_external && has_self_size_dims(target)) {
+  if (deferred_local) {
     # deferred-shape local: implicit (re)allocation matches R's rebind
     return(invisible())
   }
diff --git a/tests/testthat/_snaps/size-constraint.md b/tests/testthat/_snaps/size-constraint.md
index a019af2f..7c11e972 100644
--- a/tests/testthat/_snaps/size-constraint.md
+++ b/tests/testthat/_snaps/size-constraint.md
@@ -5,7 +5,7 @@
     Output
       function(a, b) {
           declare(type(a = double(n)), type(b = double(n + 1)))
-          a <- sum(b)
+          a <- a + sum(b)
           a
         }
       <environment: 0x0>
@@ -26,7 +26,7 @@
         ! manifest end
       
       
-        a = sum(b)
+        a = (a + sum(b))
       end subroutine
     Code
       cat(cwrapper)
diff --git a/tests/testthat/test-assignment-shape.R b/tests/testthat/test-assignment-shape.R
index 51bb86cb..226b0f55 100644
--- a/tests/testthat/test-assignment-shape.R
+++ b/tests/testthat/test-assignment-shape.R
@@ -87,12 +87,55 @@ test_that("shape-preserving reassignments still compile", {
   }
   expect_quick_identical(fn_same, c(1, 2, 3))
 
-  # scalar broadcast into an array target keeps working
-  fn_scalar <- function(a) {
+  # two length-1 values conform whatever their ranks: a declared double(1)
+  # is rank 1, a literal is rank 0
+  fn_len1 <- function(a) {
+    declare(type(a = double(1)))
+    a <- 2
+    a
+  }
+  expect_quick_identical(fn_len1, 1)
+})
+
+test_that("reassignment between scalar and array shapes is refused", {
+  # R rebinds `x` to the scalar; Fortran would broadcast it across the
+  # array, so every element would change instead of the shape
+  fn_scalar_into_array <- function(a) {
     declare(type(a = double(n)))
     x <- a
     x <- 0
     sum(x)
   }
-  expect_no_error(r2f(fn_scalar))
+  expect_error(
+    r2f(fn_scalar_into_array),
+    "replacement is a scalar but `x` is an array",
+    fixed = TRUE
+  )
+
+  # the reduction form of the same mistake
+  fn_reduce_into_array <- function(a) {
+    declare(type(a = double(n)))
+    x <- a
+    x <- sum(x)
+    x
+  }
+  expect_error(
+    r2f(fn_reduce_into_array),
+    "replacement is a scalar but `x` is an array",
+    fixed = TRUE
+  )
+
+  # the other direction: R rebinds to the array, Fortran would keep only
+  # the first element
+  fn_array_into_scalar <- function(a) {
+    declare(type(a = double(3)))
+    x <- 1
+    x <- a
+    x
+  }
+  expect_error(
+    r2f(fn_array_into_scalar),
+    "replacement is an array but `x` is a scalar",
+    fixed = TRUE
+  )
 })
diff --git a/tests/testthat/test-size-constraint.R b/tests/testthat/test-size-constraint.R
index 7b42fffa..7e5e5539 100644
--- a/tests/testthat/test-size-constraint.R
+++ b/tests/testthat/test-size-constraint.R
@@ -5,7 +5,7 @@ skip_on_cran()
 test_that("size constraint", {
   fn <- function(a, b) {
     declare(type(a = double(n)), type(b = double(n + 1)))
-    a <- sum(b)
+    a <- a + sum(b)
     a
   }
 
@@ -20,7 +20,9 @@ test_that("size constraint", {
     fixed = TRUE
   )
   expect_translation_snapshots(fn, "call_size_constraint")
-  expect_equal(qfn(1, c(2, 3)), 5)
+  # `a` stays an array: reassigning a scalar into it would be a shape
+  # change, which R does by rebinding and Fortran cannot do at all
+  expect_equal(qfn(1, c(2, 3)), 6)
 })
 
 test_that("size constraint", {
diff --git a/tests/testthat/test-size-expr-abs.R b/tests/testthat/test-size-expr-abs.R
index 1027730c..704baf1e 100644
--- a/tests/testthat/test-size-expr-abs.R
+++ b/tests/testthat/test-size-expr-abs.R
@@ -29,7 +29,7 @@ test_that("declare() size expressions validate abs() arity", {
       type(m = integer(1)),
       type(out = double(abs(n, m)))
     )
-    out <- double(1L)
+    out <- double(abs(n, m))
     out
   }
 
diff --git a/tests/testthat/test-size-expr-dim-nrow-ncol.R b/tests/testthat/test-size-expr-dim-nrow-ncol.R
index 8097c3b6..9b2d2dbc 100644
--- a/tests/testthat/test-size-expr-dim-nrow-ncol.R
+++ b/tests/testthat/test-size-expr-dim-nrow-ncol.R
@@ -42,12 +42,12 @@ test_that("declare() size expressions support dim(x)[axis] indices", {
 test_that("declare() size expressions validate nrow()/ncol() arity", {
   bad_nrow <- function(x) {
     declare(type(x = double(NA, NA)), type(out = double(nrow(x, 1L))))
-    out <- double(1L)
+    out <- double(nrow(x, 1L))
     out
   }
   bad_ncol <- function(x) {
     declare(type(x = double(NA, NA)), type(out = double(ncol(x, 1L))))
-    out <- double(1L)
+    out <- double(ncol(x, 1L))
     out
   }
 
@@ -68,7 +68,7 @@ test_that("declare() size expressions reject ncol() beyond variable rank", {
 test_that("declare() size expressions reject unsupported calls", {
   bad <- function(n) {
     declare(type(n = integer(1)), type(out = double(sum(n))))
-    out <- double(1L)
+    out <- double(sum(n))
     out
   }
 

From 6bcadbb222a4b42749cd6f8a01ebe385fa957020 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 11:49:44 +0200
Subject: [PATCH 44/97] Let hoists report emptiness instead of comparing
 rendered text

The while handler inferred "nothing hoisted" from render() returning
its input unchanged -- true today, but any formatting change in render()
would silently flip every plain do-while into the exit-check lowering.
new_hoist() exposes is_empty() and render() reuses it.

Review finding (fable-final-review.md #6); no behavior change.
---
 R/r2f-aab-core.R     | 7 ++++++-
 R/r2f-control-flow.R | 5 ++---
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/R/r2f-aab-core.R b/R/r2f-aab-core.R
index af222e03..d467217a 100644
--- a/R/r2f-aab-core.R
+++ b/R/r2f-aab-core.R
@@ -20,6 +20,10 @@ new_hoist <- function(scope) {
 
   has_block <- function() !is.null(block_scope)
 
+  # TRUE when render(code) would return `code` unchanged: nothing emitted,
+  # no block-scoped temporaries declared.
+  is_empty <- function() !length(hoisted) && !has_block()
+
   ensure_block_scope <- function() {
     if (is.null(block_scope)) {
       block_scope <<- scope_new_child(scope, "block")
@@ -42,7 +46,7 @@ new_hoist <- function(scope) {
 
   render <- function(code) {
     code <- str_split_lines(code)
-    if (!length(hoisted) && !has_block()) {
+    if (is_empty()) {
       return(str_flatten_lines(code))
     }
 
@@ -65,6 +69,7 @@ new_hoist <- function(scope) {
     list(
       emit = emit,
       declare_tmp = declare_tmp,
+      is_empty = is_empty,
       render = render
     ),
     parent = emptyenv()
diff --git a/R/r2f-control-flow.R b/R/r2f-control-flow.R
index 47ac8bd6..e46afe8c 100644
--- a/R/r2f-control-flow.R
+++ b/R/r2f-control-flow.R
@@ -82,9 +82,7 @@ r2f_handlers[["while"]] <- function(args, scope, ..., hoist = NULL) {
   # (`{` bodies already isolate each statement.)
   body <- r2f(args[[2]], scope, ..., hoist = NULL)
   check_pending_parallel_consumed(scope)
-  exit_check <- glue("if (.not. ({cond})) exit")
-  cond_code <- cond_hoist$render(exit_check)
-  if (identical(as.character(cond_code), as.character(exit_check))) {
+  if (cond_hoist$is_empty()) {
     # nothing hoisted: keep the plain do-while form
     return(Fortran(glue(
       "do while ({cond})
@@ -93,6 +91,7 @@ r2f_handlers[["while"]] <- function(args, scope, ..., hoist = NULL) {
       "
     )))
   }
+  cond_code <- cond_hoist$render(glue("if (.not. ({cond})) exit"))
   Fortran(glue(
     "do
     {indent(cond_code)}

From 7793ad5b581879568d9e7efb04e29970190ef566 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 11:52:58 +0200
Subject: [PATCH 45/97] Vignette: multi-arg reductions join logicals as
 integer, unlike c()

The shared table row said "join of all argument types" for both; that
is exact for c() but understated min/max/sum/prod, which follow R in
treating logical arguments as integers (sum(TRUE, TRUE) is 2L). Split
the row.

Review finding (fable-final-review.md #7).
---
 vignettes/quickr-semantics.Rmd | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/vignettes/quickr-semantics.Rmd b/vignettes/quickr-semantics.Rmd
index b16f0bd0..66281185 100644
--- a/vignettes/quickr-semantics.Rmd
+++ b/vignettes/quickr-semantics.Rmd
@@ -63,7 +63,8 @@ quickr then matches:
 | `%%`, `%/%` | join of the operand types; logicals count as integers |
 | `<` `<=` `>` `>=` `==` `!=` | logical |
 | `&`, `|`, `!`, `&&`, `||` | logical (see [logical operators](#logical-operators) below) |
-| `c()`, and multi-argument `min()` / `max()` / `sum()` / `prod()` | join of all argument types |
+| `c()` | join of all argument types (`c(TRUE, FALSE)` stays logical, as in R) |
+| multi-argument `min()` / `max()` / `sum()` / `prod()` | join of all argument types; logicals count as integers (in R, `sum(TRUE, TRUE)` is `2L`) |
 | single-argument reductions (`sum(x)`, ...), `abs()` | type of `x`; logical counts as integer |
 | `ifelse(test, yes, no)` | join of `yes` and `no` (but see [ifelse](#ifelse) below) |
 | `%*%`, `crossprod()`, `solve()`, and other linear algebra | always double, as in R; complex operands are a compile error (see [complex values](#complex)) |

From 5818aa0ea345e3a56532a353c91801e284de7a0e Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 16:40:33 +0200
Subject: [PATCH 46/97] Refuse complex operands in linear algebra

The BLAS/LAPACK paths cast logical/integer operands to double via
maybe_cast_double(), which passes complex through untouched -- so
complex operands flowed into the real d* routines, which read complex
storage as reals: complex(2) %*% complex(2) returned a real dot product
of the real parts where R returns the complex result. A silent wrong
answer, found in external review.

All linalg operand casts now go through cast_linalg_double(), which
refuses complex with a compile-time message naming the divergence
(linear algebra in quickr is double-only). Covers %*% (including t()
forms), crossprod/tcrossprod, solve/qr.solve, forwardsolve/backsolve,
chol, chol2inv, svd, and outer. The mode-preserving standalone t() and
elementwise complex arithmetic are untouched.
---
 R/r2f-matrix-blas.R          | 20 ++++++++--------
 R/r2f-matrix-parse.R         |  4 ++--
 R/r2f-matrix.R               |  9 +++++---
 R/r2f-operators-helpers.R    | 18 +++++++++++++++
 tests/testthat/test-errors.R | 45 ++++++++++++++++++++++++++++++++++++
 5 files changed, 81 insertions(+), 15 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index d2846b14..3b693279 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -471,8 +471,8 @@ outer_mul <- function(
 ) {
   assert_hoist_env(hoist)
 
-  x <- maybe_cast_double(x)
-  y <- maybe_cast_double(y)
+  x <- cast_linalg_double(x, context)
+  y <- cast_linalg_double(y, context)
 
   if (x@value@rank > 1L || y@value@rank > 1L) {
     stop("outer() only supports vectors or scalars")
@@ -523,8 +523,8 @@ triangular_solve <- function(
 ) {
   assert_hoist_env(hoist)
 
-  A <- maybe_cast_double(A)
-  B <- maybe_cast_double(B)
+  A <- cast_linalg_double(A, context)
+  B <- cast_linalg_double(B, context)
 
   assert_rank2_matrix(A, "triangular solve expects a matrix")
 
@@ -605,8 +605,8 @@ lapack_solve <- function(
 ) {
   assert_hoist_env(hoist)
 
-  A <- maybe_cast_double(A)
-  B <- maybe_cast_double(B)
+  A <- cast_linalg_double(A, context)
+  B <- cast_linalg_double(B, context)
 
   assert_rank2_matrix(A, paste0(context, " expects a matrix for `a`"))
 
@@ -812,7 +812,7 @@ end do"
 lapack_inverse <- function(A, scope, hoist, dest = NULL, context = "solve") {
   assert_hoist_env(hoist)
 
-  A <- maybe_cast_double(A)
+  A <- cast_linalg_double(A, context)
   assert_rank2_matrix(A, paste0(context, " expects a matrix for `a`"))
 
   a_dims <- matrix_dims(A)
@@ -886,7 +886,7 @@ lapack_inverse <- function(A, scope, hoist, dest = NULL, context = "solve") {
 lapack_chol <- function(A, scope, hoist, dest = NULL, context = "chol") {
   assert_hoist_env(hoist)
 
-  A <- maybe_cast_double(A)
+  A <- cast_linalg_double(A, context)
   assert_rank2_matrix(A, paste0(context, " expects a matrix"))
 
   a_dims <- matrix_dims(A)
@@ -949,7 +949,7 @@ lapack_chol2inv <- function(
 ) {
   assert_hoist_env(hoist)
 
-  R <- maybe_cast_double(R)
+  R <- cast_linalg_double(R, context)
   assert_rank2_matrix(R, paste0(context, " expects a matrix"))
 
   r_dims <- matrix_dims(R)
@@ -1161,7 +1161,7 @@ lapack_svd <- function(
   assert_hoist_env(hoist)
   stopifnot(inherits(d, Variable), inherits(u, Variable), inherits(v, Variable))
 
-  A <- maybe_cast_double(A)
+  A <- cast_linalg_double(A, context)
   dims <- svd_dims(A, context = context)
   m <- dims$m
   n <- dims$n
diff --git a/R/r2f-matrix-parse.R b/R/r2f-matrix-parse.R
index d492f0f7..f242bd6e 100644
--- a/R/r2f-matrix-parse.R
+++ b/R/r2f-matrix-parse.R
@@ -9,7 +9,7 @@ unwrap_transpose_arg <- function(arg, scope, ..., hoist) {
   if (is_call(arg_unwrapped, quote(t)) && length(arg_unwrapped) == 2L) {
     inner_arg <- unwrap_parens(arg_unwrapped[[2L]])
     inner <- r2f(inner_arg, scope, ..., hoist = hoist)
-    inner <- maybe_cast_double(inner)
+    inner <- cast_linalg_double(inner, "%*%")
     if (inner@value@rank == 2L) {
       return(list(value = inner, trans = "T"))
     } else if (inner@value@rank == 1L) {
@@ -26,7 +26,7 @@ unwrap_transpose_arg <- function(arg, scope, ..., hoist) {
     }
   }
   value <- r2f(arg, scope, ..., hoist = hoist)
-  value <- maybe_cast_double(value)
+  value <- cast_linalg_double(value, "%*%")
   list(value = value, trans = "N")
 }
 
diff --git a/R/r2f-matrix.R b/R/r2f-matrix.R
index 57dabee8..7fedffe4 100644
--- a/R/r2f-matrix.R
+++ b/R/r2f-matrix.R
@@ -627,7 +627,10 @@ register_r2f_handler(
     tol <- if (is.null(tol_arg) || is_missing(tol_arg)) {
       r2f(1e-7, scope, ..., hoist = hoist)
     } else {
-      tol <- maybe_cast_double(r2f(tol_arg, scope, ..., hoist = hoist))
+      tol <- cast_linalg_double(
+        r2f(tol_arg, scope, ..., hoist = hoist),
+        "qr.solve"
+      )
       if (tol@value@rank != 0L) {
         stop("qr.solve() expects a scalar `tol`", call. = FALSE)
       }
@@ -916,7 +919,7 @@ crossprod_like <- function(
   context
 ) {
   x <- r2f(x_arg, scope, ..., hoist = hoist)
-  x <- maybe_cast_double(x)
+  x <- cast_linalg_double(x, context)
 
   if (is.null(y_arg)) {
     return(syrk(
@@ -929,7 +932,7 @@ crossprod_like <- function(
     ))
   }
 
-  y <- maybe_cast_double(r2f(y_arg, scope, ..., hoist = hoist))
+  y <- cast_linalg_double(r2f(y_arg, scope, ..., hoist = hoist), context)
 
   x_dims <- matrix_dims(x)
   y_dims <- matrix_dims(y)
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 4561adbe..33db9808 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -85,6 +85,24 @@ maybe_cast_double <- function(x) {
   }
 }
 
+# Cast a linear-algebra operand to double for the real BLAS/LAPACK
+# lowerings (dgemm, dgesv, ...). Complex operands are refused: the d*
+# routines would read complex storage as reals and return a plausible
+# wrong answer, and quickr has no z* lowerings. R supports complex
+# linear algebra, so the message names the divergence.
+# Used by: r2f-matrix.R, r2f-matrix-parse.R, r2f-matrix-blas.R
+cast_linalg_double <- function(x, context) {
+  if (identical(x@value@mode, "complex")) {
+    stop(
+      context,
+      " does not support complex operands; ",
+      "linear algebra in quickr is double-only",
+      call. = FALSE
+    )
+  }
+  maybe_cast_double(x)
+}
+
 # Promote a list of operands to their common (lattice-join) mode, casting
 # each one whose mode differs. For contexts where Fortran requires uniform
 # argument types: array constructors (c()), min/max, merge, modulo.
diff --git a/tests/testthat/test-errors.R b/tests/testthat/test-errors.R
index 94e8c80b..fda1e248 100644
--- a/tests/testthat/test-errors.R
+++ b/tests/testthat/test-errors.R
@@ -223,3 +223,48 @@ test_that("unsupported complex operations are refused with R's messages", {
   }
   expect_error(quick(complex_mod), "unimplemented complex operation")
 })
+
+test_that("complex operands are refused in linear algebra", {
+  # The real BLAS/LAPACK lowerings (dgemm, dgesv, ...) would read complex
+  # storage as reals and return a plausible wrong answer where R returns a
+  # complex result: complex(2) %*% complex(2) returned a real dot product
+  # of the real parts. Refuse at compile time instead.
+  complex_matmul <- function(x, y) {
+    declare(type(x = complex(2)), type(y = complex(2)))
+    x %*% y
+  }
+  expect_error(
+    quick(complex_matmul),
+    "%*% does not support complex operands",
+    fixed = TRUE
+  )
+
+  # One complex operand is enough to poison the d* routine.
+  complex_mixed <- function(x, y) {
+    declare(type(x = complex(2, 2)), type(y = double(2, 2)))
+    x %*% y
+  }
+  expect_error(quick(complex_mixed), "does not support complex operands")
+
+  complex_solve <- function(x) {
+    declare(type(x = complex(2, 2)))
+    solve(x)
+  }
+  expect_error(quick(complex_solve), "does not support complex operands")
+
+  complex_crossprod <- function(x) {
+    declare(type(x = complex(2, 2)))
+    crossprod(x)
+  }
+  expect_error(quick(complex_crossprod), "does not support complex operands")
+
+  # t() alone is mode-preserving and keeps working on complex values.
+  complex_t <- function(x) {
+    declare(type(x = complex(2, 2)))
+    t(x)
+  }
+  expect_quick_identical(
+    complex_t,
+    list(matrix(c(1 + 1i, 2 + 0i, 3 - 1i, 4 + 2i), 2, 2))
+  )
+})

From 8ae9808575bfe5a7747e58631102699c0a69540e Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 11:52:31 +0200
Subject: [PATCH 47/97] Route the scalar-matrix broadcast guards through
 guard_conformable_dims()

The broadcast fast path hand-rolled the check + guard emission because
guard_dim_f() could only spell a guard side as a literal or as
size(operand), and the fill has no array to size(). guard_dim_f() now
accepts a caller-provided spelling, so the one conformability policy has
no bypass, and the elementwise matrix message is a single shared
constant (the runtime-guard text must match the compile-error text).

Review finding (fable-final-review.md #4); emitted code is unchanged.
---
 R/r2f-operators-helpers.R | 63 +++++++++++++++++++++++----------------
 1 file changed, 37 insertions(+), 26 deletions(-)

diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 6b9e207d..8126e3a8 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -199,22 +199,19 @@ lower_elementwise_operands <- function(args, scope, ..., hoist = NULL) {
     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
-          )
-        }
+        # The fill has no array to size(), so its side of a runtime guard
+        # is spelled from the claimed dim expression via `left_f`.
+        guard_conformable_dims(
+          fill_dims[[axis]],
+          if (axis == 1L) other_dims$rows else other_dims$cols,
+          elementwise_matrix_msg,
+          hoist,
+          scope,
+          left = NULL,
+          right = other,
+          right_axis = axis,
+          left_f = glue("({fill_dims_f[[axis]]})")
+        )
       }
       fill <- r2f(fills[[j]]$data, scope, ..., hoist = hoist)
       out <- list(fill, other)
@@ -292,12 +289,22 @@ check_elementwise_lengths <- function(left, right) {
   list(ok = TRUE, unknown = TRUE)
 }
 
-# Render one side of a dim-comparison guard: a literal dim as the literal,
-# anything else as the operand's actual extent (whole size when `axis` is
-# NULL). size() is an inquiry, so applying it to operand expression text
-# does not evaluate the operand.
+# The message shared by every enforcement point of the elementwise matrix
+# shape contract: the runtime-guard text must match the compile-error text.
+elementwise_matrix_msg <-
+  "elementwise matrix operations require matching dimensions"
+
+# Render one side of a dim-comparison guard: a caller-provided spelling
+# (`f`, for operands with no array to size(), e.g. a scalar fill's claimed
+# dims) wins; then a literal dim as the literal; anything else as the
+# operand's actual extent (whole size when `axis` is NULL). size() is an
+# inquiry, so applying it to operand expression text does not evaluate the
+# operand.
 # Used by: guard_conformable_dims()
-guard_dim_f <- function(dim, operand, axis = NULL) {
+guard_dim_f <- function(dim, operand, axis = NULL, f = NULL) {
+  if (!is.null(f)) {
+    return(f)
+  }
   if (is_wholenumber(dim)) {
     return(as.character(as.integer(dim)))
   }
@@ -318,7 +325,10 @@ guard_dim_f <- function(dim, operand, axis = NULL) {
 # `hoist` is always live: r2f() opens one per statement before dispatching
 # to a handler, and every caller forwards the one it received.
 # emit_quickr_error_if() asserts it.
-# Used by: maybe_reshape_vector_matrix(), r2f-conditionals.R, r2f-matrix*.R
+# Used by: maybe_reshape_vector_matrix(), lower_elementwise_operands(),
+# r2f-conditionals.R, r2f-matrix*.R. `left_f`/`right_f` override that
+# side's guard spelling (see guard_dim_f()); its `left`/`right` operand is
+# then unused and may be NULL.
 guard_conformable_dims <- function(
   left_dim,
   right_dim,
@@ -328,7 +338,9 @@ guard_conformable_dims <- function(
   left,
   right,
   left_axis = NULL,
-  right_axis = NULL
+  right_axis = NULL,
+  left_f = NULL,
+  right_f = NULL
 ) {
   stopifnot(is_string(message))
   conform <- check_elementwise_lengths(left_dim, right_dim)
@@ -338,7 +350,7 @@ guard_conformable_dims <- function(
   if (conform$unknown) {
     emit_quickr_error_if(
       glue(
-        "{guard_dim_f(left_dim, left, left_axis)} /= {guard_dim_f(right_dim, right, right_axis)}"
+        "{guard_dim_f(left_dim, left, left_axis, left_f)} /= {guard_dim_f(right_dim, right, right_axis, right_f)}"
       ),
       message,
       hoist,
@@ -472,14 +484,13 @@ maybe_reshape_vector_matrix <- function(
   }
 
   if (left_rank == 2L && right_rank == 2L) {
-    matrix_msg <- "elementwise matrix operations require matching dimensions"
     left_dims <- matrix_dims(left)
     right_dims <- matrix_dims(right)
     for (axis in 1:2) {
       guard_conformable_dims(
         if (axis == 1L) left_dims$rows else left_dims$cols,
         if (axis == 1L) right_dims$rows else right_dims$cols,
-        matrix_msg,
+        elementwise_matrix_msg,
         hoist,
         scope,
         left = left,

From 39a5373d8b586270db24e63c64168430c1013eb7 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 25 Jul 2026 01:45:44 +0200
Subject: [PATCH 48/97] Take R's diag() identity form for any length-1 x

R's rule for diag(x) is length(x) == 1 with no nrow/ncol, not rank 0.
quickr tested the rank, so a literal (diag(3L)) and a constant-folded
local took the identity path while a declared integer(1) argument fell
through to the vector constructor and produced a 1x1 matrix holding n
instead of the n-by-n identity -- wrong in both shape and values.

Both the handler and infer_dest_diag() now use passes_as_scalar(), so
lowering and destination inference cannot disagree about which form a
call takes.

R derives the size with as.integer(x), which also makes diag(3.7) the
3x3 identity. Size expressions gain as.integer() so quickr can spell the
same thing: INT() in Fortran (truncates toward zero, like R), a cast in
the C bridge, and r2size() folds a literal instead of rejecting a
non-whole double. The two renderers that spell a dim by deparsing --
bind_dim_string() and blas_int() -- route through one small rewriter so
the R name cannot leak into emitted Fortran.
---
 NEWS.md                             | 12 +++++
 R/c-wrapper.R                       | 10 ++++
 R/manifest.R                        |  2 +
 R/r2f-matrix-blas.R                 |  2 +-
 R/r2f-matrix-infer.R                |  7 ++-
 R/r2f-matrix.R                      | 26 +++++++--
 R/r2f-operators-helpers.R           | 22 ++++++++
 R/sizes.R                           | 35 ++++++++++++
 tests/testthat/test-matrix.R        | 82 +++++++++++++++++++++++++++++
 tests/testthat/test-size-expr-abs.R | 18 +++++++
 10 files changed, 210 insertions(+), 6 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 4148926c..94ff236b 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -26,6 +26,18 @@
   symbol in both cases. Locals declared with unknown (`NA`) dims still
   reallocate on assignment, like R.
 
+- `diag(x)` with a length-1 `x` and no `nrow`/`ncol` now builds the
+  identity matrix of size `x`, matching R. Previously only a *literal*
+  size took that path, so `diag(n)` with `n` declared `integer(1)`
+  returned a 1x1 matrix containing `n` instead of the n-by-n identity —
+  a silent divergence in both shape and values. As in R the size is
+  `as.integer(x)`, so a `double` or `logical` `x` works and truncates
+  toward zero (`diag(3.7)` is the 3x3 identity, as in R). Use
+  `diag(x, nrow)` for a 1x1 matrix holding `x`.
+
+- `declare()` size expressions now accept `as.integer()`, which lowers to
+  Fortran's `INT()` and to an integer cast in the generated C bridge.
+
 - Elementwise operations (arithmetic, comparisons, `&`, `|`) now require
   operand lengths to match, unless one operand is a scalar or a vector is
   combined column-wise with a matrix whose rows it spans. R-style partial
diff --git a/R/c-wrapper.R b/R/c-wrapper.R
index cf547300..6bc6bc32 100644
--- a/R/c-wrapper.R
+++ b/R/c-wrapper.R
@@ -627,6 +627,16 @@ dims2c_expr <- function(e, scope, c_hoist = NULL) {
     return(glue("(({e1}) < 0 ? -({e1}) : ({e1}))"))
   }
 
+  if (identical(op, "as.integer")) {
+    if (length(args) != 1L) {
+      stop("as.integer() expects one argument")
+    }
+    # a C cast to an integer type truncates toward zero, as R's
+    # as.integer() does
+    e1 <- dims2c_expr(args[[1L]], scope, c_hoist = c_hoist)
+    return(glue("((R_xlen_t)({e1}))"))
+  }
+
   if (op %in% c("+", "-", "*", "/", "%/%", "%%", "^")) {
     if (length(args) == 1L && op %in% c("+", "-")) {
       e1 <- dims2c_expr(args[[1L]], scope, c_hoist = c_hoist)
diff --git a/R/manifest.R b/R/manifest.R
index 6667b6cd..4f4d6303 100644
--- a/R/manifest.R
+++ b/R/manifest.R
@@ -511,6 +511,8 @@ dims2f_eval_base_env[["%%"]] <- function(e1, e2) {
 }
 dims2f_eval_base_env[["^"]] <- function(e1, e2) glue("({e1})**({e2})")
 dims2f_eval_base_env[["abs"]] <- function(x) glue("abs({x})")
+# Fortran INT() truncates toward zero, like as.integer() in R.
+dims2f_eval_base_env[["as.integer"]] <- function(x) glue("int({x})")
 dims2f_eval_base_env[["quickr_seq_length"]] <- function(from, to, by) {
   safe_by <- glue("merge(int({by}), 1, int({by}) /= 0)")
   glue("(abs((int({to}) - int({from})) / {safe_by}) + 1)")
diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index e2de10ca..72a529e8 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -353,7 +353,7 @@ ensure_blas_operand_name <- function(x, hoist) {
 # Wrap an expression as a BLAS int literal.
 blas_int <- function(x) {
   x_str <- if (is.language(x)) {
-    gsub("([0-9]+)L\\b", "\\1", deparse1(x))
+    gsub("([0-9]+)L\\b", "\\1", deparse1(fortranize_size_calls(x)))
   } else if (is_wholenumber(x)) {
     as.character(as.integer(x))
   } else {
diff --git a/R/r2f-matrix-infer.R b/R/r2f-matrix-infer.R
index 8bc4082a..295b4f8c 100644
--- a/R/r2f-matrix-infer.R
+++ b/R/r2f-matrix-infer.R
@@ -325,8 +325,11 @@ infer_dest_diag <- function(args, scope) {
     }
   }
 
-  # Case: x is a scalar symbol without nrow/ncol (identity matrix)
-  if (!is.null(x) && x@rank == 0L && !has_nrow && !has_ncol) {
+  # Case: x is a length-1 symbol without nrow/ncol (identity matrix). Must
+  # match the handler's predicate exactly, or the inferred destination
+  # would be the 1x1 constructor result instead of the identity's (x, x).
+  # The size depends on x's value, so leave the destination uninferred.
+  if (!is.null(x) && passes_as_scalar(x) && !has_nrow && !has_ncol) {
     return(NULL)
   }
 
diff --git a/R/r2f-matrix.R b/R/r2f-matrix.R
index 786a895b..bd60f290 100644
--- a/R/r2f-matrix.R
+++ b/R/r2f-matrix.R
@@ -312,7 +312,7 @@ bind_dim_string <- function(dim) {
   } else if (is.numeric(dim)) {
     as.character(dim)
   } else {
-    gsub("([0-9]+)L\\b", "\\1", deparse1(dim))
+    gsub("([0-9]+)L\\b", "\\1", deparse1(fortranize_size_calls(dim)))
   }
 }
 
@@ -710,8 +710,28 @@ register_r2f_handler(
       "diag() only supports scalar, vector, or matrix inputs"
     )
 
-    if (!has_nrow && !has_ncol && x_rank == 0L) {
-      nrow <- r2size(x_arg, scope)
+    # R's identity form is `length(x) == 1L` with no nrow/ncol -- it does
+    # not require a rank-0 value, so a declared `integer(1)` argument or a
+    # length-1 vector takes it too (R: diag(c(3)) is the 3x3 identity).
+    # The size comes from x's *value*, and the result is always double.
+    if (!has_nrow && !has_ncol && passes_as_scalar(x@value)) {
+      # R sizes the identity with as.integer(x), so a double or logical `x`
+      # is fine and truncates toward zero. Coerce in the size expression
+      # rather than requiring an integer, so diag(n) works whatever the
+      # caller declared. An integer `x` needs no wrapper.
+      size_arg <- if (identical(x@value@mode, "integer")) {
+        x_arg
+      } else if (x@value@mode %in% c("double", "logical")) {
+        call("as.integer", x_arg)
+      } else {
+        stop(
+          "diag(x) with a length-1 `x` builds an identity matrix of size ",
+          "`x`, which requires a numeric `x`; got ",
+          x@value@mode,
+          call. = FALSE
+        )
+      }
+      nrow <- r2size(size_arg, scope)
       ncol <- nrow
       x_val <- Fortran("1.0_c_double", Variable("double"))
       return(diag_matrix(
diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 3fa425f8..6e08a10c 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -395,6 +395,28 @@ reshape_vector_for_matrix <- function(vec, rows, cols) {
   Fortran(out_expr, out_val)
 }
 
+# Size expressions may carry an as.integer() coercion (diag()'s identity
+# form sizes the result with as.integer(x), as R does). The two renderers
+# that spell a dim by deparsing -- bind_dim_string() and blas_int() -- would
+# emit the R name verbatim, so map it to Fortran's INT(), which truncates
+# toward zero the same way. dims2f()/dims2c() translate the call properly
+# and do not need this.
+# Used by: bind_dim_string() (r2f-matrix.R), blas_int() (r2f-matrix-blas.R)
+fortranize_size_calls <- function(e) {
+  if (!is.call(e)) {
+    return(e)
+  }
+  if (identical(e[[1L]], quote(as.integer))) {
+    e[[1L]] <- quote(int)
+  }
+  for (i in seq_along(e)[-1L]) {
+    if (!is_missing(e[[i]])) {
+      e[[i]] <- fortranize_size_calls(e[[i]])
+    }
+  }
+  e
+}
+
 # Floor a double expression while staying in the real domain: Fortran
 # FLOOR() returns an integer, so a large double (e.g. 1e20) would
 # silently overflow. aint(x) truncates toward 0 (real result); adjust by
diff --git a/R/sizes.R b/R/sizes.R
index c3dd840d..e8f6068c 100644
--- a/R/sizes.R
+++ b/R/sizes.R
@@ -228,6 +228,41 @@ r2size <- function(r, scope) {
 
         switch(
           op,
+          as.integer = {
+            if (length(r) != 2L) {
+              stop("as.integer() in a size expression expects one argument")
+            }
+            # A numeric literal is coerced here rather than recursed into:
+            # r2size() rejects a non-whole double, which is exactly the
+            # case as.integer() exists to handle.
+            if (is.numeric(r[[2L]]) && length(r[[2L]]) == 1L) {
+              return(as.integer(r[[2L]]))
+            }
+            # An explicit coercion is exactly what the "not an integer"
+            # warning asks for, so don't also warn about the operand.
+            inner <- withCallingHandlers(
+              r2size(r[[2L]], scope),
+              warning = function(w) {
+                if (
+                  grepl(
+                    "size is not an integer",
+                    conditionMessage(w),
+                    fixed = TRUE
+                  )
+                ) {
+                  invokeRestart("muffleWarning")
+                }
+              }
+            )
+            if (is.atomic(inner) && length(inner) == 1L) {
+              if (is.na(inner)) {
+                return(NA_integer_)
+              }
+              # truncates toward zero, as as.integer() does in R
+              return(as.integer(inner))
+            }
+            call("as.integer", inner)
+          },
           length = {
             var <- get0(as.character(r[[2L]]), scope)
             if (!inherits(var, Variable)) {
diff --git a/tests/testthat/test-matrix.R b/tests/testthat/test-matrix.R
index cc22033e..aacdd7b7 100644
--- a/tests/testthat/test-matrix.R
+++ b/tests/testthat/test-matrix.R
@@ -348,6 +348,88 @@ test_that("t() and diag() preserve integer mode", {
   expect_quick_equal(dident, list())
 })
 
+test_that("diag() takes R's identity form for any length-1 x", {
+  # R's rule is length(x) == 1 with no nrow/ncol, not rank 0: a declared
+  # integer(1) argument is the n x n identity, not a 1x1 matrix holding n
+  dsym <- function(n) {
+    declare(type(n = integer(1)))
+    diag(n)
+  }
+  expect_quick_equal(dsym, list(3L), list(1L))
+
+  # same through the inferred-destination path
+  ddest <- function(n) {
+    declare(type(n = integer(1)))
+    out <- diag(n)
+    out
+  }
+  expect_quick_equal(ddest, list(3L))
+
+  # a size expression works too
+  dexpr <- function(n) {
+    declare(type(n = integer(1)))
+    diag(n + 1L)
+  }
+  expect_quick_equal(dexpr, list(2L))
+
+  # a length-1 vector is still length 1
+  dvec1 <- function(v) {
+    declare(type(v = integer(1)))
+    diag(v)
+  }
+  expect_quick_equal(dvec1, list(3L))
+
+  # nrow/ncol switch off the identity form, as R's nargs() rule does
+  d1x1 <- function(v) {
+    declare(type(v = double(1)))
+    diag(v, 1L)
+  }
+  expect_quick_equal(d1x1, list(3))
+
+  # longer vectors keep building a diagonal matrix
+  dlong <- function(v) {
+    declare(type(v = double(3)))
+    diag(v)
+  }
+  expect_quick_equal(dlong, list(c(1, 2, 3)))
+
+  # R sizes the identity with as.integer(x), so a double or logical x works
+  # and truncates toward zero
+  ddbl <- function(x) {
+    declare(type(x = double(1)))
+    diag(x)
+  }
+  expect_quick_equal(ddbl, list(3), list(3.7), list(1))
+
+  ddbl_dest <- function(x) {
+    declare(type(x = double(1)))
+    out <- diag(x)
+    out
+  }
+  expect_quick_equal(ddbl_dest, list(3))
+
+  dlgl <- function(b) {
+    declare(type(b = logical(1)))
+    diag(b)
+  }
+  expect_quick_equal(dlgl, list(TRUE))
+
+  # a non-whole literal truncates too, rather than tripping the
+  # "size must be an integer" check
+  dfrac <- function() {
+    out <- diag(3.7)
+    out
+  }
+  expect_quick_equal(dfrac, list())
+
+  # an explicit coercion at the call site is the same program
+  dcoerce <- function(x) {
+    declare(type(x = double(1)))
+    diag(as.integer(x))
+  }
+  expect_quick_equal(dcoerce, list(3))
+})
+
 test_that("t() and diag() preserve logical mode", {
   m <- matrix(c(TRUE, FALSE, TRUE, TRUE), 2, 2)
 
diff --git a/tests/testthat/test-size-expr-abs.R b/tests/testthat/test-size-expr-abs.R
index 704baf1e..c7ad802a 100644
--- a/tests/testthat/test-size-expr-abs.R
+++ b/tests/testthat/test-size-expr-abs.R
@@ -35,3 +35,21 @@ test_that("declare() size expressions validate abs() arity", {
 
   expect_error(quick(bad), "unused argument", fixed = TRUE)
 })
+
+test_that("declare() size expressions support as.integer()", {
+  # as.integer() reaches size expressions through diag()'s identity form,
+  # but it is spellable on its own: INT() in Fortran, a cast in the bridge
+  fn <- function(x, n) {
+    declare(type(x = double(1)), type(n = integer(1)))
+    out <- double(as.integer(x) + n)
+    out
+  }
+  expect_quick_equal(fn, list(2, 3L), list(2.9, 1L))
+
+  bad <- function(x) {
+    declare(type(x = double(1)))
+    out <- double(as.integer(x, 2L))
+    out
+  }
+  expect_error(quick(bad), "expects one argument", fixed = TRUE)
+})

From 17aad62f9756a7bc4833ff55232e1d2cc3a50eb4 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sat, 11 Jul 2026 10:45:35 +0200
Subject: [PATCH 49/97] Format with air

Two single-statement loop bodies in test-loops.R are marked `# fmt: skip`
rather than reformatted. Those functions are the regression tests for the
single-statement-body hoist fix, and their point is that the body is *not*
a `{` block; letting air brace them would leave the tests passing against
the already-working braced path and silently stop covering the bug.
---
 tests/testthat/test-loops.R | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/tests/testthat/test-loops.R b/tests/testthat/test-loops.R
index 3104cc66..6a155ccb 100644
--- a/tests/testthat/test-loops.R
+++ b/tests/testthat/test-loops.R
@@ -112,6 +112,7 @@ test_that("single-statement while/repeat bodies re-run their hoisted statements"
   #
   # Run-tested only via the snapshots: a regression in either would
   # compute the product once before the loop and never terminate.
+  # fmt: skip
   squarings_while <- function(m) {
     declare(type(m = double(2, 2)))
     while (m[1, 1] < 100) m <- m %*% m
@@ -120,6 +121,7 @@ test_that("single-statement while/repeat bodies re-run their hoisted statements"
 
   expect_translation_snapshots(squarings_while)
 
+  # fmt: skip
   squarings_repeat <- function(m) {
     declare(type(m = double(2, 2)))
     repeat m <- m %*% m

From 3b7c323ab9a5f4d8c6e070067650881453b26582 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 13:40:09 +0200
Subject: [PATCH 50/97] Vignette: state the 1x1-matrix recycling rule by
 observable shape

The shapes-table row said a 1x1 matrix in arithmetic is "treated as a
scalar" -- implementation language that reads as a shape change quickr
never makes (scalar + 1x1 returns a 1x1 matrix, as in R). Say what the
user sees instead: with a statically known length other than 1 the
result is a plain vector, exactly R's (deprecated) answer; with a
symbolic length the result shape would depend on the runtime value, so
the compiled function guards on length 1, returns a 1x1 matrix, and
errors where R would recycle (the 02-2 fix). The no-partial-recycling
divergence section gets the matching sentence.
---
 vignettes/quickr-semantics.Rmd | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

diff --git a/vignettes/quickr-semantics.Rmd b/vignettes/quickr-semantics.Rmd
index 66281185..d5a79f6b 100644
--- a/vignettes/quickr-semantics.Rmd
+++ b/vignettes/quickr-semantics.Rmd
@@ -145,10 +145,19 @@ For elementwise operations (arithmetic, comparisons, `&`, `|`),
 | scalar with anything | allowed; the scalar is broadcast |
 | identical shapes | allowed |
 | vector with matrix, `length(vec) == nrow(mat)` | allowed; the vector is recycled column-wise, exactly as in R |
-| a `1x1` matrix in *arithmetic* | treated as a scalar (R allows this, with a deprecation warning) |
+| a `1x1` matrix in *arithmetic* with a vector of statically known length other than 1 | recycled; the result is a plain vector without dims, exactly as in R (which warns that this recycling is deprecated) |
 | a `1x1` matrix in comparisons and `&` / `|` | treated as a one-row matrix; mismatched shapes are rejected, and R errors here too |
 | anything else — unequal lengths, even when one divides the other | **error**: R-style recycling is not supported |
 
+A `1x1` matrix meeting a vector whose length is only known at run time
+is the one place where R's *result shape* depends on a runtime value: R
+keeps the `1x1` dims when the vector has length 1 and drops them for
+any other length. A compiled function's result shape cannot depend on a
+value, so quickr treats the `1x1` as a one-row matrix there instead:
+the compiled function checks that the vector has length 1 and returns a
+`1x1` matrix — matching R exactly — and errors on a longer vector,
+where R would perform the deprecated recycling.
+
 The last row is the important one. In R, `1:6 + c(10, 20)` recycles the
 shorter vector. quickr never does this:
 
@@ -234,7 +243,10 @@ As described above: operand lengths must match exactly or one operand
 must be a scalar (or a vector spanning a matrix's rows). R's general
 recycling rule — including the case where one length divides the other,
 which R accepts without a warning — is a compile-time error or a runtime
-error instead.
+error instead. This also covers a `1x1` matrix in arithmetic with a
+vector whose length is only known at run time: the compiled function
+requires length 1 (returning a `1x1` matrix, as R does) and errors on a
+longer vector, where R would recycle with a deprecation warning.
 
 ### Zero-length operands do not recycle to zero-length results
 

From ae4f3b89bb4ac3e2b0d6748cfe63212ddca283b6 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Mon, 6 Jul 2026 16:46:44 +0200
Subject: [PATCH 51/97] Add NEWS entry for the complex linear-algebra refusal

---
 NEWS.md | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 33f9ccae..7d04bfc3 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -48,6 +48,13 @@
   known at compile time it is checked at run time. Use `qr.solve()` for
   least-squares solutions of rectangular systems (unchanged).
 
+- Complex operands in linear algebra (`%*%`, `crossprod()`, `solve()`,
+  `chol()`, ...) are now a compile-time error. quickr's lowerings use the
+  real (double-only) BLAS/LAPACK routines, which previously read complex
+  storage as reals and returned a plausible but wrong real result where R
+  returns a complex one. Elementwise complex arithmetic and the
+  mode-preserving `t()`/`diag()` are unaffected.
+
 # quickr 0.3.0
 
 This release adds major new support for linear algebra, local functions,

From a13213a01759962f6951062958cb6bdbf6f29375 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Tue, 7 Jul 2026 13:39:11 +0200
Subject: [PATCH 52/97] Materialize fill constructors before matrix():
 reshape() needs an array SOURCE

matrix() was on the fill-constructor pass-through whitelist, so
matrix(numeric(6), 3, 2) reached the reshape() lowering as the scalar
literal 0.0_c_double claiming array dims. That only compiled because
hoist_unless_name() used to materialize every non-name; when it learned
to skip literals (earlier on this branch), the emitted
reshape(0.0_c_double, ...) became a gfortran error -- and
matrix(logical(k), ...) kept working only because the literal regex
does not match .false.. Drop matrix from the whitelist so fills
materialize into a hoisted array temporary like any other array
consumer, restoring the pre-cleanup code shape deliberately instead of
by regex accident.

Found by codex review (fable-final round); regression relative to main.
---
 R/r2f-constructors.R            | 13 +++++++------
 tests/testthat/test-recycling.R | 30 ++++++++++++++++++++++++++++++
 2 files changed, 37 insertions(+), 6 deletions(-)

diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index ba362548..817b1bd5 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -163,11 +163,12 @@ r2f_handlers[["rep.int"]] <- function(args, scope, ..., hoist = NULL) {
 
 # Compile a zero-fill constructor call: a single scalar literal carrying
 # array dims. Whole-array assignment broadcasts that correctly, and
-# c()/array()/matrix() spread or pad it explicitly, so those contexts keep
-# the scalar form. Any other consumer (elementwise ops, reductions, ...)
-# needs a real array expression -- an expression like `numeric(2) + 1`
-# would otherwise contribute one element where its dims claim two -- so
-# materialize the fill into a hoisted temporary there.
+# c()/array() spread it as an implied-do, so those contexts keep the
+# scalar form. Any other consumer (elementwise ops, reductions,
+# matrix() -- whose reshape() lowering needs an array SOURCE, not a
+# scalar literal) needs a real array expression -- an expression like
+# `numeric(2) + 1` would otherwise contribute one element where its dims
+# claim two -- so materialize the fill into a hoisted temporary there.
 fill_constructor_value <- function(literal, mode, args, scope, ..., hoist) {
   var <- Variable(mode = mode, dims = r2dims(args, scope))
   out <- Fortran(literal, var)
@@ -175,7 +176,7 @@ fill_constructor_value <- function(literal, mode, args, scope, ..., hoist) {
     return(out)
   }
   parent_call <- parent_call_name(list(...)$calls)
-  if (parent_call %in% c("<-", "=", "<<-", "c", "array", "matrix")) {
+  if (parent_call %in% c("<-", "=", "<<-", "c", "array")) {
     return(out)
   }
   materialize_via_hoist(literal, mode, var@dims, hoist)
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index 21de0a38..85b46e7b 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -266,6 +266,36 @@ test_that("fill constructors materialize where an array is required", {
   expect_quick_identical(symbolic, list(c(5, 6), 3L))
 })
 
+test_that("fill constructors materialize inside matrix()", {
+  # matrix() lowers non-scalar data through reshape(), whose SOURCE must
+  # be an array. Fills used to pass through as scalar literals with
+  # claimed dims and relied on hoist_unless_name() to materialize them;
+  # once that helper learned to skip literals, the generated
+  # reshape(0.0_c_double, ...) failed to compile (and logical(k) only
+  # kept working because the literal regex missed `.false.`). Fills now
+  # materialize before matrix() like any other array consumer.
+  numeric_fill <- function() {
+    matrix(numeric(6), 3, 2)
+  }
+  expect_quick_identical(numeric_fill, list())
+
+  integer_fill <- function() {
+    matrix(integer(6), 3, 2)
+  }
+  expect_quick_identical(integer_fill, list())
+
+  logical_fill <- function() {
+    matrix(logical(6), 3, 2)
+  }
+  expect_quick_identical(logical_fill, list())
+
+  assigned <- function() {
+    x <- matrix(numeric(6), 3, 2)
+    x
+  }
+  expect_quick_identical(assigned, list())
+})
+
 test_that("matrix(scalar, m, n) materializes where an array is required", {
   reduced <- function() {
     sum(matrix(2, 2, 3))

From 6a2c62bffcc4a8b6ddde65e2d05e3016e52c29f7 Mon Sep 17 00:00:00 2001
From: mns-nordicals <mns@nordicals.dk>
Date: Sun, 2 Aug 2026 15:34:09 +0200
Subject: [PATCH 53/97] Read fun_name through handler_field like every other
 handler property

`resolve_handler_fun()` was the last direct property read left after the
handler_field() unification. Only R2FHandler objects carry a `fun_name`, so
reading it through the helper subsumes the class check: bare-function handlers
read NULL and return unchanged.
---
 R/r2f-aab-core.R | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/R/r2f-aab-core.R b/R/r2f-aab-core.R
index a897cd3e..a6583080 100644
--- a/R/r2f-aab-core.R
+++ b/R/r2f-aab-core.R
@@ -416,10 +416,9 @@ get_r2f_handler <- function(name) {
 # carry a `fun_name`; for every other handler this is a property read and a
 # return. See register_r2f_handler() for why the name is recorded.
 resolve_handler_fun <- function(handler) {
-  if (!inherits(handler, R2FHandler)) {
-    return(handler)
-  }
-  name <- handler@fun_name
+  # Only R2FHandler objects can carry a `fun_name`, so this doubles as the
+  # check that `handler` is one -- bare-function handlers read NULL here.
+  name <- handler_field(handler, "fun_name")
   if (!is_string(name)) {
     return(handler)
   }

From 6a36efc4fa793a59284ea39628cc8bf62042f77c Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:18:24 -0400
Subject: [PATCH 54/97] Test direct matrix fill constructors

---
 tests/testthat/test-recycling.R | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index 5404967e..b8a7b719 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -278,6 +278,13 @@ test_that("matrix(scalar, m, n) materializes where an array is required", {
   expect_quick_identical(transposed, list())
 })
 
+test_that("matrix() materializes direct non-scalar fill constructors", {
+  fn <- function() {
+    matrix(numeric(2), 2, 2)
+  }
+  expect_quick_identical(fn, list())
+})
+
 test_that("a closure's return expression materializes fills and matrix()", {
   # A local closure's return expression is compiled on its own, with no
   # enclosing call: the materialization decision sees an empty call stack,

From c4c13ea068f8537868f247a13204b76ee8b09720 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:18:37 -0400
Subject: [PATCH 55/97] Use wide kinds for size guards

---
 R/r2f-operators-helpers.R          | 6 +++++-
 tests/testthat/_snaps/recycling.md | 2 +-
 tests/testthat/test-recycling.R    | 3 +++
 3 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 8cfd1cb4..485ac8fe 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -201,7 +201,11 @@ emit_elementwise_size_guard <- function(
   right_axis = left_axis
 ) {
   size_of <- function(x, axis) {
-    if (is.null(axis)) glue("size({x})") else glue("size({x}, {axis})")
+    if (is.null(axis)) {
+      glue("size({x}, kind=c_ptrdiff_t)")
+    } else {
+      glue("size({x}, {axis}, kind=c_ptrdiff_t)")
+    }
   }
   emit_quickr_error_if(
     glue("{size_of(left, left_axis)} /= {size_of(right, right_axis)}"),
diff --git a/tests/testthat/_snaps/recycling.md b/tests/testthat/_snaps/recycling.md
index 48363f9b..c12c66f4 100644
--- a/tests/testthat/_snaps/recycling.md
+++ b/tests/testthat/_snaps/recycling.md
@@ -34,7 +34,7 @@
         ! manifest end
       
       
-        if (size(a) /= size(b)) then
+        if (size(a, kind=c_ptrdiff_t) /= size(b, kind=c_ptrdiff_t)) then
       call quickr_set_error_msg("elementwise vector operations require equal lengths or a scalar operand; R-style recycling is not&
       & supported")
           return
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index b8a7b719..f576447a 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -80,6 +80,9 @@ test_that("symbolic differing lengths get a runtime guard", {
     declare(type(a = double(n)), type(b = double(m)))
     a + b
   }
+  fsub <- as.character(r2f(fn))
+  expect_match(fsub, "size(a, kind=c_ptrdiff_t)", fixed = TRUE)
+  expect_match(fsub, "size(b, kind=c_ptrdiff_t)", fixed = TRUE)
   qfn <- quick(fn)
   expect_identical(qfn(c(1, 2), c(10, 20)), c(11, 22))
   # was: silent truncation to c(11, 22)

From caaa55acfffb3d664b250ab5945ce67c20349c44 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:21:25 -0400
Subject: [PATCH 56/97] Update wide size guard snapshot

---
 tests/testthat/_snaps/example-roll_mean.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/_snaps/example-roll_mean.md b/tests/testthat/_snaps/example-roll_mean.md
index 24e951e6..f48c6437 100644
--- a/tests/testthat/_snaps/example-roll_mean.md
+++ b/tests/testthat/_snaps/example-roll_mean.md
@@ -54,7 +54,7 @@
           weights = ((weights / sum(weights)) * size(weights))
         end if
         do i = 1, size(out)
-          if (size(x(i:(((i + n) - 1_c_int)):sign(1, (((i + n) - 1_c_int))-i))) /= size(weights)) then
+          if (size(x(i:(((i + n) - 1_c_int)):sign(1, (((i + n) - 1_c_int))-i)), kind=c_ptrdiff_t) /= size(weights, kind=c_ptrdiff_t)) then
       call quickr_set_error_msg("elementwise vector operations require equal lengths or a scalar operand; R-style recycling is not&
       & supported")
             return

From 72c1a849f03286f37d5544795c081a07f77032e5 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:27:21 -0400
Subject: [PATCH 57/97] Respect local closures in fill detection

---
 R/r2f-constructors.R            | 16 ++++++++++------
 tests/testthat/test-recycling.R | 34 +++++++++++++++++++++++++++++++++
 2 files changed, 44 insertions(+), 6 deletions(-)

diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index ba362548..bae17f60 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -8,10 +8,14 @@
 # double(k), numeric(k). These lower to a single scalar literal carrying
 # array dims, so splicing contexts must spread them explicitly.
 # Used by: c(), array()
-is_fill_constructor_call <- function(e) {
-  is.call(e) &&
-    is.symbol(e[[1L]]) &&
-    as.character(e[[1L]]) %in% c("logical", "integer", "double", "numeric")
+is_fill_constructor_call <- function(e, scope) {
+  if (!is.call(e) || !is.symbol(e[[1L]])) {
+    return(FALSE)
+  }
+  name <- as.character(e[[1L]])
+  name %in%
+    c("logical", "integer", "double", "numeric") &&
+    (is.null(scope) || !inherits(scope[[name]], LocalClosure))
 }
 
 # Name of the call one frame above the current handler ("" at top level).
@@ -44,7 +48,7 @@ r2f_handlers[["c"]] <- function(args, scope = NULL, ...) {
   mode <- promoted$mode
   # Fill constructors are one scalar literal claiming length k; spread them
   # as implied-dos so the emitted element count matches the claimed length.
-  fill_idx <- which(map_lgl(args, is_fill_constructor_call))
+  fill_idx <- which(map_lgl(args, is_fill_constructor_call, scope = scope))
   if (length(fill_idx)) {
     spread_var <- NULL
     for (j in fill_idx) {
@@ -383,7 +387,7 @@ r2f_handlers[["array"]] <- function(args, scope = NULL, ..., hoist = NULL) {
       }
       shape <- glue("int([{dims_f}])")
 
-      is_fill_constructor <- is_fill_constructor_call(args$data)
+      is_fill_constructor <- is_fill_constructor_call(args$data, scope)
 
       axis_terms <- vapply(
         target_dims,
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index 5404967e..235434b2 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -242,6 +242,40 @@ test_that("fill constructors spread inside c()", {
   expect_quick_identical(logical_fill, list(c(TRUE, FALSE)))
 })
 
+test_that("local closures can shadow fill constructors in c() and array()", {
+  numeric_shadow <- function() {
+    numeric <- function() c(1, 2)
+    combined <- c(numeric(), 3)
+    reshaped <- array(numeric(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(numeric_shadow, list())
+
+  integer_shadow <- function() {
+    integer <- function() c(1L, 2L)
+    combined <- c(integer(), 3L)
+    reshaped <- array(integer(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(integer_shadow, list())
+
+  double_shadow <- function() {
+    double <- function() c(1, 2)
+    combined <- c(double(), 3)
+    reshaped <- array(double(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(double_shadow, list())
+
+  logical_shadow <- function() {
+    logical <- function() c(1L, 2L)
+    combined <- c(logical(), 3L)
+    reshaped <- array(logical(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(logical_shadow, list())
+})
+
 test_that("fill constructors materialize where an array is required", {
   # A fill reaching c() through an expression is a real array, not a
   # scalar literal with claimed dims (which emitted one element where the

From ff65a37644bb2bc8e7c4b4be002f4b22ad7799d9 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:28:19 -0400
Subject: [PATCH 58/97] Clarify assumed-shape scalar handling

---
 R/r2f-operators-helpers.R          |   4 +-
 tests/testthat/_snaps/recycling.md | 113 -----------------------------
 tests/testthat/test-recycling.R    |  14 +---
 3 files changed, 6 insertions(+), 125 deletions(-)
 delete mode 100644 tests/testthat/_snaps/recycling.md

diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 485ac8fe..a26f01d7 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -243,7 +243,9 @@ scalarize_matrix <- function(mat) {
 # enforce the elementwise conformability policy: known-mismatched lengths
 # are compile errors (R-style recycling is not supported; scalar broadcast
 # is native), lengths that cannot be compared statically get a runtime
-# size guard through `hoist`.
+# size guard through `hoist`. Scalar broadcast requires a value represented
+# as scalar at translation time, such as `double(1)`. An assumed-shape
+# `double(NA)` remains a vector when its runtime length is one.
 #
 # `scalarize_one_by_one` mirrors R's split over length-1 arrays: arithmetic
 # recycles a 1x1 matrix against a vector of statically known length != 1
diff --git a/tests/testthat/_snaps/recycling.md b/tests/testthat/_snaps/recycling.md
deleted file mode 100644
index c12c66f4..00000000
--- a/tests/testthat/_snaps/recycling.md
+++ /dev/null
@@ -1,113 +0,0 @@
-# guard text is pinned (one snapshot per mechanism)
-
-    Code
-      cat("# Snapshot note: ", note, "\n", sep = "")
-    Output
-      # Snapshot note: Symbolic differing lengths emit one statement-level size guard.
-    Code
-      fn
-    Output
-      function(a, b) {
-          declare(type(a = double(n)), type(b = double(m)))
-          a + b
-        }
-      <environment: 0x0>
-    Code
-      cat(fsub)
-    Output
-      subroutine fn(a, b, out_, a__len_, b__len_, quickr_err_msg) bind(c)
-        use iso_c_binding, only: c_char, c_double, c_null_char, c_ptrdiff_t
-        implicit none
-      
-        ! manifest start
-        ! sizes
-        integer(c_ptrdiff_t), intent(in), value :: a__len_
-        integer(c_ptrdiff_t), intent(in), value :: b__len_
-      
-        ! error
-        character(kind=c_char), intent(inout) :: quickr_err_msg(256)
-      
-        ! args
-        real(c_double), intent(in) :: a(a__len_)
-        real(c_double), intent(in) :: b(b__len_)
-        real(c_double), intent(out) :: out_(a__len_)
-        ! manifest end
-      
-      
-        if (size(a, kind=c_ptrdiff_t) /= size(b, kind=c_ptrdiff_t)) then
-      call quickr_set_error_msg("elementwise vector operations require equal lengths or a scalar operand; R-style recycling is not&
-      & supported")
-          return
-        end if
-        out_ = (a + b)
-      
-        contains
-          subroutine quickr_set_error_msg(msg)
-            character(len=*), intent(in) :: msg
-            integer :: i
-            integer :: n
-            if (quickr_err_msg(1) == c_null_char) then
-              n = min(len(msg), 256 - 1)
-              quickr_err_msg(1:n) = [(msg(i:i), i = 1, n)]
-              quickr_err_msg(n + 1) = c_null_char
-            end if
-          end subroutine quickr_set_error_msg
-      end subroutine
-    Code
-      cat(cwrapper)
-    Output
-      #define R_NO_REMAP
-      #include <R.h>
-      #include <Rinternals.h>
-      
-      
-      extern void fn(
-        const double* const a__, 
-        const double* const b__, 
-        double* const out___, 
-        const R_xlen_t a__len_, 
-        const R_xlen_t b__len_, 
-        char* quickr_err_msg);
-      
-      SEXP fn_(SEXP _args) {
-        // a
-        _args = CDR(_args);
-        SEXP a = CAR(_args);
-        if (TYPEOF(a) != REALSXP) {
-          Rf_error("typeof(a) must be 'double', not '%s'", Rf_type2char(TYPEOF(a)));
-        }
-        const double* const a__ = REAL(a);
-        const R_xlen_t a__len_ = Rf_xlength(a);
-        
-        // b
-        _args = CDR(_args);
-        SEXP b = CAR(_args);
-        if (TYPEOF(b) != REALSXP) {
-          Rf_error("typeof(b) must be 'double', not '%s'", Rf_type2char(TYPEOF(b)));
-        }
-        const double* const b__ = REAL(b);
-        const R_xlen_t b__len_ = Rf_xlength(b);
-        
-        const R_xlen_t out___len_ = a__len_;
-        SEXP out_ = PROTECT(Rf_allocVector(REALSXP, out___len_));
-        double* out___ = REAL(out_);
-        
-        char quickr_err_msg[256];
-        quickr_err_msg[0] = '\0';
-        
-        
-        fn(
-          a__,
-          b__,
-          out___,
-          a__len_,
-          b__len_,
-          quickr_err_msg);
-        if (quickr_err_msg[0] != '\0') {
-          Rf_error("%s", quickr_err_msg);
-        }
-        
-        UNPROTECT(1);
-        return out_;
-      }
-
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index f576447a..85317a77 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -87,6 +87,9 @@ test_that("symbolic differing lengths get a runtime guard", {
   expect_identical(qfn(c(1, 2), c(10, 20)), c(11, 22))
   # was: silent truncation to c(11, 22)
   expect_error(qfn(c(1, 2), c(10, 20, 30, 40)), "equal lengths")
+  # Runtime length one does not change an assumed-shape vector into a scalar.
+  expect_error(qfn(c(1, 2, 3), 10), "equal lengths")
+  expect_error(qfn(10, c(1, 2, 3)), "equal lengths")
 })
 
 test_that("identical symbolic lengths stay guard-free and work", {
@@ -207,17 +210,6 @@ test_that("1x1 matrix with a symbolic-length vector keeps R's shape", {
   expect_error(qrev(c(1, 2, 3), matrix(2)), "matrix first dimension")
 })
 
-test_that("guard text is pinned (one snapshot per mechanism)", {
-  fn <- function(a, b) {
-    declare(type(a = double(n)), type(b = double(m)))
-    a + b
-  }
-  expect_translation_snapshots(
-    fn,
-    note = "Symbolic differing lengths emit one statement-level size guard."
-  )
-})
-
 test_that("fill constructors spread inside c()", {
   known <- function(x) {
     declare(type(x = double(3)))

From 9f85f7346a08d6da4d25adb716bd3eda6f715e28 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:34:07 -0400
Subject: [PATCH 59/97] test: execute short-circuit regressions

---
 tests/testthat/test-logical.R | 28 ++++++++++++++++++++++++++++
 tests/testthat/test-loops.R   |  5 +++--
 2 files changed, 31 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-logical.R b/tests/testthat/test-logical.R
index 484a7312..f9527dd9 100644
--- a/tests/testthat/test-logical.R
+++ b/tests/testthat/test-logical.R
@@ -131,6 +131,22 @@ test_that("&& and || require length-1 operands, like R", {
   expect_error(quick(numeric_and), "logical operands")
 })
 
+test_that("&& and || accept one-element matrices", {
+  matrix_and <- function(x, y) {
+    declare(type(x = logical(1, 1)), type(y = logical(1, 1)))
+    x && y
+  }
+  matrix_or <- function(x, y) {
+    declare(type(x = logical(1, 1)), type(y = logical(1, 1)))
+    x || y
+  }
+
+  true <- matrix(TRUE, 1, 1)
+  false <- matrix(FALSE, 1, 1)
+  expect_quick_identical(matrix_and, list(true, true), list(true, false))
+  expect_quick_identical(matrix_or, list(false, false), list(false, true))
+})
+
 test_that("&& and || short-circuit like R's scalar operators", {
   # The right operand indexes past the end of x whenever the left side
   # already decides; R never evaluates it.
@@ -154,6 +170,18 @@ test_that("&& and || short-circuit like R's scalar operators", {
   }
   expect_quick_identical(or_guarded, list(TRUE, c(1, 2), 9L))
   expect_quick_identical(or_guarded, list(FALSE, c(-1, 2), 2L))
+
+  shadowed_abs <- function() {
+    calls <- 0L
+    abs <- function() {
+      calls <<- calls + 1L
+      TRUE
+    }
+    and_result <- FALSE && abs()
+    or_result <- TRUE || abs()
+    list(and_result = and_result, or_result = or_result, calls = calls)
+  }
+  expect_quick_identical(shadowed_abs, list())
 })
 
 test_that("while re-evaluates hoisted condition code every iteration", {
diff --git a/tests/testthat/test-loops.R b/tests/testthat/test-loops.R
index 6a155ccb..7b12497b 100644
--- a/tests/testthat/test-loops.R
+++ b/tests/testthat/test-loops.R
@@ -110,8 +110,8 @@ test_that("single-statement while/repeat bodies re-run their hoisted statements"
   # loop would freeze the body's work at its first evaluation. `for` is
   # covered in test-for-iterables.R.
   #
-  # Run-tested only via the snapshots: a regression in either would
-  # compute the product once before the loop and never terminate.
+  # The repeat variant cannot terminate; execute the finite while variant
+  # to cover the generated loop as well as its translation.
   # fmt: skip
   squarings_while <- function(m) {
     declare(type(m = double(2, 2)))
@@ -120,6 +120,7 @@ test_that("single-statement while/repeat bodies re-run their hoisted statements"
   }
 
   expect_translation_snapshots(squarings_while)
+  expect_quick_identical(squarings_while, list(diag(2) * 2))
 
   # fmt: skip
   squarings_repeat <- function(m) {

From 48434538c183f881a223b9ebbd889982d1e551c7 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:36:42 -0400
Subject: [PATCH 60/97] Qualify undefined cases in semantics contract

---
 vignettes/quickr-semantics.Rmd | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/vignettes/quickr-semantics.Rmd b/vignettes/quickr-semantics.Rmd
index d5a79f6b..241829c0 100644
--- a/vignettes/quickr-semantics.Rmd
+++ b/vignettes/quickr-semantics.Rmd
@@ -25,6 +25,8 @@ value — never a different value.
 
 > `quick(f)(x)` either returns exactly what `f(x)` returns — same values,
 > same `typeof()`, same shape — or raises an error. Never a third thing.
+> The unchecked `NA` inputs and out-of-bounds runtime subscripts documented
+> below are outside this contract and have undefined behavior.
 
 When quickr cannot reproduce R's behavior, it refuses. It prefers to
 refuse at compile time, when `quick()` is called; when the decision

From 4de538c80ff366b9a20dc2c4b61d2db2aeb65b87 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:36:56 -0400
Subject: [PATCH 61/97] fix: preserve scalar short-circuit semantics

---
 R/r2f-logical.R | 54 ++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 44 insertions(+), 10 deletions(-)

diff --git a/R/r2f-logical.R b/R/r2f-logical.R
index bf79129e..b4b1385a 100644
--- a/R/r2f-logical.R
+++ b/R/r2f-logical.R
@@ -176,11 +176,17 @@ register_r2f_handler(
 # && and || are R's *scalar* control operators: operands must be length 1
 # (R errors otherwise), and the right operand is evaluated only when the
 # left side does not already decide the answer.
+andor_operand_is_length_one <- function(x) {
+  passes_as_scalar(x@value) ||
+    x@value@rank > 0L &&
+      all(vapply(x@value@dims, dim_is_one, logical(1L)))
+}
+
 check_andor_operand <- function(x, op) {
   if (is.null(x@value) || !identical(x@value@mode, "logical")) {
     stop("`", op, "` requires logical operands", call. = FALSE)
   }
-  if (!passes_as_scalar(x@value)) {
+  if (!andor_operand_is_length_one(x)) {
     stop(
       "`",
       op,
@@ -193,12 +199,35 @@ check_andor_operand <- function(x, op) {
   invisible(TRUE)
 }
 
+scalarize_andor_operand <- function(x, op, hoist) {
+  check_andor_operand(x, op)
+  if (passes_as_scalar(x@value)) {
+    return(booleanize_logical_as_int(x))
+  }
+  if (is.null(hoist)) {
+    stop("internal error: `", op, "` requires hoist context", call. = FALSE)
+  }
+
+  if (isTRUE(x@logical_booleanized)) {
+    tmp <- hoist$declare_tmp(mode = "logical", dims = x@value@dims)
+    hoist$emit(glue("{tmp@name} = {x}"))
+    x <- Fortran(tmp@name, tmp)
+  } else {
+    x <- hoist_unless_name(x, hoist)
+  }
+  idxs <- rep("1", x@value@rank)
+  Fortran(
+    glue("{x}({str_flatten_commas(idxs)})"),
+    Variable("logical")
+  )
+}
+
 # TRUE when evaluating `e` eagerly is indistinguishable from R's lazy
 # right-operand evaluation: no side effects, no errors, no traps. A
 # conservative whitelist -- names, literals, and compositions of pure
 # non-trapping operations. Anything else (subscripts, %%/%/%, function
 # calls, ...) gets the conditional lowering.
-is_pure_scalar_condition <- function(e) {
+is_pure_scalar_condition <- function(e, scope) {
   if (is.symbol(e) || (is.atomic(e) && length(e) == 1L)) {
     return(TRUE)
   }
@@ -228,7 +257,15 @@ is_pure_scalar_condition <- function(e) {
   if (!op %in% pure_ops) {
     return(FALSE)
   }
-  all(vapply(as.list(e)[-1L], is_pure_scalar_condition, logical(1L)))
+  if (inherits(scope[[op]], LocalClosure)) {
+    return(FALSE)
+  }
+  all(vapply(
+    as.list(e)[-1L],
+    is_pure_scalar_condition,
+    logical(1L),
+    scope = scope
+  ))
 }
 
 compile_andor <- function(args, scope, ..., hoist = NULL) {
@@ -237,18 +274,16 @@ compile_andor <- function(args, scope, ..., hoist = NULL) {
 
   # R always evaluates the left operand: its hoists stay unconditional.
   left <- r2f(args[[1L]], scope, ..., hoist = hoist)
-  check_andor_operand(left, op)
-  left <- booleanize_logical_as_int(left)
+  left <- scalarize_andor_operand(left, op, hoist)
 
   f <- if (op == "&&") ".and." else ".or."
 
-  if (is_pure_scalar_condition(args[[2L]])) {
+  if (is_pure_scalar_condition(args[[2L]], scope)) {
     # Fortran may evaluate both operands of .and./.or.; for a pure right
     # operand that is indistinguishable from short-circuiting, so keep
     # the compact infix form.
     right <- r2f(args[[2L]], scope, ..., hoist = hoist)
-    check_andor_operand(right, op)
-    right <- booleanize_logical_as_int(right)
+    right <- scalarize_andor_operand(right, op, hoist)
     return(Fortran(glue("{left} {f} {right}"), Variable("logical")))
   }
 
@@ -260,8 +295,7 @@ compile_andor <- function(args, scope, ..., hoist = NULL) {
   }
   sub <- new_hoist(scope)
   right <- r2f(args[[2L]], scope, ..., hoist = sub)
-  check_andor_operand(right, op)
-  right <- booleanize_logical_as_int(right)
+  right <- scalarize_andor_operand(right, op, sub)
 
   tmp <- hoist$declare_tmp(mode = "logical", dims = NULL)
   hoist$emit(glue("{tmp@name} = {left}"))

From d33e63e52394d4dde3580f7622b8b5c9633d8afe Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:42:03 -0400
Subject: [PATCH 62/97] Support zero-length BLAS contractions

---
 R/r2f-matrix-blas.R               | 73 ++++++++++++++++++++++++++-----
 tests/testthat/test-blas-guards.R | 34 ++++++++++++++
 2 files changed, 96 insertions(+), 11 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index baab43cc..d65ef878 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -78,8 +78,27 @@ guard_dim_f <- function(dim, operand, axis = NULL) {
 # The one conformability policy for BLAS/LAPACK lowerings: a statically
 # known mismatch is a compile error; dims that cannot be compared
 # statically get a statement-level runtime guard emitted before the BLAS
-# call; provably equal dims need nothing. Never warn-and-proceed. `axis`
-# NULL compares the operand's whole size (rank-1 operands).
+# call; provably equal dims, including equal zero dims, need nothing. Never
+# warn-and-proceed. `axis` NULL compares the operand's whole size (rank-1
+# operands). Unlike elementwise operations, a zero contracted dimension can
+# still produce a non-empty BLAS result.
+check_blas_dims <- function(left, right) {
+  if (is_wholenumber(left) && is_wholenumber(right)) {
+    return(list(
+      ok = identical(as.integer(left), as.integer(right)),
+      unknown = FALSE
+    ))
+  }
+  if (!is_scalar_na(left) && !is_scalar_na(right)) {
+    left_norm <- fortranize_expr_symbols(left)
+    right_norm <- fortranize_expr_symbols(right)
+    if (identical(left_norm, right_norm)) {
+      return(list(ok = TRUE, unknown = FALSE))
+    }
+  }
+  list(ok = TRUE, unknown = TRUE)
+}
+
 guard_conformable_dims <- function(
   left_dim,
   right_dim,
@@ -92,7 +111,7 @@ guard_conformable_dims <- function(
   right_axis = NULL
 ) {
   stopifnot(is_string(message))
-  conform <- check_elementwise_lengths(left_dim, right_dim)
+  conform <- check_blas_dims(left_dim, right_dim)
   if (!conform$ok) {
     stop(message, call. = FALSE)
   }
@@ -320,6 +339,32 @@ blas_int <- function(x) {
   glue("int({x_str}, kind=c_int)")
 }
 
+# Emit a BLAS call for positive contractions and fill the result with zero
+# without calling BLAS when the contracted dimension is zero.
+emit_blas_contraction <- function(call, output, contracted_dim, hoist) {
+  stopifnot(is_string(call), is_string(output))
+  assert_hoist_env(hoist)
+
+  if (is_wholenumber(contracted_dim)) {
+    if (as.integer(contracted_dim) == 0L) {
+      hoist$emit(glue("{output} = 0.0_c_double"))
+    } else {
+      hoist$emit(call)
+    }
+    return(invisible(TRUE))
+  }
+
+  hoist$emit(glue(
+    "
+if ({blas_int(contracted_dim)} == 0_c_int) then
+  {output} = 0.0_c_double
+else
+  {call}
+end if"
+  ))
+  invisible(TRUE)
+}
+
 # Centralized GEMM emission with optional destination
 # gemm: centralized BLAS GEMM emission.
 # - 'hoist' is required and provided by r2f(); handlers thread it through so
@@ -352,18 +397,20 @@ gemm <- function(
       context = context
     )
   ) {
-    hoist$emit(glue(
+    blas_call <- glue(
       "call dgemm('{opA}','{opB}', {blas_int(m)}, {blas_int(n)}, {blas_int(k)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {B_name}, {blas_int(ldb)}, 0.0_c_double, {dest@name}, {blas_int(ldc_expr)})"
-    ))
+    )
+    emit_blas_contraction(blas_call, dest@name, k, hoist)
     out <- Fortran(dest@name, dest)
     out@writes_to_dest <- TRUE
     return(out)
   }
 
   output_var <- hoist$declare_tmp(mode = "double", dims = list(m, n))
-  hoist$emit(glue(
+  blas_call <- glue(
     "call dgemm('{opA}','{opB}', {blas_int(m)}, {blas_int(n)}, {blas_int(k)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {B_name}, {blas_int(ldb)}, 0.0_c_double, {output_var@name}, {blas_int(ldc_expr)})"
-  ))
+  )
+  emit_blas_contraction(blas_call, output_var@name, k, hoist)
   Fortran(output_var@name, output_var)
 }
 
@@ -397,18 +444,22 @@ gemv <- function(
     )
   ) {
     # Assign output to output destination
-    hoist$emit(glue(
+    blas_call <- glue(
       "call dgemv('{transA}', {blas_int(m)}, {blas_int(n)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {x_name}, 1_c_int, 0.0_c_double, {dest@name}, 1_c_int)"
-    ))
+    )
+    contracted_dim <- if (transA == "N") n else m
+    emit_blas_contraction(blas_call, dest@name, contracted_dim, hoist)
     out <- Fortran(dest@name, dest)
     out@writes_to_dest <- TRUE
     return(out)
   }
   # Else assign to a temporary variable
   output_var <- hoist$declare_tmp(mode = "double", dims = out_dims)
-  hoist$emit(glue(
+  blas_call <- glue(
     "call dgemv('{transA}', {blas_int(m)}, {blas_int(n)}, 1.0_c_double, {A_name}, {blas_int(lda)}, {x_name}, 1_c_int, 0.0_c_double, {output_var@name}, 1_c_int)"
-  ))
+  )
+  contracted_dim <- if (transA == "N") n else m
+  emit_blas_contraction(blas_call, output_var@name, contracted_dim, hoist)
   Fortran(output_var@name, output_var)
 }
 
diff --git a/tests/testthat/test-blas-guards.R b/tests/testthat/test-blas-guards.R
index 3009c852..1fcf5bcc 100644
--- a/tests/testthat/test-blas-guards.R
+++ b/tests/testthat/test-blas-guards.R
@@ -103,6 +103,40 @@ test_that("solve(a) and chol() guard squareness", {
   )
 })
 
+test_that("matrix-matrix %*% returns zeros for a known empty contraction", {
+  fn <- function(a, b) {
+    declare(type(a = double(2, 0)), type(b = double(0, 3)))
+    a %*% b
+  }
+  expect_quick_identical(
+    fn,
+    list(matrix(double(), 2, 0), matrix(double(), 0, 3))
+  )
+})
+
+test_that("matrix-vector %*% returns zeros for a known empty contraction", {
+  fn <- function(a, x) {
+    declare(type(a = double(2, 0)), type(x = double(0)))
+    a %*% x
+  }
+  expect_quick_identical(fn, list(matrix(double(), 2, 0), double()))
+})
+
+test_that("%*% returns zeros for a symbolic empty contracted dimension", {
+  fn <- function(a, b, k) {
+    declare(
+      type(a = double(2, k)),
+      type(b = double(k, 3)),
+      type(k = integer(1))
+    )
+    a %*% b
+  }
+  expect_quick_identical(
+    fn,
+    list(matrix(double(), 2, 0), matrix(double(), 0, 3), 0L)
+  )
+})
+
 test_that("NA dims are never treated as equal", {
   fn <- function(a, b) {
     declare(type(a = double(NA, NA)), type(b = double(NA, NA)))

From fa1021947c025093fa146d32485feceb5fc24f3c Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:42:12 -0400
Subject: [PATCH 63/97] Guard deferred-shape reassignments

---
 R/r2f-operators-helpers.R              | 25 +++++++++++++++++--------
 tests/testthat/test-assignment-shape.R | 23 +++++++++++++++++++++++
 2 files changed, 40 insertions(+), 8 deletions(-)

diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 6e08a10c..9a6ed252 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -729,16 +729,25 @@ check_assignment_compatible <- function(
     ) {
       next
     }
-    if (
-      is.null(hoist) ||
-        !dim_guard_spellable(t_dim, scope) ||
-        !dim_guard_spellable(v_dim, scope)
-    ) {
+    if (is.null(hoist)) {
       next
     }
-    condition <- glue(
-      "({dims2f(list(t_dim), scope)}) /= ({dims2f(list(v_dim), scope)})"
-    )
+    if (dim_guard_spellable(t_dim, scope) && dim_guard_spellable(v_dim, scope)) {
+      condition <- glue(
+        "({dims2f(list(t_dim), scope)}) /= ({dims2f(list(v_dim), scope)})"
+      )
+    } else if (!is.null(target@name) && !is.null(value@name)) {
+      condition <- glue(
+        "size({target@name}, {axis}) /= size({value@name}, {axis})"
+      )
+    } else {
+      stop(
+        "cannot reassign `",
+        name,
+        "`: runtime shape cannot be validated",
+        call. = FALSE
+      )
+    }
     # Different axes can spell the same guard (e.g. a square dest vs a
     # square result, m/=k on both axes); emit each condition once.
     if (condition %in% emitted) {
diff --git a/tests/testthat/test-assignment-shape.R b/tests/testthat/test-assignment-shape.R
index 226b0f55..c50a4757 100644
--- a/tests/testthat/test-assignment-shape.R
+++ b/tests/testthat/test-assignment-shape.R
@@ -77,6 +77,29 @@ test_that("reassignment with symbolic dims gets a runtime shape guard", {
   )
 })
 
+test_that("reassignment from a deferred-shape local gets a runtime guard", {
+  fn <- function(a, b) {
+    declare(
+      type(a = double(NA)),
+      type(b = double(NA)),
+      type(x = double(NA))
+    )
+    x <- b
+    a <- x
+    a
+  }
+
+  code <- as.character(r2f(fn))
+  expect_match(code, "size\\(a, 1\\) /= size\\(x, 1\\)")
+
+  qfn := quick(fn)
+  expect_identical(qfn(c(1, 2), c(3, 4)), c(3, 4))
+  expect_error(
+    qfn(c(1, 2), c(3, 4, 5)),
+    "reassignment must preserve the shape of `a`"
+  )
+})
+
 test_that("shape-preserving reassignments still compile", {
   # same symbolic dims: provably equal, no guard needed
   fn_same <- function(a) {

From 9abf66ca2a2ec0db4ad1ced8a123eecab002cb14 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:42:29 -0400
Subject: [PATCH 64/97] Remove redundant BLAS guard snapshot

---
 tests/testthat/_snaps/blas-guards.md | 130 ---------------------------
 tests/testthat/test-blas-guards.R    |  11 ---
 2 files changed, 141 deletions(-)
 delete mode 100644 tests/testthat/_snaps/blas-guards.md

diff --git a/tests/testthat/_snaps/blas-guards.md b/tests/testthat/_snaps/blas-guards.md
deleted file mode 100644
index 11256717..00000000
--- a/tests/testthat/_snaps/blas-guards.md
+++ /dev/null
@@ -1,130 +0,0 @@
-# guard text is pinned (one snapshot per mechanism)
-
-    Code
-      cat("# Snapshot note: ", note, "\n", sep = "")
-    Output
-      # Snapshot note: Unverifiable BLAS dims emit one size guard before the call.
-    Code
-      fn
-    Output
-      function(m, x) {
-          declare(type(m = double(3, 3)), type(x = double(NA)))
-          m %*% x
-        }
-      <environment: 0x0>
-    Code
-      cat(fsub)
-    Output
-      subroutine fn(m, x, out_, x__len_, quickr_err_msg) bind(c)
-        use iso_c_binding, only: c_char, c_double, c_int, c_null_char, c_ptrdiff_t
-        implicit none
-      
-        ! manifest start
-        ! sizes
-        integer(c_ptrdiff_t), intent(in), value :: x__len_
-      
-        ! error
-        character(kind=c_char), intent(inout) :: quickr_err_msg(256)
-      
-        ! args
-        real(c_double), intent(in) :: m(3, 3)
-        real(c_double), intent(in) :: x(x__len_)
-        real(c_double), intent(out) :: out_(3, 1)
-        ! manifest end
-      
-      
-        if (3 /= size(x)) then
-          call quickr_set_error_msg("non-conformable arguments in %*%")
-          return
-        end if
-      call dgemv('N', int(3, kind=c_int), int(3, kind=c_int), 1.0_c_double, m, int(3, kind=c_int), x, 1_c_int, 0.0_c_double, out_,&
-      & 1_c_int)
-      
-        contains
-          subroutine quickr_set_error_msg(msg)
-            character(len=*), intent(in) :: msg
-            integer :: i
-            integer :: n
-            if (quickr_err_msg(1) == c_null_char) then
-              n = min(len(msg), 256 - 1)
-              quickr_err_msg(1:n) = [(msg(i:i), i = 1, n)]
-              quickr_err_msg(n + 1) = c_null_char
-            end if
-          end subroutine quickr_set_error_msg
-      end subroutine
-    Code
-      cat(cwrapper)
-    Output
-      #define R_NO_REMAP
-      #include <R.h>
-      #include <Rinternals.h>
-      
-      
-      extern void fn(
-        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) {
-        // m
-        _args = CDR(_args);
-        SEXP m = CAR(_args);
-        if (TYPEOF(m) != REALSXP) {
-          Rf_error("typeof(m) must be 'double', not '%s'", Rf_type2char(TYPEOF(m)));
-        }
-        const double* const m__ = REAL(m);
-        const int* const m__dim_ = ({
-        SEXP dim_ = Rf_getAttrib(m, R_DimSymbol);
-        if (Rf_length(dim_) != 2) Rf_error(
-          "m must be a 2D-array, but length(dim(m)) is %i",
-          (int) Rf_length(dim_));
-        INTEGER(dim_);});
-        const int m__dim_1_ = m__dim_[0];
-        const int m__dim_2_ = m__dim_[1];
-        
-        // x
-        _args = CDR(_args);
-        SEXP x = CAR(_args);
-        if (TYPEOF(x) != REALSXP) {
-          Rf_error("typeof(x) must be 'double', not '%s'", Rf_type2char(TYPEOF(x)));
-        }
-        const double* const x__ = REAL(x);
-        const R_xlen_t x__len_ = Rf_xlength(x);
-        
-        if (m__dim_1_ != 3)
-          Rf_error("dim(m)[1] must be 3, not %0.f",
-                    (double)m__dim_1_);
-        if (m__dim_2_ != 3)
-          Rf_error("dim(m)[2] must be 3, not %0.f",
-                    (double)m__dim_2_);
-        const R_xlen_t out___len_ = (3) * (1);
-        SEXP out_ = PROTECT(Rf_allocVector(REALSXP, out___len_));
-        double* out___ = REAL(out_);
-        {
-          const SEXP _dim_sexp = PROTECT(Rf_allocVector(INTSXP, 2));
-          int* const _dim = INTEGER(_dim_sexp);
-          _dim[0] = 3;
-          _dim[1] = 1;
-          Rf_dimgets(out_, _dim_sexp);
-        }
-        
-        char quickr_err_msg[256];
-        quickr_err_msg[0] = '\0';
-        
-        
-        fn(
-          m__,
-          x__,
-          out___,
-          x__len_,
-          quickr_err_msg);
-        if (quickr_err_msg[0] != '\0') {
-          Rf_error("%s", quickr_err_msg);
-        }
-        
-        UNPROTECT(2);
-        return out_;
-      }
-
diff --git a/tests/testthat/test-blas-guards.R b/tests/testthat/test-blas-guards.R
index 1fcf5bcc..6180413a 100644
--- a/tests/testthat/test-blas-guards.R
+++ b/tests/testthat/test-blas-guards.R
@@ -152,14 +152,3 @@ test_that("NA dims are never treated as equal", {
     fixed = TRUE
   )
 })
-
-test_that("guard text is pinned (one snapshot per mechanism)", {
-  fn <- function(m, x) {
-    declare(type(m = double(3, 3)), type(x = double(NA)))
-    m %*% x
-  }
-  expect_translation_snapshots(
-    fn,
-    note = "Unverifiable BLAS dims emit one size guard before the call."
-  )
-})

From b1f42ac2a2b85f43524eabc765deb9960fdd4710 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:44:56 -0400
Subject: [PATCH 65/97] Use ptrdiff shape guards

---
 R/r2f-operators-helpers.R              | 2 +-
 tests/testthat/test-assignment-shape.R | 8 +++++++-
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 9a6ed252..8e36fcfa 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -738,7 +738,7 @@ check_assignment_compatible <- function(
       )
     } else if (!is.null(target@name) && !is.null(value@name)) {
       condition <- glue(
-        "size({target@name}, {axis}) /= size({value@name}, {axis})"
+        "size({target@name}, {axis}, kind=c_ptrdiff_t) /= size({value@name}, {axis}, kind=c_ptrdiff_t)"
       )
     } else {
       stop(
diff --git a/tests/testthat/test-assignment-shape.R b/tests/testthat/test-assignment-shape.R
index c50a4757..3927e3bd 100644
--- a/tests/testthat/test-assignment-shape.R
+++ b/tests/testthat/test-assignment-shape.R
@@ -90,7 +90,13 @@ test_that("reassignment from a deferred-shape local gets a runtime guard", {
   }
 
   code <- as.character(r2f(fn))
-  expect_match(code, "size\\(a, 1\\) /= size\\(x, 1\\)")
+  expect_match(
+    code,
+    paste0(
+      "size\\(a, 1, kind=c_ptrdiff_t\\) /= ",
+      "size\\(x, 1, kind=c_ptrdiff_t\\)"
+    )
+  )
 
   qfn := quick(fn)
   expect_identical(qfn(c(1, 2), c(3, 4)), c(3, 4))

From 7e0a3da9f242d897cfbeb87704c84ef4238c9c6a Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:46:21 -0400
Subject: [PATCH 66/97] Size diag identities from scalar values

---
 R/r2f-matrix.R                      | 16 ++++++++++++++--
 tests/testthat/test-matrix-lapack.R | 19 +++++++++++++++++++
 2 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/R/r2f-matrix.R b/R/r2f-matrix.R
index bd60f290..e1dff51e 100644
--- a/R/r2f-matrix.R
+++ b/R/r2f-matrix.R
@@ -715,14 +715,26 @@ register_r2f_handler(
     # length-1 vector takes it too (R: diag(c(3)) is the 3x3 identity).
     # The size comes from x's *value*, and the result is always double.
     if (!has_nrow && !has_ncol && passes_as_scalar(x@value)) {
+      size_arg <- x_arg
+      repeat {
+        size_arg <- unwrap_parens(size_arg)
+        if (!is_call(size_arg, quote(c)) || length(size_arg) != 2L) {
+          break
+        }
+        size_arg <- size_arg[[2L]]
+      }
       # R sizes the identity with as.integer(x), so a double or logical `x`
       # is fine and truncates toward zero. Coerce in the size expression
       # rather than requiring an integer, so diag(n) works whatever the
       # caller declared. An integer `x` needs no wrapper.
       size_arg <- if (identical(x@value@mode, "integer")) {
-        x_arg
+        size_arg
       } else if (x@value@mode %in% c("double", "logical")) {
-        call("as.integer", x_arg)
+        if (is.atomic(size_arg) && length(size_arg) == 1L) {
+          as.integer(size_arg)
+        } else {
+          call("as.integer", size_arg)
+        }
       } else {
         stop(
           "diag(x) with a length-1 `x` builds an identity matrix of size ",
diff --git a/tests/testthat/test-matrix-lapack.R b/tests/testthat/test-matrix-lapack.R
index db805b50..cde07eac 100644
--- a/tests/testthat/test-matrix-lapack.R
+++ b/tests/testthat/test-matrix-lapack.R
@@ -313,6 +313,25 @@ test_that("diag matches R for vectors, matrices, and sizes", {
   expect_quick_equal(diag_named_order, list(x = c(1, 2)))
 })
 
+test_that("diag sizes identities from length-one expressions", {
+  diag_c <- function() {
+    out <- diag(c(3L))
+    out
+  }
+  diag_parens <- function() {
+    out <- diag((3L))
+    out
+  }
+  diag_logical <- function() {
+    out <- diag(c(TRUE))
+    out
+  }
+
+  expect_quick_equal(diag_c, list())
+  expect_quick_equal(diag_parens, list())
+  expect_quick_equal(diag_logical, list())
+})
+
 test_that("diag handles missing x with nrow/ncol and 1x1 matrices", {
   diag_nrow <- function(n) {
     declare(type(n = integer(1)))

From 90587f1a127abc3dea14bae91eb7f84ccd641853 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:50:11 -0400
Subject: [PATCH 67/97] Resolve scalar size expressions

---
 R/r2f-matrix.R                      | 16 ++-------------
 R/sizes.R                           | 31 ++++++++++++++++++++++-------
 tests/testthat/test-matrix-lapack.R |  5 +++++
 3 files changed, 31 insertions(+), 21 deletions(-)

diff --git a/R/r2f-matrix.R b/R/r2f-matrix.R
index e1dff51e..bd60f290 100644
--- a/R/r2f-matrix.R
+++ b/R/r2f-matrix.R
@@ -715,26 +715,14 @@ register_r2f_handler(
     # length-1 vector takes it too (R: diag(c(3)) is the 3x3 identity).
     # The size comes from x's *value*, and the result is always double.
     if (!has_nrow && !has_ncol && passes_as_scalar(x@value)) {
-      size_arg <- x_arg
-      repeat {
-        size_arg <- unwrap_parens(size_arg)
-        if (!is_call(size_arg, quote(c)) || length(size_arg) != 2L) {
-          break
-        }
-        size_arg <- size_arg[[2L]]
-      }
       # R sizes the identity with as.integer(x), so a double or logical `x`
       # is fine and truncates toward zero. Coerce in the size expression
       # rather than requiring an integer, so diag(n) works whatever the
       # caller declared. An integer `x` needs no wrapper.
       size_arg <- if (identical(x@value@mode, "integer")) {
-        size_arg
+        x_arg
       } else if (x@value@mode %in% c("double", "logical")) {
-        if (is.atomic(size_arg) && length(size_arg) == 1L) {
-          as.integer(size_arg)
-        } else {
-          call("as.integer", size_arg)
-        }
+        call("as.integer", x_arg)
       } else {
         stop(
           "diag(x) with a length-1 `x` builds an identity matrix of size ",
diff --git a/R/sizes.R b/R/sizes.R
index e8f6068c..faad79ea 100644
--- a/R/sizes.R
+++ b/R/sizes.R
@@ -156,7 +156,19 @@ substitute_declared_sizes <- function(e) {
 }
 
 
+unwrap_scalar_size_expr <- function(r) {
+  repeat {
+    r <- unwrap_parens(r)
+    if (!is_call(r, quote(c)) || length(r) != 2L) {
+      return(r)
+    }
+    r <- r[[2L]]
+  }
+}
+
 r2size <- function(r, scope) {
+  r <- unwrap_scalar_size_expr(r)
+
   sanitize_dim <- function(dim) {
     if (is.symbol(dim) || is.call(dim)) {
       return(r2size(dim, scope))
@@ -213,7 +225,7 @@ r2size <- function(r, scope) {
       language = {
         op <- as.character(r[[1]])
 
-        if (op %in% c("+", "-", "/", "*", "^", "%/%", "%%")) {
+        if (op %in% c("+", "-", "/", "*", "^", "%/%", "%%", "abs")) {
           args <- as.list(r)[-1]
           args <- lapply(args, r2size, scope)
           if (anyNA(rapply(args, as.list))) {
@@ -232,16 +244,21 @@ r2size <- function(r, scope) {
             if (length(r) != 2L) {
               stop("as.integer() in a size expression expects one argument")
             }
-            # A numeric literal is coerced here rather than recursed into:
-            # r2size() rejects a non-whole double, which is exactly the
-            # case as.integer() exists to handle.
-            if (is.numeric(r[[2L]]) && length(r[[2L]]) == 1L) {
-              return(as.integer(r[[2L]]))
+            inner_expr <- unwrap_scalar_size_expr(r[[2L]])
+            # A scalar literal is coerced here rather than recursed into:
+            # r2size() rejects a non-whole double (and a bare logical), which
+            # are exactly the cases as.integer() exists to handle.
+            if (
+              is.atomic(inner_expr) &&
+                typeof(inner_expr) %in% c("logical", "integer", "double") &&
+                length(inner_expr) == 1L
+            ) {
+              return(as.integer(inner_expr))
             }
             # An explicit coercion is exactly what the "not an integer"
             # warning asks for, so don't also warn about the operand.
             inner <- withCallingHandlers(
-              r2size(r[[2L]], scope),
+              r2size(inner_expr, scope),
               warning = function(w) {
                 if (
                   grepl(
diff --git a/tests/testthat/test-matrix-lapack.R b/tests/testthat/test-matrix-lapack.R
index cde07eac..2067670d 100644
--- a/tests/testthat/test-matrix-lapack.R
+++ b/tests/testthat/test-matrix-lapack.R
@@ -326,10 +326,15 @@ test_that("diag sizes identities from length-one expressions", {
     out <- diag(c(TRUE))
     out
   }
+  diag_computed <- function() {
+    out <- diag(abs(-3L))
+    out
+  }
 
   expect_quick_equal(diag_c, list())
   expect_quick_equal(diag_parens, list())
   expect_quick_equal(diag_logical, list())
+  expect_quick_equal(diag_computed, list())
 })
 
 test_that("diag handles missing x with nrow/ncol and 1x1 matrices", {

From 2756b9c314b45b4fabcd533c5ddc0b0dc3cb28f5 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:51:04 -0400
Subject: [PATCH 68/97] Preserve long fill lengths

---
 R/classes.R                     | 16 +++++++++++++++-
 R/manifest.R                    | 12 ++++++++----
 R/r2f-constructors.R            | 11 +++++++++--
 tests/testthat/test-recycling.R | 15 +++++++++++++++
 4 files changed, 47 insertions(+), 7 deletions(-)

diff --git a/R/classes.R b/R/classes.R
index cb6fb765..97e32465 100644
--- a/R/classes.R
+++ b/R/classes.R
@@ -339,6 +339,14 @@ Variable := new_class(
     # storage (0/1) rather than Fortran LOGICAL.
     logical_as_int = prop_bool(default = FALSE),
 
+    # Fortran kind for integer variables. User-facing R integers remain c_int;
+    # pointer-sized compiler locals opt into c_ptrdiff_t explicitly.
+    integer_kind = prop_enum(
+      c("c_int", "c_ptrdiff_t"),
+      default = "c_int",
+      exact = TRUE
+    ),
+
     # TRUE when the variable is available via host association and should not
     # be redeclared in the local scope.
     host_associated = prop_bool(default = FALSE),
@@ -350,7 +358,13 @@ Variable := new_class(
 
   validator = function(self) {
     if (isTRUE(self@logical_as_int) && !identical(self@mode, "logical")) {
-      "`logical_as_int` can only be TRUE when `mode` is 'logical'"
+      return("`logical_as_int` can only be TRUE when `mode` is 'logical'")
+    }
+    if (
+      !identical(self@integer_kind, "c_int") &&
+        !identical(self@mode, "integer")
+    ) {
+      "`integer_kind` can only differ from 'c_int' when `mode` is 'integer'"
     }
   }
 )
diff --git a/R/manifest.R b/R/manifest.R
index f80e5f1e..12b87c13 100644
--- a/R/manifest.R
+++ b/R/manifest.R
@@ -73,7 +73,11 @@ var_storage_bytes <- function(var) {
   switch(
     var@mode,
     double = 8,
-    integer = 4,
+    integer = if (identical(var@integer_kind, "c_ptrdiff_t")) {
+      .Machine$sizeof.pointer
+    } else {
+      4
+    },
     complex = 16,
     logical = 4,
     raw = 1,
@@ -196,7 +200,7 @@ iso_c_binding_symbols <- function(
         switch(
           var@mode,
           double = "c_double",
-          integer = "c_int",
+          integer = var@integer_kind,
           complex = "c_double_complex",
           logical = if (isTRUE(logical_is_c_int(var))) "c_int",
           raw = "c_int8_t",
@@ -262,7 +266,7 @@ emit_decl_line <- function(
   type <- switch(
     var@mode,
     double = "real(c_double)",
-    integer = "integer(c_int)",
+    integer = glue("integer({var@integer_kind})"),
     complex = "complex(c_double_complex)",
     logical = if (logical_as_int(var)) "integer(c_int)" else "logical",
     raw = "integer(c_int8_t)",
@@ -371,7 +375,7 @@ r2f.scope <- function(scope, include_errors = FALSE) {
     type <- switch(
       var@mode,
       double = "real(c_double)",
-      integer = "integer(c_int)",
+      integer = glue("integer({var@integer_kind})"),
       complex = "complex(c_double_complex)",
       logical = if (logical_as_int(var)) "integer(c_int)" else "logical",
       raw = "integer(c_int8_t)",
diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index ba362548..ee0d78f3 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -60,9 +60,16 @@ r2f_handlers[["c"]] <- function(args, scope = NULL, ...) {
           call. = FALSE
         )
       }
-      spread_var <- spread_var %||% scope_unique_var(scope, "integer")
+      spread_var <- spread_var %||%
+        scope_unique_var(
+          scope,
+          "integer",
+          integer_kind = "c_ptrdiff_t"
+        )
       ff[[j]] <- Fortran(
-        glue("({ff[[j]]}, {spread_var}=1, int({len_f}))"),
+        glue(
+          "({ff[[j]]}, {spread_var}=1_c_ptrdiff_t, int({len_f}, kind=c_ptrdiff_t))"
+        ),
         ff[[j]]@value
       )
     }
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index 85317a77..506ab91d 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -237,6 +237,21 @@ test_that("fill constructors spread inside c()", {
   expect_quick_identical(logical_fill, list(c(TRUE, FALSE)))
 })
 
+test_that("symbolic fill spreading preserves pointer-sized lengths", {
+  fn <- function(x) {
+    declare(type(x = double(NA)))
+    c(numeric(length(x)), 1)
+  }
+  fsub <- as.character(r2f(fn))
+  expect_match(fsub, "integer(c_ptrdiff_t) :: tmp1_", fixed = TRUE)
+  expect_match(
+    fsub,
+    "tmp1_=1_c_ptrdiff_t, int(x__len_, kind=c_ptrdiff_t)",
+    fixed = TRUE
+  )
+  expect_quick_identical(fn, list(c(2, 4, 6)))
+})
+
 test_that("fill constructors materialize where an array is required", {
   # A fill reaching c() through an expression is a real array, not a
   # scalar literal with claimed dims (which emitted one element where the

From d7fae387608cb73b62489f1ead47b0a5e3d9bd6b Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:51:42 -0400
Subject: [PATCH 69/97] Cast completed real size expressions

---
 R/c-wrapper.R                        | 79 ++++++++++++++++++++++++----
 tests/testthat/test-c-bridge-hoist.R | 31 +++++++++++
 2 files changed, 99 insertions(+), 11 deletions(-)

diff --git a/R/c-wrapper.R b/R/c-wrapper.R
index 6bc6bc32..df2361f0 100644
--- a/R/c-wrapper.R
+++ b/R/c-wrapper.R
@@ -480,8 +480,16 @@ c_bridge_hoist_seq_checks <- function(hoist, from, to, by) {
 }
 
 
-as_c_name <- function(var, c_hoist = NULL) {
+as_c_name <- function(var, c_hoist = NULL, preserve_numeric = FALSE) {
   stopifnot(inherits(var, Variable))
+  if (isTRUE(preserve_numeric)) {
+    if (identical(var@mode, "double")) {
+      return(glue("Rf_asReal({var@name})"))
+    }
+    if (!var@mode %in% c("integer", "logical")) {
+      stop("unsupported numeric size expression mode: ", var@mode)
+    }
+  }
   expr <- glue("Rf_asInteger({var@name})")
   if (is.null(c_hoist)) {
     return(expr)
@@ -531,13 +539,22 @@ dims2c_dim_index_expr <- function(cl, scope) {
   get_size_name(var, axis)
 }
 
-dims2c_expr <- function(e, scope, c_hoist = NULL) {
+dims2c_expr <- function(
+  e,
+  scope,
+  c_hoist = NULL,
+  preserve_numeric = FALSE
+) {
   if (is.null(e)) {
     return(NULL)
   }
 
   if (inherits(e, Variable)) {
-    return(as_c_name(e, c_hoist = c_hoist))
+    return(as_c_name(
+      e,
+      c_hoist = c_hoist,
+      preserve_numeric = preserve_numeric
+    ))
   }
 
   if (is_scalar_integer(e)) {
@@ -560,7 +577,11 @@ dims2c_expr <- function(e, scope, c_hoist = NULL) {
     if (!inherits(var, Variable)) {
       stop("could not resolve size: ", nm)
     }
-    return(as_c_name(var, c_hoist = c_hoist))
+    return(as_c_name(
+      var,
+      c_hoist = c_hoist,
+      preserve_numeric = preserve_numeric
+    ))
   }
 
   if (!is.call(e)) {
@@ -574,7 +595,12 @@ dims2c_expr <- function(e, scope, c_hoist = NULL) {
     if (length(args) != 1L) {
       stop("unsupported size expression: ", deparse1(e))
     }
-    return(dims2c_expr(args[[1L]], scope, c_hoist = c_hoist))
+    return(dims2c_expr(
+      args[[1L]],
+      scope,
+      c_hoist = c_hoist,
+      preserve_numeric = preserve_numeric
+    ))
   }
 
   if (identical(op, "length")) {
@@ -623,7 +649,12 @@ dims2c_expr <- function(e, scope, c_hoist = NULL) {
     if (length(args) != 1L) {
       stop("abs() expects one argument")
     }
-    e1 <- dims2c_expr(args[[1L]], scope, c_hoist = c_hoist)
+    e1 <- dims2c_expr(
+      args[[1L]],
+      scope,
+      c_hoist = c_hoist,
+      preserve_numeric = preserve_numeric
+    )
     return(glue("(({e1}) < 0 ? -({e1}) : ({e1}))"))
   }
 
@@ -633,20 +664,40 @@ dims2c_expr <- function(e, scope, c_hoist = NULL) {
     }
     # a C cast to an integer type truncates toward zero, as R's
     # as.integer() does
-    e1 <- dims2c_expr(args[[1L]], scope, c_hoist = c_hoist)
+    e1 <- dims2c_expr(
+      args[[1L]],
+      scope,
+      c_hoist = c_hoist,
+      preserve_numeric = TRUE
+    )
     return(glue("((R_xlen_t)({e1}))"))
   }
 
   if (op %in% c("+", "-", "*", "/", "%/%", "%%", "^")) {
     if (length(args) == 1L && op %in% c("+", "-")) {
-      e1 <- dims2c_expr(args[[1L]], scope, c_hoist = c_hoist)
+      e1 <- dims2c_expr(
+        args[[1L]],
+        scope,
+        c_hoist = c_hoist,
+        preserve_numeric = preserve_numeric
+      )
       return(glue("({op}({e1}))"))
     }
     if (length(args) != 2L) {
       stop("unsupported size expression: ", deparse1(e))
     }
-    e1 <- dims2c_expr(args[[1L]], scope, c_hoist = c_hoist)
-    e2 <- dims2c_expr(args[[2L]], scope, c_hoist = c_hoist)
+    e1 <- dims2c_expr(
+      args[[1L]],
+      scope,
+      c_hoist = c_hoist,
+      preserve_numeric = preserve_numeric
+    )
+    e2 <- dims2c_expr(
+      args[[2L]],
+      scope,
+      c_hoist = c_hoist,
+      preserve_numeric = preserve_numeric
+    )
     return(switch(
       op,
       `+` = glue("({e1} + {e2})"),
@@ -663,7 +714,13 @@ dims2c_expr <- function(e, scope, c_hoist = NULL) {
     if (!length(args)) {
       return("0")
     }
-    rendered <- lapply(args, dims2c_expr, scope = scope, c_hoist = c_hoist)
+    rendered <- lapply(
+      args,
+      dims2c_expr,
+      scope = scope,
+      c_hoist = c_hoist,
+      preserve_numeric = preserve_numeric
+    )
     cmp <- if (identical(op, "min")) "<" else ">"
     reduce(rendered, \(a, b) glue("(({a}) {cmp} ({b}) ? ({a}) : ({b}))"))
   } else {
diff --git a/tests/testthat/test-c-bridge-hoist.R b/tests/testthat/test-c-bridge-hoist.R
index 94a5c22c..a77b47c3 100644
--- a/tests/testthat/test-c-bridge-hoist.R
+++ b/tests/testthat/test-c-bridge-hoist.R
@@ -25,3 +25,34 @@ test_that("size check blocks redeclare hoisted size temps", {
     list(5L, 3L, c(1, 2, 3), c(4, 5, 6))
   )
 })
+
+test_that("C bridge casts completed real size expressions", {
+  fn <- function(x, y) {
+    declare(type(x = double(1)), type(y = double(1)))
+    out <- diag(x + y)
+    out
+  }
+
+  dll_paths_before <- loaded_dll_paths()
+  on.exit(cleanup_new_quick_dlls(dll_paths_before), add = TRUE)
+  qfn := quick(fn)
+
+  dll_paths <- setdiff(loaded_dll_paths(), dll_paths_before)
+  expect_length(dll_paths, 1L)
+  c_path <- list.files(
+    dirname(dll_paths[[1L]]),
+    pattern = "_c_wrapper[.]c$",
+    full.names = TRUE
+  )
+  expect_length(c_path, 1L)
+  c_code <- paste(readLines(c_path, warn = FALSE), collapse = "\n")
+  expect_match(
+    c_code,
+    "((R_xlen_t)((Rf_asReal(x) + Rf_asReal(y))))",
+    fixed = TRUE
+  )
+
+  x <- c(1.7)
+  y <- c(1.7)
+  expect_identical(qfn(x, y), fn(x, y))
+})

From 6dacb9a2566096c4161b1e0e9627dc3d2a8ef194 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:27:21 -0400
Subject: [PATCH 70/97] Respect local closures in fill detection

---
 R/r2f-constructors.R            | 16 ++++++++++------
 tests/testthat/test-recycling.R | 34 +++++++++++++++++++++++++++++++++
 2 files changed, 44 insertions(+), 6 deletions(-)

diff --git a/R/r2f-constructors.R b/R/r2f-constructors.R
index ee0d78f3..4dabbe49 100644
--- a/R/r2f-constructors.R
+++ b/R/r2f-constructors.R
@@ -8,10 +8,14 @@
 # double(k), numeric(k). These lower to a single scalar literal carrying
 # array dims, so splicing contexts must spread them explicitly.
 # Used by: c(), array()
-is_fill_constructor_call <- function(e) {
-  is.call(e) &&
-    is.symbol(e[[1L]]) &&
-    as.character(e[[1L]]) %in% c("logical", "integer", "double", "numeric")
+is_fill_constructor_call <- function(e, scope) {
+  if (!is.call(e) || !is.symbol(e[[1L]])) {
+    return(FALSE)
+  }
+  name <- as.character(e[[1L]])
+  name %in%
+    c("logical", "integer", "double", "numeric") &&
+    (is.null(scope) || !inherits(scope[[name]], LocalClosure))
 }
 
 # Name of the call one frame above the current handler ("" at top level).
@@ -44,7 +48,7 @@ r2f_handlers[["c"]] <- function(args, scope = NULL, ...) {
   mode <- promoted$mode
   # Fill constructors are one scalar literal claiming length k; spread them
   # as implied-dos so the emitted element count matches the claimed length.
-  fill_idx <- which(map_lgl(args, is_fill_constructor_call))
+  fill_idx <- which(map_lgl(args, is_fill_constructor_call, scope = scope))
   if (length(fill_idx)) {
     spread_var <- NULL
     for (j in fill_idx) {
@@ -390,7 +394,7 @@ r2f_handlers[["array"]] <- function(args, scope = NULL, ..., hoist = NULL) {
       }
       shape <- glue("int([{dims_f}])")
 
-      is_fill_constructor <- is_fill_constructor_call(args$data)
+      is_fill_constructor <- is_fill_constructor_call(args$data, scope)
 
       axis_terms <- vapply(
         target_dims,
diff --git a/tests/testthat/test-recycling.R b/tests/testthat/test-recycling.R
index 506ab91d..05cc3333 100644
--- a/tests/testthat/test-recycling.R
+++ b/tests/testthat/test-recycling.R
@@ -252,6 +252,40 @@ test_that("symbolic fill spreading preserves pointer-sized lengths", {
   expect_quick_identical(fn, list(c(2, 4, 6)))
 })
 
+test_that("local closures can shadow fill constructors in c() and array()", {
+  numeric_shadow <- function() {
+    numeric <- function() c(1, 2)
+    combined <- c(numeric(), 3)
+    reshaped <- array(numeric(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(numeric_shadow, list())
+
+  integer_shadow <- function() {
+    integer <- function() c(1L, 2L)
+    combined <- c(integer(), 3L)
+    reshaped <- array(integer(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(integer_shadow, list())
+
+  double_shadow <- function() {
+    double <- function() c(1, 2)
+    combined <- c(double(), 3)
+    reshaped <- array(double(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(double_shadow, list())
+
+  logical_shadow <- function() {
+    logical <- function() c(1L, 2L)
+    combined <- c(logical(), 3L)
+    reshaped <- array(logical(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(logical_shadow, list())
+})
+
 test_that("fill constructors materialize where an array is required", {
   # A fill reaching c() through an expression is a real array, not a
   # scalar literal with claimed dims (which emitted one element where the

From e67b6fff3b95d6ecadbda4e784530162a6749372 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:53:18 -0400
Subject: [PATCH 71/97] Document prod result type divergence

---
 vignettes/quickr-semantics.Rmd | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

diff --git a/vignettes/quickr-semantics.Rmd b/vignettes/quickr-semantics.Rmd
index 241829c0..24e268ab 100644
--- a/vignettes/quickr-semantics.Rmd
+++ b/vignettes/quickr-semantics.Rmd
@@ -18,13 +18,16 @@ knitr::opts_chunk$set(
 quickr compiles a subset of R. This vignette documents the semantics of
 that subset: what type a result has, when shapes are checked, and every
 place where a compiled function deliberately behaves differently from R.
-All differences take the same form — an error where R would return a
-value — never a different value.
+Except for the `prod()` result type documented below, all differences
+take the same form — an error where R would return a value — never a
+different value.
 
 ## The contract
 
 > `quick(f)(x)` either returns exactly what `f(x)` returns — same values,
 > same `typeof()`, same shape — or raises an error. Never a third thing.
+> Integer and logical `prod()` results have the documented type divergence
+> below.
 > The unchecked `NA` inputs and out-of-bounds runtime subscripts documented
 > below are outside this contract and have undefined behavior.
 
@@ -54,8 +57,7 @@ complex support is narrower than the lattice suggests — see
 [complex values](#complex) under the differences below.
 
 An operation's result type is the "join" of its operands' types — the
-highest type among them — except where R fixes the result type, which
-quickr then matches:
+highest type among them — except where the table says otherwise:
 
 | Operation | Result type |
 |---|---|
@@ -66,8 +68,9 @@ quickr then matches:
 | `<` `<=` `>` `>=` `==` `!=` | logical |
 | `&`, `|`, `!`, `&&`, `||` | logical (see [logical operators](#logical-operators) below) |
 | `c()` | join of all argument types (`c(TRUE, FALSE)` stays logical, as in R) |
-| multi-argument `min()` / `max()` / `sum()` / `prod()` | join of all argument types; logicals count as integers (in R, `sum(TRUE, TRUE)` is `2L`) |
-| single-argument reductions (`sum(x)`, ...), `abs()` | type of `x`; logical counts as integer |
+| multi-argument `min()` / `max()` / `sum()` | join of all argument types; logicals count as integers (in R, `sum(TRUE, TRUE)` is `2L`) |
+| single-argument `min()` / `max()` / `sum()`, `abs()` | type of `x`; logical counts as integer |
+| `prod()` | join of the argument types; unlike R, an integer/logical-only product is integer rather than double |
 | `ifelse(test, yes, no)` | join of `yes` and `no` (but see [ifelse](#ifelse) below) |
 | `%*%`, `crossprod()`, `solve()`, and other linear algebra | always double, as in R; complex operands are a compile error (see [complex values](#complex)) |
 | `t(x)`, `diag(x)` | same type as `x`; the identity forms `diag(n)` are double, as in R |
@@ -268,6 +271,12 @@ operands produce a zero-length result, as in R).
 under [Types](#reassignment-cannot-narrow-a-type). R instead promotes
 the variable to double.
 
+### `prod()` keeps integer products
+
+quickr preserves the joined input type for `prod()`. A product whose
+inputs are all integer or logical therefore has integer type. R instead
+returns double from `prod()` even when every input is integer or logical.
+
 ### Complex values are elementwise-only {#complex}
 
 Elementwise arithmetic and equality comparisons handle complex values

From 5b59abc9aa98efbe6ac48fd5df1e2f442aca7d0d Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 09:53:35 -0400
Subject: [PATCH 72/97] Format assignment shape guard

---
 R/r2f-operators-helpers.R | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/R/r2f-operators-helpers.R b/R/r2f-operators-helpers.R
index 8e36fcfa..4bd1b091 100644
--- a/R/r2f-operators-helpers.R
+++ b/R/r2f-operators-helpers.R
@@ -732,7 +732,9 @@ check_assignment_compatible <- function(
     if (is.null(hoist)) {
       next
     }
-    if (dim_guard_spellable(t_dim, scope) && dim_guard_spellable(v_dim, scope)) {
+    if (
+      dim_guard_spellable(t_dim, scope) && dim_guard_spellable(v_dim, scope)
+    ) {
       condition <- glue(
         "({dims2f(list(t_dim), scope)}) /= ({dims2f(list(v_dim), scope)})"
       )

From b5aa565118d45dfa2bd7db9043d029ff545c0171 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 10:02:09 -0400
Subject: [PATCH 73/97] test: run full conformability grid by default

---
 tests/testthat/test-conformability-grid.R | 43 +----------------------
 1 file changed, 1 insertion(+), 42 deletions(-)

diff --git a/tests/testthat/test-conformability-grid.R b/tests/testthat/test-conformability-grid.R
index cade22c5..22b69a2c 100644
--- a/tests/testthat/test-conformability-grid.R
+++ b/tests/testthat/test-conformability-grid.R
@@ -24,19 +24,7 @@ skip_on_cran()
 # 2^31 (%/% in the real domain), descending ranges, TRUE/FALSE arithmetic,
 # and equal positions so == has TRUE cells.
 #
-# The default run compiles a fixed representative sample of shape pairs;
-# set QUICKR_FULL_GRID=1 to compile every pair. Sampling is deterministic
-# (a tier per pair, no randomness) so failures always reproduce.
-# Compile-error cells never reach gfortran and always run.
-
-run_full_grid <- Sys.getenv("QUICKR_FULL_GRID") %in%
-  c("1", "true", "TRUE", "yes")
-
-skip_unless_full_grid <- function() {
-  if (!run_full_grid) {
-    skip("representative sample only; set QUICKR_FULL_GRID=1 for the full grid")
-  }
-}
+# Every intended shape pair runs in the standard non-CRAN suite.
 
 # --- Axes ---------------------------------------------------------------
 
@@ -356,29 +344,6 @@ grid_pair_verdict <- function(sa, sb) {
   grid_cell_verdict(sa, sb, "add")
 }
 
-# Which shape pairs compile in the default run. Every non-error pair must
-# be listed: adding a shape without deciding its tier is an error.
-grid_pair_tiers <- c(
-  "scl.scl" = "full",
-  "scl.vec3" = "core",
-  "scl.vec4" = "full",
-  "scl.mat32" = "full",
-  "scl.mat11" = "full",
-  "scl.sym" = "full",
-  "vec3.vec3" = "core",
-  "vec3.mat32" = "core",
-  "vec3.mat11" = "full",
-  "vec3.sym" = "core",
-  "vec4.vec4" = "full",
-  "vec4.mat11" = "full",
-  "vec4.sym" = "full",
-  "mat32.mat32" = "core",
-  "mat32.sym" = "core",
-  "mat11.mat11" = "full",
-  "mat11.sym" = "full",
-  "sym.sym" = "core"
-)
-
 # --- Oracle comparison --------------------------------------------------
 
 # suppressWarnings: R deprecation-warns on 1x1-array-vs-vector recycling
@@ -416,14 +381,9 @@ for (i in seq_along(grid_pair_names)) {
         return() # handled in the compile-error section below
       }
       pair_id <- paste0(sa, ".", sb)
-      tier <- grid_pair_tiers[[pair_id]]
-      stopifnot(tier %in% c("core", "full"))
 
       for (family in names(grid_op_families)) {
         test_that(paste0("elementwise grid ", pair_id, " [", family, "]"), {
-          if (identical(tier, "full")) {
-            skip_unless_full_grid()
-          }
           fn <- make_grid_pair_fn(sa, sb, family)
           dll_paths_before <- loaded_dll_paths()
           on.exit(cleanup_new_quick_dlls(dll_paths_before), add = TRUE)
@@ -811,7 +771,6 @@ test_that("ifelse grid: symbolic branch lengths get a runtime guard", {
 })
 
 test_that("ifelse grid: matrix test shapes the result", {
-  skip_unless_full_grid()
   src <- paste0(
     "function(tm, ym, nm, yi, pd) {\n",
     "  declare(\n",

From 96b66e112610f498790be7e6f246eee23fa9fb5d Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 10:11:13 -0400
Subject: [PATCH 74/97] fix: keep scalar logical operators scalar

---
 R/r2f-logical.R               | 65 ++++++++++++++++++++++++++++++-----
 tests/testthat/test-logical.R | 34 ++++++++++++++++++
 2 files changed, 90 insertions(+), 9 deletions(-)

diff --git a/R/r2f-logical.R b/R/r2f-logical.R
index dea03b5e..260d39f2 100644
--- a/R/r2f-logical.R
+++ b/R/r2f-logical.R
@@ -135,14 +135,13 @@ register_r2f_handler(
 
 # ---- binary logical operators ----
 
-# TODO: the scalar || probably need some more type checking.
 # TODO: gfortran supports implicit casting that of logical to integer when
 # assigning a logical to a variable declared integer, converting `.true.` to `1`,
 # but this is not a standard language feature, and Intel's `ifort` uses `-1` for `.true`.
 # We should explicitly use
 #   `merge(1_c_int, 0_c_int, <lgl>)` to cast logical to int.
 register_r2f_handler(
-  c("&", "&&", "|", "||"),
+  c("&", "|"),
   function(args, scope, ..., hoist = NULL) {
     args <- lapply(args, r2f, scope, ..., hoist = hoist)
     args <- lapply(args, function(a) {
@@ -162,13 +161,7 @@ register_r2f_handler(
       scalarize_one_by_one = FALSE
     )
 
-    operator <- switch(
-      last(list(...)$calls),
-      `&` = ,
-      `&&` = ".and.",
-      `|` = ,
-      `||` = ".or."
-    )
+    operator <- switch(last(list(...)$calls), `&` = ".and.", `|` = ".or.")
 
     s <- glue("{left} {operator} {right}")
     val <- conform(left@value, right@value)
@@ -176,3 +169,57 @@ register_r2f_handler(
     Fortran(s, val)
   }
 )
+
+andor_operand_is_length_one <- function(x) {
+  passes_as_scalar(x@value) ||
+    x@value@rank > 0L &&
+      all(vapply(x@value@dims, dim_is_one, logical(1L)))
+}
+
+scalarize_andor_operand <- function(x, op, hoist) {
+  if (is.null(x@value) || !identical(x@value@mode, "logical")) {
+    stop("`", op, "` requires logical operands", call. = FALSE)
+  }
+  if (!andor_operand_is_length_one(x)) {
+    stop(
+      "`",
+      op,
+      "` requires length-1 operands; use `",
+      if (op == "&&") "&" else "|",
+      "` for elementwise operations",
+      call. = FALSE
+    )
+  }
+  if (passes_as_scalar(x@value)) {
+    return(booleanize_logical_as_int(x))
+  }
+  if (is.null(hoist)) {
+    stop("internal error: `", op, "` requires hoist context", call. = FALSE)
+  }
+
+  if (isTRUE(x@logical_booleanized)) {
+    tmp <- hoist$declare_tmp(mode = "logical", dims = x@value@dims)
+    hoist$emit(glue("{tmp@name} = {x}"))
+    x <- Fortran(tmp@name, tmp)
+  } else {
+    x <- hoist_unless_name(x, hoist)
+  }
+  idxs <- rep("1", x@value@rank)
+  Fortran(
+    glue("{x}({str_flatten_commas(idxs)})"),
+    Variable("logical")
+  )
+}
+
+register_r2f_handler(
+  c("&&", "||"),
+  function(args, scope, ..., hoist = NULL) {
+    op <- last(list(...)$calls)
+    stopifnot(length(args) == 2L, op %in% c("&&", "||"))
+    .[left, right] <- lapply(args, r2f, scope, ..., hoist = hoist)
+    left <- scalarize_andor_operand(left, op, hoist)
+    right <- scalarize_andor_operand(right, op, hoist)
+    operator <- if (op == "&&") ".and." else ".or."
+    Fortran(glue("{left} {operator} {right}"), Variable("logical"))
+  }
+)
diff --git a/tests/testthat/test-logical.R b/tests/testthat/test-logical.R
index bd157f52..d91314e7 100644
--- a/tests/testthat/test-logical.R
+++ b/tests/testthat/test-logical.R
@@ -110,3 +110,37 @@ test_that("parentheses preserve logical precedence", {
   expect_quick_identical(fn_a, !!!cases)
   expect_quick_identical(fn_b, !!!cases)
 })
+
+test_that("&& and || require length-1 operands", {
+  vector_matrix_and <- function(x, y) {
+    declare(type(x = logical(2)), type(y = logical(2, 2)))
+    x && y
+  }
+  expect_error(quick(vector_matrix_and), "requires length-1 operands")
+
+  matrix_vector_or <- function(x, y) {
+    declare(type(x = logical(2, 2)), type(y = logical(2)))
+    x || y
+  }
+  expect_error(quick(matrix_vector_or), "requires length-1 operands")
+})
+
+test_that("&& and || accept one-element matrices", {
+  matrix_and <- function(x, y) {
+    declare(type(x = logical(1, 1)), type(y = logical(1, 1)))
+    x && y
+  }
+  expect_quick_identical(
+    matrix_and,
+    list(matrix(TRUE, 1, 1), matrix(FALSE, 1, 1))
+  )
+
+  matrix_or <- function(x, y) {
+    declare(type(x = logical(1, 1)), type(y = logical(1, 1)))
+    x || y
+  }
+  expect_quick_identical(
+    matrix_or,
+    list(matrix(FALSE, 1, 1), matrix(TRUE, 1, 1))
+  )
+})

From b3caad2bbfdc6700ed30aebb898a13feff653ac4 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 10:22:35 -0400
Subject: [PATCH 75/97] test: execute bounded repeat BLAS lowering

---
 tests/testthat/test-loops.R | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-loops.R b/tests/testthat/test-loops.R
index 7b12497b..90abbf01 100644
--- a/tests/testthat/test-loops.R
+++ b/tests/testthat/test-loops.R
@@ -110,8 +110,9 @@ test_that("single-statement while/repeat bodies re-run their hoisted statements"
   # loop would freeze the body's work at its first evaluation. `for` is
   # covered in test-for-iterables.R.
   #
-  # The repeat variant cannot terminate; execute the finite while variant
-  # to cover the generated loop as well as its translation.
+  # Keep the direct repeat assignment as a translation regression because
+  # it cannot terminate. Exercise the generated repeat path separately with
+  # a bounded one-statement body whose else branch repeats the same BLAS work.
   # fmt: skip
   squarings_while <- function(m) {
     declare(type(m = double(2, 2)))
@@ -130,4 +131,13 @@ test_that("single-statement while/repeat bodies re-run their hoisted statements"
   }
 
   expect_translation_snapshots(squarings_repeat)
+
+  # fmt: skip
+  bounded_squarings_repeat <- function(m) {
+    declare(type(m = double(2, 2)))
+    repeat if (m[1, 1] >= 100) break else m <- m %*% m
+    m
+  }
+
+  expect_quick_identical(bounded_squarings_repeat, list(diag(2) * 2))
 })

From 3cbf79a07cb62cf2df004deac6ffd997d78744dc Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 10:28:54 -0400
Subject: [PATCH 76/97] Isolate flang auto-preference test state

---
 tests/testthat/test-flang-preference.R | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/tests/testthat/test-flang-preference.R b/tests/testthat/test-flang-preference.R
index 4fc49820..6b85d7d0 100644
--- a/tests/testthat/test-flang-preference.R
+++ b/tests/testthat/test-flang-preference.R
@@ -87,6 +87,11 @@ test_that("quickr_fcompiler_env returns empty when disabled or unavailable", {
 })
 
 test_that("quickr_fcompiler_env uses caller-provided sysname for flang auto preference", {
+  state <- quickr:::quickr_flang_state
+  old_auto_disabled <- state$auto_disabled
+  state$auto_disabled <- FALSE
+  on.exit(state$auto_disabled <- old_auto_disabled, add = TRUE)
+
   temp <- withr::local_tempdir()
   prefix <- file.path(temp, "flang")
   dir.create(file.path(prefix, "bin"), recursive = TRUE)

From 0c63a7c09f92ca95477f3b5ebc30e8dbb3994037 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 10:50:07 -0400
Subject: [PATCH 77/97] test: update wide ifelse guard snapshot

---
 tests/testthat/_snaps/ifelse.md | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/_snaps/ifelse.md b/tests/testthat/_snaps/ifelse.md
index f9798be7..4461e172 100644
--- a/tests/testthat/_snaps/ifelse.md
+++ b/tests/testthat/_snaps/ifelse.md
@@ -113,12 +113,12 @@
         ! manifest end
       
       
-        if (size(a, 1) /= size((c/=0), 1)) then
+        if (size(a, 1, kind=c_ptrdiff_t) /= size((c/=0), 1, kind=c_ptrdiff_t)) then
       call quickr_set_error_msg("ifelse() `yes` and `no` must be scalars or match the shape of `test`; R-style recycling is not&
       & supported")
           return
         end if
-        if (size(b, 1) /= size((c/=0), 1)) then
+        if (size(b, 1, kind=c_ptrdiff_t) /= size((c/=0), 1, kind=c_ptrdiff_t)) then
       call quickr_set_error_msg("ifelse() `yes` and `no` must be scalars or match the shape of `test`; R-style recycling is not&
       & supported")
           return

From bf0daf1a50e02debf4e1c5039e8b5fb6eb037685 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 10:54:28 -0400
Subject: [PATCH 78/97] fix: handle empty symmetric BLAS products

---
 R/r2f-matrix-blas.R               | 28 +++++++++++++---
 tests/testthat/test-blas-guards.R | 53 +++++++++++++++++++++++++++++++
 2 files changed, 77 insertions(+), 4 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 926b028e..5e51d88b 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -190,6 +190,23 @@ assert_square_matrix <- function(dims, operand, context, hoist, scope) {
 
 # ---- BLAS emitters ----
 
+# Generated function results cannot currently represent zero-sized arrays.
+# Reject a statically known zero output before emitting a BLAS call with an
+# invalid leading dimension. A zero contracted dimension remains supported
+# when every output extent is nonzero.
+assert_nonempty_blas_output <- function(dims, context) {
+  stopifnot(is.list(dims), length(dims) > 0L, is_string(context))
+  has_zero_extent <- any(vapply(
+    dims,
+    function(dim) is_wholenumber(dim) && as.integer(dim) == 0L,
+    logical(1)
+  ))
+  if (has_zero_extent) {
+    stop(context, " zero-sized outputs are not supported", call. = FALSE)
+  }
+  invisible(TRUE)
+}
+
 # Check that destination dimensions match expected output dimensions.
 assert_dest_dims_compatible <- function(dest, expected_dims, context) {
   if (is.null(dest) || is.null(expected_dims)) {
@@ -327,6 +344,7 @@ gemm <- function(
   context = "gemm"
 ) {
   assert_hoist_env(hoist)
+  assert_nonempty_blas_output(list(m, n), context)
   A_name <- ensure_blas_operand_name(left, hoist)
   B_name <- ensure_blas_operand_name(right, hoist)
 
@@ -373,6 +391,7 @@ gemv <- function(
   context = "gemv"
 ) {
   assert_hoist_env(hoist)
+  assert_nonempty_blas_output(out_dims, context)
   A_name <- ensure_blas_operand_name(A, hoist)
   x_name <- ensure_blas_operand_name(x, hoist)
 
@@ -464,8 +483,6 @@ syrk <- function(
   context = "syrk"
 ) {
   assert_hoist_env(hoist)
-  X_name <- ensure_blas_operand_name(X, hoist)
-
   x_dims <- matrix_dims(X)
 
   # For trans = "T": C = t(X) %*% X, so C is k x k where k = ncol(X)
@@ -478,6 +495,8 @@ syrk <- function(
     k <- x_dims$cols
   }
   lda <- x_dims$rows
+  assert_nonempty_blas_output(list(n, n), context)
+  X_name <- ensure_blas_operand_name(X, hoist)
 
   # Output is symmetric n x n matrix
   writes_to_dest <- FALSE
@@ -500,9 +519,10 @@ syrk <- function(
     out_name <- out_var@name
   }
 
-  hoist$emit(glue(
+  blas_call <- glue(
     "call dsyrk('U', '{trans}', {blas_int(n)}, {blas_int(k)}, 1.0_c_double, {X_name}, {blas_int(lda)}, 0.0_c_double, {out_name}, {blas_int(n)})"
-  ))
+  )
+  emit_blas_contraction(blas_call, out_name, k, hoist)
   symmetrize_upper_to_lower(out_name, n, hoist = hoist)
 
   out <- Fortran(out_name, out_var)
diff --git a/tests/testthat/test-blas-guards.R b/tests/testthat/test-blas-guards.R
index 6180413a..fa8dd7b8 100644
--- a/tests/testthat/test-blas-guards.R
+++ b/tests/testthat/test-blas-guards.R
@@ -137,6 +137,59 @@ test_that("%*% returns zeros for a symbolic empty contracted dimension", {
   )
 })
 
+test_that("symmetric products return zeros for known empty contractions", {
+  cross_vec <- function(x) {
+    declare(type(x = double(0)))
+    crossprod(x)
+  }
+  cross_mat <- function(x) {
+    declare(type(x = double(0, 2)))
+    crossprod(x)
+  }
+  tcross_mat <- function(x) {
+    declare(type(x = double(2, 0)))
+    tcrossprod(x)
+  }
+  cross_symbolic <- function(x, n) {
+    declare(type(x = double(n, 2)), type(n = integer(1)))
+    crossprod(x)
+  }
+  tcross_symbolic <- function(x, n) {
+    declare(type(x = double(2, n)), type(n = integer(1)))
+    tcrossprod(x)
+  }
+
+  expect_quick_identical(cross_vec, list(double()))
+  expect_quick_identical(cross_mat, list(matrix(double(), 0, 2)))
+  expect_quick_identical(tcross_mat, list(matrix(double(), 2, 0)))
+  expect_quick_identical(cross_symbolic, list(matrix(double(), 0, 2), 0L))
+  expect_quick_identical(tcross_symbolic, list(matrix(double(), 2, 0), 0L))
+})
+
+test_that("matrix BLAS rejects known zero-sized outputs", {
+  matrix_matrix <- function(a, b) {
+    declare(type(a = double(0, 2)), type(b = double(2, 3)))
+    a %*% b
+  }
+  matrix_vector <- function(a, x) {
+    declare(type(a = double(0, 2)), type(x = double(2)))
+    a %*% x
+  }
+  tcross_vec <- function(x) {
+    declare(type(x = double(0)))
+    tcrossprod(x)
+  }
+  cross_mat <- function(x) {
+    declare(type(x = double(0, 0)))
+    crossprod(x)
+  }
+
+  expect_error(quick(matrix_matrix), "zero-sized outputs are not supported")
+  expect_error(quick(matrix_vector), "zero-sized outputs are not supported")
+  expect_error(quick(tcross_vec), "zero-sized outputs are not supported")
+  expect_error(quick(cross_mat), "zero-sized outputs are not supported")
+})
+
 test_that("NA dims are never treated as equal", {
   fn <- function(a, b) {
     declare(type(a = double(NA, NA)), type(b = double(NA, NA)))

From b6824c54d78b86b2ebf5679a721f0985193cfe56 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 10:57:21 -0400
Subject: [PATCH 79/97] fix: guard dynamic empty BLAS outputs

---
 R/r2f-matrix-blas.R               | 79 +++++++++++++++++++++++++------
 tests/testthat/test-blas-guards.R | 33 +++++++++++++
 2 files changed, 97 insertions(+), 15 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 5e51d88b..85858a8c 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -191,19 +191,38 @@ assert_square_matrix <- function(dims, operand, context, hoist, scope) {
 # ---- BLAS emitters ----
 
 # Generated function results cannot currently represent zero-sized arrays.
-# Reject a statically known zero output before emitting a BLAS call with an
-# invalid leading dimension. A zero contracted dimension remains supported
-# when every output extent is nonzero.
-assert_nonempty_blas_output <- function(dims, context) {
-  stopifnot(is.list(dims), length(dims) > 0L, is_string(context))
-  has_zero_extent <- any(vapply(
-    dims,
-    function(dim) is_wholenumber(dim) && as.integer(dim) == 0L,
-    logical(1)
-  ))
-  if (has_zero_extent) {
-    stop(context, " zero-sized outputs are not supported", call. = FALSE)
+# Reject a known zero output during translation and guard unknown output
+# extents at runtime before emitting a BLAS call with an invalid leading
+# dimension. A zero contracted dimension remains supported when every output
+# extent is nonzero.
+assert_nonempty_blas_output <- function(
+  dim,
+  operand,
+  axis,
+  context,
+  hoist,
+  scope
+) {
+  stopifnot(
+    inherits(operand, Fortran),
+    is.numeric(axis),
+    length(axis) == 1L,
+    is_string(context)
+  )
+  message <- paste0(context, " zero-sized outputs are not supported")
+  if (is_wholenumber(dim)) {
+    if (as.integer(dim) == 0L) {
+      stop(message, call. = FALSE)
+    }
+    return(invisible(TRUE))
   }
+
+  emit_quickr_error_if(
+    glue("{guard_dim_f(dim, operand, axis)} == 0_c_ptrdiff_t"),
+    message,
+    hoist,
+    scope
+  )
   invisible(TRUE)
 }
 
@@ -344,7 +363,22 @@ gemm <- function(
   context = "gemm"
 ) {
   assert_hoist_env(hoist)
-  assert_nonempty_blas_output(list(m, n), context)
+  assert_nonempty_blas_output(
+    m,
+    left,
+    if (opA == "N") 1L else 2L,
+    context,
+    hoist,
+    scope
+  )
+  assert_nonempty_blas_output(
+    n,
+    right,
+    if (opB == "N") 2L else 1L,
+    context,
+    hoist,
+    scope
+  )
   A_name <- ensure_blas_operand_name(left, hoist)
   B_name <- ensure_blas_operand_name(right, hoist)
 
@@ -391,7 +425,15 @@ gemv <- function(
   context = "gemv"
 ) {
   assert_hoist_env(hoist)
-  assert_nonempty_blas_output(out_dims, context)
+  output_dim <- if (transA == "N") m else n
+  assert_nonempty_blas_output(
+    output_dim,
+    A,
+    if (transA == "N") 1L else 2L,
+    context,
+    hoist,
+    scope
+  )
   A_name <- ensure_blas_operand_name(A, hoist)
   x_name <- ensure_blas_operand_name(x, hoist)
 
@@ -495,7 +537,14 @@ syrk <- function(
     k <- x_dims$cols
   }
   lda <- x_dims$rows
-  assert_nonempty_blas_output(list(n, n), context)
+  assert_nonempty_blas_output(
+    n,
+    X,
+    if (trans == "T") 2L else 1L,
+    context,
+    hoist,
+    scope
+  )
   X_name <- ensure_blas_operand_name(X, hoist)
 
   # Output is symmetric n x n matrix
diff --git a/tests/testthat/test-blas-guards.R b/tests/testthat/test-blas-guards.R
index fa8dd7b8..71d77203 100644
--- a/tests/testthat/test-blas-guards.R
+++ b/tests/testthat/test-blas-guards.R
@@ -190,6 +190,39 @@ test_that("matrix BLAS rejects known zero-sized outputs", {
   expect_error(quick(cross_mat), "zero-sized outputs are not supported")
 })
 
+test_that("matrix BLAS guards unknown output extents at runtime", {
+  matrix_matrix <- function(a, b) {
+    declare(type(a = double(NA, 2)), type(b = double(2, 3)))
+    a %*% b
+  }
+  matrix_vector <- function(a, x) {
+    declare(type(a = double(NA, 2)), type(x = double(2)))
+    a %*% x
+  }
+  cross_mat <- function(x) {
+    declare(type(x = double(2, NA)))
+    crossprod(x)
+  }
+  tcross_mat <- function(x) {
+    declare(type(x = double(NA, 2)))
+    tcrossprod(x)
+  }
+
+  q_matrix_matrix <- expect_no_warning(quick(matrix_matrix))
+  q_matrix_vector <- expect_no_warning(quick(matrix_vector))
+  q_cross_mat <- expect_no_warning(quick(cross_mat))
+  q_tcross_mat <- expect_no_warning(quick(tcross_mat))
+  message <- "zero-sized outputs are not supported"
+
+  expect_error(
+    q_matrix_matrix(matrix(double(), 0, 2), matrix(double(), 2, 3)),
+    message
+  )
+  expect_error(q_matrix_vector(matrix(double(), 0, 2), double(2)), message)
+  expect_error(q_cross_mat(matrix(double(), 2, 0)), message)
+  expect_error(q_tcross_mat(matrix(double(), 0, 2)), message)
+})
+
 test_that("NA dims are never treated as equal", {
   fn <- function(a, b) {
     declare(type(a = double(NA, NA)), type(b = double(NA, NA)))

From 375e2314516f51f15ac0112bd6b982c0676b193a Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 11:08:32 -0400
Subject: [PATCH 80/97] test: cover numeric size expression domains

---
 tests/testthat/test-sizes-arithmetic.R | 55 ++++++++++++++++++++++++++
 1 file changed, 55 insertions(+)

diff --git a/tests/testthat/test-sizes-arithmetic.R b/tests/testthat/test-sizes-arithmetic.R
index bd6c588a..1495f335 100644
--- a/tests/testthat/test-sizes-arithmetic.R
+++ b/tests/testthat/test-sizes-arithmetic.R
@@ -43,6 +43,61 @@ test_that("dynamic exponentiation works in declared dims", {
   expect_quick_identical(fn, list(3L), list(4L))
 })
 
+test_that("size division keeps double precision until the final cast", {
+  fn <- function(x, y) {
+    declare(type(x = double(1)), type(y = double(1)))
+    double(as.integer(x / y))
+  }
+
+  code <- r2f(fn)
+  expect_match(
+    as.character(code),
+    "real(x, kind=c_double) / real(y, kind=c_double)",
+    fixed = TRUE
+  )
+  expect_match(as.character(code), "kind=c_ptrdiff_t", fixed = TRUE)
+  expect_match(code@c_bridge, "Rf_asReal(x)", fixed = TRUE)
+  expect_match(code@c_bridge, "Rf_asReal(y)", fixed = TRUE)
+})
+
+test_that("size integer division evaluates numeric operands before casting", {
+  fn <- function(x, y) {
+    declare(type(x = double(1)), type(y = double(1)))
+    double(x %/% y)
+  }
+
+  code <- r2f(fn)
+  expect_match(as.character(code), "floor(", fixed = TRUE)
+  expect_match(as.character(code), "real(x, kind=c_double)", fixed = TRUE)
+  expect_match(as.character(code), "real(y, kind=c_double)", fixed = TRUE)
+  expect_match(code@c_bridge, "floor(", fixed = TRUE)
+  expect_match(code@c_bridge, "Rf_asReal(x)", fixed = TRUE)
+  expect_match(code@c_bridge, "Rf_asReal(y)", fixed = TRUE)
+})
+
+test_that("size modulo uses the divisor's sign", {
+  fn <- function(x, y) {
+    declare(type(x = integer(1)), type(y = integer(1)))
+    double((x %% y) + 1L)
+  }
+
+  code <- r2f(fn)
+  expect_match(as.character(code), "modulo(", fixed = TRUE)
+  expect_match(code@c_bridge, "floor(", fixed = TRUE)
+})
+
+test_that("size powers use the double domain before casting", {
+  fn <- function(x, y) {
+    declare(type(x = integer(1)), type(y = integer(1)))
+    double(as.integer((x^-1L) * y))
+  }
+
+  code <- r2f(fn)
+  expect_match(as.character(code), "real(x, kind=c_double)", fixed = TRUE)
+  expect_match(as.character(code), "kind=c_ptrdiff_t", fixed = TRUE)
+  expect_match(code@c_bridge, "R_pow", fixed = TRUE)
+})
+
 test_that("dim/length/nrow/ncol are supported in allocation sizes", {
   vec <- function(x) {
     declare(type(x = double(NA)))

From 4bf331f49e4f74364124cad4123a6f8ae5c62738 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 11:15:05 -0400
Subject: [PATCH 81/97] Align numeric size expression domains

---
 R/c-wrapper.R                          | 16 +++++++--
 R/manifest.R                           | 49 ++++++++++++++++++++------
 R/r2f-closures.R                       |  2 +-
 R/sizes.R                              | 17 ++++++---
 R/subroutine.R                         |  2 +-
 tests/testthat/_snaps/dims2f.md        |  9 ++---
 tests/testthat/test-sizes-arithmetic.R | 18 ++++++++--
 7 files changed, 87 insertions(+), 26 deletions(-)

diff --git a/R/c-wrapper.R b/R/c-wrapper.R
index df2361f0..3b6ada36 100644
--- a/R/c-wrapper.R
+++ b/R/c-wrapper.R
@@ -163,6 +163,7 @@ make_c_bridge <- function(
 
   c_args <- paste("SEXP", names(formals(closure)), collapse = ", ")
   needs_rmath <- any(grepl("R_pow(", c_body, fixed = TRUE))
+  needs_math <- any(grepl("floor(", c_body, fixed = TRUE))
   c_body <- as_glue(str_flatten_lines(c_body))
 
   c_func_def <- glue("SEXP {fsub@name}_(SEXP _args) {c_block(c_body)}")
@@ -171,6 +172,7 @@ make_c_bridge <- function(
 
   c_headers <- str_flatten_lines(
     "#define R_NO_REMAP",
+    if (needs_math) "#include <math.h>",
     "#include <R.h>",
     "#include <Rinternals.h>",
     if (needs_rmath || isTRUE(force_rmath_header)) "#include <Rmath.h>",
@@ -704,8 +706,10 @@ dims2c_expr <- function(
       `-` = glue("({e1} - {e2})"),
       `*` = glue("({e1} * {e2})"),
       `/` = glue("((double)({e1}) / (double)({e2}))"),
-      `%/%` = glue("((R_xlen_t){e1} / (R_xlen_t){e2})"),
-      `%%` = glue("((R_xlen_t){e1} % (R_xlen_t){e2})"),
+      `%/%` = glue("floor((double)({e1}) / (double)({e2}))"),
+      `%%` = glue(
+        "(({e1}) - ({e2}) * floor((double)({e1}) / (double)({e2})))"
+      ),
       `^` = glue("R_pow((double)({e1}), (double)({e2}))")
     ))
   }
@@ -732,7 +736,13 @@ dims2c <- function(dims, scope, c_hoist = NULL) {
   if (!length(dims) || identical(dims, list(1L))) {
     return(list(NULL, "1"))
   }
-  lapply(dims, dims2c_expr, scope = scope, c_hoist = c_hoist)
+  lapply(
+    dims,
+    dims2c_expr,
+    scope = scope,
+    c_hoist = c_hoist,
+    preserve_numeric = TRUE
+  )
 }
 
 c_dims2c_len <- function(c_dims) {
diff --git a/R/manifest.R b/R/manifest.R
index 4f4d6303..012b5c79 100644
--- a/R/manifest.R
+++ b/R/manifest.R
@@ -503,16 +503,30 @@ dims2f_eval_base_env[["("]] <- baseenv()[["("]]
 dims2f_eval_base_env[["+"]] <- function(e1, e2) glue("({e1} + {e2})")
 dims2f_eval_base_env[["-"]] <- function(e1, e2) glue("({e1} - {e2})")
 dims2f_eval_base_env[["*"]] <- function(e1, e2) glue("({e1} * {e2})")
-dims2f_eval_base_env[["/"]] <- function(e1, e2) glue("real({e1}) / real({e2})")
-# dividing integers truncates towards 0
-dims2f_eval_base_env[["%/%"]] <- function(e1, e2) glue("int({e1}) / int({e2})")
+dims2f_eval_base_env[["/"]] <- function(e1, e2) {
+  glue("real({e1}, kind=c_double) / real({e2}, kind=c_double)")
+}
+dims2f_eval_base_env[["%/%"]] <- function(e1, e2) {
+  quotient <- glue(
+    "(real({e1}, kind=c_double) / real({e2}, kind=c_double))"
+  )
+  glue("floor({quotient}, kind=c_ptrdiff_t)")
+}
 dims2f_eval_base_env[["%%"]] <- function(e1, e2) {
-  glue("mod(int({e1}), int({e2}))")
+  glue(
+    "modulo(real({e1}, kind=c_double), real({e2}, kind=c_double))"
+  )
+}
+dims2f_eval_base_env[["^"]] <- function(e1, e2) {
+  glue(
+    "(real({e1}, kind=c_double))**(real({e2}, kind=c_double))"
+  )
 }
-dims2f_eval_base_env[["^"]] <- function(e1, e2) glue("({e1})**({e2})")
 dims2f_eval_base_env[["abs"]] <- function(x) glue("abs({x})")
 # Fortran INT() truncates toward zero, like as.integer() in R.
-dims2f_eval_base_env[["as.integer"]] <- function(x) glue("int({x})")
+dims2f_eval_base_env[["as.integer"]] <- function(x) {
+  glue("int({x}, kind=c_ptrdiff_t)")
+}
 dims2f_eval_base_env[["quickr_seq_length"]] <- function(from, to, by) {
   safe_by <- glue("merge(int({by}), 1, int({by}) /= 0)")
   glue("(abs((int({to}) - int({from})) / {safe_by}) + 1)")
@@ -558,6 +572,16 @@ dims2f_eval_base_env[["max"]] <- function(...) {
   glue("max({str_flatten_commas(args)})")
 }
 
+dims2f_needs_final_size_cast <- function(e) {
+  if (!is.call(e)) {
+    return(FALSE)
+  }
+  if (as.character(e[[1L]]) %in% c("/", "%/%", "%%", "^", "as.integer")) {
+    return(TRUE)
+  }
+  any(vapply(as.list(e)[-1L], dims2f_needs_final_size_cast, logical(1)))
+}
+
 
 dims2f <- function(dims, scope) {
   syms <- unique(unlist(lapply(dims, \(d) if (is.language(d)) all.vars(d))))
@@ -567,15 +591,16 @@ dims2f <- function(dims, scope) {
   names(vars) <- syms
   eval_env <- list2env(vars, parent = dims2f_eval_base_env)
   dims <- map_chr(dims, function(d) {
+    original <- d
     d <- eval(d, eval_env)
     if (is.symbol(d)) {
-      as.character(d)
+      d <- as.character(d)
     } else if (is_wholenumber(d)) {
-      as.character(d)
+      d <- as.character(d)
     } else if (is_scalar_na(d)) {
-      ":"
+      return(":")
     } else if (is_string(d)) {
-      d
+      d <- d
     } else if (inherits(d, Variable)) {
       # a locally allocated var that is a return var
       if (!d@modified && d@is_arg) {
@@ -583,6 +608,10 @@ dims2f <- function(dims, scope) {
       }
       stop("unexpected axis size value")
     }
+    if (dims2f_needs_final_size_cast(original)) {
+      d <- glue("int(({d}), kind=c_ptrdiff_t)")
+    }
+    d
   })
   if (!length(dims) || identical(dims, "1")) {
     ""
diff --git a/R/r2f-closures.R b/R/r2f-closures.R
index cc193021..31767d41 100644
--- a/R/r2f-closures.R
+++ b/R/r2f-closures.R
@@ -396,7 +396,7 @@ compile_internal_subroutine <- function(
   body_code <- str_flatten_lines(optional_inits, body_prefix, assign_code)
   used_iso_bindings <- iso_c_binding_symbols(
     vars = vars_declared,
-    body_code = body_code,
+    body_code = str_flatten_lines(decls, body_code),
     logical_is_c_int = logical_as_int,
     uses_rng = FALSE
   )
diff --git a/R/sizes.R b/R/sizes.R
index faad79ea..5ed02005 100644
--- a/R/sizes.R
+++ b/R/sizes.R
@@ -166,12 +166,12 @@ unwrap_scalar_size_expr <- function(r) {
   }
 }
 
-r2size <- function(r, scope) {
+r2size <- function(r, scope, preserve_numeric = FALSE) {
   r <- unwrap_scalar_size_expr(r)
 
   sanitize_dim <- function(dim) {
     if (is.symbol(dim) || is.call(dim)) {
-      return(r2size(dim, scope))
+      return(r2size(dim, scope, preserve_numeric = preserve_numeric))
     }
     dim
   }
@@ -193,6 +193,8 @@ r2size <- function(r, scope) {
       double = {
         if (is_wholenumber(r)) {
           as.integer(r)
+        } else if (isTRUE(preserve_numeric)) {
+          r
         } else {
           stop("size must be an integer, found: ", r)
         }
@@ -220,14 +222,19 @@ r2size <- function(r, scope) {
         # symbol, or fail gracefully and return NA.
         # closure-locals with unspecified shape are declared allocatable
         # input and/or output args with unspecified shape signal an error.
-        r2size(var@r, scope)
+        r2size(var@r, scope, preserve_numeric = preserve_numeric)
       },
       language = {
         op <- as.character(r[[1]])
 
         if (op %in% c("+", "-", "/", "*", "^", "%/%", "%%", "abs")) {
           args <- as.list(r)[-1]
-          args <- lapply(args, r2size, scope)
+          args <- lapply(
+            args,
+            r2size,
+            scope,
+            preserve_numeric = preserve_numeric
+          )
           if (anyNA(rapply(args, as.list))) {
             return(NA_integer_)
           }
@@ -258,7 +265,7 @@ r2size <- function(r, scope) {
             # An explicit coercion is exactly what the "not an integer"
             # warning asks for, so don't also warn about the operand.
             inner <- withCallingHandlers(
-              r2size(inner_expr, scope),
+              r2size(inner_expr, scope, preserve_numeric = TRUE),
               warning = function(w) {
                 if (
                   grepl(
diff --git a/R/subroutine.R b/R/subroutine.R
index 33827750..b37f2718 100644
--- a/R/subroutine.R
+++ b/R/subroutine.R
@@ -98,7 +98,7 @@ new_fortran_subroutine <- function(
   uses_rng <- scope_uses_rng(scope)
   used_iso_bindings <- iso_c_binding_symbols(
     vars = scope_vars(scope),
-    body_code = body,
+    body_code = str_flatten_lines(manifest, body_code),
     logical_is_c_int = function(var) var@name %in% fsub_arg_names,
     uses_rng = uses_rng,
     include_errors = uses_errors
diff --git a/tests/testthat/_snaps/dims2f.md b/tests/testthat/_snaps/dims2f.md
index 7881bc1c..e8484cd1 100644
--- a/tests/testthat/_snaps/dims2f.md
+++ b/tests/testthat/_snaps/dims2f.md
@@ -83,7 +83,7 @@
       cat(fsub)
     Output
       subroutine fn(n, out_) bind(c)
-        use iso_c_binding, only: c_double, c_int
+        use iso_c_binding, only: c_double, c_int, c_ptrdiff_t
         implicit none
       
         ! manifest start
@@ -95,7 +95,8 @@
         real(c_double), allocatable :: out(:)
         ! manifest end
       
-        allocate(out((int(n) / int(2) + mod(int(n), int(2)))))
+      allocate(out(int(((floor((real(n, kind=c_double) / real(2, kind=c_double)), kind=c_ptrdiff_t) + modulo(real(n, kind=c_double),&
+      & real(2, kind=c_double)))), kind=c_ptrdiff_t)))
       
       
         out = 0.0_c_double
@@ -149,7 +150,7 @@
       cat(fsub)
     Output
       subroutine fn(n, out_) bind(c)
-        use iso_c_binding, only: c_double, c_int
+        use iso_c_binding, only: c_double, c_int, c_ptrdiff_t
         implicit none
       
         ! manifest start
@@ -161,7 +162,7 @@
         real(c_double), allocatable :: out(:, :)
         ! manifest end
       
-        allocate(out((n + 1), (int(n) / int(2) + 1)))
+        allocate(out((n + 1), int(((floor((real(n, kind=c_double) / real(2, kind=c_double)), kind=c_ptrdiff_t) + 1)), kind=c_ptrdiff_t)))
       
       
         out = 1.0_c_double
diff --git a/tests/testthat/test-sizes-arithmetic.R b/tests/testthat/test-sizes-arithmetic.R
index 1495f335..d22f66ca 100644
--- a/tests/testthat/test-sizes-arithmetic.R
+++ b/tests/testthat/test-sizes-arithmetic.R
@@ -49,7 +49,7 @@ test_that("size division keeps double precision until the final cast", {
     double(as.integer(x / y))
   }
 
-  code <- r2f(fn)
+  code <- suppressWarnings(r2f(fn))
   expect_match(
     as.character(code),
     "real(x, kind=c_double) / real(y, kind=c_double)",
@@ -58,6 +58,8 @@ test_that("size division keeps double precision until the final cast", {
   expect_match(as.character(code), "kind=c_ptrdiff_t", fixed = TRUE)
   expect_match(code@c_bridge, "Rf_asReal(x)", fixed = TRUE)
   expect_match(code@c_bridge, "Rf_asReal(y)", fixed = TRUE)
+
+  expect_quick_identical(fn, list(1.99999999, 1))
 })
 
 test_that("size integer division evaluates numeric operands before casting", {
@@ -66,13 +68,16 @@ test_that("size integer division evaluates numeric operands before casting", {
     double(x %/% y)
   }
 
-  code <- r2f(fn)
+  code <- suppressWarnings(r2f(fn))
   expect_match(as.character(code), "floor(", fixed = TRUE)
   expect_match(as.character(code), "real(x, kind=c_double)", fixed = TRUE)
   expect_match(as.character(code), "real(y, kind=c_double)", fixed = TRUE)
   expect_match(code@c_bridge, "floor(", fixed = TRUE)
   expect_match(code@c_bridge, "Rf_asReal(x)", fixed = TRUE)
   expect_match(code@c_bridge, "Rf_asReal(y)", fixed = TRUE)
+
+  qfn <- suppressWarnings(quick(fn))
+  expect_identical(qfn(3.9, 1.9), fn(3.9, 1.9))
 })
 
 test_that("size modulo uses the divisor's sign", {
@@ -84,6 +89,8 @@ test_that("size modulo uses the divisor's sign", {
   code <- r2f(fn)
   expect_match(as.character(code), "modulo(", fixed = TRUE)
   expect_match(code@c_bridge, "floor(", fixed = TRUE)
+
+  expect_quick_identical(fn, list(-3L, 2L))
 })
 
 test_that("size powers use the double domain before casting", {
@@ -96,6 +103,13 @@ test_that("size powers use the double domain before casting", {
   expect_match(as.character(code), "real(x, kind=c_double)", fixed = TRUE)
   expect_match(as.character(code), "kind=c_ptrdiff_t", fixed = TRUE)
   expect_match(code@c_bridge, "R_pow", fixed = TRUE)
+
+  expect_quick_identical(fn, list(2L, 4L))
+
+  constant <- function() {
+    double(as.integer((2L^-1L) * 4L))
+  }
+  expect_quick_identical(constant, list())
 })
 
 test_that("dim/length/nrow/ncol are supported in allocation sizes", {

From e0597311de075b6683f23562d46834841bf7db1a Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 11:16:11 -0400
Subject: [PATCH 82/97] test: cover shadowed diag size closures

---
 tests/testthat/test-matrix-lapack.R | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

diff --git a/tests/testthat/test-matrix-lapack.R b/tests/testthat/test-matrix-lapack.R
index 2067670d..0036b971 100644
--- a/tests/testthat/test-matrix-lapack.R
+++ b/tests/testthat/test-matrix-lapack.R
@@ -337,6 +337,30 @@ test_that("diag sizes identities from length-one expressions", {
   expect_quick_equal(diag_computed, list())
 })
 
+test_that("diag size folding rejects shadowed local closures", {
+  shadow_c <- function() {
+    c <- function(x) 2L
+    out <- diag(c(3L))
+    out
+  }
+  expect_error(
+    quick(shadow_c),
+    "local closure `c()` cannot determine a result size",
+    fixed = TRUE
+  )
+
+  shadow_abs <- function() {
+    abs <- function(x) 2L
+    out <- diag(abs(-3L))
+    out
+  }
+  expect_error(
+    quick(shadow_abs),
+    "local closure `abs()` cannot determine a result size",
+    fixed = TRUE
+  )
+})
+
 test_that("diag handles missing x with nrow/ncol and 1x1 matrices", {
   diag_nrow <- function(n) {
     declare(type(n = integer(1)))

From f6c9a2fba7b4a5a4ed6940352802a41fad964f05 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 11:17:11 -0400
Subject: [PATCH 83/97] Reject local closures in result sizes

---
 R/sizes.R | 23 ++++++++++++++++++++---
 1 file changed, 20 insertions(+), 3 deletions(-)

diff --git a/R/sizes.R b/R/sizes.R
index 5ed02005..d472d145 100644
--- a/R/sizes.R
+++ b/R/sizes.R
@@ -156,9 +156,26 @@ substitute_declared_sizes <- function(e) {
 }
 
 
-unwrap_scalar_size_expr <- function(r) {
+reject_local_closure_size_call <- function(r, scope) {
+  if (!is.call(r) || !is.symbol(r[[1L]]) || is.null(scope)) {
+    return(invisible(NULL))
+  }
+  name <- as.character(r[[1L]])
+  if (inherits(get0(name, scope), LocalClosure)) {
+    stop(
+      "local closure `",
+      name,
+      "()` cannot determine a result size before the generated function runs",
+      call. = FALSE
+    )
+  }
+  invisible(NULL)
+}
+
+unwrap_scalar_size_expr <- function(r, scope) {
   repeat {
     r <- unwrap_parens(r)
+    reject_local_closure_size_call(r, scope)
     if (!is_call(r, quote(c)) || length(r) != 2L) {
       return(r)
     }
@@ -167,7 +184,7 @@ unwrap_scalar_size_expr <- function(r) {
 }
 
 r2size <- function(r, scope, preserve_numeric = FALSE) {
-  r <- unwrap_scalar_size_expr(r)
+  r <- unwrap_scalar_size_expr(r, scope)
 
   sanitize_dim <- function(dim) {
     if (is.symbol(dim) || is.call(dim)) {
@@ -251,7 +268,7 @@ r2size <- function(r, scope, preserve_numeric = FALSE) {
             if (length(r) != 2L) {
               stop("as.integer() in a size expression expects one argument")
             }
-            inner_expr <- unwrap_scalar_size_expr(r[[2L]])
+            inner_expr <- unwrap_scalar_size_expr(r[[2L]], scope)
             # A scalar literal is coerced here rather than recursed into:
             # r2size() rejects a non-whole double (and a bare logical), which
             # are exactly the cases as.integer() exists to handle.

From 64d29d417e76e5ffeb6bf3af1c2e8e6d78e28473 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 11:26:17 -0400
Subject: [PATCH 84/97] Isolate auto-flang compiler tests

---
 tests/testthat/test-compiler.R | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/tests/testthat/test-compiler.R b/tests/testthat/test-compiler.R
index d4862c0a..e5ca142e 100644
--- a/tests/testthat/test-compiler.R
+++ b/tests/testthat/test-compiler.R
@@ -31,6 +31,17 @@ local_empty_compiler_probe_cache <- function(envir = parent.frame()) {
   invisible(NULL)
 }
 
+local_flang_auto_enabled <- function(envir = parent.frame()) {
+  state <- quickr:::quickr_flang_state
+  old_auto_disabled <- state$auto_disabled
+  withr::defer(
+    state$auto_disabled <- old_auto_disabled,
+    envir = envir
+  )
+  state$auto_disabled <- FALSE
+  invisible(NULL)
+}
+
 test_that("R CMD config probe distinguishes empty values from errors", {
   probe_value <- character()
   local_mocked_bindings(
@@ -537,6 +548,7 @@ test_that("quick retries failed R CMD config probes", {
 
 test_that("quick caches successful flang probes by resolved path", {
   local_empty_compiler_probe_cache()
+  local_flang_auto_enabled()
   withr::local_options(quickr.fortran_compiler = "auto")
 
   flang <- file.path(tempdir(), "flang-one")
@@ -588,6 +600,7 @@ test_that("quick caches successful flang probes by resolved path", {
 
 test_that("quick retries failed flang probes", {
   local_empty_compiler_probe_cache()
+  local_flang_auto_enabled()
   withr::local_options(quickr.fortran_compiler = "auto")
 
   flang <- file.path(tempdir(), "flang")

From 8aafe7cae8519d0906e0e9fe629613f773ba957c Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 11:26:59 -0400
Subject: [PATCH 85/97] test: cover signed size floor division

---
 tests/testthat/test-sizes-arithmetic.R | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/tests/testthat/test-sizes-arithmetic.R b/tests/testthat/test-sizes-arithmetic.R
index d22f66ca..6d83d0e1 100644
--- a/tests/testthat/test-sizes-arithmetic.R
+++ b/tests/testthat/test-sizes-arithmetic.R
@@ -80,6 +80,15 @@ test_that("size integer division evaluates numeric operands before casting", {
   expect_identical(qfn(3.9, 1.9), fn(3.9, 1.9))
 })
 
+test_that("size integer division rounds negative quotients down", {
+  fn <- function(x, y) {
+    declare(type(x = integer(1)), type(y = integer(1)))
+    double((x %/% y) + 3L)
+  }
+
+  expect_quick_identical(fn, list(-3L, 2L))
+})
+
 test_that("size modulo uses the divisor's sign", {
   fn <- function(x, y) {
     declare(type(x = integer(1)), type(y = integer(1)))

From 6e923982a7354fbc092ab84ee7db2c30d027e446 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 11:49:24 -0400
Subject: [PATCH 86/97] Use fmod for C size remainders

---
 R/c-wrapper.R                          |  6 ++++--
 tests/testthat/test-sizes-arithmetic.R | 19 ++++++++++++++++++-
 2 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/R/c-wrapper.R b/R/c-wrapper.R
index 3b6ada36..6a6ea9e2 100644
--- a/R/c-wrapper.R
+++ b/R/c-wrapper.R
@@ -163,7 +163,8 @@ make_c_bridge <- function(
 
   c_args <- paste("SEXP", names(formals(closure)), collapse = ", ")
   needs_rmath <- any(grepl("R_pow(", c_body, fixed = TRUE))
-  needs_math <- any(grepl("floor(", c_body, fixed = TRUE))
+  needs_math <- any(grepl("floor(", c_body, fixed = TRUE)) ||
+    any(grepl("fmod(", c_body, fixed = TRUE))
   c_body <- as_glue(str_flatten_lines(c_body))
 
   c_func_def <- glue("SEXP {fsub@name}_(SEXP _args) {c_block(c_body)}")
@@ -708,7 +709,8 @@ dims2c_expr <- function(
       `/` = glue("((double)({e1}) / (double)({e2}))"),
       `%/%` = glue("floor((double)({e1}) / (double)({e2}))"),
       `%%` = glue(
-        "(({e1}) - ({e2}) * floor((double)({e1}) / (double)({e2})))"
+        "fmod(fmod((double)({e1}), (double)({e2})) + ",
+        "(double)({e2}), (double)({e2}))"
       ),
       `^` = glue("R_pow((double)({e1}), (double)({e2}))")
     ))
diff --git a/tests/testthat/test-sizes-arithmetic.R b/tests/testthat/test-sizes-arithmetic.R
index 6d83d0e1..88e309db 100644
--- a/tests/testthat/test-sizes-arithmetic.R
+++ b/tests/testthat/test-sizes-arithmetic.R
@@ -97,11 +97,28 @@ test_that("size modulo uses the divisor's sign", {
 
   code <- r2f(fn)
   expect_match(as.character(code), "modulo(", fixed = TRUE)
-  expect_match(code@c_bridge, "floor(", fixed = TRUE)
+  expect_match(code@c_bridge, "fmod(fmod(", fixed = TRUE)
 
   expect_quick_identical(fn, list(-3L, 2L))
 })
 
+test_that("size modulo avoids cancellation in the C bridge", {
+  fn <- function(x, y) {
+    declare(type(x = double(1)), type(y = double(1)))
+    out <- double(as.integer((x %% y) * 20) + 10L)
+    for (i in seq_len(length(out))) {
+      out[i] <- as.double(i)
+    }
+    out
+  }
+
+  code <- r2f(fn)
+  expect_match(code@c_bridge, "fmod(fmod(", fixed = TRUE)
+  expect_match(code@c_bridge, "#include <math.h>", fixed = TRUE)
+
+  expect_quick_identical(fn, list(1, 0.1), list(1, -0.1))
+})
+
 test_that("size powers use the double domain before casting", {
   fn <- function(x, y) {
     declare(type(x = integer(1)), type(y = integer(1)))

From 9aca06d85f031c5dbcca05c4d7fe2e6cf564a7ff Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 11:51:08 -0400
Subject: [PATCH 87/97] Keep size floor division in the real domain

---
 R/manifest.R                           |  2 +-
 tests/testthat/test-sizes-arithmetic.R | 42 +++++++++++++++++++++++++-
 2 files changed, 42 insertions(+), 2 deletions(-)

diff --git a/R/manifest.R b/R/manifest.R
index 012b5c79..98a6ffdf 100644
--- a/R/manifest.R
+++ b/R/manifest.R
@@ -510,7 +510,7 @@ dims2f_eval_base_env[["%/%"]] <- function(e1, e2) {
   quotient <- glue(
     "(real({e1}, kind=c_double) / real({e2}, kind=c_double))"
   )
-  glue("floor({quotient}, kind=c_ptrdiff_t)")
+  real_floor_expr(quotient)
 }
 dims2f_eval_base_env[["%%"]] <- function(e1, e2) {
   glue(
diff --git a/tests/testthat/test-sizes-arithmetic.R b/tests/testthat/test-sizes-arithmetic.R
index 88e309db..261a8565 100644
--- a/tests/testthat/test-sizes-arithmetic.R
+++ b/tests/testthat/test-sizes-arithmetic.R
@@ -69,7 +69,7 @@ test_that("size integer division evaluates numeric operands before casting", {
   }
 
   code <- suppressWarnings(r2f(fn))
-  expect_match(as.character(code), "floor(", fixed = TRUE)
+  expect_match(as.character(code), "aint(", fixed = TRUE)
   expect_match(as.character(code), "real(x, kind=c_double)", fixed = TRUE)
   expect_match(as.character(code), "real(y, kind=c_double)", fixed = TRUE)
   expect_match(code@c_bridge, "floor(", fixed = TRUE)
@@ -89,6 +89,46 @@ test_that("size integer division rounds negative quotients down", {
   expect_quick_identical(fn, list(-3L, 2L))
 })
 
+test_that("size floor division remains real before outer arithmetic", {
+  fn <- function(x, y, z) {
+    declare(
+      type(x = double(1)),
+      type(y = double(1)),
+      type(z = double(1))
+    )
+    out <- double(1)
+    local <- double(as.integer((x %/% y) / z) + 10L)
+    out[1] <- as.double(length(local))
+    out
+  }
+
+  code <- r2f(fn)
+  expect_match(as.character(code), "aint(", fixed = TRUE)
+  expect_quick_identical(
+    fn,
+    list(1e20, 3, 1e19),
+    list(-1e20, 3, 1e19)
+  )
+
+  returned <- function(x, y, z) {
+    declare(
+      type(x = double(1)),
+      type(y = double(1)),
+      type(z = double(1))
+    )
+    out <- double(as.integer((x %/% y) / z) + 10L)
+    for (i in seq_len(length(out))) {
+      out[i] <- as.double(i)
+    }
+    out
+  }
+  expect_quick_identical(
+    returned,
+    list(1e20, 3, 1e19),
+    list(-1e20, 3, 1e19)
+  )
+})
+
 test_that("size modulo uses the divisor's sign", {
   fn <- function(x, y) {
     declare(type(x = integer(1)), type(y = integer(1)))

From e1fa87d1e7658319b8dff6634ee2f1c806bc8a7c Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 11:53:01 -0400
Subject: [PATCH 88/97] Preserve integer exponents in size powers

---
 R/manifest.R                           |  4 +---
 tests/testthat/test-sizes-arithmetic.R | 23 +++++++++++++++++++++++
 2 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/R/manifest.R b/R/manifest.R
index 98a6ffdf..c107f7a9 100644
--- a/R/manifest.R
+++ b/R/manifest.R
@@ -518,9 +518,7 @@ dims2f_eval_base_env[["%%"]] <- function(e1, e2) {
   )
 }
 dims2f_eval_base_env[["^"]] <- function(e1, e2) {
-  glue(
-    "(real({e1}, kind=c_double))**(real({e2}, kind=c_double))"
-  )
+  glue("(real({e1}, kind=c_double))**({e2})")
 }
 dims2f_eval_base_env[["abs"]] <- function(x) glue("abs({x})")
 # Fortran INT() truncates toward zero, like as.integer() in R.
diff --git a/tests/testthat/test-sizes-arithmetic.R b/tests/testthat/test-sizes-arithmetic.R
index 261a8565..207189a6 100644
--- a/tests/testthat/test-sizes-arithmetic.R
+++ b/tests/testthat/test-sizes-arithmetic.R
@@ -178,6 +178,29 @@ test_that("size powers use the double domain before casting", {
   expect_quick_identical(constant, list())
 })
 
+test_that("size powers retain integer exponent type", {
+  fn <- function(x, exponent, scale) {
+    declare(
+      type(x = integer(1)),
+      type(exponent = integer(1)),
+      type(scale = integer(1))
+    )
+    out <- double(as.integer((x^exponent) * scale) + 10L)
+    for (i in seq_len(length(out))) {
+      out[i] <- as.double(i)
+    }
+    out
+  }
+
+  code <- r2f(fn)
+  expect_match(as.character(code), "**(exponent)", fixed = TRUE)
+  expect_false(
+    grepl("real(exponent, kind=c_double)", as.character(code), fixed = TRUE)
+  )
+
+  expect_quick_identical(fn, list(-2L, -1L, 4L))
+})
+
 test_that("dim/length/nrow/ncol are supported in allocation sizes", {
   vec <- function(x) {
     declare(type(x = double(NA)))

From ba12e46e1fdd8b4f2323ff11d83447d26cefa910 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 11:55:31 -0400
Subject: [PATCH 89/97] Update size floor division snapshots

---
 tests/testthat/_snaps/dims2f.md | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/tests/testthat/_snaps/dims2f.md b/tests/testthat/_snaps/dims2f.md
index e8484cd1..b6266edd 100644
--- a/tests/testthat/_snaps/dims2f.md
+++ b/tests/testthat/_snaps/dims2f.md
@@ -95,8 +95,9 @@
         real(c_double), allocatable :: out(:)
         ! manifest end
       
-      allocate(out(int(((floor((real(n, kind=c_double) / real(2, kind=c_double)), kind=c_ptrdiff_t) + modulo(real(n, kind=c_double),&
-      & real(2, kind=c_double)))), kind=c_ptrdiff_t)))
+      allocate(out(int((((aint((real(n, kind=c_double) / real(2, kind=c_double))) - merge(1.0_c_double, 0.0_c_double, ((real(n,&
+      & kind=c_double) / real(2, kind=c_double)) < aint((real(n, kind=c_double) / real(2, kind=c_double)))))) + modulo(real(n,&
+      & kind=c_double), real(2, kind=c_double)))), kind=c_ptrdiff_t)))
       
       
         out = 0.0_c_double
@@ -162,7 +163,8 @@
         real(c_double), allocatable :: out(:, :)
         ! manifest end
       
-        allocate(out((n + 1), int(((floor((real(n, kind=c_double) / real(2, kind=c_double)), kind=c_ptrdiff_t) + 1)), kind=c_ptrdiff_t)))
+      allocate(out((n + 1), int((((aint((real(n, kind=c_double) / real(2, kind=c_double))) - merge(1.0_c_double, 0.0_c_double, ((real(n,&
+      & kind=c_double) / real(2, kind=c_double)) < aint((real(n, kind=c_double) / real(2, kind=c_double)))))) + 1)), kind=c_ptrdiff_t)))
       
       
         out = 1.0_c_double

From de017641075ece34c5bb9d7626418de5481c2c69 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 12:16:51 -0400
Subject: [PATCH 90/97] Promote size reducers to one numeric domain

---
 R/manifest.R                           | 15 ++++++++++---
 tests/testthat/test-sizes-arithmetic.R | 30 ++++++++++++++++++++++++++
 2 files changed, 42 insertions(+), 3 deletions(-)

diff --git a/R/manifest.R b/R/manifest.R
index c107f7a9..68f6e1e3 100644
--- a/R/manifest.R
+++ b/R/manifest.R
@@ -562,11 +562,17 @@ dims2f_eval_base_env[["["]] <- function(x, i) {
   }
 }
 dims2f_eval_base_env[["min"]] <- function(...) {
-  args <- list(...)
+  args <- map_chr(
+    list(...),
+    \(arg) glue("real({arg}, kind=c_double)")
+  )
   glue("min({str_flatten_commas(args)})")
 }
 dims2f_eval_base_env[["max"]] <- function(...) {
-  args <- list(...)
+  args <- map_chr(
+    list(...),
+    \(arg) glue("real({arg}, kind=c_double)")
+  )
   glue("max({str_flatten_commas(args)})")
 }
 
@@ -574,7 +580,10 @@ dims2f_needs_final_size_cast <- function(e) {
   if (!is.call(e)) {
     return(FALSE)
   }
-  if (as.character(e[[1L]]) %in% c("/", "%/%", "%%", "^", "as.integer")) {
+  if (
+    as.character(e[[1L]]) %in%
+      c("/", "%/%", "%%", "^", "as.integer", "min", "max")
+  ) {
     return(TRUE)
   }
   any(vapply(as.list(e)[-1L], dims2f_needs_final_size_cast, logical(1)))
diff --git a/tests/testthat/test-sizes-arithmetic.R b/tests/testthat/test-sizes-arithmetic.R
index 207189a6..2dd68615 100644
--- a/tests/testthat/test-sizes-arithmetic.R
+++ b/tests/testthat/test-sizes-arithmetic.R
@@ -129,6 +129,36 @@ test_that("size floor division remains real before outer arithmetic", {
   )
 })
 
+test_that("size min and max use one numeric domain", {
+  min_fn <- function(n, x) {
+    declare(
+      type(n = integer(1)),
+      type(x = double(min(n %/% 2L, 5L, 6L)))
+    )
+    sum(x)
+  }
+  max_fn <- function(n, x) {
+    declare(
+      type(n = integer(1)),
+      type(x = double(max(n %/% 2L, 5L, 6L)))
+    )
+    sum(x)
+  }
+
+  min_code <- as.character(r2f(min_fn))
+  max_code <- as.character(r2f(max_fn))
+  expect_match(min_code, "min(real(", fixed = TRUE)
+  expect_match(max_code, "max(real(", fixed = TRUE)
+  for (code in list(min_code, max_code)) {
+    expect_match(code, "real(5, kind=c_double)", fixed = TRUE)
+    expect_match(code, "real(6, kind=c_double)", fixed = TRUE)
+    expect_match(code, "kind=c_ptrdiff_t", fixed = TRUE)
+  }
+
+  expect_quick_identical(min_fn, list(8L, as.double(1:4)))
+  expect_quick_identical(max_fn, list(8L, as.double(1:6)))
+})
+
 test_that("size modulo uses the divisor's sign", {
   fn <- function(x, y) {
     declare(type(x = integer(1)), type(y = integer(1)))

From a6d0cab84481ce1db28b58ce17c66161b67953cd Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 12:28:17 -0400
Subject: [PATCH 91/97] Update size reducer snapshots

---
 tests/testthat/_snaps/c-bridge-hoist.md | 8 ++++----
 tests/testthat/_snaps/dims2c-length.md  | 8 ++++----
 tests/testthat/_snaps/qr-solve.md       | 8 ++++----
 3 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/tests/testthat/_snaps/c-bridge-hoist.md b/tests/testthat/_snaps/c-bridge-hoist.md
index 73991e89..fd163de2 100644
--- a/tests/testthat/_snaps/c-bridge-hoist.md
+++ b/tests/testthat/_snaps/c-bridge-hoist.md
@@ -22,16 +22,16 @@
       cat(fsub)
     Output
       subroutine fn(n, m, a, b, out) bind(c)
-        use iso_c_binding, only: c_double, c_int
+        use iso_c_binding, only: c_double, c_int, c_ptrdiff_t
         implicit none
       
         ! manifest start
         ! args
         integer(c_int), intent(in) :: n
         integer(c_int), intent(in) :: m
-        real(c_double), intent(in) :: a(min(n, m))
-        real(c_double), intent(in) :: b(min(n, m))
-        real(c_double), intent(out) :: out(min(n, m))
+        real(c_double), intent(in) :: a(int((min(real(n, kind=c_double), real(m, kind=c_double))), kind=c_ptrdiff_t))
+        real(c_double), intent(in) :: b(int((min(real(n, kind=c_double), real(m, kind=c_double))), kind=c_ptrdiff_t))
+        real(c_double), intent(out) :: out(int((min(real(n, kind=c_double), real(m, kind=c_double))), kind=c_ptrdiff_t))
       
         ! locals
         integer(c_int) :: i
diff --git a/tests/testthat/_snaps/dims2c-length.md b/tests/testthat/_snaps/dims2c-length.md
index dacc88d7..3cc8f269 100644
--- a/tests/testthat/_snaps/dims2c-length.md
+++ b/tests/testthat/_snaps/dims2c-length.md
@@ -166,14 +166,14 @@
       cat(fsub)
     Output
       subroutine fn(n, m, out) bind(c)
-        use iso_c_binding, only: c_double, c_int
+        use iso_c_binding, only: c_double, c_int, c_ptrdiff_t
         implicit none
       
         ! manifest start
         ! args
         integer(c_int), intent(in) :: n
         integer(c_int), intent(in) :: m
-        real(c_double), intent(out) :: out(min(n, m))
+        real(c_double), intent(out) :: out(int((min(real(n, kind=c_double), real(m, kind=c_double))), kind=c_ptrdiff_t))
       
         ! locals
         integer(c_int) :: i
@@ -255,14 +255,14 @@
       cat(fsub)
     Output
       subroutine fn(n, m, out) bind(c)
-        use iso_c_binding, only: c_double, c_int
+        use iso_c_binding, only: c_double, c_int, c_ptrdiff_t
         implicit none
       
         ! manifest start
         ! args
         integer(c_int), intent(in) :: n
         integer(c_int), intent(in) :: m
-        real(c_double), intent(out) :: out(max(n, m))
+        real(c_double), intent(out) :: out(int((max(real(n, kind=c_double), real(m, kind=c_double))), kind=c_ptrdiff_t))
       
         ! locals
         integer(c_int) :: i
diff --git a/tests/testthat/_snaps/qr-solve.md b/tests/testthat/_snaps/qr-solve.md
index a2fd1703..3ca7de21 100644
--- a/tests/testthat/_snaps/qr-solve.md
+++ b/tests/testthat/_snaps/qr-solve.md
@@ -19,7 +19,7 @@
       cat(fsub)
     Output
       subroutine fn(a, b, out_, a__dim_1_, a__dim_2_, quickr_err_msg) bind(c)
-        use iso_c_binding, only: c_char, c_double, c_int, c_null_char
+        use iso_c_binding, only: c_char, c_double, c_int, c_null_char, c_ptrdiff_t
         implicit none
       
         ! manifest start
@@ -54,7 +54,7 @@
           allocate(btmp3_(a__dim_2_))
           allocate(btmp4_(a__dim_2_))
           allocate(btmp5_(a__dim_2_, 2))
-          allocate(btmp8_(min(a__dim_1_, a__dim_2_), 1))
+          allocate(btmp8_(int((min(real(a__dim_1_, kind=c_double), real(a__dim_2_, kind=c_double))), kind=c_ptrdiff_t), 1))
           btmp1_ = a
           btmp2_ = 0.0_c_double
           btmp2_(1:a__dim_1_, 1) = b
@@ -181,7 +181,7 @@
       cat(fsub)
     Output
       subroutine fn(a, b, out_, a__dim_1_, a__dim_2_, b__dim_2_, quickr_err_msg) bind(c)
-        use iso_c_binding, only: c_char, c_double, c_int, c_null_char
+        use iso_c_binding, only: c_char, c_double, c_int, c_null_char, c_ptrdiff_t
         implicit none
       
         ! manifest start
@@ -218,7 +218,7 @@
           allocate(btmp3_(a__dim_2_))
           allocate(btmp4_(a__dim_2_))
           allocate(btmp5_(a__dim_2_, 2))
-          allocate(btmp8_(min(a__dim_1_, a__dim_2_), b__dim_2_))
+          allocate(btmp8_(int((min(real(a__dim_1_, kind=c_double), real(a__dim_2_, kind=c_double))), kind=c_ptrdiff_t), b__dim_2_))
           btmp1_ = a
           btmp2_ = 0.0_c_double
           btmp2_(1:a__dim_1_, 1:b__dim_2_) = b

From d375d6b84806121daae788f1156e694aab778669 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 12:43:58 -0400
Subject: [PATCH 92/97] Reject empty outer product outputs

---
 R/r2f-matrix-blas.R               |  3 ++
 tests/testthat/test-blas-guards.R | 46 +++++++++++++++++++++++++++++++
 2 files changed, 49 insertions(+)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 96c02fc6..06a82c4e 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -662,6 +662,9 @@ outer_mul <- function(
   m <- dim_or_one(x, 1L)
   n <- dim_or_one(y, 1L)
 
+  assert_nonempty_blas_output(m, x, 1L, context, hoist, scope)
+  assert_nonempty_blas_output(n, y, 1L, context, hoist, scope)
+
   x_name <- ensure_blas_operand_name(x, hoist)
   y_name <- ensure_blas_operand_name(y, hoist)
 
diff --git a/tests/testthat/test-blas-guards.R b/tests/testthat/test-blas-guards.R
index 71d77203..bd7e633a 100644
--- a/tests/testthat/test-blas-guards.R
+++ b/tests/testthat/test-blas-guards.R
@@ -223,6 +223,52 @@ test_that("matrix BLAS guards unknown output extents at runtime", {
   expect_error(q_tcross_mat(matrix(double(), 0, 2)), message)
 })
 
+test_that("outer products reject known zero-sized outputs", {
+  outer_empty_x <- function(x, y) {
+    declare(type(x = double(0)), type(y = double(2)))
+    outer(x, y)
+  }
+  percent_outer_empty_y <- function(x, y) {
+    declare(type(x = double(2)), type(y = double(0)))
+    x %o% y
+  }
+
+  expect_error(
+    quick(outer_empty_x),
+    "outer zero-sized outputs are not supported",
+    fixed = TRUE
+  )
+  expect_error(
+    quick(percent_outer_empty_y),
+    "%o% zero-sized outputs are not supported",
+    fixed = TRUE
+  )
+})
+
+test_that("outer products guard unknown output extents at runtime", {
+  outer_unknown_x <- function(x, y) {
+    declare(type(x = double(NA)), type(y = double(2)))
+    outer(x, y)
+  }
+  percent_outer_unknown_y <- function(x, y) {
+    declare(type(x = double(2)), type(y = double(NA)))
+    x %o% y
+  }
+
+  q_outer_unknown_x <- expect_no_warning(quick(outer_unknown_x))
+  q_percent_outer_unknown_y <- expect_no_warning(quick(percent_outer_unknown_y))
+  expect_error(
+    q_outer_unknown_x(double(), as.double(1:2)),
+    "outer zero-sized outputs are not supported",
+    fixed = TRUE
+  )
+  expect_error(
+    q_percent_outer_unknown_y(as.double(1:2), double()),
+    "%o% zero-sized outputs are not supported",
+    fixed = TRUE
+  )
+})
+
 test_that("NA dims are never treated as equal", {
   fn <- function(a, b) {
     declare(type(a = double(NA, NA)), type(b = double(NA, NA)))

From b970725a2fe3d262474c3cfe9ae9b4db06801b26 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 12:45:41 -0400
Subject: [PATCH 93/97] Handle size reducer arity explicitly

---
 R/c-wrapper.R                          |  9 ++++++-
 R/manifest.R                           | 18 +++++++++++--
 tests/testthat/test-sizes-arithmetic.R | 36 ++++++++++++++++++++++++++
 3 files changed, 60 insertions(+), 3 deletions(-)

diff --git a/R/c-wrapper.R b/R/c-wrapper.R
index 6a6ea9e2..8d6b6140 100644
--- a/R/c-wrapper.R
+++ b/R/c-wrapper.R
@@ -718,7 +718,11 @@ dims2c_expr <- function(
 
   if (op %in% c("min", "max")) {
     if (!length(args)) {
-      return("0")
+      stop(
+        op,
+        "() size expressions require at least one argument",
+        call. = FALSE
+      )
     }
     rendered <- lapply(
       args,
@@ -727,6 +731,9 @@ dims2c_expr <- function(
       c_hoist = c_hoist,
       preserve_numeric = preserve_numeric
     )
+    if (length(rendered) == 1L) {
+      return(rendered[[1L]])
+    }
     cmp <- if (identical(op, "min")) "<" else ">"
     reduce(rendered, \(a, b) glue("(({a}) {cmp} ({b}) ? ({a}) : ({b}))"))
   } else {
diff --git a/R/manifest.R b/R/manifest.R
index 7b2e3388..cd3d2baf 100644
--- a/R/manifest.R
+++ b/R/manifest.R
@@ -568,17 +568,31 @@ dims2f_eval_base_env[["["]] <- function(x, i) {
 # Fortran min()/max() require operands of one type and kind. Normalize their
 # operands to c_double, then apply the single final extent cast in dims2f().
 dims2f_eval_base_env[["min"]] <- function(...) {
+  args <- list(...)
+  if (!length(args)) {
+    stop("min() size expressions require at least one argument", call. = FALSE)
+  }
   args <- map_chr(
-    list(...),
+    args,
     \(arg) glue("real({arg}, kind=c_double)")
   )
+  if (length(args) == 1L) {
+    return(args[[1L]])
+  }
   glue("min({str_flatten_commas(args)})")
 }
 dims2f_eval_base_env[["max"]] <- function(...) {
+  args <- list(...)
+  if (!length(args)) {
+    stop("max() size expressions require at least one argument", call. = FALSE)
+  }
   args <- map_chr(
-    list(...),
+    args,
     \(arg) glue("real({arg}, kind=c_double)")
   )
+  if (length(args) == 1L) {
+    return(args[[1L]])
+  }
   glue("max({str_flatten_commas(args)})")
 }
 
diff --git a/tests/testthat/test-sizes-arithmetic.R b/tests/testthat/test-sizes-arithmetic.R
index 2dd68615..9a282471 100644
--- a/tests/testthat/test-sizes-arithmetic.R
+++ b/tests/testthat/test-sizes-arithmetic.R
@@ -159,6 +159,42 @@ test_that("size min and max use one numeric domain", {
   expect_quick_identical(max_fn, list(8L, as.double(1:6)))
 })
 
+test_that("one-argument size min and max are identity operations", {
+  min_fn <- function(n, x) {
+    declare(type(n = integer(1)), type(x = double(min(n))))
+    sum(x)
+  }
+  max_fn <- function(n, x) {
+    declare(type(n = integer(1)), type(x = double(max(n))))
+    sum(x)
+  }
+
+  expect_quick_identical(min_fn, list(3L, as.double(1:3)))
+  expect_quick_identical(max_fn, list(4L, as.double(1:4)))
+})
+
+test_that("zero-argument size min and max fail at translation", {
+  min_fn <- function(x) {
+    declare(type(x = double(min())))
+    sum(x)
+  }
+  max_fn <- function(x) {
+    declare(type(x = double(max())))
+    sum(x)
+  }
+
+  expect_error(
+    quick(min_fn),
+    "min() size expressions require at least one argument",
+    fixed = TRUE
+  )
+  expect_error(
+    quick(max_fn),
+    "max() size expressions require at least one argument",
+    fixed = TRUE
+  )
+})
+
 test_that("size modulo uses the divisor's sign", {
   fn <- function(x, y) {
     declare(type(x = integer(1)), type(y = integer(1)))

From 63cda9ac9ee6d05c78b1479338a56fcb26b35193 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 12:50:24 -0400
Subject: [PATCH 94/97] Support empty matrix RHS in QR solves

---
 R/r2f-matrix-blas.R            | 61 ++++++++++++++++++++++--------
 tests/testthat/test-qr-solve.R | 68 ++++++++++++++++++++++++++++++++++
 2 files changed, 114 insertions(+), 15 deletions(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 06a82c4e..73027a2d 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -211,11 +211,9 @@ assert_square_matrix <- function(dims, operand, context, hoist, scope) {
 
 # ---- BLAS emitters ----
 
-# Generated function results cannot currently represent zero-sized arrays.
-# Reject a known zero output during translation and guard unknown output
-# extents at runtime before emitting a BLAS call with an invalid leading
-# dimension. A zero contracted dimension remains supported when every output
-# extent is nonzero.
+# Reject zero output extents where GEMM/GEMV/SYRK/DGER would receive an invalid
+# leading dimension. A zero contracted dimension remains supported when every
+# output extent is nonzero.
 assert_nonempty_blas_output <- function(
   dim,
   operand,
@@ -920,6 +918,25 @@ lapack_solve_qr <- function(
   hoist,
   scope
 ) {
+  design_message <- "qr.solve coefficient matrices with zero extents are not supported"
+  for (axis in 1:2) {
+    dim <- list(m, n)[[axis]]
+    if (is_wholenumber(dim)) {
+      if (as.integer(dim) == 0L) {
+        stop(design_message, call. = FALSE)
+      }
+    } else {
+      emit_quickr_error_if(
+        condition = glue(
+          "size({A_name}, {axis}, kind=c_ptrdiff_t) == 0_c_ptrdiff_t"
+        ),
+        message = design_message,
+        hoist = hoist,
+        scope = scope
+      )
+    }
+  }
+
   A_work <- hoist$declare_tmp(mode = "double", dims = list(m, n))
   hoist$emit(glue("{A_work@name} = {A_name}"))
 
@@ -970,17 +987,31 @@ end do"
     dims = list(mn, nrhs)
   )
   hoist$emit(glue("{coef_work@name} = 0.0_c_double"))
-  info <- hoist$declare_tmp(mode = "integer", dims = NULL)
 
-  hoist$emit(glue(
-    "call dqrcf({A_work@name}, {blas_int(m)}, {rank@name}, {qraux@name}, {B_work@name}, {blas_int(nrhs)}, {coef_work@name}, {info@name})"
-  ))
-  emit_quickr_error_if(
-    condition = glue("{info@name} /= 0_c_int"),
-    message = "exact singularity in 'qr.coef'",
-    hoist = hoist,
-    scope = scope
-  )
+  emit_dqrcf <- function(target, info) {
+    target$emit(glue(
+      "call dqrcf({A_work@name}, {blas_int(m)}, {rank@name}, {qraux@name}, {B_work@name}, {blas_int(nrhs)}, {coef_work@name}, {info@name})"
+    ))
+    emit_quickr_error_if(
+      condition = glue("{info@name} /= 0_c_int"),
+      message = "exact singularity in 'qr.coef'",
+      hoist = target,
+      scope = scope
+    )
+  }
+  if (is_wholenumber(nrhs)) {
+    if (as.integer(nrhs) > 0L) {
+      info <- hoist$declare_tmp(mode = "integer", dims = NULL)
+      emit_dqrcf(hoist, info)
+    }
+  } else {
+    info <- hoist$declare_tmp(mode = "integer", dims = NULL)
+    sub <- new_hoist(scope)
+    emit_dqrcf(sub, info)
+    hoist$emit(glue("if ({blas_int(nrhs)} > 0_c_int) then"))
+    hoist$emit(indent(sub$render(character())))
+    hoist$emit("end if")
+  }
 
   out <- resolve_blas_output(
     dest,
diff --git a/tests/testthat/test-qr-solve.R b/tests/testthat/test-qr-solve.R
index 101d1d22..ace49af0 100644
--- a/tests/testthat/test-qr-solve.R
+++ b/tests/testthat/test-qr-solve.R
@@ -56,3 +56,71 @@ test_that("qr.solve quick matches base R", {
   b_wide <- rnorm(5)
   expect_quick_equal(qr_solve_vec, list(a_wide, b_wide))
 })
+
+test_that("qr.solve supports a known zero-width matrix right-hand side", {
+  fn <- function(a, b) {
+    declare(type(a = double(3, 2)), type(b = double(3, 0)))
+    qr.solve(a, b)
+  }
+  a <- rbind(c(1, 0), c(0, 1), c(1, 1))
+  b <- matrix(double(), 3, 0)
+
+  expect_false(grepl("call dqrcf", as.character(r2f(fn)), fixed = TRUE))
+  expect_quick_equal(fn, list(a, b))
+})
+
+test_that("qr.solve supports a dynamic zero-width matrix right-hand side", {
+  fn <- function(a, b) {
+    declare(type(a = double(3, 2)), type(b = double(3, NA)))
+    qr.solve(a, b)
+  }
+  a <- rbind(c(1, 0), c(0, 1), c(1, 1))
+  b <- matrix(double(), 3, 0)
+
+  expect_quick_equal(fn, list(a, b))
+})
+
+test_that("qr.solve still rejects rank deficiency with a zero-width RHS", {
+  fn <- function(a, b) {
+    declare(type(a = double(3, 2)), type(b = double(3, 0)))
+    qr.solve(a, b)
+  }
+  a <- cbind(as.double(1:3), as.double(1:3))
+  b <- matrix(double(), 3, 0)
+  qfn <- expect_no_warning(quick(fn))
+
+  expect_error(qfn(a, b), "rank deficient matrix in qr.solve", fixed = TRUE)
+})
+
+test_that("qr.solve rejects coefficient matrices with zero extents", {
+  message <- "qr.solve coefficient matrices with zero extents are not supported"
+  known_zero_rows <- function(a, b) {
+    declare(type(a = double(0, 2)), type(b = double(0, 0)))
+    qr.solve(a, b)
+  }
+  known_zero_cols <- function(a, b) {
+    declare(type(a = double(2, 0)), type(b = double(2, 0)))
+    qr.solve(a, b)
+  }
+  dynamic <- function(a, b) {
+    declare(type(a = double(NA, NA)), type(b = double(NA, NA)))
+    qr.solve(a, b)
+  }
+
+  expect_error(quick(known_zero_rows), message, fixed = TRUE)
+  expect_error(quick(known_zero_cols), message, fixed = TRUE)
+
+  code <- r2f(dynamic)
+  expect_match(as.character(code), message, fixed = TRUE)
+  qfn <- expect_no_warning(quick(dynamic))
+  expect_error(
+    qfn(matrix(double(), 0, 2), matrix(double(), 0, 0)),
+    message,
+    fixed = TRUE
+  )
+  expect_error(
+    qfn(matrix(double(), 2, 0), matrix(double(), 2, 0)),
+    message,
+    fixed = TRUE
+  )
+})

From 4fbdfb2244f65d6ba707f84af09c695f8e15f7e4 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 12:52:20 -0400
Subject: [PATCH 95/97] Reject empty right-hand sides in square solves

---
 R/r2f-matrix-blas.R               | 17 +++++++++++++++++
 tests/testthat/test-blas-guards.R | 17 +++++++++++++++++
 2 files changed, 34 insertions(+)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 73027a2d..7399168e 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -862,6 +862,23 @@ lapack_solve_gesv <- function(
   scope
 ) {
   assert_square_matrix(a_dims, A, context, hoist, scope)
+  if (b_rank == 2L) {
+    message <- "no right-hand side in 'b'"
+    if (is_wholenumber(nrhs)) {
+      if (as.integer(nrhs) == 0L) {
+        stop(message, call. = FALSE)
+      }
+    } else {
+      emit_quickr_error_if(
+        condition = glue(
+          "{dimension_guard_expr(nrhs, B, 2L)} == 0_c_ptrdiff_t"
+        ),
+        message = message,
+        hoist = hoist,
+        scope = scope
+      )
+    }
+  }
   A_work <- hoist$declare_tmp(mode = "double", dims = list(m, m))
   hoist$emit(glue("{A_work@name} = {A_name}"))
 
diff --git a/tests/testthat/test-blas-guards.R b/tests/testthat/test-blas-guards.R
index bd7e633a..9ecfd278 100644
--- a/tests/testthat/test-blas-guards.R
+++ b/tests/testthat/test-blas-guards.R
@@ -78,6 +78,23 @@ test_that("solve() guards an unknown RHS length", {
   expect_error(qfn(diag(2), c(1, 2, 3)), "non-conformable arguments in solve")
 })
 
+test_that("solve() rejects a zero-width matrix right-hand side", {
+  known <- function(a, b) {
+    declare(type(a = double(2, 2)), type(b = double(2, 0)))
+    solve(a, b)
+  }
+  dynamic <- function(a, b) {
+    declare(type(a = double(2, 2)), type(b = double(2, NA)))
+    solve(a, b)
+  }
+  a <- diag(2)
+  b <- matrix(double(), 2, 0)
+
+  expect_error(quick(known), "no right-hand side in 'b'", fixed = TRUE)
+  q_dynamic <- expect_no_warning(quick(dynamic))
+  expect_error(q_dynamic(a, b), "no right-hand side in 'b'", fixed = TRUE)
+})
+
 
 test_that("solve(a) and chol() guard squareness", {
   inv <- function(a) {

From a012f9811e59e1edc8e4a39e38ceb932eeb21d21 Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 12:56:26 -0400
Subject: [PATCH 96/97] Prevent triangular solves from overwriting coefficients

---
 R/r2f-matrix-blas.R              |  2 +-
 tests/testthat/test-matrix-mul.R | 14 ++++++++++++++
 2 files changed, 15 insertions(+), 1 deletion(-)

diff --git a/R/r2f-matrix-blas.R b/R/r2f-matrix-blas.R
index 7399168e..8f0c63a9 100644
--- a/R/r2f-matrix-blas.R
+++ b/R/r2f-matrix-blas.R
@@ -733,7 +733,7 @@ triangular_solve <- function(
     input_names = c(A_name, B_input_name),
     expected_dims = B@value@dims,
     context = context,
-    allow_alias = B_input_name,
+    allow_alias = setdiff(B_input_name, A_name),
     mode = B@value@mode %||% "double"
   )
   hoist$emit(glue("{out$name} = {B}"))
diff --git a/tests/testthat/test-matrix-mul.R b/tests/testthat/test-matrix-mul.R
index 33758176..a9b2813f 100644
--- a/tests/testthat/test-matrix-mul.R
+++ b/tests/testthat/test-matrix-mul.R
@@ -693,6 +693,18 @@ test_that("forwardsolve and backsolve match R", {
     backsolve(L, b, upper.tri = FALSE)
   }
 
+  back_alias_coefficient <- function(A) {
+    declare(type(A = double(4, 4)))
+    A <- backsolve(A, A, transpose = TRUE)
+    A
+  }
+
+  forward_alias_coefficient <- function(A) {
+    declare(type(A = double(4, 4)))
+    A <- forwardsolve(A, A, transpose = TRUE)
+    A
+  }
+
   set.seed(11)
   base <- matrix(rnorm(16), nrow = 4)
   L <- base
@@ -712,4 +724,6 @@ test_that("forwardsolve and backsolve match R", {
   expect_quick_equal(forward_upper, list(U = U, b = b_vec))
   expect_quick_equal(forward_transpose, list(L = L, b = b_vec))
   expect_quick_equal(back_lower, list(L = L, b = b_vec))
+  expect_quick_equal(back_alias_coefficient, list(A = U))
+  expect_quick_equal(forward_alias_coefficient, list(A = L))
 })

From e519be6ea34fe2af294c6bf70925321b05971cfb Mon Sep 17 00:00:00 2001
From: Tomasz Kalinowski <kalinowskit@gmail.com>
Date: Sat, 15 Aug 2026 12:56:31 -0400
Subject: [PATCH 97/97] Update QR solve snapshots

---
 tests/testthat/_snaps/qr-solve.md | 26 ++++++++++++++++++++++----
 1 file changed, 22 insertions(+), 4 deletions(-)

diff --git a/tests/testthat/_snaps/qr-solve.md b/tests/testthat/_snaps/qr-solve.md
index 3ca7de21..e6685f9a 100644
--- a/tests/testthat/_snaps/qr-solve.md
+++ b/tests/testthat/_snaps/qr-solve.md
@@ -55,6 +55,14 @@
           allocate(btmp4_(a__dim_2_))
           allocate(btmp5_(a__dim_2_, 2))
           allocate(btmp8_(int((min(real(a__dim_1_, kind=c_double), real(a__dim_2_, kind=c_double))), kind=c_ptrdiff_t), 1))
+          if (size(a, 1, kind=c_ptrdiff_t) == 0_c_ptrdiff_t) then
+            call quickr_set_error_msg("qr.solve coefficient matrices with zero extents are not supported")
+            return
+          end if
+          if (size(a, 2, kind=c_ptrdiff_t) == 0_c_ptrdiff_t) then
+            call quickr_set_error_msg("qr.solve coefficient matrices with zero extents are not supported")
+            return
+          end if
           btmp1_ = a
           btmp2_ = 0.0_c_double
           btmp2_(1:a__dim_1_, 1) = b
@@ -219,6 +227,14 @@
           allocate(btmp4_(a__dim_2_))
           allocate(btmp5_(a__dim_2_, 2))
           allocate(btmp8_(int((min(real(a__dim_1_, kind=c_double), real(a__dim_2_, kind=c_double))), kind=c_ptrdiff_t), b__dim_2_))
+          if (size(a, 1, kind=c_ptrdiff_t) == 0_c_ptrdiff_t) then
+            call quickr_set_error_msg("qr.solve coefficient matrices with zero extents are not supported")
+            return
+          end if
+          if (size(a, 2, kind=c_ptrdiff_t) == 0_c_ptrdiff_t) then
+            call quickr_set_error_msg("qr.solve coefficient matrices with zero extents are not supported")
+            return
+          end if
           btmp1_ = a
           btmp2_ = 0.0_c_double
           btmp2_(1:a__dim_1_, 1:b__dim_2_) = b
@@ -232,10 +248,12 @@
             return
           end if
           btmp8_ = 0.0_c_double
-          call dqrcf(btmp1_, int(a__dim_1_, kind=c_int), btmp6_, btmp3_, btmp2_, int(b__dim_2_, kind=c_int), btmp8_, btmp9_)
-          if (btmp9_ /= 0_c_int) then
-            call quickr_set_error_msg("exact singularity in 'qr.coef'")
-            return
+          if (int(b__dim_2_, kind=c_int) > 0_c_int) then
+            call dqrcf(btmp1_, int(a__dim_1_, kind=c_int), btmp6_, btmp3_, btmp2_, int(b__dim_2_, kind=c_int), btmp8_, btmp9_)
+            if (btmp9_ /= 0_c_int) then
+              call quickr_set_error_msg("exact singularity in 'qr.coef'")
+              return
+            end if
           end if
           out_ = 0.0_c_double
           do btmp11_ = 1_c_int, int(b__dim_2_, kind=c_int)