mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 09:23:44 +00:00
d8a31e574e
compiler/inst_lookup.m:
compiler/inst_mode_type_prop.m:
compiler/inst_test.m:
compiler/inst_util.m:
compiler/mode_util.m:
compiler/type_util.m:
Move these modules from the check_hlds package to the hlds package.
The reason is that all the content of five of these modules, and
most of the content of one module (inst_util.m) is not used
exclusively during semantic checking passes. (A later diff
should deal with the exception.) Some are used by the pass that
builds the initial HLDS, and all are used by middle-end and backend
passes. The move therefore reduces the number of inappropriate imports
of the check_hlds package.
compiler/check_hlds.m:
compiler/hlds.m:
Effect the transfer.
compiler/*.m:
Conform to the changes above.
616 lines
26 KiB
Mathematica
616 lines
26 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1996-2001, 2003-2012 The University of Melbourne.
|
|
% Copyright (C) 2015, 2024-2025 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_pred.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred modecheck_plain_or_foreign_call(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.
|
|
|
|
:- inst generic_call_higher_order for generic_call/0
|
|
---> higher_order(ground, ground, ground, ground, ground).
|
|
|
|
:- pred modecheck_higher_order_call(
|
|
generic_call::in(generic_call_higher_order),
|
|
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.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.mode_comparison.
|
|
:- import_module check_hlds.mode_errors.
|
|
:- import_module check_hlds.proc_requests.
|
|
:- import_module hlds.hlds_markers.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_proc_util.
|
|
:- import_module hlds.inst_lookup.
|
|
:- import_module hlds.inst_test.
|
|
:- import_module hlds.inst_util.
|
|
:- import_module hlds.instmap.
|
|
:- import_module hlds.mode_util.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.prim_data.
|
|
:- import_module parse_tree.prog_mode.
|
|
:- import_module parse_tree.prog_type_test.
|
|
:- import_module parse_tree.prog_util.
|
|
:- import_module parse_tree.set_of_var.
|
|
:- import_module parse_tree.var_table.
|
|
|
|
:- import_module bool.
|
|
:- import_module map.
|
|
:- import_module require.
|
|
:- import_module term.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
modecheck_plain_or_foreign_call(PredId, MaybeDetism, ProcId0, SelectedProcId,
|
|
ArgVars0, ArgVars, _GoalInfo, ExtraGoals, !ModeInfo) :-
|
|
mode_info_get_may_change_called_proc(!.ModeInfo, MayChangeCalledProc),
|
|
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_proc_table(PredInfo, ProcTable),
|
|
(
|
|
MayChangeCalledProc = may_not_change_called_proc,
|
|
( if ProcId0 = invalid_proc_id then
|
|
unexpected($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)
|
|
),
|
|
|
|
ArgOffset = compute_pred_modecheck_arg_offset(PredInfo),
|
|
pred_info_get_markers(PredInfo, Markers),
|
|
mode_info_get_instmap(!.ModeInfo, InstMap),
|
|
% In order to give better diagnostics, we handle the cases where there
|
|
% are zero or one modes for the called predicate specially.
|
|
% XXX Then we should have a switch on ProcIds.
|
|
( if
|
|
ProcIds = [],
|
|
not marker_is_present(Markers, marker_infer_modes)
|
|
then
|
|
set_of_var.init(WaitingVars),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
expect(unify(PredOrFunc, pf_predicate), $pred,
|
|
"function with no mode, not even the default"),
|
|
ModeError = mode_error_callee_pred_has_no_mode_decl(PredId),
|
|
mode_info_error(WaitingVars, ModeError, !ModeInfo),
|
|
SelectedProcId = invalid_proc_id,
|
|
ArgVars = ArgVars0,
|
|
ExtraGoals = no_extra_goals
|
|
else if
|
|
ProcIds = [ProcId],
|
|
( not marker_is_present(Markers, marker_infer_modes)
|
|
; MayChangeCalledProc = may_not_change_called_proc
|
|
)
|
|
then
|
|
SelectedProcId = ProcId,
|
|
map.lookup(ProcTable, ProcId, ProcInfo),
|
|
|
|
% Check that `ArgsVars0' have livenesses which match the
|
|
% expected livenesses.
|
|
proc_info_arglives(ModuleInfo, ProcInfo, ProcArgLives0),
|
|
modecheck_vars_are_live_no_exact_match(ArgOffset,
|
|
ArgVars0, ProcArgLives0, !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),
|
|
MatchWhat = match_plain_call(PredId),
|
|
modecheck_vars_have_insts_no_exact_match(MatchWhat, ArgOffset,
|
|
ArgVars0, InitialInsts, InstVarSub, _BoundInstVars, !ModeInfo),
|
|
|
|
modecheck_end_of_call(ProcInfo, ArgOffset, ProcArgModes, ArgVars0,
|
|
InstVarSub, ArgVars, ExtraGoals, !ModeInfo)
|
|
else
|
|
% We save and restore the error list in order to allow
|
|
% modecheck_find_matching_modes to use that field of !ModeInfo
|
|
% for its own purposes.
|
|
mode_info_get_errors(!.ModeInfo, OldErrors),
|
|
set_of_var.init(WaitingVars0),
|
|
modecheck_find_matching_modes(PredId, ProcTable, ArgOffset,
|
|
ArgVars0, ProcIds, [], RevMatchingProcModes, [], RevMismatches,
|
|
WaitingVars0, WaitingVars1, !ModeInfo),
|
|
mode_info_set_errors(OldErrors, !ModeInfo),
|
|
(
|
|
RevMatchingProcModes = [],
|
|
list.reverse(RevMismatches, Mismatches),
|
|
no_matching_modes(PredId, ArgVars0, Mismatches,
|
|
MaybeDetism, WaitingVars1, SelectedProcId, !ModeInfo),
|
|
ArgVars = ArgVars0,
|
|
ExtraGoals = no_extra_goals
|
|
;
|
|
RevMatchingProcModes = [_ | _],
|
|
list.reverse(RevMatchingProcModes, MatchingProcModes),
|
|
choose_best_match(!.ModeInfo, MatchingProcModes, PredId, ProcTable,
|
|
ArgVars0, SelectedProcId, InstVarSub, ProcArgModes),
|
|
map.lookup(ProcTable, SelectedProcId, ProcInfo),
|
|
look_up_proc_mode_errors(!.ModeInfo, PredId, SelectedProcId,
|
|
CalleeModeErrors),
|
|
(
|
|
CalleeModeErrors = [],
|
|
modecheck_end_of_call(ProcInfo, ArgOffset,
|
|
ProcArgModes, ArgVars0, InstVarSub, ArgVars,
|
|
ExtraGoals, !ModeInfo)
|
|
;
|
|
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),
|
|
ModeError = mode_error_in_callee(ArgVars, ArgInsts,
|
|
PredId, SelectedProcId, CalleeModeErrors),
|
|
mode_info_error(WaitingVars, ModeError, !ModeInfo)
|
|
)
|
|
)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred modecheck_find_matching_modes(pred_id::in, proc_table::in,
|
|
modecheck_arg_offset::in, list(prog_var)::in, list(proc_id)::in,
|
|
list(proc_mode)::in, list(proc_mode)::out,
|
|
list(mode_mismatch)::in, list(mode_mismatch)::out,
|
|
set_of_progvar::in, set_of_progvar::out,
|
|
mode_info::in, mode_info::out) is det.
|
|
|
|
modecheck_find_matching_modes(_PredId, _ProcTable, _ArgOffset, _ArgVars,
|
|
[], !RevMatchingProcModes, !RevMismatches, !WaitingVars, !ModeInfo).
|
|
modecheck_find_matching_modes(PredId, ProcTable, ArgOffset, ArgVars0,
|
|
[ProcId | ProcIds], !RevMatchingProcModes, !RevMismatches,
|
|
!WaitingVars, !ModeInfo) :-
|
|
% Clear the errors field of !ModeInfo so that we can check below
|
|
% whether this procedure is a match. Our caller has already saved
|
|
% the old contents of this field.
|
|
mode_info_set_errors([], !ModeInfo),
|
|
|
|
% Find the initial insts and the final livenesses of the arguments
|
|
% for this mode of the called pred.
|
|
map.lookup(ProcTable, 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),
|
|
% This adds the renamed-apart inst variables from the ProcInstVarSet of
|
|
% the callee *permanently* to the inst_varset of the current procedure,
|
|
% the caller.
|
|
mode_info_set_instvarset(InstVarSet, !ModeInfo),
|
|
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
|
|
proc_info_arglives(ModuleInfo, ProcInfo, ProcArgLives0),
|
|
|
|
% Check whether the livenesses of the args matches their expected liveness.
|
|
modecheck_vars_are_live_no_exact_match(ArgOffset, ArgVars0, ProcArgLives0,
|
|
!ModeInfo),
|
|
|
|
MatchWhat = match_plain_call(PredId),
|
|
mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
|
|
% Check whether the insts of the args matches their expected initial insts.
|
|
%
|
|
% If we are 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?
|
|
look_up_proc_mode_errors(!.ModeInfo, PredId, ProcId, ProcModeErrors),
|
|
(
|
|
ProcModeErrors = [],
|
|
ExactOrNot = eon_not_exact,
|
|
modecheck_vars_have_insts_no_exact_match(MatchWhat, ArgOffset,
|
|
ArgVars0, InitialInsts, InstVarSub, BoundInstVars, !ModeInfo)
|
|
;
|
|
ProcModeErrors = [_ | _],
|
|
ExactOrNot = eon_exact,
|
|
modecheck_vars_have_insts_exact_match(MatchWhat, ArgOffset,
|
|
ArgVars0, InitialInsts, InstVarSub, BoundInstVars, !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.
|
|
% XXX Should we include Errors in mo Mismatch?
|
|
mode_info_get_errors(!.ModeInfo, Errors),
|
|
(
|
|
Errors = [FirstError | _],
|
|
% NOTE The waiting vars and mismatches we collect here are used ONLY
|
|
% if we find no matching modes.
|
|
FirstError = mode_error_info(ErrorWaitingVars, _, _, _),
|
|
set_of_var.union(ErrorWaitingVars, !WaitingVars),
|
|
Mismatch = mode_mismatch(ExactOrNot, InitialInsts, BoundInstVars),
|
|
!:RevMismatches = [Mismatch | !.RevMismatches]
|
|
;
|
|
Errors = [],
|
|
NewMatchingProcMode = proc_mode(ProcId, InstVarSub, ProcArgModes),
|
|
!:RevMatchingProcModes = [NewMatchingProcMode | !.RevMatchingProcModes]
|
|
),
|
|
|
|
% Keep trying with the other modes for the called pred.
|
|
modecheck_find_matching_modes(PredId, ProcTable, ArgOffset,
|
|
ArgVars0, ProcIds, !RevMatchingProcModes, !RevMismatches,
|
|
!WaitingVars, !ModeInfo).
|
|
|
|
%---------------------%
|
|
|
|
:- pred no_matching_modes(pred_id::in, list(prog_var)::in,
|
|
list(mode_mismatch)::in, maybe(determinism)::in, set_of_progvar::in,
|
|
proc_id::out, mode_info::in, mode_info::out) is det.
|
|
|
|
no_matching_modes(PredId, ArgVars, Mismatches, MaybeDetism, WaitingVars,
|
|
NewProcId, !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_pred_id_table(!.ModeInfo, PredIdTable),
|
|
map.lookup(PredIdTable, PredId, PredInfo),
|
|
pred_info_get_markers(PredInfo, Markers),
|
|
( if marker_is_present(Markers, marker_infer_modes) then
|
|
insert_new_mode(PredId, ArgVars, MaybeDetism, NewProcId, !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
|
|
NewProcId = invalid_proc_id, % dummy value
|
|
mode_info_get_instmap(!.ModeInfo, InstMap),
|
|
mode_info_set_call_arg_context(0, !ModeInfo),
|
|
list.det_head_tail(Mismatches, HeadMismatch, TailMismatches),
|
|
MatchWhat = match_plain_call(PredId),
|
|
ModeError = mode_error_no_matching_mode(MatchWhat, InstMap, ArgVars,
|
|
HeadMismatch, TailMismatches),
|
|
mode_info_error(WaitingVars, ModeError, !ModeInfo)
|
|
).
|
|
|
|
% 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.
|
|
%
|
|
:- 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_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(!.ModeInfo, ArgVars, InitialInsts, ArgLives),
|
|
mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
|
|
module_info_pred_info(ModuleInfo0, 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 request_proc, which will create the new procedure,
|
|
% set its "can-process" flag to `no', and insert it into the queue
|
|
% of requested procedures.
|
|
request_proc(PredId, Modes, InstVarSet, yes(ArgLives), MaybeDet, Context,
|
|
ProcId, ModuleInfo0, ModuleInfo),
|
|
mode_info_set_module_info(ModuleInfo, !ModeInfo),
|
|
|
|
% Since we have 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(mode_info::in, list(prog_var)::in,
|
|
list(mer_inst)::out, list(is_live)::out) is det.
|
|
|
|
get_var_insts_and_lives(_, [], [], []).
|
|
get_var_insts_and_lives(ModeInfo, [Var | Vars],
|
|
[Inst | Insts], [IsLive | IsLives]) :-
|
|
get_var_inst(ModeInfo, Var, Inst),
|
|
mode_info_var_is_live(ModeInfo, Var, IsLive0),
|
|
mode_info_get_module_info(ModeInfo, ModuleInfo),
|
|
(
|
|
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.
|
|
mode_info_get_var_table(ModeInfo, VarTable),
|
|
lookup_var_type(VarTable, Var, Type),
|
|
( if
|
|
inst_is_ground(ModuleInfo, Type, Inst),
|
|
inst_is_mostly_unique(ModuleInfo, Inst)
|
|
then
|
|
IsLive = is_dead
|
|
else
|
|
IsLive = is_live
|
|
)
|
|
),
|
|
get_var_insts_and_lives(ModeInfo, Vars, Insts, IsLives).
|
|
|
|
%---------------------%
|
|
|
|
:- pred modecheck_end_of_call(proc_info::in, modecheck_arg_offset::in,
|
|
list(mer_mode)::in, list(prog_var)::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, ArgOffset, ProcArgModes, ArgVars0,
|
|
InstVarSub, ArgVars, ExtraGoals, !ModeInfo) :-
|
|
mode_info_get_module_info(!.ModeInfo, ModuleInfo),
|
|
mode_list_get_initial_final_insts(ModuleInfo, ProcArgModes,
|
|
InitialInsts0, FinalInsts0),
|
|
inst_list_apply_substitution(InstVarSub, InitialInsts0, InitialInsts),
|
|
inst_list_apply_substitution(InstVarSub, FinalInsts0, FinalInsts),
|
|
modecheck_set_var_insts(ArgOffset, ArgVars0, InitialInsts, FinalInsts,
|
|
ArgVars, ExtraGoals, !ModeInfo),
|
|
can_proc_info_ever_succeed(ProcInfo, CanSucceed),
|
|
(
|
|
CanSucceed = proc_cannot_succeed,
|
|
instmap.init_unreachable(Instmap),
|
|
mode_info_set_instmap(Instmap, !ModeInfo)
|
|
;
|
|
CanSucceed = proc_can_maybe_succeed
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
modecheck_higher_order_call(GenericCall, ArgVars0, ArgVars, Modes,
|
|
Detism, ExtraGoals, !ModeInfo) :-
|
|
GenericCall = higher_order(PredVar, _, PredOrFunc, _, _),
|
|
% First, check that `PredVar' has a higher-order inst,
|
|
% with the right pred_or_func and 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),
|
|
ActualPredFormArity = arg_list_arity(ArgVars0),
|
|
user_arity_pred_form_arity(PredOrFunc,
|
|
ActualUserArity, ActualPredFormArity),
|
|
get_higher_order_inst_match(!.ModeInfo, PredOrFunc, PredVar, PredVarInst,
|
|
ActualUserArity, Match),
|
|
(
|
|
Match = higher_order_match(PredInstInfo),
|
|
PredInstInfo = pred_inst_info(_, Modes0, _, Detism0),
|
|
( 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),
|
|
ModeError = mode_error_bind_locked_var(Reason, PredVar,
|
|
PredVarInst, BetterPredVarInst),
|
|
mode_info_error(WaitingVars, ModeError, !ModeInfo),
|
|
Modes = [],
|
|
Detism = detism_erroneous,
|
|
ArgVars = ArgVars0,
|
|
ExtraGoals = no_extra_goals
|
|
else
|
|
Modes = Modes0,
|
|
Detism = Detism0,
|
|
ArgOffset = higher_order_modecheck_arg_offset,
|
|
modecheck_arg_list(match_higher_order_call(GenericCall),
|
|
ArgOffset, Modes, ExtraGoals, ArgVars0, ArgVars, !ModeInfo),
|
|
( if determinism_components(Detism, _, at_most_zero) then
|
|
instmap.init_unreachable(Instmap),
|
|
mode_info_set_instmap(Instmap, !ModeInfo)
|
|
else
|
|
true
|
|
)
|
|
)
|
|
;
|
|
Match = higher_order_mismatch(Mismatch),
|
|
% 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),
|
|
ModeError = mode_error_bad_higher_order_inst(PredVar, PredVarInst,
|
|
PredOrFunc, ActualUserArity, Mismatch),
|
|
mode_info_error(WaitingVars, ModeError, !ModeInfo),
|
|
Modes = [],
|
|
Detism = detism_erroneous,
|
|
ArgVars = ArgVars0,
|
|
ExtraGoals = no_extra_goals
|
|
).
|
|
|
|
:- type maybe_higher_order_match
|
|
---> higher_order_match(pred_inst_info)
|
|
; higher_order_mismatch(higher_order_mismatch_info).
|
|
|
|
:- pred get_higher_order_inst_match(mode_info::in, pred_or_func::in,
|
|
prog_var::in, mer_inst::in, user_arity::in,
|
|
maybe_higher_order_match::out) is det.
|
|
|
|
get_higher_order_inst_match(ModeInfo, ExpectedPredOrFunc, PredVar, PredVarInst,
|
|
ExpectedUserArity, MaybeMatch) :-
|
|
( if
|
|
( PredVarInst = ground(_Uniq, HOInstInfo)
|
|
; PredVarInst = any(_Uniq, HOInstInfo)
|
|
)
|
|
then
|
|
(
|
|
HOInstInfo = higher_order(PredInstInfo),
|
|
check_for_pf_arity_mismatch(ExpectedPredOrFunc, ExpectedUserArity,
|
|
PredInstInfo, MaybeMatch)
|
|
;
|
|
% If PredVarInst has no higher-order inst information,
|
|
% then look for higher-order inst information in the type.
|
|
% Otherwise, if PredVar has a function type, assume the default
|
|
% function mode.
|
|
HOInstInfo = none_or_default_func,
|
|
mode_info_get_var_table(ModeInfo, VarTable),
|
|
lookup_var_type(VarTable, PredVar, Type0),
|
|
Type = strip_kind_annotation(Type0),
|
|
( if
|
|
Type = higher_order_type(TypePredOrFunc, ArgTypes,
|
|
TypeHOInstInfo, _Purity)
|
|
then
|
|
(
|
|
TypeHOInstInfo = higher_order(PredInstInfo),
|
|
PredInstInfo = pred_inst_info(TypeHOPredOrFunc, _, _, _),
|
|
expect(unify(TypePredOrFunc, TypeHOPredOrFunc), $pred,
|
|
"TypePredOrFunc != TypeHOPredOrFunc"),
|
|
check_for_pf_arity_mismatch(ExpectedPredOrFunc,
|
|
ExpectedUserArity, PredInstInfo, MaybeMatch)
|
|
;
|
|
TypeHOInstInfo = none_or_default_func,
|
|
(
|
|
TypePredOrFunc = pf_function,
|
|
list.length(ArgTypes, NumArgs),
|
|
PredInstInfo =
|
|
pred_inst_info_default_func_mode(NumArgs),
|
|
check_for_pf_arity_mismatch(ExpectedPredOrFunc,
|
|
ExpectedUserArity, PredInstInfo, MaybeMatch)
|
|
;
|
|
TypePredOrFunc = pf_predicate,
|
|
HOMismatch0 = ho_mismatch_no_higher_order_inst_info,
|
|
MaybeMatch = higher_order_mismatch(HOMismatch0)
|
|
)
|
|
)
|
|
else
|
|
HOMismatch0 = ho_mismatch_not_higher_order_type,
|
|
MaybeMatch = higher_order_mismatch(HOMismatch0)
|
|
)
|
|
)
|
|
else
|
|
MaybeMatch =
|
|
higher_order_mismatch(ho_mismatch_no_higher_order_inst_info)
|
|
).
|
|
|
|
:- pred check_for_pf_arity_mismatch(pred_or_func::in, user_arity::in,
|
|
pred_inst_info::in, maybe_higher_order_match::out) is det.
|
|
|
|
check_for_pf_arity_mismatch(ExpectedPredOrFunc, ExpectedUserArity,
|
|
PredInstInfo, MaybeMatch) :-
|
|
PredInstInfo = pred_inst_info(ActualPredOrFunc, Modes, _, _),
|
|
( if ExpectedPredOrFunc = ActualPredOrFunc then
|
|
ActualPredFormArity = arg_list_arity(Modes),
|
|
user_arity_pred_form_arity(ActualPredOrFunc,
|
|
ActualUserArity, ActualPredFormArity),
|
|
( if ExpectedUserArity = ActualUserArity then
|
|
MaybeMatch = higher_order_match(PredInstInfo)
|
|
else
|
|
HOMismatch = ho_mismatch_on_arity(ActualUserArity),
|
|
MaybeMatch = higher_order_mismatch(HOMismatch)
|
|
)
|
|
else
|
|
HOMismatch = ho_mismatch_pred_vs_func(ActualPredOrFunc),
|
|
MaybeMatch = higher_order_mismatch(HOMismatch)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
modecheck_event_call(Modes, Args0, Args, !ModeInfo) :-
|
|
ArgOffset = unify_method_event_cast_modecheck_arg_offset,
|
|
modecheck_arg_list(match_event, ArgOffset, Modes, ExtraGoals,
|
|
Args0, Args, !ModeInfo),
|
|
expect(unify(ExtraGoals, no_extra_goals), $pred, "ExtraGoals").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
modecheck_builtin_cast(Modes, Args0, Args, Det, ExtraGoals, !ModeInfo) :-
|
|
Det = detism_det,
|
|
% These should always be mode correct.
|
|
ArgOffset = unify_method_event_cast_modecheck_arg_offset,
|
|
modecheck_arg_list(match_cast, ArgOffset, Modes, ExtraGoals,
|
|
Args0, Args, !ModeInfo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Modecheck the arguments of
|
|
%
|
|
% - higher order calls,
|
|
% - events, and
|
|
% - casts.
|
|
%
|
|
:- pred modecheck_arg_list(match_what::in, modecheck_arg_offset::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(MatchWhat, 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_vars_are_live_no_exact_match(ArgOffset, Args0, ExpectedArgLives,
|
|
!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_vars_have_insts_no_exact_match(MatchWhat, ArgOffset,
|
|
Args0, InitialInsts, InstVarSub, _BoundInstVars, !ModeInfo),
|
|
mode_list_get_final_insts(ModuleInfo0, Modes, FinalInsts0),
|
|
inst_list_apply_substitution(InstVarSub, FinalInsts0, FinalInsts),
|
|
modecheck_set_var_insts(ArgOffset, Args0, InitialInsts, FinalInsts,
|
|
Args, ExtraGoals, !ModeInfo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module check_hlds.modecheck_call.
|
|
%---------------------------------------------------------------------------%
|