diff options
| -rw-r--r-- | share/txr/stdlib/struct.tl | 4 | ||||
| -rw-r--r-- | struct.c | 39 | ||||
| -rw-r--r-- | struct.h | 2 | ||||
| -rw-r--r-- | tests/012/oop.expected | 1 | ||||
| -rw-r--r-- | tests/012/oop.tl | 3 | ||||
| -rw-r--r-- | txr.1 | 36 |
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))) @@ -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) @@ -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) @@ -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 |