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

Optimize scm_exact_p by making use of SCM_INEXACTP

* libguile/numbers.c (scm_exact_p): Optimize by making use of the
  SCM_INEXACTP macro.
  (scm_inexact_p): Move it next to scm_exact_p, and add else's.

* test-suite/tests/numbers.test: Add test cases for `exact?'
  and `inexact?' applied to infinities and NaNs.
This commit is contained in:
Mark H Weaver 2011-01-26 09:36:05 -05:00 committed by Andy Wingo
parent 7112615f73
commit 41df63cf16
2 changed files with 29 additions and 24 deletions

View file

@ -503,15 +503,28 @@ SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0,
"otherwise.")
#define FUNC_NAME s_scm_exact_p
{
if (SCM_I_INUMP (x))
return SCM_BOOL_T;
if (SCM_BIGP (x))
return SCM_BOOL_T;
if (SCM_FRACTIONP (x))
return SCM_BOOL_T;
if (SCM_NUMBERP (x))
if (SCM_INEXACTP (x))
return SCM_BOOL_F;
SCM_WRONG_TYPE_ARG (1, x);
else if (SCM_NUMBERP (x))
return SCM_BOOL_T;
else
SCM_WRONG_TYPE_ARG (1, x);
}
#undef FUNC_NAME
SCM_DEFINE (scm_inexact_p, "inexact?", 1, 0, 0,
(SCM x),
"Return @code{#t} if @var{x} is an inexact number, @code{#f}\n"
"else.")
#define FUNC_NAME s_scm_inexact_p
{
if (SCM_INEXACTP (x))
return SCM_BOOL_T;
else if (SCM_NUMBERP (x))
return SCM_BOOL_F;
else
SCM_WRONG_TYPE_ARG (1, x);
}
#undef FUNC_NAME
@ -3364,21 +3377,6 @@ SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0,
#undef FUNC_NAME
SCM_DEFINE (scm_inexact_p, "inexact?", 1, 0, 0,
(SCM x),
"Return @code{#t} if @var{x} is an inexact number, @code{#f}\n"
"else.")
#define FUNC_NAME s_scm_inexact_p
{
if (SCM_INEXACTP (x))
return SCM_BOOL_T;
if (SCM_NUMBERP (x))
return SCM_BOOL_F;
SCM_WRONG_TYPE_ARG (1, x);
}
#undef FUNC_NAME
SCM scm_i_num_eq_p (SCM, SCM, SCM);
SCM_PRIMITIVE_GENERIC (scm_i_num_eq_p, "=", 0, 2, 1,
(SCM x, SCM y, SCM rest),

View file

@ -240,7 +240,11 @@
(eq? #f (exact? (sqrt (- (expt fixnum-max 2) 1)))))
(pass-if "sqrt ((fixnum-max+1)^2 - 1)"
(eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))))
(eq? #f (exact? (sqrt (- (expt (+ fixnum-max 1) 2) 1)))))
(pass-if (not (exact? +inf.0)))
(pass-if (not (exact? -inf.0)))
(pass-if (not (exact? +nan.0)))))
;;;
;;; exp
@ -1559,6 +1563,9 @@
(pass-if (not (inexact? (- 1 fixnum-min))))
(pass-if (inexact? 1.3))
(pass-if (inexact? 3.1+4.2i))
(pass-if (inexact? +inf.0))
(pass-if (inexact? -inf.0))
(pass-if (inexact? +nan.0))
(pass-if-exception "char"
exception:wrong-type-arg
(not (inexact? #\a)))