summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-11-01 20:45:02 +0100
committerAndy Wingo <wingo@pobox.com>2009-11-15 20:28:12 +0100
commitefcebb5b56a315f42c32e8bbc682d218a38c9428 (patch)
tree3b24d189c8ffeefa2cd675a47fb331f54dfd1f65
parent11561496bad94481cc2b3d8acba1a154e3c052fc (diff)
downloadguile-efcebb5b56a315f42c32e8bbc682d218a38c9428.tar.gz
fold objects.[ch] into goops.[ch]
Remove objects.h #includes as appropriate.
-rw-r--r--libguile.h1
-rw-r--r--libguile/Makefile.am4
-rw-r--r--libguile/debug.c1
-rw-r--r--libguile/eq.c1
-rw-r--r--libguile/eval.c1
-rw-r--r--libguile/goops.c165
-rw-r--r--libguile/goops.h55
-rw-r--r--libguile/init.c2
-rw-r--r--libguile/objects.c212
-rw-r--r--libguile/objects.h110
-rw-r--r--libguile/ports.c1
-rw-r--r--libguile/print.c1
-rw-r--r--libguile/procprop.c1
-rw-r--r--libguile/procs.c1
-rw-r--r--libguile/smob.c1
15 files changed, 200 insertions, 357 deletions
diff --git a/libguile.h b/libguile.h
index 73b3de76b..3b2f6958e 100644
--- 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 96c66a79e..fc6bb6fe1 100644
--- 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 fda071cb5..a6de84a73 100644
--- 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 fadd75620..2db4ac022 100644
--- 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 8039efdef..df9e5ab5c 100644
--- 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 0a97a4a42..c6188ba3a 100644
--- 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 0f8a3e7a1..01cf23c53 100644
--- 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 68156ef28..82c73f7c4 100644
--- 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
index 99aa6617d..000000000
--- 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
- */
-
-
-
-
-/* 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"
-
-
-
-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
index aabc4ecf7..000000000
--- 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
- */
-
-
-
-/* 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"
-
-
-
-/* {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 8127e9823..e71ee0adc 100644
--- 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 b07e2067f..fd984d3e8 100644
--- 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 b7e8059ca..2b67bb137 100644
--- 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 14646d989..df6251404 100644
--- 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 42a51fdff..31f6dd022 100644
--- 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"