Accept valid singleton and double-negated subscripts

Author: t-kalinowski

R/r2f-iterables-helpers.R

@@ -381,6 +381,10 @@ check_subscript_range_bounds <- function(info, from, to, by_f, hoist, scope) {
   from_lit <- lit(info$from)
   to_lit <- lit(info$to)
   by_lit <- if (is.null(info$by)) 1L else lit(info$by)
+  same_endpoint <- identical(
+    unwrap_parens(info$from),
+    unwrap_parens(info$to)
+  )
 
   bounds_msg <- "index ranges in x[a:b] must have bounds >= 1"
   if (isTRUE(from_lit < 1L) || isTRUE(to_lit < 1L)) {
@@ -416,15 +420,15 @@ check_subscript_range_bounds <- function(info, from, to, by_f, hoist, scope) {
     emit(paste(checks, collapse = " .or. "), bounds_msg)
   }
 
-  # Explicit seq() step. The result length divides by the step, and that
-  # length is evaluated in the C bridge *before* any Fortran guard can run
-  # (a zero step would be a division-by-zero crash there), so a non-literal
-  # step is a compile error, not a guard. With a literal step and symbolic
-  # bounds, R errors when the step's sign opposes the direction -- the
-  # emitted section would be zero-length while the claimed length is not;
-  # that case is checkable at runtime. All-literal ranges were already
-  # validated by seq_like_length_expr() at compile time.
-  if (!is.null(info$by)) {
+  # Explicit seq() step. When the endpoints differ, the result length divides
+  # by the step, and that length is evaluated in the C bridge *before* any
+  # Fortran guard can run (a zero step would be a division-by-zero crash
+  # there), so a non-literal step is a compile error, not a guard. With a
+  # literal step and symbolic bounds, R errors when the step's sign opposes
+  # the direction -- the emitted section would be zero-length while the
+  # claimed length is not; that case is checkable at runtime. All-literal
+  # ranges were already validated by seq_like_length_expr() at compile time.
+  if (!is.null(info$by) && !same_endpoint) {
     if (is.na(by_lit)) {
       stop(
         "seq() in x[...] requires a literal `by` step ",

R/r2f-subscript.R

@@ -232,9 +232,10 @@ r2f_handlers[["["]] <- function(
 # Reject non-positive subscripts at compile time. R's negative subscript
 # means exclusion, so the result's shape depends on the subscript's value --
 # not representable in quickr's static-shape model -- while the generated
-# Fortran would silently read out of bounds. Unary minus on a subscript is
-# unambiguously exclusion syntax in R, so the form is rejected, not just
-# statically-known values. Binary minus (x[n - 1]) is untouched.
+# Fortran would silently read out of bounds. After cancelling paired unary
+# minuses, unary minus on a subscript is exclusion syntax in R, so the form is
+# rejected, not just statically-known values. Binary minus (x[n - 1]) is
+# untouched.
 #
 # When the base's extent along the subscript's axis is statically known,
 # literal values beyond it are also compile errors: R pads out-of-range
@@ -246,6 +247,23 @@ r2f_handlers[["["]] <- function(
 # check_subscript_range_bounds().
 check_subscript_expr <- function(e, extent = NULL) {
   e <- unwrap_parens(e)
+  while (is_call(e, quote(`-`)) && length(e) == 2L) {
+    inner <- unwrap_parens(e[[2L]])
+    if (
+      is.numeric(inner) &&
+        length(inner) == 1L &&
+        !is.na(inner) &&
+        is.finite(inner) &&
+        inner < 0
+    ) {
+      e <- -inner
+      next
+    }
+    if (!is_call(inner, quote(`-`)) || length(inner) != 2L) {
+      break
+    }
+    e <- unwrap_parens(inner[[2L]])
+  }
   if (!is_wholenumber(extent)) {
     extent <- NULL
   }

tests/testthat/test-subscript-validation.R

@@ -41,6 +41,15 @@ test_that("negative and zero subscripts are rejected at compile time", {
   expect_error(quick(fnm), "negative subscripts|subscripts must be positive")
 })
 
+test_that("double negation remains a positive subscript", {
+  fn <- function(x) {
+    declare(type(x = double(4)))
+    x[-(-1L)]
+  }
+
+  expect_quick_identical(fn, list(as.double(1:4)))
+})
+
 test_that("literal subscripts beyond a known extent are compile errors", {
   # R pads out-of-range reads with NA; quickr refuses at compile time
   fn <- function(x) {
@@ -195,7 +204,7 @@ test_that("literal in-range bounds emit no guard; bad literals error at compile
   expect_error(quick(fbad), "bounds >= 1")
 })
 
-test_that("x[seq(a, b, by)] requires a literal step and guards wrong signs", {
+test_that("non-singleton x[seq(a, b, by)] validates the step", {
   fdesc <- function(x) {
     declare(type(x = double(5)))
     x[seq(5L, 1L, by = -1L)]
@@ -220,6 +229,38 @@ test_that("x[seq(a, b, by)] requires a literal step and guards wrong signs", {
   expect_error(qfs(as.double(1:9), 2L), "wrong sign")
 })
 
+test_that("a singleton seq() subscript accepts a symbolic step", {
+  fn <- function(x, n, k) {
+    declare(
+      type(x = double(5)),
+      type(n = integer(1)),
+      type(k = integer(1))
+    )
+    x[seq(n, n, by = k)]
+  }
+
+  expect_quick_identical(
+    fn,
+    list(as.double(1:5), 3L, 0L),
+    list(as.double(5:1), 3L, -2L)
+  )
+
+  fparen <- function(x, n, k) {
+    declare(
+      type(x = double(5)),
+      type(n = integer(1)),
+      type(k = integer(1))
+    )
+    x[seq(n, (n), by = k)]
+  }
+
+  expect_quick_identical(
+    fparen,
+    list(as.double(1:5), 3L, 0L),
+    list(as.double(5:1), 3L, -2L)
+  )
+})
+
 test_that("seq() value with a symbolic by is sized by the step", {
   fn <- function(k) {
     declare(type(k = integer(1)))