* print.c (scm_iprin1): Print gsubrs as primitives.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 8491619..a67d0c6 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,7 @@
+1998-11-10  Mikael Djurfeldt  <mdj@barbara.nada.kth.se>
+
+       * print.c (scm_iprin1): Print gsubrs as primitives.
+
 1998-11-09  Mikael Djurfeldt  <mdj@barbara.nada.kth.se>
 
        * debug.h (SCM_MACROFRAME, SCM_MACROFRAMEP): New frame type.

diff --git a/libguile/print.c b/libguile/print.c
index b259fbe..0a3f808 100644 (file)
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -604,9 +604,26 @@ taloop:
          break;
 #ifdef CCLO
        case scm_tc7_cclo:
-         scm_puts ("#<compiled-closure ", port);
-         scm_iprin1 (SCM_CCLO_SUBR (exp), port, pstate);
-         scm_putc ('>', port);
+         {
+           SCM proc = SCM_CCLO_SUBR (exp);
+           if (proc == scm_f_gsubr_apply)
+             {
+               /* Print gsubrs as primitives */
+               SCM name = scm_procedure_property (exp, scm_i_name);
+               scm_puts ("#<primitive-procedure", port);
+               if (SCM_NFALSEP (name))
+                 {
+                   scm_putc (' ', port);
+                   scm_puts (SCM_CHARS (name), port);
+                 }
+             }
+           else
+             {
+               scm_puts ("#<compiled-closure ", port);
+               scm_iprin1 (proc, port, pstate);
+             }
+           scm_putc ('>', port);
+         }
          break;
 #endif
        case scm_tc7_contin: