[m-dev.] diff: use pretty printer in mdb

[Mark Anthony BROWN]

Please ignore my previous post, it was sent by mistake.

Mark Anthony BROWN writes:
> 
> As for the performance problem, I think it can be solved by threading
> the available width through flatten, which should fail if there is not
> enough room for the flattened document.  This will allow the 
> condition (in be/3) to fail before the recursive call.
> 

This solution appears to work OK.  If there are no objections,
I shall commit this change soon.

Cheers,
Mark.


Estimated hours taken: 3

library/pprint.m:
	Fix a bug which led to exponential worst-case performance.
	We check the size of a document as it is being flattened,
	rather than afterward.  This means failure can occur earlier,
	which usually avoids an unnecessary recursive call while
	processing 'GROUP' documents.

Index: library/pprint.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/pprint.m,v
retrieving revision 1.2
diff -u -r1.2 pprint.m
--- library/pprint.m	2000/05/09 13:06:47	1.2
+++ library/pprint.m	2000/05/23 05:51:30
@@ -346,13 +346,6 @@
 
 %------------------------------------------------------------------------------%
 
-    % XXX We could do with a spot of laziness to avoid exponential
-    % run-times in the worst case here.  The problem is that flatten/1
-    % need only be evaluated to the point where it can be decided
-    % (by better/4 and fits/2) whether a structure is going to fit on
-    % the remainder of the line or not.  In practice, eagerness doesn't
-    % seem to be a problem.
-
 :- func be(int, int, list(pair(string, doc))) = simple_doc.
 
 be(_, _, [])                      = nil.
@@ -364,8 +357,8 @@
 be(W, _, [I - 'LINE'        | Z]) = I `line` be(W, string__length(I), Z).
 be(W, K, [I - 'GROUP'(X)    | Z]) =
     ( if
-        K =< W,                         % Really want an ordered conjunction...
-        Flattened = be(W, K, [I - flatten(X) | Z]),
+        try_flatten(X, FlatX, W - K, _),
+        Flattened = be(W, K, [I - FlatX | Z]),
         fits(W - K, Flattened)
       then
         Flattened
@@ -380,16 +373,32 @@
 extend(I, J) = string__append(I, string__duplicate_char(' ', J)).
 
 %------------------------------------------------------------------------------%
-
-:- func flatten(doc) = doc.
 
-flatten('NIL')          = 'NIL'.
-flatten('SEQ'(X, Y))    = 'SEQ'(flatten(X), flatten(Y)).
-flatten('NEST'(_, X))   = flatten(X).
-flatten('LABEL'(_, X))  = flatten(X).
-flatten('TEXT'(S))      = 'TEXT'(S).
-flatten('LINE')         = 'NIL'.
-flatten('GROUP'(X))     = flatten(X).
+    % While flattening documents, we keep track of the amount of
+    % space available on the line.  This predicate fails if there
+    % is not enough space for the flattened term.
+    %
+:- pred try_flatten(doc, doc, int, int).
+:- mode try_flatten(in, out, in, out) is semidet.
+
+try_flatten('NIL', 'NIL') -->
+    [].
+try_flatten('SEQ'(X, Y), 'SEQ'(FX, FY)) -->
+    try_flatten(X, FX),
+    try_flatten(Y, FY).
+try_flatten('NEST'(_, X), FX) -->
+    try_flatten(X, FX).
+try_flatten('LABEL'(_, X), FX) -->
+    try_flatten(X, FX).
+try_flatten('TEXT'(S), 'TEXT'(S)) -->
+    =(W0),
+    { W = W0 - string__length(S) },
+    { W >= 0 },
+    :=(W).
+try_flatten('LINE', 'NIL') -->
+    [].
+try_flatten('GROUP'(X), FX) -->
+    try_flatten(X, FX).
 
 %------------------------------------------------------------------------------%
 
-- 
Mark Brown, PhD student            )O+  |  "Another of Fortran's breakthroughs
(m.brown at cs.mu.oz.au)                   |  was the GOTO statement, which was...
Dept. of Computer Science and Software  |  uniquely simple and understandable"
Engineering, University of Melbourne    |              -- IEEE, 1994
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------