r/tools/make-callentries.R

# Licensed to the Apache Software Foundation (ASF) under one
# or more contributor license agreements.  See the NOTICE file
# distributed with this work for additional information
# regarding copyright ownership.  The ASF licenses this file
# to you under the Apache License, Version 2.0 (the
# "License"); you may not use this file except in compliance
# with the License.  You may obtain a copy of the License at
#
#   http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing,
# software distributed under the License is distributed on an
# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
# KIND, either express or implied.  See the License for the
# specific language governing permissions and limitations
# under the License.

# This file updates the call entries in src/init.c such that R code
# can use .Call(nanoarrow_c_some_function_name) for all C functions
# with the signature SEXP nanoarrow_c_some_function_name(...).

library(tidyverse)

src_files <- list.files("src", "\\.(c|cpp)$", full.names = TRUE) %>%
  setdiff("src/init.c")
src_sources <- src_files %>% set_names() %>% map_chr(readr::read_file)

defs <- tibble(
  def = src_sources %>%
    str_extract_all(regex("SEXP nanoarrow_c_[^\\)]+\\)", multiline = TRUE)) %>%
    unlist() %>%
    unique() %>%
    str_replace_all("\\s+", " ") %>%
    str_trim(),
  name = def %>% str_extract("nanoarrow_c_[^\\(]+"),
  return_type = "SEXP",
  args = def %>%
    str_remove("SEXP nanoarrow_c_[^\\(]+\\(") %>%
    str_remove("\\)$") %>%
    str_split("\\s*,\\s*") %>%
    map(~{if(identical(.x, "") || identical(.x, "void")) character(0) else .x}),
  n_args = map(args, length)
)

call_headers <- paste0(
  "extern ", defs$def, ";",
  collapse = "\n"
)
call_entries <- paste0(
  '{"', defs$name, '", (DL_FUNC)&', defs$name, ', ', defs$n_args, "},",
  collapse = "\n    "
)

header <- glue::glue('

/* generated by tools/make-callentries.R */
{call_headers}

static const R_CallMethodDef CallEntries[] = {{
    {call_entries}
    {{NULL, NULL, 0}}}};
/* end generated by tools/make-callentries.R */
')

# rewrite relevant portion of init.c
init <- read_file("src/init.c")
pattern <- regex(
  "\n/\\* generated by tools/make-callentries\\.R \\*/.*?/\\* end generated by tools/make-callentries\\.R \\*/",
  multiline = TRUE,
  dotall = TRUE
)

stopifnot(str_detect(init, pattern))
init %>%
  str_replace(pattern, header) %>%
  write_file("src/init.c")