On Thu, Jan 29, 2015 at 7:57 AM, John Chambers <[email protected]> wrote:
>
> On Jan 28, 2015, at 6:37 PM, Michael Lawrence <[email protected]>
> wrote:
>
>> At this point I would just due:
>>
>> formals(body(method)[[2L]])
>>
>> At some point we need to figure out what to do with this .local() confusion.
>
> Agreed, definitely. The current hack is to avoid re-matching arguments on
> method dispatch, so a fix would need to be fairly deep in the implementation.
>
> But I don't think the expression above is quite right. body(method)[[2L]] is
> the assignment. You need to evaluate the rhs.
>
> Here is a function that does the same sort of thing, and returns the standard
> formals for the generic if this method does not have nonstandard arguments.
> We should probably add a version of this function for 3.3.0, so user code
> doesn't have hacks around the current hack.
>
> methodFormals <- function(f, signature = character()) {
> fdef <- getGeneric(f)
> method <- selectMethod(fdef, signature)
> genFormals <- base::formals(fdef)
> b <- body(method)
> if(is(b, "{") && is(b[[2]], "<-") && identical(b[[2]][[2]],
> as.name(".local"))) {
> local <- eval(b[[2]][[3]])
> if(is.function(local))
> return(formals(local))
> warning("Expected a .local assignment to be a function. Corrupted
> method?")
> }
> genFormals
> }
I have similar code in roxygen2:
# When a generic has ... and a method adds new arguments, the S4 method
# wraps the definition inside another function which has the same arguments
# as the generic. This function figures out if that's the case, and extracts
# the original function if so.
#
# It's based on expression processing based on the structure of the
# constructed method which looks like:
#
# function (x, ...) {
# .local <- function (x, ..., y = 7) {}
# .local(x, ...)
# }
extract_method_fun <- function(x) {
fun <- [email protected]
method_body <- body(fun)
if (!is.call(method_body)) return(fun)
if (!identical(method_body[[1]], quote(`{`))) return(fun)
first_line <- method_body[[2]]
if (!is.call(first_line)) return(fun)
if (!identical(first_line[[1]], quote(`<-`))) return(fun)
if (!identical(first_line[[2]], quote(`.local`))) return(fun)
first_line[[3]]
}
--
http://had.co.nz/
______________________________________________
[email protected] mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
