(ra2l): Handle zero rank arrays.

(scm_i_print_array): Print zero rank arrays specially.
(tag_to_type): Return #t for an empty tag, not the empty symbol.
(scm_i_read_array): Allow zero rank arrays.

libguile/unif.c

@@ -2209,30 +2209,23 @@ static SCM
 ra2l (SCM ra, unsigned long base, unsigned long k)
 {
   SCM res = SCM_EOL;
-  long inc = SCM_ARRAY_DIMS (ra)[k].inc;
+  long inc;
   size_t i;
   int enclosed = SCM_ENCLOSED_ARRAYP (ra);
   
+  if (k == SCM_ARRAY_NDIM (ra))
+    return scm_i_cvref (SCM_ARRAY_V (ra), base, enclosed);
+
+  inc = SCM_ARRAY_DIMS (ra)[k].inc;
   if (SCM_ARRAY_DIMS (ra)[k].ubnd < SCM_ARRAY_DIMS (ra)[k].lbnd)
     return SCM_EOL;
   i = base + (1 + SCM_ARRAY_DIMS (ra)[k].ubnd - SCM_ARRAY_DIMS (ra)[k].lbnd) * inc;
-  if (k < SCM_ARRAY_NDIM (ra) - 1)
+  do
     {
-      do
+      i -= inc;
-	{
+      res = scm_cons (ra2l (ra, i, k + 1), res);
-	  i -= inc;
-	  res = scm_cons (ra2l (ra, i, k + 1), res);
-	}
-      while (i != base);
     }
-  else
+  while (i != base);
-    do
-      {
-	i -= inc;
-	res = scm_cons (scm_i_cvref (SCM_ARRAY_V (ra), i, enclosed),
-			res);
-      }
-    while (i != base);
   return res;
 }
 
@@ -2456,7 +2449,35 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
 	break;
       }
 
-  return scm_i_print_array_dimension (array, 0, base, 0, port, pstate);
+  if (ndim == 0)
+    {
+      /* Rank zero arrays, which are really just scalars, are printed
+	 specially.  The consequent way would be to print them as
+
+            #0 OBJ
+
+         where OBJ is the printed representation of the scalar, but we
+         print them instead as
+
+            #0(OBJ)
+
+         to make them look less strange.
+
+	 Just printing them as
+
+            OBJ
+
+         would be correct in a way as well, but zero rank arrays are
+         not really the same as Scheme values since they are boxed and
+         can be modified with array-set!, say.
+      */
+      scm_putc ('(', port);
+      scm_iprin1 (scm_i_cvref (v, base, 0), port, pstate);
+      scm_putc (')', port);
+      return 1;
+    }
+  else
+    return scm_i_print_array_dimension (array, 0, base, 0, port, pstate);
 }
 
 static int
@@ -2527,8 +2548,11 @@ tag_to_type (const char *tag, SCM port)
       }
   }
 #endif
-
+  
-  return scm_from_locale_symbol (tag);
+  if (*tag == '\0')
+    return SCM_BOOL_T;
+  else
+    return scm_from_locale_symbol (tag);
 }
 
 SCM
@@ -2539,7 +2563,7 @@ scm_i_read_array (SCM port, int c)
   char tag[80];
   int tag_len;
 
-  SCM lower_bounds, elements;
+  SCM lower_bounds = 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
@@ -2569,8 +2593,7 @@ scm_i_read_array (SCM port, int c)
       goto continue_reading_tag;
     }
 
-  /* Read rank.  We disallow arrays of rank zero since they do not
+  /* Read rank. */
-     seem to work reliably yet. */
   rank = 0;
   got_rank = 0;
   while ('0' <= c && c <= '9')
@@ -2581,9 +2604,6 @@ scm_i_read_array (SCM port, int c)
     }
   if (!got_rank)
     rank = 1;
-  else if (rank == 0)
-    scm_i_input_error (NULL, port,
-		       "array rank must be positive", SCM_EOL);
 
   /* Read tag. */
   tag_len = 0;
@@ -2596,28 +2616,32 @@ scm_i_read_array (SCM port, int c)
   tag[tag_len] = '\0';
   
   /* Read lower bounds. */
-  lower_bounds = SCM_EOL;
+  if (c == '@')
-  while (c == '@')
     {
-      /* Yeah, right, we should use some ready-made integer parsing
+      lower_bounds = SCM_EOL;
-	 routine for this...
+      
-       */
+      do
-
-      long lbnd = 0;
-      long sign = 1;
-
-      c = scm_getc (port);
-      if (c == '-')
 	{
-	  sign = -1;
+	  /* Yeah, right, we should use some ready-made integer parsing
+	     routine for this...
+	  */
+
+	  long lbnd = 0;
+	  long sign = 1;
+	  
 	  c = scm_getc (port);
-	}
+	  if (c == '-')
-      while ('0' <= c && c <= '9')
+	    {
-	{
+	      sign = -1;
-	  lbnd = 10*lbnd + c-'0';
+	      c = scm_getc (port);
-	  c = scm_getc (port);
+	    }
-	}
+	  while ('0' <= c && c <= '9')
-      lower_bounds = scm_cons (scm_from_long (sign*lbnd), lower_bounds);
+	    {
+	      lbnd = 10*lbnd + c-'0';
+	      c = scm_getc (port);
+	    }
+	  lower_bounds = scm_cons (scm_from_long (sign*lbnd), lower_bounds);
+	} while (c == '@');
     }
 
   /* Read nested lists of elements.
@@ -2629,14 +2653,21 @@ scm_i_read_array (SCM port, int c)
   scm_ungetc (c, port);
   elements = scm_read (port);
 
-  if (scm_is_null (lower_bounds))
+  if (scm_is_false (lower_bounds))
     lower_bounds = scm_from_size_t (rank);
   else if (scm_ilength (lower_bounds) != rank)
     scm_i_input_error (NULL, port,
 		       "the number of lower bounds must match the array rank",
 		       SCM_EOL);
 
-  /* Construct array. */
+  /* Handle special print syntax of rank zero arrays; see
+     scm_i_print_array for a rationale.
+  */
+  if (rank == 0)
+    elements = scm_car (elements);
+
+  /* Construct array. 
+   */
   return scm_list_to_typed_array (tag_to_type (tag, port),
 				  lower_bounds,
 				  elements);