SEXP nanoarrow_c_as_buffer_default()

in r/src/buffer.c [40:117]


SEXP nanoarrow_c_as_buffer_default(SEXP x_sexp) {
  R_xlen_t len = Rf_xlength(x_sexp);
  const void* data = NULL;
  int64_t size_bytes = 0;
  int32_t element_size_bits = 0;
  enum ArrowType buffer_data_type = NANOARROW_TYPE_UNINITIALIZED;

  // For non-NA character(1), we use the first element
  if (TYPEOF(x_sexp) == STRSXP && len == 1) {
    return nanoarrow_c_as_buffer_default(STRING_ELT(x_sexp, 0));
  }

  switch (TYPEOF(x_sexp)) {
    case NILSXP:
      data = NULL;
      break;
    case RAWSXP:
    case LGLSXP:
    case INTSXP:
    case REALSXP:
    case CPLXSXP:
      data = DATAPTR_RO(x_sexp);
      break;
    case CHARSXP:
      if (x_sexp != NA_STRING) {
        data = CHAR(x_sexp);
        break;
      }
    default:
      Rf_error("Unsupported type");
  }

  switch (TYPEOF(x_sexp)) {
    case NILSXP:
    case RAWSXP:
      buffer_data_type = NANOARROW_TYPE_BINARY;
      size_bytes = len;
      element_size_bits = 8;
      break;
    case LGLSXP:
    case INTSXP:
      buffer_data_type = NANOARROW_TYPE_INT32;
      size_bytes = len * sizeof(int);
      element_size_bits = 8 * sizeof(int);
      break;
    case REALSXP:
      buffer_data_type = NANOARROW_TYPE_DOUBLE;
      size_bytes = len * sizeof(double);
      element_size_bits = 8 * sizeof(double);
      break;
    case CPLXSXP:
      buffer_data_type = NANOARROW_TYPE_DOUBLE;
      size_bytes = len * 2 * sizeof(double);
      element_size_bits = 8 * sizeof(double);
      break;
    case CHARSXP:
      buffer_data_type = NANOARROW_TYPE_STRING;
      size_bytes = Rf_xlength(x_sexp);
      element_size_bits = 8;
      break;
    default:
      break;
  }

  // Don't bother borrowing a zero-size buffer
  SEXP buffer_xptr;
  if (size_bytes == 0) {
    buffer_xptr = PROTECT(buffer_owning_xptr());
  } else {
    buffer_xptr = PROTECT(buffer_borrowed_xptr(data, size_bytes, x_sexp));
  }

  buffer_borrowed_xptr_set_type(buffer_xptr, NANOARROW_BUFFER_TYPE_DATA, buffer_data_type,
                                element_size_bits);

  UNPROTECT(1);
  return buffer_xptr;
}