diff options
| -rw-r--r-- | share/txr/stdlib/struct.tl | 16 | ||||
| -rw-r--r-- | struct.c | 258 | ||||
| -rw-r--r-- | tests/012/oop.expected | 17 | ||||
| -rw-r--r-- | tests/012/oop.tl | 66 | ||||
| -rw-r--r-- | txr.1 | 283 |
5 files changed, 516 insertions, 124 deletions
diff --git a/share/txr/stdlib/struct.tl b/share/txr/stdlib/struct.tl index 6bf665fb..8cd70359 100644 --- a/share/txr/stdlib/struct.tl +++ b/share/txr/stdlib/struct.tl @@ -27,12 +27,10 @@ (defun sys:bad-slot-syntax (arg) (throwf 'eval-error "~s: bad slot syntax: ~s" 'defstruct arg)) - (defun sys:prune-nil-inits (slot-init-forms super-type) - (remove-if (tb ((kind name init-form)) + (defun sys:prune-missing-inits (slot-init-forms) + (remove-if (tb ((kind name : (init-form nil init-form-present))) (and (member kind '(:static :instance :function)) - (null init-form) - (or (not super-type) - (not (slotp super-type name))))) + (not init-form-present))) slot-init-forms))) (defmacro defstruct (name-spec super . slot-specs) @@ -105,8 +103,12 @@ :))) ((word name) (caseq word - ((:static :instance) + ((:static) + ^(,word ,name)) + ((:instance) ^(,word ,name nil)) + ((:method :function) + (sys:bad-slot-syntax slot)) (t ^(:instance ,word ,name)))) ((name) ^(:instance ,name nil)) @@ -120,7 +122,7 @@ 'defstruct super)))) (stat-si-forms [keep-if (op member @1 '(:static :function)) slot-init-forms car]) - (pruned-si-forms (sys:prune-nil-inits stat-si-forms super-type)) + (pruned-si-forms (sys:prune-missing-inits stat-si-forms)) (func-si-forms [keep-if (op eq :function) pruned-si-forms car]) (val-si-forms [keep-if (op eq :static) pruned-si-forms car]) (inst-si-forms [keep-if (op eq :instance) slot-init-forms car]) @@ -51,13 +51,23 @@ #define STATIC_SLOT_BASE 0x10000000 +struct stslot { + val home_type; + cnum home_offs; + val *home; + val store; +}; + +#define stslot_loc(s) mkloc(*(s)->home, (s)->home_type) +#define stslot_place(s) (*(s)->home) + struct struct_type { val self; val name; cnum id; cnum nslots; cnum nstslots; - cnum eqmslot; + struct stslot *eqmslot; val super; struct struct_type *super_handle; val slots; @@ -66,7 +76,7 @@ struct struct_type { val boactor; val postinitfun; val dvtypes; - val *stslot; + struct stslot *stslot; }; struct struct_inst { @@ -167,7 +177,7 @@ static val struct_type_finalize(val obj) static void call_stinitfun_chain(struct struct_type *st, val stype) { if (st) { - if (st->super) + if (st->super && opt_compat && opt_compat <= 151) call_stinitfun_chain(st->super_handle, stype); if (st->stinitfun) funcall1(st->stinitfun, stype); @@ -197,6 +207,20 @@ static struct struct_type *stype_handle(val *pobj, val ctx) } } +static void static_slot_home_fixup(struct struct_type *st) +{ + cnum i; + for (i = 0; i < st->nstslots; i++) { + struct stslot *s = &st->stslot[i]; + if (s->home_type == st->self) { + s->home = &s->store; + } else { + struct struct_type *shome = coerce(struct struct_type *, + s->home_type->co.handle); + *s = shome->stslot[s->home_offs]; + } + } +} val make_struct_type(val name, val super, val static_slots, val slots, @@ -235,12 +259,15 @@ val make_struct_type(val name, val super, val id = num_fast(++struct_id_counter); val iter; cnum sl, stsl; - val null_ptr = 0; + cnum stsl_upb = c_num(plus(length(static_slots), + num(if3(su, su->nstslots, 0)))); + struct stslot null_ptr = { nil, 0, 0, nil }; st->self = stype; st->name = name; st->id = c_num(id); - st->nslots = st->nstslots = st->eqmslot = 0; + st->nslots = st->nstslots = 0; + st->eqmslot = 0; st->slots = all_slots; st->super = super; st->stslot = 0; @@ -253,6 +280,10 @@ val make_struct_type(val name, val super, gc_finalize(stype, struct_type_finalize_f, nil); + st->stslot = coerce(struct stslot *, + chk_manage_vec(0, 0, stsl_upb, sizeof *st->stslot, + coerce(mem_t *, &null_ptr))); + for (sl = 0, stsl = STATIC_SLOT_BASE, iter = all_slots; iter; iter = cdr(iter)) @@ -264,27 +295,43 @@ val make_struct_type(val name, val super, static_slot_p(super, slot), memq(slot, static_slots)); - if (ts_p) - sethash(slot_hash, cons(slot, id), num(stsl++)); - else + if (ts_p) { + cnum n = stsl++ - STATIC_SLOT_BASE; + struct stslot *ss = &st->stslot[n]; + val key = if2(su, cons(slot, num_fast(su->id))); + val msl = if2(su, gethash(slot_hash, key)); + cnum m = (coerce(cnum, msl) >> TAG_SHIFT) - STATIC_SLOT_BASE; + + if (!inherited_p || (opt_compat && opt_compat <= 151)) { + ss->home_type = stype; + ss->home_offs = n; + ss->home = &ss->store; + ss->store = if2(msl, stslot_place(&su->stslot[m])); + } else { + *ss = su->stslot[m]; + } + sethash(slot_hash, cons(slot, id), num(n + STATIC_SLOT_BASE)); + } else { sethash(slot_hash, cons(slot, id), num_fast(sl++)); + } if (sl >= STATIC_SLOT_BASE) uw_throwf(error_s, lit("~a: too many slots"), self, nao); } stsl -= STATIC_SLOT_BASE; - st->stslot = coerce(val *, chk_manage_vec(0, 0, stsl, sizeof (val), - coerce(mem_t *, &null_ptr))); + st->stslot = coerce(struct stslot *, + chk_manage_vec(coerce(mem_t *, st->stslot), stsl_upb, + stsl, sizeof *st->stslot, + coerce(mem_t *, &null_ptr))); st->nslots = sl; st->nstslots = stsl; + static_slot_home_fixup(st); sethash(struct_type_hash, name, stype); - if (super) { + if (super) mpush(stype, mkloc(su->dvtypes, super)); - memcpy(st->stslot, su->stslot, sizeof (val) * su->nstslots); - } call_stinitfun_chain(st, stype); @@ -349,8 +396,14 @@ static void struct_type_mark(val obj) gc_mark(st->postinitfun); gc_mark(st->dvtypes); - for (stsl = 0; stsl < st->nstslots; stsl++) - gc_mark(st->stslot[stsl]); + for (stsl = 0; stsl < st->nstslots; stsl++) { + struct stslot *sl = &st->stslot[stsl]; + + if (sl->home_type == st->self) + gc_mark(sl->store); + else + bug_unless (sl->store != nil); + } } static void call_initfun_chain(struct struct_type *st, val strct) @@ -639,7 +692,8 @@ static loc lookup_slot(val inst, struct struct_inst *si, val sym) if (slot >= STATIC_SLOT_BASE) { struct struct_type *st = si->type; - return mkloc(st->stslot[slot - STATIC_SLOT_BASE], st->self); + struct stslot *stsl = &st->stslot[slot - STATIC_SLOT_BASE]; + return stslot_loc(stsl); } else if (slot >= 0) { check_init_lazy_struct(inst, si); return mkloc(si->slot[slot], inst); @@ -651,7 +705,8 @@ static loc lookup_slot(val inst, struct struct_inst *si, val sym) cache_set_insert(*set, id, slnum); if (slnum >= STATIC_SLOT_BASE) { struct struct_type *st = si->type; - return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], st->self); + struct stslot *stsl = &st->stslot[slnum - STATIC_SLOT_BASE]; + return stslot_loc(stsl); } check_init_lazy_struct(inst, si); return mkloc(si->slot[slnum], inst); @@ -672,7 +727,8 @@ static loc lookup_slot(val inst, struct struct_inst *si, val sym) cache_set_insert(*set, id, slnum); if (slnum >= STATIC_SLOT_BASE) { struct struct_type *st = si->type; - return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], st->self); + struct stslot *stsl = &st->stslot[slnum - STATIC_SLOT_BASE]; + return stslot_loc(stsl); } check_init_lazy_struct(inst, si); return mkloc(si->slot[slnum], inst); @@ -682,7 +738,8 @@ static loc lookup_slot(val inst, struct struct_inst *si, val sym) return nulloc; } -static loc lookup_static_slot(val stype, struct struct_type *st, val sym) +static struct stslot *lookup_static_slot_desc(val stype, + struct struct_type *st, val sym) { slot_cache_t slot_cache = sym->s.slot_cache; cnum id = st->id; @@ -692,7 +749,7 @@ static loc lookup_static_slot(val stype, struct struct_type *st, val sym) cnum slot = cache_set_lookup(*set, id); if (slot >= STATIC_SLOT_BASE) { - return mkloc(st->stslot[slot - STATIC_SLOT_BASE], stype); + return &st->stslot[slot - STATIC_SLOT_BASE]; } else if (slot < 0) { val key = cons(sym, num_fast(id)); val sl = gethash(slot_hash, key); @@ -700,7 +757,7 @@ static loc lookup_static_slot(val stype, struct struct_type *st, val sym) if (sl) { cache_set_insert(*set, id, slnum); if (slnum >= STATIC_SLOT_BASE) - return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], stype); + return &st->stslot[slnum - STATIC_SLOT_BASE]; } } } else { @@ -717,11 +774,17 @@ static loc lookup_static_slot(val stype, struct struct_type *st, val sym) if (sl) { cache_set_insert(*set, id, slnum); if (slnum >= STATIC_SLOT_BASE) - return mkloc(st->stslot[slnum - STATIC_SLOT_BASE], stype); + return &st->stslot[slnum - STATIC_SLOT_BASE]; } } - return nulloc; + return 0; +} + +static loc lookup_static_slot(val stype, struct struct_type *st, val sym) +{ + struct stslot *stsl = lookup_static_slot_desc(stype, st, sym); + return stsl ? stslot_loc(stsl) : nulloc; } static loc lookup_slot_load(val inst, struct struct_inst *si, val sym) @@ -814,7 +877,7 @@ val static_slot_set(val stype, val sym, val newval) if (symbolp(sym)) { loc ptr = lookup_static_slot(stype, st, sym); if (!nullocp(ptr)) { - if (st->eqmslot == -1) + if (st->eqmslot == (struct stslot *) -1) st->eqmslot = 0; return set(ptr, newval); } @@ -823,11 +886,56 @@ val static_slot_set(val stype, val sym, val newval) no_such_slot(self, stype, sym); } -val static_slot_ensure(val stype, val sym, val newval, val no_error_p) +static void static_slot_home_fixup_rec(struct struct_type *st) +{ + static_slot_home_fixup(st); + + { + val iter; + + for (iter = st->dvtypes; iter; iter = cdr(iter)) { + val stype = car(iter); + struct struct_type *st = coerce(struct struct_type *, stype->co.handle); + static_slot_home_fixup_rec(st); + } + } +} + +static void static_slot_rewrite_rec(struct struct_type *st, + struct stslot *from, + struct stslot *to) +{ + cnum i; + + for (i = 0; i < st->nstslots; i++) { + struct stslot *s = &st->stslot[i]; + + if (s->home_type == from->home_type && + s->home == from->home && + s->home_offs == from->home_offs) + { + *s = *to; + } + } + + { + val iter; + + for (iter = st->dvtypes; iter; iter = cdr(iter)) { + val stype = car(iter); + struct struct_type *st = coerce(struct struct_type *, stype->co.handle); + static_slot_rewrite_rec(st, from, to); + } + } +} + + +static val static_slot_ens_rec(val stype, val sym, val newval, + val no_error_p, val self, + struct stslot *inh_stsl) { - val self = lit("static-slot-ensure"); struct struct_type *st = stype_handle(&stype, self); - loc ptr; + struct stslot *stsl = lookup_static_slot_desc(stype, st, sym); if (!bindable(sym)) uw_throwf(error_s, lit("~a: ~s isn't a valid slot name"), @@ -835,36 +943,79 @@ val static_slot_ensure(val stype, val sym, val newval, val no_error_p) no_error_p = default_bool_arg(no_error_p); - if (st->eqmslot == -1) + if (st->eqmslot == (struct stslot *) -1) st->eqmslot = 0; - if (nullocp((ptr = lookup_static_slot(stype, st, sym)))) { - val null_ptr = 0; - if (!memq(sym, st->slots)) { - st->stslot = coerce(val *, chk_manage_vec(coerce(mem_t *, st->stslot), - st->nstslots, st->nstslots + 1, - sizeof (val), - coerce(mem_t *, &null_ptr))); - set(mkloc(st->slots, stype), append2(st->slots, cons(sym, nil))); - ptr = mkloc(st->stslot[st->nstslots], stype); - sethash(slot_hash, cons(sym, num_fast(st->id)), - num(st->nstslots++ + STATIC_SLOT_BASE)); + if (stsl != 0 && opt_compat && opt_compat <= 151) { + set(stslot_loc(stsl), newval); + } else if (stsl != 0 && inh_stsl != 0) { + return newval; + } else if (stsl != 0 && stsl->home_type == stype) { + set(stslot_loc(stsl), newval); + return newval; + } else if (stsl == 0 && memq(sym, st->slots)) { + if (!no_error_p) + uw_throwf(error_s, lit("~a: ~s is an instance slot of ~s"), + self, sym, stype, nao); + return newval; + } else if (stsl != 0) { + struct stslot to; + to.store = nil; + to.home_type = stype; + to.home = &stsl->store; + to.home_offs = stsl->home_offs; + static_slot_rewrite_rec(st, stsl, &to); + set(stslot_loc(stsl), newval); + return newval; + } else { + struct stslot null_ptr = { nil, 0, 0, nil }; + st->stslot = coerce(struct stslot *, + chk_manage_vec(coerce(mem_t *, st->stslot), + st->nstslots, st->nstslots + 1, + sizeof *st->stslot, + coerce(mem_t *, &null_ptr))); + static_slot_home_fixup_rec(st); + set(mkloc(st->slots, stype), append2(st->slots, cons(sym, nil))); + stsl = &st->stslot[st->nstslots]; + + if (inh_stsl == 0) { + stsl->store = newval; + stsl->home_type = stype; + stsl->home_offs = st->nstslots; + stsl->home = &stsl->store; + if (!opt_compat || opt_compat > 151) + inh_stsl = stsl; } else { - if (!no_error_p) - uw_throwf(error_s, lit("~a: ~s is an instance slot of ~s"), - self, sym, stype, nao); + stsl->store = nil; + stsl->home_type = inh_stsl->home_type; + stsl->home_offs = inh_stsl->home_offs; + stsl->home = inh_stsl->home; } - } - set(ptr, newval); + sethash(slot_hash, cons(sym, num_fast(st->id)), + num(st->nstslots++ + STATIC_SLOT_BASE)); + } { val iter; + for (iter = st->dvtypes; iter; iter = cdr(iter)) - static_slot_ensure(car(iter), sym, newval, t); + static_slot_ens_rec(car(iter), sym, newval, t, self, inh_stsl); + + return newval; } +} - return newval; +val static_slot_ensure(val stype, val sym, val newval, val no_error_p) +{ + val self = lit("static-slot-ensure"); + + if (!bindable(sym)) + uw_throwf(error_s, lit("~a: ~s isn't a valid slot name"), + self, sym, nao); + + no_error_p = default_bool_arg(no_error_p); + return static_slot_ens_rec(stype, sym, newval, no_error_p, self, 0); } static val call_super_method(val inst, val sym, struct args *args) @@ -1091,17 +1242,18 @@ static cnum struct_inst_hash(val obj, int *count) static val get_equal_method(val stype, struct struct_type *st) { - if (st->eqmslot == -1) { + if (st->eqmslot == (struct stslot *) -1) { return nil; } else if (st->eqmslot) { - return st->stslot[st->eqmslot]; + struct stslot *stsl = st->eqmslot; + return stslot_place(stsl); } else { - loc ptr = lookup_static_slot(stype, st, equal_s); - if (!nullocp(ptr)) { - st->eqmslot = valptr(ptr) - st->stslot; - return deref(ptr); + struct stslot *stsl = lookup_static_slot_desc(stype, st, equal_s); + if (stsl != 0) { + st->eqmslot = stsl; + return stslot_place(stsl); } - st->eqmslot = -1; + st->eqmslot = (struct stslot *) -1; return nil; } } diff --git a/tests/012/oop.expected b/tests/012/oop.expected new file mode 100644 index 00000000..f0bb554f --- /dev/null +++ b/tests/012/oop.expected @@ -0,0 +1,17 @@ +n/a +dog +collie +animal +dog +collie +animal +canine +collie +animal +canine +collie +poodle +#S(b a 1 b 2 c 3) +#S(d a nil b -2 c 3) +(10 20 300 42 42) +(10 -20 300 42 0) diff --git a/tests/012/oop.tl b/tests/012/oop.tl new file mode 100644 index 00000000..24cf2726 --- /dev/null +++ b/tests/012/oop.tl @@ -0,0 +1,66 @@ +(load "../common") + +(defstruct animal nil + (:function whoami () "n/a") + (:method print (self stream) (put-string self.[whoami] stream))) + +(defstruct dog animal + (:function whoami () "dog")) + +(defstruct collie dog + (:function whoami () "collie")) + +(defstruct poodle dog) + +(defvarl a (new animal)) +(defvarl d (new dog)) +(defvarl c (new collie)) + +(defun print-all () + (pprinl a) + (pprinl d) + (pprinl c)) + +(print-all) + +(defmeth animal whoami () + "animal") + +(print-all) + +(defmeth dog whoami () + "canine") + +(print-all) + +(defmeth poodle whoami () + "poodle") + +(print-all) + +(pprinl (new poodle)) + +(defstruct b nil + (:instance a 1) + (:instance b 2) + (:instance c 3) + (:static sa 10) + (:static sb 20) + (:static sc 30)) + +(defstruct d b + (a) + (b -2) + (:static sa) + (:static sb -20) + (:static y 0)) + +(static-slot-ensure 'b 'x 42) +(static-slot-ensure 'b 'y 42) + +(let ((b (new b sc 300)) + (d (new d))) + (prinl b) + (prinl d) + (prinl (list b.sa b.sb b.sc b.x b.y)) + (prinl (list d.sa d.sb d.sc d.x d.y))) @@ -19888,9 +19888,52 @@ read from a stream, if static slots are present, they will be processed and their values stored in the static locations they represent, thus changing their values for all instances. -Static slots are inherited just like instance slots. However, when one -structure type inherits a static slot from another, that structure type -has its own storage location for that slot. +Static slots are inherited just like instance slots. If a given structure +.meta B +has some static slot +.metn s , +and a new structure +.meta D +is derived from +.metn B , +using +.codn defstruct , +and does not define a slot +.metn s , +then +.meta D +inherits +.metn s . +This means that +.meta D +shares the static slot with +.metn B : +both types share a single instance of that slot. + +On the other hand if +.code D +defines a static slot +.meta s +then that slot will have its own instance in the +.meta D +structure type; +.meta D +will not inherit the +.meta B +instance of slot +.metn s . +Moreover, if the the definition of +.code D +omits the +.meta init-form +for slot +.metn s , +then that slot will be initialized with a copy of the current value of slot +.meta s +of the +.meta B +base type, which allows derived types to obtain the value of base type's +static slot, yet have that in their own instance. The slot type can be overridden. A structure type deriving from another type can introduce slots which have the same names as the supertype, @@ -19903,13 +19946,6 @@ is invoked once in a type's life time, when the type is created. The function is also inherited by derived struct types and invoked when they are created. -If a newly introduced (that is to say, non-inherited) static slot isn't -initialized by the static initialization function, its value defaults to -.codn nil . -If an inherited slot isn't initialized by its supertype's initialization -function, then its initial value in the new type is a copy of the current -value of the supertype's corresponding slot. - .coNP Macro @ defstruct .synb .mets (defstruct >> { name | >> ( name << arg *)} < super @@ -19955,7 +19991,7 @@ symbol, as defined by the .code bindable function. This form is a short form for the .cblk -.meti (:instance < name nil) +.meti (:instance << name ) .cble syntax. .meIP >> ( symbol << init-form ) @@ -19964,7 +20000,7 @@ This syntax is a short form for the .meti (:instance < name << init-form ) .cble syntax. -.meIP (:instance < name << init-form ) +.meIP (:instance < name <> [ init-form ]) This syntax specifies an instance slot called .meta name whose initial value is obtained by evaluating @@ -19972,15 +20008,36 @@ whose initial value is obtained by evaluating whenever a new instance of the structure is created. This evaluation takes place in the original lexical environment in which the .code defstruct -form occurs. -.meIP (:static < name << init-form ) +form occurs. If +.meta init-form +is omitted, the slot is initialized to +.codn nil . +.meIP (:static < name <> [ init-form ]) This syntax specifies a static slot called .meta name whose initial value is obtained by evaluating .meta init-form once, during the evaluation of the .code defstruct -form in which it occurs. +form in which it occurs, if the +.meta init-form +is present. If +.meta init-form +is absent, and a static slot with the same name +exists in the +.meta super +base type, then this slot is initialized +with the value of that slot. +Otherwise it is initialized to +.codn nil . + +The definition of a static slot in a +.code defstruct +causes the new type to have its own instance +that slot, even if a same-named static +slot occurs in the +.meta super +base type, or its bases. .meIP (:method < name <> ( param +) << body-form *) This syntax creates a static slot called .meta name @@ -20011,6 +20068,11 @@ Methods are invoked using the .code "instance.(name arg ...)" syntax, which implicitly inserts the instance into the argument list. + +Due to the semantics of static slots, methods are naturally +inherited from a base structure to a derived one, +and defining a method in a derived class which also exists +in a base class performs OOP-style overriding. .meIP (:function < name <> ( param *) << body-form *) This syntax creates a static slot called .meta name @@ -20041,6 +20103,12 @@ Such functions are called using the .code "instance.[name arg ...]" syntax which doesn't insert the instance into the argument list. + +The remarks about inheritance and overriding +in the description of +.code :method +also apply to +.codn :function . .meIP (:init <> ( param ) << body-form *) The .code :init @@ -20183,29 +20251,33 @@ in the type or that type's chain of ancestors, it is called a .IR "repeated slot" . -A repeated slot inherits initialization forms from all of its ancestors. - The kind of the repeated slot (static or instance) is not inherited; it is established by the .code defstruct and may be different from the type of the same-named slot in the supertype or its ancestors. -A repeated slot only inherits the initializations which correspond to -its kind. If a repeated slot is introduced as a static slot, then -all of the static initializations in the ancestry chain are performed -on that slot, which takes place during the evaluation of the -.code defstruct -form. If that slot is an instance slot in any of the -ancestor structure types, their initializations do not apply and are not -evaluated. +If a repeated slot is introduced as a static slot, and +has no +.meta init-form +then it receives the current of the a static of the same name from +the nearest supertype which has such a slot. -If a repeated slot is introduced as an instance slot then none of the static -initializations in the ancestry chain are performed on it; none of the forms -are evaluated. Those initializations target a static slot, which the derived -type doesn't have. When an instance of the structure is created, then the -instance initializations are performed on that slot from all of the ancestor -structure types in which that slot is also an instance slot. +If a repeated slot is an instance slot, no such inheritance of value +takes place; only the local +.meta init-form +applies to it; if it is absent, the slot it initialized to +.code nil +in each newly created instance of the new type. + +However, +.code :init +and +.code :postinit +initializations are inherited from a base type and they apply to +the repeated slots, regardless of their kind. These initializations +take place on the instantiated object, and the slot references +resolve accordingly. The initialization for slots which are specified using the .code :method @@ -20379,10 +20451,8 @@ If is used to redefine an existing method, the semantics can be inferred from that of .codn static-slot-ensure . -In particular, the method will be imposed into all subtypes which do not -override the method using an instance slot, overwriting any subtype-specific -methods stored in static slots of the same name. These subtype methods -have to be individually reinstated, if they are required. +In particular, the method will be imposed into all subtypes which inherit +(do not override) the method. .coNP Macros @ new and @ lnew .synb @@ -20884,11 +20954,9 @@ which is equivalent to specifying a function which does nothing. Prior to the invocation of .metn static-initfun , -each new static slot shall be initialized to the value -.code nil -and each inherited static slot shall be initialized to -the current value which the corresponding static slot -holds in the supertype. +each new static slot shall be initialized the value +.codn nil . +Inherited static slots retain their values from the supertype. If specified, .meta static-initfun @@ -20896,11 +20964,10 @@ function must accept one argument. When the structure type is created (before the .code make-struct-type -function returns) all of the +function returns) the .meta static-initfun -functions in the chain of supertype ancestry are invoked, in -order of inheritance. Each is passed the structure type as an argument. The -purpose is to initialize the static slots. +functions is invoked, passed the newly created +structure type as its argument. The .meta initfun @@ -21521,36 +21588,88 @@ must be a static slot of this type. .desc The .code static-slot-ensure -first ensures that the struct type +ensures, if possible, that the struct type +.metn type , +as well as possibly one or more struct types derived from it, +have a static slot called +.metn name , +that this slot is not shared with a supertype, +and that the value stored in it is +.metn new-value . + +Note: this function supports the redefinition of methods, +as the implementation underlying the +.code defmeth +macro; its semantics is designed to harmonize with expected +behaviors in that usage. + +The function operates as follows. + +If .meta type -and all struct types derived from it have a static slot called -.metn name . -The slot is added as a static slot to every eligible type which doesn't already -have an instance or static slot by that name. +itself already has an instance slot called +.meta name +then an error is thrown, and the function has no effect, unless a +true argument is specified for the +.meta no-error-p +Boolean parameter. In that case, in the same situation, the function +has no effect and simply returns +.metn new-value . -Then, -.meta new-value -is stored into all of the +If +.meta type +already has a non-inherited static slot called .meta name -static slots of +then this slot is overwritten with +.meta new-value +and the function returns +.metn new-value . +Types derived from .meta type -and all its derived types. +may also have this slot, via inheritance; consequently, its value +changes in those types also. If .meta type -itself already has an instance slot called +already has an inherited static slot called .meta name -then an error is thrown, and the function has no effect. If the same situation -is true of the subtypes of +then its inheritance is severed; the slot is converted +to a non-inherited static slot of .meta type -then the situation is ignored: for those subtypes, no static slot is added, and -.meta new-value -is not stored. If the -.meta no-error-p -argument is present, and its value is true, then +and initialized with +.metn new-value . +Then all struct types derived from +.meta type +are scanned. In each such type, if the original inherited +static slot is found, it is replaced with the same +newly converted static slot that was just introduced into +.metn type , +so that all these types now inherit this new slot from .meta type -is treated just like the subtypes: if it has a conflicting instance slot, -then the situation is ignored and the subtypes are processed anyway. +rather than the original slot from some supertype of +.metn type . +These types all share a single instance of the slot with +.metn type , +but not with supertypes of +.metn type . + +In the remaining case, +.meta type +has no slot called +.metn name . +The slot is added as a static slot to +.metn type . +Then it is added to every struct type derived from +.meta type +which does not already have a slot by that name, as if +by inheritance. That is to say, types to which this slot is introduced share a +single instance of that slot. The value of the new slot is +.metn new-value , +which is also returned from the function. Any subtypes of +.meta type +which already have a slot called +.meta name +are ignored, as are their subtypes. .coNP Function @ call-super-method .synb @@ -46577,6 +46696,42 @@ of these version values, the described behaviors are provided if is given an argument which is equal or lower. For instance .code "-C 103" selects the behaviors described below for version 105, but not those for 102. +.IP 151 +After version 151, changes were implemented to the way static slots work +in \*(TL structs. Selecting compatibility with 151 restores most of the behaviors. +Until 151, each structure type had its own instance of static slots whether +they were newly defined or inherited. Under the new scheme, a derived struct +shares one instance of each inherited static slot with its base type. +Under the old scheme, a struct inherits the static +initialization functions of its bases (the +.meta static-initfun +argument passed in +.codn make-struct-type ). +These are invoked invoked because they are relied upon by the +.code defstruct +macro to perform the initializations of all the inherited static slots. +Under the new scheme, the static initialization functions are not inherited. +Only the type's own +.meta static-initfun +is invoked to initialize its newly defined static slots that it doesn't +share with the parent. The inherited static slots simply preserve their +current values they have in the base type; their values are untouched by +the introduction of a derived type. The +.code static-slot-ensure +also changed semantics after version 151. The old behavior was problematic +because it affected all static slots throughout the inheritance hierarchy +matching the name passed in by argument. Since this function is the basis +for redefining methods, its behavior broke the semantics of overriding. +Selecting 151 compatibility only restores the behavior of this +function and macros based on it like +.codn defmeth : +in the situation when it introduces a new static slot into one or more +struct types, in compatibility mode it introduces the slot separately into each +type without sharing, and it recurses over the entire type hierarchy, +storing +.meta new-val +into all static slots which match +.metn name . .IP 150 Until version 150, the .code match-regex |