[m-rev.] For revew: a new, improved pretty printer
Ralph Becket
rafe at csse.unimelb.edu.au
Thu Aug 2 14:01:52 AEST 2007
I've tried to address Zoltan's comments as follows.
- Formatting of comments for the doc type.
- I've removed some doc constructors; those functions are now `hidden'
inside a pp_internal/1 constructor which cannot be exploited by user
code.
- open_group, close_group, indent/1, and outdent have now been replaced
with functions to construct the appropriate docs. This guarantees
correct matching.
- I've tried to improve the explanation for formatting depth limits.
Cosmetic changes:
- Change the pervasive use of doc lists to single docs (this avoids
some unnecessary list construction).
- Renamed pp_list, pp_term, etc. to format_list, format_term, etc.
- Renamed the pp type to formatter.
- Made corresponding pred name changes.
Here's the relative diff:
diff -u library/pretty_printer.m library/pretty_printer.m
--- library/pretty_printer.m 1 Aug 2007 07:28:08 -0000
+++ library/pretty_printer.m 2 Aug 2007 03:39:33 -0000
@@ -10,8 +10,8 @@
% Main author: rafe
% Stability: medium
%
-% This module defines the doc type and a pretty printer for formatting
-% doc lists.
+% This module defines a doc type for formatting and a pretty printer for
+% displaying docs.
%
% The doc type includes data constructors for outputting strings, newlines,
% forming groups, indented blocks, and arbitrary values.
@@ -47,7 +47,6 @@
:- import_module list.
:- import_module io.
-:- import_module ops.
:- import_module stream.
:- import_module string.
:- import_module type_desc.
@@ -56,146 +55,157 @@
:- 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 newlines 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!
+ ---> str(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.
+
+ ; docs(docs)
+ % An embedded sequence of docs.
+
+ ; format_univ(univ)
+ % Use a specialised formatter if available, otherwise use the
+ % generic formatter.
+
+ ; format_list(list(univ), doc)
+ % Pretty print a list of items using the given doc as a separator
+ % between items (the separator can be any doc). After the
+ % formatting limit is reached, output is truncated to "...".
+
+ ; format_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.
+
+ ; pp_internal(pp_internal).
+ % pp_internal docs are used in the implementation and cannot
+ % be exploited by user code.
:- type docs == list(doc).
- % indent = indent(" ").
+ % indent(IndentString, Docs)
+ % Append IndentString to the current indentation while
+ % printing Docs. Indentation is printed after each newline that is
+ % output.
+ %
+:- func indent(string, docs) = doc.
+
+ % indent(Docs) = indent(" ", Docs).
% A convenient abbreviation.
+ %
+:- func indent(docs) = doc.
+
+ % group(Docs)
+ % If Docs can be output on the remainder of the current line
+ % by ignoring any newlines in Docs, then do so. Otherwise
+ % newlines in Docs are printed (followed by any indentation).
+ % The formatting test is applied recursively for any subgroups in Docs.
%
-:- func indent = doc.
+:- func group(docs) = doc.
- % pp(X) = pp_univ(univ(X)).
+ % format(X) = format_univ(univ(X)).
% A convenient abbreviation.
%
-:- func pp(T) = doc.
+:- func format(T) = doc.
- % set_arg_priority =
- % set_op_priority(ops.arg_priority(ops.init_mercury_op_table))
+ % The pretty-printer limit type, used to control conversion by
+ % format_univ, format_list, and format_term.
%
- % This is a useful shorthand when pretty-printing term arguments.
+ % A limit of linear(N) formats the first N functors before truncating
+ % output to "...".
%
-:- 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.
+ % A limit of triangular(N) formats a term t(X1, ..., Xn) by applying a
+ % limit of triangular(N - 1) when formatting X1, triangular(N - 2) when
+ % formatting X2, ..., and triangular(N - n) when formatting Xn.
+ % The cost of formatting the term t(X1, ..., Xn) as a whole is just one,
+ % so a sequence of terms T1, T2, ... is formatted with limits
+ % triangular(N), triangular(N - 1), ... respectively. When the
+ % limit is exhausted, terms are output as just "...".
%
-:- type pp_limit
+:- type formatting_limit
---> linear(int) % Print this many functors.
- ; triangular(int). % Print first arg with limit n-1,
- % second arg with limit n-2, ...
+ ; triangular(int). % Print first arg with limit N-1,
+ % second arg with limit N-2, ...
- % The type and inst of pretty-printer converters.
+ % The type of generic formatting functions.
% 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 ).
+:- type formatter == ( func(univ, list(type_desc)) = doc ).
- % A pp_map maps types to pps. Types are identified by module name, type
- % name, and type arity.
+ % A formatter_map maps types to pps. Types are identified by module name,
+ % type name, and type arity.
%
-:- type pp_map.
+:- type formatter_map.
- % Construct a new pp_map.
+ % Construct a new formatter_map.
%
-:- func new_pp_map = pp_map.
+:- func new_formatter_map = formatter_map.
- % set_pp_mapping(ModuleName, TypeName, TypeArity, PP, PPMap)
- % Update PPMap to use PP to format the type
+ % set_formatter(ModuleName, TypeName, TypeArity, Formatter, FMap)
+ % Update FMap to use Formatter to format the type
% ModuleName.TypeName/TypeArity.
%
-:- func set_pp_mapping(string, string, int, pp, pp_map) = pp_map.
+:- func set_formatter(string, string, int, formatter, formatter_map) =
+ formatter_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.
+ % format(Stream, FMap, LineWidth, MaxLines, Limit, Doc, !State).
+ % Format Doc to fit on lines of LineWidth chars, truncating after
+ % MaxLines lines, fomatting format_univ(_) docs using specialised
+ % formatters Formatters 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)
+:- pred format(Stream::in, formatter_map::in, int::in, int::in,
+ formatting_limit::in, doc::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 I/O state.
+ % formatters and formatting parameters are attached to the I/O state.
% The I/O state-specific format predicate below uses this settings.
%
:- type pp_params
---> pp_params(
- pp_line_width :: int, % Line width in characters.
- pp_max_lines :: int, % Max lines to output.
- pp_limit :: pp_limit % Max term formatting depth.
+ pp_line_width :: int, % Line width in characters.
+ pp_max_lines :: int, % Max lines to output.
+ pp_limit :: formatting_limit % Term formatting limit.
).
- % The default pp_map may also be updated by initialisation goals in various
- % modules.
+ % The default formatter_map may also be updated by initialisation goals in
+ % various modules.
% These defaults are thread local (i.e., changes made by one thread to
- % the default pp_map will not be visible in another thread).
+ % the default formatter_map will not be visible in another thread).
%
-:- 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,
+:- pred get_default_formatter_map(formatter_map::out, io::di, io::uo) is det.
+:- pred set_default_formatter_map(formatter_map::in, io::di, io::uo) is det.
+:- pred set_default_formatter(string::in, string::in, int::in, formatter::in,
io::di, io::uo) is det.
% The initial default pp_params are pp_params(78, 100, triangular(100)).
% These defaults are thread local (i.e., changes made by one thread to
% the default pp_params will not be visible in another thread).
%
-:- 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.
+:- pred get_default_params(pp_params::out, io::di, io::uo) is det.
+:- pred set_default_params(pp_params::in, io::di, io::uo) is det.
- % format(Docs, !IO)
- % format(FileStream, Docs, !IO)
- % Format Docs to io.stdout_stream or FileStream respectively, using
- % the default pp_map and pp_params.
+ % format(Doc, !IO)
+ % format(FileStream, Doc, !IO)
+ % Format Doc to io.stdout_stream or FileStream respectively, using
+ % the default formatter_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.
+:- pred format(doc::in, io::di, io::uo) is det.
+:- pred format(io.output_stream::in, doc::in, io::di, io::uo) is det.
+
+ % This type is private to the implementation. It cannot be exploited by
+ % user code.
+ %
+:- type pp_internal.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -207,68 +217,102 @@
:- import_module exception.
:- import_module int.
:- import_module map.
+:- import_module ops.
:- import_module term_io.
-:- type pp_map == map(string, map(string, map(int, pp))).
+:- type formatter_map == map(string, map(string, map(int, formatter))).
:- type indents == list(string).
+:- type pp_internal
+ ---> open_group
+ % Mark the start of a group.
+
+ ; close_group
+ % Mark the end of a group.
+
+ ; indent(string)
+ % Extend the current indentation.
+
+ ; outdent
+ % Restore indentation to before the last indent/1.
+
+ ; set_op_priority(ops.priority)
+ % Set the current priority for printing operator terms with the
+ % correct parenthesisation.
+
+ ; set_limit(formatting_limit).
+ % Set the truncation limit.
+
%-----------------------------------------------------------------------------%
-new_pp_map = map.init.
+new_formatter_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
+set_formatter(ModuleName, TypeName, Arity, Formatter, FMap0) = FMap :-
+ ( if FMap0 ^ elem(ModuleName) = FMap0_Type_Arity then
+ ( if FMap0_Type_Arity ^ elem(TypeName) = FMap0_Arity then
+ FMap_Arity = FMap0_Arity ^ elem(Arity) := Formatter
else
- PPMap_Arity = map.init ^ elem(Arity) := PP
+ FMap_Arity = map.init ^ elem(Arity) := Formatter
),
- PPMap_Type_Arity = PPMap0_Type_Arity ^ elem(TypeName) := PPMap_Arity,
- PPMap = PPMap0 ^ elem(ModuleName) := PPMap_Type_Arity
+ FMap_Type_Arity = FMap0_Type_Arity ^ elem(TypeName) := FMap_Arity,
+ FMap = FMap0 ^ elem(ModuleName) := FMap_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
+ FMap_Arity = map.init ^ elem(Arity) := Formatter,
+ FMap_Type_Arity = map.init ^ elem(TypeName) := FMap_Arity,
+ FMap = FMap0 ^ elem(ModuleName) := FMap_Type_Arity
).
%-----------------------------------------------------------------------------%
-:- pred get_pp_map(pp_map::in, string::in, string::in, int::in, pp::out)
- is semidet.
+:- pred get_formatter(formatter_map::in, string::in, string::in, int::in,
+ formatter::out) is semidet.
-get_pp_map(PPMap, ModuleName, TypeName, Arity, PP) :-
- PP = PPMap ^ elem(ModuleName) ^ elem(TypeName) ^ elem(Arity).
+get_formatter(FMap, ModuleName, TypeName, Arity, Formatter) :-
+ Formatter = FMap ^ elem(ModuleName) ^ elem(TypeName) ^ elem(Arity).
%-----------------------------------------------------------------------------%
-indent = indent(" ").
+indent(Indent, Docs) =
+ docs([pp_internal(indent(Indent)), docs(Docs), pp_internal(outdent)]).
%-----------------------------------------------------------------------------%
-pp(X) = pp_univ(univ(X)).
+indent(Docs) =
+ indent(" ", Docs).
%-----------------------------------------------------------------------------%
+group(Docs) =
+ docs([pp_internal(open_group), docs(Docs), pp_internal(close_group)]).
+
+%-----------------------------------------------------------------------------%
+
+format(X) = format_univ(univ(X)).
+
+%-----------------------------------------------------------------------------%
+
+:- func set_arg_priority = doc.
+
set_arg_priority =
- set_op_priority(ops.arg_priority(ops.init_mercury_op_table)).
+ pp_internal(set_op_priority(ops.arg_priority(ops.init_mercury_op_table))).
%-----------------------------------------------------------------------------%
-format(Stream, PPMap, LineWidth, MaxLines, Limit, Docs, !IO) :-
+format(Stream, FMap, LineWidth, MaxLines, Limit, Doc, !IO) :-
Pri = ops.max_priority(ops.init_mercury_op_table),
RemainingWidth = LineWidth,
Indents = [],
- format(Stream, PPMap, LineWidth, Docs, RemainingWidth, _, Indents, _,
+ format(Stream, FMap, LineWidth, [Doc], RemainingWidth, _, Indents, _,
MaxLines, _, Limit, _, Pri, _, !IO).
%-----------------------------------------------------------------------------%
- % format(PPMap, LineWidth, Docs, !RemainingWidth, !Indents,
+ % format(FMap, 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,
@@ -278,17 +322,17 @@
% - tracking current operator priority !Pri.
% Assumes that Docs is the output of expand.
%
-:- pred format(Stream::in, pp_map::in, int::in, docs::in,
+:- pred format(Stream::in, formatter_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)
+ formatting_limit::in, formatting_limit::out,
+ ops.priority::in, ops.priority::out, State::di, State::uo)
is det
<= stream.writer(Stream, string, State).
-format(_Stream, _PPMap, _LineWidth, [],
+format(_Stream, _FMap, _LineWidth, [],
!RemainingWidth, !Indents, !RemainingLines, !Limit, !Pri, !IO).
-format(Stream, PPMap, LineWidth, [Doc | Docs0],
+format(Stream, FMap, LineWidth, [Doc | Docs0],
!RemainingWidth, !Indents, !RemainingLines, !Limit, !Pri, !IO) :-
( if !.RemainingLines =< 0 then
stream.put(Stream, "...", !IO)
@@ -296,7 +340,7 @@
(
% Output strings directly.
%
- Doc = s(String),
+ Doc = str(String),
stream.put(Stream, String, !IO),
!:RemainingWidth = !.RemainingWidth - string.length(String),
Docs = Docs0
@@ -315,15 +359,30 @@
),
Docs = Docs0
;
+ Doc = docs(Docs1),
+ Docs = list.(Docs1 ++ Docs0)
+ ;
+ Doc = format_univ(Univ),
+ expand_pp(FMap, Univ, Doc1, !Limit, !.Pri),
+ Docs = [Doc1 | Docs0]
+ ;
+ Doc = format_list(Univs, Sep),
+ expand_format_list(Univs, Sep, Doc1, !Limit),
+ Docs = [Doc1 | Docs0]
+ ;
+ Doc = format_term(Name, Univs),
+ expand_format_term(Name, Univs, Doc1, !Limit, !.Pri),
+ Docs = [Doc1 | Docs0]
+ ;
% Indents.
%
- Doc = indent(Indent),
+ Doc = pp_internal(indent(Indent)),
!:Indents = [Indent | !.Indents],
Docs = Docs0
;
% Outdents.
%
- Doc = outdent,
+ Doc = pp_internal(outdent),
!:Indents = list.det_tail(!.Indents),
Docs = Docs0
;
@@ -332,10 +391,10 @@
% it that way; otherwise we have to recognise the nls in the
% group.
%
- Doc = open_group,
+ Doc = pp_internal(open_group),
OpenGroups = 1,
CurrentRemainingWidth = !.RemainingWidth,
- expand_docs(PPMap, Docs0, Docs1, OpenGroups, !Limit, !Pri,
+ expand_docs(FMap, Docs0, Docs1, OpenGroups, !Limit, !Pri,
CurrentRemainingWidth, RemainingWidthAfterGroup),
( if RemainingWidthAfterGroup >= 0 then
output_current_group(Stream, OpenGroups, Docs1, Docs,
@@ -346,33 +405,18 @@
;
% Close groups.
%
- Doc = close_group,
+ Doc = pp_internal(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),
+ Doc = pp_internal(set_limit(Lim)),
!:Limit = Lim,
Docs = Docs0
;
- Doc = set_op_priority(NewPri),
+ Doc = pp_internal(set_op_priority(NewPri)),
!:Pri = NewPri,
Docs = Docs0
),
- format(Stream, PPMap, LineWidth, Docs, !RemainingWidth, !Indents,
+ format(Stream, FMap, LineWidth, Docs, !RemainingWidth, !Indents,
!RemainingLines, !Limit, !Pri, !IO)
).
@@ -388,19 +432,19 @@
output_current_group(Stream, OpenGroups, [Doc | Docs0], Docs, !RemainingWidth,
!IO) :-
- ( if Doc = s(String) then
+ ( if Doc = str(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
+ else if Doc = pp_internal(open_group) then
output_current_group(Stream, OpenGroups + 1, Docs0, Docs,
!RemainingWidth, !IO)
- else if Doc = close_group then
+ else if Doc = pp_internal(close_group) then
( if OpenGroups = 1 then
Docs = Docs0
@@ -419,7 +463,7 @@
%-----------------------------------------------------------------------------%
% expand_docs(Docs0, Docs, G, !L, !P, !R) expands out any doc(_),
- % pp_univ(_), pp_list(_, _), and pp_term(_) constructors in Docs0 into
+ % pp_univ(_), format_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.
@@ -428,13 +472,13 @@
% !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.
+:- pred expand_docs(formatter_map::in, docs::in, docs::out, int::in,
+ formatting_limit::in, formatting_limit::out,
+ ops.priority::in, ops.priority::out, int::in, int::out) is det.
-expand_docs(_PPMap, [], [], _OpenGroups, !Limit, !Pri, !N).
+expand_docs(_FMap, [], [], _OpenGroups, !Limit, !Pri, !N).
-expand_docs(PPMap, [Doc | Docs0], Docs, OpenGroups,
+expand_docs(FMap, [Doc | Docs0], Docs, OpenGroups,
!Limit, !Pri, !RemainingWidth) :-
( if
(
@@ -450,10 +494,10 @@
Docs = [Doc | Docs0]
else
(
- Doc = s(String),
+ Doc = str(String),
!:RemainingWidth = !.RemainingWidth - string.length(String),
Docs = [Doc | Docs1],
- expand_docs(PPMap, Docs0, Docs1, OpenGroups,
+ expand_docs(FMap, Docs0, Docs1, OpenGroups,
!Limit, !Pri, !RemainingWidth)
;
Doc = nl,
@@ -461,59 +505,59 @@
Docs = [Doc | Docs0]
else
Docs = [Doc | Docs1],
- expand_docs(PPMap, Docs0, Docs1, OpenGroups,
+ expand_docs(FMap, Docs0, Docs1, OpenGroups,
!Limit, !Pri, !RemainingWidth)
)
;
- Doc = indent(_),
- Docs = [Doc | Docs1],
- expand_docs(PPMap, Docs0, Docs1, OpenGroups,
+ Doc = docs(Docs1),
+ expand_docs(FMap, list.(Docs1 ++ Docs0), Docs, OpenGroups,
!Limit, !Pri, !RemainingWidth)
;
- Doc = outdent,
- Docs = [Doc | Docs1],
- expand_docs(PPMap, Docs0, Docs1, OpenGroups,
+ Doc = format_univ(Univ),
+ expand_pp(FMap, Univ, Doc1, !Limit, !.Pri),
+ expand_docs(FMap, [Doc1 | Docs0], Docs, 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,
+ Doc = format_list(Univs, Sep),
+ expand_format_list(Univs, Sep, Doc1, !Limit),
+ expand_docs(FMap, [Doc1 | Docs0], Docs, OpenGroups,
!Limit, !Pri, !RemainingWidth)
;
- Doc = close_group,
- Docs = [Doc | Docs1],
- OpenGroups1 = OpenGroups - ( if OpenGroups > 0 then 1 else 0 ),
- expand_docs(PPMap, Docs0, Docs1, OpenGroups1,
+ Doc = format_term(Name, Univs),
+ expand_format_term(Name, Univs, Doc1, !Limit, !.Pri),
+ expand_docs(FMap, [Doc1 | Docs0], Docs, OpenGroups,
!Limit, !Pri, !RemainingWidth)
;
- Doc = docs(Docs1),
- expand_docs(PPMap, list.(Docs1 ++ Docs0), Docs, OpenGroups,
+ Doc = pp_internal(indent(_)),
+ Docs = [Doc | Docs1],
+ expand_docs(FMap, Docs0, Docs1, OpenGroups,
!Limit, !Pri, !RemainingWidth)
;
- Doc = pp_univ(Univ),
- expand_pp(PPMap, Univ, Docs1, !Limit, !.Pri),
- expand_docs(PPMap, list.(Docs1 ++ Docs0), Docs, OpenGroups,
+ Doc = pp_internal(outdent),
+ Docs = [Doc | Docs1],
+ expand_docs(FMap, Docs0, Docs1, OpenGroups,
!Limit, !Pri, !RemainingWidth)
;
- Doc = pp_list(Univs, Sep),
- expand_pp_list(Univs, Sep, Docs1, !Limit),
- expand_docs(PPMap, list.(Docs1 ++ Docs0), Docs, OpenGroups,
+ Doc = pp_internal(open_group),
+ Docs = [Doc | Docs1],
+ OpenGroups1 = OpenGroups + ( if OpenGroups > 0 then 1 else 0 ),
+ expand_docs(FMap, Docs0, Docs1, OpenGroups1,
!Limit, !Pri, !RemainingWidth)
;
- Doc = pp_term(Name, Univs),
- expand_pp_term(Name, Univs, Docs1, !Limit, !.Pri),
- expand_docs(PPMap, list.(Docs1 ++ Docs0), Docs, OpenGroups,
+ Doc = pp_internal(close_group),
+ Docs = [Doc | Docs1],
+ OpenGroups1 = OpenGroups - ( if OpenGroups > 0 then 1 else 0 ),
+ expand_docs(FMap, Docs0, Docs1, OpenGroups1,
!Limit, !Pri, !RemainingWidth)
;
- Doc = set_limit(Lim),
+ Doc = pp_internal(set_limit(Lim)),
!:Limit = Lim,
- expand_docs(PPMap, Docs0, Docs, OpenGroups,
+ expand_docs(FMap, Docs0, Docs, OpenGroups,
!Limit, !Pri, !RemainingWidth)
;
- Doc = set_op_priority(NewPri),
+ Doc = pp_internal(set_op_priority(NewPri)),
!:Pri = NewPri,
- expand_docs(PPMap, Docs0, Docs, OpenGroups,
+ expand_docs(FMap, Docs0, Docs, OpenGroups,
!Limit, !Pri, !RemainingWidth)
)
).
@@ -549,55 +593,52 @@
% 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.
+:- pred expand_pp(formatter_map::in, univ::in, doc::out,
+ formatting_limit::in, formatting_limit::out, ops.priority::in) is det.
-expand_pp(PPMap, Univ, Docs, !Limit, CurrentPri) :-
+expand_pp(FMap, Univ, Doc, !Limit, CurrentPri) :-
( if
limit_overrun(!.Limit)
then
- Docs = [s("...")]
+ Doc = str("...")
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)
+ get_formatter(FMap, ModuleName, TypeName, Arity, Formatter)
then
decrement_limit(!Limit),
- Docs = set_post_pp_limit_correctly(!.Limit, PP(Univ, ArgTypeDescs))
+ Doc = set_formatting_limit_correctly(!.Limit,
+ Formatter(Univ, ArgTypeDescs))
else
deconstruct(univ_value(Univ), canonicalize, Name, _Arity, Args),
- expand_pp_term(Name, Args, Docs, !Limit, CurrentPri)
+ expand_format_term(Name, Args, Doc, !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.
+:- pred expand_format_list(list(univ)::in, doc::in, doc::out,
+ formatting_limit::in, formatting_limit::out) is det.
-expand_pp_list([], _Sep, [], !Limit).
+expand_format_list([], _Sep, docs([]), !Limit).
-expand_pp_list([Univ | Univs], Sep, Docs, !Limit) :-
+expand_format_list([Univ | Univs], Sep, Doc, !Limit) :-
( if limit_overrun(!.Limit) then
- Docs = [s("...")]
+ Doc = str("...")
else
(
Univs = [],
- Docs = [
- set_arg_priority,
- open_group, nl, pp_univ(Univ), close_group
- ]
+ Doc = group([set_arg_priority, nl, format_univ(Univ)])
;
Univs = [_ | _],
- Docs = [
- set_arg_priority,
- open_group, nl, pp_univ(Univ), Sep, close_group,
- pp_list(Univs, Sep)
- ]
+ Doc = docs([
+ group([set_arg_priority, nl, format_univ(Univ), Sep]),
+ format_list(Univs, Sep)
+ ])
)
).
@@ -606,117 +647,116 @@
% 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.
+:- pred expand_format_term(string::in, list(univ)::in, doc::out,
+ formatting_limit::in, formatting_limit::out, ops.priority::in) is det.
-expand_pp_term(Name, Args, Docs, !Limit, CurrentPri) :-
+expand_format_term(Name, Args, Doc, !Limit, CurrentPri) :-
decrement_limit(!Limit),
( if Args = [] then
- Docs1 = [s(term_io.quoted_atom(Name))]
+ Doc0 = str(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
+ Doc0 = str("...")
+ else if expand_format_op(Name, Args, CurrentPri, OpDoc) then
+ Doc0 = OpDoc
else if Name = "{}" then
- Docs1 = [
- s("{"), pp_list(Args, s(", ")), s("}")
- ]
+ Doc0 = docs([
+ str("{"), indent([format_list(Args, str(", "))]), str("}")
+ ])
else
- Docs1 = [
- s(term_io.quoted_atom(Name)),
- s("("),
- indent,
- pp_list(Args, s(", ")),
- s(")"),
- outdent
- ]
+ Doc0 = docs([
+ str(term_io.quoted_atom(Name)),
+ str("("), indent([format_list(Args, str(", "))]), str(")")
+ ])
),
- Docs = set_post_pp_limit_correctly(!.Limit, Docs1).
+ Doc = set_formatting_limit_correctly(!.Limit, Doc0).
%-----------------------------------------------------------------------------%
% 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.
+:- pred expand_format_op(string::in, list(univ)::in, ops.priority::in,
+ doc::out) is semidet.
-expand_pp_op(Op, [Arg], CurrentPri, Docs) :-
+expand_format_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)
+ Doc =
+ group([
+ str(Op),
+ pp_internal(set_op_priority(adjust_priority(OpPri, Assoc))),
+ format_univ(Arg)
+ ]),
+ Docs = add_parens_if_needed(OpPri, CurrentPri, Doc)
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)
+ Doc =
+ group([
+ pp_internal(set_op_priority(adjust_priority(OpPri, Assoc))),
+ format_univ(Arg),
+ str(Op)
+ ]),
+ Docs = add_parens_if_needed(OpPri, CurrentPri, Doc)
).
-expand_pp_op(Op, [ArgA, ArgB], CurrentPri, Docs) :-
+expand_format_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)
+ Doc =
+ group([
+ pp_internal(set_op_priority(adjust_priority(OpPri, AssocA))),
+ format_univ(ArgA),
+ str(" "), str(Op), str(" "),
+ indent([
+ nl,
+ pp_internal(set_op_priority(adjust_priority(OpPri,
+ AssocB))),
+ format_univ(ArgB)
+ ])
+ ]),
+ Docs = add_parens_if_needed(OpPri, CurrentPri, Doc)
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)
+ Doc =
+ group([
+ str(Op), str(" "),
+ pp_internal(set_op_priority(adjust_priority(OpPri, AssocA))),
+ format_univ(ArgA),
+ str(" "),
+ indent([
+ pp_internal(set_op_priority(adjust_priority(OpPri,
+ AssocB))),
+ format_univ(ArgB)
+ ])
+ ]),
+ Docs = add_parens_if_needed(OpPri, CurrentPri, Doc)
).
%-----------------------------------------------------------------------------%
% Update the limits properly after processing a pp_term.
%
-:- func set_post_pp_limit_correctly(pp_limit, docs) = docs.
+:- func set_formatting_limit_correctly(formatting_limit, doc) = doc.
-set_post_pp_limit_correctly(linear(_), Docs) =
- Docs.
+set_formatting_limit_correctly(linear(_), Doc) =
+ Doc.
-set_post_pp_limit_correctly(Limit @ triangular(_), Docs0) =
- [docs(Docs0), set_limit(Limit)].
+set_formatting_limit_correctly(Limit @ triangular(_), Doc0) =
+ docs([Doc0, pp_internal(set_limit(Limit))]).
%-----------------------------------------------------------------------------%
- % Add parentheses around some docs if required by operator priority.
+ % Add parentheses around a doc if required by operator priority.
%
-:- func add_parens_if_needed(ops.priority, ops.priority, docs) = docs.
+:- func add_parens_if_needed(ops.priority, ops.priority, doc) = doc.
-add_parens_if_needed(OpPriority, EnclosingPriority, Docs) =
+add_parens_if_needed(OpPriority, EnclosingPriority, Doc) =
( if OpPriority > EnclosingPriority then
- [s("("), docs(Docs), s(")")]
+ docs([str("("), Doc, str(")")])
else
- Docs
+ Doc
).
%-----------------------------------------------------------------------------%
@@ -730,7 +770,7 @@
% Succeeds if the pretty-printer state limits have been used up.
%
-:- pred limit_overrun(pp_limit::in) is semidet.
+:- pred limit_overrun(formatting_limit::in) is semidet.
limit_overrun(linear(N)) :-
N =< 0.
@@ -742,7 +782,7 @@
% Reduce the pretty-printer limit by one.
%
-:- pred decrement_limit(pp_limit::in, pp_limit::out) is det.
+:- pred decrement_limit(formatting_limit::in, formatting_limit::out) is det.
decrement_limit(linear(N), linear(N - 1)).
@@ -752,7 +792,7 @@
%-----------------------------------------------------------------------------%
% Convenience predicates.
-:- mutable(io_pp_map, pp_map, new_pp_map, ground,
+:- mutable(io_formatter_map, formatter_map, new_formatter_map, ground,
[attach_to_io_state, untrailed, thread_local]).
:- mutable(io_pp_params, pp_params, pp_params(78, 100, triangular(100)),
@@ -760,34 +800,34 @@
%-----------------------------------------------------------------------------%
-get_default_pp_map(PPMap, !IO) :-
- get_io_pp_map(PPMap, !IO).
+get_default_formatter_map(FMap, !IO) :-
+ get_io_formatter_map(FMap, !IO).
-set_default_pp_map(PPMap, !IO) :-
- set_io_pp_map(PPMap, !IO).
+set_default_formatter_map(FMap, !IO) :-
+ set_io_formatter_map(FMap, !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).
+set_default_formatter(ModuleName, TypeName, Arity, Formatter, !IO) :-
+ get_io_formatter_map(FMap0, !IO),
+ FMap = set_formatter(ModuleName, TypeName, Arity, Formatter, FMap0),
+ set_io_formatter_map(FMap, !IO).
%-----------------------------------------------------------------------------%
-get_default_pp_params(Params, !IO) :-
+get_default_params(Params, !IO) :-
get_io_pp_params(Params, !IO).
-set_default_pp_params(Params, !IO) :-
+set_default_params(Params, !IO) :-
set_io_pp_params(Params, !IO).
%-----------------------------------------------------------------------------%
-format(Docs, !IO) :-
- format(io.stdout_stream, Docs, !IO).
+format(Doc, !IO) :-
+ format(io.stdout_stream, Doc, !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).
+format(Stream, Doc, !IO) :-
+ get_default_formatter_map(Formatters, !IO),
+ get_default_params(pp_params(LineWidth, MaxLines, Limit), !IO),
+ format(Stream, Formatters, LineWidth, MaxLines, Limit, Doc, !IO).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
diff -u tests/hard_coded/test_pretty_printer.m tests/hard_coded/test_pretty_printer.m
--- tests/hard_coded/test_pretty_printer.m 1 Aug 2007 00:59:19 -0000
+++ tests/hard_coded/test_pretty_printer.m 2 Aug 2007 02:37:25 -0000
@@ -40,8 +40,8 @@
---> test_case(
line_width :: int,
max_lines :: int,
- pp_limit :: pp_limit,
- docs :: docs
+ formatting_limit :: formatting_limit,
+ doc :: doc
).
:- type op_tree
@@ -55,12 +55,12 @@
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),
+ set_default_formatter("list", "list", 1, pp_list, !IO),
+ set_default_formatter("tree234", "tree234", 2, pp_map, !IO),
+ set_default_formatter("builtin", "character", 0, pp_char, !IO),
+ set_default_formatter("builtin", "float", 0, pp_float, !IO),
+ set_default_formatter("builtin", "int", 0, pp_int, !IO),
+ set_default_formatter("builtin", "string", 0, pp_string, !IO),
unsorted_solutions(test_case, TestCases),
list.foldl(run_test_case, TestCases, !IO).
@@ -69,73 +69,64 @@
:- 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),
+ TestCase = test_case(LineWidth, MaxLines, Limit, Doc),
+ set_default_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),
+ pretty_printer.format(Doc, !IO),
io.write_string(Ruler, !IO).
-:- func pp_float : pretty_printer.pp.
+:- func pp_float : pretty_printer.formatter.
pp_float(Univ, _) =
( if Univ = univ(Float) then
- [s(string.float_to_string(Float))]
+ str(string.float_to_string(Float))
else
- [s("?pp_float?")]
+ str("?pp_float?")
).
-:- func pp_int : pretty_printer.pp.
+:- func pp_int : pretty_printer.formatter.
pp_int(Univ, _) =
( if Univ = univ(Int) then
- [s(string.int_to_string(Int))]
+ str(string.int_to_string(Int))
else
- [s("?pp_int?")]
+ str("?pp_int?")
).
-:- func pp_string : pretty_printer.pp.
+:- func pp_string : pretty_printer.formatter.
pp_string(Univ, _) =
( if Univ = univ(String) then
- [s("\""), s(String), s("\"")]
+ docs([str("\""), str(String), str("\"")])
else
- [s("?pp_string?")]
+ str("?pp_string?")
).
-:- func pp_char : pretty_printer.pp.
+:- func pp_char : pretty_printer.formatter.
pp_char(Univ, _) =
( if Univ = univ(Char) then
- [s(term_io.quoted_char(Char))]
+ str(term_io.quoted_char(Char))
else
- [s("?pp_char?")]
+ str("?pp_char?")
).
-:- pred pp_tuple(univ::in, docs::out) is semidet.
+:- func pp_list(univ, list(type_desc)) = doc.
-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 :-
+pp_list(Univ, ArgDescs) = Doc :-
( if
ArgDescs = [ArgDesc],
has_type(Arg, ArgDesc),
@@ -144,13 +135,9 @@
dynamic_cast(Value, List),
UnivList = list.map(make_univ, List)
then
- Docs = [
- indent,
- s("["), pp_list(UnivList, s(", ")), s("]"),
- outdent
- ]
+ Doc = indent([ str("["), format_list(UnivList, str(", ")), str("]") ])
else
- Docs = [s("?pp_list?")]
+ Doc = str("?pp_list?")
).
@@ -162,9 +149,9 @@
:- type key_value(K, V)
---> (K -> V).
-:- func pp_map(univ, list(type_desc)) = docs.
+:- func pp_map(univ, list(type_desc)) = doc.
-pp_map(Univ, ArgDescs) = Docs :-
+pp_map(Univ, ArgDescs) = Doc :-
( if
ArgDescs = [KArgDesc, VArgDesc],
has_type(K, KArgDesc),
@@ -175,13 +162,11 @@
then
UnivList =
map.foldr(func(KK, VV, KVs) = [univ(KK -> VV) | KVs], Map, []),
- Docs = [
- indent,
- s("map(["), pp_list(UnivList, s(", ")), s("])"),
- outdent
- ]
+ Doc = indent([
+ str("map(["), format_list(UnivList, str(", ")), str("])")
+ ])
else
- Docs = [s("?pp_map?")]
+ Doc = str("?pp_map?")
).
@@ -197,7 +182,7 @@
:- pred test_case(test_case::out) is multi.
-test_case(test_case(LineWidth, MaxLines, Limit, Docs)) :-
+test_case(test_case(LineWidth, MaxLines, Limit, Doc)) :-
List = 1..100,
ListUniv = list.map(func(X) = univ(X), List),
MapStr = list.foldl(
@@ -209,14 +194,14 @@
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")
- ],
+ IndentTest = docs([
+ str("indentation test:"),
+ indent("_1_", [nl, str("one"),
+ indent("_2_", [nl, str("two"),
+ indent("_3_", [nl, str("three"),
+ indent("_4_", [nl, str("four"),
+ indent("_5_", [nl, str("five")])])])])])
+ ]),
( Limit = linear(100)
; Limit = linear(10)
; Limit = triangular(100)
@@ -228,14 +213,14 @@
( 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
+ ( Doc = format(List)
+ ; Doc = format_list(ListUniv, str(", "))
+ ; Doc = format(MapFloat)
+ ; Doc = format(MapStr)
+ ; Doc = format(OpTree)
+ ; Doc = format(Tuple)
+ ; Doc = format(Square)
+ ; Doc = IndentTest
).
--------------------------------------------------------------------------
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