Initial exploration of class methods

R/class.R

@@ -90,6 +90,7 @@ new_class <- function(
     parent = R7_object,
     package = NULL,
     properties = list(),
+    methods = list(),
     constructor = NULL,
     validator = NULL) {
 
@@ -120,6 +121,10 @@ new_class <- function(
   new_props <- as_properties(properties)
   all_props[names(new_props)] <- new_props
 
+  # Combine methods from parent, overriding as needed
+  all_methods <- attr(parent, "methods", exact = TRUE) %||% list()
+  all_methods[names(methods)] <- methods
+
   if (is.null(constructor)) {
     constructor <- new_constructor(parent, all_props)
   }
@@ -130,14 +135,15 @@ new_class <- function(
   attr(object, "parent") <- parent
   attr(object, "package") <- package
   attr(object, "properties") <- all_props
+  attr(object, "methods") <- all_methods
   attr(object, "constructor") <- constructor
   attr(object, "validator") <- validator
   class(object) <- c("R7_class", "R7_object")
 
   global_variables(names(all_props))
   object
 }
-globalVariables(c("name", "parent", "package", "properties", "constructor", "validator"))
+globalVariables(c("name", "parent", "package", "properties", "methods", "constructor", "validator"))
 
 R7_class_name <- function(x) {
   paste(c(x@package, x@name), collapse = "::")

R/method.R

@@ -0,0 +1,15 @@
+method_exists <- function(object, name) {
+  if (!inherits(object, "R7_object")) return(FALSE)
+  name %in% names(attr(R7_class(object), "methods"))
+}
+
+method_val <- function(object, name) {
+  class <- R7_class(object)
+  method <- class@methods[[name]]
+
+  # TODO: clone arguments
+  # TODO: think about performance?
+  function(...) {
+    method(object, ...)
+  }
+}

R/property.R

@@ -152,10 +152,12 @@ prop_default <- function(prop) {
 prop <- function(object, name) {
   check_R7(object)
 
-  if (!prop_exists(object, name)) {
-    stop(prop_error_unknown(object, name))
-  } else {
+  if (prop_exists(object, name)) {
     prop_val(object, name)
+  } else if (method_exists(object, name)) {
+    method_val(object, name)
+  } else {
+    stop(prop_error_unknown(object, name))
   }
 }
 
@@ -264,7 +266,7 @@ prop_names <- function(object) {
 
   if (inherits(object, "R7_class")) {
     # R7_class isn't a R7_class (somewhat obviously) so we fake the property names
-    c("name", "parent", "package", "properties", "constructor", "validator")
+    c("name", "parent", "package", "properties", "methods", "constructor", "validator")
   } else {
     class <- R7_class(object)
     props <- attr(class, "properties", exact = TRUE)

tests/testthat/_snaps/class.md

@@ -29,6 +29,7 @@
        ..  ..$ getter :  NULL
        ..  ..$ setter :  NULL
        ..  ..$ default:  NULL
+      @ methods    :  list()
       @ constructor:  function (x = missing_class, y = missing_class)  
       @ validator  :  NULL
     Code