new .internalGenerics (instead of wrong claim in doc)

git-svn-id: https://svn.r-project.org/R/trunk@84765 00db46b3-68df-0310-9c12-caf00c1e9a41
r-devel · Jul 27, 2023 · 986b3be · 986b3be
1 parent 9b8ff09
commit 986b3be
Show file tree

Hide file tree

Showing 5 changed files with 36 additions and 12 deletions.
diff --git a/doc/NEWS.Rd b/doc/NEWS.Rd
@@ -78,6 +78,9 @@
  infinite entries, analogously to \code{range.default()}, as proposed
  by Davis Vaughan on R-devel. Other \code{range()}-methods can make
  use of new \code{.rangeNum()}.
+
+ \item New \code{.internalGenerics} complementing \code{.S3PrimitiveGenerics},
+ for documentation and low-level book keeping.
  }
  }
 

diff --git a/src/library/base/R/New-Internal.R b/src/library/base/R/New-Internal.R
@@ -318,5 +318,10 @@ lengths <- function(x, use.names=TRUE) .Internal(lengths(x, use.names))
 mem.maxVSize <- function(vsize = 0) .Internal(mem.maxVSize(vsize))
 mem.maxNSize <- function(nsize = 0) .Internal(mem.maxNSize(nsize))
 
+## The *non*-primitive internal generics; .Primitive ones = .S3PrimitiveGenerics ( ./zzz.R )
+.internalGenerics <-
+ c("as.vector", "cbind", "rbind", "unlist",
+ "is.unsorted", "lengths", "nchar", "rep.int", "rep_len")
+
 ## base has no S4 generics
 .noGenerics <- TRUE
diff --git a/src/library/base/man/InternalMethods.Rd b/src/library/base/man/InternalMethods.Rd
@@ -1,14 +1,15 @@
 % File src/library/base/man/zMethods.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2015 R Core Team
+% Copyright 1995-2023 R Core Team
 % Distributed under GPL 2 or later
 
 \name{InternalMethods}
+\title{Internal Generic Functions}
 \alias{InternalMethods}
 \alias{InternalGenerics}
 \alias{internal generic}
 \alias{.S3PrimitiveGenerics}
-\title{Internal Generic Functions}
+\alias{.internalGenerics}
 \description{
  Many \R-internal functions are \emph{generic} and allow
  methods to be written for.
@@ -56,9 +57,9 @@
  % DispatchOrEval internal generic: @
  \code{\link{@}},% % do_AT() [attrib.c]
  % DispatchOrEval internal generic: @<-
- \code{\link{@<-}},% % do_attrgets() [attrib.c] 
+ \code{\link{@<-}},% % do_attrgets() [attrib.c]
 
- % DispatchOrEval internal generic: c 
+ % DispatchOrEval internal generic: c
  \code{\link{c}},% % do_c() [bind.c]
  % DispatchOrEval internal generic: unlist
  \code{\link{unlist}},% % do_unlist() [bind.c]
@@ -90,7 +91,7 @@
  % DispatchOrEval internal generic: is.na
  \code{\link{is.na}},% % do_isna() [coerce.c]
  % DispatchOrEval internal generic: anyNA
- \code{\link{anyNA}},% % do_anyNA() [coerce.c] 
+ \code{\link{anyNA}},% % do_anyNA() [coerce.c]
  % DispatchOrEval internal generic: is.nan
  \code{\link{is.nan}},% % do_isnan() [coerce.c]
  % DispatchOrEval internal generic: is.finite
@@ -126,11 +127,13 @@
  internal/primitive and allow methods to be written for them.
 
  \code{.S3PrimitiveGenerics} is a character vector listing the
- primitives which are internal generic and not \link{group generic}.
- Currently \code{\link{as.vector}}, \code{\link{cbind}},
- \code{\link{rbind}} and \code{\link{unlist}} are the internal
- non-primitive functions which are internally generic.
-
+ primitives which are internal generic and not \link{group generic},
+ (not only for {S3} but also {S4}).
+ Similarly, the \code{.internalGenerics} character vector contains the names
+ of the internal (via \code{\link{.Internal}(..)}) non-primitive functions
+ which are internally generic.
+}
+\note{
  For efficiency, internal dispatch only occurs on \emph{objects}, that
  is those for which \code{\link{is.object}} returns true.
 }

diff --git a/src/library/tools/tests/S3.R b/src/library/tools/tests/S3.R
@@ -6,3 +6,16 @@
  stopifnot(identical(base:::.S3_methods_table, # >>> end of ../../base/R/zzz.R ; update *there* !
  tools:::.make_S3_methods_table_for_base()))
 })()
+
+
+## check that all .internalGenerics have .Internal :
+(iGens <- .internalGenerics)
+names(iGens) <- iGens
+str(bdI <- lapply(iGens, body))
+stopifnot(lengths(bdI) >= 2L)
+
+is.qI <- function(.) identical(., quote(.Internal))
+has.qI <- function(E) is.qI(E) || is.qI(E[[1L]])
+str(l1 <- lapply(bdI, \(bd) if(bd[[1]] == quote(`{`)) bd[[length(bd)]] else bd[[1]]))
+(r <- vapply(l1, \(b) has.qI(b) || has.qI(b[[length(b)]]), NA))
+stopifnot(r)
diff --git a/tests/demos.Rout.save b/tests/demos.Rout.save
@@ -1,5 +1,5 @@
 
-R Under development (unstable) (2023-05-17 r84444) -- "Unsuffered Consequences"
+R Under development (unstable) (2023-07-27 r84763) -- "Unsuffered Consequences"
 Copyright (C) 2023 The R Foundation for Statistical Computing
 Platform: aarch64-apple-darwin22.4.0 (64-bit)
 
@@ -245,7 +245,7 @@ List of 3
 + "\n\t starting with 'is.' :\t ",
 + sum(grepl("^is\\.", ls.base[base.is.f])), "\n", sep = "")
 
-Number of all base objects: 1390
+Number of all base objects: 1391
 Number of functions from these: 1346
  starting with 'is.' : 53