[m-rev.] for post-commit review: improvements in determinism error handling

Zoltan Somogyi zs at csse.unimelb.edu.au
Fri Apr 8 17:21:35 AEST 2011


For post-commit review by anyone. Mostly I am seeking feedback on the
name of the new pragma; the implementation is relatively straightforward.

The new pragma should also be announced in the NEWS file, but WHERE in the
NEWS file depends on whether Julien wants to put this into 11.01 (which
should really be 11.04 now).

Zoltan.

Improve the compiler's ability to deal with determinism errors, in three ways.

1. Add a new pragma, no_determinism_warning, that suppresses the compiler's
   warning about a determinism declaration that is not as tight as possible.

2. When printing determinism errors about disjunctions in supposed-to-be-det
   code, print the list of switch arms that the disjunction is in. Without
   this, it can be hard to find duplicated cases in a long list of switch
   cases. (If the report tells you there is a disjunction in the arm for
   f/1 in the switch on X, it tells you that you have duplicated the arm
   for X = f(_).)

3. When the compiler prints a message about a switch on a variable not covering
   some cases, sometimes the variable is an anonymous variable:

	   The switch on V_16 does not cover ...

   These anonymous variables are created by common-structure elimination,
   which groups disjuncts containing unifications such as A = f(a), A = f(b),
   A = f(c) into a single arm of the switch on A, A = f(V_16), with a switch
   inside that on V_16.

   The third part of this diff gives the context of the error in the error
   switch as not being the arm for f/1 in the switch on A, but as the arm for
   f(V_16) in the switch on A, thus letting users know where the anonymous
   variable comes from.

doc/reference_manual.texi:
	Document the new pragma.

compiler/prog_item.m:
	Add the new pragma to the list of pragmas we recognize.

compiler/hlds_pred.m:
	Add the new kind of predicate marker whose presence indicates
	that this pragma was given for this predicate.

compiler/prog_io_pragma.m:
	Parse the new pragma.

compiler/add_pragma.m:
	Process the new pragma: when found, set the marker on the named
	predicate.

compiler/det_report.m:
	Make all three changes listed above.

	In addition, fix a problem that used to happen only rarely:
	when printing switch contexts, we used to print them from the inside
	out, not the outside in.

	Capitalize only the first clause in a multi-clause error message.

compiler/hlds_out_util.m:
	Add a function for printing a cons_id either with or without its
	arguments, for use by det_report.m Let this function string module
	qualifiers from cons_ids, since these are virtually always obvious,
	and whose printing is therefore unnecessary clutter.

compiler/equiv_type.m:
compiler/hlds_out_pred.m:
compiler/make_hlds_passes.m:
compiler/mercury_to_mercury.m:
compiler/module_qual.m:
compiler/modules.m:
compiler/recompilation.version.m:
compiler/table_gen.m:
	Conform to the changes above.

tests/invalid/det_errors.{m,err_exp}:
	Add some predicates to this module to test the new functionality,
	and update the expected output.

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/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
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/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.109
diff -u -b -r1.109 add_pragma.m
--- compiler/add_pragma.m	7 Mar 2011 03:59:23 -0000	1.109
+++ compiler/add_pragma.m	6 Apr 2011 13:37:54 -0000
@@ -243,6 +243,10 @@
         add_pred_marker("obsolete", Name, Arity, ImportStatus,
             Context, marker_obsolete, [], !ModuleInfo, !Specs)
     ;
+        Pragma = pragma_no_detism_warning(Name, Arity),
+        add_pred_marker("no_determinism_warning", Name, Arity, ImportStatus,
+            Context, marker_no_detism_warning, [], !ModuleInfo, !Specs)
+    ;
         % Handle pragma foreign_export decls later on, after default
         % function modes have been added.
         Pragma = pragma_foreign_export(_, _, _, _, _)
Index: compiler/det_report.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/det_report.m,v
retrieving revision 1.154
diff -u -b -r1.154 det_report.m
--- compiler/det_report.m	1 Apr 2011 08:43:44 -0000	1.154
+++ compiler/det_report.m	7 Apr 2011 15:50:40 -0000
@@ -163,6 +163,7 @@
 :- import_module maybe.
 :- import_module pair.
 :- import_module require.
+:- import_module set.
 :- import_module set_tree234.
 :- import_module solutions.
 :- import_module string.
@@ -216,6 +217,10 @@
                 % Don't report warnings for procedures with no clauses.
                 \+ check_marker(Markers, marker_stub),
 
+                % Don't report warnings for predicates for which the user
+                % has written a pragma requesting no warnings.
+                \+ check_marker(Markers, marker_no_detism_warning),
+
                 % Don't report warnings for compiler-generated Unify, Compare
                 % or Index procedures, since the user has no way to shut
                 % these up. These can happen for the Unify pred for the unit
