diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2019-12-12 18:10:17 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2019-12-13 08:19:53 -0800 |
commit | b1fe95fef05b7e8d26ff82645d373c2ef0b5c449 (patch) | |
tree | 7220391285ce26f06a969d7087396275e50d2e46 | |
parent | 2eaa8bdbb3a6d426a9de4d916dad63f77fd54092 (diff) | |
download | txr-b1fe95fef05b7e8d26ff82645d373c2ef0b5c449.tar.gz txr-b1fe95fef05b7e8d26ff82645d373c2ef0b5c449.tar.bz2 txr-b1fe95fef05b7e8d26ff82645d373c2ef0b5c449.zip |
multiple-inheritance: super-method loose ends.
* struct.c (do_super): New function. Now the common
implementation for call_super_method, call_super_fun and
super_method.
(call_super_method, call_super_fun): Reduced to small wrappers
around do_super.
(super_method): Drill into the object to geet the struct_type
handle, and then use do_super to get the method.
* tests/012/oop-mi.tl: New tests for call-super-fun and
call-super-method.
* tests/012/oop-mi.expected: Updated.
* txr.1: Updated.
-rw-r--r-- | struct.c | 71 | ||||
-rw-r--r-- | tests/012/oop-mi.expected | 6 | ||||
-rw-r--r-- | tests/012/oop-mi.tl | 24 | ||||
-rw-r--r-- | txr.1 | 27 |
4 files changed, 87 insertions, 41 deletions
@@ -1396,39 +1396,56 @@ val static_slot_home(val stype, val sym) no_such_static_slot(self, stype, sym); } -static val call_super_method(val inst, val sym, struct args *args) +static val do_super(struct struct_type *st, + val inst, val sym, val self, + struct args *args) { - val type = struct_type(inst); - val suptype = super(type, zero); + val type = st->self; + cnum i; - if (suptype) { - val meth = static_slot(suptype, sym); - args_decl(args_copy, max(args->fill + 1, ARGS_MIN)); - args_add(args_copy, inst); - args_cat_zap(args_copy, args); - return generic_funcall(meth, args_copy); + for (i = 0; i < st->nsupers; i++) { + struct struct_type *su = st->sus[i]; + loc ptr = lookup_static_slot_load(su, sym); + if (!nullocp(ptr)) { + val meth = deref(ptr); + if (inst == t) { + return meth; + } else if (inst) { + args_decl(args_copy, max(args->fill + 1, ARGS_MIN)); + args_add(args_copy, inst); + args_cat_zap(args_copy, args); + return generic_funcall(meth, args_copy); + } else { + return generic_funcall(meth, args); + } + } } - uw_throwf(error_s, lit("call-super-method: ~s has no supertype"), - suptype, nao); + if (st->nsupers) + if (bindable(sym)) + uw_throwf(error_s, lit("~s: slot ~s not found among supertypes of ~s"), + self, sym, type, nao); + else + uw_throwf(error_s, lit("~s: ~s isn't a valid slot name"), + self, sym); + else + uw_throwf(error_s, lit("~s: ~s has no supertype"), + type, nao); +} + +static val call_super_method(val inst, val sym, struct args *args) +{ + val type = struct_type(inst); + val self = lit("call-super-method"); + struct struct_type *st = stype_handle(&type, self); + return do_super(st, inst, sym, self, args); } static val call_super_fun(val type, val sym, struct args *args) { val self = lit("call-super-fun"); struct struct_type *st = stype_handle(&type, self); - - if (st->nsupers) { - val suptype = st->sus[0]->self; - - if (suptype) { - val fun = static_slot(suptype, sym); - return generic_funcall(fun, args); - } - } - - uw_throwf(error_s, lit("~a: ~s has no supertype"), - self, type, nao); + return do_super(st, nil, sym, self, args); } val slotp(val type, val sym) @@ -1540,11 +1557,13 @@ val method_args(val strct, val slotsym, struct args *args) cons(slot(strct, slotsym), strct)), method_args_fun); } - val super_method(val strct, val slotsym) { - val super_slot = static_slot(super(struct_type(strct), zero), slotsym); - return func_f0v(cons(super_slot, strct), method_fun); + val type = struct_type(strct); + val self = lit("super-method"); + struct struct_type *st = stype_handle(&type, self); + val meth = do_super(st, t, slotsym, self, 0); + return func_f0v(cons(meth, strct), method_fun); } static val uslot_fun(val sym, val strct) diff --git a/tests/012/oop-mi.expected b/tests/012/oop-mi.expected index 91bc05df..301c7460 100644 --- a/tests/012/oop-mi.expected +++ b/tests/012/oop-mi.expected @@ -6,3 +6,9 @@ gs0 gs1-b1 (meth base3 b3m0) (meth der1 b3m1) +m1 +m2 +gm +m1 +m2 +gm diff --git a/tests/012/oop-mi.tl b/tests/012/oop-mi.tl index 162c0243..7561d096 100644 --- a/tests/012/oop-mi.tl +++ b/tests/012/oop-mi.tl @@ -4,17 +4,21 @@ (gx 'gx) (gy 'gy) (:static gs0 'gs0) - (:static gs1 'gs1)) + (:static gs1 'gs1) + (:method gm (me) 'gm)) -(defstruct base0 nil) +(defstruct base0 nil + (:method m (me) 'm0)) (defstruct base1 grand (x 'b1x) - (:static gs1 'gs1-b1)) + (:static gs1 'gs1-b1) + (:method m (me) 'm1)) (defstruct base2 grand (y 'b2y) - (:static gs1 'gs1-b2)) + (:static gs1 'gs1-b2) + (:method m (me) 'm2)) (defstruct base3 nil (x 'b3x) @@ -45,3 +49,15 @@ (prinl (func-get-name d0.b3m0)) (prinl (func-get-name d1.b3m1)) + +(defstruct der2 (base3 base1 base2)) +(defstruct der3 (base3 base2 base1)) + +(prinl (call-super-method (new der2) 'm)) +(prinl (call-super-method (new der3) 'm)) +(prinl (call-super-method (new der3) 'gm)) +(prinl (call-super-fun 'der2 'm nil)) +(prinl (call-super-fun 'der3 'm nil)) +(prinl (call-super-fun 'der3 'gm nil)) + + @@ -27442,7 +27442,7 @@ the slot name isn't a computed value. The .code super-method function retrieves a function from a static -slot belonging to the supertype of the structure type of +slot belonging to one of the direct supertypes of the structure type of .metn struct-obj . It then returns a function which binds @@ -27450,11 +27450,14 @@ that function's left argument to the structure. The .meta struct-obj -argument must be a structure which has a supertype, and +argument must be a structure which has at least one supertype, and .meta slot-name -must be a symbol denoting a static slot in that supertype. +must be a symbol denoting a static slot in one of those supertypes. The slot must hold a function of at least one -argument. +argument. The supertypes are searched from left to right for a static +slot named +.metn slot-name ; +when the first such slot is found, its value is used. The .code super-method @@ -27768,9 +27771,9 @@ should be reworked in terms of The .code call-super-method -retrieves the function stored in the slot +retrieves the function stored in the static slot .meta name -of the supertype of +of one of the direct supertypes of .meta struct-obj and invokes it, passing to that function .meta struct-obj @@ -27781,10 +27784,11 @@ if any. The .meta struct-obj argument must be of structure type. Moreover, -that structure type must be derived from another structure type, +that structure type must be derived from one or more supertypes, and .meta name -must name a static slot of that structure type. +must name a static slot available from at least one of those supertypes. +The supertypes are searched left to right in search of this slot. The object retrieved from that static slot must be callable as a function, and accept the arguments. @@ -27808,7 +27812,7 @@ The .code call-super-fun retrieves the function stored in the slot .meta name -of the supertype of +of one of the supertypes of .meta type and invokes it, passing to that function the given .metn argument -s, @@ -27817,10 +27821,11 @@ if any. The .meta type argument must be a structure type. Moreover, -that structure type must be derived from another structure type, +that structure type must be derived from one or more supertypes, and .meta name -must name a static slot of that structure type. +must name a static slot available from at least one of those supertypes. +The supertypes are searched left to right in search of this slot. The object retrieved from that static slot must be callable as a function, and accept the arguments. |