mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
d8a31e574e
compiler/inst_lookup.m:
compiler/inst_mode_type_prop.m:
compiler/inst_test.m:
compiler/inst_util.m:
compiler/mode_util.m:
compiler/type_util.m:
Move these modules from the check_hlds package to the hlds package.
The reason is that all the content of five of these modules, and
most of the content of one module (inst_util.m) is not used
exclusively during semantic checking passes. (A later diff
should deal with the exception.) Some are used by the pass that
builds the initial HLDS, and all are used by middle-end and backend
passes. The move therefore reduces the number of inappropriate imports
of the check_hlds package.
compiler/check_hlds.m:
compiler/hlds.m:
Effect the transfer.
compiler/*.m:
Conform to the changes above.
1063 lines
45 KiB
Mathematica
1063 lines
45 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2015, 2024-2025 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.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% This module formats insts for use in error messages, with the objective
|
|
% of making the generated output easily readable by humans. This sometimes
|
|
% requires departing from strict Mercury syntax, so the output is NOT
|
|
% expected to parseable by machine.
|
|
%
|
|
% The module also formats modes, since this is needed for printing the insts
|
|
% of higher order types. This capability is not yet exported.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module hlds.error_msg_inst.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.error_spec.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module list.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type maybe_expand_named_insts
|
|
---> do_not_expand_named_insts
|
|
; expand_named_insts.
|
|
|
|
:- type user_or_developer
|
|
---> uod_user
|
|
; uod_developer(tvarset).
|
|
|
|
:- type short_inst
|
|
---> quote_short_inst
|
|
; fixed_short_inst.
|
|
|
|
% error_msg_inst(ModuleInfo, InstVarSet, ExpandNamedInsts, UserOrDeveloper,
|
|
% QuoteShortInst, ShortInstPrefix, ShortInstSuffix,
|
|
% LongInstPrefix, LongInstSuffix, Inst0) = Pieces:
|
|
%
|
|
% Format Inst0 for use in an error message, in a short form that fits at
|
|
% the end of the current line if possible, and in a long form that starts
|
|
% on a separate line, if it is not.
|
|
%
|
|
% When using the short form, put the inst's text representation into quotes
|
|
% if QuoteShortInst = quote_short_inst. Put ShortInstPrefix before it
|
|
% and add ShortInstSuffix after it. Normally, ShortInstSuffix will end
|
|
% with either nl or nl_indent_delta.
|
|
%
|
|
% When using the long form, leave the inst's text representation as is,
|
|
% without quotations, put LongInstPrefix before it, and LongInstSuffix
|
|
% after it. Normally, LongInstPrefix will start with nl or nl_indent_delta
|
|
% to start the inst on a new line, and LongInstSuffix will end with nl
|
|
% or nl_indent_delta as well. (The second nl_indent_delta will usually
|
|
% undo the effect of the first.)
|
|
%
|
|
:- func error_msg_inst(module_info, inst_varset, maybe_expand_named_insts,
|
|
user_or_developer, short_inst, list(format_piece), list(format_piece),
|
|
list(format_piece), list(format_piece), mer_inst) = list(format_piece).
|
|
|
|
% Do the same job as error_msg_inst, but for inst names.
|
|
%
|
|
:- func error_msg_inst_name(module_info, inst_varset, maybe_expand_named_insts,
|
|
user_or_developer, short_inst, list(format_piece), list(format_piece),
|
|
list(format_piece), list(format_piece), inst_name) = list(format_piece).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.hlds_inst_mode.
|
|
:- import_module hlds.inst_lookup.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.builtin_modules.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.error_type_util.
|
|
:- import_module parse_tree.parse_tree_out_cons_id.
|
|
:- import_module parse_tree.parse_tree_out_info.
|
|
:- import_module parse_tree.parse_tree_out_inst.
|
|
:- import_module parse_tree.parse_tree_out_misc.
|
|
:- import_module parse_tree.parse_tree_out_term.
|
|
:- import_module parse_tree.parse_tree_to_term.
|
|
:- import_module parse_tree.prog_mode.
|
|
:- import_module parse_tree.prog_util.
|
|
:- import_module parse_tree.write_error_spec.
|
|
|
|
:- import_module counter.
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type inst_msg_info
|
|
---> inst_msg_info(
|
|
imi_module_info :: module_info,
|
|
imi_inst_varset :: inst_varset,
|
|
imi_named_insts :: maybe_expand_named_insts,
|
|
imi_audience :: user_or_developer
|
|
).
|
|
|
|
:- type maybe_inline_pieces
|
|
---> multi_line_pieces
|
|
; inline_pieces.
|
|
|
|
:- inst multi_line_pieces for maybe_inline_pieces/0
|
|
---> multi_line_pieces.
|
|
:- inst inline_pieces for maybe_inline_pieces/0
|
|
---> inline_pieces.
|
|
|
|
% We record which inst names we have seen before. The main reason why
|
|
% we do this is to prevent infinite loops when expanding inst names
|
|
% whose definitions are recursive, but even in the absence of recursion,
|
|
% printing just the name of a named inst on its second and later
|
|
% occurrences can make the output smaller and easier to read.
|
|
%
|
|
:- type expansions_info
|
|
---> expansions_info(
|
|
% We put every inst name into this map if it can be recursive.
|
|
% The value associated with an inst name is what we should
|
|
% print on any later references to the inst name.
|
|
%
|
|
% XXX Internally generated inst names can be quite big.
|
|
% If comparisons on these inside map lookups ever become
|
|
% a problem, we could make the key not the inst_name,
|
|
% but its address.
|
|
ei_seen_inst_names :: map(inst_name,
|
|
list(format_piece)),
|
|
|
|
% Inst names generated internally by the compiler don't have
|
|
% intuitively understandable names we can print, so
|
|
% we give these inst names a number. We allocate these
|
|
% using this counter.
|
|
ei_inst_num_counter :: counter
|
|
).
|
|
|
|
error_msg_inst(ModuleInfo, InstVarSet, ExpandNamedInsts, UserOrDeveloper,
|
|
QuoteShortInst, ShortInstPrefix, ShortInstSuffix,
|
|
LongInstPrefix, LongInstSuffix, Inst) = Pieces :-
|
|
Info = inst_msg_info(ModuleInfo, InstVarSet, ExpandNamedInsts,
|
|
UserOrDeveloper),
|
|
% We used to call strip_module_names_from_inst to strip builtin
|
|
% module names from all parts of the inst we are asked to convert
|
|
% to Pieces. This worked well when we used the code in this module
|
|
% only for generating descriptions of insts for error messages.
|
|
% However, it became a problem when we
|
|
%
|
|
% - started using this code to describe insts in HLDS dumps, *and*
|
|
% - we modified inst_lookup.m to report inst names that were effectively
|
|
% *dangling references*, i.e. references to an entries in the inst tables
|
|
% that weren't actually there.
|
|
%
|
|
% The sequence of events that led to the problem was as follows.
|
|
%
|
|
% - Mode analysis creates an entry in the ground inst table. Both the key
|
|
% and the value of this entry contains the same higher order inst, and
|
|
% the modes of the arguments of the pred_inst_info have the form
|
|
%
|
|
% user_defined_mode(qualified(unqualified("builtin"), "in"), [])
|
|
%
|
|
% - When printing the value in the ground table entry in a HLDS dump,
|
|
% the call to strip_module_names_from_inst replaces all the argument
|
|
% modes in that pred_inst_info with modes of the form
|
|
%
|
|
% user_defined_mode(unqualified("in"), [])
|
|
%
|
|
% - Execution continues to the call to inst_to_pieces below, which calls
|
|
% inst_name_to_pieces, which calls inst_lookup_debug. The difference
|
|
% in module qualification then causes the search of the ground inst
|
|
% table there to fail, which in turn causes inst_lookup_debug to return
|
|
% an inst constructed by make_missing_inst_name, which will then contain
|
|
% "MISSING_INST" in its name.
|
|
%
|
|
% - The occurence of this string in the HLDS dump is *supposed* to mean
|
|
% that the process of *constructing* the inst has a bug, but in this case
|
|
% it is the process of *printing* the inst that has a bug. This can be
|
|
% quite misleading.
|
|
%
|
|
% It was misleading enough to cause me, zs, to add a significant amount
|
|
% of code to help me track down what I thought was a problem in inst
|
|
% construction, only to find that the problem was in code I previously
|
|
% added to help find another bug :-) I don't want this to happen again
|
|
% in the future, so from now on.
|
|
%
|
|
% The general approach of the fix is two-fold.
|
|
%
|
|
% - First, when we generate Pieces for users, we want to strip any
|
|
% module qualifiers for builtin modules from insts only *after*
|
|
% we have called inst_lookup_debug on those insts. This should prevent
|
|
% the problem above.
|
|
%
|
|
% - Second, for insts and inst names that contain other insts or inst
|
|
% names, we want to strip away module qualifiers for builtin modules
|
|
% only from the parts of the inst or inst name that are *outside*
|
|
% the contained insts or inst names. We want to leave the contained
|
|
% insts and inst names intact, because if we didn't, the original
|
|
% problem could still occur, just for the contained insts/inst names.
|
|
% Any builtin module qualifiers in those contained insts/inst names
|
|
% would still get stripped away later, when we get to process *them*.
|
|
Expansions0 = expansions_info(map.init, counter.init(1)),
|
|
InlineSuffixPieces = [],
|
|
inst_to_pieces(Info, inline_pieces, Inst, InlineSuffixPieces,
|
|
InlinePieces, Expansions0, _InlineExpansions),
|
|
InlineStr = error_pieces_to_one_line_string(InlinePieces),
|
|
% We could base the decision on whether to put the inst inline
|
|
% on criteria other than its length, such as
|
|
%
|
|
% - on a count of the parentheses in it (which would effectively be
|
|
% a test of the inst's depth);
|
|
% - on a count of the commas in it (which would effectively be a test
|
|
% of the number of arguments in the inst); or
|
|
% - on a composite test, such as "the number of left parentheses
|
|
% plus the number of commas cannot exceed six".
|
|
%
|
|
% The current test is just a guess; experience will give us feedback.
|
|
( if
|
|
string.length(InlineStr, Len),
|
|
Len < 40
|
|
then
|
|
(
|
|
QuoteShortInst = quote_short_inst,
|
|
% An inst that is shown on the same line as English text needs
|
|
% something to visually separate it from the English text.
|
|
% The quotes provide that separation.
|
|
%
|
|
% Without a small length limit, we would use words_quote
|
|
% instead of quote to wrap InlineStr.
|
|
InlinePiece = quote(InlineStr)
|
|
;
|
|
QuoteShortInst = fixed_short_inst,
|
|
% Our caller has told us that it ensured this separation already.
|
|
InlinePiece = fixed(InlineStr)
|
|
),
|
|
Pieces = ShortInstPrefix ++ [InlinePiece | ShortInstSuffix]
|
|
else
|
|
% Showing the inst on a separate line from the English text
|
|
% provides enough separation by itself.
|
|
inst_to_pieces(Info, multi_line_pieces, Inst, LongInstSuffix,
|
|
MultiLinePieces, Expansions0, _MultiLineExpansions),
|
|
Pieces = LongInstPrefix ++ MultiLinePieces
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
error_msg_inst_name(ModuleInfo, InstVarSet, ExpandNamedInsts, UserOrDeveloper,
|
|
QuoteShortInst, ShortInstPrefix, ShortInstSuffix,
|
|
LongInstPrefix, LongInstSuffix, InstName) = Pieces :-
|
|
Info = inst_msg_info(ModuleInfo, InstVarSet, ExpandNamedInsts,
|
|
UserOrDeveloper),
|
|
Expansions0 = expansions_info(map.init, counter.init(1)),
|
|
InlineSuffixPieces = [],
|
|
inst_name_to_pieces(Info, inline_pieces, InstName, InlineSuffixPieces,
|
|
InlinePieces, Expansions0, _InlineExpansions),
|
|
InlineStr = error_pieces_to_one_line_string(InlinePieces),
|
|
% We could base the decision on whether to put the inst inline
|
|
% on criteria other than its length, such as
|
|
%
|
|
% - on a count of the parentheses in it (which would effectively be
|
|
% a test of the inst's depth);
|
|
% - on a count of the commas in it (which would effectively be a test
|
|
% of the number of arguments in the inst); or
|
|
% - on a composite test, such as "the number of left parentheses
|
|
% plus the number of commas cannot exceed six".
|
|
%
|
|
% The current test is just a guess; experience will give us feedback.
|
|
( if
|
|
string.length(InlineStr, Len),
|
|
Len < 40
|
|
then
|
|
(
|
|
QuoteShortInst = quote_short_inst,
|
|
% An inst that is shown on the same line as English text needs
|
|
% something to visually separate it from the English text.
|
|
% The quotes provide that separation.
|
|
%
|
|
% Without a small length limit, we would use words_quote
|
|
% instead of quote to wrap InlineStr.
|
|
InlinePiece = quote(InlineStr)
|
|
;
|
|
% Our caller has told us that it ensured this separation already.
|
|
QuoteShortInst = fixed_short_inst,
|
|
InlinePiece = fixed(InlineStr)
|
|
),
|
|
Pieces = ShortInstPrefix ++ [InlinePiece | ShortInstSuffix]
|
|
else
|
|
% Showing the inst on a separate line from the English text
|
|
% provides enough separation by itself.
|
|
inst_name_to_pieces(Info, multi_line_pieces, InstName, LongInstSuffix,
|
|
MultiLinePieces, Expansions0, _MultiLineExpansions),
|
|
Pieces = LongInstPrefix ++ MultiLinePieces
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% The following predicates are sort-of duplicated. The predicates whose names
|
|
% end in "to_pieces" generate output that put different parts of the inst
|
|
% on (mostly) separate lines, showing the structure of the inst through
|
|
% indentation. The predicates whose names end in "to_inline_pieces" generate
|
|
% output that contains the same components, but all on one line.
|
|
%
|
|
|
|
:- pred inst_to_pieces(inst_msg_info, maybe_inline_pieces, mer_inst,
|
|
list(format_piece), list(format_piece), expansions_info, expansions_info).
|
|
:- mode inst_to_pieces(in, in(multi_line_pieces),
|
|
in, in, out, in, out) is det.
|
|
:- mode inst_to_pieces(in, in(inline_pieces),
|
|
in, in, out, in, out) is det.
|
|
|
|
inst_to_pieces(Info, MaybeInline, Inst, Suffix, Pieces, !Expansions) :-
|
|
(
|
|
Inst = free,
|
|
Pieces = [fixed("free") | Suffix]
|
|
;
|
|
Inst = bound(Uniq, _, BoundFunctors),
|
|
BoundName = mercury_uniqueness_to_string(Uniq, "bound"),
|
|
(
|
|
BoundFunctors = [],
|
|
Pieces = [fixed(BoundName) | Suffix]
|
|
;
|
|
BoundFunctors = [HeadBoundFunctor | TailBoundFunctors],
|
|
bound_functors_to_pieces(Info, MaybeInline,
|
|
HeadBoundFunctor, TailBoundFunctors, [], BoundPieces,
|
|
!Expansions),
|
|
(
|
|
MaybeInline = multi_line_pieces,
|
|
Pieces = [fixed(BoundName ++ "("), nl_indent_delta(1) |
|
|
BoundPieces] ++ [nl_indent_delta(-1), fixed(")") | Suffix]
|
|
;
|
|
MaybeInline = inline_pieces,
|
|
Pieces = [prefix(BoundName ++ "(") | BoundPieces] ++
|
|
[suffix(")") | Suffix]
|
|
)
|
|
)
|
|
;
|
|
Inst = ground(Uniq, HOInstInfo),
|
|
(
|
|
HOInstInfo = higher_order(PredInstInfo),
|
|
pred_inst_info_to_pieces(Info, MaybeInline, "", Uniq,
|
|
PredInstInfo, HOPieces, !Expansions),
|
|
Pieces = HOPieces ++ Suffix
|
|
;
|
|
HOInstInfo = none_or_default_func,
|
|
Str = mercury_uniqueness_to_string(Uniq, "ground"),
|
|
Pieces = [fixed(Str) | Suffix]
|
|
)
|
|
;
|
|
Inst = any(Uniq, HOInstInfo),
|
|
(
|
|
HOInstInfo = higher_order(PredInstInfo),
|
|
pred_inst_info_to_pieces(Info, MaybeInline, "any_", Uniq,
|
|
PredInstInfo, HOPieces, !Expansions),
|
|
Pieces = HOPieces ++ Suffix
|
|
;
|
|
HOInstInfo = none_or_default_func,
|
|
Str = mercury_any_uniqueness_to_string(Uniq),
|
|
Pieces = [fixed(Str) | Suffix]
|
|
)
|
|
;
|
|
Inst = inst_var(Var),
|
|
InstVarSet = Info ^ imi_inst_varset,
|
|
Name = mercury_var_to_string_vs(InstVarSet, print_name_only, Var),
|
|
Pieces = [fixed(Name) | Suffix]
|
|
;
|
|
Inst = constrained_inst_vars(Vars, SubInst),
|
|
InstVarSet = Info ^ imi_inst_varset,
|
|
Names = mercury_vars_to_string_vs(InstVarSet, print_name_only,
|
|
set.to_sorted_list(Vars)),
|
|
inst_to_pieces(Info, MaybeInline, SubInst, [], SubInstPieces,
|
|
!Expansions),
|
|
Pieces = [fixed("("), words(Names), fixed("=<") | SubInstPieces] ++
|
|
[fixed(")") | Suffix]
|
|
;
|
|
Inst = defined_inst(InstName),
|
|
inst_name_to_pieces(Info, MaybeInline, InstName, Suffix, Pieces,
|
|
!Expansions)
|
|
;
|
|
Inst = not_reached,
|
|
Pieces = [fixed("not_reached") | Suffix]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred insts_to_pieces(inst_msg_info, maybe_inline_pieces,
|
|
mer_inst, list(mer_inst), list(format_piece), list(format_piece),
|
|
expansions_info, expansions_info).
|
|
:- mode insts_to_pieces(in, in(multi_line_pieces),
|
|
in, in, in, out, in, out) is det.
|
|
:- mode insts_to_pieces(in, in(inline_pieces),
|
|
in, in, in, out, in, out) is det.
|
|
|
|
insts_to_pieces(Info, MaybeInline, HeadInst, TailInsts, Suffix, Pieces,
|
|
!Expansions) :-
|
|
(
|
|
TailInsts = [],
|
|
HeadSuffix = Suffix,
|
|
inst_to_pieces(Info, MaybeInline, HeadInst, HeadSuffix,
|
|
Pieces, !Expansions)
|
|
;
|
|
TailInsts = [HeadTailInst | TailTailInsts],
|
|
(
|
|
MaybeInline = multi_line_pieces,
|
|
HeadSuffix = [suffix(","), nl]
|
|
;
|
|
MaybeInline = inline_pieces,
|
|
HeadSuffix = [suffix(",")]
|
|
),
|
|
inst_to_pieces(Info, MaybeInline, HeadInst, HeadSuffix,
|
|
HeadPieces, !Expansions),
|
|
insts_to_pieces(Info, MaybeInline, HeadTailInst, TailTailInsts, Suffix,
|
|
TailPieces, !Expansions),
|
|
Pieces = HeadPieces ++ TailPieces
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred bound_functors_to_pieces(inst_msg_info, maybe_inline_pieces,
|
|
bound_functor, list(bound_functor), list(format_piece), list(format_piece),
|
|
expansions_info, expansions_info).
|
|
:- mode bound_functors_to_pieces(in, in(multi_line_pieces),
|
|
in, in, in, out, in, out) is det.
|
|
:- mode bound_functors_to_pieces(in, in(inline_pieces),
|
|
in, in, in, out, in, out) is det.
|
|
|
|
bound_functors_to_pieces(Info, MaybeInline,
|
|
HeadBoundFunctor, TailBoundFunctors, Suffix, Pieces, !Expansions) :-
|
|
(
|
|
TailBoundFunctors = [],
|
|
HeadSuffix = Suffix
|
|
;
|
|
TailBoundFunctors = [HeadTailBoundFunctor | TailTailBoundFunctors],
|
|
bound_functors_to_pieces(Info, MaybeInline,
|
|
HeadTailBoundFunctor, TailTailBoundFunctors, Suffix, TailPieces,
|
|
!Expansions),
|
|
(
|
|
MaybeInline = multi_line_pieces,
|
|
HeadSuffix = [nl_indent_delta(-1), fixed(";"), nl_indent_delta(1) |
|
|
TailPieces]
|
|
;
|
|
MaybeInline = inline_pieces,
|
|
HeadSuffix = [fixed(";") | TailPieces]
|
|
)
|
|
),
|
|
HeadBoundFunctor = bound_functor(ConsId0, ArgInsts),
|
|
( if
|
|
ConsId0 = du_data_ctor(du_ctor(SymName, Arity, TypeCtor)),
|
|
% The module names of the cons_ids are uniquely specified
|
|
% by the types of the variables whose we are printing. Printing them
|
|
% would therefore generate more clutter than enlightenment.
|
|
% XXX This is true *most* of the time, but it is not true *all*
|
|
% of the time. For tests/invalid/qualified_cons_id2.m, it yields
|
|
% a confusing error message, at least as of 2024 apr 30.
|
|
SymName = qualified(_ModuleName, BaseName)
|
|
then
|
|
ConsId = du_data_ctor(du_ctor(unqualified(BaseName), Arity, TypeCtor))
|
|
else
|
|
ConsId = ConsId0
|
|
),
|
|
ConsIdStr = mercury_cons_id_to_string(output_mercury,
|
|
does_not_need_brackets, ConsId),
|
|
name_and_arg_insts_to_pieces(Info, MaybeInline, ConsIdStr, ArgInsts,
|
|
HeadSuffix, Pieces, !Expansions).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred inst_name_to_pieces(inst_msg_info, maybe_inline_pieces, inst_name,
|
|
list(format_piece), list(format_piece), expansions_info, expansions_info).
|
|
:- mode inst_name_to_pieces(in, in(multi_line_pieces),
|
|
in, in, out, in, out) is det.
|
|
:- mode inst_name_to_pieces(in, in(inline_pieces),
|
|
in, in, out, in, out) is det.
|
|
|
|
inst_name_to_pieces(Info, MaybeInline, InstName, Suffix, Pieces,
|
|
!Expansions) :-
|
|
( if have_we_expanded_inst_name(!.Expansions, InstName, PastPieces) then
|
|
Pieces = PastPieces ++ Suffix
|
|
else
|
|
(
|
|
InstName = user_inst(SymName, ArgInsts),
|
|
sym_name_to_min_qual_string(Info, SymName, SymNameStr),
|
|
% XXX If ArgInsts contains named user insts, expanding them
|
|
% inside the name of another inst is far from ideal. However,
|
|
% leaving them to be expanded in the call to inst_to_pieces
|
|
% on EqvInst below also has a problem. This is that we construct
|
|
% lists of insts, such as the (expansion of ArgInsts in EqvInst)
|
|
% in a back-to-front order, which means that if a named inst
|
|
% occurs in EqvInst more than once, it will be the *last*
|
|
% occurrence, not the first, which will be expanded.
|
|
NameInfo = Info ^ imi_named_insts := do_not_expand_named_insts,
|
|
ModuleInfo = Info ^ imi_module_info,
|
|
module_info_get_inst_table(ModuleInfo, InstTable),
|
|
inst_table_get_user_insts(InstTable, UserInstTable),
|
|
list.length(ArgInsts, Arity),
|
|
InstCtor = inst_ctor(SymName, Arity),
|
|
( if
|
|
is_unknown_or_missing_user_inst_name(InstName)
|
|
then
|
|
name_and_arg_insts_to_pieces(NameInfo, MaybeInline,
|
|
SymNameStr, ArgInsts, Suffix, Pieces, !.Expansions, _)
|
|
else if
|
|
map.search(UserInstTable, InstCtor, InstDefn)
|
|
then
|
|
name_and_arg_insts_to_pieces(NameInfo, MaybeInline,
|
|
SymNameStr, ArgInsts, [], NamePieces, !.Expansions, _),
|
|
NamedNamePieces = [words("named inst") | NamePieces],
|
|
ExpandInsts = Info ^ imi_named_insts,
|
|
(
|
|
ExpandInsts = do_not_expand_named_insts,
|
|
Pieces = NamePieces ++ Suffix
|
|
;
|
|
ExpandInsts = expand_named_insts,
|
|
record_user_inst_name(InstName, NamedNamePieces,
|
|
!Expansions),
|
|
InstDefn = hlds_inst_defn(_VarSet, Params, InstBody, _MMTC,
|
|
_Context, _Status),
|
|
InstBody = eqv_inst(EqvInst0),
|
|
inst_substitute_arg_list(Params, ArgInsts,
|
|
EqvInst0, EqvInst),
|
|
( if EqvInst = defined_inst(InstName) then
|
|
% XXX Would NamePieces look better in the output?
|
|
Pieces = NamedNamePieces ++ Suffix
|
|
else
|
|
inst_to_pieces(Info, MaybeInline, EqvInst,
|
|
Suffix, EqvPieces, !Expansions),
|
|
(
|
|
MaybeInline = multi_line_pieces,
|
|
Pieces = NamedNamePieces ++
|
|
[nl, words("which expands to"),
|
|
nl_indent_delta(1) | EqvPieces] ++
|
|
[nl_indent_delta(-1)]
|
|
;
|
|
MaybeInline = inline_pieces,
|
|
Pieces = NamedNamePieces ++
|
|
[words("which expands to"),
|
|
prefix("<") | EqvPieces] ++ [suffix(">")]
|
|
)
|
|
)
|
|
)
|
|
else if
|
|
SymName = unqualified(BaseName),
|
|
Builtin = mercury_public_builtin_module,
|
|
BuiltinInstCtor =
|
|
inst_ctor(qualified(Builtin, BaseName), Arity),
|
|
map.search(UserInstTable, BuiltinInstCtor, _InstDefn)
|
|
then
|
|
% check_mutable_insts in add_mutable_aux_pred.m removes
|
|
% any module qualifications by mercury_public_builtin_module
|
|
% from the inst name, to signal us that the qualification
|
|
% should not be printed in the error message.
|
|
name_and_arg_insts_to_pieces(NameInfo, MaybeInline,
|
|
SymNameStr, ArgInsts, [], NamePieces, !.Expansions, _),
|
|
Pieces = NamePieces ++ Suffix
|
|
else
|
|
( if
|
|
SymName = qualified(unqualified("FAKE_CONS_ID"),
|
|
ConsIdName)
|
|
then
|
|
% mode_error_unify_var_functor_to_spec created InstName,
|
|
% asking us to treat it just as a wrapper around ArgInsts.
|
|
name_and_arg_insts_to_pieces(NameInfo, MaybeInline,
|
|
ConsIdName, ArgInsts, [], NamePieces, !.Expansions, _),
|
|
Pieces = NamePieces ++ Suffix
|
|
else
|
|
InstCtorName = sym_name_to_string(SymName),
|
|
string.format("undefined inst %s/%d",
|
|
[s(InstCtorName), i(Arity)], Msg),
|
|
unexpected($pred, Msg)
|
|
)
|
|
)
|
|
;
|
|
InstName = typed_inst(Type, SubInstName),
|
|
Audience = Info ^ imi_audience,
|
|
(
|
|
Audience = uod_user,
|
|
% The user doesn't care about the typed_inst wrapper,
|
|
% and the wrapper cannot make an inst recursive.
|
|
inst_name_to_pieces(Info, MaybeInline, SubInstName, Suffix,
|
|
Pieces, !Expansions)
|
|
;
|
|
Audience = uod_developer(TVarSet),
|
|
InstVarSet = Info ^ imi_inst_varset,
|
|
TypePieces = type_to_pieces(TVarSet, InstVarSet,
|
|
print_name_and_num, do_not_add_quotes, [], Type),
|
|
inst_name_to_pieces(Info, MaybeInline, SubInstName, [],
|
|
SubInstNamePieces, !Expansions),
|
|
(
|
|
MaybeInline = multi_line_pieces,
|
|
Pieces = [fixed("typed_inst("), nl_indent_delta(1)] ++
|
|
TypePieces ++ [suffix(","), nl] ++
|
|
SubInstNamePieces ++
|
|
[nl_indent_delta(-1), fixed(")") | Suffix]
|
|
;
|
|
MaybeInline = inline_pieces,
|
|
Pieces = [fixed("typed_inst(")] ++
|
|
TypePieces ++ [suffix(",")] ++
|
|
SubInstNamePieces ++ [suffix(")") | Suffix]
|
|
)
|
|
)
|
|
;
|
|
InstName = typed_ground(Uniq, Type),
|
|
Audience = Info ^ imi_audience,
|
|
(
|
|
Audience = uod_user,
|
|
% The user doesn't care about the typed_inst wrapper,
|
|
% and the wrapper cannot make an inst recursive.
|
|
EqvInst = ground(Uniq, none_or_default_func),
|
|
inst_to_pieces(Info, MaybeInline, EqvInst, Suffix,
|
|
Pieces, !Expansions)
|
|
;
|
|
Audience = uod_developer(TVarSet),
|
|
InstVarSet = Info ^ imi_inst_varset,
|
|
TypePieces = type_to_pieces(TVarSet, InstVarSet,
|
|
print_name_and_num, do_not_add_quotes, [], Type),
|
|
UniqStr = inst_uniqueness(Uniq, "shared"),
|
|
(
|
|
MaybeInline = multi_line_pieces,
|
|
Pieces = [fixed("typed_ground(" ++ UniqStr ++ ",")] ++
|
|
[nl_indent_delta(1)] ++ TypePieces ++
|
|
[nl_indent_delta(-1), fixed(")") | Suffix]
|
|
;
|
|
MaybeInline = inline_pieces,
|
|
Pieces = [fixed("typed_ground(" ++ UniqStr ++ ",")] ++
|
|
TypePieces ++ [suffix(")") | Suffix]
|
|
)
|
|
)
|
|
;
|
|
( InstName = unify_inst(_, _, _, _)
|
|
; InstName = merge_inst(_, _)
|
|
; InstName = ground_inst(_, _, _, _)
|
|
; InstName = any_inst(_, _, _, _)
|
|
; InstName = shared_inst(_)
|
|
; InstName = mostly_uniq_inst(_)
|
|
),
|
|
ModuleInfo = Info ^ imi_module_info,
|
|
% We need to lookup InstName0, NOT InstName. The reason
|
|
% is explained in the big comment in error_msg_inst.
|
|
inst_lookup_debug(ModuleInfo, InstName, EqvInst),
|
|
( if
|
|
EqvInst = defined_inst(EqvInstName),
|
|
EqvInstName = user_inst(EqvSymName, EqvArgInsts),
|
|
is_unknown_or_missing_user_inst_name(EqvInstName)
|
|
then
|
|
NameInfo = Info ^ imi_named_insts := do_not_expand_named_insts,
|
|
sym_name_to_min_qual_string(Info, EqvSymName, EqvSymNameStr),
|
|
name_and_arg_insts_to_pieces(NameInfo, MaybeInline,
|
|
EqvSymNameStr, EqvArgInsts, Suffix, Pieces,
|
|
!.Expansions, _)
|
|
else
|
|
Audience = Info ^ imi_audience,
|
|
compiler_key_inst_name_to_dollar_string(InstName, InstNameStr),
|
|
(
|
|
Audience = uod_user,
|
|
( if EqvInst = defined_inst(InstName) then
|
|
Pieces = [fixed(InstNameStr) | Suffix]
|
|
else
|
|
record_internal_inst_name(InstName, InstNameStr,
|
|
InstNumPieces, !Expansions),
|
|
inst_to_pieces(Info, MaybeInline, EqvInst, Suffix,
|
|
EqvPieces, !Expansions),
|
|
(
|
|
MaybeInline = multi_line_pieces,
|
|
Pieces = InstNumPieces ++
|
|
[nl, words("which expands to"),
|
|
nl_indent_delta(1) | EqvPieces] ++
|
|
[nl_indent_delta(-1) | Suffix]
|
|
;
|
|
MaybeInline = inline_pieces,
|
|
Pieces = InstNumPieces ++
|
|
[words("which expands to"),
|
|
prefix("<") | EqvPieces] ++ [suffix(">") | Suffix]
|
|
)
|
|
)
|
|
;
|
|
Audience = uod_developer(_TVarSet),
|
|
(
|
|
(
|
|
InstName = unify_inst(Live, Real,
|
|
SubInstA, SubInstB),
|
|
UnifyOrMerge = "unify",
|
|
InitialArgs =
|
|
[suffix(is_live_to_str(Live) ++ ","),
|
|
fixed(unify_is_real_to_str(Real) ++ ",")]
|
|
;
|
|
InstName = merge_inst(SubInstA, SubInstB),
|
|
UnifyOrMerge = "merge",
|
|
InitialArgs = []
|
|
),
|
|
SubSuffixA = [],
|
|
SubSuffixB = [],
|
|
inst_to_pieces(Info, MaybeInline, SubInstA, SubSuffixA,
|
|
SubInstPiecesA, !Expansions),
|
|
inst_to_pieces(Info, MaybeInline, SubInstB, SubSuffixB,
|
|
SubInstPiecesB, !Expansions),
|
|
InstNamePieces = [fixed(UnifyOrMerge ++ "(")] ++
|
|
InitialArgs ++ [nl_indent_delta(1)] ++
|
|
SubInstPiecesA ++ [suffix(","), nl] ++
|
|
SubInstPiecesB ++ [nl_indent_delta(-1), fixed(")")]
|
|
;
|
|
(
|
|
InstName = ground_inst(SubInstName, Uniq,
|
|
Live, Real),
|
|
GroundOrAny = "ground",
|
|
UniqStr = inst_uniqueness(Uniq, "shared")
|
|
;
|
|
InstName = any_inst(SubInstName, Uniq, Live, Real),
|
|
GroundOrAny = "any",
|
|
UniqStr = any_inst_uniqueness(Uniq)
|
|
),
|
|
SubSuffix = [],
|
|
inst_name_to_pieces(Info, MaybeInline, SubInstName,
|
|
SubSuffix, SubInstNamePieces, !Expansions),
|
|
InstNamePieces =
|
|
[fixed(GroundOrAny ++ "(" ++ UniqStr ++ ","),
|
|
fixed(is_live_to_str(Live) ++ ","),
|
|
fixed(unify_is_real_to_str(Real) ++ ","),
|
|
nl_indent_delta(1)] ++ SubInstNamePieces ++
|
|
[nl_indent_delta(-1), fixed(")")]
|
|
;
|
|
(
|
|
InstName = shared_inst(SubInstName),
|
|
SorMU = "shared"
|
|
;
|
|
InstName = mostly_uniq_inst(SubInstName),
|
|
SorMU = "mostly_uniq"
|
|
),
|
|
SubSuffix = [],
|
|
inst_name_to_pieces(Info, MaybeInline, SubInstName,
|
|
SubSuffix, SubInstNamePieces, !Expansions),
|
|
InstNamePieces = [fixed(SorMU ++ "("),
|
|
nl_indent_delta(1)] ++ SubInstNamePieces ++
|
|
[nl_indent_delta(-1), fixed(")")]
|
|
),
|
|
Pieces = InstNamePieces
|
|
)
|
|
)
|
|
)
|
|
).
|
|
|
|
:- inst compiler_key_inst_name for inst_name/0
|
|
---> unify_inst(ground, ground, ground, ground)
|
|
; merge_inst(ground, ground)
|
|
; ground_inst(ground, ground, ground, ground)
|
|
; any_inst(ground, ground, ground, ground)
|
|
; shared_inst(ground)
|
|
; mostly_uniq_inst(ground).
|
|
|
|
:- pred compiler_key_inst_name_to_dollar_string(
|
|
inst_name::in(compiler_key_inst_name), string::out) is det.
|
|
|
|
compiler_key_inst_name_to_dollar_string(InstName, InstNameStr) :-
|
|
(
|
|
InstName = unify_inst(_, _, _, _),
|
|
InstNameStr = "$unify_inst"
|
|
;
|
|
InstName = merge_inst(_, _),
|
|
InstNameStr = "$merge_inst"
|
|
;
|
|
InstName = ground_inst(_, _, _, _),
|
|
InstNameStr = "$ground_inst"
|
|
;
|
|
InstName = any_inst(_, _, _, _),
|
|
InstNameStr = "$any_inst"
|
|
;
|
|
InstName = shared_inst(_),
|
|
InstNameStr = "$shared_inst"
|
|
;
|
|
InstName = mostly_uniq_inst(_),
|
|
InstNameStr = "$mostly_uniq_inst"
|
|
).
|
|
|
|
:- pred sym_name_to_min_qual_string(inst_msg_info::in,
|
|
sym_name::in, string::out) is det.
|
|
|
|
sym_name_to_min_qual_string(Info, SymName, SymNameStr) :-
|
|
(
|
|
SymName = qualified(ModuleName, BaseName),
|
|
ModuleInfo = Info ^ imi_module_info,
|
|
module_info_get_name(ModuleInfo, CurModuleName),
|
|
( if
|
|
( ModuleName = CurModuleName
|
|
; ModuleName = mercury_public_builtin_module
|
|
)
|
|
then
|
|
SymNameStr = BaseName
|
|
else
|
|
SymNameStr = sym_name_to_string(SymName)
|
|
)
|
|
;
|
|
SymName = unqualified(BaseName),
|
|
SymNameStr = BaseName
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred have_we_expanded_inst_name(expansions_info::in, inst_name::in,
|
|
list(format_piece)::out) is semidet.
|
|
|
|
have_we_expanded_inst_name(Expansions, InstName, PastPieces) :-
|
|
Expansions = expansions_info(ExpansionsMap, _),
|
|
map.search(ExpansionsMap, InstName, PastPieces).
|
|
|
|
:- pred record_user_inst_name(inst_name::in, list(format_piece)::in,
|
|
expansions_info::in, expansions_info::out) is det.
|
|
|
|
record_user_inst_name(InstName, Pieces, !Expansions) :-
|
|
!.Expansions = expansions_info(ExpansionsMap0, ExpansionsCounter0),
|
|
( if map.insert(InstName, Pieces, ExpansionsMap0, ExpansionsMap) then
|
|
!:Expansions = expansions_info(ExpansionsMap, ExpansionsCounter0)
|
|
else
|
|
% An inst_name IN may occur as its own argument, like this:
|
|
%
|
|
% IN(..., IN(...), ...)
|
|
%
|
|
% By the time our caller calls us for the outer occurrence of IN,
|
|
% the code handling an inner occurrence may have already added IN
|
|
% to !Expansions.
|
|
true
|
|
).
|
|
|
|
:- pred record_internal_inst_name(inst_name::in, string::in,
|
|
list(format_piece)::out,
|
|
expansions_info::in, expansions_info::out) is det.
|
|
|
|
record_internal_inst_name(InstName, InstNameStr, InstNumPieces, !Expansions) :-
|
|
!.Expansions = expansions_info(ExpansionsMap0, ExpansionsCounter0),
|
|
counter.allocate(InstNum, ExpansionsCounter0, ExpansionsCounter),
|
|
string.format("internal %s #%d", [s(InstNameStr), i(InstNum)],
|
|
InstNameNumStr),
|
|
InstNumPieces = [fixed(InstNameNumStr)],
|
|
map.det_insert(InstName, InstNumPieces, ExpansionsMap0, ExpansionsMap),
|
|
!:Expansions = expansions_info(ExpansionsMap, ExpansionsCounter).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred pred_inst_info_to_pieces(inst_msg_info, maybe_inline_pieces,
|
|
string, uniqueness, pred_inst_info, list(format_piece),
|
|
expansions_info, expansions_info).
|
|
:- mode pred_inst_info_to_pieces(in, in(multi_line_pieces),
|
|
in, in, in, out, in, out) is det.
|
|
:- mode pred_inst_info_to_pieces(in, in(inline_pieces),
|
|
in, in, in, out, in, out) is det.
|
|
|
|
pred_inst_info_to_pieces(Info, MaybeInline, AnyPrefix, Uniq, PredInstInfo,
|
|
Pieces, !Expansions) :-
|
|
PredInstInfo = pred_inst_info(PredOrFunc, ArgModes, _MaybeArgRegs, Det),
|
|
(
|
|
Uniq = shared,
|
|
UniqPieces = []
|
|
;
|
|
( Uniq = unique
|
|
; Uniq = mostly_unique
|
|
; Uniq = clobbered
|
|
; Uniq = mostly_clobbered
|
|
),
|
|
BoundName = mercury_uniqueness_to_string(Uniq, "ground"),
|
|
UniqPieces = [fixed("/*"), fixed(BoundName), fixed("*/")]
|
|
),
|
|
modes_to_pieces(Info, MaybeInline, ArgModes, ArgModesPieces, !Expansions),
|
|
IsDetStr = "is " ++ mercury_det_to_string(Det),
|
|
% XXX Should we print each argument mode on a separate line
|
|
% with multi_line_pieces?
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
(
|
|
ArgModes = [],
|
|
ModesDetPieces = [fixed("(" ++ AnyPrefix ++ "pred"),
|
|
fixed(IsDetStr), suffix(")")]
|
|
;
|
|
ArgModes = [_ | _],
|
|
JoinedArgModePieces = pieces_strict_list_to_pieces(ArgModesPieces),
|
|
ModesDetPieces = [prefix("(" ++ AnyPrefix ++ "pred(") |
|
|
JoinedArgModePieces] ++
|
|
[suffix(")"), fixed(IsDetStr), suffix(")")]
|
|
)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
pred_args_to_func_args(ArgModesPieces,
|
|
RealArgModePieces, RetModePieces),
|
|
% XXX Should we put parentheses around RetModePieces?
|
|
% If it prints as "InitInst >> FinalInst", then the parentheses
|
|
% could make the output easier to read, but if it prints as a
|
|
% simple name, they would probably be just in the way.
|
|
(
|
|
RealArgModePieces = [],
|
|
ModesDetPieces =
|
|
[fixed("(" ++ AnyPrefix ++ "func =") | RetModePieces] ++
|
|
[fixed(IsDetStr), suffix(")")]
|
|
;
|
|
RealArgModePieces = [_ | _],
|
|
JoinedRealArgModePieces =
|
|
pieces_strict_list_to_pieces(RealArgModePieces),
|
|
(
|
|
MaybeInline = multi_line_pieces,
|
|
ModesDetPieces =
|
|
[fixed("(" ++ AnyPrefix ++ "func("), nl_indent_delta(1) |
|
|
JoinedRealArgModePieces] ++
|
|
[nl_indent_delta(-1), fixed(") =") | RetModePieces] ++
|
|
[fixed(IsDetStr ++ ")")]
|
|
;
|
|
MaybeInline = inline_pieces,
|
|
ModesDetPieces =
|
|
[prefix("(" ++ AnyPrefix ++ "func(") |
|
|
JoinedRealArgModePieces] ++
|
|
[suffix(") =") | RetModePieces] ++
|
|
[fixed(IsDetStr ++ ")")]
|
|
)
|
|
)
|
|
),
|
|
Pieces = UniqPieces ++ ModesDetPieces.
|
|
|
|
%---------------------%
|
|
|
|
:- pred modes_to_pieces(inst_msg_info, maybe_inline_pieces,
|
|
list(mer_mode), list(list(format_piece)),
|
|
expansions_info, expansions_info).
|
|
:- mode modes_to_pieces(in, in(multi_line_pieces),
|
|
in, out, in, out) is det.
|
|
:- mode modes_to_pieces(in, in(inline_pieces),
|
|
in, out, in, out) is det.
|
|
|
|
modes_to_pieces(_Info, _, [], [], !Expansions).
|
|
modes_to_pieces(Info, MaybeInline, [HeadMode | TailModes],
|
|
[HeadPieces | TailPieces], !Expansions) :-
|
|
mode_to_pieces(Info, MaybeInline, HeadMode, HeadPieces, !Expansions),
|
|
modes_to_pieces(Info, MaybeInline, TailModes, TailPieces, !Expansions).
|
|
|
|
%---------------------%
|
|
|
|
:- pred mode_to_pieces(inst_msg_info, maybe_inline_pieces,
|
|
mer_mode, list(format_piece), expansions_info, expansions_info).
|
|
:- mode mode_to_pieces(in, in(multi_line_pieces), in, out, in, out) is det.
|
|
:- mode mode_to_pieces(in, in(inline_pieces), in, out, in, out) is det.
|
|
|
|
mode_to_pieces(Info, MaybeInline, Mode0, Pieces, !Expansions) :-
|
|
strip_typed_insts_from_mode(Mode0, Mode1),
|
|
(
|
|
Mode1 = from_to_mode(FromInst1, ToInst1),
|
|
insts_to_mode(FromInst1, ToInst1, Mode),
|
|
(
|
|
Mode = from_to_mode(FromInst, ToInst),
|
|
inst_to_pieces(Info, MaybeInline, FromInst, [], FromPieces,
|
|
!Expansions),
|
|
inst_to_pieces(Info, MaybeInline, ToInst, [], ToPieces,
|
|
!Expansions),
|
|
Pieces = FromPieces ++ [fixed(">>") | ToPieces]
|
|
;
|
|
Mode = user_defined_mode(ModeName, ArgInsts),
|
|
user_defined_mode_to_pieces(Info, MaybeInline, ModeName, ArgInsts,
|
|
Pieces, !Expansions)
|
|
)
|
|
;
|
|
Mode1 = user_defined_mode(ModeName, ArgInsts),
|
|
user_defined_mode_to_pieces(Info, MaybeInline, ModeName, ArgInsts,
|
|
Pieces, !Expansions)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred user_defined_mode_to_pieces(inst_msg_info, maybe_inline_pieces,
|
|
sym_name, list(mer_inst), list(format_piece),
|
|
expansions_info, expansions_info).
|
|
:- mode user_defined_mode_to_pieces(in, in(multi_line_pieces),
|
|
in, in, out, in, out) is det.
|
|
:- mode user_defined_mode_to_pieces(in, in(inline_pieces),
|
|
in, in, out, in, out) is det.
|
|
|
|
user_defined_mode_to_pieces(Info, MaybeInline, ModeName, ArgInsts, Pieces,
|
|
!Expansions) :-
|
|
BaseModeName = unqualify_name(ModeName),
|
|
(
|
|
ArgInsts = [],
|
|
Pieces = [fixed(BaseModeName)]
|
|
;
|
|
ArgInsts = [_ | _],
|
|
arg_insts_to_pieces(Info, MaybeInline, ArgInsts, ArgInstPieces,
|
|
!Expansions),
|
|
Pieces =
|
|
[prefix(BaseModeName ++ "(") |
|
|
pieces_strict_list_to_pieces(ArgInstPieces)] ++
|
|
[suffix(")")]
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred arg_insts_to_pieces(inst_msg_info, maybe_inline_pieces,
|
|
list(mer_inst), list(list(format_piece)),
|
|
expansions_info, expansions_info).
|
|
:- mode arg_insts_to_pieces(in, in(multi_line_pieces),
|
|
in, out, in, out) is det.
|
|
:- mode arg_insts_to_pieces(in, in(inline_pieces),
|
|
in, out, in, out) is det.
|
|
|
|
arg_insts_to_pieces(_Info, _, [], [], !Expansions).
|
|
arg_insts_to_pieces(Info, MaybeInline, [HeadArgInst | TailArgInsts],
|
|
[HeadPieces | TailPieces], !Expansions) :-
|
|
inst_to_pieces(Info, MaybeInline, HeadArgInst, [], HeadPieces,
|
|
!Expansions),
|
|
arg_insts_to_pieces(Info, MaybeInline, TailArgInsts, TailPieces,
|
|
!Expansions).
|
|
|
|
%---------------------%
|
|
|
|
:- pred name_and_arg_insts_to_pieces(inst_msg_info, maybe_inline_pieces,
|
|
string, list(mer_inst), list(format_piece), list(format_piece),
|
|
expansions_info, expansions_info).
|
|
:- mode name_and_arg_insts_to_pieces(in, in(multi_line_pieces),
|
|
in, in, in, out, in, out) is det.
|
|
:- mode name_and_arg_insts_to_pieces(in, in(inline_pieces),
|
|
in, in, in, out, in, out) is det.
|
|
|
|
name_and_arg_insts_to_pieces(Info, MaybeInline, Name, ArgInsts, Suffix, Pieces,
|
|
!Expansions) :-
|
|
(
|
|
ArgInsts = [],
|
|
Pieces = [fixed(Name) | Suffix]
|
|
;
|
|
ArgInsts = [HeadArgInst | TailArgInsts],
|
|
insts_to_pieces(Info, MaybeInline, HeadArgInst, TailArgInsts,
|
|
[], ArgPieces, !Expansions),
|
|
( if summarize_a_few_arg_insts(ArgPieces, 4, ArgSummary) then
|
|
Pieces = [fixed(Name ++ "(" ++ ArgSummary ++ ")") | Suffix]
|
|
else
|
|
(
|
|
MaybeInline = multi_line_pieces,
|
|
Pieces = [fixed(Name), suffix("("), nl_indent_delta(1)] ++
|
|
ArgPieces ++ [nl_indent_delta(-1), fixed(")") | Suffix]
|
|
;
|
|
MaybeInline = inline_pieces,
|
|
Pieces = [prefix(Name ++ "(") | ArgPieces] ++
|
|
[suffix(")") | Suffix]
|
|
)
|
|
)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred summarize_a_few_arg_insts(list(format_piece)::in,
|
|
int::in, string::out) is semidet.
|
|
|
|
summarize_a_few_arg_insts(Pieces, Left, Summary) :-
|
|
Left > 0,
|
|
Pieces = [fixed(FirstFixed) | AfterFirstFixed],
|
|
(
|
|
AfterFirstFixed = [],
|
|
Summary = FirstFixed
|
|
;
|
|
AfterFirstFixed = [suffix(","), nl | TailPieces],
|
|
summarize_a_few_arg_insts(TailPieces, Left - 1, TailSummary),
|
|
Summary = FirstFixed ++ ", " ++ TailSummary
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module hlds.error_msg_inst.
|
|
%---------------------------------------------------------------------------%
|