Files
mercury/compiler/modecheck_call.m
Zoltan Somogyi c6ab550db8 Remove the code for automatic initialization of solver vars.
We haven't supported it in years, and keeping it in the compiler
is just a maintenance burden and a performance problem.

mdbcomp/prim_data.m:
    Delete the spec_pred_init functor, since we don't support special
    "init" predicates anymore.

compiler/prog_data.m:
    Delete the slot in solver type details that record the name of the
    auto-initialization predicate.

compiler/prog_io_type_defn.m:
    Don't allow a type definition to specify an auto-initialization predicate.

compiler/options.m:
compiler/globals.m:
    Delete the option that allowed support for auto-initialization to be
    turned back on.

compiler/inst_match.m:
compiler/inst_util.m:
    Delete comments about auto-initialization.

compiler/mode_info.m:
    Delete the record of whether we have variables that can be
    auto-initialized (we never do anymore) and the flag that controls whether
    auto-initialization is permitted or not.

compiler/modecheck_conj.m:
    Simplify the code that modechecks conjunctions, since it no longer
    has to figure out where to insert auto-initializations of solver vars.

compiler/modecheck_goal.m:
    Delete the code that ensured that if one branch of a branched
    control structure auto-initialized a solver variable, then they
    all did.

compiler/modecheck_unify.m:
    Don't auto-initializate variables before unifications.

compiler/modecheck_util.m:
    Delete the code that auto-initialized solver variables at the ends
    of procedure bodies if this needed to be done and wasn't done before.

compiler/add_special_pred.m:
compiler/equiv_type.m:
compiler/equiv_type_hlds.m:
compiler/get_dependencies.m:
compiler/hlds_module.m:
compiler/hlds_pred.m:
compiler/modecheck_call.m:
compiler/modes.m:
compiler/module_qual.qualify_items.m:
compiler/parse_tree_out.m:
compiler/post_term_analysis.m:
compiler/smm_common.m:
compiler/special_pred.m:
compiler/term_constr_errors.m:
compiler/term_constr_initial.m:
compiler/term_util.m:
compiler/termination.m:
compiler/trace_params.m:
compiler/type_util.m:
compiler/unify_proc.m:
    Delete code that handled stuff related to auto-initialization,
    and now always take the path that would normally be taken in the
    absence of auto-initialization.

deep_profiler/read_profile.m:
runtime/mercury_layout_util.c:
runtime/mercury_stack_trace.c:
util/mdemangle.c:
    Remove code that recognized the compiler-generated name of initialization
    predicates.

tests/debugger/solver_test.m:
tests/hard_coded/solver_construction_init_test.m:
tests/hard_coded/solver_disj_inits.m:
tests/hard_coded/solver_ite_inits.m:
tests/invalid/missing_init_pred.m:
tests/invalid/zinc2mer_lib.m:
tests/valid/fz_conf.m:
tests/valid/solver_type_bug_2.m:
tests/valid/solver_type_mutable_bug.m:
    These tests tested the handling of auto-initialization, which we
    no longer support. Keep them around (and a bit more visible than
    inside the git repo) in case we need them again, but add a comment
    to each saying that the test is disabled.

tests/debugger/Mercury.options:
tests/debugger/Mmakefile:
tests/hard_coded/Mercury.options:
tests/hard_coded/Mmakefile:
tests/invalid/Mercury.options:
tests/invalid/Mmakefile:
tests/valid/Mercury.options:
tests/valid/Mmakefile:
    Disable those tests.

tests/warnings/non_term_user_special.{m,exp}:
    Part of this test tested the handling of auto-initialization;
    delete that part.

tests/warnings/Mercury.options:
    Delete the flag required by the deleted part, since we don't support it
    anymore.
2015-12-03 05:06:28 +11:00

