[Rd] [Q] Get formal arguments of my implemented S4 method

[Hadley Wickham]

On Thu, Jan 29, 2015 at 7:57 AM, John Chambers <jmc at r-project.org> wrote:
>
> On Jan 28, 2015, at 6:37 PM, Michael Lawrence <lawrence.michael at gene.com> 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 <- x at .Data

  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/