[m-dev.] For review: pprint performance bug fix and misc. changes

[Ralph Becket]

I've fixed the performance bug in the pretty printer and made one or
two other small changes.

Ralph

Estimated hours taken: 2

Fixed the performance problem with the pretty printer; runtime
should now be linear in the size of the input (the previous
version suffered from being a somewhat optimistic direct
transliteration of a Haskell program).

Also made one or two other minor changes.

library/pprint.m
	Changed the formatting decision procedure from
	flatten/1 + be/3 + fits/2 (short and sweet and
	works fine if you have laziness) to a new set of
	predicates flattening_works/3 + fits_flattened/3 +
	fits_on_rest/2 which ensure linear run-time
	behaviour and reduce structure creation.

	Changed to_doc/[1,2] so that closing parentheses
	don't appear on separate lines, so as to reduce
	the amount of vertical space consumed.

	Extended the comment for separated/3 to include a
	useful idiom and changed the implementation so that
	docs created by separated/3 nest to the right.

	Simplified the definition of word_wrapped/1 to use
	the above idiom.

Index: pprint.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/pprint.m,v
retrieving revision 1.1
diff -u -u -r1.1 pprint.m
--- pprint.m	2000/05/03 09:56:46	1.1
+++ pprint.m	2000/05/23 09:56:55
@@ -28,7 +28,7 @@
 %    unless that is unavoidable; and
 % 3. the pretty printer is bounded in that it never needs to
 %    look more than k characters ahead to make a formatting
-%    decision (although see the XXX comment below).
+%    decision (although see the XXX comments below).
 %
 % I have made three small changes:
 %
@@ -52,6 +52,11 @@
 % errors and warnings that should be prefixed with the
 % offending source file and line number.
 %
+% Performance problems due to the current lack of support
+% for laziness in Mercury has meant that the formatting
+% decision procedure has had to be recoded to preserve
+% linear runtime behaviour in an eager language.
+%
 % I have also added several obvious general purpose
 % formatting functions.
 %
@@ -212,8 +217,14 @@
 :- func braces(doc)                     = doc.
 
     % separated(PP, Sep, [X1,...,Xn]) =
-    %   PP(X1) `<>` Sep `<>` ... Sep `<>` PP(Xn)
+    %   PP(X1) `<>` (Sep `<>` ... (Sep `<>` PP(Xn)) ... )
+    %
+    % Note that if you want to pack as many things on one
+    % line as possible with some sort of separator, the
+    % following example illustrates a suitable idiom:
     %
+    %   separated(PP, group(comma_space_line), Xs)
+    %
 :- func separated(func(T) = doc, doc, list(T)) = doc.
 
     % Handy punctuation docs and versions with following
@@ -346,12 +357,10 @@
 
 
%---------------------------------------------------------------------------
---%
 
