* 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 "sequences.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:
-    case scm_tc7_mb_string:
       SCM_ASRTGO (vect != scm_nullstr, badarg1);
       sz = sizeof (char);
       l++;
@@ -536,18 +534,21 @@ scm_shap2ra (args, what)
       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
        {
-         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);
-         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;
        }
@@ -722,7 +723,7 @@ scm_make_shared_array (oldra, mapfunc, dims)
          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
@@ -802,7 +803,7 @@ scm_transpose_array (args)
   switch (SCM_TYP7 (ra))
     {
     default:
-    badarg:scm_wta (ra, (char *) SCM_ARGn, s_transpose_array);
+    badarg:scm_wta (ra, (char *) SCM_ARG1, s_transpose_array);
     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++)
        {
+         SCM_ASSERT (SCM_INUMP (ve[k]), ve[k], (SCM_ARG2 + k),
+                     s_transpose_array);
          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;
        }
@@ -870,7 +873,7 @@ scm_transpose_array (args)
              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;
     }
@@ -1585,6 +1588,8 @@ scm_uniform_array_write (v, port_or_fd, start, end)
   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;
@@ -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));
 
@@ -2224,7 +2229,7 @@ tail:
            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);
            }
@@ -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++)
            {
-             scm_gen_putc ('(', port);
+             scm_putc ('(', port);
              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. */
-             scm_gen_putc ('(', port);
+             scm_putc ('(', port);
              rapr1 (ra, j, k + 1, port, pstate);
-             scm_gen_putc (')', port);
+             scm_putc (')', port);
            }
          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_gen_putc (' ', port);
+         scm_putc (' ', port);
          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)
          {
-           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_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)
        {
-         scm_gen_putc (' ', port);
+         scm_putc (' ', port);
          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_gen_putc (' ', port);
+         scm_putc (' ', port);
          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_gen_putc (' ', port);
+         scm_putc (' ', port);
          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_gen_putc (' ', port);
+             scm_putc (' ', port);
              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_gen_putc (' ', port);
+             scm_putc (' ', port);
              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_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);
@@ -2373,7 +2378,7 @@ scm_raprin1 (exp, port, pstate)
 {
   SCM v = exp;
   scm_sizet base = 0;
-  scm_gen_putc ('#', port);
+  scm_putc ('#', port);
 tail:
   switch SCM_TYP7
     (v)
@@ -2386,9 +2391,9 @@ tail:
        if (SCM_ARRAYP (v))
 
          {
-           scm_gen_puts (scm_regular_string, "<enclosed-array ", port);
+           scm_puts ("<enclosed-array ", port);
            rapr1 (exp, base, 0, port, pstate);
-           scm_gen_putc ('>', port);
+           scm_putc ('>', port);
            return 1;
          }
        else
@@ -2401,13 +2406,13 @@ tail:
       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--)
                {
-                 scm_gen_putc (w & 1 ? '1' : '0', port);
+                 scm_putc (w & 1 ? '1' : '0', port);
                  w >>= 1;
                }
            }
@@ -2417,52 +2422,52 @@ tail:
              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
-       scm_gen_putc ('b', port);
+       scm_putc ('b', port);
       break;
     case scm_tc7_string:
-      scm_gen_putc ('a', port);
+      scm_putc ('a', port);
       break;
     case scm_tc7_byvect:
-      scm_gen_puts (scm_regular_string, "bytes", port);
+      scm_puts ("bytes", port);
       break;
     case scm_tc7_uvect:
-      scm_gen_putc ('u', port);
+      scm_putc ('u', port);
       break;
     case scm_tc7_ivect:
-      scm_gen_putc ('e', port);
+      scm_putc ('e', port);
       break;
     case scm_tc7_svect:
-      scm_gen_puts (scm_regular_string, "short", port);
+      scm_puts ("short", port);
       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:
-      scm_gen_putc ('s', port);
+      scm_putc ('s', port);
       break;
 #endif /*SCM_SINGLES*/
     case scm_tc7_dvect:
-      scm_gen_putc ('i', port);
+      scm_putc ('i', port);
       break;
     case scm_tc7_cvect:
-      scm_gen_putc ('c', port);
+      scm_putc ('c', port);
       break;
 #endif /*SCM_FLOATS*/
     }
-  scm_gen_putc ('(', port);
+  scm_putc ('(', port);
   rapr1 (exp, base, 0, port, pstate);
-  scm_gen_putc (')', port);
+  scm_putc (')', port);
   return 1;
 }