[m-dev.] diff: fix bugs in type specialization
Simon Taylor
stayl at cs.mu.OZ.AU
Fri Sep 1 22:48:49 AEDT 2000
Estimated hours taken: 4
Fix type specialization of calls to class methods for which
the instance declaration has unconstrained type variables.
Fix bugs in the specialization of existentially quantified
procedures.
compiler/higher_order.m:
Extract the type_infos for the unconstrained type variables
from the typeclass_info and pass them to the call.
Only pass the universally quantified type parameters, not
the head_type_params, when working out type substitutions
for specialized versions of predicates, since the existentially
quantified type variables can be bound by the substitution.
compiler/polymorphism.m:
Make sure that the types of the type_infos for existentially
quantified types match the types of the variables they describe.
We were getting this right for the types returned by
pred_info_arg_types, but the types in the vartypes fields
of the clauses_infos and proc_infos weren't bound enough.
As a result, polymorphism was producing unifications such as
`TypeInfo_for_T : type_info(T) =
TypeInfo_for_string : type_info(string)'.
This is likely to cause problems for optimization passes.
tests/hard_coded/typeclasses/Mmakefile:
Remove `--no-user-guided-type-specialization' flags which
were used to work around these bugs.
tests/hard_coded/typeclasses/instance_unconstrained_tvar_type_spec.m:
tests/hard_coded/typeclasses/instance_unconstrained_tvar_type_spec.exp:
Test case.
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.68
diff -u -u -r1.68 higher_order.m
--- compiler/higher_order.m 2000/08/10 05:10:54 1.68
+++ compiler/higher_order.m 2000/09/01 10:55:13
@@ -292,8 +292,7 @@
Sizes, Sizes, ModuleInfo, ModuleInfo).
get_specialization_requests(Params, [PredId | PredIds], NewPreds, Requests0,
Requests, GoalSizes0, GoalSizes, ModuleInfo0, ModuleInfo) :-
- module_info_preds(ModuleInfo0, Preds0),
- map__lookup(Preds0, PredId, PredInfo0),
+ module_info_pred_info(ModuleInfo0, PredId, PredInfo0),
pred_info_non_imported_procids(PredInfo0, NonImportedProcs),
(
NonImportedProcs = [],
@@ -320,8 +319,8 @@
ModuleInfo1, ModuleInfo2, PredInfo1, PredInfo2,
NewPreds, Requests1, Requests2, Procs1, Procs),
pred_info_set_procedures(PredInfo2, Procs, PredInfo),
- map__det_update(Preds0, PredId, PredInfo, Preds),
- module_info_set_preds(ModuleInfo2, Preds, ModuleInfo3)
+ module_info_set_pred_info(ModuleInfo2,
+ PredId, PredInfo, ModuleInfo3)
),
get_specialization_requests(Params, PredIds, NewPreds,
Requests2, Requests, GoalSizes1, GoalSizes,
@@ -739,10 +738,14 @@
map__lookup(Instances, ClassId, InstanceList),
list__index1_det(InstanceList, Instance, InstanceDefn),
InstanceDefn = hlds_instance_defn(_, _,
- InstanceConstraints, _, _,
+ InstanceConstraints, InstanceTypes0, _,
yes(ClassInterface), _, _),
- list__length(InstanceConstraints, InstanceArity),
- list__take(InstanceArity, OtherTypeClassArgs,
+ term__vars_list(InstanceTypes0, InstanceTvars),
+ get_unconstrained_tvars(InstanceTvars,
+ InstanceConstraints, UnconstrainedTVars),
+ NumArgsToExtract = list__length(InstanceConstraints)
+ + list__length(UnconstrainedTVars),
+ list__take(NumArgsToExtract, OtherTypeClassArgs,
InstanceConstraintArgs)
->
list__index1_det(ClassInterface, Method,
@@ -782,37 +785,31 @@
pred_info_typevarset(CallerPredInfo0, TVarSet0),
find_matching_instance_method(Instances, Method,
ClassArgs, PredId, ProcId, InstanceConstraints,
- TVarSet0, TVarSet)
+ UnconstrainedTVarTypes, TVarSet0, TVarSet)
->
pred_info_set_typevarset(CallerPredInfo0,
TVarSet, CallerPredInfo),
% Pull out the argument typeclass_infos.
- ( InstanceConstraints = [] ->
+ ( InstanceConstraints = [], UnconstrainedTVarTypes = [] ->
ExtraGoals = [],
CallerProcInfo = CallerProcInfo0,
AllArgs = Args
;
- mercury_private_builtin_module(PrivateBuiltin),
- module_info_get_predicate_table(ModuleInfo, PredTable),
- ExtractArgSymName = qualified(PrivateBuiltin,
- "instance_constraint_from_typeclass_info"),
- (
- predicate_table_search_pred_sym_arity(
- PredTable, ExtractArgSymName,
- 3, [ExtractArgPredId0])
- ->
- ExtractArgPredId = ExtractArgPredId0
- ;
- error(
- "higher_order.m: can't find `instance_constraint_from_typeclass_info'")
- ),
- hlds_pred__initial_proc_id(ExtractArgProcId),
- get_arg_typeclass_infos(PredVar, ExtractArgPredId,
- ExtractArgProcId, ExtractArgSymName,
- InstanceConstraints, 1,
- ExtraGoals, ArgTypeClassInfos,
- CallerProcInfo0, CallerProcInfo),
- list__append(ArgTypeClassInfos, Args, AllArgs)
+ get_unconstrained_instance_type_infos(ModuleInfo,
+ PredVar, UnconstrainedTVarTypes, 1,
+ ArgTypeInfoGoals, ArgTypeInfoVars,
+ CallerProcInfo0, CallerProcInfo1),
+ FirstArgTypeclassInfo =
+ list__length(UnconstrainedTVarTypes) + 1,
+ get_arg_typeclass_infos(ModuleInfo, PredVar,
+ InstanceConstraints, FirstArgTypeclassInfo,
+ ArgTypeClassInfoGoals, ArgTypeClassInfoVars,
+ CallerProcInfo1, CallerProcInfo),
+ list__condense(
+ [ArgTypeInfoVars, ArgTypeClassInfoVars, Args],
+ AllArgs),
+ list__append(ArgTypeInfoGoals,
+ ArgTypeClassInfoGoals, ExtraGoals)
),
Info1 = info(PredVars, Requests0, NewPreds, PredProcId,
CallerPredInfo, CallerProcInfo, ModuleInfo,
@@ -828,16 +825,20 @@
:- pred find_matching_instance_method(list(hlds_instance_defn)::in, int::in,
list(type)::in, pred_id::out, proc_id::out,
- list(class_constraint)::out, tvarset::in, tvarset::out) is semidet.
+ list(class_constraint)::out, list(type)::out,
+ tvarset::in, tvarset::out) is semidet.
find_matching_instance_method([Instance | Instances], MethodNum,
- ClassTypes, PredId, ProcId, Constraints, TVarSet0, TVarSet) :-
+ ClassTypes, PredId, ProcId, Constraints,
+ UnconstrainedTVarTypes, TVarSet0, TVarSet) :-
(
instance_matches(ClassTypes, Instance,
- Constraints0, TVarSet0, TVarSet1)
+ Constraints0, UnconstrainedTVarTypes0,
+ TVarSet0, TVarSet1)
->
TVarSet = TVarSet1,
Constraints = Constraints0,
+ UnconstrainedTVarTypes = UnconstrainedTVarTypes0,
Instance = hlds_instance_defn(_, _, _,
_, _, yes(ClassInterface), _, _),
list__index1_det(ClassInterface, MethodNum,
@@ -845,60 +846,129 @@
;
find_matching_instance_method(Instances, MethodNum,
ClassTypes, PredId, ProcId, Constraints,
- TVarSet0, TVarSet)
+ UnconstrainedTVarTypes, TVarSet0, TVarSet)
).
:- pred instance_matches(list(type)::in, hlds_instance_defn::in,
- list(class_constraint)::out, tvarset::in, tvarset::out) is semidet.
+ list(class_constraint)::out, list(type)::out,
+ tvarset::in, tvarset::out) is semidet.
-instance_matches(ClassTypes, Instance, Constraints, TVarSet0, TVarSet) :-
+instance_matches(ClassTypes, Instance, Constraints, UnconstrainedTVarTypes,
+ TVarSet0, TVarSet) :-
Instance = hlds_instance_defn(_, _, Constraints0,
InstanceTypes0, _, _, InstanceTVarSet, _),
varset__merge_subst(TVarSet0, InstanceTVarSet, TVarSet,
RenameSubst),
term__apply_substitution_to_list(InstanceTypes0,
RenameSubst, InstanceTypes),
- type_list_subsumes(InstanceTypes, ClassTypes, Subst),
apply_subst_to_constraint_list(RenameSubst,
Constraints0, Constraints1),
+ term__vars_list(InstanceTypes, InstanceTVars),
+ get_unconstrained_tvars(InstanceTVars, Constraints1,
+ UnconstrainedTVars0),
+
+ type_list_subsumes(InstanceTypes, ClassTypes, Subst),
apply_rec_subst_to_constraint_list(Subst,
- Constraints1, Constraints).
+ Constraints1, Constraints),
+
+ term__var_list_to_term_list(UnconstrainedTVars0,
+ UnconstrainedTVarTypes0),
+ term__apply_rec_substitution_to_list(UnconstrainedTVarTypes0,
+ Subst, UnconstrainedTVarTypes).
% Build calls to
% `private_builtin:instance_constraint_from_typeclass_info/3'
% to extract the typeclass_infos for the constraints on an instance.
% This simulates the action of `do_call_class_method' in
% runtime/mercury_ho_call.c.
-:- pred get_arg_typeclass_infos(prog_var::in, pred_id::in, proc_id::in,
- sym_name::in, list(class_constraint)::in, int::in,
- list(hlds_goal)::out, list(prog_var)::out,
- proc_info::in, proc_info::out) is det.
+:- pred get_arg_typeclass_infos(module_info::in, prog_var::in,
+ list(class_constraint)::in, int::in, list(hlds_goal)::out,
+ list(prog_var)::out, proc_info::in, proc_info::out) is det.
+
+get_arg_typeclass_infos(ModuleInfo, TypeClassInfoVar,
+ InstanceConstraints, Index, Goals, Vars,
+ ProcInfo0, ProcInfo) :-
+
+ MakeResultType = polymorphism__build_typeclass_info_type,
+ get_typeclass_info_args(ModuleInfo, TypeClassInfoVar,
+ "instance_constraint_from_typeclass_info", MakeResultType,
+ InstanceConstraints, Index, Goals, Vars, ProcInfo0, ProcInfo).
-get_arg_typeclass_infos(_, _, _, _, [], _, [], [], ProcInfo, ProcInfo).
-get_arg_typeclass_infos(TypeClassInfoVar, PredId, ProcId, SymName,
- [InstanceConstraint | InstanceConstraints],
- ConstraintNum, [ConstraintNumGoal, CallGoal | Goals],
- [ArgTypeClassInfoVar | Vars], ProcInfo0, ProcInfo) :-
- polymorphism__build_typeclass_info_type(InstanceConstraint,
- ArgTypeClassInfoType),
- proc_info_create_var_from_type(ProcInfo0, ArgTypeClassInfoType,
- ArgTypeClassInfoVar, ProcInfo1),
+ % Build calls to
+ % `private_builtin:unconstrained_type_info_from_typeclass_info/3'
+ % to extract the type-infos for the unconstrained type variables
+ % of an instance declaration.
+ % This simulates the action of `do_call_class_method' in
+ % runtime/mercury_ho_call.c.
+:- pred get_unconstrained_instance_type_infos(module_info::in,
+ prog_var::in, list(type)::in, int::in, list(hlds_goal)::out,
+ list(prog_var)::out, proc_info::in, proc_info::out) is det.
+
+get_unconstrained_instance_type_infos(ModuleInfo, TypeClassInfoVar,
+ UnconstrainedTVarTypes, Index, Goals, Vars,
+ ProcInfo0, ProcInfo) :-
+ MakeResultType = polymorphism__build_type_info_type,
+ get_typeclass_info_args(ModuleInfo, TypeClassInfoVar,
+ "unconstrained_type_info_from_typeclass_info",
+ MakeResultType, UnconstrainedTVarTypes,
+ Index, Goals, Vars, ProcInfo0, ProcInfo).
+
+:- pred get_typeclass_info_args(module_info::in, prog_var::in, string::in,
+ pred(T, type)::(pred(in, out) is det),
+ list(T)::in, int::in, list(hlds_goal)::out,
+ list(prog_var)::out, proc_info::in, proc_info::out) is det.
+
+get_typeclass_info_args(ModuleInfo, TypeClassInfoVar, PredName, MakeResultType,
+ Args, Index, Goals, Vars, ProcInfo0, ProcInfo) :-
+ mercury_private_builtin_module(PrivateBuiltin),
+ SymName = qualified(PrivateBuiltin, PredName),
+ module_info_get_predicate_table(ModuleInfo, PredTable),
+ (
+ predicate_table_search_pred_sym_arity(PredTable,
+ SymName, 3, [ExtractArgPredId0])
+ ->
+ ExtractArgPredId = ExtractArgPredId0
+ ;
+ string__append("higher_order.m: can't find private_builtin__",
+ PredName, Msg),
+ error(Msg)
+ ),
+ hlds_pred__initial_proc_id(ExtractArgProcId),
+ get_typeclass_info_args_2(TypeClassInfoVar, ExtractArgPredId,
+ ExtractArgProcId, SymName, MakeResultType,
+ Args, Index, Goals, Vars, ProcInfo0, ProcInfo).
+
+:- pred get_typeclass_info_args_2(prog_var::in, pred_id::in, proc_id::in,
+ sym_name::in, pred(T, type)::(pred(in, out) is det),
+ list(T)::in, int::in, list(hlds_goal)::out,
+ list(prog_var)::out, proc_info::in, proc_info::out) is det.
+
+get_typeclass_info_args_2(_, _, _, _, _, [], _, [], [], ProcInfo, ProcInfo).
+get_typeclass_info_args_2(TypeClassInfoVar, PredId, ProcId, SymName,
+ MakeResultType, [Arg | Args], Index,
+ [IndexGoal, CallGoal | Goals],
+ [ResultVar | Vars], ProcInfo0, ProcInfo) :-
+ MakeResultType(Arg, ResultType),
+ proc_info_create_var_from_type(ProcInfo0, ResultType,
+ ResultVar, ProcInfo1),
MaybeContext = no,
- make_int_const_construction(ConstraintNum, ConstraintNumGoal,
- ConstraintNumVar, ProcInfo1, ProcInfo2),
- Args = [TypeClassInfoVar, ConstraintNumVar, ArgTypeClassInfoVar],
+ make_int_const_construction(Index, IndexGoal,
+ IndexVar, ProcInfo1, ProcInfo2),
+ CallArgs = [TypeClassInfoVar, IndexVar, ResultVar],
- set__list_to_set(Args, NonLocals),
+ set__list_to_set(CallArgs, NonLocals),
instmap_delta_init_reachable(InstMapDelta0),
- instmap_delta_insert(InstMapDelta0, ArgTypeClassInfoVar,
+ instmap_delta_insert(InstMapDelta0, ResultVar,
ground(shared, no), InstMapDelta),
goal_info_init(NonLocals, InstMapDelta, det, GoalInfo),
- CallGoal = call(PredId, ProcId, Args, not_builtin,
+ CallGoal = call(PredId, ProcId, CallArgs, not_builtin,
MaybeContext, SymName) - GoalInfo,
- get_arg_typeclass_infos(TypeClassInfoVar, PredId, ProcId, SymName,
- InstanceConstraints, ConstraintNum + 1, Goals,
- Vars, ProcInfo2, ProcInfo).
+ get_typeclass_info_args_2(TypeClassInfoVar, PredId, ProcId, SymName,
+ MakeResultType, Args, Index + 1, Goals, Vars,
+ ProcInfo2, ProcInfo).
+%-----------------------------------------------------------------------------%
+
:- pred construct_specialized_higher_order_call(module_info::in,
pred_id::in, proc_id::in, list(prog_var)::in, hlds_goal_info::in,
hlds_goal::out, higher_order_info::in, higher_order_info::out) is det.
@@ -931,7 +1001,8 @@
;
error("higher_order.m: call expected")
),
- module_info_pred_info(Module0, CalledPred, CalleePredInfo),
+ module_info_pred_proc_info(Module0, CalledPred, CalledProc,
+ CalleePredInfo, CalleeProcInfo),
module_info_globals(Module0, Globals),
globals__lookup_bool_option(Globals, special_preds, HaveSpecialPreds),
(
@@ -966,8 +1037,12 @@
Info = Info0,
Goal = Goal0
;
- pred_info_arg_types(CalleePredInfo, CalleeArgTypes),
pred_info_import_status(CalleePredInfo, CalleeStatus),
+ proc_info_vartypes(CalleeProcInfo, CalleeVarTypes),
+ proc_info_headvars(CalleeProcInfo, CalleeHeadVars),
+ map__apply_to_list(CalleeHeadVars,
+ CalleeVarTypes, CalleeArgTypes),
+
proc_info_vartypes(ProcInfo0, VarTypes),
find_higher_order_args(Module0, CalleeStatus, Args0,
CalleeArgTypes, VarTypes, PredVars, 1, [],
@@ -1006,9 +1081,12 @@
pred_info_get_exist_quant_tvars(CalleePredInfo,
CalleeExistQTVars),
pred_info_typevarset(PredInfo0, TVarSet),
+ pred_info_get_univ_quant_tvars(PredInfo0,
+ CallerUnivQTVars),
type_subst_makes_instance_known(
Module0, CalleeUnivConstraints0,
- TVarSet, ArgTypes, CalleeTVarSet,
+ TVarSet, CallerUnivQTVars,
+ ArgTypes, CalleeTVarSet,
CalleeExistQTVars, CalleeArgTypes)
)
->
@@ -1133,11 +1211,13 @@
% the class constraints match an instance which was not matched
% before.
:- pred type_subst_makes_instance_known(module_info::in,
- list(class_constraint)::in, tvarset::in, list(type)::in,
- tvarset::in, existq_tvars::in, list(type)::in) is semidet.
+ list(class_constraint)::in, tvarset::in, list(tvar)::in,
+ list(type)::in, tvarset::in, existq_tvars::in,
+ list(type)::in) is semidet.
type_subst_makes_instance_known(ModuleInfo, CalleeUnivConstraints0, TVarSet0,
- ArgTypes, CalleeTVarSet, CalleeExistQVars, CalleeArgTypes0) :-
+ CallerHeadTypeParams, ArgTypes, CalleeTVarSet,
+ CalleeExistQVars, CalleeArgTypes0) :-
CalleeUnivConstraints0 \= [],
varset__merge_subst(TVarSet0, CalleeTVarSet,
TVarSet, TypeRenaming),
@@ -1145,11 +1225,8 @@
CalleeArgTypes1),
% Substitute the types in the callee's class constraints.
- % Typechecking has already succeeded, so none of the head type
- % variables will be bound by the substitution.
- HeadTypeParams = [],
inlining__get_type_substitution(CalleeArgTypes1, ArgTypes,
- HeadTypeParams, CalleeExistQVars, TypeSubn),
+ CallerHeadTypeParams, CalleeExistQVars, TypeSubn),
apply_subst_to_constraint_list(TypeRenaming,
CalleeUnivConstraints0, CalleeUnivConstraints1),
apply_rec_subst_to_constraint_list(TypeSubn,
@@ -1167,8 +1244,8 @@
module_info_instances(ModuleInfo, InstanceTable),
map__search(InstanceTable, class_id(ClassName, ClassArity), Instances),
list__member(Instance, Instances),
- instance_matches(ConstraintArgs, Instance, _, TVarSet, _),
- \+ instance_matches(ConstraintArgs0, Instance, _, TVarSet, _).
+ instance_matches(ConstraintArgs, Instance, _, _, TVarSet, _),
+ \+ instance_matches(ConstraintArgs0, Instance, _, _, TVarSet, _).
:- type find_result
---> match(match)
@@ -2265,14 +2342,14 @@
proc_info_headvars(NewProcInfo0, HeadVars0),
proc_info_argmodes(NewProcInfo0, ArgModes0),
- pred_info_arg_types(NewPredInfo0, _, ExistQVars0, _),
+ pred_info_get_exist_quant_tvars(NewPredInfo0, ExistQVars0),
pred_info_typevarset(NewPredInfo0, TypeVarSet0),
Caller = proc(CallerPredId, CallerProcId),
module_info_pred_proc_info(ModuleInfo, CallerPredId, CallerProcId,
CallerPredInfo, CallerProcInfo),
pred_info_arg_types(CallerPredInfo, CallerTypeVarSet, _, _),
- pred_info_get_head_type_params(CallerPredInfo, CallerHeadParams),
+ pred_info_get_univ_quant_tvars(CallerPredInfo, CallerHeadParams),
proc_info_typeinfo_varmap(CallerProcInfo, CallerTypeInfoVarMap0),
%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.194
diff -u -u -r1.194 polymorphism.m
--- compiler/polymorphism.m 2000/08/24 05:59:28 1.194
+++ compiler/polymorphism.m 2000/09/01 11:39:24
@@ -384,27 +384,69 @@
%
module_info_preds(ModuleInfo0, PredTable0),
map__lookup(PredTable0, PredId, PredInfo0),
- pred_info_clauses_info(PredInfo0, ClausesInfo),
- clauses_info_vartypes(ClausesInfo, VarTypes),
- clauses_info_headvars(ClausesInfo, HeadVars),
+ pred_info_clauses_info(PredInfo0, ClausesInfo0),
+ clauses_info_vartypes(ClausesInfo0, VarTypes0),
+ clauses_info_headvars(ClausesInfo0, HeadVars),
pred_info_arg_types(PredInfo0, TypeVarSet, ExistQVars, ArgTypes0),
list__length(ArgTypes0, NumOldArgs),
list__length(HeadVars, NumNewArgs),
NumExtraArgs is NumNewArgs - NumOldArgs,
(
- list__split_list(NumExtraArgs, HeadVars, ExtraHeadVars,
- _OldHeadVars)
+ list__split_list(NumExtraArgs, HeadVars, ExtraHeadVars0,
+ OldHeadVars0)
->
- map__apply_to_list(ExtraHeadVars, VarTypes,
- ExtraArgTypes),
- list__append(ExtraArgTypes, ArgTypes0, ArgTypes)
+ ExtraHeadVars = ExtraHeadVars0,
+ OldHeadVars = OldHeadVars0
;
error("polymorphism.m: list__split_list failed")
),
+ map__apply_to_list(ExtraHeadVars, VarTypes0, ExtraArgTypes),
+ list__append(ExtraArgTypes, ArgTypes0, ArgTypes),
pred_info_set_arg_types(PredInfo0, TypeVarSet, ExistQVars,
- ArgTypes, PredInfo),
+ ArgTypes, PredInfo1),
+
+ %
+ % If the clauses binds some existentially quantified
+ % type variables, make sure the types of the type-infos
+ % for those type variables in the variable types map
+ % are as specific as possible. The predicate argument
+ % types shouldn't be substituted, because the binding
+ % should not be visible to calling predicates.
+ %
+ (
+ ExistQVars \= [],
+ % This can fail for unification procedures
+ % of equivalence types.
+ map__apply_to_list(OldHeadVars, VarTypes0, OldHeadVarTypes),
+ type_list_subsumes(ArgTypes0, OldHeadVarTypes, Subn),
+ \+ map__is_empty(Subn)
+ ->
+ list__foldl(
+ (pred(HeadVar::in, Types0::in, Types::out) is det :-
+ map__lookup(Types0, HeadVar, HeadVarType0),
+ term__apply_rec_substitution(HeadVarType0,
+ Subn, HeadVarType),
+ map__set(Types0, HeadVar, HeadVarType, Types)
+ ), ExtraHeadVars, VarTypes0, VarTypes),
+ clauses_info_set_vartypes(ClausesInfo0, VarTypes, ClausesInfo),
+ pred_info_set_clauses_info(PredInfo1, ClausesInfo, PredInfo2),
+
+ % Fix up the var-types in the procedures as well.
+ % It would be better if this were done before copying
+ % clauses to procs, but that's difficult to arrange.
+ pred_info_procedures(PredInfo2, Procs0),
+ map__map_values(
+ (pred(_::in, ProcInfo0::in, ProcInfo::out) is det :-
+ proc_info_set_vartypes(ProcInfo0,
+ VarTypes, ProcInfo)
+ ), Procs0, Procs),
+ pred_info_set_procedures(PredInfo2, Procs, PredInfo)
+ ;
+ PredInfo = PredInfo1
+ ),
+
map__det_update(PredTable0, PredId, PredInfo, PredTable),
module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo1),
Index: tests/hard_coded/typeclasses/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/Mmakefile,v
retrieving revision 1.32
diff -u -u -r1.32 Mmakefile
--- tests/hard_coded/typeclasses/Mmakefile 2000/08/24 06:08:20 1.32
+++ tests/hard_coded/typeclasses/Mmakefile 2000/08/31 13:56:13
@@ -25,6 +25,7 @@
impure_methods \
instance_unconstrained_tvar \
instance_unconstrained_tvar_dup \
+ instance_unconstrained_tvar_type_spec \
inference_test \
inference_test_2 \
intermod_typeclass_bug \
@@ -63,13 +64,6 @@
MCFLAGS-unqualified_method = --intermodule-optimization
MCFLAGS-unqualified_method2 = --intermodule-optimization
MCFLAGS-unqualified_method3 = --intermodule-optimization
-
-# XXX Type specialization does not yet work for these test cases.
-NO_TYPE_SPEC_FLAGS = --no-user-guided-type-specialisation \
- --no-type-specialisation
-MCFLAGS-instance_unconstrained_tvar = $(NO_TYPE_SPEC_FLAGS)
-MCFLAGS-instance_unconstrained_tvar_dup = $(NO_TYPE_SPEC_FLAGS)
-MCFLAGS-typeclass_exist_method_2 = $(NO_TYPE_SPEC_FLAGS)
#-----------------------------------------------------------------------------#
Index: tests/hard_coded/typeclasses/instance_unconstrained_tvar_type_spec.exp
===================================================================
RCS file: instance_unconstrained_tvar_type_spec.exp
diff -N instance_unconstrained_tvar_type_spec.exp
--- /dev/null Fri Sep 1 22:26:20 2000
+++ instance_unconstrained_tvar_type_spec.exp Fri Sep 1 10:19:24 2000
@@ -0,0 +1 @@
+[1, 2, 3]
Index: tests/hard_coded/typeclasses/instance_unconstrained_tvar_type_spec.m
===================================================================
RCS file: instance_unconstrained_tvar_type_spec.m
diff -N instance_unconstrained_tvar_type_spec.m
--- /dev/null Fri Sep 1 22:26:20 2000
+++ instance_unconstrained_tvar_type_spec.m Fri Sep 1 00:31:42 2000
@@ -0,0 +1,30 @@
+:- module instance_unconstrained_tvar_type_spec.
+
+:- interface.
+
+:- import_module io, list.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- typeclass p(T) where [
+ pred m(T, io__state, io__state),
+ mode m(in, di, uo) is det
+].
+
+:- instance p(list(T)) where [
+ pred(m/3) is io__write
+].
+
+:- implementation.
+
+main -->
+ call_m([1, 2, 3]),
+ io__nl.
+
+:- pred call_m(T::in, io__state::di, io__state::uo) is det <= p(T).
+:- pragma type_spec(call_m/3, T = list(U)).
+:- pragma no_inline(call_m/3).
+
+call_m(T) -->
+ m(T).
+
--------------------------------------------------------------------------
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