| # 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 is used to generate code in the files |
| # src/arrowExports.cpp and R/arrowExports.R |
| # |
| # This is similar to what compileAttributes() would do, |
| # with some arrow specific changes. |
| # |
| # Functions are decorated with [[arrow::export]] |
| # and the generated code adds a layer of protection so that |
| # the arrow package can be installed even when libarrow is not |
| # |
| # All the C++ code should be guarded by |
| # |
| # #if defined(ARROW_R_WITH_ARROW) |
| # // [[arrow::export]] |
| # std::shared_ptr<arrow::Array> some_function_using_arrow_api(){ |
| # ... |
| # } |
| # #endif |
| |
| suppressPackageStartupMessages({ |
| library(decor) |
| library(dplyr) |
| library(purrr) |
| library(glue) |
| library(vctrs) |
| }) |
| |
| get_exported_functions <- function(decorations, export_tag) { |
| out <- decorations %>% |
| filter(decoration %in% paste0(export_tag, "::export")) %>% |
| mutate(functions = map(context, decor:::parse_cpp_function)) %>% |
| { vec_cbind(., vec_rbind(!!!pull(., functions))) } %>% |
| select(-functions) %>% |
| mutate(decoration = sub("::export", "", decoration)) |
| message(glue("*** > {n} functions decorated with [[{tags}::export]]", n = nrow(out), tags = paste0(export_tag, collapse = "|"))) |
| out |
| } |
| |
| glue_collapse_data <- function(data, ..., sep = ", ", last = "") { |
| res <- glue_collapse(glue_data(data, ...), sep = sep, last = last) |
| if(length(res) == 0) res <- "" |
| res |
| } |
| |
| wrap_call <- function(name, return_type, args) { |
| call <- glue::glue('{name}({list_params})', list_params = glue_collapse_data(args, "{name}")) |
| if(return_type == "void") { |
| glue::glue("\t{call};\n\treturn R_NilValue;", .trim = FALSE) |
| } else { |
| glue::glue("\treturn cpp11::as_sexp({call});") |
| } |
| } |
| |
| all_decorations <- cpp_decorations() |
| arrow_exports <- get_exported_functions(all_decorations, c("arrow", "s3")) |
| |
| arrow_classes <- c( |
| "Table" = "arrow::Table", |
| "RecordBatch" = "arrow::RecordBatch" |
| ) |
| |
| cpp_functions_definitions <- arrow_exports %>% |
| select(name, return_type, args, file, line, decoration) %>% |
| pmap_chr(function(name, return_type, args, file, line, decoration){ |
| glue::glue(' |
| // {basename(file)} |
| #if defined(ARROW_R_WITH_{toupper(decoration)}) |
| {return_type} {name}({real_params}); |
| extern "C" SEXP _arrow_{name}({sexp_params}){{ |
| BEGIN_CPP11 |
| {input_params}{return_line}{wrap_call(name, return_type, args)} |
| END_CPP11 |
| }} |
| #else |
| extern "C" SEXP _arrow_{name}({sexp_params}){{ |
| \tRf_error("Cannot call {name}(). See https://arrow.apache.org/docs/r/articles/install.html for help installing Arrow C++ libraries. "); |
| }} |
| #endif |
| |
| ', |
| sep = "\n", |
| real_params = glue_collapse_data(args, "{type} {name}"), |
| sexp_params = glue_collapse_data(args, "SEXP {name}_sexp"), |
| input_params = glue_collapse_data(args, "\tarrow::r::Input<{type}>::type {name}({name}_sexp);", sep = "\n"), |
| return_line = if(nrow(args)) "\n" else "" |
| ) |
| }) %>% |
| glue_collapse(sep = "\n") |
| |
| cpp_functions_registration <- arrow_exports %>% |
| select(name, return_type, args) %>% |
| pmap_chr(function(name, return_type, args){ |
| glue('\t\t{{ "_arrow_{name}", (DL_FUNC) &_arrow_{name}, {nrow(args)}}}, ') |
| }) %>% |
| glue_collapse(sep = "\n") |
| |
| cpp_classes_finalizers <- map2(names(arrow_classes), arrow_classes, function(name, class) { |
| glue::glue(' |
| # if defined(ARROW_R_WITH_ARROW) |
| extern "C" SEXP _arrow_{name}__Reset(SEXP r6) {{ |
| BEGIN_CPP11 |
| arrow::r::r6_reset_pointer<{class}>(r6); |
| END_CPP11 |
| return R_NilValue; |
| }} |
| # else |
| extern "C" SEXP _arrow_{name}__Reset(SEXP r6) {{ |
| Rf_error("Cannot call _arrow_{name}__Reset(). See https://arrow.apache.org/docs/r/articles/install.html for help installing Arrow C++ libraries. "); |
| }} |
| # endif |
| ') |
| }) %>% |
| glue_collapse(sep = "\n") |
| |
| classes_finalizers_registration <- map2(names(arrow_classes), arrow_classes, function(name, class) { |
| glue('\t\t{{ "_arrow_{name}__Reset", (DL_FUNC) &_arrow_{name}__Reset, 1}}, ') |
| }) %>% |
| glue_collapse(sep = "\n") |
| |
| |
| writeLines(con = "src/arrowExports.cpp", glue::glue(' |
| // Generated by using data-raw/codegen.R -> do not edit by hand |
| #include <cpp11.hpp> |
| #include <cpp11/declarations.hpp> |
| |
| #include "./arrow_types.h" |
| |
| {cpp_functions_definitions} |
| {cpp_classes_finalizers} |
| |
| extern "C" SEXP _arrow_available() {{ |
| return Rf_ScalarLogical( |
| #if defined(ARROW_R_WITH_ARROW) |
| TRUE |
| #else |
| FALSE |
| #endif |
| ); |
| }} |
| |
| extern "C" SEXP _s3_available() {{ |
| return Rf_ScalarLogical( |
| #if defined(ARROW_R_WITH_S3) |
| TRUE |
| #else |
| FALSE |
| #endif |
| ); |
| }} |
| |
| static const R_CallMethodDef CallEntries[] = {{ |
| \t\t{{ "_arrow_available", (DL_FUNC)& _arrow_available, 0 }}, |
| \t\t{{ "_s3_available", (DL_FUNC)& _s3_available, 0 }}, |
| {cpp_functions_registration} |
| {classes_finalizers_registration} |
| \t\t{{NULL, NULL, 0}} |
| }}; |
| |
| extern "C" void R_init_arrow(DllInfo* dll){{ |
| R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); |
| R_useDynamicSymbols(dll, FALSE); |
| }} |
| |
| ') ) |
| |
| message("*** > generated file `src/arrowExports.cpp`") |
| |
| r_functions <- arrow_exports %>% |
| select(name, return_type, args) %>% |
| pmap_chr(function(name, return_type, args) { |
| params <- if (nrow(args)) { |
| paste0(", ", glue_collapse_data(args, "{name}")) |
| } else { |
| "" |
| } |
| call <- if(return_type == "void") { |
| glue::glue('invisible(.Call(`_arrow_{name}` {params}))') |
| } else { |
| glue::glue('.Call(`_arrow_{name}` {params})') |
| } |
| |
| glue::glue(' |
| {name} <- function({list_params}){{ |
| {call} |
| }} |
| |
| ', |
| list_params = glue_collapse_data(args, "{name}"), |
| sep = "\n", |
| ) |
| }) %>% |
| glue_collapse(sep = "\n") |
| |
| writeLines(con = "R/arrowExports.R", glue::glue(' |
| # Generated by using data-raw/codegen.R -> do not edit by hand |
| |
| {r_functions} |
| |
| ')) |
| message("*** > generated file `R/arrowExports.R`") |