[m-rev.] For revew: a new, improved pretty printer

Ralph Becket rafe at csse.unimelb.edu.au
Wed Aug 1 14:18:17 AEST 2007


Estimated hours taken: 30
Branches: main

Add a new, improved pretty printer to the library.  The key advantages over
pprint are
- better performance on large terms;
- better output (line overruns are completely avoided where possible);
- better control (now supports maximum lines output and two different
  styles of limit on how deeply formatting of arbitrary terms can go);
- support for user-specifiable formatting for arbitrary types.

NEWS:
	Mention the new change.

library/library.m:
	Add pretty_printer.m.

library/pprint.m:
	Add a comment to say this module has been superceded.

library/pretty_printer.m:
	Added.

tests/hard_coded/Mmakefile:
tests/hard_coded/test_pretty_printer.exp:
tests/hard_coded/test_pretty_printer.m:
	A test suite.

Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.473
diff -u -r1.473 NEWS
--- NEWS	31 Jul 2007 07:59:23 -0000	1.473
+++ NEWS	1 Aug 2007 04:04:24 -0000
@@ -21,6 +21,13 @@
 
 Changes to the Mercury standard library:
 
+* An improved pretty printer module, pretty_printer.m has been added.  This
+  supercedes pprint.m in that it is more economical, produces better
+  quality output (line overruns are completely avoided wherever possible),
+  has better control over the amount of output produced, and supports
+  user-specifiable formatting for arbitrary types.  Further use of pprint is
+  deprecated.
+
 * The foldr family of functions and predicates has been added to the map
   and tree234 modules.
 
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.110
diff -u -r1.110 library.m
--- library/library.m	12 Jun 2007 06:53:58 -0000	1.110
+++ library/library.m	1 Aug 2007 00:47:06 -0000
@@ -89,6 +89,7 @@
 :- import_module parser.
 :- import_module pprint.
 :- import_module pqueue.
+:- import_module pretty_printer.
 :- import_module prolog.
 :- import_module queue.
 :- import_module random.
@@ -243,6 +244,7 @@
 mercury_std_library_module("parser").
 mercury_std_library_module("pprint").
 mercury_std_library_module("pqueue").
+mercury_std_library_module("pretty_printer").
 mercury_std_library_module("private_builtin").
 mercury_std_library_module("profiling_builtin").
 mercury_std_library_module("prolog").
Index: library/pprint.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/pprint.m,v
retrieving revision 1.27
diff -u -r1.27 pprint.m
--- library/pprint.m	26 Oct 2006 07:56:10 -0000	1.27
+++ library/pprint.m	1 Aug 2007 04:04:01 -0000
@@ -9,6 +9,11 @@
 % File: pprint.m
 % Main author: rafe
 % Stability: medium
+%
+% NOTE: this module has now been superceded by pretty_printer.m
+% which is more economical, produces better output, has better
+% control over the amount of output produced, and supports user-
+% specifiable formatting for arbitrary types.
 % 
 % ABOUT
 % -----
