mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 09:53:36 +00:00
625ec287f1
compiler/prog_type_construct.m:
New module for constructing types.
compiler/prog_type_repn.m:
New module for testing things related to type representation.
compiler/prog_type_scan.m:
New module for gather type vars in types.
compiler/prog_type_test.m:
New module containing simple tests on types.
compiler/prog_type_unify.m:
New module for testing whether two types unify, or whether
one type subsumes another.
compiler/prog_type.m:
Delete the code moved to the new modules.
compiler/parse_tree.m:
Include the new modules.
compiler/notes/compiler_design.html:
Document the new modules.
compiler/*.m:
Conform to the changes above, by adjusting imports as needed,
and by deleting any explicit module qualifications that
this diff makes obsolete.
584 lines
25 KiB
Mathematica
584 lines
25 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_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.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.inst_lookup.
|
|
:- import_module check_hlds.inst_test.
|
|
:- import_module check_hlds.inst_util.
|
|
:- import_module check_hlds.mode_comparison.
|
|
:- import_module check_hlds.mode_errors.
|
|
:- import_module check_hlds.mode_util.
|
|
:- import_module check_hlds.proc_requests.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_proc_util.
|
|
:- import_module hlds.instmap.
|
|
:- 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_call_pred(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)
|
|
),
|
|
|
|
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),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
expect(unify(PredOrFunc, pf_predicate), $pred,
|
|
"function with no mode, not even the default"),
|
|
mode_info_error(WaitingVars, mode_error_callee_pred_has_no_mode_decl,
|
|
!ModeInfo),
|
|
SelectedProcId = 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
|
|
SelectedProcId = ProcId,
|
|
map.lookup(ProcTable, ProcId, ProcInfo),
|
|
|
|
% Check that `ArgsVars0' have livenesses which match the
|
|
% expected livenesses.
|
|
proc_info_arglives(ModuleInfo, ProcInfo, 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(PredId, ProcTable, ArgVars0, ProcIds,
|
|
[], RevMatchingProcModes, [], RevProcInitialInsts,
|
|
WaitingVars0, WaitingVars1, !ModeInfo),
|
|
(
|
|
RevMatchingProcModes = [],
|
|
list.reverse(RevProcInitialInsts, ProcInitialInsts),
|
|
no_matching_modes(PredId, ArgVars0, ProcInitialInsts,
|
|
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, ProcArgModes, ArgVars0,
|
|
ArgOffset, 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)
|
|
)
|
|
),
|
|
|
|
% 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)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred modecheck_find_matching_modes(pred_id::in, proc_table::in,
|
|
list(prog_var)::in, list(proc_id)::in,
|
|
list(proc_mode)::in, list(proc_mode)::out,
|
|
list(list(mer_inst))::in, list(list(mer_inst))::out,
|
|
set_of_progvar::in, set_of_progvar::out,
|
|
mode_info::in, mode_info::out) is det.
|
|
|
|
modecheck_find_matching_modes(_PredId, _ProcTable, _ArgVars, [],
|
|
!RevMatchingProcModes, !RevProcInitialInsts,
|
|
!WaitingVars, !ModeInfo).
|
|
modecheck_find_matching_modes(PredId, ProcTable, ArgVars0, [ProcId | ProcIds],
|
|
!RevMatchingProcModes, !RevProcInitialInsts,
|
|
!WaitingVars, !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 ProcInstVarSet
|
|
% *permanently* to the inst_varset of
|
|
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_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 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?
|
|
|
|
mode_list_get_initial_insts(ModuleInfo, ProcArgModes, InitialInsts),
|
|
!:RevProcInitialInsts = [InitialInsts | !.RevProcInitialInsts],
|
|
look_up_proc_mode_errors(!.ModeInfo, PredId, ProcId, ProcModeErrors),
|
|
(
|
|
ProcModeErrors = [],
|
|
modecheck_var_has_inst_list_no_exact_match(ArgVars0, InitialInsts, 0,
|
|
InstVarSub, !ModeInfo)
|
|
;
|
|
ProcModeErrors = [_ | _],
|
|
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 = [],
|
|
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, ArgVars0, ProcIds,
|
|
!RevMatchingProcModes, !RevProcInitialInsts, !WaitingVars, !ModeInfo).
|
|
|
|
%---------------------%
|
|
|
|
:- pred no_matching_modes(pred_id::in, list(prog_var)::in,
|
|
list(list(mer_inst))::in, maybe(determinism)::in, set_of_progvar::in,
|
|
proc_id::out, mode_info::in, mode_info::out) is det.
|
|
|
|
no_matching_modes(PredId, ArgVars, ProcInitialInsts, 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 check_marker(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),
|
|
ModeError = mode_error_no_matching_mode(InstMap, ArgVars,
|
|
ProcInitialInsts),
|
|
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.
|
|
( 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(ModeInfo, Vars, Insts, IsLives).
|
|
|
|
%---------------------%
|
|
|
|
:- 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),
|
|
mode_list_get_final_insts(ModuleInfo, ProcArgModes, FinalInsts0),
|
|
inst_list_apply_substitution(InstVarSub, InitialInsts0, InitialInsts),
|
|
inst_list_apply_substitution(InstVarSub, FinalInsts0, FinalInsts),
|
|
modecheck_set_var_inst_list(ArgVars0, InitialInsts, FinalInsts,
|
|
ArgOffset, ArgVars, ExtraGoals, !ModeInfo),
|
|
proc_info_never_succeeds(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(PredOrFunc, PredVar, ArgVars0, ArgVars,
|
|
Modes, Detism, ExtraGoals, !ModeInfo) :-
|
|
% 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 = 1,
|
|
modecheck_arg_list(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 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,
|
|
higher_order_match::out) is det.
|
|
|
|
get_higher_order_inst_match(ModeInfo, ExpectedPredOrFunc, PredVar, PredVarInst,
|
|
ExpectedUserArity, Match) :-
|
|
( if
|
|
( PredVarInst = ground(_Uniq, HOInstInfo)
|
|
; PredVarInst = any(_Uniq, HOInstInfo)
|
|
)
|
|
then
|
|
(
|
|
HOInstInfo = higher_order(PredInstInfo0),
|
|
Match0 = higher_order_match(PredInstInfo0)
|
|
;
|
|
% 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, _EvalMethod)
|
|
then
|
|
(
|
|
TypeHOInstInfo = higher_order(PredInstInfo0),
|
|
PredInstInfo0 = pred_inst_info(TypeHOPredOrFunc, _, _, _),
|
|
expect(unify(TypePredOrFunc, TypeHOPredOrFunc), $pred,
|
|
"TypePredOrFunc != TypeHOPredOrFunc"),
|
|
Match0 = higher_order_match(PredInstInfo0)
|
|
;
|
|
TypeHOInstInfo = none_or_default_func,
|
|
(
|
|
TypePredOrFunc = pf_function,
|
|
list.length(ArgTypes, NumArgs),
|
|
PredInstInfo0 =
|
|
pred_inst_info_default_func_mode(NumArgs),
|
|
Match0 = higher_order_match(PredInstInfo0)
|
|
;
|
|
TypePredOrFunc = pf_predicate,
|
|
Mismatch0 = mismatch_no_higher_order_inst_info,
|
|
Match0 = higher_order_mismatch(Mismatch0)
|
|
)
|
|
)
|
|
else
|
|
Match0 = higher_order_mismatch(mismatch_not_higher_order_type)
|
|
)
|
|
),
|
|
(
|
|
Match0 = higher_order_mismatch(Mismatch),
|
|
Match = higher_order_mismatch(Mismatch)
|
|
;
|
|
Match0 = higher_order_match(PredInstInfo),
|
|
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
|
|
Match = higher_order_match(PredInstInfo)
|
|
else
|
|
Mismatch = mismatch_on_arity(ActualUserArity),
|
|
Match = higher_order_mismatch(Mismatch)
|
|
)
|
|
else
|
|
Mismatch = mismatch_pred_vs_func(ActualPredOrFunc),
|
|
Match = higher_order_mismatch(Mismatch)
|
|
)
|
|
)
|
|
else
|
|
Match = higher_order_mismatch(mismatch_no_higher_order_inst_info)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
modecheck_event_call(Modes, Args0, Args, !ModeInfo) :-
|
|
ArgOffset = 0,
|
|
modecheck_arg_list(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 = 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).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module check_hlds.modecheck_call.
|
|
%---------------------------------------------------------------------------%
|