Skip to content

S4 module metadata (2 of 2, over #1515) #1516

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
mdsumner wants to merge 2 commits into
base: master
Choose a base branch
from
Open

S4 module metadata (2 of 2, over #1515) #1516

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
63ad5ce
Module(): analyse reference class once and reuse C++Class objects
mdsumner Oct 2, 2026
ed59ef4
Modules: describe fields, methods and constructors with plain S4 objects
mdsumner Oct 2, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
81 changes: 53 additions & 28 deletions R/00_classes.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,47 +24,72 @@ setClassUnion("refGenerator", c("refObjectGenerator", "refClassGeneratorFunction
## Stands in for a reference class with those fields.
setClass( "Module", contains = "environment" )

setRefClass( "C++Field",
fields = list(
pointer = "externalptr",
cpp_class = "character",
read_only = "logical",
class_pointer = "externalptr",
## Plain S4 classes describing the fields, methods and constructors that a
## C++ class exposes. These used to be reference classes; creating one
## reference-class object per exposed method (via new()) dominated the
## time spent loading a module. A "$" method is provided below so that
## existing code using field-style access (x$pointer, x$info()) keeps working.
setClass( "C++Field",
representation(
pointer = "externalptr",
cpp_class = "character",
read_only = "logical",
class_pointer = "externalptr",
docstring = "character"
)
)

setRefClass( "C++OverloadedMethods",
fields = list(
pointer = "externalptr",
class_pointer = "externalptr",
size = "integer",
setClass( "C++OverloadedMethods",
representation(
pointer = "externalptr",
class_pointer = "externalptr",
size = "integer",
void = "logical",
const = "logical",
docstrings = "character",
signatures = "character",
const = "logical",
docstrings = "character",
signatures = "character",
nargs = "integer"
),
methods = list(
info = function(prefix = " " ){
paste(
paste( prefix, signatures, ifelse(const, " const", "" ), "\n", prefix, prefix,
ifelse( nchar(docstrings), paste( "docstring :", docstrings) , "" )
) , collapse = "\n" )
}
)
)

setRefClass( "C++Constructor",
fields = list(
pointer = "externalptr",
class_pointer = "externalptr",
nargs = "integer",
signature = "character",
setClass( "C++Constructor",
representation(
pointer = "externalptr",
class_pointer = "externalptr",
nargs = "integer",
signature = "character",
docstring = "character"
)
)

## formerly the 'info' reference method of C++OverloadedMethods
.cpp_methods_info <- function( x, prefix = " " ){
paste(
paste( prefix, x@signatures, ifelse(x@const, " const", "" ), "\n", prefix, prefix,
ifelse( nchar(x@docstrings), paste( "docstring :", x@docstrings) , "" )
) , collapse = "\n" )
}

## backwards compatible field-style access
setMethod( "$", "C++OverloadedMethods", function(x, name){
if( identical( name, "info" ) )
function( prefix = " " ) .cpp_methods_info( x, prefix )
else
methods::slot( x, name )
} )
setMethod( "$", "C++Field", function(x, name) methods::slot( x, name ) )
setMethod( "$", "C++Constructor", function(x, name) methods::slot( x, name ) )

## packages compiled against earlier versions of the Rcpp headers populate
## these objects with `$<-` (FieldProxy); keep those binaries loadable
.slot_dollar_assign <- function(x, name, value) {
methods::slot( x, name ) <- value
x
}
setReplaceMethod( "$", "C++OverloadedMethods", .slot_dollar_assign )
setReplaceMethod( "$", "C++Field", .slot_dollar_assign )
setReplaceMethod( "$", "C++Constructor", .slot_dollar_assign )

setClass( "C++Class",
representation(
pointer = "externalptr",
Expand Down
12 changes: 6 additions & 6 deletions R/01_show.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,8 +41,8 @@ setMethod( "show", "C++Class", function(object){
txt <- character( nctors )
for( i in seq_len(nctors) ){
ctor <- ctors[[i]]
doc <- ctor$docstring
txt[i] <- sprintf( " %s%s", ctor$signature, if( nchar(doc) ) sprintf( "\n docstring : %s", doc) else "" )
doc <- ctor@docstring
txt[i] <- sprintf( " %s%s", ctor@signature, if( nchar(doc) ) sprintf( "\n docstring : %s", doc) else "" )
}
writeLines( "Constructors:" )
writeLines( paste( txt, collapse = "\n" ) )
Expand All @@ -55,11 +55,11 @@ setMethod( "show", "C++Class", function(object){
writeLines( "\nFields: " )
for( i in seq_len(nfields) ){
f <- fields[[i]]
doc <- f$docstring
doc <- f@docstring
txt[i] <- sprintf( " %s %s%s%s",
f$cpp_class,
f@cpp_class,
names[i],
if( f$read_only ) " [readonly]" else "",
if( f@read_only ) " [readonly]" else "",
if( nchar(doc) ) sprintf( "\n docstring : %s", doc ) else ""
)
}
Expand All @@ -74,7 +74,7 @@ setMethod( "show", "C++Class", function(object){
writeLines( "\nMethods: " )
txt <- character( nmethods )
for( i in seq_len(nmethods) ){
txt[i] <- mets[[i]]$info(" ")
txt[i] <- .cpp_methods_info( mets[[i]], " " )
}
writeLines( paste( txt, collapse = "\n" ) )
} else {
Expand Down
43 changes: 24 additions & 19 deletions R/Module.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -222,24 +222,26 @@ Module <- function( module, PACKAGE = methods::getPackageName(where), where = to

fields <- cpp_fields( CLASS, where )
methods <- cpp_refMethods(CLASS, where)
generator <- methods::setRefClass( clname,
fields = fields,
contains = "C++Object",
methods = methods,
where = where
)
# just to make codetools happy
.self <- .refClassDef <- NULL
generator$methods(initialize =
# Supply 'initialize' together with the other methods so that the
# reference class is analysed once, instead of a second full pass
# through refClassInformation() in generator$methods(...)
methods[["initialize"]] <-
if (cpp_hasDefaultConstructor(CLASS))
function(...) Rcpp::cpp_object_initializer(.self,.refClassDef, ...)
else
function(...) {
if (nargs()) Rcpp::cpp_object_initializer(.self,.refClassDef, ...)
else Rcpp::cpp_object_dummy(.self, .refClassDef) # #nocov
}
)
rm( .self, .refClassDef )
generator <- methods::setRefClass( clname,
fields = fields,
contains = "C++Object",
methods = methods,
where = where
)

classDef <- methods::getClass(clname)
## non-public (static) fields in class representation
Expand Down Expand Up @@ -281,7 +283,10 @@ Module <- function( module, PACKAGE = methods::getPackageName(where), where = to
CLASS <- classes[[i]]
clname <- CLASS@.Data
demangled_name <- sub( "^Rcpp_", "", clname )
.classes_map[[ CLASS@typeid ]] <- storage[[ demangled_name ]] <- .get_Module_Class( module, demangled_name, xp )
# reuse the C++Class object already built by Module__classes_info
# rather than rebuilding it (and all of its method/field objects)
CLASS@generator <- generators[[ clname ]]
.classes_map[[ CLASS@typeid ]] <- storage[[ demangled_name ]] <- CLASS

# exposing enums values as CLASS.VALUE
# (should really be CLASS$value but I don't know how to do it)
Expand Down Expand Up @@ -324,31 +329,31 @@ Module <- function( module, PACKAGE = methods::getPackageName(where), where = to
dealWith <- function( x ) if(isTRUE(x[[1]])) invisible(NULL) else x[[2]] # #nocov

method_wrapper <- function( METHOD, where ){
noargs <- all( METHOD$nargs == 0 )
noargs <- all( METHOD@nargs == 0 )
stuff <- list(
class_pointer = METHOD$class_pointer,
pointer = METHOD$pointer,
class_pointer = METHOD@class_pointer,
pointer = METHOD@pointer,
CppMethod__invoke = CppMethod__invoke,
CppMethod__invoke_void = CppMethod__invoke_void,
CppMethod__invoke_notvoid = CppMethod__invoke_notvoid,
dealWith = dealWith,
docstring = METHOD$info("")
docstring = .cpp_methods_info( METHOD, "" )
)
f <- function(...) NULL
if( noargs ){
formals(f) <- NULL
}

extCall <- if( noargs ) {
if( all( METHOD$void ) ){
if( all( METHOD@void ) ){
# all methods are void, so we know we want to return invisible(NULL)
substitute(
{
docstring
.External(CppMethod__invoke_void, class_pointer, pointer, .pointer )
invisible(NULL)
} , stuff )
} else if( all( ! METHOD$void ) ){
} else if( all( ! METHOD@void ) ){
# none of the methods are void so we always return the result of
# .External
substitute(
Expand All @@ -366,15 +371,15 @@ method_wrapper <- function( METHOD, where ){
} , stuff ) # #nocov end
}
} else {
if( all( METHOD$void ) ){
if( all( METHOD@void ) ){
# all methods are void, so we know we want to return invisible(NULL)
substitute(
{
docstring
.External(CppMethod__invoke_void, class_pointer, pointer, .pointer, ...)
invisible(NULL)
} , stuff )
} else if( all( ! METHOD$void ) ){
} else if( all( ! METHOD@void ) ){
# none of the methods are void so we always return the result of
# .External
substitute(
Expand Down Expand Up @@ -426,8 +431,8 @@ binding_maker <- function( FIELD, where ){
.Call( CppField__get, class_pointer, pointer, .pointer)
else
.Call( CppField__set, class_pointer, pointer, .pointer, x)
}, list(class_pointer = FIELD$class_pointer,
pointer = FIELD$pointer,
}, list(class_pointer = FIELD@class_pointer,
pointer = FIELD@pointer,
CppField__get = CppField__get,
CppField__set = CppField__set ))
environment(f) <- where
Expand Down
56 changes: 28 additions & 28 deletions inst/include/Rcpp/Module.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -310,35 +310,35 @@ namespace Rcpp{
} ;

template <typename Class>
class S4_CppConstructor : public Reference {
typedef Reference Base;
class S4_CppConstructor : public S4 {
typedef S4 Base;
public:
typedef XPtr<class_Base> XP_Class ;
typedef Reference::Storage Storage ;
typedef S4::Storage Storage ;

S4_CppConstructor( SignedConstructor<Class>* m, const XP_Class& class_xp, const std::string& class_name, std::string& buffer ) : Reference( "C++Constructor" ){
S4_CppConstructor( SignedConstructor<Class>* m, const XP_Class& class_xp, const std::string& class_name, std::string& buffer ) : S4( "C++Constructor" ){
RCPP_DEBUG( "S4_CppConstructor( SignedConstructor<Class>* m, SEXP class_xp, const std::string& class_name, std::string& buffer" ) ;
field( "pointer" ) = Rcpp::XPtr< SignedConstructor<Class> >( m, false ) ;
field( "class_pointer" ) = class_xp ;
field( "nargs" ) = m->nargs() ;
slot( "pointer" ) = Rcpp::XPtr< SignedConstructor<Class> >( m, false ) ;
slot( "class_pointer" ) = class_xp ;
slot( "nargs" ) = m->nargs() ;
m->signature( buffer, class_name ) ;
field( "signature" ) = buffer ;
field( "docstring" ) = m->docstring ;
slot( "signature" ) = buffer ;
slot( "docstring" ) = m->docstring ;
}

RCPP_CTOR_ASSIGN_WITH_BASE(S4_CppConstructor)

} ;

template <typename Class>
class S4_CppOverloadedMethods : public Rcpp::Reference {
typedef Rcpp::Reference Base;
class S4_CppOverloadedMethods : public Rcpp::S4 {
typedef Rcpp::S4 Base;
public:
typedef Rcpp::XPtr<class_Base> XP_Class ;
typedef SignedMethod<Class> signed_method_class ;
typedef std::vector<signed_method_class*> vec_signed_method ;

S4_CppOverloadedMethods( vec_signed_method* m, const XP_Class& class_xp, const char* name, std::string& buffer ) : Reference( "C++OverloadedMethods" ){
S4_CppOverloadedMethods( vec_signed_method* m, const XP_Class& class_xp, const char* name, std::string& buffer ) : S4( "C++OverloadedMethods" ){
int n = static_cast<int>(m->size()) ;
Rcpp::LogicalVector voidness(n), constness(n) ;
Rcpp::CharacterVector docstrings(n), signatures(n) ;
Expand All @@ -354,14 +354,14 @@ namespace Rcpp{
signatures[i] = buffer ;
}

field( "pointer" ) = Rcpp::XPtr< vec_signed_method >( m, false ) ;
field( "class_pointer" ) = class_xp ;
field( "size" ) = n ;
field( "void" ) = voidness ;
field( "const" ) = constness ;
field( "docstrings" ) = docstrings ;
field( "signatures" ) = signatures ;
field( "nargs" ) = nargs ;
slot( "pointer" ) = Rcpp::XPtr< vec_signed_method >( m, false ) ;
slot( "class_pointer" ) = class_xp ;
slot( "size" ) = n ;
slot( "void" ) = voidness ;
slot( "const" ) = constness ;
slot( "docstrings" ) = docstrings ;
slot( "signatures" ) = signatures ;
slot( "nargs" ) = nargs ;

}

Expand Down Expand Up @@ -488,17 +488,17 @@ namespace Rcpp{
} ;

template <typename Class>
class S4_field : public Rcpp::Reference {
typedef Rcpp::Reference Base;
class S4_field : public Rcpp::S4 {
typedef Rcpp::S4 Base;
public:
typedef XPtr<class_Base> XP_Class ;
S4_field( CppProperty<Class>* p, const XP_Class& class_xp ) : Reference( "C++Field" ){
S4_field( CppProperty<Class>* p, const XP_Class& class_xp ) : S4( "C++Field" ){
RCPP_DEBUG( "S4_field( CppProperty<Class>* p, const XP_Class& class_xp )" )
field( "read_only" ) = p->is_readonly() ;
field( "cpp_class" ) = p->get_class();
field( "pointer" ) = Rcpp::XPtr< CppProperty<Class> >( p, false ) ;
field( "class_pointer" ) = class_xp ;
field( "docstring" ) = p->docstring ;
slot( "read_only" ) = p->is_readonly() ;
slot( "cpp_class" ) = p->get_class();
slot( "pointer" ) = Rcpp::XPtr< CppProperty<Class> >( p, false ) ;
slot( "class_pointer" ) = class_xp ;
slot( "docstring" ) = p->docstring ;
}

RCPP_CTOR_ASSIGN_WITH_BASE(S4_field)
Expand Down
20 changes: 13 additions & 7 deletions man/CppConstructor-class.Rd
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,20 +2,26 @@
\Rdversion{1.1}
\docType{class}
\alias{C++Constructor-class}
\alias{$,C++Constructor-method}
\alias{$<-,C++Constructor-method}

\title{Class "C++Constructor"}
\description{
Representation of a C++ constructor
}
\section{Extends}{
Class \code{"\linkS4class{envRefClass}"}, directly.
Class \code{"\linkS4class{.environment}"}, by class "envRefClass", distance 2.
Class \code{"\linkS4class{refClass}"}, by class "envRefClass", distance 2.
Class \code{"\linkS4class{environment}"}, by class "envRefClass", distance 3, with explicit coerce.
Class \code{"\linkS4class{refObject}"}, by class "envRefClass", distance 3.
\section{Methods}{
\describe{
\item{$}{\code{signature(x = "C++Constructor")}: slot access, kept for backwards compatibility }
\item{$<-}{\code{signature(x = "C++Constructor")}: slot assignment, kept for backwards compatibility }
}
}
\note{
This used to be a reference class. Objects of this class are plain S4
objects now; the slots may still be accessed with \code{$} for backwards
compatibility.
}
\keyword{classes}
\section{Fields}{
\section{Slots}{
\describe{
\item{\code{pointer}:}{pointer to the internal structure that represent the constructor}
\item{\code{class_pointer}:}{pointer to the internal structure that represent the associated C++ class}
Expand Down
Loading