@@ -585,16 +590,20 @@
     ;
         GoalExpr = disj(Goals),
         det_diagnose_disj(Goals, InstMap0, Desired, Actual, SwitchContexts,
-            !DetInfo, 0, ClausesWithSoln, Msgs1),
+            !DetInfo, 0, DisjunctsWithSoln, Msgs1),
         determinism_components(Desired, _, DesSolns),
         (
             DesSolns \= at_most_many,
             DesSolns \= at_most_many_cc,
-            ClausesWithSoln > 1
+            DisjunctsWithSoln > 1
         ->
             Context = goal_info_get_context(GoalInfo),
-            Pieces =
+            det_diagnose_switch_context(!.DetInfo, SwitchContexts,
+                NestingPieces),
+            DisjPieces =
                 [words("Disjunction has multiple clauses with solutions.")],
+            Pieces = NestingPieces ++ [lower_case_next_if_not_first]
+                ++ DisjPieces,
             Msg = simple_msg(Context, [always(Pieces)]),
             Msgs = [Msg] ++ Msgs1
         ;
@@ -611,7 +620,7 @@
             determinism_components(Desired, cannot_fail, _)
         ->
             Context = goal_info_get_context(GoalInfo),
-            det_diagnose_switch_context(SwitchContexts, !.DetInfo,
+            det_diagnose_switch_context(!.DetInfo, SwitchContexts,
                 NestingPieces),
             find_missing_cons_ids(!.DetInfo, InstMap0, Var, Cases,
                 VarStr, MaybeMissingPieces),
@@ -812,9 +821,9 @@
     is det.
 
 det_diagnose_disj([], _InstMap0, _Desired, _Actual, _SwitchContexts,
-        !DetInfo, !ClausesWithSoln, []).
+        !DetInfo, !DisjunctsWithSoln, []).
 det_diagnose_disj([Goal | Goals], InstMap0, Desired, Actual, SwitchContexts,
-        !DetInfo, !ClausesWithSoln, Msgs) :-
+        !DetInfo, !DisjunctsWithSoln, Msgs) :-
     determinism_components(Actual, ActualCanFail, _),
     determinism_components(Desired, DesiredCanFail, DesiredSolns),
     (
@@ -841,10 +850,10 @@
     ->
         true
     ;
-        !:ClausesWithSoln = !.ClausesWithSoln + 1
+        !:DisjunctsWithSoln = !.DisjunctsWithSoln + 1
     ),
     det_diagnose_disj(Goals, InstMap0, Desired, Actual, SwitchContexts,
-        !DetInfo, !ClausesWithSoln, Msgs2),
+        !DetInfo, !DisjunctsWithSoln, Msgs2),
     Msgs = Msgs1 ++ Msgs2.
 
 :- pred det_diagnose_switch_arms(prog_var::in, mer_type::in, list(case)::in,
@@ -856,7 +865,10 @@
 det_diagnose_switch_arms(Var, VarType, [Case | Cases], InstMap0, Desired,
         SwitchContexts0, !DetInfo, Msgs) :-
     Case = case(MainConsId, OtherConsIds, Goal),
-    NewSwitchContext = switch_context(Var, MainConsId, OtherConsIds),
+    goal_to_conj_list(Goal, GoalSeq),
+    find_switch_var_matches(GoalSeq, [Var], MainConsId, OtherConsIds,
+        MainMatch, OtherMatches),
+    NewSwitchContext = switch_context(Var, MainMatch, OtherMatches),
     SwitchContexts1 = [NewSwitchContext | SwitchContexts0],
     det_info_get_module_info(!.DetInfo, ModuleInfo0),
     bind_var_to_functors(Var, VarType, MainConsId, OtherConsIds,
@@ -868,6 +880,120 @@
         SwitchContexts0, !DetInfo, Msgs2),
     Msgs = Msgs1 ++ Msgs2.
 
+    % Given the list of conjuncts in a switch arm, find the unifications that
+    % unify the switched-on variable or its synonyms with the arm's cons_ids.
+    % The reason why we look for this is to get access to the argument
+    % variables of that unification, in case code inside the arm has errors
+    % in switches on those arguments. We don't collect argument variables
+    % from unifications in which they are all local, since in that case
+    % there is no chance of that happening, which means that printing
+    % the argument variables in that case would not be helpful, and
+    % would instead be only clutter.
+    %
+:- pred find_switch_var_matches(list(hlds_goal)::in, list(prog_var)::in,
+    cons_id::in, list(cons_id)::in,
+    switch_match::out, list(switch_match)::out) is det.
+
+find_switch_var_matches([], _, MainConsId, OtherConsIds,
+        MainMatch, OtherMatches) :-
+    make_switch_match_no_args(MainConsId, MainMatch),
+    list.map(make_switch_match_no_args, OtherConsIds, OtherMatches).
+find_switch_var_matches([Conjunct | Conjuncts], !.SwitchVarSynonyms,
+        MainConsId, OtherConsIds, MainMatch, OtherMatches) :-
+    Conjunct = hlds_goal(GoalExpr, GoalInfo),
+    (
+        GoalExpr = unify(_, _, _, Unification, _),
+        Unification = deconstruct(Var, MainConsId, ArgVars, _, _, _),
+        list.member(Var, !.SwitchVarSynonyms),
+        OtherConsIds = []
+    ->
+        NonLocals = goal_info_get_nonlocals(GoalInfo),
+        set.list_to_set(ArgVars, ArgVarsSet),
+        (
+            set.intersect(NonLocals, ArgVarsSet, NonLocalArgVarsSet),
+            set.non_empty(NonLocalArgVarsSet)
+        ->
+            MaybeArgVars = yes(ArgVars)
+        ;
+            MaybeArgVars = no
+        ),
+        MainMatch = switch_match(MainConsId, MaybeArgVars),
+        OtherMatches = []
+    ;
+        GoalExpr = disj(Disjuncts),
+        find_switch_var_submatches(Disjuncts, !.SwitchVarSynonyms,
+            yes(MainConsId), OtherConsIds, yes(MainMatch0), OtherMatches0)
+    ->
+        MainMatch = MainMatch0,
+        OtherMatches = OtherMatches0
+    ;
+        (
+            GoalExpr = unify(_, _, _, Unification, _),
+            Unification = assign(ToVar, FromVar),
+            list.member(FromVar, !.SwitchVarSynonyms)
+        ->
+            !:SwitchVarSynonyms = [ToVar | !.SwitchVarSynonyms]
+        ;
+            true
+        ),
+        find_switch_var_matches(Conjuncts, !.SwitchVarSynonyms,
+            MainConsId, OtherConsIds, MainMatch, OtherMatches)
+    ).
+
+    % If a conjunct in a switch arm is disjunction, check whether it is
+    % the disjunction that specifies that this is the arm for MainConsId
+    % and OtherConsIds. Once we have found a cons_id, we delete it from
+    % the list of cons_ids the recursive call should look for. In the case of
+    % the main cons_id, we do this by passing `no' as the MaybeMainConsId
+    % argument; in the case of the other cons_ids, we do this by deleting it
+    % from the OtherConsIds argument.
+    %
+    % If a call to this predicate succeeds, it should return switch_matches
+    % for exactly the set of main and other cons_ids it was invoked with.
+    %
+:- pred find_switch_var_submatches(list(hlds_goal)::in, list(prog_var)::in,
+    maybe(cons_id)::in, list(cons_id)::in,
+    maybe(switch_match)::out, list(switch_match)::out) is semidet.
+
+find_switch_var_submatches([], _, no, [], no, []).
+find_switch_var_submatches([Disjunct | Disjuncts], SwitchVarSynonyms,
+        MaybeMainConsId, OtherConsIds, MaybeMainMatch, OtherMatches) :-
+    Disjunct = hlds_goal(GoalExpr, GoalInfo),
+    GoalExpr = unify(_, _, _, Unification, _),
+    Unification = deconstruct(Var, ConsId, ArgVars, _, _, _),
+    list.member(Var, SwitchVarSynonyms),
+    (
+        MaybeMainConsId = yes(MainConsId),
+        ConsId = MainConsId
+    ->
+        find_switch_var_submatches(Disjuncts, SwitchVarSynonyms,
+            no, OtherConsIds, no, OtherMatches),
+        MaybeMainMatch = yes(switch_match(ConsId, yes(ArgVars)))
+    ;
+        list.delete_first(OtherConsIds, ConsId, LeftOverConsIds)
+    ->
+        find_switch_var_submatches(Disjuncts, SwitchVarSynonyms,
+            MaybeMainConsId, LeftOverConsIds, MaybeMainMatch, LeftOverMatches),
+        NonLocals = goal_info_get_nonlocals(GoalInfo),
+        set.list_to_set(ArgVars, ArgVarsSet),
+        (
+            set.intersect(NonLocals, ArgVarsSet, NonLocalArgVarsSet),
+            set.non_empty(NonLocalArgVarsSet)
+        ->
+            MaybeArgVars = yes(ArgVars)
+        ;
+            MaybeArgVars = no
+        ),
+        OtherMatches = [switch_match(ConsId, MaybeArgVars) | LeftOverMatches]
+    ;
+        fail
+    ).
+
+:- pred make_switch_match_no_args(cons_id::in, switch_match::out) is det.
+
+make_switch_match_no_args(ConsId, Match) :-
+    Match = switch_match(ConsId, no).
+
 :- pred det_diagnose_orelse_goals(list(hlds_goal)::in, instmap::in,
     determinism::in, list(switch_context)::in, det_info::in, det_info::out,
     list(error_msg)::out) is det.
@@ -875,6 +1001,8 @@
 det_diagnose_orelse_goals([], _, _Desired, _SwitchContexts, !DetInfo, []).
 det_diagnose_orelse_goals([Goal | Goals], InstMap0, Desired, SwitchContexts0,
         !DetInfo, Msgs) :-
+    % XXX Once we start using STM in earnest, we should add something
+    % representing "In orelse arm #n:" to the switch context.
     det_diagnose_goal(Goal, InstMap0, Desired, SwitchContexts0,
         !DetInfo, Msgs1),
     det_diagnose_orelse_goals(Goals, InstMap0, Desired, SwitchContexts0,
@@ -883,9 +1011,8 @@
 
 %-----------------------------------------------------------------------------%
 
-    % Check that the switches in all require_complete_switch scopes
-    % are actually complete. If they are not, add an error message
-    % to !DetInfo.
+    % Check that the switches in all require_complete_switch scopes are
+    % actually complete. If they are not, add an error message to !DetInfo.
     %
 :- pred reqscope_check_goal(hlds_goal::in, instmap::in,
     det_info::in, det_info::out) is det.
@@ -1131,27 +1258,59 @@
 
 :- type switch_context
     --->    switch_context(
-                prog_var,           % The variable being switched on.
-                cons_id,            % The first cons_id of this case.
-                list(cons_id)       % Any other cons_ids of this case.
+                % The variable being switched on.
+                prog_var,
+
+                % The match info for the first cons_id of this case.
+                switch_match,
+
+                % The match info for the other cons_ids of this case.
+                list(switch_match)
             ).
 
-:- pred det_diagnose_switch_context(list(switch_context)::in, det_info::in,
+    % A switch arm is for one or more cons_ids. A switch match can record,
+    % for one of these cons_ids, the variables on the right hand side of
+    % the unification that told switch detection that this disjunction
+    % can succeed only the switched-on variable is bound to one of these
+    % cons_ids. For example, in a switch on X, if the switch arm is
+    % for the cons_id f/2, this means that the switch arm should have
+    % a unification of the form X = f(A, B). Likewise, if the switch arm
+    % is for more than one cons_id, such as f/2 and g/1, then the switch arm
+    % should contain a disjunction such as ( X = f(A, B) ; X = g(C) ).
+    % The switch match data type records the argument variables of these
+    % unifications PROVIDED that some of them are visible from the outside,
+    % which means that later error messages (e.g. about missing arms in
+    % switches on them) can refer to them.
+    %
+:- type switch_match
+    --->    switch_match(cons_id, maybe(list(prog_var))).
+
+:- pred det_diagnose_switch_context(det_info::in, list(switch_context)::in,
     list(format_component)::out) is det.
 
-det_diagnose_switch_context([], _, []).
-det_diagnose_switch_context([SwitchContext | SwitchContexts], DetInfo,
-        HeadPieces ++ TailPieces) :-
+det_diagnose_switch_context(_, [], []).
+det_diagnose_switch_context(DetInfo, [SwitchContext | SwitchContexts],
+        Pieces) :-
     det_get_proc_info(DetInfo, ProcInfo),
     proc_info_get_varset(ProcInfo, VarSet),
-    SwitchContext = switch_context(Var, MainConsId, OtherConsIds),
-    MainConsIdStr = cons_id_and_arity_to_string(MainConsId),
-    OtherConsIdStrs = list.map(cons_id_and_arity_to_string, OtherConsIds),
-    ConsIdsStr = string.join_list(", ", [MainConsIdStr | OtherConsIdStrs]),
+    SwitchContext = switch_context(Var, MainMatch, OtherMatches),
+    MainMatchStr = switch_match_to_string(VarSet, MainMatch),
+    OtherMatchStrs = list.map(switch_match_to_string(VarSet), OtherMatches),
+    MatchsStr = string.join_list(", ", [MainMatchStr | OtherMatchStrs]),
     VarStr = mercury_var_to_string(VarSet, no, Var),
-    HeadPieces = [words("Inside the case"), words(ConsIdsStr),
+    InnerPieces = [words("Inside the case"), words(MatchsStr),
         words("of the switch on"), fixed(VarStr), suffix(":"), nl],
-    det_diagnose_switch_context(SwitchContexts, DetInfo, TailPieces).
+    det_diagnose_switch_context(DetInfo, SwitchContexts, OuterPieces),
+    % We construct the list of switch contexts so that inner contexts come
+    % before outer contexts, but we want to print the contexts from the outside
+    % towards the inside.
+    Pieces = OuterPieces ++ [lower_case_next_if_not_first] ++ InnerPieces.
+
+:- func switch_match_to_string(prog_varset, switch_match) = string.
+
+switch_match_to_string(VarSet, switch_match(ConsId, MaybeArgVars)) =
+    cons_id_and_vars_or_arity_to_string(do_not_qualify_cons_id, VarSet,
+        ConsId, MaybeArgVars).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/equiv_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type.m,v
retrieving revision 1.87
diff -u -b -r1.87 equiv_type.m
--- compiler/equiv_type.m	18 Mar 2011 04:08:12 -0000	1.87
+++ compiler/equiv_type.m	6 Apr 2011 14:26:11 -0000
@@ -644,6 +644,7 @@
         ; Pragma0 = pragma_mode_check_clauses(_, _)
         ; Pragma0 = pragma_no_inline(_, _)
         ; Pragma0 = pragma_obsolete(_, _)
+        ; Pragma0 = pragma_no_detism_warning(_, _)
         ; Pragma0 = pragma_promise_equivalent_clauses(_, _)
         ; Pragma0 = pragma_promise_pure(_, _)
         ; Pragma0 = pragma_promise_semipure(_, _)
Index: compiler/hlds_out_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_pred.m,v
retrieving revision 1.6
diff -u -b -r1.6 hlds_out_pred.m
--- compiler/hlds_out_pred.m	7 Mar 2011 03:59:24 -0000	1.6
+++ compiler/hlds_out_pred.m	6 Apr 2011 14:25:32 -0000
@@ -1238,6 +1238,7 @@
 marker_name(marker_user_marked_no_inline, "no_inline").
 marker_name(marker_heuristic_inline, "heuristic_inline").
 marker_name(marker_obsolete, "obsolete").
+marker_name(marker_no_detism_warning, "no_determinism_warning").
 marker_name(marker_class_method, "class_method").
 marker_name(marker_class_instance_method, "class_instance_method").
 marker_name(marker_named_class_instance_method, "named_class_instance_method").
Index: compiler/hlds_out_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out_util.m,v
retrieving revision 1.3
diff -u -b -r1.3 hlds_out_util.m
--- compiler/hlds_out_util.m	7 Mar 2011 03:59:24 -0000	1.3
+++ compiler/hlds_out_util.m	7 Apr 2011 08:02:04 -0000
@@ -27,6 +27,7 @@
 :- import_module bool.
 :- import_module io.
 :- import_module list.
+:- import_module maybe.
 :- import_module pair.
 :- import_module term.
 
@@ -153,6 +154,16 @@
 :- pred write_cons_id_and_arity(cons_id::in, io::di, io::uo) is det.
 :- func cons_id_and_arity_to_string(cons_id) = string.
 
+:- type maybe_qualify_cons_id
+    --->    qualify_cons_id
+    ;       do_not_qualify_cons_id.
+
+:- pred write_cons_id_and_vars_or_arity(maybe_qualify_cons_id::in,
+    prog_varset::in, cons_id::in, maybe(list(prog_var))::in,
+    io::di, io::uo) is det.
+:- func cons_id_and_vars_or_arity_to_string(maybe_qualify_cons_id,
+    prog_varset, cons_id, maybe(list(prog_var))) = string.
+
 %-----------------------------------------------------------------------------%
 
 :- pred write_constraint_proofs(int::in, tvarset::in,
@@ -723,11 +734,129 @@
         ),
         SymNameString = term_io.escaped_string(SymNameString1),
         string.int_to_string(Arity, ArityString),
-        string.append_list([SymNameString, "/", ArityString], String)
+        String = SymNameString ++ "/" ++ ArityString
+    ;
+        ConsId = tuple_cons(Arity),
+        String = "{}/" ++ string.int_to_string(Arity)
+    ;
+        ConsId = int_const(Int),
+        string.int_to_string(Int, String)
+    ;
+        ConsId = float_const(Float),
+        String = float_to_string(Float)
+    ;
+        ConsId = char_const(CharConst),
+        String = term_io.quoted_char(CharConst)
+    ;
+        ConsId = string_const(StringConst),
+        String = term_io.quoted_string(StringConst)
+    ;
+        ConsId = impl_defined_const(Name),
+        String = "$" ++ Name
+    ;
+        ConsId = closure_cons(PredProcId, _),
+        PredProcId = shrouded_pred_proc_id(PredId, ProcId),
+        String =
+            "<pred " ++ int_to_string(PredId) ++
+            " proc " ++ int_to_string(ProcId) ++ ">"
+    ;
+        ConsId = type_ctor_info_const(Module, Ctor, Arity),
+        String =
+            "<type_ctor_info " ++ sym_name_to_string(Module) ++ "." ++
+            Ctor ++ "/" ++ int_to_string(Arity) ++ ">"
+    ;
+        ConsId = base_typeclass_info_const(_, _, _, _),
+        String = "<base_typeclass_info>"
+    ;
+        ConsId = type_info_cell_constructor(_),
+        String = "<type_info_cell_constructor>"
+    ;
+        ConsId = typeclass_info_cell_constructor,
+        String = "<typeclass_info_cell_constructor>"
+    ;
+        ConsId = tabling_info_const(PredProcId),
+        PredProcId = shrouded_pred_proc_id(PredId, ProcId),
+        String =
+            "<tabling_info " ++ int_to_string(PredId) ++
+            ", " ++ int_to_string(ProcId) ++ ">"
+    ;
+        ConsId = table_io_decl(PredProcId),
+        PredProcId = shrouded_pred_proc_id(PredId, ProcId),
+        String =
+            "<table_io_decl " ++ int_to_string(PredId) ++ ", " ++
+            int_to_string(ProcId) ++ ">"
+    ;
+        ConsId = deep_profiling_proc_layout(PredProcId),
+        PredProcId = shrouded_pred_proc_id(PredId, ProcId),
+        String =
+            "<deep_profiling_proc_layout " ++ int_to_string(PredId) ++ ", " ++
+            int_to_string(ProcId) ++ ">"
+    ).
+
+write_cons_id_and_vars_or_arity(Qual, VarSet, ConsId, MaybeArgVars, !IO) :-
+    io.write_string(
+        cons_id_and_vars_or_arity_to_string(Qual, VarSet,
+            ConsId, MaybeArgVars),
+        !IO).
+
+cons_id_and_vars_or_arity_to_string(Qual, VarSet, ConsId, MaybeArgVars)
+        = String :-
+    (
+        ConsId = cons(SymName0, Arity, _TypeCtor),
+        (
+            Qual = qualify_cons_id,
+            SymName = SymName0
+        ;
+            Qual = do_not_qualify_cons_id,
+            SymName = unqualified(unqualify_name(SymName0))
+        ),
+        SymNameString0 = sym_name_to_string(SymName),
+        ( string.contains_char(SymNameString0, '*') ->
+            % We need to protect against the * appearing next to a /
+            Stuff = (pred(Char::in, Str0::in, Str::out) is det :-
+                ( Char = ('*') ->
+                    string.append(Str0, "star", Str)
+                ;
+                    string.char_to_string(Char, CharStr),
+                    string.append(Str0, CharStr, Str)
+                )
+            ),
+            string.foldl(Stuff, SymNameString0, "", SymNameString1)
+        ;
+            SymNameString1 = SymNameString0
+        ),
+        SymNameString = term_io.escaped_string(SymNameString1),
+        (
+            MaybeArgVars = no,
+            String = SymNameString ++ "/" ++ string.int_to_string(Arity)
+        ;
+            MaybeArgVars = yes(ArgVars),
+            (
+                ArgVars = [],
+                String = SymNameString ++ "/" ++ string.int_to_string(Arity)
+            ;
+                ArgVars = [_ | _],
+                ArgStr = mercury_vars_to_string(VarSet, no, ArgVars),
+                String = SymNameString ++ "(" ++ ArgStr ++ ")"
+            )
+        )
     ;
         ConsId = tuple_cons(Arity),
+        (
+            MaybeArgVars = no,
         String = "{}/" ++ string.int_to_string(Arity)
     ;
+            MaybeArgVars = yes(ArgVars),
+            (
+                ArgVars = [],
+                String = "{}/" ++ string.int_to_string(Arity)
+            ;
+                ArgVars = [_ | _],
+                ArgStr = mercury_vars_to_string(VarSet, no, ArgVars),
+                String = "{" ++ ArgStr ++ "}"
+            )
+        )
+    ;
         ConsId = int_const(Int),
         string.int_to_string(Int, String)
     ;
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.266
diff -u -b -r1.266 hlds_pred.m
--- compiler/hlds_pred.m	7 Mar 2011 03:59:24 -0000	1.266
+++ compiler/hlds_pred.m	6 Apr 2011 13:35:04 -0000
@@ -333,6 +333,11 @@
             % Requests warnings if this predicate is used.
             % Used for pragma(obsolete).
 
+    ;       marker_no_detism_warning
+            % Requests no warnings about the determinism of this predicate
+            % being too loose.
+            % Used for pragma(no_determinism_warning).
+
     ;       marker_user_marked_inline
             % The user requests that this be predicate should be inlined,
             % even if it exceeds the usual size limits. Used for
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.258
diff -u -b -r1.258 intermod.m
--- compiler/intermod.m	7 Mar 2011 03:59:25 -0000	1.258
+++ compiler/intermod.m	6 Apr 2011 15:04:38 -0000
@@ -2006,6 +2006,7 @@
     % The warning for calls to local obsolete predicates should appear
     % once in the defining module, not in importing modules.
 should_output_marker(marker_obsolete, no).
+should_output_marker(marker_no_detism_warning, no).
 should_output_marker(marker_user_marked_inline, yes).
 should_output_marker(marker_user_marked_no_inline, yes).
 should_output_marker(marker_heuristic_inline, no).
Index: compiler/make_hlds_passes.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make_hlds_passes.m,v
retrieving revision 1.106
diff -u -b -r1.106 make_hlds_passes.m
--- compiler/make_hlds_passes.m	15 Dec 2010 06:29:43 -0000	1.106
+++ compiler/make_hlds_passes.m	6 Apr 2011 14:47:44 -0000
@@ -1299,6 +1299,7 @@
         ; Pragma = pragma_mode_check_clauses(_, _)
         ; Pragma = pragma_no_inline(_, _)
         ; Pragma = pragma_obsolete(_, _)
+        ; Pragma = pragma_no_detism_warning(_, _)
         ; Pragma = pragma_promise_equivalent_clauses(_, _)
         ; Pragma = pragma_promise_pure(_, _)
         ; Pragma = pragma_promise_semipure(_, _)
@@ -3006,8 +3007,7 @@
         module_info_set_predicate_table(PredTable, !ModuleInfo)
     ;
         PredIds = [],
-        string.append_list(["`:- pragma ", PragmaName, "' declaration"],
-            Description),
+        Description = "`:- pragma " ++ PragmaName ++ "' declaration",
         undefined_pred_or_func_error(Name, Arity, Context, Description, !Specs)
     ).
 
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.346
diff -u -b -r1.346 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	7 Mar 2011 03:59:25 -0000	1.346
+++ compiler/mercury_to_mercury.m	6 Apr 2011 14:48:16 -0000
@@ -705,8 +705,12 @@
             Values, !IO)
     ;
         Pragma = pragma_obsolete(Pred, Arity),
