mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 15:40:19 +02:00
Code Activity

* objects.h, objects.c, goops.c, goops.h (scm_class_boolean,

Browse source 
scm_class_char, scm_class_pair, scm_class_procedure,
scm_class_string, scm_class_symbol,
scm_class_procedure_with_setter, scm_class_primitive_generic,
scm_class_vector, scm_class_null, scm_class_real,
scm_class_complex, scm_class_integer, scm_class_fraction,
scm_class_unknown, scm_port_class, scm_smob_class,
scm_no_applicable_method, scm_class_of): Moved from objects to
goops since they are only useable once goops has been loaded.
(scm_classes_initialized): Removed.
(scm_class_of): Do not check it.
(create_standard_classes): Do not set it.
This commit is contained in:
Marius Vollmer 2005-01-18 14:58:39 +00:00
parent 9511876f49
commit 539d541073
4 changed files with 161 additions and 169 deletions
Download patch file Download diff file Expand all files Collapse all files

147
libguile/objects.c
View file

@ -43,153 +43,6 @@
SCM scm_metaclass_standard;
SCM scm_metaclass_operator;
/* These variables are filled in by the object system when loaded. */
SCM scm_class_boolean, scm_class_char, scm_class_pair;
SCM scm_class_procedure, scm_class_string, scm_class_symbol;
SCM scm_class_procedure_with_setter, scm_class_primitive_generic;
SCM scm_class_vector, scm_class_null;
SCM scm_class_integer, scm_class_real, scm_class_complex, scm_class_fraction;
SCM scm_class_unknown;
int scm_classes_initialized = 0;
SCM *scm_port_class = 0;
SCM *scm_smob_class = 0;
SCM scm_no_applicable_method;
/* This function is used for efficient type dispatch. */
SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
(SCM x),
"Return the class of @var{x}.")
#define FUNC_NAME s_scm_class_of
{
if (!scm_classes_initialized)
scm_misc_error (NULL, "GOOPS not loaded yet.", SCM_EOL);
switch (SCM_ITAG3 (x))
{
case scm_tc3_int_1:
case scm_tc3_int_2:
return scm_class_integer;
case scm_tc3_imm24:
if (SCM_CHARP (x))
return scm_class_char;
else if (scm_is_bool (x))
return scm_class_boolean;
else if (scm_is_null (x))
return scm_class_null;
else
return scm_class_unknown;
case scm_tc3_cons:
switch (SCM_TYP7 (x))
{
case scm_tcs_cons_nimcar:
return scm_class_pair;
case scm_tcs_closures:
return scm_class_procedure;
case scm_tc7_symbol:
return scm_class_symbol;
case scm_tc7_vector:
case scm_tc7_wvect:
return scm_class_vector;
case scm_tc7_string:
return scm_class_string;
case scm_tc7_number:
switch SCM_TYP16 (x) {
case scm_tc16_big:
return scm_class_integer;
case scm_tc16_real:
return scm_class_real;
case scm_tc16_complex:
return scm_class_complex;
case scm_tc16_fraction:
return scm_class_fraction;
}
case scm_tc7_asubr:
case scm_tc7_subr_0:
case scm_tc7_subr_1:
case scm_tc7_dsubr:
case scm_tc7_cxr:
case scm_tc7_subr_3:
case scm_tc7_subr_2:
case scm_tc7_rpsubr:
case scm_tc7_subr_1o:
case scm_tc7_subr_2o:
case scm_tc7_lsubr_2:
case scm_tc7_lsubr:
if (SCM_SUBR_GENERIC (x) && *SCM_SUBR_GENERIC (x))
return scm_class_primitive_generic;
else
return scm_class_procedure;
case scm_tc7_cclo:
return scm_class_procedure;
case scm_tc7_pws:
return scm_class_procedure_with_setter;
case scm_tc7_smob:
{
scm_t_bits type = SCM_TYP16 (x);
if (type != scm_tc16_port_with_ps)
return scm_smob_class[SCM_TC2SMOBNUM (type)];
x = SCM_PORT_WITH_PS_PORT (x);
/* fall through to ports */
}
case scm_tc7_port:
return scm_port_class[(SCM_WRTNG & SCM_CELL_WORD_0 (x)
? (SCM_RDNG & SCM_CELL_WORD_0 (x)
? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x)
: SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x))
: SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))];
case scm_tcs_struct:
if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID)
return SCM_CLASS_OF (x);
else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
{
/* Goops object */
if (! scm_is_false (SCM_OBJ_CLASS_REDEF (x)))
scm_change_object_class (x,
SCM_CLASS_OF (x), /* old */
SCM_OBJ_CLASS_REDEF (x)); /* new */
return SCM_CLASS_OF (x);
}
else
{
/* ordinary struct */
SCM handle = scm_struct_create_handle (SCM_STRUCT_VTABLE (x));
if (scm_is_true (SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle))))
return SCM_STRUCT_TABLE_CLASS (SCM_CDR (handle));
else
{
SCM name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle));
SCM class = scm_make_extended_class (scm_is_true (name)
? scm_i_symbol_chars (name)
: 0,
SCM_I_OPERATORP (x));
SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
return class;
}
}
default:
if (scm_is_pair (x))
return scm_class_pair;
else
return scm_class_unknown;
}
case scm_tc3_struct:
case scm_tc3_tc7_1:
case scm_tc3_tc7_2:
case scm_tc3_closure:
/* Never reached */
break;
}
return scm_class_unknown;
}
#undef FUNC_NAME
/* The cache argument for scm_mcache_lookup_cmethod has one of two possible
* formats:
*