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; |
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, |
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)) |
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, |
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>", |
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, |
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, |
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; |