Files
mercury/compiler/inst_match.m
Zoltan Somogyi b56885be93 Fix a bug that caused bootchecks with --optimize-constructor-last-call to fail.
Estimated hours taken: 12
Branches: main

Fix a bug that caused bootchecks with --optimize-constructor-last-call to fail.

The problem was not in lco.m, but in follow_code.m. In some cases,
(specifically, the LCMC version of insert_2 in sparse_bitset.m),
follow_code.m moved an impure goal (store_at_ref) into the arms of an
if-then-else without marking those arms, or the if-then-else, as impure.
The next pass, simplify, then deleted the entire if-then-else, since it
had no outputs. (The store_at_ref that originally appeared after the
if-then-else was the only consumer of its only output.)

The fix is to get follow_code.m to make branched control structures such as
if-then-elses, as well as their arms, semipure or impure if a goal being moved
into them is semipure or impure, or if they came from an semipure or impure
conjunction.

Improve the optimization of the LCMC version of sparse_bitset.insert_2, which
had a foreign_proc invocation of bits_per_int in it: replace such invocations
with a unification of the bits_per_int constant if not cross compiling.

Add a new option, --optimize-constructor-last-call-null. When set, LCMC will
assign NULLs to the fields not yet filled in, to avoid any junk happens to be
there from being followed by the garbage collector's mark phase.

This diff also makes several other changes that helped me to track down
the bug above.

compiler/follow_code.m:
	Make the fix described above.

	Delete all the provisions for --prev-code; it won't be implemented.

	Don't export a predicate that is not now used anywhere else.

compiler/simplify.m:
	Make the optimization described above.

compiler/lco.m:
	Make sure that the LCMC specialized procedure is a predicate, not a
	function: having a function with the mode LCMC_insert_2(in, in) = in
	looks wrong.

	To avoid name collisions when a function and a predicate with the same
	name and arity have LCMC applied to them, include the predicate vs
	function status of the original procedure included in the name of the
	new procedure.

	Update the sym_name of calls to LCMC variants, not just the pred_id,
	because without that, the HLDS dump looks misleading.

compiler/pred_table.m:
	Don't have optimizations like LCMC insert new predicates at the front
	of the list of predicates. Maintain the list of predicates in the
	module as a two part list, to allow efficient addition of new pred_ids
	at the (logical) end without using O(N^2) algorithms. Having predicates
	in chronological order makes it easier to look at HLDS dumps and
	.c files.

compiler/hlds_module.m:
	Make module_info_predids return a module_info that is physically
	updated though logically unchanged.

compiler/options.m:
	Add --optimize-constructor-last-call-null.

	Make the options --dump-hlds-pred-id, --debug-opt-pred-id and
	--debug-opt-pred-name into accumulating options, to allow the user
	to specify more than one predicate to be dumped (e.g. insert_2 and
	its LCMC variant).

	Delete --prev-code.

doc/user_guide.texi:
	Document the changes in options.m.

compiler/code_info.m:
	Record the value of --optimize-constructor-last-call-null in the
	code_info, to avoid lookup at every cell construction.

compiler/unify_gen.m:
compiler/var_locn.m:
	When deciding whether a cell can be static or not, make sure that
	we never make static a cell that has some fields initialized with
	dummy zeros, to be filled in for real later.

compiler/hlds_out.m:
	For goals that are semipure or impure, note this fact. This info was
	lost when I changed the representation of impurity from markers to a
	field.

mdbcomp/prim_data.m:
	Rename some ambiguous function symbols.

compiler/intermod.m:
compiler/trans_opt.m:
	Rename the main predicates (and some function symbols) of these modules
	to avoid ambiguity and to make them more expressive.

compiler/llds.m:
	Don't print line numbers for foreign_code fragments if the user has
	specified --no-line-numbers.

compiler/make.dependencies.m:
compiler/mercury_to_mercury.m:
compiler/recompilation.usage.m:
	Don't use io.write to write out information to files we may need to
	parse again, because this is vulnerable to changes to the names of
	function symbols (e.g. the one to mdbcomp/prim_data.m).

	The compiler still contains some uses of io.write, but they are
	for debugging. I added an item to the todo list of the one exception,
	ilasm.m.

compiler/recompilation.m:
	Rename a misleading function symbol name.

compiler/parse_tree.m:
	Don't import recompilation.m here. It is not needed (all the components
	of parse_tree that need recompilation.m already import it themselves),
	and deleting the import avoids recompiling almost everything when
	recompilation.m changes.

