-#ifdef SCM_FLOATS
- SCM t;
- if (SCM_NINUMP (x))
- {
-#ifdef SCM_BIGDIG
- if (!(SCM_NIMP (x)))
- {
- badx:
- SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARG1, s_eq_p);
- }
- if (SCM_BIGP (x))
- {
- if (SCM_INUMP (y))
- return SCM_BOOL_F;
- SCM_ASRTGO (SCM_NIMP (y), bady);
- if (SCM_BIGP (y))
- return (0 == scm_bigcomp (x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
- SCM_ASRTGO (SCM_INEXP (y), bady);
- bigreal:
- return ((SCM_REALP (y) && (scm_big2dbl (x) == SCM_REALPART (y)))
- ? SCM_BOOL_T
- : SCM_BOOL_F);
- }
- SCM_ASRTGO (SCM_INEXP (x), badx);
-#else
- SCM_GASSERT2 (SCM_NIMP (x) && SCM_INEXP (x),
- g_eq_p, x, y, SCM_ARG1, s_eq_p);
-#endif
- if (SCM_INUMP (y))
- {
- t = x;
- x = y;
- y = t;
- goto realint;
- }
-#ifdef SCM_BIGDIG
- SCM_ASRTGO (SCM_NIMP (y), bady);
- if (SCM_BIGP (y))
- {
- t = x;
- x = y;
- y = t;
- goto bigreal;
- }
- SCM_ASRTGO (SCM_INEXP (y), bady);
-#else
- SCM_ASRTGO (SCM_NIMP (y) && SCM_INEXP (y), bady);
-#endif
- if (SCM_REALPART (x) != SCM_REALPART (y))
- return SCM_BOOL_F;
- if (SCM_CPLXP (x))
- return ((SCM_CPLXP (y) && (SCM_IMAG (x) == SCM_IMAG (y)))
- ? SCM_BOOL_T
- : SCM_BOOL_F);
- return SCM_CPLXP (y) ? SCM_BOOL_F : SCM_BOOL_T;
- }
- if (SCM_NINUMP (y))
- {
-#ifdef SCM_BIGDIG
- SCM_ASRTGO (SCM_NIMP (y), bady);
- if (SCM_BIGP (y))
- return SCM_BOOL_F;
- if (!(SCM_INEXP (y)))
- {
- bady:
- SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
- }
-#else
- if (!(SCM_NIMP (y) && SCM_INEXP (y)))
- {
- bady:
- SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
- }
-#endif
- realint:
- return ((SCM_REALP (y) && (((double) SCM_INUM (x)) == SCM_REALPART (y)))
- ? SCM_BOOL_T
- : SCM_BOOL_F);
- }
-#else
-#ifdef SCM_BIGDIG
- if (SCM_NINUMP (x))
- {
- SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x),
- g_eq_p, x, y, SCM_ARG1, s_eq_p);
- if (SCM_INUMP (y))
- return SCM_BOOL_F;
- SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady);
- return (0 == scm_bigcomp (x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
- }
- if (SCM_NINUMP (y))
- {
- if (!(SCM_NIMP (y) && SCM_BIGP (y)))
- {
- bady:
- SCM_WTA_DISPATCH_2 (g_eq_p, x, y, SCM_ARGn, s_eq_p);
- }
- return SCM_BOOL_F;
- }
-#else
- SCM_GASSERT2 (SCM_INUMP (x), g_eq_p, x, y, SCM_ARG1, s_eq_p);
- SCM_GASSERT2 (SCM_INUMP (y), g_eq_p, x, y, SCM_ARGn, s_eq_p);
-#endif
-#endif
- return ((long) x == (long) y) ? SCM_BOOL_T : SCM_BOOL_F;
-}
-
-
-
-SCM_GPROC1 (s_less_p, "<", scm_tc7_rpsubr, scm_less_p, g_less_p);
-
-SCM
-scm_less_p (x, y)
- SCM x;
- SCM y;
-{
-#ifdef SCM_FLOATS
- if (SCM_NINUMP (x))
- {
-#ifdef SCM_BIGDIG
- if (!(SCM_NIMP (x)))
- {
- badx:
- SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARG1, s_less_p);
- }
- if (SCM_BIGP (x))
- {
- if (SCM_INUMP (y))
- return SCM_BIGSIGN (x) ? SCM_BOOL_T : SCM_BOOL_F;
- SCM_ASRTGO (SCM_NIMP (y), bady);
- if (SCM_BIGP (y))
- return (1 == scm_bigcomp (x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
- SCM_ASRTGO (SCM_REALP (y), bady);
- return ((scm_big2dbl (x) < SCM_REALPART (y))
- ? SCM_BOOL_T
- : SCM_BOOL_F);
- }
- SCM_ASRTGO (SCM_REALP (x), badx);
-#else
- SCM_GASSERT2 (SCM_NIMP (x) && SCM_REALP (x),
- g_less_p, x, y, SCM_ARG1, s_less_p);
-#endif
- if (SCM_INUMP (y))
- return ((SCM_REALPART (x) < ((double) SCM_INUM (y)))
- ? SCM_BOOL_T
- : SCM_BOOL_F);
-#ifdef SCM_BIGDIG
- SCM_ASRTGO (SCM_NIMP (y), bady);
- if (SCM_BIGP (y))
- return (SCM_REALPART (x) < scm_big2dbl (y)) ? SCM_BOOL_T : SCM_BOOL_F;
- SCM_ASRTGO (SCM_REALP (y), bady);
-#else
- SCM_ASRTGO (SCM_NIMP (y) && SCM_REALP (y), bady);
-#endif
- return (SCM_REALPART (x) < SCM_REALPART (y)) ? SCM_BOOL_T : SCM_BOOL_F;
- }
- if (SCM_NINUMP (y))
- {
-#ifdef SCM_BIGDIG
- SCM_ASRTGO (SCM_NIMP (y), bady);
- if (SCM_BIGP (y))
- return SCM_BIGSIGN (y) ? SCM_BOOL_F : SCM_BOOL_T;
- if (!(SCM_REALP (y)))
- {
- bady:
- SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
- }
-#else
- if (!(SCM_NIMP (y) && SCM_REALP (y)))
- {
- bady:
- SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
- }
-#endif
- return ((((double) SCM_INUM (x)) < SCM_REALPART (y))
- ? SCM_BOOL_T
- : SCM_BOOL_F);
- }
-#else
-#ifdef SCM_BIGDIG
- if (SCM_NINUMP (x))
- {
- SCM_GASSERT2 (SCM_NIMP (x) && SCM_BIGP (x),
- g_less_p, x, y, SCM_ARG1, s_less_p);
- if (SCM_INUMP (y))
- return SCM_BIGSIGN (x) ? SCM_BOOL_T : SCM_BOOL_F;
- SCM_ASRTGO (SCM_NIMP (y) && SCM_BIGP (y), bady);
- return (1 == scm_bigcomp (x, y)) ? SCM_BOOL_T : SCM_BOOL_F;
- }
- if (SCM_NINUMP (y))
- {
- if (!(SCM_NIMP (y) && SCM_BIGP (y)))
- {
- bady:
- SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
- }
- return SCM_BIGSIGN (y) ? SCM_BOOL_F : SCM_BOOL_T;
- }
-#else
- SCM_GASSERT2 (SCM_INUMP (x), g_less_p, x, y, SCM_ARG1, s_less_p);
- SCM_GASSERT2 (SCM_INUMP (y), g_less_p, x, y, SCM_ARGn, s_less_p);
-#endif
-#endif
- return ((long) x < (long) y) ? SCM_BOOL_T : SCM_BOOL_F;
+ if (SCM_INUMP (x)) {
+ long xx = SCM_INUM (x);
+ if (SCM_INUMP (y)) {
+ long yy = SCM_INUM (y);
+ return SCM_BOOL (xx < yy);
+ } else if (SCM_BIGP (y)) {
+ return SCM_BOOL (!SCM_BIGSIGN (y));
+ } else if (SCM_REALP (y)) {
+ return SCM_BOOL ((double) xx < SCM_REAL_VALUE (y));
+ } else {
+ SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
+ }
+ } else if (SCM_BIGP (x)) {
+ if (SCM_INUMP (y)) {
+ return SCM_BOOL (SCM_BIGSIGN (x));
+ } else if (SCM_BIGP (y)) {
+ return SCM_BOOL (1 == scm_bigcomp (x, y));
+ } else if (SCM_REALP (y)) {
+ return SCM_BOOL (scm_big2dbl (x) < SCM_REAL_VALUE (y));
+ } else {
+ SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
+ }
+ } else if (SCM_REALP (x)) {
+ if (SCM_INUMP (y)) {
+ return SCM_BOOL (SCM_REAL_VALUE (x) < (double) SCM_INUM (y));
+ } else if (SCM_BIGP (y)) {
+ return SCM_BOOL (SCM_REAL_VALUE (x) < scm_big2dbl (y));
+ } else if (SCM_REALP (y)) {
+ return SCM_BOOL (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y));
+ } else {
+ SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARGn, s_less_p);
+ }
+ } else {
+ SCM_WTA_DISPATCH_2 (g_less_p, x, y, SCM_ARG1, s_less_p);
+ }