fold objects.[ch] into goops.[ch]

Remove objects.h #includes as appropriate.

diff --git a/libguile.h b/libguile.h
index 73b3de7..3b2f695 100644 (file)
--- a/libguile.h
+++ b/libguile.h
@@ -73,7 +73,6 @@ extern "C" {
 #include "libguile/modules.h"
 #include "libguile/net_db.h"
 #include "libguile/numbers.h"
-#include "libguile/objects.h"
 #include "libguile/objprop.h"
 #include "libguile/options.h"
 #include "libguile/pairs.h"

diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 96c66a7..fc6bb6f 100644 (file)
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -158,7 +158,6 @@ libguile_la_SOURCES =                               \
        null-threads.c                          \
        numbers.c                               \
        objcodes.c                              \
-       objects.c                               \
        objprop.c                               \
        options.c                               \
        pairs.c                                 \
@@ -251,7 +250,6 @@ DOT_X_FILES =                                       \
        mallocs.x                               \
        modules.x                               \
        numbers.x                               \
-       objects.x                               \
        objprop.x                               \
        options.x                               \
        pairs.x                                 \
@@ -347,7 +345,6 @@ DOT_DOC_FILES =                             \
        mallocs.doc                             \
        modules.doc                             \
        numbers.doc                             \
-       objects.doc                             \
        objprop.doc                             \
        options.doc                             \
        pairs.doc                               \
@@ -509,7 +506,6 @@ modinclude_HEADERS =                                \
        null-threads.h                          \
        numbers.h                               \
        objcodes.h                              \
-       objects.h                               \
        objprop.h                               \
        options.h                               \
        pairs.h                                 \

diff --git a/libguile/debug.c b/libguile/debug.c
index fda071c..a6de84a 100644 (file)
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -47,7 +47,6 @@
 #include "libguile/ports.h"
 #include "libguile/root.h"
 #include "libguile/fluids.h"
-#include "libguile/objects.h"
 #include "libguile/programs.h"
 
 #include "libguile/validate.h"

diff --git a/libguile/eq.c b/libguile/eq.c
index fadd756..2db4ac0 100644 (file)
--- a/libguile/eq.c
+++ b/libguile/eq.c
@@ -34,7 +34,6 @@
 
 #include "libguile/struct.h"
 #include "libguile/goops.h"
-#include "libguile/objects.h"
 
 #include "libguile/validate.h"
 #include "libguile/eq.h"

diff --git a/libguile/eval.c b/libguile/eval.c
index 8039efd..df9e5ab 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -48,7 +48,6 @@
 #include "libguile/list.h"
 #include "libguile/macros.h"
 #include "libguile/modules.h"
-#include "libguile/objects.h"
 #include "libguile/ports.h"
 #include "libguile/print.h"
 #include "libguile/procprop.h"

diff --git a/libguile/goops.c b/libguile/goops.c
index 0a97a4a..c6188ba 100644 (file)
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -44,9 +44,9 @@
 #include "libguile/keywords.h"
 #include "libguile/macros.h"
 #include "libguile/modules.h"
-#include "libguile/objects.h"
 #include "libguile/ports.h"
 #include "libguile/procprop.h"
+#include "libguile/programs.h"
 #include "libguile/random.h"
 #include "libguile/root.h"
 #include "libguile/smob.h"
@@ -54,12 +54,23 @@
 #include "libguile/strports.h"
 #include "libguile/vectors.h"
 #include "libguile/weaks.h"
+#include "libguile/vm.h"
 
 #include "libguile/validate.h"
 #include "libguile/goops.h"
 
 #define SPEC_OF(x)  SCM_SLOT (x, scm_si_specializers)
 
+#define SCM_CMETHOD_CODE(cmethod) SCM_CDR (cmethod)
+#define SCM_CMETHOD_FORMALS(cmethod) SCM_CAR (SCM_CMETHOD_CODE (cmethod))
+#define SCM_CMETHOD_BODY(cmethod) SCM_CDR (SCM_CMETHOD_CODE (cmethod))
+#define SCM_CMETHOD_ENV(cmethod)  SCM_CAR (cmethod)
+
+/* Port classes */
+#define SCM_IN_PCLASS_INDEX       0
+#define SCM_OUT_PCLASS_INDEX      SCM_I_MAX_PORT_TYPE_COUNT
+#define SCM_INOUT_PCLASS_INDEX    (2 * SCM_I_MAX_PORT_TYPE_COUNT)
+
 /* this file is a mess. in theory, though, we shouldn't have many SCM references
    -- most of the references should be to vars. */
 
@@ -105,10 +116,6 @@ SCM_VARIABLE (scm_var_make_extended_generic, "make-extended-generic");
    h1.
 */
 
-/* The following definition is located in libguile/objects.h:
-#define SCM_OBJ_CLASS_REDEF(x) (SCM_STRUCT_VTABLE_DATA(x)[scm_si_redefined])
-*/
-
 #define TEST_CHANGE_CLASS(obj, class)                                 \
        {                                                              \
          class = SCM_CLASS_OF (obj);                                  \
@@ -1777,6 +1784,154 @@ static SCM list_of_no_method;
 SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
 
 
+/* The cache argument for scm_mcache_lookup_cmethod has one of two possible
+ * formats:
+ *
+ * Format #1:
+ * (SCM_IM_DISPATCH ARGS N-SPECIALIZED
+ *   #((TYPE1 ... ENV FORMALS FORM ...) ...)
+ *   GF)
+ *
+ * Format #2:
+ * (SCM_IM_HASH_DISPATCH ARGS N-SPECIALIZED HASHSET MASK
+ *   #((TYPE1 ... ENV FORMALS FORM ...) ...)
+ *   GF)
+ *
+ * ARGS is either a list of expressions, in which case they
+ * are interpreted as the arguments of an application, or
+ * a non-pair, which is interpreted as a single expression
+ * yielding all arguments.
+ *
+ * SCM_IM_DISPATCH expressions in generic functions always
+ * have ARGS = the symbol `args' or the iloc #@0-0.
+ *
+ * Need FORMALS in order to support varying arity.  This
+ * also avoids the need for renaming of bindings.
+ *
+ * We should probably not complicate this mechanism by
+ * introducing "optimizations" for getters and setters or
+ * primitive methods.  Getters and setter will normally be
+ * compiled into @slot-[ref|set!] or a procedure call.
+ * They rely on the dispatch performed before executing
+ * the code which contains them.
+ *
+ * We might want to use a more efficient representation of
+ * this form in the future, perhaps after we have introduced
+ * low-level support for syntax-case macros.
+ */
+
+SCM
+scm_mcache_lookup_cmethod (SCM cache, SCM args)
+{
+  unsigned long i, mask, n, end;
+  SCM ls, methods, z = SCM_CDDR (cache);
+  n = scm_to_ulong (SCM_CAR (z)); /* maximum number of specializers */
+  methods = SCM_CADR (z);
+
+  if (scm_is_simple_vector (methods))
+    {
+      /* cache format #1: prepare for linear search */
+      mask = -1;
+      i = 0;
+      end = SCM_SIMPLE_VECTOR_LENGTH (methods);
+    }
+  else
+    {
+      /* cache format #2: compute a hash value */
+      unsigned long hashset = scm_to_ulong (methods);
+      long j = n;
+      z = SCM_CDDR (z);
+      mask = scm_to_ulong (SCM_CAR (z));
+      methods = SCM_CADR (z);
+      i = 0;
+      ls = args;
+      if (!scm_is_null (ls))
+       do
+         {
+           i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
+                [scm_si_hashsets + hashset];
+           ls = SCM_CDR (ls);
+         }
+       while (j-- && !scm_is_null (ls));
+      i &= mask;
+      end = i;
+    }
+
+  /* Search for match  */
+  do
+    {
+      long j = n;
+      z = SCM_SIMPLE_VECTOR_REF (methods, i);
+      ls = args; /* list of arguments */
+      if (!scm_is_null (ls))
+       do
+         {
+           /* More arguments than specifiers => CLASS != ENV */
+           if (! scm_is_eq (scm_class_of (SCM_CAR (ls)), SCM_CAR (z)))
+             goto next_method;
+           ls = SCM_CDR (ls);
+           z = SCM_CDR (z);
+         }
+       while (j-- && !scm_is_null (ls));
+      /* Fewer arguments than specifiers => CAR != CLASS or `no-method' */
+      if (!scm_is_pair (z)
+          || (!SCM_CLASSP (SCM_CAR (z)) && !scm_is_symbol (SCM_CAR (z))))
+       return z;
+    next_method:
+      i = (i + 1) & mask;
+    } while (i != end);
+  return SCM_BOOL_F;
+}
+
+SCM
+scm_mcache_compute_cmethod (SCM cache, SCM args)
+{
+  SCM cmethod = scm_mcache_lookup_cmethod (cache, args);
+  if (scm_is_false (cmethod))
+    /* No match - memoize */
+    return scm_memoize_method (cache, args);
+  return cmethod;
+}
+
+SCM
+scm_apply_generic (SCM gf, SCM args)
+{
+  SCM cmethod = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (gf), args);
+  if (SCM_PROGRAM_P (cmethod))
+    return scm_vm_apply (scm_the_vm (), cmethod, args);
+  else if (scm_is_pair (cmethod))
+    return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)),
+                          SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)),
+                                          args,
+                                          SCM_CMETHOD_ENV (cmethod)));
+  else
+    return scm_apply (cmethod, args, SCM_EOL);
+}
+
+SCM
+scm_call_generic_0 (SCM gf)
+{
+  return scm_apply_generic (gf, SCM_EOL);
+}
+
+SCM
+scm_call_generic_1 (SCM gf, SCM a1)
+{
+  return scm_apply_generic (gf, scm_list_1 (a1));
+}
+
+SCM
+scm_call_generic_2 (SCM gf, SCM a1, SCM a2)
+{
+  return scm_apply_generic (gf, scm_list_2 (a1, a2));
+}
+
+SCM
+scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
+{
+  return scm_apply_generic (gf, scm_list_3 (a1, a2, a3));
+}
+
 SCM
 scm_make_method_cache (SCM gf)
 {

diff --git a/libguile/goops.h b/libguile/goops.h
index 0f8a3e7..01cf23c 100644 (file)
--- a/libguile/goops.h
+++ b/libguile/goops.h
@@ -47,11 +47,9 @@
 #define scm_si_setter            4
 
 #define scm_si_goops_fields      5
-
-/* Defined in libguile/objects.h:
-#define scm_si_redefined         5    The class to which class was redefined.
+#define scm_si_redefined         5    /* The class to which class was redefined. */
 #define scm_si_hashsets                  6
-*/
+
 #define scm_si_name             14 /* a symbol */
 #define scm_si_direct_supers    15 /* (class ...) */
 #define scm_si_direct_slots     16 /* ((name . options) ...) */
@@ -61,6 +59,7 @@
 #define scm_si_slotdef_class    20
 #define scm_si_slots            21 /* ((name . options) ...) */
 #define scm_si_name_access      22
+#define scm_si_getters_n_setters scm_si_name_access
 #define scm_si_keyword_access   23
 #define scm_si_nfields          24 /* an integer */
 #define scm_si_environment      25 /* The environment in which class is built  */
@@ -74,18 +73,25 @@ typedef struct scm_t_method {
 
 #define SCM_METHOD(obj) ((scm_t_method *) SCM_STRUCT_DATA (obj))
 
+/* {Class flags}
+ *
+ * These are used for efficient identification of instances of a
+ * certain class or its subclasses when traversal of the inheritance
+ * graph would be too costly.
+ */
+#define SCM_CLASS_FLAGS(class) (SCM_STRUCT_DATA (class) [scm_struct_i_flags])
+#define SCM_OBJ_CLASS_FLAGS(obj) (SCM_STRUCT_VTABLE_DATA (obj) [scm_struct_i_flags])
+#define SCM_SET_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) |= (f))
+#define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) &= ~(f))
+#define SCM_CLASSF_MASK SCM_STRUCTF_MASK
+
 #define SCM_CLASSF_SIMPLE_METHOD    (0x004 << 20)
 #define SCM_CLASSF_ACCESSOR_METHOD  (0x008 << 20)
-
-/* Defined in libguile/objects.c */
-/* #define SCM_CLASSF_PURE_GENERIC  (0x010 << 20) */
-
+#define SCM_CLASSF_PURE_GENERIC SCM_STRUCTF_GOOPS_HACK
 #define SCM_CLASSF_FOREIGN         (0x020 << 20)
 #define SCM_CLASSF_METACLASS        (0x040 << 20)
-
-/* Defined in libguile/objects.c */
-/* #define SCM_CLASSF_GOOPS_VALID   (0x080 << 20) */
-/* #define SCM_CLASSF_GOOPS         (0x100 << 20) */
+#define SCM_CLASSF_GOOPS_VALID  (0x080 << 20)
+#define SCM_CLASSF_GOOPS        (0x100 << 20)
 #define SCM_CLASSF_GOOPS_OR_VALID (SCM_CLASSF_GOOPS | SCM_CLASSF_GOOPS_VALID)
 
 #define SCM_CLASSF_INHERIT      (~(SCM_CLASSF_PURE_GENERIC \
@@ -94,9 +100,10 @@ typedef struct scm_t_method {
                                    | SCM_STRUCTF_LIGHT) \
                                  & SCM_CLASSF_MASK)
 
+#define SCM_CLASS_OF(x)         SCM_STRUCT_VTABLE (x)
+#define SCM_OBJ_CLASS_REDEF(x)  (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x) [scm_si_redefined]))
 #define SCM_INST(x)           SCM_STRUCT_DATA (x)
 
-/* Also defined in libguile/objects.c */
 #define SCM_CLASS_OF(x)        SCM_STRUCT_VTABLE (x)
 #define SCM_ACCESSORS_OF(x)    (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x)[scm_si_getters_n_setters]))
 
@@ -133,6 +140,11 @@ typedef struct scm_t_method {
   (SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), scm_class_method))
 #define SCM_VALIDATE_METHOD(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, METHODP, "method")
 
+#define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d)
+#define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \
+  (SCM_STRUCT_DATA (c)[scm_struct_i_size] \
+   = (SCM_STRUCT_DATA (c) [scm_struct_i_size] & SCM_STRUCTF_MASK) | s)
+
 #define SCM_GENERIC_METHOD_CACHE(G) (SCM_PACK (SCM_STRUCT_DATA (G) [scm_struct_i_procedure]))
 #define SCM_SET_GENERIC_METHOD_CACHE(G,C) (SCM_STRUCT_DATA (G) [scm_struct_i_procedure] = SCM_UNPACK (C))
 #define SCM_GENERIC_SETTER(G) (SCM_PACK (SCM_STRUCT_DATA (G) [scm_struct_i_setter]))
@@ -142,8 +154,6 @@ typedef struct scm_t_method {
 
 #define SCM_INITIAL_MCACHE_SIZE          1
 
-#define scm_si_getters_n_setters scm_si_name_access
-
 #define scm_si_constructor      SCM_N_CLASS_SLOTS
 #define scm_si_destructor       SCM_N_CLASS_SLOTS + 1
 
@@ -229,6 +239,8 @@ SCM_API SCM scm_make_foreign_object (SCM cls, SCM initargs);
 SCM_API SCM scm_make_class (SCM meta, char *s_name, SCM supers, size_t size,
                            void * (*constructor) (SCM initargs),
                            size_t (*destructor) (void *));
+SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep);
+SCM_API void scm_make_port_classes (long ptobnum, char *type_name);
 SCM_API void scm_add_slot (SCM c, char *slot, SCM slot_class,
                           SCM (*getter) (SCM obj),
                           SCM (*setter) (SCM obj, SCM x),
@@ -257,6 +269,7 @@ SCM_API SCM scm_pure_generic_p (SCM obj);
 #endif
 
 SCM_API SCM scm_sys_compute_slots (SCM c);
+SCM_INTERNAL void scm_i_inherit_applicable (SCM c);
 SCM_INTERNAL SCM scm_i_get_keyword (SCM key, SCM l, long len,
                                    SCM default_value, const char *subr);
 SCM_API SCM scm_get_keyword (SCM key, SCM l, SCM default_value);
@@ -300,6 +313,18 @@ SCM_API SCM stklos_version (void);
 SCM_API SCM scm_make (SCM args);
 SCM_API SCM scm_find_method (SCM args);
 SCM_API SCM scm_sys_method_more_specific_p (SCM m1, SCM m2, SCM targs);
+SCM_API void scm_change_object_class (SCM, SCM, SCM);
+SCM_API SCM scm_memoize_method (SCM x, SCM args);
+SCM_API SCM scm_mcache_lookup_cmethod (SCM cache, SCM args);
+SCM_API SCM scm_mcache_compute_cmethod (SCM cache, SCM args);
+/* The following are declared in __scm.h
+SCM_API SCM scm_call_generic_0 (SCM gf);
+SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);
+SCM_API SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);
+SCM_API SCM scm_apply_generic (SCM gf, SCM args);
+*/
+SCM_API SCM scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3);
+
 
 SCM_INTERNAL SCM scm_init_goops_builtins (void);
 SCM_INTERNAL void scm_init_goops (void);

diff --git a/libguile/init.c b/libguile/init.c
index 68156ef..82c73f7 100644 (file)
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -82,7 +82,6 @@
 #include "libguile/modules.h"
 #include "libguile/net_db.h"
 #include "libguile/numbers.h"
-#include "libguile/objects.h"
 #include "libguile/objprop.h"
 #include "libguile/options.h"
 #include "libguile/pairs.h"
@@ -536,7 +535,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
   scm_init_symbols ();
   scm_init_values ();   /* Requires struct */
   scm_init_load ();     /* Requires strings */
-  scm_init_objects (); /* Requires struct */
   scm_init_print ();   /* Requires strings, struct */
   scm_init_read ();
   scm_init_stime ();

diff --git a/libguile/objects.c b/libguile/objects.c
deleted file mode 100644 (file)
index 99aa661..0000000
--- a/libguile/objects.c
+++ /dev/null
@@ -1,212 +0,0 @@
-/* Copyright (C) 1995,1996,1999,2000,2001, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
- * 
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-
-\f
-
-/* This file and objects.h contains those minimal pieces of the Guile
- * Object Oriented Programming System which need to be included in
- * libguile.  See the comments in objects.h.
- */
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include "libguile/_scm.h"
-
-#include "libguile/struct.h"
-#include "libguile/procprop.h"
-#include "libguile/chars.h"
-#include "libguile/keywords.h"
-#include "libguile/smob.h"
-#include "libguile/eval.h"
-#include "libguile/alist.h"
-#include "libguile/ports.h"
-#include "libguile/strings.h"
-#include "libguile/vectors.h"
-#include "libguile/programs.h"
-#include "libguile/vm.h"
-
-#include "libguile/validate.h"
-#include "libguile/objects.h"
-#include "libguile/goops.h"
-
-\f
-
-SCM scm_metaclass_standard;
-
-/* The cache argument for scm_mcache_lookup_cmethod has one of two possible
- * formats:
- *
- * Format #1:
- * (SCM_IM_DISPATCH ARGS N-SPECIALIZED
- *   #((TYPE1 ... ENV FORMALS FORM ...) ...)
- *   GF)
- *
- * Format #2:
- * (SCM_IM_HASH_DISPATCH ARGS N-SPECIALIZED HASHSET MASK
- *   #((TYPE1 ... ENV FORMALS FORM ...) ...)
- *   GF)
- *
- * ARGS is either a list of expressions, in which case they
- * are interpreted as the arguments of an application, or
- * a non-pair, which is interpreted as a single expression
- * yielding all arguments.
- *
- * SCM_IM_DISPATCH expressions in generic functions always
- * have ARGS = the symbol `args' or the iloc #@0-0.
- *
- * Need FORMALS in order to support varying arity.  This
- * also avoids the need for renaming of bindings.
- *
- * We should probably not complicate this mechanism by
- * introducing "optimizations" for getters and setters or
- * primitive methods.  Getters and setter will normally be
- * compiled into @slot-[ref|set!] or a procedure call.
- * They rely on the dispatch performed before executing
- * the code which contains them.
- *
- * We might want to use a more efficient representation of
- * this form in the future, perhaps after we have introduced
- * low-level support for syntax-case macros.
- */
-
-SCM
-scm_mcache_lookup_cmethod (SCM cache, SCM args)
-{
-  unsigned long i, mask, n, end;
-  SCM ls, methods, z = SCM_CDDR (cache);
-  n = scm_to_ulong (SCM_CAR (z)); /* maximum number of specializers */
-  methods = SCM_CADR (z);
-
-  if (scm_is_simple_vector (methods))
-    {
-      /* cache format #1: prepare for linear search */
-      mask = -1;
-      i = 0;
-      end = SCM_SIMPLE_VECTOR_LENGTH (methods);
-    }
-  else
-    {
-      /* cache format #2: compute a hash value */
-      unsigned long hashset = scm_to_ulong (methods);
-      long j = n;
-      z = SCM_CDDR (z);
-      mask = scm_to_ulong (SCM_CAR (z));
-      methods = SCM_CADR (z);
-      i = 0;
-      ls = args;
-      if (!scm_is_null (ls))
-       do
-         {
-           i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
-                [scm_si_hashsets + hashset];
-           ls = SCM_CDR (ls);
-         }
-       while (j-- && !scm_is_null (ls));
-      i &= mask;
-      end = i;
-    }
-
-  /* Search for match  */
-  do
-    {
-      long j = n;
-      z = SCM_SIMPLE_VECTOR_REF (methods, i);
-      ls = args; /* list of arguments */
-      if (!scm_is_null (ls))
-       do
-         {
-           /* More arguments than specifiers => CLASS != ENV */
-           if (! scm_is_eq (scm_class_of (SCM_CAR (ls)), SCM_CAR (z)))
-             goto next_method;
-           ls = SCM_CDR (ls);
-           z = SCM_CDR (z);
-         }
-       while (j-- && !scm_is_null (ls));
-      /* Fewer arguments than specifiers => CAR != CLASS or `no-method' */
-      if (!scm_is_pair (z)
-          || (!SCM_CLASSP (SCM_CAR (z)) && !scm_is_symbol (SCM_CAR (z))))
-       return z;
-    next_method:
-      i = (i + 1) & mask;
-    } while (i != end);
-  return SCM_BOOL_F;
-}
-
-SCM
-scm_mcache_compute_cmethod (SCM cache, SCM args)
-{
-  SCM cmethod = scm_mcache_lookup_cmethod (cache, args);
-  if (scm_is_false (cmethod))
-    /* No match - memoize */
-    return scm_memoize_method (cache, args);
-  return cmethod;
-}
-
-SCM
-scm_apply_generic (SCM gf, SCM args)
-{
-  SCM cmethod = scm_mcache_compute_cmethod (SCM_GENERIC_METHOD_CACHE (gf), args);
-  if (SCM_PROGRAM_P (cmethod))
-    return scm_vm_apply (scm_the_vm (), cmethod, args);
-  else if (scm_is_pair (cmethod))
-    return scm_eval_body (SCM_CDR (SCM_CMETHOD_CODE (cmethod)),
-                          SCM_EXTEND_ENV (SCM_CAR (SCM_CMETHOD_CODE (cmethod)),
-                                          args,
-                                          SCM_CMETHOD_ENV (cmethod)));
-  else
-    return scm_apply (cmethod, args, SCM_EOL);
-}
-
-SCM
-scm_call_generic_0 (SCM gf)
-{
-  return scm_apply_generic (gf, SCM_EOL);
-}
-
-SCM
-scm_call_generic_1 (SCM gf, SCM a1)
-{
-  return scm_apply_generic (gf, scm_list_1 (a1));
-}
-
-SCM
-scm_call_generic_2 (SCM gf, SCM a1, SCM a2)
-{
-  return scm_apply_generic (gf, scm_list_2 (a1, a2));
-}
-
-SCM
-scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
-{
-  return scm_apply_generic (gf, scm_list_3 (a1, a2, a3));
-}
-
-void
-scm_init_objects ()
-{
-#include "libguile/objects.x"
-}
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/

