[m-rev.] diff: typeclasses.m memory problems

[Mark Brown]

compiler/hlds_data.m:
	Change the map value type of redundant_constraints from a list to
	a set.  The lists can in some cases contain many duplicates, and
	this can lead to serious memory problems during typechecking.

	With the zm_eq20.m test case from G12, the number of garbage
	collections during typechecking goes from 595 down to just 1.

compiler/*.m:
	Updates corresponding to the above.

Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.125
diff -u -r1.125 hlds_data.m
--- compiler/hlds_data.m	11 Jun 2009 07:00:09 -0000	1.125
+++ compiler/hlds_data.m	26 Aug 2009 15:02:23 -0000
@@ -26,7 +26,6 @@
 :- import_module bool.
 :- import_module list.
 :- import_module map.
-:- import_module multi_map.
 :- import_module maybe.
 :- import_module pair.
 :- import_module set.
@@ -40,8 +39,8 @@
 
 :- import_module cord.
 :- import_module int.
+:- import_module multi_map.
 :- import_module svmap.
-:- import_module svmulti_map.
 :- import_module varset.
 
 %-----------------------------------------------------------------------------%
@@ -1015,7 +1014,7 @@
     % Redundant constraints are partitioned by class, which helps us
     % process them more efficiently.
     %
-:- type redundant_constraints == multi_map(class_id, hlds_constraint).
+:- type redundant_constraints == map(class_id, set(hlds_constraint)).
 
     % Constraints which are ancestors of assumed constraints, along with the
     % list of constraints (following the class hierarchy) which leads to
@@ -1124,7 +1123,7 @@
 :- implementation.
 
 empty_hlds_constraints(Constraints) :-
-    Constraints = constraints([], [], multi_map.init, map.init).
+    Constraints = constraints([], [], map.init, map.init).
 
 init_hlds_constraint_list(ProgConstraints, Constraints) :-
     list.map(init_hlds_constraint, ProgConstraints, Constraints).
@@ -1156,7 +1155,7 @@
 
 make_hlds_constraints(ClassTable, TVarSet, Unproven, Assumed, Constraints) :-
     list.foldl(update_redundant_constraints_2(ClassTable, TVarSet),
-        Unproven, multi_map.init, Redundant0),
+        Unproven, map.init, Redundant0),
     list.foldl(update_redundant_constraints_2(ClassTable, TVarSet),
         Assumed, Redundant0, Redundant),
     list.foldl(update_ancestor_constraints(ClassTable, TVarSet),
@@ -1186,7 +1185,7 @@
     ConstraintsB = constraints(UnprovenB, AssumedB, RedundantB, AncestorsB),
     list.append(UnprovenA, UnprovenB, Unproven),
     list.append(AssumedA, AssumedB, Assumed),
-    multi_map.merge(RedundantA, RedundantB, Redundant),
+    map.union(set.union, RedundantA, RedundantB, Redundant),
     map.union(shortest_list, AncestorsA, AncestorsB, Ancestors),
     Constraints = constraints(Unproven, Assumed, Redundant, Ancestors).
 
@@ -1289,7 +1288,12 @@
     Constraint = constraint(_, Name, Args),
     list.length(Args, Arity),
     ClassId = class_id(Name, Arity),
-    svmulti_map.add(ClassId, Constraint, !Redundant).
+    ( map.search(!.Redundant, ClassId, Constraints0) ->
+        set.insert(Constraints0, Constraint, Constraints)
+    ;
+        Constraints = set.make_singleton_set(Constraint)
+    ),
+    svmap.set(ClassId, Constraints, !Redundant).
 
 lookup_hlds_constraint_list(ConstraintMap, ConstraintType, GoalPath, Count,
         Constraints) :-
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.197
diff -u -r1.197 type_util.m
--- compiler/type_util.m	11 Jun 2009 07:00:21 -0000	1.197
+++ compiler/type_util.m	26 Aug 2009 15:02:23 -0000
@@ -1168,7 +1168,9 @@
     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 :-
-        apply_variable_renaming_to_constraint_list(Renaming, C0, C)
+        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.keys(Ancestors0, AncestorsKeys0),
@@ -1185,7 +1187,9 @@
     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 :-
-        apply_subst_to_constraint_list(Subst, C0, C)
+        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.keys(Ancestors0, AncestorsKeys0),
@@ -1202,7 +1206,9 @@
     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 :-
-        apply_rec_subst_to_constraint_list(Subst, C0, C)
+        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.keys(Ancestors0, AncestorsKeys0),
Index: compiler/typeclasses.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typeclasses.m,v
retrieving revision 1.24
diff -u -r1.24 typeclasses.m
--- compiler/typeclasses.m	19 Aug 2009 02:53:51 -0000	1.24
+++ compiler/typeclasses.m	26 Aug 2009 15:02:23 -0000
@@ -283,7 +283,7 @@
 do_class_improvement(ClassTable, HeadTypeParams, Constraints, !Bindings,
         Changed) :-
     Redundant = Constraints ^ redundant,
-    multi_map.keys(Redundant, ClassIds),
+    map.keys(Redundant, ClassIds),
     list.foldl2(
         do_class_improvement_2(ClassTable, HeadTypeParams, Redundant),
         ClassIds, !Bindings, no, Changed).
@@ -296,8 +296,9 @@
         ClassId, !Bindings, !Changed) :-
     map.lookup(ClassTable, ClassId, ClassDefn),
     FunDeps = ClassDefn ^ class_fundeps,
-    map.lookup(RedundantConstraints, ClassId, Constraints),
-    do_class_improvement_by_pairs(Constraints, FunDeps, HeadTypeParams,
+    map.lookup(RedundantConstraints, ClassId, ConstraintSet),
+    set.to_sorted_list(ConstraintSet, ConstraintList),
+    do_class_improvement_by_pairs(ConstraintList, FunDeps, HeadTypeParams,
         !Bindings, !Changed).
 
 :- pred has_class_id(class_id::in, hlds_constraint::in) is semidet.
@@ -396,9 +397,10 @@
     map.lookup(ClassTable, ClassId, ClassDefn),
     FunDeps = ClassDefn ^ class_fundeps,
     map.lookup(InstanceTable, ClassId, InstanceDefns),
-    map.lookup(RedundantConstraints, ClassId, Constraints),
+    map.lookup(RedundantConstraints, ClassId, ConstraintSet),
+    set.to_sorted_list(ConstraintSet, ConstraintList),
     list.foldl3(
-        do_instance_improvement_3(Constraints, FunDeps, HeadTypeParams),
+        do_instance_improvement_3(ConstraintList, FunDeps, HeadTypeParams),
         InstanceDefns, !TVarSet, !Bindings, !Changed).
 
 :- pred do_instance_improvement_3(list(hlds_constraint)::in,
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------