Skip to content

Commit

Permalink
finish 86513 {defunctifying & removing "MethodsList"-class related}
Browse files Browse the repository at this point in the history 
git-svn-id: https://svn.r-project.org/R/trunk@86516 00db46b3-68df-0310-9c12-caf00c1e9a41
  • Loading branch information
maechler committed May 3, 2024
1 parent 072155e commit 932c3b9
Show file tree
Hide file tree
Showing 4 changed files with 42 additions and 199 deletions.
173 changes: 0 additions & 173 deletions src/library/methods/R/MethodsList.R
View file
Expand Up @@ -183,179 +183,6 @@ insertMethod <-
}


MethodsListSelect <-
## select the element of a MethodsList object corresponding to the
## actual arguments (as defined in the suppled environment),
## and return the object, extended to include that method if necessary.
##
## Works recursively. At each level finds an argument name from the current `mlist'
## object, and evaluates this argument (if it is not missing), then uses the
## class of the result to select an element of `mlist'. If such an element
## exists and is another `MethodsList' object, `MethodsListSelect' calls itself recursively
## to resolve using further arguments. Matching includes using a default selection or
## a method specifically linked to class `"missing"'. Once a function is found, it
## is returned as the value. If matching fails, NULL is returned.
function(f, env,
mlist = NULL,
fEnv = if(is(fdef, "genericFunction")) environment(fdef) else baseenv(),
finalDefault = finalDefaultMethod(mlist),
evalArgs = TRUE,
useInherited = TRUE, ## supplied when evalArgs is FALSE
fdef = getGeneric(f, where = env), # MUST BE SAFE FROM RECUSIVE METHOD SELECTION
resetAllowed = TRUE # FALSE when called from selectMethod, .findNextMethod
)
{
.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
if(is.null(f)) {} # Recall, not from C
else {
fMethods <- .getMethodsForDispatch(fdef)
if(is.null(mlist) || (evalArgs && is.function(fMethods)))
mlist <- fMethods
}
resetNeeded <- .setIfBase(f, fdef, mlist) # quickly protect against recursion -- see Methods.R
if(resetNeeded) {
on.exit(.setMethodsForDispatch(f, fdef, mlist))
}
if(!is(mlist, "MethodsList")) {
if(is.function(mlist)) # call to f, inside MethodsListSelect
{on.exit(); return(mlist)}
if(is.null(f)) # recursive recall of MethodsListSelect
stop("invalid method sublist")
else if(!is.null(mlist)) # NULL => 1st call to genericFunction
stop(gettextf("%f is not a valid generic function: methods list was an object of class %s",
sQuote(f), dQuote(class(mlist))),
domain = NA)
}
if(!is.logical(useInherited))
stop(gettextf("%s must be TRUE, FALSE, or a named logical vector of those values; got an object of class %s",
sQuote("useInherited"),
dQuote(class(useInherited))),
domain = NA)
if(identical(mlist, .getMethodsForDispatch(fdef))) {
resetNeeded <- TRUE
## On the initial call:
## turn off any further method dispatch on this function, to avoid recursive
## loops if f is a function used in MethodsListSelect.
## TODO: Using namespaces in the methods package would eliminate the need for this
.setMethodsForDispatch(f, fdef, finalDefault)
if(is(mlist, "MethodsList")) {
on.exit(.setMethodsForDispatch(f, fdef, mlist))
}
}
argName <- slot(mlist, "argument")
arg <- NULL ## => don't use instance-specific inheritance
if(evalArgs) {
## check for missing argument. NB: S sense, not that of R base missing()
if(missingArg(argName, env, TRUE))
thisClass <- "missing"
else {
arg <- eval(as.name(argName), env) ## DO use instance-specific inheritance
if(missing(arg)) ## S3 weird R code? Bail out!
return(finalDefault)
thisClass <- .class1(arg)
}
}
else
thisClass <- get(as.character(argName), envir = env, inherits = FALSE)
if(isTRUE(useInherited) || isFALSE(useInherited))
thisInherit <- nextUseInherited <- useInherited
else {
which <- match(as.character(argName), names(useInherited))
if(is.na(which)) {
nextUseInherited <- useInherited
thisInherit <- TRUE
}
else {
thisInherit <- useInherited[[which]]
nextUseInherited <- useInherited[-which]
}
}
fromClass <- thisClass ## will mark the class actually providing the method
allMethods <- mlist@allMethods
which <- match(thisClass, names(allMethods))
inherited <- is.na(which)
selection <- if(inherited) NULL else allMethods[[which]]
if(!inherited) {
if(is.function(selection)) {
if(is.null(f)) {
## An inherited method at the next level up.
## only the inherited method should be added
mlist <- .trimMlist(mlist, fromClass)
}
value <- mlist ## no change
}
else {
## recursive call with NULL function name, to allow search to fail &
## to suppress any reset actions.
method <- Recall(NULL, env, selection, finalDefault = finalDefault,
evalArgs = evalArgs, useInherited = nextUseInherited, fdef = fdef,
)
if(is(method, "EmptyMethodsList"))
value <- method
else {
mlist@allMethods[[which]] <- method
value <- mlist
}
}
}
if(inherited || is(value, "EmptyMethodsList")) {
## direct selection failed at this level or below
method <- NULL
if(thisInherit) {
allSelections <- inheritedSubMethodLists(arg, fromClass, mlist, env)
allClasses <- names(allSelections)
for(i in seq_along(allSelections)) {
selection <- allSelections[[i]]
fromClass <- allClasses[[i]]
if(is.function(selection))
method <- selection
else if(is(selection, "MethodsList")) {
## go on to try matching further arguments
method <- Recall(NULL, env, selection, finalDefault = finalDefault,
evalArgs = evalArgs,
useInherited = nextUseInherited, fdef = fdef)
if(is(method, "EmptyMethodsList"))
selection <- method ## recursive selection failed
}
if(!is(selection, "EmptyMethodsList"))
break
}
}
if((is.null(selection) || is(selection, "EmptyMethodsList"))
&& !is.null(f) && !is.null(finalDefault)) {
## only use the final default method after exhausting all
## other possibilities, at all levels.
method <- finalDefault
fromClass <- "ANY"
}
if(is.null(method) || is(method, "EmptyMethodsList"))
value <- emptyMethodsList(mlist, thisClass) ## nothing found
else {
method <- MethodAddCoerce(method, argName, thisClass, fromClass)
value <- .insertCachedMethods(mlist, as.character(argName), thisClass, fromClass,
method)
}
}
if(!is.null(f)) {
## top level
if(is(value, "EmptyMethodsList")) ## selection failed
value <- NULL
if(resetNeeded) {
on.exit() # cancel the restore of the original mlist
if(resetAllowed) {
if(is.null(value)) resetMlist <- mlist else resetMlist <- value
}
.setMethodsForDispatch(f, fdef, resetMlist)
if(dispatchIsInternal(fdef))
setPrimitiveMethods(f, finalDefault, "set", fdef, resetMlist)
}

}
value
}

