diff --git a/compiler/error_msg_inst.m b/compiler/error_msg_inst.m index 95995e64f..af51ff511 100644 --- a/compiler/error_msg_inst.m +++ b/compiler/error_msg_inst.m @@ -69,6 +69,7 @@ :- 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. @@ -385,8 +386,8 @@ bound_insts_to_pieces(Info, !Expansions, HeadBoundInst, TailBoundInsts, else ConsId = ConsId0 ), - mercury_format_cons_id(does_not_need_brackets, ConsId, unit, - "", ConsIdStr), + 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). @@ -418,8 +419,8 @@ bound_insts_to_inline_pieces(Info, !Expansions, HeadBoundInst, TailBoundInsts, else ConsId = ConsId0 ), - mercury_format_cons_id(does_not_need_brackets, ConsId, unit, - "", ConsIdStr), + 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). diff --git a/compiler/hlds_out_mode.m b/compiler/hlds_out_mode.m index e9e0050e6..eb2736290 100644 --- a/compiler/hlds_out_mode.m +++ b/compiler/hlds_out_mode.m @@ -288,12 +288,12 @@ mercury_format_structured_bound_insts([BoundInst | BoundInsts], ( Args = [], mercury_format_tabs(Indent1, S, !U), - mercury_format_cons_id(needs_brackets, ConsId, S, !U), + mercury_format_cons_id(Lang, needs_brackets, ConsId, S, !U), add_string("\n", S, !U) ; Args = [_ | _], mercury_format_tabs(Indent1, S, !U), - mercury_format_cons_id(does_not_need_brackets, ConsId, S, !U), + mercury_format_cons_id(Lang, does_not_need_brackets, ConsId, S, !U), add_string("(\n", S, !U), mercury_format_structured_inst_list(Args, Indent2, Lang, InclAddr, InstVarSet, S, !U), diff --git a/compiler/hlds_out_module.m b/compiler/hlds_out_module.m index 0678bdd7b..1575e7e97 100644 --- a/compiler/hlds_out_module.m +++ b/compiler/hlds_out_module.m @@ -1577,7 +1577,8 @@ write_const_struct_db(Stream, ConstStructDb, !IO) :- write_const_struct(Stream, N - ConstStruct, !IO) :- io.format(Stream, "\nconst_struct %d:\n", [i(N)], !IO), ConstStruct = const_struct(ConsId, ConstArgs, Type, Inst, DefinedWhere), - mercury_output_cons_id(does_not_need_brackets, ConsId, Stream, !IO), + mercury_output_cons_id(output_debug, does_not_need_brackets, ConsId, + Stream, !IO), ( ConstArgs = [], io.nl(Stream, !IO) @@ -1611,7 +1612,8 @@ write_const_struct_args(Stream, HeadConstArg, TailConstArgs, !IO) :- io.format(Stream, "cs(%d)", [i(N)], !IO) ; HeadConstArg = csa_constant(ConsId, Type), - mercury_output_cons_id(does_not_need_brackets, ConsId, Stream, !IO), + mercury_output_cons_id(output_debug, does_not_need_brackets, ConsId, + Stream, !IO), io.write_string(Stream, "\n with type ", !IO), mercury_output_type(varset.init, print_name_only, Type, Stream, !IO) ), diff --git a/compiler/inst_check.m b/compiler/inst_check.m index ce53c03f8..9cc78db21 100644 --- a/compiler/inst_check.m +++ b/compiler/inst_check.m @@ -68,6 +68,7 @@ :- import_module mdbcomp.sym_name. :- import_module parse_tree.mercury_to_mercury. :- import_module parse_tree.builtin_lib_types. +:- import_module parse_tree.parse_tree_out_info. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_item. % undesirable dependency :- import_module parse_tree.prog_out. @@ -1453,11 +1454,11 @@ record_arity_mismatch(CurNum, FunctorName, ActualArity, ExpectedAritiesSet, record_mismatch(CurNum, BoundInst, !NumMismatches, !PiecesCord) :- !:NumMismatches = !.NumMismatches + 1, BoundInst = bound_functor(ConsId, SubInsts), + ConsIdStr = mercury_cons_id_to_string(output_mercury, + does_not_need_brackets, ConsId), string.format("In bound functor #%d:", [i(CurNum)], InFunctorStr), string.format("function symbol is %s/%d.", - [s(mercury_cons_id_to_string(does_not_need_brackets, ConsId)), - i(list.length(SubInsts))], - ActualStr), + [s(ConsIdStr), i(list.length(SubInsts))], ActualStr), Pieces = [words(InFunctorStr), nl, words(ActualStr), nl], !:PiecesCord = !.PiecesCord ++ cord.from_list(Pieces). diff --git a/compiler/mercury_to_mercury.m b/compiler/mercury_to_mercury.m index 313446c73..a24c53a2f 100644 --- a/compiler/mercury_to_mercury.m +++ b/compiler/mercury_to_mercury.m @@ -72,11 +72,12 @@ % Output a cons_id, parenthesizing it if necessary. % -:- pred mercury_output_cons_id(needs_brackets::in, cons_id::in, - io.text_output_stream::in, io::di, io::uo) is det. -:- func mercury_cons_id_to_string(needs_brackets, cons_id) = string. -:- pred mercury_format_cons_id(needs_brackets::in, cons_id::in, S::in, - U::di, U::uo) is det <= output(S, U). +:- pred mercury_output_cons_id(output_lang::in, needs_brackets::in, + cons_id::in, io.text_output_stream::in, io::di, io::uo) is det. +:- func mercury_cons_id_to_string(output_lang, needs_brackets, cons_id) + = string. +:- pred mercury_format_cons_id(output_lang::in, needs_brackets::in, + cons_id::in, S::in, U::di, U::uo) is det <= output(S, U). %---------------------------------------------------------------------------% % @@ -262,13 +263,13 @@ mercury_output_state_var(VarSet, VarNamePrint, Var, Stream, !IO) :- %---------------------------------------------------------------------------% -mercury_output_cons_id(NeedsBrackets, ConsId, Stream, !IO) :- - mercury_format_cons_id(NeedsBrackets, ConsId, Stream, !IO). +mercury_output_cons_id(Lang, NeedsBrackets, ConsId, Stream, !IO) :- + mercury_format_cons_id(Lang, NeedsBrackets, ConsId, Stream, !IO). -mercury_cons_id_to_string(NeedsBrackets, ConsId) = String :- - mercury_format_cons_id(NeedsBrackets, ConsId, unit, "", String). +mercury_cons_id_to_string(Lang, NeedsBrackets, ConsId) = String :- + mercury_format_cons_id(Lang, NeedsBrackets, ConsId, unit, "", String). -mercury_format_cons_id(NeedsBrackets, ConsId, S, !U) :- +mercury_format_cons_id(Lang, NeedsBrackets, ConsId, S, !U) :- ( ConsId = cons(Name, _, _), ( @@ -280,7 +281,13 @@ mercury_format_cons_id(NeedsBrackets, ConsId, S, !U) :- ) ; ConsId = tuple_cons(_), - add_string("{}", S, !U) + ( + Lang = output_mercury, + add_string("{}", S, !U) + ; + Lang = output_debug, + add_string("tuple{}", S, !U) + ) ; ConsId = int_const(Int), add_int(Int, S, !U) @@ -377,7 +384,7 @@ mercury_format_cons_id(NeedsBrackets, ConsId, S, !U) :- ConsId = ground_term_const(ConstNum, SubConsId), add_string("", S, !U) ; ConsId = tabling_info_const(_), diff --git a/compiler/mode_errors.m b/compiler/mode_errors.m index a88e72678..345005e3e 100644 --- a/compiler/mode_errors.m +++ b/compiler/mode_errors.m @@ -547,7 +547,8 @@ mode_error_unify_var_functor_to_spec(ModeInfo, X, ConsId, Args, mode_info_get_module_info(ModeInfo, ModuleInfo), FunctorConsIdStr = functor_cons_id_to_string(ModuleInfo, VarSet, print_name_only, ConsId, Args), - ConsIdStr = mercury_cons_id_to_string(does_not_need_brackets, ConsId), + ConsIdStr = mercury_cons_id_to_string(output_mercury, + does_not_need_brackets, ConsId), FakeTermInst = defined_inst(user_inst(unqualified(ConsIdStr), ArgInsts)), Pieces = [words("mode error in unification of"), quote(mercury_var_to_name_only(VarSet, X)), @@ -1872,10 +1873,11 @@ mode_warning_cannot_succeed_var_functor(ModeInfo, X, InstX, ConsId) = Spec :- Preamble = mode_info_context_preamble(ModeInfo), mode_info_get_context(ModeInfo, Context), mode_info_get_varset(ModeInfo, VarSet), + ConsIdStr = mercury_cons_id_to_string(output_mercury, + does_not_need_brackets, ConsId), Pieces = [words("warning: unification of"), quote(mercury_var_to_name_only(VarSet, X)), words("and"), - words(mercury_cons_id_to_string(does_not_need_brackets, ConsId)), - words("cannot succeed."), nl, + words(ConsIdStr), words("cannot succeed."), nl, quote(mercury_var_to_name_only(VarSet, X)) | has_instantiatedness(ModeInfo, InstX, ".")], Spec = simplest_spec($pred, severity_warning, @@ -1891,10 +1893,11 @@ mode_warning_cannot_succeed_ground_occur_check(ModeInfo, X, ConsId) = Spec :- Preamble = mode_info_context_preamble(ModeInfo), mode_info_get_context(ModeInfo, Context), mode_info_get_varset(ModeInfo, VarSet), + ConsIdStr = mercury_cons_id_to_string(output_mercury, + does_not_need_brackets, ConsId), Pieces = [words("warning: unification of"), quote(mercury_var_to_name_only(VarSet, X)), words("and"), - words(mercury_cons_id_to_string(does_not_need_brackets, ConsId)), - words("cannot succeed, because"), + words(ConsIdStr), words("cannot succeed, because"), quote(mercury_var_to_name_only(VarSet, X)), words("cannot be equal to a term containing itself."), nl], Spec = simplest_spec($pred, severity_warning, diff --git a/compiler/parse_tree_out_inst.m b/compiler/parse_tree_out_inst.m index 469b677b3..ea66b675b 100644 --- a/compiler/parse_tree_out_inst.m +++ b/compiler/parse_tree_out_inst.m @@ -199,10 +199,10 @@ mercury_format_bound_insts(Lang, InstVarSet, [BoundInst | BoundInsts], BoundInst = bound_functor(ConsId, Args), ( Args = [], - mercury_format_cons_id(needs_brackets, ConsId, S, !U) + mercury_format_cons_id(Lang, needs_brackets, ConsId, S, !U) ; Args = [_ | _], - mercury_format_cons_id(does_not_need_brackets, ConsId, S, !U), + mercury_format_cons_id(Lang, does_not_need_brackets, ConsId, S, !U), add_string("(", S, !U), mercury_format_inst_list(Lang, InstVarSet, Args, S, !U), add_string(")", S, !U) diff --git a/compiler/prog_ctgc.m b/compiler/prog_ctgc.m index e73e48958..ba8fcd6b9 100644 --- a/compiler/prog_ctgc.m +++ b/compiler/prog_ctgc.m @@ -182,6 +182,7 @@ :- import_module parse_tree.mercury_to_mercury. :- import_module parse_tree.parse_sym_name. +:- import_module parse_tree.parse_tree_out_info. :- import_module parse_tree.parse_type_name. :- import_module parse_tree.prog_out. :- import_module parse_tree.prog_type. @@ -531,7 +532,7 @@ selector_to_string(TVarSet, Selector) = String :- unit_selector_to_string(_, termsel(ConsId, Index)) = string.append_list(["sel(", - mercury_cons_id_to_string(needs_brackets, ConsId), + mercury_cons_id_to_string(output_mercury, needs_brackets, ConsId), ",", int_to_string(cons_id_arity(ConsId)), ",", diff --git a/compiler/prog_data.m b/compiler/prog_data.m index c4ebe1f17..477ea72f0 100644 --- a/compiler/prog_data.m +++ b/compiler/prog_data.m @@ -114,6 +114,22 @@ % resolve_unify_functor.m has been run as part of the % post-typecheck pass. Until then, they are represented as % cons(unqualified("{}"), ...). + % + % XXX Unfortunately, the above is not quite true. The utility + % predicate type_constructors in type_util.m return the cons_ids + % of a type, but it does not know what the current pass is. + % When called on a tuple type, it can therefore either *always* + % return cons(unqualified("{}"), ...), or it can *always* return + % tuple_cons(Arity). It does the former, which means that any code + % that deals with its output, directly or indirectly, which + % certainly includes code that uses inst_match.m and probably + % includes other modules as well, has to be prepared for this. + % + % XXX I (zs) also strongly suspect that while post-typecheck.m. + % may replace occurrences of cons(unqualified("{}"), ...) in a + % procedure's body goal with tuple_cons(Arity), it won't replace + % similar occurrences in bound_insts in those procedures' mode + % declarations. ; closure_cons(shrouded_pred_proc_id, lambda_eval_method) % Note that a closure_cons represents a closure, not just