[15/15] Deduplicate handler boilerplate and close the remaining correctness gaps

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

NEWS.md

@@ -6,6 +6,85 @@
 
 * 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
+  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. 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.
+
+- `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
+  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 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.
+
+- `&&` 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
+  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).
+
+- 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
 

R/aaa-utils.R

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

R/c-wrapper.R

@@ -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,20 +649,55 @@ 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}))"))
   }
 
+  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,
+      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})"),
@@ -653,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 {
@@ -837,9 +904,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});")
 }