[m-rev.] diff: bug fix for typeclasses
Mark Brown
mark at cs.mu.OZ.AU
Thu Dec 22 10:18:30 AEDT 2005
Hi,
This patch should fix the bug in benchmarks/progs/compress.
Cheers,
Mark.
Estimated hours taken: 5
Branches: main
Fix a bug with typeclasses.
compiler/polymorphism.m:
When setting up headvars for existential constraints in anything
other than a class method, don't record type_info_locns for the
constrained type vars. They generally won't be usable in the given
location, since the typeclass_infos that contain them might not be
constructed until just before the procedure exits.
In class methods, record the type_info_locns anyway. We know that
recording them won't be a problem (since we construct the method
bodies ourselves) and it's easier to do it here.
tests/valid/Mmakefile:
tests/valid/exists_bug.m:
New test case.
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.288
diff -u -r1.288 polymorphism.m
--- compiler/polymorphism.m 7 Dec 2005 16:07:05 -0000 1.288
+++ compiler/polymorphism.m 21 Dec 2005 16:06:11 -0000
@@ -754,8 +754,8 @@
pred_info_arg_types(PredInfo, ArgTypeVarSet, _, _),
make_head_vars(UnconstrainedInstanceTVars,
ArgTypeVarSet, UnconstrainedInstanceTypeInfoVars, !Info),
- make_typeclass_info_head_vars(InstanceConstraints,
- InstanceHeadTypeClassInfoVars, !Info),
+ make_typeclass_info_head_vars(do_record_type_info_locns,
+ InstanceConstraints, InstanceHeadTypeClassInfoVars, !Info),
poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
list__foldl(rtti_reuse_typeclass_info_var,
InstanceHeadTypeClassInfoVars, RttiVarMaps0, RttiVarMaps),
@@ -811,10 +811,23 @@
poly_info_get_constraint_map(!.Info, ConstraintMap),
get_improved_exists_head_constraints(ConstraintMap, ExistConstraints,
ActualExistConstraints),
- make_typeclass_info_head_vars(ActualExistConstraints,
+ (
+ pred_info_get_markers(PredInfo, PredMarkers),
+ check_marker(PredMarkers, class_method)
+ ->
+ % For class methods we record the type_info_locns even for the
+ % existential constraints. It's easier to do it here than when we
+ % are expanding class method bodies, and we know there won't be any
+ % references to the type_info after the instance method call so
+ % recording them now won't be a problem.
+ RecordExistQLocns = do_record_type_info_locns
+ ;
+ RecordExistQLocns = do_not_record_type_info_locns
+ ),
+ make_typeclass_info_head_vars(RecordExistQLocns, ActualExistConstraints,
ExistHeadTypeClassInfoVars, !Info),
- make_typeclass_info_head_vars(UnivConstraints, UnivHeadTypeClassInfoVars,
- !Info),
+ make_typeclass_info_head_vars(do_record_type_info_locns, UnivConstraints,
+ UnivHeadTypeClassInfoVars, !Info),
list__append(UnivHeadTypeClassInfoVars, ExistHeadTypeClassInfoVars,
ExtraHeadTypeClassInfoVars),
@@ -2062,7 +2075,8 @@
make_typeclass_info_from_proof(Constraint, Seen, Proof, ExistQVars,
Context, MaybeVar, !ExtraGoals, !Info)
;
- make_typeclass_info_head_var(Constraint, NewVar, !Info),
+ make_typeclass_info_head_var(do_record_type_info_locns, Constraint,
+ NewVar, !Info),
poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
rtti_reuse_typeclass_info_var(NewVar, RttiVarMaps0, RttiVarMaps),
poly_info_set_rtti_varmaps(RttiVarMaps, !Info),
@@ -2406,8 +2420,8 @@
make_existq_typeclass_info_vars(ExistentialConstraints, ExtraTypeClassVars,
ExtraGoals, !Info) :-
poly_info_get_rtti_varmaps(!.Info, OldRttiVarMaps),
- make_typeclass_info_head_vars(ExistentialConstraints, ExtraTypeClassVars,
- !Info),
+ make_typeclass_info_head_vars(do_record_type_info_locns,
+ ExistentialConstraints, ExtraTypeClassVars, !Info),
poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
list__foldl(rtti_reuse_typeclass_info_var, ExtraTypeClassVars,
RttiVarMaps0, RttiVarMaps),
@@ -2876,81 +2890,105 @@
%-----------------------------------------------------------------------------%
- % Create a head var for each class constraint, and make an entry in
- % the typeinfo locations map for each constrained type var.
+ % Usually when we call make_typeclass_info_head_var, we want to record
+ % the type_info_locn for each constrained type var so that later goals
+ % will know where to get the type_info from. However, when setting up
+ % head vars for existential constraints on the predicate/function we
+ % are processing, we assume that the type_infos will be produced
+ % somewhere else in the goal. In this case, we don't want to record
+ % the type_info_locns (if we did, then the code to actually produce the
+ % type_info will just try to get it from here, which would be a mode
+ % error).
+ %
+:- type record_type_info_locns
+ ---> do_record_type_info_locns
+ ; do_not_record_type_info_locns.
+
+ % Create a head var for each class constraint.
%
-:- pred make_typeclass_info_head_vars(list(prog_constraint)::in,
- list(prog_var)::out, poly_info::in, poly_info::out) is det.
+:- pred make_typeclass_info_head_vars(record_type_info_locns::in,
+ list(prog_constraint)::in, list(prog_var)::out,
+ poly_info::in, poly_info::out) is det.
-make_typeclass_info_head_vars(Constraints, ExtraHeadVars, !Info) :-
- list__map_foldl(make_typeclass_info_head_var, Constraints, ExtraHeadVars,
- !Info).
+make_typeclass_info_head_vars(RecordLocns, Constraints, ExtraHeadVars,
+ !Info) :-
+ list__map_foldl(make_typeclass_info_head_var(RecordLocns), Constraints,
+ ExtraHeadVars, !Info).
-:- pred make_typeclass_info_head_var(prog_constraint::in,
- prog_var::out, poly_info::in, poly_info::out) is det.
+:- pred make_typeclass_info_head_var(record_type_info_locns::in,
+ prog_constraint::in, prog_var::out, poly_info::in, poly_info::out) is det.
-make_typeclass_info_head_var(Constraint, ExtraHeadVar, !Info) :-
+make_typeclass_info_head_var(RecordLocns, Constraint, ExtraHeadVar, !Info) :-
(
poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
rtti_search_typeclass_info_var(RttiVarMaps0, Constraint, ExistingVar)
->
ExtraHeadVar = ExistingVar
;
- poly_info_get_module_info(!.Info, ModuleInfo),
+ % Make a new variable to contain the dictionary for this typeclass
+ % constraint.
+ Constraint = constraint(ClassName0, _ClassTypes),
+ unqualify_name(ClassName0, ClassName),
+ new_typeclass_info_var(Constraint, ClassName, ExtraHeadVar, !Info),
+ (
+ RecordLocns = do_record_type_info_locns,
+ record_constraint_type_info_locns(Constraint, ExtraHeadVar, !Info)
+ ;
+ RecordLocns = do_not_record_type_info_locns
+ )
+ ).
- Constraint = constraint(ClassName0, ClassTypes),
+:- pred record_constraint_type_info_locns(prog_constraint::in, prog_var::in,
+ poly_info::in, poly_info::out) is det.
- % Work out how many superclasses the class has.
- list__length(ClassTypes, ClassArity),
- ClassId = class_id(ClassName0, ClassArity),
- module_info_get_class_table(ModuleInfo, ClassTable),
- map__lookup(ClassTable, ClassId, ClassDefn),
- SuperClasses = ClassDefn ^ class_supers,
- list__length(SuperClasses, NumSuperClasses),
+record_constraint_type_info_locns(Constraint, ExtraHeadVar, !Info) :-
+ poly_info_get_module_info(!.Info, ModuleInfo),
- unqualify_name(ClassName0, ClassName),
+ % Work out how many superclasses the class has.
+ Constraint = constraint(ClassName, ClassTypes),
+ list__length(ClassTypes, ClassArity),
+ ClassId = class_id(ClassName, ClassArity),
+ module_info_get_class_table(ModuleInfo, ClassTable),
+ map__lookup(ClassTable, ClassId, ClassDefn),
+ SuperClasses = ClassDefn ^ class_supers,
+ list__length(SuperClasses, NumSuperClasses),
- % Make a new variable to contain the dictionary for this typeclass
- % constraint.
- new_typeclass_info_var(Constraint, ClassName, ExtraHeadVar, !Info),
+ % Find all the type variables in the constraint, and remember what
+ % index they appear in in the typeclass info.
- % Find all the type variables in the constraint, and remember what
- % index they appear in in the typeclass info.
+ % The first type_info will be just after the superclass infos.
+ First = NumSuperClasses + 1,
+ prog_type__vars_list(ClassTypes, ClassTypeVars0),
+ list__map_foldl(make_index, ClassTypeVars0, ClassTypeVars, First, _),
+
+ % Work out which type variables we haven't seen before, or which we
+ % assumed earlier would be produced in a type_info (this can happen for
+ % code which needs mode reordering and which calls existentially
+ % quantified predicates or deconstructs existentially quantified
+ % terms).
+ poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
+ IsNew = (pred(TypeVar0::in) is semidet :-
+ TypeVar0 = TypeVar - _Index,
+ (
+ rtti_search_type_info_locn(RttiVarMaps0, TypeVar, TypeInfoLocn)
+ ->
+ TypeInfoLocn = type_info(_)
+ ;
+ true
+ )
+ ),
+ list__filter(IsNew, ClassTypeVars, NewClassTypeVars),
- % The first type_info will be just after the superclass infos.
- First = NumSuperClasses + 1,
- prog_type__vars_list(ClassTypes, ClassTypeVars0),
- list__map_foldl(make_index, ClassTypeVars0, ClassTypeVars, First, _),
-
- % Work out which type variables we haven't seen before, or which we
- % assumed earlier would be produced in a type_info (this can happen for
- % code which needs mode reordering and which calls existentially
- % quantified predicates or deconstructs existentially quantified
- % terms).
- poly_info_get_rtti_varmaps(!.Info, RttiVarMaps0),
- IsNew = (pred(TypeVar0::in) is semidet :-
- TypeVar0 = TypeVar - _Index,
- (
- rtti_search_type_info_locn(RttiVarMaps0, TypeVar, TypeInfoLocn)
- ->
- TypeInfoLocn = type_info(_)
- ;
- true
- )
+ % Make an entry in the TypeInfo locations map for each new type
+ % variable. The type variable can be found at the previously calculated
+ % offset with the new typeclass_info.
+ MakeEntry = (pred(IndexedTypeVar::in, R0::in, R::out) is det :-
+ IndexedTypeVar = TheTypeVar - Index,
+ Location = typeclass_info(ExtraHeadVar, Index),
+ rtti_set_type_info_locn(TheTypeVar, Location, R0, R)
),
- list__filter(IsNew, ClassTypeVars, NewClassTypeVars),
-
- % Make an entry in the TypeInfo locations map for each new type
- % variable. The type variable can be found at the previously calculated
- % offset with the new typeclass_info.
- MakeEntry = (pred(IndexedTypeVar::in, R0::in, R::out) is det :-
- IndexedTypeVar = TheTypeVar - Index,
- Location = typeclass_info(ExtraHeadVar, Index),
- rtti_set_type_info_locn(TheTypeVar, Location, R0, R)
- ),
- list__foldl(MakeEntry, NewClassTypeVars, RttiVarMaps0, RttiVarMaps),
- poly_info_set_rtti_varmaps(RttiVarMaps, !Info)
- ).
+ list__foldl(MakeEntry, NewClassTypeVars, RttiVarMaps0, RttiVarMaps),
+ poly_info_set_rtti_varmaps(RttiVarMaps, !Info).
:- pred make_index(T::in, pair(T, int)::out, int::in, int::out) is det.
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.161
diff -u -r1.161 Mmakefile
--- tests/valid/Mmakefile 22 Nov 2005 08:41:35 -0000 1.161
+++ tests/valid/Mmakefile 21 Dec 2005 05:43:37 -0000
@@ -21,6 +21,7 @@
abstract_typeclass \
complex_constraint \
constraint_proof_bug \
+ exists_bug \
exists_fundeps \
exists_fundeps_2 \
exists_fundeps_3 \
Index: tests/valid/exists_bug.m
===================================================================
RCS file: tests/valid/exists_bug.m
diff -N tests/valid/exists_bug.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/valid/exists_bug.m 21 Dec 2005 05:47:12 -0000
@@ -0,0 +1,22 @@
+:- module exists_bug.
+:- interface.
+
+:- typeclass bar(T) where [].
+
+:- some [T] pred new_bar(T::out) is det => bar(T).
+
+:- implementation.
+
+:- instance bar(foo(S)) where [].
+new_bar(T) :-
+ % There was a bug here: polymorphism.m was attempting to construct
+ % a type_info for the existentially quantified type variable of
+ % new_foo/1. It was doing this because there was a type_info_locn
+ % (pointing inside the typeclass_info, which doesn't get constructed
+ % until later).
+ new_foo(T).
+
+:- type foo(S) ---> f(S).
+:- some [S] pred new_foo(foo(S)::out) is det.
+new_foo(f(1)).
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list