Merge commit 'b6824c54d78b86b2ebf5679a721f0985193cfe56' into fix/pr146-merge-145-20260815

Author: t-kalinowski

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

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

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) {
@@ -60,9 +64,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
       )
     }
@@ -383,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,

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,17 +161,65 @@ 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)
     val@mode <- "logical"
     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"))
+  }
+)