From 40abb2ce3a3291e433ea52e26d6841c6fd67296a Mon Sep 17 00:00:00 2001 From: perrydv Date: Wed, 3 Jun 2026 11:20:12 -0700 Subject: [PATCH 1/5] support obj[[varname]] and support true scalar types in `as` --- nCompiler/R/Rexecution.R | 1 + nCompiler/R/compile_generateCpp.R | 13 +- nCompiler/R/compile_labelAbstractTypes.R | 22 ++- nCompiler/R/cppDefs_variables.R | 6 + nCompiler/R/symbolTable.R | 54 +++--- .../post_Rcpp/ETaccessor_post_Rcpp.h | 117 +++++------- .../nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h | 120 +++++++++--- .../nCompiler/ET_ext/post_Rcpp/tensorFlex.h | 4 + .../nCompiler/ET_ext/post_Rcpp/tensorUtils.h | 6 + .../specificOp_tests/test-ETaccess-DSL.R | 93 ++++++++++ .../tests/testthat/specificOp_tests/test-as.R | 173 ++++++++++++++++++ 11 files changed, 475 insertions(+), 134 deletions(-) create mode 100644 nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R diff --git a/nCompiler/R/Rexecution.R b/nCompiler/R/Rexecution.R index 8210affa..416963ef 100644 --- a/nCompiler/R/Rexecution.R +++ b/nCompiler/R/Rexecution.R @@ -60,6 +60,7 @@ nAs <- function(object, type) { scalar_type <- storage.mode(object) input_dims <- dim(object) %||% length(object) output_dims <- make_nAs_output_dims(input_dims, output_nDim) + if(!length(output_dims)) output_dims <- 1 value_dims <- dim(value) %||% length(value) if(!all.equal(output_dims, value_dims)) stop("value doesn't conform to type in nAs<- assignment") diff --git a/nCompiler/R/compile_generateCpp.R b/nCompiler/R/compile_generateCpp.R index c3be5873..1f426ff9 100644 --- a/nCompiler/R/compile_generateCpp.R +++ b/nCompiler/R/compile_generateCpp.R @@ -617,18 +617,21 @@ inGenCppEnv( } ) -inGenCppEnv( +nCompiler:::inGenCppEnv( As <- function(code, symTab) { obj_cpp <- compile_generateCpp(code$args[[1]], symTab) - tgt_type <- code$type$type - tgt_nDim <- code$type$nDim + target_sym <- code$type +# 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) + #tgt_cpp <- as_op_scalarToCpp(target_sym$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, ')()') +# paste0('as_nC<', tgt_cpp, ', ', tgt_nDim, mode_arg, '>(', obj_cpp, ')()') + paste0('as_nC<', target_sym$genCppVar()$generate(""), + mode_arg, '>(', obj_cpp, ')()') } ) diff --git a/nCompiler/R/compile_labelAbstractTypes.R b/nCompiler/R/compile_labelAbstractTypes.R index 2b02fc93..0baf05cc 100644 --- a/nCompiler/R/compile_labelAbstractTypes.R +++ b/nCompiler/R/compile_labelAbstractTypes.R @@ -329,7 +329,7 @@ inLabelAbstractTypesEnv( # } # ) -inLabelAbstractTypesEnv( +nCompiler:::inLabelAbstractTypesEnv( DoubleBracket <- function(code, symTab, auxEnv, handlingInfo) { # specializations from generic will have already been handled # e.g obj[[1]] where obj defines its own "[[" operator definition (opDef). @@ -338,6 +338,26 @@ inLabelAbstractTypesEnv( useArgs[1] <- FALSE # already processed inserts <- recurse_labelAbstractTypes(code, symTab, auxEnv, handlingInfo, useArgs = useArgs) + if(inherits(code$args[[1]]$type, "symbolNC")) { + if(isTRUE(code$args[[2]]$isLiteral)) { + # This case is from the end of DollarSign (could be combined) + innerName <- as.character(code$args[[2]]$name) + symbol <- NCinternals(code$args[[1]]$type$NCgenerator)$symbolTable$getSymbol(innerName, inherits=TRUE) + if(is.null(symbol)) + stop(exprClassProcessingErrorMsg( + code, + paste0('member variable ', innerName, ' of ', code$args[[1]]$name, ' could not be found.') + ), call. = FALSE) + code$type <- symbol$clone(deep = TRUE) + code$name <- '->member' + } else { + code$type <- symbolETaccBase$new(name = '') + code$name <- '->method' + insertArg(code, 2, exprClass$new(name = 'access', isName = TRUE, isCall = FALSE, + isLiteral = FALSE, isAssign = FALSE)) + } + return(if(length(inserts) == 0) NULL else inserts) + } # return type of x[[i]] is the element type of x # and return type of `[[<-`(x, i, value) is the type of value, #. which is also the element type of x, so both cases have same return type diff --git a/nCompiler/R/cppDefs_variables.R b/nCompiler/R/cppDefs_variables.R index e17a66be..45f7f698 100644 --- a/nCompiler/R/cppDefs_variables.R +++ b/nCompiler/R/cppDefs_variables.R @@ -195,6 +195,12 @@ cppNcppVec <- function(name = character(), templateArgs = list(elementVar)) } +cppETaccBase <- function(name = character()) { + cppVarFullClass$new(name = name, + baseType = "std::unique_ptr", + templateArgs = list("ETaccessorBase")) +} + cppEigenTensorRef <- function(name = character(), nDim, scalarType) { diff --git a/nCompiler/R/symbolTable.R b/nCompiler/R/symbolTable.R index 1f4fef01..11bd69fa 100644 --- a/nCompiler/R/symbolTable.R +++ b/nCompiler/R/symbolTable.R @@ -442,39 +442,27 @@ symbolNcppVec <- R6::R6Class( ) ) - -## I think this was and old idea -## symbolList <- R6::R6Class( -## classname = "symbolList", -## inherit = symbolBase, -## portable = TRUE, -## public = list( -## size = NULL, -## initialize = function(..., size = NA) { -## super$initialize(...) -## self$type = 'list' -## self$size <- size -## self -## }, -## shortPrint = function() { -## 'List' -## }, -## print = function() { -## if(is.null(self$size)) { -## writeLines( -## paste0(self$name, ': ', self$type, ' size = (uninitialized),') -## ) -## } else { -## writeLines( -## paste0(self$name, ': ', self$type, ' size = ', self$size) -## ) -## } -## }, -## genCppVar = function() { -## return(cppRcppList(name = self$name)) -## } -## ) -## ) +symbolETaccBase <- R6::R6Class( + classname = "symbolETaccBase", + inherit = symbolBase, + portable = TRUE, + public = list( + initialize = function(name, isArg = FALSE) { + self$name <- name + self$type <- "ETaccessorBase" + self$isArg <- isArg + }, + print = function() { + writeLines(paste0(self$name, ': symbolETaccBase (ETaccessorBase) ')) + }, + uniqueID = function(...) { + paste0("ETaccessorBase") + }, + genCppVar = function() { + cppETaccBase(name = self$name) + } + ) +) symbolRcppType<- R6::R6Class( classname = "symbolRcppType", diff --git a/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h b/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h index a069ce00..5eaf77a0 100644 --- a/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h +++ b/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h @@ -4,10 +4,35 @@ #include #include #include +#include +#include template class ETaccessorTyped; +template +void set_output_dims(const inDimsT &inDim, outDimsT &outDim, + size_t output_nDim) { + size_t in_nDim = inDim.size(); + if(output_nDim >= in_nDim) { + for(size_t i = 0; i < in_nDim; ++i) + outDim[i] = inDim[i]; + for(size_t i = in_nDim; i < output_nDim; ++i) + outDim[i] = 1; + } else { + size_t i_out = 0; + for(size_t i_in = 0; i_in < in_nDim; ++i_in) { + if(inDim[i_in] > 1) { + if(i_out >= output_nDim) + Rcpp::stop("Too many non-singleton dimensions for requested morphing to lower dimensional object."); + outDim[i_out++] = inDim[i_in]; + } + } + for(; i_out < output_nDim; ++i_out) + outDim[i_out] = 1; + } +} + enum class AsMode { TM, STM, LHS }; // Forward declarations: proxy classes are defined in nC_as.h (included after @@ -15,6 +40,7 @@ enum class AsMode { TM, STM, LHS }; // template, instantiation is deferred to the call site where they are fully // defined. template class EmptyProxy; +template class EmptyScalarProxy; template class RHSCastProxy; template class CastingProxy; @@ -133,8 +159,11 @@ class ETaccessorTyped : public ETaccessorBase { // Central dispatch for as() operations. Returns a proxy wrapping the // appropriate view. All proxy types expose operator()() uniformly. - template + template, eigenTensor>, int> = 0> auto asTyped() { + typedef typename Eigen::nDimTraits2::Scalar TargetScalar; + constexpr int nDim = Eigen::nDimTraits2::NumDimensions; if constexpr (std::is_same_v) { if constexpr (mode == AsMode::TM) return EmptyProxy>(mapTyped()); @@ -156,6 +185,17 @@ class ETaccessorTyped : public ETaccessorBase { } } + template, trueScalar>, int> = 0> + auto asTyped() { + typedef TargetType TargetScalar; + if constexpr (std::is_same_v) { + return EmptyScalarProxy(scalarTyped()); + } else { + return CastingScalarProxy(scalarTyped()); + } + } + template ETM mapTyped() { //innate_nDim is the nDim of the object. @@ -166,32 +206,10 @@ class ETaccessorTyped : public ETaccessorBase { //but there both the LHS and RHS nDims are known at compile time. //Here only the output_nDim is known at compile time. //Also it looks like in checkAndSetupDims, RHS singletons are always dropped - typedef typename Eigen::internal::traits >::Index Index; + // typedef typename Eigen::internal::traits >::Index Index; typedef typename ETM::Dimensions output_Dimensions; output_Dimensions outDim; - const auto intDims_ = this->intDims(); - size_t innate_nDim = intDims_.size(); - if(output_nDim >= innate_nDim) { - for(size_t i = 0; i < innate_nDim; ++i) - outDim[i] = intDims_[i]; - if(output_nDim > innate_nDim) { - for(size_t i = innate_nDim; i < output_nDim; ++i) - outDim[i] = 1; - } - } else { - size_t i_out = 0; - for(size_t i_innate = 0 ; i_innate < innate_nDim; ++i_innate) { - if(intDims_[i_innate] > 1) { - if(i_out >= output_nDim) { - Rcpp::stop("Problem making a TensorMap from some form of access(): Too many non-singleton dimensions for the requested map dimensions.\n"); - break; - } else { - outDim[i_out++] = intDims_[i_innate]; - } - } - } - for( ; i_out < output_nDim; ++i_out ) outDim[i_out]=1; - } + set_output_dims(this->intDims(), outDim, output_nDim); return ETM(data(), outDim); } ~ETaccessorTyped(){}; @@ -283,14 +301,6 @@ class ETaccessor > : public ETaccessorTyped return wrap(obj); } ET &innerRef() {return obj;} - // Scalar &scalar() { - // Dimensions dim = obj.dimensions(); - // for(int i = 0; i < nDim; ++i) { - // if(dim[i]!=1) - // Rcpp::stop("Invalid call to scalar() for ETaccessor with dimensions not all equal to 1."); - // } - // return *obj.data(); // would leak memory but will never be reached and may reduce compiler warnings - // } ET &obj; std::vector intDims_; }; @@ -308,7 +318,6 @@ class ETaccessorScalar : public ETaccessorTyped { Rcpp::stop("Invalid call to ref() for ETaccessor to scalar."); return *new Eigen::Tensor(); // bad memory mgmt (would leak) but will never be called. only to show compiler valid return. } - //Scalar &scalar() {return obj;} Scalar &obj; std::vector intDims_; }; @@ -320,14 +329,6 @@ class ETaccessor : public ETaccessorScalar { ~ETaccessor() {}; }; -// // CppAD header is not read by here, so this needs attention. -// template<> -// class ETaccessor > : public ETaccessorScalar > { -// public: -// ETaccessor(CppAD::AD &obj_) : ETaccessorScalar(obj_) {}; -// ~ETaccessor() {}; -// }; - template<> class ETaccessor : public ETaccessorScalar { public: @@ -342,26 +343,6 @@ class ETaccessor : public ETaccessorScalar { ~ETaccessor() {}; }; -// template<> -// class ETaccessor : public ETaccessorTyped { -// public: -// using Scalar = double; - -// ETaccessor(Scalar &obj_) : obj(obj_) {}; -// ~ETaccessor() {}; -// Scalar *data() override {return &obj;} -// std::vector &intDims() override {return intDims_;} -// void set(SEXP Sinput) override { obj = as(Sinput);} -// SEXP get() override {return wrap(obj);} -// Eigen::Tensor &ref() { -// Rcpp::stop("Invalid call to ref() for ETaccessor to scalar."); -// return *new Eigen::Tensor(); // bad memory mgmt (would leak) but will never be called. only to show compiler valid return. -// } -// Scalar &scalar() {return obj;} -// Scalar &obj; -// std::vector intDims_; -// }; - template Eigen::Tensor &ETaccessorBase::ref() { auto castptr = dynamic_cast >* >(this); @@ -369,18 +350,6 @@ Eigen::Tensor &ETaccessorBase::ref() { return castptr->innerRef(); } -// template -// Scalar &ETaccessorBase::scalar() { -// auto castptr = dynamic_cast* >(this); -// if(castptr == nullptr) Rcpp::stop("Problem creating a scalar() from some form of access().\n"); -// return castptr->scalar(); -// } - -// template -// auto access(Eigen::Tensor &x) -> ETaccessor >{ -// return ETaccessor >(x); -// } - template auto ETaccess(T &x) -> ETaccessor{ return ETaccessor(x); diff --git a/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h b/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h index 58d7407b..62de4880 100644 --- a/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h +++ b/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h @@ -34,6 +34,30 @@ class EmptyProxy { ViewType& operator()() { return view_; } }; +template +class EmptyScalarProxy { + Scalar& scalar_; +public: + explicit EmptyScalarProxy(Scalar& s) : scalar_(s) {} + EmptyScalarProxy(const EmptyScalarProxy&) = delete; + EmptyScalarProxy& operator=(const EmptyScalarProxy&) = delete; + Scalar& operator()() { return scalar_; } +}; + +template +class CastingScalarProxy { + Scalar& scalar_; + TargetScalar casted_scalar_; +public: + explicit CastingScalarProxy(Scalar& s) : scalar_(s), casted_scalar_(static_cast(s)) {} + CastingScalarProxy(const CastingScalarProxy&) = delete; + CastingScalarProxy& operator=(const CastingScalarProxy&) = delete; + TargetScalar& operator()() { return casted_scalar_; } + ~CastingScalarProxy() { + scalar_ = static_cast(casted_scalar_); + } +}; + // RHSCastProxy // // Cross-scalar RHS proxy. ViewType is TM (AsMode::TM, non-indexed) or STM @@ -104,8 +128,68 @@ class CastingProxy { // as_nC(*acc)()(i) // element read // as_nC(*acc)()(i) = val; // element write // as_nC(*acc)() = rhs; // whole-object write -template + +template class RuntimeCastingProxy { + // TargetType5o here should be a true scalar type, + // because specialization to Eigen::Tensor types is below. + typedef TargetType TargetScalar; + + ETaccessorBase& source_; + bool is_lhs_; + bool copy_made_; + TargetScalar copy_; + TargetScalar* data_ptr_; + + void castCopyFrom() { + if constexpr (std::is_same_v) + source_.castCopyToDouble(©_, 1); + else if constexpr (std::is_same_v) + source_.castCopyToInt(©_, 1); + else if constexpr (std::is_same_v) + source_.castCopyToBool(©_, 1); + else + Rcpp::stop("RuntimeCastingProxy: unsupported TargetScalar type."); + data_ptr_ = ©_; + copy_made_ = true; + } + + void writeBack() { + if constexpr (std::is_same_v) + source_.writeBackFromDouble(©_, 1); + else if constexpr (std::is_same_v) + source_.writeBackFromInt(©_, 1); + else if constexpr (std::is_same_v) + source_.writeBackFromBool(©_, 1); + else + Rcpp::stop("RuntimeCastingProxy: unsupported TargetScalar type."); + } + +public: + explicit RuntimeCastingProxy(ETaccessorBase& acc, bool is_lhs = false) + : source_(acc), is_lhs_(is_lhs), copy_made_(false) + { + auto* typed = dynamic_cast*>(&acc); + if(typed) { + // Same scalar type: view directly, no copy. + data_ptr_ = &acc.scalar(); + } else { + castCopyFrom(); + } + } + + ~RuntimeCastingProxy() { + if(copy_made_ && is_lhs_) writeBack(); + } + + RuntimeCastingProxy(const RuntimeCastingProxy&) = delete; + RuntimeCastingProxy& operator=(const RuntimeCastingProxy&) = delete; + + TargetScalar& operator()() { return *data_ptr_; } +}; + +template +class RuntimeCastingProxy > { using TM = Eigen::TensorMap>; using CopyTensor = Eigen::Tensor; @@ -118,21 +202,7 @@ class RuntimeCastingProxy { // Mirrors mapTyped singleton-drop/pad logic from ETaccessorTyped. Eigen::array computeDims(const std::vector& intDims) { Eigen::array outDim; - int innate_nDim = static_cast(intDims.size()); - if(nDim >= innate_nDim) { - for(int i = 0; i < innate_nDim; ++i) outDim[i] = intDims[i]; - for(int i = innate_nDim; i < nDim; ++i) outDim[i] = 1; - } else { - int i_out = 0; - for(int i_in = 0; i_in < innate_nDim; ++i_in) { - if(intDims[i_in] > 1) { - if(i_out >= nDim) - Rcpp::stop("RuntimeCastingProxy: too many non-singleton dimensions for requested nDim."); - outDim[i_out++] = intDims[i_in]; - } - } - for(; i_out < nDim; ++i_out) outDim[i_out] = 1; - } + set_output_dims(intDims, outDim, nDim); return outDim; } @@ -203,16 +273,24 @@ class RuntimeCastingProxy { // Compile-time source: delegates to ETaccessorTyped::asTyped<>(). // Returns EmptyProxy, EmptyProxy, RHSCastProxy, or CastingProxy. -template +template auto as_nC(T& x) { - return ETaccess(x).template asTyped(); + return ETaccess(x).template asTyped(); } // Runtime source: scalar type of acc is unknown at compile time. // Returns RuntimeCastingProxy. Write-back occurs on destruction iff mode == LHS. -template -RuntimeCastingProxy as_nC(ETaccessorBase& acc) { - return RuntimeCastingProxy(acc, mode == AsMode::LHS); +template +RuntimeCastingProxy as_nC(ETaccessorBase& acc) { + return RuntimeCastingProxy(acc, mode == AsMode::LHS); +} + +// genericInterfaceBaseC::access() returns a unique_ptr, +// so this overload allows direct passing of the unique_ptr, for simpler usage and code-generation. +// This takes its argument by value, so that it can be an rvalue (returned from another call at the call site). +template +RuntimeCastingProxy as_nC(std::unique_ptr acc) { + return RuntimeCastingProxy(*acc, mode == AsMode::LHS); } #endif // NCOMPILER_NC_AS_H_ diff --git a/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorFlex.h b/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorFlex.h index 66c1ec44..37da58af 100644 --- a/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorFlex.h +++ b/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorFlex.h @@ -57,6 +57,10 @@ struct eigenTensor {}; typedef trueScalar type; }; +// This was added much later than initial development of this file, +// so it is has not been propagated into use. +template +using type_category_t = typename type_category::type; // checkDimsAllOne returns true if all dimensions are 1s, false otherwise template diff --git a/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorUtils.h b/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorUtils.h index 6950703e..c848c740 100644 --- a/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorUtils.h +++ b/nCompiler/inst/include/nCompiler/ET_ext/post_Rcpp/tensorUtils.h @@ -45,6 +45,8 @@ namespace Eigen { typedef nDimTraitsInternal2 Internal; typedef typename nDimTraitsInternal2::Dimensions Dimensions; static const std::size_t NumDimensions = internal::traits::NumDimensions; + typedef typename Eigen::internal::traits::Scalar Scalar; + EIGEN_DEVICE_FUNC nDimTraits2(const XprType& xpr) : m_Internal(xpr, Eigen::DefaultDevice()) @@ -67,18 +69,22 @@ namespace Eigen { template<> struct nDimTraits2 { static const std::size_t NumDimensions = 0; + typedef double Scalar; }; template<> struct nDimTraits2 { static const std::size_t NumDimensions = 0; + typedef long Scalar; }; template<> struct nDimTraits2 { static const std::size_t NumDimensions = 0; + typedef int Scalar; }; template<> struct nDimTraits2 { static const std::size_t NumDimensions = 0; + typedef bool Scalar; }; // This is used in one place, generated code for Rep. diff --git a/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R b/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R new file mode 100644 index 00000000..71011ef3 --- /dev/null +++ b/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R @@ -0,0 +1,93 @@ +library(nCompiler) +library(testthat) + +test_that("obj[['x']] works like obj$x", { + nc <- nClass( + Cpublic = list( + x = 'numericVector' + ) + ) + nf <- nFunction( + function(obj = 'nc') { + v <- obj[["x"]] + return(v) + returnType('numericVector') + } + ) + for(mode in c("R","non-pkg", "pkg")) { + if(mode == "R") { + obj <- nc$new() + foo <- nf + } else { + package <- mode=="pkg" + comp <- nCompile(nc, nf, package = package) + obj <- comp$nc$new() + foo <- comp$nf + } + obj$x <- c(1.2, 2.3) + expect_equal(foo(obj), obj$x) + rm(obj); gc() + } +}) + + +test_that("obj[[var_name]] works", { + nc <- nClass( + Cpublic = list( + x = 'numericVector' + ) + ) + nf <- nFunction( + function(obj = 'nc', var_name = 'string') { + ETacc <- obj[[var_name]] + v <- as(ETacc, 'numericVector') + return(v) + returnType('numericVector') + } + ) + for(mode in c("R","non-pkg", "pkg")) { + if(mode == "R") { + obj <- nc$new() + foo <- nf + } else { + package <- mode=="pkg" + comp <- nCompile(nc, nf, package = package) + obj <- comp$nc$new() + foo <- comp$nf + } + obj$x <- c(1.2, 2.3) + foo(obj, "x") + expect_equal(foo(obj, "x"), obj$x) + rm(obj); gc() + } +}) + +test_that("as(obj[[var_name]], type) works", { + nc <- nClass( + Cpublic = list( + x = 'numericVector' + ) + ) + nf <- nFunction( + function(obj = 'nc', var_name = 'string') { + v <- as(obj[[var_name]], 'numericVector') + return(v) + returnType('numericVector') + } + ) + for(mode in c("R","non-pkg", "pkg")) { + if(mode == "R") { + obj <- nc$new() + foo <- nf + } else { + package <- mode=="pkg" + comp <- nCompile(nc, nf, package = package) + obj <- comp$nc$new() + foo <- comp$nf + } + obj$x <- c(1.2, 2.3) + foo(obj, "x") + expect_equal(foo(obj, "x"), obj$x) + rm(obj); gc() + } +}) diff --git a/nCompiler/tests/testthat/specificOp_tests/test-as.R b/nCompiler/tests/testthat/specificOp_tests/test-as.R index abff91de..86953496 100644 --- a/nCompiler/tests/testthat/specificOp_tests/test-as.R +++ b/nCompiler/tests/testthat/specificOp_tests/test-as.R @@ -37,6 +37,7 @@ test_that("as(): same scalar 2Dā†’1D singleton-drop, RHS", { ) ) ) + package <- FALSE for(mode in c("R", "non_pkg", "pkg")) { if(mode == "R") { nco <- nc$new() @@ -624,6 +625,178 @@ test_that("as(): LHS range assignment cross-scalar (double source, integer view) } }) +# Inputs are true scalars, target type is non-scalar +# same scalar element type +test_that("as(): true scalar input (same element type)", { + foo <- nFunction( + function(x = 'numericScalar', scalar_res = numericVector()) { + v <- as(x, 'numericMatrix') + y <- x + w <- v + as(y, "numericMatrix") <- 3*w + scalar_res[1] <- y + return(v) + returnType(double(2)) + }, + refArgs = "scalar_res" + ) + cfoo <- nCompile(foo) + scalar_res <- 0 + ans <- foo(2, scalar_res) + cscalar_res <- -1 + cans <- cfoo(2, cscalar_res) + expect_identical(ans, cans) + expect_identical(dim(cans), c(1L,1L)) + expect_equal(cans[1,1], 2) + + expect_identical(scalar_res, cscalar_res) + expect_identical(cscalar_res, 6) + rm(ans, cans); gc() +}) + +# cross scalar element type +test_that("as(): true scalar input (different element type)", { + foo <- nFunction( + function(x = 'numericScalar', scalar_res = numericVector()) { + v <- as(x, 'integerMatrix') + y <- x + w <- v + as(y, "integerMatrix") <- 3*w + scalar_res[1] <- y + return(v) + returnType(integer(2)) + }, + refArgs = "scalar_res" + ) + cfoo <- nCompile(foo) + scalar_res <- 0 + ans <- foo(2, scalar_res) + cscalar_res <- -1 + cans <- cfoo(2, cscalar_res) + expect_identical(ans, cans) + expect_identical(dim(cans), c(1L,1L)) + expect_identical(cans[1,1], 2L) + + expect_identical(scalar_res, cscalar_res) + expect_identical(cscalar_res, 6) + rm(ans, cans); gc() +}) + + +# Inputs are NOT true scalars, target type is true scalar +# same type +test_that("as(): true scalar target type (same element type)", { + foo <- nFunction( + function(x = 'numericMatrix', scalar_res = numericVector()) { + v <- as(x, 'numericScalar') + y <- x + w <- v + as(y, "numericScalar") <- 3*w + scalar_res[1] <- y[1,1] + return(v) + returnType(double()) + }, + refArgs = "scalar_res" + ) + cfoo <- nCompile(foo) + x <- matrix(2, nrow = 1, ncol = 1) + scalar_res <- 0 + ans <- foo(x, scalar_res) + cscalar_res <- -1 + cans <- cfoo(x, cscalar_res) + expect_identical(ans, cans) + expect_true(is.null(dim(cans))) + expect_equal(cans, 2) + expect_identical(scalar_res, cscalar_res) + expect_identical(cscalar_res, 6) + rm(ans, cans); gc() +}) + +# cross type +test_that("as(): true scalar target type (same element type)", { + foo <- nFunction( + function(x = 'integerMatrix', scalar_res = numericVector()) { + v <- as(x, 'numericScalar') + y <- x + w <- v + as(y, "numericScalar") <- 3*w + scalar_res[1] <- y[1,1] + return(v) + returnType(double()) + }, + refArgs = "scalar_res" + ) + cfoo <- nCompile(foo) + x <- matrix(2, nrow = 1, ncol = 1) + scalar_res <- 0 + ans <- foo(x, scalar_res) + cscalar_res <- -1 + cans <- cfoo(x, cscalar_res) + expect_identical(ans, cans) + expect_true(is.null(dim(cans))) + expect_equal(cans, 2) + expect_identical(scalar_res, cscalar_res) + expect_identical(cscalar_res, 6) + rm(ans, cans); gc() +}) + +# Inputs are true scalars and output is also a true scalar +# same type +test_that("as(): true scalar input and target type (same element type)", { + foo <- nFunction( + function(x = 'numericScalar', scalar_res = numericVector()) { + v <- as(x, 'numericScalar') + y <- x + w <- v + as(y, "numericScalar") <- 3*w + scalar_res[1] <- y + return(v) + returnType(double()) + }, + refArgs = "scalar_res" + ) + cfoo <- nCompile(foo) + x <- 2.3 + scalar_res <- 1 + ans <- foo(x, scalar_res) + cscalar_res <- 0 + cans <- cfoo(x, cscalar_res) + expect_identical(ans, cans) + expect_true(is.null(dim(cans))) + expect_equal(cans, 2.3) + expect_identical(scalar_res, cscalar_res) + expect_identical(cscalar_res, 3*2.3) + rm(ans, cans); gc() +}) + +# cross type +test_that("as(): true scalar input and target type (different element type)", { + foo <- nFunction( + function(x = 'numericScalar', scalar_res = numericVector()) { + v <- as(x, 'integerScalar') + y <- x + w <- v + as(y, "integerScalar") <- 3*w + scalar_res[1] <- y + return(v) + returnType(integer()) + }, + refArgs = "scalar_res" + ) + cfoo <- nCompile(foo) + x <- 2.3 + scalar_res <- 1 + ans <- foo(x, scalar_res) + cscalar_res <- 0 + cans <- cfoo(x, cscalar_res) + expect_identical(ans, cans) + expect_true(is.null(dim(cans))) + expect_equal(cans, 2L) + expect_identical(scalar_res, cscalar_res) + expect_identical(cscalar_res, 3*2L) + rm(ans, cans); gc() +}) + # --------------------------------------------------------------------------- # Runtime-source path via ETaccessorBase (RuntimeCastingProxy) # From 41752ea37c28a0445084247a3120e1ee0dca1e55 Mon Sep 17 00:00:00 2001 From: perrydv Date: Wed, 3 Jun 2026 11:28:57 -0700 Subject: [PATCH 2/5] Add forward declaration of CastingScalarProxy --- .../nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h | 1 + 1 file changed, 1 insertion(+) diff --git a/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h b/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h index 5eaf77a0..07dd3786 100644 --- a/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h +++ b/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/ETaccessor_post_Rcpp.h @@ -43,6 +43,7 @@ template class EmptyProxy; template class EmptyScalarProxy; template class RHSCastProxy; template class CastingProxy; +template class CastingScalarProxy; // Virtual nDim-general methods (e.g. resize, conversions to and from SEXP). class ETaccessorBase { From b2ef25186606a1cb29b9350c59cdafefba4bdc43 Mon Sep 17 00:00:00 2001 From: perrydv Date: Wed, 3 Jun 2026 12:10:40 -0700 Subject: [PATCH 3/5] fix test-as.R for ETaccessBase tests --- .../tests/testthat/specificOp_tests/test-as.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/nCompiler/tests/testthat/specificOp_tests/test-as.R b/nCompiler/tests/testthat/specificOp_tests/test-as.R index 86953496..56af41c8 100644 --- a/nCompiler/tests/testthat/specificOp_tests/test-as.R +++ b/nCompiler/tests/testthat/specificOp_tests/test-as.R @@ -823,7 +823,7 @@ test_that("as(): ETaccessorBase RHS paths (same-scalar, cross-scalar sum and ele data <- ncAcc$new() data$x <- v ans <- 0.0 - cppLiteral('{ auto _acc = data->access("x"); flex_(ans) = as_nC(*_acc)().sum(); }') + cppLiteral('{ auto _acc = data->access("x"); flex_(ans) = as_nC >(*_acc)().sum(); }') return(ans) returnType(numericScalar) } @@ -834,7 +834,7 @@ test_that("as(): ETaccessorBase RHS paths (same-scalar, cross-scalar sum and ele data <- ncAcc$new() data$x <- v ans <- 0L - cppLiteral('{ auto _acc = data->access("x"); flex_(ans) = as_nC(*_acc)().sum(); }') + cppLiteral('{ auto _acc = data->access("x"); flex_(ans) = as_nC >(*_acc)().sum(); }') return(ans) returnType(integerScalar) } @@ -845,7 +845,7 @@ test_that("as(): ETaccessorBase RHS paths (same-scalar, cross-scalar sum and ele data <- ncAcc$new() data$x <- v ans <- 0L - cppLiteral('{ auto _acc = data->access("x"); flex_(ans) = as_nC(*_acc)()(i - 1); }') + cppLiteral('{ auto _acc = data->access("x"); flex_(ans) = as_nC >(*_acc)()(i - 1); }') return(ans) returnType(integerScalar) } @@ -881,9 +881,9 @@ test_that("as(): ETaccessorBase LHS paths (same-scalar write-through, cross-scal function(v = numericVector) { data <- ncAcc$new() data$x <- numeric(length = length(v), value = 0) - cppLiteral('{ auto _acc = data->access("x"); as_nC(*_acc)() = v; }') + cppLiteral('{ auto _acc = data->access("x"); as_nC ,AsMode::LHS>(*_acc)() = v; }') ans <- 0.0 - cppLiteral('{ auto _acc2 = data->access("x"); flex_(ans) = as_nC(*_acc2)().sum(); }') + cppLiteral('{ auto _acc2 = data->access("x"); flex_(ans) = as_nC >(*_acc2)().sum(); }') return(ans) returnType(numericScalar) } @@ -893,9 +893,9 @@ test_that("as(): ETaccessorBase LHS paths (same-scalar write-through, cross-scal function(v = integerVector) { data <- ncAcc$new() data$x <- numeric(length = length(v), value = 0) - cppLiteral('{ auto _acc = data->access("x"); as_nC(*_acc)() = v; }') + cppLiteral('{ auto _acc = data->access("x"); as_nC,AsMode::LHS>(*_acc)() = v; }') ans <- 0.0 - cppLiteral('{ auto _acc2 = data->access("x"); flex_(ans) = as_nC(*_acc2)().sum(); }') + cppLiteral('{ auto _acc2 = data->access("x"); flex_(ans) = as_nC >(*_acc2)().sum(); }') return(ans) returnType(numericScalar) } From c9e857e84390ee6a357873334f4074b0895025b3 Mon Sep 17 00:00:00 2001 From: perrydv Date: Thu, 4 Jun 2026 07:38:23 -0700 Subject: [PATCH 4/5] give `nC_as` both lvalue and rvalue ref versions. fix test-ETaccess-DSL with workaround --- .../nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h | 8 ++- .../specificOp_tests/test-ETaccess-DSL.R | 51 +++++++++++-------- 2 files changed, 36 insertions(+), 23 deletions(-) diff --git a/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h b/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h index 62de4880..c8001718 100644 --- a/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h +++ b/nCompiler/inst/include/nCompiler/ET_Rcpp_ext/post_Rcpp/nC_as.h @@ -289,7 +289,13 @@ RuntimeCastingProxy as_nC(ETaccessorBase& acc) { // so this overload allows direct passing of the unique_ptr, for simpler usage and code-generation. // This takes its argument by value, so that it can be an rvalue (returned from another call at the call site). template -RuntimeCastingProxy as_nC(std::unique_ptr acc) { +RuntimeCastingProxy as_nC(std::unique_ptr& acc) { + return RuntimeCastingProxy(*acc, mode == AsMode::LHS); +} + + +template +RuntimeCastingProxy as_nC(std::unique_ptr&& acc) { return RuntimeCastingProxy(*acc, mode == AsMode::LHS); } diff --git a/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R b/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R index 71011ef3..85c8d35f 100644 --- a/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R +++ b/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R @@ -7,25 +7,29 @@ test_that("obj[['x']] works like obj$x", { x = 'numericVector' ) ) - nf <- nFunction( - function(obj = 'nc') { - v <- obj[["x"]] - return(v) - returnType('numericVector') - } + nc2 <- nClass( + Cpublic = list( + nf = nFunction( + function(obj = 'nc') { + v <- obj[["x"]] + return(v) + returnType('numericVector') + } + ) + ) ) for(mode in c("R","non-pkg", "pkg")) { if(mode == "R") { obj <- nc$new() - foo <- nf + obj2 <- nc2$new() } else { package <- mode=="pkg" - comp <- nCompile(nc, nf, package = package) + comp <- nCompile(nc, nc2, package = package) obj <- comp$nc$new() - foo <- comp$nf + obj2 <- comp$nc2$new() } obj$x <- c(1.2, 2.3) - expect_equal(foo(obj), obj$x) + expect_equal(obj2$nf(obj), obj$x) rm(obj); gc() } }) @@ -37,27 +41,30 @@ test_that("obj[[var_name]] works", { x = 'numericVector' ) ) - nf <- nFunction( - function(obj = 'nc', var_name = 'string') { - ETacc <- obj[[var_name]] - v <- as(ETacc, 'numericVector') - return(v) - returnType('numericVector') - } + nc2 <- nClass( + Cpublic = list( + nf = nFunction( + function(obj = 'nc', var_name = 'string') { + ETacc <- obj[[var_name]] + v <- as(ETacc, 'numericVector') + return(v) + returnType('numericVector') + } + ) + ) ) for(mode in c("R","non-pkg", "pkg")) { if(mode == "R") { obj <- nc$new() - foo <- nf + obj2 <- nc2$new() } else { package <- mode=="pkg" - comp <- nCompile(nc, nf, package = package) + comp <- nCompile(nc, nc2, package = package) obj <- comp$nc$new() - foo <- comp$nf + obj2 <- comp$nc2$new() } obj$x <- c(1.2, 2.3) - foo(obj, "x") - expect_equal(foo(obj, "x"), obj$x) + expect_equal(obj2$nf(obj, "x"), obj$x) rm(obj); gc() } }) From c8de4605ad0487ce170c1fe6ddb74e8bca5a4ce3 Mon Sep 17 00:00:00 2001 From: perrydv Date: Thu, 4 Jun 2026 12:34:25 -0700 Subject: [PATCH 5/5] clean up last test in test-ETaccess-DSL, missed before --- .../specificOp_tests/test-ETaccess-DSL.R | 25 +++++++++++-------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R b/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R index 85c8d35f..582031e7 100644 --- a/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R +++ b/nCompiler/tests/testthat/specificOp_tests/test-ETaccess-DSL.R @@ -75,26 +75,29 @@ test_that("as(obj[[var_name]], type) works", { x = 'numericVector' ) ) - nf <- nFunction( - function(obj = 'nc', var_name = 'string') { - v <- as(obj[[var_name]], 'numericVector') - return(v) - returnType('numericVector') - } + nc2 <- nClass( + Cpublic = list( + nf = nFunction( + function(obj = 'nc', var_name = 'string') { + v <- as(obj[[var_name]], 'numericVector') + return(v) + returnType('numericVector') + } + ) + ) ) for(mode in c("R","non-pkg", "pkg")) { if(mode == "R") { obj <- nc$new() - foo <- nf + obj2 <- nc2$new() } else { package <- mode=="pkg" - comp <- nCompile(nc, nf, package = package) + comp <- nCompile(nc, nc2, package = package) obj <- comp$nc$new() - foo <- comp$nf + obj2 <- comp$nc2$new() } obj$x <- c(1.2, 2.3) - foo(obj, "x") - expect_equal(foo(obj, "x"), obj$x) + expect_equal(obj2$nf(obj, "x"), obj$x) rm(obj); gc() } })