Skip to content

Commit

Permalink
deprecating another dozen functions useing MethodsList class (now d…
Browse files Browse the repository at this point in the history 
…efunct)

git-svn-id: https://svn.r-project.org/R/trunk@86513 00db46b3-68df-0310-9c12-caf00c1e9a41
  • Loading branch information
maechler committed May 3, 2024
1 parent 145c843 commit 4e9cc9b
Show file tree
Hide file tree
Showing 19 changed files with 352 additions and 556 deletions.
4 changes: 4 additions & 0 deletions doc/NEWS.Rd
View file
Expand Up @@ -31,6 +31,10 @@
\itemize{
\item \code{is.R()} is defunct. Environment variable
\env{_R_DEPRECATED_IS_R_} no longer has any effect.
\item Several deprecated auxiliary functions and the
\code{MethodsList} class for S4 method handling are now defunct in
package \pkg{methods}, or have even been removed.
}
}
Expand Down
5 changes: 1 addition & 4 deletions src/library/methods/NAMESPACE
View file
Expand Up @@ -97,7 +97,7 @@ export(getGroup)
export(getGroupMembers)
export(getLoadActions)
export(getMethod)
export(getMethods)
export(getMethods) # "semi"-deprecated
export(getMethodsForDispatch)
export(getMethodsMetaData)
export(getPackageName)
Expand Down Expand Up @@ -125,9 +125,7 @@ export(isVirtualClass)
export(isXS3Class)
export(languageEl)
export("languageEl<-")
export(linearizeMlist)
export(listFromMethods)
export(listFromMlist)
export(loadMethod)
export(makeClassRepresentation)
export(makeExtends)
Expand Down Expand Up @@ -186,7 +184,6 @@ export(showClass)
export(showDefault)
export(showExtends)
export(showMethods)
export(showMlist)
export(sigToEnv)
export(signature)
export(slot, "slot<-", ".hasSlot")
Expand Down
5 changes: 2 additions & 3 deletions src/library/methods/R/ClassUnion.R
View file
Expand Up @@ -27,9 +27,8 @@
}, where = where)
## some classes in methods package are unions--now they can be officially
setClassUnion("OptionalFunction", c("function", "NULL"), where)
setClassUnion("PossibleMethod", c("function", "MethodDefinition"), where)
clList <- c("ClassUnionRepresentation", "OptionalFunction",
"PossibleMethod")
## rather in ./MethodsListClass.R .InitMethod...(): setClassUnion("PossibleMethod", .....)
clList <- c("ClassUnionRepresentation", "OptionalFunction")
assign(".SealedClasses", c(get(".SealedClasses", where), clList), where)
}

