mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
18817d62d0
Class and instance definitions both contain lists of methods,
predicates and/or functions, that each have one or more procedures.
Until now, we represented the methods in class and instance definitions
as lists of nothing more than pred_proc_ids. This fact complicated
several operations,
- partly because there was no simple way to tell which procedures
were part of the same predicate or function, and
- partly because the order of the list is important (we identify
each method procedure in our equivalent of vtables with a number,
which is simply the procedure's position in this list), but there was
absolutely no information about recorded about this.
This diff therefore replaces the lists of pred_proc_ids with lists of
method_infos. Each method_info contains
- the method procedure number, i.e. the vtable index,
- the pred_or_func, sym_name and user arity of the predicate or function
that the method procedure is a part of, to make it simple to test
whether two method_infos represent different modes of the same predicate
or function, or not,
- the original pred_proc_id of the method procedure, which never changes,
and
- the current pred_proc_id, which program transformations *can* change.
compiler/hlds_class.m:
Make the change above in the representations of class and instance
definitions.
Put the fields of both types into a better order, by putting
related fields next to each other.
Put a notag wrapper around method procedure numbers to prevent
accidentally mixing them up with plain integers.
Add some utility functions.
compiler/prog_data.m:
Replace three fields containing pred_or_func, sym_name and arity
in the parse tree representation of instance methods with just one,
which contains all three pieces of info. This makes it easier to operate
on them as a unit.
Change the representation of methods defined by clauses from a list
of clauses to a cord of clauses, since this supports constant-time
append.
compiler/hlds_goal.m:
Switch from plain ints to the new notag representation of method
procedure numbers in method call goals.
compiler/add_class.m:
Simplify the code for adding new classes to the HLDS.
Give some predicates better names.
compiler/check_typeclass.m:
Significantly simplify the code for that generates the pred_infos and
proc_infos implementing all the methods of an instances definition,
and construct lists of method_infos instead of lists of pred_proc_ids.
Give some predicates better names.
Some error messages about problems in instance definitions started with
In instance declaration for class/arity:
while others started with
In instance declaration for class(module_a.foo, module_b.bar):
Replace both with
In instance declaration for class(foo, bar):
because it contains more useful information than the first, and less
non-useful information than the second. Improve the wording of some
error messages.
Factor out some common code.
compiler/prog_mode.m:
compiler/prog_type.m:
compiler/prog_util.m:
Generalize the existing predicates for stripping "builtin.m" module
qualifiers from sym_names, cons_ids, insts, types and modes
to allow also the stripping of *all* module qualifiers. This capability
is now used when we print an instance's type vector as a context
for diagnostics about problems inside instance definitions.
compiler/add_pred.m:
Add a mechanism for returning the pred_id of a newly created pred_info,
whether or not it was declared using a predmode declaration. This
capability is now needed by add_class.m.
Move the code creating an error message into its own function, and export
that function for add_class.m.
compiler/polymorphism_type_info.m:
Fix some comment rot.
compiler/base_typeclass_info.m:
compiler/call_gen.m:
compiler/dead_proc_elim.m:
compiler/deep_profiling.m:
compiler/direct_arg_in_out.m:
compiler/error_msg_inst.m:
compiler/float_regs.m:
compiler/get_dependencies.m:
compiler/higher_order.m:
compiler/hlds_error_util.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_typeclass_table.m:
compiler/instance_method_clauses.m:
compiler/intermod.m:
compiler/make_hlds_error.m:
compiler/ml_call_gen.m:
compiler/mode_errors.m:
compiler/modes.m:
compiler/module_qual.qualify_items.m:
compiler/old_type_constraints.m:
compiler/parse_class.m:
compiler/parse_tree_out.m:
compiler/parse_tree_out_inst.m:
compiler/polymorphism_post_copy.m:
compiler/polymorphism_type_class_info.m:
compiler/prog_item.m:
compiler/prog_rep.m:
compiler/recompilation.usage.m:
compiler/state_var.m:
compiler/type_class_info.m:
compiler/typecheck_debug.m:
compiler/typecheck_error_type_assign.m:
compiler/typecheck_errors.m:
compiler/typecheck_msgs.m:
compiler/unused_imports.m:
compiler/xml_documentation.m:
Conform to the changes above.
tests/invalid/bug476.err_exp:
tests/invalid/tc_err1.err_exp:
tests/invalid/tc_err2.err_exp:
tests/invalid/typeclass_bogus_method.err_exp:
tests/invalid/typeclass_missing_mode.err_exp:
tests/invalid/typeclass_missing_mode_2.err_exp:
tests/invalid/typeclass_mode.err_exp:
tests/invalid/typeclass_mode_2.err_exp:
tests/invalid/typeclass_mode_3.err_exp:
tests/invalid/typeclass_mode_4.err_exp:
tests/invalid/typeclass_test_10.err_exp:
tests/invalid/typeclass_test_3.err_exp:
tests/invalid/typeclass_test_4.err_exp:
tests/invalid/typeclass_test_5.err_exp:
tests/invalid/typeclass_test_9.err_exp:
Expect the updated wording of some error messages.
1014 lines
40 KiB
Mathematica
1014 lines
40 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2015 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
|
|
---> dont_expand_named_insts
|
|
; expand_named_insts.
|
|
|
|
:- type short_inst
|
|
---> quote_short_inst
|
|
; fixed_short_inst.
|
|
|
|
% error_msg_inst(ModuleInfo, InstVarSet, ExpandNamedInsts,
|
|
% ShortInstQF, 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 ShortInstSuffix = quote_short_inst. Don't put anything before it
|
|
% (our caller will do that), but 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.
|
|
%
|
|
:- func error_msg_inst(module_info, inst_varset, maybe_expand_named_insts,
|
|
short_inst, list(format_piece),
|
|
list(format_piece), list(format_piece), mer_inst)
|
|
= list(format_piece).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.inst_lookup.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.mercury_to_mercury.
|
|
:- import_module parse_tree.parse_tree_out_info.
|
|
:- import_module parse_tree.parse_tree_out_inst.
|
|
:- import_module parse_tree.parse_tree_out_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 set.
|
|
:- import_module string.
|
|
:- import_module unit.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type inst_msg_info
|
|
---> inst_msg_info(
|
|
imi_module_info :: module_info,
|
|
imi_inst_varset :: inst_varset,
|
|
imi_named_insts :: maybe_expand_named_insts
|
|
).
|
|
|
|
% 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,
|
|
ShortInstQF, ShortInstSuffix, LongInstPrefix, LongInstSuffix, Inst0)
|
|
= Pieces :-
|
|
Info = inst_msg_info(ModuleInfo, InstVarSet, ExpandNamedInsts),
|
|
strip_module_names_from_inst(strip_builtin_module_name, Inst0, Inst),
|
|
Expansions0 = expansions_info(map.init, counter.init(1)),
|
|
SuffixPieces = [],
|
|
inst_to_inline_pieces(Info, Expansions0, _InlineExpansions, Inst,
|
|
SuffixPieces, InlinePieces),
|
|
InlineStr = error_pieces_to_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
|
|
(
|
|
ShortInstQF = 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.
|
|
ShortInstQF = fixed_short_inst,
|
|
InlinePiece = fixed(InlineStr)
|
|
),
|
|
Pieces = [InlinePiece | ShortInstSuffix]
|
|
else
|
|
% Showing the inst on a separate line from the English text
|
|
% provides enough separation by itself.
|
|
inst_to_pieces(Info, Expansions0, _NonInlineExpansions, Inst,
|
|
LongInstSuffix, NonInlinePieces),
|
|
Pieces = LongInstPrefix ++ NonInlinePieces
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% 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::in,
|
|
expansions_info::in, expansions_info::out, mer_inst::in,
|
|
list(format_piece)::in, list(format_piece)::out) is det.
|
|
|
|
inst_to_pieces(Info, !Expansions, Inst, Suffix, Pieces) :-
|
|
(
|
|
( Inst = free
|
|
; Inst = free(_)
|
|
),
|
|
Pieces = [fixed("free") | Suffix]
|
|
;
|
|
Inst = bound(Uniq, _, BoundInsts),
|
|
BoundName = mercury_uniqueness_to_string(Uniq, "bound"),
|
|
(
|
|
BoundInsts = [],
|
|
Pieces = [fixed(BoundName) | Suffix]
|
|
;
|
|
BoundInsts = [HeadBoundInst | TailBoundInsts],
|
|
bound_insts_to_pieces(Info, !Expansions,
|
|
HeadBoundInst, TailBoundInsts, [], BoundPieces),
|
|
Pieces = [fixed(BoundName), suffix("("), nl_indent_delta(1) |
|
|
BoundPieces] ++ [nl_indent_delta(-1), fixed(")") | Suffix]
|
|
)
|
|
;
|
|
Inst = ground(Uniq, HOInstInfo),
|
|
(
|
|
HOInstInfo = higher_order(PredInstInfo),
|
|
pred_inst_info_to_pieces(Info, !Expansions, "", Uniq,
|
|
PredInstInfo, HOPieces),
|
|
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, !Expansions, "any_", Uniq,
|
|
PredInstInfo, HOPieces),
|
|
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, !Expansions, SubInst, [], SubInstPieces),
|
|
Pieces = [fixed("("), words(Names), fixed("=<") | SubInstPieces] ++
|
|
[fixed(")") | Suffix]
|
|
;
|
|
Inst = abstract_inst(Name, ArgInsts),
|
|
InstName = user_inst(Name, ArgInsts),
|
|
inst_name_to_pieces(Info, !Expansions, InstName, Suffix, Pieces)
|
|
;
|
|
Inst = defined_inst(InstName),
|
|
inst_name_to_pieces(Info, !Expansions, InstName, Suffix, Pieces)
|
|
;
|
|
Inst = not_reached,
|
|
Pieces = [fixed("not_reached") | Suffix]
|
|
).
|
|
|
|
:- pred inst_to_inline_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out, mer_inst::in,
|
|
list(format_piece)::in, list(format_piece)::out) is det.
|
|
|
|
inst_to_inline_pieces(Info, !Expansions, Inst, Suffix, Pieces) :-
|
|
(
|
|
( Inst = free
|
|
; Inst = free(_)
|
|
),
|
|
Pieces = [fixed("free") | Suffix]
|
|
;
|
|
Inst = bound(Uniq, _, BoundInsts),
|
|
BoundName = mercury_uniqueness_to_string(Uniq, "bound"),
|
|
(
|
|
BoundInsts = [],
|
|
Pieces = [fixed(BoundName) | Suffix]
|
|
;
|
|
BoundInsts = [HeadBoundInst | TailBoundInsts],
|
|
bound_insts_to_inline_pieces(Info, !Expansions,
|
|
HeadBoundInst, TailBoundInsts, [], BoundPieces),
|
|
Pieces = [prefix(BoundName ++ "(") | BoundPieces] ++
|
|
[suffix(")") | Suffix]
|
|
)
|
|
;
|
|
Inst = ground(Uniq, HOInstInfo),
|
|
(
|
|
HOInstInfo = higher_order(PredInstInfo),
|
|
pred_inst_info_to_inline_pieces(Info, !Expansions, "", Uniq,
|
|
PredInstInfo, HOPieces),
|
|
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_inline_pieces(Info, !Expansions, "any_", Uniq,
|
|
PredInstInfo, HOPieces),
|
|
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_inline_pieces(Info, !Expansions, SubInst, [], SubInstPieces),
|
|
Pieces = [fixed("("), words(Names), fixed("=<") | SubInstPieces] ++
|
|
[fixed(")") | Suffix]
|
|
;
|
|
Inst = abstract_inst(Name, ArgInsts),
|
|
InstName = user_inst(Name, ArgInsts),
|
|
inst_name_to_inline_pieces(Info, !Expansions, InstName, Suffix, Pieces)
|
|
;
|
|
Inst = defined_inst(InstName),
|
|
inst_name_to_inline_pieces(Info, !Expansions, InstName, Suffix, Pieces)
|
|
;
|
|
Inst = not_reached,
|
|
Pieces = [fixed("not_reached") | Suffix]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred insts_to_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
mer_inst::in, list(mer_inst)::in,
|
|
list(format_piece)::in, list(format_piece)::out) is det.
|
|
|
|
insts_to_pieces(Info, !Expansions, HeadInst, TailInsts, Suffix, Pieces) :-
|
|
(
|
|
TailInsts = [],
|
|
HeadSuffix = Suffix,
|
|
inst_to_pieces(Info, !Expansions, HeadInst, HeadSuffix, Pieces)
|
|
;
|
|
TailInsts = [HeadTailInst | TailTailInsts],
|
|
HeadSuffix = [suffix(","), nl],
|
|
inst_to_pieces(Info, !Expansions, HeadInst, HeadSuffix, HeadPieces),
|
|
insts_to_pieces(Info, !Expansions, HeadTailInst, TailTailInsts,
|
|
Suffix, TailPieces),
|
|
Pieces = HeadPieces ++ TailPieces
|
|
).
|
|
|
|
:- pred insts_to_inline_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
mer_inst::in, list(mer_inst)::in,
|
|
list(format_piece)::in, list(format_piece)::out) is det.
|
|
|
|
insts_to_inline_pieces(Info, !Expansions, HeadInst, TailInsts,
|
|
Suffix, Pieces) :-
|
|
(
|
|
TailInsts = [],
|
|
HeadSuffix = Suffix,
|
|
inst_to_inline_pieces(Info, !Expansions,
|
|
HeadInst, HeadSuffix, Pieces)
|
|
;
|
|
TailInsts = [HeadTailInst | TailTailInsts],
|
|
HeadSuffix = [suffix(",")],
|
|
inst_to_inline_pieces(Info, !Expansions, HeadInst,
|
|
HeadSuffix, HeadPieces),
|
|
insts_to_inline_pieces(Info, !Expansions, HeadTailInst, TailTailInsts,
|
|
Suffix, TailPieces),
|
|
Pieces = HeadPieces ++ TailPieces
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred bound_insts_to_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
bound_inst::in, list(bound_inst)::in,
|
|
list(format_piece)::in, list(format_piece)::out) is det.
|
|
|
|
bound_insts_to_pieces(Info, !Expansions, HeadBoundInst, TailBoundInsts,
|
|
Suffix, Pieces) :-
|
|
(
|
|
TailBoundInsts = [],
|
|
HeadSuffix = Suffix
|
|
;
|
|
TailBoundInsts = [HeadTailBoundInst | TailTailBoundInsts],
|
|
bound_insts_to_pieces(Info, !Expansions,
|
|
HeadTailBoundInst, TailTailBoundInsts, Suffix, TailPieces),
|
|
HeadSuffix = [nl_indent_delta(-1), fixed(";"), nl_indent_delta(1) |
|
|
TailPieces]
|
|
),
|
|
HeadBoundInst = bound_functor(ConsId0, ArgInsts),
|
|
( if
|
|
ConsId0 = cons(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.
|
|
SymName = qualified(_ModuleName, BaseName)
|
|
then
|
|
ConsId = cons(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, !Expansions, ConsIdStr, ArgInsts,
|
|
HeadSuffix, Pieces).
|
|
|
|
:- pred bound_insts_to_inline_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
bound_inst::in, list(bound_inst)::in,
|
|
list(format_piece)::in, list(format_piece)::out) is det.
|
|
|
|
bound_insts_to_inline_pieces(Info, !Expansions, HeadBoundInst, TailBoundInsts,
|
|
Suffix, Pieces) :-
|
|
(
|
|
TailBoundInsts = [],
|
|
HeadSuffix = Suffix
|
|
;
|
|
TailBoundInsts = [HeadTailBoundInst | TailTailBoundInsts],
|
|
bound_insts_to_inline_pieces(Info, !Expansions,
|
|
HeadTailBoundInst, TailTailBoundInsts, Suffix, TailPieces),
|
|
HeadSuffix = [fixed(";") | TailPieces]
|
|
),
|
|
HeadBoundInst = bound_functor(ConsId0, ArgInsts),
|
|
( if
|
|
ConsId0 = cons(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.
|
|
SymName = qualified(_ModuleName, BaseName)
|
|
then
|
|
ConsId = cons(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_inline_pieces(Info, !Expansions, ConsIdStr, ArgInsts,
|
|
HeadSuffix, Pieces).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred inst_name_to_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out, inst_name::in,
|
|
list(format_piece)::in, list(format_piece)::out) is det.
|
|
|
|
inst_name_to_pieces(Info, !Expansions, InstName, Suffix, Pieces) :-
|
|
( 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 := dont_expand_named_insts,
|
|
name_and_arg_insts_to_pieces(NameInfo, !.Expansions, _,
|
|
SymNameStr, ArgInsts, [], NamePieces),
|
|
NamedNamePieces = [words("named inst") | NamePieces],
|
|
|
|
ExpandInsts = Info ^ imi_named_insts,
|
|
(
|
|
ExpandInsts = dont_expand_named_insts,
|
|
Pieces = NamePieces ++ Suffix
|
|
;
|
|
ExpandInsts = expand_named_insts,
|
|
record_user_inst_name(InstName, NamedNamePieces, !Expansions),
|
|
ModuleInfo = Info ^ imi_module_info,
|
|
inst_lookup(ModuleInfo, InstName, EqvInst),
|
|
( if
|
|
( EqvInst = defined_inst(InstName)
|
|
; EqvInst = abstract_inst(SymName, ArgInsts)
|
|
)
|
|
then
|
|
% XXX Would NamePieces look better in the output?
|
|
Pieces = NamedNamePieces ++ Suffix
|
|
else
|
|
inst_to_pieces(Info, !Expansions, EqvInst,
|
|
Suffix, EqvPieces),
|
|
Pieces = NamedNamePieces ++
|
|
[nl, words("which expands to"),
|
|
nl_indent_delta(1) | EqvPieces] ++
|
|
[nl_indent_delta(-1)]
|
|
)
|
|
)
|
|
;
|
|
InstName = typed_inst(_Type, SubInstName),
|
|
% The user doesn't care about the typed_inst wrapper.
|
|
inst_name_to_pieces(Info, !Expansions, SubInstName, Suffix, Pieces)
|
|
;
|
|
InstName = typed_ground(Uniq, _Type),
|
|
% The user doesn't care about the typed_ground wrapper.
|
|
EqvInst = ground(Uniq, none_or_default_func),
|
|
inst_to_pieces(Info, !Expansions, EqvInst, Suffix, Pieces)
|
|
;
|
|
(
|
|
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"
|
|
),
|
|
ModuleInfo = Info ^ imi_module_info,
|
|
inst_lookup(ModuleInfo, InstName, EqvInst),
|
|
( if EqvInst = defined_inst(InstName) then
|
|
Pieces = [fixed(InstNameStr) | Suffix]
|
|
else
|
|
record_internal_inst_name(InstName, InstNameStr, InstNumPieces,
|
|
!Expansions),
|
|
inst_to_inline_pieces(Info, !Expansions, EqvInst, Suffix,
|
|
EqvPieces),
|
|
Pieces = InstNumPieces ++
|
|
[nl, words("which expands to"),
|
|
nl_indent_delta(1) | EqvPieces] ++
|
|
[nl_indent_delta(-1)]
|
|
)
|
|
)
|
|
).
|
|
|
|
:- pred inst_name_to_inline_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out, inst_name::in,
|
|
list(format_piece)::in, list(format_piece)::out) is det.
|
|
|
|
inst_name_to_inline_pieces(Info, !Expansions, InstName, Suffix, Pieces) :-
|
|
( 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 := dont_expand_named_insts,
|
|
name_and_arg_insts_to_inline_pieces(NameInfo, !.Expansions, _,
|
|
SymNameStr, ArgInsts, [], NamePieces),
|
|
NamedNamePieces = [words("named inst") | NamePieces],
|
|
|
|
ExpandInsts = Info ^ imi_named_insts,
|
|
(
|
|
ExpandInsts = dont_expand_named_insts,
|
|
Pieces = NamePieces ++ Suffix
|
|
;
|
|
ExpandInsts = expand_named_insts,
|
|
record_user_inst_name(InstName, NamedNamePieces, !Expansions),
|
|
ModuleInfo = Info ^ imi_module_info,
|
|
inst_lookup(ModuleInfo, InstName, EqvInst),
|
|
( if
|
|
( EqvInst = defined_inst(InstName)
|
|
; EqvInst = abstract_inst(SymName, ArgInsts)
|
|
)
|
|
then
|
|
% XXX Would NamePieces look better in the output?
|
|
Pieces = NamedNamePieces ++ Suffix
|
|
else
|
|
inst_to_inline_pieces(Info, !Expansions, EqvInst,
|
|
Suffix, ExpandedPieces),
|
|
Pieces = NamedNamePieces ++ [words("which expands to"),
|
|
prefix("<") | ExpandedPieces] ++ [suffix(">")]
|
|
)
|
|
)
|
|
;
|
|
InstName = typed_inst(_Type, SubInstName),
|
|
% The user doesn't care about the typed_inst wrapper,
|
|
% and the wrapper cannot make an inst recursive.
|
|
inst_name_to_inline_pieces(Info, !Expansions, SubInstName, Suffix,
|
|
Pieces)
|
|
;
|
|
InstName = typed_ground(Uniq, _Type),
|
|
% The user doesn't care about the typed_ground wrapper,
|
|
% and the wrapper cannot make an inst recursive.
|
|
EqvInst = ground(Uniq, none_or_default_func),
|
|
inst_to_inline_pieces(Info, !Expansions, EqvInst, Suffix, Pieces)
|
|
;
|
|
(
|
|
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"
|
|
),
|
|
ModuleInfo = Info ^ imi_module_info,
|
|
inst_lookup(ModuleInfo, InstName, EqvInst),
|
|
( if EqvInst = defined_inst(InstName) then
|
|
Pieces = [fixed(InstNameStr) | Suffix]
|
|
else
|
|
record_internal_inst_name(InstName, InstNameStr, InstNumPieces,
|
|
!Expansions),
|
|
inst_to_inline_pieces(Info, !Expansions, EqvInst, [],
|
|
EqvPieces),
|
|
Pieces = InstNumPieces ++ [words("which expands to"),
|
|
prefix("<") | EqvPieces] ++ [suffix(">") | Suffix]
|
|
)
|
|
)
|
|
).
|
|
|
|
:- 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 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::in,
|
|
expansions_info::in, expansions_info::out,
|
|
string::in, uniqueness::in, pred_inst_info::in,
|
|
list(format_piece)::out) is det.
|
|
|
|
pred_inst_info_to_pieces(Info, !Expansions, AnyPrefix, Uniq,
|
|
PredInstInfo, Pieces) :-
|
|
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, !Expansions, ArgModes, ArgModesPieces),
|
|
mercury_format_det(Det, unit, "is ", IsDetStr),
|
|
% XXX Should we print each argument mode on a separate line?
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
(
|
|
ArgModes = [],
|
|
ModesDetPieces = [fixed("(" ++ AnyPrefix ++ "pred"),
|
|
fixed(IsDetStr), suffix(")")]
|
|
;
|
|
ArgModes = [_ | _],
|
|
JoinedArgModePieces =
|
|
strict_component_lists_to_pieces(ArgModesPieces),
|
|
ModesDetPieces = [prefix("(" ++ AnyPrefix ++ "pred(") |
|
|
JoinedArgModePieces] ++
|
|
[suffix(")"), fixed(IsDetStr), suffix(")")]
|
|
)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
pred_args_to_func_args(ArgModesPieces,
|
|
RealArgModesPieces, RetModePieces),
|
|
JoinedRealArgModePieces =
|
|
component_list_to_line_pieces(RealArgModesPieces, [nl]),
|
|
% 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.
|
|
(
|
|
ArgModes = [],
|
|
ModesDetPieces = [fixed("(" ++ AnyPrefix ++ "func =") |
|
|
RetModePieces] ++
|
|
[fixed(IsDetStr), suffix(")")]
|
|
;
|
|
ArgModes = [_ | _],
|
|
ModesDetPieces = [fixed("(" ++ AnyPrefix ++ "func("),
|
|
nl_indent_delta(1) |
|
|
JoinedRealArgModePieces] ++
|
|
[nl_indent_delta(-1), fixed(") =") | RetModePieces] ++
|
|
[fixed(IsDetStr), suffix(")")]
|
|
)
|
|
),
|
|
Pieces = UniqPieces ++ ModesDetPieces.
|
|
|
|
:- pred pred_inst_info_to_inline_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
string::in, uniqueness::in, pred_inst_info::in,
|
|
list(format_piece)::out) is det.
|
|
|
|
pred_inst_info_to_inline_pieces(Info, !Expansions, AnyPrefix, Uniq,
|
|
PredInstInfo, Pieces) :-
|
|
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_inline_pieces(Info, !Expansions, ArgModes, ArgModesPieces),
|
|
mercury_format_det(Det, unit, "is ", IsDetStr),
|
|
(
|
|
PredOrFunc = pf_predicate,
|
|
(
|
|
ArgModes = [],
|
|
ModesDetPieces = [fixed("(" ++ AnyPrefix ++ "pred"),
|
|
fixed(IsDetStr), suffix(")")]
|
|
;
|
|
ArgModes = [_ | _],
|
|
JoinedArgModePieces =
|
|
strict_component_lists_to_pieces(ArgModesPieces),
|
|
ModesDetPieces = [prefix("(" ++ AnyPrefix ++ "pred(") |
|
|
JoinedArgModePieces] ++
|
|
[suffix(")"), fixed(IsDetStr), suffix(")")]
|
|
)
|
|
;
|
|
PredOrFunc = pf_function,
|
|
pred_args_to_func_args(ArgModesPieces,
|
|
RealArgModesPieces, RetModePieces),
|
|
JoinedRealArgModePieces =
|
|
strict_component_lists_to_pieces(RealArgModesPieces),
|
|
% 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.
|
|
(
|
|
ArgModes = [],
|
|
ModesDetPieces = [fixed("(" ++ AnyPrefix ++ "func =") |
|
|
RetModePieces] ++
|
|
[fixed(IsDetStr), suffix(")")]
|
|
;
|
|
ArgModes = [_ | _],
|
|
ModesDetPieces = [prefix("(" ++ AnyPrefix ++ "func(") |
|
|
JoinedRealArgModePieces] ++
|
|
[suffix(")"), fixed("=") | RetModePieces] ++
|
|
[fixed(IsDetStr), suffix(")")]
|
|
)
|
|
),
|
|
Pieces = UniqPieces ++ ModesDetPieces.
|
|
|
|
%---------------------%
|
|
|
|
:- pred modes_to_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
list(mer_mode)::in, list(list(format_piece))::out) is det.
|
|
|
|
modes_to_pieces(_Info, !Expansions, [], []).
|
|
modes_to_pieces(Info, !Expansions, [HeadMode | TailModes],
|
|
[HeadPieces | TailPieces]) :-
|
|
mode_to_pieces(Info, !Expansions, HeadMode, HeadPieces),
|
|
modes_to_pieces(Info, !Expansions, TailModes, TailPieces).
|
|
|
|
:- pred modes_to_inline_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
list(mer_mode)::in, list(list(format_piece))::out) is det.
|
|
|
|
modes_to_inline_pieces(_Info, !Expansions, [], []).
|
|
modes_to_inline_pieces(Info, !Expansions, [HeadMode | TailModes],
|
|
[HeadPieces | TailPieces]) :-
|
|
mode_to_inline_pieces(Info, !Expansions, HeadMode, HeadPieces),
|
|
modes_to_inline_pieces(Info, !Expansions, TailModes, TailPieces).
|
|
|
|
%---------------------%
|
|
|
|
:- pred mode_to_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
mer_mode::in, list(format_piece)::out) is det.
|
|
|
|
mode_to_pieces(Info, !Expansions, Mode0, Pieces) :-
|
|
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, !Expansions, FromInst, [], FromPieces),
|
|
inst_to_pieces(Info, !Expansions, ToInst, [], ToPieces),
|
|
Pieces = FromPieces ++ [fixed(">>") | ToPieces]
|
|
;
|
|
Mode = user_defined_mode(ModeName, ArgInsts),
|
|
user_defined_mode_to_pieces(Info, !Expansions, ModeName, ArgInsts,
|
|
Pieces)
|
|
)
|
|
;
|
|
Mode1 = user_defined_mode(ModeName, ArgInsts),
|
|
user_defined_mode_to_pieces(Info, !Expansions, ModeName, ArgInsts,
|
|
Pieces)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred mode_to_inline_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
mer_mode::in, list(format_piece)::out) is det.
|
|
|
|
mode_to_inline_pieces(Info, !Expansions, Mode0, Pieces) :-
|
|
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_inline_pieces(Info, !Expansions, FromInst, [], FromPieces),
|
|
inst_to_inline_pieces(Info, !Expansions, ToInst, [], ToPieces),
|
|
Pieces = FromPieces ++ [fixed(">>") | ToPieces]
|
|
;
|
|
Mode = user_defined_mode(ModeName, ArgInsts),
|
|
user_defined_mode_to_inline_pieces(Info, !Expansions,
|
|
ModeName, ArgInsts, Pieces)
|
|
)
|
|
;
|
|
Mode1 = user_defined_mode(ModeName, ArgInsts),
|
|
user_defined_mode_to_inline_pieces(Info, !Expansions,
|
|
ModeName, ArgInsts, Pieces)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred user_defined_mode_to_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
sym_name::in, list(mer_inst)::in, list(format_piece)::out) is det.
|
|
|
|
user_defined_mode_to_pieces(Info, !Expansions, ModeName, ArgInsts, Pieces) :-
|
|
BaseModeName = unqualify_name(ModeName),
|
|
(
|
|
ArgInsts = [],
|
|
Pieces = [fixed(BaseModeName)]
|
|
;
|
|
ArgInsts = [_ | _],
|
|
arg_insts_to_pieces(Info, !Expansions, ArgInsts, ArgInstPieces),
|
|
Pieces =
|
|
[prefix(BaseModeName ++ "(") |
|
|
strict_component_lists_to_pieces(ArgInstPieces)] ++
|
|
[suffix(")")]
|
|
).
|
|
|
|
:- pred user_defined_mode_to_inline_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
sym_name::in, list(mer_inst)::in, list(format_piece)::out) is det.
|
|
|
|
user_defined_mode_to_inline_pieces(Info, !Expansions, ModeName, ArgInsts,
|
|
Pieces) :-
|
|
BaseModeName = unqualify_name(ModeName),
|
|
(
|
|
ArgInsts = [],
|
|
Pieces = [fixed(BaseModeName)]
|
|
;
|
|
ArgInsts = [_ | _],
|
|
arg_insts_to_inline_pieces(Info, !Expansions,
|
|
ArgInsts, ArgInstPieces),
|
|
Pieces =
|
|
[prefix(BaseModeName ++ "(") |
|
|
strict_component_lists_to_pieces(ArgInstPieces)] ++
|
|
[suffix(")")]
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred arg_insts_to_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
list(mer_inst)::in, list(list(format_piece))::out) is det.
|
|
|
|
arg_insts_to_pieces(_Info, !Expansions, [], []).
|
|
arg_insts_to_pieces(Info, !Expansions, [HeadArgInst | TailArgInsts],
|
|
[HeadPieces | TailPieces]) :-
|
|
inst_to_pieces(Info, !Expansions, HeadArgInst, [], HeadPieces),
|
|
arg_insts_to_pieces(Info, !Expansions, TailArgInsts, TailPieces).
|
|
|
|
:- pred arg_insts_to_inline_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
list(mer_inst)::in, list(list(format_piece))::out) is det.
|
|
|
|
arg_insts_to_inline_pieces(_Info, !Expansions, [], []).
|
|
arg_insts_to_inline_pieces(Info, !Expansions, [HeadArgInst | TailArgInsts],
|
|
[HeadPieces | TailPieces]) :-
|
|
inst_to_inline_pieces(Info, !Expansions, HeadArgInst, [], HeadPieces),
|
|
arg_insts_to_inline_pieces(Info, !Expansions, TailArgInsts, TailPieces).
|
|
|
|
%---------------------%
|
|
|
|
:- pred name_and_arg_insts_to_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
string::in, list(mer_inst)::in, list(format_piece)::in,
|
|
list(format_piece)::out) is det.
|
|
|
|
name_and_arg_insts_to_pieces(Info, !Expansions, Name, ArgInsts, Suffix,
|
|
Pieces) :-
|
|
(
|
|
ArgInsts = [],
|
|
Pieces = [fixed(Name) | Suffix]
|
|
;
|
|
ArgInsts = [HeadArgInst | TailArgInsts],
|
|
insts_to_pieces(Info, !Expansions, HeadArgInst, TailArgInsts,
|
|
[], ArgPieces),
|
|
( if summarize_a_few_arg_insts(ArgPieces, 4, ArgSummary) then
|
|
Pieces = [fixed(Name), suffix("(" ++ ArgSummary ++ ")") | Suffix]
|
|
else
|
|
Pieces = [fixed(Name), suffix("("), nl_indent_delta(1)] ++
|
|
ArgPieces ++ [nl_indent_delta(-1), fixed(")") | Suffix]
|
|
)
|
|
).
|
|
|
|
:- pred name_and_arg_insts_to_inline_pieces(inst_msg_info::in,
|
|
expansions_info::in, expansions_info::out,
|
|
string::in, list(mer_inst)::in, list(format_piece)::in,
|
|
list(format_piece)::out) is det.
|
|
|
|
name_and_arg_insts_to_inline_pieces(Info, !Expansions, Name, ArgInsts, Suffix,
|
|
Pieces) :-
|
|
(
|
|
ArgInsts = [],
|
|
Pieces = [fixed(Name) | Suffix]
|
|
;
|
|
ArgInsts = [HeadArgInst | TailArgInsts],
|
|
insts_to_inline_pieces(Info, !Expansions, HeadArgInst, TailArgInsts,
|
|
[], ArgPieces),
|
|
( if summarize_a_few_arg_insts(ArgPieces, 4, ArgSummary) then
|
|
Pieces = [fixed(Name ++ "(" ++ ArgSummary ++ ")") | Suffix]
|
|
else
|
|
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.
|
|
%---------------------------------------------------------------------------%
|