diff --git a/libguile/objects.h b/libguile/objects.h
deleted file mode 100644 (file)
index aabc4ec..0000000
--- a/libguile/objects.h
+++ /dev/null
@@ -1,110 +0,0 @@
-/* classes: h_files */
-
-#ifndef SCM_OBJECTS_H
-#define SCM_OBJECTS_H
-
-/* Copyright (C) 1996,1999,2000,2001, 2003, 2006, 2008, 2009 Free Software Foundation, Inc.
- *
- * This library is free software; you can redistribute it and/or
- * modify it under the terms of the GNU Lesser General Public License
- * as published by the Free Software Foundation; either version 3 of
- * the License, or (at your option) any later version.
- *
- * This library is distributed in the hope that it will be useful, but
- * WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- * Lesser General Public License for more details.
- *
- * You should have received a copy of the GNU Lesser General Public
- * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
- * 02110-1301 USA
- */
-
-\f
-
-/* This file and objects.c contains those minimal pieces of the Guile
- * Object Oriented Programming System which need to be included in
- * libguile.
- *
- * {Objects and structs}
- *
- * Objects are currently based upon structs.  Although the struct
- * implementation will change thoroughly in the future, objects will
- * still be based upon structs.
- */
-
-#include "libguile/__scm.h"
-#include "libguile/struct.h"
-
-\f
-
-/* {Class flags}
- *
- * These are used for efficient identification of instances of a
- * certain class or its subclasses when traversal of the inheritance
- * graph would be too costly.
- */
-#define SCM_CLASS_FLAGS(class) (SCM_STRUCT_DATA (class) [scm_struct_i_flags])
-#define SCM_OBJ_CLASS_FLAGS(obj) (SCM_STRUCT_VTABLE_DATA (obj) [scm_struct_i_flags])
-#define SCM_SET_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) |= (f))
-#define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLASS_FLAGS (c) &= ~(f))
-#define SCM_CLASSF_MASK SCM_STRUCTF_MASK
-
-#define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d)
-#define SCM_SET_CLASS_INSTANCE_SIZE(c, s) \
-  (SCM_STRUCT_DATA (c)[scm_struct_i_size] \
-   = (SCM_STRUCT_DATA (c) [scm_struct_i_size] & SCM_STRUCTF_MASK) | s)
-
-/* {Interface to Goops}
- *
- * The evaluator contains a multi-method dispatch mechanism.
- * This interface is used by that mechanism and during creation of
- * smob and struct classes. 
- */
-
-/* Internal representation of Goops objects. */
-#define SCM_CLASSF_PURE_GENERIC SCM_STRUCTF_GOOPS_HACK
-#define SCM_CLASSF_GOOPS_VALID  (0x080 << 20)
-#define SCM_CLASSF_GOOPS        (0x100 << 20)
-#define scm_si_redefined         5
-#define scm_si_hashsets          6
-#define SCM_CLASS_OF(x)         SCM_STRUCT_VTABLE (x)
-#define SCM_OBJ_CLASS_REDEF(x)  (SCM_PACK (SCM_STRUCT_VTABLE_DATA (x) [scm_si_redefined]))
-
-#define SCM_CMETHOD_CODE(cmethod) SCM_CDR (cmethod)
-#define SCM_CMETHOD_FORMALS(cmethod) SCM_CAR (SCM_CMETHOD_CODE (cmethod))
-#define SCM_CMETHOD_BODY(cmethod) SCM_CDR (SCM_CMETHOD_CODE (cmethod))
-#define SCM_CMETHOD_ENV(cmethod)  SCM_CAR (cmethod)
-
-/* Port classes */
-#define SCM_IN_PCLASS_INDEX       0
-#define SCM_OUT_PCLASS_INDEX      SCM_I_MAX_PORT_TYPE_COUNT
-#define SCM_INOUT_PCLASS_INDEX    (2 * SCM_I_MAX_PORT_TYPE_COUNT)
-
-/* Goops functions. */
-SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep);
-SCM_INTERNAL void scm_i_inherit_applicable (SCM c);
-SCM_API void scm_make_port_classes (long ptobnum, char *type_name);
-SCM_API void scm_change_object_class (SCM, SCM, SCM);
-SCM_API SCM scm_memoize_method (SCM x, SCM args);
-
-SCM_API SCM scm_mcache_lookup_cmethod (SCM cache, SCM args);
-SCM_API SCM scm_mcache_compute_cmethod (SCM cache, SCM args);
-/* The following are declared in __scm.h
-SCM_API SCM scm_call_generic_0 (SCM gf);
-SCM_API SCM scm_call_generic_1 (SCM gf, SCM a1);
-SCM_API SCM scm_call_generic_2 (SCM gf, SCM a1, SCM a2);
-SCM_API SCM scm_apply_generic (SCM gf, SCM args);
-*/
-SCM_API SCM scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3);
-
-SCM_INTERNAL void scm_init_objects (void);
-
-#endif  /* SCM_OBJECTS_H */
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/

