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

(scm_make_real, scm_num2dbl, scm_float2num, scm_double2num):

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

2
libguile/convert.i.c
View file

@ -253,7 +253,7 @@ CTYPES2SCM (const CTYPE *data, long n)
for (i = 0; i < n; i++) for (i = 0; i < n; i++)
#ifdef FLOATTYPE #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 #else
SCM_VECTOR_SET (v, i, scm_from_signed_integer (data[i])); SCM_VECTOR_SET (v, i, scm_from_signed_integer (data[i]));
#endif #endif

24
libguile/eval.c
View file

@ -4145,19 +4145,19 @@ dispatch:
case scm_tc7_dsubr: case scm_tc7_dsubr:
if (SCM_I_INUMP (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)) 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)) 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)) 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_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc))); SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
@ -4832,19 +4832,19 @@ tail:
scm_wrong_num_args (proc); scm_wrong_num_args (proc);
if (SCM_I_INUMP (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)) 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)) 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)) 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_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc))); SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
@ -5184,19 +5184,19 @@ call_dsubr_1 (SCM proc, SCM arg1)
{ {
if (SCM_I_INUMP (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)) 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)) 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)) 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_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc))); SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));

2
libguile/filesys.c
View file

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

6
libguile/gh_data.c
View file

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

12
libguile/ramap.c
View file

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

10
libguile/random.c
View file

@ -357,7 +357,7 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
} }
SCM_VALIDATE_NIM (1, n); SCM_VALIDATE_NIM (1, n);
if (SCM_REALP (n)) if (SCM_REALP (n))
return scm_make_real (SCM_REAL_VALUE (n) return scm_from_double (SCM_REAL_VALUE (n)
* scm_c_uniform01 (SCM_RSTATE (state))); * scm_c_uniform01 (SCM_RSTATE (state)));
if (!SCM_BIGP (n)) if (!SCM_BIGP (n))
@ -400,7 +400,7 @@ SCM_DEFINE (scm_random_uniform, "random:uniform", 0, 1, 0,
if (SCM_UNBNDP (state)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_state); state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (1, 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 #undef FUNC_NAME
@ -415,7 +415,7 @@ SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0,
if (SCM_UNBNDP (state)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_state); state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (1, 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 #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)); n = scm_to_int (scm_uniform_vector_length (v));
if (SCM_VECTORP (v)) if (SCM_VECTORP (v))
while (--n >= 0) 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 else
while (--n >= 0) while (--n >= 0)
((double *) SCM_VELTS (v))[n] = scm_c_normal01 (SCM_RSTATE (state)); ((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)) if (SCM_UNBNDP (state))
state = SCM_VARIABLE_REF (scm_var_random_state); state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (1, 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 #undef FUNC_NAME

26
libguile/unif.c
View file

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

2
srfi/srfi-4.c
View file

@ -1710,7 +1710,7 @@ SCM_DEFINE (scm_f64vector_ref, "f64vector-ref", 2, 0, 0,
scm_wrong_type_arg (FUNC_NAME, 1, uvec); scm_wrong_type_arg (FUNC_NAME, 1, uvec);
idx = scm_to_unsigned_integer (index, 0, SCM_UVEC_LENGTH (uvec)-1); 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 #undef FUNC_NAME