%---------------------------------------------------------------------------% % 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.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.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. %---------------------------------------------------------------------------% :- 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), IsDetStr = "is " ++ mercury_det_to_string(Det), % 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), IsDetStr = "is " ++ mercury_det_to_string(Det), ( 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. %---------------------------------------------------------------------------%