mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-11 14:21:10 +02:00
Code Activity

More distinguished handling of real and complex values.

Browse source
This commit is contained in:
Dirk Herrmann 2000-05-10 12:34:43 +00:00
parent 7235ee58f5
commit eb42e2f03a
8 changed files with 52 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

14
libguile/ChangeLog
View file

@ -1,3 +1,17 @@
2000-05-10 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eq.c (scm_eqv_p): Separate handling of real and complex
values. Remove #ifdef SCM_BIGDIG #endif test.
* eval.c (SCM_CEVAL, SCM_APPLY), gh_data.c (gh_scm2floats,
gh_scm2doubles), hash.c (scm_hasher), ramap.c (scm_array_fill_int,
ramap_rp, scm_array_map_x), random.c (vector_scale,
vector_sum_squares), unif.c (scm_make_uve, scm_array_p,
scm_array_set_x): Use SCM_REAL_VALUE instead of SCM_REALPART if
the object is known to be real. Use SCM_COMPLEXP instead of
deprecated SCM_CPLXP. Use SCM_INEXACTP instead of deprecated
SCM_INEXP.
2000-05-10 Dirk Herrmann <D.Herrmann@tu-bs.de>
* numbers.c: No need to include unif.h.

13
libguile/eq.c
View file

@ -104,13 +104,14 @@ SCM_DEFINE1 (scm_eqv_p, "eqv?", scm_tc7_rpsubr,
}
if (SCM_NUMP (x))
{
# ifdef SCM_BIGDIG
if (SCM_BIGP (x))
if (SCM_BIGP (x)) {
return SCM_BOOL (0 == scm_bigcomp (x, y));
# endif
if (SCM_REALPART (x) != SCM_REALPART(y)) return SCM_BOOL_F;
if (SCM_CPLXP(x) && (SCM_IMAG(x) != SCM_IMAG(y))) return SCM_BOOL_F;
return SCM_BOOL_T;
} else if (SCM_SLOPPY_REALP (x)) {
return SCM_BOOL (SCM_REAL_VALUE (x) == SCM_REAL_VALUE (y));
} else { /* complex */
return SCM_BOOL (SCM_COMPLEX_REAL (x) == SCM_COMPLEX_REAL (y)
&& SCM_COMPLEX_IMAG (x) == SCM_COMPLEX_IMAG (y));
}
}
return SCM_BOOL_F;
}

4
libguile/eval.c
View file

@ -2739,7 +2739,7 @@ evapply:
SCM_ASRTGO (SCM_NIMP (t.arg1), floerr);
if (SCM_REALP (t.arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REALPART (t.arg1))));
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (t.arg1))));
}
#ifdef SCM_BIGDIG
if (SCM_BIGP (t.arg1))
@ -3335,7 +3335,7 @@ tail:
SCM_ASRTGO (SCM_NIMP (arg1), floerr);
if (SCM_REALP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REALPART (arg1))));
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
}
#ifdef SCM_BIGDIG
if (SCM_BIGP (arg1))

4
libguile/gh_data.c
View file

@ -422,7 +422,7 @@ gh_scm2floats (SCM obj, float *m)
else if (SCM_BIGP (val))
m[i] = scm_num2long (val, 0, 0);
else
m[i] = SCM_REALPART (val);
m[i] = SCM_REAL_VALUE (val);
}
break;
#ifdef HAVE_ARRAYS
@ -478,7 +478,7 @@ gh_scm2doubles (SCM obj, double *m)
else if (SCM_BIGP (val))
m[i] = scm_num2long (val, 0, 0);
else
m[i] = SCM_REALPART (val);
m[i] = SCM_REAL_VALUE (val);
}
break;
#ifdef HAVE_ARRAYS

2
libguile/hash.c
View file

