diff: tvar renaming bug fix

David Glen JEFFERY dgj at cs.mu.OZ.AU
Thu Sep 10 17:42:09 AEST 1998


Hi,

Could you please review this, Fergus?

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

Estimated hours taken: 20

Fix a bug in the renaming of tvars in type class constraint proofs, and
generally clean up the handling of variable renaming in polymorphism.m.

Change the representation of constraint_proofs to only hold the number of
an instance declaration and not the hlds_instance_defn itself. This means that
polymorphism must look up the instance table to get at hlds_instance_defn,
then calculate the appropriate renamings and substitutions. The rationale
behind this is that the proofs for the superclasses, stored in the
hlds_instance_defn, also need to be renamed. However, we can't just rename them
during typecheck.m because they may not contain proofs for *all* their 
ancestors --- that would require topologically sorting the instance defns
before check_typeclass.m.

Also delete the code which attempts to specialise class method calls because
Simon's recent change does this anyway.

hlds_data.m:
	Change the constraint_proof representation to only hold instance
	numbers, not definitions.
polymorphism.m:
	When applying an instance decl, look it up in the instance table
	rather than trying to use the half-renamed one in the proof.

	Also, rather than trying to pass down a renaming substution into
	polymorphism__make_typeclass_info_var, rename everything before calling
	it.
type_util.m:
	Add two new predicates: apply_subst_to_constraint_proofs and
	apply_rec_subst_to_constraint_proofs.
typecheck.m:
	Only store the instance number in the proof.

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