Expand Down
213 changes: 14 additions & 199 deletions src/library/methods/R/MethodsList.R
View file
@@ -1,7 +1,7 @@
# File src/library/methods/R/MethodsList.R
# Part of the R package, https://www.R-project.org
#
# Copyright (C) 1995-2018 The R Core Team
# Copyright (C) 1995-2024 The R Core Team
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
Expand Down Expand Up @@ -34,7 +34,7 @@ MethodsList <-
## methods and, in R, to emulate S4-style methods.
function(.ArgName, ...)
{
.MlistDeprecated("MethodsList()")
.MlistDefunct("MethodsList")
value <- makeMethodsList(list(...))
if(is.name(.ArgName)){}
else if(is.character(.ArgName) && length(.ArgName) == 1)
Expand All @@ -46,7 +46,7 @@ MethodsList <-

makeMethodsList <- function(object, level=1)
{
.MlistDeprecated("makeMethodsList()")
.MlistDefunct("makeMethodsList()")
mnames <- allNames(object)
if(.noMlists()) {
keep <- mnames %in% c("", "ANY")
Expand Down Expand Up @@ -91,7 +91,7 @@ SignatureMethod <-
## the signatures.
function(names, signature, definition)
{
.MlistDeprecated("SignatureMethod()")
.MlistDefunct("SignatureMethod()")
n <- length(signature)
if(n > length(names))
stop("arguments 'names' and 'signature' must have the same length")
Expand All @@ -111,7 +111,7 @@ insertMethod <-
## the signature, and return the modified MethodsList.
function(mlist, signature, args, def, cacheOnly = FALSE)
{
.MlistDeprecated("insertMethod()")
.MlistDefunct("insertMethod()")
if(.noMlists() && !identical(unique(signature), "ANY"))
return(mlist)
## Checks for assertions about valid calls.
Expand Down Expand Up @@ -205,7 +205,7 @@ MethodsListSelect <-
resetAllowed = TRUE # FALSE when called from selectMethod, .findNextMethod
)
{
.MlistDeprecated("MethodsListSelect()")
.MlistDefunct("MethodsListSelect()")
if(!resetAllowed) # ensure we restore the real methods for this function
resetMlist <- .getMethodsForDispatch(fdef)
## look for call from C dispatch code during another call to MethodsListSelect
Expand Down Expand Up @@ -358,13 +358,13 @@ MethodsListSelect <-
}

emptyMethodsList <- function(mlist, thisClass = "ANY", sublist = list()) {
.MlistDeprecated("emptyMethodsList()")
.MlistDefunct("emptyMethodsList()")
sublist[thisClass] <- list(NULL)
new("EmptyMethodsList", argument = mlist@argument, sublist = sublist)
}

insertMethodInEmptyList <- function(mlist, def) {
.MlistDeprecated("insertMethodInEmptyList()")
.MlistDefunct("insertMethodInEmptyList()")
value <- new("MethodsList", argument = mlist@argument)
sublist <- mlist@sublist
submethods <- sublist[[1L]]
Expand Down Expand Up @@ -399,7 +399,7 @@ finalDefaultMethod <-
domain = NA)
}
method
}
}


inheritedSubMethodLists <-
Expand All @@ -412,7 +412,7 @@ inheritedSubMethodLists <-
## on which methods were previously used. See the detailed discussion of methods.)
function(object, thisClass, mlist, ev)
{
.MlistDeprecated("inheritedSubMethodLists()")
.MlistDefunct("inheritedSubMethodLists()")
methods <- slot(mlist, "methods")## only direct methods
defaultMethod <- methods[["ANY"]]## maybe NULL
classes <- names(methods)
Expand Down Expand Up @@ -606,79 +606,6 @@ matchSignature <-
value
}

showMlist <-
## Prints the contents of the MethodsList. If `includeDefs' the signatures and the
## corresponding definitions will be printed; otherwise, only the signatures.
##
## If `includeDefs' is `TRUE', the currently known inherited methods are included;
## otherwise, only the directly defined methods.
function(mlist, includeDefs = TRUE, inherited = TRUE, classes = NULL, useArgNames = TRUE,
printTo = stdout())
{
.MlistDeprecated("showMlist()")
if(isFALSE(printTo)) {
tmp <- tempfile()
con <- file(tmp, "w")
}
else
con <- printTo
object <- linearizeMlist(mlist, inherited)
methods <- object@methods
signatures <- object@classes
args <- object@arguments
if(!is.null(classes) && length(signatures)>0) {
keep <- !vapply(signatures, function(x, y) all(is.na(match(x, y))), NA, classes)
methods <- methods[keep]
signatures <- signatures[keep]
args <- args[keep]
}
if(length(methods) == 0)
cat(file=con, "<Empty Methods List>\n")
else {
n <- length(methods)
labels <- character(n)
if(useArgNames) {
for(i in 1L:n) {
sigi <- signatures[[i]]
labels[[i]] <- paste0(args[[i]], " = \"", sigi, "\"",
collapse = ", ")
}
}
else {
for(i in 1L:n)
labels[[i]] <- paste(signatures[[i]], collapse = ", ")
}
for(i in seq_along(methods)) {
cat(file=con, (if(includeDefs) "## Signature:" else ""), labels[[i]])
method <- methods[[i]]
if(includeDefs) {
cat(file=con, ":\n")
if(is(method, "MethodDefinition")) ## really an assertion
cat(file=con, deparse(method@.Data), sep="\n")
else
cat(file=con, deparse(method), sep="\n")
}
if(is(method, "MethodDefinition") &&
!identical(method@target, method@defined)) {
defFrom <- method@defined
cat(file = con, if(includeDefs) "##:" else "\n",
" (inherited from ",
paste0(names(defFrom), " = \"",
as.character(defFrom), "\"",
collapse = ", "),
")", if(includeDefs) "\n", sep="")
}
cat(file=con, "\n")
}
}
if(isFALSE(printTo)) {
close(con)
value <- readLines(tmp)
unlink(tmp)
value
}
}

promptMethods <- function(f, filename = NULL, methods)
{
## Generate information in the style of 'prompt' for the methods of
Expand Down Expand Up @@ -760,107 +687,8 @@ promptMethods <- function(f, filename = NULL, methods)
invisible(filename)
}

##' only called from showMlist() above, which has been deprecated in R 3.2.0 (Apr.2015):
linearizeMlist <-
## Undo the recursive nature of the methods list, making a list of
## function definitions, with the names of the list being the
## corresponding signatures (designed for printing; for looping over
## the methods, use `listFromMlist' instead).
##
## The function calls itself recursively. `prev' is the previously
## selected class names.
##
## If argument `classes' is provided, only signatures containing one
## of these classes will be included.
function(mlist, inherited = TRUE) {
methods <- mlist@methods
allMethods <- mlist@allMethods
if(inherited && length(allMethods) >= length(methods)) {
## anames <- names(allMethods)
## inh <- is.na(match(anames, names(methods)))
methods <- allMethods
}
preC <- function(y, x)c(x,y) # used with lapply below
cnames <- names(methods)
value <- list()
classes <- list()
arguments <- list()
argname <- as.character(mlist@argument)
for(i in seq_along(cnames)) {
mi <- methods[[i]]
if(is.function(mi)) {
value <- c(value, list(mi))
classes <- c(classes, list(cnames[[i]]))
arguments <- c(arguments, list(argname))
}
else if(is(mi, "MethodsList")) {
.MlistDeprecated()
mi <- Recall(mi, inherited)
value <- c(value, mi@methods)
classes <- c(classes, lapply(mi@classes, preC, cnames[[i]]))
arguments <- c(arguments, lapply(mi@arguments, preC, argname))
}
else
warning(gettextf("skipping methods list element %s of unexpected class %s\n\n",
paste(cnames[i], collapse = ", "),
dQuote(.class1(mi))),
domain = NA)
}
new("LinearMethodsList", methods = value, classes = classes, arguments = arguments)
}

print.MethodsList <- function(x, ...)
showMlist(x)


## In R's own code, this is *only* used in mergeMethods(), deprecated in R 3.2.0 (Apr.2015)
listFromMlist <-
## linearizes the MethodsList object into list(sigs, methods); `prefix' is the partial
## signature (a named list of classes) to be prepended to the signatures in this object.
##
## A utility function used to iterate over all the individual methods in the object.
function(mlist, prefix = list(), sigs. = TRUE, methods. = TRUE)
{
methodSlot <- slot(mlist, "methods")
mnames <- names(methodSlot)
argName <- as.character(slot(mlist, "argument"))
sigs <- list()
methods <- list()
for(i in seq_along(methodSlot)) {
thisMethod <- methodSlot[i]
thisClass <- mnames[[i]]
prefix[[argName]] <- thisClass
if(is.function(thisMethod)) {
if(sigs.) sigs <- c(sigs, list(prefix))
if(methods.) methods <- c(methods, list(thisMethod))
}
else {
more <- Recall(thisMethod, prefix)
if(sigs.) sigs <- c(sigs, more[[1]])
if(methods.) methods <- c(methods, more[[2]])
}
}
list(sigs, methods)
}

.insertCachedMethods <- function(mlist, argName, Class, fromClass, def) {
if(is(def, "MethodsList")) {
.MlistDeprecated()
## insert all the cached methods in def
newArg <- c(argName, as.character(def@argument))
newDefs <- def@allMethods
newSigs <- as.list(names(newDefs))
for(j in seq_along(newDefs))
mlist <- Recall(mlist, newArg, c(Class, newSigs[[j]]), fromClass,
newDefs[[j]])
}
else {
def <- .addMethodFrom(def, argName[1L], Class[1L], fromClass)
mlist <- insertMethod(mlist, Class, argName, def, TRUE)
}
mlist
}

.addMethodFrom <- function(def, arg, Class, fromClass) {
if(is(def, "MethodDefinition")) {
## eventually, we may enforce method definition objects
Expand All @@ -878,29 +706,16 @@ asMethodDefinition <- function(def, signature = list(.anyClassName), sealed = FA
if(is.primitive(def) || is(def, "MethodDefinition"))
def
else {
value = new("MethodDefinition")
value <- new("MethodDefinition")
value@.Data <- def
classes <- .MakeSignature(new("signature"), def, signature, fdef)
value@target <- classes
value@defined <- classes
value@target <- classes
value@defined <- classes
value
}
}

.trimMlist <- function(mlist, fromClass) {
mlist@methods <- mlist@methods[fromClass]
mlist@allMethods <- mlist@allMethods[fromClass]
mlist
}

.noMlistsFlag <- TRUE
.noMlists <- function() {
## if this were to be dynamically variable, but
## it can't, IMO
## isTRUE(getOption("noMlists"))
## so instead
.noMlistsFlag
}
.noMlists <- function() TRUE

.MlistDepTable <- new.env()
.MlistDeprecated <- function(this = "<default>", instead) {
Expand Down

0 comments on commit 4e9cc9b

Please sign in to comment.