From f55a50575bfe83ad320612833811640e5d8f8f12 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 3 Oct 2015 17:16:51 -0700
Subject: New umeth and umethod macro and function.

* share/txr/stdlib/struct.tl (umeth): New macro.

* struct.c (struct_init): Registered umethod intrinsic.
(umethod_fun): New static function.
(umethod): New function.

* txr.1: Documented.
---
 struct.c | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

(limited to 'struct.c')

diff --git a/struct.c b/struct.c
index 30f0ad15..1456b3b1 100644
--- a/struct.c
+++ b/struct.c
@@ -126,6 +126,7 @@ void struct_init(void)
   reg_fun(intern(lit("struct-type"), user_package), func_n1(struct_type));
   reg_fun(intern(lit("method"), user_package), func_n2(method));
   reg_fun(intern(lit("super-method"), user_package), func_n2(super_method));
+  reg_fun(intern(lit("umethod"), user_package), func_n1(umethod));
 }
 
 static noreturn void no_such_struct(val ctx, val sym)
@@ -691,6 +692,32 @@ val super_method(val strct, val slotsym)
   return func_f0v(cons(super_slot, strct), method_fun);
 }
 
+static val umethod_fun(val sym, struct args *args)
+{
+  val self = lit("umethod");
+
+  if (args->argc == 0) {
+    uw_throwf(error_s, lit("~a: object argument required to call ~s"),
+              self, env, nao);
+  } else {
+    val strct = args->arg[0];
+    struct struct_inst *si = struct_handle(strct, self);
+
+    if (symbolp(sym)) {
+      loc ptr = lookup_slot(strct, si, sym);
+      if (!nullocp(ptr))
+        return generic_funcall(deref(ptr), args);
+    }
+
+    no_such_slot(self, si->type, sym);
+  }
+}
+
+val umethod(val slot)
+{
+  return func_f0v(slot, umethod_fun);
+}
+
 static void struct_inst_print(val obj, val out, val pretty)
 {
   struct struct_inst *si = coerce(struct struct_inst *, obj->co.handle);
-- 
cgit v1.2.3