mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-15 01:13:30 +00:00
Code Issues Projects Releases Wiki Activity
Files
e00722533b25ea353e4c3adcc178f00a92fcfbf3
mercury/compiler/error_spec.m
Julien Fischer b9777da30f Fix some documentation errors in the compiler. 
Fix some mispelled variable names.

compiler/accumulator.m:
compiler/check_import_accessibility.m:
compiler/decide_type_repn.m:
compiler/du_type_layout.m:
compiler/error_spec.m:
compiler/hlds_data.m:
compiler/hlds_goal.m:
compiler/mlds.m:
compiler/parse_item.m:
compiler/prog_data.m:
compiler/type_util.m:
    As above.
2026-01-24 01:19:51 +11:00

1659 lines
64 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 1997-2012 The University of Melbourne.
% Copyright (C) 2022-2026 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: error_spec.m.
% Main author: zs.
%
% This module defines the error_spec structure for representing
% diagnostic messages, and utility predicates and functions that can help
% create error_specs.
%
%---------------------------------------------------------------------------%
:- module parse_tree.error_spec.
:- interface.
:- import_module libs.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.var_table.
:- import_module bool.
:- import_module edit_seq.
:- import_module list.
:- import_module maybe.
:- import_module set.
:- import_module term.
:- import_module varset.
%---------------------------------------------------------------------------%
% Every distinct problem should generate a single error specification,
% whose general form is error_spec(Id, Severity, Phase, Msgs).
% The second, third and fourth fields of this term state respectively
%
% - the severity of the problem (so that we can update the exit status
% of the compiler accordingly);
% - which phase of the compiler found the problem (since later phases
% may wish to suppress some problem reports if some specific earlier phases
% found problems, e.g. when a missing clause could be caused
% by a syntax error); and
% - a specification of what to print.
%
% In most cases, the "what to print" will be a single message for a single
% context. However, we may want to print messages for several contexts.
% For example, when reporting a duplicate declaration, we want to report
% this fact in the duplicate declaration's context, while printing another
% message giving the original declaration's context.
%
% spec(Id, Severity, Phase, Context, Pieces) is a shorthand for
% (and equivalent in every respect to) error_spec(Id, Severity, Phase,
% [simple_msg(Context, always(Pieces)])]).
%
% no_ctxt_spec(Id, Severity, Phase, Pieces) is shorthand for
% (and equivalent in every respect to) error_spec(Id, Severity, Phase,
% error_msg(maybe.no, treat_based_on_posn, 0, [always(Pieces)])).
%
% conditional_spec(Id, Option, MatchValue, Severity, Phase, Msgs) is intended
% to represent the error specification given by its last three fields
% *iff* Option has the value MatchValue. If Option is *not* MatchValue,
% it asks for nothing to be printed, and for the exit status to be left alone.
%
% The Id field, which is present in all these alternatives, is totally
% ignored when printing error_specs. Its job is something completely different:
% helping developers track down where in the source code each error_spec
% was constructed. Without the id fields, if developers want to know this,
% e.g. because they do not want the message printed, or because there is
% a problem with its wording, they have to grep for some words in the message.
% However, grepping for a single word will usually get many false hits,
% while grepping for two or more consecutive words in the message may miss
% the code generating the message, because in that code, some of those
% consecutive words may be on different lines. On the other hand, if every
% place that constructs an error_spec, of any of these varieties,
% fills in the id field with $pred, then finding the right place is easy:
% just specify the developer-only option --print-error-spec-id, and
% the identity of the predicate or function that generated each error_spec
% will be output just after the messages in that error_spec. Even if the
% predicate or function that this identifies has several pieces of code
% that construct error_specs, the scope in which you have to search for
% the one you are looking for will be easily manageable.
:- type error_spec
---> spec(
s_id :: string,
s_spec_severity :: spec_severity,
s_spec_phase :: spec_phase,
s_spec_context :: prog_context,
s_spec_pieces :: list(format_piece)
)
; no_ctxt_spec(
ncs_id :: string,
ncs_spec_severity :: spec_severity,
ncs_spec_phase :: spec_phase,
ncs_spec_pieces :: list(format_piece)
)
; error_spec(
es_id :: string,
es_severity :: spec_severity,
es_phase :: spec_phase,
es_msgs :: list(error_msg)
).
% An error_spec that is *intended* to contain a warning,
% XXX We can now enforce that intention using subtypes.
%
:- type warning_spec == error_spec.
:- type std_error_spec =< error_spec
---> error_spec(
es_id :: string,
es_severity :: spec_severity,
es_phase :: spec_phase,
es_msgs :: list(std_error_msg)
).
% Many operations in the compiler may either succeed or fail.
% When they succeed, they return some result(s); when they don't,
% they return one or more errors.
%
:- type maybe_error_specs(T)
---> ok_no_spec(T)
; error_specs(error_spec, list(error_spec)).
%---------------------------------------------------------------------------%
:- type spec_severity
---> severity_error
% Always print the spec, and
% always set the exit status to indicate an error.
; severity_error(option)
% Print the spec and set the exit status to indicate an error
% only if this option is enabled.
; severity_warning(option)
% Print the spec only if this option is enabled.
% Set the exit status to indicate an error only if
% both the given option AND --halt-at-warn are enabled.
; severity_informational(option).
% Don't set the exit status to indicate an error.
:- type actual_severity
---> actual_severity_error
; actual_severity_warning
; actual_severity_informational.
%---------------------------------------------------------------------------%
:- type spec_phase
---> phase_options
; phase_check_libs
; phase_make_target
; phase_make_int
; phase_find_files(string)
% The name of the file we tried to find, but failed.
% The intention is to make it possible to use this info
% to replace several messages that all report failures
% to find files with a single, shorter message to that effect.
; phase_read_files
; phase_module_name
; phase_t2pt % short for "term to parse tree"
% The "tim" in the next few phase names is short for "type inst mode".
% Some errors in check_type_inst_mode_defns.m report an invalid type, ...
; phase_tim_check_invalid_type
% some report an invalid inst or mode, ...
; phase_tim_check_invalid_inst_mode
% and some do neither.
; phase_tim_check
; phase_type_repn
; phase_pt2h % short for "parse tree to HLDS"
; phase_expand_types
; phase_type_check
; phase_inst_check
; phase_polymorphism
; phase_mode_check(mode_report_control)
; phase_purity_check
; phase_detism_check
; phase_fact_table_check
; phase_oisu_check
; phase_simplify(mode_report_control)
; phase_direct_arg_in_out
; phase_style
; phase_dead_code
; phase_termination_analysis
; phase_accumulator_intro
; phase_auto_parallelism
; phase_interface_gen
; phase_code_gen.
:- type mode_report_control
---> report_in_any_mode
; report_only_if_in_all_modes.
%---------------------------------------------------------------------------%
% An error message may have several components that may be printed under
% different circumstances. Some components are always printed; some are
% printed only if specific options have specific values. When an error
% specification is printed, we concatenate the list of all the
% format_pieces that should be printed. If this yields the empty list,
% we print nothing. Otherwise, we print them all out.
%
% When we print an error message in a list of error messages, we normally
% treat the first line of the first message differently than the rest:
% we separate it from the context by one space, whereas following lines
% are separated by three spaces. You can request that the first line of
% a message be treated as it were the first, even if it is not, by setting
% the error_treat_as_first field to "always_treat_as_first". You can also
% request that the pieces in a message be given extra indentation by setting
% the error_extra_indent field to a strictly positive value.
%
% The term simple_msg(Context, Components) is a shorthand for (and equivalent
% in every respect to) the term error_msg(yes(Context), treat_based_on_posn,
% 0, Components).
%
% The term msg(Context, Pieces) is a shorthand for (and equivalent
% in every respect to) the term simple_msg(Context, [always(Pieces)]).
:- type maybe_always_treat_as_first
---> always_treat_as_first
; treat_based_on_posn.
:- type error_msg
---> msg(
simplest_context :: prog_context,
simplest_pieces :: list(format_piece)
)
; no_ctxt_msg(
simplestnc_pieces :: list(format_piece)
)
; simple_msg(
simple_context :: prog_context,
simple_components :: list(error_msg_component)
)
; error_msg(
error_context :: maybe(prog_context),
error_treat_as_first :: maybe_always_treat_as_first,
error_extra_indent :: uint,
error_components :: list(error_msg_component)
)
; blank_msg(
blank_context :: maybe(prog_context)
).
:- type std_error_msg =< error_msg
---> error_msg(
error_context :: maybe(prog_context),
error_treat_as_first :: maybe_always_treat_as_first,
error_extra_indent :: uint,
error_components :: list(std_error_msg_component)
).
:- type verbose_always_or_once
---> verbose_always
; verbose_once.
% Message components marked as verbose_once should be printed
% just once.
:- type error_msg_component
---> always(list(format_piece))
% Print these components under all circumstances.
; option_is_set(option, bool, list(error_msg_component))
% Print the embedded components only if the specified boolean
% option has the specified value.
; verbose_only(verbose_always_or_once, list(format_piece))
% Print these components only if --verbose-errors is specified.
% If it is not specified, set the flag that triggers the printing
% of the message reminding the user about --verbose-errors.
% In addition, if the first field is verbose_once, then disable
% all but the first printing of the message even if
% --verbose-errors is specified.
; verbose_and_nonverbose(list(format_piece), list(format_piece)).
% If --verbose-errors is specified, print the first set of
% components. If it is not specified, print the second set,
% and set the flag that triggers the printing of the message
% reminding the user about --verbose-errors. The verbose part
% is implicitly verbose_always.
:- type std_error_msg_component =< error_msg_component
---> always(list(format_piece))
; verbose_only(verbose_always_or_once, list(format_piece))
; verbose_and_nonverbose(list(format_piece), list(format_piece)).
%---------------------------------------------------------------------------%
:- type format_piece
---> invis_order_default_start(int, string)
% Prints nothing. If the compiler generates two different specs
% for the same context that we intend to appear in a specific
% order, even though it may not be the order that sorting those
% specs would normally give, we can add one of these to the
% start of each error_spec, with the order of the numbers
% and/or strings inside these invis orders controlling
% the final order of the error_specs.
%
% This component sorts before other components that do not
% specify such an ordinal number. The invis_order_default_end
% component sorts after them. By choosing to use one or the other,
% users of this type can control sorting with respect to
% error messages generated in places in the code they do not
% control.
; fixed(string)
% This string should appear in the output in one piece, as it is.
; quote(string)
% Surround the string with `' quotes, then treat as fixed.
; int_fixed(int)
; int_name(int)
; uint_fixed(uint)
; uint_name(uint)
% Convert the integer to a string, then treat as fixed.
% int_fixed always generates numerals, such as 1, 2, 3 etc,
% while int_name generates one, two, three etc up to ten,
% then switches back to numerals starting with 11.
; nth_fixed(int)
; unth_fixed(uint)
% Convert the integer to a string, such as "first", "second",
% "third", "tenth", "11th" and so on, and then treat as fixed.
; lower_case_next_if_not_first
% If this is the first component, ignore it. If this is not
% the first component, lower case the initial letter of the
% next component. There is no effect if the next component
% does not exist or does not start with an upper case letter.
; upper_case_next
; treat_next_as_first
% For the purpose of the test done by lower_case_next_if_not_first,
% treat the next component as the first, even if it isn't.
; prefix(string)
% This string should appear in the output in one piece, as it is,
% inserted directly before the next format_piece, without
% any intervening space.
; suffix(string)
% This string should appear in the output in one piece, as it is,
% appended directly after the previous format_piece, without
% any intervening space.
; words(string)
% This string contains words separated by white space. The words
% should appear in the output in the given order, but the white
% space may be rearranged and line breaks may be inserted.
; words_quote(string)
% Surround the string with `' quotes, then treat as words.
; qual_sym_name(sym_name)
; unqual_sym_name(sym_name)
% The output should contain the string form of the sym_name,
% surrounded by `' quotes.
; name_arity(name_arity)
% The output should contain the name, surrounded by `' quotes,
% followed by '/' and the arity.
; qual_sym_name_arity(sym_name_arity)
; unqual_sym_name_arity(sym_name_arity)
% The output should contain the string form of the sym_name,
% surrounded by `' quotes, followed by '/' and the arity.
; qual_pf_sym_name_pred_form_arity(pf_sym_name_arity)
; unqual_pf_sym_name_pred_form_arity(pf_sym_name_arity)
; qual_pf_sym_name_user_arity(pred_pf_name_arity)
; unqual_pf_sym_name_user_arity(pred_pf_name_arity)
% The output should contain the string form of the sym_name,
% surrounded by `' quotes, followed by '/' and the arity, but
% - precede them with either "predicate" or "function", and
% - for functions, use their *user-visible* arity, which does not
% count the function result.
%
% With the forms taking a pf_sym_name_arity argument, the
% pf_sym_name_arity contains a pred_form_arity that we convert
% to the user visible arity for printing. With the forms taking
% a pred_pf_name_arity argument, the pf_sym_name_arity contains
% a user_arity that we print unchanged.
; qual_type_ctor(type_ctor)
; unqual_type_ctor(type_ctor)
% The output should contain the string form of the type_ctor,
% surrounded by `' quotes, followed by '/' and the arity.
; qual_inst_ctor(inst_ctor)
; unqual_inst_ctor(inst_ctor)
% The output should contain the string form of the inst_ctor,
% surrounded by `' quotes, followed by '/' and the arity.
; qual_mode_ctor(mode_ctor)
; unqual_mode_ctor(mode_ctor)
% The output should contain the string form of the mode_ctor,
% surrounded by `' quotes, followed by '/' and the arity.
; qual_class_id(class_id)
; unqual_class_id(class_id)
% The output should contain the string form of the class_id,
% surrounded by `' quotes, followed by '/' and the arity.
; qual_cons_id_and_maybe_arity(cons_id)
; unqual_cons_id_and_maybe_arity(cons_id)
% If the cons_id is a cons_id for a builtin type, strip the
% builtin qualifier (or all qualifier) from it, and output
% the result. If the cons_id is for a du type, output its name
% in quotes, followed by '/' and its arity.
; qual_top_ctor_of_type(mer_type)
% The top level type constructor of the given type,
% which must have one (i.e. must not be a variable).
; p_or_f(pred_or_func)
% Output the string "predicate" or "function" as appropriate.
; purity_desc(purity)
% Output the string "pure", "semipure" or "impure" as appropriate.
; a_purity_desc(purity)
% Output the string "a pure", "a semipure" or "an impure"
% as appropriate.
; purity_desc_article(purity)
% Output the article that forms the difference between
% the output of a_purity_desc(Purity) and purity_desc(Purity).
; decl(string)
% Prefix the string with ":- ", surround it with single quotes,
% and then treat as fixed.
; pragma_decl(string)
% As above, but prefix the string with ":- pragma ".
; left_paren_maybe_nl_inc(string, lp_piece_kind)
; maybe_nl_dec_right_paren(string, rp_piece_kind)
% These two pieces are intended to help implement messages
% that should be formatted to look like either
%
% aaa(bbb, ccc)
%
% if there is space on the current line, or to look like
%
% aaa(
% bbb,
% ccc
% )
%
% if there isn't.
%
% The piece sequence that would yield the above would be
%
% fixed("aaa")
% left_paren_maybe_nl_inc("(", lp_suffix)
% fixed("bbb"),
% suffix(","),
% nl,
% fixed("ccc"),
% maybe_nl_dec_right_paren(")", rp_plain)
%
% The left_paren_maybe_nl_inc adds the given string to the
% text, followed by an nl_indent(1). The maybe_nl_dec_right_paren
% adds an nl_indent(-1) to the text, followed by the given string.
% The left parenthesis may be added to the previous piece
% as a suffix, or not; the right parenthesis may be added
% to the next piece as a prefix, or not. The strings are usually
% "(" and ")", but they could also be "{" and "}", or "[" and "]",
% or anything else.
%
% The "maybe" is there in the names of these pieces because
% these pieces expressly tell the code of write_error_pieces.m
% to delete both these indent-incrementing/decrementing newlines,
% and all other newlines between the left_paren_maybe_nl_inc
% and its matching maybe_nl_dec_right_paren, provided the text
% between them fits in the space available on the line.
% Note that the size of the space depends on both the length
% of the context printed at the start of the line, and on the
% indent printed after the context, which may or may not be
% available to the code constructing these pieces.
%
% These pieces should always be used in left/right pairs,
% and should always be properly nested.
; nl
% Insert a line break if there has been text output since
% the last line break.
; nl_indent_delta(int)
% Act as nl, but also add the given integer (which should be a
% small positive or negative integer) to the current indent level.
; blank_line
% Create a blank line.
; not_for_general_use_start_color(color_name)
; not_for_general_use_end_color(color_name)
% Start or end the scope of a color.
; invis_order_default_end(int, string).
% See the documentation of invis_order_default_start above.
:- type lp_piece_kind
---> lp_plain
% The left parenthesis should be added to the previous pieces
% as if it were in a fixed(...) piece.
; lp_suffix.
% The left parenthesis should be added to the previous pieces
% as if it were in a suffix(...) piece.
:- type rp_piece_kind
---> rp_plain
% The right parenthesis should be added to the following pieces
% as if it were in a fixed(...) piece.
; rp_prefix.
% The right parenthesis should be added to the following pieces
% as if it were in a prefix(...) piece.
:- type color_name
---> color_subject
; color_correct
; color_incorrect
; color_inconsistent
; color_hint.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
% Wrap words() around a string.
%
:- func string_to_words_piece(string) = format_piece.
:- func var_to_quote_piece(varset(T), var(T)) = format_piece.
:- func var_in_table_to_quote_piece(var_table, prog_var) = format_piece.
%---------------------------------------------------------------------------%
% indented_list(Lines):
%
% Format Lines, a list of lines each given by a single format_piece,
% by putting newlines between them, and by adding nl_indent_deltas
% before and after the list to first increase and then decrease
% the indent level.
%
:- func indented_list(list(format_piece)) = list(format_piece).
% choose_number(List, Singular, Plural) = Form
%
% Choose between a singular version and a plural version of something,
% based on the length of a list. Chooses the plural if the list is empty.
%
:- func choose_number(list(T), U, U) = U.
% is_or_are(List) throws an exception if the list is empty, returns "is"
% if the list is a singleton, and otherwise returns "are".
%
:- func is_or_are(list(T)) = string.
% Return the name of the given integer as zero, one, two, three etc,
% up to ten. For integers other than 0..10, return the value as digits.
%
:- func int_name_str(int) = string.
:- func uint_name_str(uint) = string.
% The ordinal version of int_name_str, returning first, second etc
% for 1..10.
%
:- func nth_fixed_str(int) = string.
:- func unth_fixed_str(uint) = string.
%---------------------------------------------------------------------------%
:- func describe_sym_name(sym_name) = string.
:- func describe_sym_name_arity(sym_name_arity) = string.
% Put `' quotes around the given string.
%
:- func add_quotes(string) = string.
:- func add_suffix_if_nonempty(list(format_piece), list(format_piece)) =
list(format_piece).
:- pred append_prefix_and_maybe_verbose(maybe(color_name)::in,
list(format_piece)::in, list(format_piece)::in,
list(format_piece)::in, list(format_piece)::in,
error_msg_component::out) is det.
%---------------------------------------------------------------------------%
:- pred extract_msg_maybe_context(error_msg::in, maybe(prog_context)::out)
is det.
:- pred extract_spec_phase(error_spec::in, spec_phase::out) is det.
:- pred accumulate_contexts(error_spec::in,
set(prog_context)::in, set(prog_context)::out) is det.
%---------------------------------------------------------------------------%
:- pred extract_spec_msgs_and_id(error_spec::in,
list(error_msg)::out, string::out) is det.
:- pred extract_spec_msgs_and_maybe_add_id(globals::in, error_spec::in,
list(error_msg)::out) is det.
:- pred maybe_add_error_spec_id(option_table::in, string::in,
list(error_msg)::in, list(error_msg)::out) is det.
:- pred maybe_add_error_spec_id_std(option_table::in, string::in,
list(std_error_msg)::in, list(std_error_msg)::out) is det.
%---------------------------------------------------------------------------%
:- pred construct_diff_for_string_seqs(edit_params::in,
list(string)::in, list(string)::in, list(format_piece)::out) is det.
%---------------------------------------------------------------------------%
:- pred maybe_construct_did_you_mean_pieces(string::in, list(string)::in,
list(format_piece)::out) is det.
:- pred maybe_construct_prefixed_did_you_mean_pieces(string::in, string::in,
list(string)::in, list(format_piece)::out) is det.
%---------------------------------------------------------------------------%
:- func color_as_subject(list(format_piece)) = list(format_piece).
:- func color_as_correct(list(format_piece)) = list(format_piece).
:- func color_as_incorrect(list(format_piece)) = list(format_piece).
:- func color_as_inconsistent(list(format_piece)) = list(format_piece).
:- func color_as_hint(list(format_piece)) = list(format_piece).
:- func color_pieces(color_name, list(format_piece)) = list(format_piece).
:- func maybe_color_pieces(maybe(color_name), list(format_piece))
= list(format_piece).
%---------------------------------------------------------------------------%
%
% The functions in this section have the task of formatting lists of
% various kinds of items for use in diagnostic messages.
% These functions form an (incomplete) 4 by 2 by 2 by 2 matrix.
%
% The first dimension specifies what the individual items are, and how
% they should be treated.
%
% - If the function name starts with "fixed", this means that each item
% is a string, and it should be formatted as a fixed string.
%
% - If the function name starts with "quote", this means that each item
% is a string, and it should be formatted as a quoted string.
%
% - If the function name starts with "piece", this means that each item
% is a piece, and it should be used as is.
%
% - If the function name starts with "pieces", this means that each item
% is a list of pieces, which should be used as is.
%
% This dimension controls the type of the last argument of the function.
%
% The second dimension is whether the items should be formatted in color.
%
% - If the function name includes "color", then the answer is yes.
% - Otherwise, the answer is no.
%
% This dimension controls the presence of two arguments. Functions that
% return colored pieces takes as one argument the name of that color,
% and they also take a LastSuffix parameter, which is a list of pieces
% that the function adds to the last item. The caller can use this argument
% e.g. to put a period as a suffix at the end of a sentence, if the given list
% is at the end of that sentence; or to put a comma or semicolon at the
% end of clause within a sentence, if the list is at the end of that clause.
% Of course, LastSuffix may also be the empty list of pieces. In any case,
% LastSuffix will be colored the same as the items. The functions that
% do not do coloring do not take a LastSuffix argument, because their caller
% can add any suffixes they like to the return value of the function.
%
% The third dimension controls whether the last gap between two items
% should be treated any differently than all the previous gaps between items.
%
% - If the function name includes either "strict" or "to_line_pieces", then
% we treat all gaps between items the same, by adding a comma as a suffix
% to the item before the gap.
%
% - Otherwise, we treat the last gap differently, by putting a separator word,
% usually either "and" or "or", in that gap.
%
% This dimension controls whether the function has a string argument
% specifying the separator to put into the last gap.
%
% The fourth dimension controls whether each item in the list should be
% printed separately on its own line.
%
% - If the function name ends with "to_line_pieces", then the answer is yes.
% - If the function name ends with just "to_pieces", then the answer is no.
%
% This dimension has no effect on the argument list, except through its
% coupling to the third dimension. The 4 by 2 by 2 by 2 matrix is incomplete
% because we do not support non-strict list format when putting each item
% on its own line. (It would not be hard to offer such support; there is
% just no particular need for that capability.)
%
% x_list_to_pieces(LastSepWord, Items) = Pieces.
%
:- func fixed_list_to_pieces(string,
list(string)) = list(format_piece).
:- func quote_list_to_pieces(string,
list(string)) = list(format_piece).
:- func piece_list_to_pieces(string,
list(format_piece)) = list(format_piece).
:- func pieces_list_to_pieces(string,
list(list(format_piece))) = list(format_piece).
% x_list_to_color_pieces(Color, LastSepWord, LastSuffix, Items) = Pieces.
%
:- func fixed_list_to_color_pieces(color_name, string,
list(format_piece), list(string)) = list(format_piece).
:- func quote_list_to_color_pieces(color_name, string,
list(format_piece), list(string)) = list(format_piece).
:- func piece_list_to_color_pieces(color_name, string,
list(format_piece), list(format_piece)) = list(format_piece).
:- func pieces_list_to_color_pieces(color_name, string,
list(format_piece), list(list(format_piece))) = list(format_piece).
% x_strict_list_to_pieces(Items) = Pieces.
%
:- func fixed_strict_list_to_pieces(
list(string)) = list(format_piece).
:- func quote_strict_list_to_pieces(
list(string)) = list(format_piece).
:- func piece_strict_list_to_pieces(
list(format_piece)) = list(format_piece).
:- func pieces_strict_list_to_pieces(
list(list(format_piece))) = list(format_piece).
% x_strict_list_to_color_pieces(Color, LastSepWord, LastSuffix, Items)
% = Pieces.
%
:- func fixed_strict_list_to_color_pieces(color_name,
list(format_piece), list(string)) = list(format_piece).
:- func quote_strict_list_to_color_pieces(color_name,
list(format_piece), list(string)) = list(format_piece).
:- func piece_strict_list_to_color_pieces(color_name,
list(format_piece), list(format_piece)) = list(format_piece).
:- func pieces_strict_list_to_color_pieces(color_name,
list(format_piece), list(list(format_piece))) = list(format_piece).
% x_list_to_line_pieces(Items) = Pieces.
%
:- func fixed_list_to_line_pieces(
list(string)) = list(format_piece).
:- func quote_list_to_line_pieces(
list(string)) = list(format_piece).
:- func piece_list_to_line_pieces(
list(format_piece)) = list(format_piece).
:- func pieces_list_to_line_pieces(
list(list(format_piece))) = list(format_piece).
% x_list_to_color_line_pieces(Color, LastSuffix, Items) = Pieces.
%
:- func fixed_list_to_color_line_pieces(color_name,
list(format_piece), list(string)) = list(format_piece).
:- func quote_list_to_color_line_pieces(color_name,
list(format_piece), list(string)) = list(format_piece).
:- func piece_list_to_color_line_pieces(color_name,
list(format_piece), list(format_piece)) = list(format_piece).
:- func pieces_list_to_color_line_pieces(color_name,
list(format_piece), list(list(format_piece))) = list(format_piece).
%---------------------------------------------------------------------------%
% This is a specialized version of pieces_list_to_color_line_pieces
% that allows the caller to specify
%
% - two lists of pieces to put on each line,
% - a color for each of those two lists of pieces.
%
:- func pieces_list_to_split_color_line_pieces(
maybe(color_name), maybe(color_name), list(format_piece),
list({list(format_piece), list(format_piece)})) = list(format_piece).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module parse_tree.parse_tree_out_term.
:- import_module char.
:- import_module edit_distance.
:- import_module getopt.
:- import_module int.
:- import_module require.
:- import_module std_util.
:- import_module string.
:- import_module term_context.
:- import_module uint.
%---------------------------------------------------------------------------%
string_to_words_piece(Str) = words(Str).
var_to_quote_piece(VarSet, Var) =
quote(mercury_var_to_name_only_vs(VarSet, Var)).
var_in_table_to_quote_piece(VarTable, Var) =
quote(var_table_entry_name(VarTable, Var)).
%---------------------------------------------------------------------------%
indented_list(Comps) =
[nl_indent_delta(1)] ++ indented_list_loop(Comps) ++ [nl_indent_delta(-1)].
:- func indented_list_loop(list(format_piece)) = list(format_piece).
indented_list_loop([]) = [].
indented_list_loop([Comp]) = [Comp].
indented_list_loop([Comp1, Comp2 | CompLists]) =
[Comp1, nl] ++ indented_list_loop([Comp2 | CompLists]).
choose_number([], _Singular, Plural) = Plural.
choose_number([_], Singular, _Plural) = Singular.
choose_number([_, _ | _], _Singular, Plural) = Plural.
is_or_are([]) = "" :-
unexpected($pred, "[]").
is_or_are([_]) = "is".
is_or_are([_, _ | _]) = "are".
int_name_str(N) = Str :-
( if
( N = 0, StrPrime = "zero"
; N = 1, StrPrime = "one"
; N = 2, StrPrime = "two"
; N = 3, StrPrime = "three"
; N = 4, StrPrime = "four"
; N = 5, StrPrime = "five"
; N = 6, StrPrime = "six"
; N = 7, StrPrime = "seven"
; N = 8, StrPrime = "eight"
; N = 9, StrPrime = "nine"
; N = 10, StrPrime = "ten"
)
then
Str = StrPrime
else
Str = int_to_string(N)
).
uint_name_str(N) = Str :-
( if
( N = 0u, StrPrime = "zero"
; N = 1u, StrPrime = "one"
; N = 2u, StrPrime = "two"
; N = 3u, StrPrime = "three"
; N = 4u, StrPrime = "four"
; N = 5u, StrPrime = "five"
; N = 6u, StrPrime = "six"
; N = 7u, StrPrime = "seven"
; N = 8u, StrPrime = "eight"
; N = 9u, StrPrime = "nine"
; N = 10u, StrPrime = "ten"
)
then
Str = StrPrime
else
Str = uint_to_string(N)
).
nth_fixed_str(N) = Str :-
( if
( N = 1, StrPrime = "first"
; N = 2, StrPrime = "second"
; N = 3, StrPrime = "third"
; N = 4, StrPrime = "fourth"
; N = 5, StrPrime = "fifth"
; N = 6, StrPrime = "sixth"
; N = 7, StrPrime = "seventh"
; N = 8, StrPrime = "eighth"
; N = 9, StrPrime = "ninth"
; N = 10, StrPrime = "tenth"
)
then
Str = StrPrime
else
% We want to print 12th and 13th, not 12nd and 13rd,
% but 42nd and 43rd instead of 42th and 43th.
NStr = int_to_string(N),
LastDigit = N mod 10,
( if N > 20, LastDigit = 2 then
Str = NStr ++ "nd"
else if N > 20, LastDigit = 3 then
Str = NStr ++ "rd"
else
Str = NStr ++ "th"
)
).
unth_fixed_str(N) = Str :-
( if
( N = 1u, StrPrime = "first"
; N = 2u, StrPrime = "second"
; N = 3u, StrPrime = "third"
; N = 4u, StrPrime = "fourth"
; N = 5u, StrPrime = "fifth"
; N = 6u, StrPrime = "sixth"
; N = 7u, StrPrime = "seventh"
; N = 8u, StrPrime = "eighth"
; N = 9u, StrPrime = "ninth"
; N = 10u, StrPrime = "tenth"
)
then
Str = StrPrime
else
% We want to print 12th and 13th, not 12nd and 13rd,
% but 42nd and 43rd instead of 42th and 43th.
NStr = uint_to_string(N),
LastDigit = N mod 10u,
( if N > 20u, LastDigit = 2u then
Str = NStr ++ "nd"
else if N > 20u, LastDigit = 3u then
Str = NStr ++ "rd"
else
Str = NStr ++ "th"
)
).
%---------------------------------------------------------------------------%
describe_sym_name(SymName) =
string.format("`%s'", [s(sym_name_to_string(SymName))]).
describe_sym_name_arity(sym_name_arity(SymName, Arity)) =
string.format("`%s'/%d", [s(sym_name_to_string(SymName)), i(Arity)]).
add_quotes(Str) = "`" ++ Str ++ "'".
add_suffix_if_nonempty(BasePieces, SuffixPieces) = Pieces :-
(
BasePieces = [],
Pieces = []
;
BasePieces = [_ | _],
Pieces = BasePieces ++ SuffixPieces
).
append_prefix_and_maybe_verbose(MaybeColor,
NeutralPrefixPieces, ColorPrefixPieces0, MainPieces, VerbosePieces,
Component) :-
PrefixPieces = NeutralPrefixPieces ++
maybe_color_pieces(MaybeColor, ColorPrefixPieces0),
(
VerbosePieces = [],
Component = always(PrefixPieces ++ MainPieces)
;
VerbosePieces = [_ | _],
Component = verbose_and_nonverbose(
PrefixPieces ++ VerbosePieces,
PrefixPieces ++ MainPieces)
).
%---------------------------------------------------------------------------%
extract_msg_maybe_context(Msg, MaybeContext) :-
(
Msg = no_ctxt_msg(_),
MaybeContext = no
;
( Msg = msg(Context, _)
; Msg = simple_msg(Context, _)
),
MaybeContext = yes(Context)
;
( Msg = error_msg(MaybeContext, _, _, _)
; Msg = blank_msg(MaybeContext)
)
).
extract_spec_phase(Spec, Phase) :-
(
Spec = error_spec(_, _, Phase, _)
;
Spec = spec(_, _, Phase, _, _)
;
Spec = no_ctxt_spec(_, _, Phase, _)
).
accumulate_contexts(Spec, !Contexts) :-
(
Spec = error_spec(_, _, _, Msgs),
list.foldl(accumulate_contexts_in_msg, Msgs, !Contexts)
;
Spec = spec(_, _, _, Context, _),
set.insert(Context, !Contexts)
;
Spec = no_ctxt_spec(_, _, _, _)
).
:- pred accumulate_contexts_in_msg(error_msg::in,
set(prog_context)::in, set(prog_context)::out) is det.
accumulate_contexts_in_msg(Msg, !Contexts) :-
extract_msg_maybe_context(Msg, MaybeContext),
(
MaybeContext = no
;
MaybeContext = yes(Context),
set.insert(Context, !Contexts)
).
%---------------------------------------------------------------------------%
extract_spec_msgs_and_id(Spec, Msgs, Id) :-
(
Spec = error_spec(Id, _Severity, _Phase, Msgs)
;
Spec = spec(Id, _Severity, _Phase, Context, Pieces),
Msgs = [msg(Context, Pieces)]
;
Spec = no_ctxt_spec(Id, _Severity, _Phase, Pieces),
Msgs = [no_ctxt_msg(Pieces)]
).
%---------------------------------------------------------------------------%
extract_spec_msgs_and_maybe_add_id(Globals, Spec, Msgs) :-
extract_spec_msgs_and_id(Spec, Msgs0, Id),
globals.get_options(Globals, OptionTable),
maybe_add_error_spec_id(OptionTable, Id, Msgs0, Msgs).
maybe_add_error_spec_id(OptionTable, Id, Msgs0, Msgs) :-
getopt.lookup_bool_option(OptionTable, print_error_spec_id, PrintId),
(
PrintId = no,
Msgs = Msgs0
;
PrintId = yes,
(
Msgs0 = [],
% Don't add a pred id message to an empty list of messages,
% since there is nothing to identify.
Msgs = Msgs0
;
Msgs0 = [HeadMsg | _],
extract_msg_maybe_context(HeadMsg, MaybeHeadContext),
IdMsg = error_msg(MaybeHeadContext, treat_based_on_posn, 0u,
[always([words("error_spec id:"), fixed(Id), nl])]),
Msgs = Msgs0 ++ [IdMsg]
)
).
maybe_add_error_spec_id_std(OptionTable, Id, StdMsgs0, StdMsgs) :-
getopt.lookup_bool_option(OptionTable, print_error_spec_id, PrintId),
(
PrintId = no,
StdMsgs = StdMsgs0
;
PrintId = yes,
(
StdMsgs0 = [],
% Don't add a pred id message to an empty list of messages,
% since there is nothing to identify.
StdMsgs = StdMsgs0
;
StdMsgs0 = [StdHeadMsg | _],
extract_msg_maybe_context(coerce(StdHeadMsg), MaybeHeadContext),
StdIdMsg = error_msg(MaybeHeadContext, treat_based_on_posn, 0u,
[always([words("error_spec id:"), fixed(Id), nl])]),
StdMsgs = StdMsgs0 ++ [StdIdMsg]
)
).
%---------------------------------------------------------------------------%
construct_diff_for_string_seqs(Params, StrsA, StrsB, Pieces) :-
find_shortest_edit_seq(Params, StrsA, StrsB, EditSeq),
find_diff_seq(StrsA, EditSeq, DiffSeq),
find_change_hunks(3u, DiffSeq, ChangeHunks),
list.map(change_hunk_to_pieces, ChangeHunks, PieceLists),
list.condense(PieceLists, Pieces).
% Convert the output of find_change_hunks from library/edit_seq.m
% to a diff we can include in error messages.
%
:- pred change_hunk_to_pieces(change_hunk(string)::in,
list(format_piece)::out) is det.
change_hunk_to_pieces(ChangeHunk, ChangeHunkPieces) :-
ChangeHunk = change_hunk(StartA, LenA, StartB, LenB, Diffs),
string.format("@@ -%u,%u +%u,%u @@",
[u(StartA), u(LenA), u(StartB), u(LenB)], HeaderStr),
HeaderPieces = [fixed(HeaderStr), nl],
list.map(diff_seq_line_to_pieces, Diffs, DiffPieceLists),
list.condense([HeaderPieces | DiffPieceLists], ChangeHunkPieces).
:- pred diff_seq_line_to_pieces(diff(string)::in, list(format_piece)::out)
is det.
diff_seq_line_to_pieces(Diff, Pieces) :-
(
Diff = unchanged(Str),
LinePieces = [fixed(" " ++ Str)]
;
Diff = deleted(Str),
LinePieces = color_as_correct([fixed("-" ++ Str)])
;
Diff = inserted(Str),
LinePieces = color_as_incorrect([fixed("+" ++ Str)])
),
Pieces = LinePieces ++ [nl].
%---------------------------------------------------------------------------%
maybe_construct_did_you_mean_pieces(BaseName, CandidateNames,
DidYouMeanPieces) :-
do_maybe_construct_did_you_mean_pieces(BaseName, CandidateNames,
std_util.id, DidYouMeanPieces).
maybe_construct_prefixed_did_you_mean_pieces(Prefix, BaseName, CandidateNames,
DidYouMeanPieces) :-
do_maybe_construct_did_you_mean_pieces(BaseName, CandidateNames,
add_prefix(Prefix), DidYouMeanPieces).
:- pred do_maybe_construct_did_you_mean_pieces(string::in, list(string)::in,
(func(string) = string)::in, list(format_piece)::out) is det.
do_maybe_construct_did_you_mean_pieces(BaseName, CandidateNames,
TransformFunc, DidYouMeanPieces) :-
% Note: name_is_close_enough below depends on all costs here
% except for case changes being 2u.
Params = edit_params(2u, 2u, case_sensitive_replacement_cost, 2u),
string.count_code_points(BaseName, BaseNameLen),
BaseNameLenU = uint.cast_from_int(BaseNameLen),
% The algorithm we use here to set MaxCost has two purposes.
%
% One is to speed up the process of finding close enough candidates,
% by allowing candidates with too-large edit distances to be rejected
% without having to finish the computation of those edit distances.
%
% The other is to require edits to replace at most half of any base name
% that exceeds one character. Note that the heuristic for "close enough"
% that name_is_close_enough uses, which is originally from gcc, does *not*
% impose that requirement.
( if BaseNameLenU < 2u then
% If BaseName consists of a single character, allow a suggestion
% to replace that character.
MaxCost = 2u
else
% If BaseName consists of two or more characters, allow suggestions
% to replace at most half of those characters (rounded up).
% 2u is the replacement cost.
MaxCost = ((BaseNameLenU + 1u) / 2u) * 2u
),
( if
CandidateNames = [_ | _],
find_best_close_enough_strings(Params, BaseName, CandidateNames,
MaxCost, BestCost, HeadBestName, TailBestNames),
BestNames = [HeadBestName | TailBestNames],
% Don't offer a string as a replacement for itself.
BestCost > 0u,
% Don't offer a string as a replacement if it is too far
% from the original, either.
list.filter(name_is_close_enough(BestCost, BaseName, BaseNameLenU),
BestNames, CloseEnoughBestNames),
CloseEnoughBestNames = [_ | _]
then
BaseNameChars = string.to_char_list(BaseName),
list.map(char.to_lower, BaseNameChars, BaseNameLowerChars),
is_any_suggestion_same_but_for_case(BaseNameLowerChars,
CloseEnoughBestNames, SameButForCase),
% For hand-written code, having more than ten names equally close
% to BaseName should be vanishingly rare, so the limit we impose here
% should not matter. But programs that generate Mercury code
% automatically may use naming schemes that make such occurrences
% much more likely, and for these, avoiding the generation of
% far-too-long error messages may be important.
list.split_upto(10, CloseEnoughBestNames,
SuggestedNames0, NonSuggestedNames),
(
NonSuggestedNames = [],
SuggestedNames = list.map(TransformFunc, SuggestedNames0)
;
NonSuggestedNames = [_ | _],
% This should cause the message we create below
% to end with "or `...'?".
SuggestedNames =
list.map(TransformFunc, SuggestedNames0) ++ ["..."]
),
SuggestedNamePieces = quote_list_to_pieces("or", SuggestedNames),
(
SameButForCase = all_have_non_case_difference,
DidYouMeanPieces0 =
[words("(Did you mean")] ++ SuggestedNamePieces ++
[suffix("?)"), nl]
;
SameButForCase = some_have_only_case_difference,
DidYouMeanPieces0 =
[words("(Did you mean")] ++ SuggestedNamePieces ++
[suffix("?"),
% Note that "lower-vs-upper" is probably just clutter
% for experts, but may be essential for others, especially
% non-native English speakers.
words("Note the lower-vs-upper case difference.)"), nl]
),
DidYouMeanPieces = color_as_hint(DidYouMeanPieces0)
else
DidYouMeanPieces = []
).
:- pred name_is_close_enough(uint::in, string::in, uint::in, string::in)
is semidet.
name_is_close_enough(Cost, Query, QueryLenU, Name) :-
% This heuristic for when a name is "close enough"
% is from spellcheck.cc in the gcc source code.
require_det (
string.count_code_points(Name, NameLen),
NameLenU = uint.cast_from_int(NameLen),
MinLenU = uint.min(QueryLenU, NameLenU),
MaxLenU = uint.max(QueryLenU, NameLenU),
% Accept a candidate as "close enough" if the number of changes
% is at most one third of the length of the longer of the two strings.
%
% If the lengths are close, then ...
( if MaxLenU - MinLenU =< 1u then
% ... round down, but allow at least one change.
MaxAcceptableLen = uint.max(MaxLenU / 3u, 1u)
else
% Otherwise, round up, thus giving a little extra leeway
% to some cases involving insertions/deletions.
MaxAcceptableLen = (MaxLenU + 2u) / 3u
),
% Note that in situations where the Name is much longer than BaseName,
% and therefore MaxLenU is much greater than MinLenU, the above formula
% generates values of MaxAcceptableLen that exceed BaseLenU, which thus
% allows suggestions that replace *every* item in Query. This may be
% a usability bug in the gcc heuristic.
% The 2u represents the cost of edits other than case transformations.
MaxAcceptableCost = 2u * MaxAcceptableLen,
trace [compile_time(flag("debug_close_enough")), io(!IO)] (
io.output_stream(Stream, !IO),
io.format(Stream, "%s vs %s: cost %u, max acceptable cost %u\n",
[s(Query), s(Name), u(Cost), u(MaxAcceptableCost)], !IO),
io.format(Stream, "%srecommended\n",
[s(if Cost =< MaxAcceptableCost then "" else "not ")], !IO)
)
),
Cost =< MaxAcceptableCost.
:- type same_but_for_case
---> all_have_non_case_difference
; some_have_only_case_difference.
:- pred is_any_suggestion_same_but_for_case(list(char)::in, list(string)::in,
same_but_for_case::out) is det.
is_any_suggestion_same_but_for_case(_, [], all_have_non_case_difference).
is_any_suggestion_same_but_for_case(BaseNameLowerChars, [Name | Names],
SameButForCase) :-
NameChars = string.to_char_list(Name),
list.map(char.to_lower, NameChars, NameLowerChars),
( if BaseNameLowerChars = NameLowerChars then
SameButForCase = some_have_only_case_difference
else
is_any_suggestion_same_but_for_case(BaseNameLowerChars, Names,
SameButForCase)
).
:- func case_sensitive_replacement_cost(char, char) = uint.
case_sensitive_replacement_cost(CharA, CharB) = ReplacementCost :-
char.to_lower(CharA, LowerCharA),
char.to_lower(CharB, LowerCharB),
( if LowerCharA = LowerCharB then
% CharA and CharB differ only in case.
ReplacementCost = 1u
else
ReplacementCost = 2u
).
%---------------------------------------------------------------------------%
color_as_subject(Pieces) =
color_pieces(color_subject, Pieces).
color_as_correct(Pieces) =
color_pieces(color_correct, Pieces).
color_as_incorrect(Pieces) =
color_pieces(color_incorrect, Pieces).
color_as_inconsistent(Pieces) =
color_pieces(color_inconsistent, Pieces).
color_as_hint(Pieces) =
color_pieces(color_hint, Pieces).
color_pieces(Color, Pieces0) = Pieces :-
list.take_while(is_nl_piece, Pieces0, HeadNlPieces, Pieces1),
list.reverse(Pieces1, RevPieces1),
list.take_while(is_nl_piece, RevPieces1, RevTailNlPieces1, RevMainPieces1),
list.reverse(RevTailNlPieces1, TailNlPieces),
list.reverse(RevMainPieces1, MainPieces),
(
MainPieces = [_ | _],
Pieces =
HeadNlPieces ++
[not_for_general_use_start_color(Color)] ++
MainPieces ++
[not_for_general_use_end_color(Color)] ++
TailNlPieces
;
MainPieces = [],
% There are no pieces to apply color to.
Pieces = HeadNlPieces ++ TailNlPieces
).
:- pred is_nl_piece(format_piece::in) is semidet.
is_nl_piece(Piece) :-
( Piece = nl
; Piece = nl_indent_delta(_)
).
maybe_color_pieces(MaybeColor, Pieces) = MaybeColorPieces :-
(
MaybeColor = no,
MaybeColorPieces = Pieces
;
MaybeColor = yes(Color),
MaybeColorPieces = color_pieces(Color, Pieces)
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
fixed_list_to_pieces(LastSep, Strings) = Pieces :-
ItemToPieces = (func(S) = [fixed(S)]),
transform_list_to_pieces(ItemToPieces, LastSep, Strings, Pieces).
quote_list_to_pieces(LastSep, Strings) = Pieces :-
ItemToPieces = (func(S) = [quote(S)]),
transform_list_to_pieces(ItemToPieces, LastSep, Strings, Pieces).
piece_list_to_pieces(LastSep, PieceList) = Pieces :-
ItemToPieces = (func(P) = [P]),
transform_list_to_pieces(ItemToPieces, LastSep, PieceList, Pieces).
pieces_list_to_pieces(LastSep, PiecesList) = Pieces :-
ItemToPieces = (func(Ps) = Ps),
transform_list_to_pieces(ItemToPieces, LastSep, PiecesList, Pieces).
%---------------------%
:- pred transform_list_to_pieces((func(T) = list(format_piece))::in,
string::in, list(T)::in, list(format_piece)::out) is det.
transform_list_to_pieces(ItemToPieces, LastSep, Items, Pieces) :-
MaybeColor = no,
NonLastSepPieces = [suffix(",")],
LastSepPieces = [words(LastSep)],
LastSuffix = [],
general_list_to_pieces(ItemToPieces, MaybeColor,
NonLastSepPieces, LastSepPieces, LastSuffix, Items, Pieces).
%---------------------------------------------------------------------------%
fixed_list_to_color_pieces(Color, LastSep, LastSuffix, Strings) = Pieces :-
ItemToPieces = (func(S) = [fixed(S)]),
transform_list_to_color_pieces(ItemToPieces, Color, LastSep, LastSuffix,
Strings, Pieces).
quote_list_to_color_pieces(Color, LastSep, LastSuffix, Strings) = Pieces :-
ItemToPieces = (func(S) = [quote(S)]),
transform_list_to_color_pieces(ItemToPieces, Color, LastSep, LastSuffix,
Strings, Pieces).
piece_list_to_color_pieces(Color, LastSep, LastSuffix, PieceList) = Pieces :-
ItemToPieces = (func(P) = [P]),
transform_list_to_color_pieces(ItemToPieces, Color, LastSep, LastSuffix,
PieceList, Pieces).
pieces_list_to_color_pieces(Color, LastSep, LastSuffix, PiecesList) = Pieces :-
ItemToPieces = (func(Ps) = Ps),
transform_list_to_color_pieces(ItemToPieces, Color, LastSep, LastSuffix,
PiecesList, Pieces).
%---------------------%
:- pred transform_list_to_color_pieces((func(T) = list(format_piece))::in,
color_name::in, string::in, list(format_piece)::in, list(T)::in,
list(format_piece)::out) is det.
transform_list_to_color_pieces(ItemToPieces, Color, LastSep, LastSuffix,
Items, Pieces) :-
NonLastSepPieces = [suffix(",")],
LastSepPieces = [words(LastSep)],
general_list_to_pieces(ItemToPieces, yes(Color),
NonLastSepPieces, LastSepPieces, LastSuffix, Items, Pieces).
%---------------------------------------------------------------------------%
fixed_strict_list_to_pieces(Strings) = Pieces :-
ItemToPieces = (func(S) = [fixed(S)]),
transform_strict_list_to_pieces(ItemToPieces, Strings, Pieces).
quote_strict_list_to_pieces(Strings) = Pieces :-
ItemToPieces = (func(S) = [quote(S)]),
transform_strict_list_to_pieces(ItemToPieces, Strings, Pieces).
piece_strict_list_to_pieces(PieceList) = Pieces :-
ItemToPieces = (func(P) = [P]),
transform_strict_list_to_pieces(ItemToPieces, PieceList, Pieces).
pieces_strict_list_to_pieces(PiecesList) = Pieces :-
ItemToPieces = (func(Ps) = Ps),
transform_strict_list_to_pieces(ItemToPieces, PiecesList, Pieces).
%---------------------%
:- pred transform_strict_list_to_pieces((func(T) = list(format_piece))::in,
list(T)::in, list(format_piece)::out) is det.
transform_strict_list_to_pieces(ItemToPieces, Items, Pieces) :-
MaybeColor = no,
SepPieces = [suffix(",")],
LastSuffix = [],
strict_general_list_to_pieces(ItemToPieces, MaybeColor,
SepPieces, LastSuffix, Items, Pieces).
%---------------------------------------------------------------------------%
fixed_strict_list_to_color_pieces(Color, LastSuffix, Strings) = Pieces :-
ItemToPieces = (func(S) = [fixed(S)]),
transform_strict_list_to_color_pieces(ItemToPieces, Color, LastSuffix,
Strings, Pieces).
quote_strict_list_to_color_pieces(Color, LastSuffix, Strings) = Pieces :-
ItemToPieces = (func(S) = [quote(S)]),
transform_strict_list_to_color_pieces(ItemToPieces, Color, LastSuffix,
Strings, Pieces).
piece_strict_list_to_color_pieces(Color, LastSuffix, PieceList) = Pieces :-
ItemToPieces = (func(P) = [P]),
transform_strict_list_to_color_pieces(ItemToPieces, Color, LastSuffix,
PieceList, Pieces).
pieces_strict_list_to_color_pieces(Color, LastSuffix, PiecesList) = Pieces :-
ItemToPieces = (func(Ps) = Ps),
transform_strict_list_to_color_pieces(ItemToPieces, Color, LastSuffix,
PiecesList, Pieces).
%---------------------%
:- pred transform_strict_list_to_color_pieces(
(func(T) = list(format_piece))::in,
color_name::in, list(format_piece)::in, list(T)::in,
list(format_piece)::out) is det.
transform_strict_list_to_color_pieces(ItemToPieces, Color, LastSuffix,
Items, Pieces) :-
SepPieces = [suffix(",")],
strict_general_list_to_pieces(ItemToPieces, yes(Color),
SepPieces, LastSuffix, Items, Pieces).
%---------------------------------------------------------------------------%
fixed_list_to_line_pieces(Strings) = Pieces :-
ItemToPieces = (func(S) = [fixed(S)]),
transform_list_to_line_pieces(ItemToPieces, Strings, Pieces).
quote_list_to_line_pieces(Strings) = Pieces :-
ItemToPieces = (func(S) = [quote(S)]),
transform_list_to_line_pieces(ItemToPieces, Strings, Pieces).
piece_list_to_line_pieces(PieceList) = Pieces :-
ItemToPieces = (func(P) = [P]),
transform_list_to_line_pieces(ItemToPieces, PieceList, Pieces).
pieces_list_to_line_pieces(PiecesList) = Pieces :-
ItemToPieces = (func(Ps) = Ps),
transform_list_to_line_pieces(ItemToPieces, PiecesList, Pieces).
%---------------------%
:- pred transform_list_to_line_pieces((func(T) = list(format_piece))::in,
list(T)::in, list(format_piece)::out) is det.
transform_list_to_line_pieces(ItemToPieces, Items, Pieces) :-
MaybeColor = no,
LastSuffix = [],
strict_general_list_to_line_pieces(ItemToPieces, MaybeColor, LastSuffix,
Items, Pieces).
%---------------------------------------------------------------------------%
fixed_list_to_color_line_pieces(Color, LastSuffix, Strings) = Pieces :-
ItemToPieces = (func(S) = [fixed(S)]),
transform_list_to_color_line_pieces(ItemToPieces, Color, LastSuffix,
Strings, Pieces).
quote_list_to_color_line_pieces(Color, LastSuffix, Strings) = Pieces :-
ItemToPieces = (func(S) = [quote(S)]),
transform_list_to_color_line_pieces(ItemToPieces, Color, LastSuffix,
Strings, Pieces).
piece_list_to_color_line_pieces(Color, LastSuffix, PieceList) = Pieces :-
ItemToPieces = (func(P) = [P]),
transform_list_to_color_line_pieces(ItemToPieces, Color, LastSuffix,
PieceList, Pieces).
pieces_list_to_color_line_pieces(Color, LastSuffix, PiecesList) = Pieces :-
ItemToPieces = (func(Ps) = Ps),
transform_list_to_color_line_pieces(ItemToPieces, Color, LastSuffix,
PiecesList, Pieces).
%---------------------%
:- pred transform_list_to_color_line_pieces((func(T) = list(format_piece))::in,
color_name::in, list(format_piece)::in, list(T)::in,
list(format_piece)::out) is det.
transform_list_to_color_line_pieces(ItemToPieces, Color, LastSuffix,
Items, Pieces) :-
strict_general_list_to_line_pieces(ItemToPieces, yes(Color),
LastSuffix, Items, Pieces).
%---------------------------------------------------------------------------%
pieces_list_to_split_color_line_pieces(MaybeColorA, MaybeColorB,
LastSuffixB, Pairs) = Pieces :-
ItemToPieces = (func({A, B}) = {A, B}),
strict_general_list_to_split_line_pieces(ItemToPieces,
MaybeColorA, MaybeColorB, LastSuffixB, Pairs, Pieces).
%---------------------------------------------------------------------------%
%
% General predicates for converting any list of items to the specification
% of a nicely formatted and possibly colored output. Used to implement
% the functions above.
%
:- pred general_list_to_pieces((func(T) = list(format_piece))::in,
maybe(color_name)::in, list(format_piece)::in, list(format_piece)::in,
list(format_piece)::in, list(T)::in, list(format_piece)::out) is det.
general_list_to_pieces(ItemToPieces, MaybeColor, NonLastSep, LastSep,
LastSuffix, Items, Pieces) :-
(
Items = [],
Pieces = []
;
Items = [Item1],
Pieces1 = ItemToPieces(Item1),
Pieces = maybe_color_pieces(MaybeColor, Pieces1 ++ LastSuffix)
;
Items = [Item1, Item2],
Pieces1 = ItemToPieces(Item1),
Pieces2 = ItemToPieces(Item2),
Pieces = maybe_color_pieces(MaybeColor, Pieces1) ++ LastSep ++
maybe_color_pieces(MaybeColor, Pieces2 ++ LastSuffix)
;
Items = [Item1, Item2, Item3 | Items4plus],
Pieces1 = ItemToPieces(Item1),
general_list_to_pieces(ItemToPieces, MaybeColor, NonLastSep, LastSep,
LastSuffix, [Item2, Item3 | Items4plus], TailPieces),
Pieces = maybe_color_pieces(MaybeColor, Pieces1 ++ NonLastSep) ++
TailPieces
).
:- pred strict_general_list_to_pieces((func(T) = list(format_piece))::in,
maybe(color_name)::in, list(format_piece)::in,
list(format_piece)::in, list(T)::in, list(format_piece)::out) is det.
strict_general_list_to_pieces(ItemToPieces, MaybeColor, Sep, LastSuffix,
Items, Pieces) :-
(
Items = [],
Pieces = []
;
Items = [Item1],
Pieces1 = ItemToPieces(Item1),
Pieces = maybe_color_pieces(MaybeColor, Pieces1 ++ LastSuffix)
;
Items = [Item1, Item2 | Items3plus],
Pieces1 = ItemToPieces(Item1),
strict_general_list_to_pieces(ItemToPieces, MaybeColor, Sep,
LastSuffix, [Item2 | Items3plus], TailPieces),
Pieces = maybe_color_pieces(MaybeColor, Pieces1 ++ Sep) ++ TailPieces
).
:- pred strict_general_list_to_line_pieces((func(T) = list(format_piece))::in,
maybe(color_name)::in, list(format_piece)::in,
list(T)::in, list(format_piece)::out) is det.
strict_general_list_to_line_pieces(ItemToPieces, MaybeColor, LastSuffix,
Items, Pieces) :-
(
Items = [],
Pieces = []
;
Items = [Item1],
Pieces1 = ItemToPieces(Item1),
Pieces = maybe_color_pieces(MaybeColor, Pieces1 ++ LastSuffix)
;
Items = [Item1, Item2 | Items3plus],
Pieces1 = ItemToPieces(Item1),
HeadPieces = maybe_color_pieces(MaybeColor, Pieces1 ++ [suffix(",")]),
strict_general_list_to_line_pieces(ItemToPieces, MaybeColor,
LastSuffix, [Item2 | Items3plus], TailPieces),
Pieces = HeadPieces ++ [nl] ++ TailPieces
).
:- pred strict_general_list_to_split_line_pieces(
(func(T) = {list(format_piece), list(format_piece)})::in,
maybe(color_name)::in, maybe(color_name)::in, list(format_piece)::in,
list(T)::in, list(format_piece)::out) is det.
strict_general_list_to_split_line_pieces(ItemToPieces,
MaybeColorA, MaybeColorB, LastSuffixB, Items, Pieces) :-
(
Items = [],
Pieces = []
;
Items = [Item1],
{Pieces1A, Pieces1B} = ItemToPieces(Item1),
HeadPiecesA = maybe_color_pieces(MaybeColorA, Pieces1A),
HeadPiecesB = maybe_color_pieces(MaybeColorB, Pieces1B ++
LastSuffixB),
Pieces = HeadPiecesA ++ HeadPiecesB
;
Items = [Item1, Item2 | Items3plus],
{Pieces1A, Pieces1B} = ItemToPieces(Item1),
CommaB = [suffix(",")],
HeadPiecesA = maybe_color_pieces(MaybeColorA, Pieces1A),
HeadPiecesB = maybe_color_pieces(MaybeColorB, Pieces1B ++ CommaB),
strict_general_list_to_split_line_pieces(ItemToPieces,
MaybeColorA, MaybeColorB, LastSuffixB, [Item2 | Items3plus],
TailPieces),
Pieces = HeadPiecesA ++ HeadPiecesB ++ [nl] ++ TailPieces
).
%---------------------------------------------------------------------------%
:- end_module parse_tree.error_spec.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink