[m-rev.] for post-commit review: error_specs in the rest of the front end

Zoltan Somogyi zs at csse.unimelb.edu.au
Tue Jul 21 14:10:10 AEST 2009


Make all the front-end passes that do not currently return errors as a
list of error specifications do so. Use trace goals to print progress and
debugging messages.

compiler/implementation_defined_literals.m:
compiler/inst_check.m:
compiler/polymorphism.m:
compiler/simplify.m:
compiler/stratify.m:
compiler/switch_detection.m:
compiler/try_expand.m:
	Effect the change described above.

	In stratify.m, replace some booleans with purpose-specific types.

compiler/error_util.m:
	Add support for inst_check.m's new needs.

compiler/passes_aux.m:
	Update the traversal alternative used by simplify to meet simplify's
	new needs.

compiler/mercury_compile.m:
	Conform to the changes above. Amongst other things, this means
	printing the error specifications returned by the various passes.

compiler/structure_sharing.analysis.m:
	Conform to the changes above.

compiler/prop_mode_constraints.m:
	Minor style cleanups.

tests/warnings/inst_with_no_type.exp:
	Expect the new, properly sorted output.

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/error_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/error_util.m,v
retrieving revision 1.69
diff -u -b -r1.69 error_util.m
--- compiler/error_util.m	21 Jul 2009 02:08:48 -0000	1.69
+++ compiler/error_util.m	21 Jul 2009 02:33:17 -0000
@@ -109,6 +109,7 @@
     ;       phase_parse_tree_to_hlds
     ;       phase_expand_types
     ;       phase_type_check
+    ;       phase_inst_check
     ;       phase_mode_check(mode_report_control)
     ;       phase_purity_check
     ;       phase_detism_check
@@ -667,6 +668,7 @@
 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_inst_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.
Index: compiler/implementation_defined_literals.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/implementation_defined_literals.m,v
retrieving revision 1.4
diff -u -b -r1.4 implementation_defined_literals.m
--- compiler/implementation_defined_literals.m	11 Jun 2009 07:00:10 -0000	1.4
+++ compiler/implementation_defined_literals.m	21 Jul 2009 02:17:46 -0000
@@ -21,10 +21,7 @@
 
 :- import_module hlds.hlds_module.
 
-:- import_module io.
-
-:- pred subst_impl_defined_literals(module_info::in, module_info::out,
-    io::di, io::uo) is det.
+:- pred subst_impl_defined_literals(module_info::in, module_info::out) is det.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -57,7 +54,7 @@
 
 %-----------------------------------------------------------------------------%
 
-subst_impl_defined_literals(!ModuleInfo, !IO) :-
+subst_impl_defined_literals(!ModuleInfo) :-
     module_info_preds(!.ModuleInfo, Preds0),
     map.map_values(subst_literals_in_pred(!.ModuleInfo), Preds0, Preds),
     module_info_set_preds(Preds, !ModuleInfo).
Index: compiler/inst_check.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_check.m,v
retrieving revision 1.12
diff -u -b -r1.12 inst_check.m
--- compiler/inst_check.m	11 Jun 2009 07:00:10 -0000	1.12
+++ compiler/inst_check.m	21 Jul 2009 02:17:46 -0000
@@ -22,16 +22,18 @@
 :- module check_hlds.inst_check.
 :- interface.
 
-:- import_module io.
-
 :- import_module hlds.
 :- import_module hlds.hlds_module.
+:- import_module parse_tree.
+:- import_module parse_tree.error_util.
+
+:- import_module list.
 
     % This predicate issues a warning for each user defined bound inst
     % that is not consistent with at least one type in scope.
     %
 :- pred check_insts_have_matching_types(module_info::in,
-    io::di, io::uo) is det.
+    list(error_spec)::in, list(error_spec)::out) is det.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -40,7 +42,6 @@
 
 :- import_module assoc_list.
 :- import_module bool.
-:- import_module list.
 :- import_module map.
 :- import_module maybe.
 :- import_module multi_map.
@@ -54,13 +55,12 @@
 :- import_module mdbcomp.
 :- import_module mdbcomp.prim_data.
 :- import_module parse_tree.
-:- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_data.
 :- import_module parse_tree.prog_type.
 
 %-----------------------------------------------------------------------------%
 
-check_insts_have_matching_types(Module, !IO) :-
+check_insts_have_matching_types(Module, !Specs) :-
     module_info_get_inst_table(Module, InstTable),
     inst_table_get_user_insts(InstTable, UserInstTable),
     user_inst_table_get_inst_defns(UserInstTable, InstDefs),
@@ -74,7 +74,7 @@
     FunctorsToTypeDefs = index_types_by_unqualified_functors(
         UserVisibleTypeDefs),
     list.foldl(check_inst(FunctorsToTypeDefs), InstIdDefPairsForCurrentModule,
-        !IO).
+        !Specs).
 
     % Returns yes if a type definition with the given import status
     % is user visible in a section of the current module.
@@ -140,9 +140,9 @@
     ;       type_tuple(arity).
 
 :- pred check_inst(functors_to_types::in, pair(inst_id, hlds_inst_defn)::in,
-    io::di, io::uo) is det.
+    list(error_spec)::in, list(error_spec)::out) is det.
 
-check_inst(FunctorsToTypes, InstId - InstDef, !IO) :-
+check_inst(FunctorsToTypes, InstId - InstDef, !Specs) :-
     InstBody = InstDef ^ inst_body,
     (
         InstBody = eqv_inst(Inst),
@@ -154,7 +154,7 @@
                 list.map(find_types_for_functor(FunctorsToTypes),
                     Functors, MatchingTypeLists),
                 maybe_issue_inst_check_warning(InstId, InstDef,
-                    MatchingTypeLists, !IO)
+                    MatchingTypeLists, !Specs)
             ;
                 true
             )
@@ -175,9 +175,10 @@
     ).
 
 :- pred maybe_issue_inst_check_warning(inst_id::in, hlds_inst_defn::in,
-    list(list(type_defn_or_builtin))::in, io::di, io::uo) is det.
+    list(list(type_defn_or_builtin))::in,
+    list(error_spec)::in, list(error_spec)::out) is det.
 
-maybe_issue_inst_check_warning(InstId, InstDef, MatchingTypeLists, !IO) :-
+maybe_issue_inst_check_warning(InstId, InstDef, MatchingTypeLists, !Specs) :-
     InstImportStatus = InstDef ^ inst_status,
     InstIsExported = status_is_exported_to_non_submodules(InstImportStatus),
     (
@@ -206,12 +207,12 @@
     ->
         Context = InstDef ^ inst_context,
         InstId = inst_id(InstName, InstArity),
-        Warning = [
-            words("Warning: inst "),
+        Pieces = [words("Warning: inst "),
             sym_name_and_arity(InstName / InstArity),
-            words("does not match any of the types in scope.")
-        ],
-        report_warning(Context, 0, Warning, !IO)
+            words("does not match any of the types in scope.")],
+        Spec = error_spec(severity_warning, phase_inst_check,
+            [simple_msg(Context, [always(Pieces)])]),
+        !:Specs = [Spec | !.Specs]
     ;
         true
     ).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.497
diff -u -b -r1.497 mercury_compile.m
--- compiler/mercury_compile.m	21 Jul 2009 02:08:48 -0000	1.497
+++ compiler/mercury_compile.m	21 Jul 2009 02:33:17 -0000
@@ -2174,7 +2174,10 @@
         WarnInstsWithNoMatchingType = yes,
         maybe_write_string(Verbose,
             "% Checking that insts have matching types... ", !IO),
-        check_hlds.inst_check.check_insts_have_matching_types(!.HLDS, !IO),
+        check_hlds.inst_check.check_insts_have_matching_types(!.HLDS,
+            [], InstSpecs),
+        write_error_specs(InstSpecs, Globals,
+            0, _NumInstWarnings, 0, _NumInstErrors, !IO),
         maybe_write_string(Verbose, "done.\n", !IO),
         maybe_dump_hlds(!.HLDS, 12, "warn_insts_without_matching_type",
             !DumpInfo, !IO)
@@ -3071,7 +3074,7 @@
     Simplifications = list_to_simplifications(SimpList),
     write_proc_progress_message("% Simplifying ", PredId, ProcId,
         !.HLDS, !IO),
-    simplify_proc(Simplifications, PredId, ProcId, !HLDS, !ProcInfo, !IO),
+    simplify_proc(Simplifications, PredId, ProcId, !HLDS, !ProcInfo),
     write_proc_progress_message("% Computing liveness in ", PredId, ProcId,
         !.HLDS, !IO),
     detect_liveness_proc(PredId, ProcId, !.HLDS, !ProcInfo, !IO),
@@ -3215,7 +3218,7 @@
 detect_switches(Verbose, Stats, !HLDS, !IO) :-
     maybe_write_string(Verbose, "% Detecting switches...\n", !IO),
     maybe_flush_output(Verbose, !IO),
-    detect_switches(!HLDS, !IO),
+    detect_switches_in_module(!HLDS),
     maybe_write_string(Verbose, "% done.\n", !IO),
     maybe_report_stats(Stats, !IO).
 
@@ -3419,9 +3422,11 @@
             "% Checking stratification...\n", !IO),
         io.get_exit_status(OldStatus, !IO),
         io.set_exit_status(0, !IO),
-        stratify.check_stratification(!HLDS, !IO),
-        io.get_exit_status(NewStatus, !IO),
-        ( NewStatus \= 0 ->
+        stratify.check_stratification(!HLDS, [], Specs),
+        module_info_get_globals(!.HLDS, Globals),
+        write_error_specs(Specs, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
+        module_info_incr_num_errors(NumErrors, !HLDS),
+        ( NumErrors > 0 ->
             FoundError = yes,
             maybe_write_string(Verbose,
                 "% Program contains stratification error(s).\n", !IO)
@@ -3440,11 +3445,12 @@
 
 process_try_goals(Verbose, Stats, !HLDS, FoundError, !IO) :-
     maybe_write_string(Verbose, "% Transforming try goals...\n", !IO),
-    module_info_get_num_errors(!.HLDS, NumErrors0),
-    expand_try_goals(!HLDS, !IO),
-    module_info_get_num_errors(!.HLDS, NumErrors),
+    expand_try_goals_in_module(!HLDS, [], Specs),
+    module_info_get_globals(!.HLDS, Globals),
+    write_error_specs(Specs, Globals, 0, _NumWarnings, 0, NumErrors, !IO),
+    module_info_incr_num_errors(NumErrors, !HLDS),
     maybe_write_string(Verbose, "% done.\n", !IO),
-    ( NumErrors \= NumErrors0 ->
+    ( NumErrors > 0 ->
         FoundError = yes,
         maybe_write_string(Verbose, "% Program contains error(s).\n", !IO),
         io.set_exit_status(1, !IO)
@@ -3834,7 +3840,7 @@
     maybe_write_string(Verbose,
         "% Substituting implementation-defined literals...\n", !IO),
     maybe_flush_output(Verbose, !IO),
-    subst_impl_defined_literals(!HLDS, !IO),
+    subst_impl_defined_literals(!HLDS),
     maybe_write_string(Verbose, "% done.\n", !IO),
     maybe_report_stats(Stats, !IO).
 
@@ -3857,7 +3863,7 @@
                 "% Transforming polymorphic unifications...\n", !IO)
         ),
         maybe_flush_output(Verbose, !IO),
-        polymorphism_process_module(!HLDS, !IO),
+        polymorphism_process_module(!HLDS),
         (
             VeryVerbose = no,
             maybe_write_string(Verbose, " done.\n", !IO)
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.91
diff -u -b -r1.91 passes_aux.m
--- compiler/passes_aux.m	25 Nov 2008 07:46:42 -0000	1.91
+++ compiler/passes_aux.m	21 Jul 2009 02:17:46 -0000
@@ -81,8 +81,7 @@
         ;   update_proc_io(pred(in, in, in, in, out, di, uo) is det)
         ;   update_proc_error(pred(in, in, in, out, in, out, out, out, di, uo)
                 is det)
-        ;   update_pred_error(pred(in, in, out, in, out, in, out, di, uo)
-                is det)
+        ;   update_pred_error(pred(in, in, out, in, out, in, out) is det)
         ;   update_module(pred(in, in, in, in, out, in, out) is det)
         ;   update_module_io(pred(in, in, in, out, in, out, di, uo) is det)
         ;   update_module_cookie(pred(in, in, in, out, in, out, in, out)
@@ -93,10 +92,10 @@
 
 :- type pred_error_task ==
         pred(pred_id, module_info, module_info, pred_info, pred_info,
-            list(error_spec), list(error_spec), io, io).
+            list(error_spec), list(error_spec)).
 
 :- inst pred_error_task ==
-    (pred(in, in, out, in, out, in, out, di, uo) is det).
+    (pred(in, in, out, in, out, in, out) is det).
 
 :- pred process_all_nonimported_procs_errors(task::task,
     module_info::in, module_info::out,
@@ -205,8 +204,8 @@
         !Specs, !IO) :-
     module_info_predids(PredIds, !ModuleInfo),
     ( Task = update_pred_error(Pred) ->
-        list.foldl3(process_nonimported_pred(Pred, Filter), PredIds,
-            !ModuleInfo, !Specs, !IO)
+        list.foldl2(process_nonimported_pred(Pred, Filter), PredIds,
+            !ModuleInfo, !Specs)
     ;
         process_nonimported_procs_in_preds(PredIds, Task, _, Filter,
             !ModuleInfo, !IO)
@@ -234,9 +233,9 @@
 :- pred process_nonimported_pred(pred_error_task::in(pred_error_task),
     pred(pred_info)::in(pred(in) is semidet), pred_id::in,
     module_info::in, module_info::out,
-    list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
+    list(error_spec)::in, list(error_spec)::out) is det.
 
-process_nonimported_pred(Task, Filter, PredId, !ModuleInfo, !Specs, !IO) :-
+process_nonimported_pred(Task, Filter, PredId, !ModuleInfo, !Specs) :-
     module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
     (
         ( pred_info_is_imported(PredInfo0)
@@ -245,7 +244,7 @@
     ->
         true
     ;
-        Task(PredId, !ModuleInfo, PredInfo0, PredInfo, !Specs, !IO),
+        Task(PredId, !ModuleInfo, PredInfo0, PredInfo, !Specs),
         module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
     ).
 
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.340
diff -u -b -r1.340 polymorphism.m
--- compiler/polymorphism.m	11 Jun 2009 07:00:16 -0000	1.340
+++ compiler/polymorphism.m	21 Jul 2009 02:17:46 -0000
@@ -186,7 +186,6 @@
 :- import_module parse_tree.
 :- import_module parse_tree.prog_data.
 
-:- import_module io.
 :- import_module list.
 :- import_module maybe.
 :- import_module term.
@@ -195,8 +194,7 @@
 
     % Run the polymorphism pass over the whole HLDS.
     %
-:- pred polymorphism_process_module(module_info::in, module_info::out,
-    io::di, io::uo) is det.
+:- pred polymorphism_process_module(module_info::in, module_info::out) is det.
 
     % Run the polymorphism pass over a single pred. This is used to transform
     % clauses introduced by unify_proc.m for complicated unification predicates
@@ -417,6 +415,7 @@
 :- import_module bool.
 :- import_module cord.
 :- import_module int.
+:- import_module io.
 :- import_module map.
 :- import_module pair.
 :- import_module set.
@@ -434,19 +433,19 @@
 % looks at the argtypes of the called predicates, and so we need to make
 % sure we don't muck them up before we've finished the first pass.
 
-polymorphism_process_module(!ModuleInfo, !IO) :-
+polymorphism_process_module(!ModuleInfo) :-
     module_info_preds(!.ModuleInfo, Preds0),
     map.keys(Preds0, PredIds0),
-    list.foldl2(maybe_polymorphism_process_pred, PredIds0, !ModuleInfo, !IO),
+    list.foldl(maybe_polymorphism_process_pred, PredIds0, !ModuleInfo),
     module_info_preds(!.ModuleInfo, Preds1),
     map.keys(Preds1, PredIds1),
     list.foldl(fixup_pred_polymorphism, PredIds1, !ModuleInfo),
     expand_class_method_bodies(!ModuleInfo).
 
 :- pred maybe_polymorphism_process_pred(pred_id::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+    module_info::in, module_info::out) is det.
 
-maybe_polymorphism_process_pred(PredId, !ModuleInfo, !IO) :-
+maybe_polymorphism_process_pred(PredId, !ModuleInfo) :-
     module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
     (
         PredModule = pred_info_module(PredInfo),
@@ -457,7 +456,7 @@
         % Just copy the clauses to the proc_infos.
         copy_module_clauses_to_procs([PredId], !ModuleInfo)
     ;
-        polymorphism_process_pred_msg(PredId, !ModuleInfo, !IO)
+        polymorphism_process_pred_msg(PredId, !ModuleInfo)
     ).
 
 %---------------------------------------------------------------------------%
@@ -526,11 +525,13 @@
 %---------------------------------------------------------------------------%
 
 :- pred polymorphism_process_pred_msg(pred_id::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+    module_info::in, module_info::out) is det.
 
-polymorphism_process_pred_msg(PredId, !ModuleInfo, !IO) :-
+polymorphism_process_pred_msg(PredId, !ModuleInfo) :-
+    trace [io(!IO)] (
     write_pred_progress_message("% Transforming polymorphism for ",
-        PredId, !.ModuleInfo, !IO),
+            PredId, !.ModuleInfo, !IO)
+    ),
     polymorphism_process_pred(PredId, !ModuleInfo).
 
 polymorphism_process_generated_pred(PredId, !ModuleInfo) :-
Index: compiler/prop_mode_constraints.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prop_mode_constraints.m,v
retrieving revision 1.23
diff -u -b -r1.23 prop_mode_constraints.m
--- compiler/prop_mode_constraints.m	4 Jun 2009 04:39:20 -0000	1.23
+++ compiler/prop_mode_constraints.m	21 Jul 2009 02:17:46 -0000
@@ -496,21 +496,21 @@
 
 %----------------------------------------------------------------------------%
 
-    % Put the constraints to the current output stream in human
-    % readable format. It titles each pred's constraints with a
-    % module qualification based on the default filename for the
-    % module followed by the predicate's name.
+    % Print the constraints to the current output stream in human readable
+    % format. It titles each pred's constraints with a module qualification
+    % based on the default filename for the module followed by the
+    % predicate's name.
     %
-pretty_print_pred_constraints_map(
-    ModuleInfo, ConstraintVarset, PredConstraintsMap, !IO) :-
+pretty_print_pred_constraints_map(ModuleInfo, ConstraintVarset,
+        PredConstraintsMap, !IO) :-
     ConstrainedPreds = map.keys(PredConstraintsMap),
     list.foldl(
         pretty_print_pred_constraints(ModuleInfo, ConstraintVarset,
             PredConstraintsMap),
         ConstrainedPreds, !IO).
 
-    % Puts the constraints for the specified predicate from the
-    % pred_constraints_map to the current output stream in human
+    % Print the constraints for the specified predicate from the
+    % pred_constraints_map to the current output stream in a human
     % readable format.
     %
 :- pred pretty_print_pred_constraints(module_info::in, mc_varset::in,
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.242
diff -u -b -r1.242 simplify.m
--- compiler/simplify.m	16 Jul 2009 07:27:13 -0000	1.242
+++ compiler/simplify.m	21 Jul 2009 02:17:46 -0000
@@ -44,18 +44,16 @@
 :- import_module parse_tree.error_util.
 
 :- import_module bool.
-:- import_module io.
 :- import_module list.
 
 %-----------------------------------------------------------------------------%
 
 :- pred simplify_pred(simplifications::in, pred_id::in,
     module_info::in, module_info::out, pred_info::in, pred_info::out,
-    list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
+    list(error_spec)::in, list(error_spec)::out) is det.
 
 :- pred simplify_proc(simplifications::in, pred_id::in, proc_id::in,
-    module_info::in, module_info::out, proc_info::in, proc_info::out,
-    io::di, io::uo) is det.
+    module_info::in, module_info::out, proc_info::in, proc_info::out) is det.
 
 :- pred simplify_proc_return_msgs(simplifications::in, pred_id::in,
     proc_id::in, module_info::in, module_info::out,
@@ -134,9 +132,9 @@
 :- import_module check_hlds.polymorphism.
 :- import_module check_hlds.type_util.
 :- import_module check_hlds.unify_proc.
-:- import_module hlds.hlds_data.
 :- import_module hlds.goal_form.
 :- import_module hlds.goal_util.
+:- import_module hlds.hlds_data.
 :- import_module hlds.hlds_error_util.
 :- import_module hlds.hlds_module.
 :- import_module hlds.passes_aux.
@@ -161,14 +159,15 @@
 :- import_module transform_hlds.pd_cost.
 
 :- import_module int.
+:- import_module io.
 :- import_module map.
 :- import_module maybe.
 :- import_module pair.
 :- import_module set.
 :- import_module string.
+:- import_module svvarset.
 :- import_module term.
 :- import_module varset.
-:- import_module svvarset.
 
 %-----------------------------------------------------------------------------%
 
@@ -302,8 +301,11 @@
 
 %-----------------------------------------------------------------------------%
 
-simplify_pred(Simplifications0, PredId, !ModuleInfo, !PredInfo, !Specs, !IO) :-
-    write_pred_progress_message("% Simplifying ", PredId, !.ModuleInfo, !IO),
+simplify_pred(Simplifications0, PredId, !ModuleInfo, !PredInfo, !Specs) :-
+    trace [io(!IO)] (
+        write_pred_progress_message("% Simplifying ", PredId, !.ModuleInfo,
+            !IO)
+    ),
     ProcIds = pred_info_non_imported_procids(!.PredInfo),
     % Don't warn for compiler-generated procedures.
     ( is_unify_or_compare_pred(!.PredInfo) ->
@@ -318,27 +320,29 @@
     SpecsList = error_spec_accumulator_to_list(ErrorSpecs),
     !:Specs = SpecsList ++ !.Specs,
     globals.lookup_bool_option(Globals, detailed_statistics, Statistics),
-    maybe_report_stats(Statistics, !IO).
+    trace [io(!IO)] (
+        maybe_report_stats(Statistics, !IO)
+    ).
 
 :- pred simplify_pred_procs(simplifications::in, pred_id::in,
     list(proc_id)::in, module_info::in, module_info::out,
     pred_info::in, pred_info::out,
     error_spec_accumulator::in, error_spec_accumulator::out) is det.
 
-simplify_pred_procs(_, _, [], !ModuleInfo, !PredInfo, !ErrorSpecs).
+simplify_pred_procs(_, _, [], !ModuleInfo, !PredInfo, !Specs).
 simplify_pred_procs(Simplifications, PredId, [ProcId | ProcIds], !ModuleInfo,
-        !PredInfo, !ErrorSpecs) :-
+        !PredInfo, !Specs) :-
     simplify_pred_proc(Simplifications, PredId, ProcId, !ModuleInfo,
-        !PredInfo, !ErrorSpecs),
+        !PredInfo, !Specs),
     simplify_pred_procs(Simplifications, PredId, ProcIds, !ModuleInfo,
-        !PredInfo, !ErrorSpecs).
+        !PredInfo, !Specs).
 
 :- pred simplify_pred_proc(simplifications::in, pred_id::in, proc_id::in,
     module_info::in, module_info::out, pred_info::in, pred_info::out,
     error_spec_accumulator::in, error_spec_accumulator::out) is det.
 
 simplify_pred_proc(Simplifications, PredId, ProcId, !ModuleInfo,
-        !PredInfo, !ErrorSpecs) :-
+        !PredInfo, !Specs) :-
     pred_info_get_procedures(!.PredInfo, ProcTable0),
     map.lookup(ProcTable0, ProcId, ProcInfo0),
     simplify_proc_return_msgs(Simplifications, PredId, ProcId,
@@ -364,10 +368,13 @@
     ),
     map.det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
     pred_info_set_procedures(ProcTable, !PredInfo),
-    accumulate_error_specs_for_proc(ProcSpecs, !ErrorSpecs).
+    accumulate_error_specs_for_proc(ProcSpecs, !Specs).
 
-simplify_proc(Simplifications, PredId, ProcId, !ModuleInfo, !ProcInfo, !IO)  :-
-    write_pred_progress_message("% Simplifying ", PredId, !.ModuleInfo, !IO),
+simplify_proc(Simplifications, PredId, ProcId, !ModuleInfo, !ProcInfo)  :-
+    trace [io(!IO)] (
+        write_pred_progress_message("% Simplifying ", PredId, !.ModuleInfo,
+            !IO)
+    ),
     simplify_proc_return_msgs(Simplifications, PredId, ProcId, !ModuleInfo,
         !ProcInfo, _).
 
Index: compiler/stack_opt.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_opt.m,v
retrieving revision 1.38
diff -u -b -r1.38 stack_opt.m
--- compiler/stack_opt.m	11 Jun 2009 07:00:19 -0000	1.38
+++ compiler/stack_opt.m	21 Jul 2009 02:17:46 -0000
@@ -168,7 +168,7 @@
     % getting to the liveness computation.
     % (see tests/valid/stack_opt_simplify.m)
     Simplications = list_to_simplifications([]),
-    simplify_proc(Simplications, PredId, ProcId, !ModuleInfo, !ProcInfo, !IO),
+    simplify_proc(Simplications, PredId, ProcId, !ModuleInfo, !ProcInfo),
     detect_liveness_proc(PredId, ProcId, !.ModuleInfo, !ProcInfo, !IO),
     initial_liveness(!.ProcInfo, PredId, !.ModuleInfo, Liveness0),
     module_info_get_globals(!.ModuleInfo, Globals),
Index: compiler/stratify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stratify.m,v
retrieving revision 1.71
diff -u -b -r1.71 stratify.m
--- compiler/stratify.m	11 Jun 2009 07:00:19 -0000	1.71
+++ compiler/stratify.m	21 Jul 2009 02:17:46 -0000
@@ -33,8 +33,10 @@
 
 :- import_module hlds.
 :- import_module hlds.hlds_module.
+:- import_module parse_tree.
+:- import_module parse_tree.error_util.
 
-:- import_module io.
+:- import_module list.
 
     % Perform stratification analysis, for the given module. If the
     % "warn-non-stratification" option is set, this predicate will check
@@ -42,7 +44,7 @@
     % the predicates in the stratified_preds set of the module_info structure.
     %
 :- pred check_stratification(module_info::in, module_info::out,
-    io::di, io::uo) is det.
+    list(error_spec)::in, list(error_spec)::out) is det.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -61,8 +63,6 @@
 :- import_module libs.options.
 :- import_module mdbcomp.
 :- import_module mdbcomp.prim_data.
-:- import_module parse_tree.
-:- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_data.
 :- import_module parse_tree.prog_type.
 :- import_module transform_hlds.    % for pd_cost, etc.
@@ -71,22 +71,23 @@
 :- import_module assoc_list.
 :- import_module bool.
 :- import_module digraph.
-:- import_module list.
 :- import_module map.
 :- import_module pair.
 :- import_module set.
 :- import_module string.
 
-check_stratification(!ModuleInfo, !IO) :-
+check_stratification(!ModuleInfo, !Specs) :-
     module_info_ensure_dependency_info(!ModuleInfo),
     module_info_dependency_info(!.ModuleInfo, DepInfo),
 
     hlds_dependency_info_get_dependency_graph(DepInfo, DepGraph0),
     digraph.atsort(DepGraph0, FOSCCs1),
     dep_sets_to_lists_and_sets(FOSCCs1, [], FOSCCs),
-    globals.io_lookup_bool_option(warn_non_stratification, Warn, !IO),
+    module_info_get_globals(!.ModuleInfo, Globals),
+    globals.lookup_bool_option(Globals, warn_non_stratification, Warn),
     module_info_get_stratified_preds(!.ModuleInfo, StratifiedPreds),
-    first_order_check_sccs(FOSCCs, StratifiedPreds, Warn, !ModuleInfo, !IO).
+    first_order_check_sccs(FOSCCs, StratifiedPreds, Warn, !.ModuleInfo,
+        !Specs).
 
     % The following code was used for the second pass of this module but
     % as that pass is disabled so is this code. The higher order code
@@ -96,7 +97,7 @@
     % gen_conservative_graph(!ModuleInfo, DepGraph0, DepGraph, HOInfo),
     % digraph.atsort(DepGraph, HOSCCs1),
     % dep_sets_to_lists_and_sets(HOSCCs1, [], HOSCCs),
-    % higher_order_check_sccs(HOSCCs, HOInfo, !ModuleInfo, !IO).
+    % higher_order_check_sccs(HOSCCs, HOInfo, ModuleInfo, !Specs).
 
 %-----------------------------------------------------------------------------%
 
@@ -120,12 +121,12 @@
     %
 :- pred first_order_check_sccs(
     assoc_list(list(pred_proc_id), set(pred_id))::in,
-    set(pred_id)::in, bool::in, module_info::in, module_info::out,
-    io::di, io::uo) is det.
+    set(pred_id)::in, bool::in, module_info::in,
+    list(error_spec)::in, list(error_spec)::out) is det.
 
-first_order_check_sccs([], _, _, !ModuleInfo, !IO).
+first_order_check_sccs([], _, _, _, !Specs).
 first_order_check_sccs([SCCl - SCCs | Rest], StratifiedPreds, Warn0,
-        !ModuleInfo, !IO) :-
+        ModuleInfo, !Specs) :-
     (
         set.intersect(SCCs, StratifiedPreds, Intersection),
         set.empty(Intersection)
@@ -136,62 +137,64 @@
     ),
     (
         Warn = yes,
-        first_order_check_scc(SCCl, no, !ModuleInfo, !IO)
+        first_order_check_scc(SCCl, is_warning, ModuleInfo, !Specs)
     ;
         Warn = no
     ),
-    first_order_check_sccs(Rest, StratifiedPreds, Warn0, !ModuleInfo, !IO).
+    first_order_check_sccs(Rest, StratifiedPreds, Warn0, ModuleInfo, !Specs).
 
-:- pred first_order_check_scc(list(pred_proc_id)::in, bool::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+:- pred first_order_check_scc(list(pred_proc_id)::in, error_or_warning::in,
+    module_info::in, list(error_spec)::in, list(error_spec)::out) is det.
 
-first_order_check_scc(Scc, Error, !ModuleInfo, !IO) :-
-    first_order_check_scc_2(Scc, Scc, Error, !ModuleInfo, !IO).
+first_order_check_scc(Scc, ErrorOrWarning, ModuleInfo, !Specs) :-
+    first_order_check_scc_2(Scc, Scc, ErrorOrWarning, ModuleInfo, !Specs).
 
 :- pred first_order_check_scc_2(list(pred_proc_id)::in, list(pred_proc_id)::in,
-    bool::in, module_info::in, module_info::out, io::di, io::uo) is det.
+    error_or_warning::in, module_info::in,
+    list(error_spec)::in, list(error_spec)::out) is det.
 
-first_order_check_scc_2([], _Scc, _, !ModuleInfo, !IO).
-first_order_check_scc_2([PredProcId | Remaining], WholeScc, Error, !ModuleInfo,
-        !IO) :-
+first_order_check_scc_2([], _Scc, _, _, !Specs).
+first_order_check_scc_2([PredProcId | Remaining], WholeScc, ErrorOrWarning,
+        ModuleInfo, !Specs) :-
     PredProcId = proc(PredId, ProcId),
-    module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+    module_info_pred_info(ModuleInfo, PredId, PredInfo),
     pred_info_get_procedures(PredInfo, ProcTable),
     map.lookup(ProcTable, ProcId, Proc),
     proc_info_get_goal(Proc, Goal),
     first_order_check_goal(Goal, no, WholeScc,
-        PredProcId, Error, !ModuleInfo, !IO),
-    first_order_check_scc_2(Remaining, WholeScc, Error, !ModuleInfo, !IO).
+        PredProcId, ErrorOrWarning, ModuleInfo, !Specs),
+    first_order_check_scc_2(Remaining, WholeScc, ErrorOrWarning,
+        ModuleInfo, !Specs).
 
 :- pred first_order_check_goal(hlds_goal::in, bool::in, list(pred_proc_id)::in,
-    pred_proc_id::in, bool::in, module_info::in, module_info::out,
-    io::di, io::uo) is det.
+    pred_proc_id::in, error_or_warning::in, module_info::in,
+    list(error_spec)::in, list(error_spec)::out) is det.
 
-first_order_check_goal(Goal, Negated, WholeScc, ThisPredProcId, Error,
-        !ModuleInfo, !IO) :-
+first_order_check_goal(Goal, Negated, WholeScc, ThisPredProcId, ErrorOrWarning,
+        ModuleInfo, !Specs) :-
     Goal = hlds_goal(GoalExpr, GoalInfo),
     (
         ( GoalExpr = conj(_ConjType, Goals)
         ; GoalExpr = disj(Goals)
         ),
         first_order_check_goals(Goals, Negated, WholeScc, ThisPredProcId,
-            Error, !ModuleInfo, !IO)
+            ErrorOrWarning, ModuleInfo, !Specs)
     ;
         GoalExpr = switch(_Var, _Fail, Cases),
         first_order_check_cases(Cases, Negated, WholeScc, ThisPredProcId,
-            Error, !ModuleInfo, !IO)
+            ErrorOrWarning, ModuleInfo, !Specs)
     ;
         GoalExpr = if_then_else(_Vars, Cond, Then, Else),
         first_order_check_goal(Cond, yes, WholeScc,
-            ThisPredProcId, Error, !ModuleInfo, !IO),
+            ThisPredProcId, ErrorOrWarning, ModuleInfo, !Specs),
         first_order_check_goal(Then, Negated, WholeScc,
-            ThisPredProcId, Error, !ModuleInfo, !IO),
+            ThisPredProcId, ErrorOrWarning, ModuleInfo, !Specs),
         first_order_check_goal(Else, Negated, WholeScc,
-            ThisPredProcId, Error, !ModuleInfo, !IO)
+            ThisPredProcId, ErrorOrWarning, ModuleInfo, !Specs)
     ;
         GoalExpr = negation(SubGoal),
         first_order_check_goal(SubGoal, yes, WholeScc,
-            ThisPredProcId, Error, !ModuleInfo, !IO)
+            ThisPredProcId, ErrorOrWarning, ModuleInfo, !Specs)
     ;
         GoalExpr = scope(Reason, SubGoal),
         ( Reason = from_ground_term(_, from_ground_term_construct) ->
@@ -199,7 +202,7 @@
             true
         ;
             first_order_check_goal(SubGoal, Negated, WholeScc,
-                ThisPredProcId, Error, !ModuleInfo, !IO)
+                ThisPredProcId, ErrorOrWarning, ModuleInfo, !Specs)
         )
     ;
         ( GoalExpr = plain_call(CPred, CProc, _Args, _BuiltinState, _UC, _Sym)
@@ -211,9 +214,10 @@
             list.member(Callee, WholeScc)
         ->
             Context = goal_info_get_context(GoalInfo),
-            emit_message(ThisPredProcId, Context,
-                "call introduces a non-stratified loop.", Error,
-                !ModuleInfo, !IO)
+            ErrorMsg = "call introduces a non-stratified loop.",
+            Spec = generate_message(ModuleInfo, ThisPredProcId, Context,
+                ErrorMsg, ErrorOrWarning),
+            !:Specs = [Spec | !.Specs]
         ;
             true
         )
@@ -228,13 +232,13 @@
         (
             ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals, _),
             first_order_check_goal(MainGoal, Negated, WholeScc,
-                ThisPredProcId, Error, !ModuleInfo, !IO),
+                ThisPredProcId, ErrorOrWarning, ModuleInfo, !Specs),
             first_order_check_goals(OrElseGoals, Negated, WholeScc,
-                ThisPredProcId, Error, !ModuleInfo, !IO)
+                ThisPredProcId, ErrorOrWarning, ModuleInfo, !Specs)
         ;
             ShortHand = try_goal(_, _, SubGoal),
             first_order_check_goal(SubGoal, Negated, WholeScc,
-                ThisPredProcId, Error, !ModuleInfo, !IO)
+                ThisPredProcId, ErrorOrWarning, ModuleInfo, !Specs)
         ;
             ShortHand = bi_implication(_, _),
             % These should have been expanded out by now.
@@ -243,61 +247,62 @@
     ).
 
 :- pred first_order_check_goals(list(hlds_goal)::in, bool::in,
-    list(pred_proc_id)::in, pred_proc_id::in, bool::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+    list(pred_proc_id)::in, pred_proc_id::in, error_or_warning::in,
+    module_info::in, list(error_spec)::in, list(error_spec)::out) is det.
 
-first_order_check_goals([], _, _, _, _, !ModuleInfo, !IO).
+first_order_check_goals([], _, _, _, _, _, !Specs).
 first_order_check_goals([Goal | Goals], Negated,
-        WholeScc, ThisPredProcId, Error, !ModuleInfo, !IO) :-
+        WholeScc, ThisPredProcId, ErrorOrWarning, ModuleInfo, !Specs) :-
     first_order_check_goal(Goal, Negated, WholeScc, ThisPredProcId,
-        Error, !ModuleInfo, !IO),
+        ErrorOrWarning, ModuleInfo, !Specs),
     first_order_check_goals(Goals, Negated, WholeScc, ThisPredProcId,
-        Error, !ModuleInfo, !IO).
+        ErrorOrWarning, ModuleInfo, !Specs).
 
 :- pred first_order_check_cases(list(case)::in, bool::in,
-    list(pred_proc_id)::in, pred_proc_id::in, bool::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+    list(pred_proc_id)::in, pred_proc_id::in, error_or_warning::in,
+    module_info::in, list(error_spec)::in, list(error_spec)::out) is det.
 
-first_order_check_cases([], _, _, _, _, !ModuleInfo, !IO).
+first_order_check_cases([], _, _, _, _, _, !Specs).
 first_order_check_cases([Case | Goals], Negated, WholeScc, ThisPredProcId,
-        Error, !ModuleInfo, !IO) :-
+        ErrorOrWarning, ModuleInfo, !Specs) :-
     Case = case(_, _, Goal),
     first_order_check_goal(Goal, Negated, WholeScc,
-        ThisPredProcId, Error, !ModuleInfo, !IO),
+        ThisPredProcId, ErrorOrWarning, ModuleInfo, !Specs),
     first_order_check_cases(Goals, Negated, WholeScc, ThisPredProcId,
-        Error, !ModuleInfo, !IO).
+        ErrorOrWarning, ModuleInfo, !Specs).
 
 %-----------------------------------------------------------------------------%
-
- % XXX : Currently we don't allow the higher order case so this code
- % is disabled.
+%
+% XXX Currently we don't allow the higher order case so this code is disabled.
 
     % Check the higher order SCCs for stratification.
     %
 :- pred higher_order_check_sccs(
-    assoc_list(list(pred_proc_id), set(pred_proc_id))::in,
-    ho_map::in, module_info::in, module_info::out, io::di, io::uo) is det.
+    assoc_list(list(pred_proc_id), set(pred_proc_id))::in, ho_map::in,
+    module_info::in, list(error_spec)::in, list(error_spec)::out) is det.
 
-higher_order_check_sccs([], _HOInfo, !ModuleInfo, !IO).
-higher_order_check_sccs([SCCl - SCCs | Rest], HOInfo, !ModuleInfo, !IO) :-
-    higher_order_check_scc(SCCl, SCCs, HOInfo, !ModuleInfo, !IO),
-    higher_order_check_sccs(Rest, HOInfo, !ModuleInfo, !IO).
+higher_order_check_sccs([], _HOInfo, _ModuleInfo, !Specs).
+higher_order_check_sccs([SCCl - SCCs | Rest], HOInfo, ModuleInfo, !Specs) :-
+    higher_order_check_scc(SCCl, SCCs, HOInfo, ModuleInfo, !Specs),
+    higher_order_check_sccs(Rest, HOInfo, ModuleInfo, !Specs).
 
 :- pred higher_order_check_scc(list(pred_proc_id)::in, set(pred_proc_id)::in,
-    ho_map::in, module_info::in, module_info::out, io::di, io::uo) is det.
+    ho_map::in, module_info::in, list(error_spec)::in, list(error_spec)::out)
+    is det.
 
-higher_order_check_scc([], _WholeScc, _HOInfo, !ModuleInfo, !IO).
+higher_order_check_scc([], _WholeScc, _HOInfo, _ModuleInfo, !Specs).
 higher_order_check_scc([PredProcId | Remaining], WholeScc, HOInfo,
-        !ModuleInfo, !IO) :-
+        ModuleInfo, !Specs) :-
     PredProcId = proc(PredId, ProcId),
-    module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
-    globals.io_lookup_bool_option(warn_non_stratification, Warn, !IO),
-    Error = no,
+    module_info_pred_info(ModuleInfo, PredId, PredInfo),
+    module_info_get_globals(ModuleInfo, Globals),
+    globals.lookup_bool_option(Globals, warn_non_stratification, Warn),
+    ErrorOrWarning = is_warning,
     (
         Warn = yes,
         map.search(HOInfo, PredProcId, HigherOrderInfo)
     ->
-        HigherOrderInfo = info(HOCalls, _),
+        HigherOrderInfo = ho_info(HOCalls, _),
         set.intersect(HOCalls, WholeScc, HOLoops),
         ( set.empty(HOLoops) ->
             HighOrderLoops = no
@@ -308,41 +313,41 @@
         map.lookup(ProcTable, ProcId, Proc),
         proc_info_get_goal(Proc, Goal),
         higher_order_check_goal(Goal, no, WholeScc, PredProcId, HighOrderLoops,
-            Error, !ModuleInfo, !IO)
+            ErrorOrWarning, ModuleInfo, !Specs)
     ;
         true
     ),
-    higher_order_check_scc(Remaining, WholeScc, HOInfo, !ModuleInfo, !IO).
+    higher_order_check_scc(Remaining, WholeScc, HOInfo, ModuleInfo, !Specs).
 
 :- pred higher_order_check_goal(hlds_goal::in, bool::in, set(pred_proc_id)::in,
-    pred_proc_id::in, bool::in, bool::in, module_info::in, module_info::out,
-    io::di, io::uo) is det.
+    pred_proc_id::in, bool::in, error_or_warning::in,
+    module_info::in, list(error_spec)::in, list(error_spec)::out) is det.
 
 higher_order_check_goal(Goal, Negated, WholeScc, ThisPredProcId,
-        HighOrderLoops, Error, !ModuleInfo, !IO) :-
+        HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs) :-
     Goal = hlds_goal(GoalExpr, GoalInfo),
     (
         ( GoalExpr = conj(_ConjType, Goals)
         ; GoalExpr = disj(Goals)
         ),
         higher_order_check_goals(Goals, Negated, WholeScc, ThisPredProcId,
-            HighOrderLoops, Error, !ModuleInfo, !IO)
+            HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs)
     ;
         GoalExpr = switch(_Var, _Fail, Cases),
         higher_order_check_cases(Cases, Negated, WholeScc, ThisPredProcId,
-            HighOrderLoops, Error, !ModuleInfo, !IO)
+            HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs)
     ;
         GoalExpr = if_then_else(_Vars, Cond, Then, Else),
-        higher_order_check_goal(Cond, yes, WholeScc,
-            ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO),
-        higher_order_check_goal(Then, Negated, WholeScc,
-            ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO),
-        higher_order_check_goal(Else, Negated, WholeScc,
-            ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO)
+        higher_order_check_goal(Cond, yes, WholeScc, ThisPredProcId,
+            HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs),
+        higher_order_check_goal(Then, Negated, WholeScc, ThisPredProcId,
+            HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs),
+        higher_order_check_goal(Else, Negated, WholeScc, ThisPredProcId,
+            HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs)
     ;
         GoalExpr = negation(SubGoal),
-        higher_order_check_goal(SubGoal, yes, WholeScc,
-            ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO)
+        higher_order_check_goal(SubGoal, yes, WholeScc, ThisPredProcId,
+            HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs)
     ;
         GoalExpr = scope(Reason, SubGoal),
         ( Reason = from_ground_term(_, from_ground_term_construct) ->
@@ -350,7 +355,8 @@
             true
         ;
             higher_order_check_goal(SubGoal, Negated, WholeScc,
-                ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO)
+                ThisPredProcId, HighOrderLoops, ErrorOrWarning,
+                ModuleInfo, !Specs)
         )
     ;
         GoalExpr = plain_call(_CPred, _CProc, _Args, _Builtin, _UC, Sym),
@@ -363,9 +369,10 @@
             Name = "solutions"
         ->
             Context = goal_info_get_context(GoalInfo),
-            emit_message(ThisPredProcId, Context,
-                "call to solutions/2 introduces a non-stratified loop.",
-                Error, !ModuleInfo, !IO)
+            ErrorMsg = "call to solutions/2 introduces a non-stratified loop.",
+            Spec = generate_message(ModuleInfo, ThisPredProcId, Context,
+                ErrorMsg, ErrorOrWarning),
+            !:Specs = [Spec | !.Specs]
         ;
             true
         )
@@ -380,8 +387,9 @@
         ->
             Context = goal_info_get_context(GoalInfo),
             ErrorMsg = Msg ++ " call may introduce a non-stratified loop.",
-            emit_message(ThisPredProcId, Context, ErrorMsg, Error,
-                !ModuleInfo, !IO)
+            Spec = generate_message(ModuleInfo, ThisPredProcId, Context,
+                ErrorMsg, ErrorOrWarning),
+            !:Specs = [Spec | !.Specs]
         ;
             true
         )
@@ -396,13 +404,16 @@
         (
             ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals, _),
             higher_order_check_goal(MainGoal, Negated, WholeScc,
-                ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO),
+                ThisPredProcId, HighOrderLoops, ErrorOrWarning,
+                ModuleInfo, !Specs),
             higher_order_check_goals(OrElseGoals, Negated, WholeScc,
-                ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO)
+                ThisPredProcId, HighOrderLoops, ErrorOrWarning,
+                ModuleInfo, !Specs)
         ;
             ShortHand = try_goal(_, _, SubGoal),
             higher_order_check_goal(SubGoal, Negated, WholeScc,
-                ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO)
+                ThisPredProcId, HighOrderLoops, ErrorOrWarning,
+                ModuleInfo, !Specs)
         ;
             ShortHand = bi_implication(_, _),
             % These should have been expanded out by now.
@@ -411,29 +422,29 @@
     ).
 
 :- pred higher_order_check_goals(list(hlds_goal)::in, bool::in,
-    set(pred_proc_id)::in, pred_proc_id::in, bool::in, bool::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+    set(pred_proc_id)::in, pred_proc_id::in, bool::in, error_or_warning::in,
+    module_info::in, list(error_spec)::in, list(error_spec)::out) is det.
 
-higher_order_check_goals([], _, _, _, _, _, !ModuleInfo, !IO).
-higher_order_check_goals([Goal | Goals], Negated,
-        WholeScc, ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO) :-
+higher_order_check_goals([], _, _, _, _, _, _, !Specs).
+higher_order_check_goals([Goal | Goals], Negated, WholeScc, ThisPredProcId,
+        HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs) :-
     higher_order_check_goal(Goal, Negated, WholeScc,
-        ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO),
+        ThisPredProcId, HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs),
     higher_order_check_goals(Goals, Negated, WholeScc, ThisPredProcId,
-        HighOrderLoops, Error, !ModuleInfo, !IO).
+        HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs).
 
 :- pred higher_order_check_cases(list(case)::in, bool::in,
-    set(pred_proc_id)::in, pred_proc_id::in, bool::in, bool::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+    set(pred_proc_id)::in, pred_proc_id::in, bool::in, error_or_warning::in,
+    module_info::in, list(error_spec)::in, list(error_spec)::out) is det.
 
-higher_order_check_cases([], _, _, _, _, _, !ModuleInfo, !IO).
+higher_order_check_cases([], _, _, _, _, _, _, !Specs).
 higher_order_check_cases([Case | Goals], Negated, WholeScc, ThisPredProcId,
-        HighOrderLoops, Error, !ModuleInfo, !IO) :-
+        HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs) :-
     Case = case(_, _, Goal),
     higher_order_check_goal(Goal, Negated, WholeScc,
-        ThisPredProcId, HighOrderLoops, Error, !ModuleInfo, !IO),
+        ThisPredProcId, HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs),
     higher_order_check_cases(Goals, Negated, WholeScc, ThisPredProcId,
-        HighOrderLoops, Error, !ModuleInfo, !IO).
+        HighOrderLoops, ErrorOrWarning, ModuleInfo, !Specs).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -448,7 +459,7 @@
     % This structure is used to hold the higher order characteristics of a
     % procedure.
 :- type higher_order_info
-    --->    info(
+    --->    ho_info(
                 set(pred_proc_id),  % Possible higher order addresses that
                                     % can reach the procedure.
                 ho_in_out           % Possible paths the address can take
@@ -498,7 +509,7 @@
     set(pred_proc_id)::in, ho_map::in, ho_map::out) is det.
 
 iterate_solution(PredProcs, ProcCalls, CallsHO, !HOInfo) :-
-    tc(PredProcs, ProcCalls, CallsHO, !HOInfo, no, Changed),
+    stratify_tc(PredProcs, ProcCalls, CallsHO, !HOInfo, no, Changed),
     (
         Changed = no
     ;
@@ -509,15 +520,17 @@
     % For each caller, merge any higher order addresses it takes with all of
     % its callees, and return if any change has occurred.
     %
-:- pred tc(list(pred_proc_id)::in, call_map::in, set(pred_proc_id)::in,
-    ho_map::in, ho_map::out, bool::in, bool::out) is det.
+:- pred stratify_tc(list(pred_proc_id)::in, call_map::in,
+    set(pred_proc_id)::in, ho_map::in, ho_map::out, bool::in, bool::out)
+    is det.
 
-tc([], _, _, !HOInfo, !Changed).
-tc([PredProcId | PredProcIds], ProcCalls, CallsHO, !HOInfo, !Changed) :-
+stratify_tc([], _, _, !HOInfo, !Changed).
+stratify_tc([PredProcId | PredProcIds], ProcCalls, CallsHO, !HOInfo,
+        !Changed) :-
     map.lookup(ProcCalls, PredProcId, PCalls),
     set.to_sorted_list(PCalls, PCallsL),
     merge_calls(PCallsL, PredProcId, CallsHO, yes, !HOInfo, !Changed),
-    tc(PredProcIds, ProcCalls, CallsHO, !HOInfo, !Changed).
+    stratify_tc(PredProcIds, ProcCalls, CallsHO, !HOInfo, !Changed).
 
     % Merge any higher order addresses that can pass between the given caller
     % and callees. This code also merges any possible addresses that can pass
@@ -531,8 +544,8 @@
 merge_calls([C | Cs], P, CallsHO, DoingFirstOrder, !HOInfo, !Changed) :-
     ( map.search(!.HOInfo, C, CInfo) ->
         map.lookup(!.HOInfo, P, PInfo),
-        CInfo = info(CHaveAT0, CHOInOut),
-        PInfo = info(PHaveAT0, PHOInOut),
+        CInfo = ho_info(CHaveAT0, CHOInOut),
+        PInfo = ho_info(PHaveAT0, PHOInOut),
         % First merge the first order info, if we need to.
         ( CHOInOut = ho_none ->
             true
@@ -568,11 +581,11 @@
                 )
             ;
                 CHOInOut = ho_none,
-                % XXX : what is a good message for this?
+                % XXX What is a good message for this?
                 unexpected(this_file, "merge_calls: this cannot happen!")
             ),
-            NewCInfo = info(CHaveAT, CHOInOut),
-            NewPInfo = info(PHaveAT, PHOInOut),
+            NewCInfo = ho_info(CHaveAT, CHOInOut),
+            NewPInfo = ho_info(PHaveAT, PHOInOut),
             map.det_update(!.HOInfo, C, NewCInfo, !:HOInfo),
             map.det_update(!.HOInfo, P, NewPInfo, !:HOInfo)
         ),
@@ -582,7 +595,7 @@
             set.member(P, CallsHO)
         ->
             map.lookup(!.HOInfo, P, PHOInfo),
-            PHOInfo = info(PossibleCalls, _),
+            PHOInfo = ho_info(PossibleCalls, _),
             set.to_sorted_list(PossibleCalls, PossibleCallsL),
             merge_calls(PossibleCallsL, P, CallsHO, no, !HOInfo, !Changed)
         ;
@@ -604,7 +617,7 @@
 add_new_arcs([Caller - CallerInfo | Cs], CallsHO, !DepGraph) :-
     % Only add arcs for callers who call higher order procs.
     ( set.member(Caller, CallsHO) ->
-        CallerInfo = info(PossibleCallees0, _),
+        CallerInfo = ho_info(PossibleCallees0, _),
         set.to_sorted_list(PossibleCallees0, PossibleCallees),
         digraph.lookup_key(!.DepGraph, Caller, CallerKey),
         add_new_arcs2(PossibleCallees, CallerKey, !DepGraph)
@@ -670,12 +683,12 @@
     stratify_analyze_proc_body(Goal, Calls, HaveAT, CallsHigherOrder),
     map.det_insert(!.ProcCalls, PredProcId, Calls, !:ProcCalls),
     higherorder_in_out(ArgTypes, ArgModes, ModuleInfo, HOInOut),
-    map.det_insert(!.HOInfo, PredProcId, info(HaveAT, HOInOut), !:HOInfo),
+    map.det_insert(!.HOInfo, PredProcId, ho_info(HaveAT, HOInOut), !:HOInfo),
     (
-        CallsHigherOrder = yes,
+        CallsHigherOrder = calls_higher_order,
         set.insert(!.CallsHO, PredProcId, !:CallsHO)
     ;
-        CallsHigherOrder = no
+        CallsHigherOrder = does_not_calls_higher_order
     ).
 
     % Determine if a given set of modes and types indicates that
@@ -723,22 +736,26 @@
     ),
     higherorder_in_out1(Types, Modes, ModuleInfo, !HOIn, !HOOut).
 
+:- type calls_higher_order
+    --->    does_not_calls_higher_order
+    ;       calls_higher_order.
+
     % Return the set of all procedures called in the given goal
     % and all addresses taken in the given goal.
     %
 :- pred stratify_analyze_proc_body(hlds_goal::in, set(pred_proc_id)::out,
-    set(pred_proc_id)::out, bool::out) is det.
+    set(pred_proc_id)::out, calls_higher_order::out) is det.
 
 stratify_analyze_proc_body(Goal, Calls, TakenAddrs, CallsHO) :-
     set.init(Calls0),
     set.init(TakenAddrs0),
     stratify_analyze_goal(Goal, Calls0, Calls, TakenAddrs0, TakenAddrs,
-        no, CallsHO).
+        does_not_calls_higher_order, CallsHO).
 
 :- pred stratify_analyze_goal(hlds_goal::in,
     set(pred_proc_id)::in, set(pred_proc_id)::out,
     set(pred_proc_id)::in, set(pred_proc_id)::out,
-    bool::in, bool::out) is det.
+    calls_higher_order::in, calls_higher_order::out) is det.
 
 stratify_analyze_goal(Goal, !Calls, !HasAT, !CallsHO) :-
     Goal = hlds_goal(GoalExpr, _GoalInfo),
@@ -794,7 +811,7 @@
     ;
         GoalExpr = generic_call(_Var, _Vars, _Modes, _Det),
         % Record that the higher order call was made.
-        !:CallsHO = yes
+        !:CallsHO = calls_higher_order
     ;
         ( GoalExpr = conj(_ConjType, Goals)
         ; GoalExpr = disj(Goals)
@@ -839,7 +856,7 @@
 :- pred stratify_analyze_goals(list(hlds_goal)::in,
     set(pred_proc_id)::in, set(pred_proc_id)::out,
     set(pred_proc_id)::in, set(pred_proc_id)::out,
-    bool::in, bool::out) is det.
+    calls_higher_order::in, calls_higher_order::out) is det.
 
 stratify_analyze_goals([], !Calls, !HasAT, !CallsHO).
 stratify_analyze_goals([Goal | Goals], !Calls, !HasAT, !CallsHO) :-
@@ -849,7 +866,7 @@
 :- pred stratify_analyze_cases(list(case)::in,
     set(pred_proc_id)::in, set(pred_proc_id)::out,
     set(pred_proc_id)::in, set(pred_proc_id)::out,
-    bool::in, bool::out) is det.
+    calls_higher_order::in, calls_higher_order::out) is det.
 
 stratify_analyze_cases([], !Calls, !HasAT, !CallsHO).
 stratify_analyze_cases([Case | Goals], !Calls, !HasAT, !CallsHO) :-
@@ -974,19 +991,23 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-:- pred emit_message(pred_proc_id::in, prog_context::in, string::in, bool::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+:- type error_or_warning
+    --->    is_error
+    ;       is_warning.
 
-emit_message(PPId, Context, Message, Error, !ModuleInfo, !IO) :-
-    PPIdDescription = describe_one_proc_name_mode(!.ModuleInfo,
+:- func generate_message(module_info, pred_proc_id, prog_context, string,
+    error_or_warning) = error_spec.
+
+generate_message(ModuleInfo, PPId, Context, Message, ErrorOrWarning) = Spec :-
+    PPIdDescription = describe_one_proc_name_mode(ModuleInfo,
         should_not_module_qualify, PPId),
     Preamble = [words("In")] ++ PPIdDescription ++ [suffix(":"), nl],
     (
-        Error = no,
+        ErrorOrWarning = is_warning,
         ErrOrWarnMsg = words("warning:"),
         Severity = severity_warning
     ;
-        Error = yes,
+        ErrorOrWarning = is_error,
         ErrOrWarnMsg = words("error:"),
         Severity = severity_error
     ),
@@ -998,10 +1019,7 @@
         words("bottom-up evaluation of the predicate/function."), nl],
     Msg = simple_msg(Context,
         [always(Preamble ++ MainPieces), verbose_only(VerbosePieces)]),
-    Spec = error_spec(Severity, phase_code_gen, [Msg]),
-    module_info_get_globals(!.ModuleInfo, Globals),
-    % XXX _NumErrors
-    write_error_spec(Spec, Globals, 0, _NumWarnings, 0, _NumErrors, !IO).
+    Spec = error_spec(Severity, phase_code_gen, [Msg]).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/structure_sharing.analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/structure_sharing.analysis.m,v
retrieving revision 1.43
diff -u -b -r1.43 structure_sharing.analysis.m
--- compiler/structure_sharing.analysis.m	23 Dec 2008 01:37:41 -0000	1.43
+++ compiler/structure_sharing.analysis.m	21 Jul 2009 02:17:46 -0000
@@ -360,8 +360,7 @@
     % example, an if-then-else with an `erroneous' condition will cause an
     % assertion failure if it is not simplified away. 
     Simplifications = list_to_simplifications([]),
-    simplify_proc(Simplifications, PredId, ProcId, !ModuleInfo, !ProcInfo,
-        !IO),
+    simplify_proc(Simplifications, PredId, ProcId, !ModuleInfo, !ProcInfo),
     detect_liveness_proc(PredId, ProcId, !.ModuleInfo, !ProcInfo, !IO).
 
 %-----------------------------------------------------------------------------%
Index: compiler/switch_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/switch_detection.m,v
retrieving revision 1.146
diff -u -b -r1.146 switch_detection.m
--- compiler/switch_detection.m	11 Jun 2009 07:00:20 -0000	1.146
+++ compiler/switch_detection.m	21 Jul 2009 02:17:46 -0000
@@ -25,13 +25,11 @@
 :- import_module parse_tree.
 :- import_module parse_tree.prog_data.
 
-:- import_module io.
 :- import_module list.
 
 %-----------------------------------------------------------------------------%
 
-:- pred detect_switches(module_info::in, module_info::out,
-    io::di, io::uo) is det.
+:- pred detect_switches_in_module(module_info::in, module_info::out) is det.
 
 :- pred detect_switches_in_proc(proc_id::in, pred_id::in,
     module_info::in, module_info::out) is det.
@@ -114,36 +112,34 @@
         AllowMulti = dont_allow_multi_arm
     ).
 
-detect_switches(!ModuleInfo, !IO) :-
+detect_switches_in_module(!ModuleInfo) :-
     % Traverse the module structure, calling `detect_switches_in_goal'
     % for each procedure body.
     lookup_allow_multi_arm(!.ModuleInfo, AllowMulti),
     module_info_predids(PredIds, !ModuleInfo),
-    detect_switches_in_preds_allow(PredIds, AllowMulti, !ModuleInfo, !IO).
+    detect_switches_in_preds_allow(PredIds, AllowMulti, !ModuleInfo).
 
 :- pred detect_switches_in_preds_allow(list(pred_id)::in, allow_multi_arm::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+    module_info::in, module_info::out) is det.
 
-detect_switches_in_preds_allow([], _, !ModuleInfo, !IO).
-detect_switches_in_preds_allow([PredId | PredIds], AllowMulti, !ModuleInfo,
-        !IO) :-
+detect_switches_in_preds_allow([], _, !ModuleInfo).
+detect_switches_in_preds_allow([PredId | PredIds], AllowMulti, !ModuleInfo) :-
     module_info_preds(!.ModuleInfo, PredTable),
     map.lookup(PredTable, PredId, PredInfo),
-    detect_switches_in_pred_allow(PredId, PredInfo, AllowMulti, !ModuleInfo,
-        !IO),
-    detect_switches_in_preds_allow(PredIds, AllowMulti, !ModuleInfo, !IO).
+    detect_switches_in_pred_allow(PredId, PredInfo, AllowMulti, !ModuleInfo),
+    detect_switches_in_preds_allow(PredIds, AllowMulti, !ModuleInfo).
 
 :- pred detect_switches_in_pred_allow(pred_id::in, pred_info::in,
-    allow_multi_arm::in, module_info::in, module_info::out,
-    io::di, io::uo) is det.
+    allow_multi_arm::in, module_info::in, module_info::out) is det.
 
-detect_switches_in_pred_allow(PredId, PredInfo0, AllowMulti, !ModuleInfo,
-        !IO) :-
+detect_switches_in_pred_allow(PredId, PredInfo0, AllowMulti, !ModuleInfo) :-
     ProcIds = pred_info_non_imported_procids(PredInfo0),
     (
         ProcIds = [_ | _],
+        trace [io(!IO)] (
         write_pred_progress_message("% Detecting switches in ", PredId,
-            !.ModuleInfo, !IO),
+                !.ModuleInfo, !IO)
+        ),
         detect_switches_in_procs_allow(ProcIds, PredId, AllowMulti,
             !ModuleInfo)
         % This is where we should print statistics, if we ever need
Index: compiler/try_expand.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/try_expand.m,v
retrieving revision 1.5
diff -u -b -r1.5 try_expand.m
--- compiler/try_expand.m	21 Jul 2009 02:08:50 -0000	1.5
+++ compiler/try_expand.m	21 Jul 2009 02:17:46 -0000
@@ -193,14 +193,15 @@
 
 :- import_module hlds.
 :- import_module hlds.hlds_module.
+:- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_data.
 
-:- import_module io.
+:- import_module list.
 
 %-----------------------------------------------------------------------------%
 
-:- pred expand_try_goals(module_info::in, module_info::out, io::di, io::uo)
-    is det.
+:- pred expand_try_goals_in_module(module_info::in, module_info::out,
+    list(error_spec)::in, list(error_spec)::out) is det.
 
     % try_expand_may_introduce_calls(PredName, Arity):
     %
@@ -232,13 +233,11 @@
 :- import_module mdbcomp.prim_data.
 :- import_module parse_tree.
 :- import_module parse_tree.builtin_lib_types.
-:- import_module parse_tree.error_util.
 :- import_module parse_tree.prog_mode.
 :- import_module parse_tree.prog_type.
 
 :- import_module bool.
 :- import_module int.
-:- import_module list.
 :- import_module map.
 :- import_module maybe.
 :- import_module pair.
@@ -248,7 +247,7 @@
 
 %-----------------------------------------------------------------------------%
 
-expand_try_goals(!ModuleInfo, !IO) :-
+expand_try_goals_in_module(!ModuleInfo, !Specs) :-
     % The exception module is implicitly imported if any try goals were seen,
     % so if the exception module is not imported then we know there are no try
     % goals to be expanded.
@@ -260,7 +259,8 @@
             module_info_set_globals(!.Globals, !ModuleInfo),
 
             module_info_predids(PredIds, !ModuleInfo),
-            list.foldl2(expand_try_goals_in_pred, PredIds, !ModuleInfo, !IO),
+            list.foldl2(expand_try_goals_in_pred, PredIds,
+                !ModuleInfo, !Specs),
 
             module_info_get_globals(!.ModuleInfo, !:Globals),
             restore_det_warnings(OptionsToRestore, !Globals),
@@ -271,17 +271,20 @@
     ).
 
 :- pred expand_try_goals_in_pred(pred_id::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+    module_info::in, module_info::out,
+    list(error_spec)::in, list(error_spec)::out) is det.
 
-expand_try_goals_in_pred(PredId, !ModuleInfo, !IO) :-
+expand_try_goals_in_pred(PredId, !ModuleInfo, !Specs) :-
     module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
     ProcIds = pred_info_non_imported_procids(PredInfo),
-    list.foldl2(expand_try_goals_in_proc(PredId), ProcIds, !ModuleInfo, !IO).
+    list.foldl2(expand_try_goals_in_proc(PredId), ProcIds,
+        !ModuleInfo, !Specs).
 
 :- pred expand_try_goals_in_proc(pred_id::in, proc_id::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
+    module_info::in, module_info::out,
+    list(error_spec)::in, list(error_spec)::out) is det.
 
-expand_try_goals_in_proc(PredId, ProcId, !ModuleInfo, !IO) :-
+expand_try_goals_in_proc(PredId, ProcId, !ModuleInfo, !Specs) :-
     some [!PredInfo, !ProcInfo] (
         module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
             !:PredInfo, !:ProcInfo),
@@ -295,7 +298,7 @@
         (
             Changed = yes,
             update_changed_proc(Goal, PredId, ProcId, !.PredInfo, !.ProcInfo,
-                !ModuleInfo, !IO),
+                !ModuleInfo, !Specs),
             module_info_clobber_dependency_info(!ModuleInfo)
         ;
             Changed = no
@@ -304,32 +307,33 @@
 
 :- pred update_changed_proc(hlds_goal::in, pred_id::in, proc_id::in,
     pred_info::in, proc_info::in, module_info::in, module_info::out,
-    io::di, io::uo) is det.
+    list(error_spec)::in, list(error_spec)::out) is det.
 
 update_changed_proc(Goal, PredId, ProcId, PredInfo, !.ProcInfo, !ModuleInfo,
-        !IO) :-
+        !Specs) :-
     proc_info_set_goal(Goal, !ProcInfo),
     requantify_proc(!ProcInfo),
     module_info_set_pred_proc_info(PredId, ProcId, PredInfo, !.ProcInfo,
         !ModuleInfo),
 
-    modecheck_proc(ProcId, PredId, !ModuleInfo, ErrorSpecs, _Changed),
+    modecheck_proc(ProcId, PredId, !ModuleInfo, ModeSpecs, _Changed),
     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 ->
-        % In some cases we may detect mode errors after expanding try goals
-        % which were missed before, so don't abort the compiler (but we'll stop
-        % compiling not long after this pass).
-        true
-    ;
-        determinism_check_proc(ProcId, PredId, !ModuleInfo, DetSpecs),
+    HasModeErrors = contains_errors(Globals, ModeSpecs),
         (
-            DetSpecs = []
-        ;
-            DetSpecs = [_ | _],
-            unexpected(this_file, "determinism check fails when repeated")
-        )
+        HasModeErrors = yes,
+        % In some cases we may detect mode errors after expanding try goals
+        % which were missed before, so we don't abort the compiler, but we do
+        % stop compiling not long after this pass.
+        !:Specs = ModeSpecs ++ !.Specs
+    ;
+        HasModeErrors = no,
+        determinism_check_proc(ProcId, PredId, !ModuleInfo, DetismSpecs),
+        % XXX Is there any point in including DetismSpecs in !Specs?
+        % Can there be warnings in there that weren't there before the
+        % try_expand pass?
+        HasDetismErrors = contains_errors(Globals, DetismSpecs),
+        expect(unify(HasDetismErrors, no), this_file,
+            "determinism check fails when repeated")
     ).
 
 %-----------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
Index: tests/warnings/inst_with_no_type.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/warnings/inst_with_no_type.exp,v
retrieving revision 1.2
diff -u -b -r1.2 inst_with_no_type.exp
--- tests/warnings/inst_with_no_type.exp	8 Aug 2008 05:02:21 -0000	1.2
+++ tests/warnings/inst_with_no_type.exp	21 Jul 2009 03:51:34 -0000
@@ -1,5 +1,3 @@
-inst_with_no_type.m:079: Warning: inst `inst_with_no_type.citrus'/0 does not
-inst_with_no_type.m:079:   match any of the types in scope.
 inst_with_no_type.m:014: Warning: inst `inst_with_no_type.i1_no_match'/0 does
 inst_with_no_type.m:014:   not match any of the types in scope.
 inst_with_no_type.m:035: Warning: inst `inst_with_no_type.i2_no_match'/1 does
@@ -13,9 +11,11 @@
 inst_with_no_type.m:072: Warning: inst
 inst_with_no_type.m:072:   `inst_with_no_type.mostly_unique_no_match'/0 does
 inst_with_no_type.m:072:   not match any of the types in scope.
-inst_with_no_type.m:092: Warning: inst `inst_with_no_type.t_no_match'/0 does
-inst_with_no_type.m:092:   not match any of the types in scope.
 inst_with_no_type.m:074: Warning: inst `inst_with_no_type.unique_inst'/0 does
 inst_with_no_type.m:074:   not match any of the types in scope.
 inst_with_no_type.m:076: Warning: inst `inst_with_no_type.unique_no_match'/0
 inst_with_no_type.m:076:   does not match any of the types in scope.
+inst_with_no_type.m:079: Warning: inst `inst_with_no_type.citrus'/0 does not
+inst_with_no_type.m:079:   match any of the types in scope.
+inst_with_no_type.m:092: Warning: inst `inst_with_no_type.t_no_match'/0 does
+inst_with_no_type.m:092:   not match any of the types in scope.
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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