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

Optimize scm_exact_p by making use of SCM_INEXACTP

Browse source 
* 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
Download patch file Download diff file Expand all files Collapse all files

42
libguile/numbers.c
View file

@ -503,14 +503,27 @@ SCM_DEFINE (scm_exact_p, "exact?", 1, 0, 0,
"otherwise.") "otherwise.")
#define FUNC_NAME s_scm_exact_p #define FUNC_NAME s_scm_exact_p
{ {
if (SCM_I_INUMP (x)) if (SCM_INEXACTP (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))
return SCM_BOOL_F; return SCM_BOOL_F;
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); SCM_WRONG_TYPE_ARG (1, x);
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -3364,21 +3377,6 @@ SCM_DEFINE (scm_integer_p, "integer?", 1, 0, 0,
#undef FUNC_NAME #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 scm_i_num_eq_p (SCM, SCM, SCM);
SCM_PRIMITIVE_GENERIC (scm_i_num_eq_p, "=", 0, 2, 1, SCM_PRIMITIVE_GENERIC (scm_i_num_eq_p, "=", 0, 2, 1,
(SCM x, SCM y, SCM rest), (SCM x, SCM y, SCM rest),

9
test-suite/tests/numbers.test
View file

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