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.

Author: mns-nordicals

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

R/c-wrapper.R

@@ -590,6 +590,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)

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[["length"]] <- function(x) {
   if (is.symbol(x)) {
     glue("size({as.character(x)})")

R/r2f-matrix-blas.R

@@ -338,7 +338,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 {

R/r2f-matrix-infer.R

@@ -321,8 +321,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)
   }
 

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(

R/r2f-operators-helpers.R

@@ -391,6 +391,28 @@ reshape_vector_for_matrix <- function(vec, rows, cols) {
 # -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 %/%)
+# 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
+}
+
 real_floor_expr <- function(x) {
   aint <- glue("aint({x})")
   glue("({aint} - merge(1.0_c_double, 0.0_c_double, ({x} < {aint})))")

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

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)
 

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