Index: compiler/hlds_data.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_data.m,v
retrieving revision 1.25
diff -u -t -r1.25 hlds_data.m
--- hlds_data.m	1998/07/08 20:56:10	1.25
+++ hlds_data.m	1998/09/10 06:54:25
@@ -751,9 +751,20 @@
 
         % `Proof' of why a constraint is redundant
 :- type constraint_proof                        
-                        % Apply the following instance rule, the second 
-                        % argument being the number of the instance decl.
-        --->    apply_instance(hlds_instance_defn, int)
+                        % Apply the instance decl with the given number.
+                        % Note that we don't store the actual 
+                        % hlds_instance_defn for two reasons:
+                        % - That would require storing a renamed version of
+                        %   the constraint_proofs for *every* use of an instance
+                        %   declaration. This would't even get GCed for a long
+                        %   time because it would be stored in the pred_info.
+                        % - The superclass proofs stored in the
+                        %   hlds_instance_defn would need to store
+                        %   all the constraint_proofs for all its ancestors.
+                        %   This would require the class relation to be
+                        %   topologically sorted before checking the instance
+                        %   declarations.
+        --->    apply_instance(int)
 
                         % The constraint is redundant because of the following
                         % class's superclass declaration
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_out.m,v
retrieving revision 1.199
diff -u -t -r1.199 hlds_out.m
--- hlds_out.m	1998/08/05 08:45:54	1.199
+++ hlds_out.m	1998/09/10 06:43:49
@@ -2467,7 +2467,7 @@
         mercury_output_constraint(VarSet, Constraint),
         io__write_string(": "),
         (
-                { Proof = apply_instance(_, Num) },
+                { Proof = apply_instance(Num) },
                 io__write_string("apply instance decl #"),
                 io__write_int(Num)
         ;
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/polymorphism.m,v
retrieving revision 1.147
diff -u -t -r1.147 polymorphism.m
--- polymorphism.m	1998/08/26 04:38:16	1.147
+++ polymorphism.m	1998/09/10 06:34:10
@@ -728,12 +728,11 @@
         % generate code to produce values for any existentially quantified
         % typeclass-info variables in the head
         %
-        map__init(Subst),
         ExistQVarsForCall = [],
         Goal0 = _ - GoalInfo,
         goal_info_get_context(GoalInfo, Context),
         polymorphism__make_typeclass_info_vars( 
-                ExistConstraints, Subst, TypeSubst, ExistQVarsForCall, Context,
+                ExistConstraints, TypeSubst, ExistQVarsForCall, Context,
                 hlds_class_proc(PredId, ProcId),
                 hlds_class_proc(NewPredId, NewProcId),
                 ExistTypeClassVars, ExtraTypeClassGoals,
@@ -1301,7 +1300,7 @@
                 PredClassContext1 = constraints(UniversalConstraints1,
                                 ExistentialConstraints1),
                 polymorphism__make_typeclass_info_vars( 
-                        UniversalConstraints1, Subst, TypeSubst,
+                        UniversalConstraints1, TypeSubst,
                         PredExistQVars, Context,
                         hlds_class_proc(PredId0, ProcId0),
                         hlds_class_proc(PredId, ProcId),
@@ -1547,14 +1546,14 @@
 % Otherwise we return the original pred_proc_id unchanged.
 
 :- pred polymorphism__make_typeclass_info_vars(list(class_constraint),
-        substitution, tsubst, existq_tvars, term__context,
+        tsubst, existq_tvars, term__context,
         hlds_class_proc, hlds_class_proc,
         list(var), list(hlds_goal), list(tvar),
         poly_info, poly_info).
-:- mode polymorphism__make_typeclass_info_vars(in, in, in, in, in, in, out,
+:- mode polymorphism__make_typeclass_info_vars(in, in, in, in, in, out,
         out, out, out, in, out) is det.
 
-polymorphism__make_typeclass_info_vars(PredClassContext, Subst, TypeSubst, 
+polymorphism__make_typeclass_info_vars(PredClassContext, TypeSubst, 
                 ExistQVars, Context, PredProcId0, PredProcId,
                 ExtraVars, ExtraGoals, ConstrainedTVars, Info0, Info) :-
 
@@ -1572,7 +1571,7 @@
 
                 % do the work
         polymorphism__make_typeclass_info_vars_2(PredClassContext, 
-                Subst, TypeSubst, ExistQVars, Context,
+                TypeSubst, ExistQVars, Context,
                 MaybePredProcId0, MaybePredProcId,
                 ExtraVars0, ExtraVars1, 
                 ExtraGoals0, ExtraGoals1,
@@ -1593,35 +1592,35 @@
 
 % Accumulator version of the above.
 :- pred polymorphism__make_typeclass_info_vars_2(
-        list(class_constraint), substitution, tsubst,
+        list(class_constraint), tsubst,
         existq_tvars, term__context,
         maybe(hlds_class_proc), maybe(hlds_class_proc),
         list(var), list(var), 
         list(hlds_goal), list(hlds_goal), 
         list(var), list(var),
         poly_info, poly_info).
-:- mode polymorphism__make_typeclass_info_vars_2(in, in, in, in, in,
+:- mode polymorphism__make_typeclass_info_vars_2(in, in, in, in,
         in, out, in, out, in, out, in, out, in, out) is det.
 
-polymorphism__make_typeclass_info_vars_2([], _Subst, _TypeSubst, _ExistQVars,
+polymorphism__make_typeclass_info_vars_2([], _TypeSubst, _ExistQVars,
                 _Context, MaybePredProcId, MaybePredProcId,
                 ExtraVars, ExtraVars, 
                 ExtraGoals, ExtraGoals, 
                 ConstrainedTVars, ConstrainedTVars,
                 Info, Info).
-polymorphism__make_typeclass_info_vars_2([C|Cs], Subst, TypeSubst, ExistQVars,
+polymorphism__make_typeclass_info_vars_2([C|Cs], TypeSubst, ExistQVars,
                 Context, MaybePredProcId0, MaybePredProcId,
                 ExtraVars0, ExtraVars,
                 ExtraGoals0, ExtraGoals, 
                 ConstrainedTVars0, ConstrainedTVars,
                 Info0, Info) :-
-        polymorphism__make_typeclass_info_var(C, Subst, TypeSubst, ExistQVars,
+        polymorphism__make_typeclass_info_var(C, TypeSubst, ExistQVars,
                         Context, MaybePredProcId0, MaybePredProcId,
                         ExtraGoals0, ExtraGoals1, 
                         ConstrainedTVars0, ConstrainedTVars1,
                         Info0, Info1, MaybeExtraVar),
         maybe_insert_var(MaybeExtraVar, ExtraVars0, ExtraVars1),
-        polymorphism__make_typeclass_info_vars_2(Cs, Subst, TypeSubst,
+        polymorphism__make_typeclass_info_vars_2(Cs, TypeSubst,
                         ExistQVars, Context, no, _,
                         ExtraVars1, ExtraVars,
                         ExtraGoals1, ExtraGoals, 
@@ -1629,15 +1628,17 @@
                         Info1, Info).
 
 :- pred polymorphism__make_typeclass_info_var(class_constraint,
-        substitution, tsubst, existq_tvars, term__context,
+        tsubst, existq_tvars, term__context,
         maybe(hlds_class_proc), maybe(hlds_class_proc),
         list(hlds_goal), list(hlds_goal), list(var), list(var),
         poly_info, poly_info, maybe(var)). 
-:- mode polymorphism__make_typeclass_info_var(in, in, in, in, in, in, out,
+:- mode polymorphism__make_typeclass_info_var(in, in, in, in, in, out,
         in, out, in, out, in, out, out) is det.
 
-polymorphism__make_typeclass_info_var(Constraint, Subst, TypeSubst, ExistQVars,
-                Context, MaybePredProcId0, MaybePredProcId,
+        % XXX the MaybePredProcId args can be deleted now that we aren't going
+        % to do specialisation here.
+polymorphism__make_typeclass_info_var(Constraint, TypeSubst, ExistQVars,
+                Context, _MaybePredProcId0, MaybePredProcId,
                 ExtraGoals0, ExtraGoals, ConstrainedTVars0, ConstrainedTVars, 
                 Info0, Info, MaybeVar) :-
         Constraint = constraint(ClassName, NewConstrainedTypes),
@@ -1645,14 +1646,14 @@
         ClassId = class_id(ClassName, ClassArity),
         term__vars_list(NewConstrainedTypes, NewConstrainedTVars),
         list__append(NewConstrainedTVars, ConstrainedTVars0, ConstrainedTVars),
-        term__apply_substitution_to_list(NewConstrainedTypes, TypeSubst, 
+        term__apply_rec_substitution_to_list(NewConstrainedTypes, TypeSubst, 
                 ConstrainedTypes0),
         % we need to maintain the invariant that types in class constraints
         % do not contain any information in their term__context fields
         strip_term_contexts(ConstrainedTypes0, ConstrainedTypes),
         NewC = constraint(ClassName, ConstrainedTypes),
 
-        Info0 = poly_info(VarSet0, VarTypes0, TypeVarSet0, TypeInfoMap0, 
+        Info0 = poly_info(VarSet0, VarTypes0, TypeVarSet, TypeInfoMap0, 
                 TypeClassInfoMap0, Proofs, PredName, ModuleInfo),
 
         (
@@ -1674,128 +1675,84 @@
                 (
                                 % We have to construct the typeclass_info
                                 % using an instance declaration
-                        Proof = apply_instance(ProofInstanceDefn, InstanceNum),
+                        Proof = apply_instance(InstanceNum),
+
+                        module_info_instances(ModuleInfo, InstanceTable),
+                        map__lookup(InstanceTable, ClassId, InstanceList),
+                        list__index1_det(InstanceList, InstanceNum,
+                                ProofInstanceDefn),
 
-                                % The subst has already been applied to these
-                                % constraints in typecheck.m
                         ProofInstanceDefn = hlds_instance_defn(_,
-                                InstanceConstraints, _, _, _, _, _),
+                                InstanceConstraints0, InstanceTypes0, _, _, 
+                                InstanceTVarset, SuperClassProofs0),
 
-                        %
-                        % Check whether the callee is a class method,
-                        % and that this contraint is the first constraint
-                        % in that callee's constraint list (the one for
-                        % its own type class).
-                        % If so, specialize the call by replacing the
-                        % generic class method call with a direct call
-                        % to the class method for this instance.
-                        %
+                        varset__merge_subst(TypeVarSet, InstanceTVarset,
+                                NewTVarset, RenameSubst),
+                        term__apply_substitution_to_list(InstanceTypes0,
+                                RenameSubst, InstanceTypes),
                         (
-                                % check that this constraint is the
-                                % first constraint in the callee's
-                                % constraint list
-                                MaybePredProcId0 = yes(PredProcId0),
-
-                                % check that the called pred is a class method
-                                PredProcId0 = hlds_class_proc(PredId0, _),
-                                module_info_pred_info(ModuleInfo, PredId0,
-                                                PredInfo),
-                                pred_info_get_markers(PredInfo, Markers),
-                                check_marker(Markers, class_method),
-
-                                % enabling this optimisation causes a bug
-                                % where implied instances are concerned. 
-                                % When the class method call is inlined, the
-                                % extra typeclass_infos from the instance
-                                % declaration are not included. Until that
-                                % bug is fixed, we will disable the
-                                % optimisation.
-                                semidet_fail
+                                type_list_subsumes(InstanceTypes,
+                                        ConstrainedTypes, InstanceSubst0)
                         ->
-                                % Get the class methods, and figure out
-                                % the method number of this class method.
-                                module_info_classes(ModuleInfo, ClassTable),
-                                map__lookup(ClassTable, ClassId, ClassDefn),
-                                ClassDefn = hlds_class_defn(_, _, ClassMethods,
-                                                _, _),
-                                ( list__nth_member_search(ClassMethods,
-                                                PredProcId0, MethodNum0) ->
-                                        MethodNum = MethodNum0
-                                ;
-                                        error("poly: nth_member_search failed")
-                                ),
-
-                                % Get the instance methods, and lookup
-                                % the pred for the corresponding method number.
-                                % (NB. We can't use ProofInstanceDefn,
-                                % because its MaybeInstanceMethods field
-                                % has not been updated (is still `no').)
-                                module_info_instances(ModuleInfo,
-                                        InstanceTable),
-                                map__lookup(InstanceTable, ClassId,
-                                        InstanceDefns),
-                                list__index1_det(InstanceDefns, InstanceNum,
-                                        InstanceDefn),
-                                InstanceDefn = hlds_instance_defn(_, _, _, _,
-                                        MaybeInstanceMethods, _, _),
-                                ( MaybeInstanceMethods = yes(InstanceMethods0)
-                                ->
-                                        InstanceMethods = InstanceMethods0
-                                ;
-                                        error("poly: no instance methods")
-                                ),
-                                list__index1_det(InstanceMethods, MethodNum,
-                                        InstanceMethod),
-                                MaybePredProcId = yes(InstanceMethod),
-                                MaybeVar = no,
-                                ExtraGoals = ExtraGoals0,
-                                Info = Info0
+                                InstanceSubst = InstanceSubst0
                         ;
