* configure.in: check for hstrerror.

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

diff --git a/libguile/print.c b/libguile/print.c
index 00b4e3a..15ceaf9 100644 (file)
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
+/*     Copyright (C) 1995-1999 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -53,6 +53,7 @@
 #include "unif.h"
 #include "alist.h"
 #include "struct.h"
+#include "objects.h"
 
 #include "print.h"
 \f
@@ -97,7 +98,6 @@ char *scm_isymnames[] =
   "()",
   "#<unspecified>",
   "#@dispatch",
-  "#@hash-dispatch",
   "#@slot-ref",
   "#@slot-set!",
 
@@ -109,7 +109,9 @@ char *scm_isymnames[] =
   "#@0-cond",
   "#@0-ify",
   "#@1-ify",
-  "#@bind"
+  "#@bind",
+  
+  "#@delay"
 };
 
 scm_option scm_print_opts[] = {
@@ -284,7 +286,8 @@ print_circref (port, pstate, ref)
 
 /* Print generally.  Handles both write and display according to PSTATE.
  */
-
+SCM_GPROC(s_write, "write", 1, 1, 0, scm_write, g_write);
+SCM_GPROC(s_display, "display", 1, 1, 0, scm_display, g_display);
 
 void 
 scm_iprin1 (exp, port, pstate)
@@ -348,7 +351,21 @@ taloop:
          if (SCM_CDR (SCM_CAR (exp) - 1L) == 0)
            {
              ENTER_NESTED_DATA (pstate, exp, circref);
-             scm_print_struct (exp, port, pstate);
+             if (SCM_OBJ_CLASS_FLAGS (exp) & SCM_CLASSF_GOOPS)
+               {
+                 SCM pwps, print = pstate->writingp ? g_write : g_display;
+                 if (!print)
+                   goto print_struct;
+                 SCM_NEWSMOB (pwps,
+                              scm_tc16_port_with_ps,
+                              scm_cons (port, pstate->handle));
+                 scm_call_generic_2 (print, exp, pwps);
+               }
+             else
+               {
+               print_struct:
+                 scm_print_struct (exp, port, pstate);
+               }
              EXIT_NESTED_DATA (pstate);
              break;
            }
@@ -583,13 +600,16 @@ taloop:
        case scm_tc7_fvect:
        case scm_tc7_dvect:
        case scm_tc7_cvect:
-#ifdef LONGLONGS
+#ifdef HAVE_LONG_LONGS
        case scm_tc7_llvect:
 #endif
          scm_raprin1 (exp, port, pstate);
          break;
        case scm_tcs_subrs:
-         scm_puts ("#<primitive-procedure ", port);
+         scm_puts (SCM_SUBR_GENERIC (exp) && *SCM_SUBR_GENERIC (exp)
+                   ? "#<primitive-generic "
+                   : "#<primitive-procedure ",
+                   port);
          scm_puts (SCM_CHARS (SCM_SNAME (exp)), port);
          scm_putc ('>', port);
          break;
@@ -693,10 +713,10 @@ scm_prin1 (exp, port, writingp)
   /* If PORT is a print-state/port pair, use that.  Else create a new
      print-state. */
 
-  if (SCM_NIMP (port) && SCM_CONSP (port))
+  if (SCM_NIMP (port) && SCM_PORT_WITH_PS_P (port))
     {
-      pstate_scm = SCM_CDR (port);
-      port = SCM_CAR (port);
+      pstate_scm = SCM_PORT_WITH_PS_PS (port);
+      port = SCM_PORT_WITH_PS_PORT (port);
     }
   else
     {
@@ -890,7 +910,7 @@ scm_valid_oport_value_p     (SCM val)
                  && SCM_OPOUTPORTP (SCM_PORT_WITH_PS_PORT (val)))));
 }
 
-SCM_PROC(s_write, "write", 1, 1, 0, scm_write);
+/* SCM_GPROC(s_write, "write", 1, 1, 0, scm_write, g_write); */
 
 SCM 
 scm_write (obj, port)
@@ -899,8 +919,8 @@ scm_write (obj, port)
 {
   if (SCM_UNBNDP (port))
     port = scm_cur_outp;
-  else
-    SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_write);
+
+  SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_write);
 
   scm_prin1 (obj, port, 1);
 #ifdef HAVE_PIPE
@@ -913,7 +933,7 @@ scm_write (obj, port)
 }
 
 
-SCM_PROC(s_display, "display", 1, 1, 0, scm_display);
+/* SCM_GPROC(s_display, "display", 1, 1, 0, scm_display, g_display); */
 
 SCM 
 scm_display (obj, port)
@@ -922,8 +942,8 @@ scm_display (obj, port)
 {
   if (SCM_UNBNDP (port))
     port = scm_cur_outp;
-  else
-    SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_display);
+
+  SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_display);
 
   scm_prin1 (obj, port, 0);
 #ifdef HAVE_PIPE
@@ -943,8 +963,8 @@ scm_newline (port)
 {
   if (SCM_UNBNDP (port))
     port = scm_cur_outp;
-  else
-    SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG1, s_newline);
+
+  SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG1, s_newline);
 
   scm_putc ('\n', SCM_COERCE_OUTPORT (port));
   return SCM_UNSPECIFIED;
@@ -959,8 +979,8 @@ scm_write_char (chr, port)
 {
   if (SCM_UNBNDP (port))
     port = scm_cur_outp;
-  else
-    SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_write_char);
+
+  SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_write_char);
 
   SCM_ASSERT (SCM_ICHRP (chr), chr, SCM_ARG1, s_write_char);
   scm_putc ((int) SCM_ICHR (chr), SCM_COERCE_OUTPORT (port));