From 07cc9239a593610db8dd973701354bfe33e60d32 Mon Sep 17 00:00:00 2001 From: perrydv Date: Sat, 16 May 2026 10:04:37 -0700 Subject: [PATCH] support "self" keyword, translated to C++ as "this" or a safe shared_ptr to this. --- nCompiler/R/NC_CompilerClass.R | 8 + nCompiler/R/compile_generateCpp.R | 10 +- nCompiler/R/compile_labelAbstractTypes.R | 69 ++---- nCompiler/R/cppDefs_variables.R | 16 ++ nCompiler/R/symbolTable.R | 25 ++ .../nC_inter/generic_class_interface.h | 61 +++++ .../tests/testthat/nClass_tests/test-self.R | 232 ++++++++++++++++++ 7 files changed, 370 insertions(+), 51 deletions(-) create mode 100644 nCompiler/tests/testthat/nClass_tests/test-self.R diff --git a/nCompiler/R/NC_CompilerClass.R b/nCompiler/R/NC_CompilerClass.R index 63774285..0d3fdb1b 100644 --- a/nCompiler/R/NC_CompilerClass.R +++ b/nCompiler/R/NC_CompilerClass.R @@ -126,6 +126,14 @@ NC_CompilerClass <- R6::R6Class( resolveTBDsymbols(symbolTable, NCgenerator, project_env = project_env) + ## Add 'self' so method bodies can reference the current object. + ## genCppVar() gives a special cppVar case where generate() returns "" + ## and generateUse returns "nC_shared_from_this()". + symbolTable$addSymbol(symbolSelf$new( + name = 'self', + type = NCinternals(NCgenerator)$cpp_classname, + NCgenerator = NCgenerator + )) setupMethodSymbolTables() } }, diff --git a/nCompiler/R/compile_generateCpp.R b/nCompiler/R/compile_generateCpp.R index e8932ba9..28ed93ac 100644 --- a/nCompiler/R/compile_generateCpp.R +++ b/nCompiler/R/compile_generateCpp.R @@ -378,8 +378,10 @@ cppOutputMemberData <- function(code, symTab) { inGenCppEnv( ## Member(A, x) -> A.x Member <- function(code, symTab, connector = '.') { + isSelf <- code$args[[1]]$name == 'self' && inherits(code$args[[1]]$type, "symbolSelf") + objOutput <- if(isSelf) 'this' else compile_generateCpp(code$args[[1]], symTab) paste0( '(', - compile_generateCpp(code$args[[1]], symTab), + objOutput, ')', connector, code$args[[2]]$name) } ) @@ -395,7 +397,9 @@ inGenCppEnv( ## This differs from old system ## Method(A, foo, x) -> A.foo(x) Method <- function(code, symTab, connector = '.') { - obj <- paste0('(', compile_generateCpp(code$args[[1]], symTab), ')', connector) + isSelf <- code$args[[1]]$name == 'self' && inherits(code$args[[1]]$type, "symbolSelf") + objOutput <- if(isSelf) 'this' else compile_generateCpp(code$args[[1]], symTab) + objPart <- paste0('(', objOutput, ')', connector) opString <- getCppString(code$args[[2]]) methodCall <- paste0( opString, '(', @@ -404,7 +408,7 @@ inGenCppEnv( collapse = ', ' ), ')' ) - paste0(obj, methodCall) + paste0(objPart, methodCall) } ) inGenCppEnv( diff --git a/nCompiler/R/compile_labelAbstractTypes.R b/nCompiler/R/compile_labelAbstractTypes.R index fa0fce38..df3cc142 100644 --- a/nCompiler/R/compile_labelAbstractTypes.R +++ b/nCompiler/R/compile_labelAbstractTypes.R @@ -387,13 +387,12 @@ inLabelAbstractTypesEnv( ) code$type <- returnSym ## Logically it might seem this should become ->method. - ## However it appears in nFunction(->member(A, foo), x) for A->foo(x). - ## In stage generateCpp, the nFunction packs the arguments after A->foo, + ## However it appears in chainedCall(->member(A, foo), x) for A->foo(x). + ## In stage generateCpp, the chainedCall packs the arguments after A->foo, ## so we mark that here as a member. code$name <- '->member' code$args[[2]]$aux$obj_internals <- obj_internals code$args[[2]]$aux$nFunctionName <- innerName - #code$args[[2]]$name <- NFinternals(method)$cpp_code_name code$args[[2]]$name <- NCinternals(code$args[[1]]$type$NCgenerator)$all_methodName_to_cpp_code_name[[innerName]] obj_internals <- NULL @@ -407,49 +406,10 @@ inLabelAbstractTypesEnv( code$type <- symbol$clone(deep = TRUE) code$name <- '->member' } - ## TO-DO: Handle special case of "new", or put it in - ## the nClass symbol table. if(length(inserts) == 0) NULL else inserts } ) -## a$b would become nClass_member(a, b) -## a$b$foo(x) would become chainedCall(`$`(`$`(a, b), foo), x) -## which would become nFunction( nClass_member(nClass$member(a, b), foo) , x) - -## Called by Generic_nFunction and Generic_nFunction_method -## This converts foo(x) to nFunction(foo, x) -## if foo is either an nFunction or a method of the current class -## inLabelAbstractTypesEnv( -## convert_nFunction_or_method_AST <- -## function(code, obj) { -## nFunctionName <- code$name -## ## Note that the string `nFunction` matches the operatorDef entry. -## ## Therefore the change-of-name here will automatically trigger use of -## ## the 'nFunction' operatorDef in later stages. -## code$name <- 'nFunction' -## cpp_code_name <- NFinternals(obj)$cpp_code_name -## fxnNameExpr <- exprClass$new(name = cpp_code_name, isName = TRUE, -## isCall = FALSE, isLiteral = FALSE, isAssign = FALSE) -## ## We may need to add content to this symbol if -## ## necessary for later processing steps. -## fxnNameExpr$type <- symbolNF$new(name = nFunctionName) -## insertArg(code, 1, fxnNameExpr) -## ## TO-DO: Add error-trapping of argument types -## returnSym <- NFinternals(obj)$returnSym -## if(is.null(returnSym)) -## stop( -## exprClassProcessingErrorMsg( -## code, paste('In convert_nFunction_or_method_AST: the nFunction (or method) ', -## code$name, -## ' does not have a valid returnType.') -## ), call. = FALSE -## ) -## code$type <- returnSym$clone() ## Not sure if a clone is needed, but it seems safer to make one. -## invisible(NULL) -## } -## ) - ## Called by main compile_labelAbstractTypes loop ## This converts use of the function foo as an object to ## nFunctionRef(foo, namespace) @@ -1495,12 +1455,25 @@ inLabelAbstractTypesEnv( insertions <- recurse_labelAbstractTypes(code, symTab, auxEnv, handlingInfo) code$type <- code$args[[1]]$type # see if the returned object differs from the nFunction's return type - if(!identical(class(auxEnv$returnSymbol), class(code$type))) { - warning(exprClassProcessingErrorMsg( - code, - "Object type for return() does not match the nFunction's return type." - ), - call. = FALSE) + # To-do: We could look at the NCgenerator class hierarchy to actually + # determine validity of returned type. Instead here we just + # see if both are symbolNC, with a special-case check for a symbolSelf (or other case) + # that inherits from symbolNC + if(inherits(auxEnv$returnSymbol, "symbolNC")) { + if(!inherits(code$type, class(auxEnv$returnSymbol)[1])) + warning(exprClassProcessingErrorMsg( + code, + "Object nClass type for return() does not match the nFunction's return type." + ), + call. = FALSE) + } else { + if(!identical(class(auxEnv$returnSymbol), class(code$type))) { + warning(exprClassProcessingErrorMsg( + code, + "Object type for return() does not match the nFunction's return type." + ), + call. = FALSE) + } } if(inherits(auxEnv$returnSymbol, "symbolBasic")) { # problem if number of dimensions differs diff --git a/nCompiler/R/cppDefs_variables.R b/nCompiler/R/cppDefs_variables.R index 8e251526..e17a66be 100644 --- a/nCompiler/R/cppDefs_variables.R +++ b/nCompiler/R/cppDefs_variables.R @@ -48,6 +48,22 @@ cppVarClass <- R6::R6Class( ) ) +cppVarSelfClass <- R6::R6Class( + classname = 'cppVarSelfClass', + inherit = cppVarClass, + portable = TRUE, + public = list( + initialize = function(...) { + super$initialize(...) + self$name <- "self" + }, + generate = function(printName = character(), ...) { + character() + }, + generateUse = function(...) "nC_shared_from_this()" + ) +) + cppVar2cppVarFull <- function(cppVar, ...) { ans <- cppVarFullClass$new(name = cppVar$name, baseType = cppVar$baseType, diff --git a/nCompiler/R/symbolTable.R b/nCompiler/R/symbolTable.R index f8b7d9fa..1f4fef01 100644 --- a/nCompiler/R/symbolTable.R +++ b/nCompiler/R/symbolTable.R @@ -320,6 +320,31 @@ symbolNC <- R6::R6Class( ) ) +## Symbol for `self` inside nClass method bodies. +## generateUse() emits nC_shared_from_this() so that `self` used as a value +## (passed as argument or returned) produces a std::shared_ptr. +## For method calls (self$method(x)), the DollarSign handler in +## compile_labelAbstractTypes uses the inherited NCgenerator for lookup, +## and PtrMember in compile_generateCpp emits (nC_shared_from_this())->method(x). +symbolSelf <- R6::R6Class( + classname = "symbolSelf", + inherit = symbolNC, + portable = TRUE, + public = list( + initialize = function(name, type, NCgenerator, isArg = FALSE) { + super$initialize(name = name, + type = type, + NCgenerator = NCgenerator, + isArg = isArg) + }, + # Note that the genCppOutput handlers for 'Method' and 'Member' + # intercept this. If they see a name "self" with type that inherits from "symbolSelf", + # they will emit "this" instead of generating a cppVar for it. + # The cppVar for self is only used if self is used as a value, such as in an argument or return value. + genCppVar = function() cppVarSelfClass$new() + ) +) + ## type is the unique ID of the NCgenerator. ## same value as for a symbolNC for an object of the class. symbolNCgenerator <- R6::R6Class( diff --git a/nCompiler/inst/include/nCompiler/nC_inter/generic_class_interface.h b/nCompiler/inst/include/nCompiler/nC_inter/generic_class_interface.h index 30d0d4ef..2e057340 100644 --- a/nCompiler/inst/include/nCompiler/nC_inter/generic_class_interface.h +++ b/nCompiler/inst/include/nCompiler/nC_inter/generic_class_interface.h @@ -115,6 +115,14 @@ class genericInterfaceBaseC { }; }; +// Forward declaration needed for class_from_interface below +template class genericInterfaceC; + +// Extracts ClassName from genericInterfaceC, used by interface_resolver +// to determine the owned type for nC_shared_from_this(). +template struct class_from_interface { using type = void; }; +template struct class_from_interface> { using type = T; }; + // FirstDerived and interface_resolver<> designed with help from Google Gemini // Helper template to find the first type that inherits from Base template @@ -136,13 +144,65 @@ struct FirstGenericDerived { >; }; +// General case (2+ template args): derived nClass. +// nC_shared_from_this() casts the inherited shared_from_this() result to +// shared_ptr, where OwnedType is the most-derived class +// (extracted from the first template arg, which is always genericInterfaceC). +// The enable_shared_from_this lives only in the single-arg (root) specialization below; +// it is inherited through the base-class chain and initialized correctly by +// shared_ptr because DerivedClass is derived from enable_shared_from_this. template class interface_resolver : public Bases..., virtual public genericInterfaceBaseC { private: using FirstFound = typename FirstGenericDerived::type; + using OwnedType = typename class_from_interface::type; public: + std::shared_ptr nC_shared_from_this() { + return std::static_pointer_cast(this->shared_from_this()); + } + const name2access_type& get_name2access() const override { + return FirstFound::get_name2access(); + } + std::unique_ptr access(const std::string &name) override { + return FirstFound::access(name); + } + SEXP get_value(const std::string &name) const override { + return FirstFound::get_value(name); + } + void set_all_values(SEXP Robj) override { + FirstFound::set_all_values(Robj); + } + void set_value(const std::string &name, SEXP Svalue) override { + FirstFound::set_value(name, Svalue); + } + SEXP call_method(const std::string &name, SEXP Sargs) override { + return FirstFound::call_method(name, Sargs); + } + SEXP make_deserialized_return_SEXP() override { + return FirstFound::make_deserialized_return_SEXP(); + } +}; + +// Single-arg specialization: root nClass (no nClass parent). +// Adds enable_shared_from_this so that shared_ptr +// correctly initialises the weak_ptr used by shared_from_this(). +// nC_shared_from_this() is a trivial cast here (same type). +template +class interface_resolver : + public First, + virtual public genericInterfaceBaseC, + public std::enable_shared_from_this::type> +{ +private: + using FirstFound = First; + using OwnedType = typename class_from_interface::type; + +public: + std::shared_ptr nC_shared_from_this() { + return std::enable_shared_from_this::shared_from_this(); + } const name2access_type& get_name2access() const override { return FirstFound::get_name2access(); } @@ -166,6 +226,7 @@ class interface_resolver : public Bases..., virtual public genericInterfaceBaseC } }; +// Empty specialization: nClass with no generic interface (no enable_shared_from_this). template<> class interface_resolver<> : virtual public genericInterfaceBaseC { diff --git a/nCompiler/tests/testthat/nClass_tests/test-self.R b/nCompiler/tests/testthat/nClass_tests/test-self.R new file mode 100644 index 00000000..ded94ae5 --- /dev/null +++ b/nCompiler/tests/testthat/nClass_tests/test-self.R @@ -0,0 +1,232 @@ +# Tests for the `self` keyword in nClass method bodies. +# +# `self` compiles to nC_shared_from_this(), which returns +# std::shared_ptr. This covers three uses: +# 1. self$method(x) -- method call on the current object +# 2. return(self) -- return the current object by shared_ptr +# 3. f(self) -- pass the current object as an argument +# +# All three are tested for a plain (root) nClass and for a derived nClass. +# Uncompiled behaviour uses R6's built-in `self` keyword, so it matches +# compiled behaviour for all three cases. + +# --------------------------------------------------------------------------- +# Plain (root) nClass +# --------------------------------------------------------------------------- + +test_that("self$method() works in a plain nClass", { + nc <- nClass( + classname = "nc_self_method", + Cpublic = list( + x = 'numericScalar', + double_x = nFunction( + function() { return(x * 2); returnType('numericScalar') } + ), + set_x_via_self = nFunction( + function(x_ = 'numericScalar') {self$x <- x_} + ), + get_double_x_via_self = nFunction( + function() { return(self$double_x()); returnType('numericScalar') } + ) + ) + ) + + obj <- nc$new() + obj$x <- 3 + obj$set_x_via_self(5) + expect_equal(obj$get_double_x_via_self(), 10) + + for(package in c(FALSE, TRUE)) { + comp <- nCompile(nc, package = package) + Cobj <- comp$new() + Cobj$x <- 3 + Cobj$set_x_via_self(5) + expect_equal(Cobj$get_double_x_via_self(), 10) + rm(Cobj); gc() + } +}) + +test_that("self as return value works in a plain nClass", { + nc <- nClass( + classname = "nc_self_return", + Cpublic = list( + x = 'numericScalar', + get_self = nFunction( + function() { return(self); returnType('nc') } + ) + ) + ) + + obj <- nc$new() + obj$x <- 42 + s <- obj$get_self() + expect_equal(s$x, 42) + + for(package in c(FALSE, TRUE)) { + comp <- nCompile(nc, package = package) + Cobj <- comp$new() + Cobj$x <- 42 + Cs <- Cobj$get_self() + expect_true(inherits(Cs, "nc_self_return")) + expect_equal(Cs$x, 42) + rm(Cobj, Cs); gc() + } +}) + +test_that("self as argument works in a plain nClass", { + nc <- nClass( + classname = "nc_self_arg", + Cpublic = list( + x = 'numericScalar', + get_x_from = nFunction( + function(other = 'nc') { + return(other$x); returnType('numericScalar') + } + ), + get_my_x_via_self = nFunction( + function() { return(self$get_x_from(self)); returnType('numericScalar') } + ) + ) + ) + + obj <- nc$new() + obj$x <- 7 + expect_equal(obj$get_my_x_via_self(), 7) + + for(package in c(FALSE, TRUE)) { + comp <- nCompile(nc, package = package) + Cobj <- comp$new() + Cobj$x <- 7 + expect_equal(Cobj$get_my_x_via_self(), 7) + rm(Cobj); gc() + } +}) + +# --------------------------------------------------------------------------- +# Derived nClass +# --------------------------------------------------------------------------- + +test_that("self$method() works in a derived nClass", { + ncBase <- nClass( + classname = "nc_self_hier_base1", + Cpublic = list( + x = 'numericScalar', + double_x = nFunction( + function() { return(x * 2); returnType('numericScalar') }, + compileInfo = list(virtual = TRUE) + ) + ), + compileInfo = list(interface = "generic", createFromR = FALSE, + exportName = "ncBase_export", + packageNames = c(uncompiled = "ncBase")) + ) + + ncDer <- nClass( + classname = "nc_self_hier_der1", + inherit = ncBase, + Cpublic = list( + get_double_x_via_self = nFunction( + function() { return(self$double_x()); returnType('numericScalar') } + ), + triple_x = nFunction( + function() {return(x*3); returnType('numericScalar')} + ), + get_triple_x_via_self = nFunction( + function() {return(self$triple_x()); returnType('numericScalar')} + ) + ) + ) + + obj <- ncDer$new() + obj$x <- 5 + expect_equal(obj$get_double_x_via_self(), 10) + expect_equal(obj$get_triple_x_via_self(), 15) + + for(package in c(FALSE, TRUE)) { + comp <- nCompile(ncBase, ncDer, package = package) + Cobj <- comp$ncDer$new() + Cobj$x <- 5 + expect_equal(Cobj$get_double_x_via_self(), 10) + expect_equal(Cobj$get_triple_x_via_self(), 15) + rm(Cobj); gc() + } +}) + +test_that("self as return value works in a derived nClass", { + ncBase <- nClass( + classname = "nc_self_hier_base2", + Cpublic = list( + x = 'numericScalar' + ), + compileInfo = list(interface = "generic", createFromR = FALSE, + exportName = "ncBase_export", + packageNames = c(uncompiled = "ncBase")) + ) + + ncDer <- nClass( + classname = "nc_self_hier_der2", + inherit = ncBase, + Cpublic = list( + y = 'numericScalar', + get_self = nFunction( + function() { return(self); returnType('ncDer') } + ) + ) + ) + + obj <- ncDer$new() + obj$x <- 10 + obj$y <- 20 + s <- obj$get_self() + expect_equal(s$x, 10) + expect_equal(s$y, 20) + + for(package in c(FALSE, TRUE)) { + comp <- nCompile(ncBase, ncDer, package = package) + Cobj <- comp$ncDer$new() + Cobj$x <- 10 + Cobj$y <- 20 + Cs <- Cobj$get_self() + expect_equal(Cs$x, 10) + expect_equal(Cs$y, 20) + rm(Cobj, Cs); gc() + } +}) + +test_that("self as argument works in a derived nClass", { + ncBase <- nClass( + classname = "nc_self_hier_base3", + Cpublic = list( + x = 'numericScalar' + ), + compileInfo = list(interface = "generic", createFromR = FALSE, + exportName = "ncBase_export", + packageNames = c(uncompiled = "ncBase")) + ) + + ncDer <- nClass( + classname = "nc_self_hier_der3", + inherit = ncBase, + Cpublic = list( + get_x_from = nFunction( + function(other = 'ncDer') { + return(other$x); returnType('numericScalar') + } + ), + get_my_x_via_self = nFunction( + function() { return(self$get_x_from(self)); returnType('numericScalar') } + ) + ) + ) + + obj <- ncDer$new() + obj$x <- 99 + expect_equal(obj$get_my_x_via_self(), 99) + for(package in c(FALSE, TRUE)) { + comp <- nCompile(ncBase, ncDer, package = package) + Cobj <- comp$ncDer$new() + Cobj$x <- 99 + expect_equal(Cobj$get_my_x_via_self(), 99) + rm(Cobj); gc() + } +})