Move array reader from arrays.c to read.c

* libguile/arrays.c (read_decimal_integer): Move to read.c.
  (scm_i_read_array): Remove.  Incorporate the code into the
  'scm_read_array' static function in read.c.

* libguile/arrays.h (scm_i_read_array): Remove prototype.

* libguile/read.c (read_decimal_integer): Move here from read.c.
  (scm_read_array): Incorporate the code from 'scm_i_read_array'.  Call
  'scm_read_vector' and 'scm_read_sexp' instead of 'scm_read'.

diff --git a/libguile/arrays.c b/libguile/arrays.c
index a294f33..1eb10b9 100644 (file)
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004,2005,
+ *   2006, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -814,178 +815,6 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
     return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
 }
 
-/* Read an array.  This function can also read vectors and uniform
-   vectors.  Also, the conflict between '#f' and '#f32' and '#f64' is
-   handled here.
-
-   C is the first character read after the '#'.
-*/
-
-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 = sign * res;
-  return c;
-}
-
-SCM
-scm_i_read_array (SCM port, int c)
-{
-  ssize_t rank;
-  scm_t_wchar tag_buf[8];
-  int tag_len;
-
-  SCM tag, 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
-     we want to allow zero-length vectors, of course.
-  */
-  if (c == '(')
-    {
-      scm_ungetc (c, port);
-      return scm_vector (scm_read (port));
-    }
-
-  /* Disambiguate between '#f' and uniform floating point vectors.
-   */
-  if (c == 'f')
-    {
-      c = scm_getc (port);
-      if (c != '3' && c != '6')
-       {
-         if (c != EOF)
-           scm_ungetc (c, port);
-         return SCM_BOOL_F;
-       }
-      rank = 1;
-      tag_buf[0] = 'f';
-      tag_len = 1;
-      goto continue_reading_tag;
-    }
-
-  /* Read rank. 
-   */
-  rank = 1;
-  c = read_decimal_integer (port, c, &rank);
-  if (rank < 0)
-    scm_i_input_error (NULL, port, "array rank must be non-negative",
-                      SCM_EOL);
-
-  /* Read tag. 
-   */
-  tag_len = 0;
- continue_reading_tag:
-  while (c != EOF && c != '(' && c != '@' && c != ':'
-         && tag_len < sizeof tag_buf / sizeof tag_buf[0])
-    {
-      tag_buf[tag_len++] = c;
-      c = scm_getc (port);
-    }
-  if (tag_len == 0)
-    tag = SCM_BOOL_T;
-  else
-    {
-      tag = scm_string_to_symbol (scm_from_utf32_stringn (tag_buf, tag_len));
-      if (tag_len == sizeof tag_buf / sizeof tag_buf[0])
-        scm_i_input_error (NULL, port, "invalid array tag, starting with: ~a",
-                           scm_list_1 (tag));
-    }
-    
-  /* Read shape. 
-   */
-  if (c == '@' || c == ':')
-    {
-      shape = SCM_EOL;
-      
-      do
-       {
-         ssize_t lbnd = 0, len = 0;
-         SCM s;
-
-         if (c == '@')
-           {
-             c = scm_getc (port);
-             c = read_decimal_integer (port, c, &lbnd);
-           }
-         
-         s = scm_from_ssize_t (lbnd);
-
-         if (c == ':')
-           {
-             c = scm_getc (port);
-             c = read_decimal_integer (port, c, &len);
-             if (len < 0)
-               scm_i_input_error (NULL, port,
-                                  "array length must be non-negative",
-                                  SCM_EOL);
-
-             s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
-           }
-
-         shape = scm_cons (s, shape);
-       } while (c == '@' || c == ':');
-
-      shape = scm_reverse_x (shape, SCM_EOL);
-    }
-
-  /* Read nested lists of elements.
-   */
-  if (c != '(')
-    scm_i_input_error (NULL, port,
-                      "missing '(' in vector or array literal",
-                      SCM_EOL);
-  scm_ungetc (c, port);
-  elements = scm_read (port);
-
-  if (scm_is_false (shape))
-    shape = scm_from_ssize_t (rank);
-  else if (scm_ilength (shape) != rank)
-    scm_i_input_error 
-      (NULL, port,
-       "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)
-    {
-      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, shape, elements);
-}
-
-
 static SCM
 array_handle_ref (scm_t_array_handle *h, size_t pos)
 {

diff --git a/libguile/arrays.h b/libguile/arrays.h
index 5ea604d..6045ab6 100644 (file)
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -3,7 +3,8 @@
 #ifndef SCM_ARRAY_H
 #define SCM_ARRAY_H
 
-/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2004, 2006, 2008, 2009,
+ *   2010, 2012 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -73,7 +74,6 @@ typedef struct scm_i_t_array
 
 SCM_INTERNAL SCM scm_i_make_array (int ndim);
 SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state *pstate);
-SCM_INTERNAL SCM scm_i_read_array (SCM port, int c);
 
 SCM_INTERNAL void scm_init_arrays (void);
 

diff --git a/libguile/read.c b/libguile/read.c
index 87d73bf..7fb1c21 100644 (file)
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1002,14 +1002,163 @@ scm_read_vector (int chr, SCM port, long line, int column)
                                 port, line, column);
 }
 
