1 /* classes: h_files */ 2 3 #ifndef SCM_GOOPS_H 4 #define SCM_GOOPS_H 5 6 /* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2011, 2015 Free Software Foundation, Inc. 7 * 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. 12 * 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. 17 * 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 21 * 02110-1301 USA 22 */ 23 24 25 26 /* This software is a derivative work of other copyrighted softwares; the 27 * copyright notices of these softwares are placed in the file COPYRIGHTS 28 * 29 * This file is based upon stklos.h from the STk distribution by 30 * Erick Gallesio <eg@unice.fr>. 31 */ 32 33 #include "libguile/__scm.h" 34 35 #include "libguile/validate.h" 36 37 /* {Class flags} 38 * 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. 42 */ 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 47 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)) 53 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) 58 59 #define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x) 60 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") 64 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") 68 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)) 71 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)) 76 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") 79 80 #define SCM_METHODP(x) (scm_is_method (x)) 81 #define SCM_VALIDATE_METHOD(pos, x) SCM_MAKE_VALIDATE_MSG (pos, x, METHODP, "method") 82 83 #define SCM_SET_CLASS_DESTRUCTOR(c, d) SCM_SET_VTABLE_DESTRUCTOR (c, d) 84 85 SCM_INTERNAL SCM scm_i_smob_class[]; 86 87 SCM_API SCM scm_module_goops; 88 89 SCM_API SCM scm_goops_version (void); 90 SCM_API void scm_load_goops (void); 91 SCM_API SCM scm_make_extended_class (char const *type_name, int applicablep); 92 SCM_INTERNAL void scm_make_port_classes (scm_t_port_type *ptob); 93 SCM_API SCM scm_ensure_accessor (SCM name); 94 SCM_API SCM scm_class_of (SCM obj); 95 96 /* Low level functions exported */ 97 SCM_INTERNAL SCM scm_make_standard_class (SCM meta, SCM name, SCM dsupers, 98 SCM dslots); 99 100 /* Primitives exported */ 101 SCM_API SCM scm_slot_ref (SCM obj, SCM slot_name); 102 SCM_API SCM scm_slot_set_x (SCM obj, SCM slot_name, SCM value); 103 104 SCM_INTERNAL void scm_i_inherit_applicable (SCM c); 105 SCM_API SCM scm_instance_p (SCM obj); 106 SCM_API int scm_is_generic (SCM x); 107 SCM_API int scm_is_method (SCM x); 108 SCM_API SCM scm_class_name (SCM obj); 109 SCM_API SCM scm_class_direct_supers (SCM obj); 110 SCM_API SCM scm_class_direct_slots (SCM obj); 111 SCM_API SCM scm_class_direct_subclasses (SCM obj); 112 SCM_API SCM scm_class_direct_methods (SCM obj); 113 SCM_API SCM scm_class_precedence_list (SCM obj); 114 SCM_API SCM scm_class_slots (SCM obj); 115 SCM_API SCM scm_generic_function_name (SCM obj); 116 SCM_API SCM scm_generic_function_methods (SCM obj); 117 SCM_API SCM scm_method_generic_function (SCM obj); 118 SCM_API SCM scm_method_specializers (SCM obj); 119 SCM_API SCM scm_method_procedure (SCM obj); 120 SCM_API SCM scm_slot_bound_p (SCM obj, SCM slot_name); 121 SCM_API SCM scm_slot_exists_p (SCM obj, SCM slot_name); 122 SCM_API SCM scm_sys_modify_instance (SCM old, SCM newinst); 123 SCM_API SCM scm_sys_modify_class (SCM old, SCM newcls); 124 SCM_API SCM scm_generic_capability_p (SCM proc); 125 SCM_API SCM scm_enable_primitive_generic_x (SCM subrs); 126 SCM_INTERNAL SCM scm_set_primitive_generic_x (SCM subr, SCM generic); 127 SCM_API SCM scm_primitive_generic_generic (SCM subr); 128 SCM_API SCM scm_make (SCM args); 129 SCM_API void scm_change_object_class (SCM, SCM, SCM); 130 131 /* These procedures are for dispatching to a generic when a primitive 132 fails to apply. They raise a wrong-type-arg error if the primitive's 133 generic has not been initialized yet. */ 134 SCM_API SCM scm_wta_dispatch_0 (SCM gf, const char *subr); 135 SCM_API SCM scm_wta_dispatch_1 (SCM gf, SCM a1, int pos, const char *subr); 136 SCM_API SCM scm_wta_dispatch_2 (SCM gf, SCM a1, SCM a2, int pos, const char *subr); 137 SCM_API SCM scm_wta_dispatch_n (SCM gf, SCM args, int pos, const char *subr); 138 139 SCM_INTERNAL SCM scm_i_define_class_for_vtable (SCM vtable); 140 141 142 SCM_INTERNAL void scm_init_goops (void); 143 144 #endif /* SCM_GOOPS_H */ 145 146 /* 147 Local Variables: 148 c-file-style: "gnu" 149 End: 150 */ 151