suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix problems with single-flonum (versus flonum) results

Browse Source 
The problems were with

 * `sqrt' and `expt' on single-flonum complex numbers
 * `asin' and `acos' on single-flonum arguments and complex results
 * `atan' on mixtures of single-flonum and exact arguments
 * `gcd' on mixtures of single-flonum and flonum arguments
This commit is contained in:
Matthew Flatt 2013-01-04 07:56:22 -07:00
parent c07ff948ee
commit 67f0af387b
3 changed files with 136 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
collects/tests/racket/number.rktl
View File

@ -2980,6 +2980,79 @@
(err/rt-test (real->floating-point-bytes 1.0+2.0i 8))
(err/rt-test (real->floating-point-bytes 1.0 8 #f (make-bytes 7)) exn:application:mismatch?)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check single-flonum coercisons:
(define ((check-single-flonum #:real-only? [real-only? #f]
#:integer-only? [integer-only? #f]
#:two-arg-real-only? [two-arg-real-only? real-only?])
op)
(define (single-flonum-ish? op . args)
(define v (apply op args))
(and (or (single-flonum? (real-part v))
(eq? 0 (real-part v)))
(or (single-flonum? (imag-part v))
(eq? 0 (imag-part v)))))
(when (procedure-arity-includes? op 1)
(test #t single-flonum-ish? op 2.0f0)
(unless real-only?
(test #t single-flonum-ish? op 2.0f0+4.0f0i)
(test #t single-flonum-ish? op 0+4.0f0i)))
(when (procedure-arity-includes? op 2)
(test #t single-flonum-ish? op 2.0f0 4.0f0)
(test #f single-flonum-ish? op 2.0 4.0f0)
(test #f single-flonum-ish? op 2.0f0 4.0)
(test #t single-flonum-ish? op 2.0f0 4)
(test #t single-flonum-ish? op 2 4.0f0)
(unless integer-only?
(unless two-arg-real-only?
(test #t single-flonum-ish? op 2.0f0 2.0f0+4.0f0i)
(test #t single-flonum-ish? op 2.0f0 0+4.0f0i)
(test #f single-flonum-ish? op 2.0f0 2.0+4.0i)
(test #f single-flonum-ish? op 2.0f0 0+4.0i)
(test #f single-flonum-ish? op 2.0 2.0f0+4.0f0i)
(test #f single-flonum-ish? op 2.0 0+4.0f0i))
(test #t single-flonum-ish? op 2.0f0 0.5f0)
(test #f single-flonum-ish? op 2.0 0.5f0)
(test #f single-flonum-ish? op 2.0f0 0.5)
(test #t single-flonum-ish? op 2.0f0 1/2)
(test #t single-flonum-ish? op 4/5 0.5f0))))
(map (check-single-flonum)
(list + - * /
add1
sub1
sqrt
expt
exp
log
sin
cos
tan
asin
acos))
(map (check-single-flonum #:two-arg-real-only? #t)
(list atan))
(map (check-single-flonum #:real-only? #f #:integer-only? #t)
(list quotient
remainder
modulo))
(map (check-single-flonum #:real-only? #t)
(list
abs
max
min
gcd
lcm
round
floor
ceiling
truncate))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This test once trigggered a crash due to an incorrect
;; hard-wired GC declaration for xform:

21
src/racket/src/complex.c
View File

@ -328,15 +328,14 @@ Scheme_Object *scheme_complex_power(const Scheme_Object *base, const Scheme_Obje
#ifdef MZ_USE_SINGLE_FLOATS
/* Coerce to double or float? */
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
if (!SCHEME_DBLP(cb->r) && !SCHEME_DBLP(cb->i)
&& !SCHEME_DBLP(ce->r) && !SCHEME_DBLP(ce->i))
#else
if (SCHEME_FLTP(cb->r) && SCHEME_FLTP(cb->i)
&& SCHEME_FLTP(ce->r) && SCHEME_FLTP(ce->i))
#ifndef USE_SINGLE_FLOATS_AS_DEFAULT
if (SCHEME_FLTP(cb->r) || SCHEME_FLTP(cb->i)
|| SCHEME_FLTP(ce->r) || SCHEME_FLTP(ce->i))
#endif
return scheme_make_complex(scheme_make_float((float)r1),
scheme_make_float((float)r2));
return scheme_make_complex(scheme_make_float((float)r1),
scheme_make_float((float)r2));
#endif
return scheme_make_complex(scheme_make_double(r1),
@ -380,9 +379,15 @@ Scheme_Object *scheme_complex_sqrt(const Scheme_Object *o)
if (SCHEME_FLOATP(srssq)) {
/* We may have lost too much precision, if i << r. The result is
going to be inexact, anyway, so switch to using expt. */
Scheme_Object *a[2];
Scheme_Object *a[2], *p;
a[0] = (Scheme_Object *)o;
a[1] = scheme_make_double(0.5);
#ifdef MZ_USE_SINGLE_FLOATS
if (SCHEME_FLTP(c->i))
p = scheme_make_float(0.5);
else
#endif
p = scheme_make_double(0.5);
a[1] = p;
return scheme_expt(2, a);
}

86
src/racket/src/number.c
View File

@ -183,7 +183,7 @@ READ_ONLY Scheme_Object *scheme_inf_object, *scheme_minus_inf_object, *scheme_na
READ_ONLY Scheme_Object *scheme_zerod, *scheme_nzerod, *scheme_pi, *scheme_half_pi, *scheme_plus_i, *scheme_minus_i;
#ifdef MZ_USE_SINGLE_FLOATS
READ_ONLY Scheme_Object *scheme_zerof, *scheme_nzerof, *scheme_single_pi;
READ_ONLY Scheme_Object *scheme_zerof, *scheme_nzerof, *scheme_single_pi, *scheme_single_half_pi;
READ_ONLY Scheme_Object *scheme_single_inf_object, *scheme_single_minus_inf_object, *scheme_single_nan_object;
#endif
@ -266,6 +266,7 @@ scheme_init_number (Scheme_Env *env)
REGISTER_SO(scheme_nzerod);
#ifdef MZ_USE_SINGLE_FLOATS
REGISTER_SO(scheme_single_pi);
REGISTER_SO(scheme_single_half_pi);
REGISTER_SO(scheme_zerof);
REGISTER_SO(scheme_nzerof);
#endif
@ -311,7 +312,8 @@ scheme_init_number (Scheme_Env *env)
#ifdef MZ_USE_SINGLE_FLOATS
scheme_zerof = scheme_make_float(0.0f);
scheme_nzerof = scheme_make_float(-0.0f);
scheme_single_pi = scheme_make_float((float)atan2(0.0, -1.0));
scheme_single_pi = scheme_make_float(SCHEME_DBL_VAL(scheme_pi));
scheme_single_half_pi = scheme_make_float(SCHEME_DBL_VAL(scheme_half_pi));
#endif
scheme_plus_i = scheme_make_complex(scheme_make_integer(0), scheme_make_integer(1));
scheme_minus_i = scheme_make_complex(scheme_make_integer(0), scheme_make_integer(-1));
@ -1699,11 +1701,7 @@ scheme_bin_gcd (const Scheme_Object *n1, const Scheme_Object *n2)
} else if (SCHEME_FLOATP(n1) || SCHEME_FLOATP(n2)) {
double i1, i2, a, b, r;
#ifdef MZ_USE_SINGLE_FLOATS
# ifdef USE_SINGLE_FLOATS_AS_DEFAULT
int was_single = !(SCHEME_DBLP(n1) || SCHEME_DBLP(n2));
# else
int was_single = (SCHEME_FLTP(n1) || SCHEME_FLTP(n2));
# endif
#endif
if (SCHEME_INTP(n1))
@ -2106,6 +2104,18 @@ static Scheme_Object *get_frac(char *name, int low_p,
return n;
}
#ifdef USE_SINGLE_FLOATS
XFORM_NONGCING static int complex_single_flonum_p(Scheme_Object *c)
{
Scheme_Complex *cb = (Scheme_Complex *)c;
if (SCHEME_FLTP(cb->r) || SCHEME_FLTP(cb->i))
return 1;
return 0;
}
#endif
static Scheme_Object *un_exp(Scheme_Object *o);
static Scheme_Object *un_log(Scheme_Object *o);
@ -2243,30 +2253,45 @@ static Scheme_Object *complex_acos(Scheme_Object *c)
&& (scheme_bin_gt(_scheme_complex_real_part(c), scheme_make_integer(1))
|| scheme_bin_lt(_scheme_complex_real_part(c), scheme_make_integer(-1)))) {
/* Make sure real part is 0 or pi */
if (scheme_is_negative(_scheme_complex_real_part(c)))
r = scheme_pi;
else
if (scheme_is_negative(_scheme_complex_real_part(c))) {
#ifdef MZ_USE_SINGLE_FLOATS
if (complex_single_flonum_p(c))
r = scheme_single_pi;
else
#endif
r = scheme_pi;
} else
r = scheme_make_integer(0);
return scheme_make_complex(r, scheme_bin_minus(scheme_make_integer(0),
_scheme_complex_imaginary_part(a)));
} else {
return scheme_bin_minus(scheme_half_pi, a);
#ifdef MZ_USE_SINGLE_FLOATS
if (complex_single_flonum_p(c))
r = scheme_single_half_pi;
else
#endif
r = scheme_half_pi;
return scheme_bin_minus(r, a);
}
}
static Scheme_Object *complex_atan(Scheme_Object *c)
{
Scheme_Object *one_half = NULL;
if (scheme_complex_eq(c, scheme_plus_i) || scheme_complex_eq(c, scheme_minus_i))
return scheme_minus_inf_object;
return scheme_bin_mult(scheme_plus_i,
scheme_bin_mult(
#ifdef USE_SINGLE_FLOATS_AS_DEFAULT
scheme_make_float(0.5)
#else
scheme_make_double(0.5)
/* select single versus complex: */
#ifdef MZ_USE_SINGLE_FLOATS
if (complex_single_flonum_p(c))
one_half = scheme_make_float(0.5);
else
#endif
,
one_half = scheme_make_double(0.5);
return scheme_bin_mult(scheme_plus_i,
scheme_bin_mult(one_half,
un_log(scheme_bin_div(scheme_bin_plus(scheme_plus_i, c),
scheme_bin_plus(scheme_plus_i,
scheme_bin_minus(zeroi, c))))));
@ -2357,13 +2382,12 @@ atan_prim (int argc, Scheme_Object *argv[])
double v;
Scheme_Object *n1;
#ifdef MZ_USE_SINGLE_FLOATS
int dbl = 0, sgl = 0;
# ifdef USE_SINGLE_FLOATS_AS_DEFAULT
int dbl = 0;
# define MZ_USE_SINGLE !dbl
# define MZ_USE_SINGLE !dbl
# else
int sgl = 0;
# define MZ_USE_SINGLE sgl == 2
#endif
# define MZ_USE_SINGLE (sgl && !dbl)
# endif
#endif
n1 = argv[0];
@ -2373,15 +2397,13 @@ atan_prim (int argc, Scheme_Object *argv[])
#ifdef MZ_USE_SINGLE_FLOATS
else if (SCHEME_FLTP(n1)) {
v = SCHEME_FLT_VAL(n1);
# ifndef USE_SINGLE_FLOATS_AS_DEFAULT
sgl++;
# endif
}
#endif
else if (SCHEME_DBLP(n1)) {
# ifdef USE_SINGLE_FLOATS_AS_DEFAULT
#ifdef MZ_USE_SINGLE_FLOATS
dbl++;
# endif
#endif
v = SCHEME_DBL_VAL(n1);
} else if (SCHEME_BIGNUMP(n1))
v = scheme_bignum_to_double(n1);
@ -2421,15 +2443,13 @@ atan_prim (int argc, Scheme_Object *argv[])
#ifdef MZ_USE_SINGLE_FLOATS
else if (SCHEME_FLTP(n2)) {
v2 = SCHEME_FLT_VAL(n2);
# ifndef USE_SINGLE_FLOATS_AS_DEFAULT
sgl++;
# endif
}
#endif
else if (SCHEME_DBLP(n2)) {
# ifdef USE_SINGLE_FLOATS_AS_DEFAULT
#ifdef MZ_USE_SINGLE_FLOATS
dbl++;
# endif
#endif
v2 = SCHEME_DBL_VAL(n2);
} else if (SCHEME_BIGNUMP(n2))
v2 = scheme_bignum_to_double(n2);
@ -2481,12 +2501,6 @@ atan_prim (int argc, Scheme_Object *argv[])
return zeroi;
v = SCH_ATAN(v);
#ifdef MZ_USE_SINGLE_FLOATS
# ifndef USE_SINGLE_FLOATS_AS_DEFAULT
sgl++; /* sgl needs to be 2 to return a single-precision result */
# endif
#endif
}
#ifdef MZ_USE_SINGLE_FLOATS