diff: bug fix for polymorphism.m

[David Glen JEFFERY]

Hi Fergus,

Can you please review this?

------------------------------------------------------------------------------

Estimated hours taken: 8

Fix two bugs in polymorphism.m (one of which didn't show up until the other
was fixed). The test case for this fix is 
tests/hard_coded/typeclasses/existential_type_class.m.

compiler/polymorphism.m:
	Don't map__det_insert existential typeclass_infos into the type class
	info map as they may already be there. (eg. when it is in two 
	variables which get unified).

	Only add instmap_deltas for type info variables if the type info
	has its own variable. ie. it isn't inside a typeclass info.

------------------------------------------------------------------------------

Index: polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.151
diff -u -t -r1.151 polymorphism.m
--- polymorphism.m	1998/10/03 04:36:49	1.151
+++ polymorphism.m	1998/10/14 06:25:55
@@ -1433,10 +1433,17 @@
                 goal_info_get_instmap_delta(GoalInfo1, InstmapDelta0),
                 AddInstDelta = lambda([TVar::in, IMD0::in, IMD::out] is det, (
                         map__lookup(TypeVarMap, TVar, TypeInfoLocn),
-                        type_info_locn_var(TypeInfoLocn, TypeInfoVar),
-                        instmap_delta_set(IMD0, TypeInfoVar,
-                                ground(shared, no), IMD)
-                        )),
+                        (
+                                TypeInfoLocn = type_info(TypeInfoVar),
+                                instmap_delta_set(IMD0, TypeInfoVar,
+                                        ground(shared, no), IMD)
+                        ;
+                                TypeInfoLocn = typeclass_info(_, _),
+                                % the instmap delta for the type class info
+                                % variable will be added by AddTCInstDelta
+                                % (below)
+                                IMD = IMD0
+                        ))),
                 AddTCInstDelta = lambda([Constraint::in, IMD0::in, IMD::out]
                                         is det, (
                         map__lookup(TypeClassVarMap, Constraint,
@@ -1457,9 +1464,24 @@
 
 polymorphism__update_typeclass_infos(Constraints, Vars, Info0, Info) :-
         poly_info_get_typeclass_info_map(Info0, TypeClassInfoMap0),
-        map__det_insert_from_corresponding_lists(TypeClassInfoMap0,
-                Constraints, Vars, TypeClassInfoMap),
+        insert_typeclass_info_locns( Constraints, Vars, TypeClassInfoMap0, 
+                TypeClassInfoMap),
         poly_info_set_typeclass_info_map(TypeClassInfoMap, Info0, Info).
+
+:- pred insert_typeclass_info_locns(list(class_constraint), list(var), 
+        map(class_constraint, var), map(class_constraint, var)).
+:- mode insert_typeclass_info_locns(in, in, in, out) is det.
+
+insert_typeclass_info_locns([], [], TypeClassInfoMap, TypeClassInfoMap).
+insert_typeclass_info_locns([C|Cs], [V|Vs], TypeClassInfoMap0, 
+                TypeClassInfoMap) :-
+        map__set(TypeClassInfoMap0, C, V, TypeClassInfoMap1),
+        insert_typeclass_info_locns(Cs, Vs, 
+        TypeClassInfoMap1, TypeClassInfoMap).
+insert_typeclass_info_locns([], [_|_], _, _) :-
+        error("polymorphism:insert_typeclass_info_locns").
+insert_typeclass_info_locns([_|_], [], _, _) :-
+        error("polymorphism:insert_typeclass_info_locns").
 
 %-----------------------------------------------------------------------------%
 
------------------------------------------------------------------------------


dgj
-- 
David Jeffery (dgj at cs.mu.oz.au) |  Marge: Did you just call everyone "chicken"?
PhD student,                    |  Homer: Noooo.  I swear on this Bible!
Department of Computer Science  |  Marge: That's not a Bible; that's a book of
University of Melbourne         |         carpet samples!
Australia                       |  Homer: Ooooh... Fuzzy.