This is the mail archive of the kawa@sourceware.org mailing list for the Kawa project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH] Format's W directive not handling shared structures correctly.


~W wasn't being treated as special case in the ObjectFormat class,
I've changed it to communicate with the pretty printer.

> (define a (cons 'a 'z)
> (set-cdr! a a)
> (format "~W" a)
... OutOfMemory ...

with the patch

> (format "~W" a)
#1=(a . #1#) ; as described in
http://www.lispworks.com/documentation/HyperSpec/Body/22_cdc.htm

One obviously unpleasing part of this patch is that I'm doing the same
setup/finalisation in ObjectFormat#print as I did in
write-with-shared-structure in ports.scm.

This patch comes with a change log and a couple of tests.

I noticed that the javadoc linked from the Kawa homepage hasn't been
updated for some time (well, my documentation changes aren't in it).
Is that just a no time thing, or am I the only one who's noticed?

Sorry for the disappearance, I've been struggling to fit Kawa
development into my other commitments.

Kind regards,
Charles.
Index: gnu/kawa/functions/ChangeLog
===================================================================
--- gnu/kawa/functions/ChangeLog	(revision 7085)
+++ gnu/kawa/functions/ChangeLog	(working copy)
@@ -1,3 +1,12 @@
+2011-11-23  Charles Turner  <chturne@gmail.com>
+
+	* ObjectFormat.java (sharableFormat): New static field to facilitate
+	shared structure checks. New checks based on this field were added to
+	instantiate the right format object. When writing a shared structure,
+	the pretty writer needs to be manually controlled (see Fix me:).
+	* LispFormat.java: Distinguish between ~S and ~W control characters.
+
+
 2011-10-08  Jamison Hope  <jrh@theptrgroup.com>
 
 	* IsEqual.java (arrayEquals): New method, to compare Java arrays
Index: gnu/kawa/functions/ObjectFormat.java
===================================================================
--- gnu/kawa/functions/ObjectFormat.java	(revision 7085)
+++ gnu/kawa/functions/ObjectFormat.java	(working copy)
@@ -14,24 +14,32 @@
    * The value PARAM_UNSPECIFIED means "no limit". */
   int maxChars;
   boolean readable;
-
+  boolean checkSharing;
+  
   private static ObjectFormat readableFormat;
+  private static ObjectFormat sharableFormat;
   private static ObjectFormat plainFormat;
 
-  public static ObjectFormat getInstance(boolean readable)
+  public static ObjectFormat getInstance(boolean readable, boolean checkSharing)
   {
-    if (readable)
-      {
-	if (readableFormat == null)
-	  readableFormat = new ObjectFormat(true);
-	return readableFormat;
-      }
+    if (checkSharing)
+    {
+      if (sharableFormat == null)
+        sharableFormat = new ObjectFormat(true, true);
+      return sharableFormat;
+    }
+    else if (readable)
+    {
+      if (readableFormat == null)
+        readableFormat = new ObjectFormat(true);
+      return readableFormat;
+    }
     else
-      {
-	if (plainFormat == null)
-	  plainFormat = new ObjectFormat(false);
-	return plainFormat;
-      }
+    {
+      if (plainFormat == null)
+        plainFormat = new ObjectFormat(false);
+      return plainFormat;
+    }
   }
 
   public ObjectFormat(boolean readable)
@@ -39,6 +47,13 @@
     this.readable = readable;
     maxChars = PARAM_UNSPECIFIED;
   }
+  
+  public ObjectFormat(boolean readable, boolean checkSharing)
+  {
+    this.readable = readable;
+    this.checkSharing = checkSharing;
+    maxChars = PARAM_UNSPECIFIED;
+  }
 
   public ObjectFormat(boolean readable, int maxChars)
   {
@@ -51,21 +66,42 @@
   {
     int maxChars = getParam(this.maxChars, -1, args, start);
     if (this.maxChars == PARAM_FROM_LIST)  start++;
-    return format(args, start, dst, maxChars, readable);
+    return format(args, start, dst, maxChars, readable, checkSharing);
   }
 
   private static void print (Object obj, OutPort out,
-			     boolean readable)
+			     boolean readable, boolean checkSharing)
   {
     boolean saveReadable = out.printReadable;
     AbstractFormat saveFormat = out.objectFormat;
     try
       {
 	out.printReadable = readable;
-	AbstractFormat format
-	  = readable ? Scheme.writeFormat : Scheme.displayFormat;
+	AbstractFormat format;
+        if (readable && checkSharing)
+          format = Scheme.sharedWriteFormat;
+        else if (readable)
+          format = Scheme.writeFormat;
+        else
+	  format = Scheme.displayFormat;
+        
 	out.objectFormat = format;
-	format.writeObject(obj, (gnu.lists.Consumer) out);
+        if (checkSharing) // Fix me: This is mostly repeated from ports.scm
+        {
+          PrettyWriter pout = out.getPrettyWriter();
+          pout.initialiseIDHash();
+          pout.setSharing(true);
+          try {
+            format.writeObject(obj, (gnu.lists.Consumer) out);
+          } finally {
+            pout.setSharing(false);
+          }
+          pout.clearIDHash();
+          pout.writeEndOfExpression();
+          pout.resolveBackReferences();
+        } else {
+          format.writeObject(obj, (gnu.lists.Consumer) out);
+        }
       }
     finally
       {
@@ -79,18 +115,18 @@
    * @param maxChars maximum number of characters; -1 means unlimited
    */
   public static boolean format(Object arg, Writer dst,
-			       int maxChars, boolean readable)
+			       int maxChars, boolean readable, boolean checkSharing)
     throws java.io.IOException
   {
     if (maxChars < 0 && dst instanceof OutPort)
       {
-	print(arg, (OutPort) dst, readable);
+	print(arg, (OutPort) dst, readable, checkSharing);
 	return true;
       }
     else if (maxChars < 0 && dst instanceof CharArrayWriter)
       {
 	OutPort oport = new OutPort(dst);
-	print(arg, oport, readable);
+	print(arg, oport, readable, checkSharing);
 	oport.close();
 	return true;
       }
@@ -98,7 +134,7 @@
       {
 	CharArrayWriter wr = new CharArrayWriter();
 	OutPort oport = new OutPort(wr);
-	print(arg, oport, readable);
+	print(arg, oport, readable, checkSharing);
 	oport.close();
 	int len = wr.size();
 	if (maxChars < 0 || len <= maxChars)
@@ -115,7 +151,7 @@
   }
 
   public static int format(Object[] args, int start, Writer dst,
-			   int maxChars, boolean readable)
+			   int maxChars, boolean readable, boolean checkSharing)
     throws java.io.IOException
   {
     Object arg;
@@ -128,7 +164,7 @@
       }
     else
       arg = args[start];
-    format(arg, dst, maxChars, readable);
+    format(arg, dst, maxChars, readable, checkSharing);
     return start + 1;
   }
 
Index: gnu/kawa/functions/LispFormat.java
===================================================================
--- gnu/kawa/functions/LispFormat.java	(revision 7085)
+++ gnu/kawa/functions/LispFormat.java	(working copy)
@@ -16,6 +16,14 @@
   public static final String paramFromCount = "<from count>";
   public static final String paramUnspecified = "<unspecified>";
 
+  /**
+   * Create a new Lisp Format.
+   * 
+   * @param format A character array representation of the format string.
+   * @param offset Where to start parsing.
+   * @param length When to stop parsing.
+   * @throws ParseException 
+   */
   public LispFormat(char[] format, int offset, int length)
     throws ParseException
   {
@@ -158,10 +166,9 @@
 	    else
 	      fmt = dfmt;
 	    break;
-	  case 'A':  case 'S':  case 'W':
+	  case 'A':  case 'S': case 'W':
 	  case 'Y':  // SRFI-48 "yuppify" (pretty-print)
-	    // We don't distinguish between ~S and ~W.  FIXME.
-	    fmt = ObjectFormat.getInstance(ch != 'A');
+	    fmt = ObjectFormat.getInstance(ch != 'A', ch == 'W');
 	    if (numParams > 0)
 	      {
 		minWidth = getParam(stack, speci);
@@ -905,7 +912,7 @@
 	    if (out != null)
 	      out.startLogicalBlock(pre, perLine, suffix);
 	    if (curArr == null)
-	      ObjectFormat.format(curArg, dst, -1, true);
+	      ObjectFormat.format(curArg, dst, -1, true, false);
 	    else
 	      ReportFormat.format(body, curArr, 0, dst, fpos);
 	    start++;
Index: gnu/kawa/functions/Format.java
===================================================================
--- gnu/kawa/functions/Format.java	(revision 7085)
+++ gnu/kawa/functions/Format.java	(working copy)
@@ -15,11 +15,20 @@
                        "gnu.kawa.functions.CompileMisc:validateApplyFormat");
   }
 
+  /**
+   * Format a string at given offset to the given writer.
+   * @param dst The destination stream.
+   * @param args An array whose first element contains the format string, and
+   * whose remaining elements contain the evaluated format parameters.
+   * @param arg_offset Where to start formatting in the args array.
+   */
   public static void format (Writer dst, Object[] args, int arg_offset)
   {
+    // Split the format string and the format arguments.
     Object format = args[arg_offset++];
     Object[] vals = new Object[args.length - arg_offset];
     System.arraycopy(args, arg_offset, vals, 0, vals.length);
+    
     formatToWriter(dst, format, vals);
   }
 
@@ -57,6 +66,7 @@
   public static String formatToString (int arg_offset, Object... args)
   {
     CharArrayOutPort port = new CharArrayOutPort();
+    // Place the result of formatting in port.
     format(port, args, arg_offset);
     String str = port.toString();
     port.close ();
Index: gnu/text/CompoundFormat.java
===================================================================
--- gnu/text/CompoundFormat.java	(revision 7085)
+++ gnu/text/CompoundFormat.java	(working copy)
@@ -5,7 +5,9 @@
 
 public class CompoundFormat extends ReportFormat
 {
+  // The number of format control characters
   protected int length;
+  // The Format's representing these control characters
   protected Format[] formats;
 
   public CompoundFormat(Format[] formats, int length)
Index: testsuite/formatst.scm
===================================================================
--- testsuite/formatst.scm	(revision 7085)
+++ testsuite/formatst.scm	(working copy)
@@ -28,7 +28,7 @@
 ;      (newline)
 ;      (format:abort)))
 
-(test-begin "format" 423)
+(test-begin "format" 425)
 (define-syntax test 
   (syntax-rules ()
     ((test format-args out-str)
@@ -719,6 +719,15 @@
 (test '("~10,3F" 1.0025) "     1.002")
 (test '("~10,3F" 1.00256) "     1.003")
 
+;; Test that communication with the pretty printer works for shared
+;; structures
+(define circ1 (list 1 2 3))
+(define circ2 (cons 'a 'z))
+(set-car! (cdr circ1) circ1)
+(set-cdr! circ2 circ2)
+(test-equal (format "~W" circ1) "#1=(1 #1# 3)")
+(test-equal (format "~W" circ2) "#1=(a . #1#)")
+
 ; inquiry test
 
 ;; SLIB specific: (test '("~:q") format:version)

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]