1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +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:
Andy Wingo 2015-01-10 23:20:47 +01:00
parent 2b7692bcc4
commit 5a6165db6e
2 changed files with 1 additions and 68 deletions

View file

@ -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 ();

View file

@ -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);