+                                error("poly: wrong instance decl")
+                        ),
 
-                                        % Make the type_infos for the types
-                                        % that are constrained by this. These
-                                        % are packaged in the typeclass_info
-                                polymorphism__make_type_info_vars(
-                                        ConstrainedTypes, ExistQVars,
-                                        Context, InstanceExtraTypeInfoVars,
-                                        TypeInfoGoals,
-                                        Info0, Info1),
-
-                                        % Make the typeclass_infos for the
-                                        % constraints from the context of the
-                                        % instance decl.
-                                polymorphism__make_typeclass_info_vars_2(
-                                        InstanceConstraints, Subst, TypeSubst, 
-                                        ExistQVars, Context, no, _,
-                                        [], InstanceExtraTypeClassInfoVars, 
-                                        ExtraGoals0, ExtraGoals1, 
-                                        [], _,
-                                        Info1, Info2),
-
-                                polymorphism__construct_typeclass_info(
-                                        InstanceExtraTypeInfoVars, 
-                                        InstanceExtraTypeClassInfoVars, 
-                                        ClassId, InstanceNum,
-                                        ExistQVars,
-                                        Var, NewGoals, 
-                                        Info2, Info),
-
-                                MaybeVar = yes(Var),
-                                MaybePredProcId = no,
-
-                                        % Oh, yuck. The type_info goals have
-                                        % already been reversed, so lets
-                                        % reverse them back.
-                                list__reverse(TypeInfoGoals, RevTypeInfoGoals),
-
-                                list__append(ExtraGoals1, RevTypeInfoGoals,
-                                        ExtraGoals2),
-                                list__append(NewGoals, ExtraGoals2, ExtraGoals)
-                        )
+                        apply_subst_to_constraint_list(RenameSubst,
+                                InstanceConstraints0, InstanceConstraints1),
+                        apply_rec_subst_to_constraint_list(InstanceSubst,
+                                InstanceConstraints1, InstanceConstraints),
+                        apply_subst_to_constraint_proofs(RenameSubst,
+                                SuperClassProofs0, SuperClassProofs1),
+                        apply_rec_subst_to_constraint_proofs(InstanceSubst,
+                                SuperClassProofs1, SuperClassProofs),
+
+                        poly_info_set_typevarset(NewTVarset, Info0, Info1),
+
+                                % Make the type_infos for the types
+                                % that are constrained by this. These
+                                % are packaged in the typeclass_info
+                        polymorphism__make_type_info_vars(
+                                ConstrainedTypes, ExistQVars, Context, 
+                                InstanceExtraTypeInfoVars, TypeInfoGoals,
+                                Info1, Info2),
+
+                                % Make the typeclass_infos for the
+                                % constraints from the context of the
+                                % instance decl.
+                        polymorphism__make_typeclass_info_vars_2(
+                                InstanceConstraints, TypeSubst, 
+                                ExistQVars, Context, no, _,
+                                [], InstanceExtraTypeClassInfoVars, 
+                                ExtraGoals0, ExtraGoals1, 
+                                [], _,
+                                Info2, Info3),
+
+                        polymorphism__construct_typeclass_info(
+                                InstanceExtraTypeInfoVars, 
+                                InstanceExtraTypeClassInfoVars, 
+                                ClassId, ConstrainedTypes,
+                                SuperClassProofs, ExistQVars, Var, NewGoals, 
+                                Info3, Info4),
+
+                        poly_info_set_typevarset(TypeVarSet, Info4, Info),
+
+                        MaybeVar = yes(Var),
+                        MaybePredProcId = no,
+
+                                % Oh, yuck. The type_info goals have
+                                % already been reversed, so lets
+                                % reverse them back.
+                        list__reverse(TypeInfoGoals, RevTypeInfoGoals),
+
+                        list__append(ExtraGoals1, RevTypeInfoGoals,
+                                ExtraGoals2),
+                        list__append(NewGoals, ExtraGoals2, ExtraGoals)
                 ;
                                 % We have to extract the typeclass_info from
                                 % another one
