Skip to content

Commit ed59ef4

Browse files
mdsumnermdsumner
committed
Modules: describe fields, methods and constructors with plain S4 objects
1 parent 63ad5ce commit ed59ef4

7 files changed

Lines changed: 142 additions & 88 deletions

File tree

‎R/00_classes.R‎

Lines changed: 53 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -24,47 +24,72 @@ setClassUnion("refGenerator", c("refObjectGenerator", "refClassGeneratorFunction
2424
## Stands in for a reference class with those fields.
2525
setClass( "Module", contains = "environment" )
2626

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

37-
setRefClass( "C++OverloadedMethods",
38-
fields = list(
39-
pointer = "externalptr",
40-
class_pointer = "externalptr",
41-
size = "integer",
42+
setClass( "C++OverloadedMethods",
43+
representation(
44+
pointer = "externalptr",
45+
class_pointer = "externalptr",
46+
size = "integer",
4247
void = "logical",
43-
const = "logical",
44-
docstrings = "character",
45-
signatures = "character",
48+
const = "logical",
49+
docstrings = "character",
50+
signatures = "character",
4651
nargs = "integer"
47-
),
48-
methods = list(
49-
info = function(prefix = " " ){
50-
paste(
51-
paste( prefix, signatures, ifelse(const, " const", "" ), "\n", prefix, prefix,
52-
ifelse( nchar(docstrings), paste( "docstring :", docstrings) , "" )
53-
) , collapse = "\n" )
54-
}
5552
)
5653
)
5754

58-
setRefClass( "C++Constructor",
59-
fields = list(
60-
pointer = "externalptr",
61-
class_pointer = "externalptr",
62-
nargs = "integer",
63-
signature = "character",
55+
setClass( "C++Constructor",
56+
representation(
57+
pointer = "externalptr",
58+
class_pointer = "externalptr",
59+
nargs = "integer",
60+
signature = "character",
6461
docstring = "character"
6562
)
6663
)
6764

65+
## formerly the 'info' reference method of C++OverloadedMethods
66+
.cpp_methods_info <- function( x, prefix = " " ){
67+
paste(
68+
paste( prefix, x@signatures, ifelse(x@const, " const", "" ), "\n", prefix, prefix,
69+
ifelse( nchar(x@docstrings), paste( "docstring :", x@docstrings) , "" )
70+
) , collapse = "\n" )
71+
}
72+
73+
## backwards compatible field-style access
74+
setMethod( "$", "C++OverloadedMethods", function(x, name){
75+
if( identical( name, "info" ) )
76+
function( prefix = " " ) .cpp_methods_info( x, prefix )
77+
else
78+
methods::slot( x, name )
79+
} )
80+
setMethod( "$", "C++Field", function(x, name) methods::slot( x, name ) )
81+
setMethod( "$", "C++Constructor", function(x, name) methods::slot( x, name ) )
82+
83+
## packages compiled against earlier versions of the Rcpp headers populate
84+
## these objects with `$<-` (FieldProxy); keep those binaries loadable
85+
.slot_dollar_assign <- function(x, name, value) {
86+
methods::slot( x, name ) <- value
87+
x
88+
}
89+
setReplaceMethod( "$", "C++OverloadedMethods", .slot_dollar_assign )
90+
setReplaceMethod( "$", "C++Field", .slot_dollar_assign )
91+
setReplaceMethod( "$", "C++Constructor", .slot_dollar_assign )
92+
6893
setClass( "C++Class",
6994
representation(
7095
pointer = "externalptr",

‎R/01_show.R‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -41,8 +41,8 @@ setMethod( "show", "C++Class", function(object){
4141
txt <- character( nctors )
4242
for( i in seq_len(nctors) ){
4343
ctor <- ctors[[i]]
44-
doc <- ctor$docstring
45-
txt[i] <- sprintf( " %s%s", ctor$signature, if( nchar(doc) ) sprintf( "\n docstring : %s", doc) else "" )
44+
doc <- ctor@docstring
45+
txt[i] <- sprintf( " %s%s", ctor@signature, if( nchar(doc) ) sprintf( "\n docstring : %s", doc) else "" )
4646
}
4747
writeLines( "Constructors:" )
4848
writeLines( paste( txt, collapse = "\n" ) )
@@ -55,11 +55,11 @@ setMethod( "show", "C++Class", function(object){
5555
writeLines( "\nFields: " )
5656
for( i in seq_len(nfields) ){
5757
f <- fields[[i]]
58-
doc <- f$docstring
58+
doc <- f@docstring
5959
txt[i] <- sprintf( " %s %s%s%s",
60-
f$cpp_class,
60+
f@cpp_class,
6161
names[i],
62-
if( f$read_only ) " [readonly]" else "",
62+
if( f@read_only ) " [readonly]" else "",
6363
if( nchar(doc) ) sprintf( "\n docstring : %s", doc ) else ""
6464
)
6565
}
@@ -74,7 +74,7 @@ setMethod( "show", "C++Class", function(object){
7474
writeLines( "\nMethods: " )
7575
txt <- character( nmethods )
7676
for( i in seq_len(nmethods) ){
77-
txt[i] <- mets[[i]]$info(" ")
77+
txt[i] <- .cpp_methods_info( mets[[i]], " " )
7878
}
7979
writeLines( paste( txt, collapse = "\n" ) )
8080
} else {

‎R/Module.R‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -329,31 +329,31 @@ Module <- function( module, PACKAGE = methods::getPackageName(where), where = to
329329
dealWith <- function( x ) if(isTRUE(x[[1]])) invisible(NULL) else x[[2]] # #nocov
330330

331331
method_wrapper <- function( METHOD, where ){
332-
noargs <- all( METHOD$nargs == 0 )
332+
noargs <- all( METHOD@nargs == 0 )
333333
stuff <- list(
334-
class_pointer = METHOD$class_pointer,
335-
pointer = METHOD$pointer,
334+
class_pointer = METHOD@class_pointer,
335+
pointer = METHOD@pointer,
336336
CppMethod__invoke = CppMethod__invoke,
337337
CppMethod__invoke_void = CppMethod__invoke_void,
338338
CppMethod__invoke_notvoid = CppMethod__invoke_notvoid,
339339
dealWith = dealWith,
340-
docstring = METHOD$info("")
340+
docstring = .cpp_methods_info( METHOD, "" )
341341
)
342342
f <- function(...) NULL
343343
if( noargs ){
344344
formals(f) <- NULL
345345
}
346346

347347
extCall <- if( noargs ) {
348-
if( all( METHOD$void ) ){
348+
if( all( METHOD@void ) ){
349349
# all methods are void, so we know we want to return invisible(NULL)
350350
substitute(
351351
{
352352
docstring
353353
.External(CppMethod__invoke_void, class_pointer, pointer, .pointer )
354354
invisible(NULL)
355355
} , stuff )
356-
} else if( all( ! METHOD$void ) ){
356+
} else if( all( ! METHOD@void ) ){
357357
# none of the methods are void so we always return the result of
358358
# .External
359359
substitute(
@@ -371,15 +371,15 @@ method_wrapper <- function( METHOD, where ){
371371
} , stuff ) # #nocov end
372372
}
373373
} else {
374-
if( all( METHOD$void ) ){
374+
if( all( METHOD@void ) ){
375375
# all methods are void, so we know we want to return invisible(NULL)
376376
substitute(
377377
{
378378
docstring
379379
.External(CppMethod__invoke_void, class_pointer, pointer, .pointer, ...)
380380
invisible(NULL)
381381
} , stuff )
382-
} else if( all( ! METHOD$void ) ){
382+
} else if( all( ! METHOD@void ) ){
383383
# none of the methods are void so we always return the result of
384384
# .External
385385
substitute(
@@ -431,8 +431,8 @@ binding_maker <- function( FIELD, where ){
431431
.Call( CppField__get, class_pointer, pointer, .pointer)
432432
else
433433
.Call( CppField__set, class_pointer, pointer, .pointer, x)
434-
}, list(class_pointer = FIELD$class_pointer,
435-
pointer = FIELD$pointer,
434+
}, list(class_pointer = FIELD@class_pointer,
435+
pointer = FIELD@pointer,
436436
CppField__get = CppField__get,
437437
CppField__set = CppField__set ))
438438
environment(f) <- where

‎inst/include/Rcpp/Module.h‎

Lines changed: 28 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -310,35 +310,35 @@ namespace Rcpp{
310310
} ;
311311

312312
template <typename Class>
313-
class S4_CppConstructor : public Reference {
314-
typedef Reference Base;
313+
class S4_CppConstructor : public S4 {
314+
typedef S4 Base;
315315
public:
316316
typedef XPtr<class_Base> XP_Class ;
317-
typedef Reference::Storage Storage ;
317+
typedef S4::Storage Storage ;
318318

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

329329
RCPP_CTOR_ASSIGN_WITH_BASE(S4_CppConstructor)
330330

331331
} ;
332332

333333
template <typename Class>
334-
class S4_CppOverloadedMethods : public Rcpp::Reference {
335-
typedef Rcpp::Reference Base;
334+
class S4_CppOverloadedMethods : public Rcpp::S4 {
335+
typedef Rcpp::S4 Base;
336336
public:
337337
typedef Rcpp::XPtr<class_Base> XP_Class ;
338338
typedef SignedMethod<Class> signed_method_class ;
339339
typedef std::vector<signed_method_class*> vec_signed_method ;
340340

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

357-
field( "pointer" ) = Rcpp::XPtr< vec_signed_method >( m, false ) ;
358-
field( "class_pointer" ) = class_xp ;
359-
field( "size" ) = n ;
360-
field( "void" ) = voidness ;
361-
field( "const" ) = constness ;
362-
field( "docstrings" ) = docstrings ;
363-
field( "signatures" ) = signatures ;
364-
field( "nargs" ) = nargs ;
357+
slot( "pointer" ) = Rcpp::XPtr< vec_signed_method >( m, false ) ;
358+
slot( "class_pointer" ) = class_xp ;
359+
slot( "size" ) = n ;
360+
slot( "void" ) = voidness ;
361+
slot( "const" ) = constness ;
362+
slot( "docstrings" ) = docstrings ;
363+
slot( "signatures" ) = signatures ;
364+
slot( "nargs" ) = nargs ;
365365

366366
}
367367

@@ -488,17 +488,17 @@ namespace Rcpp{
488488
} ;
489489

490490
template <typename Class>
491-
class S4_field : public Rcpp::Reference {
492-
typedef Rcpp::Reference Base;
491+
class S4_field : public Rcpp::S4 {
492+
typedef Rcpp::S4 Base;
493493
public:
494494
typedef XPtr<class_Base> XP_Class ;
495-
S4_field( CppProperty<Class>* p, const XP_Class& class_xp ) : Reference( "C++Field" ){
495+
S4_field( CppProperty<Class>* p, const XP_Class& class_xp ) : S4( "C++Field" ){
496496
RCPP_DEBUG( "S4_field( CppProperty<Class>* p, const XP_Class& class_xp )" )
497-
field( "read_only" ) = p->is_readonly() ;
498-
field( "cpp_class" ) = p->get_class();
499-
field( "pointer" ) = Rcpp::XPtr< CppProperty<Class> >( p, false ) ;
500-
field( "class_pointer" ) = class_xp ;
501-
field( "docstring" ) = p->docstring ;
497+
slot( "read_only" ) = p->is_readonly() ;
498+
slot( "cpp_class" ) = p->get_class();
499+
slot( "pointer" ) = Rcpp::XPtr< CppProperty<Class> >( p, false ) ;
500+
slot( "class_pointer" ) = class_xp ;
501+
slot( "docstring" ) = p->docstring ;
502502
}
503503

504504
RCPP_CTOR_ASSIGN_WITH_BASE(S4_field)

‎man/CppConstructor-class.Rd‎

Lines changed: 13 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,20 +2,26 @@
22
\Rdversion{1.1}
33
\docType{class}
44
\alias{C++Constructor-class}
5+
\alias{$,C++Constructor-method}
6+
\alias{$<-,C++Constructor-method}
57

68
\title{Class "C++Constructor"}
79
\description{
810
Representation of a C++ constructor
911
}
10-
\section{Extends}{
11-
Class \code{"\linkS4class{envRefClass}"}, directly.
12-
Class \code{"\linkS4class{.environment}"}, by class "envRefClass", distance 2.
13-
Class \code{"\linkS4class{refClass}"}, by class "envRefClass", distance 2.
14-
Class \code{"\linkS4class{environment}"}, by class "envRefClass", distance 3, with explicit coerce.
15-
Class \code{"\linkS4class{refObject}"}, by class "envRefClass", distance 3.
12+
\section{Methods}{
13+
\describe{
14+
\item{$}{\code{signature(x = "C++Constructor")}: slot access, kept for backwards compatibility }
15+
\item{$<-}{\code{signature(x = "C++Constructor")}: slot assignment, kept for backwards compatibility }
16+
}
17+
}
18+
\note{
19+
This used to be a reference class. Objects of this class are plain S4
20+
objects now; the slots may still be accessed with \code{$} for backwards
21+
compatibility.
1622
}
1723
\keyword{classes}
18-
\section{Fields}{
24+
\section{Slots}{
1925
\describe{
2026
\item{\code{pointer}:}{pointer to the internal structure that represent the constructor}
2127
\item{\code{class_pointer}:}{pointer to the internal structure that represent the associated C++ class}

‎man/CppField-class.Rd‎

Lines changed: 13 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2,21 +2,27 @@
22
\Rdversion{1.1}
33
\docType{class}
44
\alias{C++Field-class}
5+
\alias{$,C++Field-method}
6+
\alias{$<-,C++Field-method}
57

68
\title{Class "C++Field"}
79
\description{
810
Metadata associated with a field of a class exposed through Rcpp modules
911
}
10-
\section{Fields}{
12+
\section{Slots}{
1113
\describe{
1214
\item{\code{pointer}:}{external pointer to the internal (C++) object that represents fields}
1315
\item{\code{cpp_class}:}{(demangled) name of the C++ class of the field}
1416
\item{\code{read_only}:}{Is this field read only}
1517
\item{\code{class_pointer}:}{external pointer to the class this field is from. }
18+
\item{\code{docstring}:}{docstring of the field}
1619
}
1720
}
1821
\section{Methods}{
19-
No methods defined with class "C++Field" in the signature.
22+
\describe{
23+
\item{$}{\code{signature(x = "C++Field")}: slot access, kept for backwards compatibility }
24+
\item{$<-}{\code{signature(x = "C++Field")}: slot assignment, kept for backwards compatibility }
25+
}
2026
}
2127
\seealso{
2228
The \code{fields} slot of the \code{\linkS4class{C++Class}} class is a
@@ -25,4 +31,9 @@ No methods defined with class "C++Field" in the signature.
2531
\examples{
2632
showClass("C++Field")
2733
}
34+
\note{
35+
This used to be a reference class. Objects of this class are plain S4
36+
objects now; the slots may still be accessed with \code{$} for backwards
37+
compatibility.
38+
}
2839
\keyword{classes}

0 commit comments

Comments
 (0)