Add as to DSL for inline converting among basic types

nCompiler/NAMESPACE

@@ -84,6 +84,8 @@ export(logit)
 export(method)
 export(modelBase_nClass)
 export(nArray)
+export(nAs)
+export(`nAs<-`)
 export(nBacksolve)
 export(nC)
 export(nChol)

nCompiler/R/changeKeywords.R

@@ -1,4 +1,5 @@
-nKeyWords <- list(copy = 'nCopy',
+nKeyWords <- list(as = 'nAs',
+                  copy = 'nCopy',
                   print = 'nPrint',
                   cat = 'nCat',
                   step = 'nStep',

nCompiler/R/compile_aaa_operatorLists.R

@@ -236,6 +236,24 @@ assignOperatorDef(
   )
 )
 
+assignOperatorDef(
+  # Note that nAs<- is supported but does not need
+  # separate assignment op handlers. Hence
+  # we do not have useAssignOp = TRUE.
+  'nAs',
+  list(
+    matchDef = function(object, type) {},
+    compileArgs = c("type"),
+    help = 'as(object, type) (or nAs(object, type)) uses "object" as if it is of type "type", where the type is limited to basic types.',
+    labelAbstractTypes = list(
+      handler = 'As'),
+    eigenImpl = list(
+      handler = 'As'),
+    cppOutput = list(
+      handler = 'As')
+  )
+)
+
 assignOperatorDef(
   c('if', 'while'),
   list(

nCompiler/R/compile_eigenization.R

@@ -445,6 +445,27 @@ inEigenizeEnv(
   }
 )
 
+inEigenizeEnv(
+  As <- function(code, symTab, auxEnv, workEnv, handlingInfo) {
+    caller <- code$caller
+    # labelAbstractTypes does not propagate onLHS through [<-, so we detect
+    # indexed LHS/RHS by looking up at the caller rather than reading onLHS.
+    caller_is_bracket_rhs <- !is.null(caller) && caller$name == "[" &&
+                             isTRUE(code$callerArgID == 1)
+    caller_is_bracket_lhs <- !is.null(caller) && caller$name == "[<-" &&
+                             isTRUE(code$callerArgID == 1)
+
+    # AsMode::STM is needed for indexed RHS so slicing strides are correct.
+    code$aux$useSTM <- caller_is_bracket_rhs
+
+    # labelAbstractTypes sets onLHS for the plain <- case; we handle [<- here.
+    if(caller_is_bracket_lhs)
+      code$aux$onLHS <- TRUE
+
+    invisible(NULL)
+  }
+)
+
 inEigenizeEnv(
   RandomGeneration <- function(code, symTab, auxEnv, workEnv, handlingInfo) {
     # determine arguments that parameterize the dist'n.
@@ -915,8 +936,8 @@ nCompiler:::inEigenizeEnv(
       # Either we're indexing a vector and we keep '[' in the AST, or we're
       # indexing a non-vector object and we use 'index(' instead.
       # TODO: if (code$args[[1]]$type$nDim == 0)
-      if (code$args[[1]]$type$nDim == 1) code$name <- 'index['
-      else if (code$args[[1]]$type$nDim > 1) code$name <- 'index('
+      if (code$args[[1]]$type$nDim == 1 && isTRUE(code$args[[1]]$isName) && !isTRUE(code$args[[1]]$type$isBlockRef)) code$name <- 'index['
+      else code$name <- 'index('
       ## Enforce C++ type long for all indices using static_cast<long>(index_expr)
       ## We see inconsistent C++ compiler behavior around casting a double index
       ## to a long index, so we do it explicitly.

nCompiler/R/compile_exprClass.R

@@ -588,19 +588,21 @@ exprClass_put_args_in_order <- function(def, expr,
   # separate compile-time arguments.
   # This is done AFTER inserting defaults, so that compile-time args can have defaults.
   # The nParse-ing of compileTime args was superfluous, so we throw it out in this step.
-  expr$aux[["compileArgs"]] <- list()
+  # Seed from any already-extracted compileArgs so repeated normalization calls
+  # are safe: if an arg was already removed from expr$args in a prior call, its
+  # value is preserved in aux_compileArgs rather than silently dropped.
   if(length(compileArgs)>0) {
-    aux_compileArgs <- list()
-    iRes <- 1
+    aux_compileArgs <- if(!is.null(expr$aux[["compileArgs"]])) expr$aux[["compileArgs"]] else list()
     for(CA_name in compileArgs) {
       if(CA_name %in% names(expr$args)) {
-        aux_compileArgs[[iRes]] <- expr$args[[CA_name]]$Rexpr
-        names(aux_compileArgs)[iRes] <- CA_name
-        iRes <- iRes + 1
+        aux_compileArgs[[CA_name]] <- expr$args[[CA_name]]$Rexpr
         removeArg(expr, CA_name)
       }
+      # else: already extracted in a prior normalization call — keep existing value
     }
     expr$aux[["compileArgs"]] <- aux_compileArgs
+  } else {
+    if(is.null(expr$aux[["compileArgs"]])) expr$aux[["compileArgs"]] <- list()
   }
   expr
 }

nCompiler/R/compile_generateCpp.R

@@ -174,7 +174,7 @@ inGenCppEnv(
 inGenCppEnv(
   Assign <- function(code, symTab) {
     orig_name <- code$name
-    code$name <- ' = '
+    code$name <- '='
     res <- MidOperator(code, symTab)
     code$name <- orig_name
     res
@@ -602,6 +602,32 @@ inGenCppEnv(
   }
 )
 
+inGenCppEnv(
+  as_op_scalarToCpp <- function(type) {
+    switch(type,
+      double  = 'double',
+      integer = 'int',
+      logical = 'bool',
+      stop(paste0("as_op: unknown scalar type '", type, "'"), call. = FALSE)
+    )
+  }
+)
+
+inGenCppEnv(
+  As <- function(code, symTab) {
+    obj_cpp  <- compile_generateCpp(code$args[[1]], symTab)
+    tgt_type <- code$type$type
+    tgt_nDim <- code$type$nDim
+    use_stm  <- isTRUE(code$aux$useSTM)
+    is_lhs   <- isTRUE(code$aux$onLHS)
+
+    tgt_cpp  <- as_op_scalarToCpp(tgt_type)
+    mode_arg <- if(is_lhs) ', AsMode::LHS' else if(use_stm) ', AsMode::STM' else ''
+    # All proxy types expose operator()() — always append ().
+    paste0('as_nC<', tgt_cpp, ', ', tgt_nDim, mode_arg, '>(', obj_cpp, ')()')
+  }
+)
+
 inGenCppEnv(
   ## StaticCast(A) -> static_cast<code$type>(A)
   StaticCast <- function(code, symTab) {

nCompiler/R/compile_labelAbstractTypes.R

@@ -11,6 +11,8 @@ compile_labelAbstractTypes <- function(code,
   logging <- get_nOption('compilerOptions')[['logging']]
   if (logging) appendToLog(paste('###', nErrorEnv$stateInfo, '###'))
 
+  if(isTRUE(auxEnv$onLHS)) code$aux$onLHS <- TRUE
+
   if(code$isLiteral) {
     if(is.numeric(code$name)) {
       if(is.integer(code$name)) {
@@ -205,6 +207,17 @@ inLabelAbstractTypesEnv(
   }
 )
 
+inLabelAbstractTypesEnv(
+  As <- function(code, symTab, auxEnv, handlingInfo) {
+    inner_type <- nType(expr = code$aux$compileArgs$type, env = auxEnv$where)
+    sym <- type2symbol({{inner_type}}, where = auxEnv$where)
+    sym <- resolveOneTBDsymbol(sym, env = auxEnv$where, project_env = auxEnv$project_env)
+    inserts <- recurse_labelAbstractTypes(code, symTab, auxEnv, handlingInfo)
+    code$type <- sym
+    if(length(inserts) == 0) NULL else inserts
+  }
+)
+
 ## chainedCall
 ## nParse converts something like foo(a)(b) to chainedCall(foo(a), b),
 ##     (although there is no support for a function returning a function.)
@@ -728,9 +741,11 @@ inLabelAbstractTypesEnv(
                      compile_labelAbstractTypes(code, symTab, auxEnv))
       }
       else{
+        auxEnv$onLHS <- TRUE
         inserts <- c(inserts,
                      recurse_labelAbstractTypes(code, symTab, auxEnv,
                                                 handlingInfo, useArgs = c(TRUE, FALSE)))
+        auxEnv$onLHS <- FALSE
         # auxEnv[['.ensureNimbleBlocks']] <- FALSE ## may have been true from RHS of rmnorm etc.
         inserts <- c(inserts,
                      AssignAfterRecursing(code, symTab, auxEnv,

nCompiler/inst/include/nCompiler/ET_Rcpp_ext/ET_Rcpp_ext_post_Rcpp.h

@@ -6,5 +6,6 @@
 #include <nCompiler/ET_Rcpp_ext/post_Rcpp/ET_Rcpp_as_wrap.h>
 #include <nCompiler/ET_Rcpp_ext/post_Rcpp/ET_SEXP_converter.h>
 #include <nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h>
+#include <nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h>
 
 //#endif // EIGEN_RCPP_EXTENSIONS_H_

nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h

@@ -2,10 +2,22 @@
 #define NCOMPILER_ETACCESSOR_POST_RCPP_H_
 
 #include <unsupported/Eigen/CXX11/Tensor>
+#include <type_traits>
+#include <nCompiler/ET_ext/StridedTensorMap.h>
 
 template<typename Scalar>
 class ETaccessorTyped;
 
+enum class AsMode { TM, STM, LHS };
+
+// Forward declarations: proxy classes are defined in nC_as.h (included after
+// this file). ETaccessorTyped::asTyped() returns them; because asTyped() is a
+// template, instantiation is deferred to the call site where they are fully
+// defined.
+template<typename ViewType> class EmptyProxy;
+template<typename TargetScalar, typename ViewType> class RHSCastProxy;
+template<typename TargetScalar, typename ViewType> class CastingProxy;
+
 // Virtual nDim-general methods (e.g. resize, conversions to and from SEXP).
 class ETaccessorBase {
   public:
@@ -17,9 +29,33 @@ class ETaccessorBase {
 
   virtual std::vector<int> &intDims()=0;
 
+  // Virtual element-wise cast/writeback for cross-scalar RuntimeCastingProxy.
+  // Only 3 scalar types are supported so virtual templates are avoided.
+  virtual void castCopyToDouble(double* dest, size_t n) {
+    Rcpp::stop("castCopyToDouble not supported for this ETaccessor type.");
+  }
+  virtual void castCopyToInt(int* dest, size_t n) {
+    Rcpp::stop("castCopyToInt not supported for this ETaccessor type.");
+  }
+  virtual void castCopyToBool(bool* dest, size_t n) {
+    Rcpp::stop("castCopyToBool not supported for this ETaccessor type.");
+  }
+  virtual void writeBackFromDouble(const double* src, size_t n) {
+    Rcpp::stop("writeBackFromDouble not supported for this ETaccessor type.");
+  }
+  virtual void writeBackFromInt(const int* src, size_t n) {
+    Rcpp::stop("writeBackFromInt not supported for this ETaccessor type.");
+  }
+  virtual void writeBackFromBool(const bool* src, size_t n) {
+    Rcpp::stop("writeBackFromBool not supported for this ETaccessor type.");
+  }
+
   template<int nDim, typename Scalar>
   using ETM = Eigen::TensorMap<Eigen::Tensor<Scalar, nDim> >;
 
+  template<int nDim, typename Scalar>
+  using ESTM = Eigen::StridedTensorMap<Eigen::Tensor<Scalar, nDim> >;
+
   template<typename Scalar = double>
   ETaccessorTyped<Scalar> &S() {
     auto castptr = dynamic_cast<ETaccessorTyped<Scalar>* >(this);
@@ -30,6 +66,9 @@ class ETaccessorBase {
   template<int nDim, typename Scalar = double>
   ETM<nDim, Scalar> map();
 
+  template<int nDim, typename Scalar = double>
+  ESTM<nDim, Scalar> STmap();
+
   template<int nDim, typename Scalar = double>
   Eigen::Tensor<Scalar, nDim> &ref();
 
@@ -57,6 +96,66 @@ class ETaccessorTyped : public ETaccessorBase {
     return *data();
   }
 
+  // Cast/writeback implementations (element-wise, supports all 3 scalar types).
+  void castCopyToDouble(double* dest, size_t n) override {
+    Scalar* src = data();
+    for(size_t i = 0; i < n; ++i) dest[i] = static_cast<double>(src[i]);
+  }
+  void castCopyToInt(int* dest, size_t n) override {
+    Scalar* src = data();
+    for(size_t i = 0; i < n; ++i) dest[i] = static_cast<int>(src[i]);
+  }
+  void castCopyToBool(bool* dest, size_t n) override {
+    Scalar* src = data();
+    for(size_t i = 0; i < n; ++i) dest[i] = static_cast<bool>(src[i]);
+  }
+  void writeBackFromDouble(const double* src, size_t n) override {
+    Scalar* dest = data();
+    for(size_t i = 0; i < n; ++i) dest[i] = static_cast<Scalar>(src[i]);
+  }
+  void writeBackFromInt(const int* src, size_t n) override {
+    Scalar* dest = data();
+    for(size_t i = 0; i < n; ++i) dest[i] = static_cast<Scalar>(src[i]);
+  }
+  void writeBackFromBool(const bool* src, size_t n) override {
+    Scalar* dest = data();
+    for(size_t i = 0; i < n; ++i) dest[i] = static_cast<Scalar>(src[i]);
+  }
+
+  template<int output_nDim>
+  using ESTM = Eigen::StridedTensorMap<Eigen::Tensor<Scalar, output_nDim> >;
+
+  // StridedTensorMap variant of mapTyped — same singleton-drop/pad logic.
+  template<int output_nDim>
+  ESTM<output_nDim> STmapTyped() {
+    return Eigen::MakeStridedTensorMap<output_nDim>::make(mapTyped<output_nDim>());
+  }
+
+  // Central dispatch for as() operations. Returns a proxy wrapping the
+  // appropriate view. All proxy types expose operator()() uniformly.
+  template<typename TargetScalar, int nDim, AsMode mode = AsMode::TM>
+  auto asTyped() {
+    if constexpr (std::is_same_v<TargetScalar, Scalar>) {
+      if constexpr (mode == AsMode::TM)
+        return EmptyProxy<ETM<nDim>>(mapTyped<nDim>());
+      else
+        return EmptyProxy<ESTM<nDim>>(STmapTyped<nDim>());
+    } else {
+      if constexpr (mode == AsMode::LHS) {
+        auto view = STmapTyped<nDim>();
+        return CastingProxy<TargetScalar, decltype(view)>(view);
+      } else if constexpr (mode == AsMode::STM) {
+        // Indexed RHS: use STM so that non-contiguous sources (e.g. blockRef)
+        // have correct strides in the lazy cast expression.
+        auto view = STmapTyped<nDim>();
+        return RHSCastProxy<TargetScalar, decltype(view)>(view);
+      } else {
+        auto view = mapTyped<nDim>();
+        return RHSCastProxy<TargetScalar, decltype(view)>(view);
+      }
+    }
+  }
+
   template<int output_nDim>
   ETM<output_nDim> mapTyped() {
     //innate_nDim is the nDim of the object.
@@ -105,6 +204,13 @@ Eigen::TensorMap<Eigen::Tensor<Scalar, nDim> > ETaccessorBase::map() {
   return castptr->template mapTyped<nDim>();
 }
 
+template<int nDim, typename Scalar>
+Eigen::StridedTensorMap<Eigen::Tensor<Scalar, nDim> > ETaccessorBase::STmap() {
+  auto castptr = dynamic_cast<ETaccessorTyped<Scalar>* >(this);
+  if(castptr == nullptr) Rcpp::stop("Problem creating an STmap() from some form of access().\n");
+  return castptr->template STmapTyped<nDim>();
+}
+
 template<typename Scalar>
 Scalar& ETaccessorBase::scalar() {
   auto castptr = dynamic_cast<ETaccessorTyped<Scalar>* >(this);