mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-13 12:53:53 +00:00
Code Issues Projects Releases Wiki Activity
Files
4ee7e744b715b7adf665a267de3814131839a617
mercury/compiler/prog_mode.m
Zoltan Somogyi 15aa457e12 Delete $module arg from calls to unexpected.
2018-04-07 18:25:43 +10:00

1336 lines
48 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2004-2006, 2008-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: prog_mode.m.
% Main author: fjh.
%
% Utility predicates dealing with modes and insts that do not require access
% to the HLDS. (The predicates that do are in mode_util.m.)
%
%---------------------------------------------------------------------------%
:- module parse_tree.prog_mode.
:- interface.
:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module list.
:- import_module maybe.
:- import_module term.
%---------------------------------------------------------------------------%
% Construct a mode corresponding to the standard `in', `out', `uo'
% or `unused' mode.
%
:- pred in_mode(mer_mode::out) is det.
:- func in_mode = mer_mode.
:- func in_mode(mer_inst) = mer_mode.
:- pred out_mode(mer_mode::out) is det.
:- func out_mode = mer_mode.
:- func out_mode(mer_inst) = mer_mode.
:- pred di_mode(mer_mode::out) is det.
:- func di_mode = mer_mode.
:- pred uo_mode(mer_mode::out) is det.
:- func uo_mode = mer_mode.
:- pred mdi_mode(mer_mode::out) is det.
:- func mdi_mode = mer_mode.
:- pred muo_mode(mer_mode::out) is det.
:- func muo_mode = mer_mode.
:- pred unused_mode(mer_mode::out) is det.
:- func unused_mode = mer_mode.
:- func in_any_mode = mer_mode.
:- func out_any_mode = mer_mode.
:- func in_from_to_insts = from_to_insts.
:- func out_from_to_insts = from_to_insts.
:- func di_from_to_insts = from_to_insts.
:- func mdi_from_to_insts = from_to_insts.
:- func uo_from_to_insts = from_to_insts.
:- func muo_from_to_insts = from_to_insts.
:- func unused_from_to_insts = from_to_insts.
:- func free_inst = mer_inst.
:- func ground_inst = mer_inst.
:- func unique_inst = mer_inst.
:- func mostly_unique_inst = mer_inst.
:- func clobbered_inst = mer_inst.
:- func mostly_clobbered_inst = mer_inst.
:- func any_inst = mer_inst.
:- func from_to_insts_in = from_to_insts.
:- func from_to_insts_out = from_to_insts.
:- pred make_std_mode(string::in, list(mer_inst)::in, mer_mode::out) is det.
:- func make_std_mode(string, list(mer_inst)) = mer_mode.
%---------------------------------------------------------------------------%
% mode_substitute_arg_list(Mode0, Params, Args, Mode) is true iff Mode is
% the mode that results from substituting all occurrences of Params
% in Mode0 with the corresponding value in Args.
%
:- pred mode_substitute_arg_list(mer_mode::in, list(inst_var)::in,
list(mer_inst)::in, mer_mode::out) is det.
% inst_lists_to_mode_list(InitialInsts, FinalInsts, Modes):
%
% Given two lists of corresponding initial and final insts, return
% a list of modes which maps from the initial insts to the final insts.
%
:- pred inst_lists_to_mode_list(list(mer_inst)::in, list(mer_inst)::in,
list(mer_mode)::out) is det.
% insts_to_mode(InitialInst, FinalInst, Modes):
%
% Given an initial and a final inst, return the mode which maps
% the initial inst to the final inst.
%
:- pred insts_to_mode(mer_inst::in, mer_inst::in, mer_mode::out) is det.
%---------------------------------------------------------------------------%
% inst_substitute_arg_list(Params, Args, Inst0, Inst) is true iff Inst
% is the inst that results from substituting all occurrences of Params
% in Inst0 with the corresponding value in Args.
%
:- pred inst_substitute_arg_list(list(inst_var)::in, list(mer_inst)::in,
mer_inst::in, mer_inst::out) is det.
% inst_list_apply_substitution(Subst, Insts0, Insts) is true
% iff Insts is the result of applying Subst to every inst in Insts0.
%
:- pred inst_list_apply_substitution(inst_var_sub::in,
list(mer_inst)::in, list(mer_inst)::out) is det.
% inst_apply_substitution(Inst0, Subst, Inst) is true iff Inst is the inst
% that results from applying Subst to Inst0.
%
:- pred inst_apply_substitution(inst_var_sub::in, mer_inst::in, mer_inst::out)
is det.
% mode_list_apply_substitution(Subst, Modes0, Modes) is true
% iff Mode is the mode that results from applying Subst to Modes0.
%
:- pred mode_list_apply_substitution(inst_var_sub::in,
list(mer_mode)::in, list(mer_mode)::out) is det.
:- pred rename_apart_inst_vars(inst_varset::in, inst_varset::in,
inst_varset::out, list(mer_mode)::in, list(mer_mode)::out) is det.
% inst_contains_unconstrained_var(Inst) iff Inst includes an
% unconstrained inst variable.
%
:- pred inst_contains_unconstrained_var(mer_inst::in) is semidet.
%---------------------------------------------------------------------------%
% Given an expanded inst and a cons_id and its arity, return the
% insts of the arguments of the top level functor, failing if the
% inst could not be bound to the functor.
%
% Note that inst_expand does not expand insts with constrained_inst_vars
% at the top level.
%
:- pred get_arg_insts(mer_inst::in, cons_id::in, arity::in,
list(mer_inst)::out) is semidet.
% As above, but abort instead of failing.
%
:- pred get_arg_insts_det(mer_inst::in, cons_id::in, arity::in,
list(mer_inst)::out) is det.
% Given a (list of) bound_insts, get the corresponding cons_ids.
% The type_ctor should be the type constructor of the variable
% the bound_insts are for.
%
% Note that it is entirely possible for two *different* bound_insts
% in a bound/3 inst to refer to the *same* cons_id, because they can
% specify different insts for the cons_id's arguments. Therefore the
% list returned from bound_insts_to_cons_ids may contain duplicates.
%
:- pred bound_inst_to_cons_id(type_ctor::in, bound_inst::in,
cons_id::out) is det.
:- pred bound_insts_to_cons_ids(type_ctor::in, list(bound_inst)::in,
list(cons_id)::out) is det.
:- pred mode_id_to_int(mode_id::in, int::out) is det.
% Predicates to make error messages more readable by stripping
% "builtin." module qualifiers from modes.
%
:- pred strip_builtin_qualifiers_from_mode_list(list(mer_mode)::in,
list(mer_mode)::out) is det.
:- pred strip_builtin_qualifiers_from_inst_list(list(mer_inst)::in,
list(mer_inst)::out) is det.
:- pred strip_builtin_qualifiers_from_inst(mer_inst::in, mer_inst::out) is det.
%---------------------------------------------------------------------------%
% Replace all occurrences of inst_var(InstVar) with
% constrained_inst_var(InstVar, ground(shared, none)).
%
:- pred constrain_inst_vars_in_mode(mer_mode::in, mer_mode::out) is det.
% Replace all occurrences of inst_var(InstVar) with
% constrained_inst_var(InstVar, Inst) where InstVar -> Inst
% is in the inst_var_sub.
% If InstVar is not in the inst_var_sub, default to ground(shared, none).
%
:- pred constrain_inst_vars_in_mode_sub(inst_var_sub::in,
mer_mode::in, mer_mode::out) is det.
%---------------------------------------------------------------------------%
% For each constrained inst_var, check whether all its occurrences
% have the same constraint. Return a sorted list of the inst_vars
% for which the answer is "no".
%
:- pred inconsistent_constrained_inst_vars_in_modes(
list(mer_mode)::in, list(inst_var)::out) is det.
:- pred inconsistent_constrained_inst_vars_in_type_and_modes(
list(type_and_mode)::in, list(inst_var)::out) is det.
:- pred report_inconsistent_constrained_inst_vars(string::in, term.context::in,
inst_varset::in, list(inst_var)::in, maybe(error_spec)::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.prog_util.
:- import_module map.
:- import_module require.
:- import_module set.
:- import_module varset.
%---------------------------------------------------------------------------%
in_mode(in_mode).
out_mode(out_mode).
di_mode(di_mode).
uo_mode(uo_mode).
mdi_mode(mdi_mode).
muo_mode(muo_mode).
unused_mode(unused_mode).
in_mode = make_std_mode("in", []).
in_mode(I) = make_std_mode("in", [I]).
out_mode = make_std_mode("out", []).
out_mode(I) = make_std_mode("out", [I]).
di_mode = make_std_mode("di", []).
uo_mode = make_std_mode("uo", []).
mdi_mode = make_std_mode("mdi", []).
muo_mode = make_std_mode("muo", []).
unused_mode = make_std_mode("unused", []).
in_any_mode = make_std_mode("in", [any_inst]).
out_any_mode = make_std_mode("out", [any_inst]).
in_from_to_insts = from_to_insts(ground_inst, ground_inst).
out_from_to_insts = from_to_insts(free, ground_inst).
di_from_to_insts = from_to_insts(unique_inst, clobbered_inst).
mdi_from_to_insts = from_to_insts(mostly_unique_inst, mostly_clobbered_inst).
uo_from_to_insts = from_to_insts(free, unique_inst).
muo_from_to_insts = from_to_insts(free, mostly_unique_inst).
unused_from_to_insts = from_to_insts(free, free).
free_inst = free.
ground_inst = ground(shared, none_or_default_func).
unique_inst = ground(unique, none_or_default_func).
mostly_unique_inst = ground(mostly_unique, none_or_default_func).
clobbered_inst = ground(clobbered, none_or_default_func).
mostly_clobbered_inst = ground(mostly_clobbered, none_or_default_func).
any_inst = any(shared, none_or_default_func).
from_to_insts_in = Insts :-
Ground = ground(shared, none_or_default_func),
Insts = from_to_insts(Ground, Ground).
from_to_insts_out = Insts :-
Ground = ground(shared, none_or_default_func),
Insts = from_to_insts(free, Ground).
make_std_mode(Name, Args, make_std_mode(Name, Args)).
make_std_mode(Name, Args) = Mode :-
MercuryBuiltin = mercury_public_builtin_module,
QualifiedName = qualified(MercuryBuiltin, Name),
Mode = user_defined_mode(QualifiedName, Args).
%---------------------------------------------------------------------------%
inst_lists_to_mode_list([], [], []).
inst_lists_to_mode_list([], [_ | _], _) :-
unexpected($pred, "length mismatch").
inst_lists_to_mode_list([_ | _], [], _) :-
unexpected($pred, "length mismatch").
inst_lists_to_mode_list([Initial | Initials], [Final | Finals],
[Mode | Modes]) :-
insts_to_mode(Initial, Final, Mode),
inst_lists_to_mode_list(Initials, Finals, Modes).
insts_to_mode(Initial, Final, Mode) :-
% Use some abbreviations.
% This is just to make error messages and inferred modes more readable.
( if
Initial = free
then
( if Final = ground(shared, none_or_default_func) then
make_std_mode("out", [], Mode)
else if Final = ground(unique, none_or_default_func) then
make_std_mode("uo", [], Mode)
else if Final = ground(mostly_unique, none_or_default_func) then
make_std_mode("muo", [], Mode)
else
make_std_mode("out", [Final], Mode)
)
else if
Initial = ground(shared, none_or_default_func),
Final = ground(shared, none_or_default_func)
then
make_std_mode("in", [], Mode)
else if
Initial = ground(unique, none_or_default_func),
Final = ground(clobbered, none_or_default_func)
then
make_std_mode("di", [], Mode)
else if
Initial = ground(mostly_unique, none_or_default_func),
Final = ground(mostly_clobbered, none_or_default_func)
then
make_std_mode("mdi", [], Mode)
else if
Initial = ground(unique, none_or_default_func),
Final = ground(unique, none_or_default_func)
then
make_std_mode("ui", [], Mode)
else if
Initial = ground(mostly_unique, none_or_default_func),
Final = ground(mostly_unique, none_or_default_func)
then
make_std_mode("mui", [], Mode)
else if
Final = ground(clobbered, none_or_default_func)
then
make_std_mode("di", [Initial], Mode)
else if Initial = Final then
make_std_mode("in", [Initial], Mode)
else
Mode = from_to_mode(Initial, Final)
).
%---------------------------------------------------------------------------%
mode_substitute_arg_list(Mode0, Params, Args, Mode) :-
(
Params = [],
Mode = Mode0 % optimize common case
;
Params = [_ | _],
map.from_corresponding_lists(Params, Args, Subst),
mode_apply_substitution(Subst, Mode0, Mode)
).
inst_substitute_arg_list(Params, Args, Inst0, Inst) :-
(
Params = [],
Inst = Inst0 % optimize common case
;
Params = [_ | _],
map.from_corresponding_lists(Params, Args, Subst),
inst_apply_substitution(Subst, Inst0, Inst)
).
% mode_apply_substitution(Mode0, Subst, Mode) is true iff
% Mode is the mode that results from apply Subst to Mode0.
%
:- pred mode_apply_substitution(inst_var_sub::in, mer_mode::in, mer_mode::out)
is det.
mode_apply_substitution(Subst, Mode0, Mode) :-
(
Mode0 = from_to_mode(I0, F0),
inst_apply_substitution(Subst, I0, I),
inst_apply_substitution(Subst, F0, F),
Mode = from_to_mode(I, F)
;
Mode0 = user_defined_mode(Name, Args0),
inst_list_apply_substitution_2(Subst, Args0, Args),
Mode = user_defined_mode(Name, Args)
).
inst_list_apply_substitution(Subst, Insts0, Insts) :-
( if map.is_empty(Subst) then
Insts = Insts0
else
inst_list_apply_substitution_2(Subst, Insts0, Insts)
).
:- pred inst_list_apply_substitution_2(inst_var_sub::in,
list(mer_inst)::in, list(mer_inst)::out) is det.
inst_list_apply_substitution_2(_, [], []).
inst_list_apply_substitution_2(Subst, [Inst0 | Insts0], [Inst | Insts]) :-
inst_apply_substitution(Subst, Inst0, Inst),
inst_list_apply_substitution_2(Subst, Insts0, Insts).
inst_apply_substitution(Subst, Inst0, Inst) :-
(
( Inst0 = not_reached
; Inst0 = free
; Inst0 = free(_)
),
Inst = Inst0
;
Inst0 = ground(Uniq, HOInstInfo0),
ho_inst_info_apply_substitution(Subst, HOInstInfo0, HOInstInfo),
Inst = ground(Uniq, HOInstInfo)
;
Inst0 = any(Uniq, HOInstInfo0),
ho_inst_info_apply_substitution(Subst, HOInstInfo0, HOInstInfo),
Inst = any(Uniq, HOInstInfo)
;
Inst0 = bound(Uniq0, InstResults0, BoundInsts0),
(
InstResults0 = inst_test_results_fgtc,
% There is nothing to substitute.
Inst = Inst0
;
InstResults0 = inst_test_results(_, _, _, InstVarsResult, _, _),
( if
InstVarsResult =
inst_result_contains_inst_vars_known(InstVarsSet),
set.to_sorted_list(InstVarsSet, InstVars),
no_inst_var_is_in_map(InstVars, Subst)
then
Inst = Inst0
else
bound_insts_apply_substitution(Subst, BoundInsts0, BoundInsts),
% The substitution can invalidate all existing test results.
% XXX depends on the applied ReplacementInsts.
Inst = bound(Uniq0, inst_test_no_results, BoundInsts)
)
;
InstResults0 = inst_test_no_results,
bound_insts_apply_substitution(Subst, BoundInsts0, BoundInsts),
% The substitution can invalidate all existing test results.
% XXX depends on the applied ReplacementInsts.
Inst = bound(Uniq0, inst_test_no_results, BoundInsts)
)
;
Inst0 = inst_var(Var),
( if map.search(Subst, Var, ReplacementInst) then
Inst = ReplacementInst
else
Inst = Inst0
)
;
Inst0 = constrained_inst_vars(Vars, SubInst0),
( if set.is_singleton(Vars, Var0) then
Var = Var0
else
unexpected($pred, "multiple inst_vars found")
),
( if map.search(Subst, Var, ReplacementInst) then
Inst = ReplacementInst
% XXX Should probably have a sanity check here that
% ReplacementInst =< Inst0
else
inst_apply_substitution(Subst, SubInst0, SubInst),
Inst = constrained_inst_vars(Vars, SubInst)
)
;
Inst0 = defined_inst(InstName0),
( if inst_name_apply_substitution(Subst, InstName0, InstName) then
Inst = defined_inst(InstName)
else
Inst = Inst0
)
;
Inst0 = abstract_inst(Name, ArgInsts0),
inst_list_apply_substitution_2(Subst, ArgInsts0, ArgInsts),
Inst = abstract_inst(Name, ArgInsts)
).
:- pred no_inst_var_is_in_map(list(inst_var)::in, map(inst_var, T)::in)
is semidet.
no_inst_var_is_in_map([], _Map).
no_inst_var_is_in_map([InstVar | InstVars], Map) :-
not (
map.search(Map, InstVar, _ReplacementInst)
),
no_inst_var_is_in_map(InstVars, Map).
% This predicate fails if the inst_name is not one of user_inst,
% typed_inst or typed_ground. The other types of inst_names are just used
% as keys in the inst_table so it does not make sense to apply
% substitutions to them.
%
:- pred inst_name_apply_substitution(inst_var_sub::in,
inst_name::in, inst_name::out) is semidet.
inst_name_apply_substitution(Subst, InstName0, InstName) :-
(
InstName0 = user_inst(Name, ArgInsts0),
inst_list_apply_substitution_2(Subst, ArgInsts0, ArgInsts),
InstName = user_inst(Name, ArgInsts)
;
InstName0 = typed_inst(T, SubInst0),
inst_name_apply_substitution(Subst, SubInst0, SubInst),
InstName = typed_inst(T, SubInst)
;
InstName0 = typed_ground(_Uniq, _T),
% XXX Why is this here? The caller would do the same thing
% if it wasn't here.
InstName = InstName0
).
:- pred bound_insts_apply_substitution(inst_var_sub::in,
list(bound_inst)::in, list(bound_inst)::out) is det.
bound_insts_apply_substitution(_, [], []).
bound_insts_apply_substitution(Subst,
[BoundInst0 | BoundInsts0], [BoundInst | BoundInsts]) :-
BoundInst0 = bound_functor(Name, Args0),
inst_list_apply_substitution_2(Subst, Args0, Args),
BoundInst = bound_functor(Name, Args),
bound_insts_apply_substitution(Subst, BoundInsts0, BoundInsts).
:- pred ho_inst_info_apply_substitution(inst_var_sub::in,
ho_inst_info::in, ho_inst_info::out) is det.
ho_inst_info_apply_substitution(_, none_or_default_func, none_or_default_func).
ho_inst_info_apply_substitution(Subst, HOInstInfo0, HOInstInfo) :-
HOInstInfo0 =
higher_order(pred_inst_info(PredOrFunc, Modes0, MaybeArgRegs, Det)),
mode_list_apply_substitution(Subst, Modes0, Modes),
HOInstInfo =
higher_order(pred_inst_info(PredOrFunc, Modes, MaybeArgRegs, Det)).
mode_list_apply_substitution(Subst, Modes0, Modes) :-
( if map.is_empty(Subst) then
Modes = Modes0
else
mode_list_apply_substitution_2(Subst, Modes0, Modes)
).
:- pred mode_list_apply_substitution_2(inst_var_sub::in,
list(mer_mode)::in, list(mer_mode)::out) is det.
mode_list_apply_substitution_2(_, [], []).
mode_list_apply_substitution_2(Subst, [Mode0 | Modes0], [Mode | Modes]) :-
mode_apply_substitution(Subst, Mode0, Mode),
mode_list_apply_substitution_2(Subst, Modes0, Modes).
%---------------------------------------------------------------------------%
rename_apart_inst_vars(VarSet, NewVarSet, MergedVarSet, Modes0, Modes) :-
varset.merge_renaming(VarSet, NewVarSet, MergedVarSet, Renaming),
list.map(rename_apart_inst_vars_in_mode(Renaming), Modes0, Modes).
:- pred rename_apart_inst_vars_in_mode(renaming(inst_var_type)::in,
mer_mode::in, mer_mode::out) is det.
rename_apart_inst_vars_in_mode(Renaming, Mode0, Mode) :-
(
Mode0 = from_to_mode(I0, F0),
rename_apart_inst_vars_in_inst(Renaming, I0, I),
rename_apart_inst_vars_in_inst(Renaming, F0, F),
Mode = from_to_mode(I, F)
;
Mode0 = user_defined_mode(Name, Insts0),
list.map(rename_apart_inst_vars_in_inst(Renaming), Insts0, Insts),
Mode = user_defined_mode(Name, Insts)
).
:- pred rename_apart_inst_vars_in_inst(renaming(inst_var_type)::in,
mer_inst::in, mer_inst::out) is det.
rename_apart_inst_vars_in_inst(Renaming, Inst0, Inst) :-
(
( Inst0 = not_reached
; Inst0 = free
; Inst0 = free(_)
),
Inst = Inst0
;
Inst0 = ground(Uniq, HOInstInfo0),
(
HOInstInfo0 =
higher_order(pred_inst_info(PorF, Modes0, MaybeArgRegs, Det)),
list.map(rename_apart_inst_vars_in_mode(Renaming), Modes0, Modes),
HOInstInfo =
higher_order(pred_inst_info(PorF, Modes, MaybeArgRegs, Det))
;
HOInstInfo0 = none_or_default_func,
HOInstInfo = none_or_default_func
),
Inst = ground(Uniq, HOInstInfo)
;
Inst0 = any(Uniq, HOInstInfo0),
(
HOInstInfo0 =
higher_order(pred_inst_info(PorF, Modes0, MaybeArgRegs, Det)),
list.map(rename_apart_inst_vars_in_mode(Renaming), Modes0, Modes),
HOInstInfo =
higher_order(pred_inst_info(PorF, Modes, MaybeArgRegs, Det))
;
HOInstInfo0 = none_or_default_func,
HOInstInfo = none_or_default_func
),
Inst = any(Uniq, HOInstInfo)
;
Inst0 = bound(Uniq0, InstResults0, BoundInsts0),
(
InstResults0 = inst_test_results_fgtc,
% There is nothing to substitute.
Inst = Inst0
;
InstResults0 = inst_test_results(_, _, _, InstVarsResult, _, _),
( if
InstVarsResult =
inst_result_contains_inst_vars_known(InstVarsSet),
set.to_sorted_list(InstVarsSet, InstVars),
no_inst_var_is_in_map(InstVars, Renaming)
then
Inst = Inst0
else
list.map(rename_apart_inst_vars_in_bound_inst(Renaming),
BoundInsts0, BoundInsts),
% The substitution can invalidate all existing test results.
% XXX depends on the applied ReplacementInsts.
Inst = bound(Uniq0, inst_test_no_results, BoundInsts)
)
;
InstResults0 = inst_test_no_results,
list.map(rename_apart_inst_vars_in_bound_inst(Renaming),
BoundInsts0, BoundInsts),
% The substitution can invalidate all existing test results.
% XXX depends on the applied ReplacementInsts.
Inst = bound(Uniq0, inst_test_no_results, BoundInsts)
)
;
Inst0 = inst_var(Var0),
( if map.search(Renaming, Var0, Var1) then
Inst = inst_var(Var1)
else
Inst = Inst0
)
;
Inst0 = constrained_inst_vars(Vars0, SubInst0),
rename_apart_inst_vars_in_inst(Renaming, SubInst0, SubInst),
MaybeReplaceFunc = (
func(Var0) =
( if map.search(Renaming, Var0, Var) then
Var
else
Var0
)
),
Vars = set.map(MaybeReplaceFunc, Vars0),
Inst = constrained_inst_vars(Vars, SubInst)
;
Inst0 = defined_inst(Name0),
( if rename_apart_inst_vars_in_inst_name(Renaming, Name0, Name1) then
Inst = defined_inst(Name1)
else
Inst = Inst0
)
;
Inst0 = abstract_inst(Sym, SubInsts0),
list.map(rename_apart_inst_vars_in_inst(Renaming),
SubInsts0, SubInsts),
Inst = abstract_inst(Sym, SubInsts)
).
:- pred rename_apart_inst_vars_in_bound_inst(renaming(inst_var_type)::in,
bound_inst::in, bound_inst::out) is det.
rename_apart_inst_vars_in_bound_inst(Renaming, BoundInst0, BoundInst) :-
BoundInst0 = bound_functor(ConsId, ArgInsts0),
list.map(rename_apart_inst_vars_in_inst(Renaming), ArgInsts0, ArgInsts),
BoundInst = bound_functor(ConsId, ArgInsts).
:- pred rename_apart_inst_vars_in_inst_name(renaming(inst_var_type)::in,
inst_name::in, inst_name::out) is semidet.
rename_apart_inst_vars_in_inst_name(Renaming, InstName0, InstName) :-
(
InstName0 = user_inst(Sym, Insts0),
list.map(rename_apart_inst_vars_in_inst(Renaming), Insts0, Insts),
InstName = user_inst(Sym, Insts)
;
InstName0 = typed_inst(Type, Name0),
rename_apart_inst_vars_in_inst_name(Renaming, Name0, Name),
InstName = typed_inst(Type, Name)
;
InstName0 = typed_ground(_U, _T),
% XXX Why is this here? The caller would do the same thing
% if it wasn't here.
InstName = InstName0
).
%---------------------------------------------------------------------------%
inst_contains_unconstrained_var(Inst) :-
require_complete_switch [Inst]
(
( Inst = not_reached
; Inst = free
; Inst = free(_)
),
fail
;
Inst = inst_var(_InstVar)
;
( Inst = ground(_Uniq, GroundInstInfo)
; Inst = any(_Uniq, GroundInstInfo)
),
GroundInstInfo = higher_order(PredInstInfo),
PredInstInfo = pred_inst_info(_PredOrFunc, Modes,
_MaybeArgRegs, _Detism),
list.member(Mode, Modes),
(
Mode = from_to_mode(SubInst, _)
;
Mode = from_to_mode(_, SubInst)
;
Mode = user_defined_mode(_SymName, SubInsts),
list.member(SubInst, SubInsts)
),
inst_contains_unconstrained_var(SubInst)
;
Inst = bound(_Uniq, InstResults, BoundInsts),
(
InstResults = inst_test_no_results
;
InstResults = inst_test_results(_, _, _, InstVarsResult, _, _),
(
InstVarsResult = inst_result_contains_inst_vars_unknown
;
InstVarsResult =
inst_result_contains_inst_vars_known(InstVars),
set.is_non_empty(InstVars)
)
;
InstResults = inst_test_results_fgtc,
fail
),
list.member(BoundInst, BoundInsts),
BoundInst = bound_functor(_ConsId, ArgInsts),
list.member(ArgInst, ArgInsts),
inst_contains_unconstrained_var(ArgInst)
;
Inst = defined_inst(InstName),
inst_name_contains_unconstrained_var(InstName)
;
Inst = abstract_inst(_SymName, ArgInsts),
list.member(ArgInst, ArgInsts),
inst_contains_unconstrained_var(ArgInst)
;
Inst = constrained_inst_vars(_, _),
% XXX Is this the right thing to do here? Just because Inst constrains
% SOME of the instvars in it, it does not necessarily constrain all.
% What we do here preserves the old behavior of this predicate.
fail
).
% inst_name_contains_unconstrained_var(InstName) iff InstName includes
% an unconstrained inst variable.
%
:- pred inst_name_contains_unconstrained_var(inst_name::in) is semidet.
inst_name_contains_unconstrained_var(InstName) :-
require_complete_switch [InstName]
(
InstName = user_inst(_, SubInsts),
list.member(SubInst, SubInsts),
inst_contains_unconstrained_var(SubInst)
;
InstName = unify_inst(_, _, SubInstA, SubInstB),
( inst_contains_unconstrained_var(SubInstA)
; inst_contains_unconstrained_var(SubInstB)
)
;
InstName = merge_inst(SubInstA, SubInstB),
( inst_contains_unconstrained_var(SubInstA)
; inst_contains_unconstrained_var(SubInstB)
)
;
InstName = ground_inst(SubInstName, _, _, _),
inst_name_contains_unconstrained_var(SubInstName)
;
InstName = any_inst(SubInstName, _, _, _),
inst_name_contains_unconstrained_var(SubInstName)
;
InstName = shared_inst(SubInstName),
inst_name_contains_unconstrained_var(SubInstName)
;
InstName = mostly_uniq_inst(SubInstName),
inst_name_contains_unconstrained_var(SubInstName)
;
InstName = typed_inst(_, SubInstName),
inst_name_contains_unconstrained_var(SubInstName)
;
InstName = typed_ground(_, _),
fail
).
%---------------------------------------------------------------------------%
bound_inst_to_cons_id(TypeCtor, BoundInst, ConsId) :-
BoundInst = bound_functor(ConsId0, _ArgInsts),
( if ConsId0 = cons(SymName, Arity, _TypeCtor) then
ConsId = cons(SymName, Arity, TypeCtor)
else
ConsId = ConsId0
).
bound_insts_to_cons_ids(_, [], []).
bound_insts_to_cons_ids(TypeCtor, [BoundInst | BoundInsts],
[ConsId | ConsIds]) :-
bound_inst_to_cons_id(TypeCtor, BoundInst, ConsId),
bound_insts_to_cons_ids(TypeCtor, BoundInsts, ConsIds).
%---------------------------------------------------------------------------%
get_arg_insts(Inst, ConsId, Arity, ArgInsts) :-
% XXX This is very similar to get_single_arg_inst in mode_util.
% XXX Actually, it should be MORE similar; it does not handle
% some cases that get_single_arg_inst does.
require_complete_switch [Inst]
(
Inst = not_reached,
list.duplicate(Arity, not_reached, ArgInsts)
;
Inst = ground(Uniq, _PredInst),
list.duplicate(Arity, ground(Uniq, none_or_default_func), ArgInsts)
;
Inst = bound(_Uniq, _InstResults, BoundInsts),
( if get_arg_insts_2(BoundInsts, ConsId, ArgInsts0) then
ArgInsts = ArgInsts0
else
% The code is unreachable.
list.duplicate(Arity, not_reached, ArgInsts)
)
;
( Inst = free
; Inst = free(_)
),
list.duplicate(Arity, free, ArgInsts)
;
Inst = any(Uniq, _),
list.duplicate(Arity, any(Uniq, none_or_default_func), ArgInsts)
;
Inst = defined_inst(_),
% The documentation of this predicate says that it should be called
% only with insts that have already been expanded.
unexpected($pred, "defined_inst")
;
Inst = constrained_inst_vars(_Vars, SubInst),
get_arg_insts(SubInst, ConsId, Arity, ArgInsts)
;
( Inst = inst_var(_)
; Inst = abstract_inst(_, _)
),
% The compiler has no information about what function symbol
% the variable whose inst Inst represents is bound to, so it
% cannot have any information about the insts of its arguments.
fail
).
get_arg_insts_det(Inst, ConsId, Arity, ArgInsts) :-
( if get_arg_insts(Inst, ConsId, Arity, ArgInstsPrime) then
ArgInsts = ArgInstsPrime
else
unexpected($pred, "get_arg_insts failed")
).
:- pred get_arg_insts_2(list(bound_inst)::in, cons_id::in, list(mer_inst)::out)
is semidet.
get_arg_insts_2([BoundInst | BoundInsts], ConsId, ArgInsts) :-
( if
BoundInst = bound_functor(FunctorConsId, ArgInsts0),
equivalent_cons_ids(ConsId, FunctorConsId)
then
ArgInsts = ArgInsts0
else
get_arg_insts_2(BoundInsts, ConsId, ArgInsts)
).
% In case we later decide to change the representation of mode_ids.
mode_id_to_int(mode_id(_, X), X).
%---------------------------------------------------------------------------%
%
% The active part of this code is strip_builtin_qualifier_from_sym_name;
% the rest is basically just recursive traversals to get there.
%
strip_builtin_qualifiers_from_mode_list(Modes0, Modes) :-
list.map(strip_builtin_qualifiers_from_mode, Modes0, Modes).
:- pred strip_builtin_qualifiers_from_mode(mer_mode::in, mer_mode::out) is det.
strip_builtin_qualifiers_from_mode(Mode0, Mode) :-
(
Mode0 = from_to_mode(Initial0, Final0),
strip_builtin_qualifiers_from_inst(Initial0, Initial),
strip_builtin_qualifiers_from_inst(Final0, Final),
Mode = from_to_mode(Initial, Final)
;
Mode0 = user_defined_mode(SymName0, Insts0),
strip_builtin_qualifiers_from_inst_list(Insts0, Insts),
strip_builtin_qualifier_from_sym_name(SymName0, SymName),
Mode = user_defined_mode(SymName, Insts)
).
strip_builtin_qualifiers_from_inst_list(Insts0, Insts) :-
list.map(strip_builtin_qualifiers_from_inst, Insts0, Insts).
strip_builtin_qualifiers_from_inst(Inst0, Inst) :-
(
( Inst0 = inst_var(_)
; Inst0 = not_reached
; Inst0 = free
; Inst0 = free(_)
),
Inst = Inst0
;
Inst0 = constrained_inst_vars(Vars, SubInst0),
strip_builtin_qualifiers_from_inst(SubInst0, SubInst),
Inst = constrained_inst_vars(Vars, SubInst)
;
Inst0 = any(Uniq, HOInstInfo0),
strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo),
Inst = any(Uniq, HOInstInfo)
;
Inst0 = ground(Uniq, HOInstInfo0),
strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo),
Inst = ground(Uniq, HOInstInfo)
;
Inst0 = bound(Uniq, InstResults, BoundInsts0),
strip_builtin_qualifiers_from_bound_inst_list(BoundInsts0, BoundInsts),
Inst = bound(Uniq, InstResults, BoundInsts)
;
Inst0 = defined_inst(InstName0),
strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
Inst = defined_inst(InstName)
;
Inst0 = abstract_inst(Name0, Args0),
strip_builtin_qualifier_from_sym_name(Name0, Name),
strip_builtin_qualifiers_from_inst_list(Args0, Args),
Inst = abstract_inst(Name, Args)
).
:- pred strip_builtin_qualifiers_from_bound_inst_list(list(bound_inst)::in,
list(bound_inst)::out) is det.
strip_builtin_qualifiers_from_bound_inst_list(Insts0, Insts) :-
list.map(strip_builtin_qualifiers_from_bound_inst, Insts0, Insts).
:- pred strip_builtin_qualifiers_from_bound_inst(bound_inst::in,
bound_inst::out) is det.
strip_builtin_qualifiers_from_bound_inst(BoundInst0, BoundInst) :-
BoundInst0 = bound_functor(ConsId0, Insts0),
strip_builtin_qualifier_from_cons_id(ConsId0, ConsId),
list.map(strip_builtin_qualifiers_from_inst, Insts0, Insts),
BoundInst = bound_functor(ConsId, Insts).
:- pred strip_builtin_qualifiers_from_inst_name(inst_name::in, inst_name::out)
is det.
strip_builtin_qualifiers_from_inst_name(Inst0, Inst) :-
(
Inst0 = user_inst(SymName0, Insts0),
strip_builtin_qualifier_from_sym_name(SymName0, SymName),
strip_builtin_qualifiers_from_inst_list(Insts0, Insts),
Inst = user_inst(SymName, Insts)
;
Inst0 = unify_inst(Live, Real, InstA0, InstB0),
strip_builtin_qualifiers_from_inst(InstA0, InstA),
strip_builtin_qualifiers_from_inst(InstB0, InstB),
Inst = unify_inst(Live, Real, InstA, InstB)
;
Inst0 = merge_inst(InstA0, InstB0),
strip_builtin_qualifiers_from_inst(InstA0, InstA),
strip_builtin_qualifiers_from_inst(InstB0, InstB),
Inst = merge_inst(InstA, InstB)
;
Inst0 = ground_inst(InstName0, Uniq, Live, Real),
strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
Inst = ground_inst(InstName, Uniq, Live, Real)
;
Inst0 = any_inst(InstName0, Uniq, Live, Real),
strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
Inst = any_inst(InstName, Uniq, Live, Real)
;
Inst0 = shared_inst(InstName0),
strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
Inst = shared_inst(InstName)
;
Inst0 = mostly_uniq_inst(InstName0),
strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
Inst = mostly_uniq_inst(InstName)
;
Inst0 = typed_ground(_Uniq, _Type),
Inst = Inst0
;
Inst0 = typed_inst(Type, InstName0),
strip_builtin_qualifiers_from_inst_name(InstName0, InstName),
Inst = typed_inst(Type, InstName)
).
:- pred strip_builtin_qualifiers_from_ho_inst_info(ho_inst_info::in,
ho_inst_info::out) is det.
strip_builtin_qualifiers_from_ho_inst_info(HOInstInfo0, HOInstInfo) :-
(
HOInstInfo0 = none_or_default_func,
HOInstInfo = none_or_default_func
;
HOInstInfo0 = higher_order(Pred0),
Pred0 = pred_inst_info(PorF, Modes0, ArgRegs, Det),
strip_builtin_qualifiers_from_mode_list(Modes0, Modes),
Pred = pred_inst_info(PorF, Modes, ArgRegs, Det),
HOInstInfo = higher_order(Pred)
).
%---------------------------------------------------------------------------%
constrain_inst_vars_in_mode(Mode0, Mode) :-
constrain_inst_vars_in_mode_sub(map.init, Mode0, Mode).
constrain_inst_vars_in_mode_sub(InstConstraints, Mode0, Mode) :-
(
Mode0 = from_to_mode(I0, F0),
constrain_inst_vars_in_inst(InstConstraints, I0, I),
constrain_inst_vars_in_inst(InstConstraints, F0, F),
Mode = from_to_mode(I, F)
;
Mode0 = user_defined_mode(Name, Args0),
list.map(constrain_inst_vars_in_inst(InstConstraints), Args0, Args),
Mode = user_defined_mode(Name, Args)
).
:- pred constrain_inst_vars_in_inst(inst_var_sub::in,
mer_inst::in, mer_inst::out) is det.
constrain_inst_vars_in_inst(InstConstraints, Inst0, Inst) :-
(
( Inst0 = not_reached
; Inst0 = free
; Inst0 = free(_)
; Inst0 = ground(_Uniq, none_or_default_func)
; Inst0 = any(_Uniq, none_or_default_func)
),
Inst = Inst0
;
Inst0 = ground(Uniq, higher_order(PredInstInfo0)),
constrain_inst_vars_in_pred_inst_info(InstConstraints,
PredInstInfo0, PredInstInfo),
Inst = ground(Uniq, higher_order(PredInstInfo))
;
Inst0 = any(Uniq, higher_order(PredInstInfo0)),
constrain_inst_vars_in_pred_inst_info(InstConstraints,
PredInstInfo0, PredInstInfo),
Inst = any(Uniq, higher_order(PredInstInfo))
;
Inst0 = bound(Uniq, InstResults0, BoundInsts0),
(
InstResults0 = inst_test_results_fgtc,
% There are no inst_vars to substitute.
Inst = Inst0
;
InstResults0 = inst_test_results(_, _, _, InstVarsResult, _, _),
( if
InstVarsResult =
inst_result_contains_inst_vars_known(InstVarsSet),
set.to_sorted_list(InstVarsSet, InstVars),
no_inst_var_is_in_map(InstVars, InstConstraints)
then
Inst = Inst0
else
list.map(constrain_inst_vars_in_bound_inst(InstConstraints),
BoundInsts0, BoundInsts),
% The substitutions inside BoundInsts can invalidate
% any of the existing results.
% XXX can they?
Inst = bound(Uniq, inst_test_no_results, BoundInsts)
)
;
InstResults0 = inst_test_no_results,
list.map(constrain_inst_vars_in_bound_inst(InstConstraints),
BoundInsts0, BoundInsts),
% The substitutions inside BoundInsts can invalidate
% any of the existing results.
% XXX can they?
Inst = bound(Uniq, inst_test_no_results, BoundInsts)
)
;
Inst0 = constrained_inst_vars(Vars0, SubInst0),
constrain_inst_vars_in_inst(InstConstraints, SubInst0, SubInst1),
( if SubInst1 = constrained_inst_vars(SubVars, SubSubInst) then
set.union(Vars0, SubVars, Vars),
SubInst = SubSubInst
else
Vars = Vars0,
SubInst = SubInst1
),
Inst = constrained_inst_vars(Vars, SubInst)
;
Inst0 = inst_var(Var),
( if map.search(InstConstraints, Var, SubInstPrime) then
SubInst = SubInstPrime
else
SubInst = ground(shared, none_or_default_func)
),
Inst = constrained_inst_vars(set.make_singleton_set(Var), SubInst)
;
Inst0 = defined_inst(Name0),
constrain_inst_vars_in_inst_name(InstConstraints, Name0, Name),
Inst = defined_inst(Name)
;
Inst0 = abstract_inst(InstName, SubInsts0),
list.map(constrain_inst_vars_in_inst(InstConstraints),
SubInsts0, SubInsts),
Inst = abstract_inst(InstName, SubInsts)
).
:- pred constrain_inst_vars_in_bound_inst(inst_var_sub::in,
bound_inst::in, bound_inst::out) is det.
constrain_inst_vars_in_bound_inst(InstConstraints, BoundInst0, BoundInst) :-
BoundInst0 = bound_functor(ConsId, ArgInsts0),
list.map(constrain_inst_vars_in_inst(InstConstraints),
ArgInsts0, ArgInsts),
BoundInst = bound_functor(ConsId, ArgInsts).
:- pred constrain_inst_vars_in_pred_inst_info(inst_var_sub::in,
pred_inst_info::in, pred_inst_info::out) is det.
constrain_inst_vars_in_pred_inst_info(InstConstraints, PII0, PII) :-
PII0 = pred_inst_info(PredOrFunc, Modes0, MaybeArgRegs, Det),
list.map(constrain_inst_vars_in_mode_sub(InstConstraints), Modes0, Modes),
PII = pred_inst_info(PredOrFunc, Modes, MaybeArgRegs, Det).
:- pred constrain_inst_vars_in_inst_name(inst_var_sub::in,
inst_name::in, inst_name::out) is det.
constrain_inst_vars_in_inst_name(InstConstraints, Name0, Name) :-
( if Name0 = user_inst(SymName, Args0) then
list.map(constrain_inst_vars_in_inst(InstConstraints), Args0, Args),
Name = user_inst(SymName, Args)
else
Name = Name0
).
%---------------------------------------------------------------------------%
inconsistent_constrained_inst_vars_in_modes(Modes, InconsistentVars) :-
list.foldl2(gather_inconsistent_constrained_inst_vars_in_mode,
Modes, set.init, InconsistentVarsSet, map.init, _),
set.to_sorted_list(InconsistentVarsSet, InconsistentVars).
inconsistent_constrained_inst_vars_in_type_and_modes(TypeAndModes,
InconsistentVars) :-
list.foldl2(gather_inconsistent_constrained_inst_vars_in_type_and_mode,
TypeAndModes, set.init, InconsistentVarsSet, map.init, _),
set.to_sorted_list(InconsistentVarsSet, InconsistentVars).
report_inconsistent_constrained_inst_vars(WhereDesc, Context, InstVarSet,
InconsistentVars, MaybeSpec) :-
(
InconsistentVars = [],
MaybeSpec = no
;
InconsistentVars = [HeadInstVar | TailInstVars],
(
TailInstVars = [],
varset.lookup_name(InstVarSet, HeadInstVar, HeadInstVarName),
VarsPieces = [words("inst variable"), fixed(HeadInstVarName)]
;
TailInstVars = [_ | _],
list.map(varset.lookup_name(InstVarSet), InconsistentVars,
InstVarNames),
VarsPieces = [words("inst variables") |
list_to_pieces(InstVarNames)]
),
Pieces = [words("Error: inconsistent constraints on") | VarsPieces]
++ [words(WhereDesc), suffix("."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(Context, [always(Pieces)])]),
MaybeSpec = yes(Spec)
).
%---------------------%
:- pred gather_inconsistent_constrained_inst_vars_in_type_and_mode(
type_and_mode::in, set(inst_var)::in, set(inst_var)::out,
inst_var_sub::in, inst_var_sub::out) is det.
gather_inconsistent_constrained_inst_vars_in_type_and_mode(TypeAndMode,
!InconsistentVars, !Sub) :-
(
TypeAndMode = type_only(_)
;
TypeAndMode = type_and_mode(_, Mode),
gather_inconsistent_constrained_inst_vars_in_mode(Mode,
!InconsistentVars, !Sub)
).
:- pred gather_inconsistent_constrained_inst_vars_in_modes(list(mer_mode)::in,
set(inst_var)::in, set(inst_var)::out,
inst_var_sub::in, inst_var_sub::out) is det.
gather_inconsistent_constrained_inst_vars_in_modes(Modes,
!InconsistentVars, !Sub) :-
list.foldl2(gather_inconsistent_constrained_inst_vars_in_mode, Modes,
!InconsistentVars, !Sub).
:- pred gather_inconsistent_constrained_inst_vars_in_mode(mer_mode::in,
set(inst_var)::in, set(inst_var)::out,
inst_var_sub::in, inst_var_sub::out) is det.
gather_inconsistent_constrained_inst_vars_in_mode(Mode,
!InconsistentVars, !Sub) :-
(
Mode = from_to_mode(InitialInst, FinalInst),
gather_inconsistent_constrained_inst_vars_in_inst(InitialInst,
!InconsistentVars, !Sub),
gather_inconsistent_constrained_inst_vars_in_inst(FinalInst,
!InconsistentVars, !Sub)
;
Mode = user_defined_mode(_, ArgInsts),
gather_inconsistent_constrained_inst_vars_in_insts(ArgInsts,
!InconsistentVars, !Sub)
).
:- pred gather_inconsistent_constrained_inst_vars_in_insts(list(mer_inst)::in,
set(inst_var)::in, set(inst_var)::out,
inst_var_sub::in, inst_var_sub::out) is det.
gather_inconsistent_constrained_inst_vars_in_insts(Insts,
!InconsistentVars, !Sub) :-
list.foldl2(gather_inconsistent_constrained_inst_vars_in_inst, Insts,
!InconsistentVars, !Sub).
:- pred gather_inconsistent_constrained_inst_vars_in_inst(mer_inst::in,
set(inst_var)::in, set(inst_var)::out,
inst_var_sub::in, inst_var_sub::out) is det.
gather_inconsistent_constrained_inst_vars_in_inst(Inst,
!InconsistentVars, !Sub) :-
(
( Inst = free
; Inst = free(_)
; Inst = not_reached
)
;
Inst = bound(_, InstResults, BoundInsts),
(
InstResults = inst_test_results_fgtc
;
InstResults = inst_test_results(_, _, _, InstVarsResult, _, _),
( if
InstVarsResult =
inst_result_contains_inst_vars_known(InstVarsSet),
set.is_empty(InstVarsSet)
then
true
else
list.foldl2(
gather_inconsistent_constrained_inst_vars_in_bound_args,
BoundInsts, !InconsistentVars, !Sub)
)
;
InstResults = inst_test_no_results,
list.foldl2(
gather_inconsistent_constrained_inst_vars_in_bound_args,
BoundInsts, !InconsistentVars, !Sub)
)
;
( Inst = ground(_, HOInstInfo)
; Inst = any(_, HOInstInfo)
),
(
HOInstInfo = none_or_default_func
;
HOInstInfo = higher_order(pred_inst_info(_, Modes, _, _)),
gather_inconsistent_constrained_inst_vars_in_modes(Modes,
!InconsistentVars, !Sub)
)
;
Inst = inst_var(_),
unexpected($pred, "unconstrained inst_var")
;
Inst = defined_inst(InstName),
( if InstName = user_inst(_, ArgInsts) then
gather_inconsistent_constrained_inst_vars_in_insts(ArgInsts,
!InconsistentVars, !Sub)
else
true
)
;
Inst = abstract_inst(_, ArgInsts),
gather_inconsistent_constrained_inst_vars_in_insts(ArgInsts,
!InconsistentVars, !Sub)
;
Inst = constrained_inst_vars(InstVars, SubInst),
set.fold2(
gather_inconsistent_constrained_inst_vars_in_inst_var(SubInst),
InstVars, !InconsistentVars, !Sub),
gather_inconsistent_constrained_inst_vars_in_inst(SubInst,
!InconsistentVars, !Sub)
).
:- pred gather_inconsistent_constrained_inst_vars_in_bound_args(
bound_inst::in, set(inst_var)::in, set(inst_var)::out,
inst_var_sub::in, inst_var_sub::out) is det.
gather_inconsistent_constrained_inst_vars_in_bound_args(BoundInst,
!InconsistentVars, !Sub) :-
BoundInst = bound_functor(_, ArgInsts),
gather_inconsistent_constrained_inst_vars_in_insts(ArgInsts,
!InconsistentVars, !Sub).
:- pred gather_inconsistent_constrained_inst_vars_in_inst_var(mer_inst::in,
inst_var::in, set(inst_var)::in, set(inst_var)::out,
inst_var_sub::in, inst_var_sub::out) is det.
gather_inconsistent_constrained_inst_vars_in_inst_var(SubInst, InstVar,
!InconsistentVars, !Sub) :-
( if map.search(!.Sub, InstVar, InstVarInst) then
% Check that the inst_var constraint is consistent with
% the previous constraint on this inst_var.
( if InstVarInst = SubInst then
true
else
set.insert(InstVar, !InconsistentVars)
)
else
map.det_insert(InstVar, SubInst, !Sub)
).
%---------------------------------------------------------------------------%
:- end_module parse_tree.prog_mode.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink