mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-16 01:43:35 +00:00
Code Issues Projects Releases Wiki Activity
Files
b7b4e12dc8ce2647ddbc84cdb06df078f504aa73
mercury/compiler/error_msg_inst.m
Zoltan Somogyi 386160f937 s/dont/do_not/ in the compiler directory. 
compiler/*.m:
    Standardize on the do_not spelling over the dont contraction
    in the compiler directory. (We used to have a lot of both spellings.)
2024-08-12 12:49:23 +02:00

1064 lines
45 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2015, 2024 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 check_hlds.
:- import_module check_hlds.inst_lookup.
:- import_module hlds.hlds_inst_mode.
:- 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.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink