1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00

deprecate make-vtable-vtable

* libguile/struct.h:
* libguile/struct.c (scm_make_vtable_vtable): Deprecate, as you can
  handle most of the use cases with make-vtable, and we don't want to
  promote the creation of new roots to the type hierarchy.
  (scm_i_make_vtable_vtable): The internal replacement.
This commit is contained in:
Andy Wingo 2011-11-18 11:50:50 +01:00
parent 5139b7b928
commit 0818837f65
3 changed files with 40 additions and 4 deletions

View file

@ -963,7 +963,7 @@ create_basic_classes (void)
/**** <class> ****/ /**** <class> ****/
SCM cs = scm_from_locale_string (SCM_CLASS_CLASS_LAYOUT); SCM cs = scm_from_locale_string (SCM_CLASS_CLASS_LAYOUT);
SCM name = scm_from_latin1_symbol ("<class>"); SCM name = scm_from_latin1_symbol ("<class>");
scm_class_class = scm_make_vtable_vtable (cs, SCM_INUM0, SCM_EOL); scm_class_class = scm_i_make_vtable_vtable (cs);
SCM_SET_CLASS_FLAGS (scm_class_class, (SCM_CLASSF_GOOPS_OR_VALID SCM_SET_CLASS_FLAGS (scm_class_class, (SCM_CLASSF_GOOPS_OR_VALID
| SCM_CLASSF_METACLASS)); | SCM_CLASSF_METACLASS));

View file

@ -24,6 +24,8 @@
#include <alloca.h> #include <alloca.h>
#include <assert.h> #include <assert.h>
#define SCM_BUILDING_DEPRECATED_CODE
#include "libguile/_scm.h" #include "libguile/_scm.h"
#include "libguile/async.h" #include "libguile/async.h"
#include "libguile/chars.h" #include "libguile/chars.h"
@ -569,6 +571,7 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
#if SCM_ENABLE_DEPRECATED == 1
SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1, SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
(SCM user_fields, SCM tail_array_size, SCM init), (SCM user_fields, SCM tail_array_size, SCM init),
"Return a new, self-describing vtable structure.\n\n" "Return a new, self-describing vtable structure.\n\n"
@ -663,7 +666,38 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
return obj; return obj;
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif
SCM
scm_i_make_vtable_vtable (SCM user_fields)
#define FUNC_NAME s_scm_make_vtable_vtable
{
SCM fields, layout, obj;
size_t basic_size;
scm_t_bits v;
SCM_VALIDATE_STRING (1, user_fields);
fields = scm_string_append (scm_list_2 (required_vtable_fields,
user_fields));
layout = scm_make_struct_layout (fields);
if (!scm_is_valid_vtable_layout (layout))
SCM_MISC_ERROR ("invalid user fields", scm_list_1 (user_fields));
basic_size = scm_i_symbol_length (layout) / 2;
obj = scm_i_alloc_struct (NULL, basic_size);
/* Make it so that the vtable of OBJ is itself. */
SCM_SET_CELL_WORD_0 (obj, (scm_t_bits) SCM_STRUCT_DATA (obj) | scm_tc3_struct);
v = SCM_UNPACK (layout);
scm_struct_init (obj, layout, 0, 1, &v);
SCM_SET_VTABLE_FLAGS (obj,
SCM_VTABLE_FLAG_VTABLE | SCM_VTABLE_FLAG_VALIDATED);
return obj;
}
#undef FUNC_NAME
SCM_DEFINE (scm_make_vtable, "make-vtable", 1, 1, 0, SCM_DEFINE (scm_make_vtable, "make-vtable", 1, 1, 0,
(SCM fields, SCM printer), (SCM fields, SCM printer),
@ -1038,8 +1072,7 @@ scm_init_struct ()
required_applicable_fields = scm_from_locale_string (SCM_APPLICABLE_BASE_LAYOUT); required_applicable_fields = scm_from_locale_string (SCM_APPLICABLE_BASE_LAYOUT);
required_applicable_with_setter_fields = scm_from_locale_string (SCM_APPLICABLE_WITH_SETTER_BASE_LAYOUT); required_applicable_with_setter_fields = scm_from_locale_string (SCM_APPLICABLE_WITH_SETTER_BASE_LAYOUT);
scm_standard_vtable_vtable = scm_standard_vtable_vtable = scm_i_make_vtable_vtable (scm_nullstr);
scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
scm_c_define ("<standard-vtable>", scm_standard_vtable_vtable); scm_c_define ("<standard-vtable>", scm_standard_vtable_vtable);
scm_applicable_struct_vtable_vtable = scm_applicable_struct_vtable_vtable =

View file

@ -180,7 +180,10 @@ SCM_API SCM scm_c_make_struct (SCM vtable, size_t n_tail, size_t n_inits,
SCM_API SCM scm_c_make_structv (SCM vtable, size_t n_tail, size_t n_inits, SCM_API SCM scm_c_make_structv (SCM vtable, size_t n_tail, size_t n_inits,
scm_t_bits init[]); scm_t_bits init[]);
SCM_API SCM scm_make_vtable (SCM fields, SCM printer); SCM_API SCM scm_make_vtable (SCM fields, SCM printer);
SCM_API SCM scm_make_vtable_vtable (SCM extra_fields, SCM tail_array_size, SCM init); SCM_INTERNAL SCM scm_i_make_vtable_vtable (SCM extra_fields);
#if SCM_ENABLE_DEPRECATED == 1
SCM_DEPRECATED SCM scm_make_vtable_vtable (SCM extra_fields, SCM tail_array_size, SCM init);
#endif
SCM_API SCM scm_struct_ref (SCM handle, SCM pos); SCM_API SCM scm_struct_ref (SCM handle, SCM pos);
SCM_API SCM scm_struct_set_x (SCM handle, SCM pos, SCM val); SCM_API SCM scm_struct_set_x (SCM handle, SCM pos, SCM val);
SCM_API SCM scm_struct_vtable (SCM handle); SCM_API SCM scm_struct_vtable (SCM handle);