Index: library/pretty_printer.m
===================================================================
RCS file: library/pretty_printer.m
diff -N library/pretty_printer.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ library/pretty_printer.m	1 Aug 2007 00:33:23 -0000
@@ -0,0 +1,783 @@
+%-----------------------------------------------------------------------------%
+% pretty_printer.m
+% Ralph Becket <rafe at csse.unimelb.edu.au>
+% Fri Jun  1 14:49:30 EST 2007
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+% This module defines the doc type and a pretty printer for formatting
+% doc lists.
+%
+% The doc type includes data constructors for outputting strings, newlines,
+% forming groups, indented blocks, and arbitrary values.
+%
+% The key feature of the algorithm is this: newlines in a group are ignored if
+% the group can fit on the remainder of the current line.  [The algorithm is
+% similar to those of Oppen and Wadler, although it uses neither coroutines or
+% laziness.]
+%
+% When a newline is printed, indentation is also output according to the
+% current indentation level.
+%
+% The pretty printer includes special support for formatting Mercury style
+% terms in a way that respects Mercury's operator precedence and
+% bracketing rules.
+%
+% The pretty printer takes a parameter specifying a collection of user-defined
+% formatting functions for handling certain types rather than using the
+% default built-in mechanism.  This allows one to, say, format maps as
+% sequences of (key -> value) pairs rather than exposing the underlying
+% 234-tree structure.
+%
+% The amount of output produced is controlled via limit parameters.  Three
+% kinds of limits are supported: the output line width, the maximum number of
+% lines to be output, and a limit on the depth for formatting arbitrary terms.
+% Output is replaced with ellipsis ("...") when limits are exceeded.
+%
+%-----------------------------------------------------------------------------%
+
+:- module pretty_printer.
+
+:- interface.
+
+:- import_module list.
+:- import_module io.
+:- import_module ops.
+:- import_module stream.
+:- import_module string.
+:- import_module type_desc.
+:- import_module univ.
+
+
+
+:- type doc
+    --->    s(string)                   % Output a literal string.  Strings
+                                        %   containing newlines, hard
+                                        %   tabs, etc. will lead to strange
+                                        %   output.
+    ;       nl                          % Output a newline if the enclosing
+                                        %   group does not fit on the current
+                                        %   line.
+    ;       open_group                  % Open a new group (groups control
+                                        %   how nls are handled).
+    ;       close_group                 % Close a group.
+    ;       indent(string)              % Append a string to indentation.
+    ;       outdent                     % Remove the last indentation string.
+    ;       docs(docs)                  % An embedded sequence of docs.
+    ;       pp_univ(univ)               % Use a specialised pretty printer
+                                        %  if available, otherwise use the
+                                        %  generic pretty printer.
+    ;       pp_list(list(univ), doc)    % Pretty print a list of items
+                                        %  using the given doc as a
+                                        %  separator between items.  Each
+                                        %  item - separator pair is placed
+                                        %  inside a group, preceded by nl
+                                        %  and set_arg_priority.
+    ;       pp_term(string, list(univ)) % Pretty print a term with zero or
+                                        %  more arguments.  If the term
+                                        %  corresponds to a Mercury operator
+                                        %  it will be printed with appropriate
+                                        %  fixity and, if necessary, in
+                                        %  parentheses.  The term name will be
+                                        %  quoted and escaped if necessary.
+    ;       set_op_priority(ops.priority)
+                                        % Set the current priority for printing
+                                        %  operator terms with the correct
+                                        %  parenthesisation.
+    ;       set_limit(pp_limit).        % Set the truncation limit.  This
+                                        %  should not be necessary for user
+                                        %  defined pretty printers!
+
+:- type docs == list(doc).
+
+    % indent = indent("  ").
+    %   A convenient abbreviation.
+    %
+:- func indent = doc.
+
+    % pp(X) = pp_univ(univ(X)).
+    %   A convenient abbreviation.
+    %
+:- func pp(T) = doc.
+
+    % set_arg_priority =
+    %   set_op_priority(ops.arg_priority(ops.init_mercury_op_table))
+    %
+    % This is a useful shorthand when pretty-printing term arguments.
+    %
+:- func set_arg_priority = doc.
+
+    % The pretty-printer limit type, used to truncate conversion to docs
+    % after the limit has been reached.  The linear version simply emits
+    % the first N functors before truncating.  The triangular version
+    % allocates N - 1 "units" to printing the first argument of the current
+    % term, N - 2 "units" to printing the second argument of the current
+    % term, and so forth.  [The term "functor" is not quite correct here:
+    % strictly speaking one "unit" is consumed every time a user defined
+    % pretty printer or the generic term printer is used.]  Truncation is
+    % indicated by "..." in the output.
+    %
+:- type pp_limit
+    --->    linear(int)                 % Print this many functors.
+    ;       triangular(int).            % Print first arg with limit n-1,
+                                        % second arg with limit n-2, ...
+
+    % The type and inst of pretty-printer converters.
+    % The first argument is the univ of the value to be formatted.
+    % The second argument is the list of argument type_descs for
+    % the type of the first argument.
+    %
+:- type pp == ( func(univ, list(type_desc)) = docs ).
+
+    % A pp_map maps types to pps.  Types are identified by module name, type
+    % name, and type arity.
+    %
+:- type pp_map.
+
+    % Construct a new pp_map.
+    %
+:- func new_pp_map = pp_map.
+
+    % set_pp_mapping(ModuleName, TypeName, TypeArity, PP, PPMap)
+    %   Update PPMap to use PP to format the type
+    %   ModuleName.TypeName/TypeArity.
+    %
+:- func set_pp_mapping(string, string, int, pp, pp_map) = pp_map.
+
+
+
+    % format(Stream, PPMap, LineWidth, MaxLines, Limit, Docs, !State).
+    %   Format Docs to fit on lines of LineWidth chars, truncating after
+    %   MaxLines lines, fomatting pp_univ(_) docs using pretty-printer
+    %   converters PPs starting with pretty-printer limits Limit.
+    %
+:- pred format(Stream::in, pp_map::in, int::in, int::in, pp_limit::in,
+        docs::in, State::di, State::uo)
+        is det
+        <= stream.writer(Stream, string, State).
+
+    % Convenience predicates.  A user-configurable set of type-specific
+    % pretty-printers and formatting parameters are attached to the IO state.
+    % The io state-specific format predicate below uses this settings.
+    %
+:- type pp_params
+    --->    pp_params(
+                pp_line_width   :: int,
+                pp_max_lines    :: int,
+                pp_limit        :: pp_limit
+            ).
+
+    % The default pp_map may also be updated by initialisation goals in various
+    % modules.
+    %
+:- pred get_default_pp_map(pp_map::out, io::di, io::uo) is det.
+:- pred set_default_pp_map(pp_map::in, io::di, io::uo) is det.
+:- pred set_default_pp(string::in, string::in, int::in, pp::in,
+        io::di, io::uo) is det.
+
+    % The initial default pp_params are pp_params(78, 100, triangular(100)).
+    %
+:- pred get_default_pp_params(pp_params::out, io::di, io::uo) is det.
+:- pred set_default_pp_params(pp_params::in, io::di, io::uo) is det.
+
+    % format(Docs, !IO)
+    % format(Stream, Docs, !IO)
+    %   Format Docs to io.stdout_stream or Stream respectively, using
+    %   the default pp_map and pp_params.
+    %
+:- pred format(docs::in, io::di, io::uo) is det.
+:- pred format(io.output_stream::in, docs::in, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module bool.
+:- import_module deconstruct.
+:- import_module exception.
+:- import_module int.
+:- import_module map.
+:- import_module term_io.
+
+
+
+:- type pp_map == map(string, map(string, map(int, pp))).
+
+:- type indents == list(string).
+
+%-----------------------------------------------------------------------------%
+
+new_pp_map = map.init.
+
+%-----------------------------------------------------------------------------%
+
+set_pp_mapping(ModuleName, TypeName, Arity, PP, PPMap0) = PPMap :-
+    ( if PPMap0 ^ elem(ModuleName) = PPMap0_Type_Arity then
+        ( if PPMap0_Type_Arity ^ elem(TypeName) = PPMap0_Arity then
+            PPMap_Arity = PPMap0_Arity ^ elem(Arity) := PP
+          else
+            PPMap_Arity = map.init ^ elem(Arity) := PP
+        ),
+        PPMap_Type_Arity = PPMap0_Type_Arity ^ elem(TypeName) := PPMap_Arity,
+        PPMap = PPMap0 ^ elem(ModuleName) := PPMap_Type_Arity
+      else
+        PPMap_Arity = map.init ^ elem(Arity) := PP,
+        PPMap_Type_Arity = map.init ^ elem(TypeName) := PPMap_Arity,
+        PPMap = PPMap0 ^ elem(ModuleName) := PPMap_Type_Arity
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred get_pp_map(pp_map::in, string::in, string::in, int::in, pp::out)
+        is semidet.
+
+get_pp_map(PPMap, ModuleName, TypeName, Arity, PP) :-
+    PP = PPMap ^ elem(ModuleName) ^ elem(TypeName) ^ elem(Arity).
+
+%-----------------------------------------------------------------------------%
+
+indent = indent("  ").
+
+%-----------------------------------------------------------------------------%
+
+pp(X) = pp_univ(univ(X)).
+
+%-----------------------------------------------------------------------------%
+
+set_arg_priority =
+    set_op_priority(ops.arg_priority(ops.init_mercury_op_table)).
+
+%-----------------------------------------------------------------------------%
+
+format(Stream, PPMap, LineWidth, MaxLines, Limit, Docs, !IO) :-
+    Pri = ops.max_priority(ops.init_mercury_op_table),
+    RemainingWidth = LineWidth,
+    Indents = [],
+    format(Stream, PPMap, LineWidth, Docs, RemainingWidth, _, Indents, _,
+        MaxLines, _, Limit, _, Pri, _, !IO).
+
+%-----------------------------------------------------------------------------%
+
+    % format(PPMap, LineWidth, Docs, !RemainingWidth, !Indents,
+    %       !RemainingLines, !Limit, !Pri, !IO)
+    %   Format Docs to fit on LineWidth chars per line,
+    %   - tracking !RemainingWidth chars left on the current line,
+    %   - indenting by !Indents after newlines,
+    %   - truncating output after !RemainingLines,
+    %   - expanding terms to at most !Limit depth before truncating,
+    %   - tracking current operator priority !Pri.
+    %   Assumes that Docs is the output of expand.
+    %
+:- pred format(Stream::in, pp_map::in, int::in,  docs::in,
+        int::in, int::out, indents::in, indents::out, int::in, int::out,
+        pp_limit::in, pp_limit::out, ops.priority::in, ops.priority::out,
+        State::di, State::uo)
+        is det
+        <= stream.writer(Stream, string, State).
+
+format(_Stream, _PPMap, _LineWidth, [],
+        !RemainingWidth, !Indents, !RemainingLines, !Limit, !Pri, !IO).
+
+format(Stream, PPMap, LineWidth, [Doc | Docs0],
+        !RemainingWidth, !Indents, !RemainingLines, !Limit, !Pri, !IO) :-
+    ( if !.RemainingLines =< 0 then
+        stream.put(Stream, "...", !IO)
+      else
+        (
+            % Output strings directly.
+            %
+            Doc = s(String),
+            stream.put(Stream, String, !IO),
+            !:RemainingWidth = !.RemainingWidth - string.length(String),
+            Docs = Docs0
+        ;
+            % Output soft newlines if what follows up to the next newline
+            % fits on the rest of the current line.  Don't bother outputting
+            % a newline if we're already at the start of a new line and we
+            % don't have any indentation.
+            %
+            Doc = nl,
+            ( if LineWidth = !.RemainingWidth, !.Indents = [] then
+                true
+              else
+                format_nl(Stream, LineWidth, !.Indents, !:RemainingWidth,
+                    !RemainingLines, !IO)
+            ),
+            Docs = Docs0
+        ;
+            % Indents.
+            %
+            Doc = indent(Indent),
+            !:Indents = [Indent | !.Indents],
+            Docs = Docs0
+        ;
+            % Outdents.
+            %
+            Doc = outdent,
+            !:Indents = list.det_tail(!.Indents),
+            Docs = Docs0
+        ;
+            % Open groups: if the current group (and what follows up to the
+            % next nl) fits on the remainder of the current line then print
+            % it that way; otherwise we have to recognise the nls in the
+            % group.
+            %
+            Doc = open_group,
+            OpenGroups = 1,
+            CurrentRemainingWidth = !.RemainingWidth,
+            expand_docs(PPMap, Docs0, Docs1, OpenGroups, !Limit, !Pri,
+                CurrentRemainingWidth, RemainingWidthAfterGroup),
+            ( if RemainingWidthAfterGroup >= 0 then
+                output_current_group(Stream, OpenGroups, Docs1, Docs,
+                    !RemainingWidth, !IO)
+              else
+                Docs = Docs1
+            )
+        ;
+            % Close groups.
+            %
+            Doc = close_group,
+            Docs = Docs0
+        ;
+            Doc = docs(Docs1),
+            Docs = list.(Docs1 ++ Docs0)
+        ;
+            Doc = pp_univ(Univ),
+            expand_pp(PPMap, Univ, Docs1, !Limit, !.Pri),
+            Docs = list.(Docs1 ++ Docs0)
+        ;
+            Doc = pp_list(Univs, Sep),
+            expand_pp_list(Univs, Sep, Docs1, !Limit),
+            Docs = list.(Docs1 ++ Docs0)
+        ;
+            Doc = pp_term(Name, Univs),
+            expand_pp_term(Name, Univs, Docs1, !Limit, !.Pri),
+            Docs = list.(Docs1 ++ Docs0)
+        ;
+            Doc = set_limit(Lim),
+            !:Limit = Lim,
+            Docs = Docs0
+        ;
+            Doc = set_op_priority(NewPri),
+            !:Pri = NewPri,
+            Docs = Docs0
+        ),
+        format(Stream, PPMap, LineWidth, Docs, !RemainingWidth, !Indents,
+            !RemainingLines, !Limit, !Pri, !IO)
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_current_group(Stream::in, int::in, docs::in, docs::out,
+        int::in, int::out, State::di, State::uo)
+        is det
+        <= stream.writer(Stream, string, State).
+
+output_current_group(_Stream, _OpenGroups, [], [], !RemainingWidth, !IO).
+
+output_current_group(Stream, OpenGroups, [Doc | Docs0], Docs, !RemainingWidth,
+        !IO) :-
+
+    ( if Doc = s(String) then
+
+        stream.put(Stream, String, !IO),
+        !:RemainingWidth = !.RemainingWidth - string.length(String),
+        output_current_group(Stream, OpenGroups, Docs0, Docs,
+            !RemainingWidth, !IO)
+
+      else if Doc = open_group then
+
+        output_current_group(Stream, OpenGroups + 1, Docs0, Docs,
+            !RemainingWidth, !IO)
+
+      else if Doc = close_group then
+
+        ( if OpenGroups = 1 then
+            Docs = Docs0
+          else
+            output_current_group(Stream, OpenGroups - 1, Docs0, Docs,
+                !RemainingWidth, !IO)
+        )
+
+      else
+
+        output_current_group(Stream, OpenGroups, Docs0, Docs, !RemainingWidth,
+            !IO)
+
+    ).
+
+%-----------------------------------------------------------------------------%
+
+    % expand_docs(Docs0, Docs, G, !L, !P, !R) expands out any doc(_),
+    % pp_univ(_), pp_list(_, _), and pp_term(_) constructors in Docs0 into
+    % Docs, until either Docs0 has been completely expanded, or a nl is
+    % encountered, or the remaining space on the current line has been
+    % accounted for.
+    % G is used to track nested groups.
+    % !L tracks the limits after accounting for expansion.
+    % !L tracks the operator priority after accounting for expansion.
+    % !R tracks the remaining line width after accounting for expansion.
+    %
+:- pred expand_docs(pp_map::in, docs::in, docs::out, int::in,
+        pp_limit::in, pp_limit::out, ops.priority::in, ops.priority::out,
+        int::in, int::out) is det.
+
+expand_docs(_PPMap, [], [], _OpenGroups, !Limit, !Pri, !N).
+
+expand_docs(PPMap, [Doc | Docs0], Docs, OpenGroups,
+        !Limit, !Pri, !RemainingWidth) :-
+    ( if
+        (
+            OpenGroups = 0, Doc = nl
+            % We have found the first nl after the close of the current
+            % open group.
+        ;
+            !.RemainingWidth < 0
+            % We have run out of space on this line: the current open
+            % group will not fit.
+        )
+      then
+        Docs = [Doc | Docs0]
+      else
+        (
+            Doc = s(String),
+            !:RemainingWidth = !.RemainingWidth - string.length(String),
+            Docs = [Doc | Docs1],
+            expand_docs(PPMap, Docs0, Docs1, OpenGroups,
+                !Limit, !Pri, !RemainingWidth)
+        ;
+            Doc = nl,
+            ( if OpenGroups =< 0 then
+                Docs = [Doc | Docs0]
+              else
+                Docs = [Doc | Docs1],
+                expand_docs(PPMap, Docs0, Docs1, OpenGroups,
+                    !Limit, !Pri, !RemainingWidth)
+            )
+        ;
+            Doc = indent(_),
+            Docs = [Doc | Docs1],
+            expand_docs(PPMap, Docs0, Docs1, OpenGroups,
+                !Limit, !Pri, !RemainingWidth)
+        ;
+            Doc = outdent,
+            Docs = [Doc | Docs1],
+            expand_docs(PPMap, Docs0, Docs1, OpenGroups,
+                !Limit, !Pri, !RemainingWidth)
+        ;
+            Doc = open_group,
+            Docs = [Doc | Docs1],
+            OpenGroups1 = OpenGroups + ( if OpenGroups > 0 then 1 else 0 ),
+            expand_docs(PPMap, Docs0, Docs1, OpenGroups1,
+                !Limit, !Pri, !RemainingWidth)
+        ;
+            Doc = close_group,
+            Docs = [Doc | Docs1],
+            OpenGroups1 = OpenGroups - ( if OpenGroups > 0 then 1 else 0 ),
+            expand_docs(PPMap, Docs0, Docs1, OpenGroups1,
+                !Limit, !Pri, !RemainingWidth)
+        ;
+            Doc = docs(Docs1),
+            expand_docs(PPMap, list.(Docs1 ++ Docs0), Docs, OpenGroups,
+                !Limit, !Pri, !RemainingWidth)
+        ;
+            Doc = pp_univ(Univ),
+            expand_pp(PPMap, Univ, Docs1, !Limit, !.Pri),
+            expand_docs(PPMap, list.(Docs1 ++ Docs0), Docs, OpenGroups,
+                !Limit, !Pri, !RemainingWidth)
+        ;
+            Doc = pp_list(Univs, Sep),
+            expand_pp_list(Univs, Sep, Docs1, !Limit),
+            expand_docs(PPMap, list.(Docs1 ++ Docs0), Docs, OpenGroups,
+                !Limit, !Pri, !RemainingWidth)
+        ;
+            Doc = pp_term(Name, Univs),
+            expand_pp_term(Name, Univs, Docs1, !Limit, !.Pri),
+            expand_docs(PPMap, list.(Docs1 ++ Docs0), Docs, OpenGroups,
+                !Limit, !Pri, !RemainingWidth)
+        ;
+            Doc = set_limit(Lim),
+            !:Limit = Lim,
+            expand_docs(PPMap, Docs0, Docs, OpenGroups,
+                !Limit, !Pri, !RemainingWidth)
+        ;
+            Doc = set_op_priority(NewPri),
+            !:Pri = NewPri,
+            expand_docs(PPMap, Docs0, Docs, OpenGroups,
+                !Limit, !Pri, !RemainingWidth)
+        )
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred format_nl(Stream::in, int::in, indents::in, int::out,
+        int::in, int::out, State::di, State::uo)
+        is det
+        <= stream.writer(Stream, string, State).
+
+format_nl(Stream, LineWidth, Indents, RemainingWidth, !RemainingLines, !IO) :-
+    stream.put(Stream, "\n", !IO),
+    output_indentation(Stream, Indents, LineWidth, RemainingWidth, !IO),
+    !:RemainingLines = !.RemainingLines - 1.
+
+
+:- pred output_indentation(Stream::in, indents::in, int::in, int::out,
+        State::di, State::uo)
+        is det
+        <= stream.writer(Stream, string, State).
+
+output_indentation(_Stream, [], !RemainingWidth, !IO).
+
+output_indentation(Stream, [Indent | Indents], !RemainingWidth, !IO) :-
+    output_indentation(Stream, Indents, !RemainingWidth, !IO),
+    stream.put(Stream, Indent, !IO),
+    !:RemainingWidth = !.RemainingWidth - string.length(Indent).
+
+%-----------------------------------------------------------------------------%
+
+    % Expand a univ into docs using the first pretty-printer in the given list
+    % that succeeds, otherwise use the generic pretty- printer.  If the
+    % pretty-printer limit has been exhausted then only "..." is produced.
+    %
+:- pred expand_pp(pp_map::in, univ::in, docs::out,
+        pp_limit::in, pp_limit::out, ops.priority::in) is det.
+
+expand_pp(PPMap, Univ, Docs, !Limit, CurrentPri) :-
+    ( if
+        limit_overrun(!.Limit)
+      then
+        Docs = [s("...")]
+      else if
+        Value = univ_value(Univ),
+        type_ctor_and_args(type_of(Value), TypeCtorDesc, ArgTypeDescs),
+        ModuleName = type_ctor_module_name(TypeCtorDesc),
+        TypeName = type_ctor_name(TypeCtorDesc),
+        Arity = list.length(ArgTypeDescs),
+        get_pp_map(PPMap, ModuleName, TypeName, Arity, PP)
+      then
+        decrement_limit(!Limit),
+        Docs = set_post_pp_limit_correctly(!.Limit, PP(Univ, ArgTypeDescs))
+      else
+        deconstruct(univ_value(Univ), canonicalize, Name, _Arity, Args),
+        expand_pp_term(Name, Args, Docs, !Limit, CurrentPri)
+    ).
+
+%-----------------------------------------------------------------------------%
+
+    % Expand a list of univs into docs using the given separator.
+    %
+:- pred expand_pp_list(list(univ)::in, doc::in, docs::out,
+        pp_limit::in, pp_limit::out) is det.
+
+expand_pp_list([], _Sep, [], !Limit).
+
+expand_pp_list([Univ | Univs], Sep, Docs, !Limit) :-
+    ( if limit_overrun(!.Limit) then
+        Docs = [s("...")]
+      else
+        (
+            Univs = [],
+            Docs = [
+                set_arg_priority,
+                open_group, nl, pp_univ(Univ), close_group
+            ]
+        ;
+            Univs = [_ | _],
+            Docs = [
+                set_arg_priority,
+                open_group, nl, pp_univ(Univ), Sep, close_group,
+                pp_list(Univs, Sep)
+            ]
+        )
+    ).
+
+%-----------------------------------------------------------------------------%
+
+    % Expand a name and list of univs into docs corresponding to Mercury
+    % term syntax.
+    %
+:- pred expand_pp_term(string::in, list(univ)::in, docs::out,
+        pp_limit::in, pp_limit::out, ops.priority::in) is det.
+
+expand_pp_term(Name, Args, Docs, !Limit, CurrentPri) :-
+    decrement_limit(!Limit),
+    ( if Args = [] then
+        Docs1 = [s(term_io.quoted_atom(Name))]
+      else if limit_overrun(!.Limit) then
+        Docs1 = [s("...")]
+      else if expand_pp_op(Name, Args, CurrentPri, Docs0) then
+        Docs1 = Docs0
+      else if Name = "{}" then
+        Docs1 = [
+            s("{"), pp_list(Args, s(", ")), s("}")
+        ]
+      else
+        Docs1 = [
+            s(term_io.quoted_atom(Name)),
+            s("("),
+            indent,
+            pp_list(Args, s(", ")),
+            s(")"),
+            outdent
+        ]
+    ),
+    Docs = set_post_pp_limit_correctly(!.Limit, Docs1).
+
+%-----------------------------------------------------------------------------%
+
+    % Expand a name and list of univs into docs corresponding to Mercury
+    % operator syntax.
+    %
+:- pred expand_pp_op(string::in, list(univ)::in, ops.priority::in, docs::out)
+        is semidet.
+
+expand_pp_op(Op, [Arg], CurrentPri, Docs) :-
+    ( if ops.lookup_prefix_op(ops.init_mercury_op_table, Op, OpPri, Assoc) then
+        Docs0 = [
+            open_group,
+            s(Op),
+            set_op_priority(adjust_priority(OpPri, Assoc)),
+            pp_univ(Arg),
+            close_group
+        ],
+        Docs = add_parens_if_needed(OpPri, CurrentPri, Docs0)
+      else
+        ops.lookup_postfix_op(ops.init_mercury_op_table, Op, OpPri, Assoc),
+        Docs0 = [
+            open_group,
+            set_op_priority(adjust_priority(OpPri, Assoc)),
+            pp_univ(Arg),
+            s(Op),
+            close_group
+        ],
+        Docs = add_parens_if_needed(OpPri, CurrentPri, Docs0)
+    ).
+
+expand_pp_op(Op, [ArgA, ArgB], CurrentPri, Docs) :-
+    ( if
+        ops.lookup_infix_op(ops.init_mercury_op_table, Op, OpPri, AssocA,
+            AssocB)
+      then
+        Docs0 = [
+            open_group,
+            set_op_priority(adjust_priority(OpPri, AssocA)), pp_univ(ArgA),
+            s(" "), s(Op), s(" "),
+            indent, nl,
+            set_op_priority(adjust_priority(OpPri, AssocB)), pp_univ(ArgB),
+            outdent,
+            close_group
+        ],
+        Docs = add_parens_if_needed(OpPri, CurrentPri, Docs0)
+      else
+        ops.lookup_binary_prefix_op(ops.init_mercury_op_table, Op, OpPri,
+            AssocA, AssocB),
+        Docs0 = [
+            open_group,
+            s(Op), s(" "),
+            set_op_priority(adjust_priority(OpPri, AssocA)), pp_univ(ArgA),
+            s(" "),
+            indent, nl,
+            set_op_priority(adjust_priority(OpPri, AssocB)), pp_univ(ArgB),
+            outdent,
+            close_group
+        ],
+        Docs = add_parens_if_needed(OpPri, CurrentPri, Docs0)
+    ).
+
+%-----------------------------------------------------------------------------%
+
+    % Update the limits properly after processing a pp_term.
+    %
+:- func set_post_pp_limit_correctly(pp_limit, docs) = docs.
+
+set_post_pp_limit_correctly(linear(_), Docs) =
+    Docs.
+
+set_post_pp_limit_correctly(Limit @ triangular(_), Docs0) =
+    [docs(Docs0), set_limit(Limit)].
+
+%-----------------------------------------------------------------------------%
+
+    % Add parentheses around some docs if required by operator priority.
+    %
+:- func add_parens_if_needed(ops.priority, ops.priority, docs) = docs.
+
+add_parens_if_needed(OpPriority, EnclosingPriority, Docs) =
+    ( if OpPriority > EnclosingPriority then
+        [s("("), docs(Docs), s(")")]
+      else
+        Docs
+    ).
+
+%-----------------------------------------------------------------------------%
+
+:- func adjust_priority(ops.priority, ops.assoc) = ops.priority.
+
+adjust_priority(Priority, Assoc) = AdjustedPriority :-
+    ops.adjust_priority_for_assoc(Priority, Assoc, AdjustedPriority).
+
+%-----------------------------------------------------------------------------%
+
+    % Succeeds if the pretty-printer state limits have been used up.
+    %
+:- pred limit_overrun(pp_limit::in) is semidet.
+
+limit_overrun(linear(N)) :-
+    N =< 0.
+
+limit_overrun(triangular(N)) :-
+    N =< 0.
+
+%-----------------------------------------------------------------------------%
+
+    % Reduce the pretty-printer limit by one.
+    %
+:- pred decrement_limit(pp_limit::in, pp_limit::out) is det.
+
+decrement_limit(linear(N), linear(N - 1)).
+
+decrement_limit(triangular(N), triangular(N - 1)).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+% Convenience predicates.
+
+:- mutable(io_pp_map, pp_map, new_pp_map, ground,
+    [attach_to_io_state, untrailed]).
+
+:- mutable(io_pp_params, pp_params, pp_params(78, 100, triangular(100)),
+    ground, [attach_to_io_state, untrailed]).
+
+%-----------------------------------------------------------------------------%
+
+get_default_pp_map(PPMap, !IO) :-
+    get_io_pp_map(PPMap, !IO).
+
+set_default_pp_map(PPMap, !IO) :-
+    set_io_pp_map(PPMap, !IO).
+
+set_default_pp(ModuleName, TypeName, Arity, PP, !IO) :-
+    get_io_pp_map(PPMap0, !IO),
+    PPMap = set_pp_mapping(ModuleName, TypeName, Arity, PP, PPMap0),
+    set_io_pp_map(PPMap, !IO).
+
+%-----------------------------------------------------------------------------%
+
+get_default_pp_params(Params, !IO) :-
+    get_io_pp_params(Params, !IO).
+
+set_default_pp_params(Params, !IO) :-
+    set_io_pp_params(Params, !IO).
+
+%-----------------------------------------------------------------------------%
+
+format(Docs, !IO) :-
+    format(io.stdout_stream, Docs, !IO).
+
+format(Stream, Docs, !IO) :-
+    get_default_pp_map(PPs, !IO),
+    get_default_pp_params(pp_params(LineWidth, MaxLines, Limit), !IO),
+    format(Stream, PPs, LineWidth, MaxLines, Limit, Docs, !IO).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.327
diff -u -r1.327 Mmakefile
--- tests/hard_coded/Mmakefile	30 Jul 2007 06:03:07 -0000	1.327
+++ tests/hard_coded/Mmakefile	1 Aug 2007 01:03:42 -0000
@@ -219,6 +219,7 @@
 	test_bitset \
 	test_cord \
 	test_imported_no_tag \
+	test_pretty_printer \
 	test_promise_impure_implicit \
 	tim_qual1 \
 	time_test \
Index: tests/hard_coded/test_pretty_printer.exp
===================================================================
RCS file: tests/hard_coded/test_pretty_printer.exp
diff -N tests/hard_coded/test_pretty_printer.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/test_pretty_printer.exp	1 Aug 2007 00:59:19 -0000
@@ -0,0 +1,1011 @@
+
+limit = triangular(10), max lines = 3, line width = 38
+|------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_...
+|------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 38
+|------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, ...], 
+  [1, 2, 3, 4, 5, 6, 7, ...], 
+  [1, 2, 3, 4, 5, 6, ...], 
+  ...
+|------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 38
+|------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 38
+|------------------------------------|
+-(-(-(-(... * ... / ...) / 
+  (... * ... + ...)) / 
+  ((x / ... * ... + -...) * 
+    ...
+|------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 38
+|------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), 
+  (3 -> "0x3"), (4 -> "0x4"), 
+  (5 -> "0x5"), (6 -> "0x6"), 
+  ...
+|------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 38
+|------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), 
+  (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), 
+  (6 -> 6.0), (7 -> 7.0), (8 -> ...), 
+  ...
+|------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 38
+|------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
+|------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 38
+|------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, ...]
+|------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_...
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, ...], [1, 2, 3, 4, 5, 6, 7, ...], 
+  [1, 2, 3, 4, 5, 6, ...], [1, 2, 3, 4, 5, ...], [1, 2, 3, 4, ...], 
+  [1, 2, 3, ...], [1, 2, ...], [1, ...], [...], ...]
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+-(-(-(-(... * ... / ...) / (... * ... + ...)) / 
+  ((x / ... * ... + -...) * ((x + ...) * ...))) / 
+  ((x / x * (x / ...) + -(x / ...)) * ((x + x) * (x + ...)) + 
+    ...
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), (3 -> "0x3"), (4 -> "0x4"), (5 -> "0x5"), 
+  (6 -> "0x6"), (7 -> "0x7"), (8 -> ...), ..., ...])
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), (6 -> 6.0), 
+  (7 -> 7.0), (8 -> ...), ..., ...])
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, ...]
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 38
+|------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_three
+_1__2__3__4_four
+_1__2__3__4__5_five
+|------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 38
+|------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, ...], 
+  [1, 2, 3, 4, 5, 6, 7, ...], 
+  [1, 2, 3, 4, 5, 6, ...], 
+  [1, 2, 3, 4, 5, ...], 
+  [1, 2, 3, 4, ...], [1, 2, 3, ...], 
+  [1, 2, ...], [1, ...], [...], ...]
+|------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 38
+|------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 38
+|------------------------------------|
+-(-(-(-(... * ... / ...) / 
+  (... * ... + ...)) / 
+  ((x / ... * ... + -...) * 
+    ((x + ...) * ...))) / 
+  ((x / x * (x / ...) + -(x / ...)) * 
+    ((x + x) * (x + ...)) + 
+    (x / ... - x - -... - 
+      x / ... * ...)))
+|------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 38
+|------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), 
+  (3 -> "0x3"), (4 -> "0x4"), 
+  (5 -> "0x5"), (6 -> "0x6"), 
+  (7 -> "0x7"), (8 -> ...), ..., ...])
+|------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 38
+|------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), 
+  (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), 
+  (6 -> 6.0), (7 -> 7.0), (8 -> ...), 
+  ..., ...])
+|------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 38
+|------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
+|------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 38
+|------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, ...]
+|------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_three
+_1__2__3__4_four
+_1__2__3__4__5_five
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, ...], [1, 2, 3, 4, 5, 6, 7, ...], 
+  [1, 2, 3, 4, 5, 6, ...], [1, 2, 3, 4, 5, ...], [1, 2, 3, 4, ...], 
+  [1, 2, 3, ...], [1, 2, ...], [1, ...], [...], ...]
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+-(-(-(-(... * ... / ...) / (... * ... + ...)) / 
+  ((x / ... * ... + -...) * ((x + ...) * ...))) / 
+  ((x / x * (x / ...) + -(x / ...)) * ((x + x) * (x + ...)) + 
+    (x / ... - x - -... - x / ... * ...)))
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), (3 -> "0x3"), (4 -> "0x4"), (5 -> "0x5"), 
+  (6 -> "0x6"), (7 -> "0x7"), (8 -> ...), ..., ...])
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), (6 -> 6.0), 
+  (7 -> 7.0), (8 -> ...), ..., ...])
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
+|----------------------------------------------------------------------------|
+
+limit = triangular(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, ...]
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 38
+|------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_...
+|------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 38
+|------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  ...
+|------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 38
+|------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 38
+|------------------------------------|
+-(-(-(-((x + x) * (x + x) / 
+  (x / x * (x / x))) / 
+  (x / x * (x / x) + -(x / x))) / 
+  ...
+|------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 38
+|------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), 
+  (3 -> "0x3"), (4 -> "0x4"), 
+  (5 -> "0x5"), (6 -> "0x6"), 
+  ...
+|------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 38
+|------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), 
+  (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), 
+  (6 -> 6.0), (7 -> 7.0), (8 -> 8.0), 
+  ...
+|------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 38
+|------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
+12, 13, 14, 15, 16, 17, 18, 19, 20, 
+21, 22, 23, 24, 25, 26, 27, 28, 29, 
+...
+|------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 38
+|------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
+  12, 13, 14, 15, 16, 17, 18, 19, 20, 
+  21, 22, 23, 24, 25, 26, 27, 28, 29, 
+  ...
+|------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_...
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+-(-(-(-((x + x) * (x + x) / (x / x * (x / x))) / 
+  (x / x * (x / x) + -(x / x))) / 
+  ((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)))) / 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), (3 -> "0x3"), (4 -> "0x4"), (5 -> "0x5"), 
+  (6 -> "0x6"), (7 -> "0x7"), (8 -> "0x8"), (9 -> "0x9"), (10 -> "0xA"), 
+  (11 -> "0xB"), (12 -> "0xC"), (13 -> "0xD"), (14 -> "0xE"), (15 -> "0xF"), 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), (6 -> 6.0), 
+  (7 -> 7.0), (8 -> 8.0), (9 -> 9.0), (10 -> 10.0), (11 -> 11.0), 
+  (12 -> 12.0), (13 -> 13.0), (14 -> 14.0), (15 -> 15.0), (16 -> 16.0), 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 
+22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 
+41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 
+...
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 
+  22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 
+  41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 38
+|------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_three
+_1__2__3__4_four
+_1__2__3__4__5_five
+|------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 38
+|------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]]
+|------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 38
+|------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 38
+|------------------------------------|
+-(-(-(-((x + x) * (x + x) / 
+  (x / x * (x / x))) / 
+  (x / x * (x / x) + -(x / x))) / 
+  ((x / x * (x / x) + -(x / x)) * 
+    ((x + x) * (x + x)))) / 
+  ((x / x * (x / x) + -(x / x)) * 
+    ((x + x) * (x + x)) + 
+    (x / x - x - -(x / x) - 
+      x / x * (x / x))))
+|------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 38
+|------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), 
+  (3 -> "0x3"), (4 -> "0x4"), 
+  (5 -> "0x5"), (6 -> "0x6"), 
+  (7 -> "0x7"), (8 -> "0x8"), 
+  (9 -> "0x9"), (10 -> "0xA"), 
+  (11 -> "0xB"), (12 -> "0xC"), 
+  (13 -> "0xD"), (14 -> "0xE"), 
+  (15 -> "0xF"), (16 -> "0x10"), 
+  (17 -> "0x11"), (18 -> "0x12"), 
+  (19 -> "0x13"), (20 -> "0x14"), 
+  ...
+|------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 38
+|------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), 
+  (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), 
+  (6 -> 6.0), (7 -> 7.0), (8 -> 8.0), 
+  (9 -> 9.0), (10 -> 10.0), 
+  (11 -> 11.0), (12 -> 12.0), 
+  (13 -> 13.0), (14 -> 14.0), 
+  (15 -> 15.0), (16 -> 16.0), 
+  (17 -> 17.0), (18 -> 18.0), 
+  (19 -> 19.0), (20 -> 20.0), 
+  (21 -> 21.0), (22 -> 22.0), 
+  ...
+|------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 38
+|------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
+12, 13, 14, 15, 16, 17, 18, 19, 20, 
+21, 22, 23, 24, 25, 26, 27, 28, 29, 
+30, 31, 32, 33, 34, 35, 36, 37, 38, 
+39, 40, 41, 42, 43, 44, 45, 46, 47, 
+48, 49, 50, 51, 52, 53, 54, 55, 56, 
+57, 58, 59, 60, 61, 62, 63, 64, 65, 
+66, 67, 68, 69, 70, 71, 72, 73, 74, 
+75, 76, 77, 78, 79, 80, 81, 82, 83, 
+84, 85, 86, 87, 88, 89, 90, 91, 92, 
+...
+|------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 38
+|------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
+  12, 13, 14, 15, 16, 17, 18, 19, 20, 
+  21, 22, 23, 24, 25, 26, 27, 28, 29, 
+  30, 31, 32, 33, 34, 35, 36, 37, 38, 
+  39, 40, 41, 42, 43, 44, 45, 46, 47, 
+  48, 49, 50, 51, 52, 53, 54, 55, 56, 
+  57, 58, 59, 60, 61, 62, 63, 64, 65, 
+  66, 67, 68, 69, 70, 71, 72, 73, 74, 
+  75, 76, 77, 78, 79, 80, 81, 82, 83, 
+  84, 85, 86, 87, 88, 89, 90, 91, 92, 
+  ...
+|------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_three
+_1__2__3__4_four
+_1__2__3__4__5_five
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10]]
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+-(-(-(-((x + x) * (x + x) / (x / x * (x / x))) / 
+  (x / x * (x / x) + -(x / x))) / 
+  ((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)))) / 
+  ((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)) + 
+    (x / x - x - -(x / x) - x / x * (x / x))))
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), (3 -> "0x3"), (4 -> "0x4"), (5 -> "0x5"), 
+  (6 -> "0x6"), (7 -> "0x7"), (8 -> "0x8"), (9 -> "0x9"), (10 -> "0xA"), 
+  (11 -> "0xB"), (12 -> "0xC"), (13 -> "0xD"), (14 -> "0xE"), (15 -> "0xF"), 
+  (16 -> "0x10"), (17 -> "0x11"), (18 -> "0x12"), (19 -> "0x13"), 
+  (20 -> "0x14"), (21 -> "0x15"), (22 -> "0x16"), (23 -> "0x17"), 
+  (24 -> "0x18"), (25 -> "0x19"), (26 -> "0x1A"), (27 -> "0x1B"), 
+  (28 -> "0x1C"), (29 -> "0x1D"), (30 -> "0x1E"), (31 -> "0x1F"), 
+  (32 -> "0x20"), (33 -> "0x21"), (34 -> "0x22"), (35 -> "0x23"), 
+  (36 -> "0x24"), (37 -> "0x25"), (38 -> "0x26"), (39 -> "0x27"), 
+  (40 -> "0x28"), (41 -> "0x29"), (42 -> "0x2A"), (43 -> "0x2B"), 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), (6 -> 6.0), 
+  (7 -> 7.0), (8 -> 8.0), (9 -> 9.0), (10 -> 10.0), (11 -> 11.0), 
+  (12 -> 12.0), (13 -> 13.0), (14 -> 14.0), (15 -> 15.0), (16 -> 16.0), 
+  (17 -> 17.0), (18 -> 18.0), (19 -> 19.0), (20 -> 20.0), (21 -> 21.0), 
+  (22 -> 22.0), (23 -> 23.0), (24 -> 24.0), (25 -> 25.0), (26 -> 26.0), 
+  (27 -> 27.0), (28 -> 28.0), (29 -> 29.0), (30 -> 30.0), (31 -> 31.0), 
+  (32 -> 32.0), (33 -> 33.0), (34 -> 34.0), (35 -> 35.0), (36 -> 36.0), 
+  (37 -> 37.0), (38 -> 38.0), (39 -> 39.0), (40 -> 40.0), (41 -> 41.0), 
+  (42 -> 42.0), (43 -> 43.0), (44 -> 44.0), (45 -> 45.0), (46 -> 46.0), 
+  (47 -> 47.0), (48 -> 48.0), (49 -> 49.0), (50 -> 50.0), (51 -> 51.0), 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 
+22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 
+41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 
+60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 
+79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 
+98, 99, 100
+|----------------------------------------------------------------------------|
+
+limit = triangular(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 
+  22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 
+  41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 
+  60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 
+  79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 
+  98, 99, ...]
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 38
+|------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_...
+|------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 38
+|------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, ...], ...]
+|------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 38
+|------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 38
+|------------------------------------|
+-(-(-(-(... * ... / ...) / ...) / 
+  ...) / 
+  ...)
+|------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 38
+|------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), 
+  (3 -> "0x3"), ...])
+|------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 38
+|------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), 
+  (3 -> 3.0), ...])
+|------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 38
+|------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
+|------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 38
+|------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, ...]
+|------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_...
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, ...], ...]
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+-(-(-(-(... * ... / ...) / ...) / ...) / ...)
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), (3 -> "0x3"), ...])
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), (3 -> 3.0), ...])
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, ...]
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 38
+|------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_three
+_1__2__3__4_four
+_1__2__3__4__5_five
+|------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 38
+|------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, ...], ...]
+|------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 38
+|------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 38
+|------------------------------------|
+-(-(-(-(... * ... / ...) / ...) / 
+  ...) / 
+  ...)
+|------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 38
+|------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), 
+  (3 -> "0x3"), ...])
+|------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 38
+|------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), 
+  (3 -> 3.0), ...])
+|------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 38
+|------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
+|------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 38
+|------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, ...]
+|------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_three
+_1__2__3__4_four
+_1__2__3__4__5_five
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, ...], ...]
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+-(-(-(-(... * ... / ...) / ...) / ...) / ...)
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), (3 -> "0x3"), ...])
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), (3 -> 3.0), ...])
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, ...
+|----------------------------------------------------------------------------|
+
+limit = linear(10), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, ...]
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 38
+|------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_...
+|------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 38
+|------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  ...
+|------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 38
+|------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 38
+|------------------------------------|
+-(-(-(-((x + x) * (x + x) / 
+  (x / x * (x / x))) / 
+  (x / x * (x / x) + -(x / x))) / 
+  ...
+|------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 38
+|------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), 
+  (3 -> "0x3"), (4 -> "0x4"), 
+  (5 -> "0x5"), (6 -> "0x6"), 
+  ...
+|------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 38
+|------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), 
+  (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), 
+  (6 -> 6.0), (7 -> 7.0), (8 -> 8.0), 
+  ...
+|------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 38
+|------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
+12, 13, 14, 15, 16, 17, 18, 19, 20, 
+21, 22, 23, 24, 25, 26, 27, 28, 29, 
+...
+|------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 38
+|------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
+  12, 13, 14, 15, 16, 17, 18, 19, 20, 
+  21, 22, 23, 24, 25, 26, 27, 28, 29, 
+  ...
+|------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_...
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+-(-(-(-((x + x) * (x + x) / (x / x * (x / x))) / 
+  (x / x * (x / x) + -(x / x))) / 
+  ((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)))) / 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), (3 -> "0x3"), (4 -> "0x4"), (5 -> "0x5"), 
+  (6 -> "0x6"), (7 -> "0x7"), (8 -> "0x8"), (9 -> "0x9"), (10 -> "0xA"), 
+  (11 -> "0xB"), (12 -> "0xC"), (13 -> "0xD"), (14 -> "0xE"), (15 -> "0xF"), 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), (6 -> 6.0), 
+  (7 -> 7.0), (8 -> 8.0), (9 -> 9.0), (10 -> 10.0), (11 -> 11.0), 
+  (12 -> 12.0), (13 -> 13.0), (14 -> 14.0), (15 -> 15.0), (16 -> 16.0), 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 
+22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 
+41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 
+...
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 3, line width = 78
+|----------------------------------------------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 
+  22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 
+  41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 
+  ...
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 38
+|------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_three
+_1__2__3__4_four
+_1__2__3__4__5_five
+|------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 38
+|------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 
+    10], ...]
+|------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 38
+|------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 38
+|------------------------------------|
+-(-(-(-((x + x) * (x + x) / 
+  (x / x * (x / x))) / 
+  (x / x * (x / x) + -(x / x))) / 
+  ((x / x * (x / x) + -(x / x)) * 
+    ((x + x) * (x + x)))) / 
+  ((x / x * (x / x) + -(x / x)) * 
+    ((x + x) * (x + x)) + 
+    (x / x - x - -(x / x) - 
+      x / x * (x / x))))
+|------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 38
+|------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), 
+  (3 -> "0x3"), (4 -> "0x4"), 
+  (5 -> "0x5"), (6 -> "0x6"), 
+  (7 -> "0x7"), (8 -> "0x8"), 
+  (9 -> "0x9"), (10 -> "0xA"), 
+  (11 -> "0xB"), (12 -> "0xC"), 
+  (13 -> "0xD"), (14 -> "0xE"), 
+  (15 -> "0xF"), (16 -> "0x10"), 
+  (17 -> "0x11"), (18 -> "0x12"), 
+  (19 -> "0x13"), (20 -> "0x14"), 
+  ...
+|------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 38
+|------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), 
+  (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), 
+  (6 -> 6.0), (7 -> 7.0), (8 -> 8.0), 
+  (9 -> 9.0), (10 -> 10.0), 
+  (11 -> 11.0), (12 -> 12.0), 
+  (13 -> 13.0), (14 -> 14.0), 
+  (15 -> 15.0), (16 -> 16.0), 
+  (17 -> 17.0), (18 -> 18.0), 
+  (19 -> 19.0), (20 -> 20.0), 
+  (21 -> 21.0), (22 -> 22.0), 
+  ...
+|------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 38
+|------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
+12, 13, 14, 15, 16, 17, 18, 19, 20, 
+21, 22, 23, 24, 25, 26, 27, 28, 29, 
+30, 31, 32, 33, 34, 35, 36, 37, 38, 
+39, 40, 41, 42, 43, 44, 45, 46, 47, 
+48, 49, 50, 51, 52, 53, 54, 55, 56, 
+57, 58, 59, 60, 61, 62, 63, 64, 65, 
+66, 67, 68, 69, 70, 71, 72, 73, 74, 
+75, 76, 77, 78, 79, 80, 81, 82, 83, 
+84, 85, 86, 87, 88, 89, 90, 91, 92, 
+...
+|------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 38
+|------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
+  12, 13, 14, 15, 16, 17, 18, 19, 20, 
+  21, 22, 23, 24, 25, 26, 27, 28, 29, 
+  30, 31, 32, 33, 34, 35, 36, 37, 38, 
+  39, 40, 41, 42, 43, 44, 45, 46, 47, 
+  48, 49, 50, 51, 52, 53, 54, 55, 56, 
+  57, 58, 59, 60, 61, 62, 63, 64, 65, 
+  66, 67, 68, 69, 70, 71, 72, 73, 74, 
+  75, 76, 77, 78, 79, 80, 81, 82, 83, 
+  84, 85, 86, 87, 88, 89, 90, 91, 92, 
+  ...
+|------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+indentation test:
+_1_one
+_1__2_two
+_1__2__3_three
+_1__2__3__4_four
+_1__2__3__4__5_five
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+[[1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], 
+  [1, 2, 3, 4, 5, 6, 7, 8, 9, 10], ...]
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+{1, 2.0, "three", '4', {5}}
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+-(-(-(-((x + x) * (x + x) / (x / x * (x / x))) / 
+  (x / x * (x / x) + -(x / x))) / 
+  ((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)))) / 
+  ((x / x * (x / x) + -(x / x)) * ((x + x) * (x + x)) + 
+    (x / x - x - -(x / x) - x / x * (x / x))))
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> "0x1"), (2 -> "0x2"), (3 -> "0x3"), (4 -> "0x4"), (5 -> "0x5"), 
+  (6 -> "0x6"), (7 -> "0x7"), (8 -> "0x8"), (9 -> "0x9"), (10 -> "0xA"), 
+  (11 -> "0xB"), (12 -> "0xC"), (13 -> "0xD"), (14 -> "0xE"), (15 -> "0xF"), 
+  (16 -> "0x10"), (17 -> "0x11"), (18 -> "0x12"), (19 -> "0x13"), 
+  (20 -> "0x14"), (21 -> "0x15"), (22 -> "0x16"), (23 -> "0x17"), 
+  (24 -> "0x18"), (25 -> "0x19"), (26 -> "0x1A"), (27 -> "0x1B"), 
+  (28 -> "0x1C"), (29 -> "0x1D"), (30 -> "0x1E"), (31 -> "0x1F"), 
+  (32 -> "0x20"), (33 -> "0x21"), ...])
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+map([(1 -> 1.0), (2 -> 2.0), (3 -> 3.0), (4 -> 4.0), (5 -> 5.0), (6 -> 6.0), 
+  (7 -> 7.0), (8 -> 8.0), (9 -> 9.0), (10 -> 10.0), (11 -> 11.0), 
+  (12 -> 12.0), (13 -> 13.0), (14 -> 14.0), (15 -> 15.0), (16 -> 16.0), 
+  (17 -> 17.0), (18 -> 18.0), (19 -> 19.0), (20 -> 20.0), (21 -> 21.0), 
+  (22 -> 22.0), (23 -> 23.0), (24 -> 24.0), (25 -> 25.0), (26 -> 26.0), 
+  (27 -> 27.0), (28 -> 28.0), (29 -> 29.0), (30 -> 30.0), (31 -> 31.0), 
+  (32 -> 32.0), (33 -> 33.0), ...])
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 
+22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 
+41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 
+60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 
+79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 
+98, 99, 100
+|----------------------------------------------------------------------------|
+
+limit = linear(100), max lines = 10, line width = 78
+|----------------------------------------------------------------------------|
+[1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 
+  22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 
+  41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 
+  60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 
+  79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 
+  98, 99, ...]
+|----------------------------------------------------------------------------|
Index: tests/hard_coded/test_pretty_printer.m
===================================================================
RCS file: tests/hard_coded/test_pretty_printer.m
diff -N tests/hard_coded/test_pretty_printer.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/test_pretty_printer.m	1 Aug 2007 00:59:19 -0000
@@ -0,0 +1,255 @@
+%-----------------------------------------------------------------------------%
+% test_pretty_printer.m
+% Ralph Becket <rafe at csse.unimelb.edu.au>
+% Tue Jun  5 16:19:10 EST 2007
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%
+%-----------------------------------------------------------------------------%
+
+:- module test_pretty_printer.
+
+:- interface.
+
+:- import_module io.
+
+
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module deconstruct.
+:- import_module float.
+:- import_module int.
+:- import_module list.
+:- import_module map.
+:- import_module ops.
+:- import_module pair.
+:- import_module pretty_printer.
+:- import_module solutions.
+:- import_module string.
+:- import_module term_io.
+:- import_module type_desc.
+:- import_module univ.
+
+
+
+:- type test_case
+    --->    test_case(
+                line_width              :: int,
+                max_lines               :: int,
+                pp_limit                :: pp_limit,
+                docs                    :: docs
+            ).
+
+:- type op_tree
+    --->    x
+    ;       - op_tree
+    ;       op_tree + op_tree
+    ;       op_tree - op_tree
+    ;       op_tree * op_tree
+    ;       op_tree / op_tree.
+
+
+
+main(!IO) :-
+    set_default_pp("list",    "list",       1, pp_list,   !IO),
+    set_default_pp("tree234", "tree234",    2, pp_map,    !IO),
+    set_default_pp("builtin", "character",  0, pp_char,   !IO),
+    set_default_pp("builtin", "float",      0, pp_float,  !IO),
+    set_default_pp("builtin", "int",        0, pp_int,    !IO),
+    set_default_pp("builtin", "string",     0, pp_string, !IO),
+    unsorted_solutions(test_case, TestCases),
+    list.foldl(run_test_case, TestCases, !IO).
+
+
+
+:- pred run_test_case(test_case::in, io::di, io::uo) is det.
+
+run_test_case(TestCase, !IO) :-
+    TestCase = test_case(LineWidth, MaxLines, Limit, Docs),
+    set_default_pp_params(pp_params(LineWidth, MaxLines, Limit), !IO),
+    io.format("\nlimit = %s, max lines = %d, line width = %d",
+        [s(string.string(Limit)), i(MaxLines), i(LineWidth)], !IO),
+    Ruler = "\n|" ++ string.duplicate_char(('-'), LineWidth - 2) ++ "|\n",
+    io.write_string(Ruler, !IO),
+    pretty_printer.format(Docs, !IO),
+    io.write_string(Ruler, !IO).
+
+
+
+:- func pp_float : pretty_printer.pp.
+
+pp_float(Univ, _) =
+    ( if Univ = univ(Float) then
+        [s(string.float_to_string(Float))]
+      else
+        [s("?pp_float?")]
+    ).
+
+
+
+:- func pp_int : pretty_printer.pp.
+
+pp_int(Univ, _) =
+    ( if Univ = univ(Int) then
+        [s(string.int_to_string(Int))]
+      else
+        [s("?pp_int?")]
+    ).
+
+
+
+:- func pp_string : pretty_printer.pp.
+
+pp_string(Univ, _) =
+    ( if Univ = univ(String) then
+        [s("\""), s(String), s("\"")]
+      else
+        [s("?pp_string?")]
+    ).
+
+
+
+:- func pp_char : pretty_printer.pp.
+
+pp_char(Univ, _) =
+    ( if Univ = univ(Char) then
+        [s(term_io.quoted_char(Char))]
+      else
+        [s("?pp_char?")]
+    ).
+
+
+
+:- pred pp_tuple(univ::in, docs::out) is semidet.
+
+pp_tuple(Univ, Docs) :-
+    Value = univ_value(Univ),
+    deconstruct(Value, canonicalize, "{}", _Arity, Args),
+    Docs = [s("{"), pp_list(Args, s(", ")), s("}")].
+
+
+
+:- func pp_list(univ, list(type_desc)) = docs.
+
+pp_list(Univ, ArgDescs) = Docs :-
+    ( if
+        ArgDescs = [ArgDesc],
+        has_type(Arg, ArgDesc),
+        same_list_type(List, Arg),
+        Value = univ_value(Univ),
+        dynamic_cast(Value, List),
+        UnivList = list.map(make_univ, List)
+      then
+        Docs = [
+            indent,
+            s("["), pp_list(UnivList, s(", ")), s("]"),
+            outdent
+        ]
+      else
+        Docs = [s("?pp_list?")]
+    ).
+
+
+:- pred same_list_type(list(T)::unused, T::unused) is det.
+
+same_list_type(_, _).
+
+
+:- type key_value(K, V)
+    --->    (K -> V).
+
+:- func pp_map(univ, list(type_desc)) = docs.
+
+pp_map(Univ, ArgDescs) = Docs :-
+    ( if
+        ArgDescs = [KArgDesc, VArgDesc],
+        has_type(K, KArgDesc),
+        has_type(V, VArgDesc),
+        same_map_type(Map, K, V),
+        Value = univ_value(Univ),
+        dynamic_cast(Value, Map)
+      then
+        UnivList =
+            map.foldr(func(KK, VV, KVs) = [univ(KK -> VV) | KVs], Map, []),
+        Docs = [
+            indent,
+            s("map(["), pp_list(UnivList, s(", ")), s("])"),
+            outdent
+        ]
+      else
+        Docs = [s("?pp_map?")]
+    ).
+
+
+:- func make_univ(T) = univ.
+
+make_univ(X) = univ(X).
+
+
+:- pred same_map_type(map(K, V)::unused, K::unused, V::unused) is det.
+
+same_map_type(_, _, _).
+
+
+:- pred test_case(test_case::out) is multi.
+
+test_case(test_case(LineWidth, MaxLines, Limit, Docs)) :-
+    List = 1..100,
+    ListUniv = list.map(func(X) = univ(X), List),
+    MapStr = list.foldl(
+        func(X, M) = M ^ elem(X) := "0x" ++ int_to_base_string(X, 16),
+        List, map.init : map(int, string)),
+    MapFloat = list.foldl(
+        func(X, M) = M ^ elem(X) := float(X),
+        List, map.init : map(int, float)),
+    OpTree = mk_op_tree(200),
+    Tuple = {1, 2.0, "three", '4', {5}},
+    Square = list.duplicate(10, 1..10) : list(list(int)),
+    IndentTest = [
+        s("indentation test:"),
+        indent("_1_"), nl, s("one"),
+        indent("_2_"), nl, s("two"),
+        indent("_3_"), nl, s("three"),
+        indent("_4_"), nl, s("four"),
+        indent("_5_"), nl, s("five")
+    ],
+    (   Limit = linear(100)
+    ;   Limit = linear(10)
+    ;   Limit = triangular(100)
+    ;   Limit = triangular(10)
+    ),
+    (   MaxLines = 10
+    ;   MaxLines = 3
+    ),
+    (   LineWidth = 78
+    ;   LineWidth = 38
+    ),
+    (   Docs = [pp(List)]
+    ;   Docs = [pp_list(ListUniv, s(", "))]
+    ;   Docs = [pp(MapFloat)]
+    ;   Docs = [pp(MapStr)]
+    ;   Docs = [pp(OpTree)]
+    ;   Docs = [pp(Tuple)]
+    ;   Docs = [pp(Square)]
+    ;   Docs = IndentTest
+    ).
+
+
+
+:- func mk_op_tree(int) = op_tree.
+
+mk_op_tree(N) =
+    (      if N =< 3      then x
+      else if N mod 5 = 0 then - mk_op_tree(N - 1)
+      else if N mod 5 = 1 then mk_op_tree(0 + N/2) + mk_op_tree(0 + N/3)
+      else if N mod 5 = 2 then mk_op_tree(1 + N/2) - mk_op_tree(1 + N/3)
+      else if N mod 5 = 3 then mk_op_tree(0 + N/2) * mk_op_tree(2 + N/3)
+      else                     mk_op_tree(1 + N/2) / mk_op_tree(0 + N/3)
+    ).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list