1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 06:20:23 +02:00

Added documentation strings and reordered some dispatch sequences.

This commit is contained in:
Dirk Herrmann 2000-04-20 15:51:09 +00:00
parent 195e620170
commit 4219f20d15
2 changed files with 76 additions and 65 deletions

View file

@ -1,3 +1,14 @@
2000-04-20 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.c (scm_exact_p, scm_odd_p, scm_even_p): Added
documentation strings.
* numbers.c (scm_exact_p, scm_odd_p, scm_even_p, scm_abs,
scm_quotient): Reordered dispatch sequence to first handle
immediates, second handle bignums and finally handle generic
functions respectively signal wrong type arguments. Hopefully
this will allow for easier separation when goops is integrated.
2000-04-19 Dirk Herrmann <D.Herrmann@tu-bs.de> 2000-04-19 Dirk Herrmann <D.Herrmann@tu-bs.de>
* gc.c (which_seg): Use SCM2PTR to convert a non immediate SCM * gc.c (which_seg): Use SCM2PTR to convert a non immediate SCM

View file

@ -79,84 +79,90 @@
SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0, SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0,
(SCM x), (SCM x),
"") "Return #t if X is an exact number, #f otherwise.")
#define FUNC_NAME s_scm_exact_p #define FUNC_NAME s_scm_exact_p
{ {
if (SCM_INUMP (x)) if (SCM_INUMP (x)) {
return SCM_BOOL_T; return SCM_BOOL_T;
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_BIGP (x)) } else if (SCM_BIGP (x)) {
return SCM_BOOL_T; return SCM_BOOL_T;
#endif #endif
return SCM_BOOL_F; } else {
return SCM_BOOL_F;
}
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0, SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0,
(SCM n), (SCM n),
"") "Return #t if N is an odd number, #f otherwise.")
#define FUNC_NAME s_scm_odd_p #define FUNC_NAME s_scm_odd_p
{ {
if (SCM_INUMP (n)) {
return SCM_BOOL ((4 & SCM_UNPACK (n)) != 0);
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (n)) } else if (SCM_BIGP (n)) {
{ return SCM_BOOL ((1 & SCM_BDIGITS (n) [0]) != 0);
SCM_VALIDATE_BIGINT (1,n);
return SCM_BOOL(1 & SCM_BDIGITS (n)[0]);
}
#else
SCM_VALIDATE_INUM (1,n);
#endif #endif
return SCM_BOOL(4 & SCM_UNPACK (n)); } else {
SCM_ASSERT (0, n, 1, FUNC_NAME);
}
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_even_p, "even?", 1, 0, 0, SCM_DEFINE (scm_even_p, "even?", 1, 0, 0,
(SCM n), (SCM n),
"") "Return #t if N is an even number, #f otherwise.")
#define FUNC_NAME s_scm_even_p #define FUNC_NAME s_scm_even_p
{ {
if (SCM_INUMP (n)) {
return SCM_BOOL ((4 & SCM_UNPACK (n)) == 0);
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (n)) } else if (SCM_BIGP (n)) {
{ return SCM_BOOL ((1 & SCM_BDIGITS (n) [0]) == 0);
SCM_VALIDATE_BIGINT (1,n);
return SCM_NEGATE_BOOL(1 & SCM_BDIGITS (n)[0]);
}
#else
SCM_VALIDATE_INUM (1,n);
#endif #endif
return SCM_NEGATE_BOOL(4 & SCM_UNPACK (n)); } else {
SCM_ASSERT (0, n, 1, FUNC_NAME);
}
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_GPROC (s_abs, "abs", 1, 0, 0, scm_abs, g_abs); SCM_GPROC (s_abs, "abs", 1, 0, 0, scm_abs, g_abs);
SCM SCM
scm_abs (SCM x) scm_abs (SCM x)
{ {
long int cx; if (SCM_INUMP (x)) {
long int xx = SCM_INUM (x);
if (xx >= 0) {
return x;
} else if (SCM_POSFIXABLE (-xx)) {
return SCM_MAKINUM (-xx);
} else {
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (SCM_NINUMP (x)) return scm_long2big (-xx);
{
SCM_GASSERT1 (SCM_BIGP (x), g_abs, x, SCM_ARG1, s_abs);
if (!SCM_BIGSIGN (x))
return x;
return scm_copybig (x, 0);
}
#else
SCM_GASSERT1 (SCM_INUMP (x), g_abs, x, SCM_ARG1, s_abs);
#endif
if (SCM_INUM (x) >= 0)
return x;
cx = - SCM_INUM (x);
if (!SCM_POSFIXABLE (cx))
#ifdef SCM_BIGDIG
return scm_long2big (cx);
#else #else
scm_num_overflow (s_abs); scm_num_overflow (s_abs);
#endif #endif
return SCM_MAKINUM (cx); }
#ifdef SCM_BIGDIG
} else if (SCM_BIGP (x)) {
if (!SCM_BIGSIGN (x)) {
return x;
} else {
return scm_copybig (x, 0);
}
#endif
} else {
SCM_WTA_DISPATCH_1 (g_abs, x, 1, s_abs);
}
} }
SCM_GPROC (s_quotient, "quotient", 2, 0, 0, scm_quotient, g_quotient); SCM_GPROC (s_quotient, "quotient", 2, 0, 0, scm_quotient, g_quotient);
SCM SCM
@ -183,39 +189,26 @@ scm_quotient (SCM x, SCM y)
z++; z++;
} }
#endif #endif
if (!SCM_FIXABLE (z)) { if (SCM_FIXABLE (z)) {
return SCM_MAKINUM (z);
} else {
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
return scm_long2big (z); return scm_long2big (z);
#else #else
scm_num_overflow (s_quotient); scm_num_overflow (s_quotient);
#endif #endif
} else {
return SCM_MAKINUM (z);
} }
} }
} else {
#ifdef SCM_BIGDIG #ifdef SCM_BIGDIG
if (!SCM_BIGP (y)) { } else if (SCM_BIGP (y)) {
SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient); return SCM_INUM0;
} else {
return SCM_INUM0;
}
#else
SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
#endif #endif
}
} else {
#ifdef SCM_BIGDIG
SCM_GASSERT2 (SCM_BIGP (x), g_quotient, x, y, SCM_ARG1, s_quotient);
if (SCM_NINUMP (y)) {
if (!SCM_BIGP (y)) {
SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
} else {
return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
SCM_BDIGITS (y), SCM_NUMDIGS (y),
SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y), 2);
}
} else { } else {
SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
}
#ifdef SCM_BIGDIG
} else if (SCM_BIGP (x)) {
if (SCM_INUMP (y)) {
long yy = SCM_INUM (y); long yy = SCM_INUM (y);
if (yy == 0) { if (yy == 0) {
scm_num_overflow (s_quotient); scm_num_overflow (s_quotient);
@ -243,13 +236,20 @@ scm_quotient (SCM x, SCM y)
#endif #endif
} }
} }
} else if (SCM_BIGP (y)) {
return scm_divbigbig (SCM_BDIGITS (x), SCM_NUMDIGS (x),
SCM_BDIGITS (y), SCM_NUMDIGS (y),
SCM_BIGSIGN (x) ^ SCM_BIGSIGN (y), 2);
} else {
SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
} }
#else
SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
#endif #endif
} else {
SCM_WTA_DISPATCH_2 (g_quotient, x, y, SCM_ARG2, s_quotient);
} }
} }
SCM_GPROC (s_remainder, "remainder", 2, 0, 0, scm_remainder, g_remainder); SCM_GPROC (s_remainder, "remainder", 2, 0, 0, scm_remainder, g_remainder);
SCM SCM