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.

Author: mns-nordicals

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")
   )

R/r2f-conditionals.R

@@ -8,67 +8,34 @@ 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())
   }
   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()
 }
 

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) {

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}"))
 

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 ",