- switch SCM_GSUBR_MAKTYPE(req, opt, rst) {
- case SCM_GSUBR_MAKTYPE(0, 0, 0):
- return scm_make_subr_with_generic(name, scm_tc7_subr_0, fcn, gf);
- case SCM_GSUBR_MAKTYPE(1, 0, 0):
- return scm_make_subr_with_generic(name, scm_tc7_subr_1, fcn, gf);
- case SCM_GSUBR_MAKTYPE(0, 1, 0):
- return scm_make_subr_with_generic(name, scm_tc7_subr_1o, fcn, gf);
- case SCM_GSUBR_MAKTYPE(1, 1, 0):
- return scm_make_subr_with_generic(name, scm_tc7_subr_2o, fcn, gf);
- case SCM_GSUBR_MAKTYPE(2, 0, 0):
- return scm_make_subr_with_generic(name, scm_tc7_subr_2, fcn, gf);
- case SCM_GSUBR_MAKTYPE(3, 0, 0):
- return scm_make_subr_with_generic(name, scm_tc7_subr_3, fcn, gf);
- case SCM_GSUBR_MAKTYPE(0, 0, 1):
- return scm_make_subr_with_generic(name, scm_tc7_lsubr, fcn, gf);
- case SCM_GSUBR_MAKTYPE(2, 0, 1):
- return scm_make_subr_with_generic(name, scm_tc7_lsubr_2, fcn, gf);
- default:
- ;
- }
- scm_misc_error ("scm_make_gsubr_with_generic",
+ return create_gsubr (0, name, req, opt, rst, fcn);
+}
+
+SCM
+scm_c_define_gsubr (const char *name, int req, int opt, int rst, SCM (*fcn)())
+{
+ return create_gsubr (1, name, req, opt, rst, fcn);
+}
+
+static SCM
+create_gsubr_with_generic (int define,
+ const char *name,
+ int req,
+ int opt,
+ int rst,
+ SCM (*fcn)(),
+ SCM *gf)
+{
+ SCM subr;
+
+ switch (SCM_GSUBR_MAKTYPE(req, opt, rst))
+ {
+ case SCM_GSUBR_MAKTYPE(0, 0, 0):
+ subr = scm_c_make_subr_with_generic (name, scm_tc7_subr_0, fcn, gf);
+ goto create_subr;
+ case SCM_GSUBR_MAKTYPE(1, 0, 0):
+ subr = scm_c_make_subr_with_generic (name, scm_tc7_subr_1, fcn, gf);
+ goto create_subr;
+ case SCM_GSUBR_MAKTYPE(0, 1, 0):
+ subr = scm_c_make_subr_with_generic (name, scm_tc7_subr_1o, fcn, gf);
+ goto create_subr;
+ case SCM_GSUBR_MAKTYPE(1, 1, 0):
+ subr = scm_c_make_subr_with_generic (name, scm_tc7_subr_2o, fcn, gf);
+ goto create_subr;
+ case SCM_GSUBR_MAKTYPE(2, 0, 0):
+ subr = scm_c_make_subr_with_generic (name, scm_tc7_subr_2, fcn, gf);
+ goto create_subr;
+ case SCM_GSUBR_MAKTYPE(3, 0, 0):
+ subr = scm_c_make_subr_with_generic (name, scm_tc7_subr_3, fcn, gf);
+ goto create_subr;
+ case SCM_GSUBR_MAKTYPE(0, 0, 1):
+ subr = scm_c_make_subr_with_generic (name, scm_tc7_lsubr, fcn, gf);
+ goto create_subr;
+ case SCM_GSUBR_MAKTYPE(2, 0, 1):
+ subr = scm_c_make_subr_with_generic (name, scm_tc7_lsubr_2, fcn, gf);
+ create_subr:
+ if (define)
+ scm_define (SCM_SUBR_ENTRY(subr).name, subr);
+ return subr;
+ default:
+ ;
+ }
+ scm_misc_error ("scm_c_make_gsubr_with_generic",