*** empty log message ***

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

diff --git a/libguile/print.c b/libguile/print.c
index 0b69ebd..5a0eaad 100644 (file)
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995-1999,2000,2001, 2002, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1999,2000,2001, 2002, 2003, 2004 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
@@ -140,7 +140,7 @@ SCM_DEFINE (scm_current_pstate, "current-pstate", 0, 0, 0,
            "included in @code{--enable-guile-debug} builds.")
 #define FUNC_NAME s_scm_current_pstate
 {
-  if (!SCM_NULLP (print_state_pool))
+  if (!scm_is_null (print_state_pool))
     return SCM_CAR (print_state_pool);
   else
     return SCM_BOOL_F;
@@ -170,7 +170,7 @@ scm_make_print_state ()
 
   /* First try to allocate a print state from the pool */
   scm_i_plugin_mutex_lock (&print_state_mutex);
-  if (!SCM_NULLP (print_state_pool))
+  if (!scm_is_null (print_state_pool))
     {
       answer = SCM_CAR (print_state_pool);
       print_state_pool = SCM_CDR (print_state_pool);
@@ -239,11 +239,11 @@ print_circref (SCM port, scm_print_state *pstate, SCM ref)
   register long i;
   long self = pstate->top - 1;
   i = pstate->top - 1;
-  if (SCM_CONSP (pstate->ref_stack[i]))
+  if (scm_is_pair (pstate->ref_stack[i]))
     {
       while (i > 0)
        {
-         if (!SCM_CONSP (pstate->ref_stack[i - 1])
+         if (!scm_is_pair (pstate->ref_stack[i - 1])
              || !scm_is_eq (SCM_CDR (pstate->ref_stack[i - 1]), 
                             pstate->ref_stack[i]))
            break;
@@ -484,12 +484,15 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
        case scm_tc7_string:
          if (SCM_WRITINGP (pstate))
            {
-             size_t i;
+             size_t i, len;
+             const char *data;
 
              scm_putc ('"', port);
-             for (i = 0; i < SCM_I_STRING_LENGTH (exp); ++i)
+             len = scm_i_string_length (exp);
+             data = scm_i_string_chars (exp);
+             for (i = 0; i < len; ++i)
                {
-                 unsigned char ch = SCM_I_STRING_CHARS (exp)[i];
+                 unsigned char ch = data[i];
                  if ((ch < 32 && ch != '\n') || (127 <= ch && ch < 148))
                    {
                      static char const hex[]="0123456789abcdef";
@@ -506,25 +509,26 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
                    }
                }
              scm_putc ('"', port);
+             scm_remember_upto_here_1 (exp);
            }
          else
-           scm_lfwrite (SCM_I_STRING_CHARS (exp), SCM_I_STRING_LENGTH (exp),
+           scm_lfwrite (scm_i_string_chars (exp), scm_i_string_length (exp),
                         port);
          scm_remember_upto_here_1 (exp);
          break;
        case scm_tc7_symbol:
-         if (SCM_SYMBOL_INTERNED_P (exp))
+         if (scm_i_symbol_is_interned (exp))
            {
-             scm_print_symbol_name (SCM_SYMBOL_CHARS (exp),
-                                    SCM_SYMBOL_LENGTH (exp),
+             scm_print_symbol_name (scm_i_symbol_chars (exp),
+                                    scm_i_symbol_length (exp),
                                     port);
              scm_remember_upto_here_1 (exp);
            }
          else
            {
              scm_puts ("#<uninterned-symbol ", port);
-             scm_print_symbol_name (SCM_SYMBOL_CHARS (exp),
-                                    SCM_SYMBOL_LENGTH (exp),
+             scm_print_symbol_name (scm_i_symbol_chars (exp),
+                                    scm_i_symbol_length (exp),
                                     port);
              scm_putc (' ', port);
              scm_intprint ((long)exp, 16, port);
@@ -592,7 +596,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
                    ? "#<primitive-generic "
                    : "#<primitive-procedure ",
                    port);
-         scm_puts (SCM_SYMBOL_CHARS (SCM_SNAME (exp)), port);
+         scm_puts (scm_i_symbol_chars (SCM_SNAME (exp)), port);
          scm_putc ('>', port);
          break;
 #ifdef CCLO
@@ -607,7 +611,7 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
                if (scm_is_true (name))
                  {
                    scm_putc (' ', port);
-                   scm_puts (SCM_SYMBOL_CHARS (name), port);
+                   scm_puts (scm_i_symbol_chars (name), port);
                  }
              }
            else
@@ -681,7 +685,7 @@ scm_prin1 (SCM exp, SCM port, int writingp)
     {
       /* First try to allocate a print state from the pool */
       scm_i_plugin_mutex_lock (&print_state_mutex);
-      if (!SCM_NULLP (print_state_pool))
+      if (!scm_is_null (print_state_pool))
        {
          handle = print_state_pool;
          print_state_pool = SCM_CDR (print_state_pool);
@@ -759,12 +763,12 @@ scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate)
      O(depth * N) instead of O(N^2). */
   hare = SCM_CDR (exp);
   tortoise = exp;
-  while (SCM_CONSP (hare))
+  while (scm_is_pair (hare))
     {
       if (scm_is_eq (hare, tortoise))
        goto fancy_printing;
       hare = SCM_CDR (hare);
-      if (!SCM_CONSP (hare))
+      if (!scm_is_pair (hare))
        break;
       hare = SCM_CDR (hare);
       tortoise = SCM_CDR (tortoise);
@@ -772,7 +776,7 @@ scm_iprlist (char *hdr, SCM exp, int tlr, SCM port, scm_print_state *pstate)
   
   /* No cdr cycles intrinsic to this list */
   scm_iprin1 (SCM_CAR (exp), port, pstate);
-  for (exp = SCM_CDR (exp); SCM_CONSP (exp); exp = SCM_CDR (exp))
+  for (exp = SCM_CDR (exp); scm_is_pair (exp); exp = SCM_CDR (exp))
     {
       register long i;
 
@@ -801,7 +805,7 @@ fancy_printing:
     
     scm_iprin1 (SCM_CAR (exp), port, pstate);
     exp = SCM_CDR (exp); --n;
-    for (; SCM_CONSP (exp); exp = SCM_CDR (exp))
+    for (; scm_is_pair (exp); exp = SCM_CDR (exp))
       {
        register unsigned long i;
 
@@ -913,9 +917,9 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   SCM port, answer = SCM_UNSPECIFIED;
   int fReturnString = 0;
   int writingp;
-  char *start;
-  char *end;
-  char *p;
+  const char *start;
+  const char *end;
+  const char *p;
 
   if (scm_is_eq (destination, SCM_BOOL_T))
     {
@@ -938,8 +942,8 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
   SCM_VALIDATE_STRING (2, message);
   SCM_VALIDATE_REST_ARGUMENT (args);
 
-  start = SCM_I_STRING_CHARS (message);
-  end = start + SCM_I_STRING_LENGTH (message);
+  start = scm_i_string_chars (message);
+  end = start + scm_i_string_length (message);
   for (p = start; p != end; ++p)
     if (*p == '~')
       {
@@ -970,7 +974,7 @@ SCM_DEFINE (scm_simple_format, "simple-format", 2, 0, 1,
          }
 
 
-       if (!SCM_CONSP (args))
+       if (!scm_is_pair (args))
          SCM_MISC_ERROR ("FORMAT: Missing argument for ~~~A",
                          scm_list_1 (SCM_MAKE_CHAR (*p)));
                                        
@@ -1102,9 +1106,10 @@ scm_init_print ()
   scm_gc_register_root (&print_state_pool);
   scm_gc_register_root (&scm_print_state_vtable);
   vtable = scm_make_vtable_vtable (scm_nullstr, SCM_INUM0, SCM_EOL);
-  layout = scm_make_struct_layout (scm_makfrom0str (SCM_PRINT_STATE_LAYOUT));
+  layout =
+    scm_make_struct_layout (scm_from_locale_string (SCM_PRINT_STATE_LAYOUT));
   type = scm_make_struct (vtable, SCM_INUM0, scm_list_1 (layout));
-  scm_set_struct_vtable_name_x (type, scm_str2symbol ("print-state"));
+  scm_set_struct_vtable_name_x (type, scm_from_locale_symbol ("print-state"));
   scm_print_state_vtable = type;
 
   /* Don't want to bind a wrapper class in GOOPS, so pass 0 as arg1. */