1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00

* numbers.c (scm_gr_p, scm_leq_p, scm_geq_p): Turned into

primitive generics.  (Thanks to Nicolas Neuss.)
This commit is contained in:
Mikael Djurfeldt 2000-06-30 16:08:48 +00:00
parent c73879189d
commit c76b1eafa3

View file

@ -3053,34 +3053,55 @@ scm_less_p (SCM x, SCM y)
} }
SCM_DEFINE1 (scm_gr_p, ">", scm_tc7_rpsubr, SCM_GPROC1 (s_scm_gr_p, ">", scm_tc7_rpsubr, scm_gr_p, g_gr_p);
(SCM x, SCM y), /* "Return #t if the list of parameters is monotonically\n"
"Return #t if the list of parameters is monotonically\n" * "increasing."
"increasing.") */
#define FUNC_NAME s_scm_gr_p #define FUNC_NAME s_scm_gr_p
SCM
scm_gr_p (SCM x, SCM y)
{ {
return scm_less_p (y, x); if (!SCM_NUMBERP (x))
SCM_WTA_DISPATCH_2 (g_gr_p, x, y, SCM_ARG1, FUNC_NAME);
else if (!SCM_NUMBERP (y))
SCM_WTA_DISPATCH_2 (g_gr_p, x, y, SCM_ARG2, FUNC_NAME);
else
return scm_less_p (y, x);
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE1 (scm_leq_p, "<=", scm_tc7_rpsubr, SCM_GPROC1 (s_scm_leq_p, "<=", scm_tc7_rpsubr, scm_leq_p, g_leq_p);
(SCM x, SCM y), /* "Return #t if the list of parameters is monotonically\n"
"Return #t if the list of parameters is monotonically\n" * "non-decreasing."
"non-decreasing.") */
#define FUNC_NAME s_scm_leq_p #define FUNC_NAME s_scm_leq_p
SCM
scm_leq_p (SCM x, SCM y)
{ {
return SCM_BOOL_NOT (scm_less_p (y, x)); if (!SCM_NUMBERP (x))
SCM_WTA_DISPATCH_2 (g_leq_p, x, y, SCM_ARG1, FUNC_NAME);
else if (!SCM_NUMBERP (y))
SCM_WTA_DISPATCH_2 (g_leq_p, x, y, SCM_ARG2, FUNC_NAME);
else
return SCM_BOOL_NOT (scm_less_p (y, x));
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE1 (scm_geq_p, ">=", scm_tc7_rpsubr, SCM_GPROC1 (s_scm_geq_p, ">=", scm_tc7_rpsubr, scm_geq_p, g_geq_p);
(SCM x, SCM y), /* "Return #t if the list of parameters is monotonically\n"
"Return #t if the list of parameters is monotonically\n" * "non-increasing."
"non-increasing.") */
#define FUNC_NAME s_scm_geq_p #define FUNC_NAME s_scm_geq_p
SCM
scm_geq_p (SCM x, SCM y)
{ {
if (!SCM_NUMBERP (x))
SCM_WTA_DISPATCH_2 (g_geq_p, x, y, SCM_ARG1, FUNC_NAME);
else if (!SCM_NUMBERP (y))
SCM_WTA_DISPATCH_2 (g_geq_p, x, y, SCM_ARG2, FUNC_NAME);
else
return SCM_BOOL_NOT (scm_less_p (x, y)); return SCM_BOOL_NOT (scm_less_p (x, y));
} }
#undef FUNC_NAME #undef FUNC_NAME