915 lines
37 KiB
Mathematica

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1996-2001, 2003-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: modecheck_call.m.
% Main author: fjh.
%
% This file contains the code to modecheck a call.
%
% Check that there is a mode declaration for the predicate which matches
% the current instantiation of the arguments. (Also handle calls to implied
% modes.) If the called predicate is one for which we must infer the modes,
% then a new mode for the called predicate whose initial insts are the result
% of normalising the current inst of the arguments.
%
%-----------------------------------------------------------------------------%
:- module check_hlds.modecheck_call.
:- interface.
:- import_module check_hlds.mode_info.
:- import_module check_hlds.modecheck_util.
:- import_module hlds.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.
:- import_module list.
:- import_module maybe.
%-----------------------------------------------------------------------------%
:- pred modecheck_call_pred(pred_id::in, maybe(determinism)::in,
proc_id::in, proc_id::out, list(prog_var)::in, list(prog_var)::out,
hlds_goal_info::in, extra_goals::out, mode_info::in, mode_info::out)
is det.
:- pred modecheck_higher_order_call(pred_or_func::in, prog_var::in,
list(prog_var)::in, list(prog_var)::out, list(mer_mode)::out,
determinism::out, extra_goals::out,
mode_info::in, mode_info::out) is det.
:- pred modecheck_event_call(list(mer_mode)::in,
list(prog_var)::in, list(prog_var)::out,
mode_info::in, mode_info::out) is det.
:- pred modecheck_builtin_cast(list(mer_mode)::in,
list(prog_var)::in, list(prog_var)::out, determinism::out,
extra_goals::out, mode_info::in, mode_info::out) is det.
% Given two modes of a predicate, figure out whether they are
% indistinguishable; that is, whether any valid call to one mode
% would also be a valid call to the other. (If so, it is a mode error.)
% Note that mode declarations which only have different final insts
% do not count as distinguishable.
%
:- pred modes_are_indistinguishable(proc_id::in, proc_id::in, pred_info::in,
module_info::in) is semidet.
% Given two modes of a predicate, figure out whether they are identical,
% except that one is cc_nondet/cc_multi and the other is nondet/multi.
% This is used by determinism analysis to substitute a multi mode
% for a cc_multi one if the call occurs in a non-cc context.
%
:- pred modes_are_identical_bar_cc(proc_id::in, proc_id::in, pred_info::in,
module_info::in) is semidet.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.inst_test.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_errors.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.unify_proc.
:- import_module hlds.instmap.
:- import_module hlds.vartypes.
:- import_module parse_tree.prog_detism.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.set_of_var.
:- import_module bool.
:- import_module map.
:- import_module require.
:- import_module term.
%-----------------------------------------------------------------------------%
modecheck_call_pred(PredId, DeterminismKnown, ProcId0, TheProcId,
ArgVars0, ArgVars, _GoalInfo, ExtraGoals, !ModeInfo) :-
mode_info_get_may_change_called_proc(!.ModeInfo, MayChangeCalledProc),
mode_info_get_preds(!.ModeInfo, Preds),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
map.lookup(Preds, PredId, PredInfo),
pred_info_get_proc_table(PredInfo, Procs),
(
MayChangeCalledProc = may_not_change_called_proc,
( if ProcId0 = invalid_proc_id then
unexpected($module, $pred, "invalid proc_id")
else
ProcIds = [ProcId0]
)
;
MayChangeCalledProc = may_change_called_proc,
% Get the list of different possible modes for the called predicate.
ProcIds = pred_info_all_procids(PredInfo)
),
compute_arg_offset(PredInfo, ArgOffset),
pred_info_get_markers(PredInfo, Markers),
mode_info_get_instmap(!.ModeInfo, InstMap),
( if
% In order to give better diagnostics, we handle the cases where there
% are zero or one modes for the called predicate specially.
%
ProcIds = [],
not check_marker(Markers, marker_infer_modes)
then
set_of_var.init(WaitingVars),
mode_info_error(WaitingVars, mode_error_no_mode_decl, !ModeInfo),
TheProcId = invalid_proc_id,
ArgVars = ArgVars0,
ExtraGoals = no_extra_goals
else if
ProcIds = [ProcId],
( not check_marker(Markers, marker_infer_modes)
; MayChangeCalledProc = may_not_change_called_proc
)
then
TheProcId = ProcId,
map.lookup(Procs, ProcId, ProcInfo),
% Check that `ArgsVars0' have livenesses which match the
% expected livenesses.
%
proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
modecheck_var_list_is_live_no_exact_match(ArgVars0, ProcArgLives0,
ArgOffset, !ModeInfo),
% Check that `ArgsVars0' have insts which match the expected
% initial insts, and set their new final insts (introducing
% extra unifications for implied modes, if necessary).
%
proc_info_get_argmodes(ProcInfo, ProcArgModes0),
proc_info_get_inst_varset(ProcInfo, ProcInstVarSet),
mode_info_get_instvarset(!.ModeInfo, InstVarSet0),
rename_apart_inst_vars(InstVarSet0, ProcInstVarSet, InstVarSet,
ProcArgModes0, ProcArgModes),
mode_info_set_instvarset(InstVarSet, !ModeInfo),
mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
modecheck_var_has_inst_list_no_exact_match(ArgVars0, InitialInsts,
ArgOffset, InstVarSub, !ModeInfo),
modecheck_end_of_call(ProcInfo, ProcArgModes, ArgVars0,
ArgOffset, InstVarSub, ArgVars, ExtraGoals, !ModeInfo)
else
% Set the current error list to empty (and save the old one in
% `OldErrors'). This is so the test for `Errors = []' in
% find_matching_modes will work.
mode_info_get_errors(!.ModeInfo, OldErrors),
mode_info_set_errors([], !ModeInfo),
set_of_var.init(WaitingVars0),
modecheck_find_matching_modes(ProcIds, PredId, Procs, ArgVars0,
[], RevMatchingProcIds, WaitingVars0, WaitingVars1, !ModeInfo),
(
RevMatchingProcIds = [],
no_matching_modes(PredId, ArgVars0, DeterminismKnown,
WaitingVars1, TheProcId, !ModeInfo),
ArgVars = ArgVars0,
ExtraGoals = no_extra_goals
;
RevMatchingProcIds = [_ | _],
list.reverse(RevMatchingProcIds, MatchingProcIds),
choose_best_match(!.ModeInfo, MatchingProcIds, PredId, Procs,
ArgVars0, TheProcId, InstVarSub, ProcArgModes),
map.lookup(Procs, TheProcId, ProcInfo),
proc_info_get_mode_errors(ProcInfo, CalleeModeErrors),
(
CalleeModeErrors = [_ | _],
% mode error in callee for this mode
ArgVars = ArgVars0,
WaitingVars = set_of_var.list_to_set(ArgVars),
ExtraGoals = no_extra_goals,
instmap_lookup_vars(InstMap, ArgVars, ArgInsts),
mode_info_set_call_arg_context(0, !ModeInfo),
mode_info_error(WaitingVars,
mode_error_in_callee(ArgVars, ArgInsts, PredId, TheProcId,
CalleeModeErrors),
!ModeInfo)
;
CalleeModeErrors = [],
modecheck_end_of_call(ProcInfo, ProcArgModes, ArgVars0,
ArgOffset, InstVarSub, ArgVars, ExtraGoals, !ModeInfo)
)
),
% Restore the error list, appending any new error(s).
mode_info_get_errors(!.ModeInfo, NewErrors),
list.append(OldErrors, NewErrors, Errors),
mode_info_set_errors(Errors, !ModeInfo)
).
modecheck_higher_order_call(PredOrFunc, PredVar, Args0, Args, Modes, Det,
ExtraGoals, !ModeInfo) :-
% First, check that `PredVar' has a higher-order pred inst
% (of the appropriate arity).
mode_info_get_instmap(!.ModeInfo, InstMap0),
instmap_lookup_var(InstMap0, PredVar, PredVarInst0),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
inst_expand(ModuleInfo0, PredVarInst0, PredVarInst),
list.length(Args0, Arity),
( if
(
PredVarInst = ground(_Uniq, HOInstInfo)
;
PredVarInst = any(_Uniq, HOInstInfo)
),
(
HOInstInfo = higher_order(PredInstInfo)
;
% If PredVar has no higher-order inst information, but is
% a function type, then assume the default function mode.
HOInstInfo = none_or_default_func,
mode_info_get_var_types(!.ModeInfo, VarTypes),
lookup_var_type(VarTypes, PredVar, Type),
type_is_higher_order_details(Type, _, pf_function, _, ArgTypes),
PredInstInfo = pred_inst_info_default_func_mode(
list.length(ArgTypes))
),
PredInstInfo = pred_inst_info(PredOrFunc, ModesPrime, _, DetPrime),
list.length(ModesPrime, Arity)
then
( if
% If PredVar is inst `any' then it gets bound. If it is locked,
% this is a mode error.
PredVarInst = any(A, B),
mode_info_var_is_locked(!.ModeInfo, PredVar, Reason)
then
BetterPredVarInst = ground(A, B),
WaitingVars = set_of_var.make_singleton(PredVar),
mode_info_error(WaitingVars, mode_error_bind_var(Reason, PredVar,
PredVarInst, BetterPredVarInst), !ModeInfo),
Modes = [],
Det = detism_erroneous,
Args = Args0,
ExtraGoals = no_extra_goals
else
Det = DetPrime,
Modes = ModesPrime,
ArgOffset = 1,
modecheck_arg_list(ArgOffset, Modes, ExtraGoals, Args0, Args,
!ModeInfo),
( if determinism_components(Det, _, at_most_zero) then
instmap.init_unreachable(Instmap),
mode_info_set_instmap(Instmap, !ModeInfo)
else
true
)
)
else
% The error occurred in argument 1, i.e. the pred term.
mode_info_set_call_arg_context(1, !ModeInfo),
WaitingVars = set_of_var.make_singleton(PredVar),
mode_info_error(WaitingVars,
mode_error_higher_order_pred_var(PredOrFunc, PredVar, PredVarInst,
Arity),
!ModeInfo),
Modes = [],
Det = detism_erroneous,
Args = Args0,
ExtraGoals = no_extra_goals
).
modecheck_event_call(Modes, Args0, Args, !ModeInfo) :-
ArgOffset = 0,
modecheck_arg_list(ArgOffset, Modes, ExtraGoals, Args0, Args, !ModeInfo),
expect(unify(ExtraGoals, no_extra_goals), $module, $pred,
"ExtraGoals").
modecheck_builtin_cast(Modes, Args0, Args, Det, ExtraGoals, !ModeInfo) :-
Det = detism_det,
% These should always be mode correct.
ArgOffset = 0,
modecheck_arg_list(ArgOffset, Modes, ExtraGoals, Args0, Args, !ModeInfo).
%-----------------------------------------------------------------------------%
:- pred modecheck_arg_list(int::in, list(mer_mode)::in, extra_goals::out,
list(prog_var)::in, list(prog_var)::out, mode_info::in, mode_info::out)
is det.
modecheck_arg_list(ArgOffset, Modes, ExtraGoals, Args0, Args, !ModeInfo) :-
% Check that `Args0' have livenesses which match the expected livenesses.
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
get_arg_lives(ModuleInfo0, Modes, ExpectedArgLives),
modecheck_var_list_is_live_no_exact_match(Args0, ExpectedArgLives,
ArgOffset, !ModeInfo),
% Check that `Args0' have insts which match the expected initial insts,
% and set their new final insts (introducing extra unifications for
% implied modes, if necessary).
mode_list_get_initial_insts(ModuleInfo0, Modes, InitialInsts),
modecheck_var_has_inst_list_no_exact_match(Args0, InitialInsts,
ArgOffset, InstVarSub, !ModeInfo),
mode_list_get_final_insts(ModuleInfo0, Modes, FinalInsts0),
inst_list_apply_substitution(InstVarSub, FinalInsts0, FinalInsts),
modecheck_set_var_inst_list(Args0, InitialInsts, FinalInsts,
ArgOffset, Args, ExtraGoals, !ModeInfo).
%--------------------------------------------------------------------------%
:- pred no_matching_modes(pred_id::in, list(prog_var)::in,
maybe(determinism)::in, set_of_progvar::in, proc_id::out,
mode_info::in, mode_info::out) is det.
no_matching_modes(PredId, ArgVars, DeterminismKnown, WaitingVars, TheProcId,
!ModeInfo) :-
% There were no matching modes.
% If we are inferring modes for this called predicate, then
% just insert a new mode declaration which will match.
% Otherwise, report an error.
mode_info_get_preds(!.ModeInfo, Preds),
map.lookup(Preds, PredId, PredInfo),
pred_info_get_markers(PredInfo, Markers),
( if check_marker(Markers, marker_infer_modes) then
insert_new_mode(PredId, ArgVars, DeterminismKnown, TheProcId,
!ModeInfo),
% We don't yet know the final insts for the newly created mode
% of the called predicate, so we set the instmap to unreachable,
% indicating that we have no information about the modes at this
% point in the computation.
instmap.init_unreachable(Instmap),
mode_info_set_instmap(Instmap, !ModeInfo)
else
TheProcId = invalid_proc_id, % dummy value
mode_info_get_instmap(!.ModeInfo, InstMap),
instmap_lookup_vars(InstMap, ArgVars, ArgInsts),
mode_info_set_call_arg_context(0, !ModeInfo),
mode_info_error(WaitingVars,
mode_error_no_matching_mode(ArgVars, ArgInsts), !ModeInfo)
).
:- type proc_mode
---> proc_mode(proc_id, inst_var_sub, list(mer_mode)).
:- pred modecheck_find_matching_modes(list(proc_id)::in, pred_id::in,
proc_table::in, list(prog_var)::in, list(proc_mode)::in,
list(proc_mode)::out, set_of_progvar::in, set_of_progvar::out,
mode_info::in, mode_info::out) is det.
modecheck_find_matching_modes([], _PredId, _Procs, _ArgVars,
!MatchingProcIds, !WaitingVars, !ModeInfo).
modecheck_find_matching_modes([ProcId | ProcIds], PredId, Procs, ArgVars0,
!MatchingProcIds, !WaitingVars, !ModeInfo) :-
% Find the initial insts and the final livenesses of the arguments
% for this mode of the called pred.
map.lookup(Procs, ProcId, ProcInfo),
proc_info_get_argmodes(ProcInfo, ProcArgModes0),
proc_info_get_inst_varset(ProcInfo, ProcInstVarSet),
mode_info_get_instvarset(!.ModeInfo, InstVarSet0),
rename_apart_inst_vars(InstVarSet0, ProcInstVarSet, InstVarSet,
ProcArgModes0, ProcArgModes),
mode_info_set_instvarset(InstVarSet, !ModeInfo),
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0),
% Check whether the livenesses of the args matches their expected liveness.
modecheck_var_list_is_live_no_exact_match(ArgVars0, ProcArgLives0, 0,
!ModeInfo),
% Check whether the insts of the args matches their expected initial insts.
%
% If we're doing mode inference for the called procedure, and the
% called procedure has been inferred as an invalid mode, then don't use
% it unless it is an exact match.
%
% XXX Do we really want mode inference to use implied modes?
% Would it be better to always require an exact match when doing mode
% inference, to ensure that we add new inferred modes rather than using
% implied modes?
mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
( if proc_info_is_valid_mode(ProcInfo) then
modecheck_var_has_inst_list_no_exact_match(ArgVars0, InitialInsts, 0,
InstVarSub, !ModeInfo)
else
modecheck_var_has_inst_list_exact_match(ArgVars0, InitialInsts, 0,
InstVarSub, !ModeInfo)
),
% If we got an error, reset the error list and save the list of vars
% to wait on. Otherwise, insert the proc_id in the list of matching
% proc_ids.
mode_info_get_errors(!.ModeInfo, Errors),
(
Errors = [FirstError | _],
mode_info_set_errors([], !ModeInfo),
FirstError = mode_error_info(ErrorWaitingVars, _, _, _),
set_of_var.union(ErrorWaitingVars, !WaitingVars)
;
Errors = [],
NewMatch = proc_mode(ProcId, InstVarSub, ProcArgModes),
!:MatchingProcIds = [NewMatch | !.MatchingProcIds]
),
% Keep trying with the other modes for the called pred.
modecheck_find_matching_modes(ProcIds, PredId, Procs, ArgVars0,
!MatchingProcIds, !WaitingVars, !ModeInfo).
:- pred modecheck_end_of_call(proc_info::in, list(mer_mode)::in,
list(prog_var)::in, int::in, inst_var_sub::in, list(prog_var)::out,
extra_goals::out, mode_info::in, mode_info::out) is det.
modecheck_end_of_call(ProcInfo, ProcArgModes, ArgVars0, ArgOffset,
InstVarSub, ArgVars, ExtraGoals, !ModeInfo) :-
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts0),
inst_list_apply_substitution(InstVarSub, InitialInsts0, InitialInsts),
mode_list_get_final_insts(ModuleInfo, ProcArgModes, FinalInsts0),
inst_list_apply_substitution(InstVarSub, FinalInsts0, FinalInsts),
modecheck_set_var_inst_list(ArgVars0, InitialInsts, FinalInsts,
ArgOffset, ArgVars, ExtraGoals, !ModeInfo),
proc_info_never_succeeds(ProcInfo, NeverSucceeds),
(
NeverSucceeds = yes,
instmap.init_unreachable(Instmap),
mode_info_set_instmap(Instmap, !ModeInfo)
;
NeverSucceeds = no
).
:- pred insert_new_mode(pred_id::in, list(prog_var)::in,
maybe(determinism)::in, proc_id::out,
mode_info::in, mode_info::out) is det.
% Insert a new inferred mode for a predicate.
% The initial insts are determined by using a normalised
% version of the call pattern (i.e. the insts of the arg vars).
% The final insts are initially just assumed to be all `not_reached'.
% The determinism for this mode will be inferred.
%
insert_new_mode(PredId, ArgVars, MaybeDet, ProcId, !ModeInfo) :-
% figure out the values of all the variables we need to
% create a new mode for this predicate
get_var_insts_and_lives(ArgVars, !.ModeInfo, InitialInsts, ArgLives),
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
module_info_get_preds(ModuleInfo0, Preds0),
map.lookup(Preds0, PredId, PredInfo0),
pred_info_get_context(PredInfo0, Context),
list.length(ArgVars, Arity),
list.duplicate(Arity, not_reached, FinalInsts),
inst_lists_to_mode_list(InitialInsts, FinalInsts, Modes),
mode_info_get_instvarset(!.ModeInfo, InstVarSet),
% Call unify_proc.request_proc, which will create the new procedure,
% set its "can-process" flag to `no', and insert it into the queue
% of requested procedures.
unify_proc.request_proc(PredId, Modes, InstVarSet, yes(ArgLives),
MaybeDet, Context, ProcId, ModuleInfo0, ModuleInfo),
mode_info_set_module_info(ModuleInfo, !ModeInfo),
% Since we've created a new inferred mode for this predicate,
% things have changed, so we will need to do at least one more
% pass of the fixpoint analysis.
mode_info_set_changed_flag(yes, !ModeInfo).
:- pred get_var_insts_and_lives(list(prog_var)::in, mode_info::in,
list(mer_inst)::out, list(is_live)::out) is det.
get_var_insts_and_lives([], _, [], []).
get_var_insts_and_lives([Var | Vars], ModeInfo,
[Inst | Insts], [IsLive | IsLives]) :-
mode_info_get_module_info(ModeInfo, ModuleInfo),
mode_info_get_instmap(ModeInfo, InstMap),
mode_info_get_var_types(ModeInfo, VarTypes),
instmap_lookup_var(InstMap, Var, Inst0),
lookup_var_type(VarTypes, Var, Type),
normalise_inst(ModuleInfo, Type, Inst0, Inst),
mode_info_var_is_live(ModeInfo, Var, IsLive0),
(
IsLive0 = is_live,
IsLive = is_live
;
IsLive0 = is_dead,
% To reduce the potentially exponential explosion in the number of
% modes, we only set IsLive to `dead' - meaning that the procedure
% requires its argument to be dead, so that it can do destructive
% update - if there really is a good chance of being able to do
% destructive update.
( if
inst_is_ground(ModuleInfo, Inst),
inst_is_mostly_unique(ModuleInfo, Inst)
then
IsLive = is_dead
else
IsLive = is_live
)
),
get_var_insts_and_lives(Vars, ModeInfo, Insts, IsLives).
%-----------------------------------------------------------------------------%
modes_are_indistinguishable(ProcId, OtherProcId, PredInfo, ModuleInfo) :-
% The code of this predicate is similar to the code for
% modes_are_identical/4 and compare_proc/5 below.
%
pred_info_get_proc_table(PredInfo, Procs),
map.lookup(Procs, ProcId, ProcInfo),
map.lookup(Procs, OtherProcId, OtherProcInfo),
% Compare the initial insts of the arguments.
proc_info_get_argmodes(ProcInfo, ProcArgModes),
proc_info_get_argmodes(OtherProcInfo, OtherProcArgModes),
mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
mode_list_get_initial_insts(ModuleInfo, OtherProcArgModes,
OtherInitialInsts),
pred_info_get_arg_types(PredInfo, ArgTypes),
compare_inst_list(ModuleInfo, InitialInsts, OtherInitialInsts, no,
ArgTypes, CompareInsts),
CompareInsts = same,
% Compare the expected livenesses of the arguments.
get_arg_lives(ModuleInfo, ProcArgModes, ProcArgLives),
get_arg_lives(ModuleInfo, OtherProcArgModes, OtherProcArgLives),
compare_liveness_list(ProcArgLives, OtherProcArgLives, CompareLives),
CompareLives = same,
% Compare the determinisms; if both are cc_, or if both are not cc_,
% then they are indistinguishable.
proc_info_interface_determinism(ProcInfo, Detism),
proc_info_interface_determinism(OtherProcInfo, OtherDetism),
determinism_components(Detism, _CanFail, Solns),
determinism_components(OtherDetism, _OtherCanFail, OtherSolns),
( Solns = at_most_many_cc, OtherSolns = at_most_many_cc
; Solns \= at_most_many_cc, OtherSolns \= at_most_many_cc
).
%-----------------------------------------------------------------------------%
modes_are_identical_bar_cc(ProcId, OtherProcId, PredInfo, ModuleInfo) :-
% The code of this predicate is similar to the code for
% compare_proc/5 below and modes_are_indistinguishable/4 above.
pred_info_get_proc_table(PredInfo, Procs),
map.lookup(Procs, ProcId, ProcInfo),
map.lookup(Procs, OtherProcId, OtherProcInfo),
% Compare the initial insts of the arguments
proc_info_get_argmodes(ProcInfo, ProcArgModes),
proc_info_get_argmodes(OtherProcInfo, OtherProcArgModes),
mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
mode_list_get_initial_insts(ModuleInfo, OtherProcArgModes,
OtherInitialInsts),
pred_info_get_arg_types(PredInfo, ArgTypes),
compare_inst_list(ModuleInfo, InitialInsts, OtherInitialInsts, no,
ArgTypes, CompareInitialInsts),
CompareInitialInsts = same,
% Compare the final insts of the arguments
mode_list_get_final_insts(ModuleInfo, ProcArgModes, FinalInsts),
mode_list_get_final_insts(ModuleInfo, OtherProcArgModes,
OtherFinalInsts),
compare_inst_list(ModuleInfo, FinalInsts, OtherFinalInsts, no,
ArgTypes, CompareFinalInsts),
CompareFinalInsts = same,
% Compare the expected livenesses of the arguments
get_arg_lives(ModuleInfo, ProcArgModes, ProcArgLives),
get_arg_lives(ModuleInfo, OtherProcArgModes, OtherProcArgLives),
compare_liveness_list(ProcArgLives, OtherProcArgLives, CompareLives),
CompareLives = same,
% Compare the determinisms, ignoring the cc part.
proc_info_interface_determinism(ProcInfo, Detism),
proc_info_interface_determinism(OtherProcInfo, OtherDetism),
determinism_components(Detism, CanFail, Solns),
determinism_components(OtherDetism, OtherCanFail, OtherSolns),
CanFail = OtherCanFail,
( Solns = OtherSolns
; Solns = at_most_many_cc, OtherSolns = at_most_many
; Solns = at_most_many, OtherSolns = at_most_many_cc
).
%-----------------------------------------------------------------------------%
% The algorithm for choose_best_match is supposed to be equivalent
% to the following specification:
%
% 1. Remove any modes that are strictly less instantiated or
% less informative on input than other valid modes; e.g we prefer
% an (in, in, out) mode over an (out, in, out) mode, but not necessarily
% over an (out, out, in) mode, and prefer a (ground -> ...) mode
% over a (any -> ...) mode, and prefer a (bound(f) -> ...) mode
% over a (ground -> ...) mode, and prefer a (... -> dead) mode
% over a (... -> not dead) mode.
%
% Also prefer a (any -> ...) mode over a (free -> ...) mode,
% unless the actual argument is free, in which case prefer
% the (free -> ...) mode.
%
% 2. If neither is prefered over the other by step 1, then prioritize them
% by determinism, according to the standard partial order (best first):
%
% erroneous
% / \
% det failure
% / \ /
% multi semidet
% \ /
% nondet
%
% 3. If there are still multiple possibilities, take them in
% declaration order.
:- type match
---> better
; worse
; same
; incomparable.
:- pred choose_best_match(mode_info::in, list(proc_mode)::in, pred_id::in,
proc_table::in, list(prog_var)::in, proc_id::out, inst_var_sub::out,
list(mer_mode)::out) is det.
choose_best_match(_, [], _, _, _, _, _, _) :-
unexpected($module, $pred, "no best match").
choose_best_match(ModeInfo,
[proc_mode(ProcId, InstVarSub, ArgModes) | ProcIds], PredId,
Procs, ArgVars, TheProcId, TheInstVarSub, TheArgModes) :-
% This ProcId is best iff there is no other proc_id which is better.
( if
some [OtherProcId] (
list.member(proc_mode(OtherProcId, _, _), ProcIds),
compare_proc(ModeInfo, OtherProcId, ProcId, ArgVars, Procs, better)
)
then
choose_best_match(ModeInfo, ProcIds, PredId, Procs, ArgVars,
TheProcId, TheInstVarSub, TheArgModes)
else
TheProcId = ProcId,
TheInstVarSub = InstVarSub,
TheArgModes = ArgModes
).
% Given two modes of a predicate, figure out whether one of them is a
% better match than the other, for calls which could match either mode.
%
:- pred compare_proc(mode_info::in, proc_id::in, proc_id::in,
list(prog_var)::in, proc_table::in, match::out) is det.
compare_proc(ModeInfo, ProcId, OtherProcId, ArgVars, Procs, Compare) :-
% The code of this predicate is similar to the code for
% modes_are_indistinguishable/4 and modes_are_identical_bar_cc/4 above.
map.lookup(Procs, ProcId, ProcInfo),
map.lookup(Procs, OtherProcId, OtherProcInfo),
% Compare the initial insts of the arguments.
proc_info_get_argmodes(ProcInfo, ProcArgModes),
proc_info_get_argmodes(OtherProcInfo, OtherProcArgModes),
mode_info_get_module_info(ModeInfo, ModuleInfo),
mode_info_get_var_types(ModeInfo, VarTypes),
lookup_var_types(VarTypes, ArgVars, ArgTypes),
mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
mode_list_get_initial_insts(ModuleInfo, OtherProcArgModes,
OtherInitialInsts),
get_var_insts_and_lives(ArgVars, ModeInfo, ArgInitialInsts, _ArgLives),
compare_inst_list(ModuleInfo, InitialInsts, OtherInitialInsts,
yes(ArgInitialInsts), ArgTypes, CompareInsts),
% Compare the expected livenesses of the arguments.
get_arg_lives(ModuleInfo, ProcArgModes, ProcArgLives),
get_arg_lives(ModuleInfo, OtherProcArgModes, OtherProcArgLives),
compare_liveness_list(ProcArgLives, OtherProcArgLives, CompareLives),
% Compare the determinisms.
proc_info_interface_determinism(ProcInfo, Detism),
proc_info_interface_determinism(OtherProcInfo, OtherDetism),
determinism_components(Detism, CanFail, SolnCount),
determinism_components(OtherDetism, OtherCanFail, OtherSolnCount),
compare_solncounts(SolnCount, OtherSolnCount, CompareSolnCounts),
(
CompareSolnCounts = first_tighter_than,
CompareDet = better
;
CompareSolnCounts = first_same_as,
compare_canfails(CanFail, OtherCanFail, CompareCanFails),
(
CompareCanFails = first_tighter_than,
CompareDet = better
;
CompareCanFails = first_same_as,
CompareDet = same
;
CompareCanFails = first_looser_than,
CompareDet = worse
)
;
CompareSolnCounts = first_looser_than,
CompareDet = worse
),
% Combine the results, with the insts & lives comparisons
% taking priority over the determinism comparison.
combine_results(CompareInsts, CompareLives, Compare0),
prioritized_combine_results(Compare0, CompareDet, Compare).
:- pred compare_inst_list(module_info::in,
list(mer_inst)::in, list(mer_inst)::in,
maybe(list(mer_inst))::in, list(mer_type)::in, match::out) is det.
compare_inst_list(ModuleInfo, InstsA, InstsB, ArgInsts, Types, Result) :-
( if
compare_inst_list_2(ModuleInfo, InstsA, InstsB, ArgInsts,
Types, Result0)
then
Result = Result0
else
unexpected($module, $pred, "length mismatch")
).
:- pred compare_inst_list_2(module_info::in,
list(mer_inst)::in, list(mer_inst)::in,
maybe(list(mer_inst))::in, list(mer_type)::in, match::out) is semidet.
compare_inst_list_2(_, [], [], _, [], same).
compare_inst_list_2(ModuleInfo, [InstA | InstsA], [InstB | InstsB],
no, [Type | Types], Result) :-
compare_inst(ModuleInfo, InstA, InstB, no, Type, Result0),
compare_inst_list_2(ModuleInfo, InstsA, InstsB, no, Types, Result1),
combine_results(Result0, Result1, Result).
compare_inst_list_2(ModuleInfo, [InstA | InstsA], [InstB | InstsB],
yes([ArgInst | ArgInsts]), [Type | Types], Result) :-
compare_inst(ModuleInfo, InstA, InstB, yes(ArgInst), Type, Result0),
compare_inst_list_2(ModuleInfo, InstsA, InstsB, yes(ArgInsts), Types,
Result1),
combine_results(Result0, Result1, Result).
:- pred compare_liveness_list(list(is_live)::in, list(is_live)::in, match::out)
is det.
compare_liveness_list([], [], same).
compare_liveness_list([_ | _], [], _) :-
unexpected($module, $pred, "length mismatch").
compare_liveness_list([], [_ | _], _) :-
unexpected($module, $pred, "length mismatch").
compare_liveness_list([LiveA | LiveAs], [LiveB | LiveBs], Result) :-
compare_liveness(LiveA, LiveB, Result0),
compare_liveness_list(LiveAs, LiveBs, Result1),
combine_results(Result0, Result1, Result).
% Compare_liveness -- prefer dead to live. If either is a valid match,
% then the actual argument must be dead, so prefer the mode which can take
% advantage of that).
%
:- pred compare_liveness(is_live::in, is_live::in, match::out) is det.
compare_liveness(is_dead, is_dead, same).
compare_liveness(is_dead, is_live, better).
compare_liveness(is_live, is_dead, worse).
compare_liveness(is_live, is_live, same).
% Combine two results, giving priority to the first one.
%
:- pred prioritized_combine_results(match::in, match::in, match::out) is det.
prioritized_combine_results(better, _, better).
prioritized_combine_results(worse, _, worse).
prioritized_combine_results(same, Result, Result).
prioritized_combine_results(incomparable, _, incomparable).
% Combine two results, giving them equal priority.
%
:- pred combine_results(match::in, match::in, match::out) is det.
combine_results(better, better, better).
combine_results(better, same, better).
combine_results(better, worse, incomparable).
combine_results(better, incomparable, incomparable).
combine_results(worse, worse, worse).
combine_results(worse, same, worse).
combine_results(worse, better, incomparable).
combine_results(worse, incomparable, incomparable).
combine_results(same, Result, Result).
combine_results(incomparable, _, incomparable).
% Compare two initial insts, to figure out which would be a better match.
%
% More information is better:
% prefer bound(f) to ground
% prefer unique to mostly_unique or ground, and
% prefer mostly_unique to ground
% (unique > mostly_unique > shared > mostly_dead > dead)
% More bound is better:
% (if both can match, the one which is more bound
% is better, because it may be an exact match, whereas
% the other one would be an implied mode)
% prefer ground to free (i.e. prefer in to out)
% prefer ground to any (e.g. prefer in to in(any))
% prefer any to free (e.g. prefer any->ground to out)
%
:- pred compare_inst(module_info::in, mer_inst::in, mer_inst::in,
maybe(mer_inst)::in, mer_type::in, match::out) is det.
compare_inst(ModuleInfo, InstA, InstB, MaybeArgInst, Type, Result) :-
% inst_matches_initial(A,B) succeeds iff
% A specifies at least as much information
% and at least as much binding as B --
% with the exception that `any' matches_initial `free'
% and perhaps vice versa.
( if inst_matches_initial(InstA, InstB, Type, ModuleInfo) then
A_mi_B = yes
else
A_mi_B = no
),
( if inst_matches_initial(InstB, InstA, Type, ModuleInfo) then
B_mi_A = yes
else
B_mi_A = no
),
( A_mi_B = yes, B_mi_A = no, Result = better
; A_mi_B = no, B_mi_A = yes, Result = worse
; A_mi_B = no, B_mi_A = no, Result = incomparable
; A_mi_B = yes, B_mi_A = yes,
% We need to further disambiguate the cases involving `any' and `free',
% since `any' matches_initial `free' and vice versa.
% For these cases, we want to take the actual inst of the argument
% into account: if the argument is `free', we should prefer `free',
% but otherwise, we should prefer `any'.
%
(
MaybeArgInst = no,
Result0 = same
;
MaybeArgInst = yes(ArgInst),
( if
inst_matches_initial_no_implied_modes(ArgInst,
InstA, Type, ModuleInfo)
then
Arg_mf_A = yes
else
Arg_mf_A = no
),
( if
inst_matches_initial_no_implied_modes(ArgInst,
InstB, Type, ModuleInfo)
then
Arg_mf_B = yes
else
Arg_mf_B = no
),
( Arg_mf_A = yes, Arg_mf_B = no, Result0 = better
; Arg_mf_A = no, Arg_mf_B = yes, Result0 = worse
; Arg_mf_A = yes, Arg_mf_B = yes, Result0 = same
; Arg_mf_A = no, Arg_mf_B = no, Result0 = same
)
),
(
Result0 = same,
% If the actual arg inst is not available, or comparing with
% the arg inst doesn't help, then compare the two proc insts.
( if
inst_matches_initial_no_implied_modes(InstA,
InstB, Type, ModuleInfo)
then
A_mf_B = yes
else
A_mf_B = no
),
( if
inst_matches_initial_no_implied_modes(InstB,
InstA, Type, ModuleInfo)
then
B_mf_A = yes
else
B_mf_A = no
),
( A_mf_B = yes, B_mf_A = no, Result = better
; A_mf_B = no, B_mf_A = yes, Result = worse
; A_mf_B = no, B_mf_A = no, Result = incomparable
; A_mf_B = yes, B_mf_A = yes, Result = same
)
;
( Result0 = better
; Result0 = worse
),
Result = Result0
)
).
%-----------------------------------------------------------------------------%
:- end_module check_hlds.modecheck_call.
%-----------------------------------------------------------------------------%