PRELIMINARY print: Support SRFI-38 datum label notation.

libguile/init.c

@@ -1,6 +1,4 @@
-/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
- *   2004, 2006, 2009, 2010, 2011, 2012, 2013,
- *   2014 Free Software Foundation, Inc.
+/* Copyright (C) 1995-2004, 2006, 2009-2014 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
@@ -487,7 +485,7 @@ scm_i_init_guile (void *base)
   scm_init_symbols ();
   scm_init_values ();   /* Requires struct */
   scm_init_load ();     /* Requires strings */
-  scm_init_print ();	/* Requires strings, struct, smob */
+  scm_init_print ();	/* Requires strings, struct, smob, hashtab */
   scm_init_read ();
   scm_init_strorder ();
   scm_init_srfi_13 ();

libguile/private-options.h

@@ -53,7 +53,8 @@ SCM_INTERNAL scm_t_option scm_print_opts[];
 #define SCM_PRINT_KEYWORD_STYLE     (SCM_PACK (scm_print_opts[2].val))
 #define SCM_PRINT_ESCAPE_NEWLINES_P scm_print_opts[3].val
 #define SCM_PRINT_R7RS_SYMBOLS_P    scm_print_opts[4].val
-#define SCM_N_PRINT_OPTIONS 5
+#define SCM_PRINT_DATUM_LABELS_P    scm_print_opts[5].val
+#define SCM_N_PRINT_OPTIONS 6
 
 
 /*

libguile/strports.c

@@ -354,33 +354,50 @@ scm_mkstrport (SCM pos, SCM str, long modes, const char *caller)
   return z;
 }
 
-/* Create a new string from the buffer of PORT, a string port, converting from
-   PORT's encoding to the standard string representation.  */
+/* Create a new string from the specified byte range of the buffer of
+   PORT, a string port, converting from PORT's encoding to the standard
+   string representation.  */
 SCM
-scm_strport_to_string (SCM port)
+scm_i_strport_to_string (SCM port, SCM start, SCM end)
 {
   SCM str;
+  size_t cstart, cend, len;
   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
   if (pt->rw_active == SCM_PORT_WRITE)
     st_flush (port);
 
-  if (pt->read_buf_size == 0)
+  cstart = SCM_UNBNDP (start) ? 0 : scm_to_size_t (start);
+  cend = SCM_UNBNDP (end) ? pt->read_buf_size : scm_to_size_t (end);
+
+  if (cstart < cend)
+    len = cend - cstart;
+  else if (cstart == cend)
     return scm_nullstr;
+  else
+    abort ();
 
   if (pt->encoding == NULL)
     {
       char *buf;
-      str = scm_i_make_string (pt->read_buf_size, &buf, 0);
-      memcpy (buf, pt->read_buf, pt->read_buf_size);
+      str = scm_i_make_string (len, &buf, 0);
+      memcpy (buf, pt->read_buf + cstart, len);
     }
   else
-    str = scm_from_stringn ((char *)pt->read_buf, pt->read_buf_size,
+    str = scm_from_stringn ((char *)pt->read_buf + cstart, len,
                             pt->encoding, pt->ilseq_handler);
   scm_remember_upto_here_1 (port);
   return str;
 }
 
+/* Create a new string from the buffer of PORT, a string port, converting from
+   PORT's encoding to the standard string representation.  */
+SCM
+scm_strport_to_string (SCM port)
+{
+  return scm_i_strport_to_string (port, SCM_UNDEFINED, SCM_UNDEFINED);
+}
+
 SCM_DEFINE (scm_object_to_string, "object->string", 1, 1, 0,
 	    (SCM obj, SCM printer),
 	    "Return a Scheme string obtained by printing @var{obj}.\n"

libguile/strports.h

@@ -3,7 +3,8 @@
 #ifndef SCM_STRPORTS_H
 #define SCM_STRPORTS_H
 
-/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000,2001,2002, 2006, 2008, 2010,
+ *   2014 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
@@ -56,6 +57,7 @@ SCM_API SCM scm_c_eval_string (const char *expr);
 SCM_API SCM scm_c_eval_string_in_module (const char *expr, SCM module);
 SCM_API SCM scm_eval_string (SCM string);
 SCM_API SCM scm_eval_string_in_module (SCM string, SCM module);
+SCM_INTERNAL SCM scm_i_strport_to_string (SCM port, SCM start, SCM end);
 SCM_INTERNAL void scm_init_strports (void);
 
 #endif  /* SCM_STRPORTS_H */

module/scheme/write.scm

@@ -25,14 +25,7 @@
   (import (scheme base)
           (rename (only (guile)
                         display
-                        write)
-                  (write guile-write)))
+                        write
+                        write-shared)))
   (begin
-    (define write-simple guile-write)
-
-    ;; XXX FIXME outputs cyclic data in non-standard format.
-    (define write guile-write)
-
-    ;; XXX FIXME doesn't show non-cyclic sharing, and outputs cyclic
-    ;; data in non-standard format.
-    (define write-shared guile-write)))
+    (define write-simple write)))