summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>2004-08-03 15:06:12 +0000
committerMarius Vollmer <mvo@zagadka.de>2004-08-03 15:06:12 +0000
commitd9a67fc441a066dbd352324b9b1a4a082d4ba818 (patch)
tree412f59d015fb7b090827ca886160462a416b9c5e
parent8672c728f0eac55444097c333fb4675eb6dde368 (diff)
downloadguile-d9a67fc441a066dbd352324b9b1a4a082d4ba818.tar.gz
(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.
-rw-r--r--libguile/convert.i.c2
-rw-r--r--libguile/eval.c24
-rw-r--r--libguile/filesys.c2
-rw-r--r--libguile/gh_data.c6
-rw-r--r--libguile/ramap.c12
-rw-r--r--libguile/random.c12
-rw-r--r--libguile/unif.c26
-rw-r--r--srfi/srfi-4.c2
8 files changed, 42 insertions, 44 deletions
diff --git a/libguile/convert.i.c b/libguile/convert.i.c
index f5f15891e..f0ba6ae54 100644
--- a/libguile/convert.i.c
+++ b/libguile/convert.i.c
@@ -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
diff --git a/libguile/eval.c b/libguile/eval.c
index 87cdccb03..18db8906c 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -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)));
diff --git a/libguile/filesys.c b/libguile/filesys.c
index dd2bec1fa..be8199a9b 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -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);
diff --git a/libguile/gh_data.c b/libguile/gh_data.c
index b0cab03cf..6bc67b4d8 100644
--- a/libguile/gh_data.c
+++ b/libguile/gh_data.c
@@ -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)
diff --git a/libguile/ramap.c b/libguile/ramap.c
index b85a3ae67..88ccb1603 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -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);
diff --git a/libguile/random.c b/libguile/random.c
index e98794ca4..991900af3 100644
--- a/libguile/random.c
+++ b/libguile/random.c
@@ -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
diff --git a/libguile/unif.c b/libguile/unif.c
index a81ec4643..475e353d6 100644
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -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:
diff --git a/srfi/srfi-4.c b/srfi/srfi-4.c
index 579c63dfc..2c4e119a3 100644
--- a/srfi/srfi-4.c
+++ b/srfi/srfi-4.c
@@ -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