6 /* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2011, 2015 Free Software Foundation, Inc.
8 * This library is free software; you can redistribute it and/or
9 * modify it under the terms of the GNU Lesser General Public License
10 * as published by the Free Software Foundation; either version 3 of
11 * the License, or (at your option) any later version.
13 * This library is distributed in the hope that it will be useful, but
14 * WITHOUT ANY WARRANTY; without even the implied warranty of
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 * Lesser General Public License for more details.
18 * You should have received a copy of the GNU Lesser General Public
19 * License along with this library; if not, write to the Free Software
20 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
26 /* This software is a derivative work of other copyrighted softwares; the
27 * copyright notices of these softwares are placed in the file COPYRIGHTS
29 * This file is based upon stklos.h from the STk distribution by
30 * Erick Gallesio <eg@unice.fr>.
33 #include "libguile/__scm.h"
35 #include "libguile/validate.h"
39 * These are used for efficient identification of instances of a
40 * certain class or its subclasses when traversal of the inheritance
41 * graph would be too costly.
43 #define SCM_VTABLE_FLAG_GOOPS_CLASS SCM_VTABLE_FLAG_GOOPS_0
44 #define SCM_VTABLE_FLAG_GOOPS_VALID SCM_VTABLE_FLAG_GOOPS_1
45 #define SCM_VTABLE_FLAG_GOOPS_SLOT SCM_VTABLE_FLAG_GOOPS_2
46 #define SCM_VTABLE_FLAG_GOOPS_STATIC SCM_VTABLE_FLAG_GOOPS_3
48 #define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x)
49 #define SCM_CLASS_FLAGS(class) (SCM_VTABLE_FLAGS (class))
50 #define SCM_OBJ_CLASS_FLAGS(obj) (SCM_STRUCT_VTABLE_FLAGS (obj))
51 #define SCM_SET_CLASS_FLAGS(c, f) (SCM_SET_VTABLE_FLAGS (c, f))
52 #define SCM_CLEAR_CLASS_FLAGS(c, f) (SCM_CLEAR_VTABLE_FLAGS (c, f))
54 #define SCM_CLASSF_METACLASS (SCM_VTABLE_FLAG_GOOPS_CLASS|SCM_VTABLE_FLAG_VTABLE)
55 #define SCM_CLASSF_GOOPS_VALID SCM_VTABLE_FLAG_GOOPS_VALID
56 #define SCM_CLASSF_GOOPS SCM_VTABLE_FLAG_GOOPS_CLASS
57 #define SCM_CLASSF_GOOPS_OR_VALID (SCM_CLASSF_GOOPS | SCM_CLASSF_GOOPS_VALID)
59 #define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x)
61 #define SCM_CLASSP(x) \
62 (SCM_STRUCTP (x) && SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_METACLASS)
63 #define SCM_VALIDATE_CLASS(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, CLASSP, "class")
65 #define SCM_INSTANCEP(x) \
66 (SCM_STRUCTP (x) && (SCM_STRUCT_VTABLE_FLAGS (x) & SCM_CLASSF_GOOPS))
67 #define SCM_VALIDATE_INSTANCE(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, INSTANCEP, "instance")
69 #define SCM_SLOT(x, i) (SCM_STRUCT_SLOT_REF (x, i))
70 #define SCM_SET_SLOT(x, i, v) (SCM_STRUCT_SLOT_SET (x, i, v))
72 #define SCM_SUBCLASSP(c1, c2) \
73 (scm_is_true (scm_c_memq (c2, scm_class_precedence_list (c1))))
74 #define SCM_IS_A_P(x, c) \
75 (SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), c))
77 #define SCM_GENERICP(x) (scm_is_generic (x))
78 #define SCM_VALIDATE_GENERIC(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, GENERICP, "generic function")
80 #define SCM_METHODP(x) (scm_is_method (x))
81 #define SCM_VALIDATE_METHOD(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, METHODP, "method")
83 #define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d)
85 SCM_INTERNAL SCM scm_i_port_class
[];
86 SCM_INTERNAL SCM scm_i_smob_class
[];
88 SCM_API SCM scm_module_goops
;
90 SCM_API SCM
scm_goops_version (void);
91 SCM_API
void scm_load_goops (void);
92 SCM_API SCM
scm_make_extended_class (char const *type_name
, int applicablep
);
93 SCM_API
void scm_make_port_classes (long ptobnum
, char *type_name
);
94 SCM_API SCM
scm_ensure_accessor (SCM name
);
95 SCM_API SCM
scm_class_of (SCM obj
);
97 /* Low level functions exported */
98 SCM_INTERNAL SCM
scm_make_standard_class (SCM meta
, SCM name
, SCM dsupers
,
101 /* Primitives exported */
102 SCM_API SCM
scm_slot_ref (SCM obj
, SCM slot_name
);
103 SCM_API SCM
scm_slot_set_x (SCM obj
, SCM slot_name
, SCM value
);
105 SCM_INTERNAL
void scm_i_inherit_applicable (SCM c
);
106 SCM_API SCM
scm_instance_p (SCM obj
);
107 SCM_API
int scm_is_generic (SCM x
);
108 SCM_API
int scm_is_method (SCM x
);
109 SCM_API SCM
scm_class_name (SCM obj
);
110 SCM_API SCM
scm_class_direct_supers (SCM obj
);
111 SCM_API SCM
scm_class_direct_slots (SCM obj
);
112 SCM_API SCM
scm_class_direct_subclasses (SCM obj
);
113 SCM_API SCM
scm_class_direct_methods (SCM obj
);
114 SCM_API SCM
scm_class_precedence_list (SCM obj
);
115 SCM_API SCM
scm_class_slots (SCM obj
);
116 SCM_API SCM
scm_generic_function_name (SCM obj
);
117 SCM_API SCM
scm_generic_function_methods (SCM obj
);
118 SCM_API SCM
scm_method_generic_function (SCM obj
);
119 SCM_API SCM
scm_method_specializers (SCM obj
);
120 SCM_API SCM
scm_method_procedure (SCM obj
);
121 SCM_API SCM
scm_slot_bound_p (SCM obj
, SCM slot_name
);
122 SCM_API SCM
scm_slot_exists_p (SCM obj
, SCM slot_name
);
123 SCM_API SCM
scm_sys_modify_instance (SCM old
, SCM newinst
);
124 SCM_API SCM
scm_sys_modify_class (SCM old
, SCM newcls
);
125 SCM_API SCM
scm_generic_capability_p (SCM proc
);
126 SCM_API SCM
scm_enable_primitive_generic_x (SCM subrs
);
127 SCM_INTERNAL SCM
scm_set_primitive_generic_x (SCM subr
, SCM generic
);
128 SCM_API SCM
scm_primitive_generic_generic (SCM subr
);
129 SCM_API SCM
scm_make (SCM args
);
130 SCM_API
void scm_change_object_class (SCM
, SCM
, SCM
);
132 /* These procedures are for dispatching to a generic when a primitive
133 fails to apply. They raise a wrong-type-arg error if the primitive's
134 generic has not been initialized yet. */
135 SCM_API SCM
scm_wta_dispatch_0 (SCM gf
, const char *subr
);
136 SCM_API SCM
scm_wta_dispatch_1 (SCM gf
, SCM a1
, int pos
, const char *subr
);
137 SCM_API SCM
scm_wta_dispatch_2 (SCM gf
, SCM a1
, SCM a2
, int pos
, const char *subr
);
138 SCM_API SCM
scm_wta_dispatch_n (SCM gf
, SCM args
, int pos
, const char *subr
);
140 SCM_INTERNAL SCM
scm_i_define_class_for_vtable (SCM vtable
);
143 SCM_INTERNAL
void scm_init_goops (void);
145 #endif /* SCM_GOOPS_H */