Support curried arguments in umethod and umeth.

* share/txr/stdlib/struct.tl (umeth): accept variadic
arguments. Evaluate them using the dwim brackets
and pass to umethod. The (fun umethod) trick is
used to refer to the umethod in the function namespace
even if it is shadowed by a variable.

* struct.c (struct_init): Update registration of umethod to
reflect its new variadic argument signature.
(umethod_args_fun): New static function.
(umethod): Return a function based on umethod_fun,
as before, if there are no variadic args. Otherwise,
use umethod_args_fun which deals with them.

* struct.h (umethod): Declaration updated.

* tests/012/oop.tl: Modest testcase for umeth
with curried argument.

* tests/012/oop.expected: Updated.

* txr.1: Updated documentation of umeth and umethod.

6 files changed, 71 insertions, 14 deletions

diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl
index e79dd3ed..9f643662 100644
--- a/share/txr/stdlib/struct.tl
+++ b/share/txr/stdlib/struct.tl
@@ -236,8 +236,8 @@
 (defmacro usl (slot)
   ^(uslot ',slot))
 
-(defmacro umeth (slot)
-  ^(umethod ',slot))
+(defmacro umeth (slot . bound-args)
+  ^[(fun umethod) ',slot ,*bound-args])
 
 (defun sys:defmeth (type-sym name fun)
   (let ((type (find-struct-type type-sym)))
diff --git a/struct.c b/struct.c
index f8ed361d..61ce4174 100644
--- a/struct.c
+++ b/struct.c
@@ -154,7 +154,7 @@ void struct_init(void)
   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("uslot"), user_package), func_n1(uslot));
-  reg_fun(intern(lit("umethod"), user_package), func_n1(umethod));
+  reg_fun(intern(lit("umethod"), user_package), func_n1v(umethod));
 }
 
 static noreturn void no_such_struct(val ctx, val sym)
@@ -1158,9 +1158,42 @@ static val umethod_fun(val sym, struct args *args)
   }
 }
 
-val umethod(val slot)
+static val umethod_args_fun(val env, struct args *args)
 {
-  return func_f0v(slot, umethod_fun);
+  val self = lit("umethod");
+  cons_bind (sym, curried_args, env);
+
+  if (!args_more(args, 0)) {
+    uw_throwf(error_s, lit("~a: object argument required to call ~s"),
+              self, env, nao);
+  } else {
+    cnum ca_len = c_num(length(curried_args));
+    cnum index = 0;
+    val strct = args_get(args, &index);
+    args_decl(args_call, max(args->fill + ca_len, ARGS_MIN));
+    args_add(args_call, strct);
+    args_add_list(args_call, curried_args);
+    args_normalize(args_call, ca_len + 1);
+    args_cat_zap_from(args_call, args, index);
+
+    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_call);
+    }
+
+    no_such_slot(self, si->type->self, sym);
+  }
+}
+
+val umethod(val slot, struct args *args)
+{
+  if (!args_more(args, 0))
+    return func_f0v(slot, umethod_fun);
+  else
+    return func_f0v(cons(slot, args_get_list(args)), umethod_args_fun);
 }
 
 static void struct_inst_print(val obj, val out, val pretty)
diff --git a/struct.h b/struct.h
index 3923a2f2..5d116807 100644
--- a/struct.h
+++ b/struct.h
@@ -52,6 +52,6 @@ val struct_type(val strct);
 val method(val strct, val slotsym);
 val super_method(val strct, val slotsym);
 val uslot(val slot);
-val umethod(val slot);
+val umethod(val slot, struct args *);
 val method_name(val fun);
 void struct_init(void);
diff --git a/tests/012/oop.expected b/tests/012/oop.expected
index f0bb554f..433a51d2 100644
--- a/tests/012/oop.expected
+++ b/tests/012/oop.expected
@@ -11,6 +11,7 @@ animal
 canine
 collie
 poodle
+colliecanine
 #S(b a 1 b 2 c 3)
 #S(d a nil b -2 c 3)
 (10 20 300 42 42)
diff --git a/tests/012/oop.tl b/tests/012/oop.tl
index 24cf2726..52fe30bb 100644
--- a/tests/012/oop.tl
+++ b/tests/012/oop.tl
@@ -40,6 +40,9 @@
 
 (pprinl (new poodle))
 
+(mapcar (umeth print *stdout*) (list (new collie) (new dog)))
+(put-line)
+
 (defstruct b nil
   (:instance a 1)
   (:instance b 2)
diff --git a/txr.1 b/txr.1
index d8f0f48a..4e9f4b7f 100644
--- a/txr.1
+++ b/txr.1
@@ -20963,7 +20963,7 @@ in a function slot.
 
 .coNP Macro @ umeth
 .synb
-.mets (umeth << slot )
+.mets (umeth << slot << curried-expr *)
 .syne
 .desc
 The
@@ -20972,24 +20972,37 @@ macro binds the symbol
 .meta slot
 to a function and returns that function.
 
+The
+.meta curried-expr
+arguments, if present, are evaluated as if they were
+arguments to the
+.code dwim
+operator.
+
 When that function is called, it expects at least one argument.
 The leftmost argument must be an object of struct type.
 
 The slot named
 .meta slot
 is retrieved from that object, and is expected to be a function.
-That function is called with the same arguments.
+That function is called with the object, followed by the values
+of the
+.metn curried-expr -s,
+if any, followed by that function's arguments.
 
 The syntax can be understood as a translation to a call of the
 .code umethod
 function:
 
 .cblk
-  (umeth s)  <-->  (umethod 's)
+  (umeth s ...)  <-->  [umethod 's ...]
 .cble
 
 The macro merely provides the syntactic sugar of not having to quote the
-symbol.
+symbol, and automatically treating the curried argument expressions
+using Lisp-1 semantics of the
+.code dwim
+operator.
 
 .TP* Example:
 
@@ -21598,7 +21611,7 @@ own arguments.
 
 .coNP Function @ umethod
 .synb
-.mets (umethod << slot-name )
+.mets (umethod << slot-name << curried-arg *)
 .syne
 .desc
 The
@@ -21611,12 +21624,19 @@ The
 .meta slot-name
 argument must be a symbol.
 
-This function must be called with at least one argument. The leftmost
+If one or more
+.meta curried-arg
+argument are present, these values represent the
+.I "curried arguments"
+which are stored in the function object which is returned.
+
+This returned function must be called with at least one argument. Its leftmost
 argument must be an object of structure type, which has a slot named
 .metn slot-name .
 The function will retrieve the value of the slot from that object,
-expecting it to be a function, and calls it, passing to it all of its
-arguments.
+expecting it to be a function, and calls it, passing to it the following
+arguments: the object itself; all of the curried arguments, if any; and
+all of its remaining arguments.
 
 Note: the
 .code umethod