This is the mail archive of the
kawa@sourceware.org
mailing list for the Kawa project.
Re: [PATCH] Format's W directive not handling shared structures correctly.
On 30 November 2011 23:55, Charles Turner <chturne@gmail.com> wrote:
> On 27 November 2011 23:10, Per Bothner <per@bothner.com> wrote:
>> The result is "#1=((a . z) #1# #1#)" but IMO it should be
>> "(#1=(a . z) #1# #1#)". ÂCould you look into it?
>
> I'll try and look into this at some point this week.
The problem was that PrettyWriter#startLogicalBlock didn't enqueue a
logical block queue item when we encountered open parens, since FORMAT
is creating a string, we're in a prettyPritingMode of zero. The queue
items are used in resolveBackReferences, since they were not existent,
the gap buffer wasn't skipping past them, hence the first position
marker being written first.
My solution was to check if we're doing a shared printing, and if so,
enqueue the logical block items anyway, even though they won't be used
for any formatting, they'll just be used as markers in
resolveBackReferences. A bit wasteful, but I can't think of a better
solution to this right now.
I think I've incorporated all your changes in this patch.
Charlie.
Index: gnu/kawa/functions/ChangeLog
===================================================================
--- gnu/kawa/functions/ChangeLog (revision 7092)
+++ 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 7092)
+++ 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,47 @@
{
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);
}
+
+ public static void printWithSharing (Object obj, OutPort out, AbstractFormat format)
+ {
+ PrettyWriter pout = out.getPrettyWriter();
+ pout.initialiseIDHash();
+ pout.setSharing(true);
+ try
+ {
+ format.format(obj, out);
+ } finally
+ {
+ pout.setSharing(false);
+ }
+ pout.clearIDHash();
+ pout.writeEndOfExpression();
+ pout.resolveBackReferences();
+ }
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)
+ printWithSharing(obj, out, format);
+ else
+ format.writeObject(obj, (gnu.lists.Consumer) out);
}
finally
{
@@ -79,18 +120,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 +139,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 +156,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 +169,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 7092)
+++ 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 7092)
+++ 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/PrettyWriter.java
===================================================================
--- gnu/text/PrettyWriter.java (revision 7092)
+++ gnu/text/PrettyWriter.java (working copy)
@@ -1031,7 +1031,7 @@
}
if (prefix != null)
write(prefix);
- if (prettyPrintingMode == 0)
+ if (prettyPrintingMode == 0 && !sharing)
return;
int start = enqueue (QITEM_BLOCK_START_TYPE,
QITEM_BLOCK_START_SIZE);
Index: gnu/text/CompoundFormat.java
===================================================================
--- gnu/text/CompoundFormat.java (revision 7092)
+++ 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: kawa/standard/TracedProcedure.java
===================================================================
--- kawa/standard/TracedProcedure.java (revision 7092)
+++ kawa/standard/TracedProcedure.java (working copy)
@@ -27,7 +27,7 @@
{
try
{
- if (! ObjectFormat.format(value, out, 50, true))
+ if (! ObjectFormat.format(value, out, 50, true, true))
out.print("...");
}
catch (java.io.IOException ex)
Index: kawa/lib/ports.scm
===================================================================
--- kawa/lib/ports.scm (revision 7092)
+++ kawa/lib/ports.scm (working copy)
@@ -110,16 +110,10 @@
(define (write-with-shared-structure
value #!optional (out ::output-port (current-output-port))) ::void
- (let ((pretty-out (out:getPrettyWriter)))
- (pretty-out:initialiseIDHash)
- (pretty-out:setSharing #t)
- (try-finally
- (*:format (kawa.standard.Scheme:.sharedWriteFormat) value out)
- (pretty-out:setSharing #f))
- (pretty-out:clearIDHash)
- (pretty-out:writeEndOfExpression)
- (pretty-out:resolveBackReferences)
- (pretty-out:flush)))
+ (gnu.kawa.functions.ObjectFormat:printWithSharing
+ value out
+ kawa.standard.Scheme:sharedWriteFormat)
+ ((out:getPrettyWriter):forcePrettyOutput))
(define (display value #!optional (out (current-output-port))) :: <void>
(*:format (kawa.standard.Scheme:.displayFormat) value out))
Index: testsuite/formatst.scm
===================================================================
--- testsuite/formatst.scm (revision 7092)
+++ testsuite/formatst.scm (working copy)
@@ -28,7 +28,7 @@
; (newline)
; (format:abort)))
-(test-begin "format" 423)
+(test-begin "format" 428)
(define-syntax test
(syntax-rules ()
((test format-args out-str)
@@ -719,6 +719,19 @@
(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))
+(define circ23 (list circ2 circ2 circ2))
+(test-equal "(#1=(a . z) #1# #1#)" (format "~W" circ23));
+(test-equal "((a . z) (a . z) (a . z))" (format "~A" circ23));
+(test-equal "((a . z) (a . z) (a . z))" (format "~S" circ23));
+(set-car! (cdr circ1) circ1)
+(set-cdr! circ2 circ2)
+(test-equal "#1=(1 #1# 3)" (format "~W" circ1))
+(test-equal "#1=(a . #1#)" (format "~W" circ2))
+
; inquiry test
;; SLIB specific: (test '("~:q") format:version)