(scm_list_to_typed_array): Allow the specification of the

upper bound as well.  This is needed for empty arrays.
(l2ra): Give needed number of elements in error message.
(scm_i_print_array): Print length information for arrays that need
it.
(scm_i_read_array): Parse it.

libguile/unif.c

@@ -764,7 +764,7 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 1,
   while (k--)
     {
       s[k].inc = rlen;
-      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd);
+      SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
       rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
     }
 
@@ -2332,45 +2332,59 @@ SCM_DEFINE (scm_array_to_list, "array->list", 1, 0, 0,
 static void l2ra (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k);
 
 SCM_DEFINE (scm_list_to_typed_array, "list->typed-array", 3, 0, 0,
-           (SCM type, SCM ndim, SCM lst),
+           (SCM type, SCM shape, SCM lst),
 	    "Return an array of the type @var{type}\n"
 	    "with elements the same as those of @var{lst}.\n"
 	    "\n"
-	    "The argument @var{ndim} determines the number of dimensions\n"
+	    "The argument @var{shape} determines the number of dimensions\n"
-	    "of the array.  It is either an exact integer, giving the\n"
+	    "of the array and their shape.  It is either an exact integer,\n"
-	    "number directly, or a list of exact integers, whose length\n"
+	    "giving the\n"
-	    "specifies the number of dimensions and each element is the\n"
+	    "number of dimensions directly, or a list whose length\n"
-	    "lower index bound of its dimension.")
+	    "specifies the number of dimensions and each element specified\n"
+	    "the lower and optionally the upper bound of the corresponding\n"
+	    "dimension.\n"
+	    "When the element is list of two elements, these elements\n"
+	    "give the lower and upper bounds.  When it is an exact\n"
+	    "integer, it gives only the lower bound.")
 #define FUNC_NAME s_scm_list_to_typed_array
 {
-  SCM shape, row;
+  SCM row;
   SCM ra;
   scm_t_array_handle handle;
 
-  shape = SCM_EOL;
   row = lst;
-  if (scm_is_integer (ndim))
+  if (scm_is_integer (shape))
     {
-      size_t k = scm_to_size_t (ndim);
+      size_t k = scm_to_size_t (shape);
+      shape = SCM_EOL;
       while (k-- > 0)
 	{
 	  shape = scm_cons (scm_length (row), shape);
-	  if (k > 0)
+	  if (k > 0 && !scm_is_null (row))
 	    row = scm_car (row);
 	}
     }
   else
     {
+      SCM shape_spec = shape;
+      shape = SCM_EOL;
       while (1)
 	{
-	  shape = scm_cons (scm_list_2 (scm_car (ndim),
+	  SCM spec = scm_car (shape_spec);
-					scm_sum (scm_sum (scm_car (ndim),
+	  if (scm_is_pair (spec))
-							  scm_length (row)),
+	    shape = scm_cons (spec, shape);
-						 scm_from_int (-1))),
+	  else
-			    shape);
+	    shape = scm_cons (scm_list_2 (spec,
-	  ndim = scm_cdr (ndim);
+					  scm_sum (scm_sum (spec,
-	  if (scm_is_pair (ndim))
+							    scm_length (row)),
-	    row = scm_car (row);
+						   scm_from_int (-1))),
+			      shape);
+	  shape_spec = scm_cdr (shape_spec);
+	  if (scm_is_pair (shape_spec))
+	    {
+	      if (!scm_is_null (row))
+		row = scm_car (row);
+	    }
 	  else
 	    break;
 	}
@@ -2405,8 +2419,10 @@ l2ra (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k)
     {
       scm_t_array_dim *dim = scm_array_handle_dims (handle) + k;
       ssize_t inc = dim->inc;
-      size_t n = 1 + dim->ubnd - dim->lbnd;
+      size_t len = 1 + dim->ubnd - dim->lbnd, n;
+      char *errmsg = NULL;
 
+      n = len;
       while (n > 0 && scm_is_pair (lst))
 	{
 	  l2ra (SCM_CAR (lst), handle, pos, k + 1);
@@ -2415,11 +2431,12 @@ l2ra (SCM lst, scm_t_array_handle *handle, ssize_t pos, size_t k)
 	  n -= 1;
 	}
       if (n != 0)
-	scm_misc_error (NULL, "too few elements for array dimension ~a",
+	errmsg = "too few elements for array dimension ~a, need ~a";
-			scm_list_1 (scm_from_ulong (k)));
       if (!scm_is_null (lst))
-	scm_misc_error (NULL, "too many elements for array dimension ~a",
+	errmsg = "too many elements for array dimension ~a, want ~a";
-			scm_list_1 (scm_from_ulong (k)));
+      if (errmsg)
+	scm_misc_error (NULL, errmsg, scm_list_2 (scm_from_ulong (k),
+						  scm_from_size_t (len)));
     }
 }
 
@@ -2485,6 +2502,7 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
   SCM v = SCM_ARRAY_V (array);
   unsigned long base = SCM_ARRAY_BASE (array);
   long i;
+  int print_lbnds = 0, zero_size = 0, print_lens = 0;
 
   scm_putc ('#', port);
   if (ndim != 1 || dim_specs[0].lbnd != 0)
@@ -2499,14 +2517,29 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
     scm_puts ("?", port);
   
   for (i = 0; i < ndim; i++)
-    if (dim_specs[i].lbnd != 0)
+    {
+      if (dim_specs[i].lbnd != 0)
+	print_lbnds = 1;
+      if (dim_specs[i].ubnd - dim_specs[i].lbnd + 1 == 0)
+	zero_size = 1;
+      else if (zero_size)
+	print_lens = 1;
+    }
+
+  if (print_lbnds || print_lens)
+    for (i = 0; i < ndim; i++)
       {
-	for (i = 0; i < ndim; i++)
+	if (print_lbnds)
 	  {
 	    scm_putc ('@', port);
-	    scm_uintprint (dim_specs[i].lbnd, 10, port);
+	    scm_intprint (dim_specs[i].lbnd, 10, port);
+	  }
+	if (print_lens)
+	  {
+	    scm_putc (':', port);
+	    scm_intprint (dim_specs[i].ubnd - dim_specs[i].lbnd + 1,
+			  10, port);
 	  }
-	break;
       }
 
   if (ndim == 0)
@@ -2615,6 +2648,31 @@ tag_to_type (const char *tag, SCM port)
     return scm_from_locale_symbol (tag);
 }
 
+static int
+read_decimal_integer (SCM port, int c, ssize_t *resp)
+{
+  ssize_t sign = 1;
+  ssize_t res = 0;
+  int got_it = 0;
+
+  if (c == '-')
+    {
+      sign = -1;
+      c = scm_getc (port);
+    }
+
+  while ('0' <= c && c <= '9')
+    {
+      res = 10*res + c-'0';
+      got_it = 1;
+      c = scm_getc (port);
+    }
+
+  if (got_it)
+    *resp = res;
+  return c;
+}
+
 SCM
 scm_i_read_array (SCM port, int c)
 {
@@ -2623,7 +2681,7 @@ scm_i_read_array (SCM port, int c)
   char tag[80];
   int tag_len;
 
-  SCM lower_bounds = SCM_BOOL_F, elements;
+  SCM shape = SCM_BOOL_F, elements;
 
   /* XXX - shortcut for ordinary vectors.  Shouldn't be necessary but
      the array code can not deal with zero-length dimensions yet, and
@@ -2653,55 +2711,55 @@ scm_i_read_array (SCM port, int c)
       goto continue_reading_tag;
     }
 
-  /* Read rank. */
+  /* Read rank. 
-  rank = 0;
+   */
-  got_rank = 0;
+  rank = 1;
-  while ('0' <= c && c <= '9')
+  c = read_decimal_integer (port, c, &rank);
-    {
+  if (rank < 0)
-      rank = 10*rank + c-'0';
+    scm_i_input_error (NULL, port, "array rank must be non-negative",
-      got_rank = 1;
+		       SCM_EOL);
-      c = scm_getc (port);
-    }
-  if (!got_rank)
-    rank = 1;
 
-  /* Read tag. */
+  /* Read tag. 
+   */
   tag_len = 0;
  continue_reading_tag:
-  while (c != EOF && c != '(' && c != '@' && tag_len < 80)
+  while (c != EOF && c != '(' && c != '@' && c != ':' && tag_len < 80)
     {
       tag[tag_len++] = c;
       c = scm_getc (port);
     }
   tag[tag_len] = '\0';
   
-  /* Read lower bounds. */
+  /* Read shape. 
-  if (c == '@')
+   */
+  if (c == '@' || c == ':')
     {
-      lower_bounds = SCM_EOL;
+      shape = SCM_EOL;
       
       do
 	{
-	  /* Yeah, right, we should use some ready-made integer parsing
+	  ssize_t lbnd = 0, len = 0;
-	     routine for this...
+	  SCM s;
-	  */
 
-	  long lbnd = 0;
+	  if (c == '@')
-	  long sign = 1;
+	    {
+	      c = scm_getc (port);
+	      c = read_decimal_integer (port, c, &lbnd);
+	    }
 	  
-	  c = scm_getc (port);
+	  s = scm_from_ssize_t (lbnd);
-	  if (c == '-')
+
+	  if (c == ':')
 	    {
-	      sign = -1;
 	      c = scm_getc (port);
+	      c = read_decimal_integer (port, c, &len);
+	      s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
 	    }
-	  while ('0' <= c && c <= '9')
+
-	    {
+	  shape = scm_cons (s, shape);
-	      lbnd = 10*lbnd + c-'0';
+	} while (c == '@' || c == ':');
-	      c = scm_getc (port);
+
-	    }
+      shape = scm_reverse_x (shape, SCM_EOL);
-	  lower_bounds = scm_cons (scm_from_long (sign*lbnd), lower_bounds);
-	} while (c == '@');
     }
 
   /* Read nested lists of elements.
@@ -2713,24 +2771,33 @@ scm_i_read_array (SCM port, int c)
   scm_ungetc (c, port);
   elements = scm_read (port);
 
-  if (scm_is_false (lower_bounds))
+  if (scm_is_false (shape))
-    lower_bounds = scm_from_size_t (rank);
+    shape = scm_from_size_t (rank);
-  else if (scm_ilength (lower_bounds) != rank)
+  else if (scm_ilength (shape) != rank)
-    scm_i_input_error (NULL, port,
+    scm_i_input_error 
-		       "the number of lower bounds must match the array rank",
+      (NULL, port,
-		       SCM_EOL);
+       "the number of shape specifications must match the array rank",
+       SCM_EOL);
 
   /* Handle special print syntax of rank zero arrays; see
      scm_i_print_array for a rationale.
   */
   if (rank == 0)
-    elements = scm_car (elements);
+    {
+      if (!scm_is_pair (elements))
+	scm_i_input_error (NULL, port,
+			   "too few elements in array literal, need 1",
+			   SCM_EOL);
+      if (!scm_is_null (SCM_CDR (elements)))
+	scm_i_input_error (NULL, port,
+			   "too many elements in array literal, want 1",
+			   SCM_EOL);
+      elements = SCM_CAR (elements);
+    }
 
   /* Construct array. 
    */
-  return scm_list_to_typed_array (tag_to_type (tag, port),
+  return scm_list_to_typed_array (tag_to_type (tag, port), shape, elements);
-				  lower_bounds,
-				  elements);
 }
 
 int