1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-20 02:30:23 +02:00

(scm_make_real, scm_num2dbl, scm_float2num, scm_double2num):

Discouraged by moving to discouraged.h and discouraged.c.
Replaced all uses with scm_from_double.
(scm_num2float, scm_num2double): Discouraged by moving prototype
to discouraged.h and rewriting in terms of scm_to_double.
Replaced all uses with scm_to_double.
This commit is contained in:
Marius Vollmer 2004-08-03 15:06:12 +00:00
parent 8672c728f0
commit d9a67fc441
8 changed files with 42 additions and 44 deletions

View file

@ -253,7 +253,7 @@ CTYPES2SCM (const CTYPE *data, long n)
for (i = 0; i < n; i++)
#ifdef FLOATTYPE
SCM_VECTOR_SET (v, i, scm_make_real ((double) data[i]));
SCM_VECTOR_SET (v, i, scm_from_double ((double) data[i]));
#else
SCM_VECTOR_SET (v, i, scm_from_signed_integer (data[i]));
#endif

View file

@ -4145,19 +4145,19 @@ dispatch:
case scm_tc7_dsubr:
if (SCM_I_INUMP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1))));
}
else if (SCM_REALP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
}
else if (SCM_BIGP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
}
else if (SCM_FRACTIONP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
}
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
@ -4832,19 +4832,19 @@ tail:
scm_wrong_num_args (proc);
if (SCM_I_INUMP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1))));
}
else if (SCM_REALP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
}
else if (SCM_BIGP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
}
else if (SCM_FRACTIONP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
}
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
@ -5184,19 +5184,19 @@ call_dsubr_1 (SCM proc, SCM arg1)
{
if (SCM_I_INUMP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1))));
}
else if (SCM_REALP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
}
else if (SCM_BIGP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
}
else if (SCM_FRACTIONP (arg1))
{
RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
RETURN (scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1))));
}
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));

View file

@ -1217,7 +1217,7 @@ SCM_DEFINE (scm_select, "select", 3, 2, 0,
}
else
{
double fl = scm_num2dbl (secs, FUNC_NAME);
double fl = scm_to_double (secs);
if (!SCM_UNBNDP (usecs))
SCM_WRONG_TYPE_ARG (4, secs);

View file

@ -51,7 +51,7 @@ gh_long2scm (long x)
SCM
gh_double2scm (double x)
{
return scm_make_real (x);
return scm_from_double (x);
}
SCM
gh_char2scm (char c)
@ -115,7 +115,7 @@ gh_doubles2scm (const double *d, long n)
SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
for(i = 0; i < n; i++)
SCM_VECTOR_SET (v, i, scm_make_real (d[i]));
SCM_VECTOR_SET (v, i, scm_from_double (d[i]));
return v;
}
@ -202,7 +202,7 @@ gh_scm2int (SCM obj)
double
gh_scm2double (SCM obj)
{
return scm_num2dbl (obj, "gh_scm2double");
return scm_to_double (obj);
}
char
gh_scm2char (SCM obj)

View file

