HCoop
/
bpt
/
guile.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
* gc.c, tags.h: Doc fixes.
[bpt/guile.git]
/
libguile
/
unif.c
diff --git
a/libguile/unif.c
b/libguile/unif.c
index
1650e46
..
9a67595
100644
(file)
--- a/
libguile/unif.c
+++ b/
libguile/unif.c
@@
-46,7
+46,6
@@
#include "eval.h"
#include "genio.h"
#include "smob.h"
#include "eval.h"
#include "genio.h"
#include "smob.h"
-#include "sequences.h"
#include "strop.h"
#include "feature.h"
#include "strop.h"
#include "feature.h"
@@
-100,7
+99,6
@@
scm_vector_set_length_x (vect, len)
default:
badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
case scm_tc7_string:
default:
badarg1: scm_wta (vect, (char *) SCM_ARG1, s_vector_set_length_x);
case scm_tc7_string:
- case scm_tc7_mb_string:
SCM_ASRTGO (vect != scm_nullstr, badarg1);
sz = sizeof (char);
l++;
SCM_ASRTGO (vect != scm_nullstr, badarg1);
sz = sizeof (char);
l++;
@@
-536,18
+534,21
@@
scm_shap2ra (args, what)
if (SCM_IMP (spec))
{
if (SCM_IMP (spec))
{
- SCM_ASSERT (SCM_INUMP (spec) && SCM_INUM (spec) >= 0, spec, s_bad_spec, what);
+ SCM_ASSERT (SCM_INUMP (spec) && SCM_INUM (spec) >= 0, spec,
+ s_bad_spec, what);
s->lbnd = 0;
s->ubnd = SCM_INUM (spec) - 1;
s->inc = 1;
}
else
{
s->lbnd = 0;
s->ubnd = SCM_INUM (spec) - 1;
s->inc = 1;
}
else
{
- SCM_ASSERT (SCM_CONSP (spec) && SCM_INUMP (SCM_CAR (spec)), spec, s_bad_spec, what);
+ SCM_ASSERT (SCM_CONSP (spec) && SCM_INUMP (SCM_CAR (spec)), spec,
+ s_bad_spec, what);
s->lbnd = SCM_INUM (SCM_CAR (spec));
sp = SCM_CDR (spec);
s->lbnd = SCM_INUM (SCM_CAR (spec));
sp = SCM_CDR (spec);
- SCM_ASSERT (SCM_INUMP (SCM_CAR (sp)) && SCM_NULLP (SCM_CDR (sp)),
- spec, s_bad_spec, what);
+ SCM_ASSERT (SCM_NIMP (sp) && SCM_CONSP (sp)
+ && SCM_INUMP (SCM_CAR (sp)) && SCM_NULLP (SCM_CDR (sp)),
+ spec, s_bad_spec, what);
s->ubnd = SCM_INUM (SCM_CAR (sp));
s->inc = 1;
}
s->ubnd = SCM_INUM (SCM_CAR (sp));
s->inc = 1;
}
@@
-722,7
+723,7
@@
scm_make_shared_array (oldra, mapfunc, dims)
return ra;
}
}
return ra;
}
}
- imap = scm_apply (mapfunc, scm_
list_
reverse (inds), SCM_EOL);
+ imap = scm_apply (mapfunc, scm_reverse (inds), SCM_EOL);
if (SCM_ARRAYP (oldra))
i = (scm_sizet) scm_aind (oldra, imap, s_make_shared_array);
else
if (SCM_ARRAYP (oldra))
i = (scm_sizet) scm_aind (oldra, imap, s_make_shared_array);
else
@@
-802,7
+803,7
@@
scm_transpose_array (args)
switch (SCM_TYP7 (ra))
{
default:
switch (SCM_TYP7 (ra))
{
default:
- badarg:scm_wta (ra, (char *) SCM_ARG
n
, s_transpose_array);
+ badarg:scm_wta (ra, (char *) SCM_ARG
1
, s_transpose_array);
case scm_tc7_bvect:
case scm_tc7_string:
case scm_tc7_byvect:
case scm_tc7_bvect:
case scm_tc7_string:
case scm_tc7_byvect:
@@
-831,9
+832,11
@@
scm_transpose_array (args)
ndim = 0;
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
{
ndim = 0;
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
{
+ SCM_ASSERT (SCM_INUMP (ve[k]), ve[k], (SCM_ARG2 + k),
+ s_transpose_array);
i = SCM_INUM (ve[k]);
i = SCM_INUM (ve[k]);
- SCM_ASSERT (
SCM_INUMP (ve[k]) && i >= 0 && i < SCM_ARRAY_NDIM (ra)
,
-
ve[k], SCM_ARG2
, s_transpose_array);
+ SCM_ASSERT (
i >= 0 && i < SCM_ARRAY_NDIM (ra), ve[k]
,
+
SCM_OUTOFRANGE
, s_transpose_array);
if (ndim < i)
ndim = i;
}
if (ndim < i)
ndim = i;
}
@@
-870,7
+873,7
@@
scm_transpose_array (args)
r->inc += s->inc;
}
}
r->inc += s->inc;
}
}
- SCM_ASSERT (ndim <= 0, args, "bad argument
scm_
list", s_transpose_array);
+ SCM_ASSERT (ndim <= 0, args, "bad argument list", s_transpose_array);
scm_ra_set_contp (res);
return res;
}
scm_ra_set_contp (res);
return res;
}
@@
-1585,6
+1588,8
@@
scm_uniform_array_write (v, port_or_fd, start, end)
long cstart = 0;
long cend;
long cstart = 0;
long cend;
+ port_or_fd = SCM_COERCE_OUTPORT (port_or_fd);
+
SCM_ASRTGO (SCM_NIMP (v), badarg1);
if (SCM_UNBNDP (port_or_fd))
port_or_fd = scm_cur_outp;
SCM_ASRTGO (SCM_NIMP (v), badarg1);
if (SCM_UNBNDP (port_or_fd))
port_or_fd = scm_cur_outp;
@@
-2109,7
+2114,7
@@
scm_array_to_list (v)
}
}
-static char s_bad_ralst[] = "Bad scm_array contents
scm_
list";
+static char s_bad_ralst[] = "Bad scm_array contents list";
static int l2ra SCM_P ((SCM lst, SCM ra, scm_sizet base, scm_sizet k));
static int l2ra SCM_P ((SCM lst, SCM ra, scm_sizet base, scm_sizet k));
@@
-2224,7
+2229,7
@@
tail:
scm_iprin1 (ra, port, pstate);
for (j += inc; n-- > 0; j += inc)
{
scm_iprin1 (ra, port, pstate);
for (j += inc; n-- > 0; j += inc)
{
- scm_
gen_
putc (' ', port);
+ scm_putc (' ', port);
SCM_ARRAY_BASE (ra) = j;
scm_iprin1 (ra, port, pstate);
}
SCM_ARRAY_BASE (ra) = j;
scm_iprin1 (ra, port, pstate);
}
@@
-2236,16
+2241,16
@@
tail:
inc = SCM_ARRAY_DIMS (ra)[k].inc;
for (i = SCM_ARRAY_DIMS (ra)[k].lbnd; i < SCM_ARRAY_DIMS (ra)[k].ubnd; i++)
{
inc = SCM_ARRAY_DIMS (ra)[k].inc;
for (i = SCM_ARRAY_DIMS (ra)[k].lbnd; i < SCM_ARRAY_DIMS (ra)[k].ubnd; i++)
{
- scm_
gen_
putc ('(', port);
+ scm_putc ('(', port);
rapr1 (ra, j, k + 1, port, pstate);
rapr1 (ra, j, k + 1, port, pstate);
- scm_
gen_puts (scm_regular_string,
") ", port);
+ scm_
puts (
") ", port);
j += inc;
}
if (i == SCM_ARRAY_DIMS (ra)[k].ubnd)
{ /* could be zero size. */
j += inc;
}
if (i == SCM_ARRAY_DIMS (ra)[k].ubnd)
{ /* could be zero size. */
- scm_
gen_
putc ('(', port);
+ scm_putc ('(', port);
rapr1 (ra, j, k + 1, port, pstate);
rapr1 (ra, j, k + 1, port, pstate);
- scm_
gen_
putc (')', port);
+ scm_putc (')', port);
}
break;
}
}
break;
}
@@
-2264,7
+2269,7
@@
tail:
scm_iprin1 (scm_uniform_vector_ref (ra, SCM_MAKINUM (j)), port, pstate);
for (j += inc; n-- > 0; j += inc)
{
scm_iprin1 (scm_uniform_vector_ref (ra, SCM_MAKINUM (j)), port, pstate);
for (j += inc; n-- > 0; j += inc)
{
- scm_
gen_
putc (' ', port);
+ scm_putc (' ', port);
scm_iprin1 (scm_cvref (ra, j, SCM_UNDEFINED), port, pstate);
}
break;
scm_iprin1 (scm_cvref (ra, j, SCM_UNDEFINED), port, pstate);
}
break;
@@
-2274,19
+2279,19
@@
tail:
if (SCM_WRITINGP (pstate))
for (j += inc; n-- > 0; j += inc)
{
if (SCM_WRITINGP (pstate))
for (j += inc; n-- > 0; j += inc)
{
- scm_
gen_
putc (' ', port);
+ scm_putc (' ', port);
scm_iprin1 (SCM_MAKICHR (SCM_CHARS (ra)[j]), port, pstate);
}
else
for (j += inc; n-- > 0; j += inc)
scm_iprin1 (SCM_MAKICHR (SCM_CHARS (ra)[j]), port, pstate);
}
else
for (j += inc; n-- > 0; j += inc)
- scm_
gen_
putc (SCM_CHARS (ra)[j], port);
+ scm_putc (SCM_CHARS (ra)[j], port);
break;
case scm_tc7_byvect:
if (n-- > 0)
scm_intprint (((char *)SCM_CDR (ra))[j], 10, port);
for (j += inc; n-- > 0; j += inc)
{
break;
case scm_tc7_byvect:
if (n-- > 0)
scm_intprint (((char *)SCM_CDR (ra))[j], 10, port);
for (j += inc; n-- > 0; j += inc)
{
- scm_
gen_
putc (' ', port);
+ scm_putc (' ', port);
scm_intprint (((char *)SCM_CDR (ra))[j], 10, port);
}
break;
scm_intprint (((char *)SCM_CDR (ra))[j], 10, port);
}
break;
@@
-2297,7
+2302,7
@@
tail:
scm_intprint (SCM_VELTS (ra)[j], 10, port);
for (j += inc; n-- > 0; j += inc)
{
scm_intprint (SCM_VELTS (ra)[j], 10, port);
for (j += inc; n-- > 0; j += inc)
{
- scm_
gen_
putc (' ', port);
+ scm_putc (' ', port);
scm_intprint (SCM_VELTS (ra)[j], 10, port);
}
break;
scm_intprint (SCM_VELTS (ra)[j], 10, port);
}
break;
@@
-2307,7
+2312,7
@@
tail:
scm_intprint (((short *)SCM_CDR (ra))[j], 10, port);
for (j += inc; n-- > 0; j += inc)
{
scm_intprint (((short *)SCM_CDR (ra))[j], 10, port);
for (j += inc; n-- > 0; j += inc)
{
- scm_
gen_
putc (' ', port);
+ scm_putc (' ', port);
scm_intprint (((short *)SCM_CDR (ra))[j], 10, port);
}
break;
scm_intprint (((short *)SCM_CDR (ra))[j], 10, port);
}
break;
@@
-2322,7
+2327,7
@@
tail:
scm_floprint (z, port, pstate);
for (j += inc; n-- > 0; j += inc)
{
scm_floprint (z, port, pstate);
for (j += inc; n-- > 0; j += inc)
{
- scm_
gen_
putc (' ', port);
+ scm_putc (' ', port);
SCM_FLO (z) = ((float *) SCM_VELTS (ra))[j];
scm_floprint (z, port, pstate);
}
SCM_FLO (z) = ((float *) SCM_VELTS (ra))[j];
scm_floprint (z, port, pstate);
}
@@
-2337,7
+2342,7
@@
tail:
scm_floprint (z, port, pstate);
for (j += inc; n-- > 0; j += inc)
{
scm_floprint (z, port, pstate);
for (j += inc; n-- > 0; j += inc)
{
- scm_
gen_
putc (' ', port);
+ scm_putc (' ', port);
SCM_REAL (z) = ((double *) SCM_VELTS (ra))[j];
scm_floprint (z, port, pstate);
}
SCM_REAL (z) = ((double *) SCM_VELTS (ra))[j];
scm_floprint (z, port, pstate);
}
@@
-2352,7
+2357,7
@@
tail:
scm_floprint ((0.0 == SCM_IMAG (cz) ? z : cz), port, pstate);
for (j += inc; n-- > 0; j += inc)
{
scm_floprint ((0.0 == SCM_IMAG (cz) ? z : cz), port, pstate);
for (j += inc; n-- > 0; j += inc)
{
- scm_
gen_
putc (' ', port);
+ scm_putc (' ', port);
SCM_REAL (z) = SCM_REAL (cz) = ((double *) SCM_VELTS (ra))[2 * j];
SCM_IMAG (cz) = ((double *) SCM_VELTS (ra))[2 * j + 1];
scm_floprint ((0.0 == SCM_IMAG (cz) ? z : cz), port, pstate);
SCM_REAL (z) = SCM_REAL (cz) = ((double *) SCM_VELTS (ra))[2 * j];
SCM_IMAG (cz) = ((double *) SCM_VELTS (ra))[2 * j + 1];
scm_floprint ((0.0 == SCM_IMAG (cz) ? z : cz), port, pstate);
@@
-2373,7
+2378,7
@@
scm_raprin1 (exp, port, pstate)
{
SCM v = exp;
scm_sizet base = 0;
{
SCM v = exp;
scm_sizet base = 0;
- scm_
gen_
putc ('#', port);
+ scm_putc ('#', port);
tail:
switch SCM_TYP7
(v)
tail:
switch SCM_TYP7
(v)
@@
-2386,9
+2391,9
@@
tail:
if (SCM_ARRAYP (v))
{
if (SCM_ARRAYP (v))
{
- scm_
gen_puts (scm_regular_string,
"<enclosed-array ", port);
+ scm_
puts (
"<enclosed-array ", port);
rapr1 (exp, base, 0, port, pstate);
rapr1 (exp, base, 0, port, pstate);
- scm_
gen_
putc ('>', port);
+ scm_putc ('>', port);
return 1;
}
else
return 1;
}
else
@@
-2401,13
+2406,13
@@
tail:
if (exp == v)
{ /* a uve, not an scm_array */
register long i, j, w;
if (exp == v)
{ /* a uve, not an scm_array */
register long i, j, w;
- scm_
gen_
putc ('*', port);
+ scm_putc ('*', port);
for (i = 0; i < (SCM_LENGTH (exp)) / SCM_LONG_BIT; i++)
{
w = SCM_VELTS (exp)[i];
for (j = SCM_LONG_BIT; j; j--)
{
for (i = 0; i < (SCM_LENGTH (exp)) / SCM_LONG_BIT; i++)
{
w = SCM_VELTS (exp)[i];
for (j = SCM_LONG_BIT; j; j--)
{
- scm_
gen_
putc (w & 1 ? '1' : '0', port);
+ scm_putc (w & 1 ? '1' : '0', port);
w >>= 1;
}
}
w >>= 1;
}
}
@@
-2417,52
+2422,52
@@
tail:
w = SCM_VELTS (exp)[SCM_LENGTH (exp) / SCM_LONG_BIT];
for (; j; j--)
{
w = SCM_VELTS (exp)[SCM_LENGTH (exp) / SCM_LONG_BIT];
for (; j; j--)
{
- scm_
gen_
putc (w & 1 ? '1' : '0', port);
+ scm_putc (w & 1 ? '1' : '0', port);
w >>= 1;
}
}
return 1;
}
else
w >>= 1;
}
}
return 1;
}
else
- scm_
gen_
putc ('b', port);
+ scm_putc ('b', port);
break;
case scm_tc7_string:
break;
case scm_tc7_string:
- scm_
gen_
putc ('a', port);
+ scm_putc ('a', port);
break;
case scm_tc7_byvect:
break;
case scm_tc7_byvect:
- scm_
gen_puts (scm_regular_string,
"bytes", port);
+ scm_
puts (
"bytes", port);
break;
case scm_tc7_uvect:
break;
case scm_tc7_uvect:
- scm_
gen_
putc ('u', port);
+ scm_putc ('u', port);
break;
case scm_tc7_ivect:
break;
case scm_tc7_ivect:
- scm_
gen_
putc ('e', port);
+ scm_putc ('e', port);
break;
case scm_tc7_svect:
break;
case scm_tc7_svect:
- scm_
gen_puts (scm_regular_string,
"short", port);
+ scm_
puts (
"short", port);
break;
#ifdef LONGLONGS
case scm_tc7_llvect:
break;
#ifdef LONGLONGS
case scm_tc7_llvect:
- scm_
gen_puts (scm_regular_string,
"long_long", port);
+ scm_
puts (
"long_long", port);
break;
#endif
#ifdef SCM_FLOATS
#ifdef SCM_SINGLES
case scm_tc7_fvect:
break;
#endif
#ifdef SCM_FLOATS
#ifdef SCM_SINGLES
case scm_tc7_fvect:
- scm_
gen_
putc ('s', port);
+ scm_putc ('s', port);
break;
#endif /*SCM_SINGLES*/
case scm_tc7_dvect:
break;
#endif /*SCM_SINGLES*/
case scm_tc7_dvect:
- scm_
gen_
putc ('i', port);
+ scm_putc ('i', port);
break;
case scm_tc7_cvect:
break;
case scm_tc7_cvect:
- scm_
gen_
putc ('c', port);
+ scm_putc ('c', port);
break;
#endif /*SCM_FLOATS*/
}
break;
#endif /*SCM_FLOATS*/
}
- scm_
gen_
putc ('(', port);
+ scm_putc ('(', port);
rapr1 (exp, base, 0, port, pstate);
rapr1 (exp, base, 0, port, pstate);
- scm_
gen_
putc (')', port);
+ scm_putc (')', port);
return 1;
}
return 1;
}