diff --git a/libguile/ports.c b/libguile/ports.c
index 8127e98..e71ee0a 100644 (file)
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -40,7 +40,6 @@
 #include "libguile/async.h"
 #include "libguile/eval.h"
 #include "libguile/fports.h"  /* direct access for seek and truncate */
-#include "libguile/objects.h"
 #include "libguile/goops.h"
 #include "libguile/smob.h"
 #include "libguile/chars.h"

diff --git a/libguile/print.c b/libguile/print.c
index b07e206..fd984d3 100644 (file)
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -38,7 +38,6 @@
 #include "libguile/programs.h"
 #include "libguile/alist.h"
 #include "libguile/struct.h"
-#include "libguile/objects.h"
 #include "libguile/ports.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"

diff --git a/libguile/procprop.c b/libguile/procprop.c
index b7e8059..2b67bb1 100644 (file)
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -28,7 +28,6 @@
 #include "libguile/eval.h"
 #include "libguile/procs.h"
 #include "libguile/gsubr.h"
-#include "libguile/objects.h"
 #include "libguile/smob.h"
 #include "libguile/root.h"
 #include "libguile/vectors.h"

diff --git a/libguile/procs.c b/libguile/procs.c
index 14646d9..df62514 100644 (file)
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -24,7 +24,6 @@
 
 #include "libguile/_scm.h"
 
-#include "libguile/objects.h"
 #include "libguile/strings.h"
 #include "libguile/vectors.h"
 #include "libguile/smob.h"

diff --git a/libguile/smob.c b/libguile/smob.c
index 42a51fd..31f6dd0 100644 (file)
--- a/libguile/smob.c
+++ b/libguile/smob.c
@@ -28,7 +28,6 @@
 #include "libguile/_scm.h"
 
 #include "libguile/async.h"
-#include "libguile/objects.h"
 #include "libguile/goops.h"
 #include "libguile/ports.h"