mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-16 06:14:59 +00:00
Code Issues Projects Releases Wiki Activity
Files
ae94e32d467e05454ba71ddd988f3b53646e92bd
mercury/compiler/inst_match.m
Zoltan Somogyi 8547e1634b Fix some things reported by --warn-inconsistent-pred-order-clauses. 
compiler/arg_info.m:
compiler/bytecode_data.m:
compiler/common.m:
compiler/compile_target_code.m:
compiler/delay_info.m:
compiler/det_util.m:
compiler/erl_call_gen.m:
compiler/erl_code_util.m:
compiler/from_ground_term_util.m:
compiler/hlds_out_goal.m:
compiler/inst_match.m:
compiler/inst_util.m:
compiler/mode_constraint_robdd.m:
compiler/ordering_mode_constraints.m:
compiler/simplify_info.m:
compiler/switch_detection.m:
compiler/type_util.m:
compiler/unique_modes.m:
    As above.

compiler/Mercury.options:
    Note a module that is not worth fixing this way.
2017-10-14 19:07:02 +11:00

1608 lines
65 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-1998, 2000-2012 The University of Melbourne.
% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: inst_match.m.
% Author: fjh.
%
% This module defines some utility routines for comparing insts that are used
% by modes.m and det_analysis.m.
%
% We do allow `bound' and `ground' to match `any', based on the assumption
% that `bound' and `ground' are represented in the same way as `any', i.e.
% that we use the type system rather than the mode system to distinguish
% between different representations.
%
%-----------------------------------------------------------------------------%
:- module check_hlds.inst_match.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module list.
%-----------------------------------------------------------------------------%
% inst_matches_initial(InstA, InstB, Type, ModuleInfo):
%
% Succeed iff `InstA' specifies at least as much information as `InstB',
% and in those parts where they specify the same information, `InstA'
% is at least as instantiated as `InstB'. Thus, the call
% inst_matches_initial(not_reached, ground, _) succeeds, since
% not_reached contains more information than ground - but not vice versa.
% Similarly, inst_matches_initial(bound(a), bound(a;b), _) should
% succeed, but not vice versa.
%
:- pred inst_matches_initial(mer_inst::in, mer_inst::in, mer_type::in,
module_info::in) is semidet.
% This version of inst_matches_initial builds up a substitution map
% (inst_var_sub). For each inst_var which occurs in InstA there will be
% a substitution to the corresponding inst in InstB.
%
:- pred inst_matches_initial_sub(mer_inst::in, mer_inst::in, mer_type::in,
module_info::in, module_info::out, inst_var_sub::in, inst_var_sub::out)
is semidet.
% This version of inst_matches_initial does not allow implied modes.
% This makes it almost the same as inst_matches_final. The only difference
% is in the way it handles constrained_inst_vars.
%
:- pred inst_matches_initial_no_implied_modes(mer_inst::in, mer_inst::in,
mer_type::in, module_info::in) is semidet.
% A version of the above that also computes the inst_var_sub.
%
:- pred inst_matches_initial_no_implied_modes_sub(mer_inst::in, mer_inst::in,
mer_type::in, module_info::in, module_info::out,
inst_var_sub::in, inst_var_sub::out) is semidet.
% inst_matches_final(InstA, InstB, ModuleInfo):
%
% Succeed iff InstA is compatible with InstB, i.e. iff InstA will satisfy
% the final inst requirement InstB. This is true if the information
% specified by InstA is at least as great as that specified by InstB,
% and where the information is the same and both insts specify a binding,
% the binding must be identical.
%
:- pred inst_matches_final(mer_inst::in, mer_inst::in, module_info::in)
is semidet.
% This version of inst_matches_final allows you to pass in the type of the
% variables being compared. This allows it to be more precise (i.e. less
% conservative) for cases such as inst_matches_final(ground(...),
% bound(...), ...). This version is to be preferred when the type is
% available.
%
:- pred inst_matches_final_typed(mer_inst::in, mer_inst::in, mer_type::in,
module_info::in) is semidet.
% Normally ground matches bound(...) only if the latter is complete for the
% type. However, the mode checker would reject some compiler-generated
% predicates in the absence of mode checking. We work around the problem by
% allowing ground to match incomplete bound insts when checking the final
% insts of those generated predicates.
%
:- type ground_matches_bound
---> ground_matches_bound_if_complete
; ground_matches_bound_always.
:- pred inst_matches_final_gmb(mer_inst::in, mer_inst::in, mer_type::in,
module_info::in, ground_matches_bound::in) is semidet.
% The difference between inst_matches_initial and inst_matches_final is
% that inst_matches_initial requires only something which is at least as
% instantiated, whereas this predicate wants something which is an exact
% match (or not reachable).
%
% Note that this predicate is not symmetric, because of the existence of
% `not_reached' insts: not_reached matches_final with anything, but not
% everything matches_final with not_reached - in fact only not_reached
% matches_final with not_reached. It is also asymmetric with respect to
% unique insts.
%
% It might be a good idea to fold inst_matches_initial and
% inst_matches_final into a single predicate inst_matches(When, ...) where
% When is either `initial' or `final'.
%
% inst_is_at_least_as_instantiated(InstA, InstB, Type, ModuleInfo)
% succeeds iff InstA is at least as instantiated as InstB. This defines
% a partial order which is the same as inst_matches_initial except that
% uniqueness comparisons are reversed and we don't allow
% inst_is_at_least_as_instantiated(any, any).
%
:- pred inst_is_at_least_as_instantiated(mer_inst::in, mer_inst::in,
mer_type::in, module_info::in) is semidet.
% inst_matches_binding(InstA, InstB, Type, ModuleInfo):
%
% Succeed iff the binding of InstA is definitely exactly the same as
% that of InstB. This is the same as inst_matches_final except that it
% ignores uniqueness, and that `any' does not match itself. It is used
% to check whether variables get bound in negated contexts.
%
:- pred inst_matches_binding(mer_inst::in, mer_inst::in, mer_type::in,
module_info::in) is semidet.
% inst_matches_binding_allow_any_any is the same as
% inst_matches_binding except that it also allows `any' to match `any'.
%
:- pred inst_matches_binding_allow_any_any(mer_inst::in, mer_inst::in,
mer_type::in, module_info::in) is semidet.
%-----------------------------------------------------------------------------%
% unique_matches_initial(A, B) succeeds if A >= B in the ordering
% clobbered < mostly_clobbered < shared < mostly_unique < unique
%
:- pred unique_matches_initial(uniqueness::in, uniqueness::in) is semidet.
% unique_matches_final(A, B) succeeds if A >= B in the ordering
% clobbered < mostly_clobbered < shared < mostly_unique < unique
%
:- pred unique_matches_final(uniqueness::in, uniqueness::in) is semidet.
%-----------------------------------------------------------------------------%
% inst_contains_nondefault_func_mode(Inst, ModuleInfo) succeeds iff the
% inst contains a higher-order function inst that does not match the
% default function mode `(in, ..., in) = out is det'.
% E.g. this predicate fails for "func(in) = uo" because that matches the
% default func mode "func(in) = out", even though it isn't the same as
% the default func mode.
%
:- pred inst_contains_nondefault_func_mode(module_info::in, mer_inst::in)
is semidet.
% Succeed iff the second argument is not a function ho_inst_info
% whose mode does not match the default func mode.
%
:- pred ho_inst_info_matches_ground(module_info::in, ho_inst_info::in)
is semidet.
% Succeed iff the second argument is not a function pred_inst_info
% whose mode does not match the default func mode.
%
:- pred pred_inst_matches_ground(module_info::in, pred_inst_info::in)
is semidet.
% pred_inst_matches(PredInstA, PredInstB, ModuleInfo)
%
% Succeeds if PredInstA specifies a pred that can be used wherever and
% whenever PredInstB could be used. This is true if they both have the
% same PredOrFunc indicator and the same determinism, and if the arguments
% match using pred_inst_argmodes_match.
%
:- pred pred_inst_matches(pred_inst_info::in, pred_inst_info::in,
module_info::in) is semidet.
%-----------------------------------------------------------------------------%
% Nondeterministically produce all the inst_vars contained in the
% specified list of modes.
%
:- pred mode_list_contains_inst_var(list(mer_mode)::in, inst_var::out)
is nondet.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.prog_mode.
:- import_module bool.
:- import_module int.
:- import_module map.
:- import_module maybe.
:- import_module require.
:- import_module set.
:- import_module set_tree234.
:- import_module term.
%-----------------------------------------------------------------------------%
:- type inst_match_inputs
---> inst_match_inputs(
mer_inst,
mer_inst,
maybe(mer_type)
).
:- type expansions == set_tree234(inst_match_inputs).
:- func expansion_init = expansions.
:- pragma inline(expansion_init/0).
expansion_init = set_tree234.init.
:- pred expansion_insert_new(inst_match_inputs::in,
expansions::in, expansions::out) is semidet.
:- pragma inline(expansion_insert_new/3).
expansion_insert_new(E, S0, S) :-
set_tree234.insert_new(E, S0, S).
%-----------------------------------------------------------------------------%
% The uniqueness_comparison type is used by the predicate
% compare_uniqueness to determine what order should be used for
% comparing two uniqueness annotations.
:- type uniqueness_comparison
---> uc_match
% We are doing a "matches" comparison, e.g. at a predicate call
% or the end of a procedure body.
; uc_instantiated.
% We are comparing two insts for how "instantiated" they are.
% The uniqueness order here should be the reverse of the order
% used for matching.
:- type inst_match_info
---> inst_match_info(
imi_module_info :: module_info,
imi_expansions :: expansions,
imi_maybe_sub :: maybe(inst_var_sub),
imi_calculate_sub :: calculate_sub,
imi_uniqueness_comparison :: uniqueness_comparison,
imi_any_matches_any :: bool,
imi_ground_matches_bound :: ground_matches_bound
).
% The calculate_sub type determines how the inst var substitution
% should be calculated.
:- type calculate_sub
---> cs_forward
% Calculate in the (normal) forward direction
% (used by inst_matches_initial).
; cs_reverse
% Calculate in the reverse direction. Used by the call
% to inst_matches_final from pred_inst_argmodes_match
% to ensure contravariance of the initial argument
% insts of higher order pred insts.
; cs_none.
% Do not calculate inst var substitution.
:- func init_inst_match_info(module_info, maybe(inst_var_sub),
calculate_sub, uniqueness_comparison, bool, ground_matches_bound) =
inst_match_info.
init_inst_match_info(ModuleInfo, MaybeSub, CalculateSub, Comparison,
AnyMatchesAny, GroundMatchesBound) =
inst_match_info(ModuleInfo, expansion_init, MaybeSub, CalculateSub,
Comparison, AnyMatchesAny, GroundMatchesBound).
:- type inst_matches_pred ==
pred(mer_inst, mer_inst, maybe(mer_type),
inst_match_info, inst_match_info).
:- inst inst_matches_pred == (pred(in, in, in, in, out) is semidet).
:- pred swap_sub(
pred(inst_match_info, inst_match_info)::in(pred(in, out) is semidet),
inst_match_info::in, inst_match_info::out) is semidet.
swap_sub(P, !Info) :-
CalculateSub = !.Info ^ imi_calculate_sub,
!Info ^ imi_calculate_sub := swap_calculate_sub(CalculateSub),
P(!Info),
!Info ^ imi_calculate_sub := CalculateSub.
:- pred unswap(inst_matches_pred::in(inst_matches_pred),
mer_inst::in, mer_inst::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
unswap(P, InstA, InstB, Type, !Info) :-
% Swap the arguments *and* undo swap_sub.
CalculateSub = !.Info ^ imi_calculate_sub,
!Info ^ imi_calculate_sub := swap_calculate_sub(CalculateSub),
P(InstB, InstA, Type, !Info),
!Info ^ imi_calculate_sub := CalculateSub.
:- func swap_calculate_sub(calculate_sub) = calculate_sub.
swap_calculate_sub(cs_forward) = cs_reverse.
swap_calculate_sub(cs_reverse) = cs_forward.
swap_calculate_sub(cs_none) = cs_none.
%-----------------------------------------------------------------------------%
:- pred handle_inst_var_subs(
inst_matches_pred::in(inst_matches_pred),
inst_matches_pred::in(inst_matches_pred),
mer_inst::in, mer_inst::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
handle_inst_var_subs(Recurse, Continue, InstA, InstB, Type, !Info) :-
CalculateSub = !.Info ^ imi_calculate_sub,
(
CalculateSub = cs_forward,
handle_inst_var_subs_2(Recurse, Continue, InstA, InstB,
Type, !Info)
;
CalculateSub = cs_reverse,
% Calculate the inst var substitution with arguments swapped,
% but swap back for inst matching.
handle_inst_var_subs_2(unswap(Recurse), unswap(Continue),
InstB, InstA, Type, !Info)
;
CalculateSub = cs_none,
Continue(InstA, InstB, Type, !Info)
).
:- pred handle_inst_var_subs_2(
inst_matches_pred::in(inst_matches_pred),
inst_matches_pred::in(inst_matches_pred),
mer_inst::in, mer_inst::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
handle_inst_var_subs_2(Recurse, Continue, InstA, InstB, Type, !Info) :-
( if InstB = constrained_inst_vars(InstVarsB, SubInstB) then
% Add the substitution InstVarsB => InstA `glb` SubInstB
% (see get_subst_inst in dmo's thesis, page 78).
%
% We pass `Live = is_dead' because we want
% abstractly_unify(unique, unique) = unique, not shared.
ModuleInfo0 = !.Info ^ imi_module_info,
abstractly_unify_inst(is_dead, InstA, SubInstB, fake_unify,
UnifyInst, _Det, ModuleInfo0, ModuleInfo),
!Info ^ imi_module_info := ModuleInfo,
update_inst_var_sub(InstVarsB, UnifyInst, Type, !Info),
% Check that InstA matches InstB after applying the substitution
% to InstB.
( if UnifyInst = constrained_inst_vars(InstVarsB, UnifySubInst) then
% Avoid infinite regress.
Recurse(InstA, UnifySubInst, Type, !Info)
else
Recurse(InstA, UnifyInst, Type, !Info)
)
else if InstA = constrained_inst_vars(_InstVarsA, SubInstA) then
Recurse(SubInstA, InstB, Type, !Info)
else
Continue(InstA, InstB, Type, !Info)
).
% Update the inst_var_sub that is computed by inst_matches_initial.
% The inst_var_sub records what inst should be substituted for each
% inst_var that occurs in the called procedure's argument modes.
%
:- pred update_inst_var_sub(set(inst_var)::in, mer_inst::in,
maybe(mer_type)::in, inst_match_info::in, inst_match_info::out) is semidet.
update_inst_var_sub(InstVars, InstA, MaybeType, !Info) :-
(
!.Info ^ imi_maybe_sub = yes(_),
set.fold(update_inst_var_sub_2(InstA, MaybeType), InstVars, !Info)
;
!.Info ^ imi_maybe_sub = no
).
:- pred update_inst_var_sub_2(mer_inst::in, maybe(mer_type)::in, inst_var::in,
inst_match_info::in, inst_match_info::out) is semidet.
update_inst_var_sub_2(InstA, MaybeType, InstVar, !Info) :-
(
!.Info ^ imi_maybe_sub = yes(InstVarSub0),
( if map.search(InstVarSub0, InstVar, InstB) then
% If InstVar already has an inst associated with it, merge
% the old inst and the new inst. Fail if this merge is not
% possible.
ModuleInfo0 = !.Info ^ imi_module_info,
inst_merge(InstA, InstB, MaybeType, Inst,
ModuleInfo0, ModuleInfo),
!Info ^ imi_module_info := ModuleInfo,
map.det_update(InstVar, Inst, InstVarSub0, InstVarSub),
!Info ^ imi_maybe_sub := yes(InstVarSub)
else
map.det_insert(InstVar, InstA, InstVarSub0, InstVarSub),
!Info ^ imi_maybe_sub := yes(InstVarSub)
)
;
!.Info ^ imi_maybe_sub = no,
InstVarSub = map.singleton(InstVar, InstA),
!Info ^ imi_maybe_sub := yes(InstVarSub)
).
%-----------------------------------------------------------------------------%
inst_matches_initial(InstA, InstB, Type, ModuleInfo) :-
inst_matches_initial_1(InstA, InstB, Type, ModuleInfo, _, no, _).
inst_matches_initial_sub(InstA, InstB, Type, !ModuleInfo, !Sub) :-
inst_matches_initial_1(InstA, InstB, Type, !ModuleInfo,
yes(!.Sub), MaybeSub),
(
MaybeSub = yes(!:Sub)
;
MaybeSub = no,
unexpected($module, $pred, "missing inst_var_sub")
).
inst_matches_initial_no_implied_modes(InstA, InstB, Type, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo, no, cs_forward, uc_match, yes,
ground_matches_bound_if_complete),
inst_matches_final_mt(InstA, InstB, yes(Type), Info0, _).
inst_matches_initial_no_implied_modes_sub(InstA, InstB, Type, !ModuleInfo,
!Sub) :-
Info0 = init_inst_match_info(!.ModuleInfo, yes(!.Sub), cs_forward,
uc_match, yes, ground_matches_bound_if_complete),
inst_matches_final_mt(InstA, InstB, yes(Type), Info0, Info),
!:ModuleInfo = Info ^ imi_module_info,
yes(!:Sub) = Info ^ imi_maybe_sub.
:- pred inst_matches_initial_1(mer_inst::in, mer_inst::in, mer_type::in,
module_info::in, module_info::out,
maybe(inst_var_sub)::in, maybe(inst_var_sub)::out) is semidet.
inst_matches_initial_1(InstA, InstB, Type, !ModuleInfo, !MaybeSub) :-
Info0 = init_inst_match_info(!.ModuleInfo, !.MaybeSub, cs_forward,
uc_match, yes, ground_matches_bound_if_complete),
inst_matches_initial_mt(InstA, InstB, yes(Type), Info0, Info),
!:ModuleInfo = Info ^ imi_module_info,
!:MaybeSub = Info ^ imi_maybe_sub.
:- pred inst_matches_initial_mt(mer_inst::in, mer_inst::in,
maybe(mer_type)::in, inst_match_info::in, inst_match_info::out) is semidet.
inst_matches_initial_mt(InstA, InstB, MaybeType, !Info) :-
ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType),
Expansions0 = !.Info ^ imi_expansions,
( if expansion_insert_new(ThisExpansion, Expansions0, Expansions) then
!Info ^ imi_expansions := Expansions,
inst_expand(!.Info ^ imi_module_info, InstA, ExpandedInstA),
inst_expand(!.Info ^ imi_module_info, InstB, ExpandedInstB),
handle_inst_var_subs(inst_matches_initial_mt, inst_matches_initial_4,
ExpandedInstA, ExpandedInstB, MaybeType, !Info)
else
true
).
:- pred inst_matches_initial_4(mer_inst::in, mer_inst::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
inst_matches_initial_4(InstA, InstB, MaybeType, !Info) :-
% To avoid infinite regress, we assume that inst_matches_initial is true
% for any pairs of insts which occur in `Expansions'.
%
% XXX Maybe we could use the inst result field of bound/3 insts
% in some places.
(
InstA = any(UniqA, HOInstInfoA),
InstB = any(UniqB, HOInstInfoB),
!.Info ^ imi_any_matches_any = yes,
compare_uniqueness(!.Info ^ imi_uniqueness_comparison, UniqA, UniqB),
ho_inst_info_matches_initial(HOInstInfoA, HOInstInfoB, MaybeType,
!Info)
;
InstA = any(_, _),
InstB = free
;
InstA = any(UniqA, HOInstInfoA),
InstB = ground(_, _),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqA,
HOInstInfoA, NextInstA),
inst_matches_initial_mt(NextInstA, InstB, MaybeType, !Info)
;
InstA = any(UniqA, HOInstInfoA),
InstB = bound(_, _, _),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqA,
HOInstInfoA, NextInstA),
inst_matches_initial_mt(NextInstA, InstB, MaybeType, !Info)
;
InstA = free,
InstB = free
;
InstA = bound(UniqA, _InstResultsA, BoundInstsA),
InstB = any(UniqB, none_or_default_func),
compare_uniqueness(!.Info ^ imi_uniqueness_comparison, UniqA, UniqB),
compare_bound_inst_list_uniq(!.Info ^ imi_uniqueness_comparison,
BoundInstsA, UniqB, !.Info ^ imi_module_info),
inst_contains_nondefault_func_mode_1(InstA, no, !Info)
;
InstA = bound(_, _, _),
InstB = free
;
InstA = bound(UniqA, InstResultsA, BoundInstsA),
InstB = bound(UniqB, _InstResultsB, BoundInstsB),
( if
same_addr_insts(InstA, InstB),
InstResultsA = inst_test_results_fgtc
then
true
else
compare_uniqueness(!.Info ^ imi_uniqueness_comparison,
UniqA, UniqB),
bound_inst_list_matches_initial_mt(BoundInstsA, BoundInstsB,
MaybeType, !Info)
)
;
InstA = bound(UniqA, InstResultsA, BoundInstsA),
InstB = ground(UniqB, none_or_default_func),
compare_uniqueness(!.Info ^ imi_uniqueness_comparison, UniqA, UniqB),
inst_results_bound_inst_list_is_ground_mt(InstResultsA, BoundInstsA,
MaybeType, !.Info ^ imi_module_info),
compare_bound_inst_list_uniq(!.Info ^ imi_uniqueness_comparison,
BoundInstsA, UniqB, !.Info ^ imi_module_info),
inst_contains_nondefault_func_mode_1(InstA, no, !Info)
;
InstA = bound(Uniq, InstResultsA, BoundInstsA),
InstB = abstract_inst(_,_),
inst_results_bound_inst_list_is_ground_mt(InstResultsA, BoundInstsA,
no, !.Info ^ imi_module_info),
(
Uniq = unique,
bound_inst_list_is_unique(BoundInstsA, !.Info ^ imi_module_info)
;
Uniq = mostly_unique,
bound_inst_list_is_mostly_unique(BoundInstsA,
!.Info ^ imi_module_info)
),
inst_contains_nondefault_func_mode_1(InstA, no, !Info)
;
InstA = ground(UniqA, HOInstInfoA),
InstB = any(UniqB, HOInstInfoB),
compare_uniqueness(!.Info ^ imi_uniqueness_comparison, UniqA, UniqB),
ho_inst_info_matches_initial(HOInstInfoA, HOInstInfoB, MaybeType,
!Info)
;
InstA = ground(_Uniq, _PredInst),
InstB = free
;
InstA = ground(UniqA, _GII_A),
InstB = bound(UniqB, _InstResultsB, BoundInstsB),
MaybeType = yes(Type),
% We can only check this case properly if the type is known.
compare_uniqueness(!.Info ^ imi_uniqueness_comparison, UniqA, UniqB),
bound_inst_list_is_complete_for_type(set.init,
!.Info ^ imi_module_info, BoundInstsB, Type),
ground_matches_initial_bound_inst_list(UniqA, BoundInstsB, yes(Type),
!Info)
;
InstA = ground(UniqA, HOInstInfoA),
InstB = ground(UniqB, HOInstInfoB),
compare_uniqueness(!.Info ^ imi_uniqueness_comparison, UniqA, UniqB),
ho_inst_info_matches_initial(HOInstInfoA, HOInstInfoB, MaybeType,
!Info)
;
InstA = ground(_UniqA, none_or_default_func),
InstB = abstract_inst(_,_),
% I don't know what this should do.
% Abstract insts aren't really supported.
unexpected($module, $pred,
"inst_matches_initial(ground, abstract_inst) == ??")
;
InstA = abstract_inst(_,_),
InstB = any(shared, none_or_default_func)
;
InstA = abstract_inst(_,_),
InstB = free
;
InstA = abstract_inst(Name, ArgsA),
InstB = abstract_inst(Name, ArgsB),
list.duplicate(length(ArgsA), no, MaybeTypes),
% XXX how do we get the argument types for an abstract inst?
inst_list_matches_initial_mt(ArgsA, ArgsB, MaybeTypes, !Info)
;
InstA = not_reached
).
%-----------------------------------------------------------------------------%
% This predicate assumes that the check of
% `bound_inst_list_is_complete_for_type' is done by the caller.
%
:- pred ground_matches_initial_bound_inst_list(uniqueness::in,
list(bound_inst)::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
ground_matches_initial_bound_inst_list(_, [], _, !Info).
ground_matches_initial_bound_inst_list(Uniq, [BoundInst | BoundInsts],
MaybeType, !Info) :-
BoundInst = bound_functor(ConsId, Args),
maybe_get_cons_id_arg_types(!.Info ^ imi_module_info, MaybeType, ConsId,
list.length(Args), MaybeTypes),
ground_matches_initial_inst_list(Uniq, Args, MaybeTypes, !Info),
ground_matches_initial_bound_inst_list(Uniq, BoundInsts, MaybeType, !Info).
:- pred ground_matches_initial_inst_list(uniqueness::in, list(mer_inst)::in,
list(maybe(mer_type))::in, inst_match_info::in, inst_match_info::out)
is semidet.
ground_matches_initial_inst_list(_, [], [], !Info).
ground_matches_initial_inst_list(Uniq, [Inst | Insts],
[MaybeType | MaybeTypes], !Info) :-
Ground = ground(Uniq, none_or_default_func),
inst_matches_initial_mt(Ground, Inst, MaybeType, !Info),
ground_matches_initial_inst_list(Uniq, Insts, MaybeTypes, !Info).
%-----------------------------------------------------------------------------%
% A list(bound_inst) is ``complete'' for a given type iff it includes
% each functor of the type and each argument of each functor is also
% ``complete'' for its type.
%
:- pred bound_inst_list_is_complete_for_type(set(inst_name)::in,
module_info::in, list(bound_inst)::in, mer_type::in) is semidet.
bound_inst_list_is_complete_for_type(Expansions, ModuleInfo, BoundInsts,
Type) :-
% Is this a type for which cons_ids are recorded in the type_table?
type_util.cons_id_arg_types(ModuleInfo, Type, _, _),
% Is there a bound_inst for each cons_id in the type_table?
% XXX This code has a potential performance problem. If the type has
% N cons_ids, then this code can do N invocations of list.member,
% each of which has O(N) complexity, for an overall complexity of O(N^2).
% We should fix this by taking advantage of the fact that BoundInsts
% should be sorted.
all [ConsId, ArgTypes] (
type_util.cons_id_arg_types(ModuleInfo, Type, ConsId, ArgTypes)
=>
(
list.member(bound_functor(ConsId0, ArgInsts), BoundInsts),
% Cons_ids returned from type_util.cons_id_arg_types
% are not module-qualified, so we need to call
% equivalent_cons_ids instead of just using `=/2'.
equivalent_cons_ids(ConsId0, ConsId),
list.map(inst_is_complete_for_type(Expansions, ModuleInfo),
ArgInsts, ArgTypes)
)
).
:- pred inst_is_complete_for_type(set(inst_name)::in, module_info::in,
mer_inst::in, mer_type::in) is semidet.
inst_is_complete_for_type(Expansions, ModuleInfo, Inst, Type) :-
% XXX This should be a switch on Inst.
( if Inst = defined_inst(Name) then
( if set.member(Name, Expansions) then
true
else
inst_lookup(ModuleInfo, Name, ExpandedInst),
inst_is_complete_for_type(set.insert(Expansions, Name),
ModuleInfo, ExpandedInst, Type)
)
else if Inst = bound(_, _, BoundInsts) then
bound_inst_list_is_complete_for_type(Expansions, ModuleInfo,
BoundInsts, Type)
else
Inst \= not_reached
).
% Check that the first cons_id is lexically greater than the
% second, after all module qualifiers have been removed.
%
:- pred greater_than_disregard_module_qual(cons_id::in, cons_id::in)
is semidet.
greater_than_disregard_module_qual(ConsIdA, ConsIdB) :-
( if
ConsIdA = cons(QNameA, ArityA, _),
ConsIdB = cons(QNameB, ArityB, _)
then
( QNameA = unqualified(NameA)
; QNameA = qualified(_, NameA)
),
( QNameB = unqualified(NameB)
; QNameB = qualified(_, NameB)
),
compare(O, NameA, NameB),
(
O = (>)
;
O = (=),
ArityA > ArityB
)
else
compare((>), ConsIdA, ConsIdB)
).
%-----------------------------------------------------------------------------%
% This predicate checks if two ho_inst_infos match_initial.
% It does not check uniqueness.
%
:- pred ho_inst_info_matches_initial(ho_inst_info::in, ho_inst_info::in,
maybe(mer_type)::in, inst_match_info::in, inst_match_info::out) is semidet.
ho_inst_info_matches_initial(HOInstInfoA, HOInstInfoB, MaybeType, !Info) :-
(
HOInstInfoB = none_or_default_func,
ho_inst_info_matches_ground_2(HOInstInfoA, MaybeType, !Info)
;
HOInstInfoA = none_or_default_func,
HOInstInfoB = higher_order(PredInstB),
PredInstB = pred_inst_info(pf_function, ArgModes, _, _Det),
Arity = list.length(ArgModes),
PredInstA = pred_inst_info_default_func_mode(Arity),
pred_inst_matches_2(PredInstA, PredInstB, MaybeType, !Info)
;
HOInstInfoA = higher_order(PredInstA),
HOInstInfoB = higher_order(PredInstB),
pred_inst_matches_2(PredInstA, PredInstB, MaybeType, !Info)
).
%-----------------------------------------------------------------------------%
:- pred compare_bound_inst_list_uniq(uniqueness_comparison::in,
list(bound_inst)::in, uniqueness::in, module_info::in) is semidet.
compare_bound_inst_list_uniq(uc_match, BoundInsts, Uniq, ModuleInfo) :-
bound_inst_list_matches_uniq(BoundInsts, Uniq, ModuleInfo).
compare_bound_inst_list_uniq(uc_instantiated, BoundInsts, Uniq, ModuleInfo) :-
uniq_matches_bound_inst_list(Uniq, BoundInsts, ModuleInfo).
:- pred bound_inst_list_matches_uniq(list(bound_inst)::in, uniqueness::in,
module_info::in) is semidet.
bound_inst_list_matches_uniq(BoundInsts, Uniq, ModuleInfo) :-
( if Uniq = unique then
bound_inst_list_is_unique(BoundInsts, ModuleInfo)
else if Uniq = mostly_unique then
bound_inst_list_is_mostly_unique(BoundInsts, ModuleInfo)
else
true
).
:- pred uniq_matches_bound_inst_list(uniqueness::in, list(bound_inst)::in,
module_info::in) is semidet.
uniq_matches_bound_inst_list(Uniq, BoundInsts, ModuleInfo) :-
( if Uniq = shared then
bound_inst_list_is_not_partly_unique(BoundInsts, ModuleInfo)
else if Uniq = mostly_unique then
bound_inst_list_is_not_fully_unique(BoundInsts, ModuleInfo)
else
true
).
%-----------------------------------------------------------------------------%
% Here we check that the functors in the first list are a subset of the
% functors in the second list. (If a bound(...) inst only specifies the
% insts for some of the constructors of its type, then it implicitly means
% that all other constructors must have all their arguments `not_reached'.)
% The code here makes use of the fact that the bound_inst lists are sorted.
%
:- pred bound_inst_list_matches_initial_mt(list(bound_inst)::in,
list(bound_inst)::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
bound_inst_list_matches_initial_mt([], _, _, !Info).
bound_inst_list_matches_initial_mt([X | Xs], [Y | Ys], MaybeType, !Info) :-
X = bound_functor(ConsIdX, ArgsX),
Y = bound_functor(ConsIdY, ArgsY),
( if equivalent_cons_ids(ConsIdX, ConsIdY) then
maybe_get_cons_id_arg_types(!.Info ^ imi_module_info, MaybeType,
ConsIdX, list.length(ArgsX), MaybeTypes),
inst_list_matches_initial_mt(ArgsX, ArgsY, MaybeTypes, !Info),
bound_inst_list_matches_initial_mt(Xs, Ys, MaybeType, !Info)
else
greater_than_disregard_module_qual(ConsIdX, ConsIdY),
% ConsIdY does not occur in [X | Xs].
% Hence [X | Xs] implicitly specifies `not_reached' for the args
% of ConsIdY, and hence automatically matches_initial Y. We just
% need to check that [X | Xs] matches_initial Ys.
bound_inst_list_matches_initial_mt([X | Xs], Ys, MaybeType, !Info)
).
:- pred inst_list_matches_initial_mt(list(mer_inst)::in, list(mer_inst)::in,
list(maybe(mer_type))::in, inst_match_info::in, inst_match_info::out)
is semidet.
inst_list_matches_initial_mt([], [], [], !Info).
inst_list_matches_initial_mt([X | Xs], [Y | Ys], [MaybeType | MaybeTypes],
!Info) :-
inst_matches_initial_mt(X, Y, MaybeType, !Info),
inst_list_matches_initial_mt(Xs, Ys, MaybeTypes, !Info).
%-----------------------------------------------------------------------------%
inst_matches_final(InstA, InstB, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo, no, cs_none, uc_match, yes,
ground_matches_bound_if_complete),
inst_matches_final_mt(InstA, InstB, no, Info0, _).
inst_matches_final_typed(InstA, InstB, Type, ModuleInfo) :-
inst_matches_final_gmb(InstA, InstB, Type, ModuleInfo,
ground_matches_bound_if_complete).
inst_matches_final_gmb(InstA, InstB, Type, ModuleInfo, GroundMatchesBound) :-
Info0 = init_inst_match_info(ModuleInfo, no, cs_none, uc_match, yes,
GroundMatchesBound),
inst_matches_final_mt(InstA, InstB, yes(Type), Info0, _).
:- pred inst_matches_final_mt(mer_inst::in, mer_inst::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
inst_matches_final_mt(InstA, InstB, MaybeType, !Info) :-
( if InstA = InstB then
true
else
ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType),
Expansions0 = !.Info ^ imi_expansions,
( if expansion_insert_new(ThisExpansion, Expansions0, Expansions) then
!Info ^ imi_expansions := Expansions,
inst_expand(!.Info ^ imi_module_info, InstA, ExpandedInstA),
inst_expand(!.Info ^ imi_module_info, InstB, ExpandedInstB),
handle_inst_var_subs(inst_matches_final_mt, inst_matches_final_3,
ExpandedInstA, ExpandedInstB, MaybeType, !Info)
else
true
)
).
:- pred inst_matches_final_3(mer_inst::in, mer_inst::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
inst_matches_final_3(InstA, InstB, MaybeType, !Info) :-
(
InstA = any(UniqA, HOInstInfoA),
InstB = any(UniqB, HOInstInfoB),
ho_inst_info_matches_final(HOInstInfoA, HOInstInfoB, MaybeType, !Info),
unique_matches_final(UniqA, UniqB)
;
InstA = any(UniqA, HOInstInfoA),
InstB = ground(_, _),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqA,
HOInstInfoA, NextInstA),
inst_matches_final_mt(NextInstA, InstB, MaybeType, !Info)
;
InstA = any(UniqA, HOInstInfoA),
InstB = bound(_, _, _),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqA,
HOInstInfoA, NextInstA),
inst_matches_final_mt(NextInstA, InstB, MaybeType, !Info)
;
InstA = free,
InstB = any(Uniq, _),
% We do not yet allow `free' to match `any',
% unless the `any' is `clobbered_any' or `mostly_clobbered_any'.
% Among other things, changing this would break compare_inst
% in modecheck_call.m.
( Uniq = clobbered ; Uniq = mostly_clobbered )
;
InstA = free,
InstB = free
;
InstA = bound(UniqA, InstResultsA, BoundInstsA),
InstB = any(UniqB, none_or_default_func),
unique_matches_final(UniqA, UniqB),
bound_inst_list_matches_uniq(BoundInstsA, UniqB,
!.Info ^ imi_module_info),
% We do not yet allow `free' to match `any'.
% Among other things, changing this would break compare_inst
% in modecheck_call.m.
inst_results_bound_inst_list_is_ground_or_any(InstResultsA,
BoundInstsA, !.Info ^ imi_module_info),
inst_contains_nondefault_func_mode_1(InstA, no, !Info)
;
InstA = bound(UniqA, _InstResultsA, BoundInstsA),
InstB = bound(UniqB, _InstResultsB, BoundInstsB),
unique_matches_final(UniqA, UniqB),
bound_inst_list_matches_final(BoundInstsA, BoundInstsB, MaybeType,
!Info)
;
InstA = bound(UniqA, InstResultsA, BoundInstsA),
InstB = ground(UniqB, none_or_default_func),
unique_matches_final(UniqA, UniqB),
inst_results_bound_inst_list_is_ground_mt(InstResultsA, BoundInstsA,
MaybeType, !.Info ^ imi_module_info),
bound_inst_list_matches_uniq(BoundInstsA, UniqB,
!.Info ^ imi_module_info),
inst_contains_nondefault_func_mode_1(InstA, no, !Info)
;
InstA = ground(UniqA, HOInstInfoA),
InstB = any(UniqB, HOInstInfoB),
ho_inst_info_matches_final(HOInstInfoA, HOInstInfoB, MaybeType, !Info),
unique_matches_final(UniqA, UniqB)
;
InstA = ground(UniqA, HOInstInfoA),
InstB = bound(UniqB, InstResultsB, BoundInstsB),
ho_inst_info_matches_ground_2(HOInstInfoA, MaybeType, !Info),
unique_matches_final(UniqA, UniqB),
ModuleInfo = !.Info ^ imi_module_info,
inst_results_bound_inst_list_is_ground_mt(InstResultsB, BoundInstsB,
MaybeType, ModuleInfo),
uniq_matches_bound_inst_list(UniqA, BoundInstsB, ModuleInfo),
inst_contains_nondefault_func_mode_1(InstB, no, !Info),
(
MaybeType = yes(Type),
% We can only do this check if the type is known.
bound_inst_list_is_complete_for_type(set.init, ModuleInfo,
BoundInstsB, Type)
;
% XXX the check for bound_inst_list_is_complete_for_type makes the
% mode checker too conservative in the absence of alias tracking.
% Bypass the check if instructed.
GroundMatchesBound = !.Info ^ imi_ground_matches_bound,
GroundMatchesBound = ground_matches_bound_always
)
;
InstA = ground(UniqA, HOInstInfoA),
InstB = ground(UniqB, HOInstInfoB),
ho_inst_info_matches_final(HOInstInfoA, HOInstInfoB, MaybeType, !Info),
unique_matches_final(UniqA, UniqB)
;
InstA = abstract_inst(_, _),
InstB = any(shared, none_or_default_func)
;
InstA = abstract_inst(Name, ArgsA),
InstB = abstract_inst(Name, ArgsB),
list.duplicate(length(ArgsA), no, MaybeTypes),
% XXX how do we get the argument types for an abstract inst?
inst_list_matches_final(ArgsA, ArgsB, MaybeTypes, !Info)
;
InstA = not_reached
;
InstA = constrained_inst_vars(InstVarsA, SubInstA),
( if InstB = constrained_inst_vars(InstVarsB, SubInstB) then
% Constrained_inst_vars match_final only if InstVarsA contains
% all the variables in InstVarsB.
set.subset(InstVarsB, InstVarsA),
inst_matches_final_mt(SubInstA, SubInstB, MaybeType, !Info)
else
inst_matches_final_mt(SubInstA, InstB, MaybeType, !Info)
)
).
:- pred ho_inst_info_matches_final(ho_inst_info::in, ho_inst_info::in,
maybe(mer_type)::in, inst_match_info::in, inst_match_info::out) is semidet.
ho_inst_info_matches_final(HOInstInfoA, HOInstInfoB, MaybeType, !Info) :-
(
HOInstInfoB = none_or_default_func,
ho_inst_info_matches_ground_2(HOInstInfoA, MaybeType, !Info)
;
HOInstInfoA = none_or_default_func,
HOInstInfoB = higher_order(PredInstB),
PredInstB = pred_inst_info(pf_function, ArgModes, _, _Det),
Arity = list.length(ArgModes),
PredInstA = pred_inst_info_default_func_mode(Arity),
pred_inst_matches_2(PredInstA, PredInstB, MaybeType, !Info)
;
HOInstInfoA = higher_order(PredInstA),
HOInstInfoB = higher_order(PredInstB),
pred_inst_matches_2(PredInstA, PredInstB, MaybeType, !Info)
).
:- pred inst_list_matches_final(list(mer_inst)::in, list(mer_inst)::in,
list(maybe(mer_type))::in, inst_match_info::in, inst_match_info::out)
is semidet.
inst_list_matches_final([], [], [], !Info).
inst_list_matches_final([ArgA | ArgsA], [ArgB | ArgsB],
[MaybeType | MaybeTypes], !Info) :-
inst_matches_final_mt(ArgA, ArgB, MaybeType, !Info),
inst_list_matches_final(ArgsA, ArgsB, MaybeTypes, !Info).
% Here we check that the functors in the first list are a subset of the
% functors in the second list. (If a bound(...) inst only specifies
% the insts for some of the constructors of its type, then it implicitly
% means that all other constructors must have all their arguments
% `not_reached'.) The code here makes use of the fact that the bound_inst
% lists are sorted.
%
:- pred bound_inst_list_matches_final(list(bound_inst)::in,
list(bound_inst)::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
bound_inst_list_matches_final([], _, _, !Info).
bound_inst_list_matches_final([X | Xs], [Y | Ys], MaybeType, !Info) :-
X = bound_functor(ConsIdX, ArgsX),
Y = bound_functor(ConsIdY, ArgsY),
( if equivalent_cons_ids(ConsIdX, ConsIdY) then
maybe_get_cons_id_arg_types(!.Info ^ imi_module_info, MaybeType,
ConsIdX, list.length(ArgsX), MaybeTypes),
inst_list_matches_final(ArgsX, ArgsY, MaybeTypes, !Info),
bound_inst_list_matches_final(Xs, Ys, MaybeType, !Info)
else
greater_than_disregard_module_qual(ConsIdX, ConsIdY),
% ConsIdY does not occur in [X | Xs].
% Hence [X | Xs] implicitly specifies `not_reached' for the args
% of ConsIdY, and hence automatically matches_final Y. We just
% need to check that [X | Xs] matches_final Ys.
bound_inst_list_matches_final([X | Xs], Ys, MaybeType, !Info)
).
inst_is_at_least_as_instantiated(InstA, InstB, Type, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo, no, cs_none, uc_instantiated, no,
ground_matches_bound_if_complete),
inst_matches_initial_mt(InstA, InstB, yes(Type), Info0, _).
%-----------------------------------------------------------------------------%
inst_matches_binding(InstA, InstB, Type, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo, no, cs_none, uc_match, no,
ground_matches_bound_if_complete),
inst_matches_binding_mt(InstA, InstB, yes(Type), Info0, _).
inst_matches_binding_allow_any_any(InstA, InstB, Type, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo, no, cs_none, uc_match, yes,
ground_matches_bound_if_complete),
inst_matches_binding_mt(InstA, InstB, yes(Type), Info0, _).
:- pred inst_matches_binding_mt(mer_inst::in, mer_inst::in,
maybe(mer_type)::in, inst_match_info::in, inst_match_info::out) is semidet.
inst_matches_binding_mt(InstA, InstB, MaybeType, !Info) :-
ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType),
Expansions0 = !.Info ^ imi_expansions,
( if expansion_insert_new(ThisExpansion, Expansions0, Expansions) then
!Info ^ imi_expansions := Expansions,
inst_expand_and_remove_constrained_inst_vars(!.Info ^ imi_module_info,
InstA, ExpandedInstA),
inst_expand_and_remove_constrained_inst_vars(!.Info ^ imi_module_info,
InstB, ExpandedInstB),
inst_matches_binding_3(ExpandedInstA, ExpandedInstB, MaybeType, !Info)
else
true
).
:- pred inst_matches_binding_3(mer_inst::in, mer_inst::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
inst_matches_binding_3(InstA, InstB, MaybeType, !Info) :-
(
InstA = free,
InstB = free
;
InstA = any(UniqA, HOInstInfoA),
InstB = any(UniqB, HOInstInfoB),
% Note that `any' is *not* considered to match `any' unless
% Info ^ any_matches_any = yes or the type is not a solver type
% (and does not contain any solver types).
AnyMatchesAny = !.Info ^ imi_any_matches_any,
(
AnyMatchesAny = yes,
ho_inst_info_matches_final(HOInstInfoA, HOInstInfoB, MaybeType,
!Info)
;
AnyMatchesAny = no,
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqA,
HOInstInfoA, NextInstA),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqB,
HOInstInfoB, NextInstB),
inst_matches_binding_mt(NextInstA, NextInstB, MaybeType, !Info)
)
;
InstA = any(UniqA, HOInstInfoA),
InstB = ground(_, _),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqA,
HOInstInfoA, NextInstA),
inst_matches_binding_mt(NextInstA, InstB, MaybeType, !Info)
;
InstA = any(UniqA, HOInstInfoA),
InstB = bound(_, _, _),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqA,
HOInstInfoA, NextInstA),
inst_matches_binding_mt(NextInstA, InstB, MaybeType, !Info)
;
InstA = ground(_, _),
InstB = any(UniqB, HOInstInfoB),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqB,
HOInstInfoB, NextInstB),
inst_matches_binding_mt(InstA, NextInstB, MaybeType, !Info)
;
InstA = bound(_, _, _),
InstB = any(UniqB, HOInstInfoB),
maybe_any_to_bound(MaybeType, !.Info ^ imi_module_info, UniqB,
HOInstInfoB, NextInstB),
inst_matches_binding_mt(InstA, NextInstB, MaybeType, !Info)
;
InstA = bound(_UniqA, _InstResultA, BoundInstsA),
InstB = bound(_UniqB, _InstResultB, BoundInstsB),
bound_inst_list_matches_binding(BoundInstsA, BoundInstsB, MaybeType,
!Info)
;
InstA = bound(_UniqA, InstResultsA, BoundInstsA),
InstB = ground(_UniqB, none_or_default_func),
inst_results_bound_inst_list_is_ground_mt(InstResultsA, BoundInstsA,
MaybeType, !.Info ^ imi_module_info),
inst_contains_nondefault_func_mode_1(InstA, no, !Info)
;
InstA = ground(_UniqA, _),
InstB = bound(_UniqB, InstResultsB, BoundInstsB),
inst_results_bound_inst_list_is_ground_mt(InstResultsB, BoundInstsB,
MaybeType, !.Info ^ imi_module_info),
inst_contains_nondefault_func_mode_1(InstB, no, !Info),
(
MaybeType = yes(Type),
% We can only do this check if the type is known.
bound_inst_list_is_complete_for_type(set.init,
!.Info ^ imi_module_info, BoundInstsB, Type)
;
MaybeType = no,
fail
)
;
InstA = ground(_UniqA, HOInstInfoA),
InstB = ground(_UniqB, HOInstInfoB),
ho_inst_info_matches_binding(HOInstInfoA, HOInstInfoB, MaybeType,
!.Info ^ imi_module_info)
;
InstA = abstract_inst(Name, ArgsA),
InstB = abstract_inst(Name, ArgsB),
list.duplicate(length(ArgsA), no, MaybeTypes),
% XXX how do we get the argument types for an abstract inst?
inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes, !Info)
;
InstA = not_reached
).
:- pred ho_inst_info_matches_binding(ho_inst_info::in, ho_inst_info::in,
maybe(mer_type)::in, module_info::in) is semidet.
ho_inst_info_matches_binding(HOInstInfoA, HOInstInfoB, MaybeType,
ModuleInfo) :-
(
HOInstInfoB = none_or_default_func,
ho_inst_info_matches_ground_mt(ModuleInfo, HOInstInfoA, MaybeType)
;
HOInstInfoA = none_or_default_func,
HOInstInfoB = higher_order(PredInstB),
PredInstB = pred_inst_info(pf_function, ArgModes, _, _Det),
Arity = list.length(ArgModes),
PredInstA = pred_inst_info_default_func_mode(Arity),
pred_inst_matches_mt(PredInstA, PredInstB, MaybeType, ModuleInfo)
;
HOInstInfoA = higher_order(PredInstA),
HOInstInfoB = higher_order(PredInstB),
pred_inst_matches_mt(PredInstA, PredInstB, MaybeType, ModuleInfo)
).
:- pred inst_list_matches_binding(list(mer_inst)::in, list(mer_inst)::in,
list(maybe(mer_type))::in, inst_match_info::in, inst_match_info::out)
is semidet.
inst_list_matches_binding([], [], [], !Info).
inst_list_matches_binding([ArgA | ArgsA], [ArgB | ArgsB],
[MaybeType | MaybeTypes], !Info) :-
inst_matches_binding_mt(ArgA, ArgB, MaybeType, !Info),
inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes, !Info).
% Here we check that the functors in the first list are a subset of the
% functors in the second list. (If a bound(...) inst only specifies
% the insts for some of the constructors of its type, then it implicitly
% means that all other constructors must have all their arguments
% `not_reached'.) The code here makes use of the fact that the bound_inst
% lists are sorted.
%
:- pred bound_inst_list_matches_binding(list(bound_inst)::in,
list(bound_inst)::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
bound_inst_list_matches_binding([], _, _, !Info).
bound_inst_list_matches_binding([X | Xs], [Y | Ys], MaybeType, !Info) :-
X = bound_functor(ConsIdX, ArgsX),
Y = bound_functor(ConsIdY, ArgsY),
( if equivalent_cons_ids(ConsIdX, ConsIdY) then
maybe_get_cons_id_arg_types(!.Info ^ imi_module_info, MaybeType,
ConsIdX, list.length(ArgsX), MaybeTypes),
inst_list_matches_binding(ArgsX, ArgsY, MaybeTypes, !Info),
bound_inst_list_matches_binding(Xs, Ys, MaybeType, !Info)
else
greater_than_disregard_module_qual(ConsIdX, ConsIdY),
% ConsIdX does not occur in [X | Xs].
% Hence [X | Xs] implicitly specifies `not_reached' for the args
% of ConsIdY, and hence automatically matches_binding Y. We just
% need to check that [X | Xs] matches_binding Ys.
bound_inst_list_matches_binding([X | Xs], Ys, MaybeType, !Info)
).
%-----------------------------------------------------------------------------%
% Determine what kind of uniqueness comparison we are doing and then do it.
% If we are doing a "match" then call unique_matches_initial to do the
% comparison. If we are comparing "instantiatedness" then the uniqueness
% comparison is the reverse of when we are doing a match so call
% unique_matches_initial with the arguments reversed.
%
:- pred compare_uniqueness(uniqueness_comparison::in,
uniqueness::in, uniqueness::in) is semidet.
compare_uniqueness(uc_match, InstA, InstB) :-
unique_matches_initial(InstA, InstB).
compare_uniqueness(uc_instantiated, InstA, InstB) :-
unique_matches_initial(InstB, InstA).
unique_matches_initial(unique, _).
unique_matches_initial(mostly_unique, mostly_unique).
unique_matches_initial(mostly_unique, shared).
unique_matches_initial(mostly_unique, mostly_clobbered).
unique_matches_initial(mostly_unique, clobbered).
unique_matches_initial(shared, shared).
unique_matches_initial(shared, mostly_clobbered).
unique_matches_initial(shared, clobbered).
unique_matches_initial(mostly_clobbered, mostly_clobbered).
unique_matches_initial(mostly_clobbered, clobbered).
unique_matches_initial(clobbered, clobbered).
unique_matches_final(A, B) :-
unique_matches_initial(A, B).
%-----------------------------------------------------------------------------%
inst_contains_nondefault_func_mode(ModuleInfo, Inst) :-
Info = init_inst_match_info(ModuleInfo, no, cs_none, uc_match, yes,
ground_matches_bound_if_complete),
inst_contains_nondefault_func_mode_1(Inst, yes, Info, _).
:- pred inst_contains_nondefault_func_mode_1(mer_inst::in, bool::out,
inst_match_info::in, inst_match_info::out) is det.
inst_contains_nondefault_func_mode_1(Inst, ContainsNonstd, !Info) :-
inst_contains_nondefault_func_mode_2(Inst, set.init, ContainsNonstd,
!Info).
:- pred inst_contains_nondefault_func_mode_2(mer_inst::in, set(inst_name)::in,
bool::out, inst_match_info::in, inst_match_info::out) is det.
inst_contains_nondefault_func_mode_2(Inst, !.Expansions, ContainsNonstd,
!Info) :-
(
Inst = ground(_, HOInstInfo),
( if ho_inst_info_matches_ground_2(HOInstInfo, no, !Info) then
ContainsNonstd = no
else
ContainsNonstd = yes
)
;
Inst = bound(_, InstResults, BoundInsts),
(
InstResults = inst_test_results_fgtc,
ContainsNonstd = no
;
( InstResults = inst_test_results(_, _, _, _, _, _)
; InstResults = inst_test_no_results
),
bound_inst_list_contains_nondefault_func_mode(BoundInsts,
!.Expansions, ContainsNonstd, !Info)
)
;
Inst = inst_var(_),
unexpected($module, $pred, "uninstantiated inst parameter")
;
Inst = defined_inst(InstName),
( if set.member(InstName, !.Expansions) then
ContainsNonstd = no
else
set.insert(InstName, !Expansions),
inst_lookup(!.Info ^ imi_module_info, InstName, SubInst),
inst_contains_nondefault_func_mode_2(SubInst, !.Expansions,
ContainsNonstd, !Info)
)
;
Inst = constrained_inst_vars(_, SubInst),
inst_contains_nondefault_func_mode_2(SubInst, !.Expansions,
ContainsNonstd, !Info)
;
( Inst = free
; Inst = free(_)
; Inst = not_reached
; Inst = abstract_inst(_, _)
),
ContainsNonstd = no
;
Inst = any(_, _),
% XXX This code preserves the old behavior of the predicate that
% preceded this function, but it is arguably incorrect, since
% any/2 insts, like ground/2 insts, contain a ho_inst_info.
ContainsNonstd = no
).
:- pred inst_list_contains_nondefault_func_mode(list(mer_inst)::in,
set(inst_name)::in, bool::out, inst_match_info::in, inst_match_info::out)
is det.
inst_list_contains_nondefault_func_mode([], _Expansions, no, !Info).
inst_list_contains_nondefault_func_mode([Inst | Insts], Expansions,
ContainsNonstd, !Info) :-
inst_contains_nondefault_func_mode_2(Inst, Expansions, HeadContainsNonstd,
!Info),
(
HeadContainsNonstd = yes,
ContainsNonstd = yes
;
HeadContainsNonstd = no,
inst_list_contains_nondefault_func_mode(Insts, Expansions,
ContainsNonstd, !Info)
).
:- pred bound_inst_list_contains_nondefault_func_mode(list(bound_inst)::in,
set(inst_name)::in, bool::out, inst_match_info::in, inst_match_info::out)
is det.
bound_inst_list_contains_nondefault_func_mode([], _Expansions, no, !Info).
bound_inst_list_contains_nondefault_func_mode([BoundInst | BoundInsts],
Expansions, ContainsNonstd, !Info) :-
BoundInst = bound_functor(_ConsId, ArgInsts),
inst_list_contains_nondefault_func_mode(ArgInsts, Expansions,
HeadContainsNonstd, !Info),
(
HeadContainsNonstd = yes,
ContainsNonstd = yes
;
HeadContainsNonstd = no,
bound_inst_list_contains_nondefault_func_mode(BoundInsts, Expansions,
ContainsNonstd, !Info)
).
%---------------------------------------------------------------------------%
ho_inst_info_matches_ground(ModuleInfo, HOInstInfo) :-
ho_inst_info_matches_ground_mt(ModuleInfo, HOInstInfo, no).
:- pred ho_inst_info_matches_ground_mt(module_info::in, ho_inst_info::in,
maybe(mer_type)::in) is semidet.
ho_inst_info_matches_ground_mt(ModuleInfo, HOInstInfo, MaybeType) :-
Info = init_inst_match_info(ModuleInfo, no, cs_none, uc_match, yes,
ground_matches_bound_if_complete),
ho_inst_info_matches_ground_2(HOInstInfo, MaybeType, Info, _).
:- pred ho_inst_info_matches_ground_2(ho_inst_info::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
ho_inst_info_matches_ground_2(HOInstInfo, MaybeType, !Info) :-
(
HOInstInfo = higher_order(PredInst),
pred_inst_matches_ground_2(PredInst, MaybeType, !Info)
;
HOInstInfo = none_or_default_func
).
pred_inst_matches_ground(ModuleInfo, PredInst) :-
pred_inst_matches_ground_mt(ModuleInfo, PredInst, no).
:- pred pred_inst_matches_ground_mt(module_info::in, pred_inst_info::in,
maybe(mer_type)::in) is semidet.
pred_inst_matches_ground_mt(ModuleInfo, PredInst, MaybeType) :-
Info = init_inst_match_info(ModuleInfo, no, cs_none, uc_match, yes,
ground_matches_bound_if_complete),
pred_inst_matches_ground_2(PredInst, MaybeType, Info, _).
:- pred pred_inst_matches_ground_2(pred_inst_info::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
pred_inst_matches_ground_2(PredInst, MaybeType, !Info) :-
PredInst = pred_inst_info(PredOrFunc, ArgModes, _, _),
(
PredOrFunc = pf_predicate
;
PredOrFunc = pf_function,
Arity = list.length(ArgModes),
DefaultFunc = pred_inst_info_default_func_mode(Arity),
pred_inst_matches_2(PredInst, DefaultFunc, MaybeType, !Info)
).
%-----------------------------------------------------------------------------%
pred_inst_matches(PredInstA, PredInstB, ModuleInfo) :-
pred_inst_matches_mt(PredInstA, PredInstB, no, ModuleInfo).
:- pred pred_inst_matches_mt(pred_inst_info::in, pred_inst_info::in,
maybe(mer_type)::in, module_info::in) is semidet.
pred_inst_matches_mt(PredInstA, PredInstB, MaybeType, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo, no, cs_none, uc_match, yes,
ground_matches_bound_if_complete),
pred_inst_matches_2(PredInstA, PredInstB, MaybeType, Info0, _).
% pred_inst_matches_2(PredInstA, PredInstB, !Info)
%
% Same as pred_inst_matches/3, except that it updates the inst_var_sub
% in the inst_match_info, and that any inst pairs in !.Info ^ expansions
% are assumed to match_final each other. (This avoids infinite loops
% when calling inst_matches_final on higher-order recursive insts.)
%
:- pred pred_inst_matches_2(pred_inst_info::in, pred_inst_info::in,
maybe(mer_type)::in, inst_match_info::in, inst_match_info::out) is semidet.
pred_inst_matches_2(PredInstA, PredInstB, MaybeType, !Info) :-
% In the float_regs.m pass a variable may take on pred insts which differ
% only in the arg reg lists in different branches. They should be allowed
% to match here.
PredInstA = pred_inst_info(PredOrFunc, ModesA, _MaybeArgRegsA, Det),
PredInstB = pred_inst_info(PredOrFunc, ModesB, _MaybeArgRegsB, Det),
maybe_get_higher_order_arg_types(MaybeType, length(ModesA), MaybeTypes),
pred_inst_argmodes_matches(ModesA, ModesB, MaybeTypes, !Info).
% pred_inst_argmodes_matches(ModesA, ModesB, MaybeTypes, !Info):
%
% succeeds if the initial insts of ModesB specify at least as much
% information as, and the same binding as, the initial insts of ModesA;
% and the final insts of ModesA specify at least as much information as,
% and the same binding as, the final insts of ModesB. Any inst pairs
% in Inst0 ^ expansions are assumed to match_final each other.
%
% (In other words, as far as subtyping goes it is contravariant in
% the initial insts, and covariant in the final insts;
% as far as binding goes, it is invariant for both.)
%
:- pred pred_inst_argmodes_matches(list(mer_mode)::in, list(mer_mode)::in,
list(maybe(mer_type))::in, inst_match_info::in, inst_match_info::out)
is semidet.
pred_inst_argmodes_matches([], [], [], !Info).
pred_inst_argmodes_matches([ModeA | ModeAs], [ModeB | ModeBs],
[MaybeType | MaybeTypes], !Info) :-
ModuleInfo = !.Info ^ imi_module_info,
mode_get_insts(ModuleInfo, ModeA, InitialA, FinalA0),
mode_get_insts(ModuleInfo, ModeB, InitialB, FinalB),
% inst_matches_final_mt should probably just accept cs_reverse directly.
swap_sub(inst_matches_final_mt(InitialB, InitialA, MaybeType), !Info),
% Apply the substitution computed so far (it may be necessary for InitialA
% as well).
maybe_apply_substitution(!.Info, FinalA0, FinalA),
inst_matches_final_mt(FinalA, FinalB, MaybeType, !Info),
pred_inst_argmodes_matches(ModeAs, ModeBs, MaybeTypes, !Info).
:- pred maybe_apply_substitution(inst_match_info::in,
mer_inst::in, mer_inst::out) is det.
maybe_apply_substitution(Info, Inst0, Inst) :-
(
Info ^ imi_maybe_sub = yes(Subst),
inst_apply_substitution(Subst, Inst0, Inst)
;
Info ^ imi_maybe_sub = no,
Inst = Inst0
).
%-----------------------------------------------------------------------------%
:- pred inst_name_contains_inst_var(inst_name::in, inst_var::out) is nondet.
inst_name_contains_inst_var(InstName, InstVar) :-
require_complete_switch [InstName]
(
InstName = user_inst(_Name, ArgInsts),
inst_list_contains_inst_var(ArgInsts, InstVar)
;
InstName = merge_inst(InstA, InstB),
( inst_contains_inst_var(InstA, InstVar)
; inst_contains_inst_var(InstB, InstVar)
)
;
InstName = unify_inst(_Live, _Real, InstA, InstB),
( inst_contains_inst_var(InstA, InstVar)
; inst_contains_inst_var(InstB, InstVar)
)
;
InstName = ground_inst(SubInstName, _Live, _Uniq, _Real),
inst_name_contains_inst_var(SubInstName, InstVar)
;
InstName = any_inst(SubInstName, _Live, _Uniq, _Real),
inst_name_contains_inst_var(SubInstName, InstVar)
;
InstName = shared_inst(SubInstName),
inst_name_contains_inst_var(SubInstName, InstVar)
;
InstName = mostly_uniq_inst(SubInstName),
inst_name_contains_inst_var(SubInstName, InstVar)
;
InstName = typed_ground(_Uniq, _Type),
fail
;
InstName = typed_inst(_Type, SubInstName),
inst_name_contains_inst_var(SubInstName, InstVar)
).
:- pred inst_contains_inst_var(mer_inst::in, inst_var::out) is nondet.
inst_contains_inst_var(Inst, InstVar) :-
(
Inst = inst_var(InstVar)
;
Inst = defined_inst(InstName),
inst_name_contains_inst_var(InstName, InstVar)
;
Inst = bound(_Uniq, InstResults, BoundInsts),
(
InstResults = inst_test_results_fgtc,
fail
;
InstResults = inst_test_results(_, _, _, InstVarResult, _, _),
(
InstVarResult = inst_result_contains_inst_vars_known(InstVars),
set.member(InstVar, InstVars),
% Membership in InstVars means that BoundInsts *may* contain
% InstVar, not that it *does*, so we have to check whether
% it actually does.
bound_inst_list_contains_inst_var(BoundInsts, InstVar)
;
InstVarResult = inst_result_contains_inst_vars_unknown,
bound_inst_list_contains_inst_var(BoundInsts, InstVar)
)
;
InstResults = inst_test_no_results,
bound_inst_list_contains_inst_var(BoundInsts, InstVar)
)
;
Inst = ground(_Uniq, HOInstInfo),
HOInstInfo = higher_order(pred_inst_info(_PredOrFunc, Modes, _, _Det)),
mode_list_contains_inst_var(Modes, InstVar)
;
Inst = abstract_inst(_Name, ArgInsts),
inst_list_contains_inst_var(ArgInsts, InstVar)
).
:- pred bound_inst_list_contains_inst_var(list(bound_inst)::in, inst_var::out)
is nondet.
bound_inst_list_contains_inst_var([BoundInst | BoundInsts], InstVar) :-
BoundInst = bound_functor(_Functor, ArgInsts),
(
inst_list_contains_inst_var(ArgInsts, InstVar)
;
bound_inst_list_contains_inst_var(BoundInsts, InstVar)
).
:- pred inst_list_contains_inst_var(list(mer_inst)::in, inst_var::out)
is nondet.
inst_list_contains_inst_var([Inst | Insts], InstVar) :-
(
inst_contains_inst_var(Inst, InstVar)
;
inst_list_contains_inst_var(Insts, InstVar)
).
mode_list_contains_inst_var([Mode | Modes], InstVar) :-
(
mode_contains_inst_var(Mode, InstVar)
;
mode_list_contains_inst_var(Modes, InstVar)
).
:- pred mode_contains_inst_var(mer_mode::in, inst_var::out) is nondet.
mode_contains_inst_var(Mode, InstVar) :-
(
Mode = from_to_mode(Initial, Final),
( Inst = Initial ; Inst = Final )
;
Mode = user_defined_mode(_Name, Insts),
list.member(Inst, Insts)
),
inst_contains_inst_var(Inst, InstVar).
%-----------------------------------------------------------------------------%
:- pred same_addr_insts(mer_inst::in, mer_inst::in) is semidet.
:- pragma foreign_proc("C",
same_addr_insts(InstA::in, InstB::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
SUCCESS_INDICATOR = ((void *) InstA == (void *) InstB);
").
same_addr_insts(_, _) :-
semidet_fail.
%-----------------------------------------------------------------------------%
:- end_module check_hlds.inst_match.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink