[m-rev.] for review: improve reporting of mode warnings

Ian MacLarty maclarty at csse.unimelb.edu.au
Mon May 28 08:42:17 AEST 2007


For review by anyone.

Estimated hours taken: 5
Branches: main

Only report mode warnings if they occur in all modes.
simplify.m already had code to do this, so move this code to error_util.m and
reuse it in modes.m

Also only report mode warnings for user defined predicates.  Do not report them
for compiler generated predicates (after making the change in the previous
paragraph, the compiler issued a warning for a generated unification predicate
in term_to_xml.m).

compiler/cse_detection.m:
	Conform to new interface of modecheck_proc.

compiler/error_util.m:
	Add an abstract type error_spec_accumulator and predicates for
	working with this type.  The new type is used for accumulating
	errors over multiple modes of a predicate.
	
	The code for accumulating error specs has been moved from simplify.m.
	There was a bug in this code caused by the arguments of the pair
	in the error_spec_accumulator type getting mixed up.  This bug has now
	been fixed.

	Add mode_report_control to the modecheck phase, so we can mark which
	error specs should only be reported if they occur in all modes.

compiler/mode_errors.m:
	Delete report_mode_errors and report_mode_warnings, since these are
	no longer used.

	Export mode_error_info_to_spec and mode_warning_info_to_spec for
	converting mode errors and warnings to error specs.

	Conform to changes in error_util.m.

compiler/modecheck_unify.m:
	Do not supress warnings if the mode may use a subtype, since we
	want such warnings to be displayed if the occur in all modes.

	Only report mode warnings if the predicate is not a compiler generated
	predicate.

compiler/modes.m:
	Delete modecheck_pred_mode and modecheck_proc_info, since they are
	not used anywhere.

	In modecheck_proc and modecheck_proc_general report a list of
	error specs, instead of the number of errors.  These predicates are
	now no longer responsible for printing the errors, they just return
	the error specs.  We need to do it this way so we can accumulate the
	errors over all modes (eliminating any warnings that don't occur in
	all modes) before printing them.

	Report errors in modecheck_pred_mode_2, after all modes have been
	processed.

	Accumulate the error specs in modecheck_procs, using the new predicates
	in error_util.m.

	Move the code for only reporting the first error encountered for a proc
	from mode_errors.m to here.  Also improve the comment for that bit of
	code.

	Conform to changes in error_util.m.

compiler/pd_util.m:
	Conform to changes in error_util.m.

compiler/simplify.m:
	Move the code for accumulating error specs to error_util.m

compiler/unify_proc.m:
compiler/unique_modes.m:
	Conform to changes elsewhere.

tests/invalid/ho_type_mode_bug.err_exp:
	The order the errors are reported has changed here, because we now
	call write_error_specs to report mode errors.

tests/invalid/qualified_cons_id2.err_exp:
tests/warnings/simple_code.exp:
tests/warnings/simple_code.m:
	We now correctly report a warning we didn't report before.

Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.108
diff -u -r1.108 cse_detection.m
--- compiler/cse_detection.m	19 Jan 2007 07:04:09 -0000	1.108
+++ compiler/cse_detection.m	27 May 2007 21:56:03 -0000
@@ -52,6 +52,7 @@
 :- import_module libs.globals.
 :- import_module libs.options.
 :- import_module parse_tree.
+:- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_data.
 :- import_module parse_tree.prog_out.
 :- import_module parse_tree.prog_type_subst.
@@ -126,9 +127,13 @@
         ;
             VeryVerbose = no
         ),
-        modecheck_proc(ProcId, PredId, !ModuleInfo, Errs, _Changed, !IO),
+        modecheck_proc(ProcId, PredId, !ModuleInfo, ErrorSpecs, _Changed, !IO),
         maybe_report_stats(Statistics, !IO),
-        ( Errs > 0 ->
+        module_info_get_globals(!.ModuleInfo, Globals),
+        write_error_specs(ErrorSpecs, Globals, 0, _NumWarnings, 0, NumErrors,
+            !IO),
+        module_info_incr_num_errors(NumErrors, !ModuleInfo),
+        ( NumErrors > 0 ->
             unexpected(this_file, "mode check fails when repeated")
         ;
             true
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.62
diff -u -r1.62 error_util.m
--- compiler/error_util.m	20 Apr 2007 00:48:50 -0000	1.62
+++ compiler/error_util.m	27 May 2007 21:56:03 -0000
@@ -109,7 +109,7 @@
     ;       phase_parse_tree_to_hlds
     ;       phase_expand_types
     ;       phase_type_check
-    ;       phase_mode_check
+    ;       phase_mode_check(mode_report_control)
     ;       phase_purity_check
     ;       phase_detism_check
     ;       phase_simplify(mode_report_control)
@@ -211,6 +211,23 @@
 :- pred sort_error_msgs(list(error_msg)::in, list(error_msg)::out) is det.
 
 %-----------------------------------------------------------------------------%
+% The error_spec_accumulator type can be used to accumulate errors for
+% multiple modes of a predicate.  accumulate_error_specs_for_proc will
+% eliminate warnings that should only be reported if they occur in every mode,
+% but don't occur in every mode.
+%
+
+:- type error_spec_accumulator.
+
+:- func init_error_spec_accumulator = error_spec_accumulator.
+
+:- pred accumulate_error_specs_for_proc(list(error_spec)::in,
+    error_spec_accumulator::in, error_spec_accumulator::out) is det.
+
+:- func error_spec_accumulator_to_list(error_spec_accumulator) =
+    list(error_spec).
+
+%-----------------------------------------------------------------------------%
 
     % write_error_spec(Spec, Globals, !NumWarnings, !NumErrors, !IO):
     % write_error_specs(Specs, Globals, !NumWarnings, !NumErrors, !IO):
@@ -421,7 +438,9 @@
 :- import_module char.
 :- import_module int.
 :- import_module list.
+:- import_module pair.
 :- import_module require.
+:- import_module set.
 :- import_module string.
 :- import_module term.
 
@@ -595,6 +614,51 @@
         Msg = error_msg(no, _, _, __),
         MaybeContext = no
     ).
+
+%-----------------------------------------------------------------------------%
+
+:- type error_spec_accumulator == maybe(pair(set(error_spec))).
+
+init_error_spec_accumulator = no.
+
+accumulate_error_specs_for_proc(ProcSpecs, !MaybeSpecs) :-
+    list.filter((pred(error_spec(_, Phase, _)::in) is semidet :-
+            ModeReportControl = get_maybe_mode_report_control(Phase),
+            ModeReportControl = yes(report_only_if_in_all_modes)
+        ), ProcSpecs, ProcAllModeSpecs, ProcAnyModeSpecs),
+    ProcAnyModeSpecSet = set.from_list(ProcAnyModeSpecs),
+    ProcAllModeSpecSet = set.from_list(ProcAllModeSpecs),
+    (
+        !.MaybeSpecs = yes(AnyModeSpecSet0 - AllModeSpecSet0),
+        set.union(AnyModeSpecSet0, ProcAnyModeSpecSet, AnyModeSpecSet),
+        set.intersect(AllModeSpecSet0, ProcAllModeSpecSet, AllModeSpecSet),
+        !:MaybeSpecs = yes(AnyModeSpecSet - AllModeSpecSet)
+    ;
+        !.MaybeSpecs = no,
+        !:MaybeSpecs = yes(ProcAnyModeSpecSet - ProcAllModeSpecSet)
+    ).
+
+error_spec_accumulator_to_list(no) = [].
+error_spec_accumulator_to_list(yes(AnyModeSpecSet - AllModeSpecSet)) =
+    set.to_sorted_list(set.union(AnyModeSpecSet, AllModeSpecSet)).
+
+:- func get_maybe_mode_report_control(error_phase) =
+    maybe(mode_report_control).
+
+get_maybe_mode_report_control(phase_read_files) = no.
+get_maybe_mode_report_control(phase_term_to_parse_tree) = no.
+get_maybe_mode_report_control(phase_parse_tree_to_hlds) = no.
+get_maybe_mode_report_control(phase_expand_types) = no.
+get_maybe_mode_report_control(phase_type_check) = no.
+get_maybe_mode_report_control(phase_mode_check(Control)) = yes(Control).
+get_maybe_mode_report_control(phase_purity_check) = no.
+get_maybe_mode_report_control(phase_detism_check) = no.
+get_maybe_mode_report_control(phase_simplify(Control)) = yes(Control).
+get_maybe_mode_report_control(phase_dead_code) = no.
+get_maybe_mode_report_control(phase_termination_analysis) = no.
+get_maybe_mode_report_control(phase_accumulator_intro) = no.
+get_maybe_mode_report_control(phase_interface_gen) = no.
+get_maybe_mode_report_control(phase_code_gen) = no.
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.115
diff -u -r1.115 mode_errors.m
--- compiler/mode_errors.m	17 May 2007 03:52:46 -0000	1.115
+++ compiler/mode_errors.m	27 May 2007 21:56:03 -0000
@@ -188,23 +188,10 @@
 
 %-----------------------------------------------------------------------------%
 
-    % If there were any errors recorded in the mode_info,
-    % report them to the user now.
-    %
-:- pred report_mode_errors(mode_info::in, mode_info::out,
-    io::di, io::uo) is det.
-
-    % If there were any warnings recorded in the mode_info,
-    % report them to the user now.
-    %
-:- pred report_mode_warnings(mode_info::in, mode_info::out,
-    io::di, io::uo) is det.
-
     % Initialize the mode_context.
     %
 :- pred mode_context_init(mode_context::out) is det.
 
-
     % Report an error for a predicate with no mode declarations
     % unless mode inference is enabled and the predicate is local.
     % XXX This predicate should be included in the types above.
@@ -229,6 +216,13 @@
 
 :- func mode_decl_to_string(proc_id, pred_info) = string.
 
+:- func mode_error_info_to_spec(mode_info, mode_error_info) = error_spec.
+
+:- func mode_warning_info_to_spec(mode_info, mode_warning_info) = error_spec.
+
+:- pred should_report_mode_warning_for_pred_origin(pred_origin::in,
+    bool::out) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -256,56 +250,19 @@
 :- import_module varset.
 
 %-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
 
-report_mode_errors(!ModeInfo, !IO) :-
-    mode_info_get_errors(!.ModeInfo, Errors),
-    (
-        Errors = [FirstError | _],
-        % XXX Document exactly why we only report the first.
-        FirstError = mode_error_info(_, ModeError, Context, ModeContext),
+mode_error_info_to_spec(ModeInfo0, ModeErrorInfo) = Spec :-
+    some [!ModeInfo] (
+        !:ModeInfo = ModeInfo0,
+        ModeErrorInfo = mode_error_info(_, ModeError, Context, ModeContext),
         mode_info_set_context(Context, !ModeInfo),
         mode_info_set_mode_context(ModeContext, !ModeInfo),
-        report_mode_error(ModeError, !ModeInfo, !IO)
-    ;
-        Errors = []
+        Spec = mode_error_to_spec(!.ModeInfo, ModeError)
     ).
 
-report_mode_warnings(!ModeInfo, !IO) :-
-    mode_info_get_warnings(!.ModeInfo, Warnings),
-    list.foldl2(report_mode_warning, Warnings, !ModeInfo, !IO).
+:- func mode_error_to_spec(mode_info, mode_error) = error_spec.
 
-    % Print an error message describing a mode error.
-    %
-:- pred report_mode_error(mode_error::in,
-    mode_info::in, mode_info::out, io::di, io::uo) is det.
-
-report_mode_error(ModeError, !ModeInfo, !IO) :-
-    Spec = mode_error_to_spec(ModeError, !.ModeInfo),
-    mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
-    module_info_get_globals(ModuleInfo0, Globals),
-    write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
-    module_info_incr_num_errors(NumErrors, ModuleInfo0, ModuleInfo),
-    mode_info_set_module_info(ModuleInfo, !ModeInfo).
-
-    % Print a warning message.
-    %
-:- pred report_mode_warning(mode_warning_info::in,
-    mode_info::in, mode_info::out, io::di, io::uo) is det.
-
-report_mode_warning(Warning, !ModeInfo, !IO) :-
-    Spec = mode_warning_to_spec(!.ModeInfo, Warning),
-    mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
-    module_info_get_globals(ModuleInfo0, Globals),
-    write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
-    module_info_incr_num_errors(NumErrors, ModuleInfo0, ModuleInfo),
-    mode_info_set_module_info(ModuleInfo, !ModeInfo).
-
-%-----------------------------------------------------------------------------%
-
-:- func mode_error_to_spec(mode_error, mode_info) = error_spec.
-
-mode_error_to_spec(ModeError, ModeInfo) = Spec :-
+mode_error_to_spec(ModeInfo, ModeError) = Spec :-
     (
         ModeError = mode_error_disj(MergeContext, ErrorList),
         Spec = mode_error_disj_to_spec(ModeInfo, MergeContext, ErrorList)
@@ -381,9 +338,7 @@
         Spec = purity_error_lambda_should_be_impure_to_spec(ModeInfo, Vars)
     ).
 
-:- func mode_warning_to_spec(mode_info, mode_warning_info) = error_spec.
-
-mode_warning_to_spec(!.ModeInfo, Warning) = Spec :-
+mode_warning_info_to_spec(!.ModeInfo, Warning) = Spec :-
     Warning = mode_warning_info(ModeWarning, Context, ModeContext),
     mode_info_set_context(Context, !ModeInfo),
     mode_info_set_mode_context(ModeContext, !ModeInfo),
@@ -479,7 +434,8 @@
             simple_msg(ImpureGoalContext, [always(Pieces2)])
         ]
     ),
-    Spec = error_spec(severity_error, phase_mode_check, Msgs1 ++ Msgs2).
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
+        Msgs1 ++ Msgs2).
 
 :- pred is_error_important(delayed_goal::in) is semidet.
 
@@ -520,7 +476,7 @@
     Error = mode_error_info(_, ModeError, ErrorContext, ModeContext),
     mode_info_set_context(ErrorContext, !ModeInfo),
     mode_info_set_mode_context(ModeContext, !ModeInfo),
-    SubSpec = mode_error_to_spec(ModeError, !.ModeInfo),
+    SubSpec = mode_error_to_spec(!.ModeInfo, ModeError),
     SubSpec = error_spec(_, _, SubMsgs),
     Msgs = [Msg1, Msg2] ++ SubMsgs.
 
@@ -543,7 +499,7 @@
         words(merge_context_to_string(MergeContext)), suffix("."), nl],
     MergePieceLists = list.map(merge_error_to_pieces(ModeInfo), ErrorList),
     list.condense(MergePieceLists, MergePieces),
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context,
             [always(Preamble ++ MainPieces ++ MergePieces)])]).
 
@@ -558,7 +514,7 @@
         words("parallel conjunctions to fail.)"), nl],
     MergePieceLists = list.map(merge_error_to_pieces(ModeInfo), ErrorList),
     list.condense(MergePieceLists, MergePieces),
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context,
             [always(Preamble ++ Pieces ++ MergePieces)])]).
 
@@ -642,7 +598,7 @@
             [words("A nonlocal variable of a parallel conjunction"),
             words("may be bound in at most one conjunct."), nl]
     ),
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context,
             [always(Preamble ++ MainPieces), verbose_only(VerbosePieces)])]).
 
@@ -662,7 +618,7 @@
         suffix(","), nl,
         words("expected instantiatedness for non-local variables"),
         words("of lambda goals is `ground'."), nl],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 %-----------------------------------------------------------------------------%
@@ -704,7 +660,7 @@
         mode_info_set_procid(CalleeProcId, !ModeInfo),
         mode_info_set_context(CalleeContext, !ModeInfo),
         mode_info_set_mode_context(CalleeModeContext, !ModeInfo),
-        CalleeModeErrorSpec = mode_error_to_spec(CalleeModeError, !.ModeInfo),
+        CalleeModeErrorSpec = mode_error_to_spec(!.ModeInfo, CalleeModeError),
         CalleeModeErrorSpec = error_spec(_, _, LaterMsgs0),
         (
             LaterMsgs0 = [],
@@ -722,7 +678,7 @@
             ),
             LaterMsgs = [LaterHead | LaterTail]
         ),
-        Spec = error_spec(severity_error, phase_mode_check,
+        Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
             [InitMsg | LaterMsgs])
     ;
         CalleeModeErrors = [],
@@ -749,7 +705,7 @@
         inst_list_to_sep_lines(ModeInfo, Insts) ++
         [words("which does not match any of the modes for"),
         words(CallIdStr), suffix("."), nl],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 :- func mode_error_higher_order_pred_var_to_spec(mode_info, pred_or_func,
@@ -775,7 +731,7 @@
         words(add_quotes(inst_to_string(ModeInfo, VarInst))),
         suffix(","), nl,
         words(Expecting), nl],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 :- func mode_error_poly_unify_to_spec(mode_info, prog_var, mer_inst)
@@ -796,7 +752,7 @@
         words("be ground (or have inst `any'). Unifications of"),
         words("polymorphically-typed variables with partially"),
         words("instantiated modes are not allowed.")],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context,
             [always(Preamble ++ MainPieces), verbose_only(VerbosePieces)])]).
 
@@ -810,7 +766,7 @@
         words("would clobber its argument, but variable"),
         words(add_quotes(mercury_var_to_string(VarSet, no, Var))),
         words("is still live."), nl],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 :- func mode_error_var_has_inst_to_spec(mode_info, prog_var,
@@ -826,7 +782,7 @@
         words(add_quotes(inst_to_string(ModeInfo, VarInst))), suffix(","), nl,
         words("expected instantiatedness was"),
         words(add_quotes(inst_to_string(ModeInfo, Inst))), suffix("."), nl],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 :- func mode_error_implied_mode_to_spec(mode_info, prog_var,
@@ -848,7 +804,7 @@
         words(add_quotes(inst_to_string(ModeInfo, Inst))),
         suffix("."), nl],
     Severity = severity_conditional(errorcheck_only, no, severity_error, no),
-    Spec = error_spec(Severity, phase_mode_check,
+    Spec = error_spec(Severity, phase_mode_check(report_in_any_mode),
         [simple_msg(Context,
             [option_is_set(errorcheck_only, no,
                 [always(Preamble ++ Pieces)])])]).
@@ -859,7 +815,7 @@
     Preamble = mode_info_context_preamble(ModeInfo),
     mode_info_get_context(ModeInfo, Context),
     Pieces = [words("no mode declaration for called predicate."), nl],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 :- func mode_error_unify_pred_to_spec(mode_info, prog_var,
@@ -904,7 +860,7 @@
         words("writing an explicit universal quantification, e.g."),
         fixed("`all [X] call(P, X) <=> call(Q, X)',"),
         words("instead of"), fixed("`P = Q'.")],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context,
             [always(Preamble ++ MainPieces), verbose_only(VerbosePieces)])]).
 
@@ -930,7 +886,7 @@
         words(add_quotes(mercury_var_to_string(VarSet, no, Y))),
         words("has instantiatedness"),
         words(add_quotes(inst_to_string(ModeInfo, InstY))), suffix("."), nl],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 %-----------------------------------------------------------------------------%
@@ -951,7 +907,7 @@
         words(add_quotes(inst_to_string(ModeInfo, InstX))), suffix(","), nl,
         words("lambda expression has instantiatedness"),
         words(add_quotes(inst_to_string(ModeInfo, InstY))), suffix("."), nl],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 %-----------------------------------------------------------------------------%
@@ -991,7 +947,7 @@
             words(add_quotes(mercury_cons_id_to_string(ConsId,
                 does_not_need_brackets))), suffix("."), nl]
     ),
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces1 ++ Pieces2)])]).
 
 %-----------------------------------------------------------------------------%
@@ -1014,7 +970,8 @@
         words(add_quotes(mercury_var_to_string(VarSet, no, Y))),
         words("has instantiatedness"),
         words(add_quotes(inst_to_string(ModeInfo, InstY))), suffix("."), nl],
-    Spec = error_spec(severity_warning, phase_mode_check,
+    Spec = error_spec(severity_warning,
+        phase_mode_check(report_only_if_in_all_modes),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 :- func mode_warning_cannot_succeed_var_functor(mode_info, prog_var, mer_inst,
@@ -1032,7 +989,8 @@
         words(add_quotes(mercury_var_to_string(VarSet, no, X))),
         words("has instantiatedness"),
         words(add_quotes(inst_to_string(ModeInfo, InstX))), suffix("."), nl],
-    Spec = error_spec(severity_warning, phase_mode_check,
+    Spec = error_spec(severity_warning,
+        phase_mode_check(report_only_if_in_all_modes),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 %-----------------------------------------------------------------------------%
@@ -1110,7 +1068,7 @@
         words("expected final instantiatedness was"),
         words(add_quotes(inst_to_string(ModeInfo, Inst))),
         suffix("."), nl],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 %-----------------------------------------------------------------------------%
@@ -1142,7 +1100,7 @@
             words("has inst any and appears in the body.")
         ]
     ),
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 %-----------------------------------------------------------------------------%
@@ -1161,11 +1119,21 @@
         words(mercury_vars_to_string(VarSet, no, Vars)),
         suffix("."), nl
     ],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(Context, [always(Preamble ++ Pieces)])]).
 
 %-----------------------------------------------------------------------------%
 
+should_report_mode_warning_for_pred_origin(origin_special_pred(_), no).
+should_report_mode_warning_for_pred_origin(origin_instance_method(_), no).
+should_report_mode_warning_for_pred_origin(origin_transformed(_, _, _), no).
+should_report_mode_warning_for_pred_origin(origin_created(_), no).
+should_report_mode_warning_for_pred_origin(origin_assertion(_, _), no).
+should_report_mode_warning_for_pred_origin(origin_lambda(_, _, _), yes).
+should_report_mode_warning_for_pred_origin(origin_user(_), yes).
+
+%-----------------------------------------------------------------------------%
+
 maybe_report_error_no_modes(PredId, PredInfo, !ModuleInfo, !IO) :-
     pred_info_get_import_status(PredInfo, ImportStatus),
     ( ImportStatus = status_local ->
@@ -1181,7 +1149,8 @@
                     PredId) ++ [suffix("."), nl],
             VerbosePieces =
                 [words("(Use `--infer-modes' to enable mode inference.)"), nl],
-            Spec = error_spec(severity_error, phase_mode_check,
+            Spec = error_spec(severity_error,
+                phase_mode_check(report_in_any_mode),
                 [simple_msg(Context,
                     [always(MainPieces), verbose_only(VerbosePieces)])]),
             module_info_get_globals(!.ModuleInfo, Globals),
@@ -1195,7 +1164,7 @@
         Pieces = [words("Error: no mode declaration for exported")] ++
             describe_one_pred_name(!.ModuleInfo, should_module_qualify, PredId)
             ++ [suffix("."), nl],
-        Spec = error_spec(severity_error, phase_mode_check,
+        Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
             [simple_msg(Context, [always(Pieces)])]),
         module_info_get_globals(!.ModuleInfo, Globals),
         write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
@@ -1314,7 +1283,8 @@
         ),
         Pieces = [words(Verb), words(Detail), nl],
         Msg = simple_msg(Context, [always(Pieces)]),
-        Spec = error_spec(severity_informational, phase_mode_check, [Msg]),
+        Spec = error_spec(severity_informational,
+            phase_mode_check(report_in_any_mode), [Msg]),
         module_info_get_globals(ModuleInfo, Globals),
         write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO)
     ).
@@ -1338,7 +1308,7 @@
         fixed(add_quotes(mode_decl_to_string(NewProcId, PredInfo))),
         words("are indistinguishable.")],
     OldPieces = [words("Here is the conflicting mode declaration.")],
-    Spec = error_spec(severity_error, phase_mode_check,
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
         [simple_msg(NewContext,
             [always(MainPieces), verbose_only(VerbosePieces)]),
         simple_msg(OldContext, [always(OldPieces)])]).
Index: compiler/modecheck_unify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modecheck_unify.m,v
retrieving revision 1.115
diff -u -r1.115 modecheck_unify.m
--- compiler/modecheck_unify.m	15 Jan 2007 10:30:33 -0000	1.115
+++ compiler/modecheck_unify.m	27 May 2007 21:56:03 -0000
@@ -687,25 +687,28 @@
             WarnCannotSucceed, !IO),
         (
             WarnCannotSucceed = yes,
-            InitMayHaveSubtype = init_instmap_may_have_subtype(!.ModeInfo),
             mode_info_get_in_dupl_for_switch(!.ModeInfo, InDupForSwitch),
             (
+                InDupForSwitch = yes
+                %
+                % Suppress the warning, since the unification may succeed
+                % in another copy of this duplicated switch arm.
+                %
+            ;
+                InDupForSwitch = no,
+                mode_info_get_predid(!.ModeInfo, PredId),
+                mode_info_get_module_info(!.ModeInfo, ModuleInfo),
+                module_info_pred_info(ModuleInfo, PredId, PredInfo),
+                pred_info_get_origin(PredInfo, Origin),
+                should_report_mode_warning_for_pred_origin(Origin,
+                    ReportWarning),
                 (
-                    InitMayHaveSubtype = yes
-                    % Suppress the warning, since the unification may succeed
-                    % in another mode in which the initial inst of X,
-                    % or of another head variable that is unified with it,
-                    % is not so constrained.
+                    ReportWarning = yes,
+                    Warning = cannot_succeed_var_functor(X, InstOfX, ConsId),
+                    mode_info_warning(Warning, !ModeInfo)
                 ;
-                    InDupForSwitch = yes
-                    % Suppress the warning, since the unification may succeed
-                    % in another copy of this duplicated switch arm.
+                    ReportWarning = no
                 )
-            ->
-                true
-            ;
-                Warning = cannot_succeed_var_functor(X, InstOfX, ConsId),
-                mode_info_warning(Warning, !ModeInfo)
             )
         ;
             WarnCannotSucceed = no
@@ -985,19 +988,18 @@
             WarnCannotSucceed),
         (
             WarnCannotSucceed = yes,
-            InitMayHaveSubtype = init_instmap_may_have_subtype(!.ModeInfo),
+            mode_get_insts(ModuleInfo0, ModeOfX, InstOfX, _),
+            mode_get_insts(ModuleInfo0, ModeOfY, InstOfY, _),
+            mode_info_get_predid(!.ModeInfo, PredId),
+            module_info_pred_info(ModuleInfo, PredId, PredInfo),
+            pred_info_get_origin(PredInfo, Origin),
+            should_report_mode_warning_for_pred_origin(Origin, ReportWarning),
             (
-                InitMayHaveSubtype = yes
-                % Suppress the warning, since the unification may succeed
-                % in another mode in which the initial inst of X or Y,
-                % or of another head variable that is unified with one of them,
-                % is not so constrained.
-            ;
-                InitMayHaveSubtype = no,
-                mode_get_insts(ModuleInfo0, ModeOfX, InstOfX, _),
-                mode_get_insts(ModuleInfo0, ModeOfY, InstOfY, _),
+                ReportWarning = yes,
                 Warning = cannot_succeed_var_var(X, Y, InstOfX, InstOfY),
                 mode_info_warning(Warning, !ModeInfo)
+            ;
+                ReportWarning = no
             )
         ;
             WarnCannotSucceed = no
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.356
diff -u -r1.356 modes.m
--- compiler/modes.m	17 May 2007 03:52:47 -0000	1.356
+++ compiler/modes.m	27 May 2007 21:56:03 -0000
@@ -135,6 +135,7 @@
 :- import_module hlds.hlds_pred.
 :- import_module hlds.instmap.
 :- import_module parse_tree.
+:- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_data.
 
 :- import_module bool.
@@ -161,19 +162,13 @@
 :- pred check_pred_modes(how_to_check_goal::in, may_change_called_proc::in,
     module_info::in, module_info::out, bool::out, io::di, io::uo) is det.
 
-    % Mode-check or unique-mode-check the code for single predicate.
-    %
-:- pred modecheck_pred_mode(pred_id::in, pred_info::in, how_to_check_goal::in,
-    may_change_called_proc::in, module_info::in, module_info::out,
-    int::out, io::di, io::uo) is det.
-
     % Mode-check the code for the given predicate in a given mode.
     % Returns the number of errs found and a bool `Changed'
     % which is true iff another pass of fixpoint analysis may be needed.
     %
 :- pred modecheck_proc(proc_id::in, pred_id::in,
-    module_info::in, module_info::out, int::out, bool::out,
-    io::di, io::uo) is det.
+    module_info::in, module_info::out, list(error_spec)::out,
+    bool::out, io::di, io::uo) is det.
 
     % Mode-check or unique-mode-check the code for the given predicate
     % in a given mode.
@@ -182,13 +177,7 @@
     %
 :- pred modecheck_proc_general(proc_id::in, pred_id::in, how_to_check_goal::in,
     may_change_called_proc::in, module_info::in, module_info::out,
-    int::out, bool::out, io::di, io::uo) is det.
-
-    % Mode-check the code for the given predicate in the given mode.
-    %
-:- pred modecheck_proc_info(proc_id::in, pred_id::in,
-    module_info::in, module_info::out, proc_info::in, proc_info::out,
-    int::out, io::di, io::uo) is det.
+    list(error_spec)::out, bool::out, io::di, io::uo) is det.
 
 %-----------------------------------------------------------------------------%
 
@@ -519,7 +508,8 @@
         words("(The current limit is"), int_fixed(MaxIterations),
         words("iterations.)"), nl],
     Msg = error_msg(no, no, 0, [always(Pieces)]),
-    Spec = error_spec(severity_error, phase_mode_check, [Msg]),
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
+        [Msg]),
     % XXX _NumErrors
     write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO).
 
@@ -660,13 +650,6 @@
 
 %-----------------------------------------------------------------------------%
 
-    % Mode-check the code for single predicate.
-    %
-modecheck_pred_mode(PredId, PredInfo0, WhatToCheck, MayChangeCalledProc,
-        !ModuleInfo, NumErrors, !IO) :-
-    modecheck_pred_mode_2(PredId, PredInfo0, WhatToCheck,
-        MayChangeCalledProc, !ModuleInfo, no, _, NumErrors, !IO).
-
 :- pred modecheck_pred_mode_2(pred_id::in, pred_info::in,
     how_to_check_goal::in, may_change_called_proc::in,
     module_info::in, module_info::out, bool::in, bool::out, int::out,
@@ -697,52 +680,62 @@
     % inferred as invalid.
     ProcIds = pred_info_procids(PredInfo0),
     modecheck_procs(ProcIds, PredId, WhatToCheck, MayChangeCalledProc,
-        !ModuleInfo, !Changed, 0, NumErrors, !IO).
+        !ModuleInfo, !Changed, init_error_spec_accumulator, ErrorSpecs, !IO),
+    %
+    % Report errors and warnings.
+    %
+    module_info_get_globals(!.ModuleInfo, Globals),
+    ErrorSpecsList = error_spec_accumulator_to_list(ErrorSpecs),
+    write_error_specs(ErrorSpecsList, Globals, 0, _NumWarnings, 0, NumErrors,
+        !IO),
+    module_info_incr_num_errors(NumErrors, !ModuleInfo).
 
     % Iterate over the list of modes for a predicate.
     %
 :- pred modecheck_procs(list(proc_id)::in, pred_id::in, how_to_check_goal::in,
     may_change_called_proc::in, module_info::in, module_info::out,
-    bool::in, bool::out, int::in, int::out, io::di, io::uo) is det.
+    bool::in, bool::out,
+    error_spec_accumulator::in, error_spec_accumulator::out,
+    io::di, io::uo) is det.
 
-modecheck_procs([], _PredId, _, _, !ModuleInfo, !Changed, !Errs, !IO).
+modecheck_procs([], _PredId, _, _, !ModuleInfo, !Changed, !ErrorSpecs, !IO).
 modecheck_procs([ProcId | ProcIds], PredId, WhatToCheck, MayChangeCalledProc,
-        !ModuleInfo, !Changed, !Errs, !IO) :-
+        !ModuleInfo, !Changed, !ErrorSpecs, !IO) :-
     % Mode-check that mode of the predicate.
     maybe_modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
-        !ModuleInfo, !Changed, NumErrors, !IO),
-    !:Errs = !.Errs + NumErrors,
+        !ModuleInfo, !Changed, ProcSpecs, !IO),
+    accumulate_error_specs_for_proc(ProcSpecs, !ErrorSpecs),
     % Recursively process the remaining modes.
     modecheck_procs(ProcIds, PredId, WhatToCheck, MayChangeCalledProc,
-        !ModuleInfo, !Changed, !Errs, !IO).
+        !ModuleInfo, !Changed, !ErrorSpecs, !IO).
 
 %-----------------------------------------------------------------------------%
 
     % Mode-check the code for predicate in a given mode.
     %
-modecheck_proc(ProcId, PredId, !ModuleInfo, NumErrors, Changed, !IO) :-
+modecheck_proc(ProcId, PredId, !ModuleInfo, Errors, Changed, !IO)
+        :-
     modecheck_proc_general(ProcId, PredId, check_modes, may_change_called_proc,
-        !ModuleInfo, NumErrors, Changed, !IO).
+        !ModuleInfo, Errors, Changed, !IO).
 
 modecheck_proc_general(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
-        !ModuleInfo, NumErrors, Changed, !IO) :-
+        !ModuleInfo, Errors, Changed, !IO) :-
     maybe_modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
-        !ModuleInfo, no, Changed, NumErrors, !IO).
+        !ModuleInfo, no, Changed, Errors, !IO).
 
 :- pred maybe_modecheck_proc(proc_id::in, pred_id::in, how_to_check_goal::in,
     may_change_called_proc::in, module_info::in, module_info::out,
-    bool::in, bool::out, int::out, io::di, io::uo) is det.
+    bool::in, bool::out, list(error_spec)::out, io::di, io::uo) is det.
 
 maybe_modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
-        !ModuleInfo, !Changed, NumErrors, !IO) :-
+        !ModuleInfo, !Changed, Errors, !IO) :-
     module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
         _PredInfo0, ProcInfo0),
     ( proc_info_get_can_process(ProcInfo0, no) ->
-        NumErrors = 0
+        Errors = []
     ;
         do_modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
-            !ModuleInfo, ProcInfo0, ProcInfo, !Changed, NumErrors, !IO),
-
+            !ModuleInfo, ProcInfo0, ProcInfo, !Changed, Errors, !IO),
         module_info_preds(!.ModuleInfo, Preds1),
         map.lookup(Preds1, PredId, PredInfo1),
         pred_info_get_procedures(PredInfo1, Procs1),
@@ -752,18 +745,13 @@
         module_info_set_preds(Preds, !ModuleInfo)
     ).
 
-modecheck_proc_info(ProcId, PredId, !ModuleInfo, !ProcInfo, NumErrors, !IO) :-
-    WhatToCheck = check_modes,
-    do_modecheck_proc(ProcId, PredId, WhatToCheck, may_change_called_proc,
-        !ModuleInfo, !ProcInfo, no, _Changed, NumErrors, !IO).
-
 :- pred do_modecheck_proc(proc_id::in, pred_id::in, how_to_check_goal::in,
     may_change_called_proc::in, module_info::in, module_info::out,
-    proc_info::in, proc_info::out, bool::in, bool::out, int::out,
-    io::di, io::uo) is det.
+    proc_info::in, proc_info::out, bool::in, bool::out, 
+    list(error_spec)::out, io::di, io::uo) is det.
 
 do_modecheck_proc(ProcId, PredId, WhatToCheck, MayChangeCalledProc,
-        !ModuleInfo, !ProcInfo, !Changed, NumErrors, !IO) :-
+        !ModuleInfo, !ProcInfo, !Changed, ErrorAndWarningSpecs, !IO) :-
     % Extract the useful fields in the proc_info.
     proc_info_get_headvars(!.ProcInfo, HeadVars),
     proc_info_get_argmodes(!.ProcInfo, ArgModes0),
@@ -920,22 +908,34 @@
                 ArgFinalInsts, Body1, Body, !ModeInfo)
         ),
 
+        mode_info_get_errors(!.ModeInfo, ModeErrors),
         (
             InferModes = yes,
             % For inferred predicates, we don't report the error(s) here;
             % instead we just save them in the proc_info, thus marking that
-            % procedure as invalid. Uncommenting the next call is sometimes
-            % handy for debugging:
-            % report_mode_errors(!ModeInfo),
-            mode_info_get_errors(!.ModeInfo, ModeErrors),
+            % procedure as invalid.
             !:ProcInfo = !.ProcInfo ^ mode_errors := ModeErrors,
-            NumErrors = 0
+            ErrorAndWarningSpecs = []
         ;
             InferModes = no,
-            % Report any errors we found.
-            report_mode_errors(!ModeInfo, !IO),
-            mode_info_get_num_errors(!.ModeInfo, NumErrors),
-            report_mode_warnings(!ModeInfo, !IO)
+            AllErrorSpecs = list.map(mode_error_info_to_spec(!.ModeInfo),
+                ModeErrors),
+            %
+            % We only return the first error, because there could be a
+            % large number of mode errors and usually only one is needed to
+            % diagnose the problem.
+            %
+            (
+                AllErrorSpecs = [ErrorSpec | _],
+                ErrorSpecs = [ErrorSpec]
+            ;
+                AllErrorSpecs = [],
+                ErrorSpecs = []
+            ),
+            mode_info_get_warnings(!.ModeInfo, ModeWarnings),
+            WarningSpecs = list.map(mode_warning_info_to_spec(!.ModeInfo),
+                ModeWarnings),
+            list.append(ErrorSpecs, WarningSpecs, ErrorAndWarningSpecs)
         ),
         % Save away the results.
         inst_lists_to_mode_list(ArgInitialInsts, ArgFinalInsts, ArgModes),
@@ -3397,7 +3397,8 @@
         words("is not currently implemented."), nl],
     Msg = simple_msg(Context,
         [always(MainPieces), verbose_only(VerbosePieces)]),
-    Spec = error_spec(severity_error, phase_mode_check, [Msg]),
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
+        [Msg]),
     module_info_get_globals(!.ModuleInfo, Globals),
     write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
     module_info_incr_num_errors(NumErrors, !ModuleInfo).
@@ -3420,7 +3421,8 @@
         words("in them no longer being unique."), nl],
     Msg = simple_msg(Context,
         [always(MainPieces), verbose_only(VerbosePieces)]),
-    Spec = error_spec(severity_error, phase_mode_check, [Msg]),
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
+        [Msg]),
     module_info_get_globals(!.ModuleInfo, Globals),
     write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
     module_info_incr_num_errors(NumErrors, !ModuleInfo).
@@ -3432,7 +3434,8 @@
     proc_info_get_context(ProcInfo, Context),
     Pieces = [words("Error: main/2 must have mode `(di, uo)'."), nl],
     Msg = simple_msg(Context, [always(Pieces)]),
-    Spec = error_spec(severity_error, phase_mode_check, [Msg]),
+    Spec = error_spec(severity_error, phase_mode_check(report_in_any_mode),
+        [Msg]),
     module_info_get_globals(!.ModuleInfo, Globals),
     write_error_spec(Spec, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
     module_info_incr_num_errors(NumErrors, !ModuleInfo).
Index: compiler/pd_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pd_util.m,v
retrieving revision 1.61
diff -u -r1.61 pd_util.m
--- compiler/pd_util.m	19 Jan 2007 07:04:25 -0000	1.61
+++ compiler/pd_util.m	27 May 2007 21:56:04 -0000
@@ -292,14 +292,17 @@
     mode_info_init(ModuleInfo1, PredId, ProcId, Context, LiveVars, InstMap0,
         check_unique_modes, MayChangeCalledProc, ModeInfo0),
 
-    unique_modes_check_goal(Goal0, Goal, ModeInfo0, ModeInfo1, !IO),
+    unique_modes_check_goal(Goal0, Goal, ModeInfo0, ModeInfo, !IO),
     globals.io_lookup_bool_option(debug_pd, Debug, !IO),
     (
         Debug = yes,
-        report_mode_errors(ModeInfo1, ModeInfo, !IO)
+        mode_info_get_errors(ModeInfo, ModeErrors),
+        ErrorSpecs = list.map(mode_error_info_to_spec(ModeInfo), ModeErrors),
+        module_info_get_globals(ModuleInfo, Globals),
+        write_error_specs(ErrorSpecs, Globals, 0, _NumWarnings, 0, _NumErrors,
+            !IO)
     ;
-        Debug = no,
-        ModeInfo = ModeInfo1
+        Debug = no
     ),
     mode_info_get_errors(ModeInfo, Errors),
 
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.210
diff -u -r1.210 simplify.m
--- compiler/simplify.m	17 May 2007 03:52:50 -0000	1.210
+++ compiler/simplify.m	27 May 2007 21:56:04 -0000
@@ -310,30 +310,24 @@
     ;
         Simplifications = Simplifications0
     ),
-    MaybeSpecs0 = no,
+    ErrorSpecs0 = init_error_spec_accumulator,
     simplify_procs(Simplifications, PredId, ProcIds, !ModuleInfo, !PredInfo,
-        MaybeSpecs0, MaybeSpecs, !IO),
+        ErrorSpecs0, ErrorSpecs, !IO),
     module_info_get_globals(!.ModuleInfo, Globals),
-    (
-        MaybeSpecs = yes(AnyModeSpecSet - AllModeSpecSet),
-        set.union(AnyModeSpecSet, AllModeSpecSet, SpecSet),
-        set.to_sorted_list(SpecSet, NewSpecs),
-        !:Specs = NewSpecs ++ !.Specs
-    ;
-        MaybeSpecs = no
-    ),
+    SpecsList = error_spec_accumulator_to_list(ErrorSpecs),
+    !:Specs = SpecsList ++ !.Specs,
     globals.lookup_bool_option(Globals, detailed_statistics, Statistics),
     maybe_report_stats(Statistics, !IO).
 
 :- pred simplify_procs(simplifications::in, pred_id::in,
     list(proc_id)::in, module_info::in, module_info::out,
     pred_info::in, pred_info::out,
-    maybe(pair(set(error_spec)))::in, maybe(pair(set(error_spec)))::out,
+    error_spec_accumulator::in, error_spec_accumulator::out,
     io::di, io::uo) is det.
 
-simplify_procs(_, _, [], !ModuleInfo, !PredInfo, !MaybeSpecs, !IO).
+simplify_procs(_, _, [], !ModuleInfo, !PredInfo, !ErrorSpecs, !IO).
 simplify_procs(Simplifications, PredId, [ProcId | ProcIds], !ModuleInfo,
-        !PredInfo, !MaybeSpecs, !IO) :-
+        !PredInfo, !ErrorSpecs, !IO) :-
     pred_info_get_procedures(!.PredInfo, ProcTable0),
     map.lookup(ProcTable0, ProcId, ProcInfo0),
     simplify_proc_return_msgs(Simplifications, PredId, ProcId,
@@ -359,23 +353,9 @@
     ),
     map.det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
     pred_info_set_procedures(ProcTable, !PredInfo),
-
-    list.filter((pred(error_spec(_, Phase, _)::in) is semidet :-
-            Phase = phase_simplify(report_only_if_in_all_modes)
-        ), ProcSpecs, ProcAllModeSpecs, ProcAnyModeSpecs),
-    set.sorted_list_to_set(ProcAnyModeSpecs, ProcAnyModeSpecSet),
-    set.sorted_list_to_set(ProcAllModeSpecs, ProcAllModeSpecSet),
-    (
-        !.MaybeSpecs = yes(AnyModeSpecSet0 - AllModeSpecSet0),
-        set.union(AnyModeSpecSet0, ProcAnyModeSpecSet, AnyModeSpecSet),
-        set.intersect(AllModeSpecSet0, ProcAllModeSpecSet, AllModeSpecSet),
-        !:MaybeSpecs = yes(AllModeSpecSet - AnyModeSpecSet)
-    ;
-        !.MaybeSpecs = no,
-        !:MaybeSpecs = yes(ProcAnyModeSpecSet - ProcAllModeSpecSet)
-    ),
+    accumulate_error_specs_for_proc(ProcSpecs, !ErrorSpecs),
     simplify_procs(Simplifications, PredId, ProcIds, !ModuleInfo, !PredInfo,
-        !MaybeSpecs, !IO).
+        !ErrorSpecs, !IO).
 
 simplify_proc(Simplifications, PredId, ProcId, !ModuleInfo, !ProcInfo, !IO)  :-
     write_pred_progress_message("% Simplifying ", PredId, !.ModuleInfo, !IO),
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.186
diff -u -r1.186 unify_proc.m
--- compiler/unify_proc.m	17 May 2007 03:52:55 -0000	1.186
+++ compiler/unify_proc.m	27 May 2007 21:56:04 -0000
@@ -162,6 +162,7 @@
 :- import_module libs.globals.
 :- import_module libs.options.
 :- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_mode.
 :- import_module parse_tree.prog_type.
 :- import_module parse_tree.prog_util.
@@ -474,9 +475,12 @@
     module_info_set_preds(Preds1, !ModuleInfo),
 
     % Modecheck the procedure.
-    modecheck_proc(ProcId, PredId, !ModuleInfo, NumErrors, !:Changed, !IO),
-    ( NumErrors \= 0 ->
-        io.set_exit_status(1, !IO),
+    modecheck_proc(ProcId, PredId, !ModuleInfo, ErrorSpecs, !:Changed, !IO),
+
+    module_info_get_globals(!.ModuleInfo, Globals),
+    write_error_specs(ErrorSpecs, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
+    module_info_incr_num_errors(NumErrors, !ModuleInfo),
+    ( NumErrors > 0 ->
         module_info_remove_predid(PredId, !ModuleInfo)
     ;
         (
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.120
diff -u -r1.120 unique_modes.m
--- compiler/unique_modes.m	15 Jan 2007 10:30:36 -0000	1.120
+++ compiler/unique_modes.m	27 May 2007 21:56:04 -0000
@@ -92,6 +92,7 @@
 :- import_module libs.compiler_util.
 :- import_module mdbcomp.
 :- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_mode.
 
 :- import_module bag.
@@ -111,12 +112,10 @@
 
 unique_modes_check_proc(ProcId, PredId, !ModuleInfo, Changed, !IO) :-
     modecheck_proc_general(ProcId, PredId, check_unique_modes,
-        may_change_called_proc, !ModuleInfo, NumErrors, Changed, !IO),
-    ( NumErrors \= 0 ->
-        io.set_exit_status(1, !IO)
-    ;
-        true
-    ).
+        may_change_called_proc, !ModuleInfo, ErrorSpecs, Changed, !IO),
+    module_info_get_globals(!.ModuleInfo, Globals),
+    write_error_specs(ErrorSpecs, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
+    module_info_incr_num_errors(NumErrors, !ModuleInfo).
 
 unique_modes_check_goal(Goal0, Goal, !ModeInfo, !IO) :-
     Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
Index: tests/invalid/ho_type_mode_bug.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/ho_type_mode_bug.err_exp,v
retrieving revision 1.8
diff -u -r1.8 ho_type_mode_bug.err_exp
--- tests/invalid/ho_type_mode_bug.err_exp	17 May 2007 03:53:13 -0000	1.8
+++ tests/invalid/ho_type_mode_bug.err_exp	27 May 2007 21:56:04 -0000
@@ -1,16 +1,16 @@
 ho_type_mode_bug.m:026: In clause for `my_foldl2((pred(in, in, out) is det),
-ho_type_mode_bug.m:026:   in, in, out, in, out)':
+ho_type_mode_bug.m:026:   in, in, out, di, uo)':
 ho_type_mode_bug.m:026:   mode error in conjunction. The next 4 error messages
 ho_type_mode_bug.m:026:   indicate possible causes of this error.
 ho_type_mode_bug.m:025:   In clause for `my_foldl2((pred(in, in, out) is det),
-ho_type_mode_bug.m:025:   in, in, out, in, out)':
+ho_type_mode_bug.m:025:   in, in, out, di, uo)':
 ho_type_mode_bug.m:025:   in argument 1 (i.e. the predicate term) of
 ho_type_mode_bug.m:025:   higher-order predicate call:
 ho_type_mode_bug.m:025:   mode error: variable `P' has instantiatedness
 ho_type_mode_bug.m:025:   `(pred(in, in, out) is det)',
 ho_type_mode_bug.m:025:   expecting higher-order pred inst (of arity 5).
 ho_type_mode_bug.m:026:   In clause for `my_foldl2((pred(in, in, out) is det),
-ho_type_mode_bug.m:026:   in, in, out, in, out)':
+ho_type_mode_bug.m:026:   in, in, out, di, uo)':
 ho_type_mode_bug.m:026:   in call to predicate `ho_type_mode_bug.my_foldl2'/6:
 ho_type_mode_bug.m:026:   mode error: arguments
 ho_type_mode_bug.m:026:   `TypeInfo_for_X, TypeInfo_for_Y, TypeInfo_for_Z, P, T, FirstAcc1, FirstAcc, SecAcc1, SecAcc'
@@ -27,32 +27,32 @@
 ho_type_mode_bug.m:026:   which does not match any of the modes for predicate
 ho_type_mode_bug.m:026:   `ho_type_mode_bug.my_foldl2'/6.
 ho_type_mode_bug.m:024:   In clause for `my_foldl2((pred(in, in, out) is det),
-ho_type_mode_bug.m:024:   in, in, out, in, out)':
+ho_type_mode_bug.m:024:   in, in, out, di, uo)':
 ho_type_mode_bug.m:024:   in argument 4 of clause head:
 ho_type_mode_bug.m:024:   mode error in unification of `HeadVar__4' and
 ho_type_mode_bug.m:024:   `FirstAcc'.
 ho_type_mode_bug.m:024:   Variable `HeadVar__4' has instantiatedness `free',
 ho_type_mode_bug.m:024:   variable `FirstAcc' has instantiatedness `free'.
 ho_type_mode_bug.m:024:   In clause for `my_foldl2((pred(in, in, out) is det),
-ho_type_mode_bug.m:024:   in, in, out, in, out)':
+ho_type_mode_bug.m:024:   in, in, out, di, uo)':
 ho_type_mode_bug.m:024:   in argument 6 of clause head:
 ho_type_mode_bug.m:024:   mode error in unification of `HeadVar__6' and
 ho_type_mode_bug.m:024:   `SecAcc'.
 ho_type_mode_bug.m:024:   Variable `HeadVar__6' has instantiatedness `free',
 ho_type_mode_bug.m:024:   variable `SecAcc' has instantiatedness `free'.
 ho_type_mode_bug.m:026: In clause for `my_foldl2((pred(in, in, out) is det),
-ho_type_mode_bug.m:026:   in, in, out, di, uo)':
+ho_type_mode_bug.m:026:   in, in, out, in, out)':
 ho_type_mode_bug.m:026:   mode error in conjunction. The next 4 error messages
 ho_type_mode_bug.m:026:   indicate possible causes of this error.
 ho_type_mode_bug.m:025:   In clause for `my_foldl2((pred(in, in, out) is det),
-ho_type_mode_bug.m:025:   in, in, out, di, uo)':
+ho_type_mode_bug.m:025:   in, in, out, in, out)':
 ho_type_mode_bug.m:025:   in argument 1 (i.e. the predicate term) of
 ho_type_mode_bug.m:025:   higher-order predicate call:
 ho_type_mode_bug.m:025:   mode error: variable `P' has instantiatedness
 ho_type_mode_bug.m:025:   `(pred(in, in, out) is det)',
 ho_type_mode_bug.m:025:   expecting higher-order pred inst (of arity 5).
 ho_type_mode_bug.m:026:   In clause for `my_foldl2((pred(in, in, out) is det),
-ho_type_mode_bug.m:026:   in, in, out, di, uo)':
+ho_type_mode_bug.m:026:   in, in, out, in, out)':
 ho_type_mode_bug.m:026:   in call to predicate `ho_type_mode_bug.my_foldl2'/6:
 ho_type_mode_bug.m:026:   mode error: arguments
 ho_type_mode_bug.m:026:   `TypeInfo_for_X, TypeInfo_for_Y, TypeInfo_for_Z, P, T, FirstAcc1, FirstAcc, SecAcc1, SecAcc'
@@ -69,14 +69,14 @@
 ho_type_mode_bug.m:026:   which does not match any of the modes for predicate
 ho_type_mode_bug.m:026:   `ho_type_mode_bug.my_foldl2'/6.
 ho_type_mode_bug.m:024:   In clause for `my_foldl2((pred(in, in, out) is det),
-ho_type_mode_bug.m:024:   in, in, out, di, uo)':
+ho_type_mode_bug.m:024:   in, in, out, in, out)':
 ho_type_mode_bug.m:024:   in argument 4 of clause head:
 ho_type_mode_bug.m:024:   mode error in unification of `HeadVar__4' and
 ho_type_mode_bug.m:024:   `FirstAcc'.
 ho_type_mode_bug.m:024:   Variable `HeadVar__4' has instantiatedness `free',
 ho_type_mode_bug.m:024:   variable `FirstAcc' has instantiatedness `free'.
 ho_type_mode_bug.m:024:   In clause for `my_foldl2((pred(in, in, out) is det),
-ho_type_mode_bug.m:024:   in, in, out, di, uo)':
+ho_type_mode_bug.m:024:   in, in, out, in, out)':
 ho_type_mode_bug.m:024:   in argument 6 of clause head:
 ho_type_mode_bug.m:024:   mode error in unification of `HeadVar__6' and
 ho_type_mode_bug.m:024:   `SecAcc'.
Index: tests/invalid/qualified_cons_id2.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/qualified_cons_id2.err_exp,v
retrieving revision 1.10
diff -u -r1.10 qualified_cons_id2.err_exp
--- tests/invalid/qualified_cons_id2.err_exp	7 Sep 2006 05:51:31 -0000	1.10
+++ tests/invalid/qualified_cons_id2.err_exp	27 May 2007 21:56:04 -0000
@@ -2,6 +2,14 @@
 qualified_cons_id2.m:015:   `qualified_cons_id2.test'/2:
 qualified_cons_id2.m:015:   error: duplicate mode declaration.
 qualified_cons_id2.m:016:   Here is the conflicting mode declaration.
+qualified_cons_id2.m:020: In clause for
+qualified_cons_id2.m:020:   `test(in(bound(qualified_cons_id2.yes(ground))),
+qualified_cons_id2.m:020:   out)':
+qualified_cons_id2.m:020:   in argument 1 of clause head:
+qualified_cons_id2.m:020:   warning: unification of `HeadVar__1' and maybe.yes
+qualified_cons_id2.m:020:   cannot succeed
+qualified_cons_id2.m:020:   `HeadVar__1' has instantiatedness
+qualified_cons_id2.m:020:   `bound(qualified_cons_id2.yes(ground))'.
 qualified_cons_id2.m:015: In `test'(in(bound(qualified_cons_id2.yes(ground))),
 qualified_cons_id2.m:015:   out):
 qualified_cons_id2.m:015:   error: determinism declaration not satisfied.
Index: tests/warnings/simple_code.exp
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/simple_code.exp,v
retrieving revision 1.15
diff -u -r1.15 simple_code.exp
--- tests/warnings/simple_code.exp	7 Sep 2006 05:51:47 -0000	1.15
+++ tests/warnings/simple_code.exp	27 May 2007 21:56:04 -0000
@@ -1,6 +1,10 @@
 simple_code.m:018: In clause for `p(in, out)':
 simple_code.m:018:   warning: unification of `X' and 2 cannot succeed
 simple_code.m:018:   `X' has instantiatedness `unique(3)'.
+simple_code.m:064: In clause for `r(in(bound(1)), out(bound(42)))':
+simple_code.m:064:   in argument 1 of clause head:
+simple_code.m:064:   warning: unification of `HeadVar__1' and 2 cannot succeed
+simple_code.m:064:   `HeadVar__1' has instantiatedness `bound(1)'.
 simple_code.m:010: Warning: this disjunct will never have any solutions.
 simple_code.m:015: Warning: the condition of this if-then-else cannot fail.
 simple_code.m:020: Warning: the condition of this if-then-else cannot succeed.
@@ -13,4 +17,4 @@
 simple_code.m:039: Warning: call to obsolete predicate
 simple_code.m:039:   `simple_code.obsolete'/0.
 simple_code.m:042: Warning: the condition of this if-then-else cannot fail.
-simple_code.m:099: Warning: recursive call will lead to infinite recursion.
+simple_code.m:097: Warning: recursive call will lead to infinite recursion.
Index: tests/warnings/simple_code.m
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/simple_code.m,v
retrieving revision 1.4
diff -u -r1.4 simple_code.m
--- tests/warnings/simple_code.m	16 Apr 1999 08:08:08 -0000	1.4
+++ tests/warnings/simple_code.m	27 May 2007 21:56:04 -0000
@@ -57,8 +57,6 @@
 obsolete.
 
 % This should give a warning about the second disjunct never succeeding.
-% XXX Currently it doesn't, because mode analysis simplifies away the
-% whole disjunction.
 :- pred r(int, int).
 :- mode r(in(bound(1)), out(bound(42))) is det.
 
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list