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

[Mark Anthony BROWN]

Hi,

The solution below avoids the exponential run-times, but unfortunately
it has other performance problems---it runs out of detstack space
while trying to dump an mlds, for example.  I think the Right Solution
to these problems is to rely on laziness, but that will have to wait
until laziness is better supported.

I'll commit this change as a temporary workaround.

Cheers,
Mark.

Mark Anthony BROWN writes:
...
> 
> 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
--------------------------------------------------------------------------