diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1999-01-05 09:40:49 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1999-01-05 09:40:49 +0000 |
commit | 7688430d0584f4489b81a723dc78169546496352 (patch) | |
tree | 18ebea215403bc08944180610e533a1d7a299e32 /libguile/objects.c | |
parent | 98fae09612357fbf7efe3463d5cef35f6821b112 (diff) | |
download | guile-7688430d0584f4489b81a723dc78169546496352.tar.gz |
Correction of mistake (should have committed onto a branch...)
Diffstat (limited to 'libguile/objects.c')
-rw-r--r-- | libguile/objects.c | 120 |
1 files changed, 0 insertions, 120 deletions
diff --git a/libguile/objects.c b/libguile/objects.c index a55209b13..cbb6b4ca9 100644 --- a/libguile/objects.c +++ b/libguile/objects.c @@ -49,8 +49,6 @@ #include "struct.h" #include "procprop.h" -#include "chars.h" -#include "kw.h" #include "objects.h" @@ -58,124 +56,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_vector, scm_class_null; -SCM scm_class_real, scm_class_complex, scm_class_integer; -SCM scm_class_keyword, scm_class_unknown; - -void (*scm_change_object_class) (SCM, SCM, SCM); - -/* This function is used for efficient type dispatch. */ -SCM -scm_class_of (SCM x) -{ - switch (SCM_ITAG3 (x)) - { - case scm_tc3_int_1: - case scm_tc3_int_2: - return scm_class_integer; - - case scm_tc3_imm24: - if (SCM_ICHRP (x)) - return scm_class_char; - else - { - switch (SCM_ISYMNUM (x)) - { - case SCM_ISYMNUM (SCM_BOOL_F): - case SCM_ISYMNUM (SCM_BOOL_T): - return scm_class_boolean; - case SCM_ISYMNUM (SCM_EOL): - return scm_class_null; - default: - 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_tcs_symbols: - return scm_class_symbol; - case scm_tc7_vector: - case scm_tc7_wvect: - case scm_tc7_bvect: - case scm_tc7_byvect: - case scm_tc7_svect: - case scm_tc7_ivect: - case scm_tc7_uvect: - case scm_tc7_fvect: - case scm_tc7_dvect: - case scm_tc7_cvect: - return scm_class_vector; - case scm_tc7_string: - case scm_tc7_substring: - return scm_class_string; - case scm_tc7_asubr: - case scm_tc7_subr_0: - case scm_tc7_subr_1: - 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: - return scm_class_procedure; - - case scm_tc7_port: - return scm_class_unknown; - case scm_tc7_smob: - { - SCM type = SCM_TYP16 (x); - if (type == scm_tc16_flo) - { - if (SCM_CAR (x) & SCM_IMAG_PART) - return scm_class_complex; - else - return scm_class_real; - } - else if (type == scm_tc16_bigpos || type == scm_tc16_bigneg) - return scm_class_integer; - else if (type == scm_tc16_kw) - return scm_class_keyword; - else - return scm_class_unknown; - } - case scm_tcs_cons_gloc: - /* must be a struct */ - if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS) - { - if (CLASS_REDEF (SCM_CLASS_OF (x)) != SCM_BOOL_F) - scm_change_object_class (x, - SCM_CLASS_OF (x), - CLASS_REDEF (SCM_CLASS_OF (x))); - return SCM_CLASS_OF (x); - } - default: - if (SCM_CONSP (x)) - return scm_class_pair; - else - return scm_class_unknown; - } - - case scm_tc3_cons_gloc: - case scm_tc3_tc7_1: - case scm_tc3_tc7_2: - case scm_tc3_closure: - /* Never reached */ - break; - } - return scm_class_unknown; -} - SCM_PROC (s_entity_p, "entity?", 1, 0, 0, scm_entity_p); SCM |