[m-rev.] Fixes to pprint and change for --dump-mlds

[Ralph Becket]

Estimated hours taken: 2.5
Branches: main

Fixed a performance bug in pprint and a couple of formatting bugs.
Changed the --dump-mlds option in the compiler to use pprint
rather than just dumping unformatted data.

library/pprint.m:
	Fixed a performance bug in be/5 which was not completely
	tail recursive.  This caused stack overflow when pretty
	printing large terms.
	Fixed the default formatting for lists in particular and
	terms in general where the indentation on line-wrapping
	could go wrong.
compiler/mercury_compile.m:
	Changed the --dump-mlds option to use pprint rather than
	dump unformatted data.


Index: pprint.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/pprint.m,v
retrieving revision 1.5
diff -u -r1.5 pprint.m
--- pprint.m	26 Apr 2001 14:55:13 -0000	1.5
+++ pprint.m	23 Oct 2001 08:22:00 -0000
@@ -352,7 +352,8 @@
 
 best(W, K, X)           = Best
 :-
-    be(W, K, ["" - X], Best, []).
+    be(W, K, ["" - X], [], RevBest),
+    Best = list__reverse(RevBest).
 
 %------------------------------------------------------------------------------%
 
@@ -365,15 +366,32 @@
     % simple_doc type.
 
 :- pred be(int, int, list(pair(string, doc)), simple_doc, simple_doc).
-:- mode be(in, in, in, out, in) is det.
+:- mode be(in, in, in, in, out) is det.
+
+be(_, _, [])                      -->
+    [].
+
+be(W, K, [_ - 'NIL'         | Z]) -->
+    be(W, K, Z).
+
+be(W, K, [I - 'SEQ'(X, Y)   | Z]) -->
+    be(W, K, [I - X, I - Y | Z]).
+
+be(W, K, [I - 'NEST'(J, X)  | Z]) -->
+    be(W, K, [extend(I, J) - X | Z]).
+
+be(W, K, [I - 'LABEL'(L, X) | Z]) -->
+    be(W, K, [string__append(I, L) - X | Z]).
+
+be(W, K, [_ - 'TEXT'(S)     | Z]) -->
+    push_string(S),
+    be(W, (K + string__length(S)), Z).
+
+be(W, _, [I - 'LINE'        | Z]) -->
+    push_string("\n"),
+    push_string(I),
+    be(W, string__length(I), Z).
 
-be(_, _, [], Out, In)             :-  Out = list__reverse(In).
-be(W, K, [_ - 'NIL'         | Z]) --> be(W, K, Z).
-be(W, K, [I - 'SEQ'(X, Y)   | Z]) --> be(W, K, [I - X, I - Y | Z]).
-be(W, K, [I - 'NEST'(J, X)  | Z]) --> be(W, K, [extend(I, J) - X | Z]).
-be(W, K, [I - 'LABEL'(L, X) | Z]) --> be(W, K, [string__append(I, L) - X | Z]).
-be(W, K, [_ - 'TEXT'(S)     | Z]) --> [S], be(W, (K + string__length(S)), Z).
-be(W, _, [I - 'LINE'        | Z]) --> ["\n", I], be(W, string__length(I), Z).
 be(W, K, [I - 'GROUP'(X)    | Z]) -->
     ( if { flattening_works(X, Z, W - K) } then
         be(W, K, [I - flatten(X) | Z])
@@ -381,6 +399,13 @@
         be(W, K, [I - X | Z])
     ).
 
+
+
+:- pred push_string(string, simple_doc, simple_doc).
+:- mode push_string(in, in, out) is det.
+
+push_string(S, Ss, [S | Ss]).
+
 %------------------------------------------------------------------------------%
 
     % Decide whether flattening a given doc will allow it and
@@ -473,7 +498,7 @@
 
 separated(PP, Sep, [X | Xs]) =
     ( if Xs = [] then PP(X)
-                 else PP(X) `<>` (Sep `<>` separated(PP, Sep, Xs))
+                 else PP(X) `<>` group(Sep `<>` separated(PP, Sep, Xs))
     ).
 
 %------------------------------------------------------------------------------%
@@ -521,14 +546,15 @@
             ( func(UnivArg) = to_doc(Depth - 1, univ_value(UnivArg)) ),
             UnivArgs
         ),
-        Doc = text(Name) `<>`
-            parentheses(
+        Doc =
+            text(Name) `<>` parentheses(
                 group(
                     nest(2,
-                        line `<>` separated(id, comma_space_line, Args)
+                        line `<>`
+                        separated(id, comma_space_line, Args)
                     )
                 )
-        )
+            )
     ).
 
 % ---------------------------------------------------------------------------- %
@@ -618,7 +644,13 @@
 :- func list_to_doc(int, list(T)) = doc.
 
 list_to_doc(Depth, Xs) =
-    brackets(separated_to_depth(to_doc, group(comma_space_line), Depth, Xs)).
+    brackets(
+        nest(1,
+            group(
+                separated_to_depth(to_doc, comma_space_line, Depth, Xs)
+            )
+        )
+    ).
 
 %------------------------------------------------------------------------------%
 
@@ -676,7 +708,7 @@
         Doc = PP(Depth, X)
       else
         Doc = PP(Depth, X) `<>`
-              (Sep `<>` separated_to_depth(PP, Sep, Depth - 1, Xs))
+              group(Sep `<>` separated_to_depth(PP, Sep, Depth - 1, Xs))
     ).
 
 %------------------------------------------------------------------------------%
Index: mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.220
diff -u -r1.220 mercury_compile.m
--- mercury_compile.m	2 Oct 2001 07:09:43 -0000	1.220
+++ mercury_compile.m	23 Oct 2001 08:18:56 -0000
@@ -33,6 +33,7 @@
 :- import_module equiv_type, make_hlds, typecheck, purity, polymorphism, modes.
 :- import_module switch_detection, cse_detection, det_analysis, unique_modes.
 :- import_module stratify, simplify.
+:- import_module pprint.
 
 	% high-level HLDS transformations
 :- import_module check_typeclass, intermod, trans_opt, table_gen, (lambda).
@@ -3957,10 +3958,8 @@
 	maybe_flush_output(Verbose),
 	io__tell(DumpFile, Res),
 	( { Res = ok } ->
-		% XXX the following doesn't work, due to performance bugs
-		% in pprint:
-		%	pprint__write(80, pprint__to_doc(MLDS)),
-		io__print(MLDS), io__nl,
+		pprint__write(80, pprint__to_doc(MLDS)),
+		io__nl,
 		io__told,
 		maybe_write_string(Verbose, " done.\n"),
 		maybe_report_stats(Stats)
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------