Add backport of utils::isS3stdGeneric() for R < 4.1.0

[rossellhayes]

This PR adds a backport of utils::isS3stdGeneric() for R < 4.1.0.

While utils::isStdGeneric() was available starting in R 3.4.0, the implementation prior to R 4.1.0 would throw an error when testing user-defined functions.

f <- function(x) x

# R 3.4.0 version ----

utils::isS3stdGeneric(mean)
#> mean 
#> TRUE
utils::isS3stdGeneric(f)
#> Error in bdexpr[[1L]]: object of type 'symbol' is not subsettable

Backporting the implementation from R 4.1.0 adds support for testing user-defined functions in R < 4.1. For example, this test was run in R 3.6:

# R 4.1.0 version ----

isS3stdGeneric <- function(f) {
  bdexpr <- body(if(methods::is(f, "traceable")) f@original else f)
  ## protect against technically valid but bizarre
  ## function(x) { { { UseMethod("gen")}}} by
  ## repeatedly consuming the { until we get to the first non { expr
  while(is.call(bdexpr) && bdexpr[[1L]] == "{")
    bdexpr <- bdexpr[[2L]]
  
  ## We only check if it is a "standard" s3 generic. i.e. the first non-{
  ## expression is a call to UseMethod. This will return FALSE if any
  ## work occurs before the UseMethod call ("non-standard" S3 generic)
  ret <- is.call(bdexpr) && bdexpr[[1L]] == "UseMethod"
  if(ret)
    names(ret) <- bdexpr[[2L]] ## arg passed to UseMethod naming generic
  ret
}

isS3stdGeneric(mean)
#> mean 
#> TRUE
isS3stdGeneric(f)
#> [1] FALSE

^{Created on 2023-03-31 by the reprex package (v2.0.1)}