s3-method-dispatch.r

iclass <- function(x) {
  c(
    if (is.matrix(x)) "matrix",
    if (is.array(x) && !is.matrix(x)) "array",
    if (is.double(x)) "double",
    if (is.integer(x)) "integer",
    mode(x)
  )
}
method_names <- function(generic, x) {
  paste0(generic, ".", c(class(x), iclass(x), "default"))
}
s3_dispatch <- function(call) {
  call <- substitute(call)
  generic <- as.character(call[[1]])
  object <- eval(call[[2]], parent.frame())
  methods <- method_names(generic, object)
    exists <- vapply(methods, exists, logical(1))
    cat(paste0(ifelse(exists, "*", " "), " ", methods, 
      collapse = "\n"), "\n", sep = "")
}

x <- Sys.time()
s3_dispatch(print(x))
s3_dispatch(is.numeric(x))
s3_dispatch(as.Date(x))