[m-rev.] for review: fix mantis bug #76
Peter Wang
novalazy at gmail.com
Tue Aug 19 11:41:49 AEST 2008
I'm not sure if this is correct in all the spots, but FWIW it bootchecks and
passes the test suite.
Branches: main
Fix a compiler abort when writing out an intermodule optimisation file, the
module for which has a typeclass instance of a typeclass that has a method with
an existentially typed argument, but the predicate which implements
the method is not itself existentially typed. This is Mantis bug #76.
compiler/prog_type.m:
Make `arg_type_list_subsumes' possibly succeed if a callee may bind
existential type variables in the caller, rather than failing.
compiler/pred_table.m:
Update `resolve_pred_overloading' and `find_matching_pred_id' to take
extra arguments for `arg_type_list_subsumes'.
Rename `get_pred_id' and `get_pred_id_and_proc_id' to be less
ambiguous.
compiler/intermod.m:
compiler/modes.m:
compiler/post_typecheck.m:
compiler/purity.m:
Conform to extra arguments and renamings.
compiler/trans_opt.m:
Delete an unused predicate.
tests/valid/Mercury.options:
tests/valid/Mmakefile:
tests/valid/intermod_typeclass_exist.m:
Add test case.
diff --git a/compiler/intermod.m b/compiler/intermod.m
index 6dd297e..38a41c8 100644
--- a/compiler/intermod.m
+++ b/compiler/intermod.m
@@ -872,8 +872,10 @@ gather_instances_3(ModuleInfo, ClassId, InstanceDefn, !Info) :-
qualify_instance_method(ModuleInfo, MethodCallPredId - InstanceMethod0,
InstanceMethod, PredIds0, PredIds) :-
module_info_pred_info(ModuleInfo, MethodCallPredId, MethodCallPredInfo),
- pred_info_get_arg_types(MethodCallPredInfo, MethodCallTVarSet, _,
- MethodCallArgTypes),
+ pred_info_get_arg_types(MethodCallPredInfo, MethodCallTVarSet,
+ MethodCallExistQTVars, MethodCallArgTypes),
+ pred_info_get_head_type_params(MethodCallPredInfo,
+ MethodCallHeadTypeParams),
InstanceMethod0 = instance_method(PredOrFunc, MethodName,
InstanceMethodDefn0, MethodArity, MethodContext),
(
@@ -881,8 +883,9 @@ qualify_instance_method(ModuleInfo, MethodCallPredId - InstanceMethod0,
PredOrFunc = pf_function,
(
find_func_matching_instance_method(ModuleInfo, InstanceMethodName0,
- MethodArity, MethodCallTVarSet, MethodCallArgTypes,
- MaybePredId, InstanceMethodName)
+ MethodArity, MethodCallTVarSet, MethodCallExistQTVars,
+ MethodCallArgTypes, MethodCallHeadTypeParams, MaybePredId,
+ InstanceMethodName)
->
(
MaybePredId = yes(PredId),
@@ -904,9 +907,10 @@ qualify_instance_method(ModuleInfo, MethodCallPredId - InstanceMethod0,
InstanceMethodDefn0 = instance_proc_def_name(InstanceMethodName0),
PredOrFunc = pf_predicate,
init_markers(Markers),
- resolve_pred_overloading(ModuleInfo, Markers,
- MethodCallArgTypes, MethodCallTVarSet,
- InstanceMethodName0, InstanceMethodName, PredId),
+ resolve_pred_overloading(ModuleInfo, Markers, MethodCallTVarSet,
+ MethodCallExistQTVars, MethodCallArgTypes,
+ MethodCallHeadTypeParams, InstanceMethodName0, InstanceMethodName,
+ PredId),
PredIds = [PredId | PredIds0],
InstanceMethodDefn = instance_proc_def_name(InstanceMethodName)
;
@@ -930,12 +934,13 @@ qualify_instance_method(ModuleInfo, MethodCallPredId - InstanceMethod0,
% possible matches, we don't write the instance method.
%
:- pred find_func_matching_instance_method(module_info::in, sym_name::in,
- arity::in, tvarset::in, list(mer_type)::in, maybe(pred_id)::out,
- sym_name::out) is semidet.
+ arity::in, tvarset::in, existq_tvars::in, list(mer_type)::in,
+ head_type_params::in, maybe(pred_id)::out, sym_name::out) is semidet.
find_func_matching_instance_method(ModuleInfo, InstanceMethodName0,
- MethodArity, MethodCallTVarSet, MethodCallArgTypes,
- MaybePredId, InstanceMethodName) :-
+ MethodArity, MethodCallTVarSet, MethodCallExistQTVars,
+ MethodCallArgTypes, MethodCallHeadTypeParams, MaybePredId,
+ InstanceMethodName) :-
module_info_get_ctor_field_table(ModuleInfo, CtorFieldTable),
(
@@ -970,7 +975,8 @@ find_func_matching_instance_method(ModuleInfo, InstanceMethodName0,
may_be_partially_qualified, InstanceMethodName0,
MethodArity, PredIds),
find_matching_pred_id(ModuleInfo, PredIds, MethodCallTVarSet,
- MethodCallArgTypes, no, PredId, InstanceMethodFuncName)
+ MethodCallExistQTVars, MethodCallArgTypes,
+ MethodCallHeadTypeParams, no, PredId, InstanceMethodFuncName)
->
TypeCtors = [],
MaybePredId = yes(PredId),
@@ -1173,11 +1179,12 @@ resolve_user_special_pred_overloading(ModuleInfo, SpecialId,
module_info_get_special_pred_map(ModuleInfo, SpecialPreds),
map.lookup(SpecialPreds, SpecialId - TypeCtor, UnifyPredId),
module_info_pred_info(ModuleInfo, UnifyPredId, UnifyPredInfo),
- pred_info_get_arg_types(UnifyPredInfo, TVarSet, _, ArgTypes),
+ pred_info_get_arg_types(UnifyPredInfo, TVarSet, ExistQVars, ArgTypes),
+ pred_info_get_head_type_params(UnifyPredInfo, HeadTypeParams),
init_markers(Markers0),
add_marker(marker_calls_are_fully_qualified, Markers0, Markers),
- resolve_pred_overloading(ModuleInfo, Markers, ArgTypes,
- TVarSet, Pred0, Pred, UserEqPredId),
+ resolve_pred_overloading(ModuleInfo, Markers, TVarSet, ExistQVars,
+ ArgTypes, HeadTypeParams, Pred0, Pred, UserEqPredId),
add_proc(UserEqPredId, _, !Info).
:- pred should_write_type(module_name::in, type_ctor::in, hlds_type_defn::in)
diff --git a/compiler/modes.m b/compiler/modes.m
index c754ff2..4e523df 100644
--- a/compiler/modes.m
+++ b/compiler/modes.m
@@ -3483,11 +3483,14 @@ build_call(CalleeModuleName, CalleePredName, ArgVars, ArgTypes, NonLocals,
module_info_pred_proc_info(ModuleInfo0, PredId, ProcId, PredInfo0,
ProcInfo0),
pred_info_get_typevarset(PredInfo0, TVarSet),
+ pred_info_get_exist_quant_tvars(PredInfo0, ExistQTVars),
+ pred_info_get_head_type_params(PredInfo0, HeadTypeParams),
% Get the pred_info and proc_info for the procedure we are calling.
SymName = qualified(CalleeModuleName, CalleePredName),
- get_pred_id_and_proc_id(is_fully_qualified, SymName, pf_predicate, TVarSet,
- ArgTypes, ModuleInfo0, CalleePredId, CalleeProcId),
+ get_pred_id_and_proc_id_by_types(is_fully_qualified, SymName, pf_predicate,
+ TVarSet, ExistQTVars, ArgTypes, HeadTypeParams, ModuleInfo0,
+ CalleePredId, CalleeProcId),
module_info_pred_proc_info(ModuleInfo0, CalleePredId, CalleeProcId,
CalleePredInfo, CalleeProcInfo),
diff --git a/compiler/post_typecheck.m b/compiler/post_typecheck.m
index 486f568..96e20ed 100644
--- a/compiler/post_typecheck.m
+++ b/compiler/post_typecheck.m
@@ -433,12 +433,14 @@ finally_resolve_pred_overloading(Args0, CallerPredInfo, ModuleInfo, !PredName,
% Find the set of candidate pred_ids for predicates which
% have the specified name and arity.
pred_info_get_typevarset(CallerPredInfo, TVarSet),
+ pred_info_get_exist_quant_tvars(CallerPredInfo, ExistQVars),
+ pred_info_get_head_type_params(CallerPredInfo, HeadTypeParams),
pred_info_get_markers(CallerPredInfo, Markers),
pred_info_get_clauses_info(CallerPredInfo, ClausesInfo),
clauses_info_get_vartypes(ClausesInfo, VarTypes),
map.apply_to_list(Args0, VarTypes, ArgTypes),
- resolve_pred_overloading(ModuleInfo, Markers, ArgTypes, TVarSet,
- !PredName, !:PredId)
+ resolve_pred_overloading(ModuleInfo, Markers, TVarSet, ExistQVars,
+ ArgTypes, HeadTypeParams, !PredName, !:PredId)
;
!:PredName = get_qualified_pred_name(ModuleInfo, !.PredId)
).
@@ -978,14 +980,17 @@ resolve_unify_functor(X0, ConsId0, ArgVars0, Mode0, Unification0, UnifyContext,
% which subsume the actual argument/return types of this function call,
% and which have universal constraints consistent with what we expect.
pred_info_get_typevarset(!.PredInfo, TVarSet),
+ pred_info_get_exist_quant_tvars(!.PredInfo, ExistQTVars),
+ pred_info_get_head_type_params(!.PredInfo, HeadTypeParams),
map.apply_to_list(ArgVars0, !.VarTypes, ArgTypes0),
list.append(ArgTypes0, [TypeOfX], ArgTypes),
pred_info_get_constraint_map(!.PredInfo, ConstraintMap),
GoalPath = goal_info_get_goal_path(GoalInfo0),
ConstraintSearch =
search_hlds_constraint_list(ConstraintMap, unproven, GoalPath),
- find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes,
- yes(ConstraintSearch), PredId, QualifiedFuncName)
+ find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ExistQTVars,
+ ArgTypes, HeadTypeParams, yes(ConstraintSearch), PredId,
+ QualifiedFuncName)
->
% Convert function calls into predicate calls:
% replace `X = f(A, B, C)' with `f(A, B, C, X)'.
@@ -1013,9 +1018,12 @@ resolve_unify_functor(X0, ConsId0, ArgVars0, Mode0, Unification0, UnifyContext,
map.apply_to_list(ArgVars0, !.VarTypes, ArgTypes0),
AllArgTypes = ArgTypes0 ++ HOArgTypes,
pred_info_get_typevarset(!.PredInfo, TVarSet),
+ pred_info_get_exist_quant_tvars(!.PredInfo, ExistQVars),
+ pred_info_get_head_type_params(!.PredInfo, HeadTypeParams),
pred_info_get_markers(!.PredInfo, Markers),
- get_pred_id(calls_are_fully_qualified(Markers), Name,
- PredOrFunc, TVarSet, AllArgTypes, ModuleInfo, PredId)
+ get_pred_id_by_types(calls_are_fully_qualified(Markers), Name,
+ PredOrFunc, TVarSet, ExistQVars, AllArgTypes, HeadTypeParams,
+ ModuleInfo, PredId)
->
module_info_pred_info(ModuleInfo, PredId, PredInfo),
ProcIds = pred_info_procids(PredInfo),
@@ -1102,8 +1110,11 @@ find_matching_constructor(ModuleInfo, TVarSet, ConsId, Type, ArgTypes) :-
hlds_data.get_type_defn_kind_map(TypeDefn, TypeKindMap),
ConsArgTypes = list.map(func(C) = C ^ arg_type, ConsArgs),
- arg_type_list_subsumes(TVarSet, ArgTypes, TypeTVarSet, TypeKindMap,
- ConsExistQVars, ConsArgTypes).
+ % XXX is this correct?
+ ExistQVars = [],
+ HeadTypeParams = [],
+ arg_type_list_subsumes(TVarSet, ExistQVars, ArgTypes, HeadTypeParams,
+ TypeTVarSet, TypeKindMap, ConsExistQVars, ConsArgTypes).
%-----------------------------------------------------------------------------%
diff --git a/compiler/pred_table.m b/compiler/pred_table.m
index db55882..f4669ac 100644
--- a/compiler/pred_table.m
+++ b/compiler/pred_table.m
@@ -252,8 +252,8 @@
% Abort if there are multiple matching preds.
%
:- pred resolve_pred_overloading(module_info::in, pred_markers::in,
- list(mer_type)::in, tvarset::in, sym_name::in, sym_name::out, pred_id::out)
- is det.
+ tvarset::in, existq_tvars::in, list(mer_type)::in, head_type_params::in,
+ sym_name::in, sym_name::out, pred_id::out) is det.
% Find a predicate or function from the list of pred_ids which matches the
% given name and argument types. If the constraint_search argument is
@@ -261,8 +261,9 @@
% is expected. Fail if there is no matching pred. Abort if there are
% multiple matching preds.
%
-:- pred find_matching_pred_id(module_info::in, list(pred_id)::in, tvarset::in,
- list(mer_type)::in, maybe(constraint_search)::in(maybe(constraint_search)),
+:- pred find_matching_pred_id(module_info::in, list(pred_id)::in,
+ tvarset::in, existq_tvars::in, list(mer_type)::in, head_type_params::in,
+ maybe(constraint_search)::in(maybe(constraint_search)),
pred_id::out, sym_name::out) is semidet.
% A means to check that the required constraints are available, without
@@ -274,15 +275,16 @@
% Get the pred_id and proc_id matching a higher-order term with
% the given argument types, aborting with an error if none is found.
%
-:- pred get_pred_id_and_proc_id(is_fully_qualified::in, sym_name::in,
- pred_or_func::in, tvarset::in, list(mer_type)::in, module_info::in,
- pred_id::out, proc_id::out) is det.
+:- pred get_pred_id_and_proc_id_by_types(is_fully_qualified::in, sym_name::in,
+ pred_or_func::in, tvarset::in, existq_tvars::in, list(mer_type)::in,
+ head_type_params::in, module_info::in, pred_id::out, proc_id::out) is det.
% Get the pred_id matching a higher-order term with
% the given argument types, failing if none is found.
%
-:- pred get_pred_id(is_fully_qualified::in, sym_name::in, pred_or_func::in,
- tvarset::in, list(mer_type)::in, module_info::in, pred_id::out) is semidet.
+:- pred get_pred_id_by_types(is_fully_qualified::in, sym_name::in,
+ pred_or_func::in, tvarset::in, existq_tvars::in, list(mer_type)::in,
+ head_type_params::in, module_info::in, pred_id::out) is semidet.
% Given a pred_id, return the single proc_id, aborting
% if there are no modes or more than one mode.
@@ -953,8 +955,8 @@ insert_into_mna_index(Name, Arity, PredId, Module, !MNA_Index) :-
%-----------------------------------------------------------------------------%
-resolve_pred_overloading(ModuleInfo, CallerMarkers, ArgTypes, TVarSet,
- PredName0, PredName, PredId) :-
+resolve_pred_overloading(ModuleInfo, CallerMarkers, TVarSet, ExistQTVars,
+ ArgTypes, HeadTypeParams, PredName0, PredName, PredId) :-
% Note: calls to preds declared in `.opt' files should always be
% module qualified, so they should not be considered
% when resolving overloading.
@@ -972,8 +974,8 @@ resolve_pred_overloading(ModuleInfo, CallerMarkers, ArgTypes, TVarSet,
% Check if there any of the candidate pred_ids have argument/return types
% which subsume the actual argument/return types of this function call.
(
- find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes,
- no, PredId1, PredName1)
+ find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ExistQTVars,
+ ArgTypes, HeadTypeParams, no, PredId1, PredName1)
->
PredId = PredId1,
PredName = PredName1
@@ -983,7 +985,8 @@ resolve_pred_overloading(ModuleInfo, CallerMarkers, ArgTypes, TVarSet,
unexpected(this_file, "type error in pred call: no matching pred")
).
-find_matching_pred_id(ModuleInfo, [PredId | PredIds], TVarSet, ArgTypes,
+find_matching_pred_id(ModuleInfo, [PredId | PredIds],
+ TVarSet, ExistQTVars, ArgTypes, HeadTypeParams,
MaybeConstraintSearch, ThePredId, PredName) :-
(
% Lookup the argument types of the candidate predicate
@@ -994,8 +997,8 @@ find_matching_pred_id(ModuleInfo, [PredId | PredIds], TVarSet, ArgTypes,
PredArgTypes0),
pred_info_get_tvar_kinds(PredInfo, PredKindMap),
- arg_type_list_subsumes(TVarSet, ArgTypes, PredTVarSet, PredKindMap,
- PredExistQVars0, PredArgTypes0),
+ arg_type_list_subsumes(TVarSet, ExistQTVars, ArgTypes, HeadTypeParams,
+ PredTVarSet, PredKindMap, PredExistQVars0, PredArgTypes0),
(
MaybeConstraintSearch = no
@@ -1016,8 +1019,9 @@ find_matching_pred_id(ModuleInfo, [PredId | PredIds], TVarSet, ArgTypes,
Module = pred_info_module(PredInfo),
PredName = qualified(Module, PName),
(
- find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes,
- MaybeConstraintSearch, _OtherPredId, _)
+ find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ExistQTVars,
+ ArgTypes, HeadTypeParams, MaybeConstraintSearch, _OtherPredId,
+ _)
->
% XXX this should report an error properly, not
% via error/1
@@ -1029,8 +1033,9 @@ find_matching_pred_id(ModuleInfo, [PredId | PredIds], TVarSet, ArgTypes,
ThePredId = PredId
)
;
- find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes,
- MaybeConstraintSearch, ThePredId, PredName)
+ find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ExistQTVars,
+ ArgTypes, HeadTypeParams, MaybeConstraintSearch, ThePredId,
+ PredName)
).
% Check that the universal constraints proven in the caller match the
@@ -1054,16 +1059,16 @@ univ_constraints_match([ProvenConstraint | ProvenConstraints],
list.length(CalleeArgs, Arity),
univ_constraints_match(ProvenConstraints, CalleeConstraints).
-get_pred_id(IsFullyQualified, SymName, PredOrFunc, TVarSet,
- ArgTypes, ModuleInfo, PredId) :-
+get_pred_id_by_types(IsFullyQualified, SymName, PredOrFunc, TVarSet,
+ ExistQTVars, ArgTypes, HeadTypeParams, ModuleInfo, PredId) :-
module_info_get_predicate_table(ModuleInfo, PredicateTable),
list.length(ArgTypes, Arity),
(
predicate_table_search_pf_sym_arity(PredicateTable, IsFullyQualified,
PredOrFunc, SymName, Arity, PredIds),
% Resolve overloading using the argument types.
- find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ArgTypes, no,
- PredId0, _PredName)
+ find_matching_pred_id(ModuleInfo, PredIds, TVarSet, ExistQTVars,
+ ArgTypes, HeadTypeParams, no, PredId0, _PredName)
->
PredId = PredId0
;
@@ -1071,11 +1076,12 @@ get_pred_id(IsFullyQualified, SymName, PredOrFunc, TVarSet,
fail
).
-get_pred_id_and_proc_id(IsFullyQualified, SymName, PredOrFunc, TVarSet,
- ArgTypes, ModuleInfo, PredId, ProcId) :-
+get_pred_id_and_proc_id_by_types(IsFullyQualified, SymName, PredOrFunc,
+ TVarSet, ExistQTVars, ArgTypes, HeadTypeParams, ModuleInfo, PredId,
+ ProcId) :-
(
- get_pred_id(IsFullyQualified, SymName, PredOrFunc, TVarSet,
- ArgTypes, ModuleInfo, PredId0)
+ get_pred_id_by_types(IsFullyQualified, SymName, PredOrFunc, TVarSet,
+ ExistQTVars, ArgTypes, HeadTypeParams, ModuleInfo, PredId0)
->
PredId = PredId0
;
@@ -1085,7 +1091,7 @@ get_pred_id_and_proc_id(IsFullyQualified, SymName, PredOrFunc, TVarSet,
PredOrFuncStr = prog_out.pred_or_func_to_str(PredOrFunc),
NameStr = sym_name_to_string(SymName),
string.int_to_string(Arity, ArityString),
- string.append_list(["get_pred_id_and_proc_id: ",
+ string.append_list(["get_pred_id_and_proc_id_by_types: ",
"undefined/invalid ", PredOrFuncStr,
"\n`", NameStr, "/", ArityString, "'"], Msg),
unexpected(this_file, Msg)
diff --git a/compiler/prog_type.m b/compiler/prog_type.m
index a587571..c81ae59 100644
--- a/compiler/prog_type.m
+++ b/compiler/prog_type.m
@@ -412,16 +412,18 @@
:- pred type_list_subsumes_det(list(mer_type)::in, list(mer_type)::in,
tsubst::out) is det.
- % arg_type_list_subsumes(TVarSet, ArgTypes, CalleeTVarSet,
- % CalleeExistQVars, CalleeArgTypes):
+ % arg_type_list_subsumes(TVarSet, ExistQVars, ArgTypes, HeadTypeParams,
+ % CalleeTVarSet, CalleeExistQVars, CalleeArgTypes):
%
% Check that the argument types of the called predicate, function or
% constructor subsume the types of the arguments of the call. This checks
% that none of the existentially quantified type variables of the callee
% are bound.
%
-:- pred arg_type_list_subsumes(tvarset::in, list(mer_type)::in, tvarset::in,
- tvar_kind_map::in, existq_tvars::in, list(mer_type)::in) is semidet.
+:- pred arg_type_list_subsumes(tvarset::in, existq_tvars::in,
+ list(mer_type)::in, list(tvar)::in,
+ tvarset::in, tvar_kind_map::in, existq_tvars::in, list(mer_type)::in)
+ is semidet.
% Apply a renaming (partial map) to a list.
% Useful for applying a variable renaming to a list of variables.
@@ -1366,8 +1368,8 @@ type_list_subsumes_det(TypesA, TypesB, TypeSubst) :-
"type_list_subsumes_det: type_list_subsumes failed")
).
-arg_type_list_subsumes(TVarSet, ActualArgTypes, CalleeTVarSet, PredKindMap,
- PredExistQVars, PredArgTypes) :-
+arg_type_list_subsumes(TVarSet, ExistQVars, ActualArgTypes, HeadTypeParams,
+ CalleeTVarSet, PredKindMap, PredExistQVars, PredArgTypes) :-
% Rename the type variables in the callee's argument types.
tvarset_merge_renaming(TVarSet, CalleeTVarSet, _TVarSet1, Renaming),
apply_variable_renaming_to_tvar_kind_map(Renaming, PredKindMap,
@@ -1387,7 +1389,16 @@ arg_type_list_subsumes(TVarSet, ActualArgTypes, CalleeTVarSet, PredKindMap,
% clauses_info and proc_info) -- the latter
% might not subsume the actual argument types.]
- type_list_subsumes(ParentArgTypes, ActualArgTypes, ParentToActualSubst),
+ (
+ ExistQVars = [],
+ type_list_subsumes(ParentArgTypes, ActualArgTypes, ParentToActualSubst)
+ ;
+ ExistQVars = [_ | _],
+ % For calls to existentially type preds, we may need to bind
+ % type variables in the caller, not just those in the callee.
+ type_unify_list(ParentArgTypes, ActualArgTypes, HeadTypeParams,
+ map.init, ParentToActualSubst)
+ ),
% Check that the type substitution did not bind any existentially
% typed variables to non-ground types.
diff --git a/compiler/purity.m b/compiler/purity.m
index 1b83504..39b09b3 100644
--- a/compiler/purity.m
+++ b/compiler/purity.m
@@ -936,13 +936,16 @@ check_higher_order_purity(GoalInfo, ConsId, Var, Args, ActualPurity, !Info) :-
->
PredInfo = !.Info ^ pi_pred_info,
pred_info_get_typevarset(PredInfo, TVarSet),
+ pred_info_get_exist_quant_tvars(PredInfo, ExistQTVars),
+ pred_info_get_head_type_params(PredInfo, HeadTypeParams),
map.apply_to_list(Args, VarTypes, ArgTypes0),
list.append(ArgTypes0, VarArgTypes, PredArgTypes),
ModuleInfo = !.Info ^ pi_module_info,
pred_info_get_markers(PredInfo, CallerMarkers),
(
- get_pred_id(calls_are_fully_qualified(CallerMarkers), PName,
- PredOrFunc, TVarSet, PredArgTypes, ModuleInfo, CalleePredId)
+ get_pred_id_by_types(calls_are_fully_qualified(CallerMarkers),
+ PName, PredOrFunc, TVarSet, ExistQTVars, PredArgTypes,
+ HeadTypeParams, ModuleInfo, CalleePredId)
->
module_info_pred_info(ModuleInfo, CalleePredId, CalleePredInfo),
pred_info_get_purity(CalleePredInfo, CalleePurity),
diff --git a/compiler/trans_opt.m b/compiler/trans_opt.m
index d224b8b..cf5bbb8 100644
--- a/compiler/trans_opt.m
+++ b/compiler/trans_opt.m
@@ -187,10 +187,6 @@ write_trans_opt_file(Module, !IO) :-
touch_interface_datestamp(ModuleName, ".trans_opt_date", !IO)
).
-:- pred get_pred_id(pred_proc_id::in, pred_id::out) is det.
-
-get_pred_id(proc(PredId, _ProcId), PredId).
-
%-----------------------------------------------------------------------------%
%
% Read and process the transitive optimization interfaces.
diff --git a/tests/valid/Mercury.options b/tests/valid/Mercury.options
index 2ad0d4d..57782e0 100644
--- a/tests/valid/Mercury.options
+++ b/tests/valid/Mercury.options
@@ -73,6 +73,7 @@ MCFLAGS-intermod_test2 = --intermodule-optimization
MCFLAGS-intermod_test = --intermodule-optimization
MCFLAGS-intermod_typeclass2 = --intermodule-optimization
MCFLAGS-intermod_typeclass = --intermodule-optimization
+MCFLAGS-intermod_typeclass_exist = --intermodule-optimization
MCFLAGS-intermod_type_spec_2 = --intermodule-optimization
MCFLAGS-intermod_type_spec = --intermodule-optimization
MCFLAGS-intermod_ua_type_spec = --intermod-unused-args
diff --git a/tests/valid/Mmakefile b/tests/valid/Mmakefile
index 9b61c9c..1f11506 100644
--- a/tests/valid/Mmakefile
+++ b/tests/valid/Mmakefile
@@ -133,6 +133,7 @@ OTHER_PROGS= \
intermod_test \
intermod_type_spec \
intermod_typeclass \
+ intermod_typeclass_exist \
intermod_ua_type_spec \
intermod_user_equality \
intermod_user_equality_nested \
diff --git a/tests/valid/intermod_typeclass_exist.m b/tests/valid/intermod_typeclass_exist.m
new file mode 100644
index 0000000..699d983
--- /dev/null
+++ b/tests/valid/intermod_typeclass_exist.m
@@ -0,0 +1,40 @@
+% Regression test.
+% The compiler aborted when making a .opt file if the module had a
+% typeclass instance which implements a method with existentially typed
+% arguments, but the predicate which implements the method was not itself
+% existentially typed.
+%
+% Uncaught Mercury exception:
+% Software Error: pred_table.m: Unexpected: type error in pred call:
+% no matching pred
+
+:- module intermod_typeclass_exist.
+:- interface.
+
+:- typeclass dynamic_block(T) where [
+ some [Q] pred generate_block(T::in, U::in, Q::out) is det
+].
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+
+%-----------------------------------------------------------------------------%
+
+:- type simple_dynamic_block
+ ---> simple_dynamic_block.
+
+:- instance dynamic_block(simple_dynamic_block) where [
+ pred(generate_block/3) is do_generate_block
+].
+
+:- pred do_generate_block(simple_dynamic_block::in, U::in, string::out) is det.
+
+do_generate_block(simple_dynamic_block, _, "qqq").
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=8 sts=4 sw=4 et
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list