mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 17:20:29 +02:00
Code Activity

* Simplified the goops macro system a bit and fixed a bug.

Browse source
This commit is contained in:
Dirk Herrmann 2001-06-11 08:51:28 +00:00
parent 495c67e53b
commit 00d8d838bb
3 changed files with 52 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

16
libguile/ChangeLog
View file

@ -1,3 +1,19 @@
2001-06-11 Dirk Herrmann <D.Herrmann@tu-bs.de>
* struct.h (SCM_STRUCT_VTABLE_FLAGS): New macro.
* goops.h (SCM_NUMBER_OF_SLOTS): Removed bogus `\´ at the end of
the macro definition.
(SCM_CLASSP, SCM_INSTANCEP, SCM_PUREGENERICP, SCM_ACCESSORP,
SCM_SIMPLEMETHODP, SCM_FASTMETHODP): Use SCM_STRUCT_VTABLE_FLAGS
instead of SCM_INST_TYPE.
(SCM_ACCESSORP, SCM_SIMPLEMETHODP, SCM_FASTMETHODP): Make sure
the object is a struct before accessing its struct flags.
(SCM_INST_TYPE, SCM_SIMPLEMETHODP, SCM_FASTMETHODP): Deprecated.
2001-06-10 Gary Houston <ghouston@arglist.com>
* rdelim.c (scm_init_rdelim_builtins): don't try to activate the

54
libguile/goops.h
View file

@ -117,45 +117,44 @@ typedef struct scm_method_t {
& SCM_CLASSF_MASK)
#define SCM_INST(x) SCM_STRUCT_DATA (x)
#define SCM_INST_TYPE(x) SCM_OBJ_CLASS_FLAGS (x)
/* Also defined in libguuile/objects.c */
/* 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]))
#define SCM_NUMBER_OF_SLOTS(x) \
(SCM_UNPACK (SCM_STRUCT_DATA (x)[scm_struct_i_n_words]) \
- scm_struct_n_extra_words) \
- scm_struct_n_extra_words)
#define SCM_CLASSP(x) \
(SCM_STRUCTP (x) && SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_METACLASS)
#define SCM_VALIDATE_CLASS(pos, x) SCM_MAKE_VALIDATE (pos, x, CLASSP)
#define SCM_INSTANCEP(x) \
(SCM_STRUCTP (x) && (SCM_INST_TYPE (x) & SCM_CLASSF_GOOPS))
(SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_GOOPS))
#define SCM_VALIDATE_INSTANCE(pos, x) SCM_MAKE_VALIDATE (pos, x, INSTANCEP)
#define SCM_PUREGENERICP(x) \
(SCM_STRUCTP (x) && (SCM_INST_TYPE(x) & SCM_CLASSF_PURE_GENERIC))
(SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_PURE_GENERIC))
#define SCM_VALIDATE_PUREGENERIC(pos, x) SCM_MAKE_VALIDATE (pos, x, PUREGENERICP)
#define SCM_SIMPLEMETHODP(x) (SCM_INST_TYPE(x) & SCM_CLASSF_SIMPLE_METHOD)
#define SCM_ACCESSORP(x) (SCM_INST_TYPE(x) & SCM_CLASSF_ACCESSOR_METHOD)
#define SCM_ACCESSORP(x) \
(SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_ACCESSOR_METHOD))
#define SCM_VALIDATE_ACCESSOR(pos, x) SCM_MAKE_VALIDATE (pos, x, ACCESSORP)
#define SCM_FASTMETHODP(x) (SCM_INST_TYPE(x) \
& (SCM_CLASSF_ACCESSOR_METHOD \
| SCM_CLASSF_SIMPLE_METHOD))
#define SCM_SLOT(x, i) (SCM_PACK (SCM_INST (x) [i]))
#define SCM_SET_SLOT(x, i, v) (SCM_INST (x) [i] = SCM_UNPACK (v))
#define SCM_SET_HASHSET(c, i, h) (SCM_INST (c) [scm_si_hashsets + (i)] = (h))
#define SCM_SUBCLASSP(c1, c2) (!SCM_FALSEP (scm_c_memq (c2, SCM_SLOT (c1, scm_si_cpl))))
#define SCM_IS_A_P(x, c) (SCM_NIMP (x) \
&& SCM_INSTANCEP (x) \
&& SCM_SUBCLASSP (SCM_CLASS_OF (x), c))
#define SCM_CLASSP(x) (SCM_STRUCTP (x) \
&& SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_METACLASS)
#define SCM_VALIDATE_CLASS(pos, x) SCM_MAKE_VALIDATE (pos, x, CLASSP)
#define SCM_GENERICP(x) (SCM_INSTANCEP (x) \
&& SCM_SUBCLASSP (SCM_CLASS_OF (x), scm_class_generic))
#define SCM_SUBCLASSP(c1, c2) (!SCM_FALSEP (scm_c_memq (c2, SCM_SLOT (c1, scm_si_cpl))))
#define SCM_IS_A_P(x, c) \
(SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), c))
#define SCM_GENERICP(x) \
(SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), scm_class_generic))
#define SCM_VALIDATE_GENERIC(pos, x) SCM_MAKE_VALIDATE (pos, x, GENERICP)
#define SCM_METHODP(x) (SCM_INSTANCEP (x) \
&& SCM_SUBCLASSP(SCM_CLASS_OF(x), scm_class_method))
#define SCM_METHODP(x) \
(SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), scm_class_method))
#define SCM_VALIDATE_METHOD(pos, x) SCM_MAKE_VALIDATE (pos, x, METHODP)
#define SCM_MCACHE_N_SPECIALIZED(C) SCM_CADDR (C)
@ -286,4 +285,17 @@ SCM scm_sys_method_more_specific_p (SCM m1, SCM m2, SCM targs);
SCM scm_init_goops_builtins (void);
void scm_init_goops (void);
#if (SCM_DEBUG_DEPRECATED == 0)
#define SCM_INST_TYPE(x) SCM_OBJ_CLASS_FLAGS (x)
#define SCM_SIMPLEMETHODP(x) \
(SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_SIMPLE_METHOD))
#define SCM_FASTMETHODP(x) \
(SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) \
& (SCM_CLASSF_ACCESSOR_METHOD \
| SCM_CLASSF_SIMPLE_METHOD)))
#endif
#endif /* SCM_GOOPS_H */

2
libguile/struct.h
View file

@ -86,6 +86,8 @@ typedef size_t (*scm_struct_free_t) (scm_bits_t * vtable, scm_bits_t * data);
#define SCM_SET_STRUCT_LAYOUT(X, v) (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout] = SCM_UNPACK (v))
#define SCM_STRUCT_VTABLE(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_vtable]))
#define SCM_STRUCT_VTABLE_FLAGS(X) \
(SCM_STRUCT_VTABLE_DATA (X) [scm_struct_i_flags])
#define SCM_STRUCT_PRINTER(X) (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_printer]))
#define SCM_SET_STRUCT_PRINTER(x, v)\
(SCM_STRUCT_VTABLE_DATA (x) [scm_vtable_index_printer] = SCM_UNPACK (v))