emptyMethodsList <- function(mlist, thisClass = "ANY", sublist = list()) {
.MlistDefunct("emptyMethodsList()")
Expand Down
23 changes: 0 additions & 23 deletions src/library/methods/R/RMethodUtils.R
View file
Expand Up @@ -254,29 +254,6 @@ defaultDumpName <-
}


mergeMethods <-
## merge the methods in the second MethodsList object into the first,
## and return the merged result.
function(m1, m2, genericLabel = character())
{
.MlistDefunct("mergeMethods()")
if(length(genericLabel) && is(m2, "MethodsList"))
m2 <- .GenericInPrimitiveMethods(m2, genericLabel)
if(is.null(m1) || is(m1, "EmptyMethodsList"))
return(m2)
tmp <- listFromMlist(m2)
sigs <- tmp[[1]]
methods <- tmp[[2]]
for(i in seq_along(sigs)) {
sigi <- sigs[[i]]
if(.noMlists() && !identical(unique(sigi), "ANY"))
next
args <- names(sigi)
m1 <- insertMethod(m1, as.character(sigi), args, methods[[i]], FALSE)
}
m1
}

doPrimitiveMethod <-
## do a primitive call to builtin function 'name' the definition and call
## provided, and carried out in the environment 'ev'.
Expand Down
40 changes: 40 additions & 0 deletions src/library/methods/R/methods-defunct.R
View file
Expand Up @@ -35,6 +35,46 @@
## </entry>


## <entry>
## Defunct in 4.5.0
MethodsListSelect <-
## select the element of a MethodsList object corresponding to the
## actual arguments (as defined in the suppled environment),
## and return the object, extended to include that method if necessary.
##
## Works recursively. At each level finds an argument name from the current `mlist'
## object, and evaluates this argument (if it is not missing), then uses the
## class of the result to select an element of `mlist'. If such an element
## exists and is another `MethodsList' object, `MethodsListSelect' calls itself recursively
## to resolve using further arguments. Matching includes using a default selection or
## a method specifically linked to class `"missing"'. Once a function is found, it
## is returned as the value. If matching fails, NULL is returned.
function(f, env,
mlist = NULL,
fEnv = if(is(fdef, "genericFunction")) environment(fdef) else baseenv(),
finalDefault = finalDefaultMethod(mlist),
evalArgs = TRUE,
useInherited = TRUE, ## supplied when evalArgs is FALSE
fdef = getGeneric(f, where = env), # MUST BE SAFE FROM RECUSIVE METHOD SELECTION
resetAllowed = TRUE # FALSE when called from selectMethod, .findNextMethod
)
{
.MlistDefunct("MethodsListSelect()")
}
## </entry>


## <entry>
## Defunct in 4.5.0
mergeMethods <-
## merge the methods in the second MethodsList object into the first,
## and return the merged result.
function(m1, m2, genericLabel = character())
{
.MlistDefunct("mergeMethods()")
}
## </entry>

## <entry>
## Defunct in 4.5.0
## Removed in 4.5.0
Expand Down
5 changes: 2 additions & 3 deletions src/library/methods/man/RMethodUtils.Rd
View file
Expand Up @@ -46,8 +46,7 @@
by the user.

Partly, they work with S4 classes which are also normally not for the
user, see their help page \code{\linkS4class{optionalMethods}}.

user, see their help page \code{\linkS4class{optionalMethod}}.
}
\usage{
getGeneric(f, mustFind=FALSE, where, package)
Expand Down Expand Up @@ -103,7 +102,7 @@ insertClassMethods(methods, Class, value, fieldNames, returnAll)
balanceMethodsList(mlist, args, check = TRUE) # <- defunct since R 4.5.0

substituteFunctionArgs(def, newArgs, args = formalArgs(def),
silent = FALSE, functionName = "a function")
silent = FALSE, functionName = "a function")

.valueClassTest(object, classes, fname)
}
Expand Down

0 comments on commit 932c3b9

Please sign in to comment.