@ -564,7 +564,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
case scm_tc7_fvect:
{ /* scope */
float f, *ve = (float *) SCM_VELTS (ra);
f = (float) scm_num2dbl (fill, FUNC_NAME);
f = (float) scm_to_double (fill);
for (i = base; n--; i += inc)
ve[i] = f;
break;
@ -572,7 +572,7 @@ scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
case scm_tc7_dvect:
{ /* scope */
double f, *ve = (double *) SCM_VELTS (ra);
f = scm_num2dbl (fill, FUNC_NAME);
f = scm_to_double (fill);
for (i = base; n--; i += inc)
ve[i] = f;
break;
@ -1342,7 +1342,7 @@ ramap_rp (SCM ra0, SCM proc, SCM ras)
break;
case scm_tc7_fvect:
{
SCM a1 = scm_make_real (1.0), a2 = scm_make_real (1.0);
SCM a1 = scm_from_double (1.0), a2 = scm_from_double (1.0);
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
if (SCM_BITVEC_REF (ra0, i0))
{
@ -1355,8 +1355,8 @@ ramap_rp (SCM ra0, SCM proc, SCM ras)
}
case scm_tc7_dvect:
{
SCM a1 = scm_make_real (1.0 / 3.0);
SCM a2 = scm_make_real (1.0 / 3.0);
SCM a1 = scm_from_double (1.0 / 3.0);
SCM a2 = scm_from_double (1.0 / 3.0);
for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
if (SCM_BITVEC_REF (ra0, i0))
{
@ -1545,7 +1545,7 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
{
prot = scm_array_prototype (ra0);
if (SCM_INEXACTP (prot))
fill = scm_make_real ((double) SCM_I_INUM (fill));
fill = scm_from_double ((double) SCM_I_INUM (fill));
}
scm_array_fill_x (ra0, fill);

View file

@ -357,8 +357,8 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
}
SCM_VALIDATE_NIM (1, n);
if (SCM_REALP (n))
return scm_make_real (SCM_REAL_VALUE (n)
* scm_c_uniform01 (SCM_RSTATE (state)));
return scm_from_double (SCM_REAL_VALUE (n)
* scm_c_uniform01 (SCM_RSTATE (state)));
if (!SCM_BIGP (n))
SCM_WRONG_TYPE_ARG (1, n);
@ -400,7 +400,7 @@ SCM_DEFINE (scm_random_uniform, "random:uniform", 0, 1, 0,
if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (1, state);
return scm_make_real (scm_c_uniform01 (SCM_RSTATE (state)));
return scm_from_double (scm_c_uniform01 (SCM_RSTATE (state)));
}
#undef FUNC_NAME
@ -415,7 +415,7 @@ SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0,
if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (1, state);
return scm_make_real (scm_c_normal01 (SCM_RSTATE (state)));
return scm_from_double (scm_c_normal01 (SCM_RSTATE (state)));
}
#undef FUNC_NAME
@ -517,7 +517,7 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0,
n = scm_to_int (scm_uniform_vector_length (v));
if (SCM_VECTORP (v))
while (--n >= 0)
SCM_VECTOR_SET (v, n, scm_make_real (scm_c_normal01 (SCM_RSTATE (state))));
SCM_VECTOR_SET (v, n, scm_from_double (scm_c_normal01 (SCM_RSTATE (state))));
else
while (--n >= 0)
((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state));
@ -537,7 +537,7 @@ SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0,
if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (1, state);
return scm_make_real (scm_c_exp1 (SCM_RSTATE (state)));
return scm_from_double (scm_c_exp1 (SCM_RSTATE (state)));
}
#undef FUNC_NAME

View file

@ -1125,9 +1125,9 @@ SCM_DEFINE (scm_uniform_vector_ref, "uniform-vector-ref", 2, 0, 0,
#endif
case scm_tc7_fvect:
return scm_make_real (((float *) SCM_CELL_WORD_1 (v))[pos]);
return scm_from_double (((float *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_dvect:
return scm_make_real (((double *) SCM_CELL_WORD_1 (v))[pos]);
return scm_from_double (((double *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_cvect:
return scm_make_complex (((double *) SCM_CELL_WORD_1 (v))[2 * pos],
((double *) SCM_CELL_WORD_1 (v))[2 * pos + 1]);
@ -1174,14 +1174,14 @@ scm_cvref (SCM v, unsigned long pos, SCM last)
SCM_REAL_VALUE (last) = ((float *) SCM_CELL_WORD_1 (v))[pos];
return last;
}
return scm_make_real (((float *) SCM_CELL_WORD_1 (v))[pos]);
return scm_from_double (((float *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_dvect:
if (SCM_REALP (last) && !scm_is_eq (last, scm_flo0))
{
SCM_REAL_VALUE (last) = ((double *) SCM_CELL_WORD_1 (v))[pos];
return last;
}
return scm_make_real (((double *) SCM_CELL_WORD_1 (v))[pos]);
return scm_from_double (((double *) SCM_CELL_WORD_1 (v))[pos]);
case scm_tc7_cvect:
if (SCM_COMPLEXP (last))
{
@ -1291,12 +1291,10 @@ SCM_DEFINE (scm_array_set_x, "array-set!", 2, 0, 1,
break;
#endif
case scm_tc7_fvect:
((float *) SCM_UVECTOR_BASE (v))[pos]
= (float) scm_num2dbl (obj, FUNC_NAME);
((float *) SCM_UVECTOR_BASE (v))[pos] = scm_to_double (obj);
break;
case scm_tc7_dvect:
((double *) SCM_UVECTOR_BASE (v))[pos]
= scm_num2dbl (obj, FUNC_NAME);
((double *) SCM_UVECTOR_BASE (v))[pos] = scm_to_double (obj);
break;
case scm_tc7_cvect:
SCM_ASRTGO (SCM_INEXACTP (obj), badobj);
@ -2149,14 +2147,14 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
{
float *data = (float *) SCM_VELTS (v);
for (k = SCM_UVECTOR_LENGTH (v) - 1; k >= 0; k--)
res = scm_cons (scm_make_real (data[k]), res);
res = scm_cons (scm_from_double (data[k]), res);
return res;
}
case scm_tc7_dvect:
{
double *data = (double *) SCM_VELTS (v);
for (k = SCM_UVECTOR_LENGTH (v) - 1; k >= 0; k--)
res = scm_cons (scm_make_real (data[k]), res);
res = scm_cons (scm_from_double (data[k]), res);
return res;
}
case scm_tc7_cvect:
@ -2383,7 +2381,7 @@ tail:
case scm_tc7_fvect:
if (n-- > 0)
{
SCM z = scm_make_real (1.0);
SCM z = scm_from_double (1.0);
SCM_REAL_VALUE (z) = ((float *) SCM_VELTS (ra))[j];
scm_print_real (z, port, pstate);
for (j += inc; n-- > 0; j += inc)
@ -2397,7 +2395,7 @@ tail:
case scm_tc7_dvect:
if (n-- > 0)
{
SCM z = scm_make_real (1.0 / 3.0);
SCM z = scm_from_double (1.0 / 3.0);
SCM_REAL_VALUE (z) = ((double *) SCM_VELTS (ra))[j];
scm_print_real (z, port, pstate);
for (j += inc; n-- > 0; j += inc)
@ -2411,7 +2409,7 @@ tail:
case scm_tc7_cvect:
if (n-- > 0)
{
SCM cz = scm_make_complex (0.0, 1.0), z = scm_make_real (1.0 / 3.0);
SCM cz = scm_make_complex (0.0, 1.0), z = scm_from_double (1.0/3.0);
SCM_REAL_VALUE (z) =
SCM_COMPLEX_REAL (cz) = ((double *) SCM_VELTS (ra))[2 * j];
SCM_COMPLEX_IMAG (cz) = ((double *) SCM_VELTS (ra))[2 * j + 1];
@ -2566,7 +2564,7 @@ loop:
return scm_str2symbol ("l");
#endif
case scm_tc7_fvect:
return scm_make_real (1.0);
return scm_from_double (1.0);
case scm_tc7_dvect:
return exactly_one_third;
case scm_tc7_cvect:

View file

@ -1710,7 +1710,7 @@ SCM_DEFINE (scm_f64vector_ref, "f64vector-ref", 2, 0, 0,
scm_wrong_type_arg (FUNC_NAME, 1, uvec);
idx = scm_to_unsigned_integer (index, 0, SCM_UVEC_LENGTH (uvec)-1);
return scm_make_real (((float_f64 *) SCM_UVEC_BASE (uvec))[idx]);
return scm_from_double (((float_f64 *) SCM_UVEC_BASE (uvec))[idx]);
}
#undef FUNC_NAME