diff options
author | Andy Wingo <wingo@pobox.com> | 2011-05-05 14:09:29 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-05-05 14:09:29 +0200 |
commit | 891a1851a1e0e47560cf99cf76e9478d77e1a7db (patch) | |
tree | 8d00ba1b7f14b75005285d86abba3ea05b4f1767 /libguile/goops.c | |
parent | 1903eae4c9ab97b575dad4ab1f5cf05436d84ab3 (diff) | |
parent | eae2438d2bd1d9a0e0aaa052abb8b36b2d073850 (diff) | |
download | guile-891a1851a1e0e47560cf99cf76e9478d77e1a7db.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
Diffstat (limited to 'libguile/goops.c')
-rw-r--r-- | libguile/goops.c | 73 |
1 files changed, 42 insertions, 31 deletions
diff --git a/libguile/goops.c b/libguile/goops.c index f6102085f..274749048 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -169,6 +169,8 @@ static SCM class_vm_cont; static SCM class_bytevector; static SCM class_uvec; +static SCM vtable_class_map = SCM_BOOL_F; + /* Port classes. Allocate 3 times the maximum number of port types so that input ports, output ports, and in/out ports can be stored at different offsets. See `SCM_IN_PCLASS_INDEX' et al. */ @@ -189,6 +191,41 @@ static SCM scm_sys_goops_loaded (void); static SCM scm_make_extended_class_from_symbol (SCM type_name_sym, int applicablep); + +SCM +scm_i_define_class_for_vtable (SCM vtable) +{ + SCM class; + + if (scm_is_false (vtable_class_map)) + vtable_class_map = scm_make_weak_key_hash_table (SCM_UNDEFINED); + + if (scm_is_false (scm_struct_vtable_p (vtable))) + abort (); + + class = scm_hashq_ref (vtable_class_map, vtable, SCM_BOOL_F); + + if (scm_is_false (class)) + { + if (SCM_UNPACK (scm_class_class)) + { + SCM name = SCM_VTABLE_NAME (vtable); + if (!scm_is_symbol (name)) + name = scm_string_to_symbol (scm_nullstr); + + class = scm_make_extended_class_from_symbol + (name, SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_APPLICABLE)); + } + else + /* `create_struct_classes' will fill this in later. */ + class = SCM_BOOL_F; + + scm_hashq_set_x (vtable_class_map, vtable, class); + } + + return class; +} + /* This function is used for efficient type dispatch. */ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, (SCM x), @@ -288,26 +325,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, 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 class, name; - - name = SCM_STRUCT_TABLE_NAME (SCM_CDR (handle)); - if (!scm_is_symbol (name)) - name = scm_string_to_symbol (scm_nullstr); - - class = - scm_make_extended_class_from_symbol (name, - SCM_STRUCT_APPLICABLE_P (x)); - SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class); - return class; - } - } + return scm_i_define_class_for_vtable (SCM_CLASS_OF (x)); default: if (scm_is_pair (x)) return scm_class_pair; @@ -2628,23 +2646,16 @@ static SCM make_struct_class (void *closure SCM_UNUSED, SCM vtable, SCM data, SCM prev SCM_UNUSED) { - SCM sym = SCM_STRUCT_TABLE_NAME (data); - if (scm_is_true (sym)) - { - int applicablep = SCM_CLASS_FLAGS (vtable) & SCM_VTABLE_FLAG_APPLICABLE; - - SCM_SET_STRUCT_TABLE_CLASS (data, - scm_make_extended_class_from_symbol (sym, applicablep)); - } - - scm_remember_upto_here_2 (data, vtable); + if (scm_is_false (data)) + scm_i_define_class_for_vtable (vtable); return SCM_UNSPECIFIED; } static void create_struct_classes (void) { - scm_internal_hash_fold (make_struct_class, 0, SCM_BOOL_F, scm_struct_table); + scm_internal_hash_fold (make_struct_class, 0, SCM_BOOL_F, + vtable_class_map); } /********************************************************************** |