* socket.c, rw.c, deprecated.h, validate.h
[bpt/guile.git] / libguile / read.c
index ebaf1ed..fc973dc 100644 (file)
@@ -76,22 +76,21 @@ scm_t_option scm_read_opts[] = {
 
 
 static void
-scm_input_error(char const * function,
-               SCM port, const char * message, SCM arg)
+scm_input_error (char const *function,
+                SCM port, const char *message, SCM arg)
 {
-  char *fn = SCM_STRINGP (SCM_FILENAME(port))
-    ? SCM_STRING_CHARS(SCM_FILENAME(port))
-    : "#<unknown port>";
+  SCM fn = (scm_is_string (SCM_FILENAME(port))
+           ? SCM_FILENAME(port)
+           : scm_from_locale_string ("#<unknown port>"));
 
-  SCM string_port =  scm_open_output_string ();
+  SCM string_port = scm_open_output_string ();
   SCM string = SCM_EOL;
   scm_simple_format (string_port,
                     scm_makfrom0str ("~A:~S:~S: ~A"),
-                    scm_list_4 (scm_makfrom0str (fn),
-                                scm_int2num (SCM_LINUM (port) + 1),
-                                scm_int2num (SCM_COL (port) + 1),
+                    scm_list_4 (fn,
+                                scm_from_int (SCM_LINUM (port) + 1),
+                                scm_from_int (SCM_COL (port) + 1),
                                 scm_makfrom0str (message)));
-
     
   string = scm_get_output_string (string_port);
   scm_close_output_port (string_port);
@@ -152,15 +151,15 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
 char *
 scm_grow_tok_buf (SCM *tok_buf)
 {
-  size_t oldlen = SCM_STRING_LENGTH (*tok_buf);
+  size_t oldlen = SCM_I_STRING_LENGTH (*tok_buf);
   SCM newstr = scm_allocate_string (2 * oldlen);
   size_t i;
 
   for (i = 0; i != oldlen; ++i)
-    SCM_STRING_CHARS (newstr) [i] = SCM_STRING_CHARS (*tok_buf) [i];
+    SCM_I_STRING_CHARS (newstr) [i] = SCM_I_STRING_CHARS (*tok_buf) [i];
 
   *tok_buf = newstr;
-  return SCM_STRING_CHARS (newstr);
+  return SCM_I_STRING_CHARS (newstr);
 }
 
 
@@ -388,7 +387,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
            SCM got;
 
            got = scm_call_2 (sharp, SCM_MAKE_CHAR (c), port);
-           if (SCM_EQ_P (got, SCM_UNSPECIFIED))
+           if (scm_is_eq (got, SCM_UNSPECIFIED))
              goto handle_sharp;
            if (SCM_RECORD_POSITIONS_P)
              return *copy = recsexpr (got, line, column,
@@ -438,7 +437,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 #if SCM_HAVE_ARRAYS
        case '*':
          j = scm_read_token (c, tok_buf, port, 0);
-         p = scm_istr2bve (SCM_STRING_CHARS (*tok_buf) + 1, (long) (j - 1));
+         p = scm_istr2bve (SCM_I_STRING_CHARS (*tok_buf) + 1, (long) (j - 1));
          if (scm_is_true (p))
            return p;
          else
@@ -447,7 +446,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
 
        case '{':
          j = scm_read_token (c, tok_buf, port, 1);
-         return scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j);
+         return scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j);
 
        case '\\':
          c = scm_getc (port);
@@ -461,20 +460,20 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
               * does only consist of octal digits.  Finally, it should be
               * checked whether the resulting fixnum is in the range of
               * characters.  */
-             p = scm_i_mem2number (SCM_STRING_CHARS (*tok_buf), j, 8);
-             if (SCM_INUMP (p))
-               return SCM_MAKE_CHAR (SCM_INUM (p));
+             p = scm_i_mem2number (SCM_I_STRING_CHARS (*tok_buf), j, 8);
+             if (SCM_I_INUMP (p))
+               return SCM_MAKE_CHAR (SCM_I_INUM (p));
            }
          for (c = 0; c < scm_n_charnames; c++)
            if (scm_charnames[c]
-               && (scm_casei_streq (scm_charnames[c], SCM_STRING_CHARS (*tok_buf))))
+               && (scm_casei_streq (scm_charnames[c], SCM_I_STRING_CHARS (*tok_buf))))
              return SCM_MAKE_CHAR (scm_charnums[c]);
          scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL);
 
          /* #:SYMBOL is a syntax for keywords supported in all contexts.  */
        case ':':
          j = scm_read_token ('-', tok_buf, port, 0);
-         p = scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j);
+         p = scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j);
          return scm_make_keyword_from_dash_symbol (p);
 
        default:
@@ -489,7 +488,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
                SCM got;
 
                got = scm_call_2 (sharp, SCM_MAKE_CHAR (c), port);
-               if (SCM_EQ_P (got, SCM_UNSPECIFIED))
+               if (scm_is_eq (got, SCM_UNSPECIFIED))
                  goto unkshrp;
                if (SCM_RECORD_POSITIONS_P)
                  return *copy = recsexpr (got, line, column,
@@ -510,7 +509,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
          if (c == EOF)
            str_eof: scm_input_error (FUNC_NAME, port, "end of file in string constant", SCM_EOL);
 
-         while (j + 2 >= SCM_STRING_LENGTH (*tok_buf))
+         while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf))
            scm_grow_tok_buf (tok_buf);
 
          if (c == '\\')
@@ -575,13 +574,13 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
                                "illegal character in escape sequence: ~S",
                                scm_list_1 (SCM_MAKE_CHAR (c)));
              }
-         SCM_STRING_CHARS (*tok_buf)[j] = c;
+         SCM_I_STRING_CHARS (*tok_buf)[j] = c;
          ++j;
        }
       if (j == 0)
        return scm_nullstr;
-      SCM_STRING_CHARS (*tok_buf)[j] = 0;
-      return scm_mem2string (SCM_STRING_CHARS (*tok_buf), j);
+      SCM_I_STRING_CHARS (*tok_buf)[j] = 0;
+      return scm_mem2string (SCM_I_STRING_CHARS (*tok_buf), j);
 
     case '0': case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9':
@@ -594,7 +593,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
        /* Shortcut:  Detected symbol '+ or '- */
        goto tok;
 
-      p = scm_i_mem2number (SCM_STRING_CHARS (*tok_buf), j, 10);
+      p = scm_i_mem2number (SCM_I_STRING_CHARS (*tok_buf), j, 10);
       if (scm_is_true (p))
        return p;
       if (c == '#')
@@ -602,7 +601,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
          if ((j == 2) && (scm_getc (port) == '('))
            {
              scm_ungetc ('(', port);
-             c = SCM_STRING_CHARS (*tok_buf)[1];
+             c = SCM_I_STRING_CHARS (*tok_buf)[1];
              goto callshrp;
            }
          scm_input_error (FUNC_NAME, port, "unknown # object", SCM_EOL);
@@ -610,10 +609,10 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
       goto tok;
 
     case ':':
-      if (SCM_EQ_P (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix))
+      if (scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_prefix))
        {
          j = scm_read_token ('-', tok_buf, port, 0);
-         p = scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j);
+         p = scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j);
          return scm_make_keyword_from_dash_symbol (p);
        }
       /* fallthrough */
@@ -625,7 +624,7 @@ scm_lreadr (SCM *tok_buf, SCM port, SCM *copy)
       /* fallthrough */
 
     tok:
-      return scm_mem2symbol (SCM_STRING_CHARS (*tok_buf), j);
+      return scm_mem2symbol (SCM_I_STRING_CHARS (*tok_buf), j);
     }
 }
 #undef FUNC_NAME
@@ -643,14 +642,14 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird)
   register char *p;
 
   c = (SCM_CASE_INSENSITIVE_P ? scm_c_downcase(ic) : ic);
-  p = SCM_STRING_CHARS (*tok_buf);
+  p = SCM_I_STRING_CHARS (*tok_buf);
 
   if (weird)
     j = 0;
   else
     {
       j = 0;
-      while (j + 2 >= SCM_STRING_LENGTH (*tok_buf))
+      while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf))
        p = scm_grow_tok_buf (tok_buf);
       p[j] = c;
       ++j;
@@ -658,7 +657,7 @@ scm_read_token (int ic, SCM *tok_buf, SCM port, int weird)
 
   while (1)
     {
-      while (j + 2 >= SCM_STRING_LENGTH (*tok_buf))
+      while (j + 2 >= SCM_I_STRING_LENGTH (*tok_buf))
        p = scm_grow_tok_buf (tok_buf);
       c = scm_getc (port);
       switch (c)
@@ -742,7 +741,7 @@ scm_i_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy, char term_char)
   if (term_char == c)
     return SCM_EOL;
   scm_ungetc (c, port);
-  if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
+  if (scm_is_eq (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
     {
       ans = scm_lreadr (tok_buf, port, copy);
     closeit:
@@ -754,7 +753,7 @@ scm_i_lreadparen (SCM *tok_buf, SCM port, char *name, SCM *copy, char term_char)
   while (term_char != (c = scm_flush_ws (port, name)))
     {
       scm_ungetc (c, port);
-      if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
+      if (scm_is_eq (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
        {
          SCM_SETCDR (tl, scm_lreadr (tok_buf, port, copy));
          goto closeit;
@@ -783,7 +782,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
   if (')' == c)
     return SCM_EOL;
   scm_ungetc (c, port);
-  if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
+  if (scm_is_eq (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
     {
       ans = scm_lreadr (tok_buf, port, copy);
       if (')' != (c = scm_flush_ws (port, name)))
@@ -802,7 +801,7 @@ scm_lreadrecparen (SCM *tok_buf, SCM port, char *name, SCM *copy)
       SCM new_tail;
 
       scm_ungetc (c, port);
-      if (SCM_EQ_P (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
+      if (scm_is_eq (scm_sym_dot, (tmp = scm_lreadr (tok_buf, port, copy))))
        {
          SCM_SETCDR (tl, tmp = scm_lreadr (tok_buf, port, copy));
          if (SCM_COPY_SOURCE_P)
@@ -859,7 +858,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0,
 
   SCM_VALIDATE_CHAR (1, chr);
   SCM_ASSERT (scm_is_false (proc)
-             || SCM_EQ_P (scm_procedure_p (proc), SCM_BOOL_T),
+             || scm_is_eq (scm_procedure_p (proc), SCM_BOOL_T),
              proc, SCM_ARG2, FUNC_NAME);
 
   /* Check if chr is already in the alist.  */
@@ -877,7 +876,7 @@ SCM_DEFINE (scm_read_hash_extend, "read-hash-extend", 2, 0, 0,
            }
          break;
        }
-      if (SCM_EQ_P (chr, SCM_CAAR (this)))
+      if (scm_is_eq (chr, SCM_CAAR (this)))
        {
          /* already in the alist.  */
          if (scm_is_false (proc))