[m-dev.] for review: bug fix for typeclasses
Simon Taylor
stayl at cs.mu.OZ.AU
Sun Jan 14 20:10:44 AEDT 2001
For David Jeffery (or Fergus) to review.
This change will be committed on the main and release branches.
Simon.
Estimated hours taken: 6
Fix a bug which caused some programs using typeclasses to
crash with a segmentation fault.
compiler/polymorphism.m:
For typeclass method implementations, make sure the
order of the type-info and typeclass-info arguments
matches the order used by do_call_class_method.
The type-infos for the unconstrained type variables in
the instance declaration and the typeclass-infos for the
constraints on the instance declaration must come
before any other type-infos and typeclass-infos.
compiler/hlds_pred.m:
Add a field to the pred_info type to record for each
typeclass method implementation which class constraints
come from the `:- instance' declaration and which come
from the predicate or function declaration in the
`:- typeclass' declaration.
compiler/check_typeclass.m:
Fill in the new field in the pred_info.
compiler/typecheck.m:
Apply the necessary renamings to the types and
class constraints in the new field in the pred_info.
tests/hard_coded/typeclasses/Mmakefile:
tests/hard_coded/typeclasses/typeclass_order_bug.{m,exp}
tests/hard_coded/typeclasses/typeclass_order_bug2.{m,exp}
Test cases.
Index: compiler/check_typeclass.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/check_typeclass.m,v
retrieving revision 1.38
diff -u -u -r1.38 check_typeclass.m
--- compiler/check_typeclass.m 2000/11/06 04:08:59 1.38
+++ compiler/check_typeclass.m 2001/01/13 03:34:52
@@ -457,7 +457,7 @@
[InstanceMethod | OrderedInstanceMethods0],
InstanceMethod = instance_method(_, _, InstancePredDefn,
_, Context),
- produce_auxiliary_procs(ClassVars, Markers,
+ produce_auxiliary_procs(ClassId, ClassVars, Markers,
InstanceTypes, InstanceConstraints,
InstanceVarSet,
InstancePredDefn, Context,
@@ -609,44 +609,37 @@
pred_or_func_to_string(predicate, "predicate").
pred_or_func_to_string(function, "function").
-:- pred produce_auxiliary_procs(list(tvar), pred_markers, list(type),
+:- pred produce_auxiliary_procs(class_id, list(tvar), pred_markers, list(type),
list(class_constraint), tvarset, instance_proc_def, prog_context,
pred_id, list(proc_id), instance_method_info, instance_method_info,
io__state, io__state).
-:- mode produce_auxiliary_procs(in, in, in, in, in, in, in, out, out,
+:- mode produce_auxiliary_procs(in, in, in, in, in, in, in, in, out, out,
in, out, di, uo) is det.
-produce_auxiliary_procs(ClassVars, Markers0,
+produce_auxiliary_procs(ClassId, ClassVars, Markers0,
InstanceTypes0, InstanceConstraints0, InstanceVarSet,
InstancePredDefn, Context, PredId,
InstanceProcIds, Info0, Info, IO0, IO) :-
Info0 = instance_method_info(ModuleInfo0, QualInfo0, PredName,
- Arity, ExistQVars0, ArgTypes0, ClassContext0, ArgModes,
- Errors, ArgTypeVars0, Status0, PredOrFunc),
+ Arity, ExistQVars0, ArgTypes0, ClassMethodClassContext0,
+ ArgModes, Errors, ArgTypeVars0, Status0, PredOrFunc),
% Rename the instance variables apart from the class variables
varset__merge_subst(ArgTypeVars0, InstanceVarSet, ArgTypeVars1,
RenameSubst),
term__apply_substitution_to_list(InstanceTypes0, RenameSubst,
- InstanceTypes),
+ InstanceTypes1),
apply_subst_to_constraint_list(RenameSubst, InstanceConstraints0,
- InstanceConstraints),
+ InstanceConstraints1),
% Work out what the type variables are bound to for this
% instance, and update the class types appropriately.
- map__from_corresponding_lists(ClassVars, InstanceTypes, TypeSubst),
+ map__from_corresponding_lists(ClassVars, InstanceTypes1, TypeSubst),
term__apply_substitution_to_list(ArgTypes0, TypeSubst, ArgTypes1),
- apply_subst_to_constraints(TypeSubst, ClassContext0, ClassContext1),
+ apply_subst_to_constraints(TypeSubst, ClassMethodClassContext0,
+ ClassMethodClassContext1),
- % Add the constraints from the instance declaration to the
- % constraints from the class method. This allows an instance
- % method to have constraints on it which are not part of the
- % instance declaration as a whole.
- ClassContext1 = constraints(UnivConstraints1, ExistConstraints),
- list__append(InstanceConstraints, UnivConstraints1, UnivConstraints),
- ClassContext2 = constraints(UnivConstraints, ExistConstraints),
-
% Get rid of any unwanted type variables
term__vars_list(ArgTypes1, VarsToKeep0),
list__sort_and_remove_dups(VarsToKeep0, VarsToKeep),
@@ -654,9 +647,22 @@
term__apply_variable_renaming_to_list(ArgTypes1, SquashSubst,
ArgTypes),
apply_variable_renaming_to_constraints(SquashSubst,
- ClassContext2, ClassContext),
+ ClassMethodClassContext1, ClassMethodClassContext),
apply_partial_map_to_list(ExistQVars0, SquashSubst, ExistQVars),
+ apply_variable_renaming_to_list(InstanceTypes1, SquashSubst,
+ InstanceTypes),
+ apply_variable_renaming_to_constraint_list(SquashSubst,
+ InstanceConstraints1, InstanceConstraints),
+ % Add the constraints from the instance declaration to the
+ % constraints from the class method. This allows an instance
+ % method to have constraints on it which are not part of the
+ % instance declaration as a whole.
+ ClassMethodClassContext = constraints(UnivConstraints1,
+ ExistConstraints),
+ list__append(InstanceConstraints, UnivConstraints1, UnivConstraints),
+ ClassContext = constraints(UnivConstraints, ExistConstraints),
+
% Introduce a new predicate which calls the implementation
% given in the instance declaration.
module_info_name(ModuleInfo0, ModuleName),
@@ -682,8 +688,6 @@
PredArity, ArgTypes, Markers, Context, ClausesInfo,
ModuleInfo0, ModuleInfo1, QualInfo0, QualInfo, IO0, IO),
- pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo),
-
( status_is_imported(Status0, yes) ->
Status = opt_imported
;
@@ -694,7 +698,17 @@
ExistQVars, ArgTypes, Cond, Context, ClausesInfo, Status,
Markers, none, PredOrFunc, ClassContext, Proofs, User,
PredInfo0),
+ pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo1),
+ % Fill in some information in the pred_info which is
+ % used by polymorphism to make sure the type-infos
+ % and typeclass-infos are added in the correct order.
+ MethodConstraints = instance_method_constraints(ClassId,
+ InstanceTypes, InstanceConstraints,
+ ClassMethodClassContext),
+ pred_info_set_maybe_instance_method_constraints(PredInfo1,
+ yes(MethodConstraints), PredInfo2),
+
% Add procs with the expected modes and determinisms
AddProc = lambda([ModeAndDet::in, NewProcId::out,
OldPredInfo::in, NewPredInfo::out] is det,
@@ -705,8 +719,7 @@
NewPredInfo, NewProcId)
)),
list__map_foldl(AddProc, ArgModes, InstanceProcIds,
- PredInfo0, PredInfo1),
-
+ PredInfo2, PredInfo),
module_info_get_predicate_table(ModuleInfo1, PredicateTable1),
module_info_get_partial_qualifier_info(ModuleInfo1, PQInfo),
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.90
diff -u -u -r1.90 hlds_pred.m
--- compiler/hlds_pred.m 2000/12/13 00:00:21 1.90
+++ compiler/hlds_pred.m 2001/01/14 09:01:48
@@ -447,6 +447,23 @@
% typeclass_info for that constraint.
:- type constraint_proof_map == map(class_constraint, constraint_proof).
+ % Describes the class constraints on an instance method
+ % implementation. This information is used by polymorphism.m
+ % to ensure that the type_info and typeclass_info arguments
+ % are added in the order they will be passed in by
+ % do_call_class_method.
+:- type instance_method_constraints
+ ---> instance_method_constraints(
+ class_id,
+ list(type), % The types in the head of the
+ % instance declaration.
+ list(class_constraint), % The universal constraints
+ % on the instance declaration.
+ class_constraints % The contraints on the method's
+ % type declaration in the
+ % `:- typeclass' declaration.
+ ).
+
% A typeclass_info_varmap is a map which for each type class constraint
% records which variable contains the typeclass_info for that
% constraint.
@@ -687,6 +704,14 @@
:- pred pred_info_set_assertions(pred_info, set(assert_id), pred_info).
:- mode pred_info_set_assertions(in, in, out) is det.
+:- pred pred_info_get_maybe_instance_method_constraints(pred_info,
+ maybe(instance_method_constraints)).
+:- mode pred_info_get_maybe_instance_method_constraints(in, out) is det.
+
+:- pred pred_info_set_maybe_instance_method_constraints(pred_info,
+ maybe(instance_method_constraints), pred_info).
+:- mode pred_info_set_maybe_instance_method_constraints(in, in, out) is det.
+
:- pred pred_info_get_purity(pred_info, purity).
:- mode pred_info_get_purity(in, out) is det.
@@ -868,9 +893,18 @@
% Indexes if this predicate is
% an Aditi base relation, ignored
% otherwise.
- assertions :: set(assert_id)
+ assertions :: set(assert_id),
% List of assertions which
% mention this predicate.
+ maybe_instance_method_constraints
+ :: maybe(instance_method_constraints)
+ % If this predicate is a class method
+ % implementation, record extra
+ % information about the class context
+ % to allow polymorphism.m to
+ % correctly set up the extra
+ % type_info and typeclass_info
+ % arguments.
).
pred_info_init(ModuleName, SymName, Arity, TypeVarSet, ExistQVars, Types,
@@ -884,11 +918,12 @@
UnprovenBodyConstraints = [],
Indexes = [],
set__init(Assertions),
+ MaybeInstanceConstraints = no,
PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
Context, PredModuleName, PredName, Arity, Status, TypeVarSet,
GoalType, Markers, PredOrFunc, ClassContext, ClassProofs,
ExistQVars, HeadTypeParams, UnprovenBodyConstraints, User,
- Indexes, Assertions).
+ Indexes, Assertions, MaybeInstanceConstraints).
pred_info_create(ModuleName, SymName, TypeVarSet, ExistQVars, Types, Cond,
Context, Status, Markers, PredOrFunc, ClassContext, User,
@@ -914,11 +949,12 @@
list__delete_elems(TVars, ExistQVars, HeadTypeParams),
UnprovenBodyConstraints = [],
Indexes = [],
+ MaybeInstanceConstraints = no,
PredInfo = predicate(TypeVarSet, Types, Cond, ClausesInfo, Procs,
Context, ModuleName, PredName, Arity, Status, TypeVarSet,
clauses, Markers, PredOrFunc, ClassContext, ClassProofs,
ExistQVars, HeadTypeParams, UnprovenBodyConstraints, User,
- Indexes, Assertions).
+ Indexes, Assertions, MaybeInstanceConstraints).
pred_info_procids(PredInfo, ProcIds) :-
map__keys(PredInfo^procedures, ProcIds).
@@ -1110,6 +1146,12 @@
pred_info_get_assertions(PredInfo, PredInfo^assertions).
pred_info_set_assertions(PredInfo, X, PredInfo^assertions := X).
+
+pred_info_get_maybe_instance_method_constraints(PredInfo,
+ PredInfo^maybe_instance_method_constraints).
+
+pred_info_set_maybe_instance_method_constraints(PredInfo, X,
+ PredInfo^maybe_instance_method_constraints := X).
%-----------------------------------------------------------------------------%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.204
diff -u -u -r1.204 polymorphism.m
--- compiler/polymorphism.m 2000/11/17 17:48:28 1.204
+++ compiler/polymorphism.m 2001/01/13 04:11:40
@@ -666,12 +666,95 @@
polymorphism__setup_headvars(PredInfo, HeadVars0, HeadVars, ExtraArgModes,
HeadTypeVars, UnconstrainedTVars, ExtraHeadTypeInfoVars,
ExistHeadTypeClassInfoVars, PolyInfo0, PolyInfo) :-
+ pred_info_get_maybe_instance_method_constraints(PredInfo,
+ MaybeInstanceMethodConstraints),
+ (
+ MaybeInstanceMethodConstraints = no,
+ pred_info_get_class_context(PredInfo, ClassContext),
+ ExtraHeadVars0 = [],
+ ExtraArgModes0 = [],
+ InstanceUnconstrainedTVars = [],
+ InstanceUnconstrainedTypeInfoVars = [],
+ polymorphism__setup_headvars_2(PredInfo, ClassContext,
+ ExtraHeadVars0, ExtraArgModes0,
+ InstanceUnconstrainedTVars,
+ InstanceUnconstrainedTypeInfoVars, HeadVars0, HeadVars,
+ ExtraArgModes, HeadTypeVars, UnconstrainedTVars,
+ ExtraHeadTypeInfoVars, ExistHeadTypeClassInfoVars,
+ PolyInfo0, PolyInfo)
+ ;
+ MaybeInstanceMethodConstraints =
+ yes(InstanceMethodConstraints),
+ polymorphism__setup_headvars_instance_method(PredInfo,
+ InstanceMethodConstraints, HeadVars0, HeadVars,
+ ExtraArgModes, HeadTypeVars, UnconstrainedTVars,
+ ExtraHeadTypeInfoVars, ExistHeadTypeClassInfoVars,
+ PolyInfo0, PolyInfo)
+ ).
+
+ %
+ % For class method implementations, do_call_class_method
+ % extras type-infos and typeclass-infos from the
+ % typeclass-info and pastes them onto the front of
+ % the argument list. We need to match that order here.
+ %
+:- pred polymorphism__setup_headvars_instance_method(pred_info,
+ instance_method_constraints, list(prog_var), list(prog_var),
+ list(mode), list(tvar), list(tvar), list(prog_var),
+ list(prog_var), poly_info, poly_info).
+:- mode polymorphism__setup_headvars_instance_method(in, in, in, out, out, out,
+ out, out, out, in, out) is det.
+
+polymorphism__setup_headvars_instance_method(PredInfo,
+ InstanceMethodConstraints, HeadVars0, HeadVars, ExtraArgModes,
+ HeadTypeVars, UnconstrainedTVars, ExtraHeadTypeInfoVars,
+ ExistHeadTypeClassInfoVars, PolyInfo0, PolyInfo) :-
+
+ InstanceMethodConstraints = instance_method_constraints(_,
+ InstanceTypes, InstanceConstraints, ClassContext),
+
+ term__vars_list(InstanceTypes, InstanceTVars),
+ get_unconstrained_tvars(InstanceTVars, InstanceConstraints,
+ UnconstrainedInstanceTVars),
+ pred_info_arg_types(PredInfo, ArgTypeVarSet, _, _),
+ polymorphism__make_head_vars(UnconstrainedInstanceTVars,
+ ArgTypeVarSet, UnconstrainedInstanceTypeInfoVars,
+ PolyInfo0, PolyInfo1),
+ polymorphism__make_typeclass_info_head_vars(InstanceConstraints,
+ InstanceHeadTypeClassInfoVars, PolyInfo1, PolyInfo2),
+ poly_info_get_typeclass_info_map(PolyInfo2, TCVarMap0),
+ map__det_insert_from_corresponding_lists(TCVarMap0,
+ InstanceConstraints, InstanceHeadTypeClassInfoVars, TCVarMap),
+ poly_info_set_typeclass_info_map(TCVarMap, PolyInfo2, PolyInfo3),
+ list__append(UnconstrainedInstanceTypeInfoVars,
+ InstanceHeadTypeClassInfoVars, ExtraHeadVars0),
+ in_mode(InMode),
+ list__duplicate(list__length(ExtraHeadVars0), InMode, ExtraArgModes0),
+ polymorphism__setup_headvars_2(PredInfo, ClassContext,
+ ExtraHeadVars0, ExtraArgModes0, UnconstrainedInstanceTVars,
+ UnconstrainedInstanceTypeInfoVars, HeadVars0, HeadVars,
+ ExtraArgModes, HeadTypeVars,
+ UnconstrainedTVars, ExtraHeadTypeInfoVars,
+ ExistHeadTypeClassInfoVars, PolyInfo3, PolyInfo).
+
+:- pred polymorphism__setup_headvars_2(pred_info, class_constraints,
+ list(prog_var), list(mode), list(tvar), list(prog_var),
+ list(prog_var), list(prog_var), list(mode), list(tvar),
+ list(tvar), list(prog_var), list(prog_var),
+ poly_info, poly_info).
+:- mode polymorphism__setup_headvars_2(in, in, in, in, in, in, in,
+ out, out, out, out, out, out, in, out) is det.
+
+polymorphism__setup_headvars_2(PredInfo, ClassContext, ExtraHeadVars0,
+ ExtraArgModes0, UnconstrainedInstanceTVars,
+ UnconstrainedInstanceTypeInfoVars, HeadVars0,
+ HeadVars, ExtraArgModes, HeadTypeVars, AllUnconstrainedTVars,
+ AllExtraHeadTypeInfoVars, ExistHeadTypeClassInfoVars,
+ PolyInfo0, PolyInfo) :-
%
% grab the appropriate fields from the pred_info
%
pred_info_arg_types(PredInfo, ArgTypeVarSet, ExistQVars, ArgTypes),
- pred_info_get_class_context(PredInfo, ClassContext),
-
%
% Insert extra head variables to hold the address of the
@@ -703,7 +786,12 @@
UnconstrainedTVars0),
list__delete_elems(UnconstrainedTVars0, ExistConstrainedTVars,
UnconstrainedTVars1),
- list__remove_dups(UnconstrainedTVars1, UnconstrainedTVars),
+
+ % Type-infos for the unconstrained instance tvars have already
+ % been introduced by polymorphism__setup_headvars_instance_method.
+ list__delete_elems(UnconstrainedTVars1, UnconstrainedInstanceTVars,
+ UnconstrainedTVars2),
+ list__remove_dups(UnconstrainedTVars2, UnconstrainedTVars),
( ExistQVars = [] ->
% optimize common case
@@ -720,15 +808,25 @@
ArgTypeVarSet, ExistHeadTypeInfoVars,
PolyInfo2, PolyInfo3)
),
- polymorphism__make_head_vars(UnconstrainedUnivTVars, ArgTypeVarSet,
- UnivHeadTypeInfoVars, PolyInfo3, PolyInfo4),
+
+ polymorphism__make_head_vars(UnconstrainedUnivTVars,
+ ArgTypeVarSet, UnivHeadTypeInfoVars, PolyInfo3, PolyInfo4),
list__append(UnivHeadTypeInfoVars, ExistHeadTypeInfoVars,
ExtraHeadTypeInfoVars),
- % First the type_infos, then the typeclass_infos,
- % but we have to do it in reverse because we're appending...
+ list__append(UnconstrainedInstanceTypeInfoVars, ExtraHeadTypeInfoVars,
+ AllExtraHeadTypeInfoVars),
+ list__condense([UnconstrainedInstanceTVars, UnconstrainedUnivTVars,
+ UnconstrainedExistTVars], AllUnconstrainedTVars),
+
+ % First the type_infos and typeclass_infos from
+ % the typeclass_info if this is an instance method
+ % implementation, then the type_infos, then the
+ % typeclass_infos, but we have to do it in reverse
+ % because we're appending...
list__append(ExtraHeadTypeClassInfoVars, HeadVars0, HeadVars1),
- list__append(ExtraHeadTypeInfoVars, HeadVars1, HeadVars),
+ list__append(ExtraHeadTypeInfoVars, HeadVars1, HeadVars2),
+ list__append(ExtraHeadVars0, HeadVars2, HeadVars),
%
% Figure out the modes of the introduced type_info and
@@ -744,7 +842,7 @@
list__duplicate(NumUnconstrainedExistTVars, Out, ExistTypeInfoModes),
list__duplicate(NumUnivClassInfoVars, In, UnivTypeClassInfoModes),
list__duplicate(NumExistClassInfoVars, Out, ExistTypeClassInfoModes),
- list__condense([UnivTypeInfoModes, ExistTypeInfoModes,
+ list__condense([ExtraArgModes0, UnivTypeInfoModes, ExistTypeInfoModes,
UnivTypeClassInfoModes, ExistTypeClassInfoModes],
ExtraArgModes),
@@ -763,13 +861,21 @@
list__map(ToLocn, ExistHeadTypeInfoVars, ExistTypeLocns),
map__det_insert_from_corresponding_lists(TypeInfoMap4,
UnconstrainedExistTVars, ExistTypeLocns, TypeInfoMap5),
+
+ list__map(ToLocn, UnconstrainedInstanceTypeInfoVars,
+ UnconstrainedInstanceTypeLocns),
+ map__det_insert_from_corresponding_lists(TypeInfoMap5,
+ UnconstrainedInstanceTVars, UnconstrainedInstanceTypeLocns,
+ TypeInfoMap6),
- poly_info_set_type_info_map(TypeInfoMap5, PolyInfo4, PolyInfo5),
+ poly_info_set_type_info_map(TypeInfoMap6, PolyInfo4, PolyInfo5),
% Make a map of the locations of the typeclass_infos
- map__from_corresponding_lists(UnivConstraints,
- UnivHeadTypeClassInfoVars, TypeClassInfoMap),
- poly_info_set_typeclass_info_map(TypeClassInfoMap, PolyInfo5, PolyInfo).
+ poly_info_get_typeclass_info_map(PolyInfo5, TypeClassInfoMap0),
+ map__det_insert_from_corresponding_lists(TypeClassInfoMap0,
+ UnivConstraints, UnivHeadTypeClassInfoVars, TypeClassInfoMap),
+ poly_info_set_typeclass_info_map(TypeClassInfoMap,
+ PolyInfo5, PolyInfo).
% XXX the following code ought to be rewritten to handle
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.295
diff -u -u -r1.295 typecheck.m
--- compiler/typecheck.m 2000/12/13 00:00:29 1.295
+++ compiler/typecheck.m 2001/01/13 09:07:29
@@ -527,6 +527,8 @@
; % Inferring = no
pred_info_set_head_type_params(PredInfo5,
HeadTypeParams2, PredInfo6),
+ pred_info_get_maybe_instance_method_constraints(
+ PredInfo6, MaybeInstanceMethodConstraints0),
%
% leave the original argtypes etc., but
@@ -544,7 +546,9 @@
% optimize common case
ExistQVars1 = [],
ArgTypes1 = ArgTypes0,
- PredConstraints1 = PredConstraints
+ PredConstraints1 = PredConstraints,
+ MaybeInstanceMethodConstraints1 =
+ MaybeInstanceMethodConstraints0
;
apply_var_renaming_to_var_list(ExistQVars0,
ExistTypeRenaming, ExistQVars1),
@@ -553,7 +557,11 @@
ArgTypes1),
apply_variable_renaming_to_constraints(
ExistTypeRenaming,
- PredConstraints, PredConstraints1)
+ PredConstraints, PredConstraints1),
+ rename_instance_method_constraints(
+ ExistTypeRenaming,
+ MaybeInstanceMethodConstraints0,
+ MaybeInstanceMethodConstraints1)
),
% rename them all to match the new typevarset
@@ -563,12 +571,18 @@
TVarRenaming, RenamedOldArgTypes),
apply_variable_renaming_to_constraints(TVarRenaming,
PredConstraints1, RenamedOldConstraints),
+ rename_instance_method_constraints(TVarRenaming,
+ MaybeInstanceMethodConstraints1,
+ MaybeInstanceMethodConstraints),
% save the results in the pred_info
pred_info_set_arg_types(PredInfo6, TypeVarSet,
ExistQVars, RenamedOldArgTypes, PredInfo7),
pred_info_set_class_context(PredInfo7,
- RenamedOldConstraints, PredInfo),
+ RenamedOldConstraints, PredInfo8),
+ pred_info_set_maybe_instance_method_constraints(
+ PredInfo8, MaybeInstanceMethodConstraints,
+ PredInfo),
Changed = no
),
@@ -580,6 +594,27 @@
% is_bool/1 is used to avoid a type ambiguity
:- pred is_bool(bool::in) is det.
is_bool(_).
+
+:- pred rename_instance_method_constraints(map(tvar, tvar),
+ maybe(instance_method_constraints),
+ maybe(instance_method_constraints)).
+:- mode rename_instance_method_constraints(in, in, out) is det.
+
+rename_instance_method_constraints(_, no, no).
+rename_instance_method_constraints(Renaming,
+ yes(Constraints0), yes(Constraints)) :-
+ Constraints0 = instance_method_constraints(ClassId,
+ InstanceTypes0, InstanceConstraints0,
+ ClassMethodClassContext0),
+ term__apply_variable_renaming_to_list(InstanceTypes0,
+ Renaming, InstanceTypes),
+ apply_variable_renaming_to_constraint_list(Renaming,
+ InstanceConstraints0, InstanceConstraints),
+ apply_variable_renaming_to_constraints(Renaming,
+ ClassMethodClassContext0, ClassMethodClassContext),
+ Constraints = instance_method_constraints(ClassId,
+ InstanceTypes, InstanceConstraints,
+ ClassMethodClassContext).
%
% infer which of the head variable
Index: tests/hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.42
diff -u -u -r1.42 Mmakefile
--- tests/hard_coded/typeclasses/Mmakefile 2000/11/06 04:10:05 1.42
+++ tests/hard_coded/typeclasses/Mmakefile 2001/01/13 22:40:16
@@ -49,6 +49,8 @@
tuple_instance \
typeclass_exist_method \
typeclass_exist_method_2 \
+ typeclass_order_bug \
+ typeclass_order_bug2 \
typeclass_test_5 \
typeclass_test_6 \
type_spec \
Index: tests/hard_coded/typeclasses/typeclass_order_bug.exp
===================================================================
RCS file: typeclass_order_bug.exp
diff -N typeclass_order_bug.exp
--- /dev/null Sun Jan 14 20:05:00 2001
+++ typeclass_order_bug.exp Sat Jan 13 15:42:20 2001
@@ -0,0 +1,3 @@
+yes("ok")
+yes(1)
+
Index: tests/hard_coded/typeclasses/typeclass_order_bug.m
===================================================================
RCS file: typeclass_order_bug.m
diff -N typeclass_order_bug.m
--- /dev/null Sun Jan 14 20:05:00 2001
+++ typeclass_order_bug.m Sun Jan 14 09:39:43 2001
@@ -0,0 +1,41 @@
+% The code generated for this test case by the compiler
+% of 13/1/2001 aborted with the following output:
+%
+% yes(135251024)
+% yes("
+% *** Mercury runtime: caught segmentation violation ***
+%
+% The type-infos for T and U were being passed in the wrong order.
+%
+:- module typeclass_order_bug.
+
+:- interface.
+
+:- import_module io, std_util.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- typeclass p(T, U) where [
+ pred m(U, T, io__state, io__state),
+ mode m(in, in, di, uo) is det
+].
+
+:- instance p(maybe(T), maybe(U)) where [
+ pred(m/4) is write_maybe_pair
+].
+
+:- implementation.
+
+main -->
+ m(yes("ok"), yes(1)),
+ io__nl.
+
+:- pred write_maybe_pair(maybe(T), maybe(U), io__state, io__state).
+:- mode write_maybe_pair(in, in, di, uo) is det.
+
+write_maybe_pair(MaybeT, MaybeU) -->
+ io__write(MaybeT),
+ io__nl,
+ io__write(MaybeU),
+ io__nl.
+
Index: tests/hard_coded/typeclasses/typeclass_order_bug2.exp
===================================================================
RCS file: typeclass_order_bug2.exp
diff -N typeclass_order_bug2.exp
--- /dev/null Sun Jan 14 20:05:00 2001
+++ typeclass_order_bug2.exp Sat Jan 13 15:42:12 2001
@@ -0,0 +1,7 @@
+2
+"string"
+3
+"string"
+4
+"string"
+"string"
Index: tests/hard_coded/typeclasses/typeclass_order_bug2.m
===================================================================
RCS file: typeclass_order_bug2.m
diff -N typeclass_order_bug2.m
--- /dev/null Sun Jan 14 20:05:00 2001
+++ typeclass_order_bug2.m Sun Jan 14 09:39:57 2001
@@ -0,0 +1,54 @@
+% This module tests class methods with unconstrained type
+% variables.
+%
+% The code generated by the compiler of 13/1/2001 for this test case
+% segfaults. The problem is that the argument types of
+% 'Introduced_pred_for_extra_var_method__class__list__list__arity_1______extra_var_method__p_4'
+% after polymorphism are (TypeInfo_for_U, TypeclassInfo_for_class, ...),
+% but do_call_class_method is passing in
+% (TypeclassInfo_for_class, TypeInfo_for_U, ...).
+%
+:- module typeclass_order_bug2.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int, list.
+
+:- typeclass class(T) where [
+ pred p(U::in, T::in, io__state::di, io__state::uo) is det
+].
+
+:- instance class(list(T)) <= class(T) where [
+ pred(p/4) is p_list
+].
+
+:- instance class(int) where [
+ pred(p/4) is p_int
+].
+
+main -->
+ p("string", [1,2,3]).
+
+
+:- pred p_list(U::in, list(T)::in, io__state::di,
+ io__state::uo) is det <= class(T).
+
+p_list(U, List) -->
+ list__foldl(p(U), List),
+ io__write(U),
+ io__nl.
+
+:- pred p_int(U::in, int::in, io__state::di, io__state::uo) is det.
+
+p_int(U, Int) -->
+ io__write_int(Int + 1),
+ io__nl,
+ io__write(U),
+ io__nl.
+
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list