-                        Proof = superclass(SubClassConstraint0),
+                        Proof = superclass(SubClassConstraint),
 
                                 % First create a variable to hold the new
                                 % typeclass_info 
@@ -1807,26 +1764,18 @@
                         MaybePredProcId = no,
 
                                 % Then work out where to extract it from
-                        SubClassConstraint0 = 
-                                constraint(SubClassName, SubClassTypes0),
-                        term__apply_substitution_to_list(SubClassTypes0, Subst,
-                                SubClassTypes1),
-                        % we need to maintain the invariant that types in
-                        % class constraints do not contain any information
-                        % in their term__context fields
-                        strip_term_contexts(SubClassTypes1, SubClassTypes),
                         SubClassConstraint = 
                                 constraint(SubClassName, SubClassTypes),
                         list__length(SubClassTypes, SubClassArity),
                         SubClassId = class_id(SubClassName, SubClassArity),
 
-                        Info1 = poly_info(VarSet1, VarTypes1, TypeVarSet0, 
+                        Info1 = poly_info(VarSet1, VarTypes1, TypeVarSet, 
                                 TypeInfoMap0, TypeClassInfoMap0, Proofs, 
                                 PredName, ModuleInfo),
 
                                 % Make the typeclass_info for the subclass
                         polymorphism__make_typeclass_info_var(
-                                SubClassConstraint, Subst, TypeSubst, 
+                                SubClassConstraint, TypeSubst, 
                                 ExistQVars, Context, no, _,
                                 ExtraGoals0, ExtraGoals1, 
                                 [], _,
@@ -1846,24 +1795,13 @@
 
                                 % Work out which superclass typeclass_info to
                                 % take
-                        ToTerm = lambda([TheVar::in, TheTerm::out] is det,
-                                (
-                                        TheTerm = term__variable(TheVar)
-                                )),
-                        list__map(ToTerm, SubClassVars, SubClassVarTerms),
-                        (
-                                type_list_subsumes(SubClassVarTerms,
-                                        SubClassTypes, SubTypeSubst0)
-                        ->
-                                SubTypeSubst0 = SubTypeSubst
-                        ;
-                                error("polymorphism__make_typeclass_info_var")
-                        ),
-                        apply_rec_subst_to_constraint_list(SubTypeSubst,
+                        map__from_corresponding_lists(SubClassVars,
+                                SubClassTypes, SubTypeSubst),
+                        apply_subst_to_constraint_list(SubTypeSubst,
                                 SuperClasses0, SuperClasses),
                         (
                                 list__nth_member_search(SuperClasses,
-                                        Constraint, SuperClassIndex0)
+                                        NewC, SuperClassIndex0)
                         ->
                                 SuperClassIndex0 = SuperClassIndex
                         ;
@@ -1921,22 +1859,17 @@
         ).
 
 :- pred polymorphism__construct_typeclass_info(list(var), list(var), class_id, 
-        int, existq_tvars, var, list(hlds_goal), poly_info, poly_info).
-:- mode polymorphism__construct_typeclass_info(in, in, in, in, in, out, out, 
-        in, out) is det.
+        list(type), map(class_constraint, constraint_proof),
+        existq_tvars, var, list(hlds_goal), poly_info, poly_info).
+:- mode polymorphism__construct_typeclass_info(in, in, in, in, in, in, 
+        out, out, in, out) is det.
 
 polymorphism__construct_typeclass_info(ArgTypeInfoVars, ArgTypeClassInfoVars,
-                ClassId, InstanceNum, ExistQVars,
+                ClassId, InstanceTypes, SuperClassProofs, ExistQVars,
                 NewVar, NewGoals, Info0, Info) :-
 
         poly_info_get_module_info(Info0, ModuleInfo),
 
-        module_info_instances(ModuleInfo, InstanceTable),
-        map__lookup(InstanceTable, ClassId, InstanceList),
-        list__index1_det(InstanceList, InstanceNum, InstanceDefn),
-        InstanceDefn = hlds_instance_defn(_, _, InstanceTypes, _, _, _, 
-                SuperClassProofs),
-
         module_info_classes(ModuleInfo, ClassTable),
         map__lookup(ClassTable, ClassId, ClassDefn),
 
@@ -2047,13 +1980,19 @@
         poly_info_get_proofs(Info0, Proofs),
 
         poly_info_get_varset(Info0, VarSet0),
-        ClassDefn = hlds_class_defn(SuperClasses, ClassVars, _, ClassVarSet, _),
-        map__from_corresponding_lists(ClassVars, InstanceTypes, TypeSubst),
+        ClassDefn = hlds_class_defn(SuperClasses0, ClassVars0, 
+                _, ClassVarSet, _),
         varset__merge_subst(VarSet0, ClassVarSet, VarSet1, Subst),
         poly_info_set_varset(VarSet1, Info0, Info1),
 
+        map__apply_to_list(ClassVars0, Subst, ClassVars1),
+        term__vars_list(ClassVars1, ClassVars),
+        map__from_corresponding_lists(ClassVars, InstanceTypes, TypeSubst),
+
+        apply_subst_to_constraint_list(Subst, SuperClasses0, SuperClasses),
+
         poly_info_set_proofs(SuperClassProofs, Info1, Info2),
-        polymorphism__make_superclasses_from_proofs(SuperClasses, Subst,
+        polymorphism__make_superclasses_from_proofs(SuperClasses,
                 TypeSubst, ExistQVars, [], NewGoals, Info2, Info3,
                 [], NewVars),
 
@@ -2061,19 +2000,19 @@
 
 
 :- pred polymorphism__make_superclasses_from_proofs(list(class_constraint), 
-        substitution, tsubst, existq_tvars, list(hlds_goal), list(hlds_goal), 
+        tsubst, existq_tvars, list(hlds_goal), list(hlds_goal), 
         poly_info, poly_info, list(var), list(var)).
-:- mode polymorphism__make_superclasses_from_proofs(in, in, in, in, in, out, 
+:- mode polymorphism__make_superclasses_from_proofs(in, in, in, in, out, 
         in, out, in, out) is det.
 
-polymorphism__make_superclasses_from_proofs([], _, _, _,
+polymorphism__make_superclasses_from_proofs([], _, _, 
                 Goals, Goals, Info, Info, Vars, Vars).
-polymorphism__make_superclasses_from_proofs([C|Cs], Subst, TypeSubst,
+polymorphism__make_superclasses_from_proofs([C|Cs], TypeSubst,
                 ExistQVars, Goals0, Goals, Info0, Info, Vars0, Vars) :-
-        polymorphism__make_superclasses_from_proofs(Cs, Subst, TypeSubst,
+        polymorphism__make_superclasses_from_proofs(Cs, TypeSubst,
                 ExistQVars, Goals0, Goals1, Info0, Info1, Vars0, Vars1),
         term__context_init(Context),
-        polymorphism__make_typeclass_info_var(C, Subst, TypeSubst,
+        polymorphism__make_typeclass_info_var(C, TypeSubst,
                 ExistQVars, Context, no, _, Goals1, Goals, [], _, Info1, Info,
                 MaybeVar),
         maybe_insert_var(MaybeVar, Vars1, Vars).
Index: compiler/type_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/type_util.m,v
retrieving revision 1.57
diff -u -t -r1.57 type_util.m
--- type_util.m	1998/08/04 02:14:13	1.57
+++ type_util.m	1998/09/10 06:58:44
@@ -191,6 +191,16 @@
         class_constraint).
 :- mode apply_subst_to_constraint(in, in, out) is det.
 
+:- pred apply_subst_to_constraint_proofs(substitution, 
+        map(class_constraint, constraint_proof),
+        map(class_constraint, constraint_proof)).
+:- mode apply_subst_to_constraint_proofs(in, in, out) is det.
+
+:- pred apply_rec_subst_to_constraint_proofs(substitution, 
+        map(class_constraint, constraint_proof),
+        map(class_constraint, constraint_proof)).
+:- mode apply_rec_subst_to_constraint_proofs(in, in, out) is det.
+
 :- pred apply_variable_renaming_to_constraints(map(var, var), 
         class_constraints, class_constraints).
 :- mode apply_variable_renaming_to_constraints(in, in, out) is det.
@@ -784,6 +794,46 @@
         Constraint0 = constraint(ClassName, Types0),
         term__apply_substitution_to_list(Types0, Subst, Types),
         Constraint  = constraint(ClassName, Types).
+
+apply_subst_to_constraint_proofs(Subst, Proofs0, Proofs) :-
+        map__init(Empty),
+        map__foldl(
+                lambda([Constraint0::in, Proof0::in, Map0::in, Map::out] is det,
+                (
+                        apply_subst_to_constraint(Subst, Constraint0,
+                                Constraint), 
+                        (
+                                Proof0 = apply_instance(_),
+                                Proof = Proof0
+                        ;
+                                Proof0 = superclass(Super0),
+                                apply_subst_to_constraint(Subst, Super0, 
+                                        Super),
+                                Proof = superclass(Super)
+                        ),
+                        map__set(Map0, Constraint, Proof, Map)
+                )),
+        Proofs0, Empty, Proofs).
+
+apply_rec_subst_to_constraint_proofs(Subst, Proofs0, Proofs) :-
+        map__init(Empty),
+        map__foldl(
+                lambda([Constraint0::in, Proof0::in, Map0::in, Map::out] is det,
+                (
+                        apply_rec_subst_to_constraint(Subst, Constraint0,
+                                Constraint), 
+                        (
+                                Proof0 = apply_instance(_),
+                                Proof = Proof0
+                        ;
+                                Proof0 = superclass(Super0),
+                                apply_rec_subst_to_constraint(Subst, Super0, 
+                                        Super),
+                                Proof = superclass(Super)
+                        ),
+                        map__set(Map0, Constraint, Proof, Map)
+                )),
+        Proofs0, Empty, Proofs).
 
 apply_variable_renaming_to_constraints(Renaming,
                 constraints(UniversalCs0, ExistentialCs0),
Index: compiler/typecheck.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/typecheck.m,v
retrieving revision 1.245
diff -u -t -r1.245 typecheck.m
--- typecheck.m	1998/08/06 04:58:01	1.245
+++ typecheck.m	1998/09/10 06:56:31
@@ -2959,8 +2959,8 @@
 
 % apply a type variable renaming to a class constraint proof
 
-rename_constraint_proof(_TSubst, apply_instance(Instance, Num),
-                                apply_instance(Instance, Num)).
+rename_constraint_proof(_TSubst, apply_instance(Num),
+                                apply_instance(Num)).
 rename_constraint_proof(TSubst, superclass(ClassConstraint0),
                         superclass(ClassConstraint)) :-
         apply_variable_renaming_to_constraint(TSubst, ClassConstraint0,
@@ -3394,23 +3394,22 @@
 
 find_matching_instance_rule_2([I|Is], N0, ClassName, Types, TVarSet,
                 NewTVarSet, Proofs0, Proofs, NewConstraints) :-
-        I = hlds_instance_defn(ModuleName, NewConstraints0, InstanceTypes0,
-                Interface, PredProcIds, InstanceNames, SuperClassProofs),
+        I = hlds_instance_defn(_ModuleName, NewConstraints0, InstanceTypes0,
+                _Interface, _PredProcIds, InstanceNames, _SuperClassProofs),
         (
                 varset__merge_subst(TVarSet, InstanceNames, NewTVarSet0,
                         RenameSubst),
-                term__apply_rec_substitution_to_list(InstanceTypes0,
+                term__apply_substitution_to_list(InstanceTypes0,
                         RenameSubst, InstanceTypes),
                 type_list_subsumes(InstanceTypes, Types, Subst)
         ->
-                apply_rec_subst_to_constraint_list(RenameSubst, NewConstraints0,
-                        NewConstraints1),
-                apply_rec_subst_to_constraint_list(Subst, NewConstraints1,
-                        NewConstraints),
                 NewTVarSet = NewTVarSet0,
-                NewProof = apply_instance(hlds_instance_defn(ModuleName,
-                        NewConstraints, InstanceTypes, Interface, PredProcIds,
-                        InstanceNames, SuperClassProofs), N0),
+                apply_subst_to_constraint_list(RenameSubst, 
+                        NewConstraints0, NewConstraints1),
+                apply_rec_subst_to_constraint_list(Subst, 
+                        NewConstraints1, NewConstraints),
+
+                NewProof = apply_instance(N0),
                 Constraint = constraint(ClassName, Types),
                 map__set(Proofs0, Constraint, NewProof, Proofs)
         ;
--------------------------------------------------------------------------


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.



More information about the developers mailing list