-    % 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.
+    % XXX The last clause in this predicate has been recoded to use
+    % flattening_works/3, an eager decision procedure, to avoid
+    % unacceptable performance on large terms.  A spot of laziness
+    % would do away with the need for the `fits_XXX' etc. predicates.
 
 :- func be(int, int, list(pair(string, doc))) = simple_doc.
 
@@ -363,21 +372,68 @@
 be(W, K, [_ - 'TEXT'(S)     | Z]) = S `text` be(W, (K + string__length(S)),
Z).
 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]),
-        fits(W - K, Flattened)
-      then
-        Flattened
+    ( if flattening_works(X, Z, W - K) then
+        be(W, K, [I - flatten(X) | Z])
       else
         be(W, K, [I - X | Z])
     ).
-
-%--------------------------------------------------------------------------
----%
 
-:- func extend(string, int) = string.
+%
----------------------------------------------------------------------------
%
 
-extend(I, J) = string__append(I, string__duplicate_char(' ', J)).
+    % Decide whether flattening a given doc will allow it and
+    % up to the next possible 'LINE' in the following docs to
+    % fit on the remainder of the line.
+    %
+    % XXX This solution is necessary to avoid crippling performance
+    % problems on large terms.  A spot of laziness would do away
+    % with the need for the next three predicates.
+    %
+:- pred flattening_works(doc, list(pair(string, doc)), int).
+:- mode flattening_works(in, in, in) is semidet.
+
+flattening_works(DocToFlatten, FollowingDocs, RemainingWidth) :-
+    fits_flattened([DocToFlatten], RemainingWidth, RemainingWidth0),
+    fits_on_rest(FollowingDocs, RemainingWidth0).
+
+%
----------------------------------------------------------------------------
%
+
+    % Decide if a flattened list of docs will fit on the remainder
+    % of the line.  Computes the space left over if so.
+    %
+:- pred fits_flattened(list(doc), int, int).
+:- mode fits_flattened(in, in, out) is semidet.
+
+fits_flattened([]                 ) --> [].
+fits_flattened(['NIL'         | Z]) --> fits_flattened(Z).
+fits_flattened(['SEQ'(X, Y)   | Z]) --> fits_flattened([X, Y | Z]).
+fits_flattened(['NEST'(_, X)  | Z]) --> fits_flattened([X | Z]).
+fits_flattened(['LABEL'(_, X) | Z]) --> fits_flattened([X | Z]).
+fits_flattened(['LINE'        | Z]) --> fits_flattened(Z).
+fits_flattened(['GROUP'(X)    | Z]) --> fits_flattened([X | Z]).
+fits_flattened(['TEXT'(S)     | Z], R0, R) :-
+    L = string__length(S),
+    R0 > L,
+    fits_flattened(Z, R0 - L, R).
+
+%
----------------------------------------------------------------------------
%
+
+    % Decide if a list of indent-doc pairs, up to the first 'LINE',
+    % will fit on the remainder of the line.
+    %
+:- pred fits_on_rest(list(pair(string, doc)), int).
+:- mode fits_on_rest(in, in) is semidet.
+
+fits_on_rest([]                     , _).
+fits_on_rest([_ - 'NIL'         | Z], R) :- fits_on_rest(Z, R).
+fits_on_rest([I - 'SEQ'(X, Y)   | Z], R) :- fits_on_rest([I - X, I - Y |
Z], R).
+fits_on_rest([I - 'NEST'(_, X)  | Z], R) :- fits_on_rest([I - X | Z], R).
+fits_on_rest([I - 'LABEL'(_, X) | Z], R) :- fits_on_rest([I - X | Z], R).
+fits_on_rest([_ - 'LINE'        | _], _).
+fits_on_rest([I - 'GROUP'(X)    | Z], R) :- fits_on_rest([I - X | Z], R).
+fits_on_rest([_ - 'TEXT'(S)     | Z], R) :-
+    L = string__length(S),
+    R > L,
+    fits_on_rest(Z, R - L).
 
 
%---------------------------------------------------------------------------
---%
 
@@ -391,8 +447,11 @@
 flatten('LINE')         = 'NIL'.
 flatten('GROUP'(X))     = flatten(X).
 
-%--------------------------------------------------------------------------
----%
+%
----------------------------------------------------------------------------
%
 
+    % XXX This predicate has been obviated by the eager code above.
+
+/*
 :- pred fits(int, simple_doc).
 :- mode fits(in, in) is semidet.
 
@@ -405,6 +464,13 @@
     ;
         X = _ `line` _
     ).
+*/
+
+%--------------------------------------------------------------------------
----%
+
+:- func extend(string, int) = string.
+
+extend(I, J) = string__append(I, string__duplicate_char(' ', J)).
 
 
%---------------------------------------------------------------------------
---%
 
@@ -425,7 +491,7 @@
     ( if Xs = [] then
         PP(X)
       else
-        PP(X) `<>` Sep `<>` separated(PP, Sep, Xs)
+        PP(X) `<>` (Sep `<>` separated(PP, Sep, Xs))
     ).
 
 
%---------------------------------------------------------------------------
---%
@@ -463,8 +529,7 @@
         text(Name) `<>`
         parentheses(
             group(
-                nest(2, line `<>` separated(id, comma_space_line, Args))
`<>`
-                line
+                nest(2, line `<>` separated(id, comma_space_line, Args))
             )
         )
     )
@@ -478,12 +543,10 @@
 
%---------------------------------------------------------------------------
---%
 
 word_wrapped(String) =
-    list__foldr(
-        ( func(Word, Sequel) =
-            group(line `<>` text(Word) `<>` space) `<>` Sequel
-        ),
-        string__words(char__is_whitespace, String),
-        nil
+    separated(
+        text,
+        group(space_line),
+        string__words(char__is_whitespace, String)
     ).
 
 
%---------------------------------------------------------------------------
---%

--
Ralph Becket      |      MSR Cambridge      |      rbeck at microsoft.com 
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------