compiler/*.m:
	Conform to the changes above.

compiler/*.m:
browser/*.m:
slice/*.m:
	Conform to the change to mdbcomp.

library/sparse_bitset.m:
	Use some better variable names.
2007-01-19 07:05:06 +00:00

2072 lines
86 KiB
Mathematica

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1995-1998, 2000-2007 The University of Melbourne.
% 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.
%
% rafe: XXX The following comment needs revising in the light of
% the new solver types design.
%
% The handling of `any' insts is not complete. (See also inst_util.m) It
% would be nice to allow `free' to match `any', but right now we only allow a
% few special cases of that. The reason is that although the mode analysis
% would be pretty straight-forward, generating the correct code is quite a bit
% trickier. modes.m would have to be changed to handle the implicit
% conversions from `free'/`bound'/`ground' to `any' at
%
% (1) procedure calls (this is just an extension of implied modes)
% currently we support only the easy cases of this
% (2) the end of branched goals
% (3) the end of predicates.
%
% Since that is not yet done, we currently require the user to insert explicit
% calls to initialize constraint variables.
%
% 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_expand(ModuleInfo, Inst0, Inst) checks if the top-level
% part of the inst is a defined inst, and if so replaces it
% with the definition.
%
:- pred inst_expand(module_info::in, mer_inst::in, mer_inst::out) is det.
% inst_expand_and_remove_constrained_inst_vars is the same as inst_expand
% except that it also removes constrained_inst_vars from the top level,
% replacing them with the constraining inst.
%
:- pred inst_expand_and_remove_constrained_inst_vars(module_info::in,
mer_inst::in, mer_inst::out) is det.
%-----------------------------------------------------------------------------%
% 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, 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(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 different 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(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(mer_inst::in, mer_inst::in, mer_type::in,
module_info::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.
% 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_matches_binding(InstA, InstB, 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.
%-----------------------------------------------------------------------------%
% 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.
%-----------------------------------------------------------------------------%
%
% Predicates to test various properties of insts
%
% NOTE: `not_reached' insts are considered to satisfy all of these predicates
% except inst_is_clobbered.
%
% succeed if the inst is fully ground (i.e. contains only `ground',
% `bound', and `not_reached' insts, with no `free' or `any' insts).
% This predicate succeeds for non-standard function insts so some care
% needs to be taken since these insts may not be replaced by a less
% precise inst that uses the higher-order mode information.
%
:- pred inst_is_ground(module_info::in, mer_inst::in) is semidet.
% succeed if the inst is not partly free (i.e. contains only `any',
% `ground', `bound', and `not_reached' insts, with no `free' insts).
% This predicate succeeds for non-standard function insts so some care
% needs to be taken since these insts may not be replaced by a less
% precise inst that uses the higher-order mode information.
%
:- pred inst_is_ground_or_any(module_info::in, mer_inst::in) is semidet.
% Succeed if the inst is `mostly_unique' or `unique'.
%
:- pred inst_is_mostly_unique(module_info::in, mer_inst::in) is semidet.
% Succeed if the inst is `unique'.
%
:- pred inst_is_unique(module_info::in, mer_inst::in) is semidet.
% Succeed if the inst is not `mostly_unique' or `unique'.
%
:- pred inst_is_not_partly_unique(module_info::in, mer_inst::in) is semidet.
% Succeed if the inst is not `unique'.
%
:- pred inst_is_not_fully_unique(module_info::in, mer_inst::in) is semidet.
:- pred inst_is_clobbered(module_info::in, mer_inst::in) is semidet.
:- pred inst_list_is_ground(list(mer_inst)::in, module_info::in) is semidet.
:- pred inst_list_is_ground_or_any(list(mer_inst)::in, module_info::in)
is semidet.
:- pred inst_list_is_unique(list(mer_inst)::in, module_info::in) is semidet.
:- pred inst_list_is_mostly_unique(list(mer_inst)::in, module_info::in)
is semidet.
:- pred inst_list_is_not_partly_unique(list(mer_inst)::in, module_info::in)
is semidet.
:- pred inst_list_is_not_fully_unique(list(mer_inst)::in, module_info::in)
is semidet.
:- pred bound_inst_list_is_ground(list(bound_inst)::in, module_info::in)
is semidet.
:- pred bound_inst_list_is_ground_or_any(list(bound_inst)::in,
module_info::in) is semidet.
:- pred bound_inst_list_is_unique(list(bound_inst)::in, module_info::in)
is semidet.
:- pred bound_inst_list_is_mostly_unique(list(bound_inst)::in, module_info::in)
is semidet.
:- pred bound_inst_list_is_not_partly_unique(list(bound_inst)::in,
module_info::in) is semidet.
:- pred bound_inst_list_is_not_fully_unique(list(bound_inst)::in,
module_info::in) is semidet.
:- pred inst_is_free(module_info::in, mer_inst::in) is semidet.
:- pred inst_is_any(module_info::in, mer_inst::in) is semidet.
:- pred inst_list_is_free(list(mer_inst)::in, module_info::in) is semidet.
:- pred bound_inst_list_is_free(list(bound_inst)::in, module_info::in)
is semidet.
:- pred inst_is_bound(module_info::in, mer_inst::in) is semidet.
:- pred inst_is_bound_to_functors(module_info::in, mer_inst::in,
list(bound_inst)::out) is semidet.
%-----------------------------------------------------------------------------%
% Succeed iff the specified inst contains (directly or indirectly) the
% specified inst_name.
%
:- pred inst_contains_instname(mer_inst::in, module_info::in, inst_name::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, module_info::in,
inst_var::out) is nondet.
% Given a list of insts, and a corresponding list of livenesses, return
% true iff for every element in the list of insts, either the elemement is
% ground or the corresponding element in the liveness list is dead.
%
:- pred inst_list_is_ground_or_dead(list(mer_inst)::in, list(is_live)::in,
module_info::in) is semidet.
% Given a list of insts, and a corresponding list of livenesses, return
% true iff for every element in the list of insts, either the elemement is
% ground or any, or the corresponding element in the liveness list is
% dead.
%
:- pred inst_list_is_ground_or_any_or_dead(list(mer_inst)::in,
list(is_live)::in, module_info::in) is semidet.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module libs.
:- import_module libs.compiler_util.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module set.
:- import_module set_tree234.
:- import_module svset.
:- import_module term.
%-----------------------------------------------------------------------------%
inst_matches_initial(InstA, InstB, Type, ModuleInfo) :-
inst_matches_initial_1(InstA, InstB, Type, ModuleInfo, _, no, _).
inst_matches_initial(InstA, InstB, Type, !ModuleInfo, !Sub) :-
inst_matches_initial_1(InstA, InstB, Type, !ModuleInfo,
yes(!.Sub), MaybeSub),
(
MaybeSub = yes(!:Sub)
;
MaybeSub = no,
unexpected(this_file, "inst_matches_initial: missing inst_var_sub")
).
inst_matches_initial_no_implied_modes(InstA, InstB, Type, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo) ^ calculate_sub := forward,
inst_matches_final_2(InstA, InstB, yes(Type), Info0, _).
inst_matches_initial_no_implied_modes(InstA, InstB, Type, !ModuleInfo, !Sub) :-
Info0 = (init_inst_match_info(!.ModuleInfo)
^ calculate_sub := forward)
^ maybe_sub := yes(!.Sub),
inst_matches_final_2(InstA, InstB, yes(Type), Info0, Info),
!:ModuleInfo = Info ^ module_info,
yes(!:Sub) = Info ^ 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)
^ maybe_sub := !.MaybeSub)
^ calculate_sub := forward,
inst_matches_initial_2(InstA, InstB, yes(Type), Info0, Info),
!:ModuleInfo = Info ^ module_info,
!:MaybeSub = Info ^ maybe_sub.
:- 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_member(inst_match_inputs::in, expansions::in) is semidet.
:- pragma inline(expansion_member/2).
expansion_member(E, S) :-
set_tree234.is_member(S, E) = yes.
:- pred expansion_insert(inst_match_inputs::in,
expansions::in, expansions::out) is det.
:- pragma inline(expansion_insert/3).
expansion_insert(E, S0, S) :-
set_tree234.insert(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
---> match
% We are doing a "matches" comparison, e.g. at a predicate call
% or the end of a procedure body.
; 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(
module_info :: module_info,
expansions :: expansions,
maybe_sub :: maybe(inst_var_sub),
calculate_sub :: calculate_sub,
uniqueness_comparison :: uniqueness_comparison,
any_matches_any :: bool
).
% The calculate_sub type determines how the inst var substitution
% should be calculated.
:- type calculate_sub
---> forward
% Calculate in the (normal) forward direction
% (used by inst_matches_initial).
; 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.
; none.
% Do not calculate inst var substitions.
:- func sub(inst_match_info) = inst_var_sub is semidet.
sub(Info) = Sub :-
Info ^ maybe_sub = yes(Sub).
:- func 'sub :='(inst_match_info, inst_var_sub) = inst_match_info.
'sub :='(Info, Sub) =
Info ^ maybe_sub := yes(Sub).
:- func init_inst_match_info(module_info) = inst_match_info.
init_inst_match_info(ModuleInfo) =
inst_match_info(ModuleInfo, expansion_init, no, none, match, yes).
:- 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 ^ calculate_sub,
!:Info = !.Info ^ calculate_sub := swap_calculate_sub(CalculateSub),
P(!Info),
!:Info = !.Info ^ calculate_sub := CalculateSub.
:- func swap_calculate_sub(calculate_sub) = calculate_sub.
swap_calculate_sub(forward) = reverse.
swap_calculate_sub(reverse) = forward.
swap_calculate_sub(none) = none.
:- 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 inst_matches_initial_2 `with_type` inst_matches_pred.
:- mode inst_matches_initial_2 `with_inst` inst_matches_pred.
inst_matches_initial_2(InstA, InstB, MaybeType, !Info) :-
ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType),
( expansion_member(ThisExpansion, !.Info ^ expansions) ->
true
;
inst_expand(!.Info ^ module_info, InstA, InstA2),
inst_expand(!.Info ^ module_info, InstB, InstB2),
expansion_insert(ThisExpansion, !.Info ^ expansions, Expansions1),
handle_inst_var_subs(inst_matches_initial_2,
inst_matches_initial_4, InstA2, InstB2, MaybeType,
!.Info ^ expansions := Expansions1, !:Info)
).
:- pred handle_inst_var_subs(inst_matches_pred, inst_matches_pred) `with_type`
inst_matches_pred.
:- mode handle_inst_var_subs(in(inst_matches_pred), in(inst_matches_pred))
`with_inst` inst_matches_pred.
handle_inst_var_subs(Recurse, Continue, InstA, InstB, Type, !Info) :-
CalculateSub = !.Info ^ calculate_sub,
(
CalculateSub = forward,
handle_inst_var_subs_2(Recurse, Continue, InstA, InstB,
Type, !Info)
;
CalculateSub = reverse,
handle_inst_var_subs_2(swap_args(Recurse), swap_args(Continue),
InstB, InstA, Type, !Info)
;
CalculateSub = none,
Continue(InstA, InstB, Type, !Info)
).
:- pred handle_inst_var_subs_2(inst_matches_pred, inst_matches_pred)
`with_type` inst_matches_pred.
:- mode handle_inst_var_subs_2(in(inst_matches_pred), in(inst_matches_pred))
`with_inst` inst_matches_pred.
handle_inst_var_subs_2(Recurse, Continue, InstA, InstB, Type, !Info) :-
( InstB = constrained_inst_vars(InstVarsB, InstB1) ->
% InstB is a constrained_inst_var with upper bound InstB1.
% We need to check that InstA matches_initial InstB1 and add the
% appropriate inst_var substitution.
Recurse(InstA, InstB1, Type, !Info),
ModuleInfo0 = !.Info ^ module_info,
% Call abstractly_unify_inst to calculate the uniqueness of the
% inst represented by the constrained_inst_var.
% We pass `Live = is_dead' because we want
% abstractly_unify(unique, unique) = unique, not shared.
Live = is_dead,
abstractly_unify_inst(Live, InstA, InstB1, fake_unify,
Inst, _Det, ModuleInfo0, ModuleInfo),
!:Info = !.Info ^ module_info := ModuleInfo,
update_inst_var_sub(InstVarsB, Inst, Type, !Info)
; InstA = constrained_inst_vars(_InstVarsA, InstA1) ->
Recurse(InstA1, InstB, Type, !Info)
;
Continue(InstA, InstB, Type, !Info)
).
:- pred swap_args(inst_matches_pred) `with_type` inst_matches_pred.
:- mode swap_args(in(inst_matches_pred)) `with_inst` inst_matches_pred.
swap_args(P, InstA, InstB, Type, !Info) :-
P(InstB, InstA, Type, !Info).
:- pred inst_matches_initial_4 `with_type` inst_matches_pred.
:- mode inst_matches_initial_4 `with_inst` inst_matches_pred.
% To avoid infinite regress, we assume that
% inst_matches_initial is true for any pairs of insts which
% occur in `Expansions'.
inst_matches_initial_4(any(UniqA), any(UniqB), _, !Info) :-
!.Info ^ any_matches_any = yes,
compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB).
inst_matches_initial_4(any(_), free, _, !Info).
inst_matches_initial_4(any(UniqA), ground(_, _)@InstB, Type, !Info) :-
maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA),
inst_matches_initial_2(InstA, InstB, Type, !Info).
inst_matches_initial_4(any(UniqA), bound(_, _)@InstB, Type, !Info) :-
maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA),
inst_matches_initial_2(InstA, InstB, Type, !Info).
inst_matches_initial_4(free, any(_), _, !Info).
inst_matches_initial_4(free, free, _, !Info).
inst_matches_initial_4(bound(UniqA, ListA), any(UniqB), _, !Info) :-
compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB),
compare_bound_inst_list_uniq(!.Info ^ uniqueness_comparison,
ListA, UniqB, !.Info ^ module_info).
inst_matches_initial_4(bound(_Uniq, _List), free, _, !Info).
inst_matches_initial_4(bound(UniqA, ListA), bound(UniqB, ListB), Type,
!Info) :-
compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB),
bound_inst_list_matches_initial(ListA, ListB, Type, !Info).
inst_matches_initial_4(bound(UniqA, ListA), ground(UniqB, none), Type,
!Info) :-
compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB),
bound_inst_list_is_ground(ListA, Type, !.Info ^ module_info),
compare_bound_inst_list_uniq(!.Info ^ uniqueness_comparison,
ListA, UniqB, !.Info ^ module_info).
inst_matches_initial_4(bound(Uniq, List), abstract_inst(_,_), _, !Info) :-
Uniq = unique,
bound_inst_list_is_ground(List, !.Info ^ module_info),
bound_inst_list_is_unique(List, !.Info ^ module_info).
inst_matches_initial_4(bound(Uniq, List), abstract_inst(_,_), _, !Info) :-
Uniq = mostly_unique,
bound_inst_list_is_ground(List, !.Info ^ module_info),
bound_inst_list_is_mostly_unique(List, !.Info ^ module_info).
inst_matches_initial_4(ground(UniqA, GroundInstInfoA), any(UniqB), _, !Info) :-
\+ ground_inst_info_is_nonstandard_func_mode(!.Info ^ module_info,
GroundInstInfoA),
compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB).
inst_matches_initial_4(ground(_Uniq, _PredInst), free, _, !Info).
inst_matches_initial_4(ground(UniqA, _GII_A), bound(UniqB, ListB), MaybeType,
!Info) :-
MaybeType = yes(Type),
% We can only check this case properly if the type is known.
compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB),
bound_inst_list_is_complete_for_type(set.init, !.Info ^ module_info,
ListB, Type),
ground_matches_initial_bound_inst_list(UniqA, ListB, yes(Type),
!Info).
inst_matches_initial_4(ground(UniqA, GroundInstInfoA),
ground(UniqB, GroundInstInfoB), Type, !Info) :-
compare_uniqueness(!.Info ^ uniqueness_comparison, UniqA, UniqB),
ground_inst_info_matches_initial(GroundInstInfoA, GroundInstInfoB,
UniqB, Type, !Info).
inst_matches_initial_4(ground(_UniqA, none), abstract_inst(_,_), _, !Info) :-
% I don't know what this should do.
% Abstract insts aren't really supported.
unexpected(this_file, "inst_matches_initial(ground, abstract_inst) == ??").
inst_matches_initial_4(abstract_inst(_,_), any(shared), _, !Info).
inst_matches_initial_4(abstract_inst(_,_), free, _, !Info).
inst_matches_initial_4(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
_Type, !Info) :-
list.duplicate(length(ArgsA), no, MaybeTypes),
% XXX how do we get the argument types for an abstract inst?
inst_list_matches_initial(ArgsA, ArgsB, MaybeTypes, !Info).
inst_matches_initial_4(not_reached, _, _, !Info).
%-----------------------------------------------------------------------------%
% 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,
[bound_functor(ConsId, Args) | List], MaybeType, !Info) :-
maybe_get_cons_id_arg_types(!.Info ^ module_info, MaybeType, ConsId,
list.length(Args), MaybeTypes),
ground_matches_initial_inst_list(Uniq, Args, MaybeTypes, !Info),
ground_matches_initial_bound_inst_list(Uniq, List, 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], [Type | Types],
!Info) :-
inst_matches_initial_2(ground(Uniq, none), Inst, Type, !Info),
ground_matches_initial_inst_list(Uniq, Insts, Types, !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 the 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?
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) :-
( Inst = defined_inst(Name) ->
( set.member(Name, Expansions) ->
true
;
inst_lookup(ModuleInfo, Name, ExpandedInst),
inst_is_complete_for_type(Expansions `set.insert` Name,
ModuleInfo, ExpandedInst, Type)
)
; Inst = bound(_, List) ->
bound_inst_list_is_complete_for_type(Expansions, ModuleInfo,
List, Type)
;
Inst \= not_reached
).
% Check that two cons_ids are the same, except that one may be less
% module qualified than the other.
%
:- pred equivalent_cons_ids(cons_id::in, cons_id::in) is semidet.
equivalent_cons_ids(ConsIdA, ConsIdB) :-
(
ConsIdA = cons(NameA, ArityA),
ConsIdB = cons(NameB, ArityB)
->
ArityA = ArityB,
equivalent_sym_names(NameA, NameB)
;
ConsIdA = ConsIdB
).
:- pred equivalent_sym_names(sym_name::in, sym_name::in) is semidet.
equivalent_sym_names(unqualified(S), unqualified(S)).
equivalent_sym_names(qualified(_, S), unqualified(S)).
equivalent_sym_names(unqualified(S), qualified(_, S)).
equivalent_sym_names(qualified(QualA, S), qualified(QualB, S)) :-
equivalent_sym_names(QualA, QualB).
% 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) :-
(
ConsIdA = cons(QNameA, ArityA),
ConsIdB = cons(QNameB, ArityB)
->
( QNameA = unqualified(NameA)
; QNameA = qualified(_, NameA)
),
( QNameB = unqualified(NameB)
; QNameB = qualified(_, NameB)
),
compare(O, NameA, NameB),
(
O = (>)
;
O = (=),
ArityA > ArityB
)
;
compare((>), ConsIdA, ConsIdB)
).
%-----------------------------------------------------------------------------%
% 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 ^ maybe_sub = yes(_),
set.fold(update_inst_var_sub_2(InstA, MaybeType),
InstVars, !Info)
;
!.Info ^ 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) :-
( InstB = !.Info ^ sub ^ elem(InstVar) ->
% 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 ^ module_info,
inst_merge(InstA, InstB, MaybeType, Inst,
ModuleInfo0, ModuleInfo),
!:Info = !.Info ^ module_info := ModuleInfo,
!:Info = !.Info ^ sub ^ elem(InstVar) := Inst
;
!:Info = !.Info ^ sub ^ elem(InstVar) := InstA
).
%-----------------------------------------------------------------------------%
% This predicate checks if two ground_inst_infos match_initial.
% It does not check uniqueness.
%
:- pred ground_inst_info_matches_initial(ground_inst_info::in,
ground_inst_info::in, uniqueness::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
ground_inst_info_matches_initial(GroundInstInfoA, none, _, _, !Info) :-
\+ ground_inst_info_is_nonstandard_func_mode(!.Info ^ module_info,
GroundInstInfoA).
ground_inst_info_matches_initial(none, higher_order(PredInstB), _, Type,
!Info) :-
PredInstB = pred_inst_info(pf_function, ArgModes, _Det),
Arity = list.length(ArgModes),
PredInstA = pred_inst_info_standard_func_mode(Arity),
pred_inst_matches_2(PredInstA, PredInstB, Type, !Info).
ground_inst_info_matches_initial(higher_order(PredInstA),
higher_order(PredInstB), _, MaybeType, !Info) :-
pred_inst_matches_2(PredInstA, PredInstB, MaybeType, !Info).
pred_inst_matches(PredInstA, PredInstB, ModuleInfo) :-
pred_inst_matches_1(PredInstA, PredInstB, no, ModuleInfo).
:- pred pred_inst_matches_1(pred_inst_info::in, pred_inst_info::in,
maybe(mer_type)::in, module_info::in) is semidet.
pred_inst_matches_1(PredInstA, PredInstB, MaybeType, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo),
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(pred_inst_info(PredOrFunc, ModesA, Det),
pred_inst_info(PredOrFunc, ModesB, Det), MaybeType, !Info) :-
maybe_get_higher_order_arg_types(MaybeType, length(ModesA),
MaybeTypes),
pred_inst_argmodes_matches(ModesA, ModesB, MaybeTypes, !Info).
% pred_inst_argmodes_matches(ModesA, ModesB, !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 ^ module_info,
mode_get_insts(ModuleInfo, ModeA, InitialA, FinalA),
mode_get_insts(ModuleInfo, ModeB, InitialB, FinalB),
swap_sub(inst_matches_final_2(InitialB, InitialA, MaybeType), !Info),
inst_matches_final_2(FinalA, FinalB, MaybeType, !Info),
pred_inst_argmodes_matches(ModeAs, ModeBs, MaybeTypes, !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(match, InstA, InstB) :-
unique_matches_initial(InstA, InstB).
compare_uniqueness(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).
%-----------------------------------------------------------------------------%
:- 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(match, List, Uniq, ModuleInfo) :-
bound_inst_list_matches_uniq(List, Uniq, ModuleInfo).
compare_bound_inst_list_uniq(instantiated, List, Uniq, ModuleInfo) :-
uniq_matches_bound_inst_list(Uniq, List, ModuleInfo).
:- pred bound_inst_list_matches_uniq(list(bound_inst)::in, uniqueness::in,
module_info::in) is semidet.
bound_inst_list_matches_uniq(List, Uniq, ModuleInfo) :-
( Uniq = unique ->
bound_inst_list_is_unique(List, ModuleInfo)
; Uniq = mostly_unique ->
bound_inst_list_is_mostly_unique(List, ModuleInfo)
;
true
).
:- pred uniq_matches_bound_inst_list(uniqueness::in, list(bound_inst)::in,
module_info::in) is semidet.
uniq_matches_bound_inst_list(Uniq, List, ModuleInfo) :-
( Uniq = shared ->
bound_inst_list_is_not_partly_unique(List, ModuleInfo)
; Uniq = mostly_unique ->
bound_inst_list_is_not_fully_unique(List, ModuleInfo)
;
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(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([], _, _, !Info).
bound_inst_list_matches_initial([X | Xs], [Y | Ys], MaybeType, !Info) :-
X = bound_functor(ConsIdX, ArgsX),
Y = bound_functor(ConsIdY, ArgsY),
( equivalent_cons_ids(ConsIdX, ConsIdY) ->
maybe_get_cons_id_arg_types(!.Info ^ module_info, MaybeType,
ConsIdX, list.length(ArgsX), MaybeTypes),
inst_list_matches_initial(ArgsX, ArgsY, MaybeTypes, !Info),
bound_inst_list_matches_initial(Xs, Ys, MaybeType, !Info)
;
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([X | Xs], Ys, MaybeType, !Info)
).
:- pred inst_list_matches_initial(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([], [], [], !Info).
inst_list_matches_initial([X | Xs], [Y | Ys], [Type | Types], !Info) :-
inst_matches_initial_2(X, Y, Type, !Info),
inst_list_matches_initial(Xs, Ys, Types, !Info).
%-----------------------------------------------------------------------------%
inst_expand(ModuleInfo, !Inst) :-
( !.Inst = defined_inst(InstName) ->
inst_lookup(ModuleInfo, InstName, !:Inst),
inst_expand(ModuleInfo, !Inst)
;
true
).
inst_expand_and_remove_constrained_inst_vars(ModuleInfo, !Inst) :-
( !.Inst = defined_inst(InstName) ->
inst_lookup(ModuleInfo, InstName, !:Inst),
inst_expand(ModuleInfo, !Inst)
; !.Inst = constrained_inst_vars(_, !:Inst) ->
inst_expand(ModuleInfo, !Inst)
;
true
).
%-----------------------------------------------------------------------------%
inst_matches_final(InstA, InstB, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo),
inst_matches_final_2(InstA, InstB, no, Info0, _).
inst_matches_final(InstA, InstB, Type, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo),
inst_matches_final_2(InstA, InstB, yes(Type), Info0, _).
:- pred inst_matches_final_2 `with_type` inst_matches_pred.
:- mode inst_matches_final_2 `with_inst` inst_matches_pred.
inst_matches_final_2(InstA, InstB, MaybeType, !Info) :-
ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType),
( expansion_member(ThisExpansion, !.Info ^ expansions) ->
true
; InstA = InstB ->
true
;
inst_expand(!.Info ^ module_info, InstA, InstA2),
inst_expand(!.Info ^ module_info, InstB, InstB2),
expansion_insert(ThisExpansion, !.Info ^ expansions, Expansions1),
handle_inst_var_subs(inst_matches_final_2,
inst_matches_final_3, InstA2, InstB2, MaybeType,
!.Info ^ expansions := Expansions1, !:Info)
).
:- pred inst_matches_final_3 `with_type` inst_matches_pred.
:- mode inst_matches_final_3 `with_inst` inst_matches_pred.
inst_matches_final_3(any(UniqA), any(UniqB), _, !Info) :-
unique_matches_final(UniqA, UniqB).
inst_matches_final_3(any(UniqA), ground(_, _)@InstB, Type, !Info) :-
maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA),
inst_matches_final_2(InstA, InstB, Type, !Info).
inst_matches_final_3(any(UniqA), bound(_, _)@InstB, Type, !Info) :-
maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA),
inst_matches_final_2(InstA, InstB, Type, !Info).
inst_matches_final_3(free, any(Uniq), _, !Info) :-
% 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 ).
inst_matches_final_3(free, free, _, !Info).
inst_matches_final_3(bound(UniqA, ListA), any(UniqB), _, !Info) :-
unique_matches_final(UniqA, UniqB),
bound_inst_list_matches_uniq(ListA, UniqB, !.Info ^ module_info),
% We do not yet allow `free' to match `any'.
% Among other things, changing this would break compare_inst
% in modecheck_call.m.
bound_inst_list_is_ground_or_any(ListA, !.Info ^ module_info).
inst_matches_final_3(bound(UniqA, ListA), bound(UniqB, ListB), MaybeType,
!Info) :-
unique_matches_final(UniqA, UniqB),
bound_inst_list_matches_final(ListA, ListB, MaybeType, !Info).
inst_matches_final_3(bound(UniqA, ListA), ground(UniqB, none), Type,
!Info) :-
unique_matches_final(UniqA, UniqB),
bound_inst_list_is_ground(ListA, Type, !.Info ^ module_info),
bound_inst_list_matches_uniq(ListA, UniqB, !.Info ^ module_info).
inst_matches_final_3(ground(UniqA, GroundInstInfoA), any(UniqB), _,
!Info) :-
\+ ground_inst_info_is_nonstandard_func_mode(!.Info ^ module_info,
GroundInstInfoA),
unique_matches_final(UniqA, UniqB).
inst_matches_final_3(ground(UniqA, GroundInstInfoA), bound(UniqB, ListB),
MaybeType, !Info) :-
\+ ground_inst_info_is_nonstandard_func_mode(!.Info ^ module_info,
GroundInstInfoA),
unique_matches_final(UniqA, UniqB),
bound_inst_list_is_ground(ListB, MaybeType, !.Info ^ module_info),
uniq_matches_bound_inst_list(UniqA, ListB, !.Info ^ module_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 ^ module_info, ListB, Type)
;
true
% XXX enabling the check for bound_inst_list_is_complete
% for type makes the mode checker too conservative in
% the absence of alias tracking, so we currently always
% succeed, even if this check fails.
).
inst_matches_final_3(ground(UniqA, GroundInstInfoA),
ground(UniqB, GroundInstInfoB), MaybeType, !Info) :-
ground_inst_info_matches_final(GroundInstInfoA, GroundInstInfoB,
MaybeType, !Info),
unique_matches_final(UniqA, UniqB).
inst_matches_final_3(abstract_inst(_, _), any(shared), _, !Info).
inst_matches_final_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
_MaybeType, !Info) :-
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).
inst_matches_final_3(not_reached, _, _, !Info).
inst_matches_final_3(constrained_inst_vars(InstVarsA, InstA), InstB, MaybeType,
!Info) :-
( InstB = constrained_inst_vars(InstVarsB, InstB1) ->
% Constrained_inst_vars match_final only if InstVarsA contains
% all the variables in InstVarsB
InstVarsB `set.subset` InstVarsA,
inst_matches_final_2(InstA, InstB1, MaybeType, !Info)
;
inst_matches_final_2(InstA, InstB, MaybeType, !Info)
).
:- pred ground_inst_info_matches_final(ground_inst_info::in,
ground_inst_info::in, maybe(mer_type)::in,
inst_match_info::in, inst_match_info::out) is semidet.
ground_inst_info_matches_final(GroundInstInfoA, none, _, !Info) :-
\+ ground_inst_info_is_nonstandard_func_mode(!.Info ^ module_info,
GroundInstInfoA).
ground_inst_info_matches_final(none, higher_order(PredInstB), Type, !Info) :-
PredInstB = pred_inst_info(pf_function, ArgModes, _Det),
Arity = list.length(ArgModes),
PredInstA = pred_inst_info_standard_func_mode(Arity),
pred_inst_matches_2(PredInstA, PredInstB, Type, !Info).
ground_inst_info_matches_final(higher_order(PredInstA),
higher_order(PredInstB), MaybeType, !Info) :-
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], [Type | Types],
!Info) :-
inst_matches_final_2(ArgA, ArgB, Type, !Info),
inst_list_matches_final(ArgsA, ArgsB, Types, !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),
( equivalent_cons_ids(ConsIdX, ConsIdY) ->
maybe_get_cons_id_arg_types(!.Info ^ 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)
;
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) :-
Info = (init_inst_match_info(ModuleInfo)
^ uniqueness_comparison := instantiated)
^ any_matches_any := no,
inst_matches_initial_2(InstA, InstB, yes(Type), Info, _).
inst_matches_binding(InstA, InstB, Type, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo) ^ any_matches_any := no,
inst_matches_binding_2(InstA, InstB, yes(Type), Info0, _).
inst_matches_binding_allow_any_any(InstA, InstB, Type, ModuleInfo) :-
Info0 = init_inst_match_info(ModuleInfo),
inst_matches_binding_2(InstA, InstB, yes(Type), Info0, _).
:- pred inst_matches_binding_2 `with_type` inst_matches_pred.
:- mode inst_matches_binding_2 `with_inst` inst_matches_pred.
inst_matches_binding_2(InstA, InstB, MaybeType, !Info) :-
ThisExpansion = inst_match_inputs(InstA, InstB, MaybeType),
( expansion_member(ThisExpansion, !.Info ^ expansions) ->
true
;
inst_expand_and_remove_constrained_inst_vars(
!.Info ^ module_info, InstA, InstA2),
inst_expand_and_remove_constrained_inst_vars(
!.Info ^ module_info, InstB, InstB2),
expansion_insert(ThisExpansion, !.Info ^ expansions, Expansions1),
inst_matches_binding_3(InstA2, InstB2, MaybeType,
!.Info ^ expansions := Expansions1, !:Info)
).
:- pred inst_matches_binding_3 `with_type` inst_matches_pred.
:- mode inst_matches_binding_3 `with_inst` inst_matches_pred.
% 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).
inst_matches_binding_3(free, free, _, !Info).
inst_matches_binding_3(any(UniqA), any(UniqB), Type, !Info) :-
( !.Info ^ any_matches_any = yes ->
true
;
maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA),
maybe_any_to_bound(Type, !.Info ^ module_info, UniqB, InstB),
inst_matches_binding_2(InstA, InstB, Type, !Info)
).
inst_matches_binding_3(any(UniqA), ground(_, _)@InstB, Type, !Info) :-
maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA),
inst_matches_binding_2(InstA, InstB, Type, !Info).
inst_matches_binding_3(any(UniqA), bound(_, _)@InstB, Type, !Info) :-
maybe_any_to_bound(Type, !.Info ^ module_info, UniqA, InstA),
inst_matches_binding_2(InstA, InstB, Type, !Info).
inst_matches_binding_3(ground(_, _)@InstA, any(UniqB), Type, !Info) :-
maybe_any_to_bound(Type, !.Info ^ module_info, UniqB, InstB),
inst_matches_binding_2(InstA, InstB, Type, !Info).
inst_matches_binding_3(bound(_, _)@InstA, any(UniqB), Type, !Info) :-
maybe_any_to_bound(Type, !.Info ^ module_info, UniqB, InstB),
inst_matches_binding_2(InstA, InstB, Type, !Info).
inst_matches_binding_3(bound(_UniqA, ListA), bound(_UniqB, ListB), MaybeType,
!Info) :-
bound_inst_list_matches_binding(ListA, ListB, MaybeType, !Info).
inst_matches_binding_3(bound(_UniqA, ListA), ground(_UniqB, none), Type,
!Info) :-
bound_inst_list_is_ground(ListA, Type, !.Info ^ module_info).
inst_matches_binding_3(ground(_UniqA, _), bound(_UniqB, ListB), MaybeType,
!Info) :-
bound_inst_list_is_ground(ListB, MaybeType, !.Info ^ module_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 ^ module_info, ListB, Type)
;
true
% XXX enabling the check for bound_inst_list_is_complete
% for type makes the mode checker too conservative in
% the absence of alias tracking, so we currently always
% succeed, even if this check fails.
).
inst_matches_binding_3(ground(_UniqA, GroundInstInfoA),
ground(_UniqB, GroundInstInfoB), MaybeType, !Info) :-
ground_inst_info_matches_binding(GroundInstInfoA, GroundInstInfoB,
MaybeType, !.Info ^ module_info).
inst_matches_binding_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB),
_MaybeType, !Info) :-
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).
inst_matches_binding_3(not_reached, _, _, !Info).
:- pred ground_inst_info_matches_binding(ground_inst_info::in,
ground_inst_info::in, maybe(mer_type)::in, module_info::in) is semidet.
ground_inst_info_matches_binding(_, none, _, _).
ground_inst_info_matches_binding(none, higher_order(PredInstB), MaybeType,
ModuleInfo) :-
PredInstB = pred_inst_info(pf_function, ArgModes, _Det),
Arity = list.length(ArgModes),
PredInstA = pred_inst_info_standard_func_mode(Arity),
pred_inst_matches_1(PredInstA, PredInstB, MaybeType, ModuleInfo).
ground_inst_info_matches_binding(higher_order(PredInstA),
higher_order(PredInstB), MaybeType, ModuleInfo) :-
pred_inst_matches_1(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_2(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),
( equivalent_cons_ids(ConsIdX, ConsIdY) ->
maybe_get_cons_id_arg_types(!.Info ^ 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)
;
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)
).
%-----------------------------------------------------------------------------%
% inst_is_clobbered succeeds iff the inst passed is `clobbered'
% or `mostly_clobbered' or if it is a user-defined inst which
% is defined as one of those.
inst_is_clobbered(_, not_reached) :- fail.
inst_is_clobbered(_, any(mostly_clobbered)).
inst_is_clobbered(_, any(clobbered)).
inst_is_clobbered(_, ground(clobbered, _)).
inst_is_clobbered(_, ground(mostly_clobbered, _)).
inst_is_clobbered(_, bound(clobbered, _)).
inst_is_clobbered(_, bound(mostly_clobbered, _)).
inst_is_clobbered(_, inst_var(_)) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_clobbered(ModuleInfo, constrained_inst_vars(_, Inst)) :-
inst_is_clobbered(ModuleInfo, Inst).
inst_is_clobbered(ModuleInfo, defined_inst(InstName)) :-
inst_lookup(ModuleInfo, InstName, Inst),
inst_is_clobbered(ModuleInfo, Inst).
% inst_is_free succeeds iff the inst passed is `free'
% or is a user-defined inst which is defined as `free'.
% Abstract insts must not be free.
%
inst_is_free(_, free).
inst_is_free(_, free(_Type)).
inst_is_free(_, inst_var(_)) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_free(ModuleInfo, constrained_inst_vars(_, Inst)) :-
inst_is_free(ModuleInfo, Inst).
inst_is_free(ModuleInfo, defined_inst(InstName)) :-
inst_lookup(ModuleInfo, InstName, Inst),
inst_is_free(ModuleInfo, Inst).
inst_is_any(_, any(_)).
inst_is_any(_, inst_var(_)) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_any(ModuleInfo, constrained_inst_vars(_, Inst)) :-
inst_is_any(ModuleInfo, Inst).
inst_is_any(ModuleInfo, defined_inst(InstName)) :-
inst_lookup(ModuleInfo, InstName, Inst),
inst_is_any(ModuleInfo, Inst).
% inst_is_bound succeeds iff the inst passed is not `free'
% or is a user-defined inst which is not defined as `free'.
% Abstract insts must be bound.
%
inst_is_bound(_, not_reached).
inst_is_bound(_, any(_)).
inst_is_bound(_, ground(_, _)).
inst_is_bound(_, bound(_, _)).
inst_is_bound(_, inst_var(_)) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_bound(ModuleInfo, constrained_inst_vars(_, Inst)) :-
inst_is_bound(ModuleInfo, Inst).
inst_is_bound(ModuleInfo, defined_inst(InstName)) :-
inst_lookup(ModuleInfo, InstName, Inst),
inst_is_bound(ModuleInfo, Inst).
inst_is_bound(_, abstract_inst(_, _)).
% inst_is_bound_to_functors succeeds iff the inst passed is
% `bound(_Uniq, Functors)' or is a user-defined inst which expands to
% `bound(_Uniq, Functors)'.
%
inst_is_bound_to_functors(_, bound(_Uniq, Functors), Functors).
inst_is_bound_to_functors(_, inst_var(_), _) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_bound_to_functors(ModuleInfo, constrained_inst_vars(_, Inst),
Functors) :-
inst_is_bound_to_functors(ModuleInfo, Inst, Functors).
inst_is_bound_to_functors(ModuleInfo, defined_inst(InstName), Functors) :-
inst_lookup(ModuleInfo, InstName, Inst),
inst_is_bound_to_functors(ModuleInfo, Inst, Functors).
%-----------------------------------------------------------------------------%
% inst_is_ground succeeds iff the inst passed is `ground'
% or the equivalent. Abstract insts are not considered ground.
%
inst_is_ground(ModuleInfo, Inst) :-
inst_is_ground(ModuleInfo, no, Inst).
:- pred inst_is_ground(module_info::in, maybe(mer_type)::in, mer_inst::in)
is semidet.
inst_is_ground(ModuleInfo, MaybeType, Inst) :-
set.init(Expansions0),
inst_is_ground_1(ModuleInfo, MaybeType, Inst, Expansions0, _Expansions).
% The third arg is the set of insts which have already been expanded - we
% use this to avoid going into an infinite loop.
%
:- pred inst_is_ground_1(module_info::in, maybe(mer_type)::in, mer_inst::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_is_ground_1(ModuleInfo, MaybeType, Inst, !Expansions) :-
( set.member(Inst, !.Expansions) ->
true
;
( Inst \= any(_) ->
svset.insert(Inst, !Expansions)
;
true
),
inst_is_ground_2(ModuleInfo, MaybeType, Inst, !Expansions)
).
:- pred inst_is_ground_2(module_info::in, maybe(mer_type)::in, mer_inst::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_is_ground_2(_, _, not_reached, !Expansions).
inst_is_ground_2(ModuleInfo, MaybeType, bound(_, List), !Expansions) :-
bound_inst_list_is_ground_2(List, MaybeType, ModuleInfo, !Expansions).
inst_is_ground_2(_, _, ground(_, _), !Expansions).
inst_is_ground_2(_, _, inst_var(_), !Expansions) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_ground_2(ModuleInfo, MaybeType, Inst, !Expansions) :-
Inst = constrained_inst_vars(_, Inst2),
inst_is_ground_1(ModuleInfo, MaybeType, Inst2, !Expansions).
inst_is_ground_2(ModuleInfo, MaybeType, Inst, !Expansions) :-
Inst = defined_inst(InstName),
inst_lookup(ModuleInfo, InstName, Inst2),
inst_is_ground_1(ModuleInfo, MaybeType, Inst2, !Expansions).
inst_is_ground_2(ModuleInfo, MaybeType, any(Uniq), !Expansions) :-
maybe_any_to_bound(MaybeType, ModuleInfo, Uniq, Inst),
inst_is_ground_1(ModuleInfo, MaybeType, Inst, !Expansions).
% inst_is_ground_or_any succeeds iff the inst passed is `ground',
% `any', or the equivalent. Fails for abstract insts.
%
inst_is_ground_or_any(ModuleInfo, Inst) :-
set.init(Expansions0),
inst_is_ground_or_any_2(ModuleInfo, Inst, Expansions0, _Expansions).
% The third arg is the set of insts which have already been expanded - we
% use this to avoid going into an infinite loop.
%
:- pred inst_is_ground_or_any_2(module_info::in, mer_inst::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_is_ground_or_any_2(_, not_reached, !Expansions).
inst_is_ground_or_any_2(ModuleInfo, bound(_, List), !Expansions) :-
bound_inst_list_is_ground_or_any_2(List, ModuleInfo,
!Expansions).
inst_is_ground_or_any_2(_, ground(_, _), !Expansions).
inst_is_ground_or_any_2(_, any(_), !Expansions).
inst_is_ground_or_any_2(_, inst_var(_), !Expansions) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_ground_or_any_2(ModuleInfo, Inst, !Expansions) :-
Inst = constrained_inst_vars(_, Inst2),
inst_is_ground_or_any_2(ModuleInfo, Inst2, !Expansions).
inst_is_ground_or_any_2(ModuleInfo, Inst, !Expansions) :-
Inst = defined_inst(InstName),
( set.member(Inst, !.Expansions) ->
true
;
svset.insert(Inst, !Expansions),
inst_lookup(ModuleInfo, InstName, Inst2),
inst_is_ground_or_any_2(ModuleInfo, Inst2, !Expansions)
).
% inst_is_unique succeeds iff the inst passed is unique or free. Abstract
% insts are not considered unique.
%
inst_is_unique(ModuleInfo, Inst) :-
set.init(Expansions0),
inst_is_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
% The third arg is the set of insts which have already been expanded - we
% use this to avoid going into an infinite loop.
%
:- pred inst_is_unique_2(module_info::in, mer_inst::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_is_unique_2(_, not_reached, !Expansions).
inst_is_unique_2(ModuleInfo, bound(unique, List), !Expansions) :-
bound_inst_list_is_unique_2(List, ModuleInfo, !Expansions).
inst_is_unique_2(_, any(unique), !Expansions).
inst_is_unique_2(_, free, !Expansions).
inst_is_unique_2(_, ground(unique, _), !Expansions).
inst_is_unique_2(_, inst_var(_), !Expansions) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_unique_2(ModuleInfo, Inst, !Expansions) :-
Inst = constrained_inst_vars(_, Inst2),
inst_is_unique_2(ModuleInfo, Inst2, !Expansions).
inst_is_unique_2(ModuleInfo, Inst, !Expansions) :-
Inst = defined_inst(InstName),
( set.member(Inst, !.Expansions) ->
true
;
svset.insert(Inst, !Expansions),
inst_lookup(ModuleInfo, InstName, Inst2),
inst_is_unique_2(ModuleInfo, Inst2, !Expansions)
).
% inst_is_mostly_unique succeeds iff the inst passed is unique,
% mostly_unique, or free. Abstract insts are not considered unique.
%
inst_is_mostly_unique(ModuleInfo, Inst) :-
set.init(Expansions0),
inst_is_mostly_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
% The third arg is the set of insts which have already been expanded - we
% use this to avoid going into an infinite loop.
%
:- pred inst_is_mostly_unique_2(module_info::in, mer_inst::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_is_mostly_unique_2(_, not_reached, !Expansions).
inst_is_mostly_unique_2(ModuleInfo, bound(unique, List), !Expansions) :-
bound_inst_list_is_mostly_unique_2(List, ModuleInfo, !Expansions).
inst_is_mostly_unique_2(ModuleInfo, bound(mostly_unique, List), !Expansions) :-
bound_inst_list_is_mostly_unique_2(List, ModuleInfo, !Expansions).
inst_is_mostly_unique_2(_, any(unique), !Expansions).
inst_is_mostly_unique_2(_, any(mostly_unique), !Expansions).
inst_is_mostly_unique_2(_, free, !Expansions).
inst_is_mostly_unique_2(_, ground(unique, _), !Expansions).
inst_is_mostly_unique_2(_, ground(mostly_unique, _), !Expansions).
inst_is_mostly_unique_2(_, inst_var(_), !Expansions) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_mostly_unique_2(ModuleInfo, Inst, !Expansions) :-
Inst = constrained_inst_vars(_, Inst2),
inst_is_mostly_unique_2(ModuleInfo, Inst2, !Expansions).
inst_is_mostly_unique_2(ModuleInfo, Inst, !Expansions) :-
Inst = defined_inst(InstName),
( set.member(Inst, !.Expansions) ->
true
;
svset.insert(Inst, !Expansions),
inst_lookup(ModuleInfo, InstName, Inst2),
inst_is_mostly_unique_2(ModuleInfo, Inst2, !Expansions)
).
% inst_is_not_partly_unique succeeds iff the inst passed is
% not unique or mostly_unique, i.e. if it is shared
% or free. It fails for abstract insts.
%
inst_is_not_partly_unique(ModuleInfo, Inst) :-
set.init(Expansions0),
inst_is_not_partly_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
% The third arg is the set of insts which have already
% been expanded - we use this to avoid going into an
% infinite loop.
%
:- pred inst_is_not_partly_unique_2(module_info::in, mer_inst::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_is_not_partly_unique_2(_, not_reached, !Expansions).
inst_is_not_partly_unique_2(ModuleInfo, bound(shared, List), !Expansions) :-
bound_inst_list_is_not_partly_unique_2(List, ModuleInfo, !Expansions).
inst_is_not_partly_unique_2(_, free, !Expansions).
inst_is_not_partly_unique_2(_, any(shared), !Expansions).
inst_is_not_partly_unique_2(_, ground(shared, _), !Expansions).
inst_is_not_partly_unique_2(_, inst_var(_), !Expansions) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_not_partly_unique_2(ModuleInfo, Inst, !Expansions) :-
Inst = constrained_inst_vars(_, Inst2),
inst_is_not_partly_unique_2(ModuleInfo, Inst2, !Expansions).
inst_is_not_partly_unique_2(ModuleInfo, Inst, !Expansions) :-
Inst = defined_inst(InstName),
( set.member(Inst, !.Expansions) ->
true
;
svset.insert(Inst, !Expansions),
inst_lookup(ModuleInfo, InstName, Inst2),
inst_is_not_partly_unique_2(ModuleInfo, Inst2, !Expansions)
).
% inst_is_not_fully_unique succeeds iff the inst passed is not unique,
% i.e. if it is mostly_unique, shared, or free. It fails for abstract
% insts.
%
inst_is_not_fully_unique(ModuleInfo, Inst) :-
set.init(Expansions0),
inst_is_not_fully_unique_2(ModuleInfo, Inst, Expansions0, _Expansions).
% The third arg is the set of insts which have already been expanded - we
% use this to avoid going into an infinite loop.
%
:- pred inst_is_not_fully_unique_2(module_info::in, mer_inst::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_is_not_fully_unique_2(_, not_reached, !Expansions).
inst_is_not_fully_unique_2(ModuleInfo, bound(shared, List),
!Expansions) :-
bound_inst_list_is_not_fully_unique_2(List, ModuleInfo,
!Expansions).
inst_is_not_fully_unique_2(ModuleInfo, bound(mostly_unique, List),
!Expansions) :-
bound_inst_list_is_not_fully_unique_2(List, ModuleInfo,
!Expansions).
inst_is_not_fully_unique_2(_, any(shared), !Expansions).
inst_is_not_fully_unique_2(_, any(mostly_unique), !Expansions).
inst_is_not_fully_unique_2(_, free, !Expansions).
inst_is_not_fully_unique_2(_, ground(shared, _), !Expansions).
inst_is_not_fully_unique_2(_, ground(mostly_unique, _), !Expansions).
inst_is_not_fully_unique_2(_, inst_var(_), _, _) :-
unexpected(this_file, "internal error: uninstantiated inst parameter").
inst_is_not_fully_unique_2(ModuleInfo, Inst, !Expansions) :-
Inst = constrained_inst_vars(_, Inst2),
inst_is_not_fully_unique_2(ModuleInfo, Inst2, !Expansions).
inst_is_not_fully_unique_2(ModuleInfo, Inst, !Expansions) :-
Inst = defined_inst(InstName),
( set.member(Inst, !.Expansions) ->
true
;
svset.insert(Inst, !Expansions),
inst_lookup(ModuleInfo, InstName, Inst2),
inst_is_not_fully_unique_2(ModuleInfo, Inst2, !Expansions)
).
%-----------------------------------------------------------------------------%
bound_inst_list_is_ground(BoundInsts, ModuleInfo) :-
bound_inst_list_is_ground(BoundInsts, no, ModuleInfo).
:- pred bound_inst_list_is_ground(list(bound_inst)::in, maybe(mer_type)::in,
module_info::in) is semidet.
bound_inst_list_is_ground([], _, _).
bound_inst_list_is_ground([bound_functor(Name, Args) | BoundInsts], MaybeType,
ModuleInfo) :-
maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, Name,
list.length(Args), MaybeTypes),
inst_list_is_ground(Args, MaybeTypes, ModuleInfo),
bound_inst_list_is_ground(BoundInsts, MaybeType, ModuleInfo).
bound_inst_list_is_ground_or_any([], _).
bound_inst_list_is_ground_or_any([bound_functor(_Name, Args) | BoundInsts],
ModuleInfo) :-
inst_list_is_ground_or_any(Args, ModuleInfo),
bound_inst_list_is_ground_or_any(BoundInsts, ModuleInfo).
bound_inst_list_is_unique([], _).
bound_inst_list_is_unique([bound_functor(_Name, Args) | BoundInsts],
ModuleInfo) :-
inst_list_is_unique(Args, ModuleInfo),
bound_inst_list_is_unique(BoundInsts, ModuleInfo).
bound_inst_list_is_mostly_unique([], _).
bound_inst_list_is_mostly_unique([bound_functor(_Name, Args) | BoundInsts],
ModuleInfo) :-
inst_list_is_mostly_unique(Args, ModuleInfo),
bound_inst_list_is_mostly_unique(BoundInsts, ModuleInfo).
bound_inst_list_is_not_partly_unique([], _).
bound_inst_list_is_not_partly_unique([bound_functor(_Name, Args) | BoundInsts],
ModuleInfo) :-
inst_list_is_not_partly_unique(Args, ModuleInfo),
bound_inst_list_is_not_partly_unique(BoundInsts, ModuleInfo).
bound_inst_list_is_not_fully_unique([], _).
bound_inst_list_is_not_fully_unique([bound_functor(_Name, Args) | BoundInsts],
ModuleInfo) :-
inst_list_is_not_fully_unique(Args, ModuleInfo),
bound_inst_list_is_not_fully_unique(BoundInsts, ModuleInfo).
%-----------------------------------------------------------------------------%
:- pred bound_inst_list_is_ground_2(list(bound_inst)::in, maybe(mer_type)::in,
module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
bound_inst_list_is_ground_2([], _, _, !Expansions).
bound_inst_list_is_ground_2([bound_functor(Name, Args) | BoundInsts],
MaybeType, ModuleInfo, !Expansions) :-
maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, Name,
list.length(Args), MaybeTypes),
inst_list_is_ground_2(Args, MaybeTypes, ModuleInfo, !Expansions),
bound_inst_list_is_ground_2(BoundInsts, MaybeType, ModuleInfo,
!Expansions).
:- pred bound_inst_list_is_ground_or_any_2(list(bound_inst)::in,
module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
bound_inst_list_is_ground_or_any_2([], _, !Expansions).
bound_inst_list_is_ground_or_any_2([bound_functor(_Name, Args) | BoundInsts],
ModuleInfo, !Expansions) :-
inst_list_is_ground_or_any_2(Args, ModuleInfo, !Expansions),
bound_inst_list_is_ground_or_any_2(BoundInsts, ModuleInfo,
!Expansions).
:- pred bound_inst_list_is_unique_2(list(bound_inst)::in, module_info::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
bound_inst_list_is_unique_2([], _, !Expansions).
bound_inst_list_is_unique_2([bound_functor(_Name, Args) | BoundInsts],
ModuleInfo, !Expansions) :-
inst_list_is_unique_2(Args, ModuleInfo, !Expansions),
bound_inst_list_is_unique_2(BoundInsts, ModuleInfo, !Expansions).
:- pred bound_inst_list_is_mostly_unique_2(list(bound_inst)::in,
module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
bound_inst_list_is_mostly_unique_2([], _, !Expansions).
bound_inst_list_is_mostly_unique_2([bound_functor(_Name, Args) | BoundInsts],
ModuleInfo, !Expansions) :-
inst_list_is_mostly_unique_2(Args, ModuleInfo, !Expansions),
bound_inst_list_is_mostly_unique_2(BoundInsts, ModuleInfo,
!Expansions).
:- pred bound_inst_list_is_not_partly_unique_2(list(bound_inst)::in,
module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
bound_inst_list_is_not_partly_unique_2([], _, !Expansions).
bound_inst_list_is_not_partly_unique_2(
[bound_functor(_Name, Args) | BoundInsts], ModuleInfo, !Expansions) :-
inst_list_is_not_partly_unique_2(Args, ModuleInfo, !Expansions),
bound_inst_list_is_not_partly_unique_2(BoundInsts, ModuleInfo,
!Expansions).
:- pred bound_inst_list_is_not_fully_unique_2(list(bound_inst)::in,
module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
bound_inst_list_is_not_fully_unique_2([], _, !Expansions).
bound_inst_list_is_not_fully_unique_2(
[bound_functor(_Name, Args) | BoundInsts], ModuleInfo, !Expansions) :-
inst_list_is_not_fully_unique_2(Args, ModuleInfo, !Expansions),
bound_inst_list_is_not_fully_unique_2(BoundInsts, ModuleInfo,
!Expansions).
%-----------------------------------------------------------------------------%
inst_list_is_ground(Insts, ModuleInfo) :-
MaybeTypes = list.duplicate(list.length(Insts), no),
inst_list_is_ground(Insts, MaybeTypes, ModuleInfo).
:- pred inst_list_is_ground(list(mer_inst)::in, list(maybe(mer_type))::in,
module_info::in) is semidet.
inst_list_is_ground([], [], _).
inst_list_is_ground([Inst | Insts], [MaybeType | MaybeTypes], ModuleInfo) :-
inst_is_ground(ModuleInfo, MaybeType, Inst),
inst_list_is_ground(Insts, MaybeTypes, ModuleInfo).
inst_list_is_ground_or_any([], _).
inst_list_is_ground_or_any([Inst | Insts], ModuleInfo) :-
inst_is_ground_or_any(ModuleInfo, Inst),
inst_list_is_ground_or_any(Insts, ModuleInfo).
inst_list_is_unique([], _).
inst_list_is_unique([Inst | Insts], ModuleInfo) :-
inst_is_unique(ModuleInfo, Inst),
inst_list_is_unique(Insts, ModuleInfo).
inst_list_is_mostly_unique([], _).
inst_list_is_mostly_unique([Inst | Insts], ModuleInfo) :-
inst_is_mostly_unique(ModuleInfo, Inst),
inst_list_is_mostly_unique(Insts, ModuleInfo).
inst_list_is_not_partly_unique([], _).
inst_list_is_not_partly_unique([Inst | Insts], ModuleInfo) :-
inst_is_not_partly_unique(ModuleInfo, Inst),
inst_list_is_not_partly_unique(Insts, ModuleInfo).
inst_list_is_not_fully_unique([], _).
inst_list_is_not_fully_unique([Inst | Insts], ModuleInfo) :-
inst_is_not_fully_unique(ModuleInfo, Inst),
inst_list_is_not_fully_unique(Insts, ModuleInfo).
%-----------------------------------------------------------------------------%
:- pred inst_list_is_ground_2(list(mer_inst)::in, list(maybe(mer_type))::in,
module_info::in, set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_list_is_ground_2([], _, _, !Expansions).
inst_list_is_ground_2([Inst | Insts], [MaybeType | MaybeTypes], ModuleInfo,
!Expansions) :-
inst_is_ground_1(ModuleInfo, MaybeType, Inst, !Expansions),
inst_list_is_ground_2(Insts, MaybeTypes, ModuleInfo, !Expansions).
:- pred inst_list_is_ground_or_any_2(list(mer_inst)::in, module_info::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_list_is_ground_or_any_2([], _, !Expansions).
inst_list_is_ground_or_any_2([Inst | Insts], ModuleInfo, !Expansions) :-
inst_is_ground_or_any_2(ModuleInfo, Inst, !Expansions),
inst_list_is_ground_or_any_2(Insts, ModuleInfo, !Expansions).
:- pred inst_list_is_unique_2(list(mer_inst)::in, module_info::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_list_is_unique_2([], _, !Expansions).
inst_list_is_unique_2([Inst | Insts], ModuleInfo, !Expansions) :-
inst_is_unique_2(ModuleInfo, Inst, !Expansions),
inst_list_is_unique_2(Insts, ModuleInfo, !Expansions).
:- pred inst_list_is_mostly_unique_2(list(mer_inst)::in, module_info::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_list_is_mostly_unique_2([], _, !Expansions).
inst_list_is_mostly_unique_2([Inst | Insts], ModuleInfo,
!Expansions) :-
inst_is_mostly_unique_2(ModuleInfo, Inst, !Expansions),
inst_list_is_mostly_unique_2(Insts, ModuleInfo, !Expansions).
:- pred inst_list_is_not_partly_unique_2(list(mer_inst)::in, module_info::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_list_is_not_partly_unique_2([], _, !Expansions).
inst_list_is_not_partly_unique_2([Inst | Insts], ModuleInfo,
!Expansions) :-
inst_is_not_partly_unique_2(ModuleInfo, Inst, !Expansions),
inst_list_is_not_partly_unique_2(Insts, ModuleInfo, !Expansions).
:- pred inst_list_is_not_fully_unique_2(list(mer_inst)::in, module_info::in,
set(mer_inst)::in, set(mer_inst)::out) is semidet.
inst_list_is_not_fully_unique_2([], _, !Expansions).
inst_list_is_not_fully_unique_2([Inst | Insts], ModuleInfo,
!Expansions) :-
inst_is_not_fully_unique_2(ModuleInfo, Inst, !Expansions),
inst_list_is_not_fully_unique_2(Insts, ModuleInfo, !Expansions).
%-----------------------------------------------------------------------------%
bound_inst_list_is_free([], _).
bound_inst_list_is_free([bound_functor(_Name, Args) | BoundInsts],
ModuleInfo) :-
inst_list_is_free(Args, ModuleInfo),
bound_inst_list_is_free(BoundInsts, ModuleInfo).
inst_list_is_free([], _).
inst_list_is_free([Inst | Insts], ModuleInfo) :-
inst_is_free(ModuleInfo, Inst),
inst_list_is_free(Insts, ModuleInfo).
%-----------------------------------------------------------------------------%
inst_list_is_ground_or_dead([], [], _).
inst_list_is_ground_or_dead([Inst | Insts], [Live | Lives], ModuleInfo) :-
(
Live = is_live,
inst_is_ground(ModuleInfo, Inst)
;
Live = is_dead
),
inst_list_is_ground_or_dead(Insts, Lives, ModuleInfo).
inst_list_is_ground_or_any_or_dead([], [], _).
inst_list_is_ground_or_any_or_dead([Inst | Insts], [Live | Lives],
ModuleInfo) :-
(
Live = is_live,
inst_is_ground_or_any(ModuleInfo, Inst)
;
Live = is_dead
),
inst_list_is_ground_or_any_or_dead(Insts, Lives, ModuleInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
inst_contains_instname(Inst, ModuleInfo, InstName) :-
set.init(Expansions0),
inst_contains_instname_2(Inst, ModuleInfo, InstName, yes,
Expansions0, _Expansions).
:- type inst_names == set(inst_name).
:- pred inst_contains_instname_2(mer_inst::in, module_info::in, inst_name::in,
bool::out, inst_names::in, inst_names::out) is det.
inst_contains_instname_2(abstract_inst(_, _), _, _, no, !Expansions).
inst_contains_instname_2(any(_), _, _, no, !Expansions).
inst_contains_instname_2(free, _, _, no, !Expansions).
inst_contains_instname_2(free(_T), _, _, no, !Expansions).
inst_contains_instname_2(ground(_Uniq, _), _, _, no, !Expansions).
inst_contains_instname_2(inst_var(_), _, _, no, !Expansions).
inst_contains_instname_2(not_reached, _, _, no, !Expansions).
inst_contains_instname_2(constrained_inst_vars(_, Inst), ModuleInfo, InstName,
Result, !Expansions) :-
inst_contains_instname_2(Inst, ModuleInfo, InstName, Result,
!Expansions).
inst_contains_instname_2(defined_inst(InstName1), ModuleInfo, InstName,
Result, !Expansions) :-
( InstName = InstName1 ->
Result = yes
;
( set.member(InstName1, !.Expansions) ->
Result = no
;
inst_lookup(ModuleInfo, InstName1, Inst1),
svset.insert(InstName1, !Expansions),
inst_contains_instname_2(Inst1, ModuleInfo, InstName, Result,
!Expansions)
)
).
inst_contains_instname_2(bound(_Uniq, ArgInsts), ModuleInfo,
InstName, Result, !Expansions) :-
% XXX This code has a performance problem.
%
% The problem is that e.g. in a list of length N, you'll have N variables
% for the skeletons whose insts contain an average of N/2 occurences of
% `bound' each, so the complexity of running inst_contains_instname_2
% on all their insts is quadratic in N.
%
% One solution to this would be to add an extra argument to bound/2
% that gives the set of included inst_names, or simply asserts that this
% set is empty. This field can be set at the time of the construction
% of the inst, avoiding quadratic behavior in inst_contains_instname_2.
% The complexity of constructing all the insts will remain quadratic in N,
% of course.
bound_inst_list_contains_instname(ArgInsts, ModuleInfo,
InstName, Result, !Expansions).
:- pred bound_inst_list_contains_instname(list(bound_inst)::in,
module_info::in, inst_name::in, bool::out,
inst_names::in, inst_names::out) is det.
bound_inst_list_contains_instname([], _ModuleInfo, _InstName, no, !Expansions).
bound_inst_list_contains_instname([BoundInst | BoundInsts], ModuleInfo,
InstName, Result, !Expansions) :-
BoundInst = bound_functor(_Functor, ArgInsts),
inst_list_contains_instname(ArgInsts, ModuleInfo, InstName, Result1,
!Expansions),
(
Result1 = yes,
Result = yes
;
Result1 = no,
bound_inst_list_contains_instname(BoundInsts, ModuleInfo,
InstName, Result, !Expansions)
).
:- pred inst_list_contains_instname(list(mer_inst)::in, module_info::in,
inst_name::in, bool::out, inst_names::in, inst_names::out) is det.
inst_list_contains_instname([], _ModuleInfo, _InstName, no, !Expansions).
inst_list_contains_instname([Inst | Insts], ModuleInfo, InstName, Result,
!Expansions) :-
inst_contains_instname_2(Inst, ModuleInfo, InstName, Result1, !Expansions),
(
Result1 = yes,
Result = yes
;
Result1 = no,
inst_list_contains_instname(Insts, ModuleInfo, InstName, Result,
!Expansions)
).
%-----------------------------------------------------------------------------%
:- pred inst_name_contains_inst_var(inst_name::in, inst_var::out) is nondet.
inst_name_contains_inst_var(user_inst(_Name, ArgInsts), InstVar) :-
inst_list_contains_inst_var(ArgInsts, InstVar).
inst_name_contains_inst_var(merge_inst(InstA, InstB), InstVar) :-
( inst_contains_inst_var(InstA, InstVar)
; inst_contains_inst_var(InstB, InstVar)
).
inst_name_contains_inst_var(unify_inst(_Live, InstA, InstB, _Real), InstVar) :-
( inst_contains_inst_var(InstA, InstVar)
; inst_contains_inst_var(InstB, InstVar)
).
inst_name_contains_inst_var(ground_inst(InstName, _Live, _Uniq, _Real),
InstVar) :-
inst_name_contains_inst_var(InstName, InstVar).
inst_name_contains_inst_var(any_inst(InstName, _Live, _Uniq, _Real),
InstVar) :-
inst_name_contains_inst_var(InstName, InstVar).
inst_name_contains_inst_var(shared_inst(InstName), InstVar) :-
inst_name_contains_inst_var(InstName, InstVar).
inst_name_contains_inst_var(mostly_uniq_inst(InstName), InstVar) :-
inst_name_contains_inst_var(InstName, InstVar).
inst_name_contains_inst_var(typed_ground(_Uniq, _Type), _InstVar) :- fail.
inst_name_contains_inst_var(typed_inst(_Type, InstName), InstVar) :-
inst_name_contains_inst_var(InstName, InstVar).
:- pred inst_contains_inst_var(mer_inst::in, inst_var::out) is nondet.
inst_contains_inst_var(inst_var(InstVar), InstVar).
inst_contains_inst_var(defined_inst(InstName), InstVar) :-
inst_name_contains_inst_var(InstName, InstVar).
inst_contains_inst_var(bound(_Uniq, ArgInsts), InstVar) :-
bound_inst_list_contains_inst_var(ArgInsts, InstVar).
inst_contains_inst_var(ground(_Uniq, GroundInstInfo), InstVar) :-
GroundInstInfo = higher_order(pred_inst_info(_PredOrFunc, Modes, _Det)),
mode_list_contains_inst_var(Modes, InstVar).
inst_contains_inst_var(abstract_inst(_Name, ArgInsts), InstVar) :-
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(Modes, _ModuleInfo, InstVar) :-
mode_list_contains_inst_var(Modes, InstVar).
:- pred mode_list_contains_inst_var(list(mer_mode)::in, inst_var::out)
is nondet.
mode_list_contains_inst_var([Mode | _Modes], InstVar) :-
mode_contains_inst_var(Mode, InstVar).
mode_list_contains_inst_var([_ | Modes], 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 = (Initial -> Final),
( Inst = Initial ; Inst = Final )
;
Mode = user_defined_mode(_Name, Insts),
list.member(Inst, Insts)
),
inst_contains_inst_var(Inst, InstVar).
%-----------------------------------------------------------------------------%
% For a non-solver type t (i.e. any type declared without using the
% `solver' keyword), the inst `any' should be considered to be equivalent
% to a bound inst i where i contains all the functors of the type t and
% each argument has inst `any'.
%
:- pred maybe_any_to_bound(maybe(mer_type)::in, module_info::in,
uniqueness::in, mer_inst::out) is semidet.
maybe_any_to_bound(yes(Type), ModuleInfo, Uniq, Inst) :-
\+ type_util.is_solver_type(ModuleInfo, Type),
(
type_constructors(Type, ModuleInfo, Constructors)
->
constructors_to_bound_any_insts(ModuleInfo, Uniq,
Constructors, BoundInsts0),
list.sort_and_remove_dups(BoundInsts0, BoundInsts),
Inst = bound(Uniq, BoundInsts)
;
type_may_contain_solver_type(Type, ModuleInfo)
->
% For a type for which constructors are not available (e.g. an
% abstract type) and which may contain solver types, we fail, meaning
% that we will use `any' for this type.
fail
;
Inst = ground(Uniq, none)
).
:- pred type_may_contain_solver_type(mer_type::in, module_info::in) is semidet.
type_may_contain_solver_type(Type, ModuleInfo) :-
type_may_contain_solver_type_2(classify_type(ModuleInfo, Type)) = yes.
:- func type_may_contain_solver_type_2(type_category) = bool.
type_may_contain_solver_type_2(type_cat_int) = no.
type_may_contain_solver_type_2(type_cat_char) = no.
type_may_contain_solver_type_2(type_cat_string) = no.
type_may_contain_solver_type_2(type_cat_float) = no.
type_may_contain_solver_type_2(type_cat_higher_order) = no.
type_may_contain_solver_type_2(type_cat_tuple) = yes.
type_may_contain_solver_type_2(type_cat_enum) = no.
type_may_contain_solver_type_2(type_cat_dummy) = no.
type_may_contain_solver_type_2(type_cat_variable) = yes.
type_may_contain_solver_type_2(type_cat_type_info) = no.
type_may_contain_solver_type_2(type_cat_type_ctor_info) = no.
type_may_contain_solver_type_2(type_cat_typeclass_info) = no.
type_may_contain_solver_type_2(type_cat_base_typeclass_info) = no.
type_may_contain_solver_type_2(type_cat_void) = no.
type_may_contain_solver_type_2(type_cat_user_ctor) = yes.
%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "inst_match.m".
%-----------------------------------------------------------------------------%
:- end_module inst_match.
%-----------------------------------------------------------------------------%