diff options
author | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-05-10 12:34:43 +0000 |
---|---|---|
committer | Dirk Herrmann <dirk@dirk-herrmanns-seiten.de> | 2000-05-10 12:34:43 +0000 |
commit | eb42e2f03acb86f9a0cc0c75cdd2e2ed8d19b004 (patch) | |
tree | c1c4d1404d48a4b232631b435d5ec8c2e6ef4780 /libguile/unif.c | |
parent | 7235ee58f5dbe7c3971a3553bbdc1027f3d41b54 (diff) | |
download | guile-eb42e2f03acb86f9a0cc0c75cdd2e2ed8d19b004.tar.gz |
More distinguished handling of real and complex values.
Diffstat (limited to 'libguile/unif.c')
-rw-r--r-- | libguile/unif.c | 17 |
1 files changed, 11 insertions, 6 deletions
diff --git a/libguile/unif.c b/libguile/unif.c index 5616dd155..688e26e8d 100644 --- a/libguile/unif.c +++ b/libguile/unif.c @@ -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: |