diff options
-rw-r--r-- | libguile/numbers.c | 519 | ||||
-rw-r--r-- | libguile/numbers.h | 74 |
2 files changed, 498 insertions, 95 deletions
diff --git a/libguile/numbers.c b/libguile/numbers.c index 6187fefdc..ab791edd4 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -346,7 +346,7 @@ scm_make_ratio (SCM numerator, SCM denominator) /* Then flip signs so that the denominator is positive. */ - if (SCM_NFALSEP (scm_negative_p (denominator))) + if (scm_is_true (scm_negative_p (denominator))) { numerator = scm_difference (numerator, SCM_UNDEFINED); denominator = scm_difference (denominator, SCM_UNDEFINED); @@ -459,15 +459,15 @@ SCM_DEFINE (scm_odd_p, "odd?", 1, 0, 0, if (SCM_INUMP (n)) { long val = SCM_INUM (n); - return SCM_BOOL ((val & 1L) != 0); + return scm_from_bool ((val & 1L) != 0); } else if (SCM_BIGP (n)) { int odd_p = mpz_odd_p (SCM_I_BIG_MPZ (n)); scm_remember_upto_here_1 (n); - return SCM_BOOL (odd_p); + return scm_from_bool (odd_p); } - else if (!SCM_FALSEP (scm_inf_p (n))) + else if (scm_is_true (scm_inf_p (n))) return SCM_BOOL_T; else if (SCM_REALP (n)) { @@ -494,15 +494,15 @@ SCM_DEFINE (scm_even_p, "even?", 1, 0, 0, if (SCM_INUMP (n)) { long val = SCM_INUM (n); - return SCM_BOOL ((val & 1L) == 0); + return scm_from_bool ((val & 1L) == 0); } else if (SCM_BIGP (n)) { int even_p = mpz_even_p (SCM_I_BIG_MPZ (n)); scm_remember_upto_here_1 (n); - return SCM_BOOL (even_p); + return scm_from_bool (even_p); } - else if (!SCM_FALSEP (scm_inf_p (n))) + else if (scm_is_true (scm_inf_p (n))) return SCM_BOOL_T; else if (SCM_REALP (n)) { @@ -526,9 +526,9 @@ SCM_DEFINE (scm_inf_p, "inf?", 1, 0, 0, #define FUNC_NAME s_scm_inf_p { if (SCM_REALP (n)) - return SCM_BOOL (xisinf (SCM_REAL_VALUE (n))); + return scm_from_bool (xisinf (SCM_REAL_VALUE (n))); else if (SCM_COMPLEXP (n)) - return SCM_BOOL (xisinf (SCM_COMPLEX_REAL (n)) + return scm_from_bool (xisinf (SCM_COMPLEX_REAL (n)) || xisinf (SCM_COMPLEX_IMAG (n))); else return SCM_BOOL_F; @@ -542,9 +542,9 @@ SCM_DEFINE (scm_nan_p, "nan?", 1, 0, 0, #define FUNC_NAME s_scm_nan_p { if (SCM_REALP (n)) - return SCM_BOOL (xisnan (SCM_REAL_VALUE (n))); + return scm_from_bool (xisnan (SCM_REAL_VALUE (n))); else if (SCM_COMPLEXP (n)) - return SCM_BOOL (xisnan (SCM_COMPLEX_REAL (n)) + return scm_from_bool (xisnan (SCM_COMPLEX_REAL (n)) || xisnan (SCM_COMPLEX_IMAG (n))); else return SCM_BOOL_F; @@ -671,7 +671,7 @@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", 1, 0, 0, } else if (SCM_FRACTIONP (x)) { - if (SCM_FALSEP (scm_negative_p (SCM_FRACTION_NUMERATOR (x)))) + if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (x)))) return x; return scm_make_ratio (scm_difference (SCM_FRACTION_NUMERATOR (x), SCM_UNDEFINED), SCM_FRACTION_DENOMINATOR (x)); @@ -1414,7 +1414,7 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, if (SCM_INUMP (k)) { long nk = SCM_INUM (k); - return SCM_BOOL (nj & nk); + return scm_from_bool (nj & nk); } else if (SCM_BIGP (k)) { @@ -1427,7 +1427,7 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, mpz_init_set_si (nj_z, nj); mpz_and (nj_z, nj_z, SCM_I_BIG_MPZ (k)); scm_remember_upto_here_1 (k); - result = SCM_BOOL (mpz_sgn (nj_z) != 0); + result = scm_from_bool (mpz_sgn (nj_z) != 0); mpz_clear (nj_z); return result; } @@ -1452,7 +1452,7 @@ SCM_DEFINE (scm_logtest, "logtest", 2, 0, 0, SCM_I_BIG_MPZ (j), SCM_I_BIG_MPZ (k)); scm_remember_upto_here_2 (j, k); - result = SCM_BOOL (mpz_sgn (result_z) != 0); + result = scm_from_bool (mpz_sgn (result_z) != 0); mpz_clear (result_z); return result; } @@ -1486,13 +1486,13 @@ SCM_DEFINE (scm_logbit_p, "logbit?", 2, 0, 0, { /* bits above what's in an inum follow the sign bit */ iindex = min (iindex, SCM_LONG_BIT - 1); - return SCM_BOOL ((1L << iindex) & SCM_INUM (j)); + return scm_from_bool ((1L << iindex) & SCM_INUM (j)); } else if (SCM_BIGP (j)) { int val = mpz_tstbit (SCM_I_BIG_MPZ (j), iindex); scm_remember_upto_here_1 (j); - return SCM_BOOL (val); + return scm_from_bool (val); } else SCM_WRONG_TYPE_ARG (SCM_ARG2, j); @@ -1670,9 +1670,9 @@ SCM_DEFINE (scm_integer_expt, "integer-expt", 2, 0, 0, /* 0^0 == 1 according to R5RS */ if (SCM_EQ_P (n, SCM_INUM0) || SCM_EQ_P (n, acc)) - return SCM_FALSEP (scm_zero_p(k)) ? n : acc; + return scm_is_false (scm_zero_p(k)) ? n : acc; else if (SCM_EQ_P (n, SCM_MAKINUM (-1L))) - return SCM_FALSEP (scm_even_p (k)) ? n : acc; + return scm_is_false (scm_even_p (k)) ? n : acc; if (SCM_INUMP (k)) i2 = SCM_INUM (k); @@ -1785,7 +1785,7 @@ SCM_DEFINE (scm_ash, "ash", 2, 0, 0, SCM_MAKINUM (-bits_to_shift)); /* scm_quotient assumes its arguments are integers, but it's legal to (ash 1/2 -1) */ - if (SCM_FALSEP (scm_negative_p (n))) + if (scm_is_false (scm_negative_p (n))) return scm_quotient (n, div); else return scm_sum (SCM_MAKINUM (-1L), @@ -2665,7 +2665,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, SCM uinteger; uinteger = mem2uinteger (mem, len, &idx, radix, &x); - if (SCM_FALSEP (uinteger)) + if (scm_is_false (uinteger)) return SCM_BOOL_F; if (idx == len) @@ -2677,7 +2677,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, idx++; divisor = mem2uinteger (mem, len, &idx, radix, &x); - if (SCM_FALSEP (divisor)) + if (scm_is_false (divisor)) return SCM_BOOL_F; /* both are int/big here, I assume */ @@ -2686,7 +2686,7 @@ mem2ureal (const char* mem, size_t len, unsigned int *p_idx, else if (radix == 10) { result = mem2decimal_from_point (uinteger, mem, len, &idx, &x); - if (SCM_FALSEP (result)) + if (scm_is_false (result)) return SCM_BOOL_F; } else @@ -2736,7 +2736,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx, return SCM_BOOL_F; ureal = mem2ureal (mem, len, &idx, radix, p_exactness); - if (SCM_FALSEP (ureal)) + if (scm_is_false (ureal)) { /* input must be either +i or -i */ @@ -2756,7 +2756,7 @@ mem2complex (const char* mem, size_t len, unsigned int idx, } else { - if (sign == -1 && SCM_FALSEP (scm_nan_p (ureal))) + if (sign == -1 && scm_is_false (scm_nan_p (ureal))) ureal = scm_difference (ureal, SCM_UNDEFINED); if (idx == len) @@ -2802,12 +2802,12 @@ mem2complex (const char* mem, size_t len, unsigned int idx, sign = 1; angle = mem2ureal (mem, len, &idx, radix, p_exactness); - if (SCM_FALSEP (angle)) + if (scm_is_false (angle)) return SCM_BOOL_F; if (idx != len) return SCM_BOOL_F; - if (sign == -1 && SCM_FALSEP (scm_nan_p (ureal))) + if (sign == -1 && scm_is_false (scm_nan_p (ureal))) angle = scm_difference (angle, SCM_UNDEFINED); result = scm_make_polar (ureal, angle); @@ -2825,9 +2825,9 @@ mem2complex (const char* mem, size_t len, unsigned int idx, int sign = (c == '+') ? 1 : -1; SCM imag = mem2ureal (mem, len, &idx, radix, p_exactness); - if (SCM_FALSEP (imag)) + if (scm_is_false (imag)) imag = SCM_MAKINUM (sign); - else if (sign == -1 && SCM_FALSEP (scm_nan_p (ureal))) + else if (sign == -1 && scm_is_false (scm_nan_p (ureal))) imag = scm_difference (imag, SCM_UNDEFINED); if (idx == len) @@ -2908,7 +2908,7 @@ scm_i_mem2number (const char* mem, size_t len, unsigned int default_radix) else result = mem2complex (mem, len, idx, (unsigned int) radix, &implicit_x); - if (SCM_FALSEP (result)) + if (scm_is_false (result)) return SCM_BOOL_F; switch (forced_x) @@ -2997,19 +2997,19 @@ scm_bigequal (SCM x, SCM y) { int result = mpz_cmp (SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y)); scm_remember_upto_here_2 (x, y); - return SCM_BOOL (0 == result); + return scm_from_bool (0 == result); } SCM scm_real_equalp (SCM x, SCM y) { - return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); + return scm_from_bool (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); } SCM scm_complex_equalp (SCM x, SCM y) { - return SCM_BOOL (SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y) + return scm_from_bool (SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y) && SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y)); } @@ -3018,9 +3018,9 @@ scm_i_fraction_equalp (SCM x, SCM y) { scm_i_fraction_reduce (x); scm_i_fraction_reduce (y); - if (SCM_FALSEP (scm_equal_p (SCM_FRACTION_NUMERATOR (x), + if (scm_is_false (scm_equal_p (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_NUMERATOR (y))) - || SCM_FALSEP (scm_equal_p (SCM_FRACTION_DENOMINATOR (x), + || scm_is_false (scm_equal_p (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_DENOMINATOR (y)))) return SCM_BOOL_F; else @@ -3043,7 +3043,7 @@ SCM_DEFINE (scm_number_p, "complex?", 1, 0, 0, "rational or integer number.") #define FUNC_NAME s_scm_number_p { - return SCM_BOOL (SCM_NUMBERP (x)); + return scm_from_bool (SCM_NUMBERP (x)); } #undef FUNC_NAME @@ -3139,14 +3139,14 @@ scm_num_eq_p (SCM x, SCM y) if (SCM_INUMP (y)) { long yy = SCM_INUM (y); - return SCM_BOOL (xx == yy); + return scm_from_bool (xx == yy); } else if (SCM_BIGP (y)) return SCM_BOOL_F; else if (SCM_REALP (y)) - return SCM_BOOL ((double) xx == SCM_REAL_VALUE (y)); + return scm_from_bool ((double) xx == SCM_REAL_VALUE (y)); else if (SCM_COMPLEXP (y)) - return SCM_BOOL (((double) xx == SCM_COMPLEX_REAL (y)) + return scm_from_bool (((double) xx == SCM_COMPLEX_REAL (y)) && (0.0 == SCM_COMPLEX_IMAG (y))); else if (SCM_FRACTIONP (y)) return SCM_BOOL_F; @@ -3161,7 +3161,7 @@ scm_num_eq_p (SCM x, SCM y) { int cmp = mpz_cmp (SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y)); scm_remember_upto_here_2 (x, y); - return SCM_BOOL (0 == cmp); + return scm_from_bool (0 == cmp); } else if (SCM_REALP (y)) { @@ -3170,7 +3170,7 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y)); scm_remember_upto_here_1 (x); - return SCM_BOOL (0 == cmp); + return scm_from_bool (0 == cmp); } else if (SCM_COMPLEXP (y)) { @@ -3181,7 +3181,7 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_COMPLEX_REAL (y)); scm_remember_upto_here_1 (x); - return SCM_BOOL (0 == cmp); + return scm_from_bool (0 == cmp); } else if (SCM_FRACTIONP (y)) return SCM_BOOL_F; @@ -3191,7 +3191,7 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_REALP (x)) { if (SCM_INUMP (y)) - return SCM_BOOL (SCM_REAL_VALUE (x) == (double) SCM_INUM (y)); + return scm_from_bool (SCM_REAL_VALUE (x) == (double) SCM_INUM (y)); else if (SCM_BIGP (y)) { int cmp; @@ -3199,12 +3199,12 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x)); scm_remember_upto_here_1 (y); - return SCM_BOOL (0 == cmp); + return scm_from_bool (0 == cmp); } else if (SCM_REALP (y)) - return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); + return scm_from_bool (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y)); else if (SCM_COMPLEXP (y)) - return SCM_BOOL ((SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)) + return scm_from_bool ((SCM_REAL_VALUE (x) == SCM_COMPLEX_REAL (y)) && (0.0 == SCM_COMPLEX_IMAG (y))); else if (SCM_FRACTIONP (y)) { @@ -3212,7 +3212,7 @@ scm_num_eq_p (SCM x, SCM y) if (xisnan (xx)) return SCM_BOOL_F; if (xisinf (xx)) - return SCM_BOOL (xx < 0.0); + return scm_from_bool (xx < 0.0); x = scm_inexact_to_exact (x); /* with x as frac or int */ goto again; } @@ -3222,7 +3222,7 @@ scm_num_eq_p (SCM x, SCM y) else if (SCM_COMPLEXP (x)) { if (SCM_INUMP (y)) - return SCM_BOOL ((SCM_COMPLEX_REAL (x) == (double) SCM_INUM (y)) + return scm_from_bool ((SCM_COMPLEX_REAL (x) == (double) SCM_INUM (y)) && (SCM_COMPLEX_IMAG (x) == 0.0)); else if (SCM_BIGP (y)) { @@ -3233,13 +3233,13 @@ scm_num_eq_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_COMPLEX_REAL (x)); scm_remember_upto_here_1 (y); - return SCM_BOOL (0 == cmp); + return scm_from_bool (0 == cmp); } else if (SCM_REALP (y)) - return SCM_BOOL ((SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)) + return scm_from_bool ((SCM_COMPLEX_REAL (x) == SCM_REAL_VALUE (y)) && (SCM_COMPLEX_IMAG (x) == 0.0)); else if (SCM_COMPLEXP (y)) - return SCM_BOOL ((SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)) + return scm_from_bool ((SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)) && (SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y))); else if (SCM_FRACTIONP (y)) { @@ -3250,7 +3250,7 @@ scm_num_eq_p (SCM x, SCM y) if (xisnan (xx)) return SCM_BOOL_F; if (xisinf (xx)) - return SCM_BOOL (xx < 0.0); + return scm_from_bool (xx < 0.0); x = scm_inexact_to_exact (x); /* with x as frac or int */ goto again; } @@ -3269,7 +3269,7 @@ scm_num_eq_p (SCM x, SCM y) if (xisnan (yy)) return SCM_BOOL_F; if (xisinf (yy)) - return SCM_BOOL (0.0 < yy); + return scm_from_bool (0.0 < yy); y = scm_inexact_to_exact (y); /* with y as frac or int */ goto again; } @@ -3282,7 +3282,7 @@ scm_num_eq_p (SCM x, SCM y) if (xisnan (yy)) return SCM_BOOL_F; if (xisinf (yy)) - return SCM_BOOL (0.0 < yy); + return scm_from_bool (0.0 < yy); y = scm_inexact_to_exact (y); /* with y as frac or int */ goto again; } @@ -3316,16 +3316,16 @@ scm_less_p (SCM x, SCM y) if (SCM_INUMP (y)) { long yy = SCM_INUM (y); - return SCM_BOOL (xx < yy); + return scm_from_bool (xx < yy); } else if (SCM_BIGP (y)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (y)); scm_remember_upto_here_1 (y); - return SCM_BOOL (sgn > 0); + return scm_from_bool (sgn > 0); } else if (SCM_REALP (y)) - return SCM_BOOL ((double) xx < SCM_REAL_VALUE (y)); + return scm_from_bool ((double) xx < SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) { /* "x < a/b" becomes "x*b < a" */ @@ -3343,13 +3343,13 @@ scm_less_p (SCM x, SCM y) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); scm_remember_upto_here_1 (x); - return SCM_BOOL (sgn < 0); + return scm_from_bool (sgn < 0); } else if (SCM_BIGP (y)) { int cmp = mpz_cmp (SCM_I_BIG_MPZ (x), SCM_I_BIG_MPZ (y)); scm_remember_upto_here_2 (x, y); - return SCM_BOOL (cmp < 0); + return scm_from_bool (cmp < 0); } else if (SCM_REALP (y)) { @@ -3358,7 +3358,7 @@ scm_less_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), SCM_REAL_VALUE (y)); scm_remember_upto_here_1 (x); - return SCM_BOOL (cmp < 0); + return scm_from_bool (cmp < 0); } else if (SCM_FRACTIONP (y)) goto int_frac; @@ -3368,7 +3368,7 @@ scm_less_p (SCM x, SCM y) else if (SCM_REALP (x)) { if (SCM_INUMP (y)) - return SCM_BOOL (SCM_REAL_VALUE (x) < (double) SCM_INUM (y)); + return scm_from_bool (SCM_REAL_VALUE (x) < (double) SCM_INUM (y)); else if (SCM_BIGP (y)) { int cmp; @@ -3376,17 +3376,17 @@ scm_less_p (SCM x, SCM y) return SCM_BOOL_F; cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), SCM_REAL_VALUE (x)); scm_remember_upto_here_1 (y); - return SCM_BOOL (cmp > 0); + return scm_from_bool (cmp > 0); } else if (SCM_REALP (y)) - return SCM_BOOL (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y)); + return scm_from_bool (SCM_REAL_VALUE (x) < SCM_REAL_VALUE (y)); else if (SCM_FRACTIONP (y)) { double xx = SCM_REAL_VALUE (x); if (xisnan (xx)) return SCM_BOOL_F; if (xisinf (xx)) - return SCM_BOOL (xx < 0.0); + return scm_from_bool (xx < 0.0); x = scm_inexact_to_exact (x); /* with x as frac or int */ goto again; } @@ -3408,7 +3408,7 @@ scm_less_p (SCM x, SCM y) if (xisnan (yy)) return SCM_BOOL_F; if (xisinf (yy)) - return SCM_BOOL (0.0 < yy); + return scm_from_bool (0.0 < yy); y = scm_inexact_to_exact (y); /* with y as frac or int */ goto again; } @@ -3461,10 +3461,10 @@ scm_leq_p (SCM x, SCM y) 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 if (SCM_NFALSEP (scm_nan_p (x)) || SCM_NFALSEP (scm_nan_p (y))) + else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y))) return SCM_BOOL_F; else - return SCM_BOOL_NOT (scm_less_p (y, x)); + return scm_not (scm_less_p (y, x)); } #undef FUNC_NAME @@ -3481,10 +3481,10 @@ scm_geq_p (SCM x, SCM y) 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 if (SCM_NFALSEP (scm_nan_p (x)) || SCM_NFALSEP (scm_nan_p (y))) + else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y))) return SCM_BOOL_F; else - return SCM_BOOL_NOT (scm_less_p (x, y)); + return scm_not (scm_less_p (x, y)); } #undef FUNC_NAME @@ -3497,13 +3497,13 @@ SCM scm_zero_p (SCM z) { if (SCM_INUMP (z)) - return SCM_BOOL (SCM_EQ_P (z, SCM_INUM0)); + return scm_from_bool (SCM_EQ_P (z, SCM_INUM0)); else if (SCM_BIGP (z)) return SCM_BOOL_F; else if (SCM_REALP (z)) - return SCM_BOOL (SCM_REAL_VALUE (z) == 0.0); + return scm_from_bool (SCM_REAL_VALUE (z) == 0.0); else if (SCM_COMPLEXP (z)) - return SCM_BOOL (SCM_COMPLEX_REAL (z) == 0.0 + return scm_from_bool (SCM_COMPLEX_REAL (z) == 0.0 && SCM_COMPLEX_IMAG (z) == 0.0); else if (SCM_FRACTIONP (z)) return SCM_BOOL_F; @@ -3520,15 +3520,15 @@ SCM scm_positive_p (SCM x) { if (SCM_INUMP (x)) - return SCM_BOOL (SCM_INUM (x) > 0); + return scm_from_bool (SCM_INUM (x) > 0); else if (SCM_BIGP (x)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); scm_remember_upto_here_1 (x); - return SCM_BOOL (sgn > 0); + return scm_from_bool (sgn > 0); } else if (SCM_REALP (x)) - return SCM_BOOL(SCM_REAL_VALUE (x) > 0.0); + return scm_from_bool(SCM_REAL_VALUE (x) > 0.0); else if (SCM_FRACTIONP (x)) return scm_positive_p (SCM_FRACTION_NUMERATOR (x)); else @@ -3544,15 +3544,15 @@ SCM scm_negative_p (SCM x) { if (SCM_INUMP (x)) - return SCM_BOOL (SCM_INUM (x) < 0); + return scm_from_bool (SCM_INUM (x) < 0); else if (SCM_BIGP (x)) { int sgn = mpz_sgn (SCM_I_BIG_MPZ (x)); scm_remember_upto_here_1 (x); - return SCM_BOOL (sgn < 0); + return scm_from_bool (sgn < 0); } else if (SCM_REALP (x)) - return SCM_BOOL(SCM_REAL_VALUE (x) < 0.0); + return scm_from_bool(SCM_REAL_VALUE (x) < 0.0); else if (SCM_FRACTIONP (x)) return scm_negative_p (SCM_FRACTION_NUMERATOR (x)); else @@ -3605,7 +3605,7 @@ scm_max (SCM x, SCM y) else if (SCM_FRACTIONP (y)) { use_less: - return (SCM_FALSEP (scm_less_p (x, y)) ? x : y); + return (scm_is_false (scm_less_p (x, y)) ? x : y); } else SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); @@ -3737,7 +3737,7 @@ scm_min (SCM x, SCM y) else if (SCM_FRACTIONP (y)) { use_less: - return (SCM_FALSEP (scm_less_p (x, y)) ? y : x); + return (scm_is_false (scm_less_p (x, y)) ? y : x); } else SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); @@ -4990,7 +4990,7 @@ SCM_DEFINE (scm_truncate_number, "truncate", 1, 0, 0, "Round the number @var{x} towards zero.") #define FUNC_NAME s_scm_truncate_number { - if (SCM_FALSEP (scm_negative_p (x))) + if (scm_is_false (scm_negative_p (x))) return scm_floor (x); else return scm_ceiling (x); @@ -5018,8 +5018,8 @@ SCM_DEFINE (scm_round_number, "round", 1, 0, 0, SCM plus_half = scm_sum (x, exactly_one_half); SCM result = scm_floor (plus_half); /* Adjust so that the scm_round is towards even. */ - if (!SCM_FALSEP (scm_num_eq_p (plus_half, result)) - && !SCM_FALSEP (scm_odd_p (result))) + if (scm_is_true (scm_num_eq_p (plus_half, result)) + && scm_is_true (scm_odd_p (result))) return scm_difference (result, SCM_MAKINUM (1)); else return result; @@ -5040,7 +5040,7 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0, { SCM q = scm_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); - if (SCM_FALSEP (scm_negative_p (x))) + if (scm_is_false (scm_negative_p (x))) { /* For positive x, rounding towards zero is correct. */ return q; @@ -5071,7 +5071,7 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0, { SCM q = scm_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); - if (SCM_FALSEP (scm_positive_p (x))) + if (scm_is_false (scm_positive_p (x))) { /* For negative x, rounding towards zero is correct. */ return q; @@ -5344,7 +5344,7 @@ scm_magnitude (SCM z) return scm_make_real (hypot (SCM_COMPLEX_REAL (z), SCM_COMPLEX_IMAG (z))); else if (SCM_FRACTIONP (z)) { - if (SCM_FALSEP (scm_negative_p (SCM_FRACTION_NUMERATOR (z)))) + if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (z)))) return z; return scm_make_ratio (scm_difference (SCM_FRACTION_NUMERATOR (z), SCM_UNDEFINED), SCM_FRACTION_DENOMINATOR (z)); @@ -5391,7 +5391,7 @@ scm_angle (SCM z) return scm_make_real (atan2 (SCM_COMPLEX_IMAG (z), SCM_COMPLEX_REAL (z))); else if (SCM_FRACTIONP (z)) { - if (SCM_FALSEP (scm_negative_p (SCM_FRACTION_NUMERATOR (z)))) + if (scm_is_false (scm_negative_p (SCM_FRACTION_NUMERATOR (z)))) return scm_flo0; else return scm_make_real (atan2 (0.0, -1.0)); } @@ -5479,7 +5479,7 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, SCM rx; int i = 0; - if (!SCM_FALSEP (scm_num_eq_p (ex, int_part))) + if (scm_is_true (scm_num_eq_p (ex, int_part))) return ex; ex = scm_difference (ex, int_part); /* x = x-int_part */ @@ -5495,14 +5495,14 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, { a = scm_sum (scm_product (a1, tt), a2); /* a = a1*tt + a2 */ b = scm_sum (scm_product (b1, tt), b2); /* b = b1*tt + b2 */ - if (SCM_FALSEP (scm_zero_p (b)) && /* b != 0 */ - SCM_FALSEP + if (scm_is_false (scm_zero_p (b)) && /* b != 0 */ + scm_is_false (scm_gr_p (scm_abs (scm_difference (ex, scm_divide (a, b))), err))) /* abs(x-a/b) <= err */ { SCM res = scm_sum (int_part, scm_divide (a, b)); - if (SCM_FALSEP (scm_exact_p (x)) - || SCM_FALSEP (scm_exact_p (err))) + if (scm_is_false (scm_exact_p (x)) + || scm_is_false (scm_exact_p (err))) return scm_exact_to_inexact (res); else return res; @@ -5663,6 +5663,339 @@ SCM_DEFINE (scm_rationalize, "rationalize", 2, 0, 0, #define FTYPE double #include "libguile/num2float.i.c" +/* conversion functions */ + +int +scm_is_integer (SCM val) +{ + return scm_is_true (scm_integer_p (val)); +} + +int +scm_is_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) +{ + if (SCM_INUMP (val)) + { + scm_t_signed_bits n = SCM_INUM (val); + return n >= min && n <= max; + } + else if (SCM_BIGP (val)) + { + if (min >= SCM_MOST_NEGATIVE_FIXNUM && max <= SCM_MOST_POSITIVE_FIXNUM) + return 0; + else if (min >= LONG_MIN && max <= LONG_MAX) + return (mpz_cmp_si (SCM_I_BIG_MPZ (val), min) >= 0 + && mpz_cmp_si (SCM_I_BIG_MPZ (val), max) <= 0); + else + { + /* Get the big hammer. */ + + mpz_t bigmin, bigmax; + int res; + + mpz_init (bigmin); + if (min >= 0) + mpz_import (bigmin, 1, 1, sizeof (scm_t_intmax), 0, 0, &min); + else + { + /* Magically works for min == INTMAX_MIN as well. */ + min = -min; + mpz_import (bigmin, 1, 1, sizeof (scm_t_intmax), 0, 0, &min); + mpz_neg (bigmin, bigmin); + } + res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmin); + mpz_clear (bigmin); + if (res < 0) + return 0; + + mpz_init (bigmax); + if (max >= 0) + mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); + else + { + /* Magically works for max == INTMAX_MIN as well. */ + max = -max; + mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); + mpz_neg (bigmax, bigmax); + } + res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmax); + mpz_clear (bigmax); + return res <= 0; + } + } + else if (SCM_REALP (val)) + { + double n = SCM_REAL_VALUE (val); + return n == floor(n) && n >= min && n <= max; + } + else + return 0; +} + +int +scm_is_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) +{ + if (SCM_INUMP (val)) + { + scm_t_signed_bits n = SCM_INUM (val); + return n >= 0 && ((scm_t_uintmax)n) >= min && ((scm_t_uintmax)n) <= max; + } + else if (SCM_BIGP (val)) + { + if (max <= SCM_MOST_POSITIVE_FIXNUM) + return 0; + else if (max <= ULONG_MAX) + return (mpz_cmp_ui (SCM_I_BIG_MPZ (val), min) >= 0 + && mpz_cmp_ui (SCM_I_BIG_MPZ (val), max) <= 0); + else + { + /* Get the big hammer. */ + + mpz_t bigmin, bigmax; + int res; + + mpz_init (bigmin); + mpz_import (bigmin, 1, 1, sizeof (scm_t_uintmax), 0, 0, &min); + res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmin); + mpz_clear (bigmin); + if (res < 0) + return 0; + + mpz_init (bigmax); + mpz_import (bigmax, 1, 1, sizeof (scm_t_intmax), 0, 0, &max); + res = mpz_cmp (SCM_I_BIG_MPZ (val), bigmax); + mpz_clear (bigmax); + return res <= 0; + } + } + else if (SCM_REALP (val)) + { + double n = SCM_REAL_VALUE (val); + return n == floor(n) && n >= min && n <= max; + } + else + return 0; +} + +scm_t_intmax +scm_to_signed_integer (SCM val, scm_t_intmax min, scm_t_intmax max) +{ + if (SCM_INUMP (val)) + { + scm_t_signed_bits n = SCM_INUM (val); + if (n >= min && n <= max) + return n; + else + { + out_of_range: + scm_out_of_range (NULL, val); + return 0; + } + } + else if (SCM_BIGP (val)) + { + if (min >= SCM_MOST_NEGATIVE_FIXNUM && max <= SCM_MOST_POSITIVE_FIXNUM) + goto out_of_range; + else if (min >= LONG_MIN && max <= LONG_MAX) + { + if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val))) + { + long n = mpz_get_si (SCM_I_BIG_MPZ (val)); + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + else + goto out_of_range; + } + else + { + scm_t_intmax n; + size_t count; + + if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) + > 8*sizeof (scm_t_uintmax)) + goto out_of_range; + + mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, + SCM_I_BIG_MPZ (val)); + + if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0) + { + if (n < 0) + goto out_of_range; + } + else + { + n = -n; + if (n >= 0) + goto out_of_range; + } + + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + } + else if (SCM_REALP (val)) + { + double n = SCM_REAL_VALUE (val); + if (n != floor(n)) + goto wrong_type_arg; + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + else + { + wrong_type_arg: + scm_wrong_type_arg_msg (NULL, 0, val, "integer"); + return 0; + } +} + +scm_t_uintmax +scm_to_unsigned_integer (SCM val, scm_t_uintmax min, scm_t_uintmax max) +{ + if (SCM_INUMP (val)) + { + scm_t_signed_bits n = SCM_INUM (val); + if (n >= 0 && ((scm_t_uintmax)n) >= min && ((scm_t_uintmax)n) <= max) + return n; + else + { + out_of_range: + scm_out_of_range (NULL, val); + return 0; + } + } + else if (SCM_BIGP (val)) + { + if (max <= SCM_MOST_POSITIVE_FIXNUM) + goto out_of_range; + else if (max <= ULONG_MAX) + { + if (mpz_fits_ulong_p (SCM_I_BIG_MPZ (val))) + { + unsigned long n = mpz_get_ui (SCM_I_BIG_MPZ (val)); + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + else + goto out_of_range; + } + else + { + scm_t_uintmax n; + size_t count; + + if (mpz_sgn (SCM_I_BIG_MPZ (val)) < 0) + goto out_of_range; + + if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) + > 8*sizeof (scm_t_uintmax)) + goto out_of_range; + + mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, + SCM_I_BIG_MPZ (val)); + + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + } + else if (SCM_REALP (val)) + { + double n = SCM_REAL_VALUE (val); + if (n != floor(n)) + goto wrong_type_arg; + if (n >= min && n <= max) + return n; + else + goto out_of_range; + } + else + { + wrong_type_arg: + scm_wrong_type_arg_msg (NULL, 0, val, "integer"); + return 0; + } +} + +SCM +scm_from_signed_integer (scm_t_intmax val) +{ + if (SCM_FIXABLE (val)) + return SCM_MAKINUM (val); + else if (val >= LONG_MIN && val <= LONG_MAX) + { + SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); + mpz_init_set_si (SCM_I_BIG_MPZ (z), val); + return z; + } + else + { + SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); + mpz_init (SCM_I_BIG_MPZ (z)); + if (val < 0) + { + val = -val; + mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (scm_t_intmax), 0, 0, + &val); + mpz_neg (SCM_I_BIG_MPZ (z), SCM_I_BIG_MPZ (z)); + } + else + mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (scm_t_intmax), 0, 0, + &val); + return z; + } +} + +SCM +scm_from_unsigned_integer (scm_t_uintmax val) +{ + if (SCM_POSFIXABLE (val)) + return SCM_MAKINUM (val); + else if (val <= ULONG_MAX) + { + SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); + mpz_init_set_ui (SCM_I_BIG_MPZ (z), val); + return z; + } + else + { + SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); + mpz_init (SCM_I_BIG_MPZ (z)); + mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (scm_t_uintmax), 0, 0, + &val); + return z; + } +} + +int +scm_is_real (SCM val) +{ + return scm_is_true (scm_real_p (val)); +} + +double +scm_to_double (SCM val) +{ + return scm_num2dbl (val, NULL); +} + +SCM +scm_from_double (double val) +{ + return scm_make_real (val); +} + #ifdef GUILE_DEBUG #ifndef SIZE_MAX @@ -5729,7 +6062,7 @@ check_sanity () #define CHECK \ scm_internal_catch (SCM_BOOL_T, check_body, &data, check_handler, &data); \ - if (!SCM_FALSEP (data)) abort(); + if (scm_is_true (data)) abort(); static SCM check_body (void *data) diff --git a/libguile/numbers.h b/libguile/numbers.h index a9ee5f57f..59b755e9a 100644 --- a/libguile/numbers.h +++ b/libguile/numbers.h @@ -72,7 +72,6 @@ (SCM_PACK ((((scm_t_signed_bits) (x)) << 2) + scm_tc2_int)) #define SCM_INUM(x) (SCM_SRS ((scm_t_signed_bits) SCM_UNPACK (x), 2)) - /* SCM_FIXABLE is true if its long argument can be encoded in an SCM_INUM. */ #define SCM_POSFIXABLE(n) ((n) <= SCM_MOST_POSITIVE_FIXNUM) #define SCM_NEGFIXABLE(n) ((n) >= SCM_MOST_NEGATIVE_FIXNUM) @@ -82,7 +81,6 @@ /* A name for 0. */ #define SCM_INUM0 (SCM_MAKINUM (0)) - /* SCM_MAXEXP is the maximum double precision exponent * SCM_FLTMAX is less than or scm_equal the largest single precision float */ @@ -340,6 +338,78 @@ SCM_API int scm_i_print_fraction (SCM sexp, SCM port, scm_print_state *pstate); SCM_API SCM scm_sys_check_number_conversions (void); #endif +/* conversion functions */ + +SCM_API int scm_is_integer (SCM val); +SCM_API int scm_is_signed_integer (SCM val, + scm_t_intmax min, scm_t_intmax max); +SCM_API int scm_is_unsigned_integer (SCM val, + scm_t_uintmax min, scm_t_uintmax max); + +SCM_API SCM scm_from_signed_integer (scm_t_intmax val); +SCM_API SCM scm_from_unsigned_integer (scm_t_uintmax val); + +SCM_API scm_t_intmax scm_to_signed_integer (SCM val, + scm_t_intmax min, + scm_t_intmax max); +SCM_API scm_t_uintmax scm_to_unsigned_integer (SCM val, + scm_t_uintmax min, + scm_t_uintmax max); + +#define scm_to_schar(x) \ + ((signed char)scm_to_signed_integer ((x), SCHAR_MIN, SCHAR_MAX)) +#define scm_to_uchar(x) \ + ((unsigned char)scm_to_unsigned_integer ((x), 0, UCHAR_MAX)) +#if CHAR_MIN == 0 +#define scm_to_char scm_to_uchar +#else +#define scm_to_char scm_to_schar +#endif + +#define scm_to_short(x) \ + ((short)scm_to_signed_integer ((x), SHORT_MIN, SHORT_MAX)) +#define scm_to_ushort(x) \ + ((unsigned short)scm_to_unsigned_integer ((x), 0, SHORT_MAX)) + +#define scm_to_int(x) \ + ((int)scm_to_signed_integer ((x), INT_MIN, INT_MAX)) +#define scm_to_uint(x) \ + ((unsigned int)scm_to_unsigned_integer ((x), 0, UINT_MAX)) + +#define scm_to_long(x) \ + ((long)scm_to_signed_integer ((x), LONG_MIN, LONG_MAX)) +#define scm_to_ulong(x) \ + ((unsigned long)scm_to_unsigned_integer ((x), 0, ULONG_MAX)) + +#define scm_to_ssize_t(x) \ + ((ssize_t)scm_to_signed_integer ((x), -SSIZE_MAX-1, SSIZE_MAX)) +#define scm_to_size_t(x) \ + ((unsigned long)scm_to_unsigned_integer ((x), 0, (~(size_t)0))) + +#define scm_from_schar(x) scm_from_signed_integer ((signed char)(x)) +#define scm_from_uchar(x) scm_from_unsigned_integer ((unsigned char)(x)) +#if CHAR_MIN == 0 +#define scm_from_char scm_from_uchar +#else +#define scm_from_char scm_from_schar +#endif + +#define scm_from_short(x) scm_from_signed_integer ((short)(x)) +#define scm_from_ushort(x) scm_from_unsigned_integer ((unsigned short)(x)) + +#define scm_from_int(x) scm_from_signed_integer ((int)(x)) +#define scm_from_uint(x) scm_from_unsigned_integer ((unsigned int)(x)) + +#define scm_from_long(x) scm_from_signed_integer ((long)(x)) +#define scm_from_ulong(x) scm_from_unsigned_integer ((unsigned long)(x)) + +#define scm_from_ssize_t(x) scm_from_signed_integer ((ssize_t)(x)) +#define scm_from_size_t(x) scm_from_unsigned_integer ((size_t)(x)) + +SCM_API int scm_is_real (SCM val); +SCM_API double scm_to_double (SCM val); +SCM_API SCM scm_from_double (double val); + SCM_API void scm_init_numbers (void); #endif /* SCM_NUMBERS_H */ |