guile18/libguile/snarf.h

   1 /* classes: h_files */
   2
   3 #ifndef SCM_SNARF_H
   4 #define SCM_SNARF_H
   5
   6 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 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
  10  * License as published by the Free Software Foundation; either
  11  * version 2.1 of the License, or (at your option) any later version.
  12  *
  13  * This library is distributed in the hope that it will be useful,
  14  * but 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 02110-1301 USA
  21  */
  22
  23 \f
  24
  25 /* Macros for snarfing initialization actions from C source. */
  26
  27 #if defined(__cplusplus) || defined(GUILE_CPLUSPLUS_SNARF)
  28
  29 /* This used to be "SCM (*)(...)" but GCC on RedHat 7.1 doesn't seem
  30    to like it.
  31  */
  32 #define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
  33
  34 #else
  35 #define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
  36 #endif
  37
  38 /* Generic macros to be used in user macro definitions.
  39  *
  40  * For example, in order to define a macro which creates ints and
  41  * initializes them to the result of foo (), do:
  42  *
  43  *   #define SCM_FOO(NAME) \
  44  *     SCM_SNARF_HERE (int NAME) \
  45  *     SCM_SNARF_INIT (NAME = foo ())
  46  *
  47  * The SCM_SNARF_INIT text goes into the corresponding .x file
  48  * up through the first occurrence of SCM_SNARF_DOC_START on that
  49  * line, if any.
  50  */
  51
  52 #ifdef SCM_MAGIC_SNARF_INITS
  53 # define SCM_SNARF_HERE(X)
  54 # define SCM_SNARF_INIT(X) ^^ X ^:^
  55 # define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
  56 #else
  57 # ifdef SCM_MAGIC_SNARF_DOCS
  58 #  define SCM_SNARF_HERE(X)
  59 #  define SCM_SNARF_INIT(X)
  60 #  define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING) \
  61 ^^ { \
  62 cname CNAME ^^ \
  63 fname FNAME ^^ \
  64 type TYPE ^^ \
  65 location __FILE__ __LINE__ ^^ \
  66 arglist ARGLIST ^^ \
  67 argsig REQ OPT VAR ^^ \
  68 DOCSTRING ^^ }
  69 # else
  70 #  define SCM_SNARF_HERE(X) X
  71 #  define SCM_SNARF_INIT(X)
  72 #  define SCM_SNARF_DOCS(TYPE, CNAME, FNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
  73 # endif
  74 #endif
  75
  76 #define SCM_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
  77 SCM_SNARF_HERE(\
  78 static const char s_ ## FNAME [] = PRIMNAME; \
  79 SCM FNAME ARGLIST\
  80 )\
  81 SCM_SNARF_INIT(\
  82 scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
  83                     (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
  84 )\
  85 SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
  86
  87 #define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
  88 SCM_SNARF_HERE(\
  89 static const char s_ ## FNAME [] = PRIMNAME; \
  90 static SCM g_ ## FNAME; \
  91 SCM FNAME ARGLIST\
  92 )\
  93 SCM_SNARF_INIT(\
  94 g_ ## FNAME = SCM_PACK (0); \
  95 scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \
  96                                  (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME, \
  97                                  &g_ ## FNAME); \
  98 )\
  99 SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
 100
 101 #define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
 102 SCM_SNARF_HERE(\
 103 static const char s_ ## FNAME [] = PRIMNAME; \
 104 SCM FNAME ARGLIST\
 105 )\
 106 SCM_SNARF_INIT(\
 107 scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
 108                     (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
 109 scm_c_export (s_ ## FNAME, NULL); \
 110 )\
 111 SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
 112
 113 #define SCM_DEFINE1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \
 114 SCM_SNARF_HERE(\
 115 static const char s_ ## FNAME [] = PRIMNAME; \
 116 SCM FNAME ARGLIST\
 117 )\
 118 SCM_SNARF_INIT(scm_c_define_subr (s_ ## FNAME, TYPE, FNAME); ) \
 119 SCM_SNARF_DOCS(1, FNAME, PRIMNAME, ARGLIST, 2, 0, 0, DOCSTRING)
 120
 121 #define SCM_PRIMITIVE_GENERIC_1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \
 122 SCM_SNARF_HERE(\
 123 static const char s_ ## FNAME [] = PRIMNAME; \
 124 static SCM g_ ## FNAME; \
 125 SCM FNAME ARGLIST\
 126 )\
 127 SCM_SNARF_INIT(\
 128 g_ ## FNAME = SCM_PACK (0); \
 129 scm_c_define_subr_with_generic (s_ ## FNAME, TYPE, FNAME, &g_ ## FNAME); \
 130 )\
 131 SCM_SNARF_DOCS(1, FNAME, PRIMNAME, ARGLIST, 2, 0, 0, DOCSTRING)
 132
 133 #define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
 134 SCM_SNARF_HERE(static const char RANAME[]=STR) \
 135 SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
 136                                    (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))
 137
 138 #define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN)  \
 139 SCM_SNARF_HERE(static const char RANAME[]=STR) \
 140 SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
 141                                    (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
 142 SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
 143                "implemented by the C function \"" #CFN "\"")
 144
 145 #define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF)  \
 146 SCM_SNARF_HERE(\
 147 static const char RANAME[]=STR;\
 148 static SCM GF \
 149 )SCM_SNARF_INIT(\
 150 GF = SCM_PACK (0);  /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
 151 scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \
 152                                  (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
 153 )
 154
 155 #define SCM_PROC1(RANAME, STR, TYPE, CFN) \
 156 SCM_SNARF_HERE(static const char RANAME[]=STR) \
 157 SCM_SNARF_INIT(\
 158 scm_c_define_subr (RANAME, TYPE, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN) \
 159 )
 160
 161
 162 #define SCM_GPROC1(RANAME, STR, TYPE, CFN, GF) \
 163 SCM_SNARF_HERE(\
 164 static const char RANAME[]=STR; \
 165 static SCM GF \
 166 )SCM_SNARF_INIT(\
 167 GF = SCM_PACK (0);  /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
 168 scm_c_define_subr_with_generic (RANAME, TYPE, \
 169                                 (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
 170 )
 171
 172 #define SCM_SYNTAX(RANAME, STR, TYPE, CFN)  \
 173 SCM_SNARF_HERE(static const char RANAME[]=STR)\
 174 SCM_SNARF_INIT(scm_make_synt (RANAME, TYPE, CFN))
 175
 176 #define SCM_SYMBOL(c_name, scheme_name) \
 177 SCM_SNARF_HERE(static SCM c_name) \
 178 SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_symbol (scheme_name)))
 179
 180 #define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
 181 SCM_SNARF_HERE(SCM c_name) \
 182 SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_symbol (scheme_name)))
 183
 184 #define SCM_KEYWORD(c_name, scheme_name) \
 185 SCM_SNARF_HERE(static SCM c_name) \
 186 SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_keyword (scheme_name)))
 187
 188 #define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \
 189 SCM_SNARF_HERE(SCM c_name) \
 190 SCM_SNARF_INIT(c_name = scm_permanent_object (scm_from_locale_keyword (scheme_name)))
 191
 192 #define SCM_VARIABLE(c_name, scheme_name) \
 193 SCM_SNARF_HERE(static SCM c_name) \
 194 SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, SCM_BOOL_F));)
 195
 196 #define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \
 197 SCM_SNARF_HERE(SCM c_name) \
 198 SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, SCM_BOOL_F));)
 199
 200 #define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \
 201 SCM_SNARF_HERE(static SCM c_name) \
 202 SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, init_val));)
 203
 204 #define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \
 205 SCM_SNARF_HERE(SCM c_name) \
 206 SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, init_val));)
 207
 208 #define SCM_MUTEX(c_name) \
 209 SCM_SNARF_HERE(static scm_t_mutex c_name) \
 210 SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex))
 211
 212 #define SCM_GLOBAL_MUTEX(c_name) \
 213 SCM_SNARF_HERE(scm_t_mutex c_name) \
 214 SCM_SNARF_INIT(scm_i_plugin_mutex_init (&c_name, &scm_i_plugin_mutex))
 215
 216 #define SCM_REC_MUTEX(c_name) \
 217 SCM_SNARF_HERE(static scm_t_rec_mutex c_name) \
 218 SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
 219
 220 #define SCM_GLOBAL_REC_MUTEX(c_name) \
 221 SCM_SNARF_HERE(scm_t_rec_mutex c_name) \
 222 SCM_SNARF_INIT(scm_i_plugin_rec_mutex_init (&c_name, &scm_i_plugin_rec_mutex))
 223
 224 #define SCM_SMOB(tag, scheme_name, size) \
 225 SCM_SNARF_HERE(static scm_t_bits tag) \
 226 SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
 227
 228 #define SCM_GLOBAL_SMOB(tag, scheme_name, size) \
 229 SCM_SNARF_HERE(scm_t_bits tag) \
 230 SCM_SNARF_INIT((tag)=scm_make_smob_type((scheme_name), (size));)
 231
 232 #define SCM_SMOB_MARK(tag, c_name, arg) \
 233 SCM_SNARF_HERE(static SCM c_name(SCM arg)) \
 234 SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
 235
 236 #define SCM_GLOBAL_SMOB_MARK(tag, c_name, arg) \
 237 SCM_SNARF_HERE(SCM c_name(SCM arg)) \
 238 SCM_SNARF_INIT(scm_set_smob_mark((tag), (c_name));)
 239
 240 #define SCM_SMOB_FREE(tag, c_name, arg) \
 241 SCM_SNARF_HERE(static size_t c_name(SCM arg)) \
 242 SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
 243
 244 #define SCM_GLOBAL_SMOB_FREE(tag, c_name, arg) \
 245 SCM_SNARF_HERE(size_t c_name(SCM arg)) \
 246 SCM_SNARF_INIT(scm_set_smob_free((tag), (c_name));)
 247
 248 #define SCM_SMOB_PRINT(tag, c_name, obj, port, pstate) \
 249 SCM_SNARF_HERE(static int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
 250 SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)
 251
 252 #define SCM_GLOBAL_SMOB_PRINT(tag, c_name, obj, port, pstate) \
 253 SCM_SNARF_HERE(int c_name(SCM obj, SCM port, scm_print_state* pstate)) \
 254 SCM_SNARF_INIT(scm_set_smob_print((tag), (c_name));)
 255
 256 #define SCM_SMOB_EQUALP(tag, c_name, obj1, obj2) \
 257 SCM_SNARF_HERE(static SCM c_name(SCM obj1, SCM obj2)) \
 258 SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
 259
 260 #define SCM_GLOBAL_SMOB_EQUALP(tag, c_name, obj1, obj2) \
 261 SCM_SNARF_HERE(SCM c_name(SCM obj1, SCM obj2)) \
 262 SCM_SNARF_INIT(scm_set_smob_equalp((tag), (c_name));)
 263
 264 #define SCM_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
 265 SCM_SNARF_HERE(static SCM c_name arglist) \
 266 SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
 267
 268 #define SCM_GLOBAL_SMOB_APPLY(tag, c_name, req, opt, rest, arglist) \
 269 SCM_SNARF_HERE(SCM c_name arglist) \
 270 SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req), (opt), (rest));)
 271
 272
 273 #ifdef SCM_MAGIC_SNARF_DOCS
 274 #undef SCM_ASSERT
 275 #define SCM_ASSERT(_cond, _arg, _pos, _subr) ^^ argpos _arg _pos __LINE__ ^^
 276 #endif /* SCM_MAGIC_SNARF_DOCS */
 277
 278 #endif  /* SCM_SNARF_H */
 279
 280 /*
 281   Local Variables:
 282   c-file-style: "gnu"
 283   End:
 284 */