threadsafe port revealed counts

[bpt/guile.git] / libguile / arrays.c

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 89f5e9d..cc5c726 100644 (file)
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 2009, 2010, 2011 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
@@ -472,7 +472,7 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
   int ndim, i, k;
 
   SCM_VALIDATE_REST_ARGUMENT (args);
-  SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, FUNC_NAME);
+  SCM_ASSERT (SCM_HEAP_OBJECT_P (ra), ra, SCM_ARG1, FUNC_NAME);
 
   if (scm_is_generalized_vector (ra))
     {
@@ -822,15 +822,6 @@ scm_i_print_array (SCM array, SCM port, scm_print_state *pstate)
    C is the first character read after the '#'.
 */
 
-static SCM
-tag_to_type (const char *tag, SCM port)
-{
-  if (*tag == '\0')
-    return SCM_BOOL_T;
-  else
-    return scm_from_locale_symbol (tag);
-}
-
 static int
 read_decimal_integer (SCM port, int c, ssize_t *resp)
 {
@@ -860,11 +851,10 @@ SCM
 scm_i_read_array (SCM port, int c)
 {
   ssize_t rank;
-  int got_rank;
-  char tag[80];
+  scm_t_wchar tag_buf[8];
   int tag_len;
 
-  SCM shape = SCM_BOOL_F, elements;
+  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
@@ -888,8 +878,7 @@ scm_i_read_array (SCM port, int c)
          return SCM_BOOL_F;
        }
       rank = 1;
-      got_rank = 1;
-      tag[0] = 'f';
+      tag_buf[0] = 'f';
       tag_len = 1;
       goto continue_reading_tag;
     }
@@ -906,13 +895,22 @@ scm_i_read_array (SCM port, int c)
    */
   tag_len = 0;
  continue_reading_tag:
-  while (c != EOF && c != '(' && c != '@' && c != ':' && tag_len < 80)
+  while (c != EOF && c != '(' && c != '@' && c != ':'
+         && tag_len < sizeof tag_buf / sizeof tag_buf[0])
     {
-      tag[tag_len++] = c;
+      tag_buf[tag_len++] = c;
       c = scm_getc (port);
     }
-  tag[tag_len] = '\0';
-  
+  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 == ':')
@@ -985,7 +983,7 @@ scm_i_read_array (SCM port, int c)
 
   /* Construct array. 
    */
-  return scm_list_to_typed_array (tag_to_type (tag, port), shape, elements);
+  return scm_list_to_typed_array (tag, shape, elements);
 }