R/build.R

Defines functions build_fort_sub build_signature arg one_manifest_entry

build_fort_sub <- function(l, name) {
  # l is a list of arr objects

  l <- list(...)
  manifest <- vapply(l, one_manifest_entry, "")
  arg_nms <- lapply(l, function(v) v$name)
  arg_nms <- paste0(arg_nms, collapse = ", ")

  decl <- glue("subroutine {name}({arg_nms}) bind(c)")
  body <- "x + y"

}


inline::cfunction


build_signature <- function(...) {
  l <- list(...)


}


if(FALSE) {
  x <- arg(dim = list(), modifiable = FALSE, name = "x")
  y <- arg(dim = list(), modifiable = FALSE, name = "y")

  l <- list(x, y)

}

arg <- function(type = "double",
                dim = list(NULL),
                modifiable = TRUE, # intent
                name = NULL) {
  x <- list(type = type, dim = dim,
            modifiable = modifiable,
            name = name)
  class(x) <- "array_spec"
  x
}


#' @importFrom glue glue
#' @importFrom magrittr %>% %<>%
#' @import purrr
one_manifest_entry <- function(x) {
  stopifnot(inherits(x, "array_spec"))
  intent <- if (is.null(x$modifiable) || is.na(x$modifiable))
    NULL
  else if (isTRUE(x$modifiable))
    "intent(in out)"
  else
    "intent(in)"

  type <- switch(x$type,
                 "double" = "real(c_double)",
                 "int" = ,
                 "integer" = "integer(c_int)",
                 "complex" = "complex(c_double_complex)",
                 "logical" = "logical(c_bool)")

  dimension <- vapply(x$shape, function(d) if(is.null(d)) ":" else as.character(d),
                                              "")
  dimension <- paste(dimension, collapse = ", ")
  dimension <- sprintf("dimension(%s)", dimension)

  type_decl <- paste(type, intent, dimension, sep = ", ")
  paste(type_decl, "::", x$name)
}
t-kalinowski/rfort documentation built on April 9, 2020, 6:17 a.m.