[m-rev.] for review: proper fix for deep profiling bug

Zoltan Somogyi zs at csse.unimelb.edu.au
Wed Apr 11 17:58:57 AEST 2007


Replace the workaround for the bootstrapping problem with deep profiling grades
with a proper fix. The fix requires changing the builtin generic unify and
compare routines by removing the pretest comparing the two argument words
for equality. Since this can alter the algorithmic complexity of the program
(for the worse) which a profiler should definitely avoid, we compensate for
this by adding the pretest to the compiler-generated unify and compare
predicates. Since these pretests are executed even when the deleted pretest
wouldn't be, this can also alter algorithmic complexity (for the better)
at the cost of higher constant factors. However, the likelyhood of such
alteration is much smaller: if the top level of a term doesn't match, chances
are most of the function symbols at the lower levels won't match either.
In any case, the user has the option of getting this better algorithmic
complexity anyway by specifying the new option --should-pretest-equality.
However, until we have more experience with it, the documentation of the
new option is commented out.

runtime/mercury_conf_param.h:
	Remove the workaround.

runtime/mercury_unify_compare_body.h:
	Remove the problematic pretest, and document the problem that would
	occur in its presence. Document the user_by_rtti dummy type
	constructor. Fix some misleading abort messages.

compiler/options.m:
	Add the --should-pretest-equality option.

	Add (commented out) documentation for another option for which it was
	missing.

doc/user_guide.texi:
	Add (commented out) documentation for the new option, and for some
	others which it was missing.

compiler/handle_options.m:
	Make deep profiling imply the need for pretests in compiler generated
	unify and compare predicates.

compiler/unify_proc.m:
	If the new option is set, add pretests to unify and compare predicates.
	We have to be careful to make sure that we don't add pretests if they
	would try to unify two non-ground terms, or if the unification is
	guaranteed to fail (since the casts in the pretest would obscure this
	fact)..

	Implementing this required changing the approach of this module.
	Instead of most predicates generating single clauses, they now generate
	disjuncts for a disjunction that itself can be put inside the
	if-then-else whose condition is the pretest. Since these predicates
	not longer generate clauses, their names have been changed accordingly.

compiler/hlds_goal.m:
	Add a goal feature for marking an if-then-else as representing
	a pretest.

compiler/saved_vars.m:
	Handle the new goal feature.

compiler/goal_util.m:
	Add a function for stripping pretests away.

compiler/post_term_analysis.m:
compiler/term_constr_build.m:
compiler/term_pass1.m:
compiler/term_pass2.m:
	Strip pretests away before termination analysis, since the analysis
	can't yet prove termination in the presence of the pretest.

compiler/prog_type.m:
	Add some auxilary predicates, and change the signature of an existing
	predicate to make it more convenient to use.

compiler/type_util.m:
	Conform to the change in prog_type.m, and in the process fix code to
	avoid the assumption that the names of standard library modules are
	unqualified (since the plan is to put them in package "std").

tests/hard_coded/profdeep_seg_fault.{m,exp}:
	Fix the test case to be more readable and to generate properly
	line-terminated output, now that we pass it.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.146
diff -u -b -r1.146 goal_util.m
--- compiler/goal_util.m	13 Jan 2007 12:23:05 -0000	1.146
+++ compiler/goal_util.m	5 Apr 2007 11:35:28 -0000
@@ -388,6 +388,10 @@
     is semidet.
 
 %-----------------------------------------------------------------------------%
+
+:- func maybe_strip_equality_pretest(hlds_goal) = hlds_goal.
+
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -1909,6 +1913,67 @@
 
 %-----------------------------------------------------------------------------%
 
+maybe_strip_equality_pretest(Goal0) = Goal :-
+    % The if_then_else constructed by unify_proc is sometimes wrapped up
+    % in conjunctions.
+    Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+    (
+        ( GoalExpr0 = unify(_, _, _, _, _)
+        ; GoalExpr0 = plain_call(_, _, _, _, _, _)
+        ; GoalExpr0 = generic_call(_, _, _, _)
+        ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+        ),
+        Goal = Goal0
+    ;
+        GoalExpr0 = conj(ConjType, Goals0),
+        Goals = list.map(maybe_strip_equality_pretest, Goals0),
+        GoalExpr = conj(ConjType, Goals),
+        Goal = hlds_goal(GoalExpr, GoalInfo0)
+    ;
+        GoalExpr0 = disj(SubGoals0),
+        SubGoals = list.map(maybe_strip_equality_pretest, SubGoals0),
+        GoalExpr = disj(SubGoals),
+        Goal = hlds_goal(GoalExpr, GoalInfo0)
+    ;
+        GoalExpr0 = switch(Var, CanFail, Cases0),
+        Cases = list.map(maybe_strip_equality_pretest_case, Cases0),
+        GoalExpr = switch(Var, CanFail, Cases),
+        Goal = hlds_goal(GoalExpr, GoalInfo0)
+    ;
+        GoalExpr0 = scope(Reason, SubGoal0),
+        SubGoal = maybe_strip_equality_pretest(SubGoal0),
+        GoalExpr = scope(Reason, SubGoal),
+        Goal = hlds_goal(GoalExpr, GoalInfo0)
+    ;
+        GoalExpr0 = negation(SubGoal0),
+        SubGoal = maybe_strip_equality_pretest(SubGoal0),
+        GoalExpr = negation(SubGoal),
+        Goal = hlds_goal(GoalExpr, GoalInfo0)
+    ;
+        GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+        ( goal_info_has_feature(GoalInfo0, feature_pretest_equality) ->
+            Goal = Else0
+        ;
+            Cond = maybe_strip_equality_pretest(Cond0),
+            Then = maybe_strip_equality_pretest(Then0),
+            Else = maybe_strip_equality_pretest(Else0),
+            GoalExpr = if_then_else(Vars, Cond, Then, Else),
+            Goal = hlds_goal(GoalExpr, GoalInfo0)
+        )
+    ;
+        GoalExpr0 = shorthand(_),
+        unexpected(this_file, "maybe_strip_equality_pretest: shorthand")
+    ).
+
+:- func maybe_strip_equality_pretest_case(case) = case.
+
+maybe_strip_equality_pretest_case(Case0) = Case :-
+    Case0 = case(ConsId, Goal0),
+    Goal = maybe_strip_equality_pretest(Goal0),
+    Case = case(ConsId, Goal).
+
+%-----------------------------------------------------------------------------%
+
 :- func this_file = string.
 
 this_file = "goal_util.m".
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.296
diff -u -b -r1.296 handle_options.m
--- compiler/handle_options.m	2 Mar 2007 02:56:37 -0000	1.296
+++ compiler/handle_options.m	5 Apr 2007 07:13:49 -0000
@@ -1065,6 +1065,13 @@
         option_implies(exec_trace, stack_trace, bool(yes), !Globals),
         option_implies(profile_deep, stack_trace, bool(yes), !Globals),
 
+        % Deep profiling disables the optimization for pretesting whether
+        % x == y in runtime/mercury_unify_compare_body.h, so compensate by
+        % doing the same test in the unify and compare predicates generated by
+        % the Mercury compiler.
+        option_implies(profile_deep, should_pretest_equality, bool(yes),
+            !Globals),
+
         % The `.debug' grade implies --use-trail in most cases. The reason
         % for the implication is to avoid unnecessary proliferation in
         % the number of different grades.  If you're using --debug,
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.176
diff -u -b -r1.176 hlds_goal.m
--- compiler/hlds_goal.m	19 Jan 2007 07:04:13 -0000	1.176
+++ compiler/hlds_goal.m	11 Apr 2007 06:14:02 -0000
@@ -1068,10 +1068,18 @@
             % minimal model tabling. It is safe for the code generator to omit
             % the pneg context wrappers when generating code for this goal.
 
-    ;       feature_contains_trace.
+    ;       feature_contains_trace
             % This goal contains a scope goal whose scope_reason is
             % trace_goal(...).
 
+    ;       feature_pretest_equality.
+            % This goal is an if-then-else in a compiler-generated
+            % type-constructor-specific unify or compare predicate
+            % whose condition is a test of whether the two input arguments
+            % are equal or not. The goal feature exists because in some
+            % circumstances we need to strip off this pretest, and replace
+            % the if-then-else with just its else branch.
+
 %-----------------------------------------------------------------------------%
 %
 % Get/set predicates for the extra_goal_info structure
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.552
diff -u -b -r1.552 options.m
--- compiler/options.m	5 Apr 2007 02:52:43 -0000	1.552
+++ compiler/options.m	5 Apr 2007 06:55:58 -0000
@@ -464,6 +464,7 @@
     ;       max_specialized_do_call_closure
     ;       max_specialized_do_call_class_method
     ;       compare_specialization
+    ;       should_pretest_equality
     ;       fact_table_max_array_size
             % Maximum number of elements in a single fact table data array.
 
@@ -1186,6 +1187,7 @@
                                         % -1 asks handle_options.m to give
                                         % the value, which may be grade
                                         % dependent.
+    should_pretest_equality             -   bool(no),
     fact_table_max_array_size           -   int(1024),
     fact_table_hash_percent_full        -   int(90),
     gcc_local_labels                    -   bool(no),
@@ -1910,6 +1912,7 @@
 % long_option("max-spec-do-call-class-method",
 %                   max_specialized_do_call_class_method).
 long_option("compare-specialization",   compare_specialization).
+long_option("should-pretest-equality",  should_pretest_equality).
 long_option("fact-table-max-array-size",fact_table_max_array_size).
 long_option("fact-table-hash-percent-full",
                     fact_table_hash_percent_full).
@@ -3945,12 +3948,24 @@
         "--no-reclaim-heap-on-failure",
         "\tCombines the effect of the two options above.",
 
-        "--max-jump-table-size",
+        "--max-jump-table-size=<n>",
         "\tThe maximum number of entries a jump table can have.",
         "\tThe special value 0 indicates the table size is unlimited.",
         "\tThis option can be useful to avoid exceeding fixed limits",
         "\timposed by some C compilers.",
 
+        % This is a developer only option.
+%       "--compare-specialization=<n>",
+%       "\tGenerate quadratic instead of linear compare predicates for",
+%       "\ttypes with up to n function symbols. Higher values of n lead to",
+%       "\tfaster but also bigger compare predicates.",
+
+        % This is a developer only option.
+%       "--should-pretest-equality",
+%       "\tIf specified, add a test for the two values being equal as words",
+%       "\tto the starts of potentially expensive unify and compare",
+%       "\tpredicates."
+
         "--fact-table-max-array-size <n>",
         "\tSpecify the maximum number of elements in a single",
         "\t`:- pragma fact_table' data array (default: 1024).",
Index: compiler/post_term_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/post_term_analysis.m,v
retrieving revision 1.14
diff -u -b -r1.14 post_term_analysis.m
--- compiler/post_term_analysis.m	1 Dec 2006 15:04:15 -0000	1.14
+++ compiler/post_term_analysis.m	5 Apr 2007 09:35:19 -0000
@@ -35,6 +35,7 @@
 :- import_module backend_libs.
 :- import_module backend_libs.foreign.
 :- import_module hlds.goal_form.
+:- import_module hlds.goal_util.
 :- import_module hlds.hlds_data.
 :- import_module hlds.hlds_module.
 :- import_module hlds.hlds_out.
@@ -144,19 +145,23 @@
 
 process_special_pred_for_type(ModuleInfo, SpecialPredId, TypeCtor,
         PredId, TypeDefn, !IO) :-
-    (
-        special_pred_needs_term_check(ModuleInfo, SpecialPredId, TypeDefn)
-    ->
+    ( special_pred_needs_term_check(ModuleInfo, SpecialPredId, TypeDefn) ->
         % Compiler generated special preds are always mode 0.
         proc_id_to_int(ProcId, 0),
         module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
-        proc_info_get_goal(ProcInfo, BodyGoal),
-        %
+        proc_info_get_goal(ProcInfo, BodyGoal0),
+        % The pretest code we add for compiler-generated unification
+        % and comparison predicates uses type casts. It uses them in a way
+        % that is guaranteed to terminate, but our analysis is not (yet) able
+        % to find this out for itself. We therefore analyse only the
+        % non-pretest parts of such goals.
+        BodyGoal = maybe_strip_equality_pretest(BodyGoal0),
+
         % We cannot just look up the the termination_info because the
         % termination status of compiler generated wrapper predicates for
         % special preds is always set to terminates.  Instead, we check if the
         % body of the generated wrapper predicate terminates.
-        %
+
         ( not goal_cannot_loop(ModuleInfo, BodyGoal) ->
             get_type_defn_context(TypeDefn, Context),
             emit_non_term_user_special_warning(Context, SpecialPredId,
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.33
diff -u -b -r1.33 prog_type.m
--- compiler/prog_type.m	13 Feb 2007 01:58:51 -0000	1.33
+++ compiler/prog_type.m	9 Apr 2007 05:38:08 -0000
@@ -95,7 +95,8 @@
     %
 :- pred subst_type_is_nonground(mer_type::in, tsubst::in) is semidet.
 
-    % type_has_variable_arity_ctor(Type, TypeCtor, TypeArgs)
+    % type_has_variable_arity_ctor(Type, TypeCtor, TypeArgs):
+    %
     % Check if the principal type constructor of Type is of variable arity.
     % If yes, return the type constructor as TypeCtor and its args as
     % TypeArgs. If not, fail.
@@ -103,11 +104,23 @@
 :- pred type_has_variable_arity_ctor(mer_type::in, type_ctor::out,
     list(mer_type)::out) is semidet.
 
-    % Given a non-variable type, return its type-id and argument types.
+    % Given a non-variable type, return its type_ctor and argument types.
+    % Fail if the type is a variable.
     %
 :- pred type_to_ctor_and_args(mer_type::in, type_ctor::out,
     list(mer_type)::out) is semidet.
 
+    % Given a non-variable type, return its type_ctor and argument types.
+    % Fail if the type is a variable.
+    %
+:- pred type_to_ctor_and_args_det(mer_type::in, type_ctor::out,
+    list(mer_type)::out) is det.
+
+    % Given a non-variable type, return its type_ctor and argument types.
+    % Fail if the type is a variable.
+    %
+:- pred type_to_ctor_det(mer_type::in, type_ctor::out) is det.
+
     % type_ctor_is_higher_order(TypeCtor, PredOrFunc) succeeds iff
     % TypeCtor is a higher-order predicate or function type.
     %
@@ -193,12 +206,12 @@
     %
 :- func builtin_type_ctors_with_no_hlds_type_defn = list(type_ctor).
 
-    % is_builtin_dummy_argument_type(ModuleName, TypeName, TypeArity):
+    % is_builtin_dummy_argument_type(type_ctor):
     %
-    % Is the given type a dummy type irrespective of its definition?
+    % Is the given type constructor a dummy type irrespective
+    % of its definition?
     %
-:- pred is_builtin_dummy_argument_type(string::in, string::in, arity::in)
-    is semidet.
+:- pred is_builtin_dummy_argument_type(type_ctor::in) is semidet.
 
     % Certain types, e.g. io.state and store.store(S), are just dummy types
     % used to ensure logical semantics; there is no need to actually pass them,
@@ -534,6 +547,18 @@
         type_to_ctor_and_args(SubType, TypeCtor, Args)
     ).
 
+type_to_ctor_and_args_det(Type, TypeCtor, Args) :-
+    ( type_to_ctor_and_args(Type, TypeCtorPrime, ArgsPrime) ->
+        TypeCtor = TypeCtorPrime,
+        Args = ArgsPrime
+    ;
+        unexpected(this_file,
+            "type_to_ctor_and_args_det: type_to_ctor_and_args failed")
+    ).
+
+type_to_ctor_det(Type, TypeCtor) :-
+    type_to_ctor_and_args_det(Type, TypeCtor, _Args).
+
 type_ctor_is_higher_order(TypeCtor, Purity, PredOrFunc, EvalMethod) :-
     TypeCtor = type_ctor(SymName, _Arity),
     get_purity_and_eval_method(SymName, Purity, EvalMethod, PorFStr),
@@ -750,8 +775,18 @@
       type_ctor(qualified(mercury_public_builtin_module, "tuple"), 0)
     ].
 
-is_builtin_dummy_argument_type("io", "state", 0).    % io.state/0
-is_builtin_dummy_argument_type("store", "store", 1). % store.store/1.
+is_builtin_dummy_argument_type(TypeCtor) :-
+    TypeCtor = type_ctor(CtorSymName, TypeArity),
+    CtorSymName = qualified(ModuleName, TypeName),
+    (
+        ModuleName = mercury_std_lib_module_name(unqualified("io")),
+        TypeName = "state",
+        TypeArity = 0
+    ;
+        ModuleName = mercury_std_lib_module_name(unqualified("store")),
+        TypeName = "store",
+        TypeArity = 1
+    ).
 
 constructor_list_represents_dummy_argument_type([Ctor], no) :-
     Ctor = ctor([], [], _, [], _).
@@ -1001,9 +1036,7 @@
 is_dummy_argument_type_with_constructors(TypeCtor, Ctors, UserEqCmp) :-
     % Keep this in sync with is_dummy_argument_type below.
     (
-        TypeCtor = type_ctor(CtorSymName, TypeArity),
-        CtorSymName = qualified(unqualified(ModuleName), TypeName),
-        is_builtin_dummy_argument_type(ModuleName, TypeName, TypeArity)
+        is_builtin_dummy_argument_type(TypeCtor)
     ;
         constructor_list_represents_dummy_argument_type(Ctors, UserEqCmp)
     ).
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.73
diff -u -b -r1.73 saved_vars.m
--- compiler/saved_vars.m	6 Jan 2007 09:23:50 -0000	1.73
+++ compiler/saved_vars.m	5 Apr 2007 08:51:23 -0000
@@ -231,6 +231,7 @@
 ok_to_duplicate(feature_will_not_modify_trail) = yes.
 ok_to_duplicate(feature_will_not_call_mm_tabled) = yes.
 ok_to_duplicate(feature_contains_trace) = yes.
+ok_to_duplicate(feature_pretest_equality) = yes.
 
     % Divide a list of goals into an initial subsequence of goals
     % that construct constants, and all other goals.
Index: compiler/term_constr_build.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_constr_build.m,v
retrieving revision 1.15
diff -u -b -r1.15 term_constr_build.m
--- compiler/term_constr_build.m	6 Jan 2007 09:23:54 -0000	1.15
+++ compiler/term_constr_build.m	5 Apr 2007 09:24:48 -0000
@@ -60,6 +60,7 @@
 
 :- import_module check_hlds.mode_util.
 :- import_module check_hlds.type_util. 
+:- import_module hlds.goal_util. 
 :- import_module hlds.hlds_goal. 
 :- import_module hlds.quantification. 
 :- import_module libs.compiler_util.
@@ -195,8 +196,14 @@
     pred_info_context(PredInfo, Context),
     proc_info_get_vartypes(ProcInfo, VarTypes),
     proc_info_get_headvars(ProcInfo, HeadProgVars),
-    proc_info_get_goal(ProcInfo, Goal),
     proc_info_get_argmodes(ProcInfo, ArgModes0),
+    proc_info_get_goal(ProcInfo, Goal0),
+    % The pretest code we add for compiler-generated unification and comparison
+    % predicates uses type casts. It uses them in a way that is guaranteed
+    % to terminate, but our analysis is not (yet) able to find this out for
+    % itself. We therefore analyse only the non-pretest parts of such goals.
+    Goal = maybe_strip_equality_pretest(Goal0),
+
     %
     % Allocate one size_var for each real var. in the procedure.
     % Work out which variables have zero size.
Index: compiler/term_pass1.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_pass1.m,v
retrieving revision 1.33
diff -u -b -r1.33 term_pass1.m
--- compiler/term_pass1.m	6 Jan 2007 09:23:55 -0000	1.33
+++ compiler/term_pass1.m	5 Apr 2007 09:30:55 -0000
@@ -55,6 +55,7 @@
 
 :- implementation.
 
+:- import_module hlds.goal_util.
 :- import_module hlds.hlds_goal.
 :- import_module libs.compiler_util.
 :- import_module libs.lp.
@@ -221,7 +222,12 @@
     proc_info_get_headvars(ProcInfo, Args),
     proc_info_get_argmodes(ProcInfo, ArgModes),
     proc_info_get_vartypes(ProcInfo, VarTypes),
-    proc_info_get_goal(ProcInfo, Goal),
+    proc_info_get_goal(ProcInfo, Goal0),
+    % The pretest code we add for compiler-generated unification and comparison
+    % predicates uses type casts. It uses them in a way that is guaranteed
+    % to terminate, but our analysis is not (yet) able to find this out for
+    % itself. We therefore analyse only the non-pretest parts of such goals.
+    Goal = maybe_strip_equality_pretest(Goal0),
     map.init(EmptyMap),
     PassInfo = pass_info(FunctorInfo, MaxErrors, MaxPaths),
     init_traversal_params(FunctorInfo, PPId, Context, VarTypes,
Index: compiler/term_pass2.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/term_pass2.m,v
retrieving revision 1.28
diff -u -b -r1.28 term_pass2.m
--- compiler/term_pass2.m	1 Dec 2006 15:04:24 -0000	1.28
+++ compiler/term_pass2.m	5 Apr 2007 09:26:09 -0000
@@ -41,6 +41,7 @@
 :- implementation.
 
 :- import_module check_hlds.mode_util.
+:- import_module hlds.goal_util.
 :- import_module libs.compiler_util.
 :- import_module parse_tree.prog_data.
 :- import_module transform_hlds.term_errors.
@@ -377,7 +378,12 @@
         !ModuleInfo, !IO) :-
     module_info_pred_proc_info(!.ModuleInfo, PPId, PredInfo, ProcInfo),
     pred_info_context(PredInfo, Context),
-    proc_info_get_goal(ProcInfo, Goal),
+    proc_info_get_goal(ProcInfo, Goal0),
+    % The pretest code we add for compiler-generated unification and comparison
+    % predicates uses type casts. It uses them in a way that is guaranteed
+    % to terminate, but our analysis is not (yet) able to find this out for
+    % itself. We therefore analyse only the non-pretest parts of such goals.
+    Goal = maybe_strip_equality_pretest(Goal0),
     proc_info_get_vartypes(ProcInfo, VarTypes),
     map.init(EmptyMap),
     PassInfo = pass_info(FunctorInfo, MaxErrors, MaxPaths),
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.175
diff -u -b -r1.175 type_util.m
--- compiler/type_util.m	1 Dec 2006 15:04:26 -0000	1.175
+++ compiler/type_util.m	9 Apr 2007 05:39:01 -0000
@@ -446,9 +446,7 @@
         % Keep this in sync with is_dummy_argument_type_with_constructors
         % above.
         (
-            TypeCtor = type_ctor(CtorSymName, TypeArity),
-            CtorSymName = qualified(unqualified(ModuleName), TypeName),
-            is_builtin_dummy_argument_type(ModuleName, TypeName, TypeArity)
+            is_builtin_dummy_argument_type(TypeCtor)
         ;
             module_info_get_type_table(ModuleInfo, TypeTable),
             % This can fail for some builtin type constructors such as func,
@@ -527,8 +525,7 @@
     ->
         TypeCategory = TypeCategoryPrime
     ;
-        TypeSymName = qualified(unqualified(ModuleName), TypeName),
-        is_builtin_dummy_argument_type(ModuleName, TypeName, Arity)
+        is_builtin_dummy_argument_type(TypeCtor)
     ->
         TypeCategory = type_cat_dummy
     ;
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.184
diff -u -b -r1.184 unify_proc.m
--- compiler/unify_proc.m	19 Jan 2007 07:04:34 -0000	1.184
+++ compiler/unify_proc.m	9 Apr 2007 13:14:06 -0000
@@ -142,6 +142,7 @@
 :- import_module check_hlds.cse_detection.
 :- import_module check_hlds.det_analysis.
 :- import_module check_hlds.inst_match.
+:- import_module check_hlds.mode_util.
 :- import_module check_hlds.modes.
 :- import_module check_hlds.polymorphism.
 :- import_module check_hlds.post_typecheck.
@@ -151,10 +152,10 @@
 :- import_module hlds.goal_util.
 :- import_module hlds.hlds_args.
 :- import_module hlds.hlds_out.
+:- import_module hlds.hlds_rtti.
 :- import_module hlds.instmap.
 :- import_module hlds.make_hlds.
 :- import_module hlds.quantification.
-:- import_module hlds.hlds_rtti.
 :- import_module hlds.special_pred.
 :- import_module libs.
 :- import_module libs.compiler_util.
@@ -171,6 +172,7 @@
 :- import_module queue.
 :- import_module set.
 :- import_module string.
+:- import_module svmap.
 :- import_module term.
 :- import_module varset.
 
@@ -336,37 +338,58 @@
 
 request_proc(PredId, ArgModes, InstVarSet, ArgLives, MaybeDet, Context, ProcId,
         !ModuleInfo) :-
+    some [!PredInfo, !ProcInfo, !PredMap, !ProcMap, !Goal] (
     % Create a new proc_info for this procedure.
-    module_info_preds(!.ModuleInfo, Preds0),
-    map.lookup(Preds0, PredId, PredInfo0),
+        module_info_preds(!.ModuleInfo, !:PredMap),
+        map.lookup(!.PredMap, PredId, !:PredInfo),
     list.length(ArgModes, Arity),
     DeclaredArgModes = no,
     add_new_proc(InstVarSet, Arity, ArgModes, DeclaredArgModes, ArgLives,
-        MaybeDet, Context, address_is_not_taken, PredInfo0, PredInfo1, ProcId),
+            MaybeDet, Context, address_is_not_taken, !PredInfo, ProcId),
+
+        % Copy the clauses for the procedure from the pred_info
+        % to the proc_info, and mark the procedure as one that
+        % cannot be processed yet.
+        pred_info_get_procedures(!.PredInfo, !:ProcMap),
+        pred_info_clauses_info(!.PredInfo, ClausesInfo),
+        map.lookup(!.ProcMap, ProcId, !:ProcInfo),
+        proc_info_set_can_process(no, !ProcInfo),
+
+        copy_clauses_to_proc(ProcId, ClausesInfo, !ProcInfo),
+
+        proc_info_get_goal(!.ProcInfo, !:Goal),
+        set_goal_contexts(Context, !Goal),
+        
+        % The X == Y pretest on unifications makes sense only for in-in
+        % unifications, and if the initial insts are incompatible, then
+        % casts in the pretest prevents mode analysis from discovering this
+        % fact.
+        (
+            all [ArgMode] (
+                list.member(ArgMode, ArgModes)
+            =>
+                mode_is_fully_input(!.ModuleInfo, ArgMode)
+            ),
+            \+ MaybeDet = yes(detism_failure)
+        ->
+            true
+        ;
+            !:Goal = maybe_strip_equality_pretest(!.Goal)
+        ),
+        proc_info_set_goal(!.Goal, !ProcInfo),
 
-    % Copy the clauses for the procedure from the pred_info to the proc_info,
-    % and mark the procedure as one that cannot be processed yet.
-    pred_info_get_procedures(PredInfo1, Procs1),
-    pred_info_clauses_info(PredInfo1, ClausesInfo),
-    map.lookup(Procs1, ProcId, ProcInfo0),
-    proc_info_set_can_process(no, ProcInfo0, ProcInfo1),
-
-    copy_clauses_to_proc(ProcId, ClausesInfo, ProcInfo1, ProcInfo2),
-
-    proc_info_get_goal(ProcInfo2, Goal0),
-    set_goal_contexts(Context, Goal0, Goal),
-    proc_info_set_goal(Goal, ProcInfo2, ProcInfo),
-    map.det_update(Procs1, ProcId, ProcInfo, Procs2),
-    pred_info_set_procedures(Procs2, PredInfo1, PredInfo2),
-    map.det_update(Preds0, PredId, PredInfo2, Preds2),
-    module_info_set_preds(Preds2, !ModuleInfo),
+        svmap.det_update(ProcId, !.ProcInfo, !ProcMap),
+        pred_info_set_procedures(!.ProcMap, !PredInfo),
+        svmap.det_update(PredId, !.PredInfo, !PredMap),
+        module_info_set_preds(!.PredMap, !ModuleInfo),
 
     % Insert the pred_proc_id into the request queue.
     module_info_get_proc_requests(!.ModuleInfo, Requests0),
     get_req_queue(Requests0, ReqQueue0),
     queue.put(ReqQueue0, proc(PredId, ProcId), ReqQueue),
     set_req_queue(ReqQueue, Requests0, Requests),
-    module_info_set_proc_requests(Requests, !ModuleInfo).
+        module_info_set_proc_requests(Requests, !ModuleInfo)
+    ).
 
 %-----------------------------------------------------------------------------%
 
@@ -376,18 +399,16 @@
         !IO) :-
     module_info_get_proc_requests(!.ModuleInfo, Requests0),
     get_req_queue(Requests0, RequestQueue0),
-    (
-        queue.get(RequestQueue0, PredProcId, RequestQueue1)
-    ->
+    ( queue.get(RequestQueue0, PredProcId, RequestQueue1) ->
         set_req_queue(RequestQueue1, Requests0, Requests1),
         module_info_set_proc_requests(Requests1, !ModuleInfo),
-        %
+
         % Check that the procedure is valid (i.e. type-correct), before
         % we attempt to do mode analysis on it. This check is necessary
         % to avoid internal errors caused by doing mode analysis on
         % type-incorrect code.
         % XXX inefficient! This is O(N*M).
-        %
+
         PredProcId = proc(PredId, _ProcId),
         module_info_predids(ValidPredIds, !ModuleInfo),
         ( list.member(PredId, ValidPredIds) ->
@@ -412,11 +433,13 @@
     globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO),
     (
         VeryVerbose = yes,
-        ( HowToCheckGoal = check_unique_modes ->
+        (
+            HowToCheckGoal = check_modes,
+            io.write_string("% Mode-analyzing ", !IO)
+        ;
+            HowToCheckGoal = check_unique_modes,
             io.write_string("% Analyzing modes, determinism, " ++
                 "and unique-modes for\n% ", !IO)
-        ;
-            io.write_string("% Mode-analyzing ", !IO)
         ),
         hlds_out.write_pred_proc_id(ModuleInfo, PredProcId, !IO),
         io.write_string("\n", !IO)
@@ -437,7 +460,7 @@
     bool::out, io::di, io::uo) is det.
 
 modecheck_queued_proc(HowToCheckGoal, PredProcId, !OldPredTable, !ModuleInfo,
-        Changed, !IO) :-
+        !:Changed, !IO) :-
     % Mark the procedure as ready to be processed.
     PredProcId = proc(PredId, ProcId),
     module_info_preds(!.ModuleInfo, Preds0),
@@ -451,11 +474,10 @@
     module_info_set_preds(Preds1, !ModuleInfo),
 
     % Modecheck the procedure.
-    modecheck_proc(ProcId, PredId, !ModuleInfo, NumErrors, Changed1, !IO),
+    modecheck_proc(ProcId, PredId, !ModuleInfo, NumErrors, !:Changed, !IO),
     ( NumErrors \= 0 ->
         io.set_exit_status(1, !IO),
-        module_info_remove_predid(PredId, !ModuleInfo),
-        Changed = Changed1
+        module_info_remove_predid(PredId, !ModuleInfo)
     ;
         (
             HowToCheckGoal = check_unique_modes,
@@ -469,12 +491,11 @@
                 unexpected(this_file, "modecheck_queued_proc: found error")
             ),
             save_proc_info(ProcId, PredId, !.ModuleInfo, !OldPredTable),
-            unique_modes_check_proc(ProcId, PredId, !ModuleInfo, Changed2,
+            unique_modes_check_proc(ProcId, PredId, !ModuleInfo, NewChanged,
                 !IO),
-            bool.or(Changed1, Changed2, Changed)
+            bool.or(NewChanged, !Changed)
         ;
-            HowToCheckGoal = check_modes,
-            Changed = Changed1
+            HowToCheckGoal = check_modes
         )
     ).
 
@@ -638,33 +659,33 @@
             !Info),
         (
             SpecialPredId = spec_pred_unify,
-            ( Args = [H1, H2] ->
-                generate_unify_clauses(Type, TypeBody, H1, H2,
-                    Context, Clauses, !Info)
+            ( Args = [X, Y] ->
+                generate_unify_proc_body(Type, TypeBody, X, Y,
+                    Context, Clause, !Info)
             ;
                 unexpected(this_file, "generate_clause_info: bad unify args")
             )
         ;
             SpecialPredId = spec_pred_index,
             ( Args = [X, Index] ->
-                generate_index_clauses(TypeBody, X, Index,
-                    Context, Clauses, !Info)
+                generate_index_proc_body(TypeBody, X, Index,
+                    Context, Clause, !Info)
             ;
                 unexpected(this_file, "generate_clause_info: bad index args")
             )
         ;
             SpecialPredId = spec_pred_compare,
             ( Args = [Res, X, Y] ->
-                generate_compare_clauses(Type, TypeBody, Res, X, Y,
-                    Context, Clauses, !Info)
+                generate_compare_proc_body(Type, TypeBody, Res, X, Y,
+                    Context, Clause, !Info)
             ;
                 unexpected(this_file, "generate_clause_info: bad compare args")
             )
         ;
             SpecialPredId = spec_pred_init,
             ( Args = [X] ->
-                generate_initialise_clauses(Type, TypeBody, X,
-                    Context, Clauses, !Info)
+                generate_initialise_proc_body(Type, TypeBody, X,
+                    Context, Clause, !Info)
             ;
                 unexpected(this_file, "generate_clause_info: bad init args")
             )
@@ -673,17 +694,17 @@
     ),
     map.init(TVarNameMap),
     ArgVec = proc_arg_vector_init(pf_predicate, Args),
-    set_clause_list(Clauses, ClausesRep),
+    set_clause_list([Clause], ClausesRep),
     rtti_varmaps_init(RttiVarMaps),
     HasForeignClauses = yes,
     ClauseInfo = clauses_info(VarSet, Types, TVarNameMap, Types, ArgVec,
         ClausesRep, RttiVarMaps, HasForeignClauses).
 
-:- pred generate_initialise_clauses(mer_type::in,
-    hlds_type_body::in, prog_var::in, prog_context::in,
-    list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det.
+:- pred generate_initialise_proc_body(mer_type::in, hlds_type_body::in,
+    prog_var::in, prog_context::in, clause::out,
+    unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_initialise_clauses(_Type, TypeBody, X, Context, Clauses, !Info) :-
+generate_initialise_proc_body(_Type, TypeBody, X, Context, Clause, !Info) :-
     info_get_module_info(!.Info, ModuleInfo),
     (
         type_util.type_body_has_solver_type_details(ModuleInfo,
@@ -691,16 +712,16 @@
     ->
         % Just generate a call to the specified predicate, which is
         % the user-defined equality pred for this type.
-        % (The pred_id and proc_id will be figured
-        % out by type checking and mode analysis.)
-        %
+        % (The pred_id and proc_id will be figured out by type checking
+        % and mode analysis.)
+
         InitPred = SolverTypeDetails ^ init_pred,
         PredId = invalid_pred_id,
         ModeId = invalid_proc_id,
         Call = plain_call(PredId, ModeId, [X], not_builtin, no, InitPred),
         goal_info_init(Context, GoalInfo),
         Goal = hlds_goal(Call, GoalInfo),
-        quantify_clauses_body([X], Goal, Context, Clauses, !Info)
+        quantify_clause_body([X], Goal, Context, Clause, !Info)
     ;
         % If this is an equivalence type then we just generate a call
         % to the initialisation pred of the type on the RHS of the equivalence
@@ -710,14 +731,7 @@
         goal_info_init(Context, GoalInfo),
         make_fresh_named_var_from_type(EqvType, "PreCast_HeadVar", 1, X0,
             !Info),
-        (
-            type_to_ctor_and_args(EqvType, TypeCtor0, _TypeArgs)
-        ->
-            TypeCtor = TypeCtor0
-        ;
-            unexpected(this_file,
-                "generate_initialise_clauses: type_to_ctor_and_args failed")
-        ),
+        type_to_ctor_det(EqvType, TypeCtor),
         PredName = special_pred.special_pred_name(spec_pred_init, TypeCtor),
         hlds_module.module_info_get_name(ModuleInfo, ModuleName),
         TypeCtor = type_ctor(TypeSymName, _TypeArity),
@@ -732,40 +746,45 @@
         generate_cast_with_insts(equiv_type_cast, X0, X, Any, Any, Context,
             CastGoal),
         Goal = hlds_goal(conj(plain_conj, [InitGoal, CastGoal]), GoalInfo),
-        quantify_clauses_body([X], Goal, Context, Clauses, !Info)
+        quantify_clause_body([X], Goal, Context, Clause, !Info)
     ;
-        unexpected(this_file, "generate_initialise_clauses: " ++
+        unexpected(this_file, "generate_initialise_proc_body: " ++
             "trying to create initialisation proc for type " ++
             "that has no solver_type_details")
     ).
 
-:- pred generate_unify_clauses(mer_type::in, hlds_type_body::in,
-    prog_var::in, prog_var::in, prog_context::in, list(clause)::out,
+:- pred generate_unify_proc_body(mer_type::in, hlds_type_body::in,
+    prog_var::in, prog_var::in, prog_context::in, clause::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_unify_clauses(Type, TypeBody, H1, H2, Context, Clauses, !Info) :-
+generate_unify_proc_body(Type, TypeBody, X, Y, Context, Clause, !Info) :-
     info_get_module_info(!.Info, ModuleInfo),
     (
+        type_to_ctor_det(Type, TypeCtor),
+        is_builtin_dummy_argument_type(TypeCtor)
+    ->
+        Goal = true_goal_with_context(Context),
+        quantify_clause_body([X, Y], Goal, Context, Clause, !Info)
+    ;
         type_body_has_user_defined_equality_pred(ModuleInfo,
             TypeBody, UserEqComp)
     ->
-        generate_user_defined_unify_clauses(UserEqComp, H1, H2, Context,
-            Clauses, !Info)
+        generate_user_defined_unify_proc_body(UserEqComp, X, Y, Context,
+            Clause, !Info)
     ;
         (
             TypeBody = hlds_du_type(Ctors, _, EnumDummy, _, _, _),
             (
                 EnumDummy = is_enum,
-                make_simple_test(H1, H2, umc_explicit, [], Goal),
-                quantify_clauses_body([H1, H2], Goal, Context, Clauses, !Info)
+                make_simple_test(X, Y, umc_explicit, [], Goal),
+                quantify_clause_body([X, Y], Goal, Context, Clause, !Info)
             ;
                 EnumDummy = is_dummy,
                 Goal = true_goal_with_context(Context),
-                % XXX check me
-                quantify_clauses_body([H1, H2], Goal, Context, Clauses, !Info)
+                quantify_clause_body([X, Y], Goal, Context, Clause, !Info)
             ;
                 EnumDummy = not_enum_or_dummy,
-                generate_du_unify_clauses(Ctors, H1, H2, Context, Clauses,
+                generate_du_unify_proc_body(Ctors, X, Y, Context, Clause,
                     !Info)
             )
         ;
@@ -773,31 +792,31 @@
             ( is_dummy_argument_type(ModuleInfo, EqvType) ->
                 % Treat this type as if it were a dummy type itself.
                 Goal = true_goal_with_context(Context),
-                quantify_clauses_body([H1, H2], Goal, Context, Clauses, !Info)
+                quantify_clause_body([X, Y], Goal, Context, Clause, !Info)
             ;
-                generate_unify_clauses_eqv_type(EqvType, H1, H2,
-                    Context, Clauses, !Info)
+                generate_eqv_unify_proc_body(EqvType, X, Y, Context,
+                    Clause, !Info)
             )
         ;
             TypeBody = hlds_solver_type(_, _),
             % If no user defined equality predicate is given,
             % we treat solver types as if they were an equivalent
             % to the builtin type c_pointer.
-            generate_unify_clauses_eqv_type(c_pointer_type,
-                H1, H2, Context, Clauses, !Info)
+            generate_eqv_unify_proc_body(c_pointer_type, X, Y, Context,
+                Clause, !Info)
         ;
             TypeBody = hlds_foreign_type(_),
             % If no user defined equality predicate is given,
             % we treat foreign_type as if they were an equivalent
             % to the builtin type c_pointer.
-            generate_unify_clauses_eqv_type(c_pointer_type,
-                H1, H2, Context, Clauses, !Info)
+            generate_eqv_unify_proc_body(c_pointer_type, X, Y, Context,
+                Clause, !Info)
         ;
             TypeBody = hlds_abstract_type(_),
             ( compiler_generated_rtti_for_builtins(ModuleInfo) ->
                 TypeCategory = classify_type(ModuleInfo, Type),
-                generate_builtin_unify(TypeCategory,
-                    H1, H2, Context, Clauses, !Info)
+                generate_builtin_unify(TypeCategory, X, Y, Context, Clause,
+                    !Info)
             ;
                 unexpected(this_file,
                     "trying to create unify proc for abstract type")
@@ -806,11 +825,11 @@
     ).
 
 :- pred generate_builtin_unify((type_category)::in, prog_var::in, prog_var::in,
-    prog_context::in, list(clause)::out,
+    prog_context::in, clause::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_builtin_unify(TypeCategory, H1, H2, Context, Clauses, !Info) :-
-    ArgVars = [H1, H2],
+generate_builtin_unify(TypeCategory, X, Y, Context, Clause, !Info) :-
+    ArgVars = [X, Y],
 
     % can_generate_special_pred_clauses_for_type ensures the unexpected
     % cases can never occur.
@@ -862,17 +881,17 @@
         unexpected(this_file, "generate_builtin_unify: user_ctor type")
     ),
     build_call(Name, ArgVars, Context, UnifyGoal, !Info),
-    quantify_clauses_body(ArgVars, UnifyGoal, Context, Clauses, !Info).
+    quantify_clause_body(ArgVars, UnifyGoal, Context, Clause, !Info).
 
-:- pred generate_user_defined_unify_clauses(unify_compare::in,
-    prog_var::in, prog_var::in, prog_context::in, list(clause)::out,
+:- pred generate_user_defined_unify_proc_body(unify_compare::in,
+    prog_var::in, prog_var::in, prog_context::in, clause::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_user_defined_unify_clauses(abstract_noncanonical_type(_IsSolverType),
-        _, _, _, _, !Info) :-
+generate_user_defined_unify_proc_body(UserEqCompare, _, _, _, _, !Info) :-
+    UserEqCompare = abstract_noncanonical_type(_IsSolverType),
     unexpected(this_file,
         "trying to create unify proc for abstract noncanonical type").
-generate_user_defined_unify_clauses(UserEqCompare, H1, H2, Context, Clauses,
+generate_user_defined_unify_proc_body(UserEqCompare, X, Y, Context, Clause,
         !Info) :-
     UserEqCompare = unify_compare(MaybeUnify, MaybeCompare),
     ( MaybeUnify = yes(UnifyPredName) ->
@@ -882,10 +901,10 @@
 
         PredId = invalid_pred_id,
         ModeId = invalid_proc_id,
-        Call = plain_call(PredId, ModeId, [H1, H2], not_builtin, no,
+        Call = plain_call(PredId, ModeId, [X, Y], not_builtin, no,
             UnifyPredName),
         goal_info_init(Context, GoalInfo),
-        Goal = hlds_goal(Call, GoalInfo)
+        Goal0 = hlds_goal(Call, GoalInfo)
     ; MaybeCompare = yes(ComparePredName) ->
         % Just generate a call to the specified predicate, which is the
         % user-defined comparison pred for this type, and unify the result
@@ -895,24 +914,25 @@
         info_new_var(comparison_result_type, ResultVar, !Info),
         PredId = invalid_pred_id,
         ModeId = invalid_proc_id,
-        Call = plain_call(PredId, ModeId, [ResultVar, H1, H2], not_builtin, no,
+        Call = plain_call(PredId, ModeId, [ResultVar, X, Y], not_builtin, no,
             ComparePredName),
         goal_info_init(Context, GoalInfo),
         CallGoal = hlds_goal(Call, GoalInfo),
 
         create_pure_atomic_complicated_unification(ResultVar, equal_functor,
             Context, umc_explicit, [], UnifyGoal),
-        Goal = hlds_goal(conj(plain_conj, [CallGoal, UnifyGoal]), GoalInfo)
+        Goal0 = hlds_goal(conj(plain_conj, [CallGoal, UnifyGoal]), GoalInfo)
     ;
-        unexpected(this_file, "generate_user_defined_unify_clauses")
+        unexpected(this_file, "generate_user_defined_unify_proc_body")
     ),
-    quantify_clauses_body([H1, H2], Goal, Context, Clauses, !Info).
+    maybe_wrap_with_pretest_equality(Context, X, Y, no, Goal0, Goal, !Info),
+    quantify_clause_body([X, Y], Goal, Context, Clause, !Info).
 
-:- pred generate_unify_clauses_eqv_type(mer_type::in, prog_var::in,
-    prog_var::in, prog_context::in, list(clause)::out,
+:- pred generate_eqv_unify_proc_body(mer_type::in, prog_var::in,
+    prog_var::in, prog_context::in, clause::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_unify_clauses_eqv_type(EqvType, H1, H2, Context, Clauses, !Info) :-
+generate_eqv_unify_proc_body(EqvType, X, Y, Context, Clause, !Info) :-
     % We should check whether EqvType is a type variable,
     % an abstract type or a concrete type.
     % If it is type variable, then we should generate the same code
@@ -920,19 +940,19 @@
     % its unification procedure directly; if it is a concrete type,
     % we should generate the body of its unification procedure
     % inline here.
-    make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 1, CastVar1,
+    make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 1, CastX,
         !Info),
-    make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 2, CastVar2,
+    make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 2, CastY,
         !Info),
-    generate_cast(equiv_type_cast, H1, CastVar1, Context, Cast1Goal),
-    generate_cast(equiv_type_cast, H2, CastVar2, Context, Cast2Goal),
-    create_pure_atomic_complicated_unification(CastVar1, rhs_var(CastVar2),
+    generate_cast(equiv_type_cast, X, CastX, Context, CastXGoal),
+    generate_cast(equiv_type_cast, Y, CastY, Context, CastYGoal),
+    create_pure_atomic_complicated_unification(CastX, rhs_var(CastY),
         Context, umc_explicit, [], UnifyGoal),
 
     goal_info_init(GoalInfo0),
     goal_info_set_context(Context, GoalInfo0, GoalInfo),
-    conj_list_to_goal([Cast1Goal, Cast2Goal, UnifyGoal], GoalInfo, Goal),
-    quantify_clauses_body([H1, H2], Goal, Context, Clauses, !Info).
+    conj_list_to_goal([CastXGoal, CastYGoal, UnifyGoal], GoalInfo, Goal),
+    quantify_clause_body([X, Y], Goal, Context, Clause, !Info).
 
     % This predicate generates the bodies of index predicates for the
     % types that need index predicates.
@@ -941,11 +961,11 @@
     % of special preds to define only for the kinds of types which do not
     % lead this predicate to abort.
     %
-:- pred generate_index_clauses(hlds_type_body::in,
-    prog_var::in, prog_var::in, prog_context::in, list(clause)::out,
+:- pred generate_index_proc_body(hlds_type_body::in,
+    prog_var::in, prog_var::in, prog_context::in, clause::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_index_clauses(TypeBody, X, Index, Context, Clauses, !Info) :-
+generate_index_proc_body(TypeBody, X, Index, Context, Clause, !Info) :-
     info_get_module_info(!.Info, ModuleInfo),
     ( type_body_has_user_defined_equality_pred(ModuleInfo, TypeBody, _) ->
         % For non-canonical types, the generated comparison predicate either
@@ -971,8 +991,8 @@
                     "trying to create index proc for dummy type")
             ;
                 EnumDummy = not_enum_or_dummy,
-                generate_du_index_clauses(Ctors, X, Index, Context, 0, Clauses,
-                    !Info)
+                generate_du_index_proc_body(Ctors, X, Index, Context,
+                    Clause, !Info)
             )
         ;
             TypeBody = hlds_eqv_type(_Type),
@@ -998,59 +1018,64 @@
         )
     ).
 
-:- pred generate_compare_clauses(mer_type::in, hlds_type_body::in,
+:- pred generate_compare_proc_body(mer_type::in, hlds_type_body::in,
     prog_var::in, prog_var::in, prog_var::in, prog_context::in,
-    list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det.
+    clause::out, unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_compare_clauses(Type, TypeBody, Res, H1, H2, Context, Clauses,
+generate_compare_proc_body(Type, TypeBody, Res, X, Y, Context, Clause,
         !Info) :-
     info_get_module_info(!.Info, ModuleInfo),
     (
-        type_body_has_user_defined_equality_pred(ModuleInfo,
-            TypeBody, UserEqComp)
+        type_to_ctor_det(Type, TypeCtor),
+        is_builtin_dummy_argument_type(TypeCtor)
+    ->
+        generate_dummy_compare_proc_body(Res, X, Y, Context, Clause, !Info)
+    ;
+        type_body_has_user_defined_equality_pred(ModuleInfo, TypeBody,
+            UserEqComp)
     ->
-        generate_user_defined_compare_clauses(UserEqComp,
-            Res, H1, H2, Context, Clauses, !Info)
+        generate_user_defined_compare_proc_body(UserEqComp,
+            Res, X, Y, Context, Clause, !Info)
     ;
         (
             TypeBody = hlds_du_type(Ctors, _, EnumDummy, _, _, _),
             (
                 EnumDummy = is_enum,
-                generate_enum_compare_clauses(Res, H1, H2, Context, Clauses,
+                generate_enum_compare_proc_body(Res, X, Y, Context, Clause,
                     !Info)
             ;
                 EnumDummy = is_dummy,
-                generate_dummy_compare_clauses(Res, H1, H2, Context, Clauses,
+                generate_dummy_compare_proc_body(Res, X, Y, Context, Clause,
                     !Info)
             ;
                 EnumDummy = not_enum_or_dummy,
-                generate_du_compare_clauses(Type, Ctors, Res, H1, H2,
-                    Context, Clauses, !Info)
+                generate_du_compare_proc_body(Type, Ctors, Res, X, Y,
+                    Context, Clause, !Info)
             )
         ;
             TypeBody = hlds_eqv_type(EqvType),
             ( is_dummy_argument_type(ModuleInfo, EqvType) ->
                 % Treat this type as if it were a dummy type itself.
-                generate_dummy_compare_clauses(Res, H1, H2, Context, Clauses,
+                generate_dummy_compare_proc_body(Res, X, Y, Context, Clause,
                     !Info)
             ;
-                generate_compare_clauses_eqv_type(EqvType,
-                    Res, H1, H2, Context, Clauses, !Info)
+                generate_eqv_compare_proc_body(EqvType, Res, X, Y,
+                    Context, Clause, !Info)
             )
         ;
             TypeBody = hlds_foreign_type(_),
-            generate_compare_clauses_eqv_type(c_pointer_type,
-                Res, H1, H2, Context, Clauses, !Info)
+            generate_eqv_compare_proc_body(c_pointer_type, Res, X, Y,
+                Context, Clause, !Info)
         ;
             TypeBody = hlds_solver_type(_, _),
-            generate_compare_clauses_eqv_type(c_pointer_type,
-                Res, H1, H2, Context, Clauses, !Info)
+            generate_eqv_compare_proc_body(c_pointer_type, Res, X, Y,
+                Context, Clause, !Info)
         ;
             TypeBody = hlds_abstract_type(_),
             ( compiler_generated_rtti_for_builtins(ModuleInfo) ->
                 TypeCategory = classify_type(ModuleInfo, Type),
-                generate_builtin_compare(TypeCategory, Res,
-                    H1, H2, Context, Clauses, !Info)
+                generate_builtin_compare(TypeCategory, Res, X, Y,
+                    Context, Clause, !Info)
             ;
                 unexpected(this_file,
                     "trying to create compare proc for abstract type")
@@ -1058,42 +1083,39 @@
         )
     ).
 
-:- pred generate_enum_compare_clauses(prog_var::in, prog_var::in, prog_var::in,
-    prog_context::in, list(clause)::out,
+:- pred generate_enum_compare_proc_body(prog_var::in,
+    prog_var::in, prog_var::in, prog_context::in, clause::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_enum_compare_clauses(Res, H1, H2, Context, Clauses, !Info) :-
+generate_enum_compare_proc_body(Res, X, Y, Context, Clause, !Info) :-
     IntType = int_type,
-    make_fresh_named_var_from_type(IntType, "Cast_HeadVar", 1, CastVar1,
-        !Info),
-    make_fresh_named_var_from_type(IntType, "Cast_HeadVar", 2, CastVar2,
-        !Info),
-    generate_cast(unsafe_type_cast, H1, CastVar1, Context, Cast1Goal),
-    generate_cast(unsafe_type_cast, H2, CastVar2, Context, Cast2Goal),
-    build_call("builtin_compare_int", [Res, CastVar1, CastVar2], Context,
+    make_fresh_named_var_from_type(IntType, "Cast_HeadVar", 1, CastX, !Info),
+    make_fresh_named_var_from_type(IntType, "Cast_HeadVar", 2, CastY, !Info),
+    generate_cast(unsafe_type_cast, X, CastX, Context, CastXGoal),
+    generate_cast(unsafe_type_cast, Y, CastY, Context, CastYGoal),
+    build_call("builtin_compare_int", [Res, CastX, CastY], Context,
         CompareGoal, !Info),
 
     goal_info_init(GoalInfo0),
     goal_info_set_context(Context, GoalInfo0, GoalInfo),
-    conj_list_to_goal([Cast1Goal, Cast2Goal, CompareGoal], GoalInfo, Goal),
-    quantify_clauses_body([Res, H1, H2], Goal, Context, Clauses, !Info).
+    conj_list_to_goal([CastXGoal, CastYGoal, CompareGoal], GoalInfo, Goal),
+    quantify_clause_body([Res, X, Y], Goal, Context, Clause, !Info).
 
-:- pred generate_dummy_compare_clauses(prog_var::in, prog_var::in,
-    prog_var::in, prog_context::in, list(clause)::out,
+:- pred generate_dummy_compare_proc_body(prog_var::in, prog_var::in,
+    prog_var::in, prog_context::in, clause::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_dummy_compare_clauses(Res, H1, H2, Context, Clauses, !Info) :-
+generate_dummy_compare_proc_body(Res, X, Y, Context, Clause, !Info) :-
     generate_return_equal(Res, Context, Goal),
     % XXX check me
-    quantify_clauses_body([Res, H1, H2], Goal, Context, Clauses, !Info).
+    quantify_clause_body([Res, X, Y], Goal, Context, Clause, !Info).
 
 :- pred generate_builtin_compare(type_category::in,
-    prog_var::in, prog_var::in, prog_var::in,
-    prog_context::in, list(clause)::out,
+    prog_var::in, prog_var::in, prog_var::in, prog_context::in, clause::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_builtin_compare(TypeCategory, Res, H1, H2, Context, Clauses, !Info) :-
-    ArgVars = [Res, H1, H2],
+generate_builtin_compare(TypeCategory, Res, X, Y, Context, Clause, !Info) :-
+    ArgVars = [Res, X, Y],
 
     % can_generate_special_pred_clauses_for_type ensures the unexpected
     % cases can never occur.
@@ -1145,89 +1167,65 @@
         unexpected(this_file, "generate_builtin_compare: user_ctor type")
     ),
     build_call(Name, ArgVars, Context, CompareGoal, !Info),
-    quantify_clauses_body(ArgVars, CompareGoal, Context, Clauses, !Info).
+    quantify_clause_body(ArgVars, CompareGoal, Context, Clause, !Info).
 
-:- pred generate_user_defined_compare_clauses(unify_compare::in,
-    prog_var::in, prog_var::in, prog_var::in,
-    prog_context::in, list(clause)::out,
+:- pred generate_user_defined_compare_proc_body(unify_compare::in,
+    prog_var::in, prog_var::in, prog_var::in, prog_context::in, clause::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_user_defined_compare_clauses(abstract_noncanonical_type(_),
+generate_user_defined_compare_proc_body(abstract_noncanonical_type(_),
         _, _, _, _, _, !Info) :-
     unexpected(this_file,
         "trying to create compare proc for abstract noncanonical type").
-generate_user_defined_compare_clauses(unify_compare(_, MaybeCompare),
-        Res, H1, H2, Context, Clauses, !Info) :-
-    ArgVars = [Res, H1, H2],
+generate_user_defined_compare_proc_body(unify_compare(_, MaybeCompare),
+        Res, X, Y, Context, Clause, !Info) :-
+    ArgVars = [Res, X, Y],
     (
         MaybeCompare = yes(ComparePredName),
-        %
+
         % Just generate a call to the specified predicate, which is the
         % user-defined comparison pred for this type. (The pred_id and proc_id
         % will be figured out by type checking and mode analysis.)
-        %
+
         PredId = invalid_pred_id,
         ModeId = invalid_proc_id,
         Call = plain_call(PredId, ModeId, ArgVars, not_builtin, no,
             ComparePredName),
         goal_info_init(Context, GoalInfo),
-        Goal = hlds_goal(Call, GoalInfo)
+        Goal0 = hlds_goal(Call, GoalInfo),
+        maybe_wrap_with_pretest_equality(Context, X, Y, yes(Res), Goal0, Goal,
+            !Info)
     ;
         MaybeCompare = no,
         % Just generate code that will call error/1.
         build_call("builtin_compare_non_canonical_type", ArgVars, Context,
             Goal, !Info)
     ),
-    quantify_clauses_body(ArgVars, Goal, Context, Clauses, !Info).
+    quantify_clause_body(ArgVars, Goal, Context, Clause, !Info).
 
-:- pred generate_compare_clauses_eqv_type(mer_type::in,
-    prog_var::in, prog_var::in, prog_var::in,
-    prog_context::in, list(clause)::out,
+:- pred generate_eqv_compare_proc_body(mer_type::in,
+    prog_var::in, prog_var::in, prog_var::in, prog_context::in, clause::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_compare_clauses_eqv_type(EqvType, Res, H1, H2, Context, Clauses,
-        !Info) :-
+generate_eqv_compare_proc_body(EqvType, Res, X, Y, Context, Clause, !Info) :-
     % We should check whether EqvType is a type variable, an abstract type
     % or a concrete type. If it is type variable, then we should generate
     % the same code we generate now. If it is an abstract type, we should call
     % its comparison procedure directly; if it is a concrete type, we should
     % generate the body of its comparison procedure inline here.
-    make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 1, CastVar1,
+    make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 1, CastX,
         !Info),
-    make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 2, CastVar2,
+    make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 2, CastY,
         !Info),
-    generate_cast(equiv_type_cast, H1, CastVar1, Context, Cast1Goal),
-    generate_cast(equiv_type_cast, H2, CastVar2, Context, Cast2Goal),
-    build_call("compare", [Res, CastVar1, CastVar2], Context, CompareGoal,
+    generate_cast(equiv_type_cast, X, CastX, Context, CastXGoal),
+    generate_cast(equiv_type_cast, Y, CastY, Context, CastYGoal),
+    build_call("compare", [Res, CastX, CastY], Context, CompareGoal,
         !Info),
 
     goal_info_init(GoalInfo0),
     goal_info_set_context(Context, GoalInfo0, GoalInfo),
-    conj_list_to_goal([Cast1Goal, Cast2Goal, CompareGoal], GoalInfo, Goal),
-    quantify_clauses_body([Res, H1, H2], Goal, Context, Clauses, !Info).
-
-:- pred quantify_clauses_body(list(prog_var)::in, hlds_goal::in,
-    prog_context::in, list(clause)::out,
-    unify_proc_info::in, unify_proc_info::out) is det.
-
-quantify_clauses_body(HeadVars, Goal, Context, Clauses, !Info) :-
-    quantify_clause_body(HeadVars, Goal, Context, Clause, !Info),
-    Clauses = [Clause].
-
-:- pred quantify_clause_body(list(prog_var)::in, hlds_goal::in,
-    prog_context::in, clause::out,
-    unify_proc_info::in, unify_proc_info::out) is det.
-
-quantify_clause_body(HeadVars, Goal0, Context, Clause, !Info) :-
-    info_get_varset(!.Info, Varset0),
-    info_get_types(!.Info, Types0),
-    info_get_rtti_varmaps(!.Info, RttiVarMaps0),
-    implicitly_quantify_clause_body(HeadVars, _Warnings, Goal0, Goal,
-        Varset0, Varset, Types0, Types, RttiVarMaps0, RttiVarMaps),
-    info_set_varset(Varset, !Info),
-    info_set_types(Types, !Info),
-    info_set_rtti_varmaps(RttiVarMaps, !Info),
-    Clause = clause([], Goal, impl_lang_mercury, Context).
+    conj_list_to_goal([CastXGoal, CastYGoal, CompareGoal], GoalInfo, Goal),
+    quantify_clause_body([Res, X, Y], Goal, Context, Clause, !Info).
 
 %-----------------------------------------------------------------------------%
 
@@ -1278,19 +1276,31 @@
     % should therefore be inferred to be det.
     % (tests/general/det_complicated_unify2.m tests this case.)
     %
-:- pred generate_du_unify_clauses(list(constructor)::in,
+:- pred generate_du_unify_proc_body(list(constructor)::in,
     prog_var::in, prog_var::in, prog_context::in,
-    list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det.
+    clause::out, unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_du_unify_clauses([], _X, _Y, _Context, [], !Info).
-generate_du_unify_clauses([Ctor | Ctors], X, Y, Context, [Clause | Clauses],
-        !Info) :-
+generate_du_unify_proc_body(Ctors, X, Y, Context, Clause, !Info) :-
+    CanCompareAsInt = can_compare_constants_as_ints(!.Info),
+    list.map_foldl(generate_du_unify_case(X, Y, Context, CanCompareAsInt),
+        Ctors, Disjuncts, !Info),
+    goal_info_init(GoalInfo0),
+    goal_info_set_context(Context, GoalInfo0, GoalInfo),
+    Goal0 = hlds_goal(disj(Disjuncts), GoalInfo),
+    maybe_wrap_with_pretest_equality(Context, X, Y, no, Goal0, Goal, !Info),
+    quantify_clause_body([X, Y], Goal, Context, Clause, !Info).
+
+:- pred generate_du_unify_case(prog_var::in, prog_var::in, prog_context::in,
+    bool::in, constructor::in, hlds_goal::out,
+    unify_proc_info::in, unify_proc_info::out) is det.
+
+generate_du_unify_case(X, Y, Context, CanCompareAsInt, Ctor, Goal, !Info) :-
     Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes, _Ctxt),
     list.length(ArgTypes, FunctorArity),
     FunctorConsId = cons(FunctorName, FunctorArity),
     (
         ArgTypes = [],
-        can_compare_constants_as_ints(!.Info) = yes
+        CanCompareAsInt = yes
     ->
         create_pure_atomic_complicated_unification(X,
             rhs_functor(FunctorConsId, no, []), Context,
@@ -1319,9 +1329,7 @@
     ),
     goal_info_init(GoalInfo0),
     goal_info_set_context(Context, GoalInfo0, GoalInfo),
-    conj_list_to_goal(GoalList, GoalInfo, Goal),
-    quantify_clause_body([X, Y], Goal, Context, Clause, !Info),
-    generate_du_unify_clauses(Ctors, X, Y, Context, Clauses, !Info).
+    conj_list_to_goal(GoalList, GoalInfo, Goal).
 
     % Succeed iff the target back end guarantees that comparing two constants
     % for equality can be done by casting them both to integers and comparing
@@ -1354,14 +1362,23 @@
     %           X = h(_),
     %           Index = 2
     %       ).
+:- pred generate_du_index_proc_body(list(constructor)::in,
+    prog_var::in, prog_var::in, prog_context::in, clause::out,
+    unify_proc_info::in, unify_proc_info::out) is det.
 
-:- pred generate_du_index_clauses(list(constructor)::in,
-    prog_var::in, prog_var::in, prog_context::in, int::in,
-    list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det.
-
-generate_du_index_clauses([], _X, _Index, _Context, _N, [], !Info).
-generate_du_index_clauses([Ctor | Ctors], X, Index, Context, N,
-        [Clause | Clauses], !Info) :-
+generate_du_index_proc_body(Ctors, X, Index, Context, Clause, !Info) :-
+    list.map_foldl2(generate_du_index_case(X, Index, Context),
+        Ctors, Disjuncts, 0, _, !Info),
+    goal_info_init(GoalInfo0),
+    goal_info_set_context(Context, GoalInfo0, GoalInfo),
+    Goal = hlds_goal(disj(Disjuncts), GoalInfo),
+    quantify_clause_body([X, Index], Goal, Context, Clause, !Info).
+
+:- pred generate_du_index_case(prog_var::in, prog_var::in, prog_context::in,
+    constructor::in, hlds_goal::out, int::in, int::out,
+    unify_proc_info::in, unify_proc_info::out) is det.
+
+generate_du_index_case(X, Index, Context, Ctor, Goal, !N, !Info) :-
     Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes, _Ctxt),
     list.length(ArgTypes, FunctorArity),
     FunctorConsId = cons(FunctorName, FunctorArity),
@@ -1369,21 +1386,20 @@
     create_pure_atomic_complicated_unification(X,
         rhs_functor(FunctorConsId, no, ArgVars),
         Context, umc_explicit, [], UnifyX_Goal),
-    make_int_const_construction(Index, N, UnifyIndex_Goal),
+    make_int_const_construction(Index, !.N, UnifyIndex_Goal),
+    !:N = !.N + 1,
     GoalList = [UnifyX_Goal, UnifyIndex_Goal],
     goal_info_init(GoalInfo0),
     goal_info_set_context(Context, GoalInfo0, GoalInfo),
-    conj_list_to_goal(GoalList, GoalInfo, Goal),
-    quantify_clause_body([X, Index], Goal, Context, Clause, !Info),
-    generate_du_index_clauses(Ctors, X, Index, Context, N + 1, Clauses, !Info).
+    conj_list_to_goal(GoalList, GoalInfo, Goal).
 
 %-----------------------------------------------------------------------------%
 
-:- pred generate_du_compare_clauses(mer_type::in, list(constructor)::in,
+:- pred generate_du_compare_proc_body(mer_type::in, list(constructor)::in,
     prog_var::in, prog_var::in, prog_var::in, prog_context::in,
-    list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det.
+    clause::out, unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_du_compare_clauses(Type, Ctors, Res, H1, H2, Context, Clauses,
+generate_du_compare_proc_body(Type, Ctors, Res, X, Y, Context, Clause,
         !Info) :-
     (
         Ctors = [],
@@ -1396,12 +1412,16 @@
             CompareSpec),
         list.length(Ctors, NumCtors),
         ( NumCtors =< CompareSpec ->
-            generate_du_quad_compare_clauses(
-                Ctors, Res, H1, H2, Context, Clauses, !Info)
+            generate_du_quad_compare_proc_body(Ctors, Res, X, Y,
+                Context, Goal0, !Info)
         ;
-            generate_du_linear_compare_clauses(Type,
-                Ctors, Res, H1, H2, Context, Clauses, !Info)
-        )
+            generate_du_linear_compare_proc_body(Type, Ctors, Res, X, Y,
+                Context, Goal0, !Info)
+        ),
+        maybe_wrap_with_pretest_equality(Context, X, Y, yes(Res), Goal0, Goal,
+            !Info),
+        HeadVars = [Res, X, Y],
+        quantify_clause_body(HeadVars, Goal, Context, Clause, !Info)
     ).
 
 %-----------------------------------------------------------------------------%
@@ -1462,43 +1482,41 @@
     % switch_detection and det_analysis to recognize the determinism of the
     % predicate.
     %
-:- pred generate_du_quad_compare_clauses(list(constructor)::in,
+:- pred generate_du_quad_compare_proc_body(list(constructor)::in,
     prog_var::in, prog_var::in, prog_var::in, prog_context::in,
-    list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det.
+    hlds_goal::out, unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_du_quad_compare_clauses(Ctors, R, X, Y, Context, Clauses, !Info) :-
-    generate_du_quad_compare_clauses_1(Ctors, Ctors, R, X, Y,
+generate_du_quad_compare_proc_body(Ctors, R, X, Y, Context, Goal, !Info) :-
+    generate_du_quad_compare_switch_on_x(Ctors, Ctors, R, X, Y,
         Context, [], Cases, !Info),
     goal_info_init(GoalInfo0),
     goal_info_set_context(Context, GoalInfo0, GoalInfo),
-    disj_list_to_goal(Cases, GoalInfo, Goal),
-    HeadVars = [R, X, Y],
-    quantify_clauses_body(HeadVars, Goal, Context, Clauses, !Info).
+    disj_list_to_goal(Cases, GoalInfo, Goal).
 
-:- pred generate_du_quad_compare_clauses_1(
+:- pred generate_du_quad_compare_switch_on_x(
     list(constructor)::in, list(constructor)::in,
     prog_var::in, prog_var::in, prog_var::in,
     prog_context::in, list(hlds_goal)::in, list(hlds_goal)::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_du_quad_compare_clauses_1([], _RightCtors, _R, _X, _Y, _Context,
+generate_du_quad_compare_switch_on_x([], _RightCtors, _R, _X, _Y, _Context,
         !Cases, !Info).
-generate_du_quad_compare_clauses_1([LeftCtor | LeftCtors], RightCtors, R, X, Y,
-        Context, !Cases, !Info) :-
-    generate_du_quad_compare_clauses_2(LeftCtor, RightCtors, ">", R, X, Y,
+generate_du_quad_compare_switch_on_x([LeftCtor | LeftCtors], RightCtors,
+        R, X, Y, Context, !Cases, !Info) :-
+    generate_du_quad_compare_switch_on_y(LeftCtor, RightCtors, ">", R, X, Y,
         Context, !Cases, !Info),
-    generate_du_quad_compare_clauses_1(LeftCtors, RightCtors, R, X, Y,
+    generate_du_quad_compare_switch_on_x(LeftCtors, RightCtors, R, X, Y,
         Context, !Cases, !Info).
 
-:- pred generate_du_quad_compare_clauses_2(
+:- pred generate_du_quad_compare_switch_on_y(
     constructor::in, list(constructor)::in, string::in,
     prog_var::in, prog_var::in, prog_var::in, prog_context::in,
     list(hlds_goal)::in, list(hlds_goal)::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_du_quad_compare_clauses_2(_LeftCtor, [],
+generate_du_quad_compare_switch_on_y(_LeftCtor, [],
         _Cmp, _R, _X, _Y, _Context, !Cases, !Info).
-generate_du_quad_compare_clauses_2(LeftCtor, [RightCtor | RightCtors],
+generate_du_quad_compare_switch_on_y(LeftCtor, [RightCtor | RightCtors],
         Cmp0, R, X, Y, Context, !Cases, !Info) :-
     ( LeftCtor = RightCtor ->
         generate_compare_case(LeftCtor, R, X, Y, Context, quad, Case, !Info),
@@ -1508,7 +1526,7 @@
             Context, Case, !Info),
         Cmp1 = Cmp0
     ),
-    generate_du_quad_compare_clauses_2(LeftCtor, RightCtors, Cmp1, R, X, Y,
+    generate_du_quad_compare_switch_on_y(LeftCtor, RightCtors, Cmp1, R, X, Y,
         Context, [Case | !.Cases], !:Cases, !Info).
 
 %-----------------------------------------------------------------------------%
@@ -1554,23 +1572,12 @@
     % Note that disjuncts covering constants do not test Y, since for constants
     % X_Index = Y_Index implies X = Y.
     %
-:- pred generate_du_linear_compare_clauses(mer_type::in, list(constructor)::in,
-    prog_var::in, prog_var::in, prog_var::in, prog_context::in,
-    list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det.
-
-generate_du_linear_compare_clauses(Type, Ctors, Res, X, Y, Context, [Clause],
-        !Info) :-
-    generate_du_linear_compare_clauses_2(Type, Ctors, Res, X, Y,
-        Context, Goal, !Info),
-    HeadVars = [Res, X, Y],
-    quantify_clause_body(HeadVars, Goal, Context, Clause, !Info).
-
-:- pred generate_du_linear_compare_clauses_2(mer_type::in,
+:- pred generate_du_linear_compare_proc_body(mer_type::in,
     list(constructor)::in, prog_var::in, prog_var::in, prog_var::in,
     prog_context::in, hlds_goal::out,
     unify_proc_info::in, unify_proc_info::out) is det.
 
-generate_du_linear_compare_clauses_2(Type, Ctors, Res, X, Y, Context, Goal,
+generate_du_linear_compare_proc_body(Type, Ctors, Res, X, Y, Context, Goal,
         !Info) :-
     IntType = int_type,
     info_new_var(IntType, X_Index, !Info),
@@ -1666,7 +1673,9 @@
     generate_compare_case(Ctor, R, X, Y, Context, linear, Case, !Info),
     generate_compare_cases(Ctors, R, X, Y, Context, Cases, !Info).
 
-:- type linear_or_quad  --->    linear ; quad.
+:- type linear_or_quad
+    --->    linear
+    ;       quad.
 
 :- pred generate_compare_case(constructor::in, prog_var::in, prog_var::in,
     prog_var::in, prog_context::in, linear_or_quad::in,
@@ -1848,10 +1857,10 @@
 build_call(Name, ArgVars, Context, Goal, !Info) :-
     info_get_module_info(!.Info, ModuleInfo),
     list.length(ArgVars, Arity),
-    %
+
     % We assume that the special preds compare/3, index/2, and unify/2
     % are the only public builtins called by code generated by this module.
-    %
+
     ( special_pred_name_arity(_, Name, _, Arity) ->
         MercuryBuiltin = mercury_public_builtin_module
     ;
@@ -1983,6 +1992,81 @@
 
 %-----------------------------------------------------------------------------%
 
+:- pred maybe_wrap_with_pretest_equality(prog_context::in,
+    prog_var::in, prog_var::in, maybe(prog_var)::in,
+    hlds_goal::in, hlds_goal::out,
+    unify_proc_info::in, unify_proc_info::out) is det.
+
+maybe_wrap_with_pretest_equality(Context, X, Y, MaybeCompareRes, Goal0, Goal,
+        !Info) :-
+    ShouldPretestEq = should_pretest_equality(!.Info),
+    (
+        ShouldPretestEq = no,
+        Goal = Goal0
+    ;
+        ShouldPretestEq = yes,
+        info_new_named_var(int_type, "CastX", CastX, !Info),
+        info_new_named_var(int_type, "CastY", CastY, !Info),
+        generate_cast(unsafe_type_cast, X, CastX, Context, CastXGoal0),
+        generate_cast(unsafe_type_cast, Y, CastY, Context, CastYGoal0),
+        goal_add_feature(feature_keep_constant_binding, CastXGoal0, CastXGoal),
+        goal_add_feature(feature_keep_constant_binding, CastYGoal0, CastYGoal),
+        create_pure_atomic_complicated_unification(CastX, rhs_var(CastY),
+            Context, umc_explicit, [], EqualityGoal),
+        CondGoalExpr = conj(plain_conj, [CastXGoal, CastYGoal, EqualityGoal]),
+        goal_info_init(GoalInfo0),
+        goal_info_set_context(Context, GoalInfo0, ContextGoalInfo),
+        CondGoal= hlds_goal(CondGoalExpr, ContextGoalInfo),
+        (
+            MaybeCompareRes = no,
+            EqualGoal = true_goal_with_context(Context),
+            GoalInfo = ContextGoalInfo
+        ;
+            MaybeCompareRes = yes(Res),
+            Builtin = mercury_public_builtin_module,
+            make_const_construction(Res, cons(qualified(Builtin, "="), 0),
+                EqualGoal),
+            EqualGoal = hlds_goal(_, EqualGoalInfo),
+            goal_info_get_instmap_delta(EqualGoalInfo, InstmapDelta),
+            goal_info_set_instmap_delta(InstmapDelta,
+                ContextGoalInfo, GoalInfo)
+        ),
+        GoalExpr = if_then_else([], CondGoal, EqualGoal, Goal0),
+        goal_info_add_feature(feature_pretest_equality, GoalInfo,
+            FeaturedGoalInfo),
+        Goal = hlds_goal(GoalExpr, FeaturedGoalInfo)
+    ).
+
+    % We can start unify and compare predicates that may call other predicates
+    % with an equality test, since it often succeeds, and when it does, it is 
+    % faster than executing the rest of the predicate body.
+    %
+:- func should_pretest_equality(unify_proc_info) = bool.
+
+should_pretest_equality(Info) = ShouldPretestEq :-
+    ModuleInfo = Info ^ module_info,
+    module_info_get_globals(ModuleInfo, Globals),
+    lookup_bool_option(Globals, should_pretest_equality, ShouldPretestEq).
+
+%-----------------------------------------------------------------------------%
+
+:- pred quantify_clause_body(list(prog_var)::in, hlds_goal::in,
+    prog_context::in, clause::out,
+    unify_proc_info::in, unify_proc_info::out) is det.
+
+quantify_clause_body(HeadVars, Goal0, Context, Clause, !Info) :-
+    info_get_varset(!.Info, Varset0),
+    info_get_types(!.Info, Types0),
+    info_get_rtti_varmaps(!.Info, RttiVarMaps0),
+    implicitly_quantify_clause_body(HeadVars, _Warnings, Goal0, Goal,
+        Varset0, Varset, Types0, Types, RttiVarMaps0, RttiVarMaps),
+    info_set_varset(Varset, !Info),
+    info_set_types(Types, !Info),
+    info_set_rtti_varmaps(RttiVarMaps, !Info),
+    Clause = clause([], Goal, impl_lang_mercury, Context).
+
+%-----------------------------------------------------------------------------%
+
 :- func equal_cons_id = cons_id.
 
 equal_cons_id = cons(qualified(mercury_public_builtin_module, "="), 0).
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.515
diff -u -b -r1.515 user_guide.texi
--- doc/user_guide.texi	5 Apr 2007 02:52:44 -0000	1.515
+++ doc/user_guide.texi	10 Apr 2007 06:36:24 -0000
@@ -7579,6 +7579,27 @@
 Combines the effect of the two options above.
 
 @sp 1
+ at item max-jump-table-size @var{n}
+ at findex --max-jump-table-size @var{n}
+The maximum number of entries a jump table can have.
+The special value 0 indicates the table size is unlimited.
+This option can be useful to avoid exceeding fixed limits
+imposed by some C compilers.
+
+% @sp 1
+% @item "--compare-specialization @var{n}
+% @findex --compare-specialization @var{n}
+% Generate quadratic instead of linear compare predicates for types
+% with up to n function symbols. Higher values of n lead to faster
+% but also bigger compare predicates.
+
+% @sp 1
+% @item --should-pretest-equality
+% @findex --should-pretest-equality
+% If specified, add a test for the two values being equal as words
+% to the starts of potentially expensive unify and compare predicates.
+
+ at sp 1
 @item --fact-table-max-array-size @var{size}
 @findex --fact-table-max-array-size @var{size}
 @cindex Fact tables
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/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/stream
cvs diff: Diffing extras/stream/tests
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
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.95
diff -u -b -r1.95 mercury_conf_param.h
--- runtime/mercury_conf_param.h	5 Apr 2007 02:52:46 -0000	1.95
+++ runtime/mercury_conf_param.h	5 Apr 2007 05:00:43 -0000
@@ -586,11 +586,7 @@
   #undef  MR_DEEP_PROFILING_MEMORY
 #endif
 
-/*
-** XXX MR_CHECK_DU_EQ is currently not compatible with deep profiling.
-** See the comment in mercury_unify_compare_body.h for an explanation.
-*/
-#if !defined(MR_DISABLE_CHECK_DU_EQ) && !defined(MR_DEEP_PROFILING)
+#if !defined(MR_DISABLE_CHECK_DU_EQ)
   #define MR_CHECK_DU_EQ
 #endif
 
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.81
diff -u -b -r1.81 mercury_ho_call.c
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.124
diff -u -b -r1.124 mercury_type_info.h
--- runtime/mercury_type_info.h	13 Feb 2007 01:59:00 -0000	1.124
+++ runtime/mercury_type_info.h	5 Apr 2007 05:00:43 -0000
@@ -1157,7 +1157,8 @@
 ** Map from ordinal (declaration order) functor numbers to lexicographic
 ** functor numbers which can be passed to construct.construct.
 */
-typedef const MR_Integer * MR_FunctorNumberMap;
+
+typedef const MR_Integer        *MR_FunctorNumberMap;
 
 /*---------------------------------------------------------------------------*/
 
Index: runtime/mercury_unify_compare_body.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_unify_compare_body.h,v
retrieving revision 1.45
diff -u -b -r1.45 mercury_unify_compare_body.h
--- runtime/mercury_unify_compare_body.h	5 Apr 2007 02:52:46 -0000	1.45
+++ runtime/mercury_unify_compare_body.h	5 Apr 2007 06:56:19 -0000
@@ -44,6 +44,7 @@
 ** types: they support unifications but not comparisons. Since we cannot do
 ** it for such types, it is simplest not to do it for any types.
 */
+
 #ifdef  select_compare_code
   #if defined(MR_DEEP_PROFILING) && defined(entry_point_is_mercury)
     #ifdef include_compare_rep_code
@@ -165,6 +166,12 @@
             /* fall through */
   #endif
         case MR_TYPECTOR_REP_DU:
+            /*
+            ** When deep profiling is enabled, we use the call, exit and (for
+            ** unifications) fail ports of dummy unify, compare and compare_rep
+            ** predicates for the dummy type_ctor builtin.user_by_rtti/0.
+            */
+
             {
                 const MR_DuFunctorDesc  *functor_desc;
   #ifdef  select_compare_code
@@ -186,13 +193,7 @@
                 int                     cur_slot;
                 int                     arity;
                 int                     i;
-  /*
-  ** XXX MR_CHECK_DU_EQ doesn't not currently work in deep profiling grades
-  **     since the resulting short circuit means that the exit port call
-  **     for the unification or comparison predicate is never made.
-  **     This results in the data structures used by the deep profiler
-  **     becoming corrupted.
-  */
+
   #ifdef MR_CHECK_DU_EQ
     #ifdef  select_compare_code
                 if (x == y) {
@@ -303,7 +304,8 @@
                         break;
 
                     case MR_SECTAG_VARIABLE:
-                        MR_fatal_error("find_du_functor_desc(): attempt get functor desc of variable");
+                        MR_fatal_error("find_du_functor_desc():"
+                            "attempt get functor desc of variable");
                 }
 
                 functor_desc = ptaglayout->MR_sectag_alternatives[x_sectag];
@@ -415,7 +417,7 @@
   #endif
             }
 
-            MR_fatal_error(MR_STRINGIFY(start_label) ": expected fall thru");
+            MR_fatal_error(MR_STRINGIFY(start_label) ": unexpected fall thru");
 
 #endif  /* defined(MR_COMPARE_BY_RTTI) || defined(include_compare_rep_code) */
 
@@ -440,18 +442,47 @@
         case MR_TYPECTOR_REP_FOREIGN:
         case MR_TYPECTOR_REP_STABLE_FOREIGN:
 
+            /*
+            ** In deep profiling grades, the caller of builtin.unify or
+            ** builtin.compare (the predicates this piece of code implements)
+            ** has prepared for a normal call, which must be followed by
+            ** the execution of the call port code and then of either the exit
+            ** or the fail port code.
+            **
+            ** That is a problem. First, at the moment there is no fast way
+            ** to get from the type_ctor_info (which we have) to the proc
+            ** layout structures of the type's unify or compare predicates
+            ** (which port codes need). Second, even if we put the addresses
+            ** of those proc layout structures into the type_ctor_info,
+            ** incrementing just the call and exit/fail port counts would
+            ** leave the called predicate's counts inconsistent in cases where
+            ** the body of that predicate did not have any paths through it
+            ** without making calls (since those calls are being
+            ** short-circuited here).
+            **
+            ** Our solution is two fold. First, in deep-profiling grades,
+            ** we don't check x == y here; instead, we make sure that the
+            ** compiler-generated unify and compare predicates start off
+            ** with that check. Second, since this solution increases both
+            ** code size and execution time, in non-deep-profiling grades
+            ** we do the x == y check here, and not in the compiler-generated
+            ** unify or compare predicates.
+            **
+            */
+
+#ifndef MR_DEEP_PROFILING
   #ifdef MR_CHECK_DU_EQ
     #ifdef  select_compare_code
             if (x == y) {
-                return_compare_answer(builtin, user_by_rtti, 0,
-                    MR_COMPARE_EQUAL);
+                raw_return_answer(MR_COMPARE_EQUAL);
             }
     #else
             if (x == y) {
-                return_unify_answer(builtin, user_by_rtti, 0, MR_TRUE);
+                raw_return_answer(MR_TRUE);
             }
     #endif
   #endif
+#endif
 
             /*
             ** We call the type-specific compare routine as
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing tests
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
Index: tests/hard_coded/profdeep_seg_fault.exp
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/profdeep_seg_fault.exp,v
retrieving revision 1.1
diff -u -b -r1.1 profdeep_seg_fault.exp
Index: tests/hard_coded/profdeep_seg_fault.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/profdeep_seg_fault.m,v
retrieving revision 1.3
diff -u -b -r1.3 profdeep_seg_fault.m
--- tests/hard_coded/profdeep_seg_fault.m	5 Apr 2007 02:52:47 -0000	1.3
+++ tests/hard_coded/profdeep_seg_fault.m	5 Apr 2007 07:56:32 -0000
@@ -1,11 +1,16 @@
 % vim: ft=mercury ts=4 sw=4 et
-% The following program exposes a bug in the deep profiler.
-% When compiled in a deep profiling grade at -O2 or below it aborts with a 
-% segmentation fault.
+% The following program used to expose a bug in the runtime's handling
+% of deep profiled code. When compiled in a deep profiling grade at -O2
+% or below it used to abort with a segmentation fault.
 %
-% The problem was caused by short circuit in the code for
-% builtin.{unify, compare} that is enabled by MR_CHECK_DU_EQ causing execution
-% to avoid calling the exit port code for builtin.{unify, compare}.
+% The problem was caused by the code in builtin.{unify,compare} for du types
+% having inappropriate references to the proc layout structures of the dummy
+% unify and compare predicates for the dummy type builtin.user_by_rtti. If the
+% first call to builtin.{unify,compare} at a given call site had the equality
+% pretest of the two arguments succeed, this used to fill in the call site
+% dynamic structure with a pointer to the proc dynamic structure of this dummy
+% predicate, leading later calls through that call site to refer to the wrong
+% data structure.
 %
 :- module profdeep_seg_fault.
 :- interface.
@@ -16,7 +21,7 @@
 
 :- implementation.
 
-:- type list(T) ---> [] ; [ T | list(T) ].
+:- type list(T) ---> [] ; [T | list(T)].
 
 :- type t_type
     --->    t_bool
@@ -46,7 +51,8 @@
     ],
     AllBuiltinSigs = [A, B],   
     add_sigs_to_sym(AllBuiltinSigs, [], S),
-    io.write(S, !IO).
+    io.write(S, !IO),
+    io.nl(!IO).
 
 :- pred add_sigs_to_sym(list(list(ti_sig))::in,
     list(t_sig)::in, list(t_sig)::out) is det.
@@ -87,18 +93,18 @@
     ),
     type_insts_to_t_types(Xs, Ys).
 
-:- pred append_type_sigs(list(t_sig)::in,
-    list(t_sig)::in, list(t_sig)::out) is det.
+:- pred append_type_sigs(list(t_sig)::in, list(t_sig)::in,
+    list(t_sig)::out) is det.
 
 append_type_sigs([], Zs, Zs).
-append_type_sigs([ X | Xs ], Ys, [X | Zs]) :-
+append_type_sigs([X | Xs], Ys, [X | Zs]) :-
     append_type_sigs(Xs, Ys, Zs).
 
 :- pred insertion_sort(list(t_sig)::in, list(t_sig)::in, list(t_sig)::out)
     is det.
 
 insertion_sort([], Zs, Zs).
-insertion_sort([ X | Xs], Ys0, Zs) :-
+insertion_sort([X | Xs], Ys0, Zs) :-
     insert(X, Ys0, Ys),
     insertion_sort(Xs, Ys, Zs).
 
@@ -111,7 +117,7 @@
         Res = (>)
     ->
         insert(X, Ys, Zs0),
-        Zs = [ Y | Zs0 ]
+        Zs = [Y | Zs0]
     ;
-        Zs = [ X, Y | Ys]
+        Zs = [X, Y | Ys]
     ).
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/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
Index: tools/speed_summary
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/tools/speed_summary,v
retrieving revision 1.7
diff -u -b -r1.7 speed_summary
--- tools/speed_summary	24 Jul 2002 10:29:23 -0000	1.7
+++ tools/speed_summary	11 Apr 2007 05:08:40 -0000
@@ -107,6 +107,8 @@
 
 				printf "\n"
 			}
+
+			printf "\n";
 		}
 
 	}
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