mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

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

Browse source 
Remove objects.h #includes as appropriate.
This commit is contained in:
Andy Wingo 2009-11-01 20:45:02 +01:00
parent 11561496ba
commit efcebb5b56
15 changed files with 200 additions and 357 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile.h
View file

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

4
libguile/Makefile.am
View file

@ -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 \

1
libguile/debug.c
View file

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

1
libguile/eq.c
View file

@ -34,7 +34,6 @@
#include "libguile/struct.h"
#include "libguile/goops.h"
#include "libguile/objects.h"
#include "libguile/validate.h"
#include "libguile/eq.h"

1
libguile/eval.c
View file

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

165
libguile/goops.c
View file

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

55
libguile/goops.h
View file

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

2
libguile/init.c
View file

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

212
libguile/objects.c
View file

@ -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:
*/

110
libguile/objects.h
View file

@ -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:
*/

1
libguile/ports.c
View file

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

1
libguile/print.c
View file

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

1
libguile/procprop.c
View file

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

1
libguile/procs.c
View file

@ -24,7 +24,6 @@
#include "libguile/_scm.h"
#include "libguile/objects.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
#include "libguile/smob.h"

1
libguile/smob.c
View file

@ -28,7 +28,6 @@
#include "libguile/_scm.h"
#include "libguile/async.h"
#include "libguile/objects.h"
#include "libguile/goops.h"
#include "libguile/ports.h"