mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 19:50:24 +02:00
Remove scm_c_extend_primitive_generic
* libguile/goops.h (scm_c_extend_primitive_generic): Remove public interface. This was introduced in 2003 with the "extended" generics but never documented, unused as far as I can tell, and is better accessed from Scheme. * libguile/goops.c: Remove support for scm_c_extend_primitive_generic. Simplify capture of change-class.
This commit is contained in:
parent
2b7692bcc4
commit
5a6165db6e
2 changed files with 1 additions and 68 deletions
|
@ -90,12 +90,6 @@ static SCM var_slot_set_x = SCM_BOOL_F;
|
||||||
static SCM var_slot_bound_p = SCM_BOOL_F;
|
static SCM var_slot_bound_p = SCM_BOOL_F;
|
||||||
static SCM var_slot_exists_p = SCM_BOOL_F;
|
static SCM var_slot_exists_p = SCM_BOOL_F;
|
||||||
|
|
||||||
|
|
||||||
SCM_SYMBOL (sym_change_class, "change-class");
|
|
||||||
|
|
||||||
SCM_VARIABLE (scm_var_make_extended_generic, "make-extended-generic");
|
|
||||||
|
|
||||||
|
|
||||||
#define SCM_GOOPS_UNBOUND SCM_UNBOUND
|
#define SCM_GOOPS_UNBOUND SCM_UNBOUND
|
||||||
#define SCM_GOOPS_UNBOUNDP(x) (scm_is_eq (x, SCM_GOOPS_UNBOUND))
|
#define SCM_GOOPS_UNBOUNDP(x) (scm_is_eq (x, SCM_GOOPS_UNBOUND))
|
||||||
|
|
||||||
|
@ -822,8 +816,6 @@ go_to_heaven (void *o)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
SCM_SYMBOL (scm_sym_change_class, "change-class");
|
|
||||||
|
|
||||||
static SCM
|
static SCM
|
||||||
purgatory (SCM obj, SCM new_class)
|
purgatory (SCM obj, SCM new_class)
|
||||||
{
|
{
|
||||||
|
@ -924,62 +916,6 @@ SCM_DEFINE (scm_primitive_generic_generic, "primitive-generic-generic", 1, 0, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
typedef struct t_extension {
|
|
||||||
struct t_extension *next;
|
|
||||||
SCM extended;
|
|
||||||
SCM extension;
|
|
||||||
} t_extension;
|
|
||||||
|
|
||||||
|
|
||||||
/* Hint for `scm_gc_malloc ()' et al. when allocating `t_extension'
|
|
||||||
objects. */
|
|
||||||
static const char extension_gc_hint[] = "GOOPS extension";
|
|
||||||
|
|
||||||
static t_extension *extensions = 0;
|
|
||||||
|
|
||||||
void
|
|
||||||
scm_c_extend_primitive_generic (SCM extended, SCM extension)
|
|
||||||
{
|
|
||||||
if (goops_loaded_p)
|
|
||||||
{
|
|
||||||
SCM gf, gext;
|
|
||||||
if (!SCM_UNPACK (*SCM_SUBR_GENERIC (extended)))
|
|
||||||
scm_enable_primitive_generic_x (scm_list_1 (extended));
|
|
||||||
gf = *SCM_SUBR_GENERIC (extended);
|
|
||||||
gext = scm_call_2 (SCM_VARIABLE_REF (scm_var_make_extended_generic),
|
|
||||||
gf,
|
|
||||||
SCM_SUBR_NAME (extension));
|
|
||||||
SCM_SET_SUBR_GENERIC (extension, gext);
|
|
||||||
}
|
|
||||||
else
|
|
||||||
{
|
|
||||||
t_extension *e = scm_gc_malloc (sizeof (t_extension),
|
|
||||||
extension_gc_hint);
|
|
||||||
t_extension **loc = &extensions;
|
|
||||||
/* Make sure that extensions are placed before their own
|
|
||||||
* extensions in the extensions list. O(N^2) algorithm, but
|
|
||||||
* extensions of primitive generics are rare.
|
|
||||||
*/
|
|
||||||
while (*loc && !scm_is_eq (extension, (*loc)->extended))
|
|
||||||
loc = &(*loc)->next;
|
|
||||||
e->next = *loc;
|
|
||||||
e->extended = extended;
|
|
||||||
e->extension = extension;
|
|
||||||
*loc = e;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
static void
|
|
||||||
setup_extended_primitive_generics ()
|
|
||||||
{
|
|
||||||
while (extensions)
|
|
||||||
{
|
|
||||||
t_extension *e = extensions;
|
|
||||||
scm_c_extend_primitive_generic (e->extended, e->extension);
|
|
||||||
extensions = e->next;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Dirk:FIXME:: In all of these scm_wta_dispatch_* routines it is
|
/* Dirk:FIXME:: In all of these scm_wta_dispatch_* routines it is
|
||||||
* assumed that 'gf' is zero if uninitialized. It would be cleaner if
|
* assumed that 'gf' is zero if uninitialized. It would be cleaner if
|
||||||
* some valid SCM value like SCM_BOOL_F or SCM_UNDEFINED were chosen.
|
* some valid SCM value like SCM_BOOL_F or SCM_UNDEFINED were chosen.
|
||||||
|
@ -1415,9 +1351,7 @@ SCM_DEFINE (scm_sys_goops_loaded, "%goops-loaded", 0, 0, 0,
|
||||||
var_method_specializers = scm_c_lookup ("method-specializers");
|
var_method_specializers = scm_c_lookup ("method-specializers");
|
||||||
var_method_procedure = scm_c_lookup ("method-procedure");
|
var_method_procedure = scm_c_lookup ("method-procedure");
|
||||||
|
|
||||||
var_change_class =
|
var_change_class = scm_c_lookup ("change-class");
|
||||||
scm_module_variable (scm_module_goops, sym_change_class);
|
|
||||||
setup_extended_primitive_generics ();
|
|
||||||
|
|
||||||
#if (SCM_ENABLE_DEPRECATED == 1)
|
#if (SCM_ENABLE_DEPRECATED == 1)
|
||||||
scm_init_deprecated_goops ();
|
scm_init_deprecated_goops ();
|
||||||
|
|
|
@ -167,7 +167,6 @@ SCM_API SCM scm_generic_capability_p (SCM proc);
|
||||||
SCM_API SCM scm_enable_primitive_generic_x (SCM subrs);
|
SCM_API SCM scm_enable_primitive_generic_x (SCM subrs);
|
||||||
SCM_INTERNAL SCM scm_set_primitive_generic_x (SCM subr, SCM generic);
|
SCM_INTERNAL SCM scm_set_primitive_generic_x (SCM subr, SCM generic);
|
||||||
SCM_API SCM scm_primitive_generic_generic (SCM subr);
|
SCM_API SCM scm_primitive_generic_generic (SCM subr);
|
||||||
SCM_API void scm_c_extend_primitive_generic (SCM subr, SCM extension);
|
|
||||||
SCM_API SCM stklos_version (void);
|
SCM_API SCM stklos_version (void);
|
||||||
SCM_API SCM scm_make (SCM args);
|
SCM_API SCM scm_make (SCM args);
|
||||||
SCM_API void scm_change_object_class (SCM, SCM, SCM);
|
SCM_API void scm_change_object_class (SCM, SCM, SCM);
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue