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