Skip to content

Latest commit

 

History

History
189 lines (153 loc) · 4.42 KB

File metadata and controls

189 lines (153 loc) · 4.42 KB

as.integer(double) truncates toward zero

Code
  fn
Output
  function(x) {
      declare(type(x = double(NA)))
      out <- as.integer(x)
      out
    }
  <environment: 0x0>
Code
  cat(fsub)
Output
  subroutine fn(x, out, x__len_) bind(c)
    use iso_c_binding, only: c_double, c_int, c_ptrdiff_t
    implicit none
  
    ! manifest start
    ! sizes
    integer(c_ptrdiff_t), intent(in), value :: x__len_
  
    ! args
    real(c_double), intent(in) :: x(x__len_)
    integer(c_int), intent(out) :: out(x__len_)
    ! manifest end
  
  
    out = int(x, kind=c_int)
  end subroutine
Code
  cat(cwrapper)
Output
  #define R_NO_REMAP
  #include <R.h>
  #include <Rinternals.h>
  
  
  extern void fn(
    const double* const x__, 
    int* const out__, 
    const R_xlen_t x__len_);
  
  SEXP fn_(SEXP _args) {
    // x
    _args = CDR(_args);
    SEXP x = CAR(_args);
    if (TYPEOF(x) != REALSXP) {
      Rf_error("typeof(x) must be 'double', not '%s'", Rf_type2char(TYPEOF(x)));
    }
    const double* const x__ = REAL(x);
    const R_xlen_t x__len_ = Rf_xlength(x);
    
    const R_xlen_t out__len_ = x__len_;
    SEXP out = PROTECT(Rf_allocVector(INTSXP, out__len_));
    int* out__ = INTEGER(out);
    
    fn(x__, out__, x__len_);
    
    UNPROTECT(1);
    return out;
  }

trunc() returns double and truncates toward zero

Code
  fn
Output
  function(x) {
      declare(type(x = double(NA)))
      out <- trunc(x)
      out
    }
  <environment: 0x0>
Code
  cat(fsub)
Output
  subroutine fn(x, out, x__len_) bind(c)
    use iso_c_binding, only: c_double, c_ptrdiff_t
    implicit none
  
    ! manifest start
    ! sizes
    integer(c_ptrdiff_t), intent(in), value :: x__len_
  
    ! args
    real(c_double), intent(in) :: x(x__len_)
    real(c_double), intent(out) :: out(x__len_)
    ! manifest end
  
  
    out = aint(x)
  end subroutine
Code
  cat(cwrapper)
Output
  #define R_NO_REMAP
  #include <R.h>
  #include <Rinternals.h>
  
  
  extern void fn(
    const double* const x__, 
    double* const out__, 
    const R_xlen_t x__len_);
  
  SEXP fn_(SEXP _args) {
    // x
    _args = CDR(_args);
    SEXP x = CAR(_args);
    if (TYPEOF(x) != REALSXP) {
      Rf_error("typeof(x) must be 'double', not '%s'", Rf_type2char(TYPEOF(x)));
    }
    const double* const x__ = REAL(x);
    const R_xlen_t x__len_ = Rf_xlength(x);
    
    const R_xlen_t out__len_ = x__len_;
    SEXP out = PROTECT(Rf_allocVector(REALSXP, out__len_));
    double* out__ = REAL(out);
    
    fn(x__, out__, x__len_);
    
    UNPROTECT(1);
    return out;
  }

Code
  fn
Output
  function(x) {
      declare(type(x = integer(NA)))
      out <- trunc(x)
      out
    }
  <environment: 0x0>
Code
  cat(fsub)
Output
  subroutine fn(x, out, x__len_) bind(c)
    use iso_c_binding, only: c_double, c_int, c_ptrdiff_t
    implicit none
  
    ! manifest start
    ! sizes
    integer(c_ptrdiff_t), intent(in), value :: x__len_
  
    ! args
    integer(c_int), intent(in) :: x(x__len_)
    real(c_double), intent(out) :: out(x__len_)
    ! manifest end
  
  
    out = real(x, kind=c_double)
  end subroutine
Code
  cat(cwrapper)
Output
  #define R_NO_REMAP
  #include <R.h>
  #include <Rinternals.h>
  
  
  extern void fn(
    const int* const x__, 
    double* const out__, 
    const R_xlen_t x__len_);
  
  SEXP fn_(SEXP _args) {
    // x
    _args = CDR(_args);
    SEXP x = CAR(_args);
    if (TYPEOF(x) != INTSXP) {
      Rf_error("typeof(x) must be 'integer', not '%s'", Rf_type2char(TYPEOF(x)));
    }
    const int* const x__ = INTEGER(x);
    const R_xlen_t x__len_ = Rf_xlength(x);
    
    const R_xlen_t out__len_ = x__len_;
    SEXP out = PROTECT(Rf_allocVector(REALSXP, out__len_));
    double* out__ = REAL(out);
    
    fn(x__, out__, x__len_);
    
    UNPROTECT(1);
    return out;
  }