[m-dev.] looking for testers for proposed fix for Mantis bug 246
Zoltan Somogyi
zs at csse.unimelb.edu.au
Wed Dec 14 17:44:00 AEDT 2011
I understand that the test case for 246 came from code written by Ian.
Ian, can you please test this on your code? It passes all the tests
in bootcheck, but those do NOT have anything with complex superclass
hierarchies. (I have asked Julien to add such test cases to the test suite.)
Due to the XXX below, I don't want to commit this without more extensive
testing than I can do.
Zoltan.
compiler/polymorphism.m:
Tentative work-around for Mantis bug 246. It does not fix the actual
problem, but prevents the compiler from getting there.
cvs diff: Diffing .
Index: polymorphism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.373
diff -u -b -r1.373 polymorphism.m
--- polymorphism.m 14 Dec 2011 04:55:16 -0000 1.373
+++ polymorphism.m 14 Dec 2011 05:00:22 -0000
@@ -2489,11 +2489,7 @@
make_typeclass_info_from_subclass(Constraint, Seen, SubClassConstraint,
ExistQVars, Context, TypeClassInfoVar, !ExtraGoals, !Info) :-
- % First create a variable to hold the new typeclass_info.
- new_typeclass_info_var(Constraint, typeclass_info_kind, TypeClassInfoVar,
- !Info),
-
- % Then work out where to extract it from.
+ % Work out where to extract the superclass's typeclass_info from.
SubClassConstraint = constraint(SubClassName, SubClassTypes),
list.length(SubClassTypes, SubClassArity),
SubClassId = class_id(SubClassName, SubClassArity),
@@ -2512,24 +2508,31 @@
SubTypeSubst),
apply_subst_to_prog_constraint_list(SubTypeSubst,
SubClassDefn ^ class_supers, SuperClasses),
- ( list.nth_member_search(SuperClasses, Constraint, SuperClassIndex0) ->
- SuperClassIndex0 = SuperClassIndex
- ;
- % We shouldn't have got this far if the constraints were not satisfied.
- unexpected($module, $pred, "constraint not in constraint list")
- ),
+ list.nth_member_lookup(SuperClasses, Constraint, SuperClassIndex),
+ poly_info_get_typeclass_info_rev_map(!.Info, TypeClassInfoRevMap),
+ ( map.search(TypeClassInfoRevMap, SubClassVar, ArgVars) ->
+ % XXX This code is supposed to do the same thing as the predicate
+ % interpret_typeclass_info_manipulator, but is considerably simpler.
+ % Either this code is wrong, or that code is way over-complex.
+ list.det_index1(ArgVars, SuperClassIndex, TypeClassInfoVar),
+ poly_info_get_num_reuses(!.Info, NumReuses),
+ poly_info_set_num_reuses(NumReuses + 1, !Info)
+ ;
get_poly_const(SuperClassIndex, IndexVar, IndexGoals, !Info),
-
+ % Create a variable to hold the new typeclass_info.
+ new_typeclass_info_var(Constraint, typeclass_info_kind,
+ TypeClassInfoVar, !Info),
% We extract the superclass typeclass_info by inserting a call
% to superclass_from_typeclass_info in private_builtin.
goal_util.generate_simple_call(mercury_private_builtin_module,
- "superclass_from_typeclass_info", pf_predicate, only_mode, detism_det,
- purity_pure, [SubClassVar, IndexVar, TypeClassInfoVar], [],
- instmap_delta_bind_no_var, ModuleInfo, term.context_init,
+ "superclass_from_typeclass_info", pf_predicate, only_mode,
+ detism_det, purity_pure, [SubClassVar, IndexVar, TypeClassInfoVar],
+ [], instmap_delta_bind_no_var, ModuleInfo, term.context_init,
SuperClassGoal),
!:ExtraGoals = !.ExtraGoals ++
- cord.from_list(IndexGoals ++ [SuperClassGoal]).
+ cord.from_list(IndexGoals ++ [SuperClassGoal])
+ ).
:- pred construct_base_typeclass_info(prog_constraint::in,
int::in, list(mer_type)::in, prog_var::out, hlds_goal::out,
@@ -2610,8 +2613,12 @@
instmap_delta_from_assoc_list([TypeClassInfoVar - TypeClassInfoInst]),
goal_info_set_instmap_delta(InstMapDelta, GoalInfo1, GoalInfo2),
goal_info_set_determinism(detism_det, GoalInfo2, GoalInfo),
+ Goal = hlds_goal(GoalExpr, GoalInfo),
- Goal = hlds_goal(GoalExpr, GoalInfo).
+ poly_info_get_typeclass_info_rev_map(!.Info, TypeClassInfoRevMap0),
+ map.det_insert(TypeClassInfoVar, AllArgVars,
+ TypeClassInfoRevMap0, TypeClassInfoRevMap),
+ poly_info_set_typeclass_info_rev_map(TypeClassInfoRevMap, !Info).
:- pred make_typeclass_info(list(prog_var)::in, list(prog_var)::in,
list(prog_var)::in, class_id::in, prog_constraint::in, int::in,
@@ -3281,6 +3288,8 @@
IndexIntOrVar = iov_var(IndexVar),
IndexGoals = []
),
+ % XXX If we had a poly_info, we could see whether we already have
+ % a TypeInfoVar with the required type_info.
Type = type_variable(TypeVar, Kind),
new_type_info_var_raw(Type, type_info, TypeInfoVar,
!VarSet, !VarTypes, !RttiVarMaps),
@@ -3678,9 +3687,18 @@
:- type type_ctor_info_var_map ==
map(type_ctor, prog_var).
+ % This two-stage map maps a type constructor name and a list of argument
+ % types to the program variable that holds the type_info for that type
+ % constructor applied to those types.
+ %
:- type type_info_var_map ==
map(type_ctor, map(list(mer_type), prog_var)).
+ % This two-stage map maps a type class name and a list of argument types
+ % to a structure giving information about that type class constraint.
+:- type typeclass_info_map ==
+ map(class_name, map(list(mer_type), typeclass_info_map_entry)).
+
:- type typeclass_info_map_entry
---> typeclass_info_map_entry(
% The variable that holds the base_typeclass_info for the
@@ -3693,8 +3711,12 @@
map(list(prog_var), prog_var)
).
-:- type typeclass_info_map ==
- map(class_name, map(list(mer_type), typeclass_info_map_entry)).
+ % Maps a program variable that contains a typeclass_info to the list of
+ % the arguments (base_typeclass_info, superclass typeclass_infos, argument
+ % type type_infos) it was created with.
+ % Conceptually, it is the reverse of the typeclass_info_map.
+:- type typeclass_info_rev_map ==
+ map(prog_var, list(prog_var)).
:- type int_const_map == map(int, prog_var).
@@ -3725,15 +3747,17 @@
poly_constraint_map :: constraint_map,
% The next four maps hold information about what
- % type_ctor_infos, type_infos, base_typeclass_infos and
- % typeclass_infos are guaranteed to be available (i.e. created
- % by previous code on all execution paths) at the current point
- % in the code, so they can be reused. The fifth field counts
- % the number of times that one of these variables has in fact
- % been reused.
+ % type_ctor_infos, type_infos, typeclass_infos and int consts
+ % are guaranteed to be available (i.e. created by previous code
+ % on all execution paths) at the current point in the code,
+ % so they can be reused. The fifth field contains a redundant
+ % copy of the fourth field, indexed differently. The sixth
+ % field counts the number of times that one of these variables
+ % has in fact been reused.
poly_type_ctor_info_var_map :: type_ctor_info_var_map,
poly_type_info_var_map :: type_info_var_map,
poly_typeclass_info_map :: typeclass_info_map,
+ poly_typeclass_info_rev_map :: typeclass_info_rev_map,
poly_int_const_map :: int_const_map,
poly_num_reuses :: int,
@@ -3760,11 +3784,13 @@
map.init(TypeCtorInfoVarMap),
map.init(TypeInfoVarMap),
map.init(TypeClassInfoMap),
+ map.init(TypeClassInfoRevMap),
map.init(IntConstMap),
NumReuses = 0,
PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, TypeVarKinds,
RttiVarMaps, Proofs, ConstraintMap, TypeCtorInfoVarMap, TypeInfoVarMap,
- TypeClassInfoMap, IntConstMap, NumReuses, PredInfo, ModuleInfo).
+ TypeClassInfoMap, TypeClassInfoRevMap, IntConstMap, NumReuses,
+ PredInfo, ModuleInfo).
% Create_poly_info creates a poly_info for an existing procedure.
% (See also init_poly_info.)
@@ -3780,17 +3806,20 @@
map.init(TypeCtorInfoVarMap),
map.init(TypeInfoVarMap),
map.init(TypeClassInfoMap),
+ map.init(TypeClassInfoRevMap),
map.init(IntConstMap),
NumReuses = 0,
PolyInfo = poly_info(VarSet, VarTypes, TypeVarSet, TypeVarKinds,
RttiVarMaps, Proofs, ConstraintMap, TypeCtorInfoVarMap, TypeInfoVarMap,
- TypeClassInfoMap, IntConstMap, NumReuses, PredInfo, ModuleInfo).
+ TypeClassInfoMap, TypeClassInfoRevMap, IntConstMap, NumReuses,
+ PredInfo, ModuleInfo).
poly_info_extract(Info, !PredInfo, !ProcInfo, ModuleInfo) :-
Info = poly_info(VarSet, VarTypes, TypeVarSet, TypeVarKinds,
RttiVarMaps, _Proofs, _ConstraintMap,
- _TypeCtorInfoVarMap, _TypeInfoVarMap, _TypeClassInfoMap, _IntConstMap,
- _NumReuses, _OldPredInfo, ModuleInfo),
+ _TypeCtorInfoVarMap, _TypeInfoVarMap,
+ _TypeClassInfoMap,_TypeClassInfoRevMap, _IntConstMap, _NumReuses,
+ _OldPredInfo, ModuleInfo),
% Set the new values of the fields in proc_info and pred_info.
proc_info_set_varset(VarSet, !ProcInfo),
@@ -3815,6 +3844,8 @@
type_info_var_map::out) is det.
:- pred poly_info_get_typeclass_info_map(poly_info::in,
typeclass_info_map::out) is det.
+:- pred poly_info_get_typeclass_info_rev_map(poly_info::in,
+ typeclass_info_rev_map::out) is det.
:- pred poly_info_get_int_const_map(poly_info::in, int_const_map::out) is det.
:- pred poly_info_get_num_reuses(poly_info::in, int::out) is det.
:- pred poly_info_get_pred_info(poly_info::in, pred_info::out) is det.
@@ -3831,6 +3862,8 @@
PolyInfo ^ poly_type_ctor_info_var_map).
poly_info_get_type_info_var_map(PolyInfo, PolyInfo ^ poly_type_info_var_map).
poly_info_get_typeclass_info_map(PolyInfo, PolyInfo ^ poly_typeclass_info_map).
+poly_info_get_typeclass_info_rev_map(PolyInfo,
+ PolyInfo ^ poly_typeclass_info_rev_map).
poly_info_get_int_const_map(PolyInfo, PolyInfo ^ poly_int_const_map).
poly_info_get_num_reuses(PolyInfo, PolyInfo ^ poly_num_reuses).
poly_info_get_pred_info(PolyInfo, PolyInfo ^ poly_pred_info).
@@ -3854,6 +3887,8 @@
poly_info::in, poly_info::out) is det.
:- pred poly_info_set_typeclass_info_map(typeclass_info_map::in,
poly_info::in, poly_info::out) is det.
+:- pred poly_info_set_typeclass_info_rev_map(typeclass_info_rev_map::in,
+ poly_info::in, poly_info::out) is det.
:- pred poly_info_set_int_const_map(int_const_map::in,
poly_info::in, poly_info::out) is det.
:- pred poly_info_set_num_reuses(int::in,
@@ -3878,6 +3913,8 @@
!PI ^ poly_type_info_var_map := TypeInfoVarMap.
poly_info_set_typeclass_info_map(TypeClassInfoMap, !PI) :-
!PI ^ poly_typeclass_info_map := TypeClassInfoMap.
+poly_info_set_typeclass_info_rev_map(TypeClassInfoRevMap, !PI) :-
+ !PI ^ poly_typeclass_info_rev_map := TypeClassInfoRevMap.
poly_info_set_int_const_map(IntConstMap, !PI) :-
!PI ^ poly_int_const_map := IntConstMap.
poly_info_set_num_reuses(NumReuses, !PI) :-
@@ -3900,16 +3937,19 @@
TypeCtorInfoVarMap = SnapshotInfo ^ poly_type_ctor_info_var_map,
TypeInfoVarMap = SnapshotInfo ^ poly_type_info_var_map,
TypeClassInfoMap = SnapshotInfo ^ poly_typeclass_info_map,
+ TypeClassInfoRevMap = SnapshotInfo ^ poly_typeclass_info_rev_map,
IntConstMap = SnapshotInfo ^ poly_int_const_map,
!Info ^ poly_type_ctor_info_var_map := TypeCtorInfoVarMap,
!Info ^ poly_type_info_var_map := TypeInfoVarMap,
!Info ^ poly_typeclass_info_map := TypeClassInfoMap,
+ !Info ^ poly_typeclass_info_rev_map := TypeClassInfoRevMap,
!Info ^ poly_int_const_map := IntConstMap.
empty_maps(!Info) :-
!Info ^ poly_type_ctor_info_var_map := map.init,
!Info ^ poly_type_info_var_map := map.init,
!Info ^ poly_typeclass_info_map := map.init,
+ !Info ^ poly_typeclass_info_rev_map := map.init,
!Info ^ poly_int_const_map := map.init.
%---------------------------------------------------------------------------%
cvs diff: Diffing notes
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at csse.unimelb.edu.au
Administrative Queries: owner-mercury-developers at csse.unimelb.edu.au
Subscriptions: mercury-developers-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the developers
mailing list