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 -#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"