mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-07-03 08:10:31 +02:00
c79d5bd0f7
* libguile/gsubr.h (scm_t_subr_0, scm_t_subr_1, etc): New precise typedefs. (SCM_AS_SUBR): Use C11's _Generic to cast subrs to the generic subr type, while also producing a warning/error if the function isn't compatible. (SCM_DEFINE_GSUBR, SCM_PRIMITIVE_GENERIC, SCM_DEFINE_PUBLIC) (SCM_DEFINE_STATIC, SCM_PROC, SCM_REGISTER_PROC, SCM_GPROC): Use SCM_AS_SUBR. * libguile/gsubr-internal.h (scm_t_subr_with_thread_0) (scm_t_subr_with_thread_1, etc): New precise typedefs. (SCM_AS_SUBR_WITH_THREAD): Like SCM_AS_SUBR. * libguile/gsubr.c (scm_apply_subr): Cast callee to the right type before calling. * libguile/hash.c (floor): Remove weird unused declaration. * libguile/init.c (scm_boot_guile): Fix type of main_func in definition. * libguile/jit.c: Fix type of enter_mcode. * libguile/smob.c (apply_0, apply_1, apply_2, apply_3): Cast callee to right type. (scm_smob_trampoline): Use SCM_AS_SUBR. * libguile/smob.h (SCM_SMOB_APPLY): Use SCM_AS_SUBR. * libguile/backtrace.c: * libguile/control.c: * libguile/dynl.c: * libguile/eval.c: * libguile/exceptions.c: * libguile/expand.c: * libguile/finalizers.c: * libguile/fluids.c: * libguile/fports.c: * libguile/frames.c: * libguile/gc.c: * libguile/load.c: * libguile/loader.c: * libguile/macros.c: * libguile/memoize.c: * libguile/pairs.c: * libguile/poll.c: * libguile/ports.c: * libguile/posix.c: * libguile/rdelim.c: * libguile/rw.c: * libguile/vm.c: Adapt scm_c_make_gsubr / scm_c_define_gsubr callers to use SCM_AS_SUBR.
156 lines
5.2 KiB
C
156 lines
5.2 KiB
C
#ifndef SCM_GSUBR_H
|
||
#define SCM_GSUBR_H
|
||
|
||
/* Copyright 1995-1996,1998,2000-2001,2006,2008,2009-2011,2013,2015,2018,2025
|
||
Free Software Foundation, Inc.
|
||
|
||
This file is part of Guile.
|
||
|
||
Guile is free software: you can redistribute it and/or modify it
|
||
under the terms of the GNU Lesser General Public License as published
|
||
by the Free Software Foundation, either version 3 of the License, or
|
||
(at your option) any later version.
|
||
|
||
Guile is distributed in the hope that it will be useful, but WITHOUT
|
||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public
|
||
License for more details.
|
||
|
||
You should have received a copy of the GNU Lesser General Public
|
||
License along with Guile. If not, see
|
||
<https://www.gnu.org/licenses/>. */
|
||
|
||
|
||
|
||
#include "libguile/snarf.h"
|
||
|
||
|
||
|
||
|
||
|
||
/* Subrs
|
||
*/
|
||
|
||
#define SCM_SUBRF(x) scm_subr_function (x)
|
||
#define SCM_SUBR_NAME(x) scm_subr_name (x)
|
||
|
||
|
||
|
||
SCM_API scm_t_subr scm_subr_function (SCM subr);
|
||
SCM_API SCM scm_subr_name (SCM subr);
|
||
|
||
typedef SCM (*scm_t_subr_0) (void);
|
||
typedef SCM (*scm_t_subr_1) (SCM);
|
||
typedef SCM (*scm_t_subr_2) (SCM, SCM);
|
||
typedef SCM (*scm_t_subr_3) (SCM, SCM, SCM);
|
||
typedef SCM (*scm_t_subr_4) (SCM, SCM, SCM, SCM);
|
||
typedef SCM (*scm_t_subr_5) (SCM, SCM, SCM, SCM, SCM);
|
||
typedef SCM (*scm_t_subr_6) (SCM, SCM, SCM, SCM, SCM, SCM);
|
||
typedef SCM (*scm_t_subr_7) (SCM, SCM, SCM, SCM, SCM, SCM, SCM);
|
||
typedef SCM (*scm_t_subr_8) (SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM);
|
||
typedef SCM (*scm_t_subr_9) (SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM);
|
||
typedef SCM (*scm_t_subr_10) (SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM, SCM);
|
||
|
||
#define SCM_AS_SUBR(fn) \
|
||
_Generic (fn, \
|
||
scm_t_subr_0 : (scm_t_subr) fn, \
|
||
scm_t_subr_1 : (scm_t_subr) fn, \
|
||
scm_t_subr_2 : (scm_t_subr) fn, \
|
||
scm_t_subr_3 : (scm_t_subr) fn, \
|
||
scm_t_subr_4 : (scm_t_subr) fn, \
|
||
scm_t_subr_5 : (scm_t_subr) fn, \
|
||
scm_t_subr_6 : (scm_t_subr) fn, \
|
||
scm_t_subr_7 : (scm_t_subr) fn, \
|
||
scm_t_subr_8 : (scm_t_subr) fn, \
|
||
scm_t_subr_9 : (scm_t_subr) fn, \
|
||
scm_t_subr_10 : (scm_t_subr) fn, \
|
||
default: fn)
|
||
|
||
SCM_API SCM scm_c_make_gsubr (const char *name,
|
||
int req, int opt, int rst, scm_t_subr fcn);
|
||
SCM_API SCM scm_c_make_gsubr_with_generic (const char *name,
|
||
int req, int opt, int rst,
|
||
scm_t_subr fcn, SCM *gf);
|
||
SCM_API SCM scm_c_define_gsubr (const char *name,
|
||
int req, int opt, int rst, scm_t_subr fcn);
|
||
SCM_API SCM scm_c_define_gsubr_with_generic (const char *name,
|
||
int req, int opt, int rst,
|
||
scm_t_subr fcn, SCM *gf);
|
||
|
||
|
||
|
||
/* Casting to a function that can take any number of arguments. */
|
||
#define SCM_FUNC_CAST_ARBITRARY_ARGS scm_t_subr
|
||
|
||
#define SCM_DEFINE_GSUBR(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
|
||
SCM_SNARF_HERE(\
|
||
SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
|
||
SCM FNAME ARGLIST\
|
||
)\
|
||
SCM_SNARF_INIT(\
|
||
scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, SCM_AS_SUBR (FNAME)); \
|
||
)\
|
||
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
|
||
|
||
/* Always use the generic subr case. */
|
||
#define SCM_DEFINE SCM_DEFINE_GSUBR
|
||
|
||
#define SCM_PRIMITIVE_GENERIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
|
||
SCM_SNARF_HERE(\
|
||
SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
|
||
static SCM g_ ## FNAME; \
|
||
SCM FNAME ARGLIST\
|
||
)\
|
||
SCM_SNARF_INIT(\
|
||
g_ ## FNAME = SCM_PACK (0); \
|
||
scm_c_define_gsubr_with_generic (s_ ## FNAME, REQ, OPT, VAR, \
|
||
SCM_AS_SUBR (FNAME), &g_ ## FNAME); \
|
||
)\
|
||
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
|
||
|
||
#define SCM_DEFINE_PUBLIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
|
||
SCM_SNARF_HERE(\
|
||
SCM_UNUSED static const char s_ ## FNAME [] = PRIMNAME; \
|
||
SCM FNAME ARGLIST\
|
||
)\
|
||
SCM_SNARF_INIT(\
|
||
scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, SCM_AS_SUBR (FNAME)); \
|
||
scm_c_export (s_ ## FNAME, NULL); \
|
||
)\
|
||
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
|
||
|
||
#define SCM_DEFINE_STATIC(FNAME, PRIMNAME, REQ, OPT, VAR, ARGLIST, DOCSTRING) \
|
||
SCM_SNARF_HERE(\
|
||
static const char s_ ## FNAME [] = PRIMNAME; \
|
||
static SCM FNAME ARGLIST\
|
||
)\
|
||
SCM_SNARF_INIT(\
|
||
scm_c_define_gsubr (s_ ## FNAME, REQ, OPT, VAR, SCM_AS_SUBR (FNAME)); \
|
||
)\
|
||
SCM_SNARF_DOCS(primitive, FNAME, PRIMNAME, ARGLIST, REQ, OPT, VAR, DOCSTRING)
|
||
|
||
#define SCM_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
|
||
SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
|
||
SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, SCM_AS_SUBR (CFN)))
|
||
|
||
#define SCM_REGISTER_PROC(RANAME, STR, REQ, OPT, VAR, CFN) \
|
||
SCM_SNARF_HERE(SCM_UNUSED static const char RANAME[]=STR) \
|
||
SCM_SNARF_INIT(scm_c_define_gsubr (RANAME, REQ, OPT, VAR, SCM_AS_SUBR (CFN));) \
|
||
SCM_SNARF_DOCS(register, CFN, STR, (), REQ, OPT, VAR, \
|
||
"implemented by the C function \"" #CFN "\"")
|
||
|
||
#define SCM_GPROC(RANAME, STR, REQ, OPT, VAR, CFN, GF) \
|
||
SCM_SNARF_HERE(\
|
||
SCM_UNUSED 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_AS_SUBR (CFN), &GF) \
|
||
)
|
||
|
||
|
||
|
||
|
||
SCM_INTERNAL void scm_init_gsubr (void);
|
||
|
||
#endif /* SCM_GSUBR_H */
|