/[guile]/guile/guile-core/libguile/goops.c
ViewVC logotype

Diff of /guile/guile-core/libguile/goops.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.58 by mdj, Thu Mar 6 12:50:41 2003 UTC revision 1.59 by mdj, Tue Mar 11 14:50:02 2003 UTC
# Line 137  static SCM scm_goops_lookup_closure; Line 137  static SCM scm_goops_lookup_closure;
137  SCM scm_class_top, scm_class_object, scm_class_class;  SCM scm_class_top, scm_class_object, scm_class_class;
138  SCM scm_class_entity, scm_class_entity_with_setter;  SCM scm_class_entity, scm_class_entity_with_setter;
139  SCM scm_class_generic, scm_class_generic_with_setter;  SCM scm_class_generic, scm_class_generic_with_setter;
140    SCM scm_class_accessor;
141  SCM scm_class_extended_generic, scm_class_extended_generic_with_setter;  SCM scm_class_extended_generic, scm_class_extended_generic_with_setter;
142  SCM scm_class_method;  SCM scm_class_method;
143  SCM scm_class_simple_method, scm_class_accessor;  SCM scm_class_simple_method, scm_class_accessor_method;
144  SCM scm_class_procedure_class;  SCM scm_class_procedure_class;
145  SCM scm_class_operator_class, scm_class_operator_with_setter_class;  SCM scm_class_operator_class, scm_class_operator_with_setter_class;
146  SCM scm_class_entity_class;  SCM scm_class_entity_class;
# Line 2113  SCM_DEFINE (scm_make, "make",  0, 0, 1, Line 2114  SCM_DEFINE (scm_make, "make",  0, 0, 1,
2114    class = SCM_CAR(args);    class = SCM_CAR(args);
2115    args  = SCM_CDR(args);    args  = SCM_CDR(args);
2116    
2117    if (class == scm_class_generic || class == scm_class_generic_with_setter)    if (class == scm_class_generic || class == scm_class_accessor)
2118      {      {
2119        z = scm_make_struct (class, SCM_INUM0,        z = scm_make_struct (class, SCM_INUM0,
2120                             scm_list_5 (SCM_EOL,                             scm_list_5 (SCM_EOL,
# Line 2126  SCM_DEFINE (scm_make, "make",  0, 0, 1, Line 2127  SCM_DEFINE (scm_make, "make",  0, 0, 1,
2127                                                       args,                                                       args,
2128                                                       SCM_BOOL_F));                                                       SCM_BOOL_F));
2129        clear_method_cache (z);        clear_method_cache (z);
2130        if (class == scm_class_generic_with_setter)        if (class == scm_class_accessor)
2131          {          {
2132            SCM setter = scm_get_keyword (k_setter, args, SCM_BOOL_F);            SCM setter = scm_get_keyword (k_setter, args, SCM_BOOL_F);
2133            if (!SCM_FALSEP (setter))            if (!SCM_FALSEP (setter))
# Line 2139  SCM_DEFINE (scm_make, "make",  0, 0, 1, Line 2140  SCM_DEFINE (scm_make, "make",  0, 0, 1,
2140    
2141        if (class == scm_class_method        if (class == scm_class_method
2142            || class == scm_class_simple_method            || class == scm_class_simple_method
2143            || class == scm_class_accessor)            || class == scm_class_accessor_method)
2144          {          {
2145            SCM_SET_SLOT (z, scm_si_generic_function,            SCM_SET_SLOT (z, scm_si_generic_function,
2146              scm_i_get_keyword (k_gf,              scm_i_get_keyword (k_gf,
# Line 2352  create_standard_classes (void) Line 2353  create_standard_classes (void)
2353    make_stdcls (&scm_class_simple_method,   "<simple-method>",    make_stdcls (&scm_class_simple_method,   "<simple-method>",
2354                 scm_class_class, scm_class_method,          SCM_EOL);                 scm_class_class, scm_class_method,          SCM_EOL);
2355    SCM_SET_CLASS_FLAGS (scm_class_simple_method, SCM_CLASSF_SIMPLE_METHOD);    SCM_SET_CLASS_FLAGS (scm_class_simple_method, SCM_CLASSF_SIMPLE_METHOD);
2356    make_stdcls (&scm_class_accessor,        "<accessor-method>",    make_stdcls (&scm_class_accessor_method, "<accessor-method>",
2357                 scm_class_class, scm_class_simple_method,   amethod_slots);                 scm_class_class, scm_class_simple_method,   amethod_slots);
2358    SCM_SET_CLASS_FLAGS (scm_class_accessor, SCM_CLASSF_ACCESSOR_METHOD);    SCM_SET_CLASS_FLAGS (scm_class_accessor_method, SCM_CLASSF_ACCESSOR_METHOD);
2359    make_stdcls (&scm_class_entity,          "<entity>",    make_stdcls (&scm_class_entity,          "<entity>",
2360                 scm_class_entity_class, scm_class_object,   SCM_EOL);                 scm_class_entity_class, scm_class_object,   SCM_EOL);
2361    make_stdcls (&scm_class_entity_with_setter, "<entity-with-setter>",    make_stdcls (&scm_class_entity_with_setter, "<entity-with-setter>",
# Line 2363  create_standard_classes (void) Line 2364  create_standard_classes (void)
2364                 scm_class_entity_class, scm_class_entity,   gf_slots);                 scm_class_entity_class, scm_class_entity,   gf_slots);
2365    SCM_SET_CLASS_FLAGS (scm_class_generic, SCM_CLASSF_PURE_GENERIC);    SCM_SET_CLASS_FLAGS (scm_class_generic, SCM_CLASSF_PURE_GENERIC);
2366    make_stdcls (&scm_class_extended_generic, "<extended-generic>",    make_stdcls (&scm_class_extended_generic, "<extended-generic>",
2367                 scm_class_entity_class,                 scm_class_entity_class, scm_class_generic, egf_slots);
                scm_list_1 (scm_class_generic),  
                egf_slots);  
2368    SCM_SET_CLASS_FLAGS (scm_class_extended_generic, SCM_CLASSF_PURE_GENERIC);    SCM_SET_CLASS_FLAGS (scm_class_extended_generic, SCM_CLASSF_PURE_GENERIC);
2369    make_stdcls (&scm_class_generic_with_setter, "<generic-with-setter>",    make_stdcls (&scm_class_generic_with_setter, "<generic-with-setter>",
2370                 scm_class_entity_class,                 scm_class_entity_class,
2371                 scm_list_2 (scm_class_generic, scm_class_entity_with_setter),                 scm_list_2 (scm_class_generic, scm_class_entity_with_setter),
2372                 SCM_EOL);                 SCM_EOL);
2373    SCM_SET_CLASS_FLAGS (scm_class_generic_with_setter, SCM_CLASSF_PURE_GENERIC);    SCM_SET_CLASS_FLAGS (scm_class_generic_with_setter, SCM_CLASSF_PURE_GENERIC);
2374      make_stdcls (&scm_class_accessor,        "<accessor>",
2375                   scm_class_entity_class, scm_class_generic_with_setter, SCM_EOL);
2376      SCM_SET_CLASS_FLAGS (scm_class_accessor, SCM_CLASSF_PURE_GENERIC);
2377    make_stdcls (&scm_class_extended_generic_with_setter,    make_stdcls (&scm_class_extended_generic_with_setter,
2378                 "<extended-generic-with-setter>",                 "<extended-generic-with-setter>",
2379                 scm_class_entity_class,                 scm_class_entity_class,
# Line 2644  scm_add_slot (SCM class, char *slot_name Line 2646  scm_add_slot (SCM class, char *slot_name
2646                               gf);                               gf);
2647        SCM gns = scm_list_4 (name, SCM_BOOL_F, get, set);        SCM gns = scm_list_4 (name, SCM_BOOL_F, get, set);
2648    
2649        scm_add_method (gf, scm_make (scm_list_5 (scm_class_accessor,        scm_add_method (gf, scm_make (scm_list_5 (scm_class_accessor_method,
2650                                                  k_specializers,                                                  k_specializers,
2651                                                  scm_list_1 (class),                                                  scm_list_1 (class),
2652                                                  k_procedure,                                                  k_procedure,
2653                                                  getm)));                                                  getm)));
2654        scm_add_method (scm_setter (gf),        scm_add_method (scm_setter (gf),
2655                        scm_make (scm_list_5 (scm_class_accessor,                        scm_make (scm_list_5 (scm_class_accessor_method,
2656                                              k_specializers,                                              k_specializers,
2657                                              scm_list_2 (class, scm_class_top),                                              scm_list_2 (class, scm_class_top),
2658                                              k_procedure,                                              k_procedure,
# Line 2700  SCM Line 2702  SCM
2702  scm_ensure_accessor (SCM name)  scm_ensure_accessor (SCM name)
2703  {  {
2704    SCM gf = scm_call_2 (SCM_TOP_LEVEL_LOOKUP_CLOSURE, name, SCM_BOOL_F);    SCM gf = scm_call_2 (SCM_TOP_LEVEL_LOOKUP_CLOSURE, name, SCM_BOOL_F);
2705    if (!SCM_IS_A_P (gf, scm_class_generic_with_setter))    if (!SCM_IS_A_P (gf, scm_class_accessor))
2706      {      {
2707        gf = scm_make (scm_list_3 (scm_class_generic, k_name, name));        gf = scm_make (scm_list_3 (scm_class_generic, k_name, name));
2708        gf = scm_make (scm_list_5 (scm_class_generic_with_setter,        gf = scm_make (scm_list_5 (scm_class_accessor,
2709                                   k_name, name, k_setter, gf));                                   k_name, name, k_setter, gf));
2710      }      }
2711    return gf;    return gf;

Legend:
Removed from v.1.58  
changed lines
  Added in v.1.59

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26