mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 20:30:28 +02:00
Code Activity

Generics with setters have <applicable-struct-with-setter> layout

Browse source 
* libguile/goops.c (scm_sys_set_object_setter_x): Remove.  Instead, we
  use slot-set! of 'setter.
  (scm_i_define_class_for_vtable): Move lower in the file, and fold in
  scm_make_extended_class_from_symbol and make_class_from_symbol.
  Properly handle applicable structs with setters.
  (scm_class_applicable_struct_with_setter_class): New private capture.
  (scm_sys_bless_applicable_struct_vtables_x): Rename to take two
  arguments, and bless the second argument as an applicable struct with
  setter vtable.
  (scm_sys_goops_early_init): Capture setter classes.

* libguile/deprecated.c (SPEC_OF, CPL_OF): Access slots by name, not by
  index.
  (applicablep, more_specificp): Adapt to use CPL_OF.
  (scm_find_method): Access "methods" slot by name.

* libguile/procs.c (scm_setter): Remove special case for generics; if
  it's a setter, it will be a normal applicable struct.
* module/oop/goops.scm (<applicable-struct-with-setter-class>)
  (<applicable-struct-with-setter>): New classes.
  (<generic-with-setter>): Now an instance of the setter metaclass and a
  child of the setter class, so that the "setter" slot ends up in the
  right place.
  (<accessor>, <extended-generic-with-setter>, <extended-accessor>): Be
  instances of the setter metaclass.
  (<method>, <accessor-method>): Move definitions farther down.
  (make): Use slot-set! when initializing setters here.
  (initialize): Likewise for <applicable-struct-with-setter>.  Remove
  specialization for <generic-with-setter>.
This commit is contained in:
Andy Wingo 2015-01-06 13:41:56 -05:00
parent 9e2cd55ec8
commit 6c7dd9ebd3
5 changed files with 117 additions and 138 deletions
Download patch file Download diff file Expand all files Collapse all files

12
libguile/deprecated.c
View file

@ -103,8 +103,10 @@ scm_init_deprecated_goops (void)
}
#define BUFFSIZE 32 /* big enough for most uses */
#define scm_si_specializers 1 /* offset of spec. slot in a <method> */
#define SPEC_OF(x) SCM_SLOT (x, scm_si_specializers)
#define SPEC_OF(x) \
(scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("specializers"))))
#define CPL_OF(x) \
(scm_slot_ref (x, scm_slot_ref (x, scm_from_latin1_symbol ("cpl"))))
static SCM
scm_i_vector2list (SCM l, long len)
@ -122,7 +124,7 @@ static int
applicablep (SCM actual, SCM formal)
{
/* We already know that the cpl is well formed. */
return scm_is_true (scm_c_memq (formal, SCM_SLOT (actual, scm_si_cpl)));
return scm_is_true (scm_c_memq (formal, CPL_OF (actual)));
}
static int
@ -152,7 +154,7 @@ more_specificp (SCM m1, SCM m2, SCM const *targs)
if (!scm_is_eq (SCM_CAR(s1), SCM_CAR(s2))) {
register SCM l, cs1 = SCM_CAR(s1), cs2 = SCM_CAR(s2);
for (l = SCM_SLOT (targs[i], scm_si_cpl); ; l = SCM_CDR(l)) {
for (l = CPL_OF (targs[i]); ; l = SCM_CDR(l)) {
if (scm_is_eq (cs1, SCM_CAR (l)))
return 1;
if (scm_is_eq (cs2, SCM_CAR (l)))
@ -322,7 +324,7 @@ scm_find_method (SCM l)
gf = SCM_CAR(l); l = SCM_CDR(l);
SCM_VALIDATE_GENERIC (1, gf);
if (scm_is_null (SCM_SLOT (gf, scm_si_methods)))
if (scm_is_null (scm_slot_ref (gf, scm_from_latin1_symbol ("methods"))))
SCM_MISC_ERROR ("no methods for generic ~S", scm_list_1 (gf));
return scm_compute_applicable_methods (gf, l, len - 1, 1);