Static-type function operator

static.R

# Static-type function operator
# Usage:
# int_mult = integer %:% function(integer..x, integer..y) { x * y }
`%:%` = function(..type, ..fun) {
  ..arg_types = get_arg_types(fun = ..fun)
  ..fun = untype_args(fun = ..fun, types = ..arg_types)
  function(...) {
    ..args = match.call(..fun)[-1]
    validate_args(args = ..args, types = ..arg_types)
    ..res = eval(..fun(...), envir = environment(..fun))
    ..type_name = class(eval(..type()))
    stopifnot(isTRUE(is(..res, ..type_name)))
    ..res
  }
}

get_arg_types = function(fun) {
  sapply(
    formalArgs(fun),
    function(arg) {
      type_name = strsplit(arg, split = "..", fixed = TRUE)[[1]]
      if (length(type_name) != 2 || type_name[1] == "") {
        structure(NA_character_, names = arg)
      } else {
        structure(type_name[1], names = type_name[2])
      }
    },
    USE.NAMES = FALSE
  )
}

untype_args = function(fun, types) {
  names(formals(fun)) = names(types)
  fun
}

validate_args = function(args, types) {
  for (arg_name in intersect(names(args), names(types[!is.na(types)]))) {
    stopifnot(is(args[[arg_name]], types[[arg_name]]))
  }
}