-        mercury_output_pragma_decl(Pred, Arity, pf_predicate, "obsolete", no,
-            !IO)
+        mercury_output_pragma_decl(Pred, Arity, pf_predicate,
+            "obsolete", no, !IO)
+    ;
+        Pragma = pragma_no_detism_warning(Pred, Arity),
+        mercury_output_pragma_decl(Pred, Arity, pf_predicate,
+            "no_determinism_warning", no, !IO)
     ;
         Pragma = pragma_tabled(Type, Pred, Arity, _PredOrFunc, _Mode,
             MaybeAttributes),
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.182
diff -u -b -r1.182 module_qual.m
--- compiler/module_qual.m	17 Mar 2011 05:36:44 -0000	1.182
+++ compiler/module_qual.m	6 Apr 2011 14:48:48 -0000
@@ -1347,33 +1347,56 @@
     mq_info::in, mq_info::out,
     list(error_spec)::in, list(error_spec)::out) is det.
 
-qualify_pragma(X @ pragma_source_file(_), X, !Info, !Specs).
-qualify_pragma(X @ pragma_foreign_decl(_, _, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_foreign_code(_, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_foreign_import_module(_, _), X, !Info, !Specs).
-qualify_pragma(X, Y, !Info, !Specs) :-
-    X = pragma_foreign_export_enum(Lang, TypeName0, TypeArity0, Attributes,
-        Overrides),
+qualify_pragma(Pragma0, Pragma, !Info, !Specs) :-
+    (
+        ( Pragma0 = pragma_source_file(_)
+        ; Pragma0 = pragma_foreign_decl(_, _, _)
+        ; Pragma0 = pragma_foreign_code(_, _)
+        ; Pragma0 = pragma_foreign_import_module(_, _)
+        ; Pragma0 = pragma_inline(_, _)
+        ; Pragma0 = pragma_no_inline(_, _)
+        ; Pragma0 = pragma_obsolete(_, _)
+        ; Pragma0 = pragma_no_detism_warning(_, _)
+        ; Pragma0 = pragma_unused_args(_, _, _, _, _)
+        ; Pragma0 = pragma_exceptions(_, _, _, _, _)
+        ; Pragma0 = pragma_trailing_info(_, _, _, _, _)
+        ; Pragma0 = pragma_mm_tabling_info(_, _, _, _, _)
+        ; Pragma0 = pragma_fact_table(_, _, _)
+        ; Pragma0 = pragma_reserve_tag(_, _)
+        ; Pragma0 = pragma_promise_pure(_, _)
+        ; Pragma0 = pragma_promise_semipure(_, _)
+        ; Pragma0 = pragma_promise_equivalent_clauses(_, _)
+        ; Pragma0 = pragma_terminates(_, _)
+        ; Pragma0 = pragma_does_not_terminate(_, _)
+        ; Pragma0 = pragma_check_termination(_, _)
+        ; Pragma0 = pragma_mode_check_clauses(_, _)
+        ; Pragma0 = pragma_require_feature_set(_)
+        ),
+        Pragma = Pragma0
+    ;
+        Pragma0 = pragma_foreign_export_enum(Lang, TypeName0, TypeArity0,
+            Attributes, Overrides),
     qualify_type_ctor(type_ctor(TypeName0, TypeArity0),
         type_ctor(TypeName, TypeArity), !Info, !Specs),
-    Y = pragma_foreign_export_enum(Lang, TypeName, TypeArity, Attributes,
-        Overrides).
-qualify_pragma(X, Y, !Info, !Specs) :-
-    X = pragma_foreign_enum(Lang, TypeName0, TypeArity0, Values),
+        Pragma = pragma_foreign_export_enum(Lang, TypeName, TypeArity,
+            Attributes, Overrides)
+    ;
+        Pragma0 = pragma_foreign_enum(Lang, TypeName0, TypeArity0, Values),
     qualify_type_ctor(type_ctor(TypeName0, TypeArity0),
         type_ctor(TypeName, TypeArity), !Info, !Specs),
-    Y = pragma_foreign_enum(Lang, TypeName, TypeArity, Values).
-qualify_pragma(X, Y, !Info, !Specs) :-
-    X = pragma_foreign_proc(Attrs0, Name, PredOrFunc, Vars0, Varset,
+        Pragma = pragma_foreign_enum(Lang, TypeName, TypeArity, Values)
+    ;
+        Pragma0 = pragma_foreign_proc(Attrs0, Name, PredOrFunc, Vars0, Varset,
         InstVarset, Impl),
     qualify_pragma_vars(Vars0, Vars, !Info, !Specs),
     UserSharing0 = get_user_annotated_sharing(Attrs0),
     qualify_user_sharing(UserSharing0, UserSharing, !Info, !Specs),
     set_user_annotated_sharing(UserSharing, Attrs0, Attrs),
-    Y = pragma_foreign_proc(Attrs, Name, PredOrFunc, Vars, Varset,
-        InstVarset, Impl).
-qualify_pragma(X, Y, !Info, !Specs) :-
-    X = pragma_tabled(EvalMethod, Name, Arity, PredOrFunc, MModes0, Attrs),
+        Pragma = pragma_foreign_proc(Attrs, Name, PredOrFunc, Vars, Varset,
+            InstVarset, Impl)
+    ;
+        Pragma0 = pragma_tabled(EvalMethod, Name, Arity, PredOrFunc,
+            MModes0, Attrs),
     (
         MModes0 = yes(Modes0),
         qualify_mode_list(Modes0, Modes, !Info, !Specs),
@@ -1382,20 +1405,14 @@
         MModes0 = no,
         MModes = no
     ),
-    Y = pragma_tabled(EvalMethod, Name, Arity, PredOrFunc, MModes, Attrs).
-qualify_pragma(X @ pragma_inline(_, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_no_inline(_, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_obsolete(_, _), X, !Info, !Specs).
-qualify_pragma(X, Y, !Info, !Specs) :-
-    X = pragma_foreign_export(Lang, Name, PredOrFunc, Modes0, CFunc),
+        Pragma = pragma_tabled(EvalMethod, Name, Arity, PredOrFunc,
+            MModes, Attrs)
+    ;
+        Pragma0 = pragma_foreign_export(Lang, Name, PredOrFunc, Modes0, CFunc),
     qualify_mode_list(Modes0, Modes, !Info, !Specs),
-    Y = pragma_foreign_export(Lang, Name, PredOrFunc, Modes, CFunc).
-qualify_pragma(X @ pragma_unused_args(_, _, _, _, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_exceptions(_, _, _, _, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_trailing_info(_, _, _, _, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_mm_tabling_info(_, _, _, _, _), X, !Info, !Specs).
-qualify_pragma(X, Y, !Info, !Specs) :-
-    X = pragma_type_spec(A, B, C, D, MaybeModes0, Subst0, G, H),
+        Pragma = pragma_foreign_export(Lang, Name, PredOrFunc, Modes, CFunc)
+    ;
+        Pragma0 = pragma_type_spec(A, B, C, D, MaybeModes0, Subst0, G, H),
     (
         MaybeModes0 = yes(Modes0),
         qualify_mode_list(Modes0, Modes, !Info, !Specs),
@@ -1405,39 +1422,32 @@
         MaybeModes = no
     ),
     qualify_type_spec_subst(Subst0, Subst, !Info, !Specs),
-    Y = pragma_type_spec(A, B, C, D, MaybeModes, Subst, G, H).
-qualify_pragma(X @ pragma_fact_table(_, _, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_reserve_tag(_, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_promise_pure(_, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_promise_semipure(_, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_promise_equivalent_clauses(_, _), X, !Info, !Specs).
-qualify_pragma(X, Y, !Info, !Specs) :-
-    X = pragma_termination_info(PredOrFunc, SymName, ModeList0, Args, Term),
+        Pragma = pragma_type_spec(A, B, C, D, MaybeModes, Subst, G, H)
+    ;
+        Pragma0 = pragma_termination_info(PredOrFunc, SymName, ModeList0,
+            Args, Term),
     qualify_mode_list(ModeList0, ModeList, !Info, !Specs),
-    Y = pragma_termination_info(PredOrFunc, SymName, ModeList, Args, Term).
-qualify_pragma(X, Y, !Info, !Specs) :-
-    X = pragma_structure_sharing(PredOrFunc, SymName, ModeList0, Vars, Types,
-        Sharing),
+        Pragma = pragma_termination_info(PredOrFunc, SymName, ModeList,
+            Args, Term)
+    ;
+        Pragma0 = pragma_structure_sharing(PredOrFunc, SymName, ModeList0,
+            Vars, Types, Sharing),
     qualify_mode_list(ModeList0, ModeList, !Info, !Specs),
-    Y = pragma_structure_sharing(PredOrFunc, SymName, ModeList, Vars, Types,
-        Sharing).
-qualify_pragma(X, Y, !Info, !Specs) :-
-    X = pragma_structure_reuse(PredOrFunc, SymName, ModeList0, Vars, Types,
-        ReuseTuples),
+        Pragma = pragma_structure_sharing(PredOrFunc, SymName, ModeList,
+            Vars, Types, Sharing)
+    ;
+        Pragma0 = pragma_structure_reuse(PredOrFunc, SymName, ModeList0,
+            Vars, Types, ReuseTuples),
     qualify_mode_list(ModeList0, ModeList, !Info, !Specs),
-    Y = pragma_structure_reuse(PredOrFunc, SymName, ModeList, Vars, Types,
-        ReuseTuples).
-qualify_pragma(X, Y, !Info, !Specs)  :-
-    X = pragma_termination2_info(PredOrFunc, SymName, ModeList0,
+        Pragma = pragma_structure_reuse(PredOrFunc, SymName, ModeList,
+            Vars, Types, ReuseTuples)
+    ;
+        Pragma0 = pragma_termination2_info(PredOrFunc, SymName, ModeList0,
         SuccessArgs, FailureArgs, Term),
     qualify_mode_list(ModeList0, ModeList, !Info, !Specs),
-    Y = pragma_termination2_info(PredOrFunc, SymName, ModeList,
-        SuccessArgs, FailureArgs, Term).
-qualify_pragma(X @ pragma_terminates(_, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_does_not_terminate(_, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_check_termination(_, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_mode_check_clauses(_, _), X, !Info, !Specs).
-qualify_pragma(X @ pragma_require_feature_set(_), X, !Info, !Specs).
+        Pragma = pragma_termination2_info(PredOrFunc, SymName, ModeList,
+            SuccessArgs, FailureArgs, Term)
+    ).
 
 :- pred qualify_pragma_vars(list(pragma_var)::in, list(pragma_var)::out,
     mq_info::in, mq_info::out,
@@ -1510,26 +1520,26 @@
 
     % There is no need to qualify the method name, since that is
     % done when the item is parsed.
-qualify_class_method(
-        method_pred_or_func(TypeVarset, InstVarset, ExistQVars, PredOrFunc,
-            Name, TypesAndModes0, WithType0, WithInst0, MaybeDet,
+qualify_class_method(Method0, Method, !Info, !Specs) :-
+    (
+        Method0 = method_pred_or_func(TypeVarset, InstVarset, ExistQVars,
+            PredOrFunc, Name, TypesAndModes0, WithType0, WithInst0, MaybeDet,
             Cond, Purity, ClassContext0, Context),
-        method_pred_or_func(TypeVarset, InstVarset, ExistQVars, PredOrFunc,
-            Name, TypesAndModes, WithType, WithInst, MaybeDet,
-            Cond, Purity, ClassContext, Context),
-        !Info, !Specs) :-
     qualify_types_and_modes(TypesAndModes0, TypesAndModes, !Info, !Specs),
     qualify_prog_constraints(ClassContext0, ClassContext, !Info, !Specs),
     map_fold2_maybe(qualify_type, WithType0, WithType, !Info, !Specs),
-    map_fold2_maybe(qualify_inst, WithInst0, WithInst, !Info, !Specs).
-qualify_class_method(
-        method_pred_or_func_mode(Varset, PredOrFunc, Name, Modes0,
+        map_fold2_maybe(qualify_inst, WithInst0, WithInst, !Info, !Specs),
+        Method = method_pred_or_func(TypeVarset, InstVarset, ExistQVars,
+            PredOrFunc, Name, TypesAndModes, WithType, WithInst, MaybeDet,
+            Cond, Purity, ClassContext, Context)
+    ;
+        Method0 = method_pred_or_func_mode(Varset, PredOrFunc, Name, Modes0,
             WithInst0, MaybeDet, Cond, Context),
-        method_pred_or_func_mode(Varset, PredOrFunc, Name, Modes,
-            WithInst, MaybeDet, Cond, Context),
-        !Info, !Specs) :-
     qualify_mode_list(Modes0, Modes, !Info, !Specs),
-    map_fold2_maybe(qualify_inst, WithInst0, WithInst, !Info, !Specs).
+        map_fold2_maybe(qualify_inst, WithInst0, WithInst, !Info, !Specs),
+        Method = method_pred_or_func_mode(Varset, PredOrFunc, Name, Modes,
+            WithInst, MaybeDet, Cond, Context)
+    ).
 
 :- pred qualify_instance_body(sym_name::in, instance_body::in,
     instance_body::out) is det.
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.463
diff -u -b -r1.463 modules.m
--- compiler/modules.m	7 Mar 2011 03:59:26 -0000	1.463
+++ compiler/modules.m	6 Apr 2011 14:50:52 -0000
@@ -805,7 +805,7 @@
         [], ImportModuleSpecs, [], UseModuleSpecs, [], TypeDefnInfos),
     (
         Unexpected = yes,
-        unexpected(this_file, "standardize_impl_items: unexpected items")
+        unexpected($module, $pred, "unexpected items")
         % XXX If the above exception is thrown and you need a
         % workaround you can replace the call to unexpected with this code:
         % Items = Items0
@@ -856,16 +856,14 @@
             ( ImportModules = [ModuleSpec] ->
                 insert_module_spec(Context, ModuleSpec, !ImportSpecs)
             ;
-                unexpected(this_file,
-                    "do_standardize_impl_items: non-singleton-module import")
+                unexpected($module, $pred, "non-singleton-module import")
             )
         ;
             ModuleDefn = md_use(UseModules),
             ( UseModules = [ModuleSpec] ->
                 insert_module_spec(Context, ModuleSpec, !UseSpecs)
             ;
-                unexpected(this_file,
-                    "do_standardize_impl_items: non-singleton-module use")
+                unexpected($module, $pred, "non-singleton-module use")
             )
         ;
             ( ModuleDefn = md_imported(_)
@@ -1060,8 +1058,7 @@
             ( Modules = [ModuleName] ->
                 set.member(ModuleName, NecessaryImports)
             ;
-                unexpected(this_file, "is_not_unnecessary_impl_import: " ++
-                    "non-singleton import or use decl")
+                unexpected($module, $pred, "non-singleton import or use decl")
             )
         ;
             true
@@ -1208,7 +1205,7 @@
     ( sym_name_get_module_name(SymName, ModuleName) ->
         svset.insert(ModuleName, !Modules)
     ;
-        unexpected(this_file, "accumulate_modules/3: unknown type encountered")
+        unexpected($module, $pred, "unknown type encountered")
     ).
 
     % Given a type, return the set of user-defined type constructors
@@ -1380,8 +1377,7 @@
     ( sym_name_get_module_name(ClassName, ModuleName) ->
         svset.insert(ModuleName, !Modules)
     ;
-        unexpected(this_file, "get_requirements_of_impl_from_constraint: " ++
-            "unknown typeclass in constraint.")
+        unexpected($module, $pred, "unknown typeclass in constraint")
     ),
     get_modules_from_constraint_arg_types(Args, !Modules).
 
@@ -1406,8 +1402,7 @@
         ( sym_name_get_module_name(TypeName, ModuleName) ->
             svset.insert(ModuleName, !Modules)
         ;
-            unexpected(this_file, "get_modules_from_constraint_arg: " ++
-                "unknown type encountered.")
+            unexpected($module, $pred, "unknown type encountered")
         ),
         get_modules_from_constraint_arg_types(Args, !Modules)
     ;
@@ -1581,6 +1576,7 @@
         ; Pragma = pragma_foreign_export_enum(_, _, _, _, _)
         ; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _)
         ; Pragma = pragma_inline(_, _)
+        ; Pragma = pragma_no_detism_warning(_, _)
         ; Pragma = pragma_no_inline(_, _)
         ; Pragma = pragma_fact_table(_, _, _)
         ; Pragma = pragma_tabled(_, _, _, _, _, _)
@@ -1746,8 +1742,8 @@
             )
         ;
             MaybeTimestamp = no,
-            unexpected(this_file, "write_interface_file with " ++
-                "`--smart-recompilation', timestamp not read")
+            unexpected($module, $pred,
+                "with `--smart-recompilation', timestamp not read")
         )
     ;
         InterfaceItems = InterfaceItems0
@@ -2830,8 +2826,7 @@
     ModuleName = !.Module ^ mai_module_name,
     ModAncestors0 = !.Module ^ mai_parent_deps,
     ( Ancestor = ModuleName ->
-        unexpected(this_file, "process_module_private_interfaces: " ++
-            "module is its own ancestor?")
+        unexpected($module, $pred, "module is its own ancestor?")
     ; list.member(Ancestor, ModAncestors0) ->
         % We've already read it.
         process_module_private_interfaces(Globals, HaveReadModuleMap,
@@ -2988,7 +2983,7 @@
             list.filter_map(FindImports, Items, ImportInfos),
             (
                 ImportInfos = [],
-                unexpected(this_file, "check_parent_module")
+                unexpected($module, $pred, "check_parent_module")
             ;
                 ImportInfos = [_ | _],
                 list.foldl(
@@ -3395,11 +3390,13 @@
     prog_context::in, list(error_spec)::in, list(error_spec)::out) is det.
 
 report_error_implementation_in_interface(ModuleName, Context, !Specs) :-
-    ( ModuleName = qualified(ParentModule0, ChildModule0) ->
+    (
+        ModuleName = qualified(ParentModule0, ChildModule0),
         ParentModule = ParentModule0,
         ChildModule = ChildModule0
     ;
-        unexpected(this_file, "report_error_implementation_in_interface")
+        ModuleName = unqualified(_),
+        unexpected($module, $pred, "unqualified module name")
     ),
     Pieces = [words("In interface for module"), sym_name(ParentModule),
         suffix(":"), nl,
@@ -3450,11 +3447,13 @@
     list(error_spec)::in, list(error_spec)::out) is det.
 
 report_error_duplicate_module_decl(ModuleName - Context, !Specs) :-
-    ( ModuleName = qualified(ParentModule0, ChildModule0) ->
+    (
+        ModuleName = qualified(ParentModule0, ChildModule0),
         ParentModule = ParentModule0,
         ChildModule = ChildModule0
     ;
-        unexpected(this_file, "report_error_duplicate_module_decl")
+        ModuleName = unqualified(_),
+        unexpected($module, $pred, "unqualified module name")
     ),
     Pieces = [words("In module"), sym_name(ParentModule), suffix(":"), nl,
         words("error: sub-module `" ++ ChildModule ++ "' declared"),
@@ -3782,6 +3781,7 @@
             ; Pragma = pragma_trailing_info(_, _, _, _, _)
             ; Pragma = pragma_mm_tabling_info(_, _, _, _, _)
             ; Pragma = pragma_obsolete(_, _)
+            ; Pragma = pragma_no_detism_warning(_, _)
             ; Pragma = pragma_source_file(_)
             ; Pragma = pragma_tabled(_, _, _, _, _, _)
             ; Pragma = pragma_fact_table(_, _, _)
@@ -3879,6 +3879,7 @@
             ; Pragma = pragma_trailing_info(_, _, _, _, _)
             ; Pragma = pragma_mm_tabling_info(_, _, _, _, _)
             ; Pragma = pragma_obsolete(_, _)
+            ; Pragma = pragma_no_detism_warning(_, _)
             ; Pragma = pragma_source_file(_)
             ; Pragma = pragma_tabled(_, _, _, _, _, _)
             ; Pragma = pragma_fact_table(_, _, _)
@@ -4244,56 +4245,69 @@
 :- func reorderable_module_defn(module_defn) = bool.
 
 reorderable_module_defn(ModuleDefn) = Reorderable :-
-    ( ModuleDefn = md_import(_), Reorderable = yes
-    ; ModuleDefn = md_abstract_imported, Reorderable = no
-    ; ModuleDefn = md_export(_), Reorderable = yes
-    ; ModuleDefn = md_external(_, _), Reorderable = yes
-    ; ModuleDefn = md_implementation, Reorderable = no
-    ; ModuleDefn = md_imported(_), Reorderable = no
-    ; ModuleDefn = md_include_module(_), Reorderable = no
-    ; ModuleDefn = md_interface, Reorderable = no
-    ; ModuleDefn = md_opt_imported, Reorderable = no
-    ; ModuleDefn = md_private_interface, Reorderable = no
-    ; ModuleDefn = md_transitively_imported, Reorderable = no
-    ; ModuleDefn = md_use(_), Reorderable = yes
-    ; ModuleDefn = md_used(_), Reorderable = no
-    ; ModuleDefn = md_version_numbers(_, _), Reorderable = no
+    (
+        ( ModuleDefn = md_import(_)
+        ; ModuleDefn = md_export(_)
+        ; ModuleDefn = md_external(_, _)
+        ; ModuleDefn = md_use(_)
+        ),
+        Reorderable = yes
+    ;
+        ( ModuleDefn = md_abstract_imported
+        ; ModuleDefn = md_implementation
+        ; ModuleDefn = md_imported(_)
+        ; ModuleDefn = md_include_module(_)
+        ; ModuleDefn = md_interface
+        ; ModuleDefn = md_opt_imported
+        ; ModuleDefn = md_private_interface
+        ; ModuleDefn = md_transitively_imported
+        ; ModuleDefn = md_used(_)
+        ; ModuleDefn = md_version_numbers(_, _)
+        ),
+        Reorderable = no
     ).
 
 :- func reorderable_pragma_type(pragma_type) = bool.
 
 reorderable_pragma_type(Pragma) = Reorderable :-
-    ( Pragma = pragma_check_termination(_, _), Reorderable = yes
-    ; Pragma = pragma_does_not_terminate(_, _), Reorderable = yes
-    ; Pragma = pragma_exceptions(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_trailing_info(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_mm_tabling_info(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_foreign_export(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_foreign_export_enum(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_foreign_enum(_, _, _, _), Reorderable = yes
-    ; Pragma = pragma_fact_table(_, _, _), Reorderable = no
-    ; Pragma = pragma_foreign_code(_, _), Reorderable = no
-    ; Pragma = pragma_foreign_decl(_, _, _), Reorderable = no
-    ; Pragma = pragma_foreign_import_module(_, _), Reorderable = no
-    ; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _), Reorderable = no
-    ; Pragma = pragma_inline(_, _), Reorderable = yes
-    ; Pragma = pragma_mode_check_clauses(_, _), Reorderable = yes
-    ; Pragma = pragma_no_inline(_, _), Reorderable = yes
-    ; Pragma = pragma_obsolete(_, _), Reorderable = yes
-    ; Pragma = pragma_promise_pure(_, _), Reorderable = yes
-    ; Pragma = pragma_promise_semipure(_, _), Reorderable = yes
-    ; Pragma = pragma_promise_equivalent_clauses(_, _), Reorderable = yes
-    ; Pragma = pragma_reserve_tag(_, _), Reorderable = yes
-    ; Pragma = pragma_source_file(_), Reorderable = no
-    ; Pragma = pragma_tabled(_, _, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_terminates(_, _), Reorderable = yes
-    ; Pragma = pragma_termination2_info(_, _, _, _, _, _), Reorderable = no
-    ; Pragma = pragma_termination_info(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_structure_sharing(_, _, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_structure_reuse(_, _, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_type_spec(_, _, _, _, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_unused_args(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_require_feature_set(_), Reorderable = yes
+    (
+        ( Pragma = pragma_check_termination(_, _)
+        ; Pragma = pragma_does_not_terminate(_, _)
+        ; Pragma = pragma_exceptions(_, _, _, _, _)
+        ; Pragma = pragma_trailing_info(_, _, _, _, _)
+        ; Pragma = pragma_mm_tabling_info(_, _, _, _, _)
+        ; Pragma = pragma_foreign_export(_, _, _, _, _)
+        ; Pragma = pragma_foreign_export_enum(_, _, _, _, _)
+        ; Pragma = pragma_foreign_enum(_, _, _, _)
+        ; Pragma = pragma_inline(_, _)
+        ; Pragma = pragma_mode_check_clauses(_, _)
+        ; Pragma = pragma_no_inline(_, _)
+        ; Pragma = pragma_obsolete(_, _)
+        ; Pragma = pragma_no_detism_warning(_, _)
+        ; Pragma = pragma_promise_pure(_, _)
+        ; Pragma = pragma_promise_semipure(_, _)
+        ; Pragma = pragma_promise_equivalent_clauses(_, _)
+        ; Pragma = pragma_reserve_tag(_, _)
+        ; Pragma = pragma_tabled(_, _, _, _, _, _)
+        ; Pragma = pragma_terminates(_, _)
+        ; Pragma = pragma_termination_info(_, _, _, _, _)
+        ; Pragma = pragma_structure_sharing(_, _, _, _, _, _)
+        ; Pragma = pragma_structure_reuse(_, _, _, _, _, _)
+        ; Pragma = pragma_type_spec(_, _, _, _, _, _, _, _)
+        ; Pragma = pragma_unused_args(_, _, _, _, _)
+        ; Pragma = pragma_require_feature_set(_)
+        ),
+        Reorderable = yes
+    ;
+        ( Pragma = pragma_foreign_code(_, _)
+        ; Pragma = pragma_foreign_decl(_, _, _)
+        ; Pragma = pragma_foreign_import_module(_, _)
+        ; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _)
+        ; Pragma = pragma_source_file(_)
+        ; Pragma = pragma_termination2_info(_, _, _, _, _, _)
+        ; Pragma = pragma_fact_table(_, _, _)
+        ),
+        Reorderable = no
     ).
 
 :- pred is_chunkable(item::in) is semidet.
@@ -4346,56 +4360,69 @@
 :- func chunkable_module_defn(module_defn) = bool.
 
 chunkable_module_defn(ModuleDefn) = Reorderable :-
-    ( ModuleDefn = md_abstract_imported, Reorderable = no
-    ; ModuleDefn = md_export(_), Reorderable = yes
-    ; ModuleDefn = md_external(_, _), Reorderable = yes
-    ; ModuleDefn = md_implementation, Reorderable = no
-    ; ModuleDefn = md_import(_), Reorderable = yes
-    ; ModuleDefn = md_imported(_), Reorderable = no
-    ; ModuleDefn = md_include_module(_), Reorderable = no
-    ; ModuleDefn = md_interface, Reorderable = no
-    ; ModuleDefn = md_opt_imported, Reorderable = no
-    ; ModuleDefn = md_private_interface, Reorderable = no
-    ; ModuleDefn = md_transitively_imported, Reorderable = no
-    ; ModuleDefn = md_use(_), Reorderable = yes
-    ; ModuleDefn = md_used(_), Reorderable = no
-    ; ModuleDefn = md_version_numbers(_, _), Reorderable = no
+    (
+        ( ModuleDefn = md_export(_)
+        ; ModuleDefn = md_external(_, _)
+        ; ModuleDefn = md_import(_)
+        ; ModuleDefn = md_use(_)
+        ),
+        Reorderable = yes
+    ;
+        ( ModuleDefn = md_abstract_imported
+        ; ModuleDefn = md_implementation
+        ; ModuleDefn = md_imported(_)
+        ; ModuleDefn = md_include_module(_)
+        ; ModuleDefn = md_interface
+        ; ModuleDefn = md_opt_imported
+        ; ModuleDefn = md_private_interface
+        ; ModuleDefn = md_transitively_imported
+        ; ModuleDefn = md_used(_)
+        ; ModuleDefn = md_version_numbers(_, _)
+        ),
+        Reorderable = no
     ).
 
 :- func chunkable_pragma_type(pragma_type) = bool.
 
 chunkable_pragma_type(Pragma) = Reorderable :-
-    ( Pragma = pragma_check_termination(_, _), Reorderable = yes
-    ; Pragma = pragma_does_not_terminate(_, _), Reorderable = yes
-    ; Pragma = pragma_exceptions(_, _, _, _, _), Reorderable = no
-    ; Pragma = pragma_foreign_export(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_fact_table(_, _, _), Reorderable = no
-    ; Pragma = pragma_foreign_code(_, _), Reorderable = no
-    ; Pragma = pragma_foreign_decl(_, _, _), Reorderable = no
-    ; Pragma = pragma_foreign_import_module(_, _), Reorderable = no
-    ; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _), Reorderable = no
-    ; Pragma = pragma_foreign_export_enum(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_foreign_enum(_, _, _, _), Reorderable = yes
-    ; Pragma = pragma_inline(_, _), Reorderable = yes
-    ; Pragma = pragma_mode_check_clauses(_, _), Reorderable = yes
-    ; Pragma = pragma_no_inline(_, _), Reorderable = yes
-    ; Pragma = pragma_obsolete(_, _), Reorderable = yes
-    ; Pragma = pragma_promise_pure(_, _), Reorderable = yes
-    ; Pragma = pragma_promise_semipure(_, _), Reorderable = yes
-    ; Pragma = pragma_promise_equivalent_clauses(_, _), Reorderable = yes
-    ; Pragma = pragma_reserve_tag(_, _), Reorderable = yes
-    ; Pragma = pragma_source_file(_), Reorderable = no
-    ; Pragma = pragma_tabled(_, _, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_terminates(_, _), Reorderable = yes
-    ; Pragma = pragma_termination2_info( _, _, _, _, _, _), Reorderable = no
-    ; Pragma = pragma_termination_info(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_structure_sharing(_, _, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_structure_reuse(_, _, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_trailing_info(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_mm_tabling_info(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_type_spec(_, _, _, _, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_unused_args(_, _, _, _, _), Reorderable = yes
-    ; Pragma = pragma_require_feature_set(_), Reorderable = yes
+    (
+        ( Pragma = pragma_check_termination(_, _)
+        ; Pragma = pragma_does_not_terminate(_, _)
+        ; Pragma = pragma_foreign_export(_, _, _, _, _)
+        ; Pragma = pragma_foreign_export_enum(_, _, _, _, _)
+        ; Pragma = pragma_foreign_enum(_, _, _, _)
+        ; Pragma = pragma_inline(_, _)
+        ; Pragma = pragma_mode_check_clauses(_, _)
+        ; Pragma = pragma_no_inline(_, _)
+        ; Pragma = pragma_obsolete(_, _)
+        ; Pragma = pragma_no_detism_warning(_, _)
+        ; Pragma = pragma_promise_pure(_, _)
+        ; Pragma = pragma_promise_semipure(_, _)
+        ; Pragma = pragma_promise_equivalent_clauses(_, _)
+        ; Pragma = pragma_reserve_tag(_, _)
+        ; Pragma = pragma_tabled(_, _, _, _, _, _)
+        ; Pragma = pragma_terminates(_, _)
+        ; Pragma = pragma_termination_info(_, _, _, _, _)
+        ; Pragma = pragma_structure_sharing(_, _, _, _, _, _)
+        ; Pragma = pragma_structure_reuse(_, _, _, _, _, _)
+        ; Pragma = pragma_trailing_info(_, _, _, _, _)
+        ; Pragma = pragma_mm_tabling_info(_, _, _, _, _)
+        ; Pragma = pragma_type_spec(_, _, _, _, _, _, _, _)
+        ; Pragma = pragma_unused_args(_, _, _, _, _)
+        ; Pragma = pragma_require_feature_set(_)
+        ),
+        Reorderable = yes
+    ;
+        ( Pragma = pragma_exceptions(_, _, _, _, _)
+        ; Pragma = pragma_fact_table(_, _, _)
+        ; Pragma = pragma_foreign_code(_, _)
+        ; Pragma = pragma_foreign_decl(_, _, _)
+        ; Pragma = pragma_foreign_import_module(_, _)
+        ; Pragma = pragma_foreign_proc(_, _, _, _, _, _, _)
+        ; Pragma = pragma_source_file(_)
+        ; Pragma = pragma_termination2_info( _, _, _, _, _, _)
+        ),
+        Reorderable = no
     ).
 
     % Given a list of items for which symname_ordered succeeds, we need to keep
@@ -4428,7 +4455,7 @@
     ->
         compare(Result, SymNameA, SymNameB)
     ;
-        unexpected(this_file, "compare_by_symname: symname not found")
+        unexpected($module, $pred, "symname not found")
     ).
 
 %-----------------------------------------------------------------------------%
@@ -4460,11 +4487,5 @@
     ).
 
 %-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "modules.m".
-
-%-----------------------------------------------------------------------------%
 :- end_module modules.
 %-----------------------------------------------------------------------------%
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.144
diff -u -b -r1.144 prog_io_pragma.m
--- compiler/prog_io_pragma.m	4 Apr 2011 23:50:37 -0000	1.144
+++ compiler/prog_io_pragma.m	6 Apr 2011 13:37:05 -0000
@@ -174,6 +174,10 @@
             MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
                 Pragma = pragma_obsolete(Name, Arity))
         ;
+            PragmaName = "no_determinism_warning",
+            MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
+                Pragma = pragma_no_detism_warning(Name, Arity))
+        ;
             PragmaName = "promise_equivalent_clauses",
             MakePragma = (pred(Name::in, Arity::in, Pragma::out) is det :-
                 Pragma = pragma_promise_equivalent_clauses(Name, Arity))
Index: compiler/prog_item.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_item.m,v
retrieving revision 1.42
diff -u -b -r1.42 prog_item.m
--- compiler/prog_item.m	7 Mar 2011 03:59:28 -0000	1.42
+++ compiler/prog_item.m	6 Apr 2011 13:35:05 -0000
@@ -588,6 +588,11 @@
                 % Predname, Arity
             )
 
+    ;       pragma_no_detism_warning(
+                ndw_name                :: sym_name,
+                ndw_arity               :: arity
+            )
+
     ;       pragma_source_file(
                 % Source file name.
                 pragma_source_file      :: string
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.73
diff -u -b -r1.73 recompilation.version.m
--- compiler/recompilation.version.m	15 Dec 2010 06:30:01 -0000	1.73
+++ compiler/recompilation.version.m	6 Apr 2011 15:06:32 -0000
@@ -604,62 +604,66 @@
 :- pred is_pred_pragma(pragma_type::in, maybe(maybe_pred_or_func_id)::out)
     is det.
 
-is_pred_pragma(pragma_foreign_decl(_, _, _), no).
-is_pred_pragma(pragma_foreign_import_module(_, _), no).
-is_pred_pragma(pragma_foreign_code(_, _), no).
-is_pred_pragma(pragma_foreign_proc(_, Name, PredOrFunc, Args, _, _, _),
-        yes(yes(PredOrFunc) - Name / Arity)) :-
-    adjust_func_arity(PredOrFunc, Arity, list.length(Args)).
-is_pred_pragma(pragma_type_spec(Name, _, Arity, MaybePredOrFunc, _, _, _, _),
-        yes(MaybePredOrFunc - Name / Arity)).
-is_pred_pragma(pragma_inline(Name, Arity), yes(no - Name / Arity)).
-is_pred_pragma(pragma_no_inline(Name, Arity), yes(no - Name / Arity)).
-is_pred_pragma(pragma_obsolete(Name, Arity), yes(no - Name / Arity)).
-is_pred_pragma(pragma_foreign_export(_, Name, PredOrFunc, Modes, _),
-        yes(yes(PredOrFunc) - Name / Arity)) :-
-    adjust_func_arity(PredOrFunc, Arity, list.length(Modes)).
-    % Pragma import declarations are never used directly by Mercury code.
-is_pred_pragma(pragma_foreign_export_enum(_, _, _, _, _), no).
-is_pred_pragma(pragma_foreign_enum(_, _, _, _), no).
-is_pred_pragma(pragma_source_file(_), no).
-is_pred_pragma(pragma_unused_args(PredOrFunc, Name, Arity, _, _),
-        yes(yes(PredOrFunc) - Name / Arity)).
-is_pred_pragma(pragma_exceptions(PredOrFunc, Name, Arity, _, _),
-        yes(yes(PredOrFunc) - Name / Arity)).
-is_pred_pragma(pragma_trailing_info(PredOrFunc, Name, Arity, _, _),
-		yes(yes(PredOrFunc) - Name / Arity)).
-is_pred_pragma(pragma_mm_tabling_info(PredOrFunc, Name, Arity, _, _),
-        yes(yes(PredOrFunc) - Name / Arity)).
-is_pred_pragma(pragma_fact_table(Name, Arity, _), yes(no - Name / Arity)).
-is_pred_pragma(pragma_reserve_tag(_TypeName, _TypeArity), no).
-is_pred_pragma(pragma_tabled(_, Name, Arity, MaybePredOrFunc, _, _Attrs),
-        yes(MaybePredOrFunc - Name / Arity)).
-is_pred_pragma(pragma_promise_pure(Name, Arity), yes(no - Name / Arity)).
-is_pred_pragma(pragma_promise_semipure(Name, Arity), yes(no - Name / Arity)).
-is_pred_pragma(pragma_promise_equivalent_clauses(Name, Arity),
-        yes(no - Name / Arity)).
-is_pred_pragma(pragma_termination_info(PredOrFunc, Name, Modes, _, _),
-        yes(yes(PredOrFunc) - Name / Arity)) :-
-    adjust_func_arity(PredOrFunc, Arity, list.length(Modes)).
-is_pred_pragma(pragma_structure_sharing(PredOrFunc, Name, Modes, _, _, _),
-        yes(yes(PredOrFunc) - Name / Arity)) :-
-    adjust_func_arity(PredOrFunc, Arity, list.length(Modes)).
-is_pred_pragma(pragma_structure_reuse(PredOrFunc, Name, Modes, _, _, _),
-        yes(yes(PredOrFunc) - Name / Arity)) :-
-    adjust_func_arity(PredOrFunc, Arity, list.length(Modes)).
-is_pred_pragma(pragma_termination2_info(PredOrFunc, Name, Modes, _, _, _),
-        yes(yes(PredOrFunc) - Name / Arity)) :-
-    adjust_func_arity(PredOrFunc, Arity, list.length(Modes)).
-is_pred_pragma(pragma_terminates(Name, Arity), yes(no - Name / Arity)).
-is_pred_pragma(pragma_does_not_terminate(Name, Arity), yes(no - Name / Arity)).
-is_pred_pragma(pragma_check_termination(Name, Arity), yes(no - Name / Arity)).
-is_pred_pragma(pragma_mode_check_clauses(Name, Arity), yes(no - Name / Arity)).
-is_pred_pragma(pragma_require_feature_set(_), no).
+is_pred_pragma(PragmaType, MaybePredOrFuncId) :-
+    (
+        ( PragmaType = pragma_foreign_decl(_, _, _)
+        ; PragmaType = pragma_foreign_import_module(_, _)
+        ; PragmaType = pragma_foreign_code(_, _)
+        ; PragmaType = pragma_foreign_export_enum(_, _, _, _, _)
+        ; PragmaType = pragma_foreign_enum(_, _, _, _)
+        ; PragmaType = pragma_source_file(_)
+        ; PragmaType = pragma_reserve_tag(_, _)
+        ; PragmaType = pragma_require_feature_set(_)
+        ),
+        MaybePredOrFuncId = no
+    ;
+        ( PragmaType = pragma_inline(Name, Arity)
+        ; PragmaType = pragma_no_inline(Name, Arity)
+        ; PragmaType = pragma_obsolete(Name, Arity)
+        ; PragmaType = pragma_no_detism_warning(Name, Arity)
+        ; PragmaType = pragma_promise_semipure(Name, Arity)
+        ; PragmaType = pragma_promise_equivalent_clauses(Name, Arity)
+        ; PragmaType = pragma_fact_table(Name, Arity, _)
+        ; PragmaType = pragma_promise_pure(Name, Arity)
+        ; PragmaType = pragma_terminates(Name, Arity)
+        ; PragmaType = pragma_does_not_terminate(Name, Arity)
+        ; PragmaType = pragma_check_termination(Name, Arity)
+        ; PragmaType = pragma_mode_check_clauses(Name, Arity)
+        ),
+        MaybePredOrFuncId = yes(no - Name / Arity)
+    ;
+        ( PragmaType = pragma_type_spec(Name, _, Arity, MaybePredOrFunc,
+            _, _, _, _)
+        ; PragmaType = pragma_tabled(_, Name, Arity, MaybePredOrFunc,
+            _, _Attrs)
+        ),
+        MaybePredOrFuncId = yes(MaybePredOrFunc - Name / Arity)
+    ;
+        ( PragmaType = pragma_unused_args(PredOrFunc, Name, Arity, _, _)
+        ; PragmaType = pragma_exceptions(PredOrFunc, Name, Arity, _, _)
+        ; PragmaType = pragma_trailing_info(PredOrFunc, Name, Arity, _, _)
+        ; PragmaType = pragma_mm_tabling_info(PredOrFunc, Name, Arity, _, _)
+        ),
+        MaybePredOrFuncId = yes(yes(PredOrFunc) - Name / Arity)
+    ;
+        PragmaType = pragma_foreign_proc(_, Name, PredOrFunc, Args, _, _, _),
+        adjust_func_arity(PredOrFunc, Arity, list.length(Args)),
+        MaybePredOrFuncId = yes(yes(PredOrFunc) - Name / Arity)
+    ;
+        ( PragmaType = pragma_termination_info(PredOrFunc, Name, Modes, _, _)
+        ; PragmaType = pragma_foreign_export(_, Name, PredOrFunc, Modes, _)
+        ; PragmaType = pragma_structure_sharing(PredOrFunc, Name, Modes, _,_,_)
+        ; PragmaType = pragma_structure_reuse(PredOrFunc, Name, Modes, _, _, _)
+        ; PragmaType = pragma_termination2_info(PredOrFunc, Name, Modes, _,_,_)
+        ),
+        adjust_func_arity(PredOrFunc, Arity, list.length(Modes)),
+        MaybePredOrFuncId = yes(yes(PredOrFunc) - Name / Arity)
+    ).
 
     % XXX This is a bit brittle (need to be careful with term.contexts).
     % For example, it won't work for clauses.
-    % It will never succeed when it shouldn't, so it will never
-    % cause a necessary recompilation to be missed.
+    % It will never succeed when it shouldn't, so it will never cause
+    % a necessary recompilation to be missed.
     %
 :- pred items_are_unchanged(assoc_list(section, item)::in,
     assoc_list(section, item)::in) is semidet.
@@ -673,29 +677,28 @@
     % What matters is that the variable numbers in the arguments
     % and body are the same, the names are usually irrelevant.
     %
-    % The only places where the names of variables affect the
-    % compilation of the program are in explicit type qualifications
-    % and `:- pragma type_spec' declarations. Explicit type
-    % qualifications do not need to be considered here. This module
-    % only deals with items in interface files (we don't yet write type
-    % qualifications to `.opt' files). Variables in type qualifications
-    % are only matched with the head type variables of the predicate
-    % by make_hlds.m. For `:- pragma type_spec' declarations to work
-    % we need to consider a predicate or function declaration to be
-    % changed if the names of any of the type variables are changed.
+    % The only places where the names of variables affect the compilation
+    % of the program are in explicit type qualifications and
+    % `:- pragma type_spec' declarations. Explicit type qualifications
+    % do not need to be considered here. This module only deals with items
+    % in interface files (we don't yet write type qualifications to `.opt'
+    % files). Variables in type qualifications are only matched with
+    % the head type variables of the predicate by make_hlds.m.
+    % For `:- pragma type_spec' declarations to work we need to consider
+    % a predicate or function declaration to be changed if the names
+    % of any of the type variables are changed.
     %
     % It's important not to compare the varsets for type and instance
     % declarations because the declarations we get here may be abstract
     % declarations produced from concrete declarations for use in an
-    % interface file. The varsets may contain variables from the
-    % discarded bodies which will not be present in the items read
-    % in from the interface files for comparison.
+    % interface file. The varsets may contain variables from the discarded
+    % bodies which will not be present in the items read in from the
+    % interface files for comparison.
     %
-    % This code assumes that the variables in the head of a
-    % type or instance declaration are added to the varset before
-    % those from the body, so that the variable numbers in the head of
-    % the declaration match those from an abstract declaration read
-    % from an interface file.
+    % This code assumes that the variables in the head of a type or instance
+    % declaration are added to the varset before those from the body, so that
+    % the variable numbers in the head of the declaration match those from
+    % an abstract declaration read from an interface file.
     %
 :- func item_is_unchanged(item, item) = bool.
 
@@ -796,14 +799,13 @@
                 _, Det2, Cond, Purity, Constraints2, _, _),
 
             % For predicates, ignore the determinism -- the modes and
-            % determinism should have been split into a separate
-            % declaration. This case can only happen if this was
-            % not a combined predicate and mode declaration
-            % (XXX We should warn about this somewhere).
-            % For functions a determinism declaration but no modes
-            % implies the default modes. The default modes are
-            % added later by make_hlds.m, so they won't have been
-            % split into a separate declaration here.
+            % determinism should have been split into a separate declaration.
+            % This case can only happen if this was not a combined predicate
+            % and mode declaration (XXX We should warn about this somewhere).
+            % For functions a determinism declaration but no modes implies
+            % the default modes. The default modes are added later by
+            % make_hlds.m, so they won't have been split into a separate
+            % declaration here.
             (
                 PredOrFunc = pf_function,
                 Det1 = Det2
@@ -838,9 +840,9 @@
         Item1 = item_pragma(ItemPragma1),
         ItemPragma1 = item_pragma_info(_, PragmaType1, _, _),
         % We do need to compare the variable names in `:- pragma type_spec'
-        % declarations because the names of the variables are used
-        % to find the corresponding variables in the predicate or
-        % function type declaration.
+        % declarations because the names of the variables are used to find
+        % the corresponding variables in the predicate or function
+        % type declaration.
         (
             Item2 = item_pragma(ItemPragma2),
             ItemPragma2 = item_pragma_info(_, PragmaType2, _, _)
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.158
diff -u -b -r1.158 table_gen.m
--- compiler/table_gen.m	7 Mar 2011 03:59:29 -0000	1.158
+++ compiler/table_gen.m	6 Apr 2011 14:45:51 -0000
@@ -1963,6 +1963,7 @@
 keep_marker(marker_infer_type) = no.
 keep_marker(marker_infer_modes) = no.
 keep_marker(marker_obsolete) = no.
+keep_marker(marker_no_detism_warning) = no.
 keep_marker(marker_user_marked_inline) = no.
 keep_marker(marker_user_marked_no_inline) = no.
 keep_marker(marker_heuristic_inline) = no.
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.460
diff -u -b -r1.460 reference_manual.texi
--- doc/reference_manual.texi	4 Apr 2011 07:10:39 -0000	1.460
+++ doc/reference_manual.texi	7 Apr 2011 08:21:13 -0000
@@ -9261,6 +9261,8 @@
                                 versions of polymorphic procedures.
 * Obsolescence::                Library developers can declare old versions
                                 of predicates or functions to be obsolete.
+* No determinism warnings::     Pragmas can be used to suppress warnings
+                                about too loose determinism declarations.
 * Source file name::            The @samp{source_file} pragma and
                                 @samp{#@var{line}} directives provide support
                                 for preprocessors and other tools that
@@ -9399,6 +9401,34 @@
 library developer deems that users have had sufficient warning, they
 can remove the old version entirely.
 
+ at node No determinism warnings
+ at section No determinism warnings
+
+A declaration of the form
+
+ at example
+:- pragma no_determinism_warning(@var{Name}/@var{Arity}).
+ at end example
+
+ at noindent
+tells the compiler not to generate any warnings
+that the determinism declarations of procedures of the predicate or function
+with name @var{Name} and arity @var{Arity} are not as tight as they could be.
+
+ at samp{pragma no_determinism_warning} declarations are intended for use
+in situations in which the code of a predicate has one determinism,
+but the declared determinism of the procedure must be looser
+due to some outside requirement.
+One such situation is when a set of procedures are all possible values
+of the same higher order variable,
+which requires them to have the same argument types, modes, and determinisms.
+If (say) most of the procedures are det
+but some are erroneous (that is, they always throws an exception),
+the procedures that are declared det
+but whose bodies have determinism erroneous
+will get a warning saying their determinism declaration could be tighter,
+unless the programmer specifies this pragma for them.
+
 @node Source file name
 @section Source file name
 
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/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_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
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/monte
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/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
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
Index: tests/invalid/det_errors.err_exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/det_errors.err_exp,v
retrieving revision 1.5
diff -u -b -r1.5 det_errors.err_exp
--- tests/invalid/det_errors.err_exp	7 Sep 2006 05:51:26 -0000	1.5
+++ tests/invalid/det_errors.err_exp	7 Apr 2011 15:51:10 -0000
@@ -1,23 +1,55 @@
-det_errors.m:005: In `p1'(in):
-det_errors.m:005:   error: determinism declaration not satisfied.
-det_errors.m:005:   Declared `det', inferred `semidet'.
-det_errors.m:018:   In argument 1 of clause head:
-det_errors.m:018:   unification of `HeadVar__1' and `42' can fail.
-det_errors.m:006: In `p2'(in):
-det_errors.m:006:   error: determinism declaration not satisfied.
-det_errors.m:006:   Declared `det', inferred `semidet'.
-det_errors.m:019:   Unification of `X' and `42' can fail.
-det_errors.m:007: In `p3'(in):
+det_errors.m:007: In `p1'(in):
 det_errors.m:007:   error: determinism declaration not satisfied.
 det_errors.m:007:   Declared `det', inferred `semidet'.
-det_errors.m:020:   Unification of `X' and `42' can fail.
-det_errors.m:008: In `p4'(in):
+det_errors.m:040:   In argument 1 of clause head:
+det_errors.m:040:   unification of `HeadVar__1' and `42' can fail.
+det_errors.m:008: In `p2'(in):
 det_errors.m:008:   error: determinism declaration not satisfied.
 det_errors.m:008:   Declared `det', inferred `semidet'.
-det_errors.m:021:   In argument 2 of functor `+/2':
-det_errors.m:021:   unification with `21' can fail.
-det_errors.m:013: In `q'(in, out):
-det_errors.m:013:   error: determinism declaration not satisfied.
-det_errors.m:013:   Declared `det', inferred `semidet'.
-det_errors.m:024:   The switch on HeadVar__1 does not cover det_errors.d/0,
-det_errors.m:024:   det_errors.e/0, det_errors.f/0 or det_errors.g/0.
+det_errors.m:041:   Unification of `X' and `42' can fail.
+det_errors.m:009: In `p3'(in):
+det_errors.m:009:   error: determinism declaration not satisfied.
+det_errors.m:009:   Declared `det', inferred `semidet'.
+det_errors.m:042:   Unification of `X' and `42' can fail.
+det_errors.m:010: In `p4'(in):
+det_errors.m:010:   error: determinism declaration not satisfied.
+det_errors.m:010:   Declared `det', inferred `semidet'.
+det_errors.m:043:   In argument 2 of functor `+/2':
+det_errors.m:043:   unification with `21' can fail.
+det_errors.m:024: In `q'(in, out):
+det_errors.m:024:   error: determinism declaration not satisfied.
+det_errors.m:024:   Declared `det', inferred `semidet'.
+det_errors.m:046:   The switch on HeadVar__1 does not cover det_errors.d/0,
+det_errors.m:046:   det_errors.e/0, det_errors.f/0, det_errors.g/0,
+det_errors.m:046:   det_errors.h/1 or det_errors.i/1.
+det_errors.m:032: In `r'(in, out):
+det_errors.m:032:   error: determinism declaration not satisfied.
+det_errors.m:032:   Declared `det', inferred `nondet'.
+det_errors.m:052:   Inside the case u3(V_16) of the switch on U:
+det_errors.m:052:   The switch on V_16 does not cover det_errors.d/0,
+det_errors.m:052:   det_errors.e/0, det_errors.f/0, det_errors.g/0,
+det_errors.m:052:   det_errors.h/1 or det_errors.i/1.
+det_errors.m:052:   Inside the case u4(V_17) of the switch on U:
+det_errors.m:052:   inside the case d/0 of the switch on V_17:
+det_errors.m:052:   disjunction has multiple clauses with solutions.
+det_errors.m:052:   Inside the case u4(V_17) of the switch on U:
+det_errors.m:052:   The switch on V_17 does not cover det_errors.h/1 or
+det_errors.m:052:   det_errors.i/1.
+det_errors.m:052:   The switch on U does not cover det_errors.u2/0.
+det_errors.m:033: In `s'(in, out):
+det_errors.m:033:   error: determinism declaration not satisfied.
+det_errors.m:033:   Declared `det', inferred `nondet'.
+det_errors.m:091:   Inside the case u3(V_11) of the switch on U:
+det_errors.m:091:   The switch on V_11 does not cover det_errors.d/0,
+det_errors.m:091:   det_errors.e/0, det_errors.f/0, det_errors.g/0,
+det_errors.m:091:   det_errors.h/1 or det_errors.i/1.
+det_errors.m:091:   The switch on U does not cover det_errors.u2/0.
+det_errors.m:107:   Inside the case u4(V) of the switch on U:
+det_errors.m:107:   inside the case d/0 of the switch on V:
+det_errors.m:107:   disjunction has multiple clauses with solutions.
+det_errors.m:122:   Inside the case u4(V) of the switch on U:
+det_errors.m:122:   inside the case e/0, f/0 of the switch on V:
+det_errors.m:122:   disjunction has multiple clauses with solutions.
+det_errors.m:132:   Inside the case u4(V) of the switch on U:
+det_errors.m:132:   inside the case h/1, i/1 of the switch on V:
+det_errors.m:132:   disjunction has multiple clauses with solutions.
Index: tests/invalid/det_errors.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/invalid/det_errors.m,v
retrieving revision 1.3
diff -u -b -r1.3 det_errors.m
--- tests/invalid/det_errors.m	27 Dec 2004 03:56:03 -0000	1.3
+++ tests/invalid/det_errors.m	7 Apr 2011 15:01:43 -0000
@@ -1,3 +1,5 @@
+% vim: ts=4 sw=4 et ft=mercury
+
 :- module det_errors.
 
 :- interface.
@@ -8,12 +10,32 @@
 :- pred p4(int::in) is det.
 :- pred p5(int::in) is det.
 
-:- type t ---> a ; b ; c ; d ; e ; f ; g.
+:- type t
+    --->    a
+    ;       b
+    ;       c
+    ;       d
+    ;       e
+    ;       f
+    ;       g
+    ;       h(int)
+    ;       i(int).
 
 :- pred q(t::in, int::out) is det.
 
+:- type u
+    --->    u1
+    ;       u2
+    ;       u3(t)
+    ;       u4(t).
+
+:- pred r(u::in, int::out) is det.
+:- pred s(u::in, int::out) is det.
+:- pred t(int::out) is det.
+
 :- implementation.
 :- import_module int.
+:- import_module require.
 
 p1(42).
 p2(X) :- X = 42.
@@ -24,3 +46,97 @@
 q(a, 1).
 q(b, 2).
 q(c, 3).
+
+r(U, X) :-
+    (
+        U = u1,
+        X = 11
+    ;
+        U = u3(a),
+        X = 31
+    ;
+        U = u3(b),
+        X = 32
+    ;
+        U = u3(c),
+        X = 33
+    ;
+        U = u4(a),
+        X = 41
+    ;
+        U = u4(b),
+        X = 42
+    ;
+        U = u4(c),
+        X = 43
+    ;
+        U = u4(d),
+        X = 441
+    ;
+        U = u4(d),
+        X = 442
+    ;
+        U = u4(e),
+        X = 45
+    ;
+        U = u4(f),
+        X = 46
+    ;
+        U = u4(g),
+        X = 47
+    ).
+
+s(U, X) :-
+    (
+        U = u1,
+        X = 11
+    ;
+        U = u3(a),
+        X = 31
+    ;
+        U = u3(b),
+        X = 32
+    ;
+        U = u3(c),
+        X = 33
+    ;
+        U = u4(V),
+        (
+            V = a,
+            X = 41
+        ;
+            V = b,
+            X = 42
+        ;
+            V = c,
+            X = 43
+        ;
+            V = d,
+            X = 441
+        ;
+            V = d,
+            X = 442
+        ;
+            ( V = e
+            ; V = f
+            ),
+            ( X = 461
+            ; X = 462
+            )
+        ;
+            V = g,
+            X = 47
+        ;
+            ( V = h(_)
+            ; V = i(_)
+            ),
+            ( X = 481
+            ; X = 482
+            )
+        )
+    ).
+
+:- pragma no_determinism_warning(t/1).
+
+t(_) :-
+    error("t called").
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
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