[m-rev.] for post-commit review: more compiler speedups

Zoltan Somogyi zs at csse.unimelb.edu.au
Fri Sep 4 09:06:16 AEST 2009


These are relatively simple, minor local speedups.

Zoltan.

Further compiler speedups.

library/varset.m:
	Speed up predicates by avoding making the same decisions over and over
	again.

library/tree234.m:
library/map.m:
NEWS:
	Add tree234.map_values_only and map.map_values_only.

compiler/add_pragma.m:
compiler/analysis.m:
compiler/code_info.m:
compiler/cse_detection.m:
compiler/cse_detection.m:
compiler/equiv_type_hlds.m:
compiler/global_data.m:
compiler/hlds_out.m:
compiler/hlds_rtti.m:
compiler/inst_graph.m:
compiler/lp_rational.m:
compiler/hlds_out.m:
compiler/mlds_to_il.m:
compiler/modules.m:
compiler/par_conj_gen.m:
compiler/polymorphism.m:
compiler/prog_data.m:
compiler/prog_type_subst.m:
compiler/recompilation.version.m:
compiler/simplify.m:
compiler/stack_layout.m:
compiler/type_util.m:
compiler/unneeded_code.m:
	Use the new predicates.

compiler/mark_static_terms.m:
	Do not bother traversing from_ground_term_construct scopes.

	Remove a redundant test.

compiler/ml_unify_gen.m:
	Speed up a predicate by avoding making the same decisions over and over
	again.

compiler/mlds.m:
	Factor out some code.

compiler/typecheck_info.m:
	Operate on vartypes directly as maps; don't transform them
	unnecessarily into association lists.

	Do not bother to apply empty substitutions.

cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.509
diff -u -b -r1.509 NEWS
--- NEWS	11 May 2009 05:24:08 -0000	1.509
+++ NEWS	2 Sep 2009 22:58:32 -0000
@@ -258,6 +258,10 @@
   map.from_sorted_assoc_list now also constructs the tree directly, so now
   it requires its input list to be duplicate-free.
 
+* We have added tree234.map_values_only and map.map_values_only, which are
+  versions of tree234.map_values and map.map_values which do not give the
+  higher order argument the key associated with the value being transformed.
+
 * We have replaced the hash_table and version_hash_table implementations
   with separate chaining schemes.  Consequently delete works, and double
   hashing predicates are not required.
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/add_pragma.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.95
diff -u -b -r1.95 add_pragma.m
--- compiler/add_pragma.m	19 Aug 2009 07:44:52 -0000	1.95
+++ compiler/add_pragma.m	2 Sep 2009 19:17:37 -0000
@@ -1497,7 +1497,8 @@
             MaybeProcIds, Procs0, Procs1, !ModuleInfo, !Specs),
         % Remove any imported structure sharing and reuse information for the
         % original procedure as they won't be (directly) applicable.
-        map.map_values(reset_imported_structure_sharing_reuse, Procs1, Procs),
+        map.map_values_only(reset_imported_structure_sharing_reuse,
+            Procs1, Procs),
         module_info_get_globals(!.ModuleInfo, Globals),
         globals.lookup_bool_option(Globals, user_guided_type_specialization,
             DoTypeSpec),
@@ -1883,10 +1884,10 @@
         MaybeProcIds = yes(ProcIds)
     ).
 
-:- pred reset_imported_structure_sharing_reuse(proc_id::in,
+:- pred reset_imported_structure_sharing_reuse(
     proc_info::in, proc_info::out) is det.
 
-reset_imported_structure_sharing_reuse(_, !ProcInfo) :-
+reset_imported_structure_sharing_reuse(!ProcInfo) :-
     proc_info_reset_imported_structure_sharing(!ProcInfo),
     proc_info_reset_imported_structure_reuse(!ProcInfo).
 
Index: compiler/analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/analysis.m,v
retrieving revision 1.8
diff -u -b -r1.8 analysis.m
--- compiler/analysis.m	21 Jul 2008 03:10:06 -0000	1.8
+++ compiler/analysis.m	2 Sep 2009 20:11:11 -0000
@@ -1150,20 +1150,21 @@
     module_analysis_map(imdg_arc)::out) is det.
 
 clear_imdg_entries_pointing_at(ModuleName, Map0, Map) :-
-    map.map_values(clear_imdg_entries_pointing_at_2(ModuleName), Map0, Map).
+    map.map_values_only(clear_imdg_entries_pointing_at_2(ModuleName),
+        Map0, Map).
 
-:- pred clear_imdg_entries_pointing_at_2(module_name::in, analysis_name::in,
+:- pred clear_imdg_entries_pointing_at_2(module_name::in,
     func_analysis_map(imdg_arc)::in,
     func_analysis_map(imdg_arc)::out) is det.
 
-clear_imdg_entries_pointing_at_2(ModuleName, _, FuncMap0, FuncMap) :-
-    map.map_values(clear_imdg_entries_pointing_at_3(ModuleName),
+clear_imdg_entries_pointing_at_2(ModuleName, FuncMap0, FuncMap) :-
+    map.map_values_only(clear_imdg_entries_pointing_at_3(ModuleName),
         FuncMap0, FuncMap).
 
-:- pred clear_imdg_entries_pointing_at_3(module_name::in, func_id::in,
+:- pred clear_imdg_entries_pointing_at_3(module_name::in,
     list(imdg_arc)::in, list(imdg_arc)::out) is det.
 
-clear_imdg_entries_pointing_at_3(ModuleName, _, Arcs0, Arcs) :-
+clear_imdg_entries_pointing_at_3(ModuleName, Arcs0, Arcs) :-
     list.filter((pred(Arc::in) is semidet :- Arc ^ imdg_caller \= ModuleName),
         Arcs0, Arcs).
 
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.373
diff -u -b -r1.373 code_info.m
--- compiler/code_info.m	11 Jun 2009 07:00:07 -0000	1.373
+++ compiler/code_info.m	2 Sep 2009 20:11:11 -0000
@@ -1243,7 +1243,7 @@
     set_follow_vars(abs_follow_vars(StoreMap, MaxMentionedReg + 1), !CI),
     get_instmap(!.CI, InstMap),
     ( instmap_is_reachable(InstMap) ->
-        VarLocs = assoc_list.map_values(key_abs_locn_to_lval, AbsVarLocs),
+        VarLocs = assoc_list.map_values_only(abs_locn_to_lval, AbsVarLocs),
         place_vars(VarLocs, Code, !CI)
     ;
         % With --opt-no-return-call, the variables that we would have
@@ -1332,7 +1332,7 @@
 
 remake_with_store_map(StoreMap, !CI) :-
     map.to_assoc_list(StoreMap, VarLocns),
-    VarLvals = assoc_list.map_values(key_abs_locn_to_lval, VarLocns),
+    VarLvals = assoc_list.map_values_only(abs_locn_to_lval, VarLocns),
     get_var_locn_info(!.CI, VarLocnInfo0),
     reinit_var_locn_state(VarLvals, VarLocnInfo0, VarLocnInfo),
     set_var_locn_info(VarLocnInfo, !CI).
@@ -2845,7 +2845,7 @@
         get_stack_slots(!.CI, StackSlots),
         map.select(StackSlots, FailVars, AbsStackMap),
         map.to_assoc_list(AbsStackMap, AbsStackList),
-        StackList0 = assoc_list.map_values(key_stack_slot_to_lval,
+        StackList0 = assoc_list.map_values_only(stack_slot_to_lval,
             AbsStackList),
         make_singleton_sets(StackList0, StackList),
         map.from_sorted_assoc_list(StackList, StackMap)
@@ -2948,7 +2948,7 @@
 make_stack_resume_map(ResumeVars, StackSlots, StackMap) :-
     map.select(StackSlots, ResumeVars, StackMap0),
     map.to_assoc_list(StackMap0, AbsStackList),
-    StackList0 = assoc_list.map_values(key_stack_slot_to_lval, AbsStackList),
+    StackList0 = assoc_list.map_values_only(stack_slot_to_lval, AbsStackList),
     make_singleton_sets(StackList0, StackList),
     map.from_sorted_assoc_list(StackList, StackMap).
 
Index: compiler/cse_detection.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/cse_detection.m,v
retrieving revision 1.122
diff -u -b -r1.122 cse_detection.m
--- compiler/cse_detection.m	21 Jul 2009 02:08:48 -0000	1.122
+++ compiler/cse_detection.m	2 Sep 2009 20:19:50 -0000
@@ -871,17 +871,12 @@
     map.from_assoc_list(OldNew, OldNewMap),
     apply_substitutions_to_rtti_varmaps(Renaming, map.init, OldNewMap,
         RttiVarMaps0, RttiVarMaps),
-    map.map_values(apply_tvar_rename(Renaming), VarTypes0, VarTypes),
+    map.map_values_only(apply_variable_renaming_to_type(Renaming),
+        VarTypes0, VarTypes),
 
     !:CseInfo = !.CseInfo ^ csei_rtti_varmaps := RttiVarMaps,
     !:CseInfo = !.CseInfo ^ csei_vartypes := VarTypes.
 
-:- pred apply_tvar_rename(tvar_renaming::in, prog_var::in,
-    mer_type::in, mer_type::out) is det.
-
-apply_tvar_rename(Renaming, _Var, Type0, Type) :-
-    apply_variable_renaming_to_type(Renaming, Type0, Type).
-
 :- pred find_type_info_locn_tvar_map(rtti_varmaps::in,
     map(prog_var, prog_var)::in, tvar::in,
     map(type_info_locn, tvar)::in, map(type_info_locn, tvar)::out) is det.
Index: compiler/equiv_type_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/equiv_type_hlds.m,v
retrieving revision 1.55
diff -u -b -r1.55 equiv_type_hlds.m
--- compiler/equiv_type_hlds.m	12 Jun 2009 05:21:26 -0000	1.55
+++ compiler/equiv_type_hlds.m	2 Sep 2009 20:20:45 -0000
@@ -298,12 +298,12 @@
     is det.
 
 replace_in_cons_table(EqvMap, !ConsTable) :-
-    map.map_values(replace_in_cons_defns(EqvMap), !ConsTable).
+    map.map_values_only(replace_in_cons_defns(EqvMap), !ConsTable).
 
-:- pred replace_in_cons_defns(eqv_map::in, cons_id::in,
+:- pred replace_in_cons_defns(eqv_map::in,
     list(hlds_cons_defn)::in, list(hlds_cons_defn)::out) is det.
 
-replace_in_cons_defns(EqvMap, _ConsId, !ConsDefns) :-
+replace_in_cons_defns(EqvMap, !ConsDefns) :-
     list.map(replace_in_cons_defn(EqvMap), !ConsDefns).
 
 :- pred replace_in_cons_defn(eqv_map::in,
Index: compiler/global_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/global_data.m,v
retrieving revision 1.39
diff -u -b -r1.39 global_data.m
--- compiler/global_data.m	7 Jul 2009 07:21:57 -0000	1.39
+++ compiler/global_data.m	2 Sep 2009 22:12:58 -0000
@@ -824,31 +824,31 @@
 remap_static_cell_info(Remap, !SCI) :-
     ScalarMap0 = !.SCI ^ scalar_cell_group_map,
     VectorMap0 = !.SCI ^ vector_cell_group_map,
-    map.map_values(remap_scalar_cell_group(Remap), ScalarMap0, ScalarMap),
-    map.map_values(remap_vector_cell_group(Remap), VectorMap0, VectorMap),
+    map.map_values_only(remap_scalar_cell_group(Remap), ScalarMap0, ScalarMap),
+    map.map_values_only(remap_vector_cell_group(Remap), VectorMap0, VectorMap),
     !SCI ^ scalar_cell_group_map := ScalarMap,
     !SCI ^ vector_cell_group_map := VectorMap.
 
-:- pred remap_scalar_cell_group(static_cell_remap_info::in, type_num::in,
+:- pred remap_scalar_cell_group(static_cell_remap_info::in,
     scalar_cell_group::in, scalar_cell_group::out) is det.
 
-remap_scalar_cell_group(Remap, _, !ScalarCellGroup) :-
+remap_scalar_cell_group(Remap, !ScalarCellGroup) :-
     Array0 = !.ScalarCellGroup ^ scalar_cell_rev_array,
     list.map(remap_common_cell_value(Remap), Array0, Array),
     !ScalarCellGroup ^ scalar_cell_rev_array := Array.
 
-:- pred remap_vector_cell_group(static_cell_remap_info::in, type_num::in,
+:- pred remap_vector_cell_group(static_cell_remap_info::in,
     vector_cell_group::in, vector_cell_group::out) is det.
 
-remap_vector_cell_group(Remap, _, !VectorCellGroup) :-
+remap_vector_cell_group(Remap, !VectorCellGroup) :-
     !.VectorCellGroup = vector_cell_group(Counter, Map0),
-    map.map_values(remap_vector_contents(Remap), Map0, Map),
+    map.map_values_only(remap_vector_contents(Remap), Map0, Map),
     !:VectorCellGroup = vector_cell_group(Counter, Map).
 
-:- pred remap_vector_contents(static_cell_remap_info::in, int::in,
+:- pred remap_vector_contents(static_cell_remap_info::in,
     vector_contents::in, vector_contents::out) is det.
 
-remap_vector_contents(Remap, _, !Contents) :-
+remap_vector_contents(Remap, !Contents) :-
     !.Contents = vector_contents(Values0),
     list.map(remap_common_cell_value(Remap), Values0, Values),
     !:Contents = vector_contents(Values).
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.469
diff -u -b -r1.469 hlds_out.m
--- compiler/hlds_out.m	2 Sep 2009 00:30:15 -0000	1.469
+++ compiler/hlds_out.m	2 Sep 2009 20:33:41 -0000
@@ -3407,7 +3407,7 @@
 
 write_stack_slots(Indent, StackSlots, VarSet, AppendVarNums, !IO) :-
     map.to_assoc_list(StackSlots, VarSlotList0),
-    VarSlotList = assoc_list.map_values(key_stack_slot_to_abs_locn,
+    VarSlotList = assoc_list.map_values_only(stack_slot_to_abs_locn,
         VarSlotList0),
     write_var_to_abs_locns(VarSlotList, VarSet, AppendVarNums, Indent, !IO).
 
Index: compiler/hlds_rtti.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_rtti.m,v
retrieving revision 1.16
diff -u -b -r1.16 hlds_rtti.m
--- compiler/hlds_rtti.m	12 Jun 2009 02:08:58 -0000	1.16
+++ compiler/hlds_rtti.m	2 Sep 2009 20:33:41 -0000
@@ -695,10 +695,7 @@
     ConstraintMap0 = !.RttiVarMaps ^ tci_constraint_map,
     map.foldl(apply_constraint_key_transformation(Pred), TciMap0,
         map.init, TciMap),
-    Pred2 = (pred(_::in, V::in, W::out) is det :-
-            Pred(V, W)
-    ),
-    map.map_values(Pred2, TypeMap0, TypeMap),
+    map.map_values_only(Pred, TypeMap0, TypeMap),
     map.map_values(apply_constraint_value_transformation(Pred),
         ConstraintMap0, ConstraintMap),
     !:RttiVarMaps = !.RttiVarMaps ^ tci_varmap := TciMap,
Index: compiler/inst_graph.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inst_graph.m,v
retrieving revision 1.18
diff -u -b -r1.18 inst_graph.m
--- compiler/inst_graph.m	11 Jun 2009 07:00:10 -0000	1.18
+++ compiler/inst_graph.m	2 Sep 2009 20:33:41 -0000
@@ -363,7 +363,7 @@
 merge(InstGraph0, VarSet0, NewInstGraph, NewVarSet, InstGraph, VarSet, Sub) :-
     varset.merge_subst_without_names(VarSet0, NewVarSet, VarSet, Sub0),
     (
-        map.map_values(pred(_::in, term.variable(V, _)::in, V::out) is semidet,
+        map.map_values_only(pred(term.variable(V, _)::in, V::out) is semidet,
             Sub0, Sub1)
     ->
         Sub = Sub1
@@ -372,8 +372,8 @@
     ),
     map.foldl((pred(Var0::in, Node0::in, IG0::in, IG::out) is det :-
         Node0 = node(Functors0, MaybeParent),
-        map.map_values(
-            (pred(_::in, Args0::in, Args::out) is det :-
+        map.map_values_only(
+            (pred(Args0::in, Args::out) is det :-
                 map.apply_to_list(Args0, Sub, Args)),
             Functors0, Functors),
         Node = node(Functors, MaybeParent),
Index: compiler/lp_rational.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/lp_rational.m,v
retrieving revision 1.11
diff -u -b -r1.11 lp_rational.m
--- compiler/lp_rational.m	23 Nov 2007 07:35:10 -0000	1.11
+++ compiler/lp_rational.m	2 Sep 2009 20:38:09 -0000
@@ -902,7 +902,7 @@
 
 :- func negate_lp_terms(lp_terms) = lp_terms.
 
-negate_lp_terms(Terms) = assoc_list.map_values((func(_, X) = (-X)), Terms).
+negate_lp_terms(Terms) = assoc_list.map_values_only((func(X) = (-X)), Terms).
 
 :- func add_var(map(lp_var, rat), lp_var, rat) = map(lp_var, rat).
 
@@ -2039,7 +2039,7 @@
           else  true
         ),
         DivVal = rat.abs(Coefficient),
-        !:Terms = map.map_values((func(_, C) = C / DivVal), !.Terms),
+        !:Terms = map.map_values_only((func(C) = C / DivVal), !.Terms),
         !:Constant = !.Constant / DivVal
     ;
         % In this case the the coefficient of the variable was zero
Index: compiler/mark_static_terms.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mark_static_terms.m,v
retrieving revision 1.31
diff -u -b -r1.31 mark_static_terms.m
--- compiler/mark_static_terms.m	2 Sep 2009 00:30:16 -0000	1.31
+++ compiler/mark_static_terms.m	2 Sep 2009 22:11:21 -0000
@@ -89,11 +89,14 @@
         GoalExpr = negation(SubGoal)
     ;
         GoalExpr0 = scope(Reason, SubGoal0),
-        % We should special-case the handling of from_ground_term_construct
-        % scopes, since these already have all their unifications marked
+        ( Reason = from_ground_term(_TermVar, from_ground_term_construct) ->
+            % These scopes already have all their unifications marked
         % as construct_statically.
+            GoalExpr = GoalExpr0
+        ;
         goal_mark_static_terms(SubGoal0, SubGoal, !SI),
         GoalExpr = scope(Reason, SubGoal)
+        )
     ;
         GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
         SI0 = !.SI,
@@ -152,23 +155,23 @@
 
 unification_mark_static_terms(Unification0, Unification, !StaticVars) :-
     (
-        Unification0 = construct(Var, ConsId, ArgVars, D, HowToConstruct0,
-            F, G),
+        Unification0 = construct(Var, ConsId, ArgVars, ArgModes,
+            HowToConstruct0, Unique, SubInfo),
         % If all the arguments are static, then the newly constructed variable
         % is static too.
         ( list.all_true(set_tree234.contains(!.StaticVars), ArgVars) ->
             HowToConstruct = construct_statically,
-            set_tree234.insert(Var, !StaticVars)
-        ;
-            HowToConstruct = HowToConstruct0
-        ),
-        ( HowToConstruct = HowToConstruct0 ->
+            set_tree234.insert(Var, !StaticVars),
             % This is a minor optimization to improve the efficiency of the
             % compiler: don't bother allocating memory if we don't need to.
+            ( HowToConstruct = HowToConstruct0 ->
             Unification = Unification0
         ;
-            Unification = construct(Var, ConsId, ArgVars, D, HowToConstruct,
-                F, G)
+                Unification = construct(Var, ConsId, ArgVars, ArgModes,
+                    HowToConstruct, Unique, SubInfo)
+            )
+        ;
+            Unification = Unification0
         )
     ;
         Unification0 = deconstruct(_Var, _ConsId, _ArgVars, _UniModes,
@@ -198,10 +201,9 @@
             true
         )
     ;
-        Unification0 = simple_test(_, _),
-        Unification = Unification0
-    ;
-        Unification0 = complicated_unify(_, _, _),
+        ( Unification0 = simple_test(_, _)
+        ; Unification0 = complicated_unify(_, _, _)
+        ),
         Unification = Unification0
     ).
 
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.134
diff -u -b -r1.134 ml_unify_gen.m
--- compiler/ml_unify_gen.m	2 Sep 2009 00:30:19 -0000	1.134
+++ compiler/ml_unify_gen.m	2 Sep 2009 20:38:50 -0000
@@ -2231,25 +2231,19 @@
         ConsArgTypes = ArgTypes
     ),
     assoc_list.from_corresponding_lists(Args, ConsArgTypes, ArgConsArgTypes),
-
     (
         HighLevelData = yes,
-        list.map_foldl2(
-            construct_ground_term_initializer_hld(ModuleInfo, Context),
+        construct_ground_term_initializers_hld(ModuleInfo, Context,
             ArgConsArgTypes, ArgInitializers, !GlobalData, !GroundTermMap)
     ;
         HighLevelData = no,
-        list.map_foldl2(
-            construct_ground_term_initializer_lld(ModuleInfo, Context),
+        construct_ground_term_initializers_lld(ModuleInfo, Context,
             ArgConsArgTypes, ArgInitializers, !GlobalData, !GroundTermMap)
     ),
 
     % By construction, boxing the rvals in ExtraInitializers would be a no-op.
     SubInitializers = ExtraInitializers ++ ArgInitializers,
 
-    % EntityDefn = mlds_data(MLDS_Type, Initializer, gc_no_stmt),
-    % Defn = mlds_defn(EntityName, MLDS_Context, Flags, EntityDefn),
-
     % Generate a local static constant for this term.
     ConstType = get_type_for_cons_id(Target, HighLevelData, MLDS_Type,
         ml_tag_uses_base_class(ConsTag), yes(ConsId)),
@@ -2282,6 +2276,42 @@
     GroundTerm = ml_ground_term(Rval, VarType),
     svmap.det_insert(Var, GroundTerm, !GroundTermMap).
 
+%-----------------------------------------------------------------------------%
+
+:- pred construct_ground_term_initializers_hld(module_info::in,
+    prog_context::in,
+    assoc_list(prog_var, mer_type) ::in, list(mlds_initializer)::out,
+    ml_global_data::in, ml_global_data::out,
+    ml_ground_term_map::in, ml_ground_term_map::out) is det.
+
+construct_ground_term_initializers_hld(_, _, [], [],
+        !GlobalData, !GroundTermMap).
+construct_ground_term_initializers_hld(ModuleInfo, Context,
+        [ArgConsArgType | ArgConsArgTypes], [ArgInitializer | ArgInitializers],
+        !GlobalData, !GroundTermMap) :-
+    construct_ground_term_initializer_hld(ModuleInfo, Context,
+        ArgConsArgType, ArgInitializer, !GlobalData, !GroundTermMap),
+    construct_ground_term_initializers_hld(ModuleInfo, Context,
+        ArgConsArgTypes, ArgInitializers, !GlobalData, !GroundTermMap).
+
+:- pred construct_ground_term_initializers_lld(module_info::in,
+    prog_context::in,
+    assoc_list(prog_var, mer_type) ::in, list(mlds_initializer)::out,
+    ml_global_data::in, ml_global_data::out,
+    ml_ground_term_map::in, ml_ground_term_map::out) is det.
+
+construct_ground_term_initializers_lld(_, _, [], [],
+        !GlobalData, !GroundTermMap).
+construct_ground_term_initializers_lld(ModuleInfo, Context,
+        [ArgConsArgType | ArgConsArgTypes], [ArgInitializer | ArgInitializers],
+        !GlobalData, !GroundTermMap) :-
+    construct_ground_term_initializer_lld(ModuleInfo, Context,
+        ArgConsArgType, ArgInitializer, !GlobalData, !GroundTermMap),
+    construct_ground_term_initializers_lld(ModuleInfo, Context,
+        ArgConsArgTypes, ArgInitializers, !GlobalData, !GroundTermMap).
+
+%-----------------------------------------------------------------------------%
+
 :- pred construct_ground_term_initializer_hld(module_info::in,
     prog_context::in, pair(prog_var, mer_type) ::in, mlds_initializer::out,
     ml_global_data::in, ml_global_data::out,
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.174
diff -u -b -r1.174 mlds.m
--- compiler/mlds.m	2 Sep 2009 05:48:00 -0000	1.174
+++ compiler/mlds.m	3 Sep 2009 22:40:20 -0000
@@ -1819,26 +1819,27 @@
 % and instead fully convert all Mercury types to MLDS types.
 
 mercury_type_to_mlds_type(ModuleInfo, Type) = MLDSType :-
+    ( type_to_ctor_and_args(Type, TypeCtor, TypeArgs) ->
     (
-        type_to_ctor_and_args(Type, TypeCtor, [ElemType]),
-        TypeCtor = type_ctor(qualified(unqualified("array"), "array"), 1)
+            TypeCtor = type_ctor(qualified(unqualified("array"), "array"), 1),
+            TypeArgs = [ElemType]
     ->
         MLDSElemType = mercury_type_to_mlds_type(ModuleInfo, ElemType),
         MLDSType = mlds_mercury_array_type(MLDSElemType)
     ;
-        type_to_ctor_and_args(Type, TypeCtor, [RefType]),
         TypeCtor = type_ctor(qualified(mercury_private_builtin_module,
-            "store_at_ref_type"), 1)
+                "store_at_ref_type"), 1),
+            TypeArgs = [RefType]
     ->
         MLDSRefType = mercury_type_to_mlds_type(ModuleInfo, RefType),
         MLDSType = mlds_ptr_type(MLDSRefType)
     ;
-        type_to_ctor_and_args(Type, TypeCtor, _),
         module_info_get_type_table(ModuleInfo, Types),
         map.search(Types, TypeCtor, TypeDefn),
         hlds_data.get_type_defn_body(TypeDefn, Body),
-        Body = hlds_foreign_type(foreign_type_body(MaybeIL, MaybeC, MaybeJava,
-            _MaybeErlang))
+            Body = hlds_foreign_type(ForeignTypeBody),
+            ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava,
+                _MaybeErlang)
     ->
         module_info_get_globals(ModuleInfo, Globals),
         globals.get_target(Globals, Target),
@@ -1896,13 +1897,19 @@
             unexpected(this_file, "target x86_64 with --high-level-code")
         ;
             Target = target_erlang,
-            unexpected(this_file, "mercury_type_to_mlds_type: target erlang")
+                unexpected(this_file,
+                    "mercury_type_to_mlds_type: target erlang")
         ),
         MLDSType = mlds_foreign_type(ForeignType)
     ;
         classify_type(ModuleInfo, Type) = Category,
         ExportedType = to_exported_type(ModuleInfo, Type),
         MLDSType = mercury_type(Type, Category, ExportedType)
+        )
+    ;
+        classify_type(ModuleInfo, Type) = Category,
+        ExportedType = to_exported_type(ModuleInfo, Type),
+        MLDSType = mercury_type(Type, Category, ExportedType)
     ).
 
 %-----------------------------------------------------------------------------%
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.207
diff -u -b -r1.207 mlds_to_il.m
--- compiler/mlds_to_il.m	2 Sep 2009 05:48:01 -0000	1.207
+++ compiler/mlds_to_il.m	3 Sep 2009 22:40:20 -0000
@@ -4579,7 +4579,7 @@
 
 il_info_get_locals_list(Info, Locals) :-
     DataRep = Info ^ il_data_rep,
-    map.map_values((pred(_K::in, V::in, W::out) is det :-
+    map.map_values_only((pred(V::in, W::out) is det :-
         W = mlds_type_to_ilds_type(DataRep, V)),
         Info ^ locals, LocalsMap),
     map.to_assoc_list(LocalsMap, Locals).
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.454
diff -u -b -r1.454 modules.m
--- compiler/modules.m	14 Aug 2009 20:37:47 -0000	1.454
+++ compiler/modules.m	2 Sep 2009 20:50:30 -0000
@@ -725,7 +725,8 @@
 
         % If a type in the implementation section isn't dummy and doesn't have
         % foreign type alternatives, make it abstract.
-        map.map_values(make_impl_type_abstract(BothTypesMap), !ImplTypesMap),
+        map.map_values_only(make_impl_type_abstract(BothTypesMap),
+            !ImplTypesMap),
 
         % If there is an exported type declaration for a type with an abstract
         % declaration in the implementation (usually it will originally
@@ -926,11 +927,11 @@
         Result = [Head | NewTail]
     ).
 
-:- pred make_impl_type_abstract(type_defn_map::in, type_ctor::in,
+:- pred make_impl_type_abstract(type_defn_map::in,
     assoc_list(type_defn, item_type_defn_info)::in,
     assoc_list(type_defn, item_type_defn_info)::out) is det.
 
-make_impl_type_abstract(TypeDefnMap, _TypeCtor, !TypeDefnPairs) :-
+make_impl_type_abstract(TypeDefnMap, !TypeDefnPairs) :-
     (
         !.TypeDefnPairs =
             [parse_tree_du_type(Ctors, MaybeEqCmp) - ItemTypeDefn0],
Index: compiler/par_conj_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/par_conj_gen.m,v
retrieving revision 1.39
diff -u -b -r1.39 par_conj_gen.m
--- compiler/par_conj_gen.m	6 Jan 2009 03:56:26 -0000	1.39
+++ compiler/par_conj_gen.m	2 Sep 2009 20:51:37 -0000
@@ -267,7 +267,7 @@
     get_known_variables(!.CI, Variables),
     set.list_to_set(Variables, LiveVars),
     map.select(AllSlots, LiveVars, StoreMap0),
-    StoreMap = map.map_values(key_stack_slot_to_abs_locn, StoreMap0),
+    StoreMap = map.map_values_only(stack_slot_to_abs_locn, StoreMap0),
     generate_branch_end(StoreMap, MaybeEnd0, MaybeEnd, SaveCode0, !CI),
     replace_stack_vars_by_parent_sv(SaveCode0, SaveCode),
 
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.342
diff -u -b -r1.342 polymorphism.m
--- compiler/polymorphism.m	19 Aug 2009 07:44:56 -0000	1.342
+++ compiler/polymorphism.m	2 Sep 2009 20:51:37 -0000
@@ -515,8 +515,8 @@
 
 polymorphism_introduce_exists_casts_pred(ModuleInfo, !PredInfo) :-
     pred_info_get_procedures(!.PredInfo, Procs0),
-    map.map_values(
-        (pred(_::in, !.ProcInfo::in, !:ProcInfo::out) is det :-
+    map.map_values_only(
+        (pred(!.ProcInfo::in, !:ProcInfo::out) is det :-
             % Add the extra goals to each procedure.
             introduce_exists_casts_proc(ModuleInfo, !.PredInfo, !ProcInfo)
         ), Procs0, Procs),
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.218
diff -u -b -r1.218 prog_data.m
--- compiler/prog_data.m	11 Jun 2009 08:28:27 -0000	1.218
+++ compiler/prog_data.m	2 Sep 2009 21:09:10 -0000
@@ -1862,17 +1862,17 @@
 
 tvarset_merge_renaming(TVarSetA, TVarSetB, TVarSet, Renaming) :-
     varset.merge_subst(TVarSetA, TVarSetB, TVarSet, Subst),
-    map.map_values(convert_subst_term_to_tvar, Subst, Renaming).
+    map.map_values_only(convert_subst_term_to_tvar, Subst, Renaming).
 
 tvarset_merge_renaming_without_names(TVarSetA, TVarSetB, TVarSet, Renaming) :-
     varset.merge_subst_without_names(TVarSetA, TVarSetB, TVarSet, Subst),
-    map.map_values(convert_subst_term_to_tvar, Subst, Renaming).
+    map.map_values_only(convert_subst_term_to_tvar, Subst, Renaming).
 
-:- pred convert_subst_term_to_tvar(tvar::in, term(tvar_type)::in, tvar::out)
+:- pred convert_subst_term_to_tvar(term(tvar_type)::in, tvar::out)
     is det.
 
-convert_subst_term_to_tvar(_, variable(TVar, _), TVar).
-convert_subst_term_to_tvar(_, functor(_, _, _), _) :-
+convert_subst_term_to_tvar(variable(TVar, _), TVar).
+convert_subst_term_to_tvar(functor(_, _, _), _) :-
     unexpected(this_file, "non-variable found in renaming").
 
 %-----------------------------------------------------------------------------%
Index: compiler/prog_type_subst.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/prog_type_subst.m,v
retrieving revision 1.5
diff -u -b -r1.5 prog_type_subst.m
--- compiler/prog_type_subst.m	1 Dec 2006 15:04:17 -0000	1.5
+++ compiler/prog_type_subst.m	2 Sep 2009 21:09:57 -0000
@@ -295,31 +295,13 @@
 %-----------------------------------------------------------------------------%
 
 apply_variable_renaming_to_vartypes(Renaming, !Map) :-
-    map.map_values(apply_variable_renaming_to_vartypes_2(Renaming), !Map).
-
-:- pred apply_variable_renaming_to_vartypes_2(tvar_renaming::in, prog_var::in,
-    mer_type::in, mer_type::out) is det.
-
-apply_variable_renaming_to_vartypes_2(Renaming, _, !Type) :-
-    apply_variable_renaming_to_type(Renaming, !Type).
+    map.map_values_only(apply_variable_renaming_to_type(Renaming), !Map).
 
 apply_subst_to_vartypes(Subst, !VarTypes) :-
-    map.map_values(apply_subst_to_vartypes_2(Subst), !VarTypes).
-
-:- pred apply_subst_to_vartypes_2(tsubst::in, prog_var::in,
-    mer_type::in, mer_type::out) is det.
-
-apply_subst_to_vartypes_2(Subst, _, !Type) :-
-    apply_subst_to_type(Subst, !Type).
+    map.map_values_only(apply_subst_to_type(Subst), !VarTypes).
 
 apply_rec_subst_to_vartypes(Subst, !VarTypes) :-
-    map.map_values(apply_rec_subst_to_vartypes_2(Subst), !VarTypes).
-
-:- pred apply_rec_subst_to_vartypes_2(tsubst::in, prog_var::in,
-    mer_type::in, mer_type::out) is det.
-
-apply_rec_subst_to_vartypes_2(Subst, _, !Type) :-
-    apply_rec_subst_to_type(Subst, !Type).
+    map.map_values_only(apply_rec_subst_to_type(Subst), !VarTypes).
 
 %-----------------------------------------------------------------------------%
 
Index: compiler/recompilation.version.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/recompilation.version.m,v
retrieving revision 1.67
diff -u -b -r1.67 recompilation.version.m
--- compiler/recompilation.version.m	2 Sep 2009 00:30:23 -0000	1.67
+++ compiler/recompilation.version.m	2 Sep 2009 21:10:53 -0000
@@ -208,18 +208,18 @@
     ),
 
     % Pragmas can apply to typeclass methods.
-    map.map_values(distribute_pragma_items_class_items(MaybePredOrFunc,
+    map.map_values_only(distribute_pragma_items_class_items(MaybePredOrFunc,
         SymName, Arity, Item, Section),
         extract_ids(!.GatheredItems, typeclass_item), GatheredTypeClasses),
     !:GatheredItems = update_ids(!.GatheredItems, typeclass_item,
         GatheredTypeClasses).
 
 :- pred distribute_pragma_items_class_items(maybe(pred_or_func)::in,
-    sym_name::in, arity::in, item::in, section::in, pair(string, int)::in,
+    sym_name::in, arity::in, item::in, section::in,
     assoc_list(section, item)::in, assoc_list(section, item)::out) is det.
 
 distribute_pragma_items_class_items(MaybePredOrFunc, SymName, Arity,
-        Item, Section, _, !ClassItems) :-
+        Item, Section, !ClassItems) :-
     (
         % Does this pragma match any of the methods of this class.
         list.member(_ - ClassItem, !.ClassItems),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.243
diff -u -b -r1.243 simplify.m
--- compiler/simplify.m	21 Jul 2009 04:10:42 -0000	1.243
+++ compiler/simplify.m	2 Sep 2009 21:10:53 -0000
@@ -3113,10 +3113,8 @@
     is det.
 
 renaming_transitive_closure(VarRenaming0, VarRenaming) :-
-    map.map_values(
-        (pred(_::in, Value0::in, Value::out) is det :-
-            find_renamed_var(VarRenaming0, Value0, Value)
-        ), VarRenaming0, VarRenaming).
+    map.map_values_only(find_renamed_var(VarRenaming0),
+        VarRenaming0, VarRenaming).
 
 %-----------------------------------------------------------------------------%
 
@@ -3807,10 +3805,7 @@
         !Info) :-
     simplify_info_get_var_types(!.Info, VarTypes0),
     simplify_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
-    ApplyTSubst = (pred(_::in, T0::in, T::out) is det :-
-            apply_rec_subst_to_type(TSubst, T0, T)
-        ),
-    map.map_values(ApplyTSubst, VarTypes0, VarTypes),
+    map.map_values_only(apply_rec_subst_to_type(TSubst), VarTypes0, VarTypes),
     map.det_insert(map.init, ToVar, FromVar, Renaming),
     apply_substitutions_to_rtti_varmaps(map.init, TSubst, Renaming,
         RttiVarMaps0, RttiVarMaps1),
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.145
diff -u -b -r1.145 stack_layout.m
--- compiler/stack_layout.m	25 Nov 2008 07:46:42 -0000	1.145
+++ compiler/stack_layout.m	2 Sep 2009 21:12:16 -0000
@@ -1466,13 +1466,12 @@
         !StaticCellInfo),
     add_scalar_static_cell(PTIRvalsTypes, PTIVectorAddr, !StaticCellInfo),
     PTIVectorRval = const(llconst_data_addr(PTIVectorAddr, no)),
-    map.map_values(convert_slot_to_locn_map, TVarSlotMap, TVarLocnMap),
+    map.map_values_only(convert_slot_to_locn_map, TVarSlotMap, TVarLocnMap),
     construct_tvar_vector(TVarLocnMap, TVarVectorRval, !StaticCellInfo).
 
-:- pred convert_slot_to_locn_map(tvar::in, table_locn::in,
-    set(layout_locn)::out) is det.
+:- pred convert_slot_to_locn_map(table_locn::in, set(layout_locn)::out) is det.
 
-convert_slot_to_locn_map(_TVar, SlotLocn, LvalLocns) :-
+convert_slot_to_locn_map(SlotLocn, LvalLocns) :-
     (
         SlotLocn = table_locn_direct(SlotNum),
         LvalLocn = locn_direct(reg(reg_r, SlotNum))
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.198
diff -u -b -r1.198 type_util.m
--- compiler/type_util.m	26 Aug 2009 16:05:56 -0000	1.198
+++ compiler/type_util.m	2 Sep 2009 21:12:16 -0000
@@ -1167,12 +1167,12 @@
     !.Constraints = constraints(Unproven0, Assumed0, Redundant0, Ancestors0),
     apply_variable_renaming_to_constraint_list(Renaming, Unproven0, Unproven),
     apply_variable_renaming_to_constraint_list(Renaming, Assumed0, Assumed),
-    Pred = (pred(_::in, C0::in, C::out) is det :-
+    Pred = (pred(C0::in, C::out) is det :-
         set.to_sorted_list(C0, L0),
         apply_variable_renaming_to_constraint_list(Renaming, L0, L),
         set.list_to_set(L, C)
     ),
-    map.map_values(Pred, Redundant0, Redundant),
+    map.map_values_only(Pred, Redundant0, Redundant),
     map.keys(Ancestors0, AncestorsKeys0),
     map.values(Ancestors0, AncestorsValues0),
     apply_variable_renaming_to_prog_constraint_list(Renaming, AncestorsKeys0,
@@ -1186,12 +1186,12 @@
     !.Constraints = constraints(Unproven0, Assumed0, Redundant0, Ancestors0),
     apply_subst_to_constraint_list(Subst, Unproven0, Unproven),
     apply_subst_to_constraint_list(Subst, Assumed0, Assumed),
-    Pred = (pred(_::in, C0::in, C::out) is det :-
+    Pred = (pred(C0::in, C::out) is det :-
         set.to_sorted_list(C0, L0),
         apply_subst_to_constraint_list(Subst, L0, L),
         set.list_to_set(L, C)
     ),
-    map.map_values(Pred, Redundant0, Redundant),
+    map.map_values_only(Pred, Redundant0, Redundant),
     map.keys(Ancestors0, AncestorsKeys0),
     map.values(Ancestors0, AncestorsValues0),
     apply_subst_to_prog_constraint_list(Subst, AncestorsKeys0,
@@ -1205,12 +1205,12 @@
     !.Constraints = constraints(Unproven0, Assumed0, Redundant0, Ancestors0),
     apply_rec_subst_to_constraint_list(Subst, Unproven0, Unproven),
     apply_rec_subst_to_constraint_list(Subst, Assumed0, Assumed),
-    Pred = (pred(_::in, C0::in, C::out) is det :-
+    Pred = (pred(C0::in, C::out) is det :-
         set.to_sorted_list(C0, L0),
         apply_rec_subst_to_constraint_list(Subst, L0, L),
         set.list_to_set(L, C)
     ),
-    map.map_values(Pred, Redundant0, Redundant),
+    map.map_values_only(Pred, Redundant0, Redundant),
     map.keys(Ancestors0, AncestorsKeys0),
     map.values(Ancestors0, AncestorsValues0),
     apply_rec_subst_to_prog_constraint_list(Subst, AncestorsKeys0,
@@ -1288,34 +1288,16 @@
 %-----------------------------------------------------------------------------%
 
 apply_variable_renaming_to_constraint_map(Renaming, !ConstraintMap) :-
-    map.map_values(apply_variable_renaming_to_constraint_map_2(Renaming),
+    map.map_values_only(apply_variable_renaming_to_prog_constraint(Renaming),
         !ConstraintMap).
 
-:- pred apply_variable_renaming_to_constraint_map_2(tvar_renaming::in,
-    constraint_id::in, prog_constraint::in, prog_constraint::out) is det.
-
-apply_variable_renaming_to_constraint_map_2(Renaming, _Key, !Value) :-
-    apply_variable_renaming_to_prog_constraint(Renaming, !Value).
-
 apply_subst_to_constraint_map(Subst, !ConstraintMap) :-
-    map.map_values(apply_subst_to_constraint_map_2(Subst), !ConstraintMap).
-
-:- pred apply_subst_to_constraint_map_2(tsubst::in, constraint_id::in,
-    prog_constraint::in, prog_constraint::out) is det.
-
-apply_subst_to_constraint_map_2(Subst, _Key, !Value) :-
-    apply_subst_to_prog_constraint(Subst, !Value).
+    map.map_values_only(apply_subst_to_prog_constraint(Subst), !ConstraintMap).
 
 apply_rec_subst_to_constraint_map(Subst, !ConstraintMap) :-
-    map.map_values(apply_rec_subst_to_constraint_map_2(Subst),
+    map.map_values_only(apply_rec_subst_to_prog_constraint(Subst),
         !ConstraintMap).
 
-:- pred apply_rec_subst_to_constraint_map_2(tsubst::in, constraint_id::in,
-    prog_constraint::in, prog_constraint::out) is det.
-
-apply_rec_subst_to_constraint_map_2(Subst, _Key, !Value) :-
-    apply_rec_subst_to_prog_constraint(Subst, !Value).
-
 %-----------------------------------------------------------------------------%
 
 :- func this_file = string.
Index: compiler/typecheck_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/typecheck_info.m,v
retrieving revision 1.28
diff -u -b -r1.28 typecheck_info.m
--- compiler/typecheck_info.m	2 Sep 2009 00:37:35 -0000	1.28
+++ compiler/typecheck_info.m	2 Sep 2009 21:26:27 -0000
@@ -1,7 +1,7 @@
 %-----------------------------------------------------------------------------%
 % vim: ft=mercury ts=4 sw=4 et
 %-----------------------------------------------------------------------------%
-% Copyright (C) 2005-2009 The University of Melbourne.
+% Copyright (C) 2005-2008 The University of Melbourne.
 % This file may only be copied under the terms of the GNU General
 % Public License - see the file COPYING in the Mercury distribution.
 %-----------------------------------------------------------------------------%
@@ -382,6 +382,7 @@
 :- import_module int.
 :- import_module pair.
 :- import_module string.
+:- import_module set.
 :- import_module svmap.
 :- import_module term.
 :- import_module varset.
@@ -429,16 +430,16 @@
         type_assign_get_constraint_proofs(TypeAssign, ConstraintProofs0),
         type_assign_get_constraint_map(TypeAssign, ConstraintMap0),
 
-        map.keys(VarTypes0, Vars),
         ( map.is_empty(TypeBindings) ->
-            VarTypes = VarTypes0,
+            VarTypes1 = VarTypes0,
             ConstraintProofs = ConstraintProofs0,
-            ConstraintMap1 = ConstraintMap0
-        ;
-            map.to_sorted_assoc_list(VarTypes0, VarTypesList0),
-            expand_types(VarTypesList0, TypeBindings, [], RevVarTypesList),
-            list.reverse(RevVarTypesList, VarTypesList),
-            map.from_sorted_assoc_list(VarTypesList, VarTypes),
+            ConstraintMap1 = ConstraintMap0,
+            map.values(VarTypes1, Types1),
+            type_vars_list(Types1, TypeVars1)
+        ;
+            map.map_foldl(expand_types(TypeBindings), VarTypes0, VarTypes1,
+                set.init, TypeVarsSet1),
+            set.to_sorted_list(TypeVarsSet1, TypeVars1),
             apply_rec_subst_to_constraint_proofs(TypeBindings,
                 ConstraintProofs0, ConstraintProofs),
             apply_rec_subst_to_constraint_map(TypeBindings,
@@ -488,77 +489,54 @@
         % (XXX should we do the same for TypeConstraints and ConstraintProofs
         % too?)
 
-        map.values(VarTypes, Types),
-        type_vars_list(Types, TypeVars0),
         map.values(OldExplicitVarTypes, ExplicitTypes),
         type_vars_list(ExplicitTypes, ExplicitTypeVars0),
         map.keys(ExistTypeRenaming, ExistQVarsToBeRenamed),
         list.delete_elems(OldExistQVars, ExistQVarsToBeRenamed,
             ExistQVarsToRemain),
         list.condense([ExistQVarsToRemain, HeadTypeParams,
-            TypeVars0, ExplicitTypeVars0], TypeVars1),
-        list.sort_and_remove_dups(TypeVars1, TypeVars),
+            TypeVars1, ExplicitTypeVars0], TypeVars2),
+        list.sort_and_remove_dups(TypeVars2, TypeVars),
 
         % Next, create a new typevarset with the same number of variables.
         varset.squash(OldTypeVarSet, TypeVars, NewTypeVarSet, TSubst),
 
-        % Finally, rename the types and type class constraints to use
-        % the new typevarset type variables.
-        apply_variable_renaming_to_type_list(TSubst, Types, NewTypes),
-        assoc_list.from_corresponding_lists(Vars, NewTypes, VarsNewTypes),
-        % Creating the NewVarTypes map from a list that map.m knows is sorted
-        % gives a speedup.
-        map.from_sorted_assoc_list(VarsNewTypes, NewVarTypes),
-        map.apply_to_list(HeadTypeParams, TSubst, NewHeadTypeParams),
+        % Finally, if necessary, rename the types and type class constraints
+        % to use the new typevarset type variables.
         retrieve_prog_constraints(HLDSTypeConstraints, TypeConstraints),
+        ( map.is_empty(TSubst) ->
+            NewVarTypes = VarTypes1,
+            NewHeadTypeParams = HeadTypeParams,
+            NewTypeConstraints = TypeConstraints,
+            NewConstraintProofs = ConstraintProofs,
+            NewConstraintMap = ConstraintMap
+        ;
+            map.map_values_only(apply_variable_renaming_to_type(TSubst),
+                VarTypes1, NewVarTypes),
+            map.apply_to_list(HeadTypeParams, TSubst, NewHeadTypeParams),
         apply_variable_renaming_to_prog_constraints(TSubst,
             TypeConstraints, NewTypeConstraints),
         apply_variable_renaming_to_constraint_proofs(TSubst,
             ConstraintProofs, NewConstraintProofs),
         apply_variable_renaming_to_constraint_map(TSubst,
             ConstraintMap, NewConstraintMap)
+        )
     ;
         TypeAssignSet = [],
         unexpected(this_file, "internal error in typecheck_info_get_vartypes")
     ).
 
     % Fully expand the types of the variables by applying the type bindings.
+    % We also accumulate the set of type variables we have seen so far,
+    % since doing so saves having to do a separate traversal for that.
     %
-    % The number of variables can be huge here (hundred of thousands for
-    % Doug Auclair's training_cars program). The code below prevents stack
-    % overflows in grades that do not permit tail recursion.
-    %
-:- pred expand_types(assoc_list(prog_var, mer_type)::in, tsubst::in,
-    assoc_list(prog_var, mer_type)::in, assoc_list(prog_var, mer_type)::out)
-    is det.
+:- pred expand_types(tsubst::in, prog_var::in, mer_type::in, mer_type::out,
+    set(tvar)::in, set(tvar)::out) is det.
 
-expand_types(VarTypes, TypeSubst, !RevVarTypes) :-
-    expand_types_2(VarTypes, TypeSubst, 1000, LeftOverVarTypes, !RevVarTypes),
-    (
-        LeftOverVarTypes = []
-    ;
-        LeftOverVarTypes = [_ | _],
-        expand_types(LeftOverVarTypes, TypeSubst, !RevVarTypes)
-    ).
-
-:- pred expand_types_2(assoc_list(prog_var, mer_type)::in, tsubst::in, int::in,
-    assoc_list(prog_var, mer_type)::out,
-    assoc_list(prog_var, mer_type)::in, assoc_list(prog_var, mer_type)::out)
-    is det.
-
-expand_types_2([], _, _, [], !VarTypes).
-expand_types_2([VarType0 | VarTypes0], TypeSubst, VarsToDo, LeftOverVarTypes,
-        !RevVarTypes) :-
-    ( VarsToDo < 0 ->
-        LeftOverVarTypes = [VarType0 | VarTypes0]
-    ;
-        VarType0 = Var - Type0,
+expand_types(TypeSubst, _Var, Type0, Type, !TypeVarsSet) :-
         apply_rec_subst_to_type(TypeSubst, Type0, Type),
-        VarType = Var - Type,
-        !:RevVarTypes = [VarType | !.RevVarTypes],
-        expand_types_2(VarTypes0, TypeSubst, VarsToDo - 1, LeftOverVarTypes,
-            !RevVarTypes)
-    ).
+    type_vars(Type, TypeVars),
+    set.insert_list(!.TypeVarsSet, TypeVars, !:TypeVarsSet).
 
     % We rename any existentially quantified type variables which get mapped
     % to other type variables, unless they are mapped to universally quantified
Index: compiler/unneeded_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/unneeded_code.m,v
retrieving revision 1.49
diff -u -b -r1.49 unneeded_code.m
--- compiler/unneeded_code.m	23 Dec 2008 01:37:42 -0000	1.49
+++ compiler/unneeded_code.m	2 Sep 2009 22:11:21 -0000
@@ -423,7 +423,7 @@
         %
         % This code requires compound goals containing impure code
         % to also be marked impure.
-        map.map_values(demand_var_everywhere, !WhereNeededMap)
+        map.map_values_only(demand_var_everywhere, !WhereNeededMap)
     ;
         true
     ).
@@ -615,10 +615,9 @@
 
 %---------------------------------------------------------------------------%
 
-:- pred demand_var_everywhere(prog_var::in, where_needed::in,
-    where_needed::out) is det.
+:- pred demand_var_everywhere(where_needed::in, where_needed::out) is det.
 
-demand_var_everywhere(_Var, _WhereNeeded0, everywhere).
+demand_var_everywhere(_WhereNeeded0, everywhere).
 
 %---------------------------------------------------------------------------%
 
@@ -681,7 +680,7 @@
         ),
         GoalPath = goal_info_get_goal_path(GoalInfo0),
         BranchPoint = branch_point(GoalPath, alt_switch(MaybeNumAlt)),
-        map.map_values(demand_var_everywhere, !WhereNeededMap),
+        map.map_values_only(demand_var_everywhere, !WhereNeededMap),
         map.init(BranchNeededMap0),
         unneeded_process_cases(Cases0, Cases, BranchPoint, 1,
             InitInstMap, FinalInstMap, VarTypes, ModuleInfo, Options, GoalPath,
@@ -695,7 +694,7 @@
     ;
         GoalExpr0 = disj(Disjuncts0),
         GoalPath = goal_info_get_goal_path(GoalInfo0),
-        map.map_values(demand_var_everywhere, !WhereNeededMap),
+        map.map_values_only(demand_var_everywhere, !WhereNeededMap),
         unneeded_process_disj(Disjuncts0, Disjuncts, InitInstMap, FinalInstMap,
             VarTypes, ModuleInfo, Options, GoalPath,
             !.WhereNeededMap, !.WhereNeededMap, !:WhereNeededMap,
@@ -706,7 +705,7 @@
         GoalExpr0 = if_then_else(Quant, Cond0, Then0, Else0),
         GoalPath = goal_info_get_goal_path(GoalInfo0),
         BranchPoint = branch_point(GoalPath, alt_ite),
-        map.map_values(demand_var_everywhere, !WhereNeededMap),
+        map.map_values_only(demand_var_everywhere, !WhereNeededMap),
         unneeded_process_ite(Cond0, Cond, Then0, Then, Else0, Else,
             BranchPoint, InitInstMap, FinalInstMap, VarTypes, ModuleInfo,
             Options, GoalPath, !WhereNeededMap, !RefinedGoals, !Changed),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/map.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/map.m,v
retrieving revision 1.116
diff -u -b -r1.116 map.m
--- library/map.m	16 Jul 2009 02:48:33 -0000	1.116
+++ library/map.m	2 Sep 2009 17:57:30 -0000
@@ -426,6 +426,13 @@
 :- mode map.map_values(pred(in, in, out) is det, in, out) is det.
 :- mode map.map_values(pred(in, in, out) is semidet, in, out) is semidet.
 
+    % Same as map.map_values, but do not pass the key to the given predicate.
+    %
+:- func map.map_values_only(func(V) = W, map(K, V)) = map(K, W).
+:- pred map.map_values_only(pred(V, W), map(K, V), map(K, W)).
+:- mode map.map_values_only(pred(in, out) is det, in, out) is det.
+:- mode map.map_values_only(pred(in, out) is semidet, in, out) is semidet.
+
     % Apply a transformation predicate to all the values in a map,
     % while continuously updating an accumulator.
     %
@@ -909,6 +916,9 @@
 map.map_values(Pred, Map0, Map) :-
     tree234.map_values(Pred, Map0, Map).
 
+map.map_values_only(Pred, Map0, Map) :-
+    tree234.map_values_only(Pred, Map0, Map).
+
 map.map_foldl(Pred, !Map, !Acc) :-
     tree234.map_foldl(Pred, !Map, !Acc).
 
@@ -1172,6 +1182,10 @@
     P = (pred(X::in, Y::in, Z::out) is det :- Z = F(X, Y) ),
     map.map_values(P, M1, M2).
 
+map.map_values_only(F, M1) = M2 :-
+    P = (pred(Y::in, Z::out) is det :- Z = F(Y) ),
+    map.map_values_only(P, M1, M2).
+
 map.intersect(F, M1, M2) = M3 :-
     P = (pred(X::in, Y::in, Z::out) is det :- Z = F(X, Y) ),
     map.intersect(P, M1, M2, M3).
Index: library/tree234.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/tree234.m,v
retrieving revision 1.65
diff -u -b -r1.65 tree234.m
--- library/tree234.m	16 Feb 2009 03:27:19 -0000	1.65
+++ library/tree234.m	2 Sep 2009 17:57:43 -0000
@@ -254,6 +254,12 @@
 :- mode tree234.map_values(pred(in, in, out) is det, in, out) is det.
 :- mode tree234.map_values(pred(in, in, out) is semidet, in, out) is semidet.
 
+:- func tree234.map_values_only(func(V) = W, tree234(K, V)) = tree234(K, W).
+
+:- pred tree234.map_values_only(pred(V, W), tree234(K, V), tree234(K, W)).
+:- mode tree234.map_values_only(pred(in, out) is det, in, out) is det.
+:- mode tree234.map_values_only(pred(in, out) is semidet, in, out) is semidet.
+
 :- pred tree234.map_foldl(pred(K, V, W, A, A), tree234(K, V), tree234(K, W),
     A, A).
 :- mode tree234.map_foldl(pred(in, in, out, di, uo) is det,
@@ -2732,6 +2738,32 @@
     tree234.map_values(Pred, Right0, Right),
     Tree = four(K0, W0, K1, W1, K2, W2, Left, LMid, RMid, Right).
 
+tree234.map_values_only(_Pred, empty, empty).
+tree234.map_values_only(Pred, Tree0, Tree) :-
+    Tree0 = two(K0, V0, Left0, Right0),
+    Pred(V0, W0),
+    tree234.map_values_only(Pred, Left0, Left),
+    tree234.map_values_only(Pred, Right0, Right),
+    Tree = two(K0, W0, Left, Right).
+tree234.map_values_only(Pred, Tree0, Tree) :-
+    Tree0 = three(K0, V0, K1, V1, Left0, Middle0, Right0),
+    Pred(V0, W0),
+    Pred(V1, W1),
+    tree234.map_values_only(Pred, Left0, Left),
+    tree234.map_values_only(Pred, Middle0, Middle),
+    tree234.map_values_only(Pred, Right0, Right),
+    Tree = three(K0, W0, K1, W1, Left, Middle, Right).
+tree234.map_values_only(Pred, Tree0, Tree) :-
+    Tree0 = four(K0, V0, K1, V1, K2, V2, Left0, LMid0, RMid0, Right0),
+    Pred(V0, W0),
+    Pred(V1, W1),
+    Pred(V2, W2),
+    tree234.map_values_only(Pred, Left0, Left),
+    tree234.map_values_only(Pred, LMid0, LMid),
+    tree234.map_values_only(Pred, RMid0, RMid),
+    tree234.map_values_only(Pred, Right0, Right),
+    Tree = four(K0, W0, K1, W1, K2, W2, Left, LMid, RMid, Right).
+
 %------------------------------------------------------------------------------%
 
 tree234.map_foldl(_Pred, empty, empty, !A).
@@ -2849,6 +2881,10 @@
     P = (pred(X::in, Y::in, Z::out) is det :- Z = F(X, Y) ),
     tree234.map_values(P, T1, T2).
 
+tree234.map_values_only(F, T1) = T2 :-
+    P = (pred(Y::in, Z::out) is det :- Z = F(Y) ),
+    tree234.map_values_only(P, T1, T2).
+
 %-----------------------------------------------------------------------------%
 
     % The default pretty_printer formatting for key_value_pair will do what
Index: library/varset.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/varset.m,v
retrieving revision 1.82
diff -u -b -r1.82 varset.m
--- library/varset.m	28 Sep 2007 03:17:19 -0000	1.82
+++ library/varset.m	2 Sep 2009 22:24:54 -0000
@@ -459,21 +459,18 @@
 
 %-----------------------------------------------------------------------------%
 
-    % We scan through the second varset, introducing a fresh
-    % variable into the first varset for each var in the
-    % second, and building up a substitution which maps
-    % the variables in the second varset into the corresponding
-    % fresh variable in the first varset.  We then apply
+    % We scan through the second varset, introducing a fresh variable
+    % into the first varset for each var in the second, and building up
+    % a substitution which maps the variables in the second varset into
+    % the corresponding fresh variable in the first varset. We then apply
     % this substitution to the list of terms.
 
 varset.merge(VarSetA, VarSetB, TermList0, VarSet, TermList) :-
-    IncludeNames = yes,
-    varset.merge_subst_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst),
+    varset.merge_subst(VarSetA, VarSetB, VarSet, Subst),
     term.apply_substitution_to_list(TermList0, Subst, TermList).
 
 varset.merge_without_names(VarSetA, VarSetB, TermList0, VarSet, TermList) :-
-    IncludeNames = no,
-    varset.merge_subst_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst),
+    varset.merge_subst_without_names(VarSetA, VarSetB, VarSet, Subst),
     term.apply_substitution_to_list(TermList0, Subst, TermList).
 
 %-----------------------------------------------------------------------------%
@@ -482,46 +479,59 @@
 % in the next block.
 
 varset.merge_renaming(VarSetA, VarSetB, VarSet, Subst) :-
-    IncludeNames = yes,
-    varset.merge_renaming_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst).
-
-varset.merge_renaming_without_names(VarSetA, VarSetB, VarSet, Subst) :-
-    IncludeNames = no,
-    varset.merge_renaming_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst).
-
-:- pred varset.merge_renaming_inc(bool::in, varset(T)::in, varset(T)::in,
-    varset(T)::out, map(var(T), var(T))::out) is det.
-
-varset.merge_renaming_inc(IncludeNames, VarSetA, VarSetB, VarSet, Renaming) :-
-    VarSetB = varset(MaxId, Names, Values),
-    term.init_var_supply(N),
-    map.init(Renaming0),
-    varset.merge_renaming_inc_2(IncludeNames, N, MaxId, Names, Values,
-        VarSetA, VarSet, Renaming0, Renaming).
-
-:- pred varset.merge_renaming_inc_2(bool::in, var_supply(T)::in,
-    var_supply(T)::in, map(var(T), string)::in,
-    map(var(T), term(T))::in, varset(T)::in, varset(T)::out,
+    VarSetB = varset(SupplyB, NamesB, _ValuesB),
+    term.init_var_supply(SupplyB0),
+    VarSetA = varset(SupplyA, NamesA, ValuesA),
+    map.init(Subst0),
+    varset.merge_renaming_2(SupplyB0, SupplyB, NamesB,
+        SupplyA, Supply, NamesA, Names, Subst0, Subst),
+    VarSet = varset(Supply, Names, ValuesA).
+
+:- pred varset.merge_renaming_2(var_supply(T)::in, var_supply(T)::in,
+    map(var(T), string)::in,
+    var_supply(T)::in, var_supply(T)::out,
+    map(var(T), string)::in, map(var(T), string)::out,
     map(var(T), var(T))::in, map(var(T), var(T))::out) is det.
 
-varset.merge_renaming_inc_2(IncludeNames, N, Max, Names, Values, !VarSet,
-        !Renaming) :-
-    ( N = Max ->
+varset.merge_renaming_2(!.SupplyB, MaxSupplyB, NamesB,
+        !Supply, !Names, !Subst) :-
+    ( !.SupplyB = MaxSupplyB ->
         true
     ;
-        varset.new_var(!.VarSet, VarId, !:VarSet),
-        term.create_var(N, VarN, N1),
-        (
-            IncludeNames = yes,
-            map.search(Names, VarN, Name)
-        ->
-            varset.name_var(!.VarSet, VarId, Name, !:VarSet)
+        term.create_var(!.Supply, Var, !:Supply),
+        term.create_var(!.SupplyB, VarB, !:SupplyB),
+        ( map.search(NamesB, VarB, NameB) ->
+            map.det_insert(!.Names, Var, NameB, !:Names)
         ;
             true
         ),
-        map.set(!.Renaming, VarN, VarId, !:Renaming),
-        varset.merge_renaming_inc_2(IncludeNames, N1, Max, Names, Values,
-            !VarSet, !Renaming)
+        map.det_insert(!.Subst, VarB, Var, !:Subst),
+        varset.merge_renaming_2(!.SupplyB, MaxSupplyB, NamesB,
+            !Supply, !Names, !Subst)
+    ).
+
+varset.merge_renaming_without_names(VarSetA, VarSetB, VarSet, Subst) :-
+    VarSetB = varset(SupplyB, _NamesB, _ValuesB),
+    term.init_var_supply(SupplyB0),
+    VarSetA = varset(SupplyA, NamesA, ValuesA),
+    map.init(Subst0),
+    varset.merge_renaming_without_names_2(SupplyB0, SupplyB,
+        SupplyA, Supply, Subst0, Subst),
+    VarSet = varset(Supply, NamesA, ValuesA).
+
+:- pred varset.merge_renaming_without_names_2(var_supply(T)::in,
+    var_supply(T)::in, var_supply(T)::in, var_supply(T)::out,
+    map(var(T), var(T))::in, map(var(T), var(T))::out) is det.
+
+varset.merge_renaming_without_names_2(!.SupplyB, MaxSupplyB, !Supply, !Subst) :-
+    ( !.SupplyB = MaxSupplyB ->
+        true
+    ;
+        term.create_var(!.Supply, Var, !:Supply),
+        term.create_var(!.SupplyB, VarB, !:SupplyB),
+        map.det_insert(!.Subst, VarB, Var, !:Subst),
+        varset.merge_renaming_without_names_2(!.SupplyB, MaxSupplyB,
+            !Supply, !Subst)
     ).
 
 %-----------------------------------------------------------------------------%
@@ -530,46 +540,61 @@
 % in the previous block.
 
 varset.merge_subst(VarSetA, VarSetB, VarSet, Subst) :-
-    IncludeNames = yes,
-    varset.merge_subst_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst).
-
-varset.merge_subst_without_names(VarSetA, VarSetB, VarSet, Subst) :-
-    IncludeNames = no,
-    varset.merge_subst_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst).
-
-:- pred varset.merge_subst_inc(bool::in, varset(T)::in, varset(T)::in,
-    varset(T)::out, substitution(T)::out) is det.
-
-varset.merge_subst_inc(IncludeNames, VarSetA, VarSetB, VarSet, Subst) :-
-    VarSetB = varset(MaxId, Names, Values),
-    term.init_var_supply(N),
+    VarSetB = varset(SupplyB, NamesB, _ValuesB),
+    term.init_var_supply(SupplyB0),
+    VarSetA = varset(SupplyA, NamesA, ValuesA),
     map.init(Subst0),
-    varset.merge_subst_inc_2(IncludeNames, N, MaxId, Names, Values,
-        VarSetA, VarSet, Subst0, Subst).
-
-:- pred varset.merge_subst_inc_2(bool::in, var_supply(T)::in,
-    var_supply(T)::in, map(var(T), string)::in,
-    map(var(T), term(T))::in, varset(T)::in, varset(T)::out,
+    varset.merge_subst_2(SupplyB0, SupplyB, NamesB,
+        SupplyA, Supply, NamesA, Names, Subst0, Subst),
+    VarSet = varset(Supply, Names, ValuesA).
+
+:- pred varset.merge_subst_2(var_supply(T)::in, var_supply(T)::in,
+    map(var(T), string)::in,
+    var_supply(T)::in, var_supply(T)::out,
+    map(var(T), string)::in, map(var(T), string)::out,
     substitution(T)::in, substitution(T)::out) is det.
 
-varset.merge_subst_inc_2(IncludeNames, N, Max, Names, Values, !VarSet,
-        !Subst) :-
-    ( N = Max ->
+varset.merge_subst_2(!.SupplyB, MaxSupplyB, NamesB,
+        !Supply, !Names, !Subst) :-
+    ( !.SupplyB = MaxSupplyB ->
         true
     ;
-        varset.new_var(!.VarSet, VarId, !:VarSet),
-        term.create_var(N, VarN, N1),
-        (
-            IncludeNames = yes,
-            map.search(Names, VarN, Name)
-        ->
-            varset.name_var(!.VarSet, VarId, Name, !:VarSet)
+        term.create_var(!.Supply, Var, !:Supply),
+        term.create_var(!.SupplyB, VarB, !:SupplyB),
+        ( map.search(NamesB, VarB, NameB) ->
+            map.det_insert(!.Names, Var, NameB, !:Names)
         ;
             true
         ),
-        map.set(!.Subst, VarN, term.variable(VarId, context_init), !:Subst),
-        varset.merge_subst_inc_2(IncludeNames, N1, Max, Names, Values,
-            !VarSet, !Subst)
+        Replacement = term.variable(Var, context_init),
+        map.det_insert(!.Subst, VarB, Replacement, !:Subst),
+        varset.merge_subst_2(!.SupplyB, MaxSupplyB, NamesB,
+            !Supply, !Names, !Subst)
+    ).
+
+varset.merge_subst_without_names(VarSetA, VarSetB, VarSet, Subst) :-
+    VarSetB = varset(SupplyB, _NamesB, _ValuesB),
+    term.init_var_supply(SupplyB0),
+    VarSetA = varset(SupplyA, NamesA, ValuesA),
+    map.init(Subst0),
+    varset.merge_subst_without_names_2(SupplyB0, SupplyB,
+        SupplyA, Supply, Subst0, Subst),
+    VarSet = varset(Supply, NamesA, ValuesA).
+
+:- pred varset.merge_subst_without_names_2( var_supply(T)::in,
+    var_supply(T)::in, var_supply(T)::in, var_supply(T)::out,
+    substitution(T)::in, substitution(T)::out) is det.
+
+varset.merge_subst_without_names_2(!.SupplyB, MaxSupplyB, !Supply, !Subst) :-
+    ( !.SupplyB = MaxSupplyB ->
+        true
+    ;
+        term.create_var(!.Supply, Var, !:Supply),
+        term.create_var(!.SupplyB, VarB, !:SupplyB),
+        Replacement = term.variable(Var, context_init),
+        map.det_insert(!.Subst, VarB, Replacement, !:Subst),
+        varset.merge_subst_without_names_2(!.SupplyB, MaxSupplyB,
+            !Supply, !Subst)
     ).
 
 %-----------------------------------------------------------------------------%
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list