+/* Helper used by scm_read_array */
+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 = sign * res;
+  return c;
+}
+
+/* Read an array.  This function can also read vectors and uniform
+   vectors.  Also, the conflict between '#f' and '#f32' and '#f64' is
+   handled here.
+
+   C is the first character read after the '#'. */
 static SCM
-scm_read_array (int chr, SCM port, long line, int column)
+scm_read_array (int c, SCM port, long line, int column)
 {
-  SCM result = scm_i_read_array (port, chr);
-  if (scm_is_false (result))
-    return result;
+  ssize_t rank;
+  scm_t_wchar tag_buf[8];
+  int tag_len;
+
+  SCM tag, shape = SCM_BOOL_F, elements, array;
+
+  /* XXX - shortcut for ordinary vectors.  Shouldn't be necessary but
+     the array code can not deal with zero-length dimensions yet, and
+     we want to allow zero-length vectors, of course. */
+  if (c == '(')
+    return scm_read_vector (c, port, line, column);
+
+  /* Disambiguate between '#f' and uniform floating point vectors. */
+  if (c == 'f')
+    {
+      c = scm_getc (port);
+      if (c != '3' && c != '6')
+       {
+         if (c != EOF)
+           scm_ungetc (c, port);
+         return SCM_BOOL_F;
+       }
+      rank = 1;
+      tag_buf[0] = 'f';
+      tag_len = 1;
+      goto continue_reading_tag;
+    }
+
+  /* Read rank. */
+  rank = 1;
+  c = read_decimal_integer (port, c, &rank);
+  if (rank < 0)
+    scm_i_input_error (NULL, port, "array rank must be non-negative",
+                      SCM_EOL);
+
+  /* Read tag. */
+  tag_len = 0;
+ continue_reading_tag:
+  while (c != EOF && c != '(' && c != '@' && c != ':'
+         && tag_len < sizeof tag_buf / sizeof tag_buf[0])
+    {
+      tag_buf[tag_len++] = c;
+      c = scm_getc (port);
+    }
+  if (tag_len == 0)
+    tag = SCM_BOOL_T;
   else
-    return maybe_annotate_source (result, port, line, column);
+    {
+      tag = scm_string_to_symbol (scm_from_utf32_stringn (tag_buf, tag_len));
+      if (tag_len == sizeof tag_buf / sizeof tag_buf[0])
+        scm_i_input_error (NULL, port, "invalid array tag, starting with: ~a",
+                           scm_list_1 (tag));
+    }
+
+  /* Read shape. */
+  if (c == '@' || c == ':')
+    {
+      shape = SCM_EOL;
+
+      do
+       {
+         ssize_t lbnd = 0, len = 0;
+         SCM s;
+
+         if (c == '@')
+           {
+             c = scm_getc (port);
+             c = read_decimal_integer (port, c, &lbnd);
+           }
+
+         s = scm_from_ssize_t (lbnd);
+
+         if (c == ':')
+           {
+             c = scm_getc (port);
+             c = read_decimal_integer (port, c, &len);
+             if (len < 0)
+               scm_i_input_error (NULL, port,
+                                  "array length must be non-negative",
+                                  SCM_EOL);
+
+             s = scm_list_2 (s, scm_from_ssize_t (lbnd+len-1));
+           }
+
+         shape = scm_cons (s, shape);
+       } while (c == '@' || c == ':');
+
+      shape = scm_reverse_x (shape, SCM_EOL);
+    }
+
+  /* Read nested lists of elements. */
+  if (c != '(')
+    scm_i_input_error (NULL, port,
+                      "missing '(' in vector or array literal",
+                      SCM_EOL);
+  elements = scm_read_sexp (c, port);
+
+  if (scm_is_false (shape))
+    shape = scm_from_ssize_t (rank);
+  else if (scm_ilength (shape) != rank)
+    scm_i_input_error
+      (NULL, port,
+       "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)
+    {
+      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, annotate with source location, and return. */
+  array = scm_list_to_typed_array (tag, shape, elements);
+  return maybe_annotate_source (array, port, line, column);
 }
 
 static SCM