-
/* classes: h_files */
/* Macros for snarfing initialization actions from C source. */
#ifndef LIBGUILE_SNARF_H
#define LIBGUILE_SNARF_H
-/* Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
+
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+ gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
\f
-#ifndef SCM_MAGIC_SNARFER
-#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
- static char RANAME[]=STR
-#define SCM_PROC1(RANAME, STR, TYPE, CFN) \
- static char RANAME[]=STR
+#if defined(__cplusplus) || defined(GUILE_CPLUSPLUS_SNARF)
+
+/* This used to be "SCM (*)(...)" but GCC on RedHat 7.1 doesn't seem
+ to like it.
+ */
+#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
+
#else
-#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
-%%% scm_make_gsubr (RANAME, REQ, OPT, VAR, CFN)
-#define SCM_PROC1(RANAME, STR, TYPE, CFN) \
-%%% scm_make_subr(RANAME, TYPE, CFN)
+#define SCM_FUNC_CAST_ARBITRARY_ARGS SCM (*)()
#endif
+/* Generic macros to be used in user macro definitions.
+ *
+ * For example, in order to define a macro which creates ints and
+ * initializes them to the result of foo (), do:
+ *
+ * #define SCM_FOO(NAME) \
+ * SCM_SNARF_HERE (int NAME) \
+ * SCM_SNARF_INIT (NAME = foo ())
+ *
+ * The SCM_SNARF_INIT text goes into the corresponding .x file
+ * up through the first occurrence of SCM_SNARF_DOC_START on that
+ * line, if any.
+ */
+
#ifndef SCM_MAGIC_SNARFER
-#define SCM_SYMBOL(c_name, scheme_name) \
- static SCM c_name = SCM_BOOL_F
+# define SCM_SNARF_HERE(X) X
+# define SCM_SNARF_INIT(X)
+# define SCM_SNARF_DOCS(X)
#else
-#define SCM_SYMBOL(C_NAME, SCHEME_NAME) \
-%%% C_NAME = scm_permanent_object (SCM_CAR (scm_intern0 (SCHEME_NAME)))
+# define SCM_SNARF_HERE(X)
+# define SCM_SNARF_INIT(X) SCM_SNARF_INIT_START X
+# define SCM_SNARF_DOCS(X) X
#endif
-#ifndef SCM_MAGIC_SNARFER
+#define SCM_DEFINE(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
+SCM_SNARF_HERE(\
+static const char s_ ## FNAME [] = PRIMNAME; \
+SCM FNAME ARGLIST\
+)\
+SCM_SNARF_INIT(\
+scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, \
+ (SCM_FUNC_CAST_ARBITRARY_ARGS) FNAME); \
+)\
+SCM_SNARF_DOCS(\
+SCM_SNARF_DOC_STARTP PRIMNAME #ARGLIST | REQ | OPT | VAR | __FILE__:__LINE__ | \
+ SCM_SNARF_DOCSTRING_START DOCSTRING SCM_SNARF_DOCSTRING_END \
+)
+
+#define SCM_DEFINE1(FNAME, PRIMNAME, TYPE, ARGLIST, DOCSTRING) \
+SCM_SNARF_HERE(\
+static const char s_ ## FNAME [] = PRIMNAME; \
+SCM FNAME ARGLIST\
+)\
+SCM_SNARF_INIT(scm_c_define_subr (s_ ## FNAME, TYPE, FNAME); ) \
+SCM_SNARF_DOCS(\
+SCM_SNARF_DOC_START1 PRIMNAME #ARGLIST | 2 | 0 | 0 | __FILE__:__LINE__ | \
+ SCM_SNARF_DOCSTRING_START DOCSTRING SCM_SNARF_DOCSTRING_END \
+)
+
+#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
+SCM_SNARF_HERE(static const char RANAME[]=STR) \
+SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
+ (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN))
+
+#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
+SCM_SNARF_HERE(static const char RANAME[]=STR) \
+SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, \
+ (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN);) \
+SCM_SNARF_DOCS(\
+SCM_SNARF_DOC_STARTR STR | REQ | OPT | VAR | __FILE__:__LINE__ | \
+ SCM_SNARF_DOCSTRING_START CFN SCM_SNARF_DOCSTRING_END \
+)
+
+#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \
+SCM_SNARF_HERE(\
+static const char RANAME[]=STR;\
+static SCM GF \
+)SCM_SNARF_INIT(\
+GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
+scm_c_define_gsubr_with_generic (RANAME, REQ, OPT, VAR, \
+ (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
+)
+
+#define SCM_PROC1(RANAME, STR, TYPE, CFN) \
+SCM_SNARF_HERE(static const char RANAME[]=STR) \
+SCM_SNARF_INIT(\
+scm_c_define_subr (RANAME, TYPE, (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN) \
+)
+
+
+#define SCM_GPROC1(RANAME, STR, TYPE, CFN, GF) \
+SCM_SNARF_HERE(\
+static const char RANAME[]=STR; \
+static SCM GF \
+)SCM_SNARF_INIT(\
+GF = SCM_PACK (0); /* Dirk:FIXME:: Can we safely use #f instead of 0? */ \
+scm_c_define_subr_with_generic (RANAME, TYPE, \
+ (SCM_FUNC_CAST_ARBITRARY_ARGS) CFN, &GF) \
+)
+
+#define SCM_SYNTAX(RANAME, STR, TYPE, CFN) \
+SCM_SNARF_HERE(static const char RANAME[]=STR)\
+SCM_SNARF_INIT(scm_make_synt (RANAME, TYPE, CFN))
+
+#define SCM_SYMBOL(c_name, scheme_name) \
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_str2symbol (scheme_name)))
+
#define SCM_GLOBAL_SYMBOL(c_name, scheme_name) \
- SCM c_name = SCM_BOOL_F
-#else
-#define SCM_GLOBAL_SYMBOL(C_NAME, SCHEME_NAME) \
-%%% C_NAME = scm_permanent_object (SCM_CAR (scm_intern0 (SCHEME_NAME)))
-#endif
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_str2symbol (scheme_name)))
+#define SCM_KEYWORD(c_name, scheme_name) \
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_make_keyword (scheme_name)))
+
+#define SCM_GLOBAL_KEYWORD(c_name, scheme_name) \
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_make_keyword (scheme_name)))
+
+#define SCM_VARIABLE(c_name, scheme_name) \
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, SCM_BOOL_F));)
+
+#define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, SCM_BOOL_F));)
+
+#define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, init_val));)
+
+#define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name, init_val));)
+
+#if (SCM_DEBUG_DEPRECATED == 0)
+
+#define SCM_CONST_LONG(c_name, scheme_name,value) \
+SCM_VCELL_INIT(c_name, scheme_name, scm_long2num(value))
-#ifndef SCM_MAGIC_SNARFER
#define SCM_VCELL(c_name, scheme_name) \
- static SCM c_name = SCM_BOOL_F
-#else
-#define SCM_VCELL(C_NAME, SCHEME_NAME) \
-%%% C_NAME = scm_permanent_object (scm_intern0 (SCHEME_NAME)); SCM_SETCDR (C_NAME, SCM_BOOL_F)
-#endif
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_sysintern (scheme_name, SCM_BOOL_F));)
-#ifndef SCM_MAGIC_SNARFER
#define SCM_GLOBAL_VCELL(c_name, scheme_name) \
- SCM c_name = SCM_BOOL_F
-#else
-#define SCM_GLOBAL_VCELL(C_NAME, SCHEME_NAME) \
-%%% C_NAME = scm_permanent_object (scm_intern0 (SCHEME_NAME)); SCM_SETCDR (C_NAME, SCM_BOOL_F)
-#endif
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_sysintern (scheme_name, SCM_BOOL_F));)
-#ifndef SCM_MAGIC_SNARFER
#define SCM_VCELL_INIT(c_name, scheme_name, init_val) \
- static SCM c_name = SCM_BOOL_F
-#else
-#define SCM_VCELL_INIT(C_NAME, SCHEME_NAME, init_val) \
-%%% C_NAME = scm_permanent_object (scm_intern0 (SCHEME_NAME)); SCM_SETCDR (C_NAME, init_val)
-#endif
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_sysintern (scheme_name, init_val));)
-#ifndef SCM_MAGIC_SNARFER
#define SCM_GLOBAL_VCELL_INIT(c_name, scheme_name, init_val) \
- SCM c_name = SCM_BOOL_F
-#else
-#define SCM_GLOBAL_VCELL_INIT(C_NAME, SCHEME_NAME, init_val) \
-%%% C_NAME = scm_permanent_object (scm_intern0 (SCHEME_NAME)); SCM_SETCDR (C_NAME, init_val)
-#endif
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_sysintern (scheme_name, init_val));)
-#define SCM_CONST_LONG(C_NAME, SCHEME_NAME,VALUE) SCM_VCELL_INIT(C_NAME, SCHEME_NAME, scm_long2num(VALUE));
+#endif /* (SCM_DEBUG_DEPRECATED == 0) */
+
+#ifdef SCM_MAGIC_SNARFER
+#undef SCM_ASSERT
+#define SCM_ASSERT(_cond, _arg, _pos, _subr) *&*&*&*SCM_ARG_BETTER_BE_IN_POSITION(_arg,_pos,__LINE__)
+#endif /* SCM_MAGIC_SNARFER */
#endif /* LIBGUILE_SNARF_H */
+
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/
HCoop / bpt / guile.git / blobdiff