diff options
author | Marius Vollmer <mvo@zagadka.de> | 2005-01-18 14:58:39 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2005-01-18 14:58:39 +0000 |
commit | 539d541073d68e9b7732a933d6a66ce44077a330 (patch) | |
tree | 060dfeae76f65f52e0180478f6d4fe8109be4562 /libguile/objects.c | |
parent | 9511876f49845fd6ec73502fcfc36cdb4c6fb71e (diff) | |
download | guile-539d541073d68e9b7732a933d6a66ce44077a330.tar.gz |
* objects.h, objects.c, goops.c, goops.h (scm_class_boolean,
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.
Diffstat (limited to 'libguile/objects.c')
-rw-r--r-- | libguile/objects.c | 147 |
1 files changed, 0 insertions, 147 deletions
diff --git a/libguile/objects.c b/libguile/objects.c index 1695c185c..5c7575e5e 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -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: * |