@ -106,7 +106,7 @@ scm_hasher(SCM obj, unsigned long n, scm_sizet d)
return 263 % n;
case scm_tc16_real:
{
double r = SCM_REALPART(obj);
double r = SCM_REAL_VALUE(obj);
if (floor(r)==r) {
obj = scm_inexact_to_exact (obj);
if SCM_IMP(obj) return SCM_INUM(obj) % n;

21
libguile/ramap.c
View file

@ -585,7 +585,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
{ /* scope */
float f, *ve = (float *) SCM_VELTS (ra);
SCM_ASRTGO (SCM_REALP (fill), badarg2);
f = SCM_REALPART (fill);
f = SCM_REAL_VALUE (fill);
for (i = base; n--; i += inc)
ve[i] = f;
break;
@ -594,7 +594,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
{ /* scope */
double f, *ve = (double *) SCM_VELTS (ra);
SCM_ASRTGO (SCM_REALP (fill), badarg2);
f = SCM_REALPART (fill);
f = SCM_REAL_VALUE (fill);
for (i = base; n--; i += inc)
ve[i] = f;
break;
@ -603,9 +603,14 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore)
{ /* scope */
double fr, fi;
double (*ve)[2] = (double (*)[2]) SCM_VELTS (ra);
SCM_ASRTGO (SCM_INEXP (fill), badarg2);
fr = SCM_REALPART (fill);
fi = (SCM_CPLXP (fill) ? SCM_IMAG (fill) : 0.0);
SCM_ASRTGO (SCM_INEXACTP (fill), badarg2);
if (SCM_REALP (fill)) {
fr = SCM_REAL_VALUE (fill);
fi = 0.0;
} else {
fr = SCM_COMPLEX_REAL (fill);
fi = SCM_COMPLEX_IMAG (fill);
}
for (i = base; n--; i += inc)
{
ve[i][0] = fr;
@ -1365,8 +1370,8 @@ ramap_rp (SCM ra0,SCM proc,SCM ras)
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
if (SCM_BITVEC_REF (ra0, i0))
{
SCM_REAL (a1) = ((double *) SCM_VELTS (ra1))[i1];
SCM_REAL (a2) = ((double *) SCM_VELTS (ra2))[i2];
SCM_REAL_VALUE (a1) = ((double *) SCM_VELTS (ra1))[i1];
SCM_REAL_VALUE (a2) = ((double *) SCM_VELTS (ra2))[i2];
if (SCM_FALSEP (SCM_SUBRF (proc) (a1, a2)))
SCM_BITVEC_CLR (ra0, i0);
}
@ -1550,7 +1555,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
if (SCM_INUMP(fill))
{
prot = scm_array_prototype (ra0);
if (SCM_INEXP (prot))
if (SCM_INEXACTP (prot))
fill = scm_make_real ((double) SCM_INUM (fill));
}

4
libguile/random.c
View file

@ -447,7 +447,7 @@ vector_scale (SCM v, double c)
int n = SCM_LENGTH (v);
if (SCM_VECTORP (v))
while (--n >= 0)
SCM_REAL (SCM_VELTS (v)[n]) *= c;
SCM_REAL_VALUE (SCM_VELTS (v)[n]) *= c;
else
while (--n >= 0)
((double *) SCM_VELTS (v))[n] *= c;
@ -461,7 +461,7 @@ vector_sum_squares (SCM v)
if (SCM_VECTORP (v))
while (--n >= 0)
{
x = SCM_REAL (SCM_VELTS (v)[n]);
x = SCM_REAL_VALUE (SCM_VELTS (v)[n]);
sum += x * x;
}
else

17
libguile/unif.c
View file

@ -202,7 +202,7 @@ scm_make_uve (long k, SCM prot)
}
}
else
if (SCM_IMP (prot) || !SCM_INEXP (prot))
if (SCM_IMP (prot) || !SCM_INEXACTP (prot))
/* Huge non-unif vectors are NOT supported. */
/* no special scm_vector */
return scm_make_vector (SCM_MAKINUM (k), SCM_UNDEFINED);
@ -211,7 +211,7 @@ scm_make_uve (long k, SCM prot)
i = sizeof (float) * k;
type = scm_tc7_fvect;
}
else if (SCM_CPLXP (prot))
else if (SCM_COMPLEXP (prot))
{
i = 2 * sizeof (double) * k;
type = scm_tc7_cvect;
@ -318,7 +318,7 @@ SCM_DEFINE (scm_array_p, "array?", 1, 1, 0,
case scm_tc7_dvect:
protp = SCM_REALP(prot);
case scm_tc7_cvect:
protp = SCM_CPLXP(prot);
protp = SCM_COMPLEXP(prot);
case scm_tc7_vector:
case scm_tc7_wvect:
protp = SCM_NULLP(prot);
@ -1332,9 +1332,14 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
((double *) SCM_CELL_WORD_1 (v))[pos] = scm_num2dbl (obj, FUNC_NAME);
break;
case scm_tc7_cvect:
SCM_ASRTGO (SCM_INEXP (obj), badobj);
((double *) SCM_CELL_WORD_1 (v))[2 * pos] = SCM_REALPART (obj);
((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1] = SCM_CPLXP (obj) ? SCM_IMAG (obj) : 0.0;
SCM_ASRTGO (SCM_INEXACTP (obj), badobj);
if (SCM_REALP (obj)) {
((double *) SCM_CELL_WORD_1 (v))[2 * pos] = SCM_REAL_VALUE (obj);
((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1] = 0.0;
} else {
((double *) SCM_CELL_WORD_1 (v))[2 * pos] = SCM_COMPLEX_REAL (obj);
((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1] = SCM_COMPLEX_IMAG (obj);
}
break;
case scm_tc7_vector:
case scm_tc7_wvect: