Ensure / always does float division

NEWS.md

@@ -2,6 +2,8 @@
 
 - Internal utility `r2f()` print method now shows the generated `c_bridge` 
   for translated subroutines.
+
+- Added support for `nrow()`, `ncol()` and `dim()` (#21, @mikmart).
 
 - Added support for `while`, `repeat`, `break`, `next`.
 
@@ -12,13 +14,15 @@
 - Fix passing a scalar (rank-0) arg to reduction intrinsics
   (min, max, prod, sum).
 
+- Fixed an issue where `/` might perform integer division if one of the operands
+  is an integer type (#33, #41).
+
 - Fixed an issue with dll symbol registration when
   `quick()` is used in a package (#19).
 
-- Added support for `nrow()`, `ncol()` and `dim()` (#21, @mikmart).
-
 - Fixed segfault encountered on Windows with variable sized arrays.
 
+
 # quickr 0.1.0
 
 * Initial CRAN submission.

R/r2f.R

@@ -386,7 +386,16 @@ r2f_handlers[["["]] <- function(
     if (is_missing(idx)) {
       Fortran(":", Variable("integer", var@value@dims[[i]]))
     } else {
-      r2f(idx, scope, ...)
+      sub <- r2f(idx, scope, ...)
+      if (sub@value@mode == "double") {
+        # Fortran subscripts must be integers; coerce numeric expressions
+        Fortran(
+          glue("int({sub}, kind=c_ptrdiff_t)"),
+          Variable("integer", sub@value@dims)
+        )
+      } else {
+        sub
+      }
     }
   })
 
@@ -632,6 +641,22 @@ r2f_handlers[["Conj"]] <- function(args, scope, ...) {
 
 # ---- elemental binary infix operators ----
 
+maybe_cast_double <- function(x) {
+  if (x@value@mode == "logical") {
+    Fortran(
+      glue("merge(1_c_double, 0_c_double, {x})"),
+      Variable("double", x@value@dims)
+    )
+  } else if (x@value@mode == "integer") {
+    Fortran(
+      glue("real({x}, kind=c_double)"),
+      Variable("double", x@value@dims)
+    )
+  } else {
+    x
+  }
+}
+
 r2f_handlers[["+"]] <- function(args, scope, ...) {
   .[left, right] <- lapply(args, r2f, scope, ...)
   Fortran(glue("({left} + {right})"), conform(left@value, right@value))
@@ -649,9 +674,16 @@ r2f_handlers[["*"]] <- function(args, scope = NULL, ...) {
 
 r2f_handlers[["/"]] <- function(args, scope = NULL, ...) {
   .[left, right] <- lapply(args, r2f, scope, ...)
+  left <- maybe_cast_double(left)
+  right <- maybe_cast_double(right)
   Fortran(glue("({left} / {right})"), conform(left@value, right@value))
 }
 
+r2f_handlers[["as.double"]] <- function(args, scope = NULL, ...) {
+  stopifnot(length(args) == 1L)
+  maybe_cast_double(r2f(args[[1]], scope, ...))
+}
+
 r2f_handlers[["^"]] <- function(args, scope, ...) {
   .[left, right] <- lapply(args, r2f, scope, ...)
   Fortran(glue("({left} ** {right})"), conform(left@value, right@value))

R/subroutine.R

@@ -86,6 +86,11 @@ new_fortran_subroutine <- function(name, closure, parent = emptyenv()) {
       append(used_iso_bindings) <- "c_double"
     }
   }
+  if (!"c_ptrdiff_t" %in% used_iso_bindings) {
+    if (grepl("\\bc_ptrdiff_t\\b", body)) {
+      append(used_iso_bindings) <- "c_ptrdiff_t"
+    }
+  }
   used_iso_bindings <- sort(used_iso_bindings, method = "radix")
 
   subroutine <- glue(