hoist-mask.md
In quickr: Compiler for R

hoist mask

Code
  fn
Output
  function(x) {
      declare(type(x = double(NA)))
      out <- max(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
    ! manifest end


    out = maxval(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'", R_typeToChar(x));
    }
    const double* const x__ = REAL(x);
    const R_xlen_t x__len_ = Rf_xlength(x);

    const R_xlen_t out__len_ = (1);
    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 = double(NA)))
      out <- max(x[x >= 0])
      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_)
    real(c_double), intent(out) :: out
    ! manifest end


    out = maxval(x, mask = (x >= 0_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__, 
    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'", R_typeToChar(x));
    }
    const double* const x__ = REAL(x);
    const R_xlen_t x__len_ = Rf_xlength(x);

    const R_xlen_t out__len_ = (1);
    SEXP out = PROTECT(Rf_allocVector(REALSXP, out__len_));
    double* out__ = REAL(out);

    fn(x__, out__, x__len_);

    UNPROTECT(1);
    return out;
  }