No more concept of "pure generics"

* libguile/goops.h (SCM_PUREGENERICP, SCM_VALIDATE_PUREGENERIC)
  (SCM_VTABLE_FLAG_GOOPS_PURE_GENERIC, SCM_CLASSF_PURE_GENERIC):
  Remove.
* libguile/goops.c (scm_set_primitive_generic_x): Use SCM_GENERICP, not
  SCM_PUREGENERICP.
  (scm_sys_bless_pure_generic_vtable_x): Remove; this flag isn't
  checked.

* module/oop/goops.scm: Don't call %bless-pure-generic-vtable!; there's
  no need.

diff --git a/libguile/goops.c b/libguile/goops.c
index 8a8f8ac..34d12cd 100644 (file)
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -157,7 +157,6 @@ static SCM scm_unbound_p (SCM obj);
 static SCM scm_class_p (SCM obj);
 static SCM scm_sys_bless_applicable_struct_vtables_x (SCM applicable,
                                                       SCM setter);
-static SCM scm_sys_bless_pure_generic_vtable_x (SCM vtable);
 static SCM scm_sys_make_root_class (SCM name, SCM dslots,
                                     SCM getters_n_setters);
 static SCM scm_sys_init_layout_x (SCM class, SCM layout);
@@ -904,7 +903,7 @@ SCM_DEFINE (scm_set_primitive_generic_x, "set-primitive-generic!", 2, 0, 0,
 #define FUNC_NAME s_scm_set_primitive_generic_x
 {
   SCM_ASSERT (SCM_PRIMITIVE_GENERIC_P (subr), subr, SCM_ARG1, FUNC_NAME);
-  SCM_ASSERT (SCM_PUREGENERICP (generic), generic, SCM_ARG2, FUNC_NAME);
+  SCM_ASSERT (SCM_GENERICP (generic), generic, SCM_ARG2, FUNC_NAME);
   SCM_SET_SUBR_GENERIC (subr, generic);
   return SCM_UNSPECIFIED;
 }
@@ -1301,17 +1300,6 @@ SCM_DEFINE (scm_sys_bless_applicable_struct_vtables_x, "%bless-applicable-struct
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_sys_bless_pure_generic_vtable_x, "%bless-pure-generic-vtable!", 1, 0, 0,
-           (SCM vtable),
-           "")
-#define FUNC_NAME s_scm_sys_bless_pure_generic_vtable_x
-{
-  SCM_VALIDATE_CLASS (1, vtable);
-  SCM_SET_CLASS_FLAGS (vtable, SCM_CLASSF_PURE_GENERIC);
-  return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
            (),
            "")

diff --git a/libguile/goops.h b/libguile/goops.h
index c5ed39f..29aa80d 100644 (file)
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -42,7 +42,6 @@
  */
 #define SCM_VTABLE_FLAG_GOOPS_CLASS SCM_VTABLE_FLAG_GOOPS_0
 #define SCM_VTABLE_FLAG_GOOPS_VALID SCM_VTABLE_FLAG_GOOPS_1
-#define SCM_VTABLE_FLAG_GOOPS_PURE_GENERIC SCM_VTABLE_FLAG_GOOPS_2
 
 #define SCM_CLASS_OF(x)         SCM_STRUCT_VTABLE (x)
 #define SCM_CLASS_FLAGS(class) (SCM_VTABLE_FLAGS (class))
@@ -51,7 +50,6 @@
 #define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLEAR_VTABLE_FLAGS (c, f))
 
 #define SCM_CLASSF_METACLASS     (SCM_VTABLE_FLAG_GOOPS_CLASS|SCM_VTABLE_FLAG_VTABLE)
-#define SCM_CLASSF_PURE_GENERIC  SCM_VTABLE_FLAG_GOOPS_PURE_GENERIC
 #define SCM_CLASSF_GOOPS_VALID   SCM_VTABLE_FLAG_GOOPS_VALID
 #define SCM_CLASSF_GOOPS         SCM_VTABLE_FLAG_GOOPS_CLASS
 #define SCM_CLASSF_GOOPS_OR_VALID (SCM_CLASSF_GOOPS | SCM_CLASSF_GOOPS_VALID)
@@ -97,10 +95,6 @@
   (SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_GOOPS))
 #define SCM_VALIDATE_INSTANCE(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, INSTANCEP, "instance")
 
-#define SCM_PUREGENERICP(x) \
-  (SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_PURE_GENERIC))
-#define SCM_VALIDATE_PUREGENERIC(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, PUREGENERICP, "pure generic function")
-
 #define SCM_SLOT(x, i)         (SCM_STRUCT_SLOT_REF (x, i))
 #define SCM_SET_SLOT(x, i, v)  (SCM_STRUCT_SLOT_SET (x, i, v))
 

diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index c7703ea..dcc9a45 100644 (file)
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -530,26 +530,20 @@
   (n-specialized #:init-value 0)
   (extended-by #:init-value ())
   effective-methods)
-(%bless-pure-generic-vtable! <generic>)
 (define-standard-class <extended-generic> (<generic>)
   #:metaclass <applicable-struct-class>
   (extends #:init-value ()))
-(%bless-pure-generic-vtable! <extended-generic>)
 (define-standard-class <generic-with-setter> (<generic>
                                               <applicable-struct-with-setter>)
   #:metaclass <applicable-struct-with-setter-class>)
-(%bless-pure-generic-vtable! <generic-with-setter>)
 (define-standard-class <accessor> (<generic-with-setter>)
   #:metaclass <applicable-struct-with-setter-class>)
-(%bless-pure-generic-vtable! <accessor>)
 (define-standard-class <extended-generic-with-setter> (<extended-generic>
                                                        <generic-with-setter>)
   #:metaclass <applicable-struct-with-setter-class>)
-(%bless-pure-generic-vtable! <extended-generic-with-setter>)
 (define-standard-class <extended-accessor> (<accessor>
                                             <extended-generic-with-setter>)
   #:metaclass <applicable-struct-with-setter-class>)
-(%bless-pure-generic-vtable! <extended-accessor>)
 
 ;; Methods
 (define-standard-class <method> (<object>)