summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/eval.c2
-rw-r--r--libguile/gc.c3
-rw-r--r--libguile/goops.c2
-rw-r--r--libguile/gsubr.c99
-rw-r--r--libguile/macros.c2
-rw-r--r--libguile/values.c3
6 files changed, 28 insertions, 83 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index d5405950e..8a4700843 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -941,7 +941,7 @@ scm_init_eval ()
scm_listofnull = scm_list_1 (SCM_EOL);
- f_apply = scm_c_define_subr ("apply", scm_tc7_lsubr_2, scm_apply);
+ f_apply = scm_c_define_gsubr ("apply", 2, 0, 1, scm_apply);
scm_permanent_object (f_apply);
primitive_eval = scm_c_make_gsubr ("primitive-eval", 1, 0, 0,
diff --git a/libguile/gc.c b/libguile/gc.c
index 96e3c306f..a0715f084 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -820,8 +820,7 @@ scm_init_gc ()
scm_after_gc_hook = scm_permanent_object (scm_make_hook (SCM_INUM0));
scm_c_define ("after-gc-hook", scm_after_gc_hook);
- gc_async = scm_c_make_subr ("%gc-thunk", scm_tc7_subr_0,
- gc_async_thunk);
+ gc_async = scm_c_make_gsubr ("%gc-thunk", 0, 0, 0, gc_async_thunk);
scm_c_hook_add (&scm_after_gc_c_hook, mark_gc_async, NULL, 0);
diff --git a/libguile/goops.c b/libguile/goops.c
index dcb1b7d12..dfa7117d0 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -237,11 +237,11 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
case scm_tc7_subr_2o:
case scm_tc7_lsubr_2:
case scm_tc7_lsubr:
+ case scm_tc7_gsubr:
if (SCM_SUBR_GENERIC (x) && *SCM_SUBR_GENERIC (x))
return scm_class_primitive_generic;
else
return scm_class_procedure;
- case scm_tc7_gsubr:
case scm_tc7_program:
return scm_class_procedure;
case scm_tc7_pws:
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index 6123a0b1f..06e8830c8 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -51,47 +51,16 @@ create_gsubr (int define, const char *name,
SCM (*fcn) ())
{
SCM subr;
+ unsigned type;
- switch (SCM_GSUBR_MAKTYPE (req, opt, rst))
- {
- case SCM_GSUBR_MAKTYPE(0, 0, 0):
- subr = scm_c_make_subr (name, scm_tc7_subr_0, fcn);
- break;
- case SCM_GSUBR_MAKTYPE(1, 0, 0):
- subr = scm_c_make_subr (name, scm_tc7_subr_1, fcn);
- break;
- case SCM_GSUBR_MAKTYPE(0, 1, 0):
- subr = scm_c_make_subr (name, scm_tc7_subr_1o, fcn);
- break;
- case SCM_GSUBR_MAKTYPE(1, 1, 0):
- subr = scm_c_make_subr (name, scm_tc7_subr_2o, fcn);
- break;
- case SCM_GSUBR_MAKTYPE(2, 0, 0):
- subr = scm_c_make_subr (name, scm_tc7_subr_2, fcn);
- break;
- case SCM_GSUBR_MAKTYPE(3, 0, 0):
- subr = scm_c_make_subr (name, scm_tc7_subr_3, fcn);
- break;
- case SCM_GSUBR_MAKTYPE(0, 0, 1):
- subr = scm_c_make_subr (name, scm_tc7_lsubr, fcn);
- break;
- case SCM_GSUBR_MAKTYPE(2, 0, 1):
- subr = scm_c_make_subr (name, scm_tc7_lsubr_2, fcn);
- break;
- default:
- {
- unsigned type;
-
- type = SCM_GSUBR_MAKTYPE (req, opt, rst);
- if (SCM_GSUBR_REQ (type) != req
- || SCM_GSUBR_OPT (type) != opt
- || SCM_GSUBR_REST (type) != rst)
- scm_out_of_range ("create_gsubr", scm_from_uint (req + opt + rst));
-
- subr = scm_c_make_subr (name, scm_tc7_gsubr | (type << 8U),
- fcn);
- }
- }
+ type = SCM_GSUBR_MAKTYPE (req, opt, rst);
+ if (SCM_GSUBR_REQ (type) != req
+ || SCM_GSUBR_OPT (type) != opt
+ || SCM_GSUBR_REST (type) != rst)
+ scm_out_of_range ("create_gsubr", scm_from_uint (req + opt + rst));
+
+ subr = scm_c_make_subr (name, scm_tc7_gsubr | (type << 8U),
+ fcn);
if (define)
scm_define (SCM_SUBR_NAME (subr), subr);
@@ -121,43 +90,21 @@ create_gsubr_with_generic (int define,
SCM *gf)
{
SCM subr;
+ unsigned type;
- 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_NAME (subr), subr);
- return subr;
- default:
- ;
- }
- scm_misc_error ("scm_c_make_gsubr_with_generic",
- "can't make primitive-generic with this arity",
- SCM_EOL);
- return SCM_BOOL_F; /* never reached */
+ type = SCM_GSUBR_MAKTYPE (req, opt, rst);
+ if (SCM_GSUBR_REQ (type) != req
+ || SCM_GSUBR_OPT (type) != opt
+ || SCM_GSUBR_REST (type) != rst)
+ scm_out_of_range ("create_gsubr", scm_from_uint (req + opt + rst));
+
+ subr = scm_c_make_subr_with_generic (name, scm_tc7_gsubr | (type << 8U),
+ fcn, gf);
+
+ if (define)
+ scm_define (SCM_SUBR_NAME (subr), subr);
+
+ return subr;
}
SCM
diff --git a/libguile/macros.c b/libguile/macros.c
index 970a41d54..d7c054e72 100644
--- a/libguile/macros.c
+++ b/libguile/macros.c
@@ -312,7 +312,7 @@ SCM
scm_make_synt (const char *name, SCM (*macroizer) (), SCM (*fcn)() )
{
SCM var = scm_c_define (name, SCM_UNDEFINED);
- SCM transformer = scm_c_make_subr (name, scm_tc7_subr_2, fcn);
+ SCM transformer = scm_c_make_gsubr (name, 2, 0, 0, fcn);
SCM_VARIABLE_SET (var, macroizer (transformer));
return SCM_UNSPECIFIED;
}
diff --git a/libguile/values.c b/libguile/values.c
index 71cdbe2af..967fcd6bc 100644
--- a/libguile/values.c
+++ b/libguile/values.c
@@ -77,8 +77,7 @@ SCM_DEFINE (scm_values, "values", 0, 0, 1,
void
scm_init_values (void)
{
- SCM print = scm_c_define_subr ("%print-values", scm_tc7_subr_2,
- print_values);
+ SCM print = scm_c_define_gsubr ("%print-values", 2, 0, 0, print_values);
scm_values_vtable = scm_make_vtable (scm_from_locale_string ("pr"), print);