mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 09:23:44 +00:00
Code Issues Projects Releases Wiki Activity
Files
7dccb03be114fbbc0b6c514b7f7fc94696e42487
mercury/library/pretty_printer.m
Zoltan Somogyi e658a91b08 Move related functions together.
2025-09-23 17:05:06 +10:00

2033 lines
71 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ts=4 sw=4 expandtab ft=mercury
%---------------------------------------------------------------------------%
% Copyright (C) 2007, 2009-2011 The University of Melbourne
% Copyright (C) 2014-2016, 2018, 2020, 2022-2025 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: pretty_printer.m.
% Main author: rafe
% Stability: high.
%
% 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.
%
% 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 rules for operator precedence and
% bracketing.
%
% 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 a limit
% has been exceeded.
%
%---------------------------------------------------------------------------%
:- module pretty_printer.
:- interface.
:- import_module array.
:- import_module char.
:- import_module deconstruct.
:- import_module io.
:- import_module list.
:- import_module one_or_more.
:- import_module stream.
:- import_module string.
:- import_module string.builder.
:- import_module tree234.
:- import_module type_desc.
:- import_module univ.
:- import_module version_array.
%---------------------------------------------------------------------------%
:- type doc
---> str(string)
% Output a literal string. This string should not contain newlines,
% hard tabs, or other formatting characters other than spaces;
% if it does, the resulting output will almost certainly look
% strange.
; nl
% Output a newline, followed by indentation, if and only if
% - the enclosing group does not fit on the current line, and
% - starting a new line adds more space.
; hard_nl
% Always outputs a newline, followed by indentation.
; docs(list(doc))
% An embedded sequence of docs.
; format_univ(univ)
% Use a specialised formatter on the given value if
% is available for its type. Otherwise, use the generic formatter.
; format_list(list(univ), doc)
% Pretty print a list of items using the given doc as a separator
% between each pair of items.
; 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.
; format_susp((func) = doc)
% The argument is a suspended computation that, if evaluated,
% will produce a doc to print. The evaluation must materialize
% at least one part of this doc, but other parts may remain
% in the form of other suspensions. This will produce a final
% doc in a lazy fashion, if needed. The *point* of producing the
% doc lazily is that when the formatting limit is reached,
% then the prettyprinter will just output "...", and will do so
% *without* evaluating any remaining suspensions. This is useful
% for formatting large structures without using more resources
% than required. Note that expanding a suspended computation
% reduces the formatting limit by one.
; pp_internal(pp_internal).
% pp_internal docs are used in the implementation, and cannot be
% exploited by user code.
:- type docs == list(doc).
% This type is private to the implementation and cannot be exploited
% by user code.
%
:- type pp_internal.
%---------------------------------------------------------------------------%
%
% Functions for constructing docs.
%
% indent(IndentString, Docs):
%
% Append IndentString to the current indentation while printing Docs.
% Indentation is printed after each newline that is output.
%
:- func indent(string, list(doc)) = doc.
% indent(Docs) = indent(" ", Docs).
%
% A convenient abbreviation.
%
:- func indent(list(doc)) = doc.
% group(Docs):
%
% If Docs can be output on the remainder of the current line by ignoring
% any nls in Docs, then do so. Otherwise nls in Docs are printed
% (followed by any indentation). The formatting test is applied recursively
% for any subgroups in Docs.
%
:- func group(list(doc)) = doc.
% format(X) = format_univ(univ(X)):
%
% A convenient abbreviation.
%
:- func format(T) = doc.
% format_arg(Doc) has the effect of formatting any term in Doc as though
% it were an argument in a Mercury term, by enclosing it in parentheses
% if necessary.
%
:- func format_arg(doc) = doc.
%---------------------------------------------------------------------------%
%
% Functions for converting docs to strings and writing them out to streams.
%
% write_doc_formatted(X, !IO):
% write_doc_formatted(FileStream, X, !IO):
%
% Convert X to a doc using the format function, and then
% call write_doc on the result.
%
:- pred write_doc_formatted(T::in, io::di, io::uo) is det.
:- pred write_doc_formatted(io.text_output_stream::in, T::in,
io::di, io::uo) is det.
% write_doc(Doc, !IO):
% write_doc(FileStream, Doc, !IO):
%
% Format Doc to io.stdout_stream or FileStream respectively using put_doc,
% with include_details_cc, the default formatter_map, and the default
% pp_params.
%
:- pred write_doc(doc::in, io::di, io::uo) is det.
:- pred write_doc(io.text_output_stream::in, doc::in, io::di, io::uo) is det.
% put_doc(Stream, Canonicalize, FMap, Params, Doc, !State):
%
% Format Doc to Stream. Format format_univ(_) docs using specialised
% formatters Formatters, and using Params as the pretty printer parameters.
% The Canonicalize argument controls how put_doc deconstructs values
% of noncanonical types (see the documentation of the noncanon_handling
% type for details).
%
:- pred put_doc(Stream, noncanon_handling, formatter_map, pp_params, doc,
State, State) <= stream.writer(Stream, string, State).
:- mode put_doc(in, in(canonicalize), in, in, in, di, uo) is det.
:- mode put_doc(in, in(include_details_cc), in, in, in, di, uo) is cc_multi.
:- pragma type_spec_constrained_preds(
[stream.writer(Stream, string, State)],
apply_to_superclasses,
[subst([Stream => io.text_output_stream, State = io.state]),
subst([Stream => string.builder.handle, State = string.builder.state])]).
%---------------------------------------------------------------------------%
%
% Mechanisms for controlling *how* docs are converted to strings.
%
% The type of generic formatting functions.
% The first argument is the univ of the value to be formatted.
% The type of this value will have the form "TC(AT1, AT2, ..., ATn)",
% where TC is a type constructor, and ATi are its argument types.
% The second argument of the function will consist of the list of
% type descriptors describing AT1, AT2, ... ATn.
%
% These arguments are intended to be used as shown by this example
% function, which can be the entry for the type constructor tree234(K, V):
%
% fmt_tree234(Univ, ArgDescs) =
% ( if
% ArgDescs = [ArgDescA, ArgDescB],
% has_type(_ArgA : K, ArgDescA),
% has_type(_ArgB : V, ArgDescB),
% Value = univ_value(Univ),
% dynamic_cast(Value, Tree : tree234(K, V))
% then
% pretty_printer.tree234_to_doc(Tree)
% else
% str("internal error: expected a tree234, did not get it")
% ).
%
% Since the tree234 type constructor has arity two, the caller will pass
% two type descriptors to fmt_tree234, which will describe the actual types
% of the keys and values in *this* tree. The two calls to has_type
% (which is defined in the type_desc module of the Mercury standard
% library) tell the compiler that the type variables K and V in *this*
% function should stand for the ground types described by ArgDescA
% and ArgDescB respectively.
%
% After the call to univ_value picks the value out of Univ, the call to
% dynamic_cast (which is defined in the builtin module of the Mercury
% standard library) checks whether the type of Value is tree234(K, V),
% and if it is, (which it should be, since the predicates and functions
% of this module would not have called fmt_tree234 otherwise), will return
% Value as Tree. Note that the difference between Value and Tree is that
%
% - the compiler does not know the type of Value statically, since that
% information comes from Univ, which is available only at runtime, but
%
% - the compiler *does* know the type of Tree statically, due to the type
% annotation on it. This type, tree234(K, V), does contain type
% variables, but its principal type constructor is known, and that is
% enough for the code in the then-part of the if-then-else to do its job.
%
% Note that the code in the else-part should not matter. If that code
% is ever executed, that would mean that a predicate or function of
% this module has called fmt_tree234 with inappropriate data.
%
:- type formatter == (func(univ, list(type_desc)) = doc).
% A formatter_map maps type constructors to formatters.
%
% If the principal (outermost) type constructor of a value's type
% has an entry in the formatter_map given to one of the prettyprinting
% predicates or functions below, then that predicate or function will use
% the corresponding formatter to format that value.
%
:- type formatter_map.
% Formatter maps identify type constructors by
%
% - the name of the module that defines the type constructor,
% - the type constructor's name, and
% - the type constructor's arity.
%
% The three fields contain this info in this order.
%
:- type formatter_map_entry
---> formatter_map_entry(string, string, int).
% ModuleName.TypeName/TypeArity.
% Construct a new formatter_map.
%
:- func new_formatter_map = formatter_map.
% set_formatter(ModuleName, TypeName, TypeArity, Formatter, !FMap):
%
% Update !FMap to use Formatter to format values whose type is
% ModuleName.TypeName/TypeArity.
%
:- pred set_formatter(string::in, string::in, int::in, formatter::in,
formatter_map::in, formatter_map::out) is det.
:- func get_formatter_map_entry_types(formatter_map) =
list(formatter_map_entry).
%---------------------%
% The func_symbol_limit type controls *how many* of the function symbols
% stored in the term inside a format_univ, format_list, or format_term doc
% the write_doc family of functions should include in the resulting string.
%
% A limit of linear(N) formats the first N functors before truncating
% output to "...".
%
% A limit of triangular(N) formats a term t(X1, ..., Xn) by applying
% the following limits:
%
% - 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 func_symbol_limit
---> linear(int)
; triangular(int).
% The pp_params type contains the parameters of the prettyprinting process:
%
% - the width of each line,
% - the maximum number of lines to print, and
% - the controls for how many function symbols to print.
%
:- type pp_params
---> pp_params(
pp_line_width :: int,
pp_max_lines :: int,
pp_limit :: func_symbol_limit
).
%---------------------%
% A user-configurable default set of type-specific formatters and
% formatting parameters is always attached to the I/O state.
% The write_doc predicate (in both its arities) uses these settings.
%
% The get_default_formatter_map predicate reads the default formatter_map
% from the current I/O state, while set_default_formatter_map writes
% the specified formatter_map to the I/O state to become the new default.
%
% The initial value of the default formatter_map provides the means
% to prettyprint the most commonly used types in the Mercury standard
% library, such as arrays, chars, floats, ints, maps, strings, etc.
%
% The default formatter_map may also be updated by users' modules
% (e.g. in initialisation goals).
%
:- 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.
% set_default_formatter(ModuleName, TypeName, TypeArity, Formatter, !IO):
%
% Update the default formatter in the I/O state to use Formatter
% to print values of the type ModuleName.TypeName/TypeArity.
%
:- pred set_default_formatter(string::in, string::in, int::in, formatter::in,
io::di, io::uo) is det.
% Alongside the default formatter_map, the I/O state also always stores
% a default set of pretty-printing parameters (pp_params) for use by
% the write_doc predicate (in both its arities).
%
% The get_default_params predicate reads the default parameters
% from the current I/O state, while set_default_params writes the specified
% parameters to the I/O state to become the new default.
%
% The initial default parameters are pp_params(78, 100, triangular(100)).
%
:- 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.
%---------------------------------------------------------------------------%
% Convert a char to a doc.
%
:- func char_to_doc(char) = doc.
% Convert a string to a doc.
%
:- func string_to_doc(string) = doc.
% Convert a float to a doc.
%
:- func float_to_doc(float) = doc.
% Convert an int to a doc.
%
:- func int_to_doc(int) = doc.
:- func int8_to_doc(int8) = doc.
:- func int16_to_doc(int16) = doc.
:- func int32_to_doc(int32) = doc.
:- func int64_to_doc(int64) = doc.
% Convert a uint to a doc.
%
:- func uint_to_doc(uint) = doc.
:- func uint8_to_doc(uint8) = doc.
:- func uint16_to_doc(uint16) = doc.
:- func uint32_to_doc(uint32) = doc.
:- func uint64_to_doc(uint64) = doc.
% Convert a list to a doc.
%
:- func list_to_doc(list(T)) = doc.
% Convert a nonempty list to a doc.
%
:- func one_or_more_to_doc(one_or_more(T)) = doc.
% Convert a 2-3-4 tree to a doc.
%
:- func tree234_to_doc(tree234(K, V)) = doc.
% Convert an array to a doc.
%
:- func array_to_doc(array(T)) = doc.
% Convert a version array to a doc.
%
:- func version_array_to_doc(version_array(T)) = doc.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module bool.
:- import_module fat_sparse_bitset.
:- import_module fatter_sparse_bitset.
:- import_module int.
:- import_module map.
:- import_module ops.
:- import_module require.
:- import_module sparse_bitset.
:- import_module term_io.
:- import_module tree_bitset.
:- import_module uint.
%---------------------------------------------------------------------------%
% Consider {add,remove}_indent as (), and {inc,dec}_std_indent as [].
% The indent-related operations must occur as balanced pairs, meaning
% that matching sequences such as (([])), ([][]) and [([])] are allowed,
% but non-matching sequences such as ([)] are not.
%
% Since the definition of the pp_internal type is private to this module,
% code outside this module cannot violate this requirement; only code
% inside this module can. If it does, that is a bug.
:- type pp_internal
---> open_group
% Mark the start of a group.
; close_group
% Mark the end of a group.
; add_indent(string)
% Extend the current indent stack with the given string.
; remove_indent
% Restore indentation to before the last add_indent/1.
% Calling the two operations above {inc,dec}_user_indent
% would be more consistent with the two operations below,
% but the hard_coded/test_pretty_printer test case references
% these names, even though they are supposed to be private.
; inc_std_indent
% Add a standard indentation level.
; dec_std_indent
% Remove a standard indentation level.
; set_op_priority(ops.priority)
% Set the current priority for printing operator terms with the
% correct parenthesisation.
; set_limit(func_symbol_limit).
% Set the truncation limit.
% Maps module names (first map), type names (second map) and type arities
% (third map) to the formatter to be used when printing values of the type
% ModuleName.TypeName/TypeArity.
%
:- type formatter_map == map(string, map(string, map(int, formatter))).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
indent(Indent, Docs) =
docs([
pp_internal(add_indent(Indent)),
docs(Docs),
pp_internal(remove_indent)
]).
indent(Docs) =
docs([
pp_internal(inc_std_indent),
docs(Docs),
pp_internal(dec_std_indent)
]).
group(Docs) =
docs([pp_internal(open_group), docs(Docs), pp_internal(close_group)]).
%---------------------------------------------------------------------------%
format(X) = format_univ(univ(X)).
format_arg(Doc) =
docs([
pp_internal(set_arg_priority),
Doc
]).
:- func set_arg_priority = pp_internal.
:- pragma inline(func(set_arg_priority/0)).
set_arg_priority = set_op_priority(ops.mercury_op_table_arg_priority).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- pragma foreign_export("C", write_doc_formatted(in, di, uo),
"ML_write_doc_formatted").
:- pragma foreign_export("C", write_doc_formatted(in, in, di, uo),
"ML_write_doc_formatted_to_stream").
write_doc_formatted(X, !IO) :-
Doc = format(X),
write_doc(io.stdout_stream, Doc, !IO).
write_doc_formatted(Stream, X, !IO) :-
Doc = format(X),
write_doc(Stream, Doc, !IO).
write_doc(Doc, !IO) :-
write_doc(io.stdout_stream, Doc, !IO).
write_doc(Stream, Doc, !IO) :-
get_default_formatter_map(Formatters, !IO),
get_default_params(Params, !IO),
promise_equivalent_solutions [!:IO] (
put_doc(Stream, include_details_cc, Formatters, Params, Doc, !IO)
).
%---------------------------------------------------------------------------%
put_doc(Stream, Canonicalize, FMap, Params, Doc, !IO) :-
Pri = ops.mercury_op_table_loosest_op_priority,
Params = pp_params(LineWidth, MaxLines, Limit),
RemainingWidth = LineWidth,
Indents = indent_empty,
do_put_docs(Stream, Canonicalize, FMap, LineWidth, [Doc],
RemainingWidth, _, Indents, _, MaxLines, _, Limit, _, Pri, _, !IO).
%---------------------------------------------------------------------------%
% do_put_docs(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,
% - 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 do_put_docs(Stream, noncanon_handling, formatter_map, int,
list(doc), int, int, indent_stack, indent_stack, int, int,
func_symbol_limit, func_symbol_limit,
ops.priority, ops.priority, State, State)
<= stream.writer(Stream, string, State).
:- mode do_put_docs(in, in(canonicalize), in, in, in,
in, out, in, out, in, out, in, out, in, out, di, uo) is det.
:- mode do_put_docs(in, in(include_details_cc), in, in, in,
in, out, in, out, in, out, in, out, in, out, di, uo) is cc_multi.
do_put_docs(_Stream, _Canonicalize, _FMap, _LineWidth, [],
!RemainingWidth, !Indents, !RemainingLines, !Limit, !Pri, !IO).
do_put_docs(Stream, Canonicalize, FMap, LineWidth, [HeadDoc0 | TailDocs0],
!RemainingWidth, !Indents, !RemainingLines, !Limit, !Pri, !IO) :-
( if !.RemainingLines =< 0 then
stream.put(Stream, "...", !IO)
else
(
% Output strings directly.
HeadDoc0 = str(String),
stream.put(Stream, String, !IO),
StrWidth = string.count_code_points(String),
!:RemainingWidth = !.RemainingWidth - StrWidth,
Docs = TailDocs0
;
HeadDoc0 = nl,
IndentWidth = count_indent_code_points(!.Indents),
( if !.RemainingWidth < LineWidth - IndentWidth then
format_nl(Stream, LineWidth, !.Indents, !:RemainingWidth,
!RemainingLines, !IO)
else
true
),
Docs = TailDocs0
;
HeadDoc0 = hard_nl,
format_nl(Stream, LineWidth, !.Indents, !:RemainingWidth,
!RemainingLines, !IO),
Docs = TailDocs0
;
HeadDoc0 = docs(HeadDocs0),
Docs = list.(HeadDocs0 ++ TailDocs0)
;
(
HeadDoc0 = format_univ(Univ),
expand_format_univ(Canonicalize, FMap, Univ, TailDocs0, Docs,
!Limit, !.Pri)
;
HeadDoc0 = format_list(Univs, Sep),
expand_format_list(!.Limit, Univs, Sep, TailDocs0, Docs)
;
HeadDoc0 = format_term(Name, Univs),
expand_format_term(Name, Univs, TailDocs0, Docs, !Limit, !.Pri)
;
HeadDoc0 = format_susp(Susp),
expand_format_susp(Susp, TailDocs0, Docs, !Limit)
)
;
HeadDoc0 = pp_internal(Internal),
(
% 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.
Internal = open_group,
OpenGroups1 = 1,
CurrentRemainingWidth = !.RemainingWidth,
expand_docs_to_line_end(Canonicalize, FMap, TailDocs0, Docs1,
OpenGroups1, !Limit, !Pri,
CurrentRemainingWidth, RemainingWidthAfterGroup),
( if RemainingWidthAfterGroup >= 0 then
output_current_group(Stream, LineWidth, !.Indents,
Docs1, Docs, OpenGroups1,
!RemainingWidth, !RemainingLines, !IO)
else
Docs = Docs1
)
;
(
Internal = close_group
;
Internal = add_indent(IndentStr),
increment_user_indent(IndentStr, !Indents)
;
Internal = remove_indent,
decrement_user_indent(!Indents)
;
Internal = inc_std_indent,
increment_std_indent(!Indents)
;
Internal = dec_std_indent,
decrement_std_indent(!Indents)
;
Internal = set_limit(Limit),
!:Limit = Limit
;
Internal = set_op_priority(Pri),
!:Pri = Pri
),
Docs = TailDocs0
)
),
do_put_docs(Stream, Canonicalize, FMap, LineWidth, Docs,
!RemainingWidth, !Indents, !RemainingLines, !Limit, !Pri, !IO)
).
%---------------------%
:- type open_groups == int.
:- pred output_current_group(Stream::in, int::in, indent_stack::in,
list(doc)::in, list(doc)::out, open_groups::in, int::in, int::out,
int::in, int::out, State::di, State::uo) is det
<= stream.writer(Stream, string, State).
output_current_group(_Stream, _LineWidth, _Indents, [], [],
_OpenGroups, !RemainingWidth, !RemainingLines, !IO).
output_current_group(Stream, LineWidth, Indents, [HeadDoc0 | TailDocs0], Docs,
!.OpenGroups, !RemainingWidth, !RemainingLines, !IO) :-
(
HeadDoc0 = str(String),
stream.put(Stream, String, !IO),
StrWidth = string.count_code_points(String),
!:RemainingWidth = !.RemainingWidth - StrWidth,
output_current_group(Stream, LineWidth, Indents, TailDocs0, Docs,
!.OpenGroups, !RemainingWidth, !RemainingLines, !IO)
;
HeadDoc0 = hard_nl,
format_nl(Stream, LineWidth, Indents, !:RemainingWidth,
!RemainingLines, !IO),
( if !.RemainingLines =< 0 then
Docs = TailDocs0
else
output_current_group(Stream, LineWidth, Indents, TailDocs0, Docs,
!.OpenGroups, !RemainingWidth, !RemainingLines, !IO)
)
;
HeadDoc0 = pp_internal(Internal),
(
Internal = open_group,
!:OpenGroups = !.OpenGroups + 1,
output_current_group(Stream, LineWidth, Indents, TailDocs0, Docs,
!.OpenGroups, !RemainingWidth, !RemainingLines, !IO)
;
Internal = close_group,
( if !.OpenGroups = 1 then
Docs = TailDocs0
else
!:OpenGroups = !.OpenGroups - 1,
output_current_group(Stream, LineWidth, Indents,
TailDocs0, Docs, !.OpenGroups,
!RemainingWidth, !RemainingLines, !IO)
)
;
( Internal = add_indent(_)
; Internal = remove_indent
; Internal = inc_std_indent
; Internal = dec_std_indent
; Internal = set_op_priority(_)
; Internal = set_limit(_)
),
output_current_group(Stream, LineWidth, Indents, TailDocs0, Docs,
!.OpenGroups, !RemainingWidth, !RemainingLines, !IO)
)
;
( HeadDoc0 = nl
; HeadDoc0 = docs(_)
; HeadDoc0 = format_univ(_)
; HeadDoc0 = format_list(_, _)
; HeadDoc0 = format_term(_, _)
; HeadDoc0 = format_susp(_)
),
output_current_group(Stream, LineWidth, Indents, TailDocs0, Docs,
!.OpenGroups, !RemainingWidth, !RemainingLines, !IO)
).
%---------------------%
% expand_docs_to_line_end(Canonicalize, Docs0, Docs,
% !.OpenGroups, !Limit, !Pri, !RemainingWidth)
%
% expands out any doc(_), 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.
%
% !.OpenGroups is used to track nested groups.
% !Limit tracks the limits after accounting for expansion.
% !Pri tracks the operator priority after accounting for expansion.
% !RemainingWidth tracks the remaining line width after accounting for
% expansion.
%
:- pred expand_docs_to_line_end(noncanon_handling, formatter_map,
list(doc), list(doc), open_groups, func_symbol_limit, func_symbol_limit,
ops.priority, ops.priority, int, int).
:- mode expand_docs_to_line_end(in(canonicalize), in,
in, out, in, in, out, in, out, in, out) is det.
:- mode expand_docs_to_line_end(in(include_details_cc), in,
in, out, in, in, out, in, out, in, out) is cc_multi.
expand_docs_to_line_end(_, _, [], [], _OpenGroups,
!Limit, !Pri, !RemainingWidth).
expand_docs_to_line_end(Canonicalize, FMap,
Docs0 @ [HeadDoc0 | TailDocs0], Docs,
!.OpenGroups, !Limit, !Pri, !RemainingWidth) :-
( if
(
!.OpenGroups =< 0, ( HeadDoc0 = nl ; HeadDoc0 = hard_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 = Docs0
else
(
HeadDoc0 = str(String),
StrWidth = string.count_code_points(String),
!:RemainingWidth = !.RemainingWidth - StrWidth,
expand_docs_to_line_end(Canonicalize, FMap, TailDocs0, TailDocs,
!.OpenGroups, !Limit, !Pri, !RemainingWidth),
Docs = [HeadDoc0 | TailDocs]
;
( HeadDoc0 = nl
; HeadDoc0 = hard_nl
),
( if !.OpenGroups =< 0 then
Docs = Docs0
else
expand_docs_to_line_end(Canonicalize, FMap,
TailDocs0, TailDocs,
!.OpenGroups, !Limit, !Pri, !RemainingWidth),
Docs = [HeadDoc0 | TailDocs]
)
;
HeadDoc0 = docs(HeadDocs0),
Docs1 = list.(HeadDocs0 ++ TailDocs0),
expand_docs_to_line_end(Canonicalize, FMap, Docs1, Docs,
!.OpenGroups, !Limit, !Pri, !RemainingWidth)
;
(
HeadDoc0 = format_univ(HeadUniv),
expand_format_univ(Canonicalize, FMap, HeadUniv,
TailDocs0, Docs1, !Limit, !.Pri)
;
HeadDoc0 = format_list(HeadUnivs, Sep),
expand_format_list(!.Limit, HeadUnivs, Sep, TailDocs0, Docs1)
;
HeadDoc0 = format_term(Name, HeadUnivs),
expand_format_term(Name, HeadUnivs, TailDocs0, Docs1, !Limit,
!.Pri)
;
HeadDoc0 = format_susp(HeadSusp),
expand_format_susp(HeadSusp, TailDocs0, Docs1, !Limit)
),
expand_docs_to_line_end(Canonicalize, FMap, Docs1, Docs,
!.OpenGroups, !Limit, !Pri, !RemainingWidth)
;
HeadDoc0 = pp_internal(Internal),
(
(
Internal = add_indent(_)
;
Internal = remove_indent
;
Internal = inc_std_indent
;
Internal = dec_std_indent
;
Internal = open_group,
% XXX This is probably a bug, because if !.OpenGroups = 0,
% then it will *stay* at 0 even *after* this opening
% of a group.
!:OpenGroups = !.OpenGroups +
( if !.OpenGroups > 0 then 1 else 0 )
;
Internal = close_group,
!:OpenGroups = !.OpenGroups -
( if !.OpenGroups > 0 then 1 else 0 )
),
expand_docs_to_line_end(Canonicalize, FMap,
TailDocs0, TailDocs,
!.OpenGroups, !Limit, !Pri, !RemainingWidth),
Docs = [HeadDoc0 | TailDocs]
;
(
Internal = set_limit(Limit),
!:Limit = Limit
;
Internal = set_op_priority(Pri),
!:Pri = Pri
),
expand_docs_to_line_end(Canonicalize, FMap, TailDocs0, Docs,
!.OpenGroups, !Limit, !Pri, !RemainingWidth)
)
)
).
%---------------------%
% Output a newline followed by indentation.
%
:- pred format_nl(Stream::in, int::in, indent_stack::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),
RemainingWidth = LineWidth - count_indent_code_points(Indents),
output_indent_stack(Stream, Indents, !IO),
!:RemainingLines = !.RemainingLines - 1.
:- pred output_indent_stack(Stream::in, indent_stack::in,
State::di, State::uo) is det <= stream.writer(Stream, string, State).
output_indent_stack(Stream, IndentStack, !IO) :-
(
IndentStack = indent_empty
;
IndentStack = indent_user(PrevStack, IndentStr, _NumCPs),
output_indent_stack(Stream, PrevStack, !IO),
stream.put(Stream, IndentStr, !IO)
;
IndentStack = indent_std(PrevStack, IndentLevels, _NumCPs),
output_indent_stack(Stream, PrevStack, !IO),
output_std_indent_levels(Stream, IndentLevels, !IO)
).
:- pred output_std_indent_levels(Stream::in, int::in,
State::di, State::uo) is det <= stream.writer(Stream, string, State).
output_std_indent_levels(Stream, NumLevels, !IO) :-
% We try to amortize the overhead of stream.put over as large a part
% of the overall indentation as we can.
( if NumLevels >= 30 then
std_indent_30(IndentStr),
stream.put(Stream, IndentStr, !IO),
output_std_indent_levels(Stream, NumLevels - 30, !IO)
else if NumLevels > 0 then
( if std_indent(NumLevels, IndentStr) then
stream.put(Stream, IndentStr, !IO)
else
unexpected($pred, "std_indent failed")
)
else
true
).
:- pred std_indent(int::in, string::out) is semidet.
:- pred std_indent_30(string::out) is det.
std_indent(1, " ").
std_indent(2, " ").
std_indent(3, " ").
std_indent(4, " ").
std_indent(5, " ").
std_indent(6, " ").
std_indent(7, " ").
std_indent(8, " ").
std_indent(9, " ").
std_indent(10, " ").
std_indent(11, " ").
std_indent(12, " ").
std_indent(13, " ").
std_indent(14, " ").
std_indent(15, " ").
std_indent(16, " ").
std_indent(17, " ").
std_indent(18, " ").
std_indent(19, " ").
std_indent(20, " ").
std_indent(21, " ").
std_indent(22, " ").
std_indent(23, " ").
std_indent(24, " ").
std_indent(25, " ").
std_indent(26, " ").
std_indent(27, " ").
std_indent(28, " ").
std_indent(29, " ").
std_indent_30( " ").
%---------------------%
% 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 generate only "...".
%
:- pred expand_format_univ(noncanon_handling, formatter_map, univ,
list(doc), list(doc), func_symbol_limit, func_symbol_limit, ops.priority).
:- mode expand_format_univ(in(canonicalize), in, in,
in, out, in, out, in) is det.
:- mode expand_format_univ(in(include_details_cc), in, in,
in, out, in, out, in) is cc_multi.
expand_format_univ(Canonicalize, FMap, Univ, TailDocs, Docs,
!Limit, CurrentPri) :-
( if func_limit_reached(!.Limit) then
Docs = [ellipsis | TailDocs]
else
Value = univ_value(Univ),
( if
type_ctor_and_args(type_of(Value), TypeCtorDesc, ArgTypeDescs),
ModuleName = type_ctor_module_name(TypeCtorDesc),
map.search(FMap, ModuleName, FMapTypeArity),
TypeName = type_ctor_name(TypeCtorDesc),
map.search(FMapTypeArity, TypeName, FMapArity),
list.length(ArgTypeDescs, Arity),
map.search(FMapArity, Arity, Formatter)
then
decrement_func_limit(!Limit),
Doc0 = Formatter(Univ, ArgTypeDescs),
set_func_limit_in_doc(!.Limit, Doc0, TailDocs, Docs)
else
deconstruct(Value, Canonicalize, Name, _Arity, Args),
expand_format_term(Name, Args, TailDocs, Docs, !Limit, CurrentPri)
)
).
%---------------------%
% Expand a list of univs into docs using the given separator.
%
:- pred expand_format_list(func_symbol_limit::in, list(univ)::in,
doc::in, list(doc)::in, list(doc)::out) is det.
expand_format_list(_Limit, [], _Sep, TailDocs, Docs) :-
Docs = TailDocs.
expand_format_list(Limit, [HeadUniv | TailUnivs], Sep, TailDocs, Docs) :-
( if func_limit_reached(Limit) then
Docs = [ellipsis | TailDocs]
else
(
TailUnivs = [],
Docs = [
pp_internal(set_arg_priority),
pp_internal(open_group),
nl,
format_univ(HeadUniv),
pp_internal(close_group)
| TailDocs
]
;
TailUnivs = [_ | _],
Docs = [
pp_internal(set_arg_priority),
pp_internal(open_group),
nl,
format_univ(HeadUniv),
Sep,
pp_internal(close_group),
format_list(TailUnivs, Sep)
| TailDocs
]
)
).
% Expand a name and list of univs into docs corresponding to Mercury
% term syntax.
%
:- pred expand_format_term(string::in, list(univ)::in,
list(doc)::in, list(doc)::out,
func_symbol_limit::in, func_symbol_limit::out, ops.priority::in) is det.
expand_format_term(Name, Args, TailDocs, Docs, !Limit, CurrentPri) :-
( if Args = [] then
HeadDoc0 = str(term_io.quoted_atom(Name)),
decrement_func_limit(!Limit),
set_func_limit_in_doc(!.Limit, HeadDoc0, TailDocs, Docs)
else if func_limit_reached(!.Limit) then
HeadDoc0 = ellipsis,
% There *should* be no point im decrementing !Limit even further.
decrement_func_limit(!Limit),
set_func_limit_in_doc(!.Limit, HeadDoc0, TailDocs, Docs)
else if expand_format_op(Name, Args, CurrentPri, OpDocs) then
decrement_func_limit(!Limit),
set_func_limit_in_docs(!.Limit, OpDocs, TailDocs, Docs)
else
( if Name = "{}" then
HeadDocs0 = [
str("{"),
pp_internal(inc_std_indent),
format_list(Args, str(", ")),
pp_internal(dec_std_indent),
str("}")
]
else
HeadDocs0 = [
pp_internal(open_group),
nl,
str(term_io.quoted_atom(Name)),
str("("),
pp_internal(inc_std_indent),
format_list(Args, str(", ")),
pp_internal(dec_std_indent),
str(")"),
pp_internal(close_group)
]
),
decrement_func_limit(!Limit),
set_func_limit_in_docs(!.Limit, HeadDocs0, TailDocs, Docs)
).
% Expand a function symbol name and list of univs representing its
% arguments into docs corresponding to Mercury operator syntax.
%
:- pred expand_format_op(string::in, list(univ)::in, ops.priority::in,
list(doc)::out) is semidet.
expand_format_op(Op, Args, EnclosingPriority, Docs) :-
% XXX With one exception, all the set_op_priority pp_internals are
% created here. They are intended to set the priority of one argument,
% which in this case is equivalent to setting the priority from
% the occurrence of the set_op_priority until either the next
% set_op_priority, or until the next close_group. The fact that
% the predicates above do NOT reset the priority when they get to
% a close_group seems to me to be a bug -zs.
%
% The one exception is the format_arg function, which appears
% to have the same bug, but in an even worse form, since it does not
% wrap an open_group/close_group pair around the argument.
(
Args = [ArgA],
ops.mercury_op_table_search_op_infos(Op, OpInfos),
( if OpInfos ^ oi_prefix = pre(Pri, GtOrGeA) then
OpPriority = Pri,
PriorityArgA = min_priority_for_arg(OpPriority, GtOrGeA),
Docs0 = [
pp_internal(open_group),
str(Op),
pp_internal(set_op_priority(PriorityArgA)),
format_univ(ArgA),
pp_internal(close_group)
]
else if OpInfos ^ oi_postfix = post(Pri, GtOrGeA) then
OpPriority = Pri,
PriorityArgA = min_priority_for_arg(OpPriority, GtOrGeA),
Docs0 = [
pp_internal(open_group),
pp_internal(set_op_priority(PriorityArgA)),
format_univ(ArgA),
str(Op),
pp_internal(close_group)
]
else
fail
)
;
Args = [ArgA, ArgB],
ops.mercury_op_table_search_op_infos(Op, OpInfos),
( if
OpInfos ^ oi_infix = in(Pri, GtOrGeA, GtOrGeB)
then
OpPriority = Pri,
PriorityArgA = min_priority_for_arg(OpPriority, GtOrGeA),
PriorityArgB = min_priority_for_arg(OpPriority, GtOrGeB),
Docs0 = [
pp_internal(open_group),
pp_internal(set_op_priority(PriorityArgA)),
format_univ(ArgA),
( if Op = "." then
str(Op)
else
docs([str(" "), str(Op), str(" ")])
),
pp_internal(inc_std_indent),
nl,
pp_internal(set_op_priority(PriorityArgB)),
format_univ(ArgB),
pp_internal(dec_std_indent),
pp_internal(close_group)
]
else if
OpInfos ^ oi_binary_prefix = bin_pre(Pri, GtOrGeA, GtOrGeB)
then
OpPriority = Pri,
PriorityArgA = min_priority_for_arg(OpPriority, GtOrGeA),
PriorityArgB = min_priority_for_arg(OpPriority, GtOrGeB),
Docs0 = [
pp_internal(open_group),
str(Op),
str(" "),
pp_internal(set_op_priority(PriorityArgA)),
format_univ(ArgA),
str(" "),
pp_internal(inc_std_indent),
pp_internal(set_op_priority(PriorityArgB)),
format_univ(ArgB),
pp_internal(dec_std_indent),
pp_internal(close_group)
]
else
fail
)
),
% Add parentheses around a doc if required by operator priority.
( if priority_lt(OpPriority, EnclosingPriority) then
Docs = [str("(") | Docs0] ++ [str(")")]
else
Docs = Docs0
).
%---------------------%
:- pred expand_format_susp(((func) = doc)::in, list(doc)::in, list(doc)::out,
func_symbol_limit::in, func_symbol_limit::out) is det.
expand_format_susp(Susp, TailDocs, Docs, !Limit) :-
( if func_limit_reached(!.Limit) then
Docs = [ellipsis | TailDocs]
else
decrement_func_limit(!Limit),
HeadDoc0 = apply(Susp),
set_func_limit_in_doc(!.Limit, HeadDoc0, TailDocs, Docs)
).
%---------------------%
:- func ellipsis = doc.
ellipsis = str("...").
%---------------------%
% Update the limits properly after processing a term.
%
:- pred set_func_limit_in_doc(func_symbol_limit::in,
doc::in, list(doc)::in, list(doc)::out) is det.
set_func_limit_in_doc(linear(_), HeadDoc, TailDocs, [HeadDoc | TailDocs]).
set_func_limit_in_doc(Limit @ triangular(_), HeadDoc0, TailDocs, Docs) :-
Docs = [HeadDoc0, pp_internal(set_limit(Limit)) | TailDocs].
% Update the limits properly after processing a term.
%
:- pred set_func_limit_in_docs(func_symbol_limit::in,
list(doc)::in, list(doc)::in, list(doc)::out) is det.
set_func_limit_in_docs(linear(_), HeadDocs, TailDocs, HeadDocs ++ TailDocs).
set_func_limit_in_docs(Limit @ triangular(_), HeadDocs0, TailDocs, Docs) :-
Docs = HeadDocs0 ++ [pp_internal(set_limit(Limit)) | TailDocs].
% Succeeds if the pretty-printer state limits have been used up.
%
:- pred func_limit_reached(func_symbol_limit::in) is semidet.
func_limit_reached(linear(N)) :-
N =< 0.
func_limit_reached(triangular(N)) :-
N =< 0.
% Reduce the pretty-printer limit by one.
%
:- pred decrement_func_limit(func_symbol_limit::in, func_symbol_limit::out)
is det.
decrement_func_limit(linear(N), linear(N - 1)).
decrement_func_limit(triangular(N), triangular(N - 1)).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- type indent_stack
---> indent_empty
% No indent at all. Number of code points is zero.
; indent_user(
% The indentation after which this indentation is added.
user_prevstack :: indent_stack,
% Indentation added by a non-standard indent() function.
user_indent_string :: string,
% The total number of code points in user_prevstack and
% user_indent_string. Must be the sum of
% count_indent_code_points(user_prevstack) and
% string.count_code_points(user_indent_string).
user_total_code_points :: int
)
; indent_std(
% The indentation after which this indentation is added.
std_prevstack :: indent_stack,
% The number of extra standard indent levels added
% after std_prevstack. Each indent level consists of two
% spaces.
std_extra_indent_levels :: int,
% The total number of code points in user_prevstack and
% user_extra_indent. Must be the sum of
% count_indent_code_points(std_prevstack) and
% 2 * std_extra_indent_levels.
std_total_code_points :: int
).
:- func count_indent_code_points(indent_stack) = int.
count_indent_code_points(indent_empty) = 0.
count_indent_code_points(indent_user(_PrevStack, _Str, NumCPs)) = NumCPs.
count_indent_code_points(indent_std(_PrevStack, _NL, NumCPs)) = NumCPs.
:- pred increment_user_indent(string::in, indent_stack::in, indent_stack::out)
is det.
increment_user_indent(IndentStr, IndentStack0, IndentStack) :-
NumCPs0 = count_indent_code_points(IndentStack0),
NumCPs = NumCPs0 + string.count_code_points(IndentStr),
IndentStack = indent_user(IndentStack0, IndentStr, NumCPs).
:- pred decrement_user_indent(indent_stack::in, indent_stack::out) is det.
decrement_user_indent(IndentStack0, IndentStack) :-
(
IndentStack0 = indent_user(IndentStack, _, _)
;
( IndentStack0 = indent_empty
; IndentStack0 = indent_std(_, _, _)
),
unexpected($pred, "last indent is not user indent")
).
:- pred increment_std_indent(indent_stack::in, indent_stack::out) is det.
increment_std_indent(IndentStack0, IndentStack) :-
(
IndentStack0 = indent_user(_, _, NumCPs0),
NumCPs = NumCPs0 + 2,
IndentStack = indent_std(IndentStack0, 1, NumCPs)
;
IndentStack0 = indent_empty,
NumCPs = 2,
IndentStack = indent_std(IndentStack0, 1, NumCPs)
;
IndentStack0 = indent_std(PrevStack, NumLevels0, NumCPs0),
NumLevels = NumLevels0 + 1,
NumCPs = NumCPs0 + 2,
IndentStack = indent_std(PrevStack, NumLevels, NumCPs)
).
:- pred decrement_std_indent(indent_stack::in, indent_stack::out) is det.
decrement_std_indent(IndentStack0, IndentStack) :-
(
IndentStack0 = indent_std(PrevStack, NumLevels0, NumCPs0),
NumLevels = NumLevels0 - 1,
( if NumLevels > 0 then
NumCPs = NumCPs0 - 2,
IndentStack = indent_std(PrevStack, NumLevels, NumCPs)
else
IndentStack = PrevStack
)
;
( IndentStack0 = indent_empty
; IndentStack0 = indent_user(_, _, _)
),
unexpected($pred, "last indent is not std indent")
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
new_formatter_map = map.init.
set_formatter(ModuleName, TypeName, Arity, Formatter, !FMap) :-
( if map.search(!.FMap, ModuleName, FMapTypeArity0) then
( if map.search(FMapTypeArity0, TypeName, FMapArity0) then
map.det_update(Arity, Formatter, FMapArity0, FMapArity),
map.det_update(TypeName, FMapArity, FMapTypeArity0, FMapTypeArity)
else
FMapArity = map.singleton(Arity, Formatter),
map.det_insert(TypeName, FMapArity, FMapTypeArity0, FMapTypeArity)
),
map.det_update(ModuleName, FMapTypeArity, !FMap)
else
FMapArity = map.singleton(Arity, Formatter),
FMapTypeArity = map.singleton(TypeName, FMapArity),
map.det_insert(ModuleName, FMapTypeArity, !FMap)
).
%---------------------%
get_formatter_map_entry_types(FMap) = Entries :-
% To allocate as few cons cells as possible, build Entries from the back.
map.foldr(get_fmap_entries_module, FMap, [], Entries).
:- pred get_fmap_entries_module(string::in,
map(string, map(int, formatter))::in,
list(formatter_map_entry)::in, list(formatter_map_entry)::out) is det.
get_fmap_entries_module(ModuleName, TypeNameArityMap, !Entries) :-
map.foldr(get_fmap_entries_type(ModuleName), TypeNameArityMap, !Entries).
:- pred get_fmap_entries_type(string::in, string::in, map(int, formatter)::in,
list(formatter_map_entry)::in, list(formatter_map_entry)::out) is det.
get_fmap_entries_type(ModuleName, TypeName, ArityMap, !Entries) :-
map.foldr(get_fmap_entries_arity(ModuleName, TypeName),
ArityMap, !Entries).
:- pred get_fmap_entries_arity(string::in, string::in, int::in, formatter::in,
list(formatter_map_entry)::in, list(formatter_map_entry)::out) is det.
get_fmap_entries_arity(ModuleName, TypeName, Arity, _Formatter, !Entries) :-
Entry = formatter_map_entry(ModuleName, TypeName, Arity),
!:Entries = [Entry | !.Entries].
%---------------------%
get_default_formatter_map(FMap, !IO) :-
pretty_printer_is_initialised(Okay, !IO),
(
Okay = no,
FMap = initial_formatter_map,
set_default_formatter_map(FMap, !IO)
;
Okay = yes,
unsafe_get_default_formatter_map(FMap, !IO)
).
% set_default_formatter_map is implemented using only foreign_procs,
% with no Mercury code.
set_default_formatter(ModuleName, TypeName, TypeArity, Formatter, !IO) :-
get_default_formatter_map(FMap0, !IO),
set_formatter(ModuleName, TypeName, TypeArity, Formatter, FMap0, FMap),
set_default_formatter_map(FMap, !IO).
%---------------------%
% Because there is no guaranteed order of module initialisation, we need
% to ensure that we do the right thing if other modules try to update the
% default formatter_map before this module has been initialised.
%
% All of this machinery is needed to avoid a race condition between
% initialise directives and initialisation of mutables.
%
:- pragma foreign_decl("C",
"
extern MR_Bool ML_pretty_printer_is_initialised;
extern MR_Word ML_pretty_printer_default_formatter_map;
").
:- pragma foreign_code("C",
"
MR_Bool ML_pretty_printer_is_initialised = MR_NO;
MR_Word ML_pretty_printer_default_formatter_map = 0;
").
:- pragma foreign_code("C#",
"
static mr_bool.Bool_0 isInitialised = mr_bool.NO;
static tree234.Tree234_2 defaultFormatterMap = null;
").
:- pragma foreign_code("Java",
"
static bool.Bool_0 isInitialised = bool.NO;
static tree234.Tree234_2<String,
tree234.Tree234_2<String,
tree234.Tree234_2<Integer, /* closure */ java.lang.Object[]>>>
defaultFormatterMap = null;
").
%---------------------%
:- pred pretty_printer_is_initialised(bool::out, io::di, io::uo) is det.
:- pragma foreign_proc("C",
pretty_printer_is_initialised(Okay::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, thread_safe],
"
Okay = ML_pretty_printer_is_initialised;
").
:- pragma foreign_proc("C#",
pretty_printer_is_initialised(Okay::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, thread_safe, may_not_duplicate],
"
Okay = pretty_printer.isInitialised;
").
:- pragma foreign_proc("Java",
pretty_printer_is_initialised(Okay::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, thread_safe, may_not_duplicate],
"
Okay = pretty_printer.isInitialised;
").
%---------------------%
% This predicate must not be called unless pretty_printer_is_initialised ==
% MR_TRUE, which occurs when set_default_formatter_map has been called at
% least once.
%
:- pred unsafe_get_default_formatter_map(formatter_map::out, io::di, io::uo)
is det.
:- pragma foreign_proc("C",
unsafe_get_default_formatter_map(FMap::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, thread_safe],
"
FMap = ML_pretty_printer_default_formatter_map;
").
:- pragma foreign_proc("C#",
unsafe_get_default_formatter_map(FMap::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, thread_safe, may_not_duplicate],
"
FMap = pretty_printer.defaultFormatterMap;
").
:- pragma foreign_proc("Java",
unsafe_get_default_formatter_map(FMap::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, thread_safe, may_not_duplicate],
"
FMap = pretty_printer.defaultFormatterMap;
").
%---------------------%
:- pragma foreign_proc("C",
set_default_formatter_map(FMap::in, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury],
"
ML_pretty_printer_default_formatter_map = FMap;
ML_pretty_printer_is_initialised = MR_TRUE;
").
:- pragma foreign_proc("C#",
set_default_formatter_map(FMap::in, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, may_not_duplicate],
"
pretty_printer.isInitialised = mr_bool.YES;
pretty_printer.defaultFormatterMap = FMap;
").
:- pragma foreign_proc("Java",
set_default_formatter_map(FMap::in, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, may_not_duplicate],
"
pretty_printer.isInitialised = bool.YES;
pretty_printer.defaultFormatterMap = FMap;
").
%---------------------------------------------------------------------------%
% Construct the initial default formatter map. This function
% should be extended as more specialised formatters are added
% to the standard library modules.
%
:- func initial_formatter_map = formatter_map.
initial_formatter_map = !:Formatters :-
!:Formatters = new_formatter_map,
set_formatter("builtin", "character", 0, fmt_char, !Formatters),
set_formatter("builtin", "float", 0, fmt_float, !Formatters),
set_formatter("builtin", "int", 0, fmt_int, !Formatters),
set_formatter("builtin", "int8", 0, fmt_int8, !Formatters),
set_formatter("builtin", "int16", 0, fmt_int16, !Formatters),
set_formatter("builtin", "int32", 0, fmt_int32, !Formatters),
set_formatter("builtin", "int64", 0, fmt_int64, !Formatters),
set_formatter("builtin", "uint", 0, fmt_uint, !Formatters),
set_formatter("builtin", "uint8", 0, fmt_uint8, !Formatters),
set_formatter("builtin", "uint16", 0, fmt_uint16, !Formatters),
set_formatter("builtin", "uint32", 0, fmt_uint32, !Formatters),
set_formatter("builtin", "uint64", 0, fmt_uint64, !Formatters),
set_formatter("builtin", "string", 0, fmt_string, !Formatters),
set_formatter("array", "array", 1, fmt_array, !Formatters),
set_formatter("list", "list", 1, fmt_list, !Formatters),
set_formatter("one_or_more", "one_or_more",
1, fmt_one_or_more, !Formatters),
set_formatter("tree234", "tree234", 2, fmt_tree234, !Formatters),
set_formatter("version_array", "version_array",
1, fmt_version_array, !Formatters),
set_formatter("sparse_bitset", "sparse_bitset",
1, fmt_sparse_bitset, !Formatters),
set_formatter("fat_sparse_bitset", "fat_sparse_bitset",
1, fmt_fat_sparse_bitset, !Formatters),
set_formatter("fatter_sparse_bitset", "fatter_sparse_bitset",
1, fmt_fatter_sparse_bitset, !Formatters),
set_formatter("tree_bitset", "tree_bitset",
1, fmt_tree_bitset, !Formatters).
%---------------------%
:- func fmt_char(univ, list(type_desc)) = doc.
fmt_char(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.char_to_doc(X)
else
str("?char?")
).
:- func fmt_float(univ, list(type_desc)) = doc.
fmt_float(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.float_to_doc(X)
else
str("?float?")
).
:- func fmt_int(univ, list(type_desc)) = doc.
fmt_int(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.int_to_doc(X)
else
str("?int?")
).
:- func fmt_int8(univ, list(type_desc)) = doc.
fmt_int8(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.int8_to_doc(X)
else
str("?int8?")
).
:- func fmt_int16(univ, list(type_desc)) = doc.
fmt_int16(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.int16_to_doc(X)
else
str("?int16?")
).
:- func fmt_int32(univ, list(type_desc)) = doc.
fmt_int32(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.int32_to_doc(X)
else
str("?int32?")
).
:- func fmt_int64(univ, list(type_desc)) = doc.
fmt_int64(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.int64_to_doc(X)
else
str("?int64?")
).
:- func fmt_uint(univ, list(type_desc)) = doc.
fmt_uint(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.uint_to_doc(X)
else
str("?uint?")
).
:- func fmt_uint8(univ, list(type_desc)) = doc.
fmt_uint8(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.uint8_to_doc(X)
else
str("?uint8?")
).
:- func fmt_uint16(univ, list(type_desc)) = doc.
fmt_uint16(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.uint16_to_doc(X)
else
str("?uint16?")
).
:- func fmt_uint32(univ, list(type_desc)) = doc.
fmt_uint32(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.uint32_to_doc(X)
else
str("?uint32?")
).
:- func fmt_uint64(univ, list(type_desc)) = doc.
fmt_uint64(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.uint64_to_doc(X)
else
str("?uint64?")
).
:- func fmt_string(univ, list(type_desc)) = doc.
fmt_string(Univ, _ArgDescs) =
( if Univ = univ(X) then
pretty_printer.string_to_doc(X)
else
str("?string?")
).
:- func fmt_array(univ, list(type_desc)) = doc.
fmt_array(Univ, ArgDescs) =
( if
ArgDescs = [ArgDesc],
has_type(_Arg : T, ArgDesc),
Value = univ_value(Univ),
dynamic_cast(Value, X : array(T))
then
pretty_printer.array_to_doc(X)
else
str("?array?")
).
:- func fmt_list(univ, list(type_desc)) = doc.
fmt_list(Univ, ArgDescs) =
( if
ArgDescs = [ArgDesc],
has_type(_Arg : T, ArgDesc),
Value = univ_value(Univ),
dynamic_cast(Value, X : list(T))
then
pretty_printer.list_to_doc(X)
else
str("?list?")
).
:- func fmt_one_or_more(univ, list(type_desc)) = doc.
fmt_one_or_more(Univ, ArgDescs) =
( if
ArgDescs = [ArgDesc],
has_type(_Arg : T, ArgDesc),
Value = univ_value(Univ),
dynamic_cast(Value, X : one_or_more(T))
then
pretty_printer.one_or_more_to_doc(X)
else
str("?one_or_more?")
).
:- func fmt_tree234(univ, list(type_desc)) = doc.
fmt_tree234(Univ, ArgDescs) =
( if
ArgDescs = [ArgDescA, ArgDescB],
has_type(_ArgA : K, ArgDescA),
has_type(_ArgB : V, ArgDescB),
Value = univ_value(Univ),
dynamic_cast(Value, X : tree234(K, V))
then
pretty_printer.tree234_to_doc(X)
else
str("?tree234?")
).
:- func fmt_version_array(univ, list(type_desc)) = doc.
fmt_version_array(Univ, ArgDescs) =
( if
ArgDescs = [ArgDesc],
has_type(_Arg : T, ArgDesc),
Value = univ_value(Univ),
dynamic_cast(Value, X : version_array(T))
then
pretty_printer.version_array_to_doc(X)
else
str("?version_array?")
).
:- func fmt_sparse_bitset(univ, list(type_desc)) = doc.
fmt_sparse_bitset(Univ, ArgDescs) =
( if
ArgDescs = [ArgDesc],
has_type(_Arg : T, ArgDesc),
Value = univ_value(Univ),
dynamic_cast(Value, X : sparse_bitset(uint))
then
pretty_printer.sparse_bitset_to_doc(X)
else
str("?sparse_bitset?")
).
:- func fmt_fat_sparse_bitset(univ, list(type_desc)) = doc.
fmt_fat_sparse_bitset(Univ, ArgDescs) =
( if
ArgDescs = [ArgDesc],
has_type(_Arg : T, ArgDesc),
Value = univ_value(Univ),
dynamic_cast(Value, X : fat_sparse_bitset(uint))
then
pretty_printer.fat_sparse_bitset_to_doc(X)
else
str("?fat_sparse_bitset?")
).
:- func fmt_fatter_sparse_bitset(univ, list(type_desc)) = doc.
fmt_fatter_sparse_bitset(Univ, ArgDescs) =
( if
ArgDescs = [ArgDesc],
has_type(_Arg : T, ArgDesc),
Value = univ_value(Univ),
dynamic_cast(Value, X : fatter_sparse_bitset(uint))
then
pretty_printer.fatter_sparse_bitset_to_doc(X)
else
str("?sparse_bitset?")
).
:- func fmt_tree_bitset(univ, list(type_desc)) = doc.
fmt_tree_bitset(Univ, ArgDescs) =
( if
ArgDescs = [ArgDesc],
has_type(_Arg : T, ArgDesc),
Value = univ_value(Univ),
dynamic_cast(Value, X : tree_bitset(uint))
then
pretty_printer.tree_bitset_to_doc(X)
else
str("?tree_bitset?")
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% This is where we keep the display parameters (line width etc.).
% The formatter map is handled separately, because it *has* to be
% initialised immediately, i.e. before any other module's initialisation
% directive can update the default formatter map.
%
:- mutable(io_pp_params, pp_params, pp_params(78, 100, triangular(100)),
ground, [attach_to_io_state, untrailed]).
get_default_params(Params, !IO) :-
get_io_pp_params(Params, !IO).
set_default_params(Params, !IO) :-
set_io_pp_params(Params, !IO).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
char_to_doc(C) = str(term_io.quoted_char_to_string(C)).
string_to_doc(S) = str(term_io.quoted_string(S)).
float_to_doc(F) = str(string.float_to_string(F)).
int_to_doc(I) = str(string.int_to_string(I)).
int8_to_doc(I) = str(string.int8_to_string(I)).
int16_to_doc(I) = str(string.int16_to_string(I)).
int32_to_doc(I) = str(string.int32_to_string(I)).
int64_to_doc(I) = str(string.int64_to_string(I)).
uint_to_doc(U) = str(string.uint_to_string(U)).
uint8_to_doc(U) = str(string.uint8_to_string(U)).
uint16_to_doc(U) = str(string.uint16_to_string(U)).
uint32_to_doc(U) = str(string.uint32_to_string(U)).
uint64_to_doc(U) = str(string.uint64_to_string(U)).
%---------------------------------------------------------------------------%
% XXX The to_doc functions of the compound library types used to put
% different amounts of indentation at the outermost level.
%
% - list_to_doc added one space as indent
% - one_or_more_to_doc added one space as indent
% - tree234_to_doc added one standard indent (two spaces)
% - array_to_doc added one standard indent (two spaces)
% - version_array_to_doc added one standard indent (two spaces)
%
% We now leave any indentation around the doc returned by all these X_to_doc
% functions to their caller.
%---------------------------------------------------------------------------%
list_to_doc(Xs) = docs([str("["), list_to_doc_loop(Xs), str("]")]).
:- func list_to_doc_loop(list(T)) = doc.
list_to_doc_loop([]) = str("").
list_to_doc_loop([X | Xs]) = Doc :-
(
Xs = [],
Doc = format_arg(format(X))
;
Xs = [_ | _],
Doc = docs([
format_arg(format(X)),
group([str(", "), nl]),
format_susp((func) = list_to_doc_loop(Xs))
])
).
%---------------------------------------------------------------------------%
one_or_more_to_doc(one_or_more(H, T)) =
docs([
str("one_or_more("),
format_arg(format(H)),
group([str(", "), nl]),
str("["),
format_susp((func) = list_to_doc_loop(T)),
str("])")
]).
%---------------------------------------------------------------------------%
% With this type definition, including the use of the -> operator
% as the function symbol, the default pretty_printer formatting
% for key_value_pair will generate the output we want.
%
:- type key_value_pair(K, V)
---> (K -> V).
tree234_to_doc(T) =
docs([
str("map(["),
tree234_elements_to_doc(tree234_to_lazy_list(T, tll_nil)),
str("])")
]).
:- func tree234_elements_to_doc(tree234_lazy_list(K, V)) = doc.
tree234_elements_to_doc(tll_nil) = str("").
tree234_elements_to_doc(tll_lazy_cons(K, V, Susp)) = Doc :-
LL = apply(Susp),
(
LL = tll_nil,
Doc = group([nl, format_arg(format((K -> V)))])
;
LL = tll_lazy_cons(_, _, _),
Doc = docs([
group([nl, format_arg(format((K -> V))), str(", ")]),
format_susp((func) = tree234_elements_to_doc(LL))
])
).
%---------------------------------------------------------------------------%
array_to_doc(A) =
docs([str("array(["), array_to_doc_loop(A, 0), str("])")]).
:- func array_to_doc_loop(array(T), int) = doc.
array_to_doc_loop(A, I) = Doc :-
( if I > array.max(A) then
Doc = str("")
else
array.unsafe_lookup(A, I, Elem),
Doc = docs([
format_arg(format(Elem)),
( if I = array.max(A) then
str("")
else
group([str(", "), nl])
),
format_susp((func) = array_to_doc_loop(A, I + 1))
])
).
%---------------------------------------------------------------------------%
version_array_to_doc(A) =
docs([
str("version_array(["),
version_array_to_doc_loop(A, 0),
str("])")
]).
:- func version_array_to_doc_loop(version_array(T), int) = doc.
version_array_to_doc_loop(VA, I) = Doc :-
( if I > version_array.max(VA) then
Doc = str("")
else
version_array.lookup(VA, I, Elem),
Doc = docs([
format_arg(format(Elem)),
( if I = version_array.max(VA) then
str("")
else
group([str(", "), nl])
),
format_susp((func) = version_array_to_doc_loop(VA, I + 1))
])
).
%---------------------------------------------------------------------------%
%
% Convert a sparse_bitset, in any one of its forms, to a doc.
%
% Unlike all the other X_to_doc functions above, these are not exported.
% The reason for that is that as far as I (zs) know, the current RTTI
% system does not support taking a value of type sparse_bitset(T)
% and converting each element of that set back to a value of type T.
% That would requiring invoking the from_uint method of T's instance
% of the uenum type class, and we do not have the data structures
% we would need to find that method.
%
% The best we can do is to print the set elements as uints. (Our callers,
% fmt_sparse_bitset and its other versions do the required cast from e.g.
% sparse_bitset(T) to sparse_bitset(uint) for us.) This is not as good
% as printing the values of type T encoded by the uints, but it is *much*
% more understandable than e.g. a list of bitset_elems.
%
% Note that formatting a list of uints yields a string containing numbers
% *without* the "u" suffix, because string.uint_to_string does not add one.
%
:- func sparse_bitset_to_doc(sparse_bitset(uint)) = doc.
sparse_bitset_to_doc(Set) = Doc :-
sparse_bitset.to_sorted_list(Set, SortedList),
Doc = docs([
str("sparse_bitset("),
format(SortedList),
str(")")
]).
:- func fat_sparse_bitset_to_doc(fat_sparse_bitset(uint)) = doc.
fat_sparse_bitset_to_doc(Set) = Doc :-
fat_sparse_bitset.to_sorted_list(Set, SortedList),
Doc = docs([
str("fat_sparse_bitset("),
format(SortedList),
str(")")
]).
:- func fatter_sparse_bitset_to_doc(fatter_sparse_bitset(uint)) = doc.
fatter_sparse_bitset_to_doc(Set) = Doc :-
fatter_sparse_bitset.to_sorted_list(Set, SortedList),
Doc = docs([
str("fatter_sparse_bitset("),
format(SortedList),
str(")")
]).
:- func tree_bitset_to_doc(tree_bitset(uint)) = doc.
tree_bitset_to_doc(Set) = Doc :-
tree_bitset.to_sorted_list(Set, SortedList),
Doc = docs([
str("tree_bitset("),
format(SortedList),
str(")")
]).
%---------------------------------------------------------------------------%